{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Swarm.TUI.Editor.Model where
import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Lens hiding (from, (.=), (<.>))
import Data.Map qualified as M
import Data.Vector qualified as V
import Swarm.Game.Display (Display)
import Swarm.Game.Entity qualified as E
import Swarm.Game.Scenario.Topography.EntityFacade
import Swarm.Game.Scenario.Topography.WorldPalette
import Swarm.Game.Terrain (TerrainType)
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.TUI.Model.Name
import Swarm.Util
import System.Clock
data BoundsSelectionStep
= UpperLeftPending
|
LowerRightPending (Cosmic W.Coords)
| SelectionComplete
data EntityPaint
= Facade EntityFacade
| Ref E.Entity
deriving (EntityPaint -> EntityPaint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityPaint -> EntityPaint -> Bool
$c/= :: EntityPaint -> EntityPaint -> Bool
== :: EntityPaint -> EntityPaint -> Bool
$c== :: EntityPaint -> EntityPaint -> Bool
Eq)
getDisplay :: EntityPaint -> Display
getDisplay :: EntityPaint -> Display
getDisplay (Facade (EntityFacade EntityName
_ Display
d)) = Display
d
getDisplay (Ref Entity
e) = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Display
E.entityDisplay
toFacade :: EntityPaint -> EntityFacade
toFacade :: EntityPaint -> EntityFacade
toFacade = \case
Facade EntityFacade
f -> EntityFacade
f
Ref Entity
e -> Entity -> EntityFacade
mkFacade Entity
e
getEntityName :: EntityFacade -> E.EntityName
getEntityName :: EntityFacade -> EntityName
getEntityName (EntityFacade EntityName
name Display
_) = EntityName
name
data MapEditingBounds = MapEditingBounds
{ MapEditingBounds -> Maybe (Cosmic BoundsRectangle)
_boundsRect :: Maybe (Cosmic W.BoundsRectangle)
, MapEditingBounds -> TimeSpec
_boundsPersistDisplayUntil :: TimeSpec
, MapEditingBounds -> BoundsSelectionStep
_boundsSelectionStep :: BoundsSelectionStep
}
makeLenses ''MapEditingBounds
data WorldOverdraw = WorldOverdraw
{ WorldOverdraw -> Bool
_isWorldEditorEnabled :: Bool
, WorldOverdraw -> Map Coords (TerrainWith EntityFacade)
_paintedTerrain :: M.Map W.Coords (TerrainWith EntityFacade)
}
makeLenses ''WorldOverdraw
data WorldEditor n = WorldEditor
{ forall n. WorldEditor n -> WorldOverdraw
_worldOverdraw :: WorldOverdraw
, forall n. WorldEditor n -> List n TerrainType
_terrainList :: BL.List n TerrainType
, forall n. WorldEditor n -> List n EntityFacade
_entityPaintList :: BL.List n EntityFacade
, forall n. WorldEditor n -> MapEditingBounds
_editingBounds :: MapEditingBounds
, forall n. WorldEditor n -> FocusRing n
_editorFocusRing :: FocusRing n
, forall n. WorldEditor n -> FilePath
_outputFilePath :: FilePath
, forall n. WorldEditor n -> Maybe FilePath
_lastWorldEditorMessage :: Maybe String
}
makeLenses ''WorldEditor
initialWorldEditor :: TimeSpec -> WorldEditor Name
initialWorldEditor :: TimeSpec -> WorldEditor Name
initialWorldEditor TimeSpec
ts =
forall n.
WorldOverdraw
-> List n TerrainType
-> List n EntityFacade
-> MapEditingBounds
-> FocusRing n
-> FilePath
-> Maybe FilePath
-> WorldEditor n
WorldEditor
(Bool -> Map Coords (TerrainWith EntityFacade) -> WorldOverdraw
WorldOverdraw Bool
False forall a. Monoid a => a
mempty)
(forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
TerrainList (forall a. [a] -> Vector a
V.fromList forall e. (Enum e, Bounded e) => [e]
listEnums) Int
1)
(forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
EntityPaintList (forall a. [a] -> Vector a
V.fromList []) Int
1)
MapEditingBounds
bounds
(forall n. [n] -> FocusRing n
focusRing forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map WorldEditorFocusable -> Name
WorldEditorPanelControl forall e. (Enum e, Bounded e) => [e]
listEnums)
FilePath
"mymap.yaml"
forall a. Maybe a
Nothing
where
bounds :: MapEditingBounds
bounds =
Maybe (Cosmic BoundsRectangle)
-> TimeSpec -> BoundsSelectionStep -> MapEditingBounds
MapEditingBounds
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
DefaultRootSubworld ((Int32, Int32) -> Coords
W.Coords (-Int32
10, -Int32
20), (Int32, Int32) -> Coords
W.Coords (Int32
10, Int32
20)))
(TimeSpec
ts forall a. Num a => a -> a -> a
- TimeSpec
1)
BoundsSelectionStep
SelectionComplete