{-# LANGUAGE OverloadedStrings #-}
module Swarm.TUI.Controller.EventHandlers.Main (
mainEventHandlers,
) where
import Brick
import Brick.Keybindings
import Control.Lens as Lens
import Control.Monad (unless, void, when)
import Control.Monad.IO.Class (liftIO)
import Swarm.Game.Scenario.Topography.Structure.Recognition (automatons)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (originalStructureDefinitions)
import Swarm.Game.State
import Swarm.Game.State.Substate
import Swarm.Game.Step (finishGameTick)
import Swarm.TUI.Controller.EventHandlers.Frame (runGameTickUI)
import Swarm.TUI.Controller.UpdateUI (updateUI)
import Swarm.TUI.Controller.Util
import Swarm.TUI.Editor.Model (isWorldEditorEnabled, worldOverdraw)
import Swarm.TUI.Model
import Swarm.TUI.Model.Event (MainEvent (..), SwarmEvent (..))
import Swarm.TUI.Model.Goal
import Swarm.TUI.Model.UI
import System.Clock (Clock (..), TimeSpec (..), getTime)
mainEventHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
mainEventHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
mainEventHandlers = (MainEvent -> SwarmEvent)
-> (MainEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall e2 e1.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (Text, EventM Name AppState ()))
-> [KeyEventHandler e2 (EventM Name AppState)]
allHandlers MainEvent -> SwarmEvent
Main ((MainEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)])
-> (MainEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall a b. (a -> b) -> a -> b
$ \case
MainEvent
QuitEvent -> (Text
"Open quit game dialog", EventM Name AppState ()
toggleQuitGameDialog)
MainEvent
ViewHelpEvent -> (Text
"View Help screen", ModalType -> EventM Name AppState ()
toggleModal ModalType
HelpModal)
MainEvent
ViewRobotsEvent -> (Text
"View Robots screen", ModalType -> EventM Name AppState ()
toggleModal ModalType
RobotsModal)
MainEvent
ViewRecipesEvent -> (Text
"View Recipes screen", ModalType
-> Lens' Discovery (Notifications (Recipe Entity))
-> EventM Name AppState ()
forall a.
ModalType
-> Lens' Discovery (Notifications a) -> EventM Name AppState ()
toggleDiscoveryNotificationModal ModalType
RecipesModal (Notifications (Recipe Entity)
-> f (Notifications (Recipe Entity)))
-> Discovery -> f Discovery
Lens' Discovery (Notifications (Recipe Entity))
availableRecipes)
MainEvent
ViewCommandsEvent -> (Text
"View Commands screen", ModalType
-> Lens' Discovery (Notifications Const) -> EventM Name AppState ()
forall a.
ModalType
-> Lens' Discovery (Notifications a) -> EventM Name AppState ()
toggleDiscoveryNotificationModal ModalType
CommandsModal (Notifications Const -> f (Notifications Const))
-> Discovery -> f Discovery
Lens' Discovery (Notifications Const)
availableCommands)
MainEvent
ViewMessagesEvent -> (Text
"View Messages screen", EventM Name AppState ()
toggleMessagesModal)
MainEvent
ViewStructuresEvent -> (Text
"View Structures screen", ModalType
-> Lens' Discovery (Map Text (StructureInfo StructureCells Entity))
-> EventM Name AppState ()
forall (t :: * -> *) a.
Foldable t =>
ModalType -> Lens' Discovery (t a) -> EventM Name AppState ()
toggleDiscoveryModal ModalType
StructuresModal ((StructureRecognizer StructureCells Entity
-> f (StructureRecognizer StructureCells Entity))
-> Discovery -> f Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
-> f (StructureRecognizer StructureCells Entity))
-> Discovery -> f Discovery)
-> ((Map Text (StructureInfo StructureCells Entity)
-> f (Map Text (StructureInfo StructureCells Entity)))
-> StructureRecognizer StructureCells Entity
-> f (StructureRecognizer StructureCells Entity))
-> (Map Text (StructureInfo StructureCells Entity)
-> f (Map Text (StructureInfo StructureCells Entity)))
-> Discovery
-> f Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognizerAutomatons StructureCells Entity
-> f (RecognizerAutomatons StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> f (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(RecognizerAutomatons b a -> f (RecognizerAutomatons b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
automatons ((RecognizerAutomatons StructureCells Entity
-> f (RecognizerAutomatons StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> f (StructureRecognizer StructureCells Entity))
-> ((Map Text (StructureInfo StructureCells Entity)
-> f (Map Text (StructureInfo StructureCells Entity)))
-> RecognizerAutomatons StructureCells Entity
-> f (RecognizerAutomatons StructureCells Entity))
-> (Map Text (StructureInfo StructureCells Entity)
-> f (Map Text (StructureInfo StructureCells Entity)))
-> StructureRecognizer StructureCells Entity
-> f (StructureRecognizer StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text (StructureInfo StructureCells Entity)
-> f (Map Text (StructureInfo StructureCells Entity)))
-> RecognizerAutomatons StructureCells Entity
-> f (RecognizerAutomatons StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(Map Text (StructureInfo b a) -> f (Map Text (StructureInfo b a)))
-> RecognizerAutomatons b a -> f (RecognizerAutomatons b a)
originalStructureDefinitions))
MainEvent
ViewGoalEvent -> (Text
"View scenario goal description", EventM Name AppState ()
viewGoal)
MainEvent
HideRobotsEvent -> (Text
"Hide robots for a few ticks", EventM Name AppState ()
hideRobots)
MainEvent
ShowCESKDebugEvent -> (Text
"Show active robot CESK machine debugging line", EventM Name AppState ()
showCESKDebug)
MainEvent
PauseEvent -> (Text
"Pause or unpause the game", EventM Name AppState () -> EventM Name AppState ()
whenRunning EventM Name AppState ()
safeTogglePause)
MainEvent
RunSingleTickEvent -> (Text
"Run game for a single tick", EventM Name AppState () -> EventM Name AppState ()
whenRunning EventM Name AppState ()
runSingleTick)
MainEvent
IncreaseTpsEvent -> (Text
"Double game speed", EventM Name AppState () -> EventM Name AppState ()
whenRunning (EventM Name AppState () -> EventM Name AppState ())
-> ((AppState -> AppState) -> EventM Name AppState ())
-> (AppState -> AppState)
-> EventM Name AppState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM Name AppState ())
-> (AppState -> AppState) -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> AppState -> AppState
adjustTPS Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))
MainEvent
DecreaseTpsEvent -> (Text
"Halve game speed", EventM Name AppState () -> EventM Name AppState ()
whenRunning (EventM Name AppState () -> EventM Name AppState ())
-> ((AppState -> AppState) -> EventM Name AppState ())
-> (AppState -> AppState)
-> EventM Name AppState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM Name AppState ())
-> (AppState -> AppState) -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> AppState -> AppState
adjustTPS (-))
MainEvent
FocusWorldEvent -> (Text
"Set focus on the World panel", FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
WorldPanel)
MainEvent
FocusRobotEvent -> (Text
"Set focus on the Robot panel", FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
RobotPanel)
MainEvent
FocusREPLEvent -> (Text
"Set focus on the REPL panel", FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
REPLPanel)
MainEvent
FocusInfoEvent -> (Text
"Set focus on the Info panel", FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
InfoPanel)
MainEvent
ToggleCreativeModeEvent -> (Text
"Toggle creative mode", EventM Name AppState () -> EventM Name AppState ()
whenCheating EventM Name AppState ()
toggleCreativeMode)
MainEvent
ToggleWorldEditorEvent -> (Text
"Toggle world editor mode", EventM Name AppState () -> EventM Name AppState ()
whenCheating EventM Name AppState ()
toggleWorldEditor)
MainEvent
ToggleREPLVisibilityEvent -> (Text
"Collapse/Expand REPL panel", EventM Name AppState ()
toggleREPLVisibility)
toggleQuitGameDialog :: EventM Name AppState ()
toggleQuitGameDialog :: EventM Name AppState ()
toggleQuitGameDialog = do
AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
case AppState
s AppState
-> Getting WinCondition AppState WinCondition -> WinCondition
forall s a. s -> Getting a s a -> a
^. (GameState -> Const WinCondition GameState)
-> AppState -> Const WinCondition AppState
Lens' AppState GameState
gameState ((GameState -> Const WinCondition GameState)
-> AppState -> Const WinCondition AppState)
-> ((WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState)
-> Getting WinCondition AppState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition of
WinConditions (Won Bool
_ TickNumber
_) ObjectiveCompletion
_ -> ModalType -> EventM Name AppState ()
toggleModal (ModalType -> EventM Name AppState ())
-> ModalType -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
WinModal
WinConditions (Unwinnable Bool
_) ObjectiveCompletion
_ -> ModalType -> EventM Name AppState ()
toggleModal (ModalType -> EventM Name AppState ())
-> ModalType -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
LoseModal
WinCondition
_ -> ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
toggleGameModal :: Foldable t => ModalType -> Getter GameState (t a) -> EventM Name AppState Bool
toggleGameModal :: forall (t :: * -> *) a.
Foldable t =>
ModalType -> Getter GameState (t a) -> EventM Name AppState Bool
toggleGameModal ModalType
m Getter GameState (t a)
l = do
AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
let nothingToShow :: Bool
nothingToShow = t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (t a -> Bool) -> t a -> Bool
forall a b. (a -> b) -> a -> b
$ AppState
s AppState -> Getting (t a) AppState (t a) -> t a
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (t a) GameState)
-> AppState -> Const (t a) AppState
Lens' AppState GameState
gameState ((GameState -> Const (t a) GameState)
-> AppState -> Const (t a) AppState)
-> ((t a -> Const (t a) (t a))
-> GameState -> Const (t a) GameState)
-> Getting (t a) AppState (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> Const (t a) (t a)) -> GameState -> Const (t a) GameState
Getter GameState (t a)
l
Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nothingToShow (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ ModalType -> EventM Name AppState ()
toggleModal ModalType
m
Bool -> EventM Name AppState Bool
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
nothingToShow
toggleDiscoveryModal :: Foldable t => ModalType -> Lens' Discovery (t a) -> EventM Name AppState ()
toggleDiscoveryModal :: forall (t :: * -> *) a.
Foldable t =>
ModalType -> Lens' Discovery (t a) -> EventM Name AppState ()
toggleDiscoveryModal ModalType
m Lens' Discovery (t a)
l = EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name AppState Bool -> EventM Name AppState ())
-> EventM Name AppState Bool -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ ModalType -> Getter GameState (t a) -> EventM Name AppState Bool
forall (t :: * -> *) a.
Foldable t =>
ModalType -> Getter GameState (t a) -> EventM Name AppState Bool
toggleGameModal ModalType
m ((Discovery -> f Discovery) -> GameState -> f GameState
Lens' GameState Discovery
discovery ((Discovery -> f Discovery) -> GameState -> f GameState)
-> ((t a -> f (t a)) -> Discovery -> f Discovery)
-> (t a -> f (t a))
-> GameState
-> f GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> f (t a)) -> Discovery -> f Discovery
Lens' Discovery (t a)
l)
toggleDiscoveryNotificationModal :: ModalType -> Lens' Discovery (Notifications a) -> EventM Name AppState ()
toggleDiscoveryNotificationModal :: forall a.
ModalType
-> Lens' Discovery (Notifications a) -> EventM Name AppState ()
toggleDiscoveryNotificationModal ModalType
m Lens' Discovery (Notifications a)
l = do
Bool
nothingToShow <- ModalType -> Getter GameState [a] -> EventM Name AppState Bool
forall (t :: * -> *) a.
Foldable t =>
ModalType -> Getter GameState (t a) -> EventM Name AppState Bool
toggleGameModal ModalType
m ((Discovery -> f Discovery) -> GameState -> f GameState
Lens' GameState Discovery
discovery ((Discovery -> f Discovery) -> GameState -> f GameState)
-> (([a] -> f [a]) -> Discovery -> f Discovery)
-> ([a] -> f [a])
-> GameState
-> f GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications a -> f (Notifications a))
-> Discovery -> f Discovery
Lens' Discovery (Notifications a)
l ((Notifications a -> f (Notifications a))
-> Discovery -> f Discovery)
-> (([a] -> f [a]) -> Notifications a -> f (Notifications a))
-> ([a] -> f [a])
-> Discovery
-> f Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> f [a]) -> Notifications a -> f (Notifications a)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent)
Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nothingToShow (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)
-> ((Int -> Identity Int) -> GameState -> Identity GameState)
-> (Int -> Identity Int)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
-> GameState -> Identity GameState)
-> ((Int -> Identity Int) -> Discovery -> Identity Discovery)
-> (Int -> Identity Int)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications a -> Identity (Notifications a))
-> Discovery -> Identity Discovery
Lens' Discovery (Notifications a)
l ((Notifications a -> Identity (Notifications a))
-> Discovery -> Identity Discovery)
-> ((Int -> Identity Int)
-> Notifications a -> Identity (Notifications a))
-> (Int -> Identity Int)
-> Discovery
-> Identity Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> Notifications a -> Identity (Notifications a)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> Notifications a -> f (Notifications a)
notificationsCount ((Int -> Identity Int) -> AppState -> Identity AppState)
-> Int -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
toggleMessagesModal :: EventM Name AppState ()
toggleMessagesModal :: EventM Name AppState ()
toggleMessagesModal = do
AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
Bool
nothingToShow <- ModalType
-> Getter GameState [LogEntry] -> EventM Name AppState Bool
forall (t :: * -> *) a.
Foldable t =>
ModalType -> Getter GameState (t a) -> EventM Name AppState Bool
toggleGameModal ModalType
MessagesModal ((Notifications LogEntry -> f (Notifications LogEntry))
-> GameState -> f GameState
Getter GameState (Notifications LogEntry)
messageNotifications ((Notifications LogEntry -> f (Notifications LogEntry))
-> GameState -> f GameState)
-> (([LogEntry] -> f [LogEntry])
-> Notifications LogEntry -> f (Notifications LogEntry))
-> ([LogEntry] -> f [LogEntry])
-> GameState
-> f GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LogEntry] -> f [LogEntry])
-> Notifications LogEntry -> f (Notifications LogEntry)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent)
Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nothingToShow (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)
-> ((TickNumber -> Identity TickNumber)
-> GameState -> Identity GameState)
-> (TickNumber -> Identity TickNumber)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Identity Messages) -> GameState -> Identity GameState
Lens' GameState Messages
messageInfo ((Messages -> Identity Messages)
-> GameState -> Identity GameState)
-> ((TickNumber -> Identity TickNumber)
-> Messages -> Identity Messages)
-> (TickNumber -> Identity TickNumber)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Identity TickNumber)
-> Messages -> Identity Messages
Lens' Messages TickNumber
lastSeenMessageTime ((TickNumber -> Identity TickNumber)
-> AppState -> Identity AppState)
-> TickNumber -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AppState
s AppState -> Getting TickNumber AppState TickNumber -> TickNumber
forall s a. s -> Getting a s a -> a
^. (GameState -> Const TickNumber GameState)
-> AppState -> Const TickNumber AppState
Lens' AppState GameState
gameState ((GameState -> Const TickNumber GameState)
-> AppState -> Const TickNumber AppState)
-> ((TickNumber -> Const TickNumber TickNumber)
-> GameState -> Const TickNumber GameState)
-> Getting TickNumber AppState 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
viewGoal :: EventM Name AppState ()
viewGoal :: EventM Name AppState ()
viewGoal = do
AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
if GoalTracking -> Bool
hasAnythingToShow (GoalTracking -> Bool) -> GoalTracking -> Bool
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting GoalTracking AppState GoalTracking -> GoalTracking
forall s a. s -> Getting a s a -> a
^. (UIState -> Const GoalTracking UIState)
-> AppState -> Const GoalTracking AppState
Lens' AppState UIState
uiState ((UIState -> Const GoalTracking UIState)
-> AppState -> Const GoalTracking AppState)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
-> UIState -> Const GoalTracking UIState)
-> Getting GoalTracking AppState GoalTracking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const GoalTracking UIGameplay)
-> UIState -> Const GoalTracking UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const GoalTracking UIGameplay)
-> UIState -> Const GoalTracking UIState)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
-> UIGameplay -> Const GoalTracking UIGameplay)
-> (GoalTracking -> Const GoalTracking GoalTracking)
-> UIState
-> Const GoalTracking UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const GoalTracking GoalDisplay)
-> UIGameplay -> Const GoalTracking UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Const GoalTracking GoalDisplay)
-> UIGameplay -> Const GoalTracking UIGameplay)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
-> GoalDisplay -> Const GoalTracking GoalDisplay)
-> (GoalTracking -> Const GoalTracking GoalTracking)
-> UIGameplay
-> Const GoalTracking UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalTracking -> Const GoalTracking GoalTracking)
-> GoalDisplay -> Const GoalTracking GoalDisplay
Lens' GoalDisplay GoalTracking
goalsContent
then ModalType -> EventM Name AppState ()
toggleModal ModalType
GoalModal
else EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
hideRobots :: EventM Name AppState ()
hideRobots :: EventM Name AppState ()
hideRobots = do
TimeSpec
t <- 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
TimeSpec
h <- Getting TimeSpec AppState TimeSpec -> EventM Name AppState TimeSpec
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting TimeSpec AppState TimeSpec
-> EventM Name AppState TimeSpec)
-> Getting TimeSpec AppState TimeSpec
-> EventM Name AppState TimeSpec
forall a b. (a -> b) -> a -> b
$ (UIState -> Const TimeSpec UIState)
-> AppState -> Const TimeSpec AppState
Lens' AppState UIState
uiState ((UIState -> Const TimeSpec UIState)
-> AppState -> Const TimeSpec AppState)
-> ((TimeSpec -> Const TimeSpec TimeSpec)
-> UIState -> Const TimeSpec UIState)
-> Getting TimeSpec AppState TimeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const TimeSpec UIGameplay)
-> UIState -> Const TimeSpec UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const TimeSpec UIGameplay)
-> UIState -> Const TimeSpec UIState)
-> ((TimeSpec -> Const TimeSpec TimeSpec)
-> UIGameplay -> Const TimeSpec UIGameplay)
-> (TimeSpec -> Const TimeSpec TimeSpec)
-> UIState
-> Const TimeSpec UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeSpec -> Const TimeSpec TimeSpec)
-> UIGameplay -> Const TimeSpec UIGameplay
Lens' UIGameplay TimeSpec
uiHideRobotsUntil
case TimeSpec
h TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeSpec
t of
Bool
True -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
Bool
False -> do
(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
. (TimeSpec -> Identity TimeSpec)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay TimeSpec
uiHideRobotsUntil ((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
t TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ Int64 -> Int64 -> TimeSpec
TimeSpec Int64
2 Int64
0
Name -> EventM Name AppState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
showCESKDebug :: EventM Name AppState ()
showCESKDebug :: EventM Name AppState ()
showCESKDebug = do
AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
let isPaused :: Bool
isPaused = AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (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
let isCreative :: Bool
isCreative = AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (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
let hasDebug :: Bool
hasDebug = Bool -> AppState -> Bool
hasDebugCapability Bool
isCreative AppState
s
Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isPaused Bool -> Bool -> Bool
&& Bool
hasDebug) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
Bool
debug <- (UIState -> (Bool, UIState)) -> AppState -> (Bool, AppState)
Lens' AppState UIState
uiState ((UIState -> (Bool, UIState)) -> AppState -> (Bool, AppState))
-> ((Bool -> (Bool, Bool)) -> UIState -> (Bool, UIState))
-> (Bool -> (Bool, Bool))
-> AppState
-> (Bool, AppState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> (Bool, UIGameplay)) -> UIState -> (Bool, UIState)
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> (Bool, UIGameplay)) -> UIState -> (Bool, UIState))
-> ((Bool -> (Bool, Bool)) -> UIGameplay -> (Bool, UIGameplay))
-> (Bool -> (Bool, Bool))
-> UIState
-> (Bool, UIState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> (Bool, Bool)) -> UIGameplay -> (Bool, UIGameplay)
Lens' UIGameplay Bool
uiShowDebug ((Bool -> (Bool, Bool)) -> AppState -> (Bool, AppState))
-> (Bool -> Bool) -> EventM Name AppState Bool
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
Lens.<%= Bool -> Bool
not
if Bool
debug
then (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
-> AppState -> Identity AppState)
-> ((Step -> Identity Step) -> GameState -> Identity GameState)
-> (Step -> Identity Step)
-> 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)
-> ((Step -> Identity Step)
-> TemporalState -> Identity TemporalState)
-> (Step -> Identity Step)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Step -> Identity Step) -> TemporalState -> Identity TemporalState
Lens' TemporalState Step
gameStep ((Step -> Identity Step) -> AppState -> Identity AppState)
-> Step -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SingleStep -> Step
RobotStep SingleStep
SBefore
else 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 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 Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void EventM Name AppState Bool
updateUI
runSingleTick :: EventM Name AppState ()
runSingleTick :: EventM Name AppState ()
runSingleTick = do
(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
ManualPause
EventM Name AppState ()
runGameTickUI
adjustTPS :: (Int -> Int -> Int) -> AppState -> AppState
adjustTPS :: (Int -> Int -> Int) -> AppState -> AppState
adjustTPS Int -> Int -> Int
(+/-) = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Int -> Identity Int) -> UIState -> Identity UIState)
-> (Int -> Identity Int)
-> 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)
-> ((Int -> Identity Int) -> UIGameplay -> Identity UIGameplay)
-> (Int -> Identity Int)
-> 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)
-> ((Int -> Identity Int) -> UITiming -> Identity UITiming)
-> (Int -> Identity Int)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> UITiming -> Identity UITiming
Lens' UITiming Int
lgTicksPerSecond ((Int -> Identity Int) -> AppState -> Identity AppState)
-> (Int -> Int) -> AppState -> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
+/- Int
1)
toggleCreativeMode :: EventM Name AppState ()
toggleCreativeMode :: EventM Name AppState ()
toggleCreativeMode = (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
-> AppState -> Identity AppState)
-> ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> (Bool -> Identity Bool)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> GameState -> Identity GameState
Lens' GameState Bool
creativeMode ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> (Bool -> Bool) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
toggleWorldEditor :: EventM Name AppState ()
toggleWorldEditor :: EventM Name AppState ()
toggleWorldEditor = do
(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
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay)
-> ((Bool -> Identity Bool)
-> WorldEditor Name -> Identity (WorldEditor Name))
-> (Bool -> Identity Bool)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldOverdraw -> Identity WorldOverdraw)
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw ((WorldOverdraw -> Identity WorldOverdraw)
-> WorldEditor Name -> Identity (WorldEditor Name))
-> ((Bool -> Identity Bool)
-> WorldOverdraw -> Identity WorldOverdraw)
-> (Bool -> Identity Bool)
-> WorldEditor Name
-> Identity (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> WorldOverdraw -> Identity WorldOverdraw
Lens' WorldOverdraw Bool
isWorldEditorEnabled ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> (Bool -> Bool) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
WorldEditorPanel
toggleREPLVisibility :: EventM Name AppState ()
toggleREPLVisibility :: EventM Name AppState ()
toggleREPLVisibility = do
Name -> EventM Name AppState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
(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
uiShowREPL ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> (Bool -> Bool) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
isRunning :: EventM Name AppState Bool
isRunning :: EventM Name AppState Bool
isRunning = do
Maybe ModalType
mt <- Getting (First ModalType) AppState ModalType
-> EventM Name AppState (Maybe ModalType)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First ModalType) AppState ModalType
-> EventM Name AppState (Maybe ModalType))
-> Getting (First ModalType) AppState ModalType
-> EventM Name AppState (Maybe ModalType)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (First ModalType) UIState)
-> AppState -> Const (First ModalType) AppState
Lens' AppState UIState
uiState ((UIState -> Const (First ModalType) UIState)
-> AppState -> Const (First ModalType) AppState)
-> ((ModalType -> Const (First ModalType) ModalType)
-> UIState -> Const (First ModalType) UIState)
-> Getting (First ModalType) AppState ModalType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (First ModalType) UIGameplay)
-> UIState -> Const (First ModalType) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (First ModalType) UIGameplay)
-> UIState -> Const (First ModalType) UIState)
-> ((ModalType -> Const (First ModalType) ModalType)
-> UIGameplay -> Const (First ModalType) UIGameplay)
-> (ModalType -> Const (First ModalType) ModalType)
-> UIState
-> Const (First ModalType) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> UIGameplay -> Const (First ModalType) UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> UIGameplay -> Const (First ModalType) UIGameplay)
-> ((ModalType -> Const (First ModalType) ModalType)
-> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> (ModalType -> Const (First ModalType) ModalType)
-> UIGameplay
-> Const (First ModalType) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Const (First ModalType) Modal)
-> Maybe Modal -> Const (First ModalType) (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Const (First ModalType) Modal)
-> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> ((ModalType -> Const (First ModalType) ModalType)
-> Modal -> Const (First ModalType) Modal)
-> (ModalType -> Const (First ModalType) ModalType)
-> Maybe Modal
-> Const (First ModalType) (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModalType -> Const (First ModalType) ModalType)
-> Modal -> Const (First ModalType) Modal
Lens' Modal ModalType
modalType
Bool -> EventM Name AppState Bool
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> EventM Name AppState Bool)
-> Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ Bool -> (ModalType -> Bool) -> Maybe ModalType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ModalType -> Bool
isRunningModal Maybe ModalType
mt
whenRunning :: EventM Name AppState () -> EventM Name AppState ()
whenRunning :: EventM Name AppState () -> EventM Name AppState ()
whenRunning EventM Name AppState ()
a = EventM Name AppState Bool
isRunning EventM Name AppState Bool
-> (Bool -> EventM Name AppState ()) -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> (a -> EventM Name AppState b) -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
r -> Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
r EventM Name AppState ()
a
whenCheating :: EventM Name AppState () -> EventM Name AppState ()
whenCheating :: EventM Name AppState () -> EventM Name AppState ()
whenCheating EventM Name AppState ()
a = do
AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
-> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIState -> Const Bool UIState
Lens' UIState Bool
uiCheatMode) EventM Name AppState ()
a