swarm-0.5.0.0: 2D resource gathering game with programmable robots
LicenseBSD-3-Clause
Safe HaskellSafe-Inferred
LanguageHaskell2010

Swarm.Game.Robot

Description

A data type to represent robots.

Synopsis

Robots data

Robots

data RobotPhase Source #

The phase of a robot description record.

Constructors

TemplateRobot

The robot record has just been read in from a scenario description; it represents a template that may later be instantiated as one or more concrete robots.

ConcreteRobot

The robot record represents a concrete robot in the world.

type RID = Int Source #

A unique identifier for a robot.

data RobotR (phase :: RobotPhase) Source #

A value of type RobotR is a record representing the state of a single robot. The f parameter is for tracking whether or not the robot has been assigned a unique ID.

Instances

Instances details
ToJSON Robot Source # 
Instance details

Defined in Swarm.Game.Robot

ToSample Robot Source # 
Instance details

Defined in Swarm.Game.Robot

Methods

toSamples :: Proxy Robot -> [(Text, Robot)] #

Valuable Robot Source # 
Instance details

Defined in Swarm.Game.Value

Methods

asValue :: Robot -> Value Source #

FromJSONE EntityMap TRobot Source #

We can parse a robot from a YAML file if we have access to an EntityMap in which we can look up the names of entities.

Instance details

Defined in Swarm.Game.Robot

Generic (RobotR phase) Source # 
Instance details

Defined in Swarm.Game.Robot

Associated Types

type Rep (RobotR phase) :: Type -> Type #

Methods

from :: RobotR phase -> Rep (RobotR phase) x #

to :: Rep (RobotR phase) x -> RobotR phase #

(Show (RobotLocation phase), Show (RobotID phase)) => Show (RobotR phase) Source # 
Instance details

Defined in Swarm.Game.Robot

Methods

showsPrec :: Int -> RobotR phase -> ShowS #

show :: RobotR phase -> String #

showList :: [RobotR phase] -> ShowS #

(Eq (RobotLocation phase), Eq (RobotID phase)) => Eq (RobotR phase) Source # 
Instance details

Defined in Swarm.Game.Robot

Methods

(==) :: RobotR phase -> RobotR phase -> Bool #

(/=) :: RobotR phase -> RobotR phase -> Bool #

FromJSONE (EntityMap, RobotMap) Cell Source # 
Instance details

Defined in Swarm.Game.Scenario.Topography.Cell

FromJSONE (EntityMap, RobotMap) (AugmentedCell Entity) Source #

Parse a tuple such as [grass, rock, base] into a PCell. The entity and robot, if present, are immediately looked up and converted into Entity and TRobot values. If they are not found, a parse error results.

Instance details

Defined in Swarm.Game.Scenario.Topography.Cell

FromJSONE (EntityMap, RobotMap) (NamedStructure (Maybe (PCell Entity))) Source # 
Instance details

Defined in Swarm.Game.Scenario.Topography.Structure

FromJSONE (EntityMap, RobotMap) (PStructure (Maybe (PCell Entity))) Source # 
Instance details

Defined in Swarm.Game.Scenario.Topography.Structure

FromJSONE (EntityMap, RobotMap) (WorldPalette Entity) Source # 
Instance details

Defined in Swarm.Game.Scenario.Topography.WorldPalette

FromJSONE (WorldMap, InheritedStructureDefs, EntityMap, RobotMap) WorldDescription Source # 
Instance details

Defined in Swarm.Game.Scenario.Topography.WorldDescription

type Rep (RobotR phase) Source # 
Instance details

Defined in Swarm.Game.Robot

type Rep (RobotR phase)

type Robot = RobotR 'ConcreteRobot Source #

A concrete robot, with a unique ID number and a specific location.

type TRobot = RobotR 'TemplateRobot Source #

A template robot, i.e. a template robot record without a unique ID number, and possibly without a location.

Runtime robot update

data RobotUpdate Source #

Enumeration of robot updates. This type is used for changes by e.g. the drill command which must be carried out at a later tick. Using a first-order representation (as opposed to e.g. just a Robot -> Robot function) allows us to serialize and inspect the updates.

Note that this can not be in Robot as it would create a cyclic dependency.

Constructors

AddEntity Count Entity

Add copies of an entity to the robot's inventory.

LearnEntity Entity

Make the robot learn about an entity.

Instances

Instances details
FromJSON RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

ToJSON RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Generic RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Associated Types

type Rep RobotUpdate :: Type -> Type #

Show RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Eq RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Ord RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

type Rep RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Robot context

data RobotContext Source #

A record that stores the information for all definitions stored in a Robot

Instances

Instances details
FromJSON RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

ToJSON RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

Generic RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

Associated Types

type Rep RobotContext :: Type -> Type #

Show RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

Eq RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

At RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

Ixed RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

type Rep RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

type Rep RobotContext = D1 ('MetaData "RobotContext" "Swarm.Game.Robot" "swarm-0.5.0.0-6qXEbhCmuXA4wRndqqhBu" 'False) (C1 ('MetaCons "RobotContext" 'PrefixI 'True) ((S1 ('MetaSel ('Just "_defTypes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 TCtx) :*: S1 ('MetaSel ('Just "_defReqs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ReqCtx)) :*: (S1 ('MetaSel ('Just "_defVals") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env) :*: S1 ('MetaSel ('Just "_defStore") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Store))))
type Index RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

type IxValue RobotContext Source # 
Instance details

Defined in Swarm.Game.Robot

Lenses

robotEntity :: Lens' (RobotR phase) Entity Source #

Robots are not entities, but they have almost all the characteristics of one (or perhaps we could think of robots as very special sorts of entities), so for convenience each robot carries an Entity record to store all the information it has in common with any Entity.

Note there are various lenses provided for convenience that directly reference fields inside this record; for example, one can use robotName instead of writing robotEntity . entityName.

robotName :: Lens' Robot Text Source #

The name of a robot.

trobotName :: Lens' TRobot Text Source #

The name of a robot template.

unwalkableEntities :: Lens' Robot (Set EntityName) Source #

Entities that the robot cannot move onto

robotCreatedAt :: Lens' Robot TimeSpec Source #

The creation date of the robot.

robotDisplay :: Lens' Robot Display Source #

The Display of a robot. This is a special lens that automatically sets the curOrientation to the orientation of the robot every time you do a get operation. Technically this does not satisfy the lens laws---in particular, the get/put law does not hold. But we should think of the curOrientation as being simply a cache of the displayed entity's direction.

robotLocation :: Getter Robot (Cosmic Location) Source #

The robot's current location, represented as (x,y). This is only a getter, since when changing a robot's location we must remember to update the robotsByLocation map as well. You can use the updateRobotLocation function for this purpose.

unsafeSetRobotLocation :: Cosmic Location -> Robot -> Robot Source #

Set a robot's location. This is unsafe and should never be called directly except by the updateRobotLocation function. The reason is that we need to make sure the robotsByLocation map stays in sync.

trobotLocation :: Lens' TRobot (Maybe (Cosmic Location)) Source #

A template robot's location. Unlike robotLocation, this is a lens, since when dealing with robot templates there is as yet no robotsByLocation map to keep up-to-date.

robotOrientation :: Lens' Robot (Maybe Heading) Source #

Which way the robot is currently facing.

robotInventory :: Lens' Robot Inventory Source #

The robot's inventory.

equippedDevices :: Lens' Robot Inventory Source #

A separate inventory for equipped devices, which provide the robot with certain capabilities.

Note that every time the inventory of equipped devices is modified, this lens recomputes a cached set of the capabilities the equipped devices provide, to speed up subsequent lookups to see whether the robot has a certain capability (see robotCapabilities)

robotLog :: Lens' Robot (Seq LogEntry) Source #

The robot's own private message log, most recent message last. Messages can be added both by explicit use of the Log command, and by uncaught exceptions. Stored as a Seq so that we can efficiently add to the end and also process from beginning to end. Note that updating via this lens will also set the robotLogUpdated.

robotLogUpdated :: Lens' Robot Bool Source #

Has the robotLog been updated since the last time it was viewed?

inventoryHash :: Getter Robot Int Source #

A hash of a robot's entity record and equipped devices, to facilitate quickly deciding whether we need to redraw the robot info panel.

robotCapabilities :: Getter Robot (Set Capability) Source #

Get the set of capabilities this robot possesses. This is only a getter, not a lens, because it is automatically generated from the equippedDevices. The only way to change a robot's capabilities is to modify its equippedDevices.

robotContext :: Lens' Robot RobotContext Source #

The robot's context.

robotID :: Getter Robot RID Source #

The (unique) ID number of the robot. This is only a Getter since the robot ID is immutable.

robotParentID :: Lens' Robot (Maybe RID) Source #

The ID number of the robot's parent, that is, the robot that built (or most recently reprogrammed) this robot, if there is one.

robotHeavy :: Lens' Robot Bool Source #

Is this robot extra heavy (thus requiring tank treads to move)?

machine :: Lens' Robot CESK Source #

The robot's current CEK machine state.

systemRobot :: Lens' Robot Bool Source #

Is this robot a "system robot"? System robots are generated by the system (as opposed to created by the user) and are not subject to the usual capability restrictions.

selfDestruct :: Lens' Robot Bool Source #

Does this robot wish to self destruct?

runningAtomic :: Lens' Robot Bool Source #

Is the robot currently running an atomic block?

activityCounts :: Lens' Robot ActivityCounts Source #

Diagnostic and operational tracking of CESK steps or other activity

tickStepBudget :: Lens' ActivityCounts Int Source #

A counter that is decremented upon each step of the robot within the CESK machine. Initially set to robotStepsPerTick at each new tick.

The need for tickStepBudget is a bit technical, and I hope I can eventually find a different, better way to accomplish it. Ideally, we would want each robot to execute a single command at every game tick, so that e.g. two robots executing move;move;move and repeat 3 move (given a suitable definition of repeat) will move in lockstep. However, the second robot actually has to do more computation than the first (it has to look up the definition of repeat, reduce its application to the number 3, etc.), so its CESK machine will take more steps. It won't do to simply let each robot run until executing a command---because robot programs can involve arbitrary recursion, it is very easy to write a program that evaluates forever without ever executing a command, which in this scenario would completely freeze the UI. (It also wouldn't help to ensure all programs are terminating---it would still be possible to effectively do the same thing by making a program that takes a very, very long time to terminate.) So instead, we allocate each robot a certain maximum number of computation steps per tick (defined in evalStepsPerTick), and it suspends computation when it either executes a command or reaches the maximum number of steps, whichever comes first.

It seems like this really isn't something the robot should be keeping track of itself, but that seemed the most technically convenient way to do it at the time. The robot needs some way to signal when it has executed a command, which it currently does by setting tickStepBudget to zero. However, that has the disadvantage that when tickStepBudget becomes zero, we can't tell whether that happened because the robot ran out of steps, or because it executed a command and set it to zero manually.

Perhaps instead, each robot should keep a counter saying how many commands it has executed. The loop stepping the robot can tell when the counter increments.

tangibleCommandCount :: Lens' ActivityCounts Int Source #

Total number of tangible commands executed over robot's lifetime

commandsHistogram :: Lens' ActivityCounts (Map Const Int) Source #

Histogram of commands executed over robot's lifetime

lifetimeStepCount :: Lens' ActivityCounts Int Source #

Total number of CESK steps executed over robot's lifetime. This could be thought of as "CPU cycles" consumed, and is labeled as "cycles" in the F2 dialog in the UI.

activityWindow :: Lens' ActivityCounts (WindowedCounter TickNumber) Source #

Sliding window over a span of ticks indicating ratio of activity

Creation & instantiation

mkRobot Source #

Arguments

:: RobotID phase

ID number of the robot.

-> Maybe Int

ID number of the robot's parent, if it has one.

-> Text

Name of the robot.

-> Document Syntax

Description of the robot.

-> RobotLocation phase

Initial location.

-> Heading

Initial heading/direction.

-> Display

Robot display.

-> CESK

Initial CESK machine.

-> [Entity]

Equipped devices.

-> [(Count, Entity)]

Initial inventory.

-> Bool

Should this be a system robot?

-> Bool

Is this robot heavy?

-> Set EntityName

Unwalkable entities

-> TimeSpec

Creation date

-> RobotR phase 

A general function for creating robots.

instantiateRobot :: RID -> TRobot -> Robot Source #

Instantiate a robot template to make it into a concrete robot, by providing a robot ID. Concrete robots also require a location; if the robot template didn't have a location already, just set the location to (0,0) by default. If you want a different location, set it via trobotLocation before calling instantiateRobot.

Query

robotKnows :: Robot -> Entity -> Bool Source #

Does a robot know of an entity's existence?

isActive :: Robot -> Bool Source #

Is the robot actively in the middle of a computation?

wantsToStep :: TickNumber -> Robot -> Bool Source #

Active robots include robots that are waiting; wantsToStep is true if the robot actually wants to take another step right now (this is a subset of active robots).

waitingUntil :: Robot -> Maybe TickNumber Source #

The time until which the robot is waiting, if any.

getResult :: Robot -> Maybe (Value, Store) Source #

Get the result of the robot's computation if it is finished.

Constants