extensible terrain

.vscode/settings.json

@@ -4,6 +4,9 @@
             "data/scenarios/**/*.yaml",
             "scenarios/**/*.yaml"
         ],
+        "data/schema/terrains.json": [
+            "data/terrains.yaml"
+        ],
         "data/schema/entities.json": [
             "data/entities.yaml"
         ],

app/doc/Main.hs

@@ -47,6 +47,7 @@ cliParser =
     Data.Foldable.asum
       [ pure Nothing
       , Just Entities <$ switch (long "entities" <> help "Generate entities page (uses data from entities.yaml)")
+      , Just Terrain <$ switch (long "terrain" <> help "Generate terrain page (uses data from terrains.yaml)")
       , Just Recipes <$ switch (long "recipes" <> help "Generate recipes page (uses data from recipes.yaml)")
       , Just Capabilities <$ switch (long "capabilities" <> help "Generate capabilities page (uses entity map)")
       , Just Commands <$ switch (long "commands" <> help "Generate commands page (uses constInfo, constCaps and inferConst)")

app/doc/Swarm/Doc/Gen.hs

@@ -135,7 +135,7 @@ generateSpecialKeyNames =
 
 generateRecipe :: IO String
 generateRecipe = simpleErrorHandle $ do
-  (classic, GameStateInputs worlds entities recipes) <- loadStandaloneScenario "data/scenarios/classic.yaml"
+  (classic, GameStateInputs worlds _ entities recipes) <- loadStandaloneScenario "data/scenarios/classic.yaml"
   baseRobot <- instantiateBaseRobot $ classic ^. scenarioLandscape
   return . Dot.showDot $ recipesToDot baseRobot (worlds ! "classic") entities recipes
 

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

@@ -31,6 +31,7 @@ import Swarm.Game.Display (displayChar)
 import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities)
 import Swarm.Game.Entity qualified as E
 import Swarm.Game.Recipe (Recipe, loadRecipes, recipeCatalysts, recipeInputs, recipeOutputs, recipeTime, recipeWeight)
+import Swarm.Game.Terrain (loadTerrain)
 import Swarm.Language.Capability (Capability)
 import Swarm.Language.Capability qualified as Capability
 import Swarm.Language.Pretty (prettyText, prettyTextLine)
@@ -54,7 +55,7 @@ data PageAddress = PageAddress
   deriving (Eq, Show)
 
 -- | An enumeration of the kinds of cheat sheets we can produce.
-data SheetType = Entities | Commands | CommandMatrix | Capabilities | Recipes | Scenario
+data SheetType = Entities | Terrain | Commands | CommandMatrix | Capabilities | Recipes | Scenario
   deriving (Eq, Show, Enum, Bounded)
 
 -- * Functions
@@ -73,6 +74,9 @@ makeWikiPage address s = case s of
     Entities -> simpleErrorHandle $ do
       entities <- loadEntities
       sendIO $ T.putStrLn $ entitiesPage address (Map.elems $ entitiesByName entities)
+    Terrain -> simpleErrorHandle $ do
+      _terrains <- loadTerrain
+      sendIO $ T.putStrLn "Not implemented" -- TODO
     Recipes -> simpleErrorHandle $ do
       entities <- loadEntities
       recipes <- loadRecipes entities

data/schema/terrain.json

@@ -0,0 +1,46 @@
+{
+    "$schema": "http://json-schema.org/draft-07/schema#",
+    "$id": "https://raw.githubusercontent.com/swarm-game/swarm/main/data/schema/terrain.json",
+    "title": "Terrain",
+    "description": "Description of a terrain in the Swarm game",
+    "type": "object",
+    "additionalProperties": false,
+    "properties": {
+        "name": {
+            "type": "string",
+            "description": "The name of the terrain."
+        },
+        "description": {
+            "type": "string",
+            "description": "A description of the terrain."
+        },
+        "attr": {
+            "default": "entity",
+            "type": "string",
+            "examples": [
+                "entity",
+                "device",
+                "plant",
+                "rock",
+                "wood",
+                "flower",
+                "rubber",
+                "copper",
+                "copper'",
+                "iron",
+                "iron'",
+                "quartz",
+                "silver",
+                "gold",
+                "snow",
+                "sand",
+                "fire",
+                "red",
+                "green",
+                "blue",
+                "water"
+            ],
+            "description": "The name of the attribute that should be used to style the robot or entity. A list of currently valid attributes can be found [here](https://github.com/swarm-game/swarm/blob/main/src/Swarm/TUI/View/Attribute/Attr.hs)."
+        }
+    }
+}

data/schema/terrains.json

@@ -0,0 +1,10 @@
+{
+    "$schema": "http://json-schema.org/draft-07/schema#",
+    "$id": "https://raw.githubusercontent.com/swarm-game/swarm/main/data/schema/terrains.json",
+    "title": "Entities",
+    "description": "Description of terrain in the Swarm game",
+    "type": "array",
+    "items": {
+        "$ref": "terrain.json"
+    }
+}

data/terrains.yaml

@@ -0,0 +1,16 @@
+- name: stone
+  attr: stone
+  description: |
+    Solid, impenetrable material
+- name: dirt
+  attr: dirt
+  description: |
+    Soil amenable to plant growth
+- name: grass
+  attr: grass
+  description: |
+    Soft, verdant ground
+- name: ice
+  attr: ice
+  description: |
+    Cold, solid, and slippery.

scripts/validate-json-schemas.sh

@@ -5,5 +5,6 @@ cd $SCRIPT_DIR/..
 
 find data/scenarios -name "*.yaml" -type f -print0 | xargs -0 check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/scenario.json --schemafile data/schema/scenario.json
 
+check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/terrains.json --schemafile data/schema/terrains.json data/terrains.yaml
 check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/entities.json --schemafile data/schema/entities.json data/entities.yaml
 check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/recipes.json --schemafile data/schema/recipes.json data/recipes.yaml

src/Swarm/Doc/Pedagogy.hs

@@ -33,6 +33,7 @@ import Data.Text qualified as T
 import Swarm.Constant
 import Swarm.Game.Entity (loadEntities)
 import Swarm.Game.Failure (SystemFailure)
+import Swarm.Game.Land
 import Swarm.Game.Scenario (
   Scenario,
   scenarioDescription,
@@ -51,6 +52,7 @@ import Swarm.Game.ScenarioInfo (
   scenarioCollectionToList,
   scenarioPath,
  )
+import Swarm.Game.Terrain (loadTerrain)
 import Swarm.Game.World.Load (loadWorlds)
 import Swarm.Language.Module (Module (..))
 import Swarm.Language.Pipeline (ProcessedTerm (..))
@@ -174,13 +176,16 @@ generateIntroductionsSequence =
 -- For unit tests, can instead access the scenarios via the GameState.
 loadScenarioCollection :: IO ScenarioCollection
 loadScenarioCollection = simpleErrorHandle $ do
+  terrains <- loadTerrain
   entities <- loadEntities
+  let tem = TerrainEntityMaps terrains entities
+
   -- Note we ignore any warnings generated by 'loadWorlds' and
   -- 'loadScenarios' below.  Any warnings will be caught when loading
   -- all the scenarios via the usual code path; we do not need to do
   -- anything with them here while simply rendering pedagogy info.
-  worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds entities
-  ignoreWarnings @(Seq SystemFailure) $ loadScenarios entities worlds
+  worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds tem
+  ignoreWarnings @(Seq SystemFailure) $ loadScenarios tem worlds
 
 renderUsagesMarkdown :: CoverageInfo -> Text
 renderUsagesMarkdown (CoverageInfo (TutorialInfo (s, si) idx _sCmds dCmds) novelCmds) =

src/Swarm/TUI/Controller.hs

@@ -49,6 +49,7 @@ import Brick.Widgets.List qualified as BL
 import Control.Applicative (liftA2, pure)
 import Control.Carrier.Lift qualified as Fused
 import Control.Carrier.State.Lazy qualified as Fused
+import Swarm.Game.Land
 import Control.Lens as Lens
 import Control.Lens.Extras as Lens (is)
 import Control.Monad (forM_, unless, void, when)
@@ -1191,7 +1192,7 @@ handleREPLEventTyping = \case
       CharKey '\t' -> do
         s <- get
         let names = s ^.. gameState . baseRobot . robotContext . defTypes . to assocs . traverse . _1
-        uiState . uiGameplay . uiREPL %= tabComplete (CompletionContext (s ^. gameState . creativeMode)) names (s ^. gameState . landscape . entityMap)
+        uiState . uiGameplay . uiREPL %= tabComplete (CompletionContext (s ^. gameState . creativeMode)) names (s ^. gameState . landscape . terrainAndEntities . entityMap)
         modify validateREPLForm
       EscapeKey -> do
         formSt <- use $ uiState . uiGameplay . uiREPL . replPromptType

src/Swarm/TUI/Editor/Controller.hs

@@ -4,6 +4,7 @@
 -- SPDX-License-Identifier: BSD-3-Clause
 module Swarm.TUI.Editor.Controller where
 
+import Swarm.Game.Land
 import Brick hiding (Direction (..), Location (..))
 import Brick qualified as B
 import Brick.Focus
@@ -83,9 +84,11 @@ handleMiddleClick mouseLoc = do
   worldEditor <- use $ uiState . uiGameplay . uiWorldEditor
   when (worldEditor ^. worldOverdraw . isWorldEditorEnabled) $ do
     w <- use $ gameState . landscape . multiWorld
+    tem <- use $ gameState . landscape . terrainAndEntities . terrainMap
     let setTerrainPaint coords = do
           let (terrain, maybeElementPaint) =
                 EU.getEditorContentAt
+                  tem
                   (worldEditor ^. worldOverdraw)
                   w
                   coords
@@ -142,7 +145,8 @@ saveMapFile = do
   worldEditor <- use $ uiState . uiGameplay . uiWorldEditor
   maybeBounds <- use $ uiState . uiGameplay . uiWorldEditor . editingBounds . boundsRect
   w <- use $ gameState . landscape . multiWorld
-  let mapCellGrid = EU.getEditedMapRectangle (worldEditor ^. worldOverdraw) maybeBounds w
+  tm <- use $ gameState . landscape . terrainAndEntities . terrainMap
+  let mapCellGrid = EU.getEditedMapRectangle tm (worldEditor ^. worldOverdraw) maybeBounds w
 
   let fp = worldEditor ^. outputFilePath
   maybeScenarioPair <- use $ uiState . uiGameplay . scenarioRef

src/Swarm/TUI/Editor/Model.hs

@@ -79,7 +79,7 @@ initialWorldEditor :: TimeSpec -> WorldEditor Name
 initialWorldEditor ts =
   WorldEditor
     (WorldOverdraw False mempty)
-    (BL.list TerrainList (V.fromList listEnums) 1)
+    (BL.list TerrainList (V.fromList []) 1)
     (BL.list EntityPaintList (V.fromList []) 1)
     bounds
     (focusRing $ map WorldEditorPanelControl listEnums)

src/Swarm/TUI/Editor/Palette.hs

@@ -20,26 +20,27 @@ import Data.Text qualified as T
 import Data.Tuple (swap)
 import Swarm.Game.Display (Display, defaultChar)
 import Swarm.Game.Entity (Entity, EntityName, entitiesByName)
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
 import Swarm.Game.Scenario.Topography.WorldPalette
-import Swarm.Game.Terrain (TerrainType, getTerrainDefaultPaletteChar)
+import Swarm.Game.Terrain (TerrainMap, TerrainType, getTerrainDefaultPaletteChar, terrainByName)
 import Swarm.Game.Universe
 import Swarm.Language.Text.Markdown (fromText)
 import Swarm.TUI.Editor.Json (SkeletonScenario (SkeletonScenario))
 import Swarm.Util (binTuples, histogram)
-import Swarm.Util qualified as U
 import Swarm.Util.Erasable
 
 makeSuggestedPalette ::
+  TerrainMap ->
   KM.KeyMap (AugmentedCell Entity) ->
   [[CellPaintDisplay]] ->
   KM.KeyMap (AugmentedCell EntityFacade)
-makeSuggestedPalette originalScenarioPalette cellGrid =
+makeSuggestedPalette tm originalScenarioPalette cellGrid =
   KM.fromMapText
     . M.map (AugmentedCell Nothing)
     . M.fromList
@@ -109,7 +110,7 @@ makeSuggestedPalette originalScenarioPalette cellGrid =
   -- TODO (#1153): Filter out terrain-only palette entries that aren't actually
   -- used in the map.
   terrainOnlyPalette :: Map (TerrainWith EntityName) (T.Text, CellPaintDisplay)
-  terrainOnlyPalette = M.fromList $ map f U.listEnums
+  terrainOnlyPalette = M.fromList . map f . M.keys $ terrainByName tm
    where
     f x = ((x, ENothing), (T.singleton $ getTerrainDefaultPaletteChar x, Cell x ENothing []))
 
@@ -126,7 +127,8 @@ constructScenario maybeOriginalScenario (Grid cellGrid) =
     wd
     [] -- robots
  where
-  customEntities = maybe mempty (^. scenarioLandscape . scenarioEntities) maybeOriginalScenario
+  tem = maybe mempty (^. scenarioLandscape . scenarioTerrainAndEntities) maybeOriginalScenario
+  customEntities = tem ^. entityMap
   wd =
     WorldDescription
       { offsetOrigin = False
@@ -142,7 +144,7 @@ constructScenario maybeOriginalScenario (Grid cellGrid) =
 
   extractPalette = unPalette . palette . NE.head . (^. scenarioLandscape . scenarioWorlds)
   originalPalette = maybe mempty extractPalette maybeOriginalScenario
-  suggestedPalette = makeSuggestedPalette originalPalette cellGrid
+  suggestedPalette = makeSuggestedPalette (tem ^. terrainMap) originalPalette cellGrid
 
   upperLeftCoord =
     Location

src/Swarm/TUI/Editor/Util.hs

@@ -14,7 +14,7 @@ import Swarm.Game.Scenario.Topography.Area qualified as EA
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.WorldDescription
-import Swarm.Game.Terrain (TerrainType)
+import Swarm.Game.Terrain (TerrainMap, TerrainType)
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.TUI.Editor.Model
@@ -37,11 +37,12 @@ getEditingBounds myWorld =
   lowerRightLoc = EA.upperLeftToBottomRight a upperLeftLoc
 
 getEditorContentAt ::
+  TerrainMap ->
   WorldOverdraw ->
   W.MultiWorld Int Entity ->
   Cosmic W.Coords ->
   (TerrainType, Maybe EntityPaint)
-getEditorContentAt editorOverdraw w coords =
+getEditorContentAt tm editorOverdraw w coords =
   (terrainWithOverride, entityWithOverride)
  where
   terrainWithOverride = Maybe.fromMaybe underlyingCellTerrain $ do
@@ -60,15 +61,16 @@ getEditorContentAt editorOverdraw w coords =
   pm = editorOverdraw ^. paintedTerrain
 
   entityWithOverride = (Ref <$> underlyingCellEntity) <|> maybeEntityOverride
-  (underlyingCellTerrain, underlyingCellEntity) = getContentAt w coords
+  (underlyingCellTerrain, underlyingCellEntity) = getContentAt tm w coords
 
 getEditorTerrainAt ::
+  TerrainMap ->
   WorldOverdraw ->
   W.MultiWorld Int Entity ->
   Cosmic W.Coords ->
   TerrainType
-getEditorTerrainAt editor w coords =
-  fst $ getEditorContentAt editor w coords
+getEditorTerrainAt tm editor w coords =
+  fst $ getEditorContentAt tm editor w coords
 
 isOutsideTopLeftCorner ::
   -- | top left corner coords
@@ -98,12 +100,13 @@ isOutsideRegion (tl, br) coord =
   isOutsideTopLeftCorner tl coord || isOutsideBottomRightCorner br coord
 
 getEditedMapRectangle ::
+  TerrainMap ->
   WorldOverdraw ->
   Maybe (Cosmic W.BoundsRectangle) ->
   W.MultiWorld Int Entity ->
   EA.Grid CellPaintDisplay
-getEditedMapRectangle _ Nothing _ = EA.Grid []
-getEditedMapRectangle worldEditor (Just (Cosmic subworldName coords)) w =
+getEditedMapRectangle _ _ Nothing _ = EA.Grid []
+getEditedMapRectangle tm worldEditor (Just (Cosmic subworldName coords)) w =
   getMapRectangle toFacade getContent coords
  where
-  getContent = getEditorContentAt worldEditor w . Cosmic subworldName
+  getContent = getEditorContentAt tm worldEditor w . Cosmic subworldName