{-# LANGUAGE PatternSynonyms #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
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_, 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
import Swarm.TUI.Model.Repl (REPLHistItem, REPLPrompt, REPLState, addREPLItem, replHistory, replPromptText, replPromptType)
import Swarm.TUI.Model.UI
import Swarm.TUI.View.Util (generateModal)
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) [])

openModal :: ModalType -> EventM Name AppState ()
openModal :: ModalType -> EventM Name AppState ()
openModal ModalType
mt = do
  ViewportScroll Name -> EventM Name AppState ()
resetViewport ViewportScroll Name
modalScroll
  Modal
newModal <- (AppState -> Modal) -> EventM Name AppState Modal
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((AppState -> Modal) -> EventM Name AppState Modal)
-> (AppState -> Modal) -> EventM Name AppState Modal
forall a b. (a -> b) -> a -> b
$ (AppState -> ModalType -> Modal) -> ModalType -> AppState -> Modal
forall a b c. (a -> b -> c) -> b -> a -> c
flip AppState -> ModalType -> Modal
generateModal ModalType
mt
  EventM Name AppState ()
ensurePause
  (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIState -> Identity UIState)
-> (Maybe Modal -> Identity (Maybe Modal))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> AppState -> Identity AppState)
-> Modal -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Modal
newModal
  -- Beep
  case ModalType
mt of
    ScenarioEndModal ScenarioOutcome
_ -> do
      Vty
vty <- EventM Name AppState Vty
forall n s. EventM n s Vty
getVtyHandle
      IO () -> EventM Name AppState ()
forall a. IO a -> EventM Name AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name AppState ())
-> IO () -> EventM Name AppState ()
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
    ModalType
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  -- Set the game to AutoPause if needed
  ensurePause :: EventM Name AppState ()
ensurePause = do
    Bool
pause <- Getting Bool AppState Bool -> EventM Name AppState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> EventM Name AppState Bool)
-> Getting Bool AppState Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState 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)
-> ((Bool -> Const Bool Bool)
    -> TemporalState -> Const Bool TemporalState)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> TemporalState -> Const Bool TemporalState
Getter TemporalState Bool
paused
    Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
pause Bool -> Bool -> Bool
|| ModalType -> Bool
isRunningModal ModalType
mt) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((RunStatus -> Identity RunStatus)
    -> GameState -> Identity GameState)
-> (RunStatus -> Identity RunStatus)
-> AppState
-> Identity AppState
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)
 -> AppState -> Identity AppState)
-> RunStatus -> EventM Name AppState ()
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
  ModalType
RobotsModal -> Bool
True
  ModalType
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 AppState ()
safeTogglePause :: EventM Name AppState ()
safeTogglePause = do
  TimeSpec
curTime <- IO TimeSpec -> EventM Name AppState TimeSpec
forall a. IO a -> EventM Name AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> EventM Name AppState TimeSpec)
-> IO TimeSpec -> EventM Name AppState TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((TimeSpec -> Identity TimeSpec) -> UIState -> Identity UIState)
-> (TimeSpec -> Identity TimeSpec)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((TimeSpec -> Identity TimeSpec)
    -> UIGameplay -> Identity UIGameplay)
-> (TimeSpec -> Identity TimeSpec)
-> UIState
-> Identity UIState
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) -> AppState -> Identity AppState)
-> TimeSpec -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime
  (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Bool -> Identity Bool) -> UIState -> Identity UIState)
-> (Bool -> Identity Bool)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay
Lens' UIGameplay Bool
uiShowDebug ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> Bool -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  RunStatus
p <- (GameState -> (RunStatus, GameState))
-> AppState -> (RunStatus, AppState)
Lens' AppState GameState
gameState ((GameState -> (RunStatus, GameState))
 -> AppState -> (RunStatus, AppState))
-> ((RunStatus -> (RunStatus, RunStatus))
    -> GameState -> (RunStatus, GameState))
-> (RunStatus -> (RunStatus, RunStatus))
-> AppState
-> (RunStatus, AppState)
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))
 -> AppState -> (RunStatus, AppState))
-> (RunStatus -> RunStatus) -> EventM Name AppState 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 AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
p RunStatus -> RunStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RunStatus
Running) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ StateC GameState (TimeIOC (LiftC IO)) () -> EventM Name AppState ()
forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (TimeIOC (LiftC IO)) a -> m a
zoomGameState 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 AppState ()
safeAutoUnpause :: EventM Name AppState ()
safeAutoUnpause = do
  RunStatus
runs <- Getting RunStatus AppState RunStatus
-> EventM Name AppState RunStatus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting RunStatus AppState RunStatus
 -> EventM Name AppState RunStatus)
-> Getting RunStatus AppState RunStatus
-> EventM Name AppState RunStatus
forall a b. (a -> b) -> a -> b
$ (GameState -> Const RunStatus GameState)
-> AppState -> Const RunStatus AppState
Lens' AppState GameState
gameState ((GameState -> Const RunStatus GameState)
 -> AppState -> Const RunStatus AppState)
-> ((RunStatus -> Const RunStatus RunStatus)
    -> GameState -> Const RunStatus GameState)
-> Getting RunStatus AppState 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 AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
runs RunStatus -> RunStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RunStatus
AutoPause) EventM Name AppState ()
safeTogglePause

toggleModal :: ModalType -> EventM Name AppState ()
toggleModal :: ModalType -> EventM Name AppState ()
toggleModal ModalType
mt = do
  Maybe Modal
modal <- Getting (Maybe Modal) AppState (Maybe Modal)
-> EventM Name AppState (Maybe Modal)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe Modal) AppState (Maybe Modal)
 -> EventM Name AppState (Maybe Modal))
-> Getting (Maybe Modal) AppState (Maybe Modal)
-> EventM Name AppState (Maybe Modal)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (Maybe Modal) UIState)
-> AppState -> Const (Maybe Modal) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Modal) UIState)
 -> AppState -> Const (Maybe Modal) AppState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIState -> Const (Maybe Modal) UIState)
-> Getting (Maybe Modal) AppState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> UIState -> Const (Maybe Modal) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> UIState -> Const (Maybe Modal) UIState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIState
-> Const (Maybe Modal) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal
  case Maybe Modal
modal of
    Maybe Modal
Nothing -> ModalType -> EventM Name AppState ()
openModal ModalType
mt
    Just Modal
_ -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIState -> Identity UIState)
-> (Maybe Modal -> Identity (Maybe Modal))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> AppState -> Identity AppState)
-> Maybe Modal -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Modal
forall a. Maybe a
Nothing EventM Name AppState ()
-> EventM Name AppState () -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> EventM Name AppState b -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name AppState ()
safeAutoUnpause

setFocus :: FocusablePanel -> EventM Name AppState ()
setFocus :: FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
name = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIState -> Identity UIState)
-> (FocusRing Name -> Identity (FocusRing Name))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIState
-> Identity UIState
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))
 -> AppState -> Identity AppState)
-> (FocusRing Name -> FocusRing Name) -> EventM Name AppState ()
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 AppState ()
immediatelyRedrawWorld :: EventM Name AppState ()
immediatelyRedrawWorld = do
  Name -> EventM Name AppState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
  EventM Name AppState ()
loadVisibleRegion

-- | Make sure all tiles covering the visible part of the world are
--   loaded.
loadVisibleRegion :: EventM Name AppState ()
loadVisibleRegion :: EventM Name AppState ()
loadVisibleRegion = do
  Maybe (Extent Name)
mext <- Name -> EventM Name AppState (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 AppState ())
-> EventM Name AppState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Extent Name)
mext ((Extent Name -> EventM Name AppState ())
 -> EventM Name AppState ())
-> (Extent Name -> EventM Name AppState ())
-> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ \(Extent Name
_ Location
_ (Int, Int)
size) -> do
    GameState
gs <- Getting GameState AppState GameState
-> EventM Name AppState GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GameState AppState GameState
Lens' AppState GameState
gameState
    let vr :: Cosmic (Coords, Coords)
vr = Cosmic Location -> (Int32, Int32) -> Cosmic (Coords, Coords)
viewingRegion (GameState
gs GameState
-> Getting (Cosmic Location) GameState (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. (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) (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)
    (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((MultiWorld Int Entity -> Identity (MultiWorld Int Entity))
    -> GameState -> Identity GameState)
-> (MultiWorld Int Entity -> Identity (MultiWorld Int Entity))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
 -> AppState -> Identity AppState)
-> (MultiWorld Int Entity -> MultiWorld Int Entity)
-> EventM Name AppState ()
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
  case Maybe (Extent Name)
mext of
    Maybe (Extent Name)
Nothing -> Maybe (Cosmic Coords)
-> EventM Name GameState (Maybe (Cosmic Coords))
forall a. a -> EventM Name GameState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Cosmic Coords)
forall a. Maybe a
Nothing
    Just 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 Maybe (Cosmic Coords)
-> EventM Name GameState (Maybe (Cosmic Coords))
forall a. a -> EventM Name GameState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Cosmic Coords)
 -> EventM Name GameState (Maybe (Cosmic Coords)))
-> (Cosmic Coords -> Maybe (Cosmic Coords))
-> Cosmic Coords
-> EventM Name GameState (Maybe (Cosmic Coords))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Coords -> Maybe (Cosmic Coords)
forall a. a -> Maybe a
Just (Cosmic Coords -> EventM Name GameState (Maybe (Cosmic Coords)))
-> Cosmic Coords -> EventM Name GameState (Maybe (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 -> AppState -> Bool
hasDebugCapability :: Bool -> AppState -> Bool
hasDebugCapability Bool
isCreative AppState
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
$
    AppState
s AppState
-> Getting
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     AppState
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
-> Maybe
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState
 -> Const
      (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
      GameState)
-> AppState
-> Const
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     AppState
Lens' AppState GameState
gameState ((GameState
  -> Const
       (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
       GameState)
 -> AppState
 -> Const
      (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
      AppState)
-> ((Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
     -> Const
          (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
          (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
    -> GameState
    -> Const
         (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
         GameState)
-> Getting
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     AppState
     (Capabilities (NonEmpty (DeviceUseCost Entity EntityName)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))
    -> Const
         (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
         (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
-> GameState
-> Const
     (First (Capabilities (NonEmpty (DeviceUseCost Entity EntityName))))
     GameState
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 AppState ()
resetViewport :: ViewportScroll Name -> EventM Name AppState ()
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.
zoomGameState :: (MonadState AppState m, MonadIO m) => Fused.StateC GameState (TimeIOC (Fused.LiftC IO)) a -> m a
zoomGameState :: forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (TimeIOC (LiftC IO)) a -> m a
zoomGameState 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
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) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((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

onlyCreative :: (MonadState AppState m) => m () -> m ()
onlyCreative :: forall (m :: * -> *). MonadState AppState m => m () -> m ()
onlyCreative m ()
a = do
  Bool
c <- Getting Bool AppState Bool -> m Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> m Bool)
-> Getting Bool AppState Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState 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 AppState ())) ->
  [KeyEventHandler e2 (EventM Name AppState)]
allHandlers :: forall e2 e1.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (EntityName, EventM Name AppState ()))
-> [KeyEventHandler e2 (EventM Name AppState)]
allHandlers e1 -> e2
eEmbed e1 -> (EntityName, EventM Name AppState ())
f = (e1 -> KeyEventHandler e2 (EventM Name AppState))
-> [e1] -> [KeyEventHandler e2 (EventM Name AppState)]
forall a b. (a -> b) -> [a] -> [b]
map e1 -> KeyEventHandler e2 (EventM Name AppState)
handleEvent1 [e1]
forall a. (Enum a, Bounded a) => [a]
enumerate
 where
  handleEvent1 :: e1 -> KeyEventHandler e2 (EventM Name AppState)
handleEvent1 e1
e1 = let (EntityName
n, EventM Name AppState ()
a) = e1 -> (EntityName, EventM Name AppState ())
f e1
e1 in e2
-> EntityName
-> EventM Name AppState ()
-> KeyEventHandler e2 (EventM Name AppState)
forall k (m :: * -> *).
k -> EntityName -> m () -> KeyEventHandler k m
onEvent (e1 -> e2
eEmbed e1
e1) EntityName
n EventM Name AppState ()
a

runBaseTerm :: (MonadState AppState m) => Maybe TSyntax -> m ()
runBaseTerm :: forall (m :: * -> *).
MonadState AppState m =>
Maybe TSyntax -> m ()
runBaseTerm = m () -> (TSyntax -> m ()) -> Maybe TSyntax -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) TSyntax -> m ()
forall {m :: * -> *}. MonadState AppState 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) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((REPLStatus -> Identity REPLStatus)
    -> GameState -> Identity GameState)
-> (REPLStatus -> Identity REPLStatus)
-> AppState
-> Identity AppState
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)
 -> AppState -> Identity AppState)
-> 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) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((CESK -> Identity CESK) -> GameState -> Identity GameState)
-> (CESK -> Identity CESK)
-> AppState
-> Identity AppState
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) -> AppState -> Identity AppState)
-> (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) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> (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 AppState m => Text -> REPLPrompt -> m ()
resetREPL :: forall (m :: * -> *).
MonadState AppState m =>
EntityName -> REPLPrompt -> m ()
resetREPL EntityName
t REPLPrompt
p = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLState -> Identity REPLState)
    -> UIState -> Identity UIState)
-> (REPLState -> Identity REPLState)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> AppState -> Identity AppState)
-> (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 AppState m => REPLHistItem -> m ()
addREPLHistItem :: forall (m :: * -> *). MonadState AppState m => REPLHistItem -> m ()
addREPLHistItem REPLHistItem
item = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLHistory -> Identity REPLHistory)
    -> UIState -> Identity UIState)
-> (REPLHistory -> Identity REPLHistory)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLHistory -> Identity REPLHistory)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLHistory -> Identity REPLHistory)
-> UIState
-> Identity UIState
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)
 -> AppState -> Identity AppState)
-> (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