fix positioning bug with negative coordinates

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,77 @@
+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
+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, -1]
+          - src: goldish
+            orient:
+              flip: true
+            offset: [3, 0]
+          - 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:

data/test/standalone-topography/flip-duplicate.yaml

@@ -0,0 +1,46 @@
+structures:
+  - name: house
+    structure:
+      palette:
+        'x': "#ff0000"
+        'A': "#ff8800"
+        '.': "#ffff00"
+      map: |
+        xxxx
+        x..x
+        x..A
+        xxAA
+  - name: street pair
+    structure:
+      palette:
+        '.': "#00ff00"
+      placements:
+        - src: house
+          offset: [-1, 0]
+          orient:
+            up: south
+      map: |
+        .
+        .
+        .
+        .
+        .
+        .
+        .
+        .
+        .
+  - name: block
+    structure:
+      placements:
+        - src: street pair
+          orient:
+            flip: true
+        - src: street pair
+      map: ""
+placements:
+  - src: street pair
+    orient:
+      flip: true
+  - src: street pair
+upperleft: [0, 0]
+map: ""

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
 
+  -- TODO: Each successive overlay may alter the coordinate origin.
+  -- Make sure this new origin is propagated to subsequent placements.
   foldlM
     (flip $ overlaySingleStructure structureMap)
     (MergedStructure origArea wrappedOverlays originatedWaypoints)
@@ -97,18 +98,24 @@ 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 .+^ (yamlPlacementOffset .-. origin)
+
+    positionedOverlay = PositionedGrid placementAdjustedByOrigin reorientedOverlayCells
 
 -- * Validation
 

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

@@ -106,7 +106,7 @@ instance (Alternative f) => Semigroup (PositionedGrid (f a)) where
     -- 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
+    V2 deltaX deltaY = overlayLoc .-. origin
     -- 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).
@@ -116,7 +116,7 @@ instance (Alternative f) => Semigroup (PositionedGrid (f a)) where
     newOrigin = baseLoc .-^ clampedDelta
 
     paddedOverlayPair =
-      padSouthwest originDelta $
+      padSouthwest (overlayLoc .-. origin) $
         OverlayPair baseGrid overlayGrid
 
 -- | NOTE: We only make explicit grid adjustments for

test/integration/Main.hs

@@ -440,7 +440,14 @@ testScenarioSolutions rs ui key =
             [ testSolution Default "Testing/1535-ping/1535-in-range"
             , testSolution Default "Testing/1535-ping/1535-out-of-range"
             ]
-        , testGroup
+        , -- , testGroup
+          --     "Structure placement (#1780)"
+          --     [ 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"
+          --     , testSolution Default "Testing/1780-structure-merge-expansion/sequential-placement"
+          --     ]
+          testGroup
             "Structure recognition (#1575)"
             [ testSolution Default "Testing/1575-structure-recognizer/1575-browse-structures"
             , testSolution Default "Testing/1575-structure-recognizer/1575-nested-structure-definition"

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,48 @@
 -- SPDX-License-Identifier: BSD-3-Clause
 module Main where
 
-import Test.Tasty (defaultMain, testGroup)
+import Data.Proxy
+import Data.Typeable (Typeable)
+import Test.Tasty
 import Test.Tasty.HUnit (testCase)
+import Test.Tasty.Options
 
-import Lib
+import Lib (compareToReferenceImage)
+
+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 ingreds $ 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"
+              , "flip-duplicate"
+              ]
           ]
-      ]
  where
-  doTest stem =
-    testCase (unwords ["Image equality:", stem]) $
-      compareToReferenceImage stem
-
-  mkGroup title members =
-    testGroup title $
-      map
-        doTest
-        members
+  ingreds = includingOptions [Option (Proxy :: Proxy UpdateGoldenTests)] : defaultIngredients