{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      :  Swarm.TUI.Model
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Application state for the @brick@-based Swarm TUI.
module Swarm.TUI.Model (
  -- * Custom UI label types
  -- $uilabel
  AppEvent (..),
  Name (..),

  -- * Menus and dialogs
  ModalType (..),
  ButtonSelection (..),
  Modal (..),
  modalType,
  modalDialog,
  MainMenuEntry (..),
  mainMenu,
  Menu (..),
  _NewGameMenu,
  mkScenarioList,
  mkNewGameMenu,

  -- * UI state

  -- ** REPL
  REPLHistItem (..),
  replItemText,
  isREPLEntry,
  getREPLEntry,
  REPLHistory,
  replIndex,
  replLength,
  replSeq,
  newREPLHistory,
  addREPLItem,
  restartREPLHistory,
  getLatestREPLHistoryItems,
  moveReplHistIndex,
  getCurrentItemText,
  replIndexIsAtInput,
  TimeDir (..),

  -- ** Prompt utils
  REPLPrompt (..),
  removeEntry,

  -- ** Inventory
  InventoryListEntry (..),
  _Separator,
  _InventoryEntry,
  _InstalledEntry,

  -- ** UI Model
  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,

  -- *** REPL Panel Model
  REPLState,
  replPromptType,
  replPromptEditor,
  replPromptText,
  replValid,
  replLast,
  replType,
  replHistory,
  newREPLEditor,

  -- ** Initialization
  initFocusRing,
  defaultPrompt,
  initREPLState,
  initLgTicksPerSecond,
  initUIState,
  lastEntry,

  -- ** Updating
  populateInventoryList,
  infoScroll,
  modalScroll,

  -- * Runtime state
  RuntimeState,
  webPort,
  upstreamRelease,
  eventLog,
  logEvent,

  -- * App state
  AppState,
  gameState,
  uiState,
  runtimeState,

  -- ** Initialization
  AppOpts (..),
  initAppState,
  startGame,
  restartGame,
  scenarioToAppState,
  Seed,

  -- ** Utility
  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)

------------------------------------------------------------
-- Custom UI label types
------------------------------------------------------------

-- $uilabel These types are used as parameters to various @brick@
-- types.

-- | 'Swarm.TUI.Model.AppEvent' represents a type for custom event types our app can
--   receive.  At the moment, we only have one custom event, but it's
--   very important: a separate thread sends 'Frame' events as fast as
--   it can, telling the TUI to render a new frame.
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)

-- | 'Name' represents names to uniquely identify various components
--   of the UI, such as forms, panels, caches, extents, and lists.
data Name
  = -- | The panel containing the REPL.
    REPLPanel
  | -- | The panel containing the world view.
    WorldPanel
  | -- | The panel showing robot info and inventory on the top left.
    RobotPanel
  | -- | The info panel on the bottom left.
    InfoPanel
  | -- | The REPL input form.
    REPLInput
  | -- | The render cache for the world view.
    WorldCache
  | -- | The cached extent for the world view.
    WorldExtent
  | -- | The list of inventory items for the currently
    --   focused robot.
    InventoryList
  | -- | The inventory item position in the InventoryList.
    InventoryListItem Int
  | -- | The list of main menu choices.
    MenuList
  | -- | The list of scenario choices.
    ScenarioList
  | -- | The scrollable viewport for the info panel.
    InfoViewport
  | -- | The scrollable viewport for any modal dialog.
    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

------------------------------------------------------------
-- REPL History
------------------------------------------------------------

-- | An item in the REPL history.
data REPLHistItem
  = -- | Something entered by the user.
    REPLEntry Text
  | -- | A response printed by the system.
    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)

-- | Useful helper function to only get user input text.
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

-- | Useful helper function to filter out REPL output.
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

-- | Get the text of REPL input/output.
replItemText :: REPLHistItem -> Text
replItemText :: REPLHistItem -> Text
replItemText = \case
  REPLEntry Text
t -> Text
t
  REPLOutput Text
t -> Text
t

-- | History of the REPL with indices (0 is first entry) to the current
--   line and to the first entry since loading saved history.
--   We also (ab)use the length of the REPL as the index of current
--   input line, since that number is one past the index of last entry.
data REPLHistory = REPLHistory
  { REPLHistory -> Seq REPLHistItem
_replSeq :: Seq REPLHistItem
  , REPLHistory -> Int
_replIndex :: Int
  , REPLHistory -> Int
_replStart :: Int
  }

makeLensesWith (lensRules & generateSignatures .~ False) ''REPLHistory

-- | Sequence of REPL inputs and outputs, oldest entry is leftmost.
replSeq :: Lens' REPLHistory (Seq REPLHistItem)

-- | The current index in the REPL history (if the user is going back
--   through the history using up/down keys).
replIndex :: Lens' REPLHistory Int

-- | The index of the first entry since loading saved history.
--
-- It will be set on load and reset on save (happens during exit).
replStart :: Lens' REPLHistory Int

-- | Create new REPL history (i.e. from loaded history file lines).
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
        }

-- | Point the start of REPL history after current last line. See 'replStart'.
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

-- | Current number lines of the REPL history - (ab)used as index of input buffer.
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

-- | Add new REPL input - the index must have been pointing one past
--   the last element already, so we increment it to keep it that way.
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

-- | Get the latest N items in history, starting with the oldest one.
--
-- This is used to show previous REPL lines in UI, so we need the items
-- sorted in the order they were entered and will be drawn top to bottom.
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
  -- split repl at index
  (Seq REPLHistItem
olderP, Seq REPLHistItem
newer) = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
curIndex Seq REPLHistItem
entries
  -- find first different entry in direction
  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

-- | Given some text,  removes the REPLEntry within REPLHistory which is equal to that.
--   This is used when the user enters in search mode and want to traverse the history.
--   If a command has been used many times, the history will be populated with it causing
--   the effect that search command always finds the same command.
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)

-- | Get the last REPLEntry in REPLHistory matching the given text
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

------------------------------------------------------------
-- REPL
------------------------------------------------------------

-- | This data type tells us how to interpret the text typed
--   by the player at the prompt (which is stored in Editor).
data REPLPrompt
  = -- | Interpret the prompt text as a regular command.
    --   The list is for potential completions, which we can
    --   cycle through by hitting Tab repeatedly
    CmdPrompt [Text]
  | -- | Interpret the prompt text as "search this text in history"
    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

-- | The way we interpret text typed by the player in the REPL prompt.
replPromptType :: Lens' REPLState REPLPrompt

-- | The prompt where the user can type input at the REPL.
replPromptEditor :: Lens' REPLState (Editor Text Name)

-- | Convinience lens to get text from editor and replace it with new
--   one that has the provided text.
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

-- | Whether the prompt text is a valid 'Term'.
replValid :: Lens' REPLState Bool

-- | The type of the current REPL input which should be displayed to
--   the user (if any).
replType :: Lens' REPLState (Maybe Polytype)

-- | The last thing the user has typed which isn't part of the history.
--   This is used to restore the repl form after the user visited the history.
replLast :: Lens' REPLState Text

-- | History of things the user has typed at the REPL, interleaved
--   with outputs the system has generated.
replHistory :: Lens' REPLState REPLHistory

------------------------------------------------------------
-- Menus and dialogs
------------------------------------------------------------

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 Menu
  = NoMenu -- We started playing directly from command line, no menu to show
  | MainMenu (BL.List Name MainMenuEntry)
  | NewGameMenu (NonEmpty (BL.List Name ScenarioItem)) -- stack of scenario item lists
  | MessagesMenu
  | AboutMenu

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

makePrisms ''Menu

-- | Create a brick 'BL.List' of scenario items from a 'ScenarioCollection'.
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)

-- | Given a 'ScenarioCollection' and a 'FilePath' which is the canonical
--   path to some folder or scenario, construct a 'NewGameMenu' stack
--   focused on the given item, if possible.
mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
mkNewGameMenu 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

------------------------------------------------------------
-- Inventory list entries
------------------------------------------------------------

-- | An entry in the inventory list displayed in the info panel.  We
--   can either have an entity with a count in the robot's inventory,
--   an entity installed on the robot, or a labelled separator.  The
--   purpose of the separators is to show a clear distinction between
--   the robot's /inventory/ and its /installed devices/.
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

------------------------------------------------------------
-- UI state
------------------------------------------------------------

-- | The main record holding the UI state.  For access to the fields,
-- see the lenses below.
data UIState = UIState
  { UIState -> Menu
_uiMenu :: 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
  }

--------------------------------------------------
-- Lenses for UIState

let exclude = ['_lgTicksPerSecond]
 in makeLensesWith
      ( lensRules
          & generateSignatures .~ False
          & lensField . mapped . mapped %~ \fn n ->
            if n `elem` exclude then [] else fn n
      )
      ''UIState

-- | The current menu state.
uiMenu :: Lens' UIState Menu

-- | Are we currently playing the game?  True = we are playing, and
--   should thus display a world, REPL, etc.; False = we should
--   display the current menu.
uiPlaying :: Lens' UIState Bool

-- | Cheat mode, i.e. are we allowed to turn creative mode on and off?
uiCheatMode :: Lens' UIState Bool

-- | The focus ring is the set of UI panels we can cycle among using
--   the Tab key.
uiFocusRing :: Lens' UIState (FocusRing Name)

-- | The last clicked position on the world view.
uiWorldCursor :: Lens' UIState (Maybe W.Coords)

-- | The state of REPL panel.
uiREPL :: Lens' UIState REPLState

-- | The order and direction of sorting inventory list.
uiInventorySort :: Lens' UIState InventorySortOptions

-- | The hash value of the focused robot entity (so we can tell if its
--   inventory changed) along with a list of the items in the
--   focused robot's inventory.
uiInventory :: Lens' UIState (Maybe (Int, BL.List Name InventoryListEntry))

-- | Does the info panel contain more content past the top of the panel?
uiMoreInfoTop :: Lens' UIState Bool

-- | Does the info panel contain more content past the bottom of the panel?
uiMoreInfoBot :: Lens' UIState Bool

-- | A flag telling the UI to scroll the info panel to the very end
--   (used when a new log message is appended).
uiScrollToEnd :: Lens' UIState Bool

-- | When this is @Just@, it represents a popup box containing an
--   error message that is shown on top of the rest of the UI.
uiError :: Lens' UIState (Maybe Text)

-- | When this is @Just@, it represents a modal to be displayed on
--   top of the UI, e.g. for the Help screen.
uiModal :: Lens' UIState (Maybe Modal)

-- | Status of the scenario goal: whether there is one, and whether it
--   has been displayed to the user initially.
uiGoal :: Lens' UIState (Maybe [Text])

-- | A toggle to show the FPS by pressing `f`
uiShowFPS :: Lens' UIState Bool

-- | A toggle to show or hide inventory items with count 0 by pressing `0`
uiShowZero :: Lens' UIState Bool

-- | Hide robots on the world map.
uiHideRobotsUntil :: Lens' UIState TimeSpec

-- | Whether to show or hide robots on the world map.
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)

-- | Whether the Inventory ui panel should update
uiInventoryShouldUpdate :: Lens' UIState Bool

-- | Computed ticks per milli seconds
uiTPF :: Lens' UIState Double

-- | Computed frames per milli seconds
uiFPS :: Lens' UIState Double

-- | The currently active Scenario description, useful for starting over.
scenarioRef :: Lens' UIState (Maybe ScenarioInfoPair)

-- | The base-2 logarithm of the current game speed in ticks/second.
--   Note that we cap this value to the range of +/- log2 INTMAX.
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}

-- | A counter used to track how many ticks have happened since the
--   last time we updated the ticks/frame statistics.
tickCount :: Lens' UIState Int

-- | A counter used to track how many frames have been rendered since the
--   last time we updated the ticks/frame statistics.
frameCount :: Lens' UIState Int

-- | A counter used to track how many ticks have happened in the
--   current frame, so we can stop when we get to the tick cap.
frameTickCount :: Lens' UIState Int

-- | The time of the last info widget update
lastInfoTime :: Lens' UIState TimeSpec

-- | The time of the last 'Frame' event.
lastFrameTime :: Lens' UIState TimeSpec

-- | The amount of accumulated real time.  Every time we get a 'Frame'
--   event, we accumulate the amount of real time that happened since
--   the last frame, then attempt to take an appropriate number of
--   ticks to "catch up", based on the target tick rate.
--
--   See https://gafferongames.com/post/fix_your_timestep/ .
accumulatedTime :: Lens' UIState TimeSpec

-- | Free-form data loaded from the @data@ directory, for things like
--   the logo, about page, tutorial story, etc.
appData :: Lens' UIState (Map Text Text)

-- ----------------------------------------------------------------------------
--                                Runtime state                              --
-- ----------------------------------------------------------------------------

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

-- | The port on which the HTTP debug service is running.
webPort :: Lens' RuntimeState (Maybe Port)

-- | The upstream release version.
upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)

-- | A log of runtime events.
--
-- This logging is separate from the logging done during game-play.
-- If some error happens before a game is even selected, this is the
-- place to log it.
eventLog :: Lens' RuntimeState (Notifications LogEntry)

-- | Simply log to the runtime event log.
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

-- ----------------------------------------------------------------------------
--                                   APPSTATE                                --
-- ----------------------------------------------------------------------------

-- | The 'AppState' just stores together the other states.
--
-- This is so you can use a smaller state when e.g. writing some game logic
-- or updating the UI. Also consider that GameState can change when loading
-- a new scenario - if the state should persist games, use RuntimeState.
data AppState = AppState
  { AppState -> GameState
_gameState :: GameState
  , AppState -> UIState
_uiState :: UIState
  , AppState -> RuntimeState
_runtimeState :: RuntimeState
  }

--------------------------------------------------
-- Lenses for AppState

makeLensesWith (lensRules & generateSignatures .~ False) ''AppState

-- | The 'GameState' record.
gameState :: Lens' AppState GameState

-- | The 'UIState' record.
uiState :: Lens' AppState UIState

-- | The 'RuntimeState' record
runtimeState :: Lens' AppState RuntimeState

--------------------------------------------------
-- Utility functions

-- | Get the currently focused 'InventoryListEntry' from the robot
--   info panel (if any).
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

-- | Get the currently focused entity from the robot info panel (if
--   any).  This is just like 'focusedItem' but forgets the
--   distinction between plain inventory items and installed devices.
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

--------------------------------------------------
-- UIState initialization

-- | The initial state of the focus ring.
initFocusRing :: FocusRing Name
initFocusRing :: FocusRing Name
initFocusRing = forall n. [n] -> FocusRing n
focusRing [Name
REPLPanel, Name
InfoPanel, Name
RobotPanel, Name
WorldPanel]

-- | The initial tick speed.
initLgTicksPerSecond :: Int
initLgTicksPerSecond :: Int
initLgTicksPerSecond = Int
4 -- 2^4 = 16 ticks / second

-- | Initialize the UI state.  This needs to be in the IO monad since
--   it involves reading a REPL history file, getting the current
--   time, and loading text files from the data directory.  The @Bool@
--   parameter indicates whether we should start off by showing the
--   main menu.
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
      }

------------------------------------------------------------
-- Functions for updating the UI state
------------------------------------------------------------

-- | Given the focused robot, populate the UI inventory list in the info
--   panel with information about its inventory.
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

      -- Display items if we have a positive number of them, or they
      -- aren't an installed device.  In other words we don't need to
      -- display installed devices twice unless we actually have some
      -- in our inventory in addition to being installed.
      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"))

      -- Attempt to keep the selected element steady.
      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 -- Get the currently selected element+index.
      idx :: Int
idx = case Maybe (Int, InventoryListEntry)
sel of
        -- If there is no currently selected element, just focus on
        -- index 1 (not 0, to avoid the separator).
        Maybe (Int, InventoryListEntry)
Nothing -> Int
1
        -- Otherwise, try to find the same entry in the list;
        -- if it's not there, keep the index the same.
        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

      -- Create the new list, focused at the desired index.
      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

  -- Finally, populate the newly created list in the UI, and remember
  -- the hash of the current robot.
  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)

------------------------------------------------------------
-- App state (= UI state + game state) initialization
------------------------------------------------------------

-- | Command-line options for configuring the app.
data AppOpts = AppOpts
  { -- | Explicit seed chosen by the user.
    AppOpts -> Maybe Int
userSeed :: Maybe Seed
  , -- | Scenario the user wants to play.
    AppOpts -> Maybe FilePath
userScenario :: Maybe FilePath
  , -- | Code to be run on base.
    AppOpts -> Maybe FilePath
scriptToRun :: Maybe FilePath
  , -- | Automatically run the solution defined in the scenario file
    AppOpts -> Bool
autoPlay :: Bool
  , -- | Should cheat mode be enabled?
    AppOpts -> Bool
cheatMode :: Bool
  , -- | Explicit port on which to run the web API
    AppOpts -> Maybe Int
userWebPort :: Maybe Port
  , -- | Information about the Git repository (not present in release).
    AppOpts -> Maybe GitInfo
repoGitInfo :: Maybe GitInfo
  }

-- | Initialize the 'AppState'.
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)

-- | Load a 'Scenario' and start playing the game.
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

-- | Re-initialize the game from the stored reference to the current scenario.
--
-- Note that "restarting" is intended only for "scenarios";
-- with some scenarios, it may be possible to get stuck so that it is
-- either impossible or very annoying to win, so being offered an
-- option to restart is more user-friendly.
--
-- Since scenarios are stored as a Maybe in the UI state, we handle the Nothing
-- case upstream so that the Scenario passed to this function definitely exists.
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

-- | Load a 'Scenario' and start playing the game, with the
--   possibility for the user to override the seed.
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

-- | Extract the scenario which would come next in the menu from the
--   currently selected scenario (if any).  Can return @Nothing@ if
--   either we are not in the @NewGameMenu@, or the current scenario
--   is the last among its siblings.
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

-- | Context for the REPL commands to execute in. Contains the base
--   robot context plus the `it` variable that refer to the previously
--   computed values. (Note that `it{n}` variables are set in the
--   base robot context; we only set `it` here because it's so transient)
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

-- XXX do we need to keep an old entity map around???

-- | Modify the 'AppState' appropriately when starting a new scenario.
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'

-- | Modify the UI state appropriately when starting a new scenario.
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