{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Swarm.TUI.Controller (
handleEvent,
quitGame,
runFrameUI,
runFrame,
ticksPerFrameCap,
runFrameTicks,
runGameTickUI,
runGameTick,
updateUI,
runBaseWebCode,
handleREPLEvent,
validateREPLForm,
adjReplHistIndex,
TimeDir (..),
handleWorldEvent,
keyToDir,
scrollView,
adjustTPS,
handleInfoPanelEvent,
getTutorials,
) where
import Brick hiding (Direction, Location)
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.Applicative (liftA2, pure)
import Control.Carrier.Lift qualified as Fused
import Control.Carrier.State.Lazy qualified as Fused
import Control.Lens as Lens
import Control.Lens.Extras as Lens (is)
import Control.Monad (forM_, unless, void, when)
import Control.Monad.Extra (whenJust)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.State (MonadState, execState)
import Data.Bits
import Data.Either (isRight)
import Data.Foldable (toList)
import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time (getZonedTime)
import Data.Vector qualified as V
import Graphics.Vty qualified as V
import Linear
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Achievement.Persistence
import Swarm.Game.CESK (CESK (Out), Frame (FApp, FExec), cancel, emptyStore, initMachine)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Location
import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
import Swarm.Game.Robot
import Swarm.Game.ScenarioInfo
import Swarm.Game.State
import Swarm.Game.Step (finishGameTick, gameTick)
import Swarm.Language.Capability (Capability (CDebug, CMake))
import Swarm.Language.Context
import Swarm.Language.Key (KeyCombo, mkKeyCombo)
import Swarm.Language.Module
import Swarm.Language.Parse (reservedWords)
import Swarm.Language.Pipeline
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Pretty
import Swarm.Language.Requirement qualified as R
import Swarm.Language.Syntax hiding (Key)
import Swarm.Language.Typed (Typed (..))
import Swarm.Language.Types
import Swarm.Language.Value (Value (VKey, VUnit), prettyValue, stripVResult)
import Swarm.Log
import Swarm.TUI.Controller.Util
import Swarm.TUI.Editor.Controller qualified as EC
import Swarm.TUI.Editor.Model
import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder)
import Swarm.TUI.Launch.Controller
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep (prepareLaunchDialog)
import Swarm.TUI.List
import Swarm.TUI.Model
import Swarm.TUI.Model.Goal
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.StateUpdate
import Swarm.TUI.Model.UI
import Swarm.TUI.View.Objective qualified as GR
import Swarm.TUI.View.Util (generateModal)
import Swarm.Util hiding (both, (<<.=))
import Swarm.Version (NewReleaseFailure (..))
import System.Clock
import System.FilePath (splitDirectories)
import Witch (into)
import Prelude hiding (Applicative (..))
tutorialsDirname :: FilePath
tutorialsDirname :: FilePath
tutorialsDirname = FilePath
"Tutorials"
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 -> Severity -> a -> m ()
logReleaseEvent LogSource
l Severity
sev 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
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
l Severity
sev Text
"Release" (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 NewReleaseFailure
e ->
let sev :: Severity
sev = case NewReleaseFailure
e of
FailedReleaseQuery {} -> Severity
Error
OnDevelopmentBranch {} -> Severity
Info
NewReleaseFailure
_ -> Severity
Warning
in forall {m :: * -> *} {a}.
(MonadState AppState m, Show a) =>
LogSource -> Severity -> a -> m ()
logReleaseEvent LogSource
SystemLog Severity
sev 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 ->
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 LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls FileBrowserControl
fileBrowser forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileBrowserControl Bool
fbIsDisplayed
then BrickEvent Name AppEvent -> EventM Name AppState ()
handleFBEvent
else 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 LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (Maybe ScenarioInfoPair)
isDisplayedFor of
Maybe ScenarioInfoPair
Nothing -> NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent NonEmpty (List Name ScenarioItem)
l
Just ScenarioInfoPair
siPair -> ScenarioInfoPair
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleLaunchOptionsEvent ScenarioInfoPair
siPair
Menu
MessagesMenu -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent
AchievementsMenu List Name CategorizedAchievement
l -> List Name CategorizedAchievement
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainAchievementsEvent List Name CategorizedAchievement
l
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 RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState 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 (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState 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
== FilePath
tutorialsDirname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack 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 = List Name ScenarioItem
tutorialMenu forall a. a -> [a] -> NonEmpty a
:| forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
Achievements -> 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 CategorizedAchievement -> Menu
AchievementsMenu (forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
AchievementList (forall a. [a] -> Vector a
V.fromList [CategorizedAchievement]
listAchievements) Int
1)
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 -> 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 ()
.= Menu
AboutMenu
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
CategorizedAchievement -> m ()
attainAchievement forall a b. (a -> b) -> a -> b
$ GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
LookedAtAboutScreen
MainMenuEntry
Quit -> forall n s. EventM n s ()
halt
CharKey Char
'q' -> forall n s. EventM n s ()
halt
ControlChar 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
tutorialsDirname (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
sc) of
Just (SICollection Text
_ ScenarioCollection
c) -> ScenarioCollection
c
Maybe ScenarioItem
_ -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"No tutorials exist: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ScenarioCollection
sc
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
handleMainAchievementsEvent ::
BL.List Name CategorizedAchievement ->
BrickEvent Name AppEvent ->
EventM Name AppState ()
handleMainAchievementsEvent :: List Name CategorizedAchievement
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainAchievementsEvent List Name CategorizedAchievement
l BrickEvent Name AppEvent
e = case BrickEvent Name AppEvent
e of
Key Key
V.KEsc -> EventM Name AppState ()
returnToMainMenu
CharKey Char
'q' -> EventM Name AppState ()
returnToMainMenu
ControlChar Char
'q' -> EventM Name AppState ()
returnToMainMenu
VtyEvent Event
ev -> do
List Name CategorizedAchievement
l' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name CategorizedAchievement
l (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 CategorizedAchievement -> Menu
AchievementsMenu List Name CategorizedAchievement
l'
BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
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)
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
ControlChar 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 n s. Ord n => EventM n s ()
invalidateCache 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
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)
CharKey Char
'o' -> EventM Name AppState ()
showLaunchDialog
CharKey Char
'O' -> EventM Name AppState ()
showLaunchDialog
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
ControlChar 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
where
showLaunchDialog :: EventM Name AppState ()
showLaunchDialog = 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
Just (SISingle ScenarioInfoPair
siPair) -> 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 LaunchOptions
uiLaunchConfig) forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> EventM Name LaunchOptions ()
prepareLaunchDialog ScenarioInfoPair
siPair
Maybe ScenarioItem
_ -> 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
let isPaused :: Bool
isPaused = 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 TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused
let isCreative :: Bool
isCreative = 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 Bool
creativeMode
let hasDebug :: Bool
hasDebug = forall a. a -> Maybe a -> a
fromMaybe Bool
isCreative 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
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot 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
. Getter Robot (Set Capability)
robotCapabilities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
Lens.contains Capability
CDebug
case BrickEvent Name AppEvent
ev of
AppEvent AppEvent
ae -> case AppEvent
ae of
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
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused -> forall n s. EventM n s ()
continueWithoutRedraw
| Bool
otherwise -> EventM Name AppState ()
runFrameUI
Web (RunWebCode Text
c) -> forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseWebCode Text
c
AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
ControlChar 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
WinConditions (Won Bool
_) ObjectiveCompletion
_ -> ModalType -> EventM Name AppState ()
toggleModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
WinModal
WinConditions (Unwinnable Bool
_) ObjectiveCompletion
_ -> ModalType -> EventM Name AppState ()
toggleModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
LoseModal
WinCondition
_ -> ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
VtyEvent (V.EvResize Int
_ Int
_) -> forall n s. Ord n => EventM n s ()
invalidateCache
Key Key
V.KEsc
| 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
case Modal
m forall s a. s -> Getting a s a -> a
^. Lens' Modal ModalType
modalType of
ModalType
MessagesModal -> do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages TickNumber
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 TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
ModalType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (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 Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (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 Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (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 Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (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 Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages TickNumber
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 TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
ControlChar Char
'g' ->
if GoalTracking -> Bool
hasAnythingToShow forall a b. (a -> b) -> a -> b
$ 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 GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay GoalTracking
goalsContent
then ModalType -> EventM Name AppState ()
toggleModal ModalType
GoalModal
else forall n s. EventM n s ()
continueWithoutRedraw
MetaChar 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
MetaChar Char
'd' | Bool
isPaused Bool -> Bool -> Bool
&& Bool
hasDebug -> do
Bool
debug <- Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowDebug forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
Lens.<%= Bool -> Bool
not
if Bool
debug
then Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SingleStep -> Step
RobotStep SingleStep
SBefore
else forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
finishGameTick 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
ControlChar Char
'p' | Bool
isRunning -> EventM Name AppState ()
safeTogglePause
ControlChar Char
'o' | Bool
isRunning -> do
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
ManualPause
EventM Name AppState ()
runGameTickUI
ControlChar 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
(+)
ControlChar 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 (-)
MetaChar Char
'w' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
WorldPanel
MetaChar Char
'e' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
RobotPanel
MetaChar Char
'r' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
REPLPanel
MetaChar Char
't' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
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
MouseDown (TerrainListItem Int
pos) Button
V.BLeft [Modifier]
_ Location
_ ->
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n TerrainType)
terrainList 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
MouseDown (EntityPaintListItem Int
pos) Button
V.BLeft [Modifier]
_ Location
_ ->
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n EntityFacade)
entityPaintList 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
ControlChar 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
ControlChar Char
'e'
| 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 -> do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WorldOverdraw Bool
isWorldEditorEnabled forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
WorldEditorPanel
MouseDown Name
WorldPositionIndicator Button
_ [Modifier]
_ Location
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Cosmic Coords))
uiWorldCursor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BMiddle [Modifier]
_ Location
mouseLoc ->
Location -> EventM Name AppState ()
EC.handleMiddleClick Location
mouseLoc
MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BRight [Modifier]
_ Location
mouseLoc ->
Location -> EventM Name AppState ()
EC.handleRightClick Location
mouseLoc
MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BLeft [Modifier
V.MCtrl] Location
mouseLoc ->
Location -> EventM Name AppState ()
EC.handleCtrlLeftClick Location
mouseLoc
MetaChar Char
',' -> do
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowREPL 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
FocusablePanel FocusablePanel
WorldPanel -> do
Maybe (Cosmic 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 forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
Bool
shouldUpdateCursor <- Maybe (Cosmic Coords) -> EventM Name AppState Bool
EC.updateAreaBounds Maybe (Cosmic Coords)
mouseCoordsM
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdateCursor forall a b. (a -> b) -> a -> b
$
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Cosmic Coords))
uiWorldCursor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Cosmic Coords)
mouseCoordsM
Name
REPLInput -> 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, GenericList Name Vector 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
x :: Name
x@(WorldEditorPanelControl WorldEditorFocusable
y) -> do
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (FocusRing n)
editorFocusRing 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
x
WorldEditorFocusable -> EventM Name AppState ()
EC.activateWorldEditorFunction WorldEditorFocusable
y
Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust FocusablePanel -> EventM Name AppState ()
setFocus forall a b. (a -> b) -> a -> b
$ case Name
n of
Name
InventoryList -> forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
InventoryListItem Int
_ -> forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
Name
InfoViewport -> forall a. a -> Maybe a
Just FocusablePanel
InfoPanel
Name
REPLInput -> forall a. a -> Maybe a
Just FocusablePanel
REPLPanel
WorldEditorPanelControl WorldEditorFocusable
_ -> forall a. a -> Maybe a
Just FocusablePanel
WorldEditorPanel
Name
_ -> forall a. Maybe a
Nothing
case Name
n of
FocusablePanel FocusablePanel
x -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
x
Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 (FocusablePanel FocusablePanel
x) -> (forall a b. (a -> b) -> a -> b
$ BrickEvent Name AppEvent
ev) forall a b. (a -> b) -> a -> b
$ case FocusablePanel
x of
FocusablePanel
REPLPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent
FocusablePanel
WorldPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent
FocusablePanel
WorldEditorPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
EC.handleWorldEditorPanelEvent
FocusablePanel
RobotPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent
FocusablePanel
InfoPanel -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
infoScroll
Maybe Name
_ -> forall n s. EventM n s ()
continueWithoutRedraw
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 UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowDebug forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
RunStatus
p <- Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RunStatus
runStatus forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
Lens.<%= RunStatus -> RunStatus
toggleRunStatus
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
p forall a. Eq a => a -> a -> Bool
== RunStatus
Running) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
finishGameTick
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 TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState 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 -> ModalType -> EventM Name AppState ()
openModal ModalType
mt
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
handleModalEvent :: V.Event -> EventM Name AppState ()
handleModalEvent :: Event -> EventM Name AppState ()
handleModalEvent = \case
V.EvKey Key
V.KEnter [] -> do
Maybe (Dialog ButtonAction Name)
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 ButtonAction Name)
modalDialog
ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
case forall n a. Eq n => Dialog a n -> Maybe (n, a)
dialogSelection forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Dialog ButtonAction Name)
mdialog of
Just (Button Button
QuitButton, ButtonAction
_) -> EventM Name AppState ()
quitGame
Just (Button Button
KeepPlayingButton, ButtonAction
_) -> ModalType -> EventM Name AppState ()
toggleModal ModalType
KeepPlayingModal
Just (Button Button
StartOverButton, StartOver Int
currentSeed ScenarioInfoPair
siPair) -> do
forall n s. Ord n => EventM n s ()
invalidateCache
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Int -> ScenarioInfoPair -> m ()
restartGame Int
currentSeed ScenarioInfoPair
siPair
Just (Button Button
NextButton, Next ScenarioInfoPair
siPair) -> do
EventM Name AppState ()
quitGame
forall n s. Ord n => EventM n s ()
invalidateCache
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair forall a. Maybe a
Nothing
Maybe (Name, ButtonAction)
_ -> 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 ButtonAction Name)
modalDialog) (forall n a. Event -> EventM n (Dialog a n) ()
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
TerrainPaletteModal ->
forall {t :: * -> *} {n} {t} {e}.
(Foldable t, Splittable t, Ord n) =>
LensLike'
(Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
-> EventM n t ()
refreshList forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n TerrainType)
terrainList
Just ModalType
EntityPaletteModal -> do
forall {t :: * -> *} {n} {t} {e}.
(Foldable t, Splittable t, Ord n) =>
LensLike'
(Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
-> EventM n t ()
refreshList forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n EntityFacade)
entityPaintList
Just ModalType
GoalModal -> case Event
ev of
V.EvKey (V.KChar Char
'\t') [] -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (FocusRing Name)
focus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
Event
_ -> do
FocusRing Name
focused <- 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 GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (FocusRing Name)
focus
case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focused of
Just (GoalWidgets GoalWidget
w) -> case GoalWidget
w of
GoalWidget
ObjectivesList -> do
List Name GoalEntry
lw <- 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 GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (List Name GoalEntry)
listWidget
List Name GoalEntry
newList <- forall {t :: * -> *} {n} {s}.
(Foldable t, Splittable t, Ord n, Searchable t) =>
GenericList n t GoalEntry -> EventM n s (GenericList n t GoalEntry)
refreshGoalList List Name GoalEntry
lw
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (List Name GoalEntry)
listWidget forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name GoalEntry
newList
GoalWidget
GoalSummary -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
Maybe Name
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
Maybe ModalType
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
where
refreshGoalList :: GenericList n t GoalEntry -> EventM n s (GenericList n t GoalEntry)
refreshGoalList GenericList n t GoalEntry
lw = forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList n t GoalEntry
lw forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n, Searchable t) =>
Event -> (e -> Bool) -> EventM n (GenericList n t e) ()
handleListEventWithSeparators Event
ev GoalEntry -> Bool
shouldSkipSelection
refreshList :: LensLike'
(Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
-> EventM n t ()
refreshList LensLike'
(Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
z = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom LensLike'
(Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
z forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
BL.handleListEvent Event
ev
getNormalizedCurrentScenarioPath :: (MonadIO m, MonadState AppState m) => m (Maybe FilePath)
getNormalizedCurrentScenarioPath :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
m (Maybe FilePath)
getNormalizedCurrentScenarioPath =
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 (Maybe FilePath)
currentScenarioPath) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
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 RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState ScenarioCollection
scenarios
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *).
MonadIO m =>
ScenarioCollection -> FilePath -> m FilePath
normalizeScenarioPath ScenarioCollection
gs FilePath
p')
saveScenarioInfoOnFinish :: (MonadIO m, MonadState AppState m) => FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish FilePath
p = do
Maybe ProcessedTerm
initialRunCode <- 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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe ProcessedTerm)
initiallyRunCode
ZonedTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
WinCondition
wc <- 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 WinCondition
winCondition
let won :: Bool
won = case WinCondition
wc of
WinConditions (Won Bool
_) ObjectiveCompletion
_ -> Bool
True
WinCondition
_ -> Bool
False
TickNumber
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 TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
let currentScenarioInfo :: Traversal' AppState ScenarioInfo
currentScenarioInfo :: Traversal' AppState ScenarioInfo
currentScenarioInfo = Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState 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
REPLHistory
replHist <- 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 determinator :: CodeSizeDeterminators
determinator = Maybe ProcessedTerm -> Bool -> CodeSizeDeterminators
CodeSizeDeterminators Maybe ProcessedTerm
initialRunCode forall a b. (a -> b) -> a -> b
$ REPLHistory
replHist forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Bool
replHasExecutedManualInput
Traversal' AppState ScenarioInfo
currentScenarioInfo
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CodeSizeDeterminators
-> ZonedTime -> TickNumber -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnFinish CodeSizeDeterminators
determinator ZonedTime
t TickNumber
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 -> do
let segments :: [FilePath]
segments = FilePath -> [FilePath]
splitDirectories FilePath
p
case [FilePath]
segments of
FilePath
firstDir : [FilePath]
_ -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
won Bool -> Bool -> Bool
&& FilePath
firstDir forall a. Eq a => a -> a -> Bool
== FilePath
tutorialsDirname) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ZonedTime -> Maybe FilePath -> CategorizedAchievement -> m ()
attainAchievement' ZonedTime
t (forall a. a -> Maybe a
Just FilePath
p) (GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
CompletedSingleTutorial)
[FilePath]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
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
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ScenarioInfo
status
saveScenarioInfoOnFinishNocheat :: (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat :: forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat = 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
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
m (Maybe FilePath)
getNormalizedCurrentScenarioPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
p -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish FilePath
p
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
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
m (Maybe FilePath)
getNormalizedCurrentScenarioPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
p -> do
Maybe ScenarioInfo
maybeSi <- forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish FilePath
p
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
Maybe ScenarioInfo
maybeSi
( 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 s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
)
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 RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState 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
WinCondition
wc <- 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 WinCondition
winCondition
case WinCondition
wc of
WinConditions (Won Bool
_) ObjectiveCompletion
_ -> 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
WinCondition
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 a
zoomGameState :: forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
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', a
a) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a. LiftC m a -> m a
Fused.runM (forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState 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'
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
updateAchievements :: EventM Name AppState ()
updateAchievements :: EventM Name AppState ()
updateAchievements = do
Map GameplayAchievement Attainment
achievementsFromGame <- 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 Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Map GameplayAchievement Attainment)
gameAchievements
let wrappedGameAchievements :: Map CategorizedAchievement Attainment
wrappedGameAchievements = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys GameplayAchievement -> CategorizedAchievement
GameplayAchievement Map GameplayAchievement Attainment
achievementsFromGame
Map CategorizedAchievement Attainment
oldMasterAchievementsList <- 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 (Map CategorizedAchievement Attainment)
uiAchievements
Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Map CategorizedAchievement Attainment)
uiAchievements forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map CategorizedAchievement Attainment
wrappedGameAchievements
let incrementalAchievements :: Map CategorizedAchievement Attainment
incrementalAchievements = Map CategorizedAchievement Attainment
wrappedGameAchievements forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map CategorizedAchievement Attainment
oldMasterAchievementsList
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map CategorizedAchievement Attainment
incrementalAchievements) forall a b. (a -> b) -> a -> b
$ do
Map CategorizedAchievement Attainment
newAchievements <- 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 (Map CategorizedAchievement Attainment)
uiAchievements
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Attainment] -> IO ()
saveAchievementsInfo forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map CategorizedAchievement Attainment
newAchievements
runGameTick :: EventM Name AppState ()
runGameTick :: EventM Name AppState ()
runGameTick = do
Bool
ticked <- forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m Bool
gameTick
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ticked EventM Name AppState ()
updateAchievements
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, GenericList Name Vector 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)
Maybe RobotRange
dist <- 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 RobotRange
focusedRange)
Bool
farOK <- forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (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 Bool
creativeMode)) (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 Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable))
let tooFar :: Bool
tooFar = Bool -> Bool
not Bool
farOK Bool -> Bool -> Bool
&& Maybe RobotRange
dist forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just RobotRange
Far
farChanged :: Bool
farChanged = Bool
tooFar forall a. Eq a => a -> a -> Bool
/= forall a. Maybe a -> Bool
isNothing Maybe Int
listRobotHash
Bool
inventoryUpdated <-
if Bool
farChanged Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
farChanged Bool -> Bool -> Bool
&& 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 (if Bool
tooFar then forall a. Maybe a
Nothing else 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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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 -> Value
stripVResult 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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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)
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
replScroll
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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
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
let sticky :: Bool
sticky = forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusablePanel -> Name
FocusablePanel) [FocusablePanel
RobotPanel, FocusablePanel
InfoPanel]
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 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sticky 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 a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
clearFocusedRobotLogUpdated
let isLogger :: InventoryListEntry -> Bool
isLogger (EquippedEntry 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, GenericList Name Vector 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
goalOrWinUpdated <- EventM Name AppState Bool
doGoalUpdates
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
goalOrWinUpdated
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
redraw
doGoalUpdates :: EventM Name AppState Bool
doGoalUpdates :: EventM Name AppState Bool
doGoalUpdates = do
GoalTracking
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 GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay GoalTracking
goalsContent)
Bool
isCheating <- 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
uiCheatMode)
WinCondition
curWinCondition <- 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)
Seq Announcement
announcementsSeq <- 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 Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq Announcement)
announcementQueue)
let announcementsList :: [Announcement]
announcementsList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Announcement
announcementsSeq
case WinCondition
curWinCondition of
WinCondition
NoWinCondition -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
WinConditions (Unwinnable Bool
False) ObjectiveCompletion
x -> 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 ()
.= WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions (Bool -> WinStatus
Unwinnable Bool
True) ObjectiveCompletion
x
ModalType -> EventM Name AppState ()
openModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
LoseModal
forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
WinConditions (Won Bool
False) ObjectiveCompletion
x -> 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 ()
.= WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions (Bool -> WinStatus
Won Bool
True) ObjectiveCompletion
x
ModalType -> EventM Name AppState ()
openModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
WinModal
forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
WinConditions WinStatus
_ ObjectiveCompletion
oc -> do
let newGoalTracking :: GoalTracking
newGoalTracking = [Announcement] -> CategorizedGoals -> GoalTracking
GoalTracking [Announcement]
announcementsList forall a b. (a -> b) -> a -> b
$ Bool -> ObjectiveCompletion -> CategorizedGoals
constructGoalMap Bool
isCheating ObjectiveCompletion
oc
isFirstGoalDisplay :: Bool
isFirstGoalDisplay = GoalTracking -> Bool
hasAnythingToShow GoalTracking
newGoalTracking Bool -> Bool -> Bool
&& Bool -> Bool
not (GoalTracking -> Bool
hasAnythingToShow GoalTracking
curGoal)
goalWasUpdated :: Bool
goalWasUpdated = Bool
isFirstGoalDisplay Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Announcement]
announcementsList)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
goalWasUpdated forall a b. (a -> b) -> a -> b
$ do
let hasMultiple :: Bool
hasMultiple = GoalTracking -> Bool
hasMultipleGoals GoalTracking
newGoalTracking
defaultFocus :: GoalWidget
defaultFocus =
if Bool
hasMultiple
then GoalWidget
ObjectivesList
else GoalWidget
GoalSummary
ring :: FocusRing Name
ring =
forall n. [n] -> FocusRing n
focusRing forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map GoalWidget -> Name
GoalWidgets forall a b. (a -> b) -> a -> b
$
if Bool
hasMultiple
then forall e. (Enum e, Bounded e) => [e]
listEnums
else [GoalWidget
GoalSummary]
Lens' AppState UIState
uiState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GoalTracking
-> List Name GoalEntry -> FocusRing Name -> GoalDisplay
GoalDisplay
GoalTracking
newGoalTracking
(GoalTracking -> List Name GoalEntry
GR.makeListWidget GoalTracking
newGoalTracking)
(forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (GoalWidget -> Name
GoalWidgets GoalWidget
defaultFocus) FocusRing Name
ring)
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq Announcement)
announcementQueue forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Monoid a => a
mempty
Bool
hideGoals <- 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
uiHideGoals
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hideGoals forall a b. (a -> b) -> a -> b
$
ModalType -> EventM Name AppState ()
openModal ModalType
GoalModal
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
goalWasUpdated
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
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
x = do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
let theRepl :: REPLState
theRepl = 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
controlMode :: ReplControlMode
controlMode = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState ReplControlMode
replControlMode
uinput :: Text
uinput = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText
case BrickEvent Name AppEvent
x of
ControlChar 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 []
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 forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
""
MetaChar Char
'p' ->
forall (m :: * -> *). MonadState AppState m => m () -> m ()
onlyCreative forall a b. (a -> b) -> a -> b
$ do
ReplControlMode
curMode <- 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 ReplControlMode
replControlMode
case ReplControlMode
curMode of
ReplControlMode
Piloting -> 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 ReplControlMode
replControlMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ReplControlMode
Typing
ReplControlMode
_ ->
if Text -> Bool
T.null Text
uinput
then 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 ReplControlMode
replControlMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ReplControlMode
Piloting
else do
let err :: REPLHistItem
err = Text -> REPLHistItem
REPLError Text
"Please clear the REPL before engaging pilot mode."
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 REPLHistItem
err
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache
MetaChar Char
'k' -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust (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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe (Text, Value))
inputHandler)) forall a b. (a -> b) -> a -> b
$ do
ReplControlMode
curMode <- 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 ReplControlMode
replControlMode
(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 ReplControlMode
replControlMode) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case ReplControlMode
curMode of ReplControlMode
Handling -> ReplControlMode
Typing; ReplControlMode
_ -> ReplControlMode
Handling
BrickEvent Name AppEvent
_ -> case ReplControlMode
controlMode of
ReplControlMode
Typing -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping BrickEvent Name AppEvent
x
ReplControlMode
Piloting -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting BrickEvent Name AppEvent
x
ReplControlMode
Handling -> case BrickEvent Name AppEvent
x of
VtyEvent (V.EvKey Key
k [Modifier]
mods) -> KeyCombo -> EventM Name AppState ()
runInputHandler ([Modifier] -> Key -> KeyCombo
mkKeyCombo [Modifier]
mods Key
k)
BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping BrickEvent Name AppEvent
x
runInputHandler :: KeyCombo -> EventM Name AppState ()
runInputHandler :: KeyCombo -> EventM Name AppState ()
runInputHandler KeyCombo
kc = do
Maybe (Text, Value)
mhandler <- 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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe (Text, Value))
inputHandler
case Maybe (Text, Value)
mhandler of
Maybe (Text, Value)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Text
_, Value
handler) -> do
Bool
working <- 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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameControls Bool
replWorking
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
working forall a b. (a -> b) -> a -> b
$ do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
let topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s
handlerCESK :: CESK
handlerCESK = Value -> Store -> Cont -> CESK
Out (KeyCombo -> Value
VKey KeyCombo
kc) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Store
defStore) [Value -> Frame
FApp Value
handler, Frame
FExec]
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 ()
.= CESK
handlerCESK
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)
handleREPLEventPiloting :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting BrickEvent Name AppEvent
x = case BrickEvent Name AppEvent
x of
Key Key
V.KUp -> Text -> EventM Name AppState ()
inputCmd Text
"move"
Key Key
V.KDown -> Text -> EventM Name AppState ()
inputCmd Text
"turn back"
Key Key
V.KLeft -> Text -> EventM Name AppState ()
inputCmd Text
"turn left"
Key Key
V.KRight -> Text -> EventM Name AppState ()
inputCmd Text
"turn right"
ShiftKey Key
V.KUp -> Text -> EventM Name AppState ()
inputCmd Text
"turn north"
ShiftKey Key
V.KDown -> Text -> EventM Name AppState ()
inputCmd Text
"turn south"
ShiftKey Key
V.KLeft -> Text -> EventM Name AppState ()
inputCmd Text
"turn west"
ShiftKey Key
V.KRight -> Text -> EventM Name AppState ()
inputCmd Text
"turn east"
Key Key
V.KDel -> Text -> EventM Name AppState ()
inputCmd Text
"selfdestruct"
CharKey Char
'g' -> Text -> EventM Name AppState ()
inputCmd Text
"grab"
CharKey Char
'h' -> Text -> EventM Name AppState ()
inputCmd Text
"harvest"
CharKey Char
'd' -> Text -> EventM Name AppState ()
inputCmd Text
"drill forward"
CharKey Char
'x' -> Text -> EventM Name AppState ()
inputCmd Text
"drill down"
CharKey Char
's' -> Text -> EventM Name AppState ()
inputCmd Text
"scan forward"
CharKey Char
'b' -> Text -> EventM Name AppState ()
inputCmd Text
"blocked"
CharKey Char
'u' -> Text -> EventM Name AppState ()
inputCmd Text
"upload base"
CharKey Char
'p' -> Text -> EventM Name AppState ()
inputCmd Text
"push"
BrickEvent Name AppEvent
_ -> Text -> EventM Name AppState ()
inputCmd Text
"noop"
where
inputCmd :: Text -> EventM Name AppState ()
inputCmd Text
cmdText = do
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 -> REPLState -> REPLState
setCmd (Text
cmdText forall a. Semigroup a => a -> a -> a
<> Text
";")
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping forall a b. (a -> b) -> a -> b
$ forall n e. Key -> BrickEvent n e
Key Key
V.KEnter
setCmd :: Text -> REPLState -> REPLState
setCmd Text
nt REPLState
theRepl =
REPLState
theRepl
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 []
runBaseWebCode :: (MonadState AppState m) => T.Text -> m ()
runBaseWebCode :: forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseWebCode Text
uinput = do
AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
let topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameControls Bool
replWorking) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Text -> m ()
runBaseCode RobotContext
topCtx Text
uinput
runBaseCode :: (MonadState AppState m) => RobotContext -> T.Text -> m ()
runBaseCode :: forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Text -> m ()
runBaseCode RobotContext
topCtx Text
uinput = do
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)
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 [])
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 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLHistory Bool
replHasExecutedManualInput forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Maybe ProcessedTerm -> m ()
runBaseTerm RobotContext
topCtx Maybe ProcessedTerm
mt
Left Text
err -> do
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
REPLError Text
err)
runBaseTerm :: (MonadState AppState m) => RobotContext -> Maybe ProcessedTerm -> m ()
runBaseTerm :: forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Maybe ProcessedTerm -> m ()
runBaseTerm RobotContext
topCtx =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ProcessedTerm -> AppState -> AppState
startBaseProgram
where
startBaseProgram :: ProcessedTerm -> AppState -> AppState
startBaseProgram t :: ProcessedTerm
t@(ProcessedTerm (Module Syntax' Polytype
tm TCtx
_) Requirements
reqs ReqCtx
reqCtx) =
(Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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 (Syntax' Polytype
tm forall s a. s -> Getting a s a -> a
^. forall ty. Lens' (Syntax' ty) ty
sType) 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 RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ ReqCtx
reqCtx)
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))
handleREPLEventTyping :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping = \case
Key Key
V.KPageUp -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
replScroll Direction
Brick.Up
Key Key
V.KPageDown -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
replScroll Direction
Brick.Down
BrickEvent Name AppEvent
k -> do
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
replScroll
case BrickEvent Name AppEvent
k of
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
theRepl :: REPLState
theRepl = 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
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText
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
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameControls Bool
replWorking
then case REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLPrompt
replPromptType of
CmdPrompt [Text]
_ -> do
forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Text -> m ()
runBaseCode RobotContext
topCtx Text
uinput
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache
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
ControlChar 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 Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape 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 [])
ControlChar 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
theRepl = case REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLPrompt
replPromptType of
SearchPrompt REPLHistory
_ -> REPLState
theRepl
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
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText
setCmd :: Text -> [Text] -> REPLState
setCmd Text
nt [Text]
ms =
REPLState
theRepl
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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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 (Module Syntax' Polytype
tm TCtx
_) Requirements
_ ReqCtx
_)) -> forall a. a -> Maybe a
Just (Syntax' Polytype
tm forall s a. s -> Getting a s a -> a
^. forall ty. Lens' (Syntax' ty) ty
sType)
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
theRepl =
REPLState
newREPL
forall a b. a -> (a -> b) -> b
& (if REPLHistory -> Bool
replIndexIsAtInput (REPLState
theRepl 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
theRepl 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
theRepl 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
theRepl 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
theRepl
newEntry :: Text
newEntry = REPLState -> Text
getCurrEntry REPLState
newREPL
worldScrollDist :: Int32
worldScrollDist :: Int32
worldScrollDist = Int32
8
onlyCreative :: (MonadState AppState m) => m () -> m ()
onlyCreative :: forall (m :: * -> *). MonadState AppState m => 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
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 -> 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
Bool
s <- 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 Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
c Bool -> Bool -> Bool
|| Bool
s) forall a b. (a -> b) -> a -> b
$ (Location -> Location) -> EventM Name AppState ()
scrollView (forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Int32
worldScrollDist forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Key -> V2 Int32
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
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 :: (Location -> Location) -> EventM Name AppState ()
scrollView :: (Location -> Location) -> EventM Name AppState ()
scrollView Location -> Location
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 ()
%= (Cosmic Location -> Cosmic Location) -> GameState -> GameState
modifyViewCenter (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> Location
update)
keyToDir :: V.Key -> Heading
keyToDir :: Key -> V2 Int32
keyToDir Key
V.KUp = V2 Int32
north
keyToDir Key
V.KDown = V2 Int32
south
keyToDir Key
V.KRight = V2 Int32
east
keyToDir Key
V.KLeft = V2 Int32
west
keyToDir (V.KChar Char
'h') = V2 Int32
west
keyToDir (V.KChar Char
'j') = V2 Int32
south
keyToDir (V.KChar Char
'k') = V2 Int32
north
keyToDir (V.KChar Char
'l') = V2 Int32
east
keyToDir Key
_ = forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
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 BrickEvent Name AppEvent
bev = do
Maybe Text
search <- 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)
uiInventorySearch)
case Maybe Text
search of
Just Text
_ -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent BrickEvent Name AppEvent
bev
Maybe Text
Nothing -> case BrickEvent Name AppEvent
bev of
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
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 (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Text
""
VtyEvent Event
ev -> Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev
BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
handleInventoryListEvent :: V.Event -> EventM Name AppState ()
handleInventoryListEvent :: Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev = do
Maybe (GenericList Name Vector 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, GenericList Name Vector 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 (GenericList Name Vector InventoryListEntry)
mList of
Maybe (GenericList Name Vector InventoryListEntry)
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
Just GenericList Name Vector InventoryListEntry
l -> do
GenericList Name Vector InventoryListEntry
l' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector InventoryListEntry
l (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n, Searchable t) =>
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, GenericList Name Vector 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 ()
.= GenericList Name Vector InventoryListEntry
l'
handleInventorySearchEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent = \case
BrickEvent Name AppEvent
EscapeKey -> 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 (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
Key Key
V.KEnter -> 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 (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
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
c -> 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 (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. Snoc s s a a => s -> a -> s
`snoc` Char
c)
BrickEvent Name AppEvent
BackspaceKey -> 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 (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.dropEnd Int
1)
VtyEvent Event
ev -> Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev
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 name :: Text
name = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName
mkPT :: ProcessedTerm
mkPT = [tmQ| make $str:name |]
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 GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls 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
PolyUnit (Capability -> Requirements
R.singletonCap Capability
CMake))
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 ()