module Hs2048.Game
( addRandomTile
, addRandomTiles
, hasWon
, isOver
, new
, randomEmptyIndex
, randomEmptyPoint
, randomTile
) where
import Data.Maybe (fromJust)
import qualified Hs2048.Board as B
import qualified Hs2048.Direction as D
import qualified Hs2048.Point as P
import qualified Hs2048.Settings as S
import qualified Hs2048.Tile as T
import qualified Hs2048.Vector as V
import qualified System.Random as R
addRandomTile :: R.RandomGen r => B.Board -> r -> (B.Board, r)
addRandomTile b r = case p of
Nothing -> (b, r)
_ -> (b', r'')
where
b' = B.set b t (fromJust p)
(p, r') = randomEmptyPoint b r
(t, r'') = randomTile r'
addRandomTiles :: R.RandomGen r => Int -> B.Board -> r -> (B.Board, r)
addRandomTiles 0 b r = (b, r)
addRandomTiles n b r = addRandomTiles (n 1) b' r'
where
(b', r') = addRandomTile b r
hasWon :: B.Board -> Bool
hasWon = any (any (maybe False (>= S.maxTile)))
isOver :: B.Board -> Bool
isOver b = cantMove && haveNoEmptyPoints
where
cantMove = not (any (B.canMove b) D.directions)
haveNoEmptyPoints = null (B.emptyPoints b)
new :: R.RandomGen r => r -> (B.Board, r)
new = addRandomTiles S.tiles (B.empty S.width S.height)
randomEmptyIndex :: R.RandomGen r => V.Vector -> r -> (Maybe Int, r)
randomEmptyIndex v r = if null is then (Nothing, r) else (Just i, r')
where
i = is !! x
(x, r') = R.randomR (0, length is 1) r
is = V.emptyIndexes v
randomEmptyPoint :: R.RandomGen r => B.Board -> r -> (Maybe P.Point, r)
randomEmptyPoint b r = if null ps then (Nothing, r) else (Just p, r')
where
p = ps !! x
(x, r') = R.randomR (0, length ps 1) r
ps = B.emptyPoints b
randomTile :: R.RandomGen r => r -> (T.Tile, r)
randomTile r = (Just n, r')
where
n = if (x :: Float) < 0.9 then 2 else 4
(x, r') = R.random r