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

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
This commit is contained in:
Griffin Smith 2021-11-06 13:20:26 -04:00 committed by grfn
parent eeafd0fa0e
commit b68414c66b
2 changed files with 70 additions and 11 deletions

View file

@ -52,13 +52,18 @@ initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s)
initializeEmpty dims = initializeEmpty dims =
lift $ newArray (0, V2 (dims ^. width) (dims ^. height)) False 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 numAliveNeighborsM
:: forall a i m :: forall a i m
. (MArray a Bool m, Ix i, Integral i) . (MArray a Bool m, Ix i, Integral i)
=> a (V2 i) Bool => a (V2 i) Bool
-> V2 i -> V2 i
-> m Word -> m Word
numAliveNeighborsM cells (V2 x y) = do numAliveNeighborsM cells pt@(V2 x y) = do
cellBounds <- getBounds cells cellBounds <- getBounds cells
getSum <$> foldlMapM' getSum <$> foldlMapM'
(fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds) (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds)
@ -66,24 +71,32 @@ numAliveNeighborsM cells (V2 x y) = do
where where
boundedGet :: (V2 i, V2 i) -> (Int, Int) -> m Bool 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) boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
| x <= minX | (x <= minX && i < 0)
|| y <= minY || (y <= minY && j < 0)
|| x >= maxX || (x >= maxX && i > 0)
|| y >= maxY || (y >= maxY && j > 0)
= pure True = pure True
| otherwise = | otherwise =
let nx = fromIntegral $ fromIntegral x + i let nx = fromIntegral $ fromIntegral x + i
ny = fromIntegral $ fromIntegral y + j ny = fromIntegral $ fromIntegral y + j
in readArray cells $ V2 nx ny 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 numAliveNeighbors
:: forall a i :: forall a i
. (IArray a Bool, Ix i, Integral i) . (IArray a Bool, Ix i, Integral i)
=> a (V2 i) Bool => a (V2 i) Bool
-> V2 i -> V2 i
-> Word -> Word
numAliveNeighbors cells (V2 x y) = numAliveNeighbors cells pt@(V2 x y) =
let cellBounds = bounds cells let cellBounds = bounds cells
in getSum $ foldMap in getSum $ foldMap
(Sum . fromIntegral . fromEnum . boundedGet cellBounds) (Sum . fromIntegral . fromEnum . boundedGet cellBounds)
@ -91,11 +104,14 @@ numAliveNeighbors cells (V2 x y) =
where where
boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool
boundedGet bnds _
| not (inRange bnds pt)
= True
boundedGet (V2 minX minY, V2 maxX maxY) (i, j) boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
| x <= minX | (x <= minX && i < 0)
|| y <= minY || (y <= minY && j < 0)
|| x >= maxX || (x >= maxX && i > 0)
|| y >= maxY || (y >= maxY && j > 0)
= True = True
| otherwise = | otherwise =
let nx = fromIntegral $ fromIntegral x + i let nx = fromIntegral $ fromIntegral x + i

View file

@ -6,7 +6,7 @@ import Test.Prelude
import System.Random (mkStdGen) import System.Random (mkStdGen)
import Control.Monad.Random (runRandT) import Control.Monad.Random (runRandT)
import Data.Array.ST (STUArray, runSTUArray, thaw) 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.MArray (newArray, readArray, writeArray)
import Data.Array (Array, range, listArray, Ix) import Data.Array (Array, range, listArray, Ix)
import Control.Monad.ST (ST, runST) import Control.Monad.ST (ST, runST)
@ -15,6 +15,7 @@ import Linear.V2
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Util import Xanthous.Util
import Xanthous.Data (width, height) import Xanthous.Data (width, height)
--------------------------------------------------------------------------------
import Xanthous.Generators.Level.Util import Xanthous.Generators.Level.Util
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -57,6 +58,30 @@ test = testGroup "Xanthous.Generators.Util"
numAliveNeighborsM mArr loc numAliveNeighborsM mArr loc
res = runST act res = runST act
in counterexample (show res) $ between 0 8 res 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" , testGroup "numAliveNeighbors"
[ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $ [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $
@ -68,6 +93,24 @@ test = testGroup "Xanthous.Generators.Util"
numAliveNeighborsM mArr loc numAliveNeighborsM mArr loc
res = runST act res = runST act
in numAliveNeighbors arr loc === res 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" , testGroup "cloneMArray"
[ testCase "clones the array" $ runST $ [ testCase "clones the array" $ runST $