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:
parent
eeafd0fa0e
commit
b68414c66b
2 changed files with 70 additions and 11 deletions
|
@ -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
|
||||||
|
|
|
@ -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 $
|
||||||
|
|
Loading…
Reference in a new issue