extensible terrain (#1775)

Closes #1641

The `data/terrain.yaml` file is now the authoritative source of terrains, though `BlankT` is still a hard-coded special case.

I have not changed the underlying integer representation of terrain in the world function, which means that the `terrainIndexByName` Map in the `TerrainMap` record is needed for translating between `Int` and `TerrainType`.

# Demo

    scripts/play.sh -i data/scenarios/Testing/1775-custom-terrain.yaml

![Screenshot from 2024-02-22 16-51-53](https://github.com/swarm-game/swarm/assets/261693/1d263c8b-4e9c-40bf-bdc8-bf5ba8e33c4d)

# Changes

* There used to be a function called `integrateScenarioEntities` that combined the `EntityMap` stored in the `Scenario` record with the global entity map.  However, the global entity map is accessible at parse time of the `Scenario`, so we do the combining there and only ever store the combined map in the `Scenario` record.
* JSON Schema for terrain
* Removed the distinction between "World" attributes and "Terrain" attributes
* Unit tests for scenario-defined terrain and related validations
    * Validate existence of referenced terrain at scenario parse time
    * Validate attributes referenced by terrains at parse time

.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, terrainByName)
 import Swarm.Language.Capability (Capability)
 import Swarm.Language.Capability qualified as Capability
 import Swarm.Language.Pretty (prettyText, prettyTextLine)
@@ -38,7 +39,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
@@ -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 . T.unlines . map showT . Map.elems $ terrainByName terrains
     Recipes -> simpleErrorHandle $ do
       entities <- loadEntities
       recipes <- loadRecipes entities

data/scenarios/Testing/00-ORDER.txt

@@ -55,3 +55,4 @@ Achievements
 1634-message-colors.yaml
 1681-pushable-entity.yaml
 1747-volume-command.yaml
+1775-custom-terrain.yaml

data/scenarios/Testing/1775-custom-terrain.yaml

@@ -0,0 +1,58 @@
+version: 1
+name: Demo custom terrain
+description: |
+  Colorful new terrain
+creative: false
+attrs:
+  - name: beachsand
+    bg: "#c2b280"
+  - name: lava
+    bg: "#dd7733"
+  - name: lilac
+    bg: "#a4a4bb"
+terrains:
+  - name: beach
+    attr: beachsand
+    description: |
+      Shoreline covering, laborious to cross
+  - name: lava
+    attr: lava
+    description: |
+      Scorching, liquid rock
+  - name: heather
+    attr: lilac
+    description: |
+      Flowery ground cover
+objectives:
+  - goal:
+      - |
+        No entities should be here
+    condition: |
+      as base {
+        isEmpty
+      }
+solution: |
+  noop
+robots:
+  - name: base
+    dir: east
+known: []
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [heather, null, base]
+    '.': [heather]
+    'i': [ice]
+    'b': [beach]
+    'v': [lava]
+  upperleft: [0, 0]
+  map: |
+    vvvvvvvv
+    vvvvvvvv
+    B.......
+    ........
+    iiiiiiii
+    iiiiiiii
+    bbbbbbbb
+    bbbbbbbb

data/scenarios/Testing/_Validation/1775-invalid-terrain-attr.yaml

@@ -0,0 +1,27 @@
+version: 1
+name: Custom terrain - invalid attribute
+description: |
+  Colorful new terrain
+creative: false
+attrs:
+  - name: lava
+    bg: "#dd7733"
+terrains:
+  - name: lava
+    attr: baklava
+    description: |
+      Scorching, liquid rock
+robots:
+  - name: base
+    dir: east
+known: []
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    '.': [lava]
+  upperleft: [0, 0]
+  map: |
+    B.
+    ..

data/scenarios/Testing/_Validation/1775-invalid-terrain-reference.yaml

@@ -0,0 +1,27 @@
+version: 1
+name: Custom terrain - invalid terrain reference
+description: |
+  Colorful new terrain
+creative: false
+attrs:
+  - name: lava
+    bg: "#dd7733"
+terrains:
+  - name: lava
+    attr: lava
+    description: |
+      Scorching, liquid rock
+robots:
+  - name: base
+    dir: east
+known: []
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    '.': [liver]
+  upperleft: [0, 0]
+  map: |
+    B.
+    ..

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,27 @@
+{
+    "$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": {
+            "type": "string",
+            "examples": [
+                "red",
+                "ice",
+                "dirt"
+            ],
+            "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": "Terrains",
+    "description": "Description of terrains 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/enforce-todo-issues.sh

@@ -4,7 +4,7 @@ SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
 cd $SCRIPT_DIR/..
 
 
-if grep --line-number --include \*.hs -riP '(TODO|FIXME|XXX)\b' src 2>&1 | grep -vP '#\d+'; then
+if grep --line-number --include \*.hs -riP '(TODO|FIXME|XXX)\b' src app 2>&1 | grep -vP '#\d+'; then
   echo "Please add a link to Issue, for example: TODO: #123"
   exit 1
 else

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
+  worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds tem
-  ignoreWarnings @(Seq SystemFailure) $ loadScenarios entities worlds
+  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
+    tm <- use $ gameState . landscape . terrainAndEntities . terrainMap
     let setTerrainPaint coords = do
           let (terrain, maybeElementPaint) =
                 EU.getEditorContentAt
+                  tm
                   (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,6 +20,7 @@ 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
@@ -27,19 +28,19 @@ 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 =
+getEditorTerrainAt tm editor w coords =
-  fst $ getEditorContentAt 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 _ _ Nothing _ = EA.Grid []
-getEditedMapRectangle worldEditor (Just (Cosmic subworldName coords)) w =
+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

src/Swarm/TUI/Editor/View.hs

@@ -8,9 +8,11 @@ import Brick.Widgets.Center (hCenter)
 import Brick.Widgets.List qualified as BL
 import Control.Lens hiding (Const, from)
 import Data.List qualified as L
+import Swarm.Game.Land
+import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Topography.Area qualified as EA
 import Swarm.Game.Scenario.Topography.EntityFacade
-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.Border
@@ -22,7 +24,11 @@ import Swarm.TUI.Panel
 import Swarm.TUI.View.Attribute.Attr
 import Swarm.TUI.View.CellDisplay (renderDisplay)
 import Swarm.TUI.View.Util qualified as VU
-import Swarm.Util (listEnums)
+
+extractTerrainMap :: UIState -> TerrainMap
+extractTerrainMap uis =
+  maybe mempty (view (scenarioLandscape . scenarioTerrainAndEntities . terrainMap) . fst) $
+    uis ^. uiGameplay . scenarioRef
 
 drawWorldEditor :: FocusRing Name -> UIState -> Widget Name
 drawWorldEditor toplevelFocusRing uis =
@@ -73,10 +79,12 @@ drawWorldEditor toplevelFocusRing uis =
    where
     selectedThing = snd <$> BL.listSelectedElement list
 
+  tm = extractTerrainMap uis
+
   brushWidget =
     mkFormControl (WorldEditorPanelControl BrushSelector) $
       padRight (Pad 1) (str "Brush:")
-        <+> swatchContent (worldEditor ^. terrainList) VU.drawLabeledTerrainSwatch
+        <+> swatchContent (worldEditor ^. terrainList) (VU.drawLabeledTerrainSwatch tm)
 
   entityWidget =
     mkFormControl (WorldEditorPanelControl EntitySelector) $
@@ -141,13 +149,13 @@ drawTerrainSelector :: AppState -> Widget Name
 drawTerrainSelector s =
   padAll 1
     . hCenter
-    . vLimit (length (listEnums :: [TerrainType]))
+    . vLimit 8
-    . BL.renderListWithIndex listDrawTerrainElement True
+    . BL.renderListWithIndex (listDrawTerrainElement $ extractTerrainMap $ s ^. uiState) True
     $ s ^. uiState . uiGameplay . uiWorldEditor . terrainList
 
-listDrawTerrainElement :: Int -> Bool -> TerrainType -> Widget Name
+listDrawTerrainElement :: TerrainMap -> Int -> Bool -> TerrainType -> Widget Name
-listDrawTerrainElement pos _isSelected a =
+listDrawTerrainElement tm pos _isSelected a =
-  clickable (TerrainListItem pos) $ VU.drawLabeledTerrainSwatch a
+  clickable (TerrainListItem pos) $ VU.drawLabeledTerrainSwatch tm a
 
 drawEntityPaintSelector :: AppState -> Widget Name
 drawEntityPaintSelector s =

src/Swarm/TUI/Model/StateUpdate.hs

@@ -45,6 +45,7 @@ import Swarm.Game.Achievement.Attainment
 import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Achievement.Persistence
 import Swarm.Game.Failure (SystemFailure)
+import Swarm.Game.Land
 import Swarm.Game.Scenario (
   loadScenario,
   scenarioAttrs,
@@ -141,7 +142,12 @@ constructAppState rs ui opts@(AppOpts {..}) = do
   case skipMenu opts of
     False -> return $ AppState gs (ui & uiGameplay . uiTiming . lgTicksPerSecond .~ defaultInitLgTicksPerSecond) rs
     True -> do
-      (scenario, path) <- loadScenario (fromMaybe "classic" userScenario) (gs ^. landscape . entityMap) (rs ^. worlds)
+      let tem = gs ^. landscape . terrainAndEntities
+      (scenario, path) <-
+        loadScenario
+          (fromMaybe "classic" userScenario)
+          tem
+          (rs ^. worlds)
       maybeRunScript <- traverse parseCodeFile scriptToRun
 
       let maybeAutoplay = do
@@ -260,8 +266,14 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
   return $
     u
       & uiPlaying .~ True
-      & uiGameplay . uiGoal .~ emptyGoalDisplay
       & uiCheatMode ||~ isAutoplaying
+      & uiAttrMap
+        .~ applyAttrMappings
+          ( map (first getWorldAttrName . toAttrPair) $
+              fst siPair ^. scenarioLandscape . scenarioAttrs
+          )
+          swarmAttrMap
+      & uiGameplay . uiGoal .~ emptyGoalDisplay
       & uiGameplay . uiHideGoals .~ (isAutoplaying && not (u ^. uiCheatMode))
       & uiGameplay . uiFocusRing .~ initFocusRing
       & uiGameplay . uiInventory . uiInventoryList .~ Nothing
@@ -270,12 +282,6 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
       & uiGameplay . uiTiming . uiShowFPS .~ False
       & uiGameplay . uiREPL .~ initREPLState (u ^. uiGameplay . uiREPL . replHistory)
       & uiGameplay . uiREPL . replHistory %~ restartREPLHistory
-      & uiAttrMap
-        .~ applyAttrMappings
-          ( map (first getWorldAttrName . toAttrPair) $
-              fst siPair ^. scenarioLandscape . scenarioAttrs
-          )
-          swarmAttrMap
       & uiGameplay . scenarioRef ?~ siPair
       & uiGameplay . uiTiming . lastFrameTime .~ curTime
       & uiGameplay . uiWorldEditor . EM.entityPaintList %~ BL.listReplace entityList Nothing
@@ -285,7 +291,7 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
           (SR.makeListWidget . M.elems $ gs ^. discovery . structureRecognition . automatons . originalStructureDefinitions)
           (focusSetCurrent (StructureWidgets StructuresList) $ focusRing $ map StructureWidgets listEnums)
  where
-  entityList = EU.getEntitiesForList $ gs ^. landscape . entityMap
+  entityList = EU.getEntitiesForList $ gs ^. landscape . terrainAndEntities . entityMap
 
   (isEmptyArea, newBounds) =
     EU.getEditingBounds $

src/Swarm/TUI/View.hs

@@ -75,6 +75,7 @@ import Swarm.Constant
 import Swarm.Game.CESK (CESK (..))
 import Swarm.Game.Display
 import Swarm.Game.Entity as E
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.Robot
@@ -91,6 +92,7 @@ import Swarm.Game.Scenario (
   scenarioObjectives,
   scenarioOperation,
   scenarioSeed,
+  scenarioTerrainAndEntities,
  )
 import Swarm.Game.Scenario.Scoring.Best
 import Swarm.Game.Scenario.Scoring.CodeSize
@@ -263,14 +265,17 @@ drawNewGameMenuUI (l :| ls) launchOptions = case displayedFor of
         fromMaybe 0 $
           s ^. scenarioLandscape . scenarioSeed
 
-    ri =
+    entIsKnown =
-      RenderingInput theWorlds $
       getEntityIsKnown $
         EntityKnowledgeDependencies
           { isCreativeMode = s ^. scenarioOperation . scenarioCreative
           , globallyKnownEntities = s ^. scenarioLandscape . scenarioKnown
           , theFocusedRobot = Nothing
           }
+
+    tm = s ^. scenarioLandscape . scenarioTerrainAndEntities . terrainMap
+    ri = RenderingInput theWorlds entIsKnown tm
+
     renderCoord = renderDisplay . displayLocRaw (WorldOverdraw False mempty) ri []
     worldPeek = worldWidget renderCoord vc
 
@@ -520,7 +525,12 @@ drawWorldCursorInfo worldEditor g cCoords =
    where
     f cell preposition = [renderDisplay cell, txt preposition]
 
-  ri = RenderingInput (g ^. landscape . multiWorld) (getEntityIsKnown $ mkEntityKnowledge g)
+  ri =
+    RenderingInput
+      (g ^. landscape . multiWorld)
+      (getEntityIsKnown $ mkEntityKnowledge g)
+      (g ^. landscape . terrainAndEntities . terrainMap)
+
   terrain = displayTerrainCell worldEditor ri cCoords
   entity = displayEntityCell worldEditor ri cCoords
   robot = displayRobotCell g cCoords

src/Swarm/TUI/View/Attribute/Attr.hs

@@ -19,7 +19,6 @@ module Swarm.TUI.View.Attribute.Attr (
   messageAttributeNames,
   toAttrName,
   getWorldAttrName,
-  getTerrainAttrName,
   mkBrickColor,
 
   -- ** Common attributes
@@ -69,7 +68,6 @@ toAttrName = \case
   ARobot -> robotAttr
   AEntity -> entityAttr
   AWorld n -> worldPrefix <> attrName (unpack n)
-  ATerrain n -> terrainPrefix <> attrName (unpack n)
   ADefault -> defAttr
 
 toVtyAttr :: PreservableColor -> V.Attr
@@ -98,7 +96,6 @@ swarmAttrMap =
     $ NE.toList activityMeterAttributes
       <> NE.toList robotMessageAttributes
       <> map (getWorldAttrName *** toVtyAttr) (M.toList worldAttributes)
-      <> map (getTerrainAttrName *** toVtyAttr) (M.toList terrainAttributes)
       <> [ -- Robot attribute
            (robotAttr, fg V.white `V.withStyle` V.bold)
          , -- UI rendering attributes
@@ -126,12 +123,6 @@ swarmAttrMap =
            (defAttr, V.defAttr)
          ]
 
-terrainPrefix :: AttrName
-terrainPrefix = attrName "terrain"
-
-getTerrainAttrName :: TerrainAttr -> AttrName
-getTerrainAttrName (TerrainAttr n) = terrainPrefix <> attrName n
-
 worldPrefix :: AttrName
 worldPrefix = attrName "world"
 

src/Swarm/TUI/View/CellDisplay.hs

@@ -30,6 +30,7 @@ import Swarm.Game.Display (
   hidden,
  )
 import Swarm.Game.Entity
+import Swarm.Game.Land
 import Swarm.Game.Robot
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
@@ -76,6 +77,7 @@ drawLoc ui g cCoords@(Cosmic _ coords) =
 data RenderingInput = RenderingInput
   { multiworldInfo :: W.MultiWorld Int Entity
   , isKnownFunc :: EntityPaint -> Bool
+  , terrMap :: TerrainMap
   }
 
 displayTerrainCell ::
@@ -84,7 +86,10 @@ displayTerrainCell ::
   Cosmic W.Coords ->
   Display
 displayTerrainCell worldEditor ri coords =
-  terrainMap M.! EU.getEditorTerrainAt worldEditor (multiworldInfo ri) coords
+  maybe mempty terrainDisplay $ M.lookup t tm
+ where
+  tm = terrainByName $ terrMap ri
+  t = EU.getEditorTerrainAt (terrMap ri) worldEditor (multiworldInfo ri) coords
 
 displayRobotCell ::
   GameState ->
@@ -136,7 +141,7 @@ displayEntityCell ::
 displayEntityCell worldEditor ri coords =
   maybeToList $ displayForEntity <$> maybeEntity
  where
-  (_, maybeEntity) = EU.getEditorContentAt worldEditor (multiworldInfo ri) coords
+  (_, maybeEntity) = EU.getEditorContentAt (terrMap ri) worldEditor (multiworldInfo ri) coords
 
   displayForEntity :: EntityPaint -> Display
   displayForEntity e = (if isKnownFunc ri e then id else hidden) $ getDisplay e
@@ -150,7 +155,12 @@ displayLoc showRobots we g cCoords@(Cosmic _ coords) =
   staticDisplay g coords
     <> displayLocRaw we ri robots cCoords
  where
-  ri = RenderingInput (g ^. landscape . multiWorld) (getEntityIsKnown $ mkEntityKnowledge g)
+  ri =
+    RenderingInput
+      (g ^. landscape . multiWorld)
+      (getEntityIsKnown $ mkEntityKnowledge g)
+      (g ^. landscape . terrainAndEntities . terrainMap)
+
   robots =
     if showRobots
       then displayRobotCell g cCoords

src/Swarm/TUI/View/Logo.hs

@@ -39,4 +39,4 @@ drawLogo = centerLayer . vBox . map (hBox . T.foldr (\c ws -> drawThing c : ws)
   plantAttr = getWorldAttrName $ fst plant
 
   dirtAttr :: AttrName
-  dirtAttr = getTerrainAttrName $ fst dirt
+  dirtAttr = getWorldAttrName $ fst dirt

src/Swarm/TUI/View/Util.hs

@@ -16,10 +16,12 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Graphics.Vty qualified as V
 import Swarm.Game.Entity as E
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Scenario (scenarioMetadata, scenarioName)
 import Swarm.Game.ScenarioInfo (scenarioItemName)
 import Swarm.Game.State
+import Swarm.Game.State.Landscape
 import Swarm.Game.State.Substate
 import Swarm.Game.Terrain
 import Swarm.Language.Pretty (prettyTextLine)
@@ -30,7 +32,6 @@ import Swarm.TUI.Model
 import Swarm.TUI.Model.UI
 import Swarm.TUI.View.Attribute.Attr
 import Swarm.TUI.View.CellDisplay
-import Swarm.Util (listEnums)
 import Witch (from, into)
 
 -- | Generate a fresh modal window of the requested type.
@@ -110,7 +111,8 @@ generateModal s mt = Modal mt (dialog (Just $ str title) buttons (maxModalWindow
       KeepPlayingModal -> ("", Just (Button CancelButton, [("OK", Button CancelButton, Cancel)]), 80)
       TerrainPaletteModal -> ("Terrain", Nothing, w)
        where
-        wordLength = maximum $ map (length . show) (listEnums :: [TerrainType])
+        tm = s ^. gameState . landscape . terrainAndEntities . terrainMap
+        wordLength = maximum $ map (T.length . getTerrainWord) (M.keys $ terrainByName tm)
         w = wordLength + 6
       EntityPaletteModal -> ("Entity", Nothing, 30)
 
@@ -150,11 +152,16 @@ drawMarkdown d = do
     "type" -> magentaAttr
     _snippet -> highlightAttr -- same as plain code
 
-drawLabeledTerrainSwatch :: TerrainType -> Widget Name
+drawLabeledTerrainSwatch :: TerrainMap -> TerrainType -> Widget Name
-drawLabeledTerrainSwatch a =
+drawLabeledTerrainSwatch tm a =
   tile <+> str materialName
  where
-  tile = padRight (Pad 1) $ renderDisplay $ terrainMap M.! a
+  tile =
+    padRight (Pad 1)
+      . renderDisplay
+      . maybe mempty terrainDisplay
+      $ M.lookup a (terrainByName tm)
+
   materialName = init $ show a
 
 descriptionTitle :: Entity -> String

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

@@ -55,8 +55,8 @@ import Data.Sequence (Seq)
 import Data.Sequence qualified as Seq
 import Data.Text (Text)
 import Data.Yaml as Y
-import Swarm.Game.Entity
 import Swarm.Game.Failure
+import Swarm.Game.Land
 import Swarm.Game.ResourceLoading (getDataDirSafe, getSwarmSavePath)
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Scoring.CodeSize
@@ -137,16 +137,16 @@ flatten (SICollection _ c) = concatMap flatten $ scenarioCollectionToList c
 -- | Load all the scenarios from the scenarios data directory.
 loadScenarios ::
   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
-  EntityMap ->
+  TerrainEntityMaps ->
   WorldMap ->
   m ScenarioCollection
-loadScenarios em worldMap = do
+loadScenarios tem worldMap = do
   res <- runThrow @SystemFailure $ getDataDirSafe Scenarios "scenarios"
   case res of
     Left err -> do
       warn err
       return $ SC mempty mempty
-    Right dataDir -> loadScenarioDir em worldMap dataDir
+    Right dataDir -> loadScenarioDir tem worldMap dataDir
 
 -- | The name of the special file which indicates the order of
 --   scenarios in a folder.
@@ -161,11 +161,11 @@ readOrderFile orderFile =
 --   the 00-ORDER file (if any) giving the order for the scenarios.
 loadScenarioDir ::
   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
-  EntityMap ->
+  TerrainEntityMaps ->
   WorldMap ->
   FilePath ->
   m ScenarioCollection
-loadScenarioDir em worldMap dir = do
+loadScenarioDir tem worldMap dir = do
   let orderFile = dir </> orderFileName
       dirName = takeBaseName dir
   orderExists <- sendIO $ doesFileExist orderFile
@@ -196,7 +196,7 @@ loadScenarioDir em worldMap dir = do
   -- Only keep the files from 00-ORDER.txt that actually exist.
   let morder' = filter (`elem` itemPaths) <$> morder
       loadItem filepath = do
-        item <- loadScenarioItem em worldMap (dir </> filepath)
+        item <- loadScenarioItem tem worldMap (dir </> filepath)
         return (filepath, item)
   scenarios <- mapM (runThrow @SystemFailure . loadItem) itemPaths
   let (failures, successes) = partitionEithers scenarios
@@ -257,17 +257,17 @@ loadScenarioItem ::
   , Has (Accum (Seq SystemFailure)) sig m
   , Has (Lift IO) sig m
   ) =>
-  EntityMap ->
+  TerrainEntityMaps ->
   WorldMap ->
   FilePath ->
   m ScenarioItem
-loadScenarioItem em worldMap path = do
+loadScenarioItem tem worldMap path = do
   isDir <- sendIO $ doesDirectoryExist path
   let collectionName = into @Text . dropWhile isSpace . takeBaseName $ path
   case isDir of
-    True -> SICollection collectionName <$> loadScenarioDir em worldMap path
+    True -> SICollection collectionName <$> loadScenarioDir tem worldMap path
     False -> do
-      s <- loadScenarioFile em worldMap path
+      s <- loadScenarioFile tem worldMap path
       eitherSi <- runThrow @SystemFailure (loadScenarioInfo path)
       case eitherSi of
         Right si -> return $ SISingle (s, si)

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

@@ -101,6 +101,7 @@ import Linear (V2 (..))
 import Swarm.Game.CESK (emptyStore, finalValue, initMachine)
 import Swarm.Game.Entity
 import Swarm.Game.Failure (SystemFailure (..))
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Recipe (
   catRecipeMap,
@@ -577,7 +578,7 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
       & randomness . seed .~ theSeed
       & randomness . randGen .~ mkStdGen theSeed
       & recipesInfo %~ modifyRecipesInfo
-      & landscape .~ mkLandscape sLandscape em worldTuples theSeed
+      & landscape .~ mkLandscape sLandscape worldTuples theSeed
       & gameControls . initiallyRunCode .~ initialCodeToRun
       & gameControls . replStatus .~ case running of -- When the base starts out running a program, the REPL status must be set to working,
       -- otherwise the store of definition cells is not saved (see #333, #838)
@@ -593,7 +594,7 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
       & recipesIn %~ addRecipesWith inRecipeMap
       & recipesCat %~ addRecipesWith catRecipeMap
 
-  em = integrateScenarioEntities (initState gsc) sLandscape
+  TerrainEntityMaps _ em = sLandscape ^. scenarioTerrainAndEntities
   baseID = 0
   (things, devices) = partition (null . view entityCapabilities) (M.elems (entitiesByName em))
 

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

@@ -13,7 +13,7 @@ module Swarm.Game.State.Runtime (
   eventLog,
   worlds,
   scenarios,
-  stdEntityMap,
+  stdEntityTerrainMap,
   stdRecipes,
   appData,
   nameParts,
@@ -32,8 +32,9 @@ import Data.Map (Map)
 import Data.Sequence (Seq)
 import Data.Text (Text)
 import Network.Wai.Handler.Warp (Port)
-import Swarm.Game.Entity (Entity, EntityMap, loadEntities)
+import Swarm.Game.Entity (Entity)
 import Swarm.Game.Failure (SystemFailure)
+import Swarm.Game.Land
 import Swarm.Game.Recipe (Recipe, loadRecipes)
 import Swarm.Game.ResourceLoading (NameGenerator, initNameGenerator, readAppData)
 import Swarm.Game.Scenario (GameStateInputs (..))
@@ -51,7 +52,7 @@ data RuntimeState = RuntimeState
   , _eventLog :: Notifications LogEntry
   , _worlds :: WorldMap
   , _scenarios :: ScenarioCollection
-  , _stdEntityMap :: EntityMap
+  , _stdEntityTerrainMap :: TerrainEntityMaps
   , _stdRecipes :: [Recipe Entity]
   , _appData :: Map Text Text
   , _nameParts :: NameGenerator
@@ -64,10 +65,10 @@ initRuntimeState ::
   ) =>
   m RuntimeState
 initRuntimeState = do
-  entities <- loadEntities
+  tem <- loadEntitiesAndTerrain
-  recipes <- loadRecipes entities
+  recipes <- loadRecipes $ tem ^. entityMap
-  worlds <- loadWorlds entities
+  worlds <- loadWorlds tem
-  scenarios <- loadScenarios entities worlds
+  scenarios <- loadScenarios tem worlds
   appDataMap <- readAppData
   nameGen <- initNameGenerator appDataMap
   return $
@@ -77,7 +78,7 @@ initRuntimeState = do
       , _eventLog = mempty
       , _worlds = worlds
       , _scenarios = scenarios
-      , _stdEntityMap = entities
+      , _stdEntityTerrainMap = tem
       , _stdRecipes = recipes
       , _appData = appDataMap
       , _nameParts = nameGen
@@ -105,10 +106,10 @@ worlds :: Lens' RuntimeState WorldMap
 -- | The collection of scenarios that comes with the game.
 scenarios :: Lens' RuntimeState ScenarioCollection
 
--- | The standard entity map loaded from disk.  Individual scenarios
+-- | The standard terrain/entity maps loaded from disk.  Individual scenarios
---   may define additional entities which will get added to this map
+--   may define additional terrain/entities which will get added to this map
 --   when loading the scenario.
-stdEntityMap :: Lens' RuntimeState EntityMap
+stdEntityTerrainMap :: Lens' RuntimeState TerrainEntityMaps
 
 -- | The standard list of recipes loaded from disk.  Individual scenarios
 --   may define additional recipes which will get added to this list
@@ -129,7 +130,7 @@ mkGameStateConfig rs =
     { initNameParts = rs ^. nameParts
     , initState =
         GameStateInputs
-          { initEntities = rs ^. stdEntityMap
+          { initEntityTerrain = rs ^. stdEntityTerrainMap
           , initRecipes = rs ^. stdRecipes
           , initWorldMap = rs ^. worlds
           }

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

@@ -48,6 +48,7 @@ import Swarm.Game.CESK
 import Swarm.Game.Display
 import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
 import Swarm.Game.Exception
+import Swarm.Game.Land
 import Swarm.Game.Robot
 import Swarm.Game.Robot.Activity
 import Swarm.Game.Robot.Concrete
@@ -123,7 +124,7 @@ gameTick = do
     case wc of
       WinConditions winState oc -> do
         g <- get @GameState
-        em <- use $ landscape . entityMap
+        em <- use $ landscape . terrainAndEntities . entityMap
         hypotheticalWinCheck em g winState oc
       _ -> pure ()
   return ticked
@@ -620,7 +621,7 @@ stepCESK cesk = case cesk of
   -- listing the requirements of the given expression.
   Out (VRequirements src t _) s (FExec : k) -> do
     currentContext <- use $ robotContext . defReqs
-    em <- use $ landscape . entityMap
+    em <- use $ landscape . terrainAndEntities . entityMap
     let (R.Requirements caps devs inv, _) = R.requirements currentContext t
 
         devicesForCaps, requiredDevices :: Set (Set Text)
@@ -780,7 +781,7 @@ stepCESK cesk = case cesk of
     -- cells which were in the middle of being evaluated will be reset.
     let s' = resetBlackholes s
     h <- hasCapability CLog
-    em <- use $ landscape . entityMap
+    em <- use $ landscape . terrainAndEntities . entityMap
     if h
       then do
         void $ traceLog RobotError Error (formatExn em exn)

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

@@ -28,6 +28,7 @@ import Swarm.Game.CESK (emptyStore, initMachine)
 import Swarm.Game.Display
 import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
 import Swarm.Game.Entity qualified as E
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Robot
 import Swarm.Game.State
@@ -91,7 +92,7 @@ addCombustionBot inputEntity combustibility ts loc = do
   botInventory <- case maybeCombustionProduct of
     Nothing -> return []
     Just n -> do
-      maybeE <- uses (landscape . entityMap) (lookupEntityName n)
+      maybeE <- uses (landscape . terrainAndEntities . entityMap) (lookupEntityName n)
       return $ maybe [] (pure . (1,)) maybeE
   combustionDurationRand <- uniform durationRange
   let combustionProg = combustionProgram combustionDurationRand combustibility

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

@@ -52,6 +52,7 @@ import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
 import Swarm.Game.Entity qualified as E
 import Swarm.Game.Exception
 import Swarm.Game.Failure
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.ResourceLoading (getDataFileNameSafe)
@@ -292,7 +293,7 @@ execConst runChildProg c vs s k = do
           let area = map (<$ nextLoc) $ getLocsInArea (nextLoc ^. planar) 5
           emptyLocs <- filterM (fmap isNothing . entityAt) area
           randomLoc <- weightedChoice (const 1) emptyLocs
-          es <- uses (landscape . entityMap) allEntities
+          es <- uses (landscape . terrainAndEntities . entityMap) allEntities
           randomEntity <- weightedChoice (const 1) es
           case (randomLoc, randomEntity) of
             (Just loc, Just e) -> updateEntityAt loc (const (Just e))
@@ -427,7 +428,7 @@ execConst runChildProg c vs s k = do
       [VText name] -> do
         inv <- use robotInventory
         ins <- use equippedDevices
-        em <- use $ landscape . entityMap
+        em <- use $ landscape . terrainAndEntities . entityMap
         e <-
           lookupEntityName name em
             `isJustOrFail` ["I've never heard of", indefiniteQ name <> "."]
@@ -570,7 +571,7 @@ execConst runChildProg c vs s k = do
       _ -> badConst
     HasTag -> case vs of
       [VText eName, VText tName] -> do
-        em <- use $ landscape . entityMap
+        em <- use $ landscape . terrainAndEntities . entityMap
         e <-
           lookupEntityName eName em
             `isJustOrFail` ["I've never heard of", indefiniteQ eName <> "."]
@@ -845,7 +846,7 @@ execConst runChildProg c vs s k = do
       _ -> badConst
     Create -> case vs of
       [VText name] -> do
-        em <- use $ landscape . entityMap
+        em <- use $ landscape . terrainAndEntities . entityMap
         e <-
           lookupEntityName name em
             `isJustOrFail` ["I've never heard of", indefiniteQ name <> "."]
@@ -1132,7 +1133,7 @@ execConst runChildProg c vs s k = do
 
             -- Copy over the salvaged robot's log, if we have one
             inst <- use equippedDevices
-            em <- use $ landscape . entityMap
+            em <- use $ landscape . terrainAndEntities . entityMap
             isPrivileged <- isPrivilegedBot
             logger <-
               lookupEntityName "logger" em
@@ -1467,7 +1468,7 @@ execConst runChildProg c vs s k = do
     m (Set Entity, Inventory)
   checkRequirements parentInventory childInventory childDevices cmd subject fixI = do
     currentContext <- use $ robotContext . defReqs
-    em <- use $ landscape . entityMap
+    em <- use $ landscape . terrainAndEntities . entityMap
     creative <- use creativeMode
     let -- Note that _capCtx must be empty: at least at the
         -- moment, definitions are only allowed at the top level,
@@ -1734,7 +1735,7 @@ execConst runChildProg c vs s k = do
     let yieldName = e ^. entityYields
     e' <- case yieldName of
       Nothing -> return e
-      Just n -> fromMaybe e <$> uses (landscape . entityMap) (lookupEntityName n)
+      Just n -> fromMaybe e <$> uses (landscape . terrainAndEntities . entityMap) (lookupEntityName n)
 
     robotInventory %= insert e'
     updateDiscoveredEntities e'

src/swarm-scenario/Swarm/Game/Display.hs

@@ -54,12 +54,9 @@ import Swarm.Util.Yaml (FromJSONE (..), With (runE), getE, liftE, withObjectE)
 type Priority = Int
 
 -- | An internal attribute name.
-data Attribute = ADefault | ARobot | AEntity | AWorld Text | ATerrain Text
+data Attribute = ADefault | ARobot | AEntity | AWorld Text
   deriving (Eq, Ord, Show, Generic, Hashable)
 
-terrainPrefix :: Text
-terrainPrefix = "terrain_"
-
 instance FromJSON Attribute where
   parseJSON =
     withText "attribute" $
@@ -67,7 +64,6 @@ instance FromJSON Attribute where
         "robot" -> ARobot
         "entity" -> AEntity
         "default" -> ADefault
-        t | terrainPrefix `T.isPrefixOf` t -> ATerrain $ T.drop (T.length terrainPrefix) t
         w -> AWorld w
 
 instance ToJSON Attribute where
@@ -76,7 +72,6 @@ instance ToJSON Attribute where
     ARobot -> String "robot"
     AEntity -> String "entity"
     AWorld w -> String w
-    ATerrain t -> String $ terrainPrefix <> t
 
 -- | A record explaining how to display an entity in the TUI.
 data Display = Display

src/swarm-scenario/Swarm/Game/Entity.hs

@@ -47,7 +47,7 @@ module Swarm.Game.Entity (
   -- ** Entity map
   EntityMap (..),
   buildEntityMap,
-  validateAttrRefs,
+  validateEntityAttrRefs,
   loadEntities,
   allEntities,
   lookupEntityName,
@@ -403,8 +403,8 @@ deviceForCap :: Capability -> EntityMap -> [Entity]
 deviceForCap cap = fromMaybe [] . M.lookup cap . entitiesByCap
 
 -- | Validates references to 'Display' attributes
-validateAttrRefs :: Has (Throw LoadingFailure) sig m => Set WorldAttr -> [Entity] -> m ()
+validateEntityAttrRefs :: Has (Throw LoadingFailure) sig m => Set WorldAttr -> [Entity] -> m ()
-validateAttrRefs validAttrs es =
+validateEntityAttrRefs validAttrs es =
   forM_ namedEntities $ \(eName, ent) ->
     case ent ^. entityDisplay . displayAttr of
       AWorld n ->
@@ -496,7 +496,7 @@ loadEntities = do
     withThrow (entityFailure . CanNotParseYaml) . (liftEither <=< sendIO) $
       decodeFileEither fileName
 
-  withThrow entityFailure $ validateAttrRefs (M.keysSet worldAttributes) decoded
+  withThrow entityFailure $ validateEntityAttrRefs (M.keysSet worldAttributes) decoded
   withThrow entityFailure $ buildEntityMap decoded
 
 ------------------------------------------------------------

src/swarm-scenario/Swarm/Game/Entity/Cosmetic.hs

@@ -69,6 +69,3 @@ flattenBg = \case
 
 newtype WorldAttr = WorldAttr String
   deriving (Eq, Ord, Show)
-
-newtype TerrainAttr = TerrainAttr String
-  deriving (Eq, Ord, Show)

src/swarm-scenario/Swarm/Game/Entity/Cosmetic/Assignment.hs

@@ -15,7 +15,7 @@ import Data.Map (Map)
 import Data.Map qualified as M
 import Swarm.Game.Entity.Cosmetic
 
--- * Entities
+-- * Entities and Terrain
 
 entity :: (WorldAttr, PreservableColor)
 entity = (WorldAttr "entity", FgOnly $ AnsiColor White)
@@ -29,13 +29,33 @@ rock = (WorldAttr "rock", FgOnly $ Triple $ RGB 80 80 80)
 plant :: (WorldAttr, PreservableColor)
 plant = (WorldAttr "plant", FgOnly $ AnsiColor Green)
 
+dirt :: (WorldAttr, PreservableColor)
+dirt = (WorldAttr "dirt", BgOnly $ Triple $ RGB 87 47 47)
+
+grass :: (WorldAttr, PreservableColor)
+grass = (WorldAttr "grass", BgOnly $ Triple $ RGB 0 47 0) -- dark green
+
+stone :: (WorldAttr, PreservableColor)
+stone = (WorldAttr "stone", BgOnly $ Triple $ RGB 47 47 47)
+
+ice :: (WorldAttr, PreservableColor)
+ice = (WorldAttr "ice", BgOnly $ AnsiColor White)
+
 -- | Colors of entities in the world.
 worldAttributes :: Map WorldAttr PreservableColor
 worldAttributes =
   M.fromList $
-    -- these four are referenced elsewhere,
+    -- these few are referenced elsewhere,
     -- so they have their own toplevel definition
-    [entity, water, rock, plant]
+    [ entity
+    , water
+    , rock
+    , plant
+    , dirt
+    , grass
+    , stone
+    , ice
+    ]
       <> map
         (bimap WorldAttr FgOnly)
         [ ("device", AnsiColor BrightYellow)
@@ -56,26 +76,3 @@ worldAttributes =
         , ("green", AnsiColor Green)
         , ("blue", AnsiColor Blue)
         ]
-
--- * Terrain
-
-dirt :: (TerrainAttr, PreservableColor)
-dirt = (TerrainAttr "dirt", BgOnly $ Triple $ RGB 87 47 47)
-
-grass :: (TerrainAttr, PreservableColor)
-grass = (TerrainAttr "grass", BgOnly $ Triple $ RGB 0 47 0) -- dark green
-
-stone :: (TerrainAttr, PreservableColor)
-stone = (TerrainAttr "stone", BgOnly $ Triple $ RGB 47 47 47)
-
-ice :: (TerrainAttr, PreservableColor)
-ice = (TerrainAttr "ice", BgOnly $ AnsiColor White)
-
-terrainAttributes :: M.Map TerrainAttr PreservableColor
-terrainAttributes =
-  M.fromList
-    [ dirt
-    , grass
-    , stone
-    , ice
-    ]

src/swarm-scenario/Swarm/Game/Failure.hs

@@ -33,7 +33,7 @@ import Witch (into)
 -- Failure descriptions
 
 -- | Enumeration of various assets we can attempt to load.
-data AssetData = AppAsset | NameGeneration | Entities | Recipes | Worlds | Scenarios | Script
+data AssetData = AppAsset | NameGeneration | Entities | Terrain | Recipes | Worlds | Scenarios | Script
   deriving (Eq, Show)
 
 -- | Overarching enumeration of various assets we can attempt to load.

src/swarm-scenario/Swarm/Game/Land.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Terrain and Entities
+module Swarm.Game.Land (
+  TerrainEntityMaps (TerrainEntityMaps),
+  terrainMap,
+  entityMap,
+  loadEntitiesAndTerrain,
+) where
+
+import Control.Algebra (Has)
+import Control.Effect.Lift (Lift)
+import Control.Effect.Throw (Throw)
+import Control.Lens (makeLenses)
+import GHC.Generics (Generic)
+import Swarm.Game.Entity
+import Swarm.Game.Failure (SystemFailure)
+import Swarm.Game.Terrain
+
+data TerrainEntityMaps = TerrainEntityMaps
+  { _terrainMap :: TerrainMap
+  , _entityMap :: EntityMap
+  }
+  deriving (Show, Generic)
+
+makeLenses ''TerrainEntityMaps
+
+instance Semigroup TerrainEntityMaps where
+  TerrainEntityMaps tm1 em1 <> TerrainEntityMaps tm2 em2 =
+    TerrainEntityMaps (tm1 <> tm2) (em1 <> em2)
+
+instance Monoid TerrainEntityMaps where
+  mempty = TerrainEntityMaps mempty mempty
+
+loadEntitiesAndTerrain ::
+  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
+  m TerrainEntityMaps
+loadEntitiesAndTerrain =
+  TerrainEntityMaps <$> loadTerrain <*> loadEntities

src/swarm-scenario/Swarm/Game/Robot.hs

@@ -80,6 +80,7 @@ import GHC.Generics (Generic)
 import Linear
 import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible)
 import Swarm.Game.Entity hiding (empty)
+import Swarm.Game.Land
 import Swarm.Game.Location (Heading, Location, toDirection, toHeading)
 import Swarm.Game.Universe
 import Swarm.Language.Capability (Capability)
@@ -377,7 +378,7 @@ instance FromJSON HeadingSpec where
 
 -- | We can parse a robot from a YAML file if we have access to an
 --   'EntityMap' in which we can look up the names of entities.
-instance FromJSONE EntityMap TRobot where
+instance FromJSONE TerrainEntityMaps TRobot where
   parseJSONE = withObjectE "robot" $ \v -> do
     -- Note we can't generate a unique ID here since we don't have
     -- access to a 'State GameState' effect; a unique ID will be
@@ -392,8 +393,8 @@ instance FromJSONE EntityMap TRobot where
       <*> liftE (fmap getHeading $ v .:? "dir" .!= HeadingSpec zero)
       <*> localE (const defDisplay) (v ..:? "display" ..!= defDisplay)
       <*> liftE (v .:? "program")
-      <*> v ..:? "devices" ..!= []
+      <*> localE (view entityMap) (v ..:? "devices" ..!= [])
-      <*> v ..:? "inventory" ..!= []
+      <*> localE (view entityMap) (v ..:? "inventory" ..!= [])
       <*> pure sys
       <*> liftE (v .:? "heavy" .!= False)
       <*> liftE (v .:? "unwalkable" ..!= mempty)

src/swarm-scenario/Swarm/Game/Scenario.hs

@@ -38,7 +38,7 @@ module Swarm.Game.Scenario (
   scenarioCreative,
   scenarioSeed,
   scenarioAttrs,
-  scenarioEntities,
+  scenarioTerrainAndEntities,
   scenarioCosmetics,
   scenarioRecipes,
   scenarioKnown,
@@ -58,7 +58,6 @@ module Swarm.Game.Scenario (
   GameStateInputs (..),
 
   -- * Utilities
-  integrateScenarioEntities,
   arbitrateSeed,
 ) where
 
@@ -83,6 +82,7 @@ import Swarm.Game.Entity
 import Swarm.Game.Entity.Cosmetic
 import Swarm.Game.Entity.Cosmetic.Assignment (worldAttributes)
 import Swarm.Game.Failure
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.ResourceLoading (getDataFileNameSafe)
@@ -99,6 +99,7 @@ import Swarm.Game.Scenario.Topography.Structure qualified as Structure
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (SymmetryAnnotatedGrid (..))
 import Swarm.Game.Scenario.Topography.WorldDescription
+import Swarm.Game.Terrain
 import Swarm.Game.Universe
 import Swarm.Game.World.Gen (Seed)
 import Swarm.Game.World.Load (loadWorlds)
@@ -197,7 +198,7 @@ scenarioStepsPerTick :: Lens' ScenarioOperation (Maybe Int)
 data ScenarioLandscape = ScenarioLandscape
   { _scenarioSeed :: Maybe Int
   , _scenarioAttrs :: [CustomAttr]
-  , _scenarioEntities :: EntityMap
+  , _scenarioTerrainAndEntities :: TerrainEntityMaps
   , _scenarioCosmetics :: M.Map WorldAttr PreservableColor
   , _scenarioKnown :: Set EntityName
   , _scenarioWorlds :: NonEmpty WorldDescription
@@ -216,8 +217,9 @@ scenarioSeed :: Lens' ScenarioLandscape (Maybe Int)
 -- | Custom attributes defined in the scenario.
 scenarioAttrs :: Lens' ScenarioLandscape [CustomAttr]
 
--- | Any custom entities used for this scenario.
+-- | Any custom terrain and entities used for this scenario,
-scenarioEntities :: Lens' ScenarioLandscape EntityMap
+-- combined with the default system terrain and entities.
+scenarioTerrainAndEntities :: Lens' ScenarioLandscape TerrainEntityMaps
 
 -- | High-fidelity color map for entities
 scenarioCosmetics :: Lens' ScenarioLandscape (M.Map WorldAttr PreservableColor)
@@ -263,8 +265,11 @@ scenarioLandscape :: Lens' Scenario ScenarioLandscape
 
 -- * Parsing
 
-instance FromJSONE (EntityMap, WorldMap) Scenario where
+instance FromJSONE (TerrainEntityMaps, WorldMap) Scenario where
   parseJSONE = withObjectE "scenario" $ \v -> do
+    -- parse custom terrain
+    tmRaw <- liftE (v .:? "terrains" .!= [])
+
     -- parse custom entities
     emRaw <- liftE (v .:? "entities" .!= [])
 
@@ -272,20 +277,29 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
     let mergedCosmetics = worldAttributes <> M.fromList (mapMaybe toHifiPair parsedAttrs)
         attrsUnion = M.keysSet mergedCosmetics
 
-    runValidation $ validateAttrRefs attrsUnion emRaw
+    validatedTerrainObjects <- runValidation $ validateTerrainAttrRefs attrsUnion tmRaw
+
+    let tm = mkTerrainMap validatedTerrainObjects
+
+    runValidation $ validateEntityAttrRefs attrsUnion emRaw
 
     em <- runValidation $ buildEntityMap emRaw
 
+    let scenarioSpecificTerrainEntities = TerrainEntityMaps tm em
+
     -- Save the passed in WorldMap for later
     worldMap <- snd <$> getE
 
-    -- Get rid of WorldMap from context locally, and combine EntityMap
+    -- Get rid of WorldMap from context locally, and combine
-    -- with any custom entities parsed above
+    -- the default system TerrainMap and EntityMap
-    localE fst $ withE em $ do
+    -- with any custom terrain/entities parsed above
+    localE fst $ withE scenarioSpecificTerrainEntities $ do
       -- parse 'known' entity names and make sure they exist
       known <- liftE (v .:? "known" .!= mempty)
-      em' <- getE
+      combinedTEM <- getE
-      case filter (isNothing . (`lookupEntityName` em')) known of
+
+      let TerrainEntityMaps _tm emCombined = combinedTEM
+      case filter (isNothing . (`lookupEntityName` emCombined)) known of
         [] -> return ()
         unk -> failT ["Unknown entities in 'known' list:", T.intercalate ", " unk]
 
@@ -314,7 +328,7 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
 
       let namedGrids = map (\(ns, Structure.MergedStructure s _ _) -> Grid s <$ ns) mergedStructures
 
-      allWorlds <- localE (worldMap,rootLevelSharedStructures,,rsMap) $ do
+      allWorlds <- localE (WorldParseDependencies worldMap rootLevelSharedStructures rsMap) $ do
         rootWorld <- v ..: "world"
         subworlds <- v ..:? "subworlds" ..!= []
         return $ rootWorld :| subworlds
@@ -355,7 +369,7 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
             ScenarioLandscape
               seed
               parsedAttrs
-              em
+              combinedTEM
               mergedCosmetics
               (Set.fromList known)
               allWorlds
@@ -375,7 +389,7 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
           <*> liftE (v .:? "description" .!= "")
           <*> (liftE (v .:? "objectives" .!= []) >>= validateObjectives)
           <*> liftE (v .:? "solution")
-          <*> v ..:? "recipes" ..!= []
+          <*> localE (view entityMap) (v ..:? "recipes" ..!= [])
           <*> liftE (v .:? "stepsPerTick")
 
       return $ Scenario metadata playInfo landscape
@@ -402,24 +416,24 @@ getScenarioPath scenario = do
 loadScenario ::
   (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
   FilePath ->
-  EntityMap ->
+  TerrainEntityMaps ->
   WorldMap ->
   m (Scenario, FilePath)
-loadScenario scenario em worldMap = do
+loadScenario scenario tem worldMap = do
   mfileName <- getScenarioPath scenario
   fileName <- maybe (throwError $ ScenarioNotFound scenario) return mfileName
-  (,fileName) <$> loadScenarioFile em worldMap fileName
+  (,fileName) <$> loadScenarioFile tem worldMap fileName
 
 -- | Load a scenario from a file.
 loadScenarioFile ::
   (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
-  EntityMap ->
+  TerrainEntityMaps ->
   WorldMap ->
   FilePath ->
   m Scenario
-loadScenarioFile em worldMap fileName =
+loadScenarioFile tem worldMap fileName =
   (withThrow adaptError . (liftEither <=< sendIO)) $
-    decodeFileEitherE (em, worldMap) fileName
+    decodeFileEitherE (tem, worldMap) fileName
  where
   adaptError = AssetNotLoaded (Data Scenarios) fileName . CanNotParseYaml
 
@@ -428,22 +442,18 @@ loadStandaloneScenario ::
   FilePath ->
   m (Scenario, GameStateInputs)
 loadStandaloneScenario fp = do
-  entities <- loadEntities
+  tem <- loadEntitiesAndTerrain
-  recipes <- loadRecipes entities
+  recipes <- loadRecipes $ tem ^. entityMap
-  worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds entities
+  worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds tem
-  scene <- fst <$> loadScenario fp entities worlds
+  scene <- fst <$> loadScenario fp tem worlds
-  return (scene, GameStateInputs worlds entities recipes)
+  return (scene, GameStateInputs worlds tem recipes)
 
 data GameStateInputs = GameStateInputs
   { initWorldMap :: WorldMap
-  , initEntities :: EntityMap
+  , initEntityTerrain :: TerrainEntityMaps
   , initRecipes :: [Recipe Entity]
   }
 
-integrateScenarioEntities :: GameStateInputs -> ScenarioLandscape -> EntityMap
-integrateScenarioEntities gsi sLandscape =
-  initEntities gsi <> sLandscape ^. scenarioEntities
-
 -- |
 -- Decide on a seed.  In order of preference, we will use:
 --   1. seed value provided by the user

src/swarm-scenario/Swarm/Game/Scenario/Topography/Cell.hs

@@ -11,17 +11,21 @@ module Swarm.Game.Scenario.Topography.Cell (
 ) where
 
 import Control.Lens hiding (from, (.=), (<.>))
-import Control.Monad.Extra (mapMaybeM)
+import Control.Monad.Extra (mapMaybeM, unless)
 import Data.List.NonEmpty qualified as NE
+import Data.Map.Strict qualified as M
 import Data.Maybe (catMaybes, listToMaybe)
 import Data.Text (Text)
+import Data.Text qualified as T
 import Data.Vector qualified as V
 import Data.Yaml as Y
 import Swarm.Game.Entity hiding (empty)
+import Swarm.Game.Land
 import Swarm.Game.Scenario.RobotLookup
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointConfig)
 import Swarm.Game.Terrain
+import Swarm.Util (quote, showT)
 import Swarm.Util.Erasable (Erasable (..))
 import Swarm.Util.Yaml
 
@@ -67,14 +71,24 @@ instance ToJSON Cell where
     ENothing -> Nothing
     EJust e -> Just (e ^. entityName)
 
-instance FromJSONE (EntityMap, RobotMap) Cell where
+instance FromJSONE (TerrainEntityMaps, RobotMap) Cell where
   parseJSONE = withArrayE "tuple" $ \v -> do
     let tupRaw = V.toList v
     tup <- case NE.nonEmpty tupRaw of
       Nothing -> fail "palette entry must have nonzero length (terrain, optional entity and then robots if any)"
       Just x -> return x
 
+    (TerrainEntityMaps tm _, _) <- getE
     terr <- liftE $ parseJSON (NE.head tup)
+    unless (M.member terr $ terrainByName tm)
+      . fail
+      . T.unpack
+      $ T.unwords
+        [ "Unrecognized terrain type"
+        , quote $ getTerrainWord terr
+        , "Avaliable:"
+        , showT $ M.keys $ terrainByName tm
+        ]
 
     ent <- case tup ^? ix 1 of
       Nothing -> return ENothing
@@ -83,7 +97,7 @@ instance FromJSONE (EntityMap, RobotMap) Cell where
         case meName of
           Nothing -> return ENothing
           Just "erase" -> return EErase
-          Just name -> fmap EJust . localE fst $ getEntity name
+          Just name -> fmap EJust . localE (view entityMap . fst) $ getEntity name
 
     let name2rob r = do
           mrName <- liftE $ parseJSON @(Maybe RobotName) r
@@ -97,7 +111,7 @@ instance FromJSONE (EntityMap, RobotMap) Cell where
 --   entity and robot, if present, are immediately looked up and
 --   converted into 'Entity' and 'TRobot' values.  If they are not
 --   found, a parse error results.
-instance FromJSONE (EntityMap, RobotMap) (AugmentedCell Entity) where
+instance FromJSONE (TerrainEntityMaps, RobotMap) (AugmentedCell Entity) where
   parseJSONE x = case x of
     Object v -> objParse v
     z -> AugmentedCell Nothing <$> parseJSONE z

src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure.hs

@@ -22,7 +22,7 @@ import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Yaml as Y
-import Swarm.Game.Entity
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Scenario.RobotLookup
 import Swarm.Game.Scenario.Topography.Area
@@ -58,7 +58,7 @@ type NamedStructure c = NamedArea (PStructure c)
 
 type InheritedStructureDefs = [NamedStructure (Maybe Cell)]
 
-instance FromJSONE (EntityMap, RobotMap) (NamedArea (PStructure (Maybe Cell))) where
+instance FromJSONE (TerrainEntityMaps, RobotMap) (NamedArea (PStructure (Maybe Cell))) where
   parseJSONE = withObjectE "named structure" $ \v -> do
     NamedArea
       <$> liftE (v .: "name")
@@ -211,14 +211,16 @@ mergeStructures inheritedStrucDefs parentPlacement (Structure origArea subStruct
    where
     renderDir = quote . T.pack . directionJsonModifier . show
 
-instance FromJSONE (EntityMap, RobotMap) (PStructure (Maybe Cell)) where
+instance FromJSONE (TerrainEntityMaps, RobotMap) (PStructure (Maybe Cell)) where
   parseJSONE = withObjectE "structure definition" $ \v -> do
     pal <- v ..:? "palette" ..!= WorldPalette mempty
     localStructureDefs <- v ..:? "structures" ..!= []
-    placementDefs <- liftE $ v .:? "placements" .!= []
+
-    waypointDefs <- liftE $ v .:? "waypoints" .!= []
+    liftE $ do
-    maybeMaskChar <- liftE $ v .:? "mask"
+      placementDefs <- v .:? "placements" .!= []
-    (maskedArea, mapWaypoints) <- liftE $ (v .:? "map" .!= "") >>= paintMap maybeMaskChar pal
+      waypointDefs <- v .:? "waypoints" .!= []
+      maybeMaskChar <- v .:? "mask"
+      (maskedArea, mapWaypoints) <- (v .:? "map" .!= "") >>= paintMap maybeMaskChar pal
       return $ Structure maskedArea localStructureDefs placementDefs $ waypointDefs <> mapWaypoints
 
 -- | \"Paint\" a world map using a 'WorldPalette', turning it from a raw

src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs

@@ -15,6 +15,7 @@ import Data.Maybe (catMaybes)
 import Data.Text qualified as T
 import Data.Yaml as Y
 import Swarm.Game.Entity
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Scenario.RobotLookup
 import Swarm.Game.Scenario.Topography.Cell
@@ -61,10 +62,18 @@ data PWorldDescription e = WorldDescription
 
 type WorldDescription = PWorldDescription Entity
 
-instance FromJSONE (WorldMap, InheritedStructureDefs, EntityMap, RobotMap) WorldDescription where
+data WorldParseDependencies
+  = WorldParseDependencies
+      WorldMap
+      InheritedStructureDefs
+      RobotMap
+      -- | last for the benefit of partial application
+      TerrainEntityMaps
+
+instance FromJSONE WorldParseDependencies WorldDescription where
   parseJSONE = withObjectE "world description" $ \v -> do
-    (worldMap, scenarioLevelStructureDefs, em, rm) <- getE
+    WorldParseDependencies worldMap scenarioLevelStructureDefs rm tem <- getE
-    (pal, rootWorldStructureDefs) <- localE (const (em, rm)) $ do
+    (pal, rootWorldStructureDefs) <- localE (const (tem, rm)) $ do
       pal <- v ..:? "palette" ..!= WorldPalette mempty
       rootWorldStructs <- v ..:? "structures" ..!= []
       return (pal, rootWorldStructs)
@@ -97,7 +106,7 @@ instance FromJSONE (WorldMap, InheritedStructureDefs, EntityMap, RobotMap) World
     mwexp <- liftE (v .:? "dsl")
     dslTerm <- forM mwexp $ \wexp -> do
       let checkResult =
-            run . runThrow @CheckErr . runReader worldMap . runReader em $
+            run . runThrow @CheckErr . runReader worldMap . runReader tem $
               check CNil (TTyWorld TTyCell) wexp
       either (fail . prettyString) return checkResult
     WorldDescription

src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs

@@ -14,6 +14,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Tuple (swap)
 import Swarm.Game.Entity
+import Swarm.Game.Land
 import Swarm.Game.Scenario.RobotLookup
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
@@ -26,7 +27,7 @@ newtype WorldPalette e = WorldPalette
   {unPalette :: KeyMap (AugmentedCell e)}
   deriving (Eq, Show)
 
-instance FromJSONE (EntityMap, RobotMap) (WorldPalette Entity) where
+instance FromJSONE (TerrainEntityMaps, RobotMap) (WorldPalette Entity) where
   parseJSONE = withObjectE "palette" $ fmap WorldPalette . mapM parseJSONE
 
 type TerrainWith a = (TerrainType, Erasable a)

src/swarm-scenario/Swarm/Game/State/Landscape.hs

@@ -12,7 +12,7 @@ module Swarm.Game.State.Landscape (
   worldNavigation,
   multiWorld,
   worldScrollable,
-  entityMap,
+  terrainAndEntities,
 
   -- ** Utilities
   initLandscape,
@@ -34,12 +34,13 @@ import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (isJust, listToMaybe)
 import Swarm.Game.Entity
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Robot (TRobot, trobotLocation)
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
 import Swarm.Game.State.Config
-import Swarm.Game.Terrain (TerrainType (..))
+import Swarm.Game.Terrain (TerrainType (..), terrainIndexByName)
 import Swarm.Game.Universe as U
 import Swarm.Game.World
 import Swarm.Game.World.Eval (runWorld)
@@ -53,7 +54,7 @@ type SubworldDescription = (SubworldName, ([IndexedTRobot], Seed -> WorldFun Int
 data Landscape = Landscape
   { _worldNavigation :: Navigation (M.Map SubworldName) Location
   , _multiWorld :: MultiWorld Int Entity
-  , _entityMap :: EntityMap
+  , _terrainAndEntities :: TerrainEntityMaps
   , _worldScrollable :: Bool
   }
 
@@ -69,8 +70,8 @@ worldNavigation :: Lens' Landscape (Navigation (M.Map SubworldName) Location)
 --   unboxed tile arrays.
 multiWorld :: Lens' Landscape (MultiWorld Int Entity)
 
--- | The catalog of all entities that the game knows about.
+-- | The catalogs of all terrain and entities that the game knows about.
-entityMap :: Lens' Landscape EntityMap
+terrainAndEntities :: Lens' Landscape TerrainEntityMaps
 
 -- | Whether the world map is supposed to be scrollable or not.
 worldScrollable :: Lens' Landscape Bool
@@ -82,16 +83,16 @@ initLandscape gsc =
   Landscape
     { _worldNavigation = Navigation mempty mempty
     , _multiWorld = mempty
-    , _entityMap = initEntities $ initState gsc
+    , _terrainAndEntities = initEntityTerrain $ initState gsc
     , _worldScrollable = True
     }
 
-mkLandscape :: ScenarioLandscape -> EntityMap -> NonEmpty SubworldDescription -> Seed -> Landscape
+mkLandscape :: ScenarioLandscape -> NonEmpty SubworldDescription -> Seed -> Landscape
-mkLandscape sLandscape em worldTuples theSeed =
+mkLandscape sLandscape worldTuples theSeed =
   Landscape
-    { _entityMap = em
+    { _worldNavigation = sLandscape ^. scenarioNavigation
-    , _worldNavigation = sLandscape ^. scenarioNavigation
     , _multiWorld = genMultiWorld worldTuples theSeed
+    , _terrainAndEntities = sLandscape ^. scenarioTerrainAndEntities
     , -- TODO (#1370): Should we allow subworlds to have their own scrollability?
       -- Leaning toward no, but for now just adopt the root world scrollability
       -- as being universal.
@@ -100,7 +101,7 @@ mkLandscape sLandscape em worldTuples theSeed =
 
 buildWorldTuples :: ScenarioLandscape -> NonEmpty SubworldDescription
 buildWorldTuples sLandscape =
-  NE.map (worldName &&& buildWorld) $
+  NE.map (worldName &&& buildWorld (sLandscape ^. scenarioTerrainAndEntities)) $
     sLandscape ^. scenarioWorlds
 
 genMultiWorld :: NonEmpty SubworldDescription -> Seed -> MultiWorld Int Entity
@@ -114,9 +115,11 @@ genMultiWorld worldTuples s =
 
 -- | Take a world description, parsed from a scenario file, and turn
 --   it into a list of located robots and a world function.
-buildWorld :: WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity)
+buildWorld :: TerrainEntityMaps -> WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity)
-buildWorld WorldDescription {..} = (robots worldName, first fromEnum . wf)
+buildWorld tem WorldDescription {..} =
+  (robots worldName, first getTerrainIndex . wf)
  where
+  getTerrainIndex t = M.findWithDefault 0 t $ terrainIndexByName $ tem ^. terrainMap
   rs = fromIntegral $ length area
   cs = fromIntegral $ maybe 0 length $ listToMaybe area
   Coords (ulr, ulc) = locToCoords ul

src/swarm-scenario/Swarm/Game/Terrain.hs

@@ -5,36 +5,60 @@
 --
 -- Terrain types and properties.
 module Swarm.Game.Terrain (
-  -- * Terrain
   TerrainType (..),
-  readTerrain,
+  TerrainObj (..),
-  terrainMap,
+  TerrainMap (..),
+  blankTerrainIndex,
   getTerrainDefaultPaletteChar,
   getTerrainWord,
+  terrainFromText,
+  loadTerrain,
+  mkTerrainMap,
+  validateTerrainAttrRefs,
 ) where
 
-import Data.Aeson (FromJSON (..), withText)
+import Control.Algebra (Has)
-import Data.List.NonEmpty qualified as NE
+import Control.Arrow (first, (&&&))
+import Control.Effect.Lift (Lift, sendIO)
+import Control.Effect.Throw (Throw, liftEither, throwError)
+import Control.Monad (forM, unless, (<=<))
+import Data.Char (toUpper)
+import Data.IntMap (IntMap)
+import Data.IntMap qualified as IM
 import Data.Map (Map)
 import Data.Map qualified as M
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Text (Text)
 import Data.Text qualified as T
+import Data.Tuple (swap)
+import Data.Yaml
+import GHC.Generics (Generic)
 import Swarm.Game.Display
-import Swarm.Util (failT, showEnum)
+import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
-import Text.Read (readMaybe)
+import Swarm.Game.Failure
-import Witch (into)
+import Swarm.Game.ResourceLoading (getDataFileNameSafe)
+import Swarm.Util (enumeratedMap, quote)
+import Swarm.Util.Effect (withThrow)
 
--- | The different possible types of terrain. Unlike entities and
+data TerrainType = BlankT | TerrainType Text
---   robots, these are hard-coded into the game.
+  deriving (Eq, Ord, Show, Generic, ToJSON)
-data TerrainType
-  = StoneT
-  | DirtT
-  | GrassT
-  | IceT
-  | BlankT
-  deriving (Eq, Ord, Show, Read, Bounded, Enum)
 
-readTerrain :: T.Text -> Maybe TerrainType
+blankTerrainIndex :: Int
-readTerrain t = readMaybe (into @String (T.toTitle t) ++ "T")
+blankTerrainIndex = 0
+
+terrainFromText :: Text -> TerrainType
+terrainFromText "blank" = BlankT
+terrainFromText x = TerrainType x
+
+getTerrainWord :: TerrainType -> Text
+getTerrainWord BlankT = "blank"
+getTerrainWord (TerrainType x) = x
+
+instance FromJSON TerrainType where
+  parseJSON =
+    withText "TerrainType" $
+      return . terrainFromText
 
 instance Semigroup TerrainType where
   t <> BlankT = t
@@ -43,25 +67,98 @@ instance Semigroup TerrainType where
 instance Monoid TerrainType where
   mempty = BlankT
 
-instance FromJSON TerrainType where
-  parseJSON = withText "text" $ \t ->
-    case readTerrain t of
-      Just ter -> return ter
-      Nothing -> failT ["Unknown terrain type:", t]
-
 getTerrainDefaultPaletteChar :: TerrainType -> Char
-getTerrainDefaultPaletteChar = NE.head . showEnum
+getTerrainDefaultPaletteChar = toUpper . T.head . getTerrainWord
 
-getTerrainWord :: TerrainType -> T.Text
+-- | Representation for parsing only. Not exported.
-getTerrainWord = T.toLower . T.pack . init . show
+data TerrainItem = TerrainItem
+  { name :: TerrainType
+  , attr :: Text
+  , description :: Text
+  }
+  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
 
--- | A map containing a 'Display' record for each different 'TerrainType'.
+data TerrainObj = TerrainObj
-terrainMap :: Map TerrainType Display
+  { terrainName :: TerrainType
-terrainMap =
+  , terrainDesc :: Text
-  M.fromList
+  , terrainDisplay :: Display
-    [ (StoneT, defaultTerrainDisplay (ATerrain "stone"))
+  }
-    , (DirtT, defaultTerrainDisplay (ATerrain "dirt"))
+  deriving (Show)
-    , (GrassT, defaultTerrainDisplay (ATerrain "grass"))
+
-    , (IceT, defaultTerrainDisplay (ATerrain "ice"))
+promoteTerrainObjects :: [TerrainItem] -> [TerrainObj]
-    , (BlankT, defaultTerrainDisplay ADefault)
+promoteTerrainObjects =
+  map (\(TerrainItem n a d) -> TerrainObj n d $ defaultTerrainDisplay (AWorld a))
+
+invertedIndexMap :: IntMap TerrainObj -> Map TerrainType Int
+invertedIndexMap = M.fromList . map (first terrainName . swap) . IM.toList
+
+-- | Each terrain type shall have a unique
+-- integral index. The indices should
+-- be consecutive by parse order.
+data TerrainMap = TerrainMap
+  { terrainByName :: Map TerrainType TerrainObj
+  , terrainByIndex :: IntMap TerrainObj
+  , terrainIndexByName :: Map TerrainType Int
+  -- ^ basically the inverse of 'terrainByIndex'.
+  -- This needs to be (is) recomputed upon every update to
+  -- the other fields in 'TerrainMap'.
+  }
+  deriving (Show)
+
+instance Semigroup TerrainMap where
+  TerrainMap oldByName oldByIndex _ <> TerrainMap newByName newByIndex _ =
+    TerrainMap
+      (oldByName <> newByName)
+      combinedTerrainByIndex
+      (invertedIndexMap combinedTerrainByIndex)
+   where
+    combinedTerrainByIndex = oldByIndex <> enumeratedMap (IM.size oldByIndex) (IM.elems newByIndex)
+
+instance Monoid TerrainMap where
+  mempty = TerrainMap mempty mempty mempty
+
+mkTerrainMap :: [TerrainObj] -> TerrainMap
+mkTerrainMap items =
+  TerrainMap
+    { terrainByName = M.fromList $ map (terrainName &&& id) items
+    , terrainByIndex = byIndex
+    , terrainIndexByName = invertedIndexMap byIndex
+    }
+ where
+  byIndex = enumeratedMap blankTerrainIndex items
+
+-- | Validates references to 'Display' attributes
+validateTerrainAttrRefs :: Has (Throw LoadingFailure) sig m => Set WorldAttr -> [TerrainItem] -> m [TerrainObj]
+validateTerrainAttrRefs validAttrs rawTerrains =
+  forM rawTerrains $ \(TerrainItem n a d) -> do
+    unless (Set.member (WorldAttr $ T.unpack a) validAttrs)
+      . throwError
+      . CustomMessage
+      $ T.unwords
+        [ "Nonexistent attribute"
+        , quote a
+        , "referenced by terrain"
+        , quote $ getTerrainWord n
         ]
+
+    return $ TerrainObj n d $ defaultTerrainDisplay (AWorld a)
+
+-- | Load terrain from a data file called @terrains.yaml@, producing
+--   either an 'TerrainMap' or a parse error.
+loadTerrain ::
+  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
+  m TerrainMap
+loadTerrain = do
+  fileName <- getDataFileNameSafe Terrain terrainFile
+  decoded <-
+    withThrow (terrainFailure . CanNotParseYaml) . (liftEither <=< sendIO) $
+      decodeFileEither fileName
+
+  let terrainObjs = promoteTerrainObjects decoded
+  -- Ensures that the blank terrain gets index 0
+  return $ mkTerrainMap $ blankTerrainObj : terrainObjs
+ where
+  terrainFile = "terrains.yaml"
+  terrainFailure = AssetNotLoaded (Data Terrain) terrainFile
+
+  blankTerrainObj = TerrainObj BlankT "Blank terrain" $ defaultTerrainDisplay ADefault

src/swarm-scenario/Swarm/Game/World.hs

@@ -61,14 +61,16 @@ import Data.Bifunctor (second)
 import Data.Bits
 import Data.Foldable (foldl')
 import Data.Int (Int32)
+import Data.IntMap qualified as IM
 import Data.Map (Map)
 import Data.Map.Strict qualified as M
+import Data.Maybe (fromMaybe)
 import Data.Semigroup (Last (..))
 import Data.Yaml (FromJSON, ToJSON)
 import GHC.Generics (Generic)
 import Swarm.Game.Entity (Entity)
 import Swarm.Game.Location
-import Swarm.Game.Terrain (TerrainType (BlankT))
+import Swarm.Game.Terrain (TerrainMap, TerrainType (BlankT), terrainByIndex, terrainName)
 import Swarm.Game.Universe
 import Swarm.Game.World.Coords
 import Swarm.Game.World.Modify
@@ -199,12 +201,15 @@ newWorld :: WorldFun t e -> World t e
 newWorld f = World f M.empty M.empty
 
 lookupCosmicTerrain ::
-  IArray U.UArray Int =>
+  TerrainMap ->
   Cosmic Coords ->
   MultiWorld Int e ->
   TerrainType
-lookupCosmicTerrain (Cosmic subworldName i) multiWorld =
+lookupCosmicTerrain tm (Cosmic subworldName i) multiWorld =
-  maybe BlankT (toEnum . lookupTerrain i) $ M.lookup subworldName multiWorld
+  fromMaybe BlankT $ do
+    x <- M.lookup subworldName multiWorld
+    y <- (`IM.lookup` terrainByIndex tm) . lookupTerrain i $ x
+    return $ terrainName y
 
 -- | Look up the terrain value at certain coordinates: try looking it
 --   up in the tile cache first, and fall back to running the 'WorldFun'

src/swarm-scenario/Swarm/Game/World/Load.hs

@@ -16,8 +16,8 @@ import Data.Map qualified as M
 import Data.Maybe (catMaybes)
 import Data.Sequence (Seq)
 import Data.Text (Text)
-import Swarm.Game.Entity (EntityMap)
 import Swarm.Game.Failure (Asset (..), AssetData (..), LoadingFailure (..), SystemFailure (..))
+import Swarm.Game.Land
 import Swarm.Game.ResourceLoading (getDataDirSafe)
 import Swarm.Game.World.Parse (parseWExp, runParser)
 import Swarm.Game.World.Typecheck
@@ -31,15 +31,15 @@ import Witch (into)
 --   Emit a warning for each one which fails to parse or typecheck.
 loadWorlds ::
   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
-  EntityMap ->
+  TerrainEntityMaps ->
   m WorldMap
-loadWorlds em = do
+loadWorlds tem = do
   res <- throwToWarning @SystemFailure $ getDataDirSafe Worlds "worlds"
   case res of
     Nothing -> return M.empty
     Just dir -> do
       worldFiles <- sendIO $ acquireAllWithExt dir "world"
-      ws <- mapM (throwToWarning @SystemFailure . loadWorld dir em) worldFiles
+      ws <- mapM (throwToWarning @SystemFailure . loadWorld dir tem) worldFiles
       return . M.fromList . catMaybes $ ws
 
 -- | Load a file containing a world DSL term, throwing an exception if
@@ -47,16 +47,16 @@ loadWorlds em = do
 loadWorld ::
   (Has (Throw SystemFailure) sig m) =>
   FilePath ->
-  EntityMap ->
+  TerrainEntityMaps ->
   (FilePath, String) ->
   m (Text, Some (TTerm '[]))
-loadWorld dir em (fp, src) = do
+loadWorld dir tem (fp, src) = do
   wexp <-
     liftEither . left (AssetNotLoaded (Data Worlds) fp . CanNotParseMegaparsec) $
       runParser parseWExp (into @Text src)
   t <-
     withThrow (AssetNotLoaded (Data Worlds) fp . DoesNotTypecheck . prettyText @CheckErr) $
-      runReader em . runReader @WorldMap M.empty $
+      runReader tem . runReader @WorldMap M.empty $
         infer CNil wexp
   return (into @Text (dropExtension (stripDir dir fp)), t)
 

src/swarm-scenario/Swarm/Game/World/Render.hs

@@ -20,6 +20,7 @@ import Linear (V2 (..))
 import Swarm.Game.Display (defaultChar)
 import Swarm.Game.Entity.Cosmetic
 import Swarm.Game.Failure (SystemFailure)
+import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Topography.Area
@@ -128,7 +129,7 @@ getDisplayGrid ::
 getDisplayGrid vc sLandscape ls maybeSize =
   getMapRectangle
     mkFacade
-    (getContentAt worlds . mkCosmic)
+    (getContentAt (sLandscape ^. scenarioTerrainAndEntities . terrainMap) worlds . mkCosmic)
     (getBoundingBox vc firstScenarioWorld maybeSize)
  where
   mkCosmic = Cosmic $ worldName firstScenarioWorld
@@ -142,13 +143,12 @@ getRenderableGrid ::
   FilePath ->
   m (Grid (PCell EntityFacade), M.Map WorldAttr PreservableColor)
 getRenderableGrid (RenderOpts maybeSeed _ _ maybeSize _) fp = do
-  (myScenario, gsi) <- loadStandaloneScenario fp
+  (myScenario, _gsi) <- loadStandaloneScenario fp
   let sLandscape = myScenario ^. scenarioLandscape
   theSeed <- sendIO $ arbitrateSeed maybeSeed sLandscape
 
-  let em = integrateScenarioEntities gsi sLandscape
+  let worldTuples = buildWorldTuples sLandscape
-      worldTuples = buildWorldTuples sLandscape
+      myLandscape = mkLandscape sLandscape worldTuples theSeed
-      myLandscape = mkLandscape sLandscape em worldTuples theSeed
 
       vc =
         view planar $

src/swarm-scenario/Swarm/Game/World/Typecheck.hs

@@ -34,8 +34,9 @@ import Data.Semigroup (Last (..))
 import Data.Text (Text)
 import Data.Type.Equality (TestEquality (..), type (:~:) (Refl))
 import Prettyprinter
-import Swarm.Game.Entity (EntityMap, lookupEntityName)
+import Swarm.Game.Entity (lookupEntityName)
-import Swarm.Game.Terrain (readTerrain)
+import Swarm.Game.Land
+import Swarm.Game.Terrain
 import Swarm.Game.World.Syntax
 import Swarm.Language.Pretty
 import Swarm.Util (showT)
@@ -448,7 +449,7 @@ lookup x (CCons y ty ctx)
 --   value (/i.e./ @const 3@).
 check ::
   ( Has (Throw CheckErr) sig m
-  , Has (Reader EntityMap) sig m
+  , Has (Reader TerrainEntityMaps) sig m
   , Has (Reader WorldMap) sig m
   ) =>
   Ctx g ->
@@ -562,7 +563,7 @@ typeArgsFor _ _ = []
 --   a typed, elaborated version of the application.
 applyOp ::
   ( Has (Throw CheckErr) sig m
-  , Has (Reader EntityMap) sig m
+  , Has (Reader TerrainEntityMaps) sig m
   , Has (Reader WorldMap) sig m
   ) =>
   Ctx g ->
@@ -577,7 +578,7 @@ applyOp ctx op ts = do
 infer ::
   forall sig m g.
   ( Has (Throw CheckErr) sig m
-  , Has (Reader EntityMap) sig m
+  , Has (Reader TerrainEntityMaps) sig m
   , Has (Reader WorldMap) sig m
   ) =>
   Ctx g ->
@@ -606,7 +607,9 @@ infer _ctx (WImport key) = do
 --   terrain, entities, and robots---into a real 'CellVal' with
 --   references to actual terrain, entities, and robots.
 resolveCell ::
-  (Has (Throw CheckErr) sig m, Has (Reader EntityMap) sig m) =>
+  ( Has (Throw CheckErr) sig m
+  , Has (Reader TerrainEntityMaps) sig m
+  ) =>
   RawCellVal ->
   m CellVal
 resolveCell items = do
@@ -617,7 +620,9 @@ resolveCell items = do
 -- entity, robot, etc.).
 resolveCellItem ::
   forall sig m.
-  (Has (Throw CheckErr) sig m, Has (Reader EntityMap) sig m) =>
+  ( Has (Throw CheckErr) sig m
+  , Has (Reader TerrainEntityMaps) sig m
+  ) =>
   (Maybe CellTag, Text) ->
   m CellVal
 resolveCellItem (mCellTag, item) = case mCellTag of
@@ -635,14 +640,17 @@ resolveCellItem (mCellTag, item) = case mCellTag of
  where
   mkTerrain t = CellVal t mempty mempty
   mkEntity e = CellVal mempty (EJust (Last e)) mempty
+
   resolverByTag :: CellTag -> Text -> m (Maybe CellVal)
   resolverByTag = \case
-    CellTerrain -> return . fmap mkTerrain . readTerrain
+    CellTerrain -> \tName -> do
+      TerrainEntityMaps tm _em <- ask @TerrainEntityMaps
+      return . fmap (mkTerrain . terrainName) . (`M.lookup` terrainByName tm) $ terrainFromText tName
     CellEntity -> \eName ->
       case eName of
         "erase" -> return $ Just (CellVal mempty EErase mempty)
         _ -> do
-          em <- ask @EntityMap
+          TerrainEntityMaps _tm em <- ask @TerrainEntityMaps
           return . fmap mkEntity $ lookupEntityName eName em
     CellRobot -> \_ -> return Nothing -- TODO (#1396): support robots
 
@@ -650,7 +658,7 @@ resolveCellItem (mCellTag, item) = case mCellTag of
 --   of lambda applications.
 inferLet ::
   ( Has (Throw CheckErr) sig m
-  , Has (Reader EntityMap) sig m
+  , Has (Reader TerrainEntityMaps) sig m
   , Has (Reader WorldMap) sig m
   ) =>
   Ctx g ->
@@ -667,7 +675,7 @@ inferLet ctx ((x, e) : xs) body = do
 --   chain of @<>@ (over) operations.
 inferOverlay ::
   ( Has (Throw CheckErr) sig m
-  , Has (Reader EntityMap) sig m
+  , Has (Reader TerrainEntityMaps) sig m
   , Has (Reader WorldMap) sig m
   ) =>
   Ctx g ->

src/swarm-scenario/Swarm/Util/Content.hs

@@ -11,21 +11,20 @@ import Data.Map qualified as M
 import Data.Text qualified as T
 import Swarm.Game.Display
 import Swarm.Game.Entity.Cosmetic
-import Swarm.Game.Entity.Cosmetic.Assignment (terrainAttributes)
 import Swarm.Game.Scenario.Topography.Area qualified as EA
 import Swarm.Game.Scenario.Topography.Cell (PCell (..))
 import Swarm.Game.Scenario.Topography.EntityFacade
-import Swarm.Game.Terrain (TerrainType, getTerrainWord)
+import Swarm.Game.Terrain (TerrainMap, TerrainType, getTerrainWord)
 import Swarm.Game.Universe
 import Swarm.Game.World
 import Swarm.Util.Erasable (erasableToMaybe, maybeToErasable)
 
 -- | Get the terrain and entity at a single cell
-getContentAt :: MultiWorld Int e -> Cosmic Coords -> (TerrainType, Maybe e)
+getContentAt :: TerrainMap -> MultiWorld Int e -> Cosmic Coords -> (TerrainType, Maybe e)
-getContentAt w coords = (underlyingCellTerrain, underlyingCellEntity)
+getContentAt tm w coords = (underlyingCellTerrain, underlyingCellEntity)
  where
   underlyingCellEntity = lookupCosmicEntity coords w
-  underlyingCellTerrain = lookupCosmicTerrain coords w
+  underlyingCellTerrain = lookupCosmicTerrain tm coords w
 
 -- * Rendering
 
@@ -60,7 +59,7 @@ getTerrainEntityColor ::
 getTerrainEntityColor aMap (Cell terr cellEnt _) =
   (entityColor =<< erasableToMaybe cellEnt) <|> terrainFallback
  where
-  terrainFallback = M.lookup (TerrainAttr $ T.unpack $ getTerrainWord terr) terrainAttributes
+  terrainFallback = M.lookup (WorldAttr $ T.unpack $ getTerrainWord terr) aMap
   entityColor (EntityFacade _ d) = case d ^. displayAttr of
     AWorld n -> M.lookup (WorldAttr $ T.unpack n) aMap
     _ -> Nothing

src/swarm-util/Swarm/Util.hs

@@ -13,6 +13,7 @@ module Swarm.Util (
   sortPair,
   maxOn,
   maximum0,
+  enumeratedMap,
   cycleEnum,
   listEnums,
   listEnumsNonempty,
@@ -90,6 +91,8 @@ import Data.Bifunctor (Bifunctor (bimap), first)
 import Data.Char (isAlphaNum, toLower)
 import Data.Either.Validation
 import Data.Foldable qualified as Foldable
+import Data.IntMap.Strict (IntMap)
+import Data.IntMap.Strict qualified as IM
 import Data.List (foldl', maximumBy, partition)
 import Data.List qualified as List
 import Data.List.NonEmpty (NonEmpty ((:|)))
@@ -142,6 +145,9 @@ maximum0 :: (Num a, Ord a) => [a] -> a
 maximum0 [] = 0
 maximum0 xs = maximum xs
 
+enumeratedMap :: Int -> [a] -> IntMap a
+enumeratedMap startIdx = IM.fromList . zip [startIdx ..]
+
 -- | Take the successor of an 'Enum' type, wrapping around when it
 --   reaches the end.
 cycleEnum :: (Eq e, Enum e, Bounded e) => e -> e

swarm.cabal

@@ -188,6 +188,7 @@ library swarm-scenario
     Swarm.Game.Entity.Cosmetic
     Swarm.Game.Entity.Cosmetic.Assignment
     Swarm.Game.Failure
+    Swarm.Game.Land
     Swarm.Game.Location
     Swarm.Game.Recipe
     Swarm.Game.ResourceLoading
@@ -536,6 +537,7 @@ library
     Swarm.Game.Entity.Cosmetic.Assignment,
     Swarm.Game.Exception,
     Swarm.Game.Failure,
+    Swarm.Game.Land,
     Swarm.Game.Location,
     Swarm.Game.Recipe,
     Swarm.Game.ResourceLoading,

test/bench/Benchmark.hs

@@ -25,7 +25,7 @@ import Swarm.Game.State.Landscape (multiWorld)
 import Swarm.Game.State.Robot (addTRobot)
 import Swarm.Game.State.Runtime (initRuntimeState, mkGameStateConfig)
 import Swarm.Game.Step (gameTick)
-import Swarm.Game.Terrain (TerrainType (DirtT))
+import Swarm.Game.Terrain (blankTerrainIndex)
 import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld))
 import Swarm.Game.World (WorldFun (..), newWorld)
 import Swarm.Language.Context qualified as Context
@@ -151,7 +151,7 @@ mkGameState prog robotMaker numRobots = do
     (zoomRobots $ mapM_ (addTRobot $ initMachine prog Context.empty emptyStore) robots)
     ( gs
         & creativeMode .~ True
-        & landscape . multiWorld .~ M.singleton DefaultRootSubworld (newWorld (WF $ const (fromEnum DirtT, ENothing)))
+        & landscape . multiWorld .~ M.singleton DefaultRootSubworld (newWorld (WF $ const (blankTerrainIndex, ENothing)))
     )
 
 -- | Runs numGameTicks ticks of the game.

test/integration/Main.hs

@@ -31,8 +31,9 @@ import Swarm.Doc.Keyword qualified as Keyword
 import Swarm.Effect (runTimeIO)
 import Swarm.Game.Achievement.Definitions (GameplayAchievement (..))
 import Swarm.Game.CESK (emptyStore, initMachine)
-import Swarm.Game.Entity (EntityMap, lookupByName)
+import Swarm.Game.Entity (lookupByName)
 import Swarm.Game.Failure (SystemFailure)
+import Swarm.Game.Land
 import Swarm.Game.Robot (equippedDevices, systemRobot)
 import Swarm.Game.Robot.Activity (commandsHistogram, lifetimeStepCount, tangibleCommandCount)
 import Swarm.Game.Robot.Concrete (activityCounts, machine, robotContext, robotLog, waitingUntil)
@@ -57,7 +58,7 @@ import Swarm.Game.State.Robot (
 import Swarm.Game.State.Runtime (
   RuntimeState,
   eventLog,
-  stdEntityMap,
+  stdEntityTerrainMap,
   worlds,
  )
 import Swarm.Game.State.Substate (
@@ -106,16 +107,16 @@ main = do
   (rs, ui) <- do
     out <- runM . runThrow @SystemFailure $ initPersistentState defaultAppOpts
     either (assertFailure . prettyString) return out
-  let em = rs ^. stdEntityMap
+  let tem = rs ^. stdEntityTerrainMap
-  let rs' = rs & eventLog .~ mempty
+      rs' = rs & eventLog .~ mempty
   defaultMain $
     testGroup
       "Tests"
       [ testNoLoadingErrors rs
       , exampleTests examplePaths
       , exampleTests scenarioPrograms
-      , scenarioParseTests em (rs ^. worlds) parseableScenarios
+      , scenarioParseTests tem (rs ^. worlds) parseableScenarios
-      , scenarioParseInvalidTests em (rs ^. worlds) unparseableScenarios
+      , scenarioParseInvalidTests tem (rs ^. worlds) unparseableScenarios
       , testScenarioSolutions rs' ui
       , testEditorFiles
       ]
@@ -144,27 +145,27 @@ exampleTest (path, fileContent) =
  where
   value = processTerm $ into @Text fileContent
 
-scenarioParseTests :: EntityMap -> WorldMap -> [(FilePath, String)] -> TestTree
+scenarioParseTests :: TerrainEntityMaps -> WorldMap -> [(FilePath, String)] -> TestTree
-scenarioParseTests em worldMap inputs =
+scenarioParseTests tem worldMap inputs =
   testGroup
     "Test scenarios parse"
-    (map (scenarioTest Parsed em worldMap) inputs)
+    (map (scenarioTest Parsed tem worldMap) inputs)
 
-scenarioParseInvalidTests :: EntityMap -> WorldMap -> [(FilePath, String)] -> TestTree
+scenarioParseInvalidTests :: TerrainEntityMaps -> WorldMap -> [(FilePath, String)] -> TestTree
-scenarioParseInvalidTests em worldMap inputs =
+scenarioParseInvalidTests tem worldMap inputs =
   testGroup
     "Test invalid scenarios fail to parse"
-    (map (scenarioTest Failed em worldMap) inputs)
+    (map (scenarioTest Failed tem worldMap) inputs)
 
 data ParseResult = Parsed | Failed
 
-scenarioTest :: ParseResult -> EntityMap -> WorldMap -> (FilePath, String) -> TestTree
+scenarioTest :: ParseResult -> TerrainEntityMaps -> WorldMap -> (FilePath, String) -> TestTree
-scenarioTest expRes em worldMap (path, _) =
+scenarioTest expRes tem worldMap (path, _) =
-  testCase ("parse scenario " ++ show path) (getScenario expRes em worldMap path)
+  testCase ("parse scenario " ++ show path) (getScenario expRes tem worldMap path)
 
-getScenario :: ParseResult -> EntityMap -> WorldMap -> FilePath -> IO ()
+getScenario :: ParseResult -> TerrainEntityMaps -> WorldMap -> FilePath -> IO ()
-getScenario expRes em worldMap p = do
+getScenario expRes tem worldMap p = do
-  res <- decodeFileEitherE (em, worldMap) p :: IO (Either ParseException Scenario)
+  res <- decodeFileEitherE (tem, worldMap) p :: IO (Either ParseException Scenario)
   case expRes of
     Parsed -> case res of
       Left err -> assertFailure (prettyPrintParseException err)
@@ -366,6 +367,7 @@ testScenarioSolutions rs ui =
         , testSolution Default "Testing/1536-custom-unwalkable-entities"
         , testSolution Default "Testing/1631-tags"
         , testSolution Default "Testing/1747-volume-command"
+        , testSolution Default "Testing/1775-custom-terrain"
         , testGroup
             -- Note that the description of the classic world in
             -- data/worlds/classic.yaml (automatically tested to some

test/unit/TestRecipeCoverage.hs

@@ -12,8 +12,9 @@ import Data.Map qualified as M
 import Data.Set qualified as Set
 import Data.Text qualified as T
 import Swarm.Game.Entity (EntityMap (entitiesByCap), entityName)
+import Swarm.Game.Land
 import Swarm.Game.Recipe (recipeOutputs)
-import Swarm.Game.State.Runtime (RuntimeState, stdEntityMap, stdRecipes)
+import Swarm.Game.State.Runtime (RuntimeState, stdEntityTerrainMap, stdRecipes)
 import Swarm.Util (commaList, quote)
 import Test.Tasty
 import Test.Tasty.ExpectedFailure (expectFailBecause)
@@ -41,7 +42,9 @@ testDeviceRecipeCoverage rs =
           ]
 
     -- Only include entities that grant a capability:
-    entityNames = Set.fromList . map (^. entityName) . concat . M.elems . entitiesByCap $ rs ^. stdEntityMap
+    entityNames =
+      Set.fromList . map (^. entityName) . concat . M.elems . entitiesByCap $
+        rs ^. stdEntityTerrainMap . entityMap
 
     getOutputsForRecipe r = map ((^. entityName) . snd) $ r ^. recipeOutputs
     recipeOutputEntities = Set.fromList . concatMap getOutputsForRecipe $ rs ^. stdRecipes

test/unit/TestUtil.hs

@@ -16,6 +16,7 @@ import Data.Text qualified as T
 import Swarm.Effect
 import Swarm.Game.CESK
 import Swarm.Game.Exception
+import Swarm.Game.Land
 import Swarm.Game.Robot
 import Swarm.Game.Robot.Concrete (isActive)
 import Swarm.Game.State
@@ -48,7 +49,7 @@ evalCESK g cesk =
   orderResult ((res, rr), rg) = (rg, rr, res)
 
 runCESK :: Int -> CESK -> StateT Robot (StateT GameState IO) (Either Text (Value, Int))
-runCESK _ (Up exn _ []) = Left . flip formatExn exn <$> lift (use $ landscape . entityMap)
+runCESK _ (Up exn _ []) = Left . flip formatExn exn <$> lift (use $ landscape . terrainAndEntities . entityMap)
 runCESK !steps cesk = case finalValue cesk of
   Just (v, _) -> return (Right (v, steps))
   Nothing -> runTimeIO (stepCESK cesk) >>= runCESK (steps + 1)