Minesweeper/src/Minesweeper.hs

116 lines
4.4 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
} 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