fixed

data/scenarios/Testing/1780-structure-merge-expansion/simultaneous-north-and-west-offset.yaml

@@ -7,6 +7,7 @@ description: |
 robots:
   - name: base
     dir: north
+    loc: [0, 2]
 creative: true
 objectives:
   - goal:
@@ -48,12 +49,9 @@ world:
     , mask (y > -2 && y < 2 || x > -2 && x < 2) {ice}
     , mask (y > -1 && y < 1 || x > -1 && x < 1) {dirt}
     ]
-  palette:
-    'Ω': [grass, erase, base]
   mask: '.'
   placements:
     - src: master
       offset: [0, 0]
   upperleft: [0, 0]
-  map: |
-    Ω
+  map: ""

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

@@ -122,8 +122,7 @@ instance FromJSONE WorldParseDependencies WorldDescription where
       let placedStructures =
             map (offsetLoc $ coerce ul) staticStructurePlacements
 
-      let area = modifyLoc ((ul .-^) . asVector) mergedGrid
-
+      let area = modifyLoc ((ul .+^) . asVector) mergedGrid
       return $ WorldDescription {..}
 
 ------------------------------------------------------------

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

@@ -18,6 +18,7 @@ data AreaDimensions = AreaDimensions
   { rectWidth :: Int32
   , rectHeight :: Int32
   }
+  deriving (Show, Eq)
 
 getGridDimensions :: Grid a -> AreaDimensions
 getGridDimensions g = getAreaDimensions $ getRows g

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

@@ -22,6 +22,7 @@ import Data.Map qualified as M
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
+import Debug.Trace (trace)
 import Linear.Affine
 import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Area
@@ -122,10 +123,20 @@ overlayGridExpanded
   -- The 'childAdjustedOrigin' is the sum of origin adjustments
   -- to completely assemble some substructure.
   (PositionedGrid childAdjustedOrigin overlayArea) =
-    baseGrid <> positionedOverlay
+    trace
+      ( unwords
+          [ "Merging base grid at position"
+          , show $ gridPosition baseGrid
+          , "with overlay grid at position"
+          , show $ gridPosition positionedOverlay
+          ]
+      )
+      result
    where
+    result = baseGrid <> positionedOverlay
+
     reorientedOverlayCells = applyOrientationTransform orientation overlayArea
-    placementAdjustedByOrigin = (gridPosition baseGrid .+^ asVector yamlPlacementOffset) .-^ asVector childAdjustedOrigin
+    placementAdjustedByOrigin = yamlPlacementOffset .+^ asVector childAdjustedOrigin
     positionedOverlay = PositionedGrid placementAdjustedByOrigin reorientedOverlayCells
 
 -- * Validation

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

@@ -6,13 +6,18 @@
 -- Generic overlay operations on grids
 module Swarm.Game.Scenario.Topography.Structure.Overlay (
   PositionedGrid (..),
+
+  -- * Exported for unit tests
+  computeMergedArea,
+  OverlayPair (..),
 ) where
 
 import Control.Applicative
 import Data.Function (on)
 import Data.Int (Int32)
 import Data.Tuple (swap)
-import Linear
+import Debug.Trace (trace)
+import Linear hiding (trace)
 import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Grid
@@ -50,16 +55,27 @@ data SubsumingRect = SubsumingRect
   , _southeastCorner :: Location
   }
 
+getNorthwesternExtent :: Location -> Location -> Location
+getNorthwesternExtent (Location ulx1 uly1) (Location ulx2 uly2) =
+  Location westernMostX northernMostY
+ where
+  westernMostX = min ulx1 ulx2
+  northernMostY = max uly1 uly2
+
+getSoutheasternExtent :: Location -> Location -> Location
+getSoutheasternExtent (Location brx1 bry1) (Location brx2 bry2) =
+  Location easternMostX southernMostY
+ where
+  easternMostX = max brx1 brx2
+  southernMostY = min bry1 bry2
+
 -- | @r1 <> r2@ is the smallest rectangle that contains both @r1@ and @r2@.
 instance Semigroup SubsumingRect where
-  SubsumingRect (Location ulx1 uly1) (Location brx1 bry1)
-    <> SubsumingRect (Location ulx2 uly2) (Location brx2 bry2) =
-      SubsumingRect (Location westernMostX northernMostY) (Location easternMostX southernMostY)
-     where
-      westernMostX = min ulx1 ulx2
-      northernMostY = max uly1 uly2
-      easternMostX = max brx1 brx2
-      southernMostY = min bry1 bry2
+  SubsumingRect ul1 br1 <> SubsumingRect ul2 br2 =
+    SubsumingRect northwesternExtent southeasternExtent
+   where
+    northwesternExtent = getNorthwesternExtent ul1 ul2
+    southeasternExtent = getSoutheasternExtent br1 br2
 
 getSubsumingRect :: PositionedGrid a -> SubsumingRect
 getSubsumingRect (PositionedGrid loc g) =
@@ -79,7 +95,7 @@ zipGridRows ::
 zipGridRows dims (OverlayPair paddedBaseRows paddedOverlayRows) =
   mkGrid $ (pad2D paddedBaseRows . pad2D paddedOverlayRows) blankGrid
  where
-  -- Right-bias; that is, take the last non-empty value
+  -- Right-biased; that is, takes the last non-empty value
   pad2D = zipPadded $ zipPadded $ flip (<|>)
   blankGrid = getRows $ fillGrid dims empty
 
@@ -100,39 +116,56 @@ zipGridRows dims (OverlayPair paddedBaseRows paddedOverlayRows) =
 -- of the base layer.
 instance (Alternative f) => Semigroup (PositionedGrid (f a)) where
   a1@(PositionedGrid baseLoc baseGrid) <> a2@(PositionedGrid overlayLoc overlayGrid) =
-    PositionedGrid newOrigin combinedGrid
+    PositionedGrid newUpperLeftCornerPosition combinedGrid
    where
-    mergedSize = computeMergedArea $ OverlayPair a1 a2
+    mergedSize2 = computeMergedArea $ OverlayPair a1 a2
+    mergedSize =
+      trace
+        ( unwords
+            [ "Merged size for "
+            , show a1
+            , "and"
+            , show a2
+            , ":"
+            , show mergedSize2
+            ]
+        )
+        mergedSize2
     combinedGrid = zipGridRows mergedSize paddedOverlayPair
 
     -- 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) = 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).
-    -- We don't have to adjust the origin if the base layer lies
-    -- to the northwest of the overlay layer.
-    clampedDelta = V2 (min 0 deltaX) (max 0 deltaY)
-    newOrigin = baseLoc .-^ clampedDelta
+    upperLeftCornersDelta = overlayLoc .-. baseLoc
+
+    newUpperLeftCornerPosition = getNorthwesternExtent baseLoc overlayLoc
 
     paddedOverlayPair =
-      padSouthwest originDelta $
+      padNorthwest upperLeftCornersDelta $
         OverlayPair baseGrid overlayGrid
 
 -- | NOTE: We only make explicit grid adjustments for
 -- left/top padding.  Any padding that is needed on the right/bottom
 -- of either grid will be taken care of by the 'zipPadded' function.
 --
 -- TODO(#2004): The return type should be 'Grid'.
-padSouthwest ::
+--
+-- 'deltaX' and 'deltaY' refer to the positioning of the *overlay grid*
+-- relative to the *base grid*.
+-- A negative 'deltaY' means that the top edge of the overlay
+-- lies to the south of the top edge of the base grid.
+-- A positive 'deltaX' means that the left edge of the overlay
+-- lies to the east of the left edge of base grid.
+--
+-- We add padding to either the overlay grid or the base grid
+-- so as to align their upper-left corners.
+padNorthwest ::
   Alternative f =>
   V2 Int32 ->
   OverlayPair (Grid (f a)) ->
   OverlayPair [[f a]]
-padSouthwest (V2 deltaX deltaY) (OverlayPair baseGrid overlayGrid) =
+padNorthwest (V2 deltaX deltaY) (OverlayPair baseGrid overlayGrid) =
   OverlayPair paddedBaseGrid paddedOverlayGrid
  where
   prefixPadDimension delta f = f (padding <>)

test/unit/Main.hs

@@ -45,27 +45,43 @@ import Witch (from)
 
 main :: IO ()
 main = do
-  ms <- runExceptT classicGame0
-  case ms of
-    Left err -> assertFailure (from err)
-    Right s -> defaultMain (tests s)
+  defaultMain statelessTests
 
-tests :: AppState -> TestTree
-tests s =
+-- ms <- runExceptT classicGame0
+-- case ms of
+--   Left err -> assertFailure (from err)
+--   Right s -> defaultMain (stateDependentTests s)
+
+-- | Initializing an 'AppState' entails
+-- loading challenge scenarios, etc. from
+-- disk.  We might not want to do this, in
+-- case we inject a 'trace' somewhere in
+-- the code and want to minimize the noise.
+--
+-- So we keep this list separate from the stateless
+-- tests so we can easily comment it out.
+stateDependentTests :: AppState -> TestTree
+stateDependentTests s =
   testGroup
-    "Tests"
+    "Stateful tests"
+    [ testEval (s ^. gameState)
+    , testPedagogy (s ^. runtimeState)
+    , testNotification (s ^. gameState)
+    ]
+
+statelessTests :: TestTree
+statelessTests =
+  testGroup
+    "Stateless tests"
     [ testLanguagePipeline
     , testParse
     , testPrettyConst
     , testBoolExpr
     , testCommands
     , testHighScores
-    , testEval (s ^. gameState)
     , testRepl
     , testRequirements
-    , testPedagogy (s ^. runtimeState)
     , testInventory
-    , testNotification (s ^. gameState)
     , testOrdering
     , testOverlay
     , testMisc

test/unit/TestOverlay.hs

@@ -9,6 +9,7 @@ module TestOverlay where
 import Control.Monad (when)
 import Data.Text (Text)
 import Swarm.Game.Location
+import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Placement
 import Swarm.Game.Scenario.Topography.Structure
@@ -27,7 +28,6 @@ debugRenderGrid = True
 oneByOneGrid :: [[Int]]
 oneByOneGrid = [[0]]
 
-
 -- | Single row with two columns
 oneByTwoGrid :: [[Int]]
 oneByTwoGrid = [[5, 6]]
@@ -45,16 +45,12 @@ testOverlay =
     "Overlay"
     [ testGroup
         "Empty grids, base grid at origin"
-        [ -- Overlay is to the east and north of the base.
-          -- Therefore, the origin of the combined grid must
-          -- be adjusted southward to match its original position
-          -- in the base layer.
-          mkOriginTestCase "Southward" (Location 3 2) (Location 0 (-2))
+        [ mkOriginTestCase "Southward" (Location 3 2) (Location 0 2)
         , -- Overlay is to the west and south of the base.
           -- Therefore, the origin of the combined grid must
           -- be adjusted eastward to match its original position
           -- in the base layer.
-          mkOriginTestCase "Eastward" (Location (-7) (-1)) (Location 7 0)
+          mkOriginTestCase "Eastward" (Location (-7) (-1)) (Location (-7) 0)
         ]
     , testGroup
         "Overlay sequences"
@@ -65,13 +61,13 @@ testOverlay =
                 [ placeUnshifted "sibling1" (Location (-2) 0) twoByTwoGrid
                 , placeUnshifted "sibling2" (Location 0 0) oneByTwoGrid
                 ]
-                (Location 2 0)
+                (Location (-2) 0)
             , mkOverlaySequenceOriginTest
                 "first east of negative second"
                 [ placeUnshifted "sibling1" (Location 0 0) twoByTwoGrid
                 , placeUnshifted "sibling2" (Location (-2) 0) oneByTwoGrid
                 ]
-                (Location 2 0)
+                (Location (-2) 0)
             ]
         , testGroup
             "Vertical siblings"
@@ -80,13 +76,13 @@ testOverlay =
                 [ placeUnshifted "sibling1" (Location 0 2) twoByTwoGrid
                 , placeUnshifted "sibling2" (Location 0 0) oneByTwoGrid
                 ]
-                (Location 0 (-2))
+                (Location 0 2)
             , mkOverlaySequenceOriginTest
                 "first north of positive second"
                 [ placeUnshifted "sibling1" (Location 0 0) twoByTwoGrid
                 , placeUnshifted "sibling2" (Location 0 2) oneByTwoGrid
                 ]
-                (Location 0 (-2))
+                (Location 0 2)
             ]
         , testGroup
             "Nonzero local origin"
@@ -98,17 +94,43 @@ testOverlay =
             ]
         , testGroup
             "Northwesterly offset of first sibling"
-            [ mkOverlaySequenceOriginTest
+            [ --  testMergedSize
+              --   "test merged size"
+              --   (placeUnshifted "baseLayer" (Location 0 0) [[]])
+              --   (placeUnshifted "sibling1" (Location (-1) 1) oneByOneGrid)
+              --   (AreaDimensions 1 1)
+
+              -- , testMergedSize
+              --   "test merged size"
+              --   (place (Location 1 (-1)) "sibling1" (Location (-1) 1) oneByOneGrid)
+              --   (placeUnshifted "sibling2" (Location 0 0) twoByTwoGrid)
+              --   (AreaDimensions 3 3)
+              -- ,
+
+              mkOverlaySequenceOriginTest
                 "positive first south of second"
                 [ placeUnshifted "sibling1" (Location (-1) 1) oneByOneGrid
                 , placeUnshifted "sibling2" (Location 0 0) twoByTwoGrid
                 ]
-                (Location 1 (-1))
+                (Location (-1) 1)
             ]
         ]
     ]
 
 -- * Test construction
+testMergedSize ::
+  String ->
+  Placed (Maybe Int) ->
+  Placed (Maybe Int) ->
+  AreaDimensions ->
+  TestTree
+testMergedSize testLabel (Placed _ ns1) (Placed _ ns2) expectedArea =
+  testCase testLabel $ do
+    assertEqual "Merged area is wrong" expectedArea mergedSize
+ where
+  a1 = area $ structure ns1
+  a2 = area $ structure ns2
+  mergedSize = computeMergedArea $ OverlayPair a1 a2
 
 -- | Base layer is at the origin (0, 0).
 mkOriginTestCase ::
@@ -140,7 +162,6 @@ mkOverlaySequenceTest ::
   TestTree
 mkOverlaySequenceTest f testLabel overlays expectedBaseLoc =
   testCase testLabel $ do
-
     when debugRenderGrid $
       renderGridResult eitherResultGrid
 
@@ -158,7 +179,6 @@ mkOverlaySequenceTest f testLabel overlays expectedBaseLoc =
       overlays
       []
 
-
 getGridFromMergedStructure :: MergedStructure c -> PositionedGrid c
 getGridFromMergedStructure (MergedStructure g _ _) = g
 
@@ -194,6 +214,6 @@ place localOrigin theName placementOffset g =
 renderGridResult :: Either a (PositionedGrid (Maybe Int)) -> IO ()
 renderGridResult eitherResult = case eitherResult of
   Right pg -> do
-      print pg
-      print $ getRows $ gridContent pg
-  Left _ -> return ()
+    print pg
+    print $ getRows $ gridContent pg
+  Left _ -> return ()