{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
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

------------------------------------------------------------
-- World Editor panel events
------------------------------------------------------------

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 =
  -- TODO: #1371
  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 ()

-- | "Eye Dropper" tool:
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

-- | Handle user input events in the robot panel.
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 ()

-- | Return value: whether the cursor position should be updated
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
      -- TODO (#1152): Validate that the lower-right click is below and to the right of
      -- the top-left coord and that they are within the same subworld
      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."