{-# LANGUAGE PatternSynonyms #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Keyboard key event patterns and drawing utilities
module Swarm.TUI.Controller.Util where

import Brick hiding (Direction)
import Brick.Focus
import Brick.Keybindings
import Control.Carrier.Lift qualified as Fused
import Control.Carrier.State.Lazy qualified as Fused
import Control.Lens as Lens
import Control.Monad (forM, forM_, unless, when)
import Control.Monad.IO.Class (MonadIO (liftIO), liftIO)
import Control.Monad.State (MonadState, execState)
import Data.List.Extra (enumerate)
import Data.Map qualified as M
import Data.Set qualified as S
import Data.Text (Text)
import Graphics.Vty qualified as V
import Swarm.Effect (TimeIOC, runTimeIO)
import Swarm.Game.CESK (continue)
import Swarm.Game.Device
import Swarm.Game.Robot (robotCapabilities)
import Swarm.Game.Robot.Concrete
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Substate
import Swarm.Game.Step (finishGameTick)
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.Game.World.Coords
import Swarm.Language.Capability (Capability (CDebug))
import Swarm.Language.Syntax hiding (Key)
import Swarm.TUI.Model (
  AppState,
  PlayState,
  ScenarioState,
  gameState,
  modalScroll,
  playState,
  progression,
  scenarioSequence,
  scenarioState,
  uiGameplay,
 )
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl (REPLHistItem (..), REPLHistItemType, REPLPrompt, REPLState, addREPLItem, replHistory, replPromptText, replPromptType)
import Swarm.TUI.Model.UI.Gameplay
import Swarm.TUI.View.Util (ScenarioSeriesContext (..), curMenuName, generateModal, generateScenarioEndModal)
import System.Clock (Clock (..), getTime)

-- | Pattern synonyms to simplify brick event handler
pattern Key :: V.Key -> BrickEvent n e
pattern $mKey :: forall {r} {n} {e}.
BrickEvent n e -> (Key -> r) -> ((# #) -> r) -> r
$bKey :: forall n e. Key -> BrickEvent n e
Key k = VtyEvent (V.EvKey k [])

pattern CharKey, ControlChar, MetaChar :: Char -> BrickEvent n e
pattern $mCharKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
$bCharKey :: forall n e. Char -> BrickEvent n e
CharKey c = VtyEvent (V.EvKey (V.KChar c) [])
pattern $mControlChar :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
$bControlChar :: forall n e. Char -> BrickEvent n e
ControlChar c = VtyEvent (V.EvKey (V.KChar c) [V.MCtrl])
pattern $mMetaChar :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
$bMetaChar :: forall n e. Char -> BrickEvent n e
MetaChar c = VtyEvent (V.EvKey (V.KChar c) [V.MMeta])

pattern ShiftKey :: V.Key -> BrickEvent n e
pattern $mShiftKey :: forall {r} {n} {e}.
BrickEvent n e -> (Key -> r) -> ((# #) -> r) -> r
$bShiftKey :: forall n e. Key -> BrickEvent n e
ShiftKey k = VtyEvent (V.EvKey k [V.MShift])

pattern MetaKey :: V.Key -> BrickEvent n e
pattern $mMetaKey :: forall {r} {n} {e}.
BrickEvent n e -> (Key -> r) -> ((# #) -> r) -> r
$bMetaKey :: forall n e. Key -> BrickEvent n e
MetaKey k = VtyEvent (V.EvKey k [V.MMeta])

pattern EscapeKey :: BrickEvent n e
pattern $mEscapeKey :: forall {r} {n} {e}.
BrickEvent n e -> ((# #) -> r) -> ((# #) -> r) -> r
$bEscapeKey :: forall n e. BrickEvent n e
EscapeKey = VtyEvent (V.EvKey V.KEsc [])

pattern BackspaceKey :: BrickEvent n e
pattern $mBackspaceKey :: forall {r} {n} {e}.
BrickEvent n e -> ((# #) -> r) -> ((# #) -> r) -> r
$bBackspaceKey :: forall n e. BrickEvent n e
BackspaceKey = VtyEvent (V.EvKey V.KBS [])

pattern FKey :: Int -> BrickEvent n e
pattern $mFKey :: forall {r} {n} {e}.
BrickEvent n e -> (Int -> r) -> ((# #) -> r) -> r
$bFKey :: forall n e. Int -> BrickEvent n e
FKey c = VtyEvent (V.EvKey (V.KFun c) [])

-- | Requires 'PlayState' for access to remaining scenario sequence
openEndScenarioModal :: Menu -> EndScenarioModalType -> EventM Name PlayState ()
openEndScenarioModal :: Menu -> EndScenarioModalType -> EventM Name PlayState ()
openEndScenarioModal Menu
m EndScenarioModalType
mt = do
  ViewportScroll Name -> EventM Name PlayState ()
forall s. ViewportScroll Name -> EventM Name s ()
resetViewport ViewportScroll Name
modalScroll
  [ScenarioWith ScenarioPath]
remainingScenarios <- Getting
  [ScenarioWith ScenarioPath] PlayState [ScenarioWith ScenarioPath]
-> EventM Name PlayState [ScenarioWith ScenarioPath]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   [ScenarioWith ScenarioPath] PlayState [ScenarioWith ScenarioPath]
 -> EventM Name PlayState [ScenarioWith ScenarioPath])
-> Getting
     [ScenarioWith ScenarioPath] PlayState [ScenarioWith ScenarioPath]
-> EventM Name PlayState [ScenarioWith ScenarioPath]
forall a b. (a -> b) -> a -> b
$ (ProgressionState
 -> Const [ScenarioWith ScenarioPath] ProgressionState)
-> PlayState -> Const [ScenarioWith ScenarioPath] PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const [ScenarioWith ScenarioPath] ProgressionState)
 -> PlayState -> Const [ScenarioWith ScenarioPath] PlayState)
-> (([ScenarioWith ScenarioPath]
     -> Const [ScenarioWith ScenarioPath] [ScenarioWith ScenarioPath])
    -> ProgressionState
    -> Const [ScenarioWith ScenarioPath] ProgressionState)
-> Getting
     [ScenarioWith ScenarioPath] PlayState [ScenarioWith ScenarioPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ScenarioWith ScenarioPath]
 -> Const [ScenarioWith ScenarioPath] [ScenarioWith ScenarioPath])
-> ProgressionState
-> Const [ScenarioWith ScenarioPath] ProgressionState
Lens' ProgressionState [ScenarioWith ScenarioPath]
scenarioSequence
  let sequenceContext :: ScenarioSeriesContext
sequenceContext = [ScenarioWith ScenarioPath]
-> Maybe EntityName -> Bool -> ScenarioSeriesContext
ScenarioSeriesContext [ScenarioWith ScenarioPath]
remainingScenarios (Menu -> Maybe EntityName
curMenuName Menu
m) Bool
isNoMenu

  LensLike'
  (Zoomed (EventM Name ScenarioState) ()) PlayState ScenarioState
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom LensLike'
  (Zoomed (EventM Name ScenarioState) ()) PlayState ScenarioState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
    Modal
newModal <- (ScenarioState -> Modal) -> EventM Name ScenarioState Modal
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((ScenarioState -> Modal) -> EventM Name ScenarioState Modal)
-> (ScenarioState -> Modal) -> EventM Name ScenarioState Modal
forall a b. (a -> b) -> a -> b
$ ScenarioSeriesContext
-> EndScenarioModalType -> ScenarioState -> Modal
generateScenarioEndModal ScenarioSeriesContext
sequenceContext EndScenarioModalType
mt
    EventM Name ScenarioState ()
ensurePause
    (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIDialogs -> Identity UIDialogs)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> ScenarioState -> Identity ScenarioState)
-> Modal -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Modal
newModal

  -- Beep
  case EndScenarioModalType
mt of
    ScenarioFinishModal ScenarioOutcome
_ -> do
      Vty
vty <- EventM Name PlayState Vty
forall n s. EventM n s Vty
getVtyHandle
      IO () -> EventM Name PlayState ()
forall a. IO a -> EventM Name PlayState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name PlayState ())
-> IO () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ Output -> IO ()
V.ringTerminalBell (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ Vty -> Output
V.outputIface Vty
vty
    EndScenarioModalType
_ -> () -> EventM Name PlayState ()
forall a. a -> EventM Name PlayState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  isNoMenu :: Bool
isNoMenu = case Menu
m of
    Menu
NoMenu -> Bool
True
    Menu
_ -> Bool
False

  -- Set the game to AutoPause if needed
  ensurePause :: EventM Name ScenarioState ()
ensurePause = LensLike'
  (Zoomed (EventM Name TemporalState) ()) ScenarioState TemporalState
-> EventM Name TemporalState () -> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name TemporalState) c) ScenarioState TemporalState
-> EventM Name TemporalState 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 -> Zoomed (EventM Name TemporalState) () GameState)
-> ScenarioState
-> Zoomed (EventM Name TemporalState) () ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Zoomed (EventM Name TemporalState) () GameState)
 -> ScenarioState
 -> Zoomed (EventM Name TemporalState) () ScenarioState)
-> ((TemporalState
     -> Zoomed (EventM Name TemporalState) () TemporalState)
    -> GameState -> Zoomed (EventM Name TemporalState) () GameState)
-> LensLike'
     (Zoomed (EventM Name TemporalState) ()) ScenarioState TemporalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState
 -> Zoomed (EventM Name TemporalState) () TemporalState)
-> GameState -> Zoomed (EventM Name TemporalState) () GameState
Lens' GameState TemporalState
temporal) (EventM Name TemporalState () -> EventM Name ScenarioState ())
-> EventM Name TemporalState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
pause <- Getting Bool TemporalState Bool -> EventM Name TemporalState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool TemporalState Bool
Getter TemporalState Bool
paused
    Bool
-> EventM Name TemporalState () -> EventM Name TemporalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pause (EventM Name TemporalState () -> EventM Name TemporalState ())
-> EventM Name TemporalState () -> EventM Name TemporalState ()
forall a b. (a -> b) -> a -> b
$ (RunStatus -> Identity RunStatus)
-> TemporalState -> Identity TemporalState
Lens' TemporalState RunStatus
runStatus ((RunStatus -> Identity RunStatus)
 -> TemporalState -> Identity TemporalState)
-> RunStatus -> EventM Name TemporalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
AutoPause

openMidScenarioModal :: MidScenarioModalType -> EventM Name ScenarioState ()
openMidScenarioModal :: MidScenarioModalType -> EventM Name ScenarioState ()
openMidScenarioModal MidScenarioModalType
mt = do
  ViewportScroll Name -> EventM Name ScenarioState ()
forall s. ViewportScroll Name -> EventM Name s ()
resetViewport ViewportScroll Name
modalScroll
  Modal
newModal <- (ScenarioState -> Modal) -> EventM Name ScenarioState Modal
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((ScenarioState -> Modal) -> EventM Name ScenarioState Modal)
-> (ScenarioState -> Modal) -> EventM Name ScenarioState Modal
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> MidScenarioModalType -> Modal)
-> MidScenarioModalType -> ScenarioState -> Modal
forall a b c. (a -> b -> c) -> b -> a -> c
flip ScenarioState -> MidScenarioModalType -> Modal
generateModal MidScenarioModalType
mt
  EventM Name ScenarioState ()
ensurePause
  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIDialogs -> Identity UIDialogs)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> ScenarioState -> Identity ScenarioState)
-> Modal -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Modal
newModal
 where
  -- Set the game to AutoPause if needed
  ensurePause :: EventM Name ScenarioState ()
ensurePause = do
    Bool
pause <- Getting Bool ScenarioState Bool -> EventM Name ScenarioState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool ScenarioState Bool -> EventM Name ScenarioState Bool)
-> Getting Bool ScenarioState Bool
-> EventM Name ScenarioState Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Bool GameState)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool ScenarioState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Const Bool TemporalState)
-> GameState -> Const Bool GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const Bool TemporalState)
 -> GameState -> Const Bool GameState)
-> Getting Bool TemporalState Bool
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool TemporalState Bool
Getter TemporalState Bool
paused
    Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
pause Bool -> Bool -> Bool
|| ModalType -> Bool
isRunningModal (MidScenarioModalType -> ModalType
MidScenarioModal MidScenarioModalType
mt)) (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((RunStatus -> Identity RunStatus)
    -> GameState -> Identity GameState)
-> (RunStatus -> Identity RunStatus)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Identity TemporalState)
-> GameState -> Identity GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Identity TemporalState)
 -> GameState -> Identity GameState)
-> ((RunStatus -> Identity RunStatus)
    -> TemporalState -> Identity TemporalState)
-> (RunStatus -> Identity RunStatus)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunStatus -> Identity RunStatus)
-> TemporalState -> Identity TemporalState
Lens' TemporalState RunStatus
runStatus ((RunStatus -> Identity RunStatus)
 -> ScenarioState -> Identity ScenarioState)
-> RunStatus -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
AutoPause

-- | The running modals do not autopause the game.
isRunningModal :: ModalType -> Bool
isRunningModal :: ModalType -> Bool
isRunningModal = \case
  MidScenarioModal MidScenarioModalType
RobotsModal -> Bool
True
  MidScenarioModal MidScenarioModalType
MessagesModal -> Bool
True
  ModalType
_ -> Bool
False

-- | Set the game to Running if it was (auto) paused otherwise to paused.
--
-- Also resets the last frame time to now. If we are pausing, it
-- doesn't matter; if we are unpausing, this is critical to
-- ensure the next frame doesn't think it has to catch up from
-- whenever the game was paused!
safeTogglePause :: EventM Name ScenarioState ()
safeTogglePause :: EventM Name ScenarioState ()
safeTogglePause = do
  TimeSpec
curTime <- 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
  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((TimeSpec -> Identity TimeSpec)
    -> UIGameplay -> Identity UIGameplay)
-> (TimeSpec -> Identity TimeSpec)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Identity UITiming)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Identity UITiming)
 -> UIGameplay -> Identity UIGameplay)
-> ((TimeSpec -> Identity TimeSpec)
    -> UITiming -> Identity UITiming)
-> (TimeSpec -> Identity TimeSpec)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming
Lens' UITiming TimeSpec
lastFrameTime ((TimeSpec -> Identity TimeSpec)
 -> ScenarioState -> Identity ScenarioState)
-> TimeSpec -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime
  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay
Lens' UIGameplay Bool
uiShowDebug ((Bool -> Identity Bool)
 -> ScenarioState -> Identity ScenarioState)
-> Bool -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  RunStatus
p <- (GameState -> (RunStatus, GameState))
-> ScenarioState -> (RunStatus, ScenarioState)
Lens' ScenarioState GameState
gameState ((GameState -> (RunStatus, GameState))
 -> ScenarioState -> (RunStatus, ScenarioState))
-> ((RunStatus -> (RunStatus, RunStatus))
    -> GameState -> (RunStatus, GameState))
-> (RunStatus -> (RunStatus, RunStatus))
-> ScenarioState
-> (RunStatus, ScenarioState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> (RunStatus, TemporalState))
-> GameState -> (RunStatus, GameState)
Lens' GameState TemporalState
temporal ((TemporalState -> (RunStatus, TemporalState))
 -> GameState -> (RunStatus, GameState))
-> ((RunStatus -> (RunStatus, RunStatus))
    -> TemporalState -> (RunStatus, TemporalState))
-> (RunStatus -> (RunStatus, RunStatus))
-> GameState
-> (RunStatus, GameState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunStatus -> (RunStatus, RunStatus))
-> TemporalState -> (RunStatus, TemporalState)
Lens' TemporalState RunStatus
runStatus ((RunStatus -> (RunStatus, RunStatus))
 -> ScenarioState -> (RunStatus, ScenarioState))
-> (RunStatus -> RunStatus) -> EventM Name ScenarioState RunStatus
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
Lens.<%= RunStatus -> RunStatus
toggleRunStatus
  Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
p RunStatus -> RunStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RunStatus
Running) (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ StateC GameState (TimeIOC (LiftC IO)) ()
-> EventM Name ScenarioState ()
forall (m :: * -> *) a.
(MonadState ScenarioState m, MonadIO m) =>
StateC GameState (TimeIOC (LiftC IO)) a -> m a
zoomGameStateFromScenarioState StateC GameState (TimeIOC (LiftC IO)) ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasGameStepState sig m =>
m ()
finishGameTick

-- | Only unpause the game if leaving autopaused modal.
--
-- Note that the game could have been paused before opening
-- the modal, in that case, leave the game paused.
safeAutoUnpause :: EventM Name ScenarioState ()
safeAutoUnpause :: EventM Name ScenarioState ()
safeAutoUnpause = do
  RunStatus
runs <- Getting RunStatus ScenarioState RunStatus
-> EventM Name ScenarioState RunStatus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting RunStatus ScenarioState RunStatus
 -> EventM Name ScenarioState RunStatus)
-> Getting RunStatus ScenarioState RunStatus
-> EventM Name ScenarioState RunStatus
forall a b. (a -> b) -> a -> b
$ (GameState -> Const RunStatus GameState)
-> ScenarioState -> Const RunStatus ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const RunStatus GameState)
 -> ScenarioState -> Const RunStatus ScenarioState)
-> ((RunStatus -> Const RunStatus RunStatus)
    -> GameState -> Const RunStatus GameState)
-> Getting RunStatus ScenarioState RunStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Const RunStatus TemporalState)
-> GameState -> Const RunStatus GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const RunStatus TemporalState)
 -> GameState -> Const RunStatus GameState)
-> ((RunStatus -> Const RunStatus RunStatus)
    -> TemporalState -> Const RunStatus TemporalState)
-> (RunStatus -> Const RunStatus RunStatus)
-> GameState
-> Const RunStatus GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunStatus -> Const RunStatus RunStatus)
-> TemporalState -> Const RunStatus TemporalState
Lens' TemporalState RunStatus
runStatus
  Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
runs RunStatus -> RunStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RunStatus
AutoPause) EventM Name ScenarioState ()
safeTogglePause

dismissScenarioDialog :: EventM Name ScenarioState ()
dismissScenarioDialog :: EventM Name ScenarioState ()
dismissScenarioDialog = do
  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIDialogs -> Identity UIDialogs)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> ScenarioState -> Identity ScenarioState)
-> Maybe Modal -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Modal
forall a. Maybe a
Nothing
  EventM Name ScenarioState ()
safeAutoUnpause

isUIModalClosed :: ScenarioState -> Bool
isUIModalClosed :: ScenarioState -> Bool
isUIModalClosed ScenarioState
s = Maybe Modal -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Modal -> Bool) -> Maybe Modal -> Bool
forall a b. (a -> b) -> a -> b
$ ScenarioState
s ScenarioState
-> Getting (Maybe Modal) ScenarioState (Maybe Modal) -> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ScenarioState -> Const (Maybe Modal) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> Getting (Maybe Modal) ScenarioState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (Maybe Modal) UIDialogs)
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (Maybe Modal) UIDialogs)
 -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIDialogs -> Const (Maybe Modal) UIDialogs)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay
-> Const (Maybe Modal) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIDialogs -> Const (Maybe Modal) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal

toggleMidScenarioModal :: MidScenarioModalType -> EventM Name ScenarioState ()
toggleMidScenarioModal :: MidScenarioModalType -> EventM Name ScenarioState ()
toggleMidScenarioModal MidScenarioModalType
mt = do
  ScenarioState
s <- EventM Name ScenarioState ScenarioState
forall s (m :: * -> *). MonadState s m => m s
get
  if ScenarioState -> Bool
isUIModalClosed ScenarioState
s
    then MidScenarioModalType -> EventM Name ScenarioState ()
openMidScenarioModal MidScenarioModalType
mt
    else EventM Name ScenarioState ()
dismissScenarioDialog

-- | Requires 'PlayState' for access to remaining scenario sequence
toggleEndScenarioModal :: EndScenarioModalType -> Menu -> EventM Name PlayState ()
toggleEndScenarioModal :: EndScenarioModalType -> Menu -> EventM Name PlayState ()
toggleEndScenarioModal EndScenarioModalType
mt Menu
m = do
  ScenarioState
s <- Getting ScenarioState PlayState ScenarioState
-> EventM Name PlayState ScenarioState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ScenarioState PlayState ScenarioState
Lens' PlayState ScenarioState
scenarioState
  if ScenarioState -> Bool
isUIModalClosed ScenarioState
s
    then Menu -> EndScenarioModalType -> EventM Name PlayState ()
openEndScenarioModal Menu
m EndScenarioModalType
mt
    else LensLike'
  (Zoomed (EventM Name ScenarioState) ()) PlayState ScenarioState
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
LensLike'
  (Zoomed (EventM Name ScenarioState) ()) PlayState ScenarioState
Lens' PlayState ScenarioState
scenarioState EventM Name ScenarioState ()
dismissScenarioDialog

setFocus :: FocusablePanel -> EventM Name ScenarioState ()
setFocus :: FocusablePanel -> EventM Name ScenarioState ()
setFocus FocusablePanel
name = (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
. (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (FocusRing Name)
uiFocusRing ((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 ()
%= Name -> FocusRing Name -> FocusRing Name
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (FocusablePanel -> Name
FocusablePanel FocusablePanel
name)

immediatelyRedrawWorld :: EventM Name GameState ()
immediatelyRedrawWorld :: EventM Name GameState ()
immediatelyRedrawWorld = do
  Name -> EventM Name GameState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
  EventM Name GameState ()
loadVisibleRegion

-- | Make sure all tiles covering the visible part of the world are
--   loaded.
loadVisibleRegion :: EventM Name GameState ()
loadVisibleRegion :: EventM Name GameState ()
loadVisibleRegion = do
  Maybe (Extent Name)
mext <- Name -> EventM Name GameState (Maybe (Extent Name))
forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent Name
WorldExtent
  Maybe (Extent Name)
-> (Extent Name -> EventM Name GameState ())
-> EventM Name GameState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Extent Name)
mext ((Extent Name -> EventM Name GameState ())
 -> EventM Name GameState ())
-> (Extent Name -> EventM Name GameState ())
-> EventM Name GameState ()
forall a b. (a -> b) -> a -> b
$ \(Extent Name
_ Location
_ (Int, Int)
size) -> do
    Cosmic Location
vc <- Getting (Cosmic Location) GameState (Cosmic Location)
-> EventM Name GameState (Cosmic Location)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Cosmic Location) GameState (Cosmic Location)
 -> EventM Name GameState (Cosmic Location))
-> Getting (Cosmic Location) GameState (Cosmic Location)
-> EventM Name GameState (Cosmic Location)
forall a b. (a -> b) -> a -> b
$ (Robots -> Const (Cosmic Location) Robots)
-> GameState -> Const (Cosmic Location) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (Cosmic Location) Robots)
 -> GameState -> Const (Cosmic Location) GameState)
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> Robots -> Const (Cosmic Location) Robots)
-> Getting (Cosmic Location) GameState (Cosmic Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> Robots -> Const (Cosmic Location) Robots
Getter Robots (Cosmic Location)
viewCenter
    let vr :: Cosmic (Coords, Coords)
vr = Cosmic Location -> (Int32, Int32) -> Cosmic (Coords, Coords)
viewingRegion Cosmic Location
vc (ASetter (Int, Int) (Int32, Int32) Int Int32
-> (Int -> Int32) -> (Int, Int) -> (Int32, Int32)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Int, Int) (Int32, Int32) Int Int32
Traversal (Int, Int) (Int32, Int32) Int Int32
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int, Int)
size)
    (Landscape -> Identity Landscape)
-> GameState -> Identity GameState
Lens' GameState Landscape
landscape ((Landscape -> Identity Landscape)
 -> GameState -> Identity GameState)
-> ((MultiWorld Int Entity -> Identity (MultiWorld Int Entity))
    -> Landscape -> Identity Landscape)
-> (MultiWorld Int Entity -> Identity (MultiWorld Int Entity))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiWorld Int Entity -> Identity (MultiWorld Int Entity))
-> Landscape -> Identity Landscape
Lens' Landscape (MultiWorld Int Entity)
multiWorld ((MultiWorld Int Entity -> Identity (MultiWorld Int Entity))
 -> GameState -> Identity GameState)
-> (MultiWorld Int Entity -> MultiWorld Int Entity)
-> EventM Name GameState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (World Int Entity -> World Int Entity)
-> SubworldName -> MultiWorld Int Entity -> MultiWorld Int Entity
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Coords, Coords) -> World Int Entity -> World Int Entity
forall t e.
IArray UArray t =>
(Coords, Coords) -> World t e -> World t e
W.loadRegion (Cosmic (Coords, Coords)
vr Cosmic (Coords, Coords)
-> Getting
     (Coords, Coords) (Cosmic (Coords, Coords)) (Coords, Coords)
-> (Coords, Coords)
forall s a. s -> Getting a s a -> a
^. Getting (Coords, Coords) (Cosmic (Coords, Coords)) (Coords, Coords)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar)) (Cosmic (Coords, Coords)
vr Cosmic (Coords, Coords)
-> Getting SubworldName (Cosmic (Coords, Coords)) SubworldName
-> SubworldName
forall s a. s -> Getting a s a -> a
^. Getting SubworldName (Cosmic (Coords, Coords)) SubworldName
forall a (f :: * -> *).
Functor f =>
(SubworldName -> f SubworldName) -> Cosmic a -> f (Cosmic a)
subworld)

mouseLocToWorldCoords :: Brick.Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords :: Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords (Brick.Location (Int, Int)
mouseLoc) = do
  Maybe (Extent Name)
mext <- Name -> EventM Name GameState (Maybe (Extent Name))
forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent Name
WorldExtent
  Maybe (Extent Name)
-> (Extent Name -> EventM Name GameState (Cosmic Coords))
-> EventM Name GameState (Maybe (Cosmic Coords))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Extent Name)
mext ((Extent Name -> EventM Name GameState (Cosmic Coords))
 -> EventM Name GameState (Maybe (Cosmic Coords)))
-> (Extent Name -> EventM Name GameState (Cosmic Coords))
-> EventM Name GameState (Maybe (Cosmic Coords))
forall a b. (a -> b) -> a -> b
$ \Extent Name
ext -> do
    Cosmic (Coords, Coords)
region <- (GameState -> Cosmic (Coords, Coords))
-> EventM Name GameState (Cosmic (Coords, Coords))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((GameState -> Cosmic (Coords, Coords))
 -> EventM Name GameState (Cosmic (Coords, Coords)))
-> (GameState -> Cosmic (Coords, Coords))
-> EventM Name GameState (Cosmic (Coords, Coords))
forall a b. (a -> b) -> a -> b
$ (Cosmic Location -> (Int32, Int32) -> Cosmic (Coords, Coords))
-> (Int32, Int32) -> Cosmic Location -> Cosmic (Coords, Coords)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cosmic Location -> (Int32, Int32) -> Cosmic (Coords, Coords)
viewingRegion ((Int -> Int32) -> (Int -> Int32) -> (Int, Int) -> (Int32, Int32)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Extent Name -> (Int, Int)
forall n. Extent n -> (Int, Int)
extentSize Extent Name
ext)) (Cosmic Location -> Cosmic (Coords, Coords))
-> (GameState -> Cosmic Location)
-> GameState
-> Cosmic (Coords, Coords)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Cosmic Location) GameState (Cosmic Location)
-> GameState -> Cosmic Location
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Robots -> Const (Cosmic Location) Robots)
-> GameState -> Const (Cosmic Location) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (Cosmic Location) Robots)
 -> GameState -> Const (Cosmic Location) GameState)
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> Robots -> Const (Cosmic Location) Robots)
-> Getting (Cosmic Location) GameState (Cosmic Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> Robots -> Const (Cosmic Location) Robots
Getter Robots (Cosmic Location)
viewCenter)
    let regionStart :: (Int32, Int32)
regionStart = Coords -> (Int32, Int32)
unCoords ((Coords, Coords) -> Coords
forall a b. (a, b) -> a
fst ((Coords, Coords) -> Coords) -> (Coords, Coords) -> Coords
forall a b. (a -> b) -> a -> b
$ Cosmic (Coords, Coords)
region Cosmic (Coords, Coords)
-> Getting
     (Coords, Coords) (Cosmic (Coords, Coords)) (Coords, Coords)
-> (Coords, Coords)
forall s a. s -> Getting a s a -> a
^. Getting (Coords, Coords) (Cosmic (Coords, Coords)) (Coords, Coords)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar)
        mouseLoc' :: (Int32, Int32)
mouseLoc' = (Int -> Int32) -> (Int -> Int32) -> (Int, Int) -> (Int32, Int32)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int, Int)
mouseLoc
        mx :: Int32
mx = (Int32, Int32) -> Int32
forall a b. (a, b) -> b
snd (Int32, Int32)
mouseLoc' Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32, Int32) -> Int32
forall a b. (a, b) -> a
fst (Int32, Int32)
regionStart
        my :: Int32
my = (Int32, Int32) -> Int32
forall a b. (a, b) -> a
fst (Int32, Int32)
mouseLoc' Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32, Int32) -> Int32
forall a b. (a, b) -> b
snd (Int32, Int32)
regionStart
     in Cosmic Coords -> EventM Name GameState (Cosmic Coords)
forall a. a -> EventM Name GameState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cosmic Coords -> EventM Name GameState (Cosmic Coords))
-> Cosmic Coords -> EventM Name GameState (Cosmic Coords)
forall a b. (a -> b) -> a -> b
$ SubworldName -> Coords -> Cosmic Coords
forall a. SubworldName -> a -> Cosmic a
Cosmic (Cosmic (Coords, Coords)
region Cosmic (Coords, Coords)
-> Getting SubworldName (Cosmic (Coords, Coords)) SubworldName
-> SubworldName
forall s a. s -> Getting a s a -> a
^. Getting SubworldName (Cosmic (Coords, Coords)) SubworldName
forall a (f :: * -> *).
Functor f =>
(SubworldName -> f SubworldName) -> Cosmic a -> f (Cosmic a)
subworld) (Coords -> Cosmic Coords) -> Coords -> Cosmic Coords
forall a b. (a -> b) -> a -> b
$ (Int32, Int32) -> Coords
Coords (Int32
mx, Int32
my)

hasDebugCapability :: Bool -> GameState -> Bool
hasDebugCapability :: Bool -> GameState -> Bool
hasDebugCapability Bool
isCreative GameState
s =
  Bool
-> (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
    -> Bool)
-> Maybe
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
isCreative (Capability -> Set Capability -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Capability
CDebug (Set Capability -> Bool)
-> (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
    -> Set Capability)
-> Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
-> Set Capability
forall e. Capabilities e -> Set Capability
getCapabilitySet) (Maybe (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
 -> Bool)
-> Maybe
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
-> Bool
forall a b. (a -> b) -> a -> b
$
    GameState
s GameState
-> Getting
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     GameState
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
-> Maybe
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Maybe Robot)
-> (Maybe Robot
    -> Const
         (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
         (Maybe Robot))
-> GameState
-> Const
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     GameState
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot ((Maybe Robot
  -> Const
       (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
       (Maybe Robot))
 -> GameState
 -> Const
      (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
      GameState)
-> ((Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
     -> Const
          (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
          (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
    -> Maybe Robot
    -> Const
         (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
         (Maybe Robot))
-> Getting
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     GameState
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot
 -> Const
      (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
      Robot)
-> Maybe Robot
-> Const
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot
  -> Const
       (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
       Robot)
 -> Maybe Robot
 -> Const
      (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
      (Maybe Robot))
-> ((Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
     -> Const
          (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
          (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
    -> Robot
    -> Const
         (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
         Robot)
-> (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
    -> Const
         (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
         (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
-> Maybe Robot
-> Const
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
 -> Const
      (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
      (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
-> Robot
-> Const
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     Robot
Getter
  Robot (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
robotCapabilities

-- | Resets the viewport scroll position
resetViewport :: ViewportScroll Name -> EventM Name s ()
resetViewport :: forall s. ViewportScroll Name -> EventM Name s ()
resetViewport ViewportScroll Name
n = do
  ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll Name
n
  ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
hScrollToBeginning ViewportScroll Name
n

-- | Modifies the game state using a fused-effect state action.
zoomGameStateFromAppState ::
  (MonadState AppState m, MonadIO m) =>
  Fused.StateC GameState (TimeIOC (Fused.LiftC IO)) a ->
  m a
zoomGameStateFromAppState :: forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (TimeIOC (LiftC IO)) a -> m a
zoomGameStateFromAppState StateC GameState (TimeIOC (LiftC IO)) a
f = do
  GameState
gs <- Getting GameState AppState GameState -> m GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GameState AppState GameState
Lens' AppState GameState
z
  (GameState
gs', a
a) <- IO (GameState, a) -> m (GameState, a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GameState, a) -> m (GameState, a))
-> (TimeIOC (LiftC IO) (GameState, a) -> IO (GameState, a))
-> TimeIOC (LiftC IO) (GameState, a)
-> m (GameState, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiftC IO (GameState, a) -> IO (GameState, a)
forall (m :: * -> *) a. LiftC m a -> m a
Fused.runM (LiftC IO (GameState, a) -> IO (GameState, a))
-> (TimeIOC (LiftC IO) (GameState, a) -> LiftC IO (GameState, a))
-> TimeIOC (LiftC IO) (GameState, a)
-> IO (GameState, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeIOC (LiftC IO) (GameState, a) -> LiftC IO (GameState, a)
forall (m :: * -> *) a. TimeIOC m a -> m a
runTimeIO (TimeIOC (LiftC IO) (GameState, a) -> m (GameState, a))
-> TimeIOC (LiftC IO) (GameState, a) -> m (GameState, a)
forall a b. (a -> b) -> a -> b
$ GameState
-> StateC GameState (TimeIOC (LiftC IO)) a
-> TimeIOC (LiftC IO) (GameState, a)
forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState GameState
gs StateC GameState (TimeIOC (LiftC IO)) a
f
  (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
z ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> GameState -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GameState
gs'
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
 where
  z :: Lens' AppState GameState
  z :: Lens' AppState GameState
z = (PlayState -> f PlayState) -> AppState -> f AppState
Lens' AppState PlayState
playState ((PlayState -> f PlayState) -> AppState -> f AppState)
-> ((GameState -> f GameState) -> PlayState -> f PlayState)
-> (GameState -> f GameState)
-> AppState
-> f AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> f ScenarioState) -> PlayState -> f PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> f ScenarioState) -> PlayState -> f PlayState)
-> ((GameState -> f GameState) -> ScenarioState -> f ScenarioState)
-> (GameState -> f GameState)
-> PlayState
-> f PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> f GameState) -> ScenarioState -> f ScenarioState
Lens' ScenarioState GameState
gameState

-- | Modifies the game state using a fused-effect state action.
zoomGameStateFromScenarioState ::
  (MonadState ScenarioState m, MonadIO m) =>
  Fused.StateC GameState (TimeIOC (Fused.LiftC IO)) a ->
  m a
zoomGameStateFromScenarioState :: forall (m :: * -> *) a.
(MonadState ScenarioState m, MonadIO m) =>
StateC GameState (TimeIOC (LiftC IO)) a -> m a
zoomGameStateFromScenarioState StateC GameState (TimeIOC (LiftC IO)) a
f = do
  GameState
gs <- Getting GameState ScenarioState GameState -> m GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState
  (GameState
gs', a
a) <- IO (GameState, a) -> m (GameState, a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (LiftC IO (GameState, a) -> IO (GameState, a)
forall (m :: * -> *) a. LiftC m a -> m a
Fused.runM (TimeIOC (LiftC IO) (GameState, a) -> LiftC IO (GameState, a)
forall (m :: * -> *) a. TimeIOC m a -> m a
runTimeIO (GameState
-> StateC GameState (TimeIOC (LiftC IO)) a
-> TimeIOC (LiftC IO) (GameState, a)
forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState GameState
gs StateC GameState (TimeIOC (LiftC IO)) a
f)))
  (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> GameState -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GameState
gs'
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Modifies the game state using a fused-effect state action.
zoomGameStateFromPlayState ::
  (MonadState PlayState m, MonadIO m) =>
  Fused.StateC GameState (TimeIOC (Fused.LiftC IO)) a ->
  m a
zoomGameStateFromPlayState :: forall (m :: * -> *) a.
(MonadState PlayState m, MonadIO m) =>
StateC GameState (TimeIOC (LiftC IO)) a -> m a
zoomGameStateFromPlayState StateC GameState (TimeIOC (LiftC IO)) a
f = do
  GameState
gs <- Getting GameState PlayState GameState -> m GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting GameState PlayState GameState -> m GameState)
-> Getting GameState PlayState GameState -> m GameState
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const GameState ScenarioState)
-> PlayState -> Const GameState PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const GameState ScenarioState)
 -> PlayState -> Const GameState PlayState)
-> Getting GameState ScenarioState GameState
-> Getting GameState PlayState GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState
  (GameState
gs', a
a) <- IO (GameState, a) -> m (GameState, a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (LiftC IO (GameState, a) -> IO (GameState, a)
forall (m :: * -> *) a. LiftC m a -> m a
Fused.runM (TimeIOC (LiftC IO) (GameState, a) -> LiftC IO (GameState, a)
forall (m :: * -> *) a. TimeIOC m a -> m a
runTimeIO (GameState
-> StateC GameState (TimeIOC (LiftC IO)) a
-> TimeIOC (LiftC IO) (GameState, a)
forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState GameState
gs StateC GameState (TimeIOC (LiftC IO)) a
f)))
  (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((GameState -> Identity GameState)
    -> ScenarioState -> Identity ScenarioState)
-> (GameState -> Identity GameState)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> PlayState -> Identity PlayState)
-> GameState -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GameState
gs'
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

onlyCreative :: (MonadState ScenarioState m) => m () -> m ()
onlyCreative :: forall (m :: * -> *). MonadState ScenarioState m => m () -> m ()
onlyCreative m ()
a = do
  Bool
c <- Getting Bool ScenarioState Bool -> m Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool ScenarioState Bool -> m Bool)
-> Getting Bool ScenarioState Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Bool GameState)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool ScenarioState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GameState -> Const Bool GameState
Lens' GameState Bool
creativeMode
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c m ()
a

-- | Create a list of handlers with embedding events and using pattern matching.
allHandlers ::
  (Ord e2, Enum e1, Bounded e1) =>
  (e1 -> e2) ->
  (e1 -> (Text, EventM Name s ())) ->
  [KeyEventHandler e2 (EventM Name s)]
allHandlers :: forall e2 e1 s.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (EntityName, EventM Name s ()))
-> [KeyEventHandler e2 (EventM Name s)]
allHandlers e1 -> e2
eEmbed e1 -> (EntityName, EventM Name s ())
f = (e1 -> KeyEventHandler e2 (EventM Name s))
-> [e1] -> [KeyEventHandler e2 (EventM Name s)]
forall a b. (a -> b) -> [a] -> [b]
map e1 -> KeyEventHandler e2 (EventM Name s)
handleEvent1 [e1]
forall a. (Enum a, Bounded a) => [a]
enumerate
 where
  handleEvent1 :: e1 -> KeyEventHandler e2 (EventM Name s)
handleEvent1 e1
e1 = let (EntityName
n, EventM Name s ()
a) = e1 -> (EntityName, EventM Name s ())
f e1
e1 in e2
-> EntityName
-> EventM Name s ()
-> KeyEventHandler e2 (EventM Name s)
forall k (m :: * -> *).
k -> EntityName -> m () -> KeyEventHandler k m
onEvent (e1 -> e2
eEmbed e1
e1) EntityName
n EventM Name s ()
a

runBaseTerm :: (MonadState ScenarioState m) => Maybe TSyntax -> m ()
runBaseTerm :: forall (m :: * -> *).
MonadState ScenarioState m =>
Maybe TSyntax -> m ()
runBaseTerm = (TSyntax -> m ()) -> Maybe TSyntax -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TSyntax -> m ()
forall {m :: * -> *}. MonadState ScenarioState m => TSyntax -> m ()
startBaseProgram
 where
  -- The player typed something at the REPL and hit Enter; this
  -- function takes the resulting term (if the REPL
  -- input is valid) and sets up the base robot to run it.
  startBaseProgram :: TSyntax -> m ()
startBaseProgram TSyntax
t = do
    -- Set the REPL status to Working
    (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((REPLStatus -> Identity REPLStatus)
    -> GameState -> Identity GameState)
-> (REPLStatus -> Identity REPLStatus)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Identity GameControls)
-> GameState -> Identity GameState
Lens' GameState GameControls
gameControls ((GameControls -> Identity GameControls)
 -> GameState -> Identity GameState)
-> ((REPLStatus -> Identity REPLStatus)
    -> GameControls -> Identity GameControls)
-> (REPLStatus -> Identity REPLStatus)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLStatus -> Identity REPLStatus)
-> GameControls -> Identity GameControls
Lens' GameControls REPLStatus
replStatus ((REPLStatus -> Identity REPLStatus)
 -> ScenarioState -> Identity ScenarioState)
-> REPLStatus -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Polytype -> Maybe Value -> REPLStatus
REPLWorking (TSyntax
t TSyntax -> Getting Polytype TSyntax Polytype -> Polytype
forall s a. s -> Getting a s a -> a
^. Getting Polytype TSyntax Polytype
forall ty (f :: * -> *).
Functor f =>
(ty -> f ty) -> Syntax' ty -> f (Syntax' ty)
sType) Maybe Value
forall a. Maybe a
Nothing
    -- Set up the robot's CESK machine to evaluate/execute the
    -- given term.
    (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((CESK -> Identity CESK) -> GameState -> Identity GameState)
-> (CESK -> Identity CESK)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> GameState -> Identity GameState
Traversal' GameState Robot
baseRobot ((Robot -> Identity Robot) -> GameState -> Identity GameState)
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine ((CESK -> Identity CESK)
 -> ScenarioState -> Identity ScenarioState)
-> (CESK -> CESK) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= TSyntax -> CESK -> CESK
continue TSyntax
t
    -- Finally, be sure to activate the base robot.
    (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> (GameState -> GameState) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= State GameState () -> GameState -> GameState
forall s a. State s a -> s -> s
execState (StateC Robots Identity () -> State GameState ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity () -> State GameState ())
-> StateC Robots Identity () -> State GameState ()
forall a b. (a -> b) -> a -> b
$ Int -> StateC Robots Identity ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
Int -> m ()
activateRobot Int
0)

-- | Set the REPL to the given text and REPL prompt type.
modifyResetREPL :: Text -> REPLPrompt -> REPLState -> REPLState
modifyResetREPL :: EntityName -> REPLPrompt -> REPLState -> REPLState
modifyResetREPL EntityName
t REPLPrompt
r = ((EntityName -> Identity EntityName)
-> REPLState -> Identity REPLState
Lens' REPLState EntityName
replPromptText ((EntityName -> Identity EntityName)
 -> REPLState -> Identity REPLState)
-> EntityName -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EntityName
t) (REPLState -> REPLState)
-> (REPLState -> REPLState) -> REPLState -> REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLPrompt
r)

-- | Reset the REPL state to the given text and REPL prompt type.
resetREPL :: MonadState ScenarioState m => Text -> REPLPrompt -> m ()
resetREPL :: forall (m :: * -> *).
MonadState ScenarioState m =>
EntityName -> REPLPrompt -> m ()
resetREPL EntityName
t REPLPrompt
p = (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> ScenarioState -> Identity ScenarioState)
-> (REPLState -> REPLState) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= EntityName -> REPLPrompt -> REPLState -> REPLState
modifyResetREPL EntityName
t REPLPrompt
p

-- | Add an item to the REPL history.
addREPLHistItem :: MonadState ScenarioState m => REPLHistItemType -> Text -> m ()
addREPLHistItem :: forall (m :: * -> *).
MonadState ScenarioState m =>
REPLHistItemType -> EntityName -> m ()
addREPLHistItem REPLHistItemType
itemType EntityName
msg = do
  TickNumber
t <- Getting TickNumber ScenarioState TickNumber -> m TickNumber
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting TickNumber ScenarioState TickNumber -> m TickNumber)
-> Getting TickNumber ScenarioState TickNumber -> m TickNumber
forall a b. (a -> b) -> a -> b
$ (GameState -> Const TickNumber GameState)
-> ScenarioState -> Const TickNumber ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const TickNumber GameState)
 -> ScenarioState -> Const TickNumber ScenarioState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> GameState -> Const TickNumber GameState)
-> Getting TickNumber ScenarioState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> (TickNumber -> Const TickNumber TickNumber)
-> GameState
-> Const TickNumber GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
  let item :: REPLHistItem
item = REPLHistItemType -> TickNumber -> EntityName -> REPLHistItem
REPLHistItem REPLHistItemType
itemType TickNumber
t EntityName
msg
  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((REPLHistory -> Identity REPLHistory)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLHistory -> Identity REPLHistory)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((REPLHistory -> Identity REPLHistory)
    -> REPLState -> Identity REPLState)
-> (REPLHistory -> Identity REPLHistory)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Identity REPLHistory)
-> REPLState -> Identity REPLState
Lens' REPLState REPLHistory
replHistory ((REPLHistory -> Identity REPLHistory)
 -> ScenarioState -> Identity ScenarioState)
-> (REPLHistory -> REPLHistory) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem REPLHistItem
item