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

Swarm.Game.World

Description

A world refers to the grid on which the game takes place, and the things in it (besides robots). A world has a base, immutable terrain layer, where each cell contains a terrain type, and a mutable entity layer, with at most one entity per cell.

A world is technically finite but practically infinite (worlds are indexed by 32-bit signed integers, so they correspond to a \( 2^{32} \times 2^{32} \) torus).

Synopsis

Worlds

newtype WorldFun t e Source #

A WorldFun t e represents a 2D world with terrain of type t (exactly one per cell) and entities of type e (at most one per cell).

Constructors

WF 

Fields

Instances

Instances details
Bifunctor WorldFun Source # 
Instance details

Defined in Swarm.Game.World

Methods

bimap :: (a -> b) -> (c -> d) -> WorldFun a c -> WorldFun b d #

first :: (a -> b) -> WorldFun a c -> WorldFun b c #

second :: (b -> c) -> WorldFun a b -> WorldFun a c #

Functor (WorldFun t) Source # 
Instance details

Defined in Swarm.Game.World

Methods

fmap :: (a -> b) -> WorldFun t a -> WorldFun t b #

(<$) :: a -> WorldFun t b -> WorldFun t a #

Monoid t => Monoid (WorldFun t e) Source # 
Instance details

Defined in Swarm.Game.World

Methods

mempty :: WorldFun t e #

mappend :: WorldFun t e -> WorldFun t e -> WorldFun t e #

mconcat :: [WorldFun t e] -> WorldFun t e #

Semigroup t => Semigroup (WorldFun t e) Source # 
Instance details

Defined in Swarm.Game.World

Methods

(<>) :: WorldFun t e -> WorldFun t e -> WorldFun t e #

sconcat :: NonEmpty (WorldFun t e) -> WorldFun t e #

stimes :: Integral b => b -> WorldFun t e -> WorldFun t e #

runWF :: WorldFun t e -> Coords -> (t, Maybe e) Source #

worldFunFromArray :: Monoid t => Array (Int32, Int32) (t, Erasable e) -> WorldFun t e Source #

Create a world function from a finite array of specified cells.

data World t e Source #

A World consists of a WorldFun that specifies the initial world, a cache of loaded square tiles to make lookups faster, and a map storing locations whose entities have changed from their initial values.

Right now the World simply holds on to all the tiles it has ever loaded. Ideally it would use some kind of LRU caching scheme to keep memory usage bounded, but it would be a bit tricky, and in any case it's probably not going to matter much for a while. Once tile loads can trigger robots to spawn, it would also make for some difficult decisions in terms of how to handle respawning.

type MultiWorld t e = Map SubworldName (World t e) Source #

Tile management

loadCell :: IArray UArray t => Coords -> World t e -> World t e Source #

Load the tile containing a specific cell.

loadRegion :: IArray UArray t => (Coords, Coords) -> World t e -> World t e Source #

Load all the tiles which overlap the given rectangular region (specified as an upper-left and lower-right corner, inclusive).

World functions

newWorld :: WorldFun t e -> World t e Source #

Create a new World from a WorldFun.

lookupTerrain :: IArray UArray t => Coords -> World t e -> t Source #

Look up the terrain value at certain coordinates: try looking it up in the tile cache first, and fall back to running the WorldFun otherwise.

This function does not ensure that the tile containing the given coordinates is loaded. For that, see lookupTerrainM.

lookupCosmicEntity :: Cosmic Coords -> MultiWorld t e -> Maybe e Source #

lookupEntity :: Coords -> World t e -> Maybe e Source #

Look up the entity at certain coordinates: first, see if it is in the map of locations with changed entities; then try looking it up in the tile cache first; and finally fall back to running the WorldFun.

This function does not ensure that the tile containing the given coordinates is loaded. For that, see lookupEntityM.

update :: Coords -> (Maybe Entity -> Maybe Entity) -> World t Entity -> (World t Entity, CellUpdate Entity) Source #

Update the entity (or absence thereof) at a certain location, returning an updated World and a Boolean indicating whether the update changed the entity here. See also updateM.

Monadic variants

lookupTerrainM :: forall t e (sig :: (Type -> Type) -> Type -> Type) m. (Has (State (World t e)) sig m, IArray UArray t) => Coords -> m t Source #

A stateful variant of lookupTerrain, which first loads the tile containing the given coordinates if it is not already loaded, then looks up the terrain value.

lookupEntityM :: forall t e (sig :: (Type -> Type) -> Type -> Type) m. (Has (State (World t e)) sig m, IArray UArray t) => Coords -> m (Maybe e) Source #

A stateful variant of lookupEntity, which first loads the tile containing the given coordinates if it is not already loaded, then looks up the terrain value.

lookupContentM :: forall t e (sig :: (Type -> Type) -> Type -> Type) m. (Has (State (World t e)) sig m, IArray UArray t) => Coords -> m (t, Maybe e) Source #

updateM :: forall t (sig :: (Type -> Type) -> Type -> Type) m. (Has (State (World t Entity)) sig m, IArray UArray t) => Coords -> (Maybe Entity -> Maybe Entity) -> m (CellUpdate Entity) Source #

A stateful variant of update, which also ensures the tile containing the given coordinates is loaded.

Runtime updates

data WorldUpdate e Source #

Enumeration of world 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 World -> World function) allows us to serialize and inspect the updates.

Constructors

ReplaceEntity 

Fields

Instances

Instances details
FromJSON e => FromJSON (WorldUpdate e) Source # 
Instance details

Defined in Swarm.Game.World

ToJSON e => ToJSON (WorldUpdate e) Source # 
Instance details

Defined in Swarm.Game.World

Generic (WorldUpdate e) Source # 
Instance details

Defined in Swarm.Game.World

Associated Types

type Rep (WorldUpdate e) 
Instance details

Defined in Swarm.Game.World

type Rep (WorldUpdate e) = D1 ('MetaData "WorldUpdate" "Swarm.Game.World" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-scenario" 'False) (C1 ('MetaCons "ReplaceEntity" 'PrefixI 'True) (S1 ('MetaSel ('Just "updatedLoc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Cosmic Location)) :*: (S1 ('MetaSel ('Just "originalEntity") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 e) :*: S1 ('MetaSel ('Just "newEntity") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe e)))))

Methods

from :: WorldUpdate e -> Rep (WorldUpdate e) x #

to :: Rep (WorldUpdate e) x -> WorldUpdate e #

Show e => Show (WorldUpdate e) Source # 
Instance details

Defined in Swarm.Game.World

Eq e => Eq (WorldUpdate e) Source # 
Instance details

Defined in Swarm.Game.World

Ord e => Ord (WorldUpdate e) Source # 
Instance details

Defined in Swarm.Game.World

type Rep (WorldUpdate e) Source # 
Instance details

Defined in Swarm.Game.World

type Rep (WorldUpdate e) = D1 ('MetaData "WorldUpdate" "Swarm.Game.World" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-scenario" 'False) (C1 ('MetaCons "ReplaceEntity" 'PrefixI 'True) (S1 ('MetaSel ('Just "updatedLoc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Cosmic Location)) :*: (S1 ('MetaSel ('Just "originalEntity") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 e) :*: S1 ('MetaSel ('Just "newEntity") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe e)))))