235 lines
9.8 KiB
Haskell
235 lines
9.8 KiB
Haskell
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 |