Convert device capabilities from Set to Map

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,15 @@ 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.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
@@ -38,7 +38,7 @@ import Swarm.Language.Syntax (Const (..))
 import Swarm.Language.Syntax qualified as Syntax
 import Swarm.Language.Text.Markdown as Markdown (docToMark)
 import Swarm.Language.Typecheck (inferConst)
-import Swarm.Util (listEnums)
+import Swarm.Util (listEnums, showT)
 import Swarm.Util.Effect (simpleErrorHandle)
 
 -- * Types
@@ -106,7 +106,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
@@ -168,13 +168,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
@@ -197,8 +197,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:"
@@ -221,13 +221,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 = Map.keys $ D.getMap $ view E.entityCapabilities e
 
 entitiesPage :: PageAddress -> [Entity] -> Text
 entitiesPage _a es =
@@ -251,11 +251,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

@@ -55,3 +55,4 @@ Achievements
 1634-message-colors.yaml
 1681-pushable-entity.yaml
 1747-volume-command.yaml
+1777-capability-cost.yaml

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

@@ -0,0 +1,62 @@
+version: 1
+name: Capability cost
+description: |
+  Consume inventory by exercising device capabilities
+creative: false
+objectives:
+  - goal:
+      - |
+        Eliminate the paper
+    condition: |
+      judge <- robotnamed "judge";
+      as judge {
+        dist <- sniff "paper";
+        return $ dist < 0;
+      }
+solution: |
+  ignite forward;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - treads
+      - logger
+      - Zippo
+    inventory:
+      - [0, lighter fluid]
+  - name: judge
+    dir: east
+    system: true
+entities:
+  - name: lighter 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: [paper, ash]
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    'j': [grass, null, judge]
+    '.': [grass]
+    'c': [grass, paper]
+  upperleft: [-1, 1]
+  map: |
+    ......
+    Bcccc.
+    .j..c.
+    .cccc.
+    ......

data/schema/entity.json

@@ -94,10 +94,30 @@
             "description": "A list of properties of this entity."
         },
         "capabilities": {
+
             "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

@@ -89,7 +89,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
@@ -307,7 +307,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

src/Swarm/TUI/Model/Menu.hs

@@ -21,6 +21,7 @@ import Data.Text (Text)
 import Data.Vector qualified as V
 import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Entity as E
+import Swarm.Game.Ingredients
 import Swarm.Game.ScenarioInfo (
   ScenarioCollection,
   ScenarioInfo (..),

src/Swarm/TUI/View.hs

@@ -73,8 +73,10 @@ import Network.Wai.Handler.Warp (Port)
 import Numeric (showFFloat)
 import Swarm.Constant
 import Swarm.Game.CESK (CESK (..))
+import Swarm.Game.Device (getMap)
 import Swarm.Game.Display
 import Swarm.Game.Entity as E
+import Swarm.Game.Ingredients
 import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.Robot
@@ -120,6 +122,7 @@ import Swarm.Language.Typecheck (inferConst)
 import Swarm.Log
 import Swarm.TUI.Border
 import Swarm.TUI.Controller (ticksPerFrameCap)
+import Swarm.TUI.Controller.Util (hasDebugCapability)
 import Swarm.TUI.Editor.Model
 import Swarm.TUI.Editor.View qualified as EV
 import Swarm.TUI.Inventory.Sorting (renderSortMethod)
@@ -993,7 +996,7 @@ drawKeyMenu s =
 
   isReplWorking = s ^. gameState . gameControls . replWorking
   isPaused = s ^. gameState . temporal . paused
-  hasDebug = fromMaybe creative $ s ^? gameState . to focusedRobot . _Just . robotCapabilities . Lens.contains CDebug
+  hasDebug = hasDebugCapability creative s
   viewingBase = (s ^. gameState . robotInfo . viewCenterRule) == VCRobot 0
   creative = s ^. gameState . creativeMode
   cheat = s ^. uiState . uiCheatMode
@@ -1199,8 +1202,8 @@ explainEntry s e =
     , drawMarkdown (e ^. entityDescription)
     , explainRecipes s e
     ]
-      <> [drawRobotMachine s False | e ^. entityCapabilities . Lens.contains CDebug]
-      <> [drawRobotLog s | e ^. entityCapabilities . Lens.contains CLog]
+      <> [drawRobotMachine s False | CDebug `M.member` getMap (e ^. entityCapabilities)]
+      <> [drawRobotLog s | CLog `M.member` getMap (e ^. entityCapabilities)]
 
 displayProperties :: [EntityProperty] -> Widget Name
 displayProperties = displayList . mapMaybe showProperty
@@ -1349,7 +1352,7 @@ drawRecipe me inv (Recipe ins outs reqs time _weight) =
 
 -- | Ad-hoc entity to represent time - only used in recipe drawing
 timeE :: Entity
-timeE = mkEntity (defaultEntityDisplay '.') "ticks" mempty [] []
+timeE = mkEntity (defaultEntityDisplay '.') "ticks" mempty [] mempty
 
 drawReqs :: IngredientList Entity -> Widget Name
 drawReqs = vBox . map (hCenter . drawReq)

src/swarm-engine/Swarm/Game/CESK.hs

@@ -86,8 +86,9 @@ import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IM
 import GHC.Generics (Generic)
 import Prettyprinter (Doc, Pretty (..), encloseSep, hsep, (<+>))
-import Swarm.Game.Entity (Count, Entity)
+import Swarm.Game.Entity (Entity)
 import Swarm.Game.Exception
+import Swarm.Game.Ingredients (Count)
 import Swarm.Game.Tick
 import Swarm.Game.World (WorldUpdate (..))
 import Swarm.Language.Context