{-# 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.Land
import Swarm.Game.Scenario.Status
import Swarm.Game.Scenario.Topography.EntityFacade
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.Universe
import Swarm.Game.World.Coords
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.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.UI.Gameplay
import Swarm.Util (hoistMaybe)
import Swarm.Util.Erasable (maybeToErasable)
import System.Clock

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

activateWorldEditorFunction :: WorldEditorFocusable -> EventM Name ScenarioState ()
activateWorldEditorFunction :: WorldEditorFocusable -> EventM Name ScenarioState ()
activateWorldEditorFunction WorldEditorFocusable
BrushSelector = MidScenarioModalType -> EventM Name ScenarioState ()
openMidScenarioModal MidScenarioModalType
TerrainPaletteModal
activateWorldEditorFunction WorldEditorFocusable
EntitySelector = MidScenarioModalType -> EventM Name ScenarioState ()
openMidScenarioModal MidScenarioModalType
EntityPaletteModal
activateWorldEditorFunction WorldEditorFocusable
AreaSelector =
  LensLike'
  (Zoomed (EventM Name MapEditingBounds) ())
  ScenarioState
  MapEditingBounds
-> EventM Name MapEditingBounds () -> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name MapEditingBounds) c)
  ScenarioState
  MapEditingBounds
-> EventM Name MapEditingBounds c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay -> Zoomed (EventM Name MapEditingBounds) () UIGameplay)
-> ScenarioState
-> Zoomed (EventM Name MapEditingBounds) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Zoomed (EventM Name MapEditingBounds) () UIGameplay)
 -> ScenarioState
 -> Zoomed (EventM Name MapEditingBounds) () ScenarioState)
-> ((MapEditingBounds
     -> Zoomed (EventM Name MapEditingBounds) () MapEditingBounds)
    -> UIGameplay
    -> Zoomed (EventM Name MapEditingBounds) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name MapEditingBounds) ())
     ScenarioState
     MapEditingBounds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Zoomed (EventM Name MapEditingBounds) () (WorldEditor Name))
-> UIGameplay
-> Zoomed (EventM Name MapEditingBounds) () UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Zoomed (EventM Name MapEditingBounds) () (WorldEditor Name))
 -> UIGameplay
 -> Zoomed (EventM Name MapEditingBounds) () UIGameplay)
-> ((MapEditingBounds
     -> Zoomed (EventM Name MapEditingBounds) () MapEditingBounds)
    -> WorldEditor Name
    -> Zoomed (EventM Name MapEditingBounds) () (WorldEditor Name))
-> (MapEditingBounds
    -> Zoomed (EventM Name MapEditingBounds) () MapEditingBounds)
-> UIGameplay
-> Zoomed (EventM Name MapEditingBounds) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapEditingBounds
 -> Zoomed (EventM Name MapEditingBounds) () MapEditingBounds)
-> WorldEditor Name
-> Zoomed (EventM Name MapEditingBounds) () (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds) (EventM Name MapEditingBounds () -> EventM Name ScenarioState ())
-> EventM Name MapEditingBounds () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    BoundsSelectionStep
selectorStage <- Getting BoundsSelectionStep MapEditingBounds BoundsSelectionStep
-> EventM Name MapEditingBounds BoundsSelectionStep
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting BoundsSelectionStep MapEditingBounds BoundsSelectionStep
Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep
    case BoundsSelectionStep
selectorStage of
      BoundsSelectionStep
SelectionComplete -> (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> MapEditingBounds -> Identity MapEditingBounds
Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep ((BoundsSelectionStep -> Identity BoundsSelectionStep)
 -> MapEditingBounds -> Identity MapEditingBounds)
-> BoundsSelectionStep -> EventM Name MapEditingBounds ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BoundsSelectionStep
UpperLeftPending
      BoundsSelectionStep
_ -> () -> EventM Name MapEditingBounds ()
forall a. a -> EventM Name MapEditingBounds a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
activateWorldEditorFunction WorldEditorFocusable
OutputPathSelector =
  -- TODO: #1371
  IO () -> EventM Name ScenarioState ()
forall a. IO a -> EventM Name ScenarioState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name ScenarioState ())
-> IO () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"File selection"
activateWorldEditorFunction WorldEditorFocusable
MapSaveButton = EventM Name ScenarioState ()
saveMapFile
activateWorldEditorFunction WorldEditorFocusable
ClearEntityButton =
  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Int -> Identity (Maybe Int))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Int -> Identity (Maybe Int))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (Maybe Int -> Identity (Maybe Int))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name EntityFacade -> Identity (List Name EntityFacade))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList ((List Name EntityFacade -> Identity (List Name EntityFacade))
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> ((Maybe Int -> Identity (Maybe Int))
    -> List Name EntityFacade -> Identity (List Name EntityFacade))
-> (Maybe Int -> Identity (Maybe Int))
-> WorldEditor Name
-> Identity (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Identity (Maybe Int))
-> List Name EntityFacade -> Identity (List Name EntityFacade)
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> GenericList n t e -> f (GenericList n t e)
BL.listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> ScenarioState -> Identity ScenarioState)
-> Maybe Int -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
forall a. Maybe a
Nothing

handleCtrlLeftClick :: B.Location -> EventM Name ScenarioState ()
handleCtrlLeftClick :: Location -> EventM Name ScenarioState ()
handleCtrlLeftClick Location
mouseLoc = do
  WorldEditor Name
worldEditor <- Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
-> EventM Name ScenarioState (WorldEditor Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
 -> EventM Name ScenarioState (WorldEditor Name))
-> Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
-> EventM Name ScenarioState (WorldEditor Name)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> ScenarioState -> Const (WorldEditor Name) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (WorldEditor Name) UIGameplay)
 -> ScenarioState -> Const (WorldEditor Name) ScenarioState)
-> ((WorldEditor Name
     -> Const (WorldEditor Name) (WorldEditor Name))
    -> UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Const (WorldEditor Name) (WorldEditor Name))
-> UIGameplay -> Const (WorldEditor Name) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor
  Maybe ()
_ <- MaybeT (EventM Name ScenarioState) ()
-> EventM Name ScenarioState (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (EventM Name ScenarioState) ()
 -> EventM Name ScenarioState (Maybe ()))
-> MaybeT (EventM Name ScenarioState) ()
-> EventM Name ScenarioState (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
    Bool -> MaybeT (EventM Name ScenarioState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (EventM Name ScenarioState) ())
-> Bool -> MaybeT (EventM Name ScenarioState) ()
forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor WorldEditor Name -> Getting Bool (WorldEditor Name) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WorldOverdraw -> Const Bool WorldOverdraw)
-> WorldEditor Name -> Const Bool (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw ((WorldOverdraw -> Const Bool WorldOverdraw)
 -> WorldEditor Name -> Const Bool (WorldEditor Name))
-> ((Bool -> Const Bool Bool)
    -> WorldOverdraw -> Const Bool WorldOverdraw)
-> Getting Bool (WorldEditor Name) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WorldOverdraw -> Const Bool WorldOverdraw
Lens' WorldOverdraw Bool
isWorldEditorEnabled
    let getSelected :: GenericList n t b -> Maybe b
getSelected GenericList n t b
x = (Int, b) -> b
forall a b. (a, b) -> b
snd ((Int, b) -> b) -> Maybe (Int, b) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericList n t b -> Maybe (Int, 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 = GenericList Name Vector TerrainType -> Maybe TerrainType
forall {t :: * -> *} {b} {n}.
(Splittable t, Traversable t, Semigroup (t b)) =>
GenericList n t b -> Maybe b
getSelected (GenericList Name Vector TerrainType -> Maybe TerrainType)
-> GenericList Name Vector TerrainType -> Maybe TerrainType
forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor WorldEditor Name
-> Getting
     (GenericList Name Vector TerrainType)
     (WorldEditor Name)
     (GenericList Name Vector TerrainType)
-> GenericList Name Vector TerrainType
forall s a. s -> Getting a s a -> a
^. Getting
  (GenericList Name Vector TerrainType)
  (WorldEditor Name)
  (GenericList Name Vector TerrainType)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList
        maybeEntityPaint :: Maybe EntityFacade
maybeEntityPaint = List Name EntityFacade -> Maybe EntityFacade
forall {t :: * -> *} {b} {n}.
(Splittable t, Traversable t, Semigroup (t b)) =>
GenericList n t b -> Maybe b
getSelected (List Name EntityFacade -> Maybe EntityFacade)
-> List Name EntityFacade -> Maybe EntityFacade
forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor WorldEditor Name
-> Getting
     (List Name EntityFacade)
     (WorldEditor Name)
     (List Name EntityFacade)
-> List Name EntityFacade
forall s a. s -> Getting a s a -> a
^. Getting
  (List Name EntityFacade)
  (WorldEditor Name)
  (List Name EntityFacade)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList
    TerrainType
terrain <- Maybe TerrainType -> MaybeT (EventM Name ScenarioState) TerrainType
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe Maybe TerrainType
maybeTerrainType
    Cosmic Coords
mouseCoords <- EventM Name ScenarioState (Maybe (Cosmic Coords))
-> MaybeT (EventM Name ScenarioState) (Cosmic Coords)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (EventM Name ScenarioState (Maybe (Cosmic Coords))
 -> MaybeT (EventM Name ScenarioState) (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
-> MaybeT (EventM Name ScenarioState) (Cosmic Coords)
forall a b. (a -> b) -> a -> b
$ LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall c.
LensLike'
  (Zoomed (EventM Name GameState) c) ScenarioState GameState
-> EventM Name GameState c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GameState
 -> Focusing
      (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) GameState)
-> ScenarioState
-> Focusing
     (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) ScenarioState
LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
Lens' ScenarioState GameState
gameState (EventM Name GameState (Maybe (Cosmic Coords))
 -> EventM Name ScenarioState (Maybe (Cosmic Coords)))
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
    LensLike'
  (Zoomed (MaybeT (EventM Name (WorldEditor Name))) ())
  ScenarioState
  (WorldEditor Name)
-> MaybeT (EventM Name (WorldEditor Name)) ()
-> MaybeT (EventM Name ScenarioState) ()
forall c.
LensLike'
  (Zoomed (MaybeT (EventM Name (WorldEditor Name))) c)
  ScenarioState
  (WorldEditor Name)
-> MaybeT (EventM Name (WorldEditor Name)) c
-> MaybeT (EventM Name ScenarioState) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay
 -> Zoomed (MaybeT (EventM Name (WorldEditor Name))) () UIGameplay)
-> ScenarioState
-> Zoomed
     (MaybeT (EventM Name (WorldEditor Name))) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Zoomed (MaybeT (EventM Name (WorldEditor Name))) () UIGameplay)
 -> ScenarioState
 -> Zoomed
      (MaybeT (EventM Name (WorldEditor Name))) () ScenarioState)
-> ((WorldEditor Name
     -> Zoomed
          (MaybeT (EventM Name (WorldEditor Name))) () (WorldEditor Name))
    -> UIGameplay
    -> Zoomed (MaybeT (EventM Name (WorldEditor Name))) () UIGameplay)
-> LensLike'
     (Zoomed (MaybeT (EventM Name (WorldEditor Name))) ())
     ScenarioState
     (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Zoomed
      (MaybeT (EventM Name (WorldEditor Name))) () (WorldEditor Name))
-> UIGameplay
-> Zoomed (MaybeT (EventM Name (WorldEditor Name))) () UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor) (MaybeT (EventM Name (WorldEditor Name)) ()
 -> MaybeT (EventM Name ScenarioState) ())
-> MaybeT (EventM Name (WorldEditor Name)) ()
-> MaybeT (EventM Name ScenarioState) ()
forall a b. (a -> b) -> a -> b
$ do
      (WorldOverdraw -> Identity WorldOverdraw)
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw ((WorldOverdraw -> Identity WorldOverdraw)
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> ((Map Coords (TerrainWith EntityFacade)
     -> Identity (Map Coords (TerrainWith EntityFacade)))
    -> WorldOverdraw -> Identity WorldOverdraw)
-> (Map Coords (TerrainWith EntityFacade)
    -> Identity (Map Coords (TerrainWith EntityFacade)))
-> WorldEditor Name
-> Identity (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Coords (TerrainWith EntityFacade)
 -> Identity (Map Coords (TerrainWith EntityFacade)))
-> WorldOverdraw -> Identity WorldOverdraw
Lens' WorldOverdraw (Map Coords (TerrainWith EntityFacade))
paintedTerrain ((Map Coords (TerrainWith EntityFacade)
  -> Identity (Map Coords (TerrainWith EntityFacade)))
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> (Map Coords (TerrainWith EntityFacade)
    -> Map Coords (TerrainWith EntityFacade))
-> MaybeT (EventM Name (WorldEditor Name)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Coords
-> TerrainWith EntityFacade
-> Map Coords (TerrainWith EntityFacade)
-> Map Coords (TerrainWith EntityFacade)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Cosmic Coords
mouseCoords Cosmic Coords -> Getting Coords (Cosmic Coords) Coords -> Coords
forall s a. s -> Getting a s a -> a
^. Getting Coords (Cosmic Coords) Coords
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar) (TerrainType
terrain, Maybe EntityFacade -> Erasable EntityFacade
forall e. Maybe e -> Erasable e
maybeToErasable Maybe EntityFacade
maybeEntityPaint)
      (Maybe String -> Identity (Maybe String))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(Maybe String -> f (Maybe String))
-> WorldEditor n -> f (WorldEditor n)
lastWorldEditorMessage ((Maybe String -> Identity (Maybe String))
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> Maybe String -> MaybeT (EventM Name (WorldEditor Name)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe String
forall a. Maybe a
Nothing
  LensLike'
  (Zoomed (EventM Name GameState) ()) ScenarioState GameState
-> EventM Name GameState () -> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name GameState) c) ScenarioState GameState
-> EventM Name GameState c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GameState -> Focusing (StateT (EventState Name) IO) () GameState)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
LensLike'
  (Zoomed (EventM Name GameState) ()) ScenarioState GameState
Lens' ScenarioState GameState
gameState EventM Name GameState ()
immediatelyRedrawWorld

handleRightClick :: B.Location -> EventM Name ScenarioState ()
handleRightClick :: Location -> EventM Name ScenarioState ()
handleRightClick Location
mouseLoc = do
  WorldEditor Name
worldEditor <- Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
-> EventM Name ScenarioState (WorldEditor Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
 -> EventM Name ScenarioState (WorldEditor Name))
-> Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
-> EventM Name ScenarioState (WorldEditor Name)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> ScenarioState -> Const (WorldEditor Name) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (WorldEditor Name) UIGameplay)
 -> ScenarioState -> Const (WorldEditor Name) ScenarioState)
-> ((WorldEditor Name
     -> Const (WorldEditor Name) (WorldEditor Name))
    -> UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Const (WorldEditor Name) (WorldEditor Name))
-> UIGameplay -> Const (WorldEditor Name) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor
  Maybe ()
_ <- MaybeT (EventM Name ScenarioState) ()
-> EventM Name ScenarioState (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (EventM Name ScenarioState) ()
 -> EventM Name ScenarioState (Maybe ()))
-> MaybeT (EventM Name ScenarioState) ()
-> EventM Name ScenarioState (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
    Bool -> MaybeT (EventM Name ScenarioState) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (EventM Name ScenarioState) ())
-> Bool -> MaybeT (EventM Name ScenarioState) ()
forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor WorldEditor Name -> Getting Bool (WorldEditor Name) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WorldOverdraw -> Const Bool WorldOverdraw)
-> WorldEditor Name -> Const Bool (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw ((WorldOverdraw -> Const Bool WorldOverdraw)
 -> WorldEditor Name -> Const Bool (WorldEditor Name))
-> ((Bool -> Const Bool Bool)
    -> WorldOverdraw -> Const Bool WorldOverdraw)
-> Getting Bool (WorldEditor Name) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WorldOverdraw -> Const Bool WorldOverdraw
Lens' WorldOverdraw Bool
isWorldEditorEnabled
    Cosmic Coords
mouseCoords <- EventM Name ScenarioState (Maybe (Cosmic Coords))
-> MaybeT (EventM Name ScenarioState) (Cosmic Coords)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (EventM Name ScenarioState (Maybe (Cosmic Coords))
 -> MaybeT (EventM Name ScenarioState) (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
-> MaybeT (EventM Name ScenarioState) (Cosmic Coords)
forall a b. (a -> b) -> a -> b
$ LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall c.
LensLike'
  (Zoomed (EventM Name GameState) c) ScenarioState GameState
-> EventM Name GameState c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GameState
 -> Focusing
      (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) GameState)
-> ScenarioState
-> Focusing
     (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) ScenarioState
LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
Lens' ScenarioState GameState
gameState (EventM Name GameState (Maybe (Cosmic Coords))
 -> EventM Name ScenarioState (Maybe (Cosmic Coords)))
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
    (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Map Coords (TerrainWith EntityFacade)
     -> Identity (Map Coords (TerrainWith EntityFacade)))
    -> UIGameplay -> Identity UIGameplay)
-> (Map Coords (TerrainWith EntityFacade)
    -> Identity (Map Coords (TerrainWith EntityFacade)))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((Map Coords (TerrainWith EntityFacade)
     -> Identity (Map Coords (TerrainWith EntityFacade)))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (Map Coords (TerrainWith EntityFacade)
    -> Identity (Map Coords (TerrainWith EntityFacade)))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldOverdraw -> Identity WorldOverdraw)
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw ((WorldOverdraw -> Identity WorldOverdraw)
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> ((Map Coords (TerrainWith EntityFacade)
     -> Identity (Map Coords (TerrainWith EntityFacade)))
    -> WorldOverdraw -> Identity WorldOverdraw)
-> (Map Coords (TerrainWith EntityFacade)
    -> Identity (Map Coords (TerrainWith EntityFacade)))
-> WorldEditor Name
-> Identity (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Coords (TerrainWith EntityFacade)
 -> Identity (Map Coords (TerrainWith EntityFacade)))
-> WorldOverdraw -> Identity WorldOverdraw
Lens' WorldOverdraw (Map Coords (TerrainWith EntityFacade))
paintedTerrain ((Map Coords (TerrainWith EntityFacade)
  -> Identity (Map Coords (TerrainWith EntityFacade)))
 -> ScenarioState -> Identity ScenarioState)
-> (Map Coords (TerrainWith EntityFacade)
    -> Map Coords (TerrainWith EntityFacade))
-> MaybeT (EventM Name ScenarioState) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Coords
-> Map Coords (TerrainWith EntityFacade)
-> Map Coords (TerrainWith EntityFacade)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Cosmic Coords
mouseCoords Cosmic Coords -> Getting Coords (Cosmic Coords) Coords -> Coords
forall s a. s -> Getting a s a -> a
^. Getting Coords (Cosmic Coords) Coords
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar)
  LensLike'
  (Zoomed (EventM Name GameState) ()) ScenarioState GameState
-> EventM Name GameState () -> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name GameState) c) ScenarioState GameState
-> EventM Name GameState c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GameState -> Focusing (StateT (EventState Name) IO) () GameState)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
LensLike'
  (Zoomed (EventM Name GameState) ()) ScenarioState GameState
Lens' ScenarioState GameState
gameState EventM Name GameState ()
immediatelyRedrawWorld

-- | "Eye Dropper" tool:
handleMiddleClick :: B.Location -> EventM Name ScenarioState ()
handleMiddleClick :: Location -> EventM Name ScenarioState ()
handleMiddleClick Location
mouseLoc = do
  WorldEditor Name
worldEditor <- Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
-> EventM Name ScenarioState (WorldEditor Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
 -> EventM Name ScenarioState (WorldEditor Name))
-> Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
-> EventM Name ScenarioState (WorldEditor Name)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> ScenarioState -> Const (WorldEditor Name) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (WorldEditor Name) UIGameplay)
 -> ScenarioState -> Const (WorldEditor Name) ScenarioState)
-> ((WorldEditor Name
     -> Const (WorldEditor Name) (WorldEditor Name))
    -> UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> Getting (WorldEditor Name) ScenarioState (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Const (WorldEditor Name) (WorldEditor Name))
-> UIGameplay -> Const (WorldEditor Name) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor
  Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorldEditor Name
worldEditor WorldEditor Name -> Getting Bool (WorldEditor Name) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WorldOverdraw -> Const Bool WorldOverdraw)
-> WorldEditor Name -> Const Bool (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw ((WorldOverdraw -> Const Bool WorldOverdraw)
 -> WorldEditor Name -> Const Bool (WorldEditor Name))
-> ((Bool -> Const Bool Bool)
    -> WorldOverdraw -> Const Bool WorldOverdraw)
-> Getting Bool (WorldEditor Name) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WorldOverdraw -> Const Bool WorldOverdraw
Lens' WorldOverdraw Bool
isWorldEditorEnabled) (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    MultiWorld Int Entity
w <- Getting
  (MultiWorld Int Entity) ScenarioState (MultiWorld Int Entity)
-> EventM Name ScenarioState (MultiWorld Int Entity)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (MultiWorld Int Entity) ScenarioState (MultiWorld Int Entity)
 -> EventM Name ScenarioState (MultiWorld Int Entity))
-> Getting
     (MultiWorld Int Entity) ScenarioState (MultiWorld Int Entity)
-> EventM Name ScenarioState (MultiWorld Int Entity)
forall a b. (a -> b) -> a -> b
$ (GameState -> Const (MultiWorld Int Entity) GameState)
-> ScenarioState -> Const (MultiWorld Int Entity) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (MultiWorld Int Entity) GameState)
 -> ScenarioState -> Const (MultiWorld Int Entity) ScenarioState)
-> ((MultiWorld Int Entity
     -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
    -> GameState -> Const (MultiWorld Int Entity) GameState)
-> Getting
     (MultiWorld Int Entity) ScenarioState (MultiWorld Int Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Landscape -> Const (MultiWorld Int Entity) Landscape)
-> GameState -> Const (MultiWorld Int Entity) GameState
Lens' GameState Landscape
landscape ((Landscape -> Const (MultiWorld Int Entity) Landscape)
 -> GameState -> Const (MultiWorld Int Entity) GameState)
-> ((MultiWorld Int Entity
     -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
    -> Landscape -> Const (MultiWorld Int Entity) Landscape)
-> (MultiWorld Int Entity
    -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
-> GameState
-> Const (MultiWorld Int Entity) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiWorld Int Entity
 -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
-> Landscape -> Const (MultiWorld Int Entity) Landscape
Lens' Landscape (MultiWorld Int Entity)
multiWorld
    TerrainMap
tm <- Getting TerrainMap ScenarioState TerrainMap
-> EventM Name ScenarioState TerrainMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting TerrainMap ScenarioState TerrainMap
 -> EventM Name ScenarioState TerrainMap)
-> Getting TerrainMap ScenarioState TerrainMap
-> EventM Name ScenarioState TerrainMap
forall a b. (a -> b) -> a -> b
$ (GameState -> Const TerrainMap GameState)
-> ScenarioState -> Const TerrainMap ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const TerrainMap GameState)
 -> ScenarioState -> Const TerrainMap ScenarioState)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> GameState -> Const TerrainMap GameState)
-> Getting TerrainMap ScenarioState TerrainMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Landscape -> Const TerrainMap Landscape)
-> GameState -> Const TerrainMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const TerrainMap Landscape)
 -> GameState -> Const TerrainMap GameState)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> Landscape -> Const TerrainMap Landscape)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> GameState
-> Const TerrainMap GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> Landscape -> Const TerrainMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
 -> Landscape -> Const TerrainMap Landscape)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> Landscape
-> Const TerrainMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainMap -> Const TerrainMap TerrainMap)
-> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps
Lens' TerrainEntityMaps TerrainMap
terrainMap
    let setTerrainPaint :: Cosmic Coords -> m ()
setTerrainPaint Cosmic Coords
coords = do
          let (TerrainType
terrain, Maybe EntityPaint
maybeElementPaint) =
                TerrainMap
-> WorldOverdraw
-> MultiWorld Int Entity
-> Cosmic Coords
-> (TerrainType, Maybe EntityPaint)
EU.getEditorContentAt
                  TerrainMap
tm
                  (WorldEditor Name
worldEditor WorldEditor Name
-> Getting WorldOverdraw (WorldEditor Name) WorldOverdraw
-> WorldOverdraw
forall s a. s -> Getting a s a -> a
^. Getting WorldOverdraw (WorldEditor Name) WorldOverdraw
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw)
                  MultiWorld Int Entity
w
                  Cosmic Coords
coords
          (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((GenericList Name Vector TerrainType
     -> Identity (GenericList Name Vector TerrainType))
    -> UIGameplay -> Identity UIGameplay)
-> (GenericList Name Vector TerrainType
    -> Identity (GenericList Name Vector TerrainType))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((GenericList Name Vector TerrainType
     -> Identity (GenericList Name Vector TerrainType))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (GenericList Name Vector TerrainType
    -> Identity (GenericList Name Vector TerrainType))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector TerrainType
 -> Identity (GenericList Name Vector TerrainType))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList ((GenericList Name Vector TerrainType
  -> Identity (GenericList Name Vector TerrainType))
 -> ScenarioState -> Identity ScenarioState)
-> (GenericList Name Vector TerrainType
    -> GenericList Name Vector TerrainType)
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= TerrainType
-> GenericList Name Vector TerrainType
-> GenericList Name Vector TerrainType
forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
BL.listMoveToElement TerrainType
terrain
          Maybe EntityPaint -> (EntityPaint -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe EntityPaint
maybeElementPaint ((EntityPaint -> m ()) -> m ()) -> (EntityPaint -> m ()) -> m ()
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 (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name EntityFacade -> Identity (List Name EntityFacade))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList ((List Name EntityFacade -> Identity (List Name EntityFacade))
 -> ScenarioState -> Identity ScenarioState)
-> (List Name EntityFacade -> List Name EntityFacade) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= EntityFacade -> List Name EntityFacade -> List Name EntityFacade
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 <- LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall c.
LensLike'
  (Zoomed (EventM Name GameState) c) ScenarioState GameState
-> EventM Name GameState c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GameState
 -> Focusing
      (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) GameState)
-> ScenarioState
-> Focusing
     (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) ScenarioState
LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
Lens' ScenarioState GameState
gameState (EventM Name GameState (Maybe (Cosmic Coords))
 -> EventM Name ScenarioState (Maybe (Cosmic Coords)))
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
    Maybe (Cosmic Coords)
-> (Cosmic Coords -> EventM Name ScenarioState ())
-> EventM Name ScenarioState ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Cosmic Coords)
mouseCoordsM Cosmic Coords -> EventM Name ScenarioState ()
forall {m :: * -> *}.
MonadState ScenarioState m =>
Cosmic Coords -> m ()
setTerrainPaint

-- | Handle user input events in the robot panel.
handleWorldEditorPanelEvent :: BrickEvent Name AppEvent -> EventM Name ScenarioState ()
handleWorldEditorPanelEvent :: BrickEvent Name AppEvent -> EventM Name ScenarioState ()
handleWorldEditorPanelEvent = \case
  Key Key
V.KEsc -> (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((BoundsSelectionStep -> Identity BoundsSelectionStep)
    -> UIGameplay -> Identity UIGameplay)
-> (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((BoundsSelectionStep -> Identity BoundsSelectionStep)
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapEditingBounds -> Identity MapEditingBounds)
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds ((MapEditingBounds -> Identity MapEditingBounds)
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> ((BoundsSelectionStep -> Identity BoundsSelectionStep)
    -> MapEditingBounds -> Identity MapEditingBounds)
-> (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> WorldEditor Name
-> Identity (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> MapEditingBounds -> Identity MapEditingBounds
Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep ((BoundsSelectionStep -> Identity BoundsSelectionStep)
 -> ScenarioState -> Identity ScenarioState)
-> BoundsSelectionStep -> EventM Name ScenarioState ()
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 <- Getting (FocusRing Name) ScenarioState (FocusRing Name)
-> EventM Name ScenarioState (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (FocusRing Name) ScenarioState (FocusRing Name)
 -> EventM Name ScenarioState (FocusRing Name))
-> Getting (FocusRing Name) ScenarioState (FocusRing Name)
-> EventM Name ScenarioState (FocusRing Name)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ScenarioState -> Const (FocusRing Name) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> Getting (FocusRing Name) ScenarioState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Const (FocusRing Name) (WorldEditor Name))
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Const (FocusRing Name) (WorldEditor Name))
 -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> WorldEditor Name -> Const (FocusRing Name) (WorldEditor Name))
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay
-> Const (FocusRing Name) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> WorldEditor Name -> Const (FocusRing Name) (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n))
-> WorldEditor n -> f (WorldEditor n)
editorFocusRing
    case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring of
      Just (WorldEditorPanelControl WorldEditorFocusable
x) -> WorldEditorFocusable -> EventM Name ScenarioState ()
activateWorldEditorFunction WorldEditorFocusable
x
      Maybe Name
_ -> () -> EventM Name ScenarioState ()
forall a. a -> EventM Name ScenarioState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ControlChar Char
's' -> EventM Name ScenarioState ()
saveMapFile
  CharKey Char
'\t' -> (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n))
-> WorldEditor n -> f (WorldEditor n)
editorFocusRing ((FocusRing Name -> Identity (FocusRing Name))
 -> ScenarioState -> Identity ScenarioState)
-> (FocusRing Name -> FocusRing Name)
-> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext
  Key Key
V.KBackTab -> (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n))
-> WorldEditor n -> f (WorldEditor n)
editorFocusRing ((FocusRing Name -> Identity (FocusRing Name))
 -> ScenarioState -> Identity ScenarioState)
-> (FocusRing Name -> FocusRing Name)
-> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusPrev
  BrickEvent Name AppEvent
_ -> () -> EventM Name ScenarioState ()
forall a. a -> EventM Name ScenarioState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Return value: whether the cursor position should be updated
updateAreaBounds :: Maybe (Cosmic Coords) -> EventM Name ScenarioState Bool
updateAreaBounds :: Maybe (Cosmic Coords) -> EventM Name ScenarioState Bool
updateAreaBounds = \case
  Maybe (Cosmic Coords)
Nothing -> Bool -> EventM Name ScenarioState Bool
forall a. a -> EventM Name ScenarioState a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  Just Cosmic Coords
mouseCoords -> do
    BoundsSelectionStep
selectorStage <- Getting BoundsSelectionStep ScenarioState BoundsSelectionStep
-> EventM Name ScenarioState BoundsSelectionStep
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting BoundsSelectionStep ScenarioState BoundsSelectionStep
 -> EventM Name ScenarioState BoundsSelectionStep)
-> Getting BoundsSelectionStep ScenarioState BoundsSelectionStep
-> EventM Name ScenarioState BoundsSelectionStep
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const BoundsSelectionStep UIGameplay)
-> ScenarioState -> Const BoundsSelectionStep ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const BoundsSelectionStep UIGameplay)
 -> ScenarioState -> Const BoundsSelectionStep ScenarioState)
-> ((BoundsSelectionStep
     -> Const BoundsSelectionStep BoundsSelectionStep)
    -> UIGameplay -> Const BoundsSelectionStep UIGameplay)
-> Getting BoundsSelectionStep ScenarioState BoundsSelectionStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Const BoundsSelectionStep (WorldEditor Name))
-> UIGameplay -> Const BoundsSelectionStep UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Const BoundsSelectionStep (WorldEditor Name))
 -> UIGameplay -> Const BoundsSelectionStep UIGameplay)
-> ((BoundsSelectionStep
     -> Const BoundsSelectionStep BoundsSelectionStep)
    -> WorldEditor Name
    -> Const BoundsSelectionStep (WorldEditor Name))
-> (BoundsSelectionStep
    -> Const BoundsSelectionStep BoundsSelectionStep)
-> UIGameplay
-> Const BoundsSelectionStep UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapEditingBounds -> Const BoundsSelectionStep MapEditingBounds)
-> WorldEditor Name -> Const BoundsSelectionStep (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds ((MapEditingBounds -> Const BoundsSelectionStep MapEditingBounds)
 -> WorldEditor Name
 -> Const BoundsSelectionStep (WorldEditor Name))
-> Getting BoundsSelectionStep MapEditingBounds BoundsSelectionStep
-> (BoundsSelectionStep
    -> Const BoundsSelectionStep BoundsSelectionStep)
-> WorldEditor Name
-> Const BoundsSelectionStep (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting BoundsSelectionStep MapEditingBounds BoundsSelectionStep
Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep
    case BoundsSelectionStep
selectorStage of
      BoundsSelectionStep
UpperLeftPending -> do
        (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((BoundsSelectionStep -> Identity BoundsSelectionStep)
    -> UIGameplay -> Identity UIGameplay)
-> (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((BoundsSelectionStep -> Identity BoundsSelectionStep)
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapEditingBounds -> Identity MapEditingBounds)
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds ((MapEditingBounds -> Identity MapEditingBounds)
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> ((BoundsSelectionStep -> Identity BoundsSelectionStep)
    -> MapEditingBounds -> Identity MapEditingBounds)
-> (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> WorldEditor Name
-> Identity (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> MapEditingBounds -> Identity MapEditingBounds
Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep ((BoundsSelectionStep -> Identity BoundsSelectionStep)
 -> ScenarioState -> Identity ScenarioState)
-> BoundsSelectionStep -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Cosmic Coords -> BoundsSelectionStep
LowerRightPending Cosmic Coords
mouseCoords
        Bool -> EventM Name ScenarioState Bool
forall a. a -> EventM Name ScenarioState a
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
        TimeSpec
t <- IO TimeSpec -> EventM Name ScenarioState TimeSpec
forall a. IO a -> EventM Name ScenarioState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> EventM Name ScenarioState TimeSpec)
-> IO TimeSpec -> EventM Name ScenarioState TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
        LensLike'
  (Zoomed (EventM Name (WorldEditor Name)) ())
  ScenarioState
  (WorldEditor Name)
-> EventM Name (WorldEditor Name) ()
-> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name (WorldEditor Name)) c)
  ScenarioState
  (WorldEditor Name)
-> EventM Name (WorldEditor Name) c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay
 -> Zoomed (EventM Name (WorldEditor Name)) () UIGameplay)
-> ScenarioState
-> Zoomed (EventM Name (WorldEditor Name)) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Zoomed (EventM Name (WorldEditor Name)) () UIGameplay)
 -> ScenarioState
 -> Zoomed (EventM Name (WorldEditor Name)) () ScenarioState)
-> ((WorldEditor Name
     -> Zoomed (EventM Name (WorldEditor Name)) () (WorldEditor Name))
    -> UIGameplay
    -> Zoomed (EventM Name (WorldEditor Name)) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name (WorldEditor Name)) ())
     ScenarioState
     (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Zoomed (EventM Name (WorldEditor Name)) () (WorldEditor Name))
-> UIGameplay
-> Zoomed (EventM Name (WorldEditor Name)) () UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor) (EventM Name (WorldEditor Name) () -> EventM Name ScenarioState ())
-> EventM Name (WorldEditor Name) ()
-> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
          (Maybe String -> Identity (Maybe String))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(Maybe String -> f (Maybe String))
-> WorldEditor n -> f (WorldEditor n)
lastWorldEditorMessage ((Maybe String -> Identity (Maybe String))
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> Maybe String -> EventM Name (WorldEditor Name) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe String
forall a. Maybe a
Nothing
          ((MapEditingBounds
  -> Zoomed (EventM Name MapEditingBounds) () MapEditingBounds)
 -> WorldEditor Name
 -> Zoomed (EventM Name MapEditingBounds) () (WorldEditor Name))
-> EventM Name MapEditingBounds ()
-> EventM Name (WorldEditor Name) ()
forall c.
LensLike'
  (Zoomed (EventM Name MapEditingBounds) c)
  (WorldEditor Name)
  MapEditingBounds
-> EventM Name MapEditingBounds c
-> EventM Name (WorldEditor Name) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (MapEditingBounds
 -> Zoomed (EventM Name MapEditingBounds) () MapEditingBounds)
-> WorldEditor Name
-> Zoomed (EventM Name MapEditingBounds) () (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds (EventM Name MapEditingBounds ()
 -> EventM Name (WorldEditor Name) ())
-> EventM Name MapEditingBounds ()
-> EventM Name (WorldEditor Name) ()
forall a b. (a -> b) -> a -> b
$ do
            (Maybe (Cosmic BoundsRectangle)
 -> Identity (Maybe (Cosmic BoundsRectangle)))
-> MapEditingBounds -> Identity MapEditingBounds
Lens' MapEditingBounds (Maybe (Cosmic BoundsRectangle))
boundsRect ((Maybe (Cosmic BoundsRectangle)
  -> Identity (Maybe (Cosmic BoundsRectangle)))
 -> MapEditingBounds -> Identity MapEditingBounds)
-> Maybe (Cosmic BoundsRectangle)
-> EventM Name MapEditingBounds ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Cosmic BoundsRectangle -> Maybe (Cosmic BoundsRectangle)
forall a. a -> Maybe a
Just ((Coords -> BoundsRectangle)
-> Cosmic Coords -> Cosmic BoundsRectangle
forall a b. (a -> b) -> Cosmic a -> Cosmic b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Getting Coords (Cosmic Coords) Coords -> Cosmic Coords -> Coords
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coords (Cosmic Coords) Coords
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar Cosmic Coords
mouseCoords) Cosmic Coords
upperLeftMouseCoords)
            (BoundsSelectionStep -> Identity BoundsSelectionStep)
-> MapEditingBounds -> Identity MapEditingBounds
Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep ((BoundsSelectionStep -> Identity BoundsSelectionStep)
 -> MapEditingBounds -> Identity MapEditingBounds)
-> BoundsSelectionStep -> EventM Name MapEditingBounds ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BoundsSelectionStep
SelectionComplete
            (TimeSpec -> Identity TimeSpec)
-> MapEditingBounds -> Identity MapEditingBounds
Lens' MapEditingBounds TimeSpec
boundsPersistDisplayUntil ((TimeSpec -> Identity TimeSpec)
 -> MapEditingBounds -> Identity MapEditingBounds)
-> TimeSpec -> EventM Name MapEditingBounds ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
t TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ Int64 -> Int64 -> TimeSpec
TimeSpec Int64
2 Int64
0
        FocusablePanel -> EventM Name ScenarioState ()
setFocus FocusablePanel
WorldEditorPanel
        Bool -> EventM Name ScenarioState Bool
forall a. a -> EventM Name ScenarioState a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      BoundsSelectionStep
SelectionComplete -> Bool -> EventM Name ScenarioState Bool
forall a. a -> EventM Name ScenarioState a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

saveMapFile :: EventM Name ScenarioState ()
saveMapFile :: EventM Name ScenarioState ()
saveMapFile = do
  UIGameplay
uig <- Getting UIGameplay ScenarioState UIGameplay
-> EventM Name ScenarioState UIGameplay
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay
  Landscape
land <- Getting Landscape ScenarioState Landscape
-> EventM Name ScenarioState Landscape
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Landscape ScenarioState Landscape
 -> EventM Name ScenarioState Landscape)
-> Getting Landscape ScenarioState Landscape
-> EventM Name ScenarioState Landscape
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Landscape GameState)
-> ScenarioState -> Const Landscape ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Landscape GameState)
 -> ScenarioState -> Const Landscape ScenarioState)
-> ((Landscape -> Const Landscape Landscape)
    -> GameState -> Const Landscape GameState)
-> Getting Landscape ScenarioState Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Landscape -> Const Landscape Landscape)
-> GameState -> Const Landscape GameState
Lens' GameState Landscape
landscape
  let worldEditor :: WorldEditor Name
worldEditor = UIGameplay
uig UIGameplay
-> ((WorldEditor Name
     -> Const (WorldEditor Name) (WorldEditor Name))
    -> UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> WorldEditor Name
forall s a. s -> Getting a s a -> a
^. (WorldEditor Name -> Const (WorldEditor Name) (WorldEditor Name))
-> UIGameplay -> Const (WorldEditor Name) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor
      maybeBounds :: Maybe (Cosmic BoundsRectangle)
maybeBounds = UIGameplay
uig UIGameplay
-> Getting
     (Maybe (Cosmic BoundsRectangle))
     UIGameplay
     (Maybe (Cosmic BoundsRectangle))
-> Maybe (Cosmic BoundsRectangle)
forall s a. s -> Getting a s a -> a
^. (WorldEditor Name
 -> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name))
-> UIGameplay -> Const (Maybe (Cosmic BoundsRectangle)) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name))
 -> UIGameplay -> Const (Maybe (Cosmic BoundsRectangle)) UIGameplay)
-> ((Maybe (Cosmic BoundsRectangle)
     -> Const
          (Maybe (Cosmic BoundsRectangle)) (Maybe (Cosmic BoundsRectangle)))
    -> WorldEditor Name
    -> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name))
-> Getting
     (Maybe (Cosmic BoundsRectangle))
     UIGameplay
     (Maybe (Cosmic BoundsRectangle))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapEditingBounds
 -> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds)
-> WorldEditor Name
-> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds ((MapEditingBounds
  -> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds)
 -> WorldEditor Name
 -> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name))
-> ((Maybe (Cosmic BoundsRectangle)
     -> Const
          (Maybe (Cosmic BoundsRectangle)) (Maybe (Cosmic BoundsRectangle)))
    -> MapEditingBounds
    -> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds)
-> (Maybe (Cosmic BoundsRectangle)
    -> Const
         (Maybe (Cosmic BoundsRectangle)) (Maybe (Cosmic BoundsRectangle)))
-> WorldEditor Name
-> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic BoundsRectangle)
 -> Const
      (Maybe (Cosmic BoundsRectangle)) (Maybe (Cosmic BoundsRectangle)))
-> MapEditingBounds
-> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds
Lens' MapEditingBounds (Maybe (Cosmic BoundsRectangle))
boundsRect

      w :: MultiWorld Int Entity
w = Landscape
land Landscape
-> ((MultiWorld Int Entity
     -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
    -> Landscape -> Const (MultiWorld Int Entity) Landscape)
-> MultiWorld Int Entity
forall s a. s -> Getting a s a -> a
^. (MultiWorld Int Entity
 -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
-> Landscape -> Const (MultiWorld Int Entity) Landscape
Lens' Landscape (MultiWorld Int Entity)
multiWorld
      tm :: TerrainMap
tm = Landscape
land Landscape
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> Landscape -> Const TerrainMap Landscape)
-> TerrainMap
forall s a. s -> Getting a s a -> a
^. (TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> Landscape -> Const TerrainMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
 -> Landscape -> Const TerrainMap Landscape)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> Landscape
-> Const TerrainMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainMap -> Const TerrainMap TerrainMap)
-> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps
Lens' TerrainEntityMaps TerrainMap
terrainMap
      mapCellGrid :: Grid (Maybe CellPaintDisplay)
mapCellGrid =
        CellPaintDisplay -> Maybe CellPaintDisplay
forall a. a -> Maybe a
Just
          (CellPaintDisplay -> Maybe CellPaintDisplay)
-> Grid CellPaintDisplay -> Grid (Maybe CellPaintDisplay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TerrainMap
-> WorldOverdraw
-> Maybe (Cosmic BoundsRectangle)
-> MultiWorld Int Entity
-> Grid CellPaintDisplay
EU.getEditedMapRectangle TerrainMap
tm (WorldEditor Name
worldEditor WorldEditor Name
-> Getting WorldOverdraw (WorldEditor Name) WorldOverdraw
-> WorldOverdraw
forall s a. s -> Getting a s a -> a
^. Getting WorldOverdraw (WorldEditor Name) WorldOverdraw
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw) Maybe (Cosmic BoundsRectangle)
maybeBounds MultiWorld Int Entity
w

      fp :: String
fp = WorldEditor Name
worldEditor WorldEditor Name
-> Getting String (WorldEditor Name) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (WorldEditor Name) String
forall n (f :: * -> *).
Functor f =>
(String -> f String) -> WorldEditor n -> f (WorldEditor n)
outputFilePath
      maybeScenarioPair :: Maybe (ScenarioWith ScenarioPath)
maybeScenarioPair = UIGameplay
uig UIGameplay
-> Getting
     (Maybe (ScenarioWith ScenarioPath))
     UIGameplay
     (Maybe (ScenarioWith ScenarioPath))
-> Maybe (ScenarioWith ScenarioPath)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ScenarioWith ScenarioPath))
  UIGameplay
  (Maybe (ScenarioWith ScenarioPath))
Lens' UIGameplay (Maybe (ScenarioWith ScenarioPath))
scenarioRef

  IO () -> EventM Name ScenarioState ()
forall a. IO a -> EventM Name ScenarioState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name ScenarioState ())
-> IO () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ String -> SkeletonScenario -> IO ()
forall a. ToJSON a => String -> a -> IO ()
Y.encodeFile String
fp (SkeletonScenario -> IO ()) -> SkeletonScenario -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Scenario -> Grid (Maybe CellPaintDisplay) -> SkeletonScenario
constructScenario (Getting Scenario (ScenarioWith ScenarioPath) Scenario
-> ScenarioWith ScenarioPath -> Scenario
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Scenario (ScenarioWith ScenarioPath) Scenario
forall a (f :: * -> *).
Functor f =>
(Scenario -> f Scenario) -> ScenarioWith a -> f (ScenarioWith a)
getScenario (ScenarioWith ScenarioPath -> Scenario)
-> Maybe (ScenarioWith ScenarioPath) -> Maybe Scenario
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ScenarioWith ScenarioPath)
maybeScenarioPair) Grid (Maybe CellPaintDisplay)
mapCellGrid

  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe String -> Identity (Maybe String))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe String -> Identity (Maybe String))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe String -> Identity (Maybe String))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (Maybe String -> Identity (Maybe String))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> Identity (Maybe String))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(Maybe String -> f (Maybe String))
-> WorldEditor n -> f (WorldEditor n)
lastWorldEditorMessage ((Maybe String -> Identity (Maybe String))
 -> ScenarioState -> Identity ScenarioState)
-> Maybe String -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String -> Maybe String
forall a. a -> Maybe a
Just String
"Saved."