{-# 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.List.Extra (enumerate)
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.Coords
import Swarm.TUI.Model.Name
import System.Clock
data BoundsSelectionStep
= UpperLeftPending
|
LowerRightPending (Cosmic Coords)
| SelectionComplete
data EntityPaint
= Facade EntityFacade
| Ref E.Entity
deriving (EntityPaint -> EntityPaint -> Bool
(EntityPaint -> EntityPaint -> Bool)
-> (EntityPaint -> EntityPaint -> Bool) -> Eq EntityPaint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityPaint -> EntityPaint -> Bool
== :: EntityPaint -> EntityPaint -> Bool
$c/= :: EntityPaint -> EntityPaint -> Bool
/= :: EntityPaint -> EntityPaint -> Bool
Eq)
getDisplay :: EntityPaint -> Display
getDisplay :: EntityPaint -> Display
getDisplay (Facade (EntityFacade EntityName
_ Display
d)) = Display
d
getDisplay (Ref Entity
e) = Entity
e Entity -> Getting Display Entity Display -> Display
forall s a. s -> Getting a s a -> a
^. Getting Display Entity Display
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
data MapEditingBounds = MapEditingBounds
{ MapEditingBounds -> Maybe (Cosmic BoundsRectangle)
_boundsRect :: Maybe (Cosmic 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 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 =
WorldOverdraw
-> List Name TerrainType
-> List Name EntityFacade
-> MapEditingBounds
-> FocusRing Name
-> FilePath
-> Maybe FilePath
-> WorldEditor Name
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 Map Coords (TerrainWith EntityFacade)
forall a. Monoid a => a
mempty)
(Name -> Vector TerrainType -> Int -> List Name TerrainType
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
TerrainList ([TerrainType] -> Vector TerrainType
forall a. [a] -> Vector a
V.fromList []) Int
1)
(Name -> Vector EntityFacade -> Int -> List Name EntityFacade
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
EntityPaintList ([EntityFacade] -> Vector EntityFacade
forall a. [a] -> Vector a
V.fromList []) Int
1)
MapEditingBounds
bounds
([Name] -> FocusRing Name
forall n. [n] -> FocusRing n
focusRing ([Name] -> FocusRing Name) -> [Name] -> FocusRing Name
forall a b. (a -> b) -> a -> b
$ (WorldEditorFocusable -> Name) -> [WorldEditorFocusable] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map WorldEditorFocusable -> Name
WorldEditorPanelControl [WorldEditorFocusable]
forall a. (Enum a, Bounded a) => [a]
enumerate)
FilePath
"mymap.yaml"
Maybe FilePath
forall a. Maybe a
Nothing
where
bounds :: MapEditingBounds
bounds =
Maybe (Cosmic BoundsRectangle)
-> TimeSpec -> BoundsSelectionStep -> MapEditingBounds
MapEditingBounds
(Cosmic BoundsRectangle -> Maybe (Cosmic BoundsRectangle)
forall a. a -> Maybe a
Just (Cosmic BoundsRectangle -> Maybe (Cosmic BoundsRectangle))
-> Cosmic BoundsRectangle -> Maybe (Cosmic BoundsRectangle)
forall a b. (a -> b) -> a -> b
$ SubworldName -> BoundsRectangle -> Cosmic BoundsRectangle
forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
DefaultRootSubworld ((Int32, Int32) -> Coords
Coords (-Int32
10, -Int32
20), (Int32, Int32) -> Coords
Coords (Int32
10, Int32
20)))
(TimeSpec
ts TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
- TimeSpec
1)
BoundsSelectionStep
SelectionComplete