{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.TUI.Model (
AppEvent (..),
Name (..),
ModalType (..),
ButtonSelection (..),
Modal (..),
modalType,
modalDialog,
MainMenuEntry (..),
mainMenu,
Menu (..),
_NewGameMenu,
mkScenarioList,
mkNewGameMenu,
REPLHistItem (..),
replItemText,
isREPLEntry,
getREPLEntry,
REPLHistory,
replIndex,
replLength,
replSeq,
newREPLHistory,
addREPLItem,
restartREPLHistory,
getLatestREPLHistoryItems,
moveReplHistIndex,
getCurrentItemText,
replIndexIsAtInput,
TimeDir (..),
REPLPrompt (..),
removeEntry,
InventoryListEntry (..),
_Separator,
_InventoryEntry,
_InstalledEntry,
UIState,
uiMenu,
uiPlaying,
uiCheatMode,
uiFocusRing,
uiWorldCursor,
uiREPL,
uiInventory,
uiInventorySort,
uiMoreInfoTop,
uiMoreInfoBot,
uiScrollToEnd,
uiError,
uiModal,
uiGoal,
lgTicksPerSecond,
lastFrameTime,
accumulatedTime,
tickCount,
frameCount,
frameTickCount,
lastInfoTime,
uiShowFPS,
uiShowZero,
uiShowRobots,
uiHideRobotsUntil,
uiInventoryShouldUpdate,
uiTPF,
uiFPS,
scenarioRef,
appData,
REPLState,
replPromptType,
replPromptEditor,
replPromptText,
replValid,
replLast,
replType,
replHistory,
newREPLEditor,
initFocusRing,
defaultPrompt,
initREPLState,
initLgTicksPerSecond,
initUIState,
lastEntry,
populateInventoryList,
infoScroll,
modalScroll,
RuntimeState,
webPort,
upstreamRelease,
eventLog,
logEvent,
AppState,
gameState,
uiState,
runtimeState,
AppOpts (..),
initAppState,
startGame,
restartGame,
scenarioToAppState,
Seed,
topContext,
focusedItem,
focusedEntity,
nextScenario,
initRuntimeState,
) where
import Brick
import Brick.Focus
import Brick.Widgets.Dialog (Dialog)
import Brick.Widgets.Edit (Editor, applyEdit, editorText, getEditContents)
import Brick.Widgets.List qualified as BL
import Control.Applicative (Applicative (liftA2), (<|>))
import Control.Lens hiding (from, (<.>))
import Control.Monad.Except
import Control.Monad.State
import Data.Bits (FiniteBits (finiteBitSize))
import Data.Foldable (toList)
import Data.List (findIndex)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Zipper qualified as TZ
import Data.Time (getZonedTime)
import Data.Vector qualified as V
import GitHash (GitInfo)
import Linear (zero)
import Network.Wai.Handler.Warp (Port)
import Swarm.Game.Entity as E
import Swarm.Game.Robot
import Swarm.Game.Scenario (loadScenario)
import Swarm.Game.ScenarioInfo (
ScenarioCollection,
ScenarioInfo (..),
ScenarioInfoPair,
ScenarioItem (..),
ScenarioStatus (..),
normalizeScenarioPath,
scMap,
scenarioCollectionToList,
scenarioItemByPath,
scenarioPath,
scenarioSolution,
scenarioStatus,
_SISingle,
)
import Swarm.Game.State
import Swarm.Game.World qualified as W
import Swarm.Language.Types
import Swarm.TUI.Inventory.Sorting
import Swarm.Util
import Swarm.Version (NewReleaseFailure (NoMainUpstreamRelease))
import System.Clock
import System.FilePath (dropTrailingPathSeparator, splitPath, takeFileName)
import Witch (into)
data AppEvent
= Frame
| UpstreamVersion (Either NewReleaseFailure String)
deriving (Int -> AppEvent -> ShowS
[AppEvent] -> ShowS
AppEvent -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AppEvent] -> ShowS
$cshowList :: [AppEvent] -> ShowS
show :: AppEvent -> FilePath
$cshow :: AppEvent -> FilePath
showsPrec :: Int -> AppEvent -> ShowS
$cshowsPrec :: Int -> AppEvent -> ShowS
Show)
data Name
=
REPLPanel
|
WorldPanel
|
RobotPanel
|
InfoPanel
|
REPLInput
|
WorldCache
|
WorldExtent
|
InventoryList
|
InventoryListItem Int
|
|
ScenarioList
|
InfoViewport
|
ModalViewport
deriving (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> FilePath
$cshow :: Name -> FilePath
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Name]
$creadListPrec :: ReadPrec [Name]
readPrec :: ReadPrec Name
$creadPrec :: ReadPrec Name
readList :: ReadS [Name]
$creadList :: ReadS [Name]
readsPrec :: Int -> ReadS Name
$creadsPrec :: Int -> ReadS Name
Read)
infoScroll :: ViewportScroll Name
infoScroll :: ViewportScroll Name
infoScroll = forall n. n -> ViewportScroll n
viewportScroll Name
InfoViewport
modalScroll :: ViewportScroll Name
modalScroll :: ViewportScroll Name
modalScroll = forall n. n -> ViewportScroll n
viewportScroll Name
ModalViewport
data REPLHistItem
=
REPLEntry Text
|
REPLOutput Text
deriving (REPLHistItem -> REPLHistItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: REPLHistItem -> REPLHistItem -> Bool
$c/= :: REPLHistItem -> REPLHistItem -> Bool
== :: REPLHistItem -> REPLHistItem -> Bool
$c== :: REPLHistItem -> REPLHistItem -> Bool
Eq, Eq REPLHistItem
REPLHistItem -> REPLHistItem -> Bool
REPLHistItem -> REPLHistItem -> Ordering
REPLHistItem -> REPLHistItem -> REPLHistItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: REPLHistItem -> REPLHistItem -> REPLHistItem
$cmin :: REPLHistItem -> REPLHistItem -> REPLHistItem
max :: REPLHistItem -> REPLHistItem -> REPLHistItem
$cmax :: REPLHistItem -> REPLHistItem -> REPLHistItem
>= :: REPLHistItem -> REPLHistItem -> Bool
$c>= :: REPLHistItem -> REPLHistItem -> Bool
> :: REPLHistItem -> REPLHistItem -> Bool
$c> :: REPLHistItem -> REPLHistItem -> Bool
<= :: REPLHistItem -> REPLHistItem -> Bool
$c<= :: REPLHistItem -> REPLHistItem -> Bool
< :: REPLHistItem -> REPLHistItem -> Bool
$c< :: REPLHistItem -> REPLHistItem -> Bool
compare :: REPLHistItem -> REPLHistItem -> Ordering
$ccompare :: REPLHistItem -> REPLHistItem -> Ordering
Ord, Int -> REPLHistItem -> ShowS
[REPLHistItem] -> ShowS
REPLHistItem -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [REPLHistItem] -> ShowS
$cshowList :: [REPLHistItem] -> ShowS
show :: REPLHistItem -> FilePath
$cshow :: REPLHistItem -> FilePath
showsPrec :: Int -> REPLHistItem -> ShowS
$cshowsPrec :: Int -> REPLHistItem -> ShowS
Show, ReadPrec [REPLHistItem]
ReadPrec REPLHistItem
Int -> ReadS REPLHistItem
ReadS [REPLHistItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [REPLHistItem]
$creadListPrec :: ReadPrec [REPLHistItem]
readPrec :: ReadPrec REPLHistItem
$creadPrec :: ReadPrec REPLHistItem
readList :: ReadS [REPLHistItem]
$creadList :: ReadS [REPLHistItem]
readsPrec :: Int -> ReadS REPLHistItem
$creadsPrec :: Int -> ReadS REPLHistItem
Read)
getREPLEntry :: REPLHistItem -> Maybe Text
getREPLEntry :: REPLHistItem -> Maybe Text
getREPLEntry = \case
REPLEntry Text
t -> forall a. a -> Maybe a
Just Text
t
REPLHistItem
_ -> forall a. Maybe a
Nothing
isREPLEntry :: REPLHistItem -> Bool
isREPLEntry :: REPLHistItem -> Bool
isREPLEntry = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistItem -> Maybe Text
getREPLEntry
replItemText :: REPLHistItem -> Text
replItemText :: REPLHistItem -> Text
replItemText = \case
REPLEntry Text
t -> Text
t
REPLOutput Text
t -> Text
t
data REPLHistory = REPLHistory
{ REPLHistory -> Seq REPLHistItem
_replSeq :: Seq REPLHistItem
, REPLHistory -> Int
_replIndex :: Int
, REPLHistory -> Int
_replStart :: Int
}
makeLensesWith (lensRules & generateSignatures .~ False) ''REPLHistory
replSeq :: Lens' REPLHistory (Seq REPLHistItem)
replIndex :: Lens' REPLHistory Int
replStart :: Lens' REPLHistory Int
newREPLHistory :: [REPLHistItem] -> REPLHistory
newREPLHistory :: [REPLHistItem] -> REPLHistory
newREPLHistory [REPLHistItem]
xs =
let s :: Seq REPLHistItem
s = forall a. [a] -> Seq a
Seq.fromList [REPLHistItem]
xs
in REPLHistory
{ _replSeq :: Seq REPLHistItem
_replSeq = Seq REPLHistItem
s
, _replStart :: Int
_replStart = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq REPLHistItem
s
, _replIndex :: Int
_replIndex = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq REPLHistItem
s
}
restartREPLHistory :: REPLHistory -> REPLHistory
restartREPLHistory :: REPLHistory -> REPLHistory
restartREPLHistory REPLHistory
h = REPLHistory
h forall a b. a -> (a -> b) -> b
& Lens' REPLHistory Int
replStart forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLHistory -> Int
replLength REPLHistory
h
replLength :: REPLHistory -> Int
replLength :: REPLHistory -> Int
replLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Seq REPLHistItem
_replSeq
addREPLItem :: REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem :: REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem REPLHistItem
t REPLHistory
h =
REPLHistory
h
forall a b. a -> (a -> b) -> b
& Lens' REPLHistory (Seq REPLHistItem)
replSeq forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall s a. Snoc s s a a => s -> a -> s
|> REPLHistItem
t)
forall a b. a -> (a -> b) -> b
& Lens' REPLHistory Int
replIndex forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
1 forall a. Num a => a -> a -> a
+ REPLHistory -> Int
replLength REPLHistory
h
getLatestREPLHistoryItems :: Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems :: Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems Int
n REPLHistory
h = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REPLHistItem
latestN
where
latestN :: Seq REPLHistItem
latestN = forall a. Int -> Seq a -> Seq a
Seq.drop Int
oldestIndex forall a b. (a -> b) -> a -> b
$ REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq
oldestIndex :: Int
oldestIndex = forall a. Ord a => a -> a -> a
max (REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replStart) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq) forall a. Num a => a -> a -> a
- Int
n
data TimeDir = Newer | Older deriving (TimeDir -> TimeDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeDir -> TimeDir -> Bool
$c/= :: TimeDir -> TimeDir -> Bool
== :: TimeDir -> TimeDir -> Bool
$c== :: TimeDir -> TimeDir -> Bool
Eq, Eq TimeDir
TimeDir -> TimeDir -> Bool
TimeDir -> TimeDir -> Ordering
TimeDir -> TimeDir -> TimeDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeDir -> TimeDir -> TimeDir
$cmin :: TimeDir -> TimeDir -> TimeDir
max :: TimeDir -> TimeDir -> TimeDir
$cmax :: TimeDir -> TimeDir -> TimeDir
>= :: TimeDir -> TimeDir -> Bool
$c>= :: TimeDir -> TimeDir -> Bool
> :: TimeDir -> TimeDir -> Bool
$c> :: TimeDir -> TimeDir -> Bool
<= :: TimeDir -> TimeDir -> Bool
$c<= :: TimeDir -> TimeDir -> Bool
< :: TimeDir -> TimeDir -> Bool
$c< :: TimeDir -> TimeDir -> Bool
compare :: TimeDir -> TimeDir -> Ordering
$ccompare :: TimeDir -> TimeDir -> Ordering
Ord, Int -> TimeDir -> ShowS
[TimeDir] -> ShowS
TimeDir -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TimeDir] -> ShowS
$cshowList :: [TimeDir] -> ShowS
show :: TimeDir -> FilePath
$cshow :: TimeDir -> FilePath
showsPrec :: Int -> TimeDir -> ShowS
$cshowsPrec :: Int -> TimeDir -> ShowS
Show)
moveReplHistIndex :: TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex :: TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex TimeDir
d Text
lastEntered REPLHistory
history = REPLHistory
history forall a b. a -> (a -> b) -> b
& Lens' REPLHistory Int
replIndex forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newIndex
where
historyLen :: Int
historyLen = REPLHistory -> Int
replLength REPLHistory
history
curText :: Text
curText = forall a. a -> Maybe a -> a
fromMaybe Text
lastEntered forall a b. (a -> b) -> a -> b
$ REPLHistory -> Maybe Text
getCurrentItemText REPLHistory
history
curIndex :: Int
curIndex = REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replIndex
entries :: Seq REPLHistItem
entries = REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq
(Seq REPLHistItem
olderP, Seq REPLHistItem
newer) = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
curIndex Seq REPLHistItem
entries
notSameEntry :: REPLHistItem -> Bool
notSameEntry = \case
REPLEntry Text
t -> Text
t forall a. Eq a => a -> a -> Bool
/= Text
curText
REPLHistItem
_ -> Bool
False
newIndex :: Int
newIndex = case TimeDir
d of
TimeDir
Newer -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
historyLen (Int
curIndex forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL REPLHistItem -> Bool
notSameEntry Seq REPLHistItem
newer
TimeDir
Older -> forall a. a -> Maybe a -> a
fromMaybe Int
curIndex forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexR REPLHistItem -> Bool
notSameEntry Seq REPLHistItem
olderP
getCurrentItemText :: REPLHistory -> Maybe Text
getCurrentItemText :: REPLHistory -> Maybe Text
getCurrentItemText REPLHistory
history = REPLHistItem -> Text
replItemText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Seq a -> Maybe a
Seq.lookup (REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replIndex) (REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq)
replIndexIsAtInput :: REPLHistory -> Bool
replIndexIsAtInput :: REPLHistory -> Bool
replIndexIsAtInput REPLHistory
repl = REPLHistory
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replIndex forall a. Eq a => a -> a -> Bool
== REPLHistory -> Int
replLength REPLHistory
repl
removeEntry :: Text -> REPLHistory -> REPLHistory
removeEntry :: Text -> REPLHistory -> REPLHistory
removeEntry Text
foundtext REPLHistory
hist = REPLHistory
hist forall a b. a -> (a -> b) -> b
& Lens' REPLHistory (Seq REPLHistItem)
replSeq forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall a. Eq a => a -> a -> Bool
/= Text -> REPLHistItem
REPLEntry Text
foundtext)
lastEntry :: Text -> REPLHistory -> Maybe Text
lastEntry :: Text -> REPLHistory -> Maybe Text
lastEntry Text
t REPLHistory
h =
case forall a. Seq a -> ViewR a
Seq.viewr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter REPLHistItem -> Bool
matchEntry forall a b. (a -> b) -> a -> b
$ REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq of
ViewR REPLHistItem
Seq.EmptyR -> forall a. Maybe a
Nothing
Seq REPLHistItem
_ Seq.:> REPLHistItem
a -> forall a. a -> Maybe a
Just (REPLHistItem -> Text
replItemText REPLHistItem
a)
where
matchesText :: REPLHistItem -> Bool
matchesText REPLHistItem
histItem = Text
t Text -> Text -> Bool
`T.isInfixOf` REPLHistItem -> Text
replItemText REPLHistItem
histItem
matchEntry :: REPLHistItem -> Bool
matchEntry = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) REPLHistItem -> Bool
matchesText REPLHistItem -> Bool
isREPLEntry
data REPLPrompt
=
CmdPrompt [Text]
|
SearchPrompt REPLHistory
defaultPrompt :: REPLPrompt
defaultPrompt :: REPLPrompt
defaultPrompt = [Text] -> REPLPrompt
CmdPrompt []
data REPLState = REPLState
{ REPLState -> REPLPrompt
_replPromptType :: REPLPrompt
, REPLState -> Editor Text Name
_replPromptEditor :: Editor Text Name
, REPLState -> Bool
_replValid :: Bool
, REPLState -> Text
_replLast :: Text
, REPLState -> Maybe Polytype
_replType :: Maybe Polytype
, REPLState -> REPLHistory
_replHistory :: REPLHistory
}
newREPLEditor :: Text -> Editor Text Name
newREPLEditor :: Text -> Editor Text Name
newREPLEditor Text
t = forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
gotoEnd forall a b. (a -> b) -> a -> b
$ forall n. n -> Maybe Int -> Text -> Editor Text n
editorText Name
REPLInput (forall a. a -> Maybe a
Just Int
1) Text
t
where
ls :: [Text]
ls = Text -> [Text]
T.lines Text
t
pos :: (Int, Int)
pos = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls forall a. Num a => a -> a -> a
- Int
1, Text -> Int
T.length (forall a. [a] -> a
last [Text]
ls))
gotoEnd :: TextZipper Text -> TextZipper Text
gotoEnd = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls then forall a. a -> a
id else forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
TZ.moveCursor (Int, Int)
pos
initREPLState :: REPLHistory -> REPLState
initREPLState :: REPLHistory -> REPLState
initREPLState = REPLPrompt
-> Editor Text Name
-> Bool
-> Text
-> Maybe Polytype
-> REPLHistory
-> REPLState
REPLState REPLPrompt
defaultPrompt (Text -> Editor Text Name
newREPLEditor Text
"") Bool
True Text
"" forall a. Maybe a
Nothing
makeLensesWith (lensRules & generateSignatures .~ False) ''REPLState
replPromptType :: Lens' REPLState REPLPrompt
replPromptEditor :: Lens' REPLState (Editor Text Name)
replPromptText :: Lens' REPLState Text
replPromptText :: Lens' REPLState Text
replPromptText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens REPLState -> Text
g REPLState -> Text -> REPLState
s
where
g :: REPLState -> Text
g REPLState
r = REPLState
r forall s a. s -> Getting a s a -> a
^. Lens' REPLState (Editor Text Name)
replPromptEditor 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 n. Monoid t => Editor t n -> [t]
getEditContents 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 [Text] -> Text
T.concat
s :: REPLState -> Text -> REPLState
s REPLState
r Text
t = REPLState
r forall a b. a -> (a -> b) -> b
& 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
t
replValid :: Lens' REPLState Bool
replType :: Lens' REPLState (Maybe Polytype)
replLast :: Lens' REPLState Text
replHistory :: Lens' REPLState REPLHistory
data ModalType
= HelpModal
| RecipesModal
| CommandsModal
| MessagesModal
| RobotsModal
| WinModal
| QuitModal
| KeepPlayingModal
| DescriptionModal Entity
| GoalModal [Text]
deriving (ModalType -> ModalType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModalType -> ModalType -> Bool
$c/= :: ModalType -> ModalType -> Bool
== :: ModalType -> ModalType -> Bool
$c== :: ModalType -> ModalType -> Bool
Eq, Int -> ModalType -> ShowS
[ModalType] -> ShowS
ModalType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModalType] -> ShowS
$cshowList :: [ModalType] -> ShowS
show :: ModalType -> FilePath
$cshow :: ModalType -> FilePath
showsPrec :: Int -> ModalType -> ShowS
$cshowsPrec :: Int -> ModalType -> ShowS
Show)
data ButtonSelection = CancelButton | KeepPlayingButton | StartOverButton Seed ScenarioInfoPair | QuitButton | NextButton ScenarioInfoPair
data Modal = Modal
{ Modal -> ModalType
_modalType :: ModalType
, Modal -> Dialog ButtonSelection
_modalDialog :: Dialog ButtonSelection
}
makeLenses ''Modal
data MainMenuEntry = NewGame | Tutorial | Messages | About | Quit
deriving (MainMenuEntry -> MainMenuEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MainMenuEntry -> MainMenuEntry -> Bool
$c/= :: MainMenuEntry -> MainMenuEntry -> Bool
== :: MainMenuEntry -> MainMenuEntry -> Bool
$c== :: MainMenuEntry -> MainMenuEntry -> Bool
Eq, Eq MainMenuEntry
MainMenuEntry -> MainMenuEntry -> Bool
MainMenuEntry -> MainMenuEntry -> Ordering
MainMenuEntry -> MainMenuEntry -> MainMenuEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
$cmin :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
max :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
$cmax :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
>= :: MainMenuEntry -> MainMenuEntry -> Bool
$c>= :: MainMenuEntry -> MainMenuEntry -> Bool
> :: MainMenuEntry -> MainMenuEntry -> Bool
$c> :: MainMenuEntry -> MainMenuEntry -> Bool
<= :: MainMenuEntry -> MainMenuEntry -> Bool
$c<= :: MainMenuEntry -> MainMenuEntry -> Bool
< :: MainMenuEntry -> MainMenuEntry -> Bool
$c< :: MainMenuEntry -> MainMenuEntry -> Bool
compare :: MainMenuEntry -> MainMenuEntry -> Ordering
$ccompare :: MainMenuEntry -> MainMenuEntry -> Ordering
Ord, Int -> MainMenuEntry -> ShowS
[MainMenuEntry] -> ShowS
MainMenuEntry -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MainMenuEntry] -> ShowS
$cshowList :: [MainMenuEntry] -> ShowS
show :: MainMenuEntry -> FilePath
$cshow :: MainMenuEntry -> FilePath
showsPrec :: Int -> MainMenuEntry -> ShowS
$cshowsPrec :: Int -> MainMenuEntry -> ShowS
Show, ReadPrec [MainMenuEntry]
ReadPrec MainMenuEntry
Int -> ReadS MainMenuEntry
ReadS [MainMenuEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MainMenuEntry]
$creadListPrec :: ReadPrec [MainMenuEntry]
readPrec :: ReadPrec MainMenuEntry
$creadPrec :: ReadPrec MainMenuEntry
readList :: ReadS [MainMenuEntry]
$creadList :: ReadS [MainMenuEntry]
readsPrec :: Int -> ReadS MainMenuEntry
$creadsPrec :: Int -> ReadS MainMenuEntry
Read, MainMenuEntry
forall a. a -> a -> Bounded a
maxBound :: MainMenuEntry
$cmaxBound :: MainMenuEntry
minBound :: MainMenuEntry
$cminBound :: MainMenuEntry
Bounded, Int -> MainMenuEntry
MainMenuEntry -> Int
MainMenuEntry -> [MainMenuEntry]
MainMenuEntry -> MainMenuEntry
MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
MainMenuEntry -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
$cenumFromThenTo :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
enumFromTo :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
$cenumFromTo :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
enumFromThen :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
$cenumFromThen :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
enumFrom :: MainMenuEntry -> [MainMenuEntry]
$cenumFrom :: MainMenuEntry -> [MainMenuEntry]
fromEnum :: MainMenuEntry -> Int
$cfromEnum :: MainMenuEntry -> Int
toEnum :: Int -> MainMenuEntry
$ctoEnum :: Int -> MainMenuEntry
pred :: MainMenuEntry -> MainMenuEntry
$cpred :: MainMenuEntry -> MainMenuEntry
succ :: MainMenuEntry -> MainMenuEntry
$csucc :: MainMenuEntry -> MainMenuEntry
Enum)
data
=
| MainMenu (BL.List Name MainMenuEntry)
| (NonEmpty (BL.List Name ScenarioItem))
|
|
mainMenu :: MainMenuEntry -> BL.List Name MainMenuEntry
mainMenu :: MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
e = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
MenuList (forall a. [a] -> Vector a
V.fromList [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]) Int
1 forall a b. a -> (a -> b) -> b
& forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
BL.listMoveToElement MainMenuEntry
e
mkScenarioList :: Bool -> ScenarioCollection -> BL.List Name ScenarioItem
mkScenarioList :: Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
ScenarioList) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScenarioItem] -> [ScenarioItem]
filterTest forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection -> [ScenarioItem]
scenarioCollectionToList
where
filterTest :: [ScenarioItem] -> [ScenarioItem]
filterTest = if Bool
cheat then forall a. a -> a
id else forall a. (a -> Bool) -> [a] -> [a]
filter (\case SICollection Text
n ScenarioCollection
_ -> Text
n forall a. Eq a => a -> a -> Bool
/= Text
"Testing"; ScenarioItem
_ -> Bool
True)
mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
Bool
cheat ScenarioCollection
sc FilePath
path = NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScenarioCollection
-> [FilePath]
-> [List Name ScenarioItem]
-> Maybe [List Name ScenarioItem]
go (forall a. a -> Maybe a
Just ScenarioCollection
sc) (FilePath -> [FilePath]
splitPath FilePath
path) []
where
go :: Maybe ScenarioCollection -> [FilePath] -> [BL.List Name ScenarioItem] -> Maybe [BL.List Name ScenarioItem]
go :: Maybe ScenarioCollection
-> [FilePath]
-> [List Name ScenarioItem]
-> Maybe [List Name ScenarioItem]
go Maybe ScenarioCollection
_ [] [List Name ScenarioItem]
stk = forall a. a -> Maybe a
Just [List Name ScenarioItem]
stk
go Maybe ScenarioCollection
Nothing [FilePath]
_ [List Name ScenarioItem]
_ = forall a. Maybe a
Nothing
go (Just ScenarioCollection
curSC) (FilePath
thing : [FilePath]
rest) [List Name ScenarioItem]
stk = Maybe ScenarioCollection
-> [FilePath]
-> [List Name ScenarioItem]
-> Maybe [List Name ScenarioItem]
go Maybe ScenarioCollection
nextSC [FilePath]
rest (List Name ScenarioItem
lst forall a. a -> [a] -> [a]
: [List Name ScenarioItem]
stk)
where
hasName :: ScenarioItem -> Bool
hasName :: ScenarioItem -> Bool
hasName (SISingle (Scenario
_, ScenarioInfo FilePath
pth ScenarioStatus
_ ScenarioStatus
_ ScenarioStatus
_)) = ShowS
takeFileName FilePath
pth forall a. Eq a => a -> a -> Bool
== FilePath
thing
hasName (SICollection Text
nm ScenarioCollection
_) = Text
nm forall a. Eq a => a -> a -> Bool
== forall target source. From source target => source -> target
into @Text (ShowS
dropTrailingPathSeparator FilePath
thing)
lst :: List Name ScenarioItem
lst = forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy ScenarioItem -> Bool
hasName (Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
curSC)
nextSC :: Maybe ScenarioCollection
nextSC = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ShowS
dropTrailingPathSeparator FilePath
thing) (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
curSC) of
Just (SICollection Text
_ ScenarioCollection
c) -> forall a. a -> Maybe a
Just ScenarioCollection
c
Maybe ScenarioItem
_ -> forall a. Maybe a
Nothing
data InventoryListEntry
= Separator Text
| InventoryEntry Count Entity
| InstalledEntry Entity
deriving (InventoryListEntry -> InventoryListEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InventoryListEntry -> InventoryListEntry -> Bool
$c/= :: InventoryListEntry -> InventoryListEntry -> Bool
== :: InventoryListEntry -> InventoryListEntry -> Bool
$c== :: InventoryListEntry -> InventoryListEntry -> Bool
Eq)
makePrisms ''InventoryListEntry
data UIState = UIState
{ :: Menu
, UIState -> Bool
_uiPlaying :: Bool
, UIState -> Bool
_uiCheatMode :: Bool
, UIState -> FocusRing Name
_uiFocusRing :: FocusRing Name
, UIState -> Maybe Coords
_uiWorldCursor :: Maybe W.Coords
, UIState -> REPLState
_uiREPL :: REPLState
, UIState -> Maybe (Int, GenericList Name Vector InventoryListEntry)
_uiInventory :: Maybe (Int, BL.List Name InventoryListEntry)
, UIState -> InventorySortOptions
_uiInventorySort :: InventorySortOptions
, UIState -> Bool
_uiMoreInfoTop :: Bool
, UIState -> Bool
_uiMoreInfoBot :: Bool
, UIState -> Bool
_uiScrollToEnd :: Bool
, UIState -> Maybe Text
_uiError :: Maybe Text
, UIState -> Maybe Modal
_uiModal :: Maybe Modal
, UIState -> Maybe [Text]
_uiGoal :: Maybe [Text]
, UIState -> Bool
_uiShowFPS :: Bool
, UIState -> Bool
_uiShowZero :: Bool
, UIState -> TimeSpec
_uiHideRobotsUntil :: TimeSpec
, UIState -> Bool
_uiInventoryShouldUpdate :: Bool
, UIState -> Double
_uiTPF :: Double
, UIState -> Double
_uiFPS :: Double
, UIState -> Int
_lgTicksPerSecond :: Int
, UIState -> Int
_tickCount :: Int
, UIState -> Int
_frameCount :: Int
, UIState -> Int
_frameTickCount :: Int
, UIState -> TimeSpec
_lastFrameTime :: TimeSpec
, UIState -> TimeSpec
_accumulatedTime :: TimeSpec
, UIState -> TimeSpec
_lastInfoTime :: TimeSpec
, UIState -> Map Text Text
_appData :: Map Text Text
, UIState -> Maybe ScenarioInfoPair
_scenarioRef :: Maybe ScenarioInfoPair
}
uiMenu :: Lens' UIState Menu
uiPlaying :: Lens' UIState Bool
uiCheatMode :: Lens' UIState Bool
uiFocusRing :: Lens' UIState (FocusRing Name)
uiWorldCursor :: Lens' UIState (Maybe W.Coords)
uiREPL :: Lens' UIState REPLState
uiInventorySort :: Lens' UIState InventorySortOptions
uiInventory :: Lens' UIState (Maybe (Int, BL.List Name InventoryListEntry))
uiMoreInfoTop :: Lens' UIState Bool
uiMoreInfoBot :: Lens' UIState Bool
uiScrollToEnd :: Lens' UIState Bool
uiError :: Lens' UIState (Maybe Text)
uiModal :: Lens' UIState (Maybe Modal)
uiGoal :: Lens' UIState (Maybe [Text])
uiShowFPS :: Lens' UIState Bool
uiShowZero :: Lens' UIState Bool
uiHideRobotsUntil :: Lens' UIState TimeSpec
uiShowRobots :: Getter UIState Bool
uiShowRobots :: Getter UIState Bool
uiShowRobots = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\UIState
ui -> UIState
ui forall s a. s -> Getting a s a -> a
^. Lens' UIState TimeSpec
lastFrameTime forall a. Ord a => a -> a -> Bool
> UIState
ui forall s a. s -> Getting a s a -> a
^. Lens' UIState TimeSpec
uiHideRobotsUntil)
uiInventoryShouldUpdate :: Lens' UIState Bool
uiTPF :: Lens' UIState Double
uiFPS :: Lens' UIState Double
scenarioRef :: Lens' UIState (Maybe ScenarioInfoPair)
lgTicksPerSecond :: Lens' UIState Int
lgTicksPerSecond :: Lens' UIState Int
lgTicksPerSecond = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UIState -> Int
_lgTicksPerSecond UIState -> Int -> UIState
safeSetLgTicks
where
maxLog :: Int
maxLog = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. Bounded a => a
maxBound :: Int)
maxTicks :: Int
maxTicks = Int
maxLog forall a. Num a => a -> a -> a
- Int
2
minTicks :: Int
minTicks = Int
2 forall a. Num a => a -> a -> a
- Int
maxLog
safeSetLgTicks :: UIState -> Int -> UIState
safeSetLgTicks UIState
ui Int
lTicks
| Int
lTicks forall a. Ord a => a -> a -> Bool
< Int
minTicks = UIState -> Int -> UIState
setLgTicks UIState
ui Int
minTicks
| Int
lTicks forall a. Ord a => a -> a -> Bool
> Int
maxTicks = UIState -> Int -> UIState
setLgTicks UIState
ui Int
maxTicks
| Bool
otherwise = UIState -> Int -> UIState
setLgTicks UIState
ui Int
lTicks
setLgTicks :: UIState -> Int -> UIState
setLgTicks UIState
ui Int
lTicks = UIState
ui {_lgTicksPerSecond :: Int
_lgTicksPerSecond = Int
lTicks}
tickCount :: Lens' UIState Int
frameCount :: Lens' UIState Int
frameTickCount :: Lens' UIState Int
lastInfoTime :: Lens' UIState TimeSpec
lastFrameTime :: Lens' UIState TimeSpec
accumulatedTime :: Lens' UIState TimeSpec
appData :: Lens' UIState (Map Text Text)
data RuntimeState = RuntimeState
{ RuntimeState -> Maybe Int
_webPort :: Maybe Port
, RuntimeState -> Either NewReleaseFailure FilePath
_upstreamRelease :: Either NewReleaseFailure String
, RuntimeState -> Notifications LogEntry
_eventLog :: Notifications LogEntry
}
initRuntimeState :: RuntimeState
initRuntimeState :: RuntimeState
initRuntimeState =
RuntimeState
{ _webPort :: Maybe Int
_webPort = forall a. Maybe a
Nothing
, _upstreamRelease :: Either NewReleaseFailure FilePath
_upstreamRelease = forall a b. a -> Either a b
Left ([FilePath] -> NewReleaseFailure
NoMainUpstreamRelease [])
, _eventLog :: Notifications LogEntry
_eventLog = forall a. Monoid a => a
mempty
}
makeLensesWith (lensRules & generateSignatures .~ False) ''RuntimeState
webPort :: Lens' RuntimeState (Maybe Port)
upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)
eventLog :: Lens' RuntimeState (Notifications LogEntry)
logEvent :: LogSource -> (Text, RID) -> Text -> Notifications LogEntry -> Notifications LogEntry
logEvent :: LogSource
-> (Text, Int)
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
src (Text
who, Int
rid) Text
msg Notifications LogEntry
el =
Notifications LogEntry
el
forall a b. a -> (a -> b) -> b
& forall a. Lens' (Notifications a) Int
notificationsCount forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Enum a => a -> a
succ
forall a b. a -> (a -> b) -> b
& forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (LogEntry
l forall a. a -> [a] -> [a]
:)
where
l :: LogEntry
l = Integer -> LogSource -> Text -> Int -> V2 Int64 -> Text -> LogEntry
LogEntry Integer
0 LogSource
src Text
who Int
rid forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Text
msg
data AppState = AppState
{ AppState -> GameState
_gameState :: GameState
, AppState -> UIState
_uiState :: UIState
, AppState -> RuntimeState
_runtimeState :: RuntimeState
}
makeLensesWith (lensRules & generateSignatures .~ False) ''AppState
gameState :: Lens' AppState GameState
uiState :: Lens' AppState UIState
runtimeState :: Lens' AppState RuntimeState
focusedItem :: AppState -> Maybe InventoryListEntry
focusedItem :: AppState -> Maybe InventoryListEntry
focusedItem AppState
s = do
GenericList Name Vector InventoryListEntry
list <- AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? 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
(Int
_, InventoryListEntry
entry) <- forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement GenericList Name Vector InventoryListEntry
list
forall (m :: * -> *) a. Monad m => a -> m a
return InventoryListEntry
entry
focusedEntity :: AppState -> Maybe Entity
focusedEntity :: AppState -> Maybe Entity
focusedEntity =
AppState -> Maybe InventoryListEntry
focusedItem forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
Separator Text
_ -> forall a. Maybe a
Nothing
InventoryEntry Int
_ Entity
e -> forall a. a -> Maybe a
Just Entity
e
InstalledEntry Entity
e -> forall a. a -> Maybe a
Just Entity
e
initFocusRing :: FocusRing Name
initFocusRing :: FocusRing Name
initFocusRing = forall n. [n] -> FocusRing n
focusRing [Name
REPLPanel, Name
InfoPanel, Name
RobotPanel, Name
WorldPanel]
initLgTicksPerSecond :: Int
initLgTicksPerSecond :: Int
initLgTicksPerSecond = Int
4
initUIState :: Bool -> Bool -> ExceptT Text IO UIState
initUIState :: Bool -> Bool -> ExceptT Text IO UIState
initUIState Bool
showMainMenu Bool
cheatMode = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe Text
historyT <- FilePath -> IO (Maybe Text)
readFileMayT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO FilePath
getSwarmHistoryPath Bool
False
Map Text Text
appDataMap <- IO (Map Text Text)
readAppData
let history :: [REPLHistItem]
history = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map Text -> REPLHistItem
REPLEntry forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) Maybe Text
historyT
TimeSpec
startTime <- Clock -> IO TimeSpec
getTime Clock
Monotonic
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
UIState
{ _uiMenu :: Menu
_uiMenu = if Bool
showMainMenu then List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
NewGame) else Menu
NoMenu
, _uiPlaying :: Bool
_uiPlaying = Bool -> Bool
not Bool
showMainMenu
, _uiCheatMode :: Bool
_uiCheatMode = Bool
cheatMode
, _uiFocusRing :: FocusRing Name
_uiFocusRing = FocusRing Name
initFocusRing
, _uiWorldCursor :: Maybe Coords
_uiWorldCursor = forall a. Maybe a
Nothing
, _uiREPL :: REPLState
_uiREPL = REPLHistory -> REPLState
initREPLState forall a b. (a -> b) -> a -> b
$ [REPLHistItem] -> REPLHistory
newREPLHistory [REPLHistItem]
history
, _uiInventory :: Maybe (Int, GenericList Name Vector InventoryListEntry)
_uiInventory = forall a. Maybe a
Nothing
, _uiInventorySort :: InventorySortOptions
_uiInventorySort = InventorySortOptions
defaultSortOptions
, _uiMoreInfoTop :: Bool
_uiMoreInfoTop = Bool
False
, _uiMoreInfoBot :: Bool
_uiMoreInfoBot = Bool
False
, _uiScrollToEnd :: Bool
_uiScrollToEnd = Bool
False
, _uiError :: Maybe Text
_uiError = forall a. Maybe a
Nothing
, _uiModal :: Maybe Modal
_uiModal = forall a. Maybe a
Nothing
, _uiGoal :: Maybe [Text]
_uiGoal = forall a. Maybe a
Nothing
, _uiShowFPS :: Bool
_uiShowFPS = Bool
False
, _uiShowZero :: Bool
_uiShowZero = Bool
True
, _uiHideRobotsUntil :: TimeSpec
_uiHideRobotsUntil = TimeSpec
startTime forall a. Num a => a -> a -> a
- TimeSpec
1
, _uiInventoryShouldUpdate :: Bool
_uiInventoryShouldUpdate = Bool
False
, _uiTPF :: Double
_uiTPF = Double
0
, _uiFPS :: Double
_uiFPS = Double
0
, _lgTicksPerSecond :: Int
_lgTicksPerSecond = Int
initLgTicksPerSecond
, _lastFrameTime :: TimeSpec
_lastFrameTime = TimeSpec
startTime
, _accumulatedTime :: TimeSpec
_accumulatedTime = TimeSpec
0
, _lastInfoTime :: TimeSpec
_lastInfoTime = TimeSpec
0
, _tickCount :: Int
_tickCount = Int
0
, _frameCount :: Int
_frameCount = Int
0
, _frameTickCount :: Int
_frameTickCount = Int
0
, _appData :: Map Text Text
_appData = Map Text Text
appDataMap
, _scenarioRef :: Maybe ScenarioInfoPair
_scenarioRef = forall a. Maybe a
Nothing
}
populateInventoryList :: MonadState UIState m => Maybe Robot -> m ()
populateInventoryList :: forall (m :: * -> *). MonadState UIState m => Maybe Robot -> m ()
populateInventoryList Maybe Robot
Nothing = Lens'
UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
populateInventoryList (Just Robot
r) = do
Maybe (GenericList Name Vector InventoryListEntry)
mList <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (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)
Bool
showZero <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UIState Bool
uiShowZero
InventorySortOptions
sortOptions <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UIState InventorySortOptions
uiInventorySort
let mkInvEntry :: (Int, Entity) -> InventoryListEntry
mkInvEntry (Int
n, Entity
e) = Int -> Entity -> InventoryListEntry
InventoryEntry Int
n Entity
e
mkInstEntry :: (a, Entity) -> InventoryListEntry
mkInstEntry (a
_, Entity
e) = Entity -> InventoryListEntry
InstalledEntry Entity
e
itemList :: ((Int, Entity) -> InventoryListEntry)
-> Text -> Inventory -> [InventoryListEntry]
itemList (Int, Entity) -> InventoryListEntry
mk Text
label =
(\case [] -> []; [InventoryListEntry]
xs -> Text -> InventoryListEntry
Separator Text
label forall a. a -> [a] -> [a]
: [InventoryListEntry]
xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> InventoryListEntry
mk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Ord a =>
InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]
sortInventory InventorySortOptions
sortOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (Ord a, Num a) => (a, Entity) -> Bool
shouldDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems
shouldDisplay :: (a, Entity) -> Bool
shouldDisplay (a
n, Entity
e) = a
n forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
|| Bool
showZero Bool -> Bool -> Bool
&& Bool -> Bool
not ((Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
installedDevices) Inventory -> Entity -> Bool
`E.contains` Entity
e)
items :: [InventoryListEntry]
items =
(Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory 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 (((Int, Entity) -> InventoryListEntry)
-> Text -> Inventory -> [InventoryListEntry]
itemList (Int, Entity) -> InventoryListEntry
mkInvEntry Text
"Inventory"))
forall a. [a] -> [a] -> [a]
++ (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
installedDevices 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 (((Int, Entity) -> InventoryListEntry)
-> Text -> Inventory -> [InventoryListEntry]
itemList forall {a}. (a, Entity) -> InventoryListEntry
mkInstEntry Text
"Installed devices"))
sel :: Maybe (Int, InventoryListEntry)
sel = Maybe (GenericList Name Vector InventoryListEntry)
mList forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement
idx :: Int
idx = case Maybe (Int, InventoryListEntry)
sel of
Maybe (Int, InventoryListEntry)
Nothing -> Int
1
Just (Int
selIdx, InventoryEntry Int
_ Entity
e) ->
forall a. a -> Maybe a -> a
fromMaybe Int
selIdx (forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Entity
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Prism' InventoryListEntry (Int, Entity)
_InventoryEntry 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)) [InventoryListEntry]
items)
Just (Int
selIdx, InstalledEntry Entity
e) ->
forall a. a -> Maybe a -> a
fromMaybe Int
selIdx (forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Entity
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Prism' InventoryListEntry Entity
_InstalledEntry) [InventoryListEntry]
items)
Just (Int
selIdx, InventoryListEntry
_) -> Int
selIdx
lst :: GenericList Name Vector InventoryListEntry
lst = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
idx forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
InventoryList (forall a. [a] -> Vector a
V.fromList [InventoryListEntry]
items) Int
1
Lens'
UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot Int
inventoryHash, GenericList Name Vector InventoryListEntry
lst)
data AppOpts = AppOpts
{
AppOpts -> Maybe Int
userSeed :: Maybe Seed
,
AppOpts -> Maybe FilePath
userScenario :: Maybe FilePath
,
AppOpts -> Maybe FilePath
scriptToRun :: Maybe FilePath
,
AppOpts -> Bool
autoPlay :: Bool
,
AppOpts -> Bool
cheatMode :: Bool
,
AppOpts -> Maybe Int
userWebPort :: Maybe Port
,
AppOpts -> Maybe GitInfo
repoGitInfo :: Maybe GitInfo
}
initAppState :: AppOpts -> ExceptT Text IO AppState
initAppState :: AppOpts -> ExceptT Text IO AppState
initAppState AppOpts {Bool
Maybe Int
Maybe FilePath
Maybe GitInfo
repoGitInfo :: Maybe GitInfo
userWebPort :: Maybe Int
cheatMode :: Bool
autoPlay :: Bool
scriptToRun :: Maybe FilePath
userScenario :: Maybe FilePath
userSeed :: Maybe Int
repoGitInfo :: AppOpts -> Maybe GitInfo
userWebPort :: AppOpts -> Maybe Int
cheatMode :: AppOpts -> Bool
autoPlay :: AppOpts -> Bool
scriptToRun :: AppOpts -> Maybe FilePath
userScenario :: AppOpts -> Maybe FilePath
userSeed :: AppOpts -> Maybe Int
..} = do
let isRunningInitialProgram :: Bool
isRunningInitialProgram = forall a. Maybe a -> Bool
isJust Maybe FilePath
scriptToRun Bool -> Bool -> Bool
|| Bool
autoPlay
skipMenu :: Bool
skipMenu = forall a. Maybe a -> Bool
isJust Maybe FilePath
userScenario Bool -> Bool -> Bool
|| Bool
isRunningInitialProgram Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe Int
userSeed
GameState
gs <- ExceptT Text IO GameState
initGameState
UIState
ui <- Bool -> Bool -> ExceptT Text IO UIState
initUIState (Bool -> Bool
not Bool
skipMenu) Bool
cheatMode
let rs :: RuntimeState
rs = RuntimeState
initRuntimeState
case Bool
skipMenu of
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GameState -> UIState -> RuntimeState -> AppState
AppState GameState
gs UIState
ui RuntimeState
rs
Bool
True -> do
(Scenario
scenario, FilePath
path) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
FilePath -> EntityMap -> m (Scenario, FilePath)
loadScenario (forall a. a -> Maybe a -> a
fromMaybe FilePath
"classic" Maybe FilePath
userScenario) (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState EntityMap
entityMap)
let maybeAutoplay :: Maybe CodeToRun
maybeAutoplay = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
autoPlay
ProcessedTerm
soln <- Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe ProcessedTerm)
scenarioSolution
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProcessedTerm -> CodeToRun
SuggestedSolution ProcessedTerm
soln
let realToRun :: Maybe CodeToRun
realToRun = Maybe CodeToRun
maybeAutoplay forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FilePath -> CodeToRun
ScriptPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
scriptToRun)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
(forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Maybe Int -> ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGameWithSeed Maybe Int
userSeed (Scenario
scenario, FilePath
-> ScenarioStatus
-> ScenarioStatus
-> ScenarioStatus
-> ScenarioInfo
ScenarioInfo FilePath
path ScenarioStatus
NotStarted ScenarioStatus
NotStarted ScenarioStatus
NotStarted) Maybe CodeToRun
realToRun)
(GameState -> UIState -> RuntimeState -> AppState
AppState GameState
gs UIState
ui RuntimeState
rs)
startGame :: (MonadIO m, MonadState AppState m) => ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame = forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Maybe Int -> ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGameWithSeed forall a. Maybe a
Nothing
restartGame :: (MonadIO m, MonadState AppState m) => Seed -> ScenarioInfoPair -> m ()
restartGame :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Int -> ScenarioInfoPair -> m ()
restartGame Int
currentSeed ScenarioInfoPair
siPair = forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Maybe Int -> ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGameWithSeed (forall a. a -> Maybe a
Just Int
currentSeed) ScenarioInfoPair
siPair forall a. Maybe a
Nothing
startGameWithSeed :: (MonadIO m, MonadState AppState m) => Maybe Seed -> ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGameWithSeed :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Maybe Int -> ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGameWithSeed Maybe Int
userSeed siPair :: ScenarioInfoPair
siPair@(Scenario
_scene, ScenarioInfo
si) Maybe CodeToRun
toRun = do
ZonedTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
ScenarioCollection
ss <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios
FilePath
p <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ScenarioCollection -> FilePath -> IO FilePath
normalizeScenarioPath ScenarioCollection
ss (ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo FilePath
scenarioPath)
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (Maybe FilePath)
currentScenarioPath forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just FilePath
p
Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath FilePath
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ScenarioInfo ScenarioStatus
scenarioStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ZonedTime -> NominalDiffTime -> Integer -> ScenarioStatus
InProgress ZonedTime
t NominalDiffTime
0 Integer
0
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe Int -> Maybe CodeToRun -> m ()
scenarioToAppState ScenarioInfoPair
siPair Maybe Int
userSeed Maybe CodeToRun
toRun
nextScenario :: Menu -> Maybe ScenarioInfoPair
nextScenario :: Menu -> Maybe ScenarioInfoPair
nextScenario = \case
NewGameMenu (List Name ScenarioItem
curMenu :| [List Name ScenarioItem]
_) ->
let nextMenuList :: List Name ScenarioItem
nextMenuList = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
BL.listMoveDown List Name ScenarioItem
curMenu
isLastScenario :: Bool
isLastScenario = forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
BL.listSelected List Name ScenarioItem
curMenu forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall n (t :: * -> *) e. GenericList n t e -> t e
BL.listElements List Name ScenarioItem
curMenu) forall a. Num a => a -> a -> a
- Int
1)
in if Bool
isLastScenario
then forall a. Maybe a
Nothing
else forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
nextMenuList forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
Menu
_ -> forall a. Maybe a
Nothing
topContext :: AppState -> RobotContext
topContext :: AppState -> RobotContext
topContext AppState
s = RobotContext
ctxPossiblyWithIt
where
ctx :: RobotContext
ctx = forall a. a -> Maybe a -> a
fromMaybe RobotContext
emptyRobotContext 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
ctxPossiblyWithIt :: RobotContext
ctxPossiblyWithIt = 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 REPLStatus
replStatus of
REPLDone (Just Typed Value
p) -> RobotContext
ctx forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
"it" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Typed Value
p
REPLStatus
_ -> RobotContext
ctx
scenarioToAppState :: (MonadIO m, MonadState AppState m) => ScenarioInfoPair -> Maybe Seed -> Maybe CodeToRun -> m ()
scenarioToAppState :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe Int -> Maybe CodeToRun -> m ()
scenarioToAppState siPair :: ScenarioInfoPair
siPair@(Scenario
scene, ScenarioInfo
_) Maybe Int
userSeed Maybe CodeToRun
toRun = do
forall (m :: * -> *) x.
(MonadIO m, MonadState AppState m) =>
Lens' AppState x -> (x -> IO x) -> m ()
withLensIO Lens' AppState GameState
gameState forall a b. (a -> b) -> a -> b
$ Scenario
-> Maybe Int -> Maybe CodeToRun -> GameState -> IO GameState
scenarioToGameState Scenario
scene Maybe Int
userSeed Maybe CodeToRun
toRun
forall (m :: * -> *) x.
(MonadIO m, MonadState AppState m) =>
Lens' AppState x -> (x -> IO x) -> m ()
withLensIO Lens' AppState UIState
uiState forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> UIState -> IO UIState
scenarioToUIState ScenarioInfoPair
siPair
where
withLensIO :: (MonadIO m, MonadState AppState m) => Lens' AppState x -> (x -> IO x) -> m ()
withLensIO :: forall (m :: * -> *) x.
(MonadIO m, MonadState AppState m) =>
Lens' AppState x -> (x -> IO x) -> m ()
withLensIO Lens' AppState x
l x -> IO x
a = do
x
x <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' AppState x
l
x
x' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ x -> IO x
a x
x
Lens' AppState x
l forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= x
x'
scenarioToUIState :: ScenarioInfoPair -> UIState -> IO UIState
scenarioToUIState :: ScenarioInfoPair -> UIState -> IO UIState
scenarioToUIState ScenarioInfoPair
siPair UIState
u =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
UIState
u
forall a b. a -> (a -> b) -> b
& Lens' UIState Bool
uiPlaying forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
forall a b. a -> (a -> b) -> b
& Lens' UIState (Maybe [Text])
uiGoal forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
forall a b. a -> (a -> b) -> b
& Lens' UIState (FocusRing Name)
uiFocusRing forall s t a b. ASetter s t a b -> b -> s -> t
.~ FocusRing Name
initFocusRing
forall a b. a -> (a -> b) -> b
& Lens'
UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
forall a b. a -> (a -> b) -> b
& Lens' UIState InventorySortOptions
uiInventorySort forall s t a b. ASetter s t a b -> b -> s -> t
.~ InventorySortOptions
defaultSortOptions
forall a b. a -> (a -> b) -> b
& Lens' UIState Bool
uiShowFPS forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
forall a b. a -> (a -> b) -> b
& Lens' UIState Bool
uiShowZero forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
forall a b. a -> (a -> b) -> b
& Lens' UIState Int
lgTicksPerSecond forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
initLgTicksPerSecond
forall a b. a -> (a -> b) -> b
& Lens' UIState REPLState
uiREPL forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLHistory -> REPLState
initREPLState (UIState
u forall s a. s -> Getting a s a -> a
^. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory)
forall a b. a -> (a -> b) -> b
& Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ REPLHistory -> REPLHistory
restartREPLHistory
forall a b. a -> (a -> b) -> b
& Lens' UIState (Maybe ScenarioInfoPair)
scenarioRef forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ScenarioInfoPair
siPair