{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module Swarm.TUI.Controller (
handleEvent,
quitGame,
runFrameUI,
runFrame,
runFrameTicks,
runGameTickUI,
runGameTick,
updateUI,
handleREPLEvent,
validateREPLForm,
adjReplHistIndex,
TimeDir (..),
handleWorldEvent,
keyToDir,
scrollView,
adjustTPS,
handleInfoPanelEvent,
) where
import Brick hiding (Direction)
import Brick.Focus
import Brick.Widgets.Dialog
import Brick.Widgets.Edit (handleEditorEvent)
import Brick.Widgets.List (handleListEvent)
import Brick.Widgets.List qualified as BL
import Control.Carrier.Lift qualified as Fused
import Control.Carrier.State.Lazy qualified as Fused
import Control.Lens
import Control.Lens.Extras (is)
import Control.Monad.Except
import Control.Monad.State
import Data.Bits
import Data.Either (isRight)
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time (getZonedTime)
import Graphics.Vty qualified as V
import Linear
import Swarm.Game.CESK (cancel, emptyStore, initMachine)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Robot
import Swarm.Game.ScenarioInfo
import Swarm.Game.State
import Swarm.Game.Step (gameTick)
import Swarm.Game.Value (Value (VUnit), prettyValue)
import Swarm.Game.World qualified as W
import Swarm.Language.Capability (Capability (CMake))
import Swarm.Language.Context
import Swarm.Language.Parse (reservedWords)
import Swarm.Language.Pipeline
import Swarm.Language.Pretty
import Swarm.Language.Requirement qualified as R
import Swarm.Language.Syntax
import Swarm.Language.Typed (Typed (..))
import Swarm.Language.Types
import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder)
import Swarm.TUI.List
import Swarm.TUI.Model
import Swarm.TUI.View (generateModal)
import Swarm.Util hiding ((<<.=))
import Swarm.Version (NewReleaseFailure (..))
import System.Clock
import Witch (into)
pattern Key :: V.Key -> BrickEvent n e
pattern $bKey :: forall n e. Key -> BrickEvent n e
$mKey :: forall {r} {n} {e}.
BrickEvent n e -> (Key -> r) -> ((# #) -> r) -> r
Key k = VtyEvent (V.EvKey k [])
pattern CharKey, ControlKey, MetaKey :: Char -> BrickEvent n e
pattern $bCharKey :: forall n e. Char -> BrickEvent n e
$mCharKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
CharKey c = VtyEvent (V.EvKey (V.KChar c) [])
pattern $bControlKey :: forall n e. Char -> BrickEvent n e
$mControlKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
ControlKey c = VtyEvent (V.EvKey (V.KChar c) [V.MCtrl])
pattern $bMetaKey :: forall n e. Char -> BrickEvent n e
$mMetaKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
MetaKey c = VtyEvent (V.EvKey (V.KChar c) [V.MMeta])
pattern EscapeKey :: BrickEvent n e
pattern $bEscapeKey :: forall n e. BrickEvent n e
$mEscapeKey :: forall {r} {n} {e}.
BrickEvent n e -> ((# #) -> r) -> ((# #) -> r) -> r
EscapeKey = VtyEvent (V.EvKey V.KEsc [])
pattern FKey :: Int -> BrickEvent n e
pattern $bFKey :: forall n e. Int -> BrickEvent n e
$mFKey :: forall {r} {n} {e}.
BrickEvent n e -> (Int -> r) -> ((# #) -> r) -> r
FKey c = VtyEvent (V.EvKey (V.KFun c) [])
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent = \case
AppEvent (UpstreamVersion Either NewReleaseFailure FilePath
ev) -> do
let logReleaseEvent :: LogSource -> a -> m ()
logReleaseEvent LogSource
l a
e = Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Notifications LogEntry)
eventLog forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= LogSource
-> (Text, Int)
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
l (Text
"Release", -Int
7) (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show a
e)
case Either NewReleaseFailure FilePath
ev of
Left e :: NewReleaseFailure
e@(FailedReleaseQuery FilePath
_e) -> forall {m :: * -> *} {a}.
(MonadState AppState m, Show a) =>
LogSource -> a -> m ()
logReleaseEvent LogSource
ErrorTrace NewReleaseFailure
e
Left NewReleaseFailure
e -> forall {m :: * -> *} {a}.
(MonadState AppState m, Show a) =>
LogSource -> a -> m ()
logReleaseEvent LogSource
Said NewReleaseFailure
e
Right FilePath
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Either NewReleaseFailure FilePath)
upstreamRelease forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Either NewReleaseFailure FilePath
ev
BrickEvent Name AppEvent
e -> do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
if AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiPlaying
then BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent BrickEvent Name AppEvent
e
else
BrickEvent Name AppEvent
e forall a b. a -> (a -> b) -> b
& case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu of
Menu
NoMenu -> forall a b. a -> b -> a
const forall n s. EventM n s ()
halt
MainMenu List Name MainMenuEntry
l -> List Name MainMenuEntry
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent List Name MainMenuEntry
l
NewGameMenu NonEmpty (List Name ScenarioItem)
l -> NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent NonEmpty (List Name ScenarioItem)
l
Menu
MessagesMenu -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent
Menu
AboutMenu -> Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey (List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
About))
handleMainMenuEvent ::
BL.List Name MainMenuEntry -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent :: List Name MainMenuEntry
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent List Name MainMenuEntry
menu = \case
Key Key
V.KEnter ->
case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name MainMenuEntry
menu of
Maybe MainMenuEntry
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
Just MainMenuEntry
x0 -> case MainMenuEntry
x0 of
MainMenuEntry
NewGame -> do
Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
ScenarioCollection
ss <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (forall a. [a] -> NonEmpty a
NE.fromList [Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
ss])
MainMenuEntry
Tutorial -> do
Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
ScenarioCollection
ss <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios
let tutorialCollection :: ScenarioCollection
tutorialCollection = ScenarioCollection -> ScenarioCollection
getTutorials ScenarioCollection
ss
topMenu :: List Name ScenarioItem
topMenu =
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy
((forall a. Eq a => a -> a -> Bool
== Text
"Tutorials") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioItem -> Text
scenarioItemName)
(Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
ss)
tutorialMenu :: List Name ScenarioItem
tutorialMenu = Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
tutorialCollection
menuStack :: NonEmpty (List Name ScenarioItem)
menuStack = forall a. [a] -> NonEmpty a
NE.fromList [List Name ScenarioItem
tutorialMenu, List Name ScenarioItem
topMenu]
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu NonEmpty (List Name ScenarioItem)
menuStack
let firstTutorial :: ScenarioInfoPair
firstTutorial = case ScenarioCollection -> Maybe [FilePath]
scOrder ScenarioCollection
tutorialCollection of
Just (FilePath
t : [FilePath]
_) -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
t (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
tutorialCollection) of
Just (SISingle ScenarioInfoPair
siPair) -> ScenarioInfoPair
siPair
Maybe ScenarioItem
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"No first tutorial found!"
Maybe [FilePath]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"No first tutorial found!"
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
firstTutorial forall a. Maybe a
Nothing
MainMenuEntry
Messages -> do
Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Notifications LogEntry)
eventLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Int
notificationsCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
MessagesMenu
MainMenuEntry
About -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
AboutMenu
MainMenuEntry
Quit -> forall n s. EventM n s ()
halt
CharKey Char
'q' -> forall n s. EventM n s ()
halt
ControlKey Char
'q' -> forall n s. EventM n s ()
halt
VtyEvent Event
ev -> do
List Name MainMenuEntry
menu' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name MainMenuEntry
menu (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu List Name MainMenuEntry
menu'
BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
getTutorials :: ScenarioCollection -> ScenarioCollection
getTutorials :: ScenarioCollection -> ScenarioCollection
getTutorials ScenarioCollection
sc = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
"Tutorials" (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
sc) of
Just (SICollection Text
_ ScenarioCollection
c) -> ScenarioCollection
c
Maybe ScenarioItem
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"No tutorials exist!"
advanceMenu :: Menu -> Menu
= Prism' Menu (NonEmpty (List Name ScenarioItem))
_NewGameMenu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
BL.listMoveDown
handleMainMessagesEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent = \case
Key Key
V.KEsc -> EventM Name AppState ()
returnToMainMenu
CharKey Char
'q' -> EventM Name AppState ()
returnToMainMenu
ControlKey Char
'q' -> EventM Name AppState ()
returnToMainMenu
BrickEvent Name AppEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
returnToMainMenu :: EventM Name AppState ()
returnToMainMenu = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
Messages)
handleNewGameMenuEvent :: NonEmpty (BL.List Name ScenarioItem) -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent :: NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent scenarioStack :: NonEmpty (List Name ScenarioItem)
scenarioStack@(List Name ScenarioItem
curMenu :| [List Name ScenarioItem]
rest) = \case
Key Key
V.KEnter ->
case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
curMenu of
Maybe ScenarioItem
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
Just (SISingle ScenarioInfoPair
siPair) -> forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair forall a. Maybe a
Nothing
Just (SICollection Text
_ ScenarioCollection
c) -> do
Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
c) NonEmpty (List Name ScenarioItem)
scenarioStack)
Key Key
V.KEsc -> NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
scenarioStack
CharKey Char
'q' -> NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
scenarioStack
ControlKey Char
'q' -> forall n s. EventM n s ()
halt
VtyEvent Event
ev -> do
List Name ScenarioItem
menu' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name ScenarioItem
curMenu (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (List Name ScenarioItem
menu' forall a. a -> [a] -> NonEmpty a
:| [List Name ScenarioItem]
rest)
BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
exitNewGameMenu :: NonEmpty (BL.List Name ScenarioItem) -> EventM Name AppState ()
NonEmpty (List Name ScenarioItem)
stk = do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case forall a b. (a, b) -> b
snd (forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty (List Name ScenarioItem)
stk) of
Maybe (NonEmpty (List Name ScenarioItem))
Nothing -> List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
NewGame)
Just NonEmpty (List Name ScenarioItem)
stk' -> NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu NonEmpty (List Name ScenarioItem)
stk'
pressAnyKey :: Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey :: Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey Menu
m (VtyEvent (V.EvKey Key
_ [Modifier]
_)) = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
m
pressAnyKey Menu
_ BrickEvent Name AppEvent
_ = forall n s. EventM n s ()
continueWithoutRedraw
handleMainEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent BrickEvent Name AppEvent
ev = do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
Maybe ModalType
mt <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal ModalType
modalType
let isRunning :: Bool
isRunning = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ModalType -> Bool
isRunningModal Maybe ModalType
mt
case BrickEvent Name AppEvent
ev of
AppEvent AppEvent
Frame
| AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState Bool
paused -> forall n s. EventM n s ()
continueWithoutRedraw
| Bool
otherwise -> EventM Name AppState ()
runFrameUI
ControlKey Char
'q' ->
case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition of
Won Bool
_ -> ModalType -> EventM Name AppState ()
toggleModal ModalType
WinModal
WinCondition
_ -> ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
VtyEvent (V.EvResize Int
_ Int
_) -> forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
Key Key
V.KEsc
| forall a. Maybe a -> Bool
isJust (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiError) -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiError forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
| Just Modal
m <- AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal -> do
EventM Name AppState ()
safeAutoUnpause
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Modal
m forall s a. s -> Getting a s a -> a
^. Lens' Modal ModalType
modalType forall a. Eq a => a -> a -> Bool
== ModalType
MessagesModal) forall a b. (a -> b) -> a -> b
$ do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
lastSeenMessageTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
ticks
FKey Int
1 -> ModalType -> EventM Name AppState ()
toggleModal ModalType
HelpModal
FKey Int
2 -> ModalType -> EventM Name AppState ()
toggleModal ModalType
RobotsModal
FKey Int
3 | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (Notifications (Recipe Entity))
availableRecipes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent)) -> do
ModalType -> EventM Name AppState ()
toggleModal ModalType
RecipesModal
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (Notifications (Recipe Entity))
availableRecipes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Int
notificationsCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
FKey Int
4 | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (Notifications Const)
availableCommands forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent)) -> do
ModalType -> EventM Name AppState ()
toggleModal ModalType
CommandsModal
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (Notifications Const)
availableCommands forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Int
notificationsCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
FKey Int
5 | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState (Notifications LogEntry)
messageNotifications forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent)) -> do
ModalType -> EventM Name AppState ()
toggleModal ModalType
MessagesModal
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
lastSeenMessageTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
ticks
ControlKey Char
'g' -> case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe [Text])
uiGoal of
Just [Text]
g | [Text]
g forall a. Eq a => a -> a -> Bool
/= [] -> ModalType -> EventM Name AppState ()
toggleModal ([Text] -> ModalType
GoalModal [Text]
g)
Maybe [Text]
_ -> forall n s. EventM n s ()
continueWithoutRedraw
MetaKey Char
'h' -> do
TimeSpec
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
TimeSpec
h <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
uiHideRobotsUntil
if TimeSpec
h forall a. Ord a => a -> a -> Bool
>= TimeSpec
t
then
forall n s. EventM n s ()
continueWithoutRedraw
else
do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
uiHideRobotsUntil forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
t forall a. Num a => a -> a -> a
+ Int64 -> Int64 -> TimeSpec
TimeSpec Int64
2 Int64
0
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
ControlKey Char
'p' | Bool
isRunning -> EventM Name AppState ()
safeTogglePause
ControlKey Char
'o' | Bool
isRunning -> do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
ManualPause
EventM Name AppState ()
runGameTickUI
ControlKey Char
'x' | Bool
isRunning -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> AppState -> AppState
adjustTPS forall a. Num a => a -> a -> a
(+)
ControlKey Char
'z' | Bool
isRunning -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> AppState -> AppState
adjustTPS (-)
MetaKey Char
'w' -> Name -> EventM Name AppState ()
setFocus Name
WorldPanel
MetaKey Char
'e' -> Name -> EventM Name AppState ()
setFocus Name
RobotPanel
MetaKey Char
'r' -> Name -> EventM Name AppState ()
setFocus Name
REPLPanel
MetaKey Char
't' -> Name -> EventM Name AppState ()
setFocus Name
InfoPanel
VtyEvent Event
vev
| forall a. Maybe a -> Bool
isJust (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal) -> Event -> EventM Name AppState ()
handleModalEvent Event
vev
ControlKey Char
'v'
| AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode -> Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
MouseDown Name
n Button
_ [Modifier]
_ Location
mouseLoc ->
case Name
n of
Name
WorldPanel -> do
Maybe Coords
mouseCoordsM <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' AppState GameState
gameState (Location -> EventM Name GameState (Maybe Coords)
mouseLocToWorldCoords Location
mouseLoc)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Coords)
uiWorldCursor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Coords
mouseCoordsM
Name
REPLInput -> do
Name -> EventM Name AppState ()
setFocus Name
REPLPanel
BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
ev
Name
_ -> forall n s. EventM n s ()
continueWithoutRedraw
MouseUp Name
n Maybe Button
_ Location
_mouseLoc -> do
case Name
n of
InventoryListItem Int
pos -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Int, List Name InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Name -> EventM Name AppState ()
setFocus forall a b. (a -> b) -> a -> b
$ case Name
n of
Name
InventoryList -> Name
RobotPanel
InventoryListItem Int
_ -> Name
RobotPanel
Name
InfoViewport -> Name
InfoPanel
Name
_ -> Name
n
BrickEvent Name AppEvent
_ev -> do
FocusRing Name
fring <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing
case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring of
Just Name
REPLPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
ev
Just Name
WorldPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent BrickEvent Name AppEvent
ev
Just Name
RobotPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent BrickEvent Name AppEvent
ev
Just Name
InfoPanel -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
infoScroll BrickEvent Name AppEvent
ev
Maybe Name
_ -> forall n s. EventM n s ()
continueWithoutRedraw
mouseLocToWorldCoords :: Brick.Location -> EventM Name GameState (Maybe W.Coords)
mouseLocToWorldCoords :: Location -> EventM Name GameState (Maybe Coords)
mouseLocToWorldCoords (Brick.Location (Int, Int)
mouseLoc) = do
Maybe (Extent Name)
mext <- 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just Extent Name
ext -> do
(Coords, Coords)
region <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip GameState -> (Int64, Int64) -> (Coords, Coords)
viewingRegion (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall n. Extent n -> (Int, Int)
extentSize Extent Name
ext))
let regionStart :: (Int64, Int64)
regionStart = Coords -> (Int64, Int64)
W.unCoords (forall a b. (a, b) -> a
fst (Coords, Coords)
region)
mouseLoc' :: (Int64, Int64)
mouseLoc' = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int, Int)
mouseLoc
mx :: Int64
mx = forall a b. (a, b) -> b
snd (Int64, Int64)
mouseLoc' forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> a
fst (Int64, Int64)
regionStart
my :: Int64
my = forall a b. (a, b) -> a
fst (Int64, Int64)
mouseLoc' forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (Int64, Int64)
regionStart
in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int64, Int64) -> Coords
W.Coords (Int64
mx, Int64
my)
setFocus :: Name -> EventM Name AppState ()
setFocus :: Name -> EventM Name AppState ()
setFocus Name
name = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Name
name
safeTogglePause :: EventM Name AppState ()
safeTogglePause :: EventM Name AppState ()
safeTogglePause = do
TimeSpec
curTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastFrameTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= RunStatus -> RunStatus
toggleRunStatus
safeAutoUnpause :: EventM Name AppState ()
safeAutoUnpause :: EventM Name AppState ()
safeAutoUnpause = do
RunStatus
runs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState RunStatus
runStatus
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
runs 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal
case Maybe Modal
modal of
Maybe Modal
Nothing -> do
Modal
newModal <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip AppState -> ModalType -> Modal
generateModal ModalType
mt
EventM Name AppState ()
ensurePause
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Modal
newModal
Just Modal
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name AppState ()
safeAutoUnpause
where
ensurePause :: EventM Name AppState ()
ensurePause = do
Bool
pause <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState Bool
paused
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
pause Bool -> Bool -> Bool
|| ModalType -> Bool
isRunningModal ModalType
mt) forall a b. (a -> b) -> a -> b
$ do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
AutoPause
isRunningModal :: ModalType -> Bool
isRunningModal :: ModalType -> Bool
isRunningModal ModalType
mt = ModalType
mt forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModalType
RobotsModal, ModalType
MessagesModal]
handleModalEvent :: V.Event -> EventM Name AppState ()
handleModalEvent :: Event -> EventM Name AppState ()
handleModalEvent = \case
V.EvKey Key
V.KEnter [] -> do
Maybe (Dialog ButtonSelection)
mdialog <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal (Dialog ButtonSelection)
modalDialog
ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
case forall a. Dialog a -> Maybe a
dialogSelection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Dialog ButtonSelection)
mdialog of
Just (Just ButtonSelection
QuitButton) -> EventM Name AppState ()
quitGame
Just (Just ButtonSelection
KeepPlayingButton) -> ModalType -> EventM Name AppState ()
toggleModal ModalType
KeepPlayingModal
Just (Just (StartOverButton Int
currentSeed ScenarioInfoPair
siPair)) -> forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Int -> ScenarioInfoPair -> m ()
restartGame Int
currentSeed ScenarioInfoPair
siPair
Just (Just (NextButton ScenarioInfoPair
siPair)) -> forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair forall a. Maybe a
Nothing
Maybe (Maybe ButtonSelection)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Event
ev -> do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal (Dialog ButtonSelection)
modalDialog) (forall n a. Event -> EventM n (Dialog a) ()
handleDialogEvent Event
ev)
Maybe ModalType
modal <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal ModalType
modalType
case Maybe ModalType
modal of
Just ModalType
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
Maybe ModalType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
saveScenarioInfoOnQuit :: (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit :: forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit = do
Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cheat forall a b. (a -> b) -> a -> b
$ do
Maybe FilePath
mp' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (Maybe FilePath)
currentScenarioPath
case Maybe FilePath
mp' of
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
p' -> do
ScenarioCollection
gs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios
FilePath
p <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ScenarioCollection -> FilePath -> IO FilePath
normalizeScenarioPath ScenarioCollection
gs FilePath
p'
ZonedTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
Bool
won <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' WinCondition Bool
_Won)
Integer
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
ticks
let currentScenarioInfo :: Traversal' AppState ScenarioInfo
currentScenarioInfo :: Traversal' AppState ScenarioInfo
currentScenarioInfo = Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath FilePath
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
Traversal' AppState ScenarioInfo
currentScenarioInfo forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ZonedTime -> Integer -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnQuit ZonedTime
t Integer
ts Bool
won
Maybe ScenarioInfo
status <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse Traversal' AppState ScenarioInfo
currentScenarioInfo
case Maybe ScenarioInfo
status of
Maybe ScenarioInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ScenarioInfo
si -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> ScenarioInfo -> IO ()
saveScenarioInfo FilePath
p ScenarioInfo
si
Maybe FilePath
curPath <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Menu (NonEmpty (List Name ScenarioItem))
_NewGameMenu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
Traversal' (GenericList n t e) e
BL.listSelectedElementL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ScenarioInfo FilePath
scenarioPath
ScenarioCollection
sc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Bool -> ScenarioCollection -> FilePath -> Maybe Menu
mkNewGameMenu Bool
cheat ScenarioCollection
sc (forall a. a -> Maybe a -> a
fromMaybe FilePath
p Maybe FilePath
curPath)) (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
quitGame :: EventM Name AppState ()
quitGame :: EventM Name AppState ()
quitGame = do
REPLHistory
history <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory
let hist :: [Text]
hist = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe REPLHistItem -> Maybe Text
getREPLEntry forall a b. (a -> b) -> a -> b
$ Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems forall a. Bounded a => a
maxBound REPLHistory
history
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (FilePath -> Text -> IO ()
`T.appendFile` [Text] -> Text
T.unlines [Text]
hist) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO FilePath
getSwarmHistoryPath Bool
True
forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit
Menu
menu <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu
case Menu
menu of
Menu
NoMenu -> forall n s. EventM n s ()
halt
Menu
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiPlaying forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
runFrameUI :: EventM Name AppState ()
runFrameUI :: EventM Name AppState ()
runFrameUI = do
EventM Name AppState ()
runFrame
Bool
redraw <- EventM Name AppState Bool
updateUI
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
redraw forall n s. EventM n s ()
continueWithoutRedraw
runFrame :: EventM Name AppState ()
runFrame :: EventM Name AppState ()
runFrame = do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
needsRedraw forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
TimeSpec
prevTime <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastFrameTime)
TimeSpec
curTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
let frameTime :: TimeSpec
frameTime = TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
curTime TimeSpec
prevTime
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastFrameTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
accumulatedTime forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= TimeSpec
frameTime
Int
lgTPS <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
lgTicksPerSecond)
let oneSecond :: Integer
oneSecond = Integer
1_000_000_000
dt :: Integer
dt
| Int
lgTPS forall a. Ord a => a -> a -> Bool
>= Int
0 = Integer
oneSecond forall a. Integral a => a -> a -> a
`div` (Integer
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
lgTPS)
| Bool
otherwise = Integer
oneSecond forall a. Num a => a -> a -> a
* (Integer
1 forall a. Bits a => a -> Int -> a
`shiftL` forall a. Num a => a -> a
abs Int
lgTPS)
TimeSpec
infoUpdateTime <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastInfoTime)
let updateTime :: Integer
updateTime = TimeSpec -> Integer
toNanoSecs forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
curTime TimeSpec
infoUpdateTime
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
updateTime forall a. Ord a => a -> a -> Bool
>= Integer
oneSecond) forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeSpec
infoUpdateTime forall a. Eq a => a -> a -> Bool
/= TimeSpec
0) forall a b. (a -> b) -> a -> b
$ do
Int
frames <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameCount)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiFPS forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
frames forall a. Num a => a -> a -> a
* forall a. Num a => Integer -> a
fromInteger Integer
oneSecond) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
updateTime
Int
uiTicks <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
tickCount)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiTPF forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
uiTicks forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frames
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
needsRedraw forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
tickCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastInfoTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameCount forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameTickCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
TimeSpec -> EventM Name AppState ()
runFrameTicks (Integer -> TimeSpec
fromNanoSecs Integer
dt)
ticksPerFrameCap :: Int
ticksPerFrameCap :: Int
ticksPerFrameCap = Int
30
runFrameTicks :: TimeSpec -> EventM Name AppState ()
runFrameTicks :: TimeSpec -> EventM Name AppState ()
runFrameTicks TimeSpec
dt = do
TimeSpec
a <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
accumulatedTime)
Int
t <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameTickCount)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeSpec
a forall a. Ord a => a -> a -> Bool
>= TimeSpec
dt Bool -> Bool -> Bool
&& Int
t forall a. Ord a => a -> a -> Bool
< Int
ticksPerFrameCap) forall a b. (a -> b) -> a -> b
$ do
EventM Name AppState ()
runGameTick
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
tickCount forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameTickCount forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
accumulatedTime forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= TimeSpec
dt
TimeSpec -> EventM Name AppState ()
runFrameTicks TimeSpec
dt
runGameTickUI :: EventM Name AppState ()
runGameTickUI :: EventM Name AppState ()
runGameTickUI = EventM Name AppState ()
runGameTick forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Functor f => f a -> f ()
void EventM Name AppState Bool
updateUI
zoomGameState :: (MonadState AppState m, MonadIO m) => Fused.StateC GameState (Fused.LiftC IO) a -> m ()
zoomGameState :: forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m ()
zoomGameState StateC GameState (LiftC IO) a
f = do
GameState
gs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' AppState GameState
gameState
GameState
gs' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a. LiftC m a -> m a
Fused.runM (forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m s
Fused.execState GameState
gs StateC GameState (LiftC IO) a
f))
Lens' AppState GameState
gameState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GameState
gs'
runGameTick :: EventM Name AppState ()
runGameTick :: EventM Name AppState ()
runGameTick = forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m ()
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
gameTick
updateUI :: EventM Name AppState Bool
updateUI :: EventM Name AppState Bool
updateUI = do
EventM Name AppState ()
loadVisibleRegion
GameState
g <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' AppState GameState
gameState
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
needsRedraw) forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
Maybe Int
listRobotHash <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Int, List Name InventoryListEntry))
uiInventory)
Maybe Robot
fr <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot)
let focusedRobotHash :: Maybe Int
focusedRobotHash = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Robot Int
inventoryHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
fr
Bool
shouldUpdate <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate)
Bool
inventoryUpdated <-
if Maybe Int
listRobotHash forall a. Eq a => a -> a -> Bool
/= Maybe Int
focusedRobotHash Bool -> Bool -> Bool
|| Bool
shouldUpdate
then do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' AppState UIState
uiState forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadState UIState m => Maybe Robot -> m ()
populateInventoryList Maybe Robot
fr
(Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Bool
replUpdated <- case GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState REPLStatus
replStatus of
REPLWorking (Typed (Just Value
VUnit) Polytype
typ Requirements
reqs) -> do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Typed Value) -> REPLStatus
REPLDone (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall v. v -> Polytype -> Requirements -> Typed v
Typed Value
VUnit Polytype
typ Requirements
reqs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
REPLWorking (Typed (Just Value
v) Polytype
pty Requirements
reqs) -> do
let finalType :: Polytype
finalType = Polytype -> Polytype
stripCmd Polytype
pty
let val :: Typed Value
val = forall v. v -> Polytype -> Requirements -> Typed v
Typed Value
v Polytype
finalType Requirements
reqs
Integer
itIx <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
replNextValueIndex)
let itName :: Text
itName = forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath
"it" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Integer
itIx
let out :: Text
out = Text -> [Text] -> Text
T.intercalate Text
" " [Text
itName, Text
":", forall a. PrettyPrec a => a -> Text
prettyText Polytype
finalType, Text
"=", forall target source. From source target => source -> target
into (Value -> Text
prettyValue Value
v)]
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem (Text -> REPLHistItem
REPLOutput Text
out)
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Typed Value) -> REPLStatus
REPLDone (forall a. a -> Maybe a
Just Typed Value
val)
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
itName forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Typed Value
val
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
replNextValueIndex forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Num a => a -> a -> a
+ Integer
1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
REPLStatus
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiScrollToEnd forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
Bool
logUpdated <- do
case forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Robot Bool
robotLogUpdated) Maybe Robot
fr of
Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Bool
True -> do
forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m ()
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
clearFocusedRobotLogUpdated
let isLogger :: InventoryListEntry -> Bool
isLogger (InstalledEntry Entity
e) = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName forall a. Eq a => a -> a -> Bool
== Text
"logger"
isLogger InventoryListEntry
_ = Bool
False
focusLogger :: GenericList n Vector InventoryListEntry
-> GenericList n Vector InventoryListEntry
focusLogger = forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy InventoryListEntry -> Bool
isLogger
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Int, List Name InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {n}.
GenericList n Vector InventoryListEntry
-> GenericList n Vector InventoryListEntry
focusLogger
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiScrollToEnd forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Bool
infoPanelUpdated <- do
Maybe Viewport
mvp <- forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport Name
InfoViewport
case Maybe Viewport
mvp of
Maybe Viewport
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Viewport
vp -> do
let topMore :: Bool
topMore = (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport Int
vpTop) forall a. Ord a => a -> a -> Bool
> Int
0
botMore :: Bool
botMore = (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport Int
vpTop forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport (Int, Int)
vpSize)) forall a. Ord a => a -> a -> Bool
< forall a b. (a, b) -> b
snd (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport (Int, Int)
vpContentSize)
Bool
oldTopMore <- Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiMoreInfoTop forall s (m :: * -> *) a b.
MonadState s m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= Bool
topMore
Bool
oldBotMore <- Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiMoreInfoBot forall s (m :: * -> *) a b.
MonadState s m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= Bool
botMore
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
oldTopMore forall a. Eq a => a -> a -> Bool
/= Bool
topMore Bool -> Bool -> Bool
|| Bool
oldBotMore forall a. Eq a => a -> a -> Bool
/= Bool
botMore
Maybe [Text]
curGoal <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe [Text])
uiGoal)
Maybe [Text]
newGoal <-
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' WinCondition (NonEmpty Objective)
_WinConditions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (NonEmpty a) (a, [a])
_NonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Objective [Text]
objectiveGoal)
let goalUpdated :: Bool
goalUpdated = Maybe [Text]
curGoal forall a. Eq a => a -> a -> Bool
/= Maybe [Text]
newGoal
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
goalUpdated forall a b. (a -> b) -> a -> b
$ do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe [Text])
uiGoal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe [Text]
newGoal
case Maybe [Text]
newGoal of
Just [Text]
goal | [Text]
goal forall a. Eq a => a -> a -> Bool
/= [] -> do
ModalType -> EventM Name AppState ()
toggleModal ([Text] -> ModalType
GoalModal [Text]
goal)
Maybe [Text]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
winModalUpdated <- do
WinCondition
w <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition)
case WinCondition
w of
Won Bool
False -> do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool -> WinCondition
Won Bool
True
ModalType -> EventM Name AppState ()
toggleModal ModalType
WinModal
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Menu -> Menu
advanceMenu
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
WinCondition
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
let redraw :: Bool
redraw = GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
needsRedraw Bool -> Bool -> Bool
|| Bool
inventoryUpdated Bool -> Bool -> Bool
|| Bool
replUpdated Bool -> Bool -> Bool
|| Bool
logUpdated Bool -> Bool -> Bool
|| Bool
infoPanelUpdated Bool -> Bool -> Bool
|| Bool
goalUpdated Bool -> Bool -> Bool
|| Bool
winModalUpdated
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
redraw
loadVisibleRegion :: EventM Name AppState ()
loadVisibleRegion :: EventM Name AppState ()
loadVisibleRegion = do
Maybe (Extent Name)
mext <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Extent Name
_ Location
_ (Int, Int)
size) -> do
GameState
gs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' AppState GameState
gameState
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (World Int Entity)
world forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t e.
IArray UArray t =>
(Coords, Coords) -> World t e -> World t e
W.loadRegion (GameState -> (Int64, Int64) -> (Coords, Coords)
viewingRegion GameState
gs (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int, Int)
size))
stripCmd :: Polytype -> Polytype
stripCmd :: Polytype -> Polytype
stripCmd (Forall [Text]
xs (TyCmd Type
ty)) = forall t. [Text] -> t -> Poly t
Forall [Text]
xs Type
ty
stripCmd Polytype
pty = Polytype
pty
resetREPL :: T.Text -> REPLPrompt -> UIState -> UIState
resetREPL :: Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
t REPLPrompt
r UIState
ui =
UIState
ui
forall a b. a -> (a -> b) -> b
& Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
t
forall a b. a -> (a -> b) -> b
& Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLPrompt
r
forall a b. a -> (a -> b) -> b
& Lens' UIState (Maybe Text)
uiError forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent = \case
ControlKey Char
'c' -> do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CESK -> CESK
cancel
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Text] -> REPLPrompt
CmdPrompt []
Key Key
V.KEnter -> do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
let topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s
repl :: REPLState
repl = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL
uinput :: Text
uinput = REPLState
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText
startBaseProgram :: ProcessedTerm -> AppState -> AppState
startBaseProgram t :: ProcessedTerm
t@(ProcessedTerm Term
_ (Module Polytype
ty TCtx
_) Requirements
reqs ReqCtx
_) =
(Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed forall a. Maybe a
Nothing Polytype
ty Requirements
reqs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
t (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Env
defVals) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Store
defStore))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' AppState GameState
gameState forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s a. State s a -> s -> s
execState (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m ()
activateRobot Int
0))
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState Bool
replWorking
then case REPLState
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLPrompt
replPromptType of
CmdPrompt [Text]
_ ->
case TCtx -> ReqCtx -> Text -> Either Text (Maybe ProcessedTerm)
processTerm' (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext TCtx
defTypes) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext ReqCtx
defReqs) Text
uinput of
Right Maybe ProcessedTerm
mt -> do
Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem (Text -> REPLHistItem
REPLEntry Text
uinput)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ProcessedTerm -> AppState -> AppState
startBaseProgram Maybe ProcessedTerm
mt
Left Text
err -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiError forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Text
err
SearchPrompt REPLHistory
hist ->
case Text -> REPLHistory -> Maybe Text
lastEntry Text
uinput REPLHistory
hist of
Maybe Text
Nothing -> Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
Just Text
found
| Text -> Bool
T.null Text
uinput -> Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
| Bool
otherwise -> do
Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
found ([Text] -> REPLPrompt
CmdPrompt [])
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
else forall n s. EventM n s ()
continueWithoutRedraw
Key Key
V.KUp -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
Older
Key Key
V.KDown -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
Newer
ControlKey Char
'r' -> do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
let uinput :: Text
uinput = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText
case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType of
CmdPrompt [Text]
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLHistory -> REPLPrompt
SearchPrompt (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory)
SearchPrompt REPLHistory
rh -> case Text -> REPLHistory -> Maybe Text
lastEntry Text
uinput REPLHistory
rh of
Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Text
found -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLHistory -> REPLPrompt
SearchPrompt (Text -> REPLHistory -> REPLHistory
removeEntry Text
found REPLHistory
rh)
CharKey Char
'\t' -> do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
let names :: [Text]
names = AppState
s forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext TCtx
defTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall t. Ctx t -> [(Text, t)]
assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= [Text] -> EntityMap -> REPLState -> REPLState
tabComplete [Text]
names (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState EntityMap
entityMap)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
BrickEvent Name AppEvent
EscapeKey -> do
REPLPrompt
formSt <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType
case REPLPrompt
formSt of
CmdPrompt {} -> forall n s. EventM n s ()
continueWithoutRedraw
SearchPrompt REPLHistory
_ ->
Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
ControlKey Char
'd' -> do
Text
text <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText
if Text
text forall a. Eq a => a -> a -> Bool
== Text
T.empty
then ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
else forall n s. EventM n s ()
continueWithoutRedraw
BrickEvent Name AppEvent
ev -> do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState (Editor Text Name)
replPromptEditor) (forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent BrickEvent Name AppEvent
ev)
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \case
CmdPrompt [Text]
_ -> [Text] -> REPLPrompt
CmdPrompt []
SearchPrompt REPLHistory
a -> REPLHistory -> REPLPrompt
SearchPrompt REPLHistory
a
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
data CompletionType
= FunctionName
| EntityName
deriving (CompletionType -> CompletionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionType -> CompletionType -> Bool
$c/= :: CompletionType -> CompletionType -> Bool
== :: CompletionType -> CompletionType -> Bool
$c== :: CompletionType -> CompletionType -> Bool
Eq)
tabComplete :: [Var] -> EntityMap -> REPLState -> REPLState
tabComplete :: [Text] -> EntityMap -> REPLState -> REPLState
tabComplete [Text]
names EntityMap
em REPLState
repl = case REPLState
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLPrompt
replPromptType of
SearchPrompt REPLHistory
_ -> REPLState
repl
CmdPrompt [Text]
mms
| (Text
m : [Text]
ms) <- [Text]
mms -> Text -> [Text] -> REPLState
setCmd (Text -> Text
replacementFunc Text
m) ([Text]
ms forall a. [a] -> [a] -> [a]
++ [Text
m])
| Text -> Bool
T.null Text
lastWord Bool -> Bool -> Bool
&& CompletionType
completionType forall a. Eq a => a -> a -> Bool
== CompletionType
FunctionName -> Text -> [Text] -> REPLState
setCmd Text
t []
| Bool
otherwise -> case [Text]
candidateMatches of
[] -> Text -> [Text] -> REPLState
setCmd Text
t []
[Text
m] -> Text -> [Text] -> REPLState
setCmd (Text -> Text
completeWith Text
m) []
(Text
m : [Text]
ms) -> Text -> [Text] -> REPLState
setCmd (Text -> Text
completeWith Text
m) ([Text]
ms forall a. [a] -> [a] -> [a]
++ [Text
m])
where
hasOpenQuotes :: Text -> Bool
hasOpenQuotes = (forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Int
T.count Text
"\""
completionType :: CompletionType
completionType =
if Text -> Bool
hasOpenQuotes Text
t
then CompletionType
EntityName
else CompletionType
FunctionName
replacementFunc :: Text -> Text
replacementFunc = Text -> Text -> Text
T.append forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
replacementBoundaryPredicate Text
t
completeWith :: Text -> Text
completeWith Text
m = Text -> Text -> Text
T.append Text
t forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
lastWord) Text
m
lastWord :: Text
lastWord = (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
replacementBoundaryPredicate Text
t
candidateMatches :: [Text]
candidateMatches = forall a. (a -> Bool) -> [a] -> [a]
filter (Text
lastWord Text -> Text -> Bool
`T.isPrefixOf`) [Text]
replacementCandidates
([Text]
replacementCandidates, Char -> Bool
replacementBoundaryPredicate) = case CompletionType
completionType of
CompletionType
EntityName -> ([Text]
entityNames, (forall a. Eq a => a -> a -> Bool
/= Char
'"'))
CompletionType
FunctionName -> ([Text]
possibleWords, Char -> Bool
isIdentChar)
possibleWords :: [Text]
possibleWords = [Text]
reservedWords forall a. [a] -> [a] -> [a]
++ [Text]
names
entityNames :: [Text]
entityNames = forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ EntityMap -> Map Text Entity
entitiesByName EntityMap
em
t :: Text
t = REPLState
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText
setCmd :: Text -> [Text] -> REPLState
setCmd Text
nt [Text]
ms =
REPLState
repl
forall a b. a -> (a -> b) -> b
& Lens' REPLState Text
replPromptText forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
nt
forall a b. a -> (a -> b) -> b
& Lens' REPLState REPLPrompt
replPromptType forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt [Text]
ms
validateREPLForm :: AppState -> AppState
validateREPLForm :: AppState -> AppState
validateREPLForm AppState
s =
case REPLPrompt
replPrompt of
CmdPrompt [Text]
_
| Text -> Bool
T.null Text
uinput ->
let theType :: Maybe Polytype
theType = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter REPLStatus (Maybe Polytype)
replActiveType
in AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState (Maybe Polytype)
replType forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
CmdPrompt [Text]
_
| Bool
otherwise ->
let result :: Either Text (Maybe ProcessedTerm)
result = TCtx -> ReqCtx -> Text -> Either Text (Maybe ProcessedTerm)
processTerm' (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext TCtx
defTypes) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext ReqCtx
defReqs) Text
uinput
theType :: Maybe Polytype
theType = case Either Text (Maybe ProcessedTerm)
result of
Right (Just (ProcessedTerm Term
_ (Module Polytype
ty TCtx
_) Requirements
_ ReqCtx
_)) -> forall a. a -> Maybe a
Just Polytype
ty
Either Text (Maybe ProcessedTerm)
_ -> forall a. Maybe a
Nothing
in AppState
s
forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Bool
replValid forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b. Either a b -> Bool
isRight Either Text (Maybe ProcessedTerm)
result
forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState (Maybe Polytype)
replType forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
SearchPrompt REPLHistory
_ -> AppState
s
where
uinput :: Text
uinput = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText
replPrompt :: REPLPrompt
replPrompt = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType
topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
d AppState
s =
AppState
s
forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ REPLState -> REPLState
moveREPL
forall a b. a -> (a -> b) -> b
& AppState -> AppState
validateREPLForm
where
moveREPL :: REPLState -> REPLState
moveREPL :: REPLState -> REPLState
moveREPL REPLState
repl =
REPLState
newREPL
forall a b. a -> (a -> b) -> b
& (if REPLHistory -> Bool
replIndexIsAtInput (REPLState
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLHistory
replHistory) then REPLState -> REPLState
saveLastEntry else forall a. a -> a
id)
forall a b. a -> (a -> b) -> b
& (if Text
oldEntry forall a. Eq a => a -> a -> Bool
/= Text
newEntry then REPLState -> REPLState
showNewEntry else forall a. a -> a
id)
where
newREPL :: REPLState
newREPL :: REPLState
newREPL = REPLState
repl forall a b. a -> (a -> b) -> b
& Lens' REPLState REPLHistory
replHistory forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex TimeDir
d Text
oldEntry
saveLastEntry :: REPLState -> REPLState
saveLastEntry = Lens' REPLState Text
replLast forall s t a b. ASetter s t a b -> b -> s -> t
.~ (REPLState
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText)
showNewEntry :: REPLState -> REPLState
showNewEntry = (Lens' REPLState (Editor Text Name)
replPromptEditor forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Editor Text Name
newREPLEditor Text
newEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' REPLState REPLPrompt
replPromptType forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt [])
getCurrEntry :: REPLState -> Text
getCurrEntry = forall a. a -> Maybe a -> a
fromMaybe (REPLState
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replLast) forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Maybe Text
getCurrentItemText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' REPLState REPLHistory
replHistory
oldEntry :: Text
oldEntry = REPLState -> Text
getCurrEntry REPLState
repl
newEntry :: Text
newEntry = REPLState -> Text
getCurrEntry REPLState
newREPL
worldScrollDist :: Int64
worldScrollDist :: Int64
worldScrollDist = Int64
8
handleWorldEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent = \case
Key Key
k | Key
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
moveKeys -> forall {m :: * -> *}. MonadState AppState m => m () -> m ()
onlyCreative forall a b. (a -> b) -> a -> b
$ (V2 Int64 -> V2 Int64) -> EventM Name AppState ()
scrollView (forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (Int64
worldScrollDist forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Key -> V2 Int64
keyToDir Key
k))
CharKey Char
'c' -> do
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ViewCenterRule
viewCenterRule forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> ViewCenterRule
VCRobot Int
0
CharKey Char
'f' -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowFPS forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
where
onlyCreative :: m () -> m ()
onlyCreative m ()
a = do
Bool
c <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c m ()
a
moveKeys :: [Key]
moveKeys =
[ Key
V.KUp
, Key
V.KDown
, Key
V.KLeft
, Key
V.KRight
, Char -> Key
V.KChar Char
'h'
, Char -> Key
V.KChar Char
'j'
, Char -> Key
V.KChar Char
'k'
, Char -> Key
V.KChar Char
'l'
]
scrollView :: (V2 Int64 -> V2 Int64) -> EventM Name AppState ()
scrollView :: (V2 Int64 -> V2 Int64) -> EventM Name AppState ()
scrollView V2 Int64 -> V2 Int64
update = do
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
Lens' AppState GameState
gameState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (V2 Int64 -> V2 Int64) -> GameState -> GameState
modifyViewCenter V2 Int64 -> V2 Int64
update
keyToDir :: V.Key -> V2 Int64
keyToDir :: Key -> V2 Int64
keyToDir Key
V.KUp = V2 Int64
north
keyToDir Key
V.KDown = V2 Int64
south
keyToDir Key
V.KRight = V2 Int64
east
keyToDir Key
V.KLeft = V2 Int64
west
keyToDir (V.KChar Char
'h') = V2 Int64
west
keyToDir (V.KChar Char
'j') = V2 Int64
south
keyToDir (V.KChar Char
'k') = V2 Int64
north
keyToDir (V.KChar Char
'l') = V2 Int64
east
keyToDir Key
_ = forall a. a -> a -> V2 a
V2 Int64
0 Int64
0
adjustTPS :: (Int -> Int -> Int) -> AppState -> AppState
adjustTPS :: (Int -> Int -> Int) -> AppState -> AppState
adjustTPS Int -> Int -> Int
(+/-) = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
lgTicksPerSecond forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
+/- Int
1)
handleRobotPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent = \case
(Key Key
V.KEnter) ->
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe Entity
focusedEntity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n s. EventM n s ()
continueWithoutRedraw Entity -> EventM Name AppState ()
descriptionModal
(CharKey Char
'm') ->
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe Entity
focusedEntity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n s. EventM n s ()
continueWithoutRedraw Entity -> EventM Name AppState ()
makeEntity
(CharKey Char
'0') -> do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowZero forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
(CharKey Char
';') -> do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState InventorySortOptions
uiInventorySort forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= InventorySortOptions -> InventorySortOptions
cycleSortOrder
(CharKey Char
':') -> do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState InventorySortOptions
uiInventorySort forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= InventorySortOptions -> InventorySortOptions
cycleSortDirection
(VtyEvent Event
ev) -> do
Maybe (List Name InventoryListEntry)
mList <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Int, List Name InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
case Maybe (List Name InventoryListEntry)
mList of
Maybe (List Name InventoryListEntry)
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
Just List Name InventoryListEntry
l -> do
List Name InventoryListEntry
l' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name InventoryListEntry
l (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> (e -> Bool) -> EventM n (GenericList n t e) ()
handleListEventWithSeparators Event
ev (forall s t a b. APrism s t a b -> s -> Bool
is Prism' InventoryListEntry Text
_Separator))
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Int, List Name InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name InventoryListEntry
l'
BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
makeEntity :: Entity -> EventM Name AppState ()
makeEntity :: Entity -> EventM Name AppState ()
makeEntity Entity
e = do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
let mkTy :: Polytype
mkTy = Polytype
PolyUnit
mkReq :: Requirements
mkReq = Capability -> Requirements
R.singletonCap Capability
CMake
mkProg :: Term
mkProg = Term -> Term -> Term
TApp (Const -> Term
TConst Const
Make) (Text -> Term
TText (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName))
mkPT :: ProcessedTerm
mkPT = Term
-> Module Polytype Polytype
-> Requirements
-> ReqCtx
-> ProcessedTerm
ProcessedTerm Term
mkProg (forall s t. s -> Ctx t -> Module s t
Module Polytype
mkTy forall t. Ctx t
empty) Requirements
mkReq forall t. Ctx t
empty
topStore :: Store
topStore =
forall a. a -> Maybe a -> a
fromMaybe Store
emptyStore forall a b. (a -> b) -> a -> b
$
AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Store
defStore
case Robot -> Bool
isActive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot) of
Just Bool
False -> do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed forall a. Maybe a
Nothing Polytype
mkTy Requirements
mkReq)
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
mkPT forall t. Ctx t
empty Store
topStore
Lens' AppState GameState
gameState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall s a. State s a -> s -> s
execState (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m ()
activateRobot Int
0)
Maybe Bool
_ -> forall n s. EventM n s ()
continueWithoutRedraw
descriptionModal :: Entity -> EventM Name AppState ()
descriptionModal :: Entity -> EventM Name AppState ()
descriptionModal Entity
e = do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= AppState -> ModalType -> Modal
generateModal AppState
s (Entity -> ModalType
DescriptionModal Entity
e)
handleInfoPanelEvent :: ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent :: ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
vs = \case
Key Key
V.KDown -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs Int
1
Key Key
V.KUp -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs (-Int
1)
CharKey Char
'k' -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs Int
1
CharKey Char
'j' -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs (-Int
1)
Key Key
V.KPageDown -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
vs Direction
Brick.Down
Key Key
V.KPageUp -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
vs Direction
Brick.Up
Key Key
V.KHome -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll Name
vs
Key Key
V.KEnd -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
vs
BrickEvent Name AppEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()