module Minesweeper where import System.Random type Square = (Int, Int) type Grid = [[Bool]] 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 createBoard size mineRatio rng = Board size (seedGrid rng mineRatio (createGrid size)) (createGrid size) (createGrid size) -- Creates a 2D list of booleans of given size, initialised to False createGrid :: Int -> Grid createGrid size = replicate size (replicate size False) -- 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 : seedList2 newRng p ls, newRng) where (newBool, newRng) = randomlyTrue 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) where (generatedFloat, newRng) = randomR (0.0, 1.0) rng -- Functions for determing statuses and info on square(s) -- N.B. (r,c) = (row, column) hasMine :: Board -> Square -> Bool hasMine b (r,c) | validSquare b (r,c) = (mines b !! r) !! c | otherwise = False isUncovered :: Board -> Square -> Bool isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c | otherwise = False isFlagged :: Board -> Square -> Bool isFlagged b (r,c) = (flagged b !! r) !! c validSquare :: Board -> Square -> Bool validSquare b (r,c) = r >= 0 && c >= 0 && r < size b && c < size b squareAscii :: Board -> Square -> String squareAscii b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "X" | isUncovered b (r,c) = show $ adjacentBombs b (r,c) -- remove this for production | adjacentToUncovered b (r,c) = show $ adjacentBombs 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" adjacentBombs :: Board -> Square -> Int adjacentBombs b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c) adjacentToUncovered :: Board -> Square -> Bool adjacentToUncovered b (r,c) = any (isUncovered b) $ adjacentSquares (r,c) 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)] boolToInt :: Bool -> Int boolToInt x | x = 1 | otherwise = 0 -- Functions for changing the status of square(s) uncover :: Board -> Square -> Board uncover b (r,c) | not $ validSquare b (r,c) = b | isUncovered b (r,c) = b | 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 uncoverSafeAdjacents (Board s m newRows f) (r,c) uncoverSafeAdjacents :: Board -> Square -> Board uncoverSafeAdjacents b (r,c) | adjacentBombs b (r,c) == 0 = uncoverSafe b $ adjacentSquares (r,c) | otherwise = b uncoverSafe :: Board -> [Square] -> Board uncoverSafe b [] = b uncoverSafe b ((r,c):xs) | adjacentBombs b (r,c) == 0 = uncoverSafe (uncover b (r,c)) xs | otherwise = uncoverSafe b xs -- 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