swarm-0.7.0.0: 2D resource gathering game with programmable robots
LicenseBSD-3-Clause
Safe HaskellNone
LanguageHaskell2010

Swarm.Game.State.Substate

Description

Subrecord definitions that belong to GameState

Synopsis

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 Polytype represents the type of the expression that was entered. The Maybe Value starts out as Nothing and gets filled in with a result once the command completes.

Instances

Instances details
ToJSON REPLStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Generic REPLStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Associated Types

type Rep REPLStatus 
Instance details

Defined in Swarm.Game.State.Substate

type Rep REPLStatus = D1 ('MetaData "REPLStatus" "Swarm.Game.State.Substate" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "REPLDone" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe (Polytype, Value)))) :+: C1 ('MetaCons "REPLWorking" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Polytype) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Value))))
Eq REPLStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

type Rep REPLStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

type Rep REPLStatus = D1 ('MetaData "REPLStatus" "Swarm.Game.State.Substate" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "REPLDone" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe (Polytype, Value)))) :+: C1 ('MetaCons "REPLWorking" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Polytype) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Value))))

data WinStatus Source #

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

Instances details
FromJSON WinStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

ToJSON WinStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Generic WinStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Associated Types

type Rep WinStatus 
Instance details

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))))
Show WinStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Eq WinStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

type Rep WinStatus Source # 
Instance details

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

Instances details
FromJSON WinCondition Source # 
Instance details

Defined in Swarm.Game.State.Substate

ToJSON WinCondition Source # 
Instance details

Defined in Swarm.Game.State.Substate

Generic WinCondition Source # 
Instance details

Defined in Swarm.Game.State.Substate

Associated Types

type Rep WinCondition 
Instance details

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)))
Show WinCondition Source # 
Instance details

Defined in Swarm.Game.State.Substate

ToSample WinCondition Source # 
Instance details

Defined in Swarm.Game.State.Substate

type Rep WinCondition Source # 
Instance details

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

Instances details
FromJSON ObjectiveCompletion 
Instance details

Defined in Swarm.Game.Scenario.Objective

ToJSON ObjectiveCompletion 
Instance details

Defined in Swarm.Game.Scenario.Objective

Generic ObjectiveCompletion 
Instance details

Defined in Swarm.Game.Scenario.Objective

Associated Types

type Rep ObjectiveCompletion 
Instance details

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))))
Show ObjectiveCompletion 
Instance details

Defined in Swarm.Game.Scenario.Objective

type Rep ObjectiveCompletion 
Instance details

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

newtype Announcement #

TODO: #1044 Could also add an ObjectiveFailed constructor...

Instances

Instances details
ToJSON Announcement 
Instance details

Defined in Swarm.Game.Scenario.Objective

Generic Announcement 
Instance details

Defined in Swarm.Game.Scenario.Objective

Associated Types

type Rep Announcement 
Instance details

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)))
Show Announcement 
Instance details

Defined in Swarm.Game.Scenario.Objective

type Rep Announcement 
Instance details

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

data RunStatus Source #

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

Instances details
FromJSON RunStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

ToJSON RunStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Generic RunStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Associated Types

type Rep RunStatus 
Instance details

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)))
Show RunStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

Eq RunStatus Source # 
Instance details

Defined in Swarm.Game.State.Substate

type Rep RunStatus Source # 
Instance details

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

data Step Source #

Game step mode - we use the single step mode when debugging robot CESK machine.

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│
└─────────┘

Constructors

SBefore

Run the robots from the beginning until the focused robot (noninclusive).

SSingle RID

Run a single step of the focused robot.

SAfter RID

Run robots after the (previously) focused robot and finish the tick.

GameState fields

Randomness state

seed :: Lens' Randomness Seed Source #

The initial seed that was used for the random number generator, and world generation.

randGen :: Lens' Randomness StdGen Source #

Pseudorandom generator initialized at start.

Temporal state

data PauseOnObjective Source #

Instances

Instances details
Bounded PauseOnObjective Source # 
Instance details

Defined in Swarm.Game.State.Substate

Enum PauseOnObjective Source # 
Instance details

Defined in Swarm.Game.State.Substate

Show PauseOnObjective Source # 
Instance details

Defined in Swarm.Game.State.Substate

Eq PauseOnObjective Source # 
Instance details

Defined in Swarm.Game.State.Substate

Ord PauseOnObjective Source # 
Instance details

Defined in Swarm.Game.State.Substate

gameStep :: Lens' TemporalState Step Source #

How to step the game: WorldTick or RobotStep for debugging the CESK machine.

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.

paused :: Getter TemporalState Bool Source #

Whether the game is currently paused.

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

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.

Instances

Instances details
FromJSON a => FromJSON (Notifications a) Source # 
Instance details

Defined in Swarm.Game.State.Substate

ToJSON a => ToJSON (Notifications a) Source # 
Instance details

Defined in Swarm.Game.State.Substate

Monoid (Notifications a) Source # 
Instance details

Defined in Swarm.Game.State.Substate

Semigroup (Notifications a) Source # 
Instance details

Defined in Swarm.Game.State.Substate

Generic (Notifications a) Source # 
Instance details

Defined in Swarm.Game.State.Substate

Associated Types

type Rep (Notifications a) 
Instance details

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]))))
Show a => Show (Notifications a) Source # 
Instance details

Defined in Swarm.Game.State.Substate

Eq a => Eq (Notifications a) Source # 
Instance details

Defined in Swarm.Game.State.Substate

type Rep (Notifications a) Source # 
Instance details

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.