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

Swarm.Game.Entity

Description

An Entity represents an object that exists in the world. Each entity has a way to be displayed, some metadata such as a name and description, some properties, and possibly an inventory of other entities.

This module also defines the Inventory type, since the two types are mutually recursive (an inventory contains entities, which can have inventories).

Synopsis

Entity properties

type EntityName = Text Source #

A type representing entity names, currently a synonym for Text. In the future it is conceivable that it might become more complex.

data EntityProperty Source #

Various properties that an entity can have, which affect how robots can interact with it.

Constructors

Unwalkable

Robots can't move onto a cell containing this entity.

Portable

Robots can pick this up (via Grab or Harvest).

Opaque

Obstructs the view of robots that attempt to "scout"

Growable

Regrows from a seed after it is harvested.

Combustible

Can burn when ignited (either via Ignite or by an adjacent burning entity).

Infinite

Regenerates infinitely when grabbed or harvested.

Liquid

Robots drown if they walk on this without a boat.

Known

Robots automatically know what this is without having to scan it.

Instances

Instances details
FromJSON EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

ToJSON EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Bounded EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Enum EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Generic EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Associated Types

type Rep EntityProperty :: Type -> Type #

Read EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Show EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Eq EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Ord EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

Hashable EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep EntityProperty Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep EntityProperty = D1 ('MetaData "EntityProperty" "Swarm.Game.Entity" "swarm-0.5.0.0-6qXEbhCmuXA4wRndqqhBu" 'False) (((C1 ('MetaCons "Unwalkable" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Portable" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Opaque" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Growable" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Combustible" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Infinite" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Liquid" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Known" 'PrefixI 'False) (U1 :: Type -> Type))))

newtype GrowthTime Source #

How long an entity takes to regrow. This represents the minimum and maximum amount of time taken by one growth stage (there are two stages). The actual time for each stage will be chosen uniformly at random between these two values.

Constructors

GrowthTime (Integer, Integer) 

Instances

Instances details
FromJSON GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

ToJSON GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

Generic GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

Associated Types

type Rep GrowthTime :: Type -> Type #

Read GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

Show GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

Eq GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

Ord GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

Hashable GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep GrowthTime Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep GrowthTime = D1 ('MetaData "GrowthTime" "Swarm.Game.Entity" "swarm-0.5.0.0-6qXEbhCmuXA4wRndqqhBu" 'True) (C1 ('MetaCons "GrowthTime" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Integer, Integer))))

defaultGrowthTime :: GrowthTime Source #

The default growth time (100, 200) for a growable entity with no growth time specification.

data Combustibility Source #

Properties of combustion.

Constructors

Combustibility 

Fields

Instances

Instances details
FromJSON Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

ToJSON Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

Generic Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

Associated Types

type Rep Combustibility :: Type -> Type #

Read Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

Show Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

Eq Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

Ord Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

Hashable Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep Combustibility Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep Combustibility = D1 ('MetaData "Combustibility" "Swarm.Game.Entity" "swarm-0.5.0.0-6qXEbhCmuXA4wRndqqhBu" 'False) (C1 ('MetaCons "Combustibility" 'PrefixI 'True) (S1 ('MetaSel ('Just "ignition") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Double) :*: (S1 ('MetaSel ('Just "duration") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Integer, Integer)) :*: S1 ('MetaSel ('Just "product") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe EntityName)))))

defaultCombustibility :: Combustibility Source #

The default combustion specification for a combustible entity with no combustion specification:

  • ignition rate 0.5
  • duration (100, 200)
  • product ash

Entities

data Entity Source #

A record to hold information about an entity.

The constructor for Entity is intentionally not exported. To construct one manually, use the mkEntity function.

There are two main constraints on the way entities are stored:

  1. We want to be able to easily modify an entity in one particular cell of the world (for example, painting one tree red).
  2. In an inventory, we want to store identical entities only once, along with a count.

We could get (2) nicely by storing only names of entities, and having a global lookup table from names to entity records. However, storing names instead of actual entity records in the world makes (1) more complex: every time we modify an entity we would have to generate a fresh name for the modified entity and add it to the global entity table. This approach is also annoying because it means we can't just uses lenses to drill down into the properties of an entity in the world or in an inventory, but have to do an intermediate lookup in the global (mutable!) entity table.

On the other hand, if we just store entity records everywhere, checking them for equality becomes expensive. Having an inventory be a map with entities themselves as keys sounds awful.

The solution we adopt here is that every Entity record carries along a hash value of all the other fields. We just assume that these hashes are unique (a collision is of course possible but extremely unlikely). Entities can be efficiently compared just by looking at their hashes; they can be stored in a map using hash values as keys; and we provide lenses which automatically recompute the hash value when modifying a field of an entity record. Note also that world storage is still efficient, too: thanks to referential transparency, in practice most of the entities stored in the world that are the same will literally just be stored as pointers to the same shared record.

Instances

Instances details
FromJSON Entity Source # 
Instance details

Defined in Swarm.Game.Entity

ToJSON Entity Source # 
Instance details

Defined in Swarm.Game.Entity

ToJSON Cell Source # 
Instance details

Defined in Swarm.Game.Scenario.Topography.Cell

Generic Entity Source # 
Instance details

Defined in Swarm.Game.Entity

Associated Types

type Rep Entity :: Type -> Type #

Methods

from :: Entity -> Rep Entity x #

to :: Rep Entity x -> Entity #

Show Entity Source # 
Instance details

Defined in Swarm.Game.Entity

Eq Entity Source #

Entities are compared by hash for efficiency.

Instance details

Defined in Swarm.Game.Entity

Methods

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

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

Ord Entity Source #

Entities are compared by hash for efficiency.

Instance details

Defined in Swarm.Game.Entity

Hashable Entity Source #

The Hashable instance for Entity ignores the cached hash value and simply combines the other fields.

Instance details

Defined in Swarm.Game.Entity

Methods

hashWithSalt :: Int -> Entity -> Int #

hash :: Entity -> Int #

Valuable Entity Source # 
Instance details

Defined in Swarm.Game.Value

Methods

asValue :: Entity -> Value Source #

FromJSONE EntityMap Entity Source #

If we have access to an EntityMap, we can parse the name of an Entity as a string and look it up in the map.

Instance details

Defined in Swarm.Game.Entity

FromJSONE EntityMap (Recipe Entity) Source # 
Instance details

Defined in Swarm.Game.Recipe

FromJSON (Recipe Entity) Source # 
Instance details

Defined in Swarm.Game.Recipe

ToJSON (Recipe Entity) Source # 
Instance details

Defined in Swarm.Game.Recipe

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 Entity Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep Entity = D1 ('MetaData "Entity" "Swarm.Game.Entity" "swarm-0.5.0.0-6qXEbhCmuXA4wRndqqhBu" 'False) (C1 ('MetaCons "Entity" 'PrefixI 'True) (((S1 ('MetaSel ('Just "_entityHash") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Just "_entityDisplay") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Display) :*: S1 ('MetaSel ('Just "_entityName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 EntityName))) :*: (S1 ('MetaSel ('Just "_entityPlural") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Text)) :*: (S1 ('MetaSel ('Just "_entityDescription") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Document Syntax)) :*: S1 ('MetaSel ('Just "_entityOrientation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Heading))))) :*: ((S1 ('MetaSel ('Just "_entityGrowth") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe GrowthTime)) :*: (S1 ('MetaSel ('Just "_entityCombustion") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Combustibility)) :*: S1 ('MetaSel ('Just "_entityYields") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Text)))) :*: (S1 ('MetaSel ('Just "_entityProperties") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Set EntityProperty)) :*: (S1 ('MetaSel ('Just "_entityCapabilities") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Set Capability)) :*: S1 ('MetaSel ('Just "_entityInventory") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Inventory))))))

mkEntity Source #

Arguments

:: Display

Display

-> Text

Entity name

-> Document Syntax

Entity description

-> [EntityProperty]

Properties

-> [Capability]

Capabilities

-> Entity 

Create an entity with no orientation, an empty inventory, providing no capabilities (automatically filling in the hash value).

Fields

Our own custom lenses which properly recompute the cached hash value each time something gets updated. See https://byorgey.wordpress.com/2021/09/17/automatically-updated-cached-views-with-lens/ for the approach used here.

entityDisplay :: Lens' Entity Display Source #

The Display explaining how to draw this entity in the world display.

entityName :: Lens' Entity EntityName Source #

The name of the entity.

entityPlural :: Lens' Entity (Maybe Text) Source #

The irregular plural version of the entity's name, if there is one.

entityNameFor :: Int -> Getter Entity Text Source #

Get a version of the entity's name appropriate to the number---the singular name for 1, and a plural name for any other number. The plural name is obtained either by looking it up if irregular, or by applying standard heuristics otherwise.

entityDescription :: Lens' Entity (Document Syntax) Source #

A longer, free-form description of the entity. Each Text value represents a paragraph.

entityOrientation :: Lens' Entity (Maybe Heading) Source #

The direction this entity is facing (if it has one).

entityGrowth :: Lens' Entity (Maybe GrowthTime) Source #

How long this entity takes to grow, if it regrows.

entityCombustion :: Lens' Entity (Maybe Combustibility) Source #

Susceptibility to and duration of combustion

entityYields :: Lens' Entity (Maybe Text) Source #

The name of a different entity yielded when this entity is grabbed, if any.

entityProperties :: Lens' Entity (Set EntityProperty) Source #

The properties enjoyed by this entity.

hasProperty :: Entity -> EntityProperty -> Bool Source #

Test whether an entity has a certain property.

entityCapabilities :: Lens' Entity (Set Capability) Source #

The capabilities this entity provides when equipped.

entityInventory :: Lens' Entity Inventory Source #

The inventory of other entities carried by this entity.

entityHash :: Getter Entity Int Source #

Get the hash of an entity. Note that this is a getter, not a lens; the Swarm.Game.Entity module carefully maintains some internal invariants ensuring that hashes work properly, and by golly, no one else is going to mess that up.

Entity map

data EntityMap Source #

An EntityMap is a data structure containing all the loaded entities, allowing them to be looked up either by name or by what capabilities they provide (if any).

Instances

Instances details
FromJSON EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

ToJSON EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

Monoid EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

Semigroup EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

Generic EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

Associated Types

type Rep EntityMap :: Type -> Type #

Show EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

Eq EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

FromJSONE EntityMap Entity Source #

If we have access to an EntityMap, we can parse the name of an Entity as a string and look it up in the map.

Instance details

Defined in Swarm.Game.Entity

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

FromJSONE EntityMap (Recipe Entity) Source # 
Instance details

Defined in Swarm.Game.Recipe

FromJSONE (EntityMap, RobotMap) Cell Source # 
Instance details

Defined in Swarm.Game.Scenario.Topography.Cell

FromJSONE (EntityMap, WorldMap) Scenario Source # 
Instance details

Defined in Swarm.Game.Scenario

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 EntityMap Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep EntityMap = D1 ('MetaData "EntityMap" "Swarm.Game.Entity" "swarm-0.5.0.0-6qXEbhCmuXA4wRndqqhBu" 'False) (C1 ('MetaCons "EntityMap" 'PrefixI 'True) (S1 ('MetaSel ('Just "entitiesByName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Map Text Entity)) :*: S1 ('MetaSel ('Just "entitiesByCap") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Map Capability [Entity]))))

buildEntityMap :: Has (Throw LoadingFailure) sig m => [Entity] -> m EntityMap Source #

Build an EntityMap from a list of entities. The idea is that this will be called once at startup, when loading the entities from a file; see loadEntities.

loadEntities :: (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) => m EntityMap Source #

Load entities from a data file called entities.yaml, producing either an EntityMap or a parse error.

lookupEntityName :: Text -> EntityMap -> Maybe Entity Source #

Find an entity with the given name.

deviceForCap :: Capability -> EntityMap -> [Entity] Source #

Find all entities which are devices that provide the given capability.

Inventories

data Inventory Source #

An inventory is really just a bag/multiset of entities. That is, it contains some entities, along with the number of times each occurs. Entities can be looked up directly, or by name.

Instances

Instances details
FromJSON Inventory Source # 
Instance details

Defined in Swarm.Game.Entity

ToJSON Inventory Source # 
Instance details

Defined in Swarm.Game.Entity

Generic Inventory Source # 
Instance details

Defined in Swarm.Game.Entity

Associated Types

type Rep Inventory :: Type -> Type #

Show Inventory Source # 
Instance details

Defined in Swarm.Game.Entity

Eq Inventory Source #

Inventories are compared by hash for efficiency.

Instance details

Defined in Swarm.Game.Entity

Hashable Inventory Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep Inventory Source # 
Instance details

Defined in Swarm.Game.Entity

type Rep Inventory = D1 ('MetaData "Inventory" "Swarm.Game.Entity" "swarm-0.5.0.0-6qXEbhCmuXA4wRndqqhBu" 'False) (C1 ('MetaCons "Inventory" 'PrefixI 'True) (S1 ('MetaSel ('Just "counts") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (IntMap (Count, Entity))) :*: (S1 ('MetaSel ('Just "byName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Map Text IntSet)) :*: S1 ('MetaSel ('Just "inventoryHash") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int))))

type Count = Int Source #

A convenient synonym to remind us when an Int is supposed to represent how many of something we have.

Construction

empty :: Inventory Source #

The empty inventory.

singleton :: Entity -> Inventory Source #

Create an inventory containing one entity.

fromList :: [Entity] -> Inventory Source #

Create an inventory from a list of entities.

fromElems :: [(Count, Entity)] -> Inventory Source #

Create an inventory from a list of entities and their counts.

Lookup

lookup :: Entity -> Inventory -> Count Source #

Look up an entity in an inventory, returning the number of copies contained.

lookupByName :: Text -> Inventory -> [Entity] Source #

Look up an entity by name in an inventory, returning a list of matching entities. Note, if this returns some entities, it does not mean we necessarily have any in our inventory! It just means we know about them. If you want to know whether you have any, use lookup and see whether the resulting Count is positive, or just use countByName in the first place.

countByName :: Text -> Inventory -> Count Source #

Look up an entity by name and see how many there are in the inventory. If there are multiple entities with the same name, it just picks the first one returned from lookupByName.

contains :: Inventory -> Entity -> Bool Source #

Check whether an inventory contains at least one of a given entity.

contains0plus :: Entity -> Inventory -> Bool Source #

Check whether an inventory has an entry for the given entity, even if there are 0 copies. In particular this is used to indicate whether a robot "knows about" an entity.

elems :: Inventory -> [(Count, Entity)] Source #

Get the entities in an inventory and their associated counts.

isSubsetOf :: Inventory -> Inventory -> Bool Source #

Check if the first inventory is a subset of the second. Note that entities with a count of 0 are ignored.

isEmpty :: Inventory -> Bool Source #

Check whether an inventory is empty, meaning that it contains 0 total entities (although it may still know about some entities, that is, have them as keys with a count of 0).

inventoryCapabilities :: Inventory -> Set Capability Source #

Compute the set of capabilities provided by the devices in an inventory.

extantElemsWithCapability :: Capability -> Inventory -> [Entity] Source #

List elements that possess a given Capability and exist with nonzero count in the inventory.

entitiesByCapability :: Inventory -> Map Capability (NonEmpty Entity) Source #

Groups entities by the capabilities they offer.

Modification

insert :: Entity -> Inventory -> Inventory Source #

Insert an entity into an inventory. If the inventory already contains this entity, then only its count will be incremented.

insertCount :: Count -> Entity -> Inventory -> Inventory Source #

Insert a certain number of copies of an entity into an inventory. If the inventory already contains this entity, then only its count will be incremented.

delete :: Entity -> Inventory -> Inventory Source #

Delete a single copy of a certain entity from an inventory.

deleteCount :: Count -> Entity -> Inventory -> Inventory Source #

Delete a specified number of copies of an entity from an inventory.

deleteAll :: Entity -> Inventory -> Inventory Source #

Delete all copies of a certain entity from an inventory.

union :: Inventory -> Inventory -> Inventory Source #

Union two inventories.

difference :: Inventory -> Inventory -> Inventory Source #

Subtract the second inventory from the first.