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

Swarm.Game.State

Description

Definition of the record holding all the game-related state, and various related utility functions.

Synopsis

Game state record

data GameState Source #

The main record holding the state for the game itself (as distinct from the UI). See the lenses below for access to its fields.

To answer the question of what belongs in the GameState and what belongs in the UIState, ask yourself the question: is this something specific to a particular UI, or is it something inherent to the game which would be needed even if we put a different UI on top (web-based, GUI-based, etc.)? For example, tracking whether the game is paused needs to be in the GameState: especially if we want to have the game running in one thread and the UI running in another thread, then the game itself needs to keep track of whether it is currently paused, so that it can know whether to step independently of the UI telling it so. For example, the game may run for several ticks during a single frame, but if an objective is completed during one of those ticks, the game needs to immediately auto-pause without waiting for the UI to tell it that it should do so, which could come several ticks late.

creativeMode :: Lens' GameState Bool Source #

Is the user in creative mode (i.e. able to do anything without restriction)?

winCondition :: Lens' GameState WinCondition Source #

How to determine whether the player has won.

winSolution :: Lens' GameState (Maybe TSyntax) Source #

How to win (if possible). This is useful for automated testing and to show help to cheaters (or testers).

completionStatsSaved :: Lens' GameState Bool Source #

Whether statistics for the current scenario have been saved to disk *upon scenario completion*. (It should remain False whenever the current scenario has not been completed, either because there is no win condition or because the player has not yet achieved it.) If this is set to True, we should not update completion statistics any more. We need this to make sure we don't overwrite statistics if the user continues playing the scenario after completing it (or even if the user stays in the completion menu for a while before quitting; see #1932).

Launch parameters

type ValidatedLaunchParams = LaunchParams Identity Source #

In this stage in the UI pipeline, both fields have already been validated, and Nothing means that the field is simply absent.

Subrecord accessors

temporal :: Lens' GameState TemporalState Source #

Aspects of the temporal state of the game

robotNaming :: Lens' Robots RobotNaming Source #

State and data for assigning identifiers to robots

recipesInfo :: Lens' GameState Recipes Source #

Collection of recipe info

gameControls :: Lens' GameState GameControls Source #

Controls, including REPL and key mapping

randomness :: Lens' GameState Randomness Source #

Inputs for randomness

discovery :: Lens' GameState Discovery Source #

Discovery state of entities, commands, recipes

landscape :: Lens' GameState Landscape Source #

Info about the lay of the land

robotInfo :: Lens' GameState Robots Source #

Info about robots

pathCaching :: Lens' GameState PathCaching Source #

Registry for caching output of the path command

GameState initialization

initGameState :: GameStateConfig -> GameState Source #

Create an initial, fresh game state record when starting a new scenario.

data CodeToRun Source #

Constructors

CodeToRun 

newtype Sha1 Source #

Constructors

Sha1 String 

Instances

Instances details
ToJSON Sha1 Source # 
Instance details

Defined in Swarm.Game.State

Generic Sha1 Source # 
Instance details

Defined in Swarm.Game.State

Associated Types

type Rep Sha1 
Instance details

Defined in Swarm.Game.State

type Rep Sha1 = D1 ('MetaData "Sha1" "Swarm.Game.State" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'True) (C1 ('MetaCons "Sha1" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))

Methods

from :: Sha1 -> Rep Sha1 x #

to :: Rep Sha1 x -> Sha1 #

Show Sha1 Source # 
Instance details

Defined in Swarm.Game.State

Methods

showsPrec :: Int -> Sha1 -> ShowS #

show :: Sha1 -> String #

showList :: [Sha1] -> ShowS #

Eq Sha1 Source # 
Instance details

Defined in Swarm.Game.State

Methods

(==) :: Sha1 -> Sha1 -> Bool #

(/=) :: Sha1 -> Sha1 -> Bool #

Ord Sha1 Source # 
Instance details

Defined in Swarm.Game.State

Methods

compare :: Sha1 -> Sha1 -> Ordering #

(<) :: Sha1 -> Sha1 -> Bool #

(<=) :: Sha1 -> Sha1 -> Bool #

(>) :: Sha1 -> Sha1 -> Bool #

(>=) :: Sha1 -> Sha1 -> Bool #

max :: Sha1 -> Sha1 -> Sha1 #

min :: Sha1 -> Sha1 -> Sha1 #

type Rep Sha1 Source # 
Instance details

Defined in Swarm.Game.State

type Rep Sha1 = D1 ('MetaData "Sha1" "Swarm.Game.State" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'True) (C1 ('MetaCons "Sha1" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))

data SolutionSource Source #

Constructors

ScenarioSuggested 
PlayerAuthored FilePath Sha1

Includes the SHA1 of the program text for the purpose of corroborating solutions on a leaderboard.

parseCodeFile :: forall (sig :: (Type -> Type) -> Type -> Type) m. (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) => FilePath -> m CodeToRun Source #

Utilities

robotsAtLocation :: Cosmic Location -> GameState -> [Robot] Source #

Get a list of all the robots at a particular location.

robotsInArea :: Cosmic Location -> Int32 -> Robots -> [Robot] Source #

Get all the robots within a given Manhattan distance from a location.

baseRobot :: Traversal' GameState Robot Source #

The base robot, if it exists.

baseEnv :: Traversal' GameState Env Source #

The base robot environment.

baseStore :: Getter GameState Store Source #

The base robot store, or the empty store if there is no base robot.

messageNotifications :: Getter GameState (Notifications LogEntry) Source #

Get the notification list of messages from the point of view of focused robot.

currentScenarioPath :: Lens' GameState (Maybe ScenarioPath) Source #

The filepath of the currently running scenario.

This is useful as an index to the scenarios collection, see scenarioItemByPath.

Note that it is possible for this to be missing even with an active game state, since the game state can be initialized from sources other than a scenario file on disk.

We keep a reference to the possible path within the GameState, however, so that the achievement/progress saving functions do not require access to anything outside GameState.

needsRedraw :: Lens' GameState Bool Source #

Whether the world view needs to be redrawn.

replWorking :: Getter GameControls Bool Source #

Whether the repl is currently working.

recalcViewCenterAndRedraw :: GameState -> GameState Source #

Recalculate the view center (and cache the result in the viewCenter field) based on the current viewCenterRule. If the viewCenterRule specifies a robot which does not exist, simply leave the current viewCenter as it is. Set needsRedraw if the view center changes.

viewingRegion :: Cosmic Location -> (Int32, Int32) -> Cosmic BoundsRectangle Source #

Given a width and height, compute the region, centered on the viewCenter, that should currently be in view.

focusedRobot :: GameState -> Maybe Robot Source #

Find out which robot has been last specified by the viewCenterRule, if any.

data RobotRange Source #

Type for describing how far away a robot is from the base, which determines what kind of communication can take place.

Constructors

Close

Close; communication is perfect.

MidRange Double

Mid-range; communication is possible but lossy.

Far

Far; communication is not possible.

focusedRange :: GameState -> Maybe RobotRange Source #

Check how far away the focused robot is from the base. Nothing is returned if there is no focused robot; otherwise, return a RobotRange value as follows.

  • If we are in creative or scroll-enabled mode, the focused robot is always considered Close.
  • Otherwise, there is a "minimum radius" and "maximum radius".

    • If the robot is within the minimum radius, it is Close.
    • If the robot is between the minimum and maximum radii, it is MidRange, with a Double value ranging linearly from 0 to 1 proportional to the distance from the minimum to maximum radius. For example, MidRange 0.5 would indicate a robot exactly halfway between the minimum and maximum radii.
    • If the robot is beyond the maximum radius, it is Far.
  • By default, the minimum radius is 16, and maximum is 64.
  • Device augmentations

    • If the focused robot has an antenna installed, it doubles both radii.
    • If the base has an antenna installed, it also doubles both radii.

getRadioRange :: Maybe Robot -> Maybe Robot -> (Double, Double) Source #

Get the min/max communication radii given possible augmentations on each end

clearFocusedRobotLogUpdated :: forall (sig :: (Type -> Type) -> Type -> Type) m. Has (State Robots) sig m => m () Source #

Clear the robotLogUpdated flag of the focused robot.

emitMessage :: forall (sig :: (Type -> Type) -> Type -> Type) m. Has (State GameState) sig m => LogEntry -> m () Source #

Add a message to the message queue.

messageIsFromNearby :: Cosmic Location -> LogEntry -> Bool Source #

Reconciles the possibilities of log messages being omnipresent and robots being in different worlds

genRobotTemplates :: ScenarioLandscape -> NonEmpty (a, ([(Int, TRobot)], b)) -> [TRobot] #

Returns a list of robots, ordered by decreasing preference to serve as the "base".

Rules for selecting the "base" robot:

What follows is a thorough description of how the base choice is made as of the most recent study of the code. This level of detail is not meant to be public-facing.

For an abbreviated explanation, see the "Base robot" section of the Scenario Authoring Guide.

Precedence rules

  1. Prefer those robots defined with a loc (robotLocation) in the scenario file

    1. If multiple robots define a loc, use the robot that is defined first within the scenario file.
    2. Note that if a robot is both given a loc AND is specified in the world map, then two instances of the robot shall be created. The instance with the loc shall be preferred as the base.
  1. Fall back to robots generated from templates via the map and palette.

    1. If multiple robots are specified in the map, prefer the one that is defined first within the scenario file.
    2. If multiple robots are instantiated from the same template, then prefer the one with a lower-indexed subworld. Note that the root subworld is always first.
    3. If multiple robots instantiated from the same template are in the same subworld, then prefer the one closest to the upper-left of the screen, with higher rows given precedence over columns (i.e. first in row-major order).

entityAt :: forall (sig :: (Type -> Type) -> Type -> Type) m. Has (State GameState) sig m => Cosmic Location -> m (Maybe Entity) Source #

Get the entity (if any) at a given location.

mtlEntityAt :: Cosmic Location -> State GameState (Maybe Entity) Source #

Provide an entity accessor via the MTL transformer State API. This is useful for the structure recognizer.

contentAt :: forall (sig :: (Type -> Type) -> Type -> Type) m. Has (State GameState) sig m => Cosmic Location -> m (TerrainType, Maybe Entity) Source #

zoomWorld :: forall (sig :: (Type -> Type) -> Type -> Type) m b. Has (State GameState) sig m => SubworldName -> StateC (World Int Entity) Identity b -> m (Maybe b) Source #

Perform an action requiring a World state component in a larger context with a GameState.

zoomRobots :: forall (sig :: (Type -> Type) -> Type -> Type) m b. Has (State GameState) sig m => StateC Robots Identity b -> m b Source #

Perform an action requiring a Robots state component in a larger context with a GameState.