Make structures parseable independently of entity definitions

data/test/standalone-topography/demo-structures.yaml

@@ -0,0 +1,66 @@
+structures:
+  - name: cross
+    structure:
+      structures:
+        - name: beam
+          structure:
+            palette:
+              't': true
+              'f': false
+            map: |
+              ttt
+              ttt
+              ttt
+              ttt
+              ttt
+              ttt
+              fff
+              fff
+              fff
+      placements:
+        - src: beam
+          offset: [0, 3]
+          truncate: false
+        - src: beam
+          offset: [-3, -3]
+          truncate: false
+          orient:
+            up: east
+      map: ""
+  - name: disc
+    structure:
+      mask: '.'
+      palette:
+        't': true
+      map: |
+        ..tttt..
+        .tttttt.
+        ttt..ttt
+        tt....tt
+        tt....tt
+        ttt..ttt
+        .tttttt.
+        ..tttt..
+placements:
+  - src: cross
+    offset: [0, -15]
+    truncate: false
+  - src: cross
+    offset: [0, 0]
+    truncate: false
+    orient:
+      up: east
+  - src: cross
+    offset: [15, 0]
+    truncate: false
+    orient:
+      up: south
+  - src: cross
+    offset: [15, -15]
+    truncate: false
+    orient:
+      up: west
+  - src: disc
+    offset: [8, -8]
+    truncate: false
+map: ""

scripts/normalize/all.sh

@@ -0,0 +1,11 @@
+#!/bin/bash -xe
+
+# Run this locally before pushing a branch to save some CI cycles
+
+SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
+cd $SCRIPT_DIR/../..
+
+scripts/normalize/cabal.sh
+scripts/normalize/code-format.sh
+scripts/normalize/yaml.sh
+hlint .

scripts/validate/json-schemas.sh

@@ -5,6 +5,7 @@ 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
+for STEM in terrains entities recipes
+do
+  check-jsonschema --base-uri $(git rev-parse --show-toplevel)/data/schema/$STEM.json --schemafile data/schema/$STEM.json data/$STEM.yaml
+done

src/swarm-engine/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs

@@ -27,11 +27,11 @@ import Linear (V2 (..))
 import Swarm.Game.Entity
 import Swarm.Game.Location
 import Swarm.Game.Scenario (Cell)
+import Swarm.Game.Scenario.Topography.Structure qualified as Structure
 import Swarm.Game.Scenario.Topography.Structure.Recognition
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
-import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
 import Swarm.Game.State
 import Swarm.Game.State.Substate
 import Swarm.Game.Universe

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

@@ -117,11 +117,11 @@ import Swarm.Game.Robot.Concrete
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Status
+import Swarm.Game.Scenario.Topography.Structure qualified as Structure
 import Swarm.Game.Scenario.Topography.Structure.Recognition
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
-import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
 import Swarm.Game.State.Landscape
 import Swarm.Game.State.Robot
 import Swarm.Game.State.Substate

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

@@ -102,7 +102,6 @@ import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
 import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (SymmetryAnnotatedGrid (..))
-import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
 import Swarm.Game.Scenario.Topography.WorldDescription
 import Swarm.Game.Terrain
 import Swarm.Game.Universe
@@ -320,7 +319,7 @@ instance FromJSONE ScenarioInputs Scenario where
       let rsMap = buildRobotMap rs
 
       -- NOTE: These have not been merged with their children yet.
-      rootLevelSharedStructures :: Structure.InheritedStructureDefs <-
+      rootLevelSharedStructures :: InheritedStructureDefs <-
         localE (,rsMap) $
           v ..:? "structures" ..!= []
 

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

@@ -6,7 +6,7 @@
 module Swarm.Game.Scenario.Topography.Cell (
   PCell (..),
   Cell,
-  AugmentedCell (..),
+  AugmentedCell,
   CellPaintDisplay,
 ) where
 
@@ -23,7 +23,7 @@ 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.Scenario.Topography.ProtoCell
 import Swarm.Game.Terrain
 import Swarm.Util (quote, showT)
 import Swarm.Util.Erasable (Erasable (..))
@@ -49,11 +49,7 @@ data PCell e = Cell
 type Cell = PCell Entity
 
 -- | Supplements a cell with waypoint information
-data AugmentedCell e = AugmentedCell
-  { waypointCfg :: Maybe WaypointConfig
-  , standardCell :: PCell e
-  }
-  deriving (Eq, Show)
+type AugmentedCell e = SignpostableCell (PCell e)
 
 -- | Re-usable serialization for variants of 'PCell'
 mkPCellJson :: ToJSON b => (Erasable a -> Maybe b) -> PCell a -> Value
@@ -71,6 +67,10 @@ instance ToJSON Cell where
     ENothing -> Nothing
     EJust e -> Just (e ^. entityName)
 
+-- | Parse a tuple such as @[grass, rock, base]@ into a 'Cell'.  The
+--   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 (TerrainEntityMaps, RobotMap) Cell where
   parseJSONE = withArrayE "tuple" $ \v -> do
     let tupRaw = V.toList v
@@ -107,20 +107,6 @@ instance FromJSONE (TerrainEntityMaps, RobotMap) Cell where
 
     return $ Cell terr ent robs
 
--- | Parse a tuple such as @[grass, rock, base]@ into a 'Cell'.  The
---   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 (TerrainEntityMaps, RobotMap) (AugmentedCell Entity) where
-  parseJSONE x = case x of
-    Object v -> objParse v
-    z -> AugmentedCell Nothing <$> parseJSONE z
-   where
-    objParse v =
-      AugmentedCell
-        <$> liftE (v .:? "waypoint")
-        <*> v ..: "cell"
-
 ------------------------------------------------------------
 -- World editor
 ------------------------------------------------------------

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

@@ -57,9 +57,9 @@ import Swarm.Game.Scenario (StaticStructureInfo (..))
 import Swarm.Game.Scenario.Topography.Area (Grid (Grid))
 import Swarm.Game.Scenario.Topography.Cell (PCell, cellEntity)
 import Swarm.Game.Scenario.Topography.Placement (Orientation (..), applyOrientationTransform)
+import Swarm.Game.Scenario.Topography.Structure
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
-import Swarm.Game.Scenario.Topography.Structure.Type
 import Swarm.Game.Universe (Cosmic (..))
 import Swarm.Language.Syntax.Direction (AbsoluteDir)
 import Swarm.Util (binTuples, histogram)

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

@@ -26,18 +26,16 @@ import Swarm.Game.Scenario.Topography.Navigation.Waypoint (
   Parentage (Root),
   WaypointName,
  )
+import Swarm.Game.Scenario.Topography.ProtoCell
 import Swarm.Game.Scenario.Topography.Structure (
-  InheritedStructureDefs,
- )
-import Swarm.Game.Scenario.Topography.Structure qualified as Structure
-import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
-import Swarm.Game.Scenario.Topography.Structure.Overlay
-import Swarm.Game.Scenario.Topography.Structure.Type (
   LocatedStructure,
   MergedStructure (MergedStructure),
   NamedStructure,
   PStructure (Structure),
+  paintMap,
  )
+import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
+import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Swarm.Game.Scenario.Topography.WorldPalette
 import Swarm.Game.Universe
 import Swarm.Game.World.Parse ()
@@ -68,6 +66,8 @@ data PWorldDescription e = WorldDescription
 
 type WorldDescription = PWorldDescription Entity
 
+type InheritedStructureDefs = [NamedStructure (Maybe Cell)]
+
 data WorldParseDependencies
   = WorldParseDependencies
       WorldMap
@@ -85,7 +85,7 @@ integrateArea palette initialStructureDefs v = do
   placementDefs <- v .:? "placements" .!= []
   waypointDefs <- v .:? "waypoints" .!= []
   rawMap <- v .:? "map" .!= ""
-  (initialArea, mapWaypoints) <- Structure.paintMap Nothing palette rawMap
+  (initialArea, mapWaypoints) <- paintMap Nothing palette rawMap
   let unflattenedStructure =
         Structure
           (PositionedGrid origin $ Grid initialArea)
@@ -102,7 +102,7 @@ instance FromJSONE WorldParseDependencies WorldDescription where
     let withDeps = localE (const (tem, rm))
     palette <-
       withDeps $
-        v ..:? "palette" ..!= WorldPalette mempty
+        v ..:? "palette" ..!= StructurePalette mempty
     subworldLocalStructureDefs <-
       withDeps $
         v ..:? "structures" ..!= []

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

@@ -6,7 +6,6 @@ module Swarm.Game.Scenario.Topography.WorldPalette where
 
 import Control.Arrow (first)
 import Control.Lens hiding (from, (.=), (<.>))
-import Data.Aeson.KeyMap (KeyMap)
 import Data.Aeson.KeyMap qualified as KM
 import Data.Map qualified as M
 import Data.Maybe (catMaybes)
@@ -15,24 +14,15 @@ 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.Area
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
+import Swarm.Game.Scenario.Topography.ProtoCell
 import Swarm.Game.Terrain (TerrainType)
 import Swarm.Util.Erasable
-import Swarm.Util.Yaml
 
 -- | A world palette maps characters to 'Cell' values.
-newtype WorldPalette e = WorldPalette
-  {unPalette :: KeyMap (AugmentedCell e)}
-  deriving (Eq, Show)
-
-instance FromJSONE (TerrainEntityMaps, RobotMap) (WorldPalette Entity) where
-  parseJSONE =
-    withObjectE "palette" $
-      fmap WorldPalette . mapM parseJSONE
+type WorldPalette e = StructurePalette (PCell e)
 
 type TerrainWith a = (TerrainType, Erasable a)
 
@@ -111,7 +101,7 @@ prepForJson ::
   PaletteAndMaskChar ->
   Grid (Maybe CellPaintDisplay) ->
   (Text, KM.KeyMap CellPaintDisplay)
-prepForJson (PaletteAndMaskChar (WorldPalette suggestedPalette) maybeMaskChar) cellGrid =
+prepForJson (PaletteAndMaskChar (StructurePalette suggestedPalette) maybeMaskChar) cellGrid =
   (constructWorldMap mappedPairs maskCharacter cellGrid, constructPalette mappedPairs)
  where
   preassignments :: [(Char, TerrainWith EntityFacade)]

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

@@ -15,7 +15,6 @@ import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
 import Data.Tuple.Extra (both)
-import Data.Vector qualified as V
 import Linear (V2 (..))
 import Swarm.Game.Display (defaultChar)
 import Swarm.Game.Entity.Cosmetic
@@ -27,6 +26,7 @@ import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.Center
 import Swarm.Game.Scenario.Topography.EntityFacade (EntityFacade (..), mkFacade)
+import Swarm.Game.Scenario.Topography.Rasterize
 import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Swarm.Game.State.Landscape
 import Swarm.Game.Universe
@@ -167,11 +167,6 @@ renderScenarioMap opts fp = simpleErrorHandle $ do
   (grid, _) <- getRenderableGrid opts fp
   return $ unGrid $ getDisplayChar <$> grid
 
--- | Converts linked lists to vectors to facilitate
--- random access when assembling the image
-gridToVec :: Grid a -> V.Vector (V.Vector a)
-gridToVec (Grid g) = V.fromList . map V.fromList $ g
-
 renderScenarioPng :: RenderOpts -> FilePath -> IO ()
 renderScenarioPng opts fp = do
   result <- runThrow $ getRenderableGrid opts fp
@@ -185,14 +180,8 @@ renderScenarioPng opts fp = do
      where
       errorMsg :: String
       errorMsg = prettyString err
-    Right (grid, aMap) -> return $ mkImg aMap grid
+    Right (grid, aMap) -> return $ (makeImage . getDisplayColor) aMap grid
   writePng (outputFilepath opts) img
- where
-  mkImg aMap g = generateImage (pixelRenderer vecGrid) (fromIntegral w) (fromIntegral h)
-   where
-    vecGrid = gridToVec g
-    AreaDimensions w h = getGridDimensions g
-    pixelRenderer vg x y = getDisplayColor aMap $ (vg V.! y) V.! x
 
 printScenarioMap :: [String] -> IO ()
 printScenarioMap =

src/swarm-topography/Swarm/Game/Scenario/Topography/ProtoCell.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Scenario.Topography.ProtoCell (
+  SignpostableCell (..),
+  StructurePalette (..),
+) where
+
+import Control.Applicative ((<|>))
+import Data.Aeson.KeyMap (KeyMap)
+import Data.Yaml as Y
+import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointConfig)
+import Swarm.Util.Yaml
+
+newtype StructurePalette e = StructurePalette
+  {unPalette :: KeyMap (SignpostableCell e)}
+  deriving (Eq, Show)
+
+instance (FromJSONE e a) => FromJSONE e (StructurePalette a) where
+  parseJSONE =
+    withObjectE "palette" $
+      fmap StructurePalette . mapM parseJSONE
+
+-- | Supplements a cell with waypoint information
+data SignpostableCell c = SignpostableCell
+  { waypointCfg :: Maybe WaypointConfig
+  , standardCell :: c
+  }
+  deriving (Eq, Show)
+
+instance (FromJSONE e a) => FromJSONE e (SignpostableCell a) where
+  parseJSONE x =
+    withObjectE "SignpostableCell" objParse x
+      <|> (SignpostableCell Nothing <$> parseJSONE x)
+   where
+    objParse v =
+      SignpostableCell
+        <$> liftE (v .:? "waypoint")
+        <*> v ..: "cell"