tweak newRandomBoard

This commit is contained in:
Sidharth Kulkarni 2026-05-03 14:10:20 -07:00
parent 140d6989ec
commit a26149c242
Signed by: skulk
SSH key fingerprint: SHA256:Jby+S9d1WmwqnXIrngHgccYNHz+cYquxN1zm3ym3Kbg

View file

@ -9,6 +9,7 @@ module Types.GameBoard where
import Data.Array
import Data.Binary.Builder (append)
import Data.Maybe (mapMaybe)
import Data.Tuple.Extra
import Display (Display, display)
import System.Random.Stateful (RandomGen)
import Types.BoardPosition
@ -34,21 +35,17 @@ select :: (GameMode mode) => BoardPosition -> BoardPosition -> GameBoard mode ->
select topLeft bottomRight MkGameBoard{board} =
mapMaybe (board !) (range (topLeft, bottomRight))
-- TODO: rewrite this with monadic RNG
newRandomBoard :: (RandomGen g, GameMode mode) => g -> mode -> Int -> Int -> (GameBoard mode, g)
newRandomBoard rng gameMode width height =
(MkGameBoard{width, height, gameMode, board = array (low, high) cellAssocList}, nextRng)
-- TODO: rewrite this with monadic RNG?
newRandomBoard :: (RandomGen g, GameMode mode) => mode -> Int -> Int -> g -> (GameBoard mode, g)
newRandomBoard gameMode width height rng =
(MkGameBoard{width, height, gameMode, board = array ixRange cellAssocList}, nextRng)
where
low = (0, 0)
high = (width - 1, height - 1)
ixRange = ((0, 0), (width - 1, height - 1))
(cellAssocList, nextRng) =
foldl'
( \(cur, rng') -> \ix ->
let (res, next) = gen gameMode rng' in ((ix, Just res) : cur, next)
)
(\(cur, rng') -> \ix -> first ((: cur) . (ix,) . Just) (gen gameMode rng'))
([], rng)
ixs
ixs = range (low, high)
(range ixRange)
instance (Display (Tile mode)) => Display (GameBoard mode) where
display MkGameBoard{width, height, board} =