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

Swarm.Game.Step

Description

Facilities for stepping the robot CESK machines, i.e. the actual interpreter for the Swarm language.

  • * Note on the IO:

The only reason we need IO is so that robots can run programs loaded from files, via the Run command. This could be avoided by using a hypothetical import command instead and parsing the required files at the time of declaration. See https://github.com/swarm-game/swarm/issues/495.

Synopsis

Documentation

gameTick :: (Has (State GameState) sig m, Has (Lift IO) sig m) => m Bool Source #

The main function to do one game tick.

Note that the game may be in RobotStep mode and not finish the tick. Use the return value to check whether a full tick happened.

finishGameTick :: (Has (State GameState) sig m, Has (Lift IO) sig m) => m () Source #

Finish a game tick in progress and set the game to WorldTick mode afterwards.

Use this function if you need to unpause the game.

insertBackRobot :: Has (State GameState) sig m => RID -> Robot -> m () Source #

runRobotIDs :: (Has (State GameState) sig m, Has (Lift IO) sig m) => IntSet -> m () Source #

singleStep :: (Has (State GameState) sig m, Has (Lift IO) sig m) => SingleStep -> RID -> IntSet -> m Bool Source #

data CompletionsWithExceptions Source #

An accumulator for folding over the incomplete objectives to evaluate for their completion

Constructors

CompletionsWithExceptions 

Fields

hypotheticalWinCheck :: (Has (State GameState) sig m, Has (Lift IO) sig m) => EntityMap -> GameState -> WinStatus -> ObjectiveCompletion -> m () Source #

Execute the win condition check *hypothetically*: i.e. in a fresh CESK machine, using a copy of the current game state.

The win check is performed only on "active" goals; that is, the goals that are currently unmet and have had all of their prerequisites satisfied. Note that it may be possible, while traversing through the goal list, for one goal to be met earlier in the list that happens to be a prerequisite later in the traversal. This is why: 1) We must not pre-filter the goals to be traversed based on satisfied prerequisites (i.e. we cannot use the "getActiveObjectives" function). 2) The traversal order must be "reverse topological" order, so that prerequisites are evaluated before dependent goals. 3) The iteration needs to be a "fold", so that state is updated after each element.

evalPT :: (Has (Lift IO) sig m, Has (Throw Exn) sig m, Has (State GameState) sig m) => ProcessedTerm -> m Value Source #

hypotheticalRobot :: CESK -> TimeSpec -> Robot Source #

Create a special robot to check some hypothetical, for example the win condition.

Use ID (-1) so it won't conflict with any robots currently in the robot map.

evaluateCESK :: (Has (Lift IO) sig m, Has (Throw Exn) sig m, Has (State GameState) sig m) => CESK -> m Value Source #

runCESK :: (Has (Lift IO) sig m, Has (Throw Exn) sig m, Has (State GameState) sig m, Has (State Robot) sig m) => CESK -> m Value Source #

createLogEntry :: (Has (State GameState) sig m, Has (State Robot) sig m) => RobotLogSource -> Severity -> Text -> m LogEntry Source #

Create a log entry given current robot and game time in ticks noting whether it has been said.

This is the more generic version used both for (recorded) said messages and normal logs.

traceLog :: (Has (State GameState) sig m, Has (State Robot) sig m) => RobotLogSource -> Severity -> Text -> m LogEntry Source #

Print some text via the robot's log.

traceLogShow :: (Has (State GameState) sig m, Has (State Robot) sig m, Show a) => a -> m () Source #

Print a showable value via the robot's log.

Useful for debugging.

constCapsFor :: Const -> Robot -> Maybe Capability Source #

Capabilities needed for a specific robot to evaluate or execute a constant. Right now, the only difference is whether the robot is heavy or not when executing the Move command, but there might be other exceptions added in the future.

ensureCanExecute :: (Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Const -> m () Source #

Ensure that a robot is capable of executing a certain constant (either because it has a device which gives it that capability, or it is a system robot, or we are in creative mode).

cmdExnWithAchievement :: Const -> [Text] -> GameplayAchievement -> Exn Source #

Create an exception about a command failing, with an achievement

raise :: Has (Throw Exn) sig m => Const -> [Text] -> m a Source #

Raise an exception about a command failing with a formatted error message.

withExceptions :: Monad m => Store -> Cont -> ThrowC Exn m CESK -> m CESK Source #

Run a subcomputation that might throw an exception in a context where we are returning a CESK machine; any exception will be turned into an Up state.

tickRobot :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Robot Source #

Run a robot for one tick, which may consist of up to robotStepsPerTick CESK machine steps and at most one tangible command execution, whichever comes first.

tickRobotRec :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Robot Source #

Recursive helper function for tickRobot, which checks if the robot is actively running and still has steps left, and if so runs it for one step, then calls itself recursively to continue stepping the robot.

stepRobot :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Robot Source #

Single-step a robot by decrementing its tickStepBudget counter and running its CESK machine for one step.

updateWorld :: (Has (State GameState) sig m, Has (Throw Exn) sig m) => Const -> WorldUpdate Entity -> m () Source #

replace some entity in the world with another entity

applyRobotUpdates :: (Has (State GameState) sig m, Has (State Robot) sig m) => [RobotUpdate] -> m () Source #

data SKpair Source #

Constructors

SKpair Store Cont 

processImmediateFrame Source #

Arguments

:: (Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) 
=> Value 
-> SKpair 
-> ErrorC Exn m ()

the unreliable computation

-> m CESK 

Performs some side-effectful computation for an FImmediate Frame. Aborts processing the continuation stack if an error is encountered.

Compare to "withExceptions".

stepCESK :: (Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) => CESK -> m CESK Source #

The main CESK machine workhorse. Given a robot, look at its CESK machine state and figure out a single next step.

evalConst :: (Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) => Const -> [Value] -> Store -> Cont -> m CESK Source #

Eexecute a constant, catching any exception thrown and returning it via a CESK machine state.

seedProgram :: Integer -> Integer -> Text -> ProcessedTerm Source #

A system program for a "seed robot", to regrow a growable entity after it is harvested.

addSeedBot :: Has (State GameState) sig m => Entity -> (Integer, Integer) -> Cosmic Location -> TimeSpec -> m () Source #

Construct a "seed robot" from entity, time range and position, and add it to the world. It has low priority and will be covered by placed entities.

execConst :: (HasRobotStepState sig m, Has (Lift IO) sig m) => Const -> [Value] -> Store -> Cont -> m CESK Source #

Interpret the execution (or evaluation) of a constant application to some values.

purgeFarAwayWatches :: HasRobotStepState sig m => m () Source #

Clear watches that are out of range

isNearbyOrExempt :: Bool -> Cosmic Location -> Cosmic Location -> Bool Source #

Requires that the target location is within one cell. Requirement is waived if the bot is privileged.

data RobotFailure Source #

How to handle failure, for example when moving to blocked location

Constructors

ThrowExn 
Destroy 
IgnoreFail 

type MoveFailureHandler = MoveFailureMode -> RobotFailure Source #

How to handle different types of failure when moving/teleporting to a location.

data GrabbingCmd Source #

Constructors

Grab' 
Harvest' 
Swap' 
Push' 

Instances

Instances details
Show GrabbingCmd Source # 
Instance details

Defined in Swarm.Game.Step

Eq GrabbingCmd Source # 
Instance details

Defined in Swarm.Game.Step

formatDevices :: Set Entity -> Text Source #

Format a set of suggested devices for use in an error message, in the format device1 or device2 or ... or deviceN.

provisionChild :: HasRobotStepState sig m => RID -> Inventory -> Inventory -> m () Source #

Give some entities from a parent robot (the robot represented by the ambient State Robot effect) to a child robot (represented by the given RID) as part of a Build or Reprogram command. The first Inventory is devices to be equipped, and the second is entities to be transferred.

In classic mode, the entities will be transferred (that is, removed from the parent robot's inventory); in creative mode, the entities will be copied/created, that is, no entities will be removed from the parent robot.

updateRobotLocation :: HasRobotStepState sig m => Cosmic Location -> Cosmic Location -> m () Source #

Update the location of a robot, and simultaneously update the robotsByLocation map, so we can always look up robots by location. This should be the only way to update the location of a robot. Also implements teleportation by portals.

onTarget :: (HasRobotStepState sig m, Has (Lift IO) sig m) => RID -> (forall sig' m'. (HasRobotStepState sig' m', Has (Lift IO) sig' m') => m' ()) -> m () Source #

Execute a stateful action on a target robot --- whether the current one or another.

evalCmp :: Has (Throw Exn) sig m => Const -> Value -> Value -> m Bool Source #

Evaluate the application of a comparison operator. Returns Nothing if the application does not make sense.

compareValues :: Has (Throw Exn) sig m => Value -> Value -> m Ordering Source #

Compare two values, returning an Ordering if they can be compared, or Nothing if they cannot.

incompatCmp :: Has (Throw Exn) sig m => Value -> Value -> m a Source #

Values with different types were compared; this should not be possible since the type system should catch it.

incomparable :: Has (Throw Exn) sig m => Value -> Value -> m a Source #

Values were compared of a type which cannot be compared (e.g. functions, etc.).

evalArith :: Has (Throw Exn) sig m => Const -> Integer -> Integer -> m Integer Source #

Evaluate the application of an arithmetic operator, returning an exception in the case of a failing operation, or in case we incorrectly use it on a bad Const in the library.

safeDiv :: Has (Throw Exn) sig m => Integer -> Integer -> m Integer Source #

Perform an integer division, but return Nothing for division by zero.

safeExp :: Has (Throw Exn) sig m => Integer -> Integer -> m Integer Source #

Perform exponentiation, but return Nothing if the power is negative.

updateDiscoveredEntities :: HasRobotStepState sig m => Entity -> m () Source #

Update the global list of discovered entities, and check for new recipes.

updateAvailableRecipes :: Has (State GameState) sig m => (Inventory, Inventory) -> Entity -> m () Source #

Update the availableRecipes list. This implementation is not efficient: * Every time we discover a new entity, we iterate through the entire list of recipes to see which ones we can make. Trying to do something more clever seems like it would definitely be a case of premature optimization. One doesn't discover new entities all that often. * For each usable recipe, we do a linear search through the list of known recipes to see if we already know it. This is a little more troubling, since it's quadratic in the number of recipes. But it probably doesn't really make that much difference until we get up to thousands of recipes.