Capability exercise cost

app/doc/Swarm/Doc/Schema/Render.hs

@@ -25,7 +25,6 @@ import Swarm.Doc.Schema.Arrangement
 import Swarm.Doc.Schema.Parse
 import Swarm.Doc.Schema.Refined
 import Swarm.Doc.Schema.SchemaType
-import Swarm.Doc.Util
 import Swarm.Doc.Wiki.Util
 import Swarm.Util (applyWhen, brackets, quote, showT)
 import System.Directory (listDirectory)
@@ -77,7 +76,7 @@ makePandocTable titleMap (SchemaData _ (ToplevelSchema theTitle theDescription _
     ItemList xs ->
       makePropsTable False listColumnHeadings titleMap
         . M.fromList
-        $ zip (map tshow [0 :: Int ..]) xs
+        $ zip (map showT [0 :: Int ..]) xs
 
   mkTable x = doc $ case x of
     ObjectProperties props -> makePropsTable True propertyColumnHeadings titleMap props

app/doc/Swarm/Doc/Wiki/Cheatsheet.hs

@@ -18,15 +18,16 @@ import Control.Lens.Combinators (to)
 import Data.Foldable (find, toList)
 import Data.List (transpose)
 import Data.Map.Lazy qualified as Map
-import Data.Maybe (fromMaybe, isJust)
-import Data.Set qualified as Set
+import Data.Maybe (isJust)
+import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Swarm.Doc.Schema.Render
 import Swarm.Doc.Util
 import Swarm.Doc.Wiki.Matrix
 import Swarm.Doc.Wiki.Util
+import Swarm.Game.Device qualified as D
 import Swarm.Game.Display (displayChar)
 import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities)
 import Swarm.Game.Entity qualified as E
@@ -110,7 +111,7 @@ commandToList :: Const -> [Text]
 commandToList c =
   map
     escapeTable
-    [ addLink ("#" <> tshow c) . codeQuote $ constSyntax c
+    [ addLink ("#" <> showT c) . codeQuote $ constSyntax c
     , codeQuote . prettyTextLine $ inferConst c
     , maybe "" Capability.capabilityName $ Capability.constCaps c
     , Syntax.briefDoc . Syntax.constDoc $ Syntax.constInfo c
@@ -172,13 +173,13 @@ capabilityRow PageAddress {..} em cap =
   linkCommand c =
     ( if T.null commandsAddress
         then id
-        else addLink (commandsAddress <> "#" <> tshow c)
+        else addLink (commandsAddress <> "#" <> showT c)
     )
       . codeQuote
       $ constSyntax c
 
   cs = [c | c <- Syntax.allConst, let mcap = Capability.constCaps c, isJust $ find (== cap) mcap]
-  es = fromMaybe [] $ E.entitiesByCap em Map.!? cap
+  es = E.devicesForCap cap em
 
 capabilityTable :: PageAddress -> EntityMap -> [Capability] -> Text
 capabilityTable a em cs = T.unlines $ header <> map (listToRow mw) capabilityRows
@@ -201,8 +202,8 @@ entityToList e =
     escapeTable
     [ codeQuote . T.singleton $ e ^. entityDisplay . to displayChar
     , addLink ("#" <> linkID) $ view entityName e
-    , T.intercalate ", " $ Capability.capabilityName <$> Set.toList (view E.entityCapabilities e)
-    , T.intercalate ", " . map tshow . filter (/= E.Pickable) $ toList props
+    , T.intercalate ", " $ Capability.capabilityName <$> Map.keys (D.getMap $ view E.entityCapabilities e)
+    , T.intercalate ", " . map showT . filter (/= E.Pickable) $ toList props
     , if E.Pickable `elem` props
         then ":heavy_check_mark:"
         else ":negative_squared_cross_mark:"
@@ -225,13 +226,13 @@ entityToSection e =
     , ""
     , " - Char: " <> (codeQuote . T.singleton $ e ^. entityDisplay . to displayChar)
     ]
-      <> [" - Properties: " <> T.intercalate ", " (map tshow $ toList props) | not $ null props]
+      <> [" - Properties: " <> T.intercalate ", " (map showT $ toList props) | not $ null props]
       <> [" - Capabilities: " <> T.intercalate ", " (Capability.capabilityName <$> caps) | not $ null caps]
       <> ["\n"]
       <> [Markdown.docToMark $ view E.entityDescription e]
  where
   props = view E.entityProperties e
-  caps = Set.toList $ view E.entityCapabilities e
+  caps = S.toList $ D.getCapabilitySet $ view E.entityCapabilities e
 
 entitiesPage :: PageAddress -> [Entity] -> Text
 entitiesPage _a es =
@@ -255,11 +256,11 @@ recipeRow PageAddress {..} r =
     [ T.intercalate ", " (map formatCE $ view recipeInputs r)
     , T.intercalate ", " (map formatCE $ view recipeOutputs r)
     , T.intercalate ", " (map formatCE $ view recipeCatalysts r)
-    , tshow $ view recipeTime r
-    , tshow $ view recipeWeight r
+    , showT $ view recipeTime r
+    , showT $ view recipeWeight r
     ]
  where
-  formatCE (c, e) = T.unwords [tshow c, linkEntity $ view entityName e]
+  formatCE (c, e) = T.unwords [showT c, linkEntity $ view entityName e]
   linkEntity t =
     if T.null entityAddress
       then t

data/scenarios/Testing/00-ORDER.txt

@@ -36,6 +36,7 @@ Achievements
 1218-stride-command.yaml
 1234-push-command.yaml
 1256-halt-command.yaml
+1262-display-device-commands.yaml
 1295-density-command.yaml
 1138-structures
 1320-world-DSL
@@ -59,4 +60,5 @@ Achievements
 1634-message-colors.yaml
 1681-pushable-entity.yaml
 1747-volume-command.yaml
+1777-capability-cost.yaml
 1775-custom-terrain.yaml

data/scenarios/Testing/1262-display-device-commands.yaml

@@ -0,0 +1,54 @@
+version: 1
+name: Device commands
+description: |
+  Demo display of commands offered by each device, along with their cost.
+creative: false
+robots:
+  - name: base
+    dir: east
+    devices:
+      - treads
+      - logger
+      - Fresnel lens
+      - string
+    inventory:
+      - [1, flash bulb]
+      - [1, photographic plate]
+entities:
+  - name: flash bulb
+    display:
+      char: 'f'
+    description:
+      - Consumables for a `Fresnel lens`{=entity} that enable `ignite`ing
+    properties: [known, pickable]
+  - name: photographic plate
+    display:
+      char: 'p'
+    description:
+      - Consumables for a `Fresnel lens`{=entity} that enable `scan`ning
+    properties: [known, pickable]
+  - name: Fresnel lens
+    display:
+      char: 'z'
+    description:
+      - Ignites things with sufficiently powerful light source
+    properties: [known, pickable]
+    capabilities:
+      - capability: ignite
+        cost:
+          - [1, "flash bulb"]
+      - capability: scan
+        cost:
+          - [2, "photographic plate"]
+known: [water]
+world:
+  dsl: |
+    {water}
+  palette:
+    'B': [grass, erase, base]
+    '.': [grass, erase]
+  upperleft: [-1, 1]
+  map: |
+    ...
+    .B.
+    ...

data/scenarios/Testing/1777-capability-cost.yaml

@@ -0,0 +1,94 @@
+version: 1
+name: Capability cost
+description: |
+  Consume inventory by exercising device capabilities
+creative: false
+seed: 0
+objectives:
+  - goal:
+      - |
+        Eliminate the `packing peanut`{=entity}s
+    condition: |
+      hasLighterFluid <- as base {
+        has "lighter fluid";
+      };
+
+      if (not hasLighterFluid) {
+        judge <- robotnamed "judge";
+        as judge {
+          maybePath <- path (inL ()) (inR "packing peanut");
+          return $ case maybePath (\_. true) (\d. false);
+        }
+      } {
+        return false;
+      };
+solution: |
+  move;
+  turn right;
+  move;
+  place "packing peanut";
+  ignite down;
+  move;
+  move;
+  ignite forward;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - treads
+      - logger
+      - Zippo
+      - grabber
+    inventory:
+      - [2, lighter fluid]
+      - [1, packing peanut]
+  - name: judge
+    dir: east
+    system: true
+entities:
+  - name: lighter fluid
+    display:
+      char: 'f'
+    description:
+      - Fuel for a `Zippo`{=entity}
+    properties: [known, pickable]
+  - name: Zippo
+    display:
+      char: 'z'
+    description:
+      - Ignites things
+    properties: [known, pickable]
+    capabilities:
+      - capability: ignite
+        cost:
+          - [1, "lighter fluid"]
+  - name: packing peanut
+    display:
+      attr: snow
+      char: 's'
+    description:
+      - Easy to drop, but impossible to pick up.
+      - Highly combustible.
+    properties: [known, combustible]
+    combustion:
+      ignition: 0.5
+      duration: [10, 20]
+      product: ash
+known: [water, ash]
+world:
+  dsl: |
+    {water}
+  palette:
+    'B': [grass, erase, base]
+    'j': [grass, erase, judge]
+    '.': [grass, erase]
+    'c': [grass, packing peanut]
+  upperleft: [-1, 1]
+  map: |
+    ......
+    Bcccc.
+    .j....
+    .cccc.
+    ......
+    .cccc.
+    ......

data/scenarios/Testing/_Validation/1777-capability-cost-bad-entity-reference.yaml

@@ -0,0 +1,39 @@
+version: 1
+name: Capability cost - bad entity reference
+description: |
+  Capability cost recipe for 'ignite' in `Zippo`{=entity}
+  references a non-existent entity
+creative: false
+robots:
+  - name: base
+    dir: east
+    devices:
+      - Zippo
+entities:
+  - name: heavier fluid
+    display:
+      char: 'f'
+    description:
+      - Fuel for a Zippo
+    properties: [known, pickable]
+  - name: Zippo
+    display:
+      char: 'z'
+    description:
+      - Ignites things
+    properties: [known, pickable]
+    capabilities:
+      - capability: ignite
+        cost:
+          - [1, "lighter fluid"]
+known: []
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    '.': [grass]
+  upperleft: [-1, 1]
+  map: |
+    ..
+    B.

data/schema/entity.json

@@ -97,7 +97,25 @@
             "default": [],
             "type": "array",
             "items": {
-                "type": "string"
+                "oneOf": [
+                    {
+                        "type": "string"
+                    },
+                    {
+                        "type": "object",
+                        "additionalProperties": false,
+                        "properties": {
+                            "capability": {
+                                "description": "Capability name",
+                                "type": "string"
+                            },
+                            "cost": {
+                                "$ref": "inventory.json",
+                                "description": "A list of ingredients consumed by the command."
+                            }
+                        }
+                    }
+                ]
             },
             "description": "A list of capabilities provided by entity, when it is equipped as a device. See [Capabilities](https://github.com/swarm-game/swarm/wiki/Capabilities-cheat-sheet)."
         }

src/Swarm/Doc/Util.hs

@@ -30,9 +30,6 @@ codeQuote = wrap '`'
 addLink :: Text -> Text -> Text
 addLink l t = T.concat ["[", t, "](", l, ")"]
 
-tshow :: (Show a) => a -> Text
-tshow = T.pack . show
-
 -- * Common symbols
 
 operators :: [Const]

src/Swarm/TUI/Controller.hs

@@ -91,7 +91,7 @@ import Swarm.Game.State.Robot
 import Swarm.Game.State.Runtime
 import Swarm.Game.State.Substate
 import Swarm.Game.Step (finishGameTick, gameTick)
-import Swarm.Language.Capability (Capability (CDebug, CGod, CMake), constCaps)
+import Swarm.Language.Capability (Capability (CGod, CMake), constCaps)
 import Swarm.Language.Context
 import Swarm.Language.Key (KeyCombo, mkKeyCombo)
 import Swarm.Language.Module
@@ -309,7 +309,7 @@ handleMainEvent ev = do
   let isRunning = maybe True isRunningModal mt
   let isPaused = s ^. gameState . temporal . paused
   let isCreative = s ^. gameState . creativeMode
-  let hasDebug = fromMaybe isCreative $ s ^? gameState . to focusedRobot . _Just . robotCapabilities . Lens.contains CDebug
+  let hasDebug = hasDebugCapability isCreative s
   case ev of
     AppEvent ae -> case ae of
       Frame

src/Swarm/TUI/Controller/Util.hs

@@ -10,13 +10,17 @@ import Control.Lens
 import Control.Monad (forM_, unless)
 import Control.Monad.IO.Class (liftIO)
 import Data.Map qualified as M
+import Data.Set qualified as S
 import Graphics.Vty qualified as V
+import Swarm.Game.Device
+import Swarm.Game.Robot (robotCapabilities)
 import Swarm.Game.State
 import Swarm.Game.State.Landscape
 import Swarm.Game.State.Robot
 import Swarm.Game.State.Substate
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
+import Swarm.Language.Capability (Capability (CDebug))
 import Swarm.TUI.Model
 import Swarm.TUI.Model.UI
 import Swarm.TUI.View.Util (generateModal)
@@ -97,3 +101,8 @@ mouseLocToWorldCoords (Brick.Location mouseLoc) = do
           mx = snd mouseLoc' + fst regionStart
           my = fst mouseLoc' + snd regionStart
        in pure . Just $ Cosmic (region ^. subworld) $ W.Coords (mx, my)
+
+hasDebugCapability :: Bool -> AppState -> Bool
+hasDebugCapability isCreative s =
+  maybe isCreative (S.member CDebug . getCapabilitySet) $
+    s ^? gameState . to focusedRobot . _Just . robotCapabilities

src/Swarm/TUI/Model.hs

@@ -117,6 +117,7 @@ import GitHash (GitInfo)
 import Graphics.Vty (ColorMode (..))
 import Network.Wai.Handler.Warp (Port)
 import Swarm.Game.Entity as E
+import Swarm.Game.Ingredients
 import Swarm.Game.Robot
 import Swarm.Game.Robot.Concrete
 import Swarm.Game.Robot.Context