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

@@ -35,6 +35,7 @@ import Swarm.Doc.Util
 import Swarm.Doc.Wiki.Cheatsheet
 import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityName)
 import Swarm.Game.Entity qualified as E
+import Swarm.Game.Land
 import Swarm.Game.Recipe (Recipe, recipeCatalysts, recipeInputs, recipeOutputs)
 import Swarm.Game.Robot (Robot, equippedDevices, robotInventory)
 import Swarm.Game.Scenario (GameStateInputs (..), loadStandaloneScenario, scenarioLandscape)
@@ -135,7 +136,7 @@ generateSpecialKeyNames =
 
 generateRecipe :: IO String
 generateRecipe = simpleErrorHandle $ do
-  (classic, GameStateInputs worlds entities recipes) <- loadStandaloneScenario "data/scenarios/classic.yaml"
+  (classic, GameStateInputs worlds (TerrainEntityMaps _ 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/scenarios/Testing/1775-custom-terrain.yaml

@@ -0,0 +1,56 @@
+version: 1
+name: Demo custom terrain
+description: |
+  Colorful new terrain
+creative: false
+terrains:
+  - name: beach
+    attr: gold
+    description: |
+      Shoreline covering, laborious to cross
+objectives:
+  - goal:
+      - |
+        Make an enclosed volume of 14 cells
+    condition: |
+      as base {
+        let targetVolume = 14 in
+        vol <- volume targetVolume;
+        return $case vol (\_. false) (\x. x == targetVolume);
+      }
+solution: |
+  noop
+robots:
+  - name: base
+    dir: east
+    devices:
+      - ADT calculator
+      - treads
+      - dozer blade
+      - logger
+      - branch predictor
+      - comparator
+entities:
+  - name: monolith
+    display:
+      char: '@'
+    description:
+      - Pushable rock
+    properties: [known, unwalkable, pickable]
+known: []
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    '.': [grass]
+    'i': [ice]
+    'b': [beach]
+  upperleft: [-1, 1]
+  map: |
+    B.......
+    ........
+    iiiiiiii
+    iiiiiiii
+    bbbbbbbb
+    bbbbbbbb

data/schema/scenario.json

@@ -32,6 +32,13 @@
             "default": null,
             "type": "number"
         },
+        "terrains": {
+            "description": "An optional list of custom terrain, to be used in addition to the built-in terrain.",
+            "default": [],
+            "items": {
+                "$ref": "terrain.json"
+            }
+        },
         "entities": {
             "description": "An optional list of custom entities, to be used in addition to the built-in entities.",
             "default": [],

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

@@ -31,8 +31,8 @@ import Data.Set qualified as S
 import Data.Text (Text)
 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,
@@ -174,13 +174,14 @@ generateIntroductionsSequence =
 -- For unit tests, can instead access the scenarios via the GameState.
 loadScenarioCollection :: IO ScenarioCollection
 loadScenarioCollection = simpleErrorHandle $ do
-  entities <- loadEntities
+  tem <- loadEntitiesAndTerrain
+
   -- 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

@@ -75,6 +75,7 @@ import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Achievement.Persistence
 import Swarm.Game.CESK (CESK (Out), Frame (FApp, FExec), cancel, emptyStore, initMachine)
 import Swarm.Game.Entity hiding (empty)
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
 import Swarm.Game.Robot
@@ -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

@@ -16,6 +16,7 @@ import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
 import Data.Map qualified as M
 import Data.Yaml qualified as Y
 import Graphics.Vty qualified as V
+import Swarm.Game.Land
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.State
 import Swarm.Game.State.Landscape
@@ -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