Minesweeper/src/Minesweeper.hs

232 lines
9.6 KiB
Haskell
Raw Normal View History

module Minesweeper where
import System.Random
type Square = (Int, Int)
type Grid = [[Bool]]
data Board = Board { size :: Int
, mines :: Grid
, uncovered :: Grid
, flagged :: Grid
2021-01-28 21:39:11 +00:00
}
2021-01-30 21:21:27 +00:00
instance Show Board where
2021-01-31 20:17:24 +00:00
show b = printBoardGrid (mines b)
2021-01-30 21:21:27 +00:00
2021-01-30 16:04:02 +00:00
--
-- Functions related to creating and initialising a board
--
-- Creates a board given a size (width/height), mine ratio and random generator
createBoard :: Int -> Float -> StdGen -> Board
2021-01-30 16:04:02 +00:00
createBoard size mineRatio rng = Board size
(seedGrid rng mineRatio (createGrid False size))
(createGrid False size)
(createGrid False size)
2021-01-30 13:27:49 +00:00
-- Creates a 2D list of booleans of given size, initialised to given boolean
createGrid :: Bool -> Int -> Grid
createGrid b size = replicate size (replicate size b)
2021-01-30 16:04:02 +00:00
--
-- Functions relating to seeding a grid with mines
2021-01-30 16:04:02 +00:00
--
seedGrid :: StdGen -> Float -> Grid -> Grid
seedGrid _ _ [] = []
seedGrid rng p (l:ls) = newL : seedGrid rng2 p ls
where (rng1, rng2) = split rng
(newL, _) = seedList rng1 p l
seedList :: StdGen -> Float -> [Bool] -> ([Bool], StdGen)
2021-01-28 21:39:11 +00:00
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
2021-01-30 16:04:02 +00:00
-- returns True with probability p, otherwise False
2021-01-28 21:39:11 +00:00
weightedRandomBool :: StdGen -> Float -> (Bool, StdGen)
weightedRandomBool rng p = (generatedFloat <= p, newRng)
2021-01-31 20:54:08 +00:00
where (generatedFloat, newRng) = randomR (0.0, 1.0) rng
2021-01-30 16:04:02 +00:00
--
-- Functions for determing statuses and info on square(s)
-- N.B. (r,c) = (row, column)
2021-01-30 16:04:02 +00:00
--
2021-01-30 16:04:02 +00:00
-- returns True if the given square has a mine, otherwise False
hasMine :: Board -> Square -> Bool
hasMine b (r,c) | validSquare b (r,c) = (mines b !! r) !! c
2021-01-31 20:54:08 +00:00
| otherwise = error "square out of board bounds"
2021-01-30 16:04:02 +00:00
-- returns True if the given square is uncovered, otherwise False
isUncovered :: Board -> Square -> Bool
isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c
2021-01-31 20:54:08 +00:00
| otherwise = error "square out of board bounds"
2021-01-31 19:31:59 +00:00
-- returns True if the given square is covered, otherwise False
isCovered :: Board -> Square -> Bool
isCovered b (r,c) | validSquare b (r,c) = not $ (uncovered b !! r) !! c
2021-01-31 20:54:08 +00:00
| otherwise = error "square out of board bounds"
2021-01-31 19:31:59 +00:00
2021-01-30 16:04:02 +00:00
-- returns True if the given square is flagged, otherwise False
isFlagged :: Board -> Square -> Bool
2021-01-30 13:21:50 +00:00
isFlagged b (r,c) | validSquare b (r,c) = (flagged b !! r) !! c
2021-01-31 20:54:08 +00:00
| otherwise = error "square out of board bounds"
2021-01-30 16:04:02 +00:00
-- returns True if the given square is within the bounds of the board
validSquare :: Board -> Square -> Bool
validSquare b (r,c) = r >= 0 && c >= 0 && r < size b && c < size b
2021-01-30 16:04:02 +00:00
-- returns True if the given square is on the edge of the board
onEdge :: Board -> Square -> Bool
onEdge b (r,c) = r == 0 || c == 0 || r+1 == size b || c+1 == size b
2021-01-30 16:04:02 +00:00
-- returns the number of mines adjacent to the given square
adjacentMines :: Board -> Square -> Int
2021-01-31 20:54:08 +00:00
adjacentMines b s = sum $ map (boolToInt . hasMine b) $ adjacentSquares b s
2021-01-30 16:04:02 +00:00
2021-01-31 19:31:59 +00:00
-- returns the number of flagged squares adjacent to the given square
adjacentFlags :: Board -> Square -> Int
2021-01-31 20:54:08 +00:00
adjacentFlags b s = sum $ map (boolToInt . isFlagged b) $ adjacentSquares b s
2021-01-31 19:31:59 +00:00
-- returns the number of covered squares adjacent to the given square
adjacentCovereds :: Board -> Square -> Int
2021-01-31 20:54:08 +00:00
adjacentCovereds b s = sum $ map (boolToInt . isCovered b) $ adjacentSquares b s
2021-01-31 19:31:59 +00:00
2021-01-30 16:04:02 +00:00
-- returns true if the given square is adjacent to a covered square
adjacentToCovered :: Board -> Square -> Bool
2021-01-31 20:54:08 +00:00
adjacentToCovered b s = adjacentCovereds b s > 0
2021-01-30 16:04:02 +00:00
-- returns a list of all the squares directly adjacent to the given square (using arithmetic)
2021-01-31 20:54:08 +00:00
adjacentSquares :: Board -> Square -> [Square]
adjacentSquares b s = filter (validSquare b) $ adjacentSquares' s
adjacentSquares' (r,c) = [(r-1,c-1), (r-1,c), (r-1,c+1), (r,c-1), (r,c+1), (r+1,c-1), (r+1,c), (r+1,c+1)]
2021-01-30 16:04:02 +00:00
-- returns 1 for boolean True and 0 for Boolean false
boolToInt :: Bool -> Int
boolToInt x | x = 1
| otherwise = 0
-- returns true if the game has been won (all remaining covered squares have a mine)
gameWon :: Board -> Bool
2021-01-31 20:17:24 +00:00
gameWon b = all (hasMine b) (coveredSquares b) && not (any (hasMine b) (uncoveredSquares b))
2021-01-30 16:04:02 +00:00
-- returns a list of all squares on a board currently still covered
coveredSquares :: Board -> [Square]
2021-01-31 20:54:08 +00:00
coveredSquares b = matchingSquares 0 False (uncovered b)
2021-01-31 19:31:59 +00:00
-- returns a list of all squares on a board currently uncovered
uncoveredSquares :: Board -> [Square]
2021-01-31 20:54:08 +00:00
uncoveredSquares b = matchingSquares 0 True (uncovered b)
2021-01-31 19:31:59 +00:00
-- returns a list of all squares in a grid starting at the given row with the given boolean status
2021-01-31 20:17:24 +00:00
matchingSquares :: Int -> Bool -> Grid -> [Square]
matchingSquares _ _ [] = []
matchingSquares r status (row:rows) = matchingSquares' r 0 status row ++ matchingSquares (r+1) status rows
2021-01-31 19:31:59 +00:00
-- returns a list of all squares in an individual row of a grid with the given boolean status
2021-01-31 20:17:24 +00:00
matchingSquares' :: Int -> Int -> Bool -> [Bool] -> [Square]
matchingSquares' _ _ _ [] = []
matchingSquares' r c status (col:cols) | col == status = (r,c) : matchingSquares' r (c+1) status cols
| otherwise = matchingSquares' r (c+1) status cols
2021-01-31 19:31:59 +00:00
-- returns a list of all squares on a board
allSquares :: Board -> [Square]
allSquares b = allSquares' b 0 0
allSquares' (Board s m u f) r c | r < s && c < s = (r,c) : allSquares' (Board s m u f) r (c+1)
| r < s = allSquares' (Board s m u f) (r+1) 0
| otherwise = []
2021-01-30 16:04:02 +00:00
--
-- Functions for rendering a board to a UI
--
-- returns a string that should be shown in the given square for a UI render of the board
-- typically either blank or if bordering on covered squares: the number of adjacent mines
squareAscii :: Board -> Square -> String
2021-01-31 20:54:08 +00:00
squareAscii b s | gameWon b = ""
| onEdge b s = ""
| isCovered b s = ""
| not (adjacentToCovered b s) = ""
| otherwise = show $ adjacentMines b s
2021-01-30 16:04:02 +00:00
-- returns a string indicating the bg colour class for a given square for a UI render of the board
-- intended to be a used as a CSS class
2021-01-28 21:39:11 +00:00
squareBgColour :: Board -> Square -> String
2021-01-31 20:54:08 +00:00
squareBgColour b s | gameWon b && hasMine b s = "bg-blue"
| gameWon b = "bg-green"
| isUncovered b s && hasMine b s = "bg-red"
| isUncovered b s = "bg-light"
| isFlagged b s = "bg-yellow"
| otherwise = "bg-dark"
2021-01-30 16:04:02 +00:00
-- returns a string indicating the text colour class for a given square for a UI render of the board
-- intended to be a used as a CSS class
squareTextColour :: Board -> Square -> String
2021-01-31 20:54:08 +00:00
squareTextColour b s | hasMine b s = ""
| isFlagged b s = ""
| isUncovered b s && adjacentToCovered b s =
case adjacentMines b s of
0 -> "text-white"
1 -> "text-blue"
2 -> "text-green"
3 -> "text-red"
4 -> "text-purple"
5 -> "text-maroon"
6 -> "text-turquoise"
7 -> "text-black"
8 -> "text-gray"
| otherwise = ""
2021-01-30 16:04:02 +00:00
--
2021-01-31 20:54:08 +00:00
-- Functions for interacting with the board/making changes
2021-01-30 16:04:02 +00:00
--
2021-01-31 20:54:08 +00:00
-- uncovers a square, if the uncovered square has a mine: uncovers the entire board (lost)
-- otherwise, trigger the recursive uncover in case of 0 adjacent mines
uncover :: Board -> Square -> Board
2021-01-31 20:54:08 +00:00
uncover b s | not $ validSquare b s = b
| isUncovered b s = b
| hasMine b s = Board (size b) (mines b) (createGrid True (size b)) (flagged b)
| otherwise = uncoverRecurse
(Board (size b) (mines b) (modSquare (uncovered b) s True) (flagged b)) s
2021-01-28 21:39:11 +00:00
2021-01-31 20:54:08 +00:00
-- uncovers adjacent squares iff the square has zero adjacent mines
uncoverRecurse :: Board -> Square -> Board
uncoverRecurse b s | adjacentMines b s == 0 = uncoverAll b $ adjacentSquares b s
| otherwise = b
2021-01-28 21:39:11 +00:00
-- uncovers all squares given in a list
uncoverAll :: Board -> [Square] -> Board
uncoverAll b [] = b
2021-01-31 20:54:08 +00:00
uncoverAll b (s:ss) = uncoverAll newB ss where newB = uncover b s
2021-01-31 20:17:24 +00:00
-- toggles a square's flagged status
2021-01-30 13:21:50 +00:00
flag :: Board -> Square -> Board
2021-01-31 20:54:08 +00:00
flag b s | not $ validSquare b s = b
| isUncovered b s = b
| isFlagged b s = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) s False)
| otherwise = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) s True)
2021-01-31 20:17:24 +00:00
2021-01-31 20:54:08 +00:00
-- modifies the boolean status value of a given square in a given grid
2021-01-31 20:17:24 +00:00
modSquare :: Grid -> Square -> Bool -> Grid
modSquare grid (r,c) newStatus = let (rowsA, row : rowsB) = splitAt r grid
(cellsA, _ : cellsB) = splitAt c row
newRow = cellsA ++ newStatus : cellsB
in rowsA ++ newRow : rowsB
2021-01-30 13:21:50 +00:00
2021-01-30 16:04:02 +00:00
--
-- Functions for turning a board into a string for debug purposes
2021-01-30 16:04:02 +00:00
--
printBoardGrid :: Grid -> String
printBoardGrid [] = ""
printBoardGrid (l:ls) = printBoardLine l ++ "\n" ++ printBoardGrid ls
printBoardLine :: [Bool] -> String
printBoardLine [] = ""
printBoardLine (x:xs) = (if x then " x" else " .") ++ printBoardLine xs