Code cleanup and renamings
This commit is contained in:
parent
1f9f56f04c
commit
4d80480c65
14
src/Main.hs
14
src/Main.hs
|
@ -22,10 +22,7 @@ setup w = void $ do
|
|||
UI.addStyleSheet w "minesweeper.css"
|
||||
|
||||
rng <- liftIO newStdGen
|
||||
--let board = createBoard 10 0.2 rng
|
||||
let board = uncover (createBoard 30 0.1 rng) (4,4)
|
||||
--let board = uncoverSafeAdjacents board (4,4)
|
||||
--let board = uncoverSafe board [(3,4)]
|
||||
let board = uncover (createBoard 30 0.15 rng) (4,4)
|
||||
|
||||
getBody w #+ [
|
||||
UI.div #. "container" #+ [
|
||||
|
@ -38,11 +35,12 @@ gameGridTable :: Board -> UI Element
|
|||
gameGridTable b = mkElement "table" #+ rows b
|
||||
|
||||
rows :: Board -> [UI Element]
|
||||
rows b = rows2 b 0
|
||||
rows2 b r | r < size b = (mkElement "tr" #+ cells b r) : rows2 b (r+1)
|
||||
rows b = rows' b 0
|
||||
rows' b r | r < size b = (mkElement "tr" #+ cells b r) : rows' b (r+1)
|
||||
| otherwise = []
|
||||
|
||||
cells :: Board -> Int -> [UI Element]
|
||||
cells b r = cells2 b r 0
|
||||
cells2 b r c | c < size b = mkElement "td" #. (squareColour b (r,c) ++ " " ++ squareTextColour b (r,c)) #+ [string $ squareAscii b (r,c)] : cells2 b r (c+1)
|
||||
cells b r = cells' b r 0
|
||||
cells' b r c | c < size b = mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
|
||||
#+ [string $ squareAscii b (r,c)] : cells' b r (c+1)
|
||||
| otherwise = []
|
|
@ -9,7 +9,7 @@ data Board = Board { size :: Int
|
|||
, mines :: Grid
|
||||
, uncovered :: Grid
|
||||
, flagged :: Grid
|
||||
} deriving (Show)
|
||||
}
|
||||
|
||||
-- Creates a board given a size (width/height), mine ratio and random generator
|
||||
createBoard :: Int -> Float -> StdGen -> Board
|
||||
|
@ -28,16 +28,16 @@ seedGrid rng p (l:ls) = newL : seedGrid rng2 p ls
|
|||
(newL, _) = seedList rng1 p l
|
||||
|
||||
seedList :: StdGen -> Float -> [Bool] -> ([Bool], StdGen)
|
||||
seedList rng p (l:ls) = (newBool : seedList2 newRng p ls, newRng)
|
||||
where (newBool, newRng) = randomlyTrue rng p
|
||||
seedList rng p (l:ls) = (newBool : seedList' newRng p ls, newRng)
|
||||
where (newBool, newRng) = weightedRandomBool rng p
|
||||
seedList' :: StdGen -> Float -> [Bool] -> [Bool]
|
||||
seedList' _ _ [] = []
|
||||
seedList' rng p (l:ls) = newBool : seedList' newRng p ls
|
||||
where (newBool, newRng) = weightedRandomBool rng p
|
||||
|
||||
seedList2 :: StdGen -> Float -> [Bool] -> [Bool]
|
||||
seedList2 _ _ [] = []
|
||||
seedList2 rng p (l:ls) = newBool : seedList2 newRng p ls
|
||||
where (newBool, newRng) = randomlyTrue rng p
|
||||
|
||||
randomlyTrue :: StdGen -> Float -> (Bool, StdGen)
|
||||
randomlyTrue rng p = (generatedFloat <= p, newRng)
|
||||
-- Returns true with probability p, otherwise false
|
||||
weightedRandomBool :: StdGen -> Float -> (Bool, StdGen)
|
||||
weightedRandomBool rng p = (generatedFloat <= p, newRng)
|
||||
where (generatedFloat, newRng) = randomR (0.0, 1.0) rng
|
||||
|
||||
-- Functions for determing statuses and info on square(s)
|
||||
|
@ -62,17 +62,17 @@ onEdge b (r,c) = r == 0 || c == 0 || r+1 == size b || c+1 == size b
|
|||
|
||||
squareAscii :: Board -> Square -> String
|
||||
squareAscii b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "X"
|
||||
| isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentBombs b (r,c)
|
||||
| isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c)
|
||||
| otherwise = ""
|
||||
|
||||
squareColour :: Board -> Square -> String
|
||||
squareColour b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "bomb"
|
||||
| isUncovered b (r,c) = "uncovered"
|
||||
| otherwise = "covered"
|
||||
squareBgColour :: Board -> Square -> String
|
||||
squareBgColour b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "bomb"
|
||||
| isUncovered b (r,c) = "uncovered"
|
||||
| otherwise = "covered"
|
||||
|
||||
squareTextColour :: Board -> Square -> String
|
||||
squareTextColour b (r,c) | isUncovered b (r,c) && adjacentToCovered b (r,c) =
|
||||
case adjacentBombs b (r,c) of
|
||||
case adjacentMines b (r,c) of
|
||||
1 -> "text-blue"
|
||||
2 -> "text-green"
|
||||
3 -> "text-red"
|
||||
|
@ -83,8 +83,8 @@ squareTextColour b (r,c) | isUncovered b (r,c) && adjacentToCovered b (r,c) =
|
|||
8 -> "text-gray"
|
||||
| otherwise = ""
|
||||
|
||||
adjacentBombs :: Board -> Square -> Int
|
||||
adjacentBombs b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
|
||||
adjacentMines :: Board -> Square -> Int
|
||||
adjacentMines b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
|
||||
|
||||
adjacentToCovered :: Board -> Square -> Bool
|
||||
adjacentToCovered b (r,c) = not $ all (isUncovered b) $ adjacentSquares (r,c)
|
||||
|
@ -98,6 +98,8 @@ boolToInt x | x = 1
|
|||
|
||||
-- Functions for changing the status of square(s)
|
||||
|
||||
-- uncovers a square and recursively uncovers adjacent squares iff the square has zero adjacent mines
|
||||
-- N.B. not very efficient due to lots of splitting and remerging
|
||||
uncover :: Board -> Square -> Board
|
||||
uncover b (r,c) | not $ validSquare b (r,c) = b
|
||||
| isUncovered b (r,c) = b
|
||||
|
@ -107,11 +109,12 @@ uncover b (r,c) | not $ validSquare b (r,c) = b
|
|||
newRow = cellsA ++ True : cellsB
|
||||
newRows = rowsA ++ newRow : rowsB
|
||||
in uncoverAdjacentsIfSafe (Board s m newRows f) (r,c)
|
||||
|
||||
|
||||
uncoverAdjacentsIfSafe :: Board -> Square -> Board
|
||||
uncoverAdjacentsIfSafe b (r,c) | adjacentBombs b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
|
||||
uncoverAdjacentsIfSafe b (r,c) | adjacentMines b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
|
||||
| otherwise = b
|
||||
|
||||
-- uncovers all squares given in a list
|
||||
uncoverAll :: Board -> [Square] -> Board
|
||||
uncoverAll b [] = b
|
||||
uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c)
|
||||
|
|
Loading…
Reference in New Issue