Fix growable structure grids for multiple children with negative coor…

…dinates (#2127)

Fixes a bug from #1826.

## Background

Structure definitions can be nested, in that a structure can reference and place multiple "substructures", each with an "offset", to compose something more complicated.  Each placement onto a particular "base" structure is a "child".  Multiple child placements atop the same base structure are "siblings".

It so happened that if a child placement with a "negative" horizontal offset preceded a sibling with non-negative offset, this would result in miscalculated placements.  This had to do with the fact that "growing" the "base grid" in the negative direction means that the original "origin" (that the "offset" of subsequent placements are made with respect to) of the base grid must be shifted further right (to somewhere in the middle of the grid), rather than lying on the left edge.

Conversely, if negative offsets occurred as later siblings, then the placement would be correct (the bug would not be triggered).

## The fix

This fix ensures that sibling placements can be re-ordered without affecting the end result.  There were actually two bugs:
* changes to the origin offset were not propagated between sibling placements (i.e. across iterations of [`foldlM`](https://github.com/swarm-game/swarm/blob/ab13170f4c3d47e6fb3e44d3ec1c86aa91451575/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs#L84))
* the math for computing combined offset (`originDelta` in the `Semigroup` instance of `PositionedGrid`) was incorrect.

## Other changes
Also implements a `--refresh` option to the `standalone-topography` test for updating image-based test fixtures.

## Bug repro
```
scripts/play.sh -i data/scenarios/Testing/1780-structure-merge-expansion/sequential-placement.yaml
```
| Before (incorrect) | After (correct) |
| --- | --- |
| ![broken](https://github.com/user-attachments/assets/47952f83-b877-4fc2-b6b7-8ceb495e8ba0)| ![fixed](https://github.com/user-attachments/assets/907d8872-bff0-4c41-b1c4-8561bf206b4a) |

# Refreshing test images
```
scripts/test/run-tests.sh standalone-topography --test-options '--refresh'
```

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

@@ -1,3 +1,4 @@
 nonoverlapping-structure-merge.yaml
 root-map-expansion.yaml
-structure-composition.yaml
+structure-composition.yaml
+sequential-placement.yaml

data/scenarios/Testing/1780-structure-merge-expansion/sequential-placement.yaml

@@ -0,0 +1,95 @@
+version: 1
+name: Flipped structure placement
+author: Karl Ostmo
+description: |
+  Sequentially place structures that are larger than the map
+  with flipped orientation.
+robots:
+  - name: base
+    dir: north
+creative: true
+objectives:
+  - goal:
+      - Must have 3 of each color visible
+    condition: |
+      def countColor = \e.
+        resonate e ((0, 0), (10, -5));
+        end;
+
+      as base {
+        r <- countColor "pixel (R)";
+        g <- countColor "pixel (G)";
+        b <- countColor "pixel (B)";
+        y <- countColor "gold";
+        return $ r == 3 && g == 3 && b == 3 && y == 3;
+      }
+solution: |
+  noop
+known: [boulder, log, pixel (R), pixel (G), pixel (B), gold]
+world:
+  structures:
+    - name: reddish
+      structure:
+        mask: '.'
+        palette:
+          'x': [stone, pixel (R)]
+        map: |
+          xx
+          x.
+    - name: greenish
+      structure:
+        mask: '.'
+        palette:
+          'x': [stone, pixel (G)]
+        map: |
+          xx
+          x.
+    - name: bluish
+      structure:
+        mask: '.'
+        palette:
+          'x': [stone, pixel (B)]
+        map: |
+          xx
+          x.
+    - name: goldish
+      structure:
+        mask: '.'
+        palette:
+          'x': [stone, gold]
+        map: |
+          xx
+          x.
+    - name: block
+      structure:
+        mask: '.'
+        palette:
+          'x': [ice, log]
+        placements:
+          - src: greenish
+            orient:
+              flip: true
+            offset: [-3, 2]
+          - src: reddish
+            offset: [-6, 0]
+          - src: goldish
+            orient:
+              flip: true
+            offset: [3, -1]
+          - src: bluish
+            offset: [0, 1]
+        map: |
+          xxx
+          xx.
+          x..
+  palette:
+    'Ω': [grass, erase, base]
+  mask: '.'
+  placements:
+    - src: block
+      offset: [0, -1]
+  upperleft: [0, 0]
+  dsl: |
+    {grass}
+  map: |
+    Ω

data/test/standalone-topography/circle-and-crosses.yaml

@@ -19,7 +19,7 @@ structures:
               fff
       placements:
         - src: beam
-          offset: [0, 3]
+          offset: [0, 0]
         - src: beam
           offset: [-3, -3]
           orient:

scripts/validate/issues-for-todos.sh

@@ -3,7 +3,7 @@
 cd $(git rev-parse --show-toplevel)
 
 
-if grep --line-number --include \*.hs -riP '(TODO|FIXME|XXX)\b' src app 2>&1 | grep -vP '#\d+'; then
+if grep --line-number --include \*.hs -riP '(TODO|FIXME|XXX)\b' src app test 2>&1 | grep -vP '#\d+'; then
   echo "Please add a link to Issue, for example: TODO: #123"
   exit 1
 else

src/swarm-scenario/Swarm/Game/Scenario/Topography/Navigation/Portal.hs

@@ -179,7 +179,7 @@ validatePartialNavigation currentSubworldName upperLeft unmergedWaypoints portal
   correctedWaypoints =
     binTuples $
       map
-        (\x -> (wpName $ wpConfig $ value x, fmap (offsetLoc $ upperLeft .-. origin) x))
+        (\x -> (wpName $ wpConfig $ value x, fmap (offsetLoc $ asVector upperLeft) x))
         unmergedWaypoints
   bareWaypoints = M.map (NE.map extractLoc) correctedWaypoints
   waypointsWithUniqueFlag = M.filter (any $ wpUnique . wpConfig . value) correctedWaypoints

src/swarm-topography/Swarm/Game/Location.hs

@@ -29,6 +29,7 @@ module Swarm.Game.Location (
   -- ** Utility functions
   manhattan,
   euclidean,
+  asVector,
   getLocsInArea,
   getElemsInArea,
 
@@ -199,6 +200,10 @@ manhattan (Location x1 y1) (Location x2 y2) = abs (x1 - x2) + abs (y1 - y2)
 euclidean :: Location -> Location -> Double
 euclidean p1 p2 = norm (fromIntegral <$> (p2 .-. p1))
 
+-- | Converts a 'Point' to a vector offset from the 'origin'.
+asVector :: Location -> V2 Int32
+asVector loc = loc .-. origin
+
 -- | Get all the locations that are within a certain manhattan
 --   distance from a given location.
 --

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs

@@ -22,7 +22,6 @@ import Data.Text qualified as T
 import Linear.Affine
 import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Area
-import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint
 import Swarm.Game.Scenario.Topography.Placement
 import Swarm.Game.Scenario.Topography.Structure
@@ -42,14 +41,14 @@ overlaySingleStructure ::
   Either Text (MergedStructure (Maybe a))
 overlaySingleStructure
   inheritedStrucDefs
-  (Placed p@(Placement _ pose@(Pose loc orientation)) ns)
+  (Placed p@(Placement _sName pose@(Pose loc orientation)) ns)
   (MergedStructure inputArea inputPlacements inputWaypoints) = do
     MergedStructure overlayArea overlayPlacements overlayWaypoints <-
       mergeStructures inheritedStrucDefs (WithParent p) $ structure ns
 
     let mergedWaypoints = inputWaypoints <> map (fmap $ placeOnArea overlayArea) overlayWaypoints
         mergedPlacements = inputPlacements <> map (placeOnArea overlayArea) overlayPlacements
-        mergedArea = overlayGridExpanded (gridContent inputArea) pose overlayArea
+        mergedArea = overlayGridExpanded inputArea pose overlayArea
 
     return $ MergedStructure mergedArea mergedPlacements mergedWaypoints
    where
@@ -81,6 +80,8 @@ mergeStructures inheritedStrucDefs parentPlacement (Structure origArea subStruct
         map wrapPlacement $
           filter (\(Placed _ ns) -> isRecognizable ns) overlays
 
+  -- NOTE: Each successive overlay may alter the coordinate origin.
+  -- We make sure this new origin is propagated to subsequent sibling placements.
   foldlM
     (flip $ overlaySingleStructure structureMap)
     (MergedStructure origArea wrappedOverlays originatedWaypoints)
@@ -97,18 +98,22 @@ mergeStructures inheritedStrucDefs parentPlacement (Structure origArea subStruct
 -- * Grid manipulation
 
 overlayGridExpanded ::
-  Grid (Maybe a) ->
+  PositionedGrid (Maybe a) ->
   Pose ->
   PositionedGrid (Maybe a) ->
   PositionedGrid (Maybe a)
 overlayGridExpanded
-  inputGrid
-  (Pose loc orientation)
-  (PositionedGrid _ overlayArea) =
-    PositionedGrid origin inputGrid <> positionedOverlay
+  baseGrid
+  (Pose yamlPlacementOffset orientation)
+  -- NOTE: The '_childAdjustedOrigin' is the sum of origin adjustments
+  -- to completely assemble some substructure. However, we discard
+  -- this when we place a substructure into a new base grid.
+  (PositionedGrid _childAdjustedOrigin overlayArea) =
+    baseGrid <> positionedOverlay
    where
     reorientedOverlayCells = applyOrientationTransform orientation overlayArea
-    positionedOverlay = PositionedGrid loc reorientedOverlayCells
+    placementAdjustedByOrigin = gridPosition baseGrid .+^ asVector yamlPlacementOffset
+    positionedOverlay = PositionedGrid placementAdjustedByOrigin reorientedOverlayCells
 
 -- * Validation
 

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs

@@ -101,12 +101,11 @@ instance (Alternative f) => Semigroup (PositionedGrid (f a)) where
     mergedSize = computeMergedArea $ OverlayPair a1 a2
     combinedGrid = zipGridRows mergedSize paddedOverlayPair
 
-    -- We subtract the base origin from the
-    -- overlay position, such that the displacement vector
-    -- will have:
+    -- We create a vector from the overlay position,
+    -- such that the displacement vector will have:
     -- \* negative X component if the origin must be shifted east
     -- \* positive Y component if the origin must be shifted south
-    originDelta@(V2 deltaX deltaY) = overlayLoc .-. baseLoc
+    originDelta@(V2 deltaX deltaY) = asVector overlayLoc
     -- Note that the adjustment vector will only ever have
     -- a non-negative X component (i.e. loc of upper-left corner must be shifted east) and
     -- a non-positive Y component (i.e. loc of upper-left corner must be shifted south).

test/integration/Main.hs

@@ -440,6 +440,14 @@ testScenarioSolutions rs ui key =
             [ testSolution Default "Testing/1535-ping/1535-in-range"
             , testSolution Default "Testing/1535-ping/1535-out-of-range"
             ]
+        , testGroup
+            "Structure placement (#1780)"
+            [ testSolution Default "Testing/1780-structure-merge-expansion/sequential-placement"
+            -- TODO(#2148) define goal conditions or convert to image fixtures
+            -- , testSolution Default "Testing/1780-structure-merge-expansion/nonoverlapping-structure-merge"
+            -- , testSolution Default "Testing/1780-structure-merge-expansion/root-map-expansion"
+            -- , testSolution Default "Testing/1780-structure-merge-expansion/structure-composition"
+            ]
         , testGroup
             "Structure recognition (#1575)"
             [ testSolution Default "Testing/1575-structure-recognizer/1575-browse-structures"

test/standalone-topography/src/Lib.hs

@@ -32,8 +32,12 @@ parseStructures dataDir baseFilename = do
       dataDir </> "test/standalone-topography" </> baseFilename
   return $ forceEither $ left prettyPrintParseException eitherResult
 
-compareToReferenceImage :: FilePath -> Assertion
-compareToReferenceImage fileStem = do
+compareToReferenceImage ::
+  -- | set this to update the golden tests
+  Bool ->
+  FilePath ->
+  Assertion
+compareToReferenceImage refreshReferenceImage fileStem = do
   dataDir <- getDataDir
   parentStruct <- parseStructures dataDir $ fileStem <.> "yaml"
   let MergedStructure overlayArea _ _ = forceEither $ mergeStructures mempty Root parentStruct
@@ -44,6 +48,3 @@ compareToReferenceImage fileStem = do
     else do
       decodedImg <- LBS.readFile referenceFilepath
       assertEqual "Generated image must equal reference image!" decodedImg encodedImgBytestring
- where
-  -- Manually toggle this to update the golden tests
-  refreshReferenceImage = False

test/standalone-topography/src/Main.hs

@@ -4,33 +4,46 @@
 -- SPDX-License-Identifier: BSD-3-Clause
 module Main where
 
-import Test.Tasty (defaultMain, testGroup)
+import Data.Proxy
+import Data.Typeable (Typeable)
+import Lib (compareToReferenceImage)
+import Test.Tasty
 import Test.Tasty.HUnit (testCase)
+import Test.Tasty.Options
 
-import Lib
+newtype UpdateGoldenTests = UpdateGoldenTests Bool
+  deriving (Eq, Ord, Typeable)
+
+instance IsOption UpdateGoldenTests where
+  parseValue = fmap UpdateGoldenTests . safeRead
+  defaultValue = UpdateGoldenTests False
+  optionName = return "refresh"
+  optionHelp = return "Should overwrite the golden test images"
+  optionCLParser = mkFlagCLParser mempty (UpdateGoldenTests True)
 
 main :: IO ()
 main = do
-  defaultMain $
-    testGroup
-      "Test structure assembly"
-      [ mkGroup
-          "Black and white"
-          [ "circle-and-crosses"
-          , "checkerboard"
-          ]
-      , mkGroup
-          "Color"
-          [ "rainbow"
+  defaultMainWithIngredients ingredients $ askOption $ \(UpdateGoldenTests shouldRefreshTests) ->
+    let doTest stem =
+          testCase (unwords ["Image equality:", stem]) $
+            compareToReferenceImage shouldRefreshTests stem
+
+        mkGroup title members =
+          testGroup title $
+            map
+              doTest
+              members
+     in testGroup
+          "Test structure assembly"
+          [ mkGroup
+              "Black and white"
+              [ "circle-and-crosses"
+              , "checkerboard"
+              ]
+          , mkGroup
+              "Color"
+              [ "rainbow"
+              ]
           ]
-      ]
  where
-  doTest stem =
-    testCase (unwords ["Image equality:", stem]) $
-      compareToReferenceImage stem
-
-  mkGroup title members =
-    testGroup title $
-      map
-        doTest
-        members
+  ingredients = includingOptions [Option (Proxy :: Proxy UpdateGoldenTests)] : defaultIngredients