fix(gs/xanthous): Fix numAliveNeighbors{,M} on the edge r/3012

numAliveNeighbors was doing bounds checks too aggressively, resulting in
always returning 8 for points on the edge, meaning walls weren't getting
properly created for those points, making edges of the map open to walk
through.

Change-Id: Iada6be46ce7cc77ce99a320b7310008898b89273
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3805
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

2 files changed, 70 insertions, 11 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs
index c64377817939..0008eb965c42 100644
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs
+++ b/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs
@@ -52,13 +52,18 @@ initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s)
 initializeEmpty dims =
   lift $ newArray (0, V2 (dims ^. width) (dims ^. height)) False
 
+-- | Returns the number of neighbors of the given point in the given array that
+-- are True.
+--
+-- Behavior if point is out-of-bounds for the array is undefined, but will not
+-- error
 numAliveNeighborsM
   :: forall a i m
   . (MArray a Bool m, Ix i, Integral i)
   => a (V2 i) Bool
   -> V2 i
   -> m Word
-numAliveNeighborsM cells (V2 x y) = do
+numAliveNeighborsM cells pt@(V2 x y) = do
   cellBounds <- getBounds cells
   getSum <$> foldlMapM'
     (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds)
@@ -66,24 +71,32 @@ numAliveNeighborsM cells (V2 x y) = do
 
   where
     boundedGet :: (V2 i, V2 i) -> (Int, Int) -> m Bool
+    boundedGet bnds _
+      | not (inRange bnds pt)
+      = pure True
     boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
-      | x <= minX
-        || y <= minY
-        || x >= maxX
-        || y >= maxY
+      | (x <= minX && i < 0)
+      || (y <= minY && j < 0)
+      || (x >= maxX && i > 0)
+      || (y >= maxY && j > 0)
       = pure True
       | otherwise =
         let nx = fromIntegral $ fromIntegral x + i
             ny = fromIntegral $ fromIntegral y + j
         in readArray cells $ V2 nx ny
 
+-- | Returns the number of neighbors of the given point in the given array that
+-- are True.
+--
+-- Behavior if point is out-of-bounds for the array is undefined, but will not
+-- error
 numAliveNeighbors
   :: forall a i
   . (IArray a Bool, Ix i, Integral i)
   => a (V2 i) Bool
   -> V2 i
   -> Word
-numAliveNeighbors cells (V2 x y) =
+numAliveNeighbors cells pt@(V2 x y) =
   let cellBounds = bounds cells
   in getSum $ foldMap
       (Sum . fromIntegral . fromEnum . boundedGet cellBounds)
@@ -91,11 +104,14 @@ numAliveNeighbors cells (V2 x y) =
 
   where
     boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool
+    boundedGet bnds _
+      | not (inRange bnds pt)
+      = True
     boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
-      | x <= minX
-        || y <= minY
-        || x >= maxX
-        || y >= maxY
+      | (x <= minX && i < 0)
+      || (y <= minY && j < 0)
+      || (x >= maxX && i > 0)
+      || (y >= maxY && j > 0)
       = True
       | otherwise =
         let nx = fromIntegral $ fromIntegral x + i
diff --git a/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs b/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs
index 2d70a55e88bc..b53c657f7559 100644
--- a/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs
+++ b/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs
@@ -6,7 +6,7 @@ import Test.Prelude
 import System.Random (mkStdGen)
 import Control.Monad.Random (runRandT)
 import Data.Array.ST (STUArray, runSTUArray, thaw)
-import Data.Array.IArray (bounds)
+import Data.Array.IArray (bounds, array)
 import Data.Array.MArray (newArray, readArray, writeArray)
 import Data.Array (Array, range, listArray, Ix)
 import Control.Monad.ST (ST, runST)
@@ -15,6 +15,7 @@ import Linear.V2
 --------------------------------------------------------------------------------
 import Xanthous.Util
 import Xanthous.Data (width, height)
+--------------------------------------------------------------------------------
 import Xanthous.Generators.Level.Util
 --------------------------------------------------------------------------------
 
@@ -57,6 +58,30 @@ test = testGroup "Xanthous.Generators.Util"
             numAliveNeighborsM mArr loc
           res = runST act
         in counterexample (show res) $ between 0 8 res
+    , testCase "on the outer x edge" $
+      let act :: forall s. ST s Word
+          act = do
+            cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word)
+              (V2 0 0, V2 2 2)
+              [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
+              , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
+              , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
+              ]
+            numAliveNeighborsM cells (V2 0 1)
+          res = runST act
+      in res @?= 7
+    , testCase "on the outer y edge" $
+      let act :: forall s. ST s Word
+          act = do
+            cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word)
+              (V2 0 0, V2 2 2)
+              [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
+              , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
+              , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
+              ]
+            numAliveNeighborsM cells (V2 1 0)
+          res = runST act
+      in res @?= 6
     ]
   , testGroup "numAliveNeighbors"
     [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $
@@ -68,6 +93,24 @@ test = testGroup "Xanthous.Generators.Util"
             numAliveNeighborsM mArr loc
           res = runST act
         in numAliveNeighbors arr loc === res
+    , testCase "on the outer x edge" $
+      let cells =
+            array @Array @Bool @(V2 Word)
+            (V2 0 0, V2 2 2)
+            [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
+            , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
+            , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
+            ]
+      in numAliveNeighbors cells (V2 0 1) @?= 7
+    , testCase "on the outer y edge" $
+      let cells =
+            array @Array @Bool @(V2 Word)
+            (V2 0 0, V2 2 2)
+            [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
+            , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
+            , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
+            ]
+      in numAliveNeighbors cells (V2 1 0) @?= 6
     ]
   , testGroup "cloneMArray"
       [ testCase "clones the array" $ runST $