Implement non-truncating structure overlays

data/scenarios/Testing/00-ORDER.txt

@@ -62,4 +62,5 @@ Achievements
 1747-volume-command.yaml
 1777-capability-cost.yaml
 1775-custom-terrain.yaml
-1642-biomes.yaml
+1642-biomes.yaml
+1780-structure-merge-expansion

data/scenarios/Testing/1780-structure-merge-expansion/00-ORDER.txt

@@ -0,0 +1,3 @@
+nonoverlapping-structure-merge.yaml
+root-map-expansion.yaml
+structure-composition.yaml

data/scenarios/Testing/1780-structure-merge-expansion/nonoverlapping-structure-merge.yaml

@@ -0,0 +1,61 @@
+version: 1
+name: Expansion of a substructure to fit its placements
+description: |
+  Define two structures and place them on the map.
+robots:
+  - name: base
+    loc: [4, -4]
+    dir: east
+known: [water, sand, tree]
+world:
+  palette:
+    '.': [grass]
+  upperleft: [-1, 1]
+  structures:
+    - name: vertical rectangle
+      structure:
+        palette:
+          'x': [blank, tree]
+        map: |
+          xx
+          xx
+          xx
+          xx
+    - name: horizontal rectangle
+      structure:
+        palette:
+          'x': [blank, sand]
+        map: |
+          xxxx
+          xxxx
+    - name: disjoint rectangles
+      structure:
+        palette:
+          'x': [blank, water]
+        map: |
+          xx
+          xx
+        placements:
+          - src: vertical rectangle
+            truncate: false
+            offset: [-7, 7]
+          - src: horizontal rectangle
+            truncate: false
+            offset: [7, -7]
+  placements:
+    - src: disjoint rectangles
+      offset: [2, -2]
+  map: |
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............
+    ...............

data/scenarios/Testing/1780-structure-merge-expansion/root-map-expansion.yaml

@@ -0,0 +1,34 @@
+version: 1
+name: Non-overlapping merging with expansion
+description: |
+  Define two structures and place them on the map.
+
+  Demonstrates automatic expansion of the root map grid.
+robots:
+  - name: base
+    loc: [8, 0]
+    dir: east
+known: [tree, sand, water]
+world:
+  palette:
+    '.': [grass]
+    'i': [ice]
+    'j': [dirt]
+    'k': [stone]
+    'l': [stone, sand]
+    'm': [stone, water]
+  upperleft: [3, 3]
+  structures:
+    - name: single tree
+      structure:
+        palette:
+          'x': [blank, tree]
+        map: |
+          x
+  placements:
+    - src: single tree
+      truncate: false
+      offset: [-2, -4]
+  map: |
+    i.
+    .j

data/scenarios/Testing/1780-structure-merge-expansion/structure-composition.yaml

@@ -0,0 +1,111 @@
+version: 1
+name: Various structure merging arrangements
+description: |
+  Define two structures and place them on the map.
+robots:
+  - name: base
+    loc: [11, 0]
+    dir: east
+known: [water, sand]
+world:
+  palette:
+    '.': [grass]
+  upperleft: [-1, 1]
+  structures:
+    - name: vertical rectangle
+      structure:
+        palette:
+          'x': [blank, water]
+        map: |
+          xx
+          xx
+          xx
+          xx
+    - name: horizontal rectangle
+      structure:
+        palette:
+          'x': [blank, sand]
+        map: |
+          xxxx
+          xxxx
+    - name: combined rectangles blank base
+      structure:
+        palette:
+          'x': [blank]
+        map: |
+          xxxx
+          xxxx
+          xxxx
+          xxxx
+        placements:
+          - src: vertical rectangle
+          - src: horizontal rectangle
+    - name: combined rectangles empty base
+      structure:
+        palette:
+          'x': [blank]
+        map: ""
+        placements:
+          - src: vertical rectangle
+            truncate: false
+          - src: horizontal rectangle
+            truncate: false
+    - name: combined rectangles single cell base
+      structure:
+        palette:
+          'x': [blank]
+        map: |
+          x
+        placements:
+          - src: vertical rectangle
+            truncate: false
+          - src: horizontal rectangle
+            truncate: false
+    - name: multi overlap
+      structure:
+        palette:
+          'x': [blank]
+        map: |
+          xxxx
+        placements:
+          - src: vertical rectangle
+            offset: [1, 0]
+            truncate: false
+          - src: horizontal rectangle
+            truncate: false
+            offset: [0, -2]
+          - src: vertical rectangle
+            offset: [3, -2]
+            truncate: false
+          - src: horizontal rectangle
+            truncate: false
+            offset: [3, -4]
+          - src: vertical rectangle
+            offset: [5, -4]
+            truncate: false
+  placements:
+    - src: vertical rectangle
+      offset: [1, -1]
+    - src: horizontal rectangle
+      offset: [1, -1]
+    - src: multi overlap
+      offset: [1, -6]
+      truncate: false
+    - src: combined rectangles blank base
+      offset: [6, -1]
+    - src: combined rectangles empty base
+      offset: [11, -1]
+    - src: combined rectangles single cell base
+      offset: [11, -6]
+  map: |
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................

scripts/test/run-tests.sh

@@ -1,7 +1,6 @@
 #!/bin/bash -ex
 
-SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
-cd $SCRIPT_DIR/..
+cd $(git rev-parse --show-toplevel)
 
 # See https://github.com/swarm-game/swarm/issues/936
-STACK_WORK=.stack-work-test stack test --fast "$@"
+cabal test -O0 -j "$@"

src/Swarm/TUI/Editor/Controller.hs

@@ -17,6 +17,7 @@ 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.Area
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.State
 import Swarm.Game.State.Landscape
@@ -146,7 +147,9 @@ saveMapFile = do
   maybeBounds <- use $ uiState . uiGameplay . uiWorldEditor . editingBounds . boundsRect
   w <- use $ gameState . landscape . multiWorld
   tm <- use $ gameState . landscape . terrainAndEntities . terrainMap
-  let mapCellGrid = EU.getEditedMapRectangle tm (worldEditor ^. worldOverdraw) maybeBounds w
+  let mapCellGrid =
+        mapRows (map (map Just)) $
+          EU.getEditedMapRectangle tm (worldEditor ^. worldOverdraw) maybeBounds w
 
   let fp = worldEditor ^. outputFilePath
   maybeScenarioPair <- use $ uiState . uiGameplay . scenarioRef

src/Swarm/TUI/Editor/Palette.hs

@@ -12,7 +12,7 @@ import Data.List (sortOn)
 import Data.List.NonEmpty qualified as NE
 import Data.Map (Map)
 import Data.Map qualified as M
-import Data.Maybe (mapMaybe)
+import Data.Maybe (catMaybes, mapMaybe)
 import Data.Ord (Down (..))
 import Data.Set (Set)
 import Data.Set qualified as Set
@@ -27,6 +27,7 @@ import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
+import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Swarm.Game.Scenario.Topography.WorldPalette
 import Swarm.Game.Terrain (TerrainMap, TerrainType, getTerrainDefaultPaletteChar, terrainByName)
 import Swarm.Game.Universe
@@ -38,7 +39,7 @@ import Swarm.Util.Erasable
 makeSuggestedPalette ::
   TerrainMap ->
   KM.KeyMap (AugmentedCell Entity) ->
-  [[CellPaintDisplay]] ->
+  Grid (Maybe CellPaintDisplay) ->
   KM.KeyMap (AugmentedCell EntityFacade)
 makeSuggestedPalette tm originalScenarioPalette cellGrid =
   KM.fromMapText
@@ -48,6 +49,8 @@ makeSuggestedPalette tm originalScenarioPalette cellGrid =
     -- NOTE: the left-most maps take precedence!
     $ paletteCellsByKey <> pairsWithDisplays <> terrainOnlyPalette
  where
+  cellList = concatMap catMaybes $ unGrid cellGrid
+
   getMaybeEntityDisplay :: PCell EntityFacade -> Maybe (EntityName, Display)
   getMaybeEntityDisplay (Cell _terrain (erasableToMaybe -> maybeEntity) _) = do
     EntityFacade eName d <- maybeEntity
@@ -60,11 +63,11 @@ makeSuggestedPalette tm originalScenarioPalette cellGrid =
 
   getEntityTerrainMultiplicity :: Map EntityName (Map TerrainType Int)
   getEntityTerrainMultiplicity =
-    M.map histogram $ binTuples $ concatMap (mapMaybe getMaybeEntityNameTerrainPair) cellGrid
+    M.map histogram $ binTuples $ mapMaybe getMaybeEntityNameTerrainPair cellList
 
   usedEntityDisplays :: Map EntityName Display
   usedEntityDisplays =
-    M.fromList $ concatMap (mapMaybe getMaybeEntityDisplay) cellGrid
+    M.fromList $ mapMaybe getMaybeEntityDisplay cellList
 
   -- Finds the most-used terrain type (the "mode" in the statistical sense)
   -- paired with each entity
@@ -115,8 +118,8 @@ makeSuggestedPalette tm originalScenarioPalette cellGrid =
     f x = ((x, ENothing), (T.singleton $ getTerrainDefaultPaletteChar x, Cell x ENothing []))
 
 -- | Generate a \"skeleton\" scenario with placeholders for certain required fields
-constructScenario :: Maybe Scenario -> Grid CellPaintDisplay -> SkeletonScenario
-constructScenario maybeOriginalScenario (Grid cellGrid) =
+constructScenario :: Maybe Scenario -> Grid (Maybe CellPaintDisplay) -> SkeletonScenario
+constructScenario maybeOriginalScenario cellGrid =
   SkeletonScenario
     (maybe 1 (^. scenarioMetadata . scenarioVersion) maybeOriginalScenario)
     (maybe "My Scenario" (^. scenarioMetadata . scenarioName) maybeOriginalScenario)
@@ -135,7 +138,7 @@ constructScenario maybeOriginalScenario (Grid cellGrid) =
       , scrollable = True
       , palette = WorldPalette suggestedPalette
       , ul = upperLeftCoord
-      , area = cellGrid
+      , area = PositionedGrid upperLeftCoord cellGrid
       , navigation = Navigation mempty mempty
       , placedStructures = mempty
       , worldName = DefaultRootSubworld
@@ -151,4 +154,4 @@ constructScenario maybeOriginalScenario (Grid cellGrid) =
       (negate $ w `div` 2)
       (h `div` 2)
    where
-    AreaDimensions w h = getAreaDimensions cellGrid
+    AreaDimensions w h = getGridDimensions cellGrid

src/Swarm/TUI/Editor/Util.hs

@@ -13,6 +13,7 @@ import Swarm.Game.Entity
 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.Structure.Overlay
 import Swarm.Game.Scenario.Topography.WorldDescription
 import Swarm.Game.Terrain (TerrainMap, TerrainType)
 import Swarm.Game.Universe
@@ -33,8 +34,8 @@ getEditingBounds myWorld =
  where
   newBounds = Cosmic DefaultRootSubworld (W.locToCoords upperLeftLoc, W.locToCoords lowerRightLoc)
   upperLeftLoc = ul myWorld
-  a = EA.getAreaDimensions $ area myWorld
-  lowerRightLoc = EA.upperLeftToBottomRight a upperLeftLoc
+  a = EA.getGridDimensions $ gridContent $ area myWorld
+  lowerRightLoc = EA.computeBottomRightFromUpperLeft a upperLeftLoc
 
 getEditorContentAt ::
   TerrainMap ->

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

@@ -99,6 +99,7 @@ import Swarm.Game.Scenario.Topography.Navigation.Portal
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint (Parentage (..))
 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.Recognition.Symmetry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (SymmetryAnnotatedGrid (..))
 import Swarm.Game.Scenario.Topography.WorldDescription
@@ -336,7 +337,7 @@ instance FromJSONE ScenarioInputs Scenario where
             (sequenceA . (id &&& (Assembly.mergeStructures mempty Root . Structure.structure)))
             rootLevelSharedStructures
 
-      let namedGrids = map (\(ns, Structure.MergedStructure s _ _) -> s <$ ns) mergedStructures
+      let namedGrids = map (\(ns, Structure.MergedStructure (PositionedGrid _ s) _ _) -> s <$ ns) mergedStructures
 
       allWorlds <- localE (WorldParseDependencies worldMap rootLevelSharedStructures rsMap) $ do
         rootWorld <- v ..: "world"