{-# LANGUAGE OverloadedStrings #-}
module Swarm.TUI.Editor.Controller where
import Brick hiding (Direction (..), Location (..))
import Brick qualified as B
import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Lens
import Control.Monad (forM_, guard, when)
import Control.Monad.Extra (whenJust)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.Map qualified as M
import Data.Yaml qualified as Y
import Graphics.Vty qualified as V
import Swarm.Game.Scenario.Topography.EntityFacade
import Swarm.Game.State
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.TUI.Controller.Util
import Swarm.TUI.Editor.Model
import Swarm.TUI.Editor.Palette
import Swarm.TUI.Editor.Util qualified as EU
import Swarm.TUI.Model
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.UI
import Swarm.Util (hoistMaybe)
import Swarm.Util.Erasable (maybeToErasable)
import System.Clock
activateWorldEditorFunction :: WorldEditorFocusable -> EventM Name AppState ()
activateWorldEditorFunction :: WorldEditorFocusable -> EventM Name AppState ()
activateWorldEditorFunction WorldEditorFocusable
BrushSelector = ModalType -> EventM Name AppState ()
openModal ModalType
TerrainPaletteModal
activateWorldEditorFunction WorldEditorFocusable
EntitySelector = ModalType -> EventM Name AppState ()
openModal ModalType
EntityPaletteModal
activateWorldEditorFunction WorldEditorFocusable
AreaSelector = do
BoundsSelectionStep
selectorStage <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep
case BoundsSelectionStep
selectorStage of
BoundsSelectionStep
SelectionComplete -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BoundsSelectionStep
UpperLeftPending
BoundsSelectionStep
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
activateWorldEditorFunction WorldEditorFocusable
OutputPathSelector =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"File selection"
activateWorldEditorFunction WorldEditorFocusable
MapSaveButton = EventM Name AppState ()
saveMapFile
activateWorldEditorFunction WorldEditorFocusable
ClearEntityButton =
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n EntityFacade)
entityPaintList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
BL.listSelectedL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
handleCtrlLeftClick :: B.Location -> EventM Name AppState ()
handleCtrlLeftClick :: Location -> EventM Name AppState ()
handleCtrlLeftClick Location
mouseLoc = do
WorldEditor Name
worldEditor <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor
Maybe ()
_ <- forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WorldOverdraw Bool
isWorldEditorEnabled
let getSelected :: GenericList n t b -> Maybe b
getSelected GenericList n t b
x = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement GenericList n t b
x
maybeTerrainType :: Maybe TerrainType
maybeTerrainType = forall {t :: * -> *} {b} {n}.
(Splittable t, Traversable t, Semigroup (t b)) =>
GenericList n t b -> Maybe b
getSelected forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) (List n TerrainType)
terrainList
maybeEntityPaint :: Maybe EntityFacade
maybeEntityPaint = forall {t :: * -> *} {b} {n}.
(Splittable t, Traversable t, Semigroup (t b)) =>
GenericList n t b -> Maybe b
getSelected forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) (List n EntityFacade)
entityPaintList
TerrainType
terrain <- forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe Maybe TerrainType
maybeTerrainType
Cosmic Coords
mouseCoords <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' AppState GameState
gameState forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WorldOverdraw (Map Coords (TerrainWith EntityFacade))
paintedTerrain forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Cosmic Coords
mouseCoords forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) (TerrainType
terrain, forall e. Maybe e -> Erasable e
maybeToErasable Maybe EntityFacade
maybeEntityPaint)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (Maybe String)
lastWorldEditorMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
EventM Name AppState ()
immediatelyRedrawWorld
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleRightClick :: B.Location -> EventM Name AppState ()
handleRightClick :: Location -> EventM Name AppState ()
handleRightClick Location
mouseLoc = do
WorldEditor Name
worldEditor <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor
Maybe ()
_ <- forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WorldOverdraw Bool
isWorldEditorEnabled
Cosmic Coords
mouseCoords <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' AppState GameState
gameState forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WorldOverdraw (Map Coords (TerrainWith EntityFacade))
paintedTerrain forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Cosmic Coords
mouseCoords forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar)
EventM Name AppState ()
immediatelyRedrawWorld
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleMiddleClick :: B.Location -> EventM Name AppState ()
handleMiddleClick :: Location -> EventM Name AppState ()
handleMiddleClick Location
mouseLoc = do
WorldEditor Name
worldEditor <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WorldOverdraw Bool
isWorldEditorEnabled) forall a b. (a -> b) -> a -> b
$ do
MultiWorld Int Entity
w <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld Int Entity)
multiWorld
let setTerrainPaint :: Cosmic Coords -> m ()
setTerrainPaint Cosmic Coords
coords = do
let (TerrainType
terrain, Maybe EntityPaint
maybeElementPaint) =
WorldOverdraw
-> MultiWorld Int Entity
-> Cosmic Coords
-> (TerrainType, Maybe EntityPaint)
EU.getEditorContentAt
(WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw)
MultiWorld Int Entity
w
Cosmic Coords
coords
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n TerrainType)
terrainList forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
BL.listMoveToElement TerrainType
terrain
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe EntityPaint
maybeElementPaint forall a b. (a -> b) -> a -> b
$ \EntityPaint
elementPaint ->
let p :: EntityFacade
p = case EntityPaint
elementPaint of
Facade EntityFacade
efd -> EntityFacade
efd
Ref Entity
r -> Entity -> EntityFacade
mkFacade Entity
r
in Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n EntityFacade)
entityPaintList forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
BL.listMoveToElement EntityFacade
p
Maybe (Cosmic Coords)
mouseCoordsM <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' AppState GameState
gameState forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Cosmic Coords)
mouseCoordsM forall {m :: * -> *}.
MonadState AppState m =>
Cosmic Coords -> m ()
setTerrainPaint
handleWorldEditorPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEditorPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEditorPanelEvent = \case
Key Key
V.KEsc -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BoundsSelectionStep
SelectionComplete
Key Key
V.KEnter -> do
FocusRing Name
fring <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (FocusRing n)
editorFocusRing
case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring of
Just (WorldEditorPanelControl WorldEditorFocusable
x) -> WorldEditorFocusable -> EventM Name AppState ()
activateWorldEditorFunction WorldEditorFocusable
x
Maybe Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ControlChar Char
's' -> EventM Name AppState ()
saveMapFile
CharKey Char
'\t' -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (FocusRing n)
editorFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
Key Key
V.KBackTab -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (FocusRing n)
editorFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
BrickEvent Name AppEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateAreaBounds :: Maybe (Cosmic W.Coords) -> EventM Name AppState Bool
updateAreaBounds :: Maybe (Cosmic Coords) -> EventM Name AppState Bool
updateAreaBounds = \case
Maybe (Cosmic Coords)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just Cosmic Coords
mouseCoords -> do
BoundsSelectionStep
selectorStage <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep
case BoundsSelectionStep
selectorStage of
BoundsSelectionStep
UpperLeftPending -> do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Cosmic Coords -> BoundsSelectionStep
LowerRightPending Cosmic Coords
mouseCoords
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
LowerRightPending Cosmic Coords
upperLeftMouseCoords -> do
Lens' AppState UIState
uiState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds (Maybe (Cosmic BoundsRectangle))
boundsRect
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar Cosmic Coords
mouseCoords) Cosmic Coords
upperLeftMouseCoords)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (Maybe String)
lastWorldEditorMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BoundsSelectionStep
SelectionComplete
TimeSpec
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds TimeSpec
boundsPersistDisplayUntil forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
t forall a. Num a => a -> a -> a
+ Int64 -> Int64 -> TimeSpec
TimeSpec Int64
2 Int64
0
FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
WorldEditorPanel
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
BoundsSelectionStep
SelectionComplete -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
saveMapFile :: EventM Name AppState ()
saveMapFile :: EventM Name AppState ()
saveMapFile = do
WorldEditor Name
worldEditor <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor
Maybe (Cosmic BoundsRectangle)
maybeBounds <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) MapEditingBounds
editingBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MapEditingBounds (Maybe (Cosmic BoundsRectangle))
boundsRect
MultiWorld Int Entity
w <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld Int Entity)
multiWorld
let mapCellGrid :: [[CellPaintDisplay]]
mapCellGrid = WorldOverdraw
-> Maybe (Cosmic BoundsRectangle)
-> MultiWorld Int Entity
-> [[CellPaintDisplay]]
EU.getEditedMapRectangle (WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw) Maybe (Cosmic BoundsRectangle)
maybeBounds MultiWorld Int Entity
w
let fp :: String
fp = WorldEditor Name
worldEditor forall s a. s -> Getting a s a -> a
^. forall n. Lens' (WorldEditor n) String
outputFilePath
Maybe ScenarioInfoPair
maybeScenarioPair <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe ScenarioInfoPair)
scenarioRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => String -> a -> IO ()
Y.encodeFile String
fp forall a b. (a -> b) -> a -> b
$ Maybe Scenario -> [[CellPaintDisplay]] -> SkeletonScenario
constructScenario (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScenarioInfoPair
maybeScenarioPair) [[CellPaintDisplay]]
mapCellGrid
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (Maybe String)
lastWorldEditorMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just String
"Saved."