module Minesweeper where import System.Random type Square = (Int, Int) type Grid = [[Bool]] data Board = Board { size :: Int , mines :: Grid , uncovered :: Grid , flagged :: Grid } instance Show Board where show b = printBoardGrid (mines b) -- -- 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 createBoard size mineRatio rng = Board size (seedGrid rng mineRatio (createGrid False size)) (createGrid False size) (createGrid False size) -- 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) -- -- Functions relating to seeding a grid with mines -- 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) 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 -- 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) -- N.B. (r,c) = (row, column) -- -- 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 | otherwise = error "square out of board bounds" -- 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 | otherwise = error "square out of board bounds" -- 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 | otherwise = error "square out of board bounds" -- returns True if the given square is flagged, otherwise False isFlagged :: Board -> Square -> Bool isFlagged b (r,c) | validSquare b (r,c) = (flagged b !! r) !! c | otherwise = error "square out of board bounds" -- 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 -- 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 -- returns the number of mines adjacent to the given square adjacentMines :: Board -> Square -> Int adjacentMines b s = sum $ map (boolToInt . hasMine b) $ adjacentSquares b s -- returns the number of flagged squares adjacent to the given square adjacentFlags :: Board -> Square -> Int adjacentFlags b s = sum $ map (boolToInt . isFlagged b) $ adjacentSquares b s -- returns the number of covered squares adjacent to the given square adjacentCovereds :: Board -> Square -> Int adjacentCovereds b s = sum $ map (boolToInt . isCovered b) $ adjacentSquares b s -- returns true if the given square is adjacent to a covered square adjacentToCovered :: Board -> Square -> Bool adjacentToCovered b s = adjacentCovereds b s > 0 -- returns a list of all the squares directly adjacent to the given square (using arithmetic) 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)] -- 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 gameWon b = all (hasMine b) (coveredSquares b) && not (any (hasMine b) (uncoveredSquares b)) -- returns a list of all squares on a board currently still covered coveredSquares :: Board -> [Square] coveredSquares b = matchingSquares 0 False (uncovered b) -- returns a list of all squares on a board currently uncovered uncoveredSquares :: Board -> [Square] uncoveredSquares b = matchingSquares 0 True (uncovered b) -- returns a list of all squares in a grid starting at the given row with the given boolean status matchingSquares :: Int -> Bool -> Grid -> [Square] matchingSquares _ _ [] = [] matchingSquares r status (row:rows) = matchingSquares' r 0 status row ++ matchingSquares (r+1) status rows -- returns a list of all squares in an individual row of a grid with the given boolean status 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 -- 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 = [] -- -- 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 squareAscii b s | gameWon b = "" | onEdge b s = "" | isCovered b s = "" | not (adjacentToCovered b s) = "" | otherwise = show $ adjacentMines b s -- 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 squareBgColour :: Board -> Square -> String 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" -- 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 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 = "" -- -- Functions for interacting with the board/making changes -- -- 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 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 -- 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 -- uncovers all squares given in a list uncoverAll :: Board -> [Square] -> Board uncoverAll b [] = b uncoverAll b (s:ss) = uncoverAll newB ss where newB = uncover b s -- toggles a square's flagged status flag :: Board -> Square -> Board 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) -- modifies the boolean status value of a given square in a given grid 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 -- -- Functions for turning a board into a string for debug purposes -- 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