License | BSD-3-Clause |
---|---|
Safe Haskell | None |
Language | Haskell2010 |
Swarm.Game.State.Substate
Description
Subrecord definitions that belong to GameState
Synopsis
- data GameStateConfig = GameStateConfig {
- initAppDataMap :: Map Text Text
- nameParts :: NameGenerator
- startPaused :: Bool
- pauseOnObjectiveCompletion :: Bool
- initState :: GameStateInputs
- data REPLStatus
- = REPLDone (Maybe (Polytype, Value))
- | REPLWorking Polytype (Maybe Value)
- data WinStatus
- data WinCondition
- data ObjectiveCompletion
- _NoWinCondition :: Prism' WinCondition ()
- _WinConditions :: Prism' WinCondition (WinStatus, ObjectiveCompletion)
- newtype Announcement = ObjectiveCompleted Objective
- data RunStatus
- data Step
- data SingleStep
- data Randomness
- initRandomness :: Randomness
- seed :: Lens' Randomness Seed
- randGen :: Lens' Randomness StdGen
- data TemporalState
- data PauseOnObjective
- initTemporalState :: Bool -> TemporalState
- gameStep :: Lens' TemporalState Step
- runStatus :: Lens' TemporalState RunStatus
- ticks :: Lens' TemporalState TickNumber
- robotStepsPerTick :: Lens' TemporalState Int
- paused :: Getter TemporalState Bool
- pauseOnObjective :: Lens' TemporalState PauseOnObjective
- data Recipes
- initRecipeMaps :: GameStateConfig -> Recipes
- recipesOut :: Lens' Recipes (IntMap [Recipe Entity])
- recipesIn :: Lens' Recipes (IntMap [Recipe Entity])
- recipesCat :: Lens' Recipes (IntMap [Recipe Entity])
- data Messages
- initMessages :: Messages
- messageQueue :: Lens' Messages (Seq LogEntry)
- lastSeenMessageTime :: Lens' Messages TickNumber
- announcementQueue :: Lens' Messages (Seq Announcement)
- data GameControls
- initGameControls :: GameControls
- initiallyRunCode :: Lens' GameControls (Maybe Syntax)
- replStatus :: Lens' GameControls REPLStatus
- replNextValueIndex :: Lens' GameControls Integer
- replListener :: Lens' GameControls (Text -> IO ())
- inputHandler :: Lens' GameControls (Maybe (Text, Value))
- data Discovery
- initDiscovery :: Discovery
- allDiscoveredEntities :: Lens' Discovery Inventory
- availableRecipes :: Lens' Discovery (Notifications (Recipe Entity))
- availableCommands :: Lens' Discovery (Notifications Const)
- knownEntities :: Lens' Discovery (Set EntityName)
- craftableDevices :: Lens' Discovery (Set EntityName)
- gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)
- structureRecognition :: Lens' Discovery (RecognitionState RecognizableStructureContent Entity)
- tagMembers :: Lens' Discovery (Map Text (NonEmpty EntityName))
- data Notifications a = Notifications {}
- notificationsCount :: forall a f. Functor f => (Int -> f Int) -> Notifications a -> f (Notifications a)
- notificationsShouldAlert :: forall a f. Functor f => (Bool -> f Bool) -> Notifications a -> f (Notifications a)
- notificationsContent :: forall a1 a2 f. Functor f => ([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
- defaultRobotStepsPerTick :: Int
- replActiveType :: Getter REPLStatus (Maybe Polytype)
- replWorking :: Getter GameControls Bool
- toggleRunStatus :: RunStatus -> RunStatus
Documentation
data GameStateConfig #
Record to pass information needed to create an initial
GameState
record when starting a scenario.
Constructors
GameStateConfig | |
Fields
|
data REPLStatus Source #
A data type to represent the current status of the REPL.
Constructors
REPLDone (Maybe (Polytype, Value)) | The REPL is not doing anything actively at the moment. We persist the last value and its type though. |
REPLWorking Polytype (Maybe Value) | A command entered at the REPL is currently being run. The
|
Instances
Constructors
Ongoing | There are one or more objectives remaining that the player has not yet accomplished. |
Won Bool TickNumber | The player has won. The boolean indicates whether they have already been congratulated. |
Unwinnable Bool | The player has completed certain "goals" that preclude (via negative prerequisites) the completion of all of the required goals. The boolean indicates whether they have already been informed. |
Instances
FromJSON WinStatus Source # | |||||
Defined in Swarm.Game.State.Substate | |||||
ToJSON WinStatus Source # | |||||
Generic WinStatus Source # | |||||
Defined in Swarm.Game.State.Substate Associated Types
| |||||
Show WinStatus Source # | |||||
Eq WinStatus Source # | |||||
type Rep WinStatus Source # | |||||
Defined in Swarm.Game.State.Substate type Rep WinStatus = D1 ('MetaData "WinStatus" "Swarm.Game.State.Substate" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "Ongoing" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Won" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 TickNumber)) :+: C1 ('MetaCons "Unwinnable" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool)))) |
data WinCondition Source #
Constructors
NoWinCondition | There is no winning condition. |
WinConditions WinStatus ObjectiveCompletion | NOTE: It is possible to continue to achieve "optional" objectives even after the game has been won (or deemed unwinnable). |
Instances
FromJSON WinCondition Source # | |||||
Defined in Swarm.Game.State.Substate | |||||
ToJSON WinCondition Source # | |||||
Defined in Swarm.Game.State.Substate Methods toJSON :: WinCondition -> Value # toEncoding :: WinCondition -> Encoding # toJSONList :: [WinCondition] -> Value # toEncodingList :: [WinCondition] -> Encoding # omitField :: WinCondition -> Bool # | |||||
Generic WinCondition Source # | |||||
Defined in Swarm.Game.State.Substate Associated Types
| |||||
Show WinCondition Source # | |||||
Defined in Swarm.Game.State.Substate Methods showsPrec :: Int -> WinCondition -> ShowS # show :: WinCondition -> String # showList :: [WinCondition] -> ShowS # | |||||
ToSample WinCondition Source # | |||||
Defined in Swarm.Game.State.Substate Methods toSamples :: Proxy WinCondition -> [(Text, WinCondition)] # | |||||
type Rep WinCondition Source # | |||||
Defined in Swarm.Game.State.Substate type Rep WinCondition = D1 ('MetaData "WinCondition" "Swarm.Game.State.Substate" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "NoWinCondition" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WinConditions" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 WinStatus) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ObjectiveCompletion))) |
data ObjectiveCompletion #
A record to keep track of the completion status of all a scenario's objectives. We do not export the constructor or record field labels of this type in order to ensure that its internal invariants cannot be violated.
Instances
FromJSON ObjectiveCompletion | |||||
Defined in Swarm.Game.Scenario.Objective Methods parseJSON :: Value -> Parser ObjectiveCompletion # parseJSONList :: Value -> Parser [ObjectiveCompletion] # | |||||
ToJSON ObjectiveCompletion | |||||
Defined in Swarm.Game.Scenario.Objective Methods toJSON :: ObjectiveCompletion -> Value # toEncoding :: ObjectiveCompletion -> Encoding # toJSONList :: [ObjectiveCompletion] -> Value # toEncodingList :: [ObjectiveCompletion] -> Encoding # omitField :: ObjectiveCompletion -> Bool # | |||||
Generic ObjectiveCompletion | |||||
Defined in Swarm.Game.Scenario.Objective Associated Types
Methods from :: ObjectiveCompletion -> Rep ObjectiveCompletion x # to :: Rep ObjectiveCompletion x -> ObjectiveCompletion # | |||||
Show ObjectiveCompletion | |||||
Defined in Swarm.Game.Scenario.Objective Methods showsPrec :: Int -> ObjectiveCompletion -> ShowS # show :: ObjectiveCompletion -> String # showList :: [ObjectiveCompletion] -> ShowS # | |||||
type Rep ObjectiveCompletion | |||||
Defined in Swarm.Game.Scenario.Objective type Rep ObjectiveCompletion = D1 ('MetaData "ObjectiveCompletion" "Swarm.Game.Scenario.Objective" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-scenario" 'False) (C1 ('MetaCons "ObjectiveCompletion" 'PrefixI 'True) (S1 ('MetaSel ('Just "_completionBuckets") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 CompletionBuckets) :*: S1 ('MetaSel ('Just "_completedIDs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Set ObjectiveLabel)))) |
_NoWinCondition :: Prism' WinCondition () Source #
newtype Announcement #
TODO: #1044 Could also add an ObjectiveFailed constructor...
Constructors
ObjectiveCompleted Objective |
Instances
ToJSON Announcement | |||||
Defined in Swarm.Game.Scenario.Objective Methods toJSON :: Announcement -> Value # toEncoding :: Announcement -> Encoding # toJSONList :: [Announcement] -> Value # toEncodingList :: [Announcement] -> Encoding # omitField :: Announcement -> Bool # | |||||
Generic Announcement | |||||
Defined in Swarm.Game.Scenario.Objective Associated Types
| |||||
Show Announcement | |||||
Defined in Swarm.Game.Scenario.Objective Methods showsPrec :: Int -> Announcement -> ShowS # show :: Announcement -> String # showList :: [Announcement] -> ShowS # | |||||
type Rep Announcement | |||||
Defined in Swarm.Game.Scenario.Objective type Rep Announcement = D1 ('MetaData "Announcement" "Swarm.Game.Scenario.Objective" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-scenario" 'True) (C1 ('MetaCons "ObjectiveCompleted" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Objective))) |
A data type to keep track of the pause mode.
Constructors
Running | The game is running. |
ManualPause | The user paused the game, and it should stay pause after visiting the help. |
AutoPause | The game got paused while visiting the help, and it should unpause after returning back to the game. |
Instances
FromJSON RunStatus Source # | |||||
Defined in Swarm.Game.State.Substate | |||||
ToJSON RunStatus Source # | |||||
Generic RunStatus Source # | |||||
Defined in Swarm.Game.State.Substate Associated Types
| |||||
Show RunStatus Source # | |||||
Eq RunStatus Source # | |||||
type Rep RunStatus Source # | |||||
Defined in Swarm.Game.State.Substate type Rep RunStatus = D1 ('MetaData "RunStatus" "Swarm.Game.State.Substate" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "Running" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ManualPause" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "AutoPause" 'PrefixI 'False) (U1 :: Type -> Type))) |
Game step mode - we use the single step mode when debugging robot CESK
machine.
Constructors
WorldTick | |
RobotStep SingleStep |
data SingleStep Source #
Type for remembering which robots will be run next in a robot step mode.
Once some robots have run, we need to store RID
to know which ones should go next.
At SBefore
no robots were run yet, so it is safe to transition to and from WorldTick
.
tick ┌────────────────────────────────────┐ │ │ │ step │ │ ┌────┐ │ ▼ ▼ │ │ ┌───────┐ step ┌───────┴───┐ step ┌────┴─────┐ │SBefore├──────►│SSingle RID├──────►│SAfter RID│ └──┬────┘ └───────────┘ └────┬─────┘ │ ▲ player ▲ │ ▼ │ switch └───────────────────┘ ┌────┴────┐ view RID > oldRID │WorldTick│ └─────────┘
GameState fields
Randomness state
data Randomness Source #
seed :: Lens' Randomness Seed Source #
The initial seed that was used for the random number generator, and world generation.
Temporal state
data TemporalState Source #
data PauseOnObjective Source #
Constructors
PauseOnWin | |
PauseOnAnyObjective |
Instances
Bounded PauseOnObjective Source # | |
Defined in Swarm.Game.State.Substate | |
Enum PauseOnObjective Source # | |
Defined in Swarm.Game.State.Substate Methods succ :: PauseOnObjective -> PauseOnObjective # pred :: PauseOnObjective -> PauseOnObjective # toEnum :: Int -> PauseOnObjective # fromEnum :: PauseOnObjective -> Int # enumFrom :: PauseOnObjective -> [PauseOnObjective] # enumFromThen :: PauseOnObjective -> PauseOnObjective -> [PauseOnObjective] # enumFromTo :: PauseOnObjective -> PauseOnObjective -> [PauseOnObjective] # enumFromThenTo :: PauseOnObjective -> PauseOnObjective -> PauseOnObjective -> [PauseOnObjective] # | |
Show PauseOnObjective Source # | |
Defined in Swarm.Game.State.Substate Methods showsPrec :: Int -> PauseOnObjective -> ShowS # show :: PauseOnObjective -> String # showList :: [PauseOnObjective] -> ShowS # | |
Eq PauseOnObjective Source # | |
Defined in Swarm.Game.State.Substate Methods (==) :: PauseOnObjective -> PauseOnObjective -> Bool # (/=) :: PauseOnObjective -> PauseOnObjective -> Bool # | |
Ord PauseOnObjective Source # | |
Defined in Swarm.Game.State.Substate Methods compare :: PauseOnObjective -> PauseOnObjective -> Ordering # (<) :: PauseOnObjective -> PauseOnObjective -> Bool # (<=) :: PauseOnObjective -> PauseOnObjective -> Bool # (>) :: PauseOnObjective -> PauseOnObjective -> Bool # (>=) :: PauseOnObjective -> PauseOnObjective -> Bool # max :: PauseOnObjective -> PauseOnObjective -> PauseOnObjective # min :: PauseOnObjective -> PauseOnObjective -> PauseOnObjective # |
ticks :: Lens' TemporalState TickNumber Source #
The number of ticks elapsed since the game started.
robotStepsPerTick :: Lens' TemporalState Int Source #
The maximum number of CESK machine steps a robot may take during a single tick.
pauseOnObjective :: Lens' TemporalState PauseOnObjective Source #
Whether to pause the game after an objective is completed.
Recipes
recipesOut :: Lens' Recipes (IntMap [Recipe Entity]) Source #
All recipes the game knows about, indexed by outputs.
recipesIn :: Lens' Recipes (IntMap [Recipe Entity]) Source #
All recipes the game knows about, indexed by inputs.
recipesCat :: Lens' Recipes (IntMap [Recipe Entity]) Source #
All recipes the game knows about, indexed by requirement/catalyst.
Messages
messageQueue :: Lens' Messages (Seq LogEntry) Source #
A queue of global messages.
Note that we put the newest entry to the right.
lastSeenMessageTime :: Lens' Messages TickNumber Source #
Last time message queue has been viewed (used for notification).
announcementQueue :: Lens' Messages (Seq Announcement) Source #
A queue of global announcements.
Note that this is distinct from the messageQueue
,
which is for messages emitted by robots.
Note that we put the newest entry to the right.
Controls
data GameControls Source #
initiallyRunCode :: Lens' GameControls (Maybe Syntax) Source #
Code that is run upon scenario start, before any REPL interaction.
replStatus :: Lens' GameControls REPLStatus Source #
The current status of the REPL.
replNextValueIndex :: Lens' GameControls Integer Source #
The index of the next it{index}
value
replListener :: Lens' GameControls (Text -> IO ()) Source #
The action to be run after transitioning to REPLDone. This is used to tell Web API the result of run command.
inputHandler :: Lens' GameControls (Maybe (Text, Value)) Source #
The currently installed input handler and hint text.
Discovery
allDiscoveredEntities :: Lens' Discovery Inventory Source #
The list of entities that have been discovered.
availableRecipes :: Lens' Discovery (Notifications (Recipe Entity)) Source #
The list of available recipes.
availableCommands :: Lens' Discovery (Notifications Const) Source #
The list of available commands.
knownEntities :: Lens' Discovery (Set EntityName) Source #
The names of entities that should be considered "known", that is, robots know what they are without having to scan them.
craftableDevices :: Lens' Discovery (Set EntityName) Source #
The set of all entities that can be crafted in the current scenario.
gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment) Source #
Map of in-game achievements that were obtained
structureRecognition :: Lens' Discovery (RecognitionState RecognizableStructureContent Entity) Source #
Recognizer for robot-constructed structures
tagMembers :: Lens' Discovery (Map Text (NonEmpty EntityName)) Source #
Map from tags to entities that possess that tag
Notifications
data Notifications a Source #
A data type to keep track of some kind of log or sequence, with an index to remember which ones are "new", which ones have "already been seen", and whether the user has yet been notified of the fact that there are unseen notifications.
Constructors
Notifications | |
Fields |
Instances
FromJSON a => FromJSON (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate Methods parseJSON :: Value -> Parser (Notifications a) # parseJSONList :: Value -> Parser [Notifications a] # omittedField :: Maybe (Notifications a) # | |||||
ToJSON a => ToJSON (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate Methods toJSON :: Notifications a -> Value # toEncoding :: Notifications a -> Encoding # toJSONList :: [Notifications a] -> Value # toEncodingList :: [Notifications a] -> Encoding # omitField :: Notifications a -> Bool # | |||||
Monoid (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate Methods mempty :: Notifications a # mappend :: Notifications a -> Notifications a -> Notifications a # mconcat :: [Notifications a] -> Notifications a # | |||||
Semigroup (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate Methods (<>) :: Notifications a -> Notifications a -> Notifications a # sconcat :: NonEmpty (Notifications a) -> Notifications a # stimes :: Integral b => b -> Notifications a -> Notifications a # | |||||
Generic (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate Associated Types
Methods from :: Notifications a -> Rep (Notifications a) x # to :: Rep (Notifications a) x -> Notifications a # | |||||
Show a => Show (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate Methods showsPrec :: Int -> Notifications a -> ShowS # show :: Notifications a -> String # showList :: [Notifications a] -> ShowS # | |||||
Eq a => Eq (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate Methods (==) :: Notifications a -> Notifications a -> Bool # (/=) :: Notifications a -> Notifications a -> Bool # | |||||
type Rep (Notifications a) Source # | |||||
Defined in Swarm.Game.State.Substate type Rep (Notifications a) = D1 ('MetaData "Notifications" "Swarm.Game.State.Substate" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "Notifications" 'PrefixI 'True) (S1 ('MetaSel ('Just "_notificationsCount") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Just "_notificationsShouldAlert") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "_notificationsContent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [a])))) |
notificationsCount :: forall a f. Functor f => (Int -> f Int) -> Notifications a -> f (Notifications a) Source #
notificationsShouldAlert :: forall a f. Functor f => (Bool -> f Bool) -> Notifications a -> f (Notifications a) Source #
notificationsContent :: forall a1 a2 f. Functor f => ([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2) Source #
Utilities
defaultRobotStepsPerTick :: Int Source #
By default, robots may make a maximum of 100 CESK machine steps during one game tick.
replActiveType :: Getter REPLStatus (Maybe Polytype) Source #
Either the type of the command being executed, or of the last command
replWorking :: Getter GameControls Bool Source #
Whether the repl is currently working.
toggleRunStatus :: RunStatus -> RunStatus Source #
Switch (auto or manually) paused game to running and running to manually paused.
Note that this function is not safe to use in the app directly, because the UI
also tracks time between ticks---use safeTogglePause
instead.