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 = printBoard 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 = False -- 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 = True -- We return True when the requested square does not exist as a useful -- hack so that adjacent mine numbers are not shown on the edge of the -- board grid -- 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 = False -- 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 = False -- 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 (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c) -- returns the number of flagged squares adjacent to the given square adjacentFlags :: Board -> Square -> Int adjacentFlags b (r,c) = sum $ map (boolToInt . isFlagged b) $ adjacentSquares (r,c) -- returns the number of covered squares adjacent to the given square adjacentCovereds :: Board -> Square -> Int adjacentCovereds b (r,c) = sum $ map (boolToInt . isCovered b) $ adjacentSquares (r,c) -- returns true if the given square is adjacent to a covered square adjacentToCovered :: Board -> Square -> Bool adjacentToCovered b (r,c) = not $ all (isUncovered b) $ adjacentSquares (r,c) -- returns a list of all the squares directly adjacent to the given square (using arithmetic) adjacentSquares :: Square -> [Square] 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) -- returns a list of all squares on a board currently still covered coveredSquares :: Board -> [Square] coveredSquares (Board _ _ u _) = booleanSquares 0 False u -- returns a list of all squares on a board currently uncovered uncoveredSquares :: Board -> [Square] uncoveredSquares (Board _ _ u _) = booleanSquares 0 True u -- returns a list of all squares in a grid starting at the given row with the given boolean status booleanSquares :: Int -> Bool -> Grid -> [Square] booleanSquares _ _ [] = [] booleanSquares r status (row:rows) = booleanSquares' r 0 status row ++ booleanSquares (r+1) status rows -- returns a list of all squares in an individual row of a grid with the given boolean status booleanSquares' :: Int -> Int -> Bool -> [Bool] -> [Square] booleanSquares' _ _ _ [] = [] booleanSquares' r c status (col:cols) | col == status = (r,c) : booleanSquares' r (c+1) status cols | otherwise = booleanSquares' 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 (r,c) | gameWon b = "" | isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c) | otherwise = "" -- 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 (r,c) | gameWon b && hasMine b (r,c) = "bg-red" | gameWon b = "bg-green" | isUncovered b (r,c) && hasMine b (r,c) = "bg-red" | isUncovered b (r,c) = "bg-light" | isFlagged b (r,c) = "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 (r,c) | hasMine b (r,c) || isFlagged b (r,c) = "" | isUncovered b (r,c) && adjacentToCovered b (r,c) = case adjacentMines b (r,c) of 1 -> "text-blue" 2 -> "text-green" 3 -> "text-red" 4 -> "text-purple" 5 -> "text-maroon" 6 -> "text-turquoise" 7 -> "text-black" 8 -> "text-gray" _ -> "text-black" | otherwise = "text-black" -- -- 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 | hasMine b (r,c) = let Board s m u f = b in Board s m (createGrid True s) f | otherwise = let Board s m u f = b (rowsA, row : rowsB) = splitAt r u (cellsA, _ : cellsB) = splitAt c row 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) | 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) -- marks a square as flagged flag :: Board -> Square -> Board flag b (r,c) | not $ validSquare b (r,c) = b | isUncovered b (r,c) = b | isFlagged b (r,c) = b | otherwise = let Board s m u f = b (rowsA, row : rowsB) = splitAt r f (cellsA, _ : cellsB) = splitAt c row newRow = cellsA ++ True : cellsB newRows = rowsA ++ newRow : rowsB in Board s m u newRows -- -- Functions for turning a board into a string for debug purposes -- printBoard :: Board -> String printBoard b = printBoardGrid (mines b) 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