wip

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

@@ -174,7 +174,7 @@ capabilityRow PageAddress {..} em cap =
       $ constSyntax c
 
   cs = [c | c <- Syntax.allConst, let mcap = Capability.constCaps c, isJust $ find (== cap) mcap]
-  es = maybe [] (map D.device) $ 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

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

@@ -20,9 +20,10 @@ robots:
     dir: east
     devices:
       - treads
+      - logger
       - Zippo
     inventory:
-      - [1, lighter fluid]
+      - [0, lighter fluid]
   - name: judge
     dir: east
     system: true
@@ -43,7 +44,7 @@ entities:
       - capability: ignite
         cost:
           - [1, "lighter fluid"]
-known: [ash]
+known: [paper, ash]
 world:
   dsl: |
     {grass}

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/View.hs

@@ -122,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)
@@ -995,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

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

@@ -9,6 +9,7 @@ module Swarm.Game.Exception (
   Exn (..),
   IncapableFix (..),
   formatExn,
+  IncapableFixWords (..),
 
   -- * Helper functions
   formatIncapable,
@@ -25,7 +26,7 @@ import Data.Text qualified as T
 import GHC.Generics (Generic)
 import Swarm.Constant
 import Swarm.Game.Achievement.Definitions
-import Swarm.Game.Entity (EntityMap, deviceForCap, entityName)
+import Swarm.Game.Entity (EntityMap, devicesForCap, entityName)
 import Swarm.Language.Capability (Capability (CGod), capabilityName)
 import Swarm.Language.Pretty (prettyText)
 import Swarm.Language.Requirement (Requirements (..))
@@ -54,7 +55,9 @@ data IncapableFix
   = -- | 'Swarm.Language.Syntax.Equip' the missing device on yourself/target
     FixByEquip
   | -- | Add the missing device to your inventory
-    FixByObtain
+    FixByObtainDevice
+  | -- | Add the missing consumables to your inventory
+    FixByObtainConsumables
   deriving (Eq, Show, Generic, FromJSON, ToJSON)
 
 -- | The type of exceptions that can be thrown by robot programs.
@@ -99,11 +102,17 @@ formatExn em = \case
 -- INCAPABLE HELPERS
 -- ------------------------------------------------------------------
 
+data IncapableFixWords = IncapableFixWords
+  { fixVerb :: Text
+  , fixNoun :: Text
+  }
+
 -- | Pretty-print an 'IncapableFix': either "equip" or "obtain".
-formatIncapableFix :: IncapableFix -> Text
+formatIncapableFix :: IncapableFix -> IncapableFixWords
 formatIncapableFix = \case
-  FixByEquip -> "equip"
-  FixByObtain -> "obtain"
+  FixByEquip -> IncapableFixWords "equip" "device"
+  FixByObtainDevice -> IncapableFixWords "obtain" "device"
+  FixByObtainConsumables -> IncapableFixWords "obtain" "consumables"
 
 -- | Pretty print the incapable exception with an actionable suggestion
 --   on how to fix it.
@@ -156,12 +165,13 @@ formatIncapable em f (Requirements caps _ inv) tm
              , swarmRepoUrl <> "issues/26"
              ]
   | not (S.null caps) =
-      unlinesExText
-        ( "You do not have the devices required for:"
-            :| squote (prettyText tm)
-            : "Please " <> formatIncapableFix f <> ":"
-            : (("- " <>) . formatDevices <$> filter (not . null) deviceSets)
-        )
+      let IncapableFixWords fVerb fNoun = formatIncapableFix f
+       in unlinesExText
+            ( T.unwords ["You do not have the", fNoun, "required for:"]
+                :| squote (prettyText tm)
+                : "Please " <> fVerb <> ":"
+                : (("- " <>) . formatDevices <$> filter (not . null) deviceSets)
+            )
   | otherwise =
       unlinesExText
         ( "You are missing required inventory for:"
@@ -171,7 +181,7 @@ formatIncapable em f (Requirements caps _ inv) tm
         )
  where
   capList = S.toList caps
-  deviceSets = map (`deviceForCap` em) capList
+  deviceSets = map (`devicesForCap` em) capList
   devicePerCap = zip capList deviceSets
   -- capabilities not provided by any device
   capsNone = map (capabilityName . fst) $ filter (null . snd) devicePerCap

src/swarm-engine/Swarm/Game/Robot/Concrete.hs

@@ -98,6 +98,7 @@ instance ToSample Robot where
     sampleBase =
       instantiateRobot (Just $ C.initMachine [tmQ| move |] mempty C.emptyStore) 0 $
         mkRobot
+          mempty
           Nothing
           "base"
           "The starting robot."

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

@@ -99,7 +99,7 @@ import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TL
 import Linear (V2 (..))
 import Swarm.Game.CESK (emptyStore, finalValue, initMachine)
-import Swarm.Game.Device (getMap)
+import Swarm.Game.Device (getCapabilitySet, getMap)
 import Swarm.Game.Entity
 import Swarm.Game.Failure (SystemFailure (..))
 import Swarm.Game.Location
@@ -639,9 +639,9 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
   -- devices in inventory or equipped; and commands that require no
   -- capability.
   allCapabilities r =
-    inventoryCapabilities (r ^. equippedDevices)
-      <> inventoryCapabilities (r ^. robotInventory)
-  initialCaps = mconcat $ map allCapabilities robotList
+    inventoryCapabilities em (r ^. equippedDevices)
+      <> inventoryCapabilities em (r ^. robotInventory)
+  initialCaps = getCapabilitySet $ mconcat $ map allCapabilities robotList
   initialCommands =
     filter
       (maybe True (`S.member` initialCaps) . constCaps)

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

@@ -157,17 +157,36 @@ insertBackRobot rn rob = do
             unless (isActive rob) (sleepForever rn)
 
 -- Run a set of robots - this is used to run robots before/after the focused one.
-runRobotIDs :: (Has (State GameState) sig m, Has (Lift IO) sig m, Has Effect.Time sig m) => IS.IntSet -> m ()
+runRobotIDs ::
+  ( Has (State GameState) sig m
+  , Has (Lift IO) sig m
+  , Has Effect.Time sig m
+  ) =>
+  IS.IntSet ->
+  m ()
 runRobotIDs robotNames = forM_ (IS.toList robotNames) $ \rn -> do
   mr <- uses (robotInfo . robotMap) (IM.lookup rn)
   forM_ mr (stepOneRobot rn)
  where
   stepOneRobot rn rob = tickRobot rob >>= insertBackRobot rn
 
 -- This is a helper function to do one robot step or run robots before/after.
-singleStep :: (Has (State GameState) sig m, Has (Lift IO) sig m, Has Effect.Time sig m) => SingleStep -> RID -> IS.IntSet -> m Bool
+singleStep ::
+  ( Has (State GameState) sig m
+  , Has (Lift IO) sig m
+  , Has Effect.Time sig m
+  ) =>
+  SingleStep ->
+  RID ->
+  IS.IntSet ->
+  m Bool
 singleStep ss focRID robotSet = do
   let (preFoc, focusedActive, postFoc) = IS.splitMember focRID robotSet
+  em <- use $ landscape . entityMap
+  let h = hypotheticalRobot em (Out VUnit emptyStore []) 0
+      debugLog txt = do
+        m <- evalState @Robot h $ createLogEntry RobotError Debug txt
+        emitMessage m
   case ss of
     ----------------------------------------------------------------------------
     -- run robots from the beginning until focused robot
@@ -225,11 +244,6 @@ singleStep ss focRID robotSet = do
       -- go to single step if new robot is focused
       let (_pre, postRID) = IS.split rid robotSet
       singleStep SBefore focRID postRID
- where
-  h = hypotheticalRobot (Out VUnit emptyStore []) 0
-  debugLog txt = do
-    m <- evalState @Robot h $ createLogEntry RobotError Debug txt
-    emitMessage m
 
 -- | An accumulator for folding over the incomplete
 -- objectives to evaluate for their completion
@@ -345,7 +359,7 @@ hypotheticalWinCheck em g ws oc = do
     m <- evalState @Robot h $ createLogEntry RobotError Critical exnText
     emitMessage m
    where
-    h = hypotheticalRobot (Out VUnit emptyStore []) 0
+    h = hypotheticalRobot em (Out VUnit emptyStore []) 0
 
 evalPT ::
   ( Has Effect.Time sig m
@@ -360,10 +374,11 @@ evalPT t = evaluateCESK (initMachine t empty emptyStore)
 -- | Create a special robot to check some hypothetical, for example the win condition.
 --
 -- Use ID (-1) so it won't conflict with any robots currently in the robot map.
-hypotheticalRobot :: CESK -> TimeSpec -> Robot
-hypotheticalRobot m =
+hypotheticalRobot :: EntityMap -> CESK -> TimeSpec -> Robot
+hypotheticalRobot em m =
   instantiateRobot (Just m) (-1)
     . mkRobot
+      em
       Nothing
       "hypothesis"
       mempty
@@ -387,7 +402,8 @@ evaluateCESK ::
   m Value
 evaluateCESK cesk = do
   createdAt <- getNow
-  let r = hypotheticalRobot cesk createdAt
+  em <- use $ landscape . entityMap
+  let r = hypotheticalRobot em cesk createdAt
   zoomRobots $ addRobot r -- Add the special robot to the robot map, so it can look itself up if needed
   evalState r . runCESK $ cesk
 
@@ -625,7 +641,7 @@ stepCESK cesk = case cesk of
 
         devicesForCaps, requiredDevices :: Set (Set Text)
         -- possible devices to provide each required capability
-        devicesForCaps = S.map (S.fromList . map (^. entityName) . (`deviceForCap` em)) caps
+        devicesForCaps = S.map (S.fromList . map (^. entityName) . (`devicesForCap` em)) caps
         -- outright required devices
         requiredDevices = S.map S.singleton devs
 

src/swarm-engine/Swarm/Game/Step/Combustion.hs

@@ -21,6 +21,7 @@ import Control.Carrier.State.Lazy
 import Control.Effect.Lens
 import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
 import Control.Monad (forM_, when)
+import Data.Maybe (fromMaybe)
 import Data.Text qualified as T
 import Linear (zero)
 import Swarm.Effect as Effect (Time, getNow)
@@ -88,16 +89,17 @@ addCombustionBot ::
   Cosmic Location ->
   m Integer
 addCombustionBot inputEntity combustibility ts loc = do
-  botInventory <- case maybeCombustionProduct of
-    Nothing -> return []
-    Just n -> do
-      maybeE <- uses (landscape . entityMap) (lookupEntityName n)
-      return $ maybe [] (pure . (1,)) maybeE
+  em <- use $ landscape . entityMap
+  let botInventory = fromMaybe [] $ do
+        n <- maybeCombustionProduct
+        e <- lookupEntityName n em
+        return $ pure (1, e)
   combustionDurationRand <- uniform durationRange
   let combustionProg = combustionProgram combustionDurationRand combustibility
   zoomRobots
     . addTRobot (initMachine combustionProg empty emptyStore)
     $ mkRobot
+      em
       Nothing
       "fire"
       (Markdown.fromText $ T.unwords ["A burning", (inputEntity ^. entityName) <> "."])
@@ -180,9 +182,10 @@ igniteNeighbor ::
   m ()
 igniteNeighbor creationTime sourceDuration loc = do
   maybeEnt <- entityAt loc
-  forM_ maybeEnt igniteEntity
+  em <- use $ landscape . entityMap
+  forM_ maybeEnt $ igniteEntity em
  where
-  igniteEntity e =
+  igniteEntity em e =
     when (e `hasProperty` Combustible) $ do
       threshold <- uniform (0, 1)
       when (probabilityOfIgnition >= threshold) $ do
@@ -192,7 +195,7 @@ igniteNeighbor creationTime sourceDuration loc = do
                 . min (fromIntegral sourceDuration)
                 . negate
                 $ log ignitionDelayRand / rate
-        zoomRobots $ addIgnitionBot ignitionDelay e creationTime loc
+        zoomRobots $ addIgnitionBot em ignitionDelay e creationTime loc
    where
     neighborCombustibility = (e ^. entityCombustion) ? defaultCombustibility
     rate = E.ignition neighborCombustibility
@@ -203,14 +206,16 @@ igniteNeighbor creationTime sourceDuration loc = do
 --   that has been a priori determined that it shall be ignited.
 addIgnitionBot ::
   Has (State Robots) sig m =>
+  EntityMap ->
   Integer ->
   Entity ->
   TimeSpec ->
   Cosmic Location ->
   m ()
-addIgnitionBot ignitionDelay inputEntity ts loc =
+addIgnitionBot em ignitionDelay inputEntity ts loc =
   addTRobot (initMachine (ignitionProgram ignitionDelay) empty emptyStore) $
     mkRobot
+      em
       Nothing
       "firestarter"
       (Markdown.fromText $ T.unwords ["Delayed ignition of", (inputEntity ^. entityName) <> "."])