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