combustion

data/entities.yaml

@@ -7,8 +7,20 @@
     A tall, living entity made of a tough cellular material called "wood".
     They regrow after being harvested and are an important raw ingredient used
     in making many different devices.
-  properties: [portable, growable, opaque]
+  properties: [portable, growable, opaque, combustible]
   growth: [500, 600]
+  combustion:
+    ignition: 0.5
+    duration: [50, 100]
+
+- name: ash
+  display:
+    attr: rock
+    char: '#'
+  description:
+  - |
+    Burned-out remnants of combustion.
+  properties: [portable]
 
 - name: branch
   display:

data/scenarios/Testing/1355-combustion.yaml

@@ -0,0 +1,72 @@
+version: 1
+name: Combustion
+creative: true
+seed: 0
+description: Demo of spreading fire
+solution: |
+  move;
+  ignite forward;
+  turn right;
+  move;
+  ignite forward;
+  turn right;
+  move; move; move;
+  turn right;
+  move;
+  ignite left;
+  turn right;
+  move; move;
+robots:
+  - name: base
+    dir: [1, 0]
+    devices:
+      - logger
+      - treads
+entities:
+- name: fuse
+  display:
+    attr: wood
+    char: '~'
+  description:
+    - Reliably combustible
+  combustion:
+    ignition: 1
+    duration: [8, 8]
+  properties: [known, portable, combustible]
+- name: dynamite
+  display:
+    attr: red
+    char: '!'
+  description:
+    - Explosive material
+  combustion:
+    ignition: 1
+    duration: [2, 2]
+    product: crater
+  properties: [known, portable, combustible]
+- name: crater
+  display:
+    attr: rock
+    char: '@'
+  description:
+    - Result of explosive excavation
+  properties: [known]
+known: [tree]
+world:
+  palette:
+    'Ω': [grass, null, base]
+    'T': [grass, tree]
+    'F': [grass, fuse]
+    'd': [grass, dynamite]
+    '.': [grass]
+  upperleft: [0, 0]
+  map: |
+   ......T............FFFFF...d..
+   ......TT...........F...F...F..
+   ......TTT..........F...F...F..
+   ......TTTTT........F...F...F..
+   ......TTTTTT..Ω.FFFF...FFFFF..
+   ......TTTTT...................
+   ......TTT....TTTTTTTTT........
+   ......TT.....TTTTTTTTT........
+   ......T......TTTTTTTTT........

editors/emacs/swarm-mode.el

@@ -60,6 +60,7 @@
                "turn"
                "grab"
                "harvest"
+               "ignite"
                "place"
                "give"
                "equip"

editors/vscode/syntaxes/swarm.tmLanguage.json

@@ -58,7 +58,7 @@
 				},
 				{
 				"name": "keyword.other",
-				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|push|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b"
+				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|push|stride|turn|grab|harvest|ignite|place|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b"
 				}
 			]
 			},

src/Swarm/Game/Entity.hs

@@ -13,11 +13,13 @@
 -- are mutually recursive (an inventory contains entities, which can
 -- have inventories).
 module Swarm.Game.Entity (
+  EntityName,
   -- * Properties
   EntityProperty (..),
   GrowthTime (..),
   defaultGrowthTime,
-
+  Combustibility (..),
+  defaultCombustibility,
   -- * Entities
   Entity,
   mkEntity,
@@ -31,6 +33,7 @@ module Swarm.Game.Entity (
   entityDescription,
   entityOrientation,
   entityGrowth,
+  entityCombustion,
   entityYields,
   entityProperties,
   hasProperty,
@@ -118,6 +121,8 @@ import Text.Read (readMaybe)
 import Witch
 import Prelude hiding (lookup)
 
+type EntityName = Text
+
 ------------------------------------------------------------
 -- Properties
 ------------------------------------------------------------
@@ -133,6 +138,8 @@ data EntityProperty
     Opaque
   | -- | Regrows from a seed after it is harvested.
     Growable
+  | -- | Can use the Ignite command on it
+    Combustible
   | -- | Regenerates infinitely when grabbed or harvested.
     Infinite
   | -- | Robots drown if they walk on this without a boat.
@@ -162,6 +169,22 @@ newtype GrowthTime = GrowthTime (Integer, Integer)
 defaultGrowthTime :: GrowthTime
 defaultGrowthTime = GrowthTime (100, 200)
 
+-- | Properties of combustion
+data Combustibility = Combustibility {
+    ignition :: Double
+    -- ^ Likelihood of ignition by a neighbor, per tick.
+    -- This gets multiplied by the number of (4-adjacent) neighbors
+    -- currently burning.
+  , duration :: (Integer, Integer)
+    -- ^ min and max tick counts for combustion to persist
+  , product :: Maybe EntityName
+    -- ^ what entity, if any, is left over after combustion
+  }
+  deriving (Eq, Ord, Show, Read, Generic, Hashable, FromJSON, ToJSON)
+
+defaultCombustibility :: Combustibility
+defaultCombustibility = Combustibility 0.5 (100, 200) (Just "ash")
+
 ------------------------------------------------------------
 -- Entity
 ------------------------------------------------------------
@@ -224,6 +247,8 @@ data Entity = Entity
   --   a robot moves, it moves in the direction of its orientation.
   , _entityGrowth :: Maybe GrowthTime
   -- ^ If this entity grows, how long does it take?
+  , _entityCombustion :: Maybe Combustibility
+  -- ^ If this entity is combustible, how spreadable is it?
   , _entityYields :: Maybe Text
   -- ^ The name of a different entity obtained when this entity is
   -- grabbed.
@@ -243,14 +268,15 @@ data Entity = Entity
 -- | The @Hashable@ instance for @Entity@ ignores the cached hash
 --   value and simply combines the other fields.
 instance Hashable Entity where
-  hashWithSalt s (Entity _ disp nm pl descr orient grow yld props caps inv) =
+  hashWithSalt s (Entity _ disp nm pl descr orient grow combust yld props caps inv) =
     s
       `hashWithSalt` disp
       `hashWithSalt` nm
       `hashWithSalt` pl
       `hashWithSalt` docToText descr
       `hashWithSalt` orient
       `hashWithSalt` grow
+      `hashWithSalt` combust
       `hashWithSalt` yld
       `hashWithSalt` props
       `hashWithSalt` caps
@@ -284,7 +310,19 @@ mkEntity ::
   [Capability] ->
   Entity
 mkEntity disp nm descr props caps =
-  rehashEntity $ Entity 0 disp nm Nothing descr Nothing Nothing Nothing (Set.fromList props) (Set.fromList caps) empty
+  rehashEntity $ Entity
+    0
+    disp
+    nm
+    Nothing
+    descr
+    Nothing
+    Nothing
+    Nothing
+    Nothing
+    (Set.fromList props)
+    (Set.fromList caps)
+    empty
 
 ------------------------------------------------------------
 -- Entity map
@@ -345,6 +383,7 @@ instance FromJSON Entity where
               <*> (v .: "description")
               <*> v .:? "orientation"
               <*> v .:? "growth"
+              <*> v .:? "combustion"
               <*> v .:? "yields"
               <*> v .:? "properties" .!= mempty
               <*> v .:? "capabilities" .!= mempty
@@ -445,6 +484,10 @@ entityOrientation = hashedLens _entityOrientation (\e x -> e {_entityOrientation
 entityGrowth :: Lens' Entity (Maybe GrowthTime)
 entityGrowth = hashedLens _entityGrowth (\e x -> e {_entityGrowth = x})
 
+-- | Susceptibility to and duration of combustion
+entityCombustion :: Lens' Entity (Maybe Combustibility)
+entityCombustion = hashedLens _entityCombustion (\e x -> e {_entityCombustion = x})
+
 -- | The name of a different entity yielded when this entity is
 --   grabbed, if any.
 entityYields :: Lens' Entity (Maybe Text)

src/Swarm/Game/Scenario/Topography/EntityFacade.hs

@@ -9,19 +9,17 @@
 module Swarm.Game.Scenario.Topography.EntityFacade where
 
 import Control.Lens ((^.))
-import Data.Text (Text)
 import Data.Yaml as Y (ToJSON (toJSON))
 import Swarm.Game.Display (Display)
 import Swarm.Game.Entity qualified as E
 
-type EntityName = Text
 
 -- | This datatype is a lightweight stand-in for the
 -- full-fledged "Entity" type without the baggage of all
 -- of its other fields.
 -- It contains the bare minimum display information
 -- for rendering.
-data EntityFacade = EntityFacade EntityName Display
+data EntityFacade = EntityFacade E.EntityName Display
   deriving (Eq)
 
 -- Note: This instance is used only for the purpose of WorldPalette

src/Swarm/Game/Step.hs

@@ -1065,6 +1065,92 @@ seedProgram minTime randTime thing =
     selfdestruct
   |]
 
+-- | A system program for a "combustion robot", to burn an entity
+--   after it is ignited.
+--
+-- Creates sub-partitions (of 10-tick duration) of the "stages"
+-- of combustion for opportunities to light adjacent entities on fire.
+combustionProgram :: Integer -> Integer -> Text -> Double -> ProcessedTerm
+combustionProgram minTime randTime thing spreadProbabilityPerTick =
+  [tmQ|
+    def max = \a. \b.
+      if (a > b) {a} {b};
+      end;
+
+    def trySpread = \denom. \d.
+      try {
+        r <- random denom;
+        if (r == 0) {
+          ignite d;
+          noop;
+        } {};
+      } {};
+      end;
+
+    def tryDirs = \denom.
+      trySpread denom forward;
+      trySpread denom left;
+      trySpread denom back;
+      trySpread denom right;
+      end;
+
+
+    try {
+      r <- random (1 + $int:randTime);
+      wait (r + $int:minTime);
+      appear "X";
+      r <- random (1 + $int:randTime);
+      let spreadableDuration = r + $int:minTime in
+      let segmentCount = max 1 $ spreadableDuration/10 in
+
+      tryDirs $int:spreadProbabilityDenominator;
+      wait spreadableDuration;
+    } {};
+
+    try {
+      create $str:thing;
+      place $str:thing;
+    } {};
+    selfdestruct
+  |]
+  where
+    spreadProbabilityDenominator = floor (1 / spreadProbabilityPerTick) :: Integer
+
+-- | Construct a "combustion robot" from entity, time range and position,
+--   and add it to the world.  It has low priority and will be covered
+--   by placed entities.
+addCombustionBot ::
+  Has (State GameState) sig m =>
+  Combustibility ->
+  Cosmic Location ->
+  TimeSpec ->
+  m ()
+addCombustionBot combustibility loc ts =
+  void $
+    addTRobot $
+      mkRobot
+        ()
+        Nothing
+        "fire"
+        (Markdown.fromText $ T.unwords ["A burning", combustionOutput <> "."])
+        (Just loc)
+        north
+        ( defaultEntityDisplay '*'
+            & displayAttr .~ AWorld "fire"
+            & displayPriority .~ 0
+        )
+        (initMachine combustionProg empty emptyStore)
+        []
+        []
+        True
+        False
+        ts
+  where
+    combustionProg = combustionProgram minT (maxT - minT) combustionOutput spreadLikelihood
+    -- FIXME should support Maybe
+    Combustibility spreadLikelihood (minT, maxT) maybeCombustionProduct = combustibility
+    combustionOutput = fromMaybe "ash" maybeCombustionProduct
+
 -- | 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.
@@ -1082,7 +1168,7 @@ addSeedBot e (minT, maxT) loc ts =
         ()
         Nothing
         "seed"
-        "A growing seed."
+        (Markdown.fromText $ T.unwords ["A growing", e ^. entityName,  "seed."])
         (Just loc)
         zero
         ( defaultEntityDisplay '.'
@@ -1230,6 +1316,34 @@ execConst c vs s k = do
       _ -> badConst
     Grab -> doGrab Grab'
     Harvest -> doGrab Harvest'
+    Ignite -> case vs of
+      [VDir d] -> do
+        let verb = "ignite"
+            verbed = "ignited"
+
+        (loc, me) <- lookInDirection d
+        -- Ensure there is an entity here.
+        e <-
+          me `isJustOrFail` ["There is nothing here to", verb <> "."]
+
+        -- Ensure it can be ignited.
+        (e `hasProperty` Combustible)
+          `holdsOrFail` ["The", e ^. entityName, "here can't be", verbed <> "."]
+
+        -- Remove the entity from the world.
+        updateEntityAt loc (const Nothing)
+        flagRedraw
+
+        -- Start burning process
+        let combustibility = (e ^. entityCombustion) ? defaultCombustibility
+
+        createdAt <- getNow
+
+        addCombustionBot combustibility loc createdAt 
+
+        return $ Out VUnit s k
+
+      _ -> badConst
     Swap -> case vs of
       [VText name] -> do
         loc <- use robotLocation