jack
/
Minesweeper
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: jack:6860d44700831bfe3d0a39fdb771a7972348e668
Branches Tags
jack:master
..
compare: jack:05eeaae01aab662580343a8222d3c5d46c017b9a
Branches Tags
jack:master

No commits in common. "6860d44700831bfe3d0a39fdb771a7972348e668" and "05eeaae01aab662580343a8222d3c5d46c017b9a" have entirely different histories.
6860d44700 ... 05eeaae01a

11 changed files with 85 additions and 624 deletions
Show Stats Expand all files Collapse all files

7
.gitignore vendored
View File

@ -1,6 +1 @@
.stack-work
report/*.aux
report/*.log
report/*.synctex.gz
report/*.toc
report/*.out
.stack-work

1
Minesweeper.cabal
View File

@ -20,7 +20,6 @@ extra-source-files:
executable Minesweeper
main-is: Main.hs
other-modules:
Autosolver
Minesweeper
Paths_Minesweeper
hs-source-dirs:

BIN
report/autoplay.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 9.1 KiB

BIN
report/report.pdf
View File

Binary file not shown.

312
report/report.tex
View File

@ -1,312 +0,0 @@
\documentclass[11pt]{article}
\usepackage[margin=0.5in]{geometry}
\usepackage{titling}
\usepackage{listings}
\usepackage{graphicx}
\usepackage{xcolor}
\usepackage{url}
\usepackage{enumitem}
\usepackage{hyperref}
\definecolor{lightblue}{RGB}{0,130,186}
\definecolor{darkgreen}{RGB}{0,114,0}
\definecolor{darkpurple}{RGB}{125,0,183}
\lstset{
language=Haskell,
tabsize=4,
basicstyle=\color{black}\footnotesize\ttfamily,
keywordstyle=\color{blue}\footnotesize\ttfamily, % style for keywords
identifierstyle=\color{purple}\footnotesize\ttfamily,
commentstyle=\color{lightblue}\footnotesize\ttfamily,
numbers=left, % where to put the line-numbers
numberstyle=\footnotesize\ttfamily, % the size of the fonts that are used for the line-numbers
showstringspaces=false
}
\hypersetup{
colorlinks,
citecolor=black,
filecolor=black,
linkcolor=black,
urlcolor=black
}
\setlength{\droptitle}{-5em}
\setlength{\parindent}{0cm}
\setlength{\righthyphenmin}{62}
\setlength{\lefthyphenmin}{62}
\title{CSU44012 Topics in Functional Programming\\Assignment \#2\\Minesweeper}
\author{Jack Harley jharley@tcd.ie | Student No. 16317123}
\date{January 2021}
\begin{document}
\maketitle
\includegraphics[width=12cm]{screenshot.png} \qquad \includegraphics[width=4cm]{autoplay.png}
\tableofcontents
\newpage
\setlength{\parskip}{1em}
\section{Introduction}
I have implemented a fully functional Minesweeper game in Haskell with the Threepenny GUI serving the interface, and also an autosolver/autoplayer which can perform a move by clicking an "Autoplay" button.
The code is well commented and I have also documented and explained key parts of it in this PDF.
Stack successfully builds and executes the solution binary, serving the GUI at \url{http://localhost:8023}.
I attempted to integrate it into an Electron application, so that the interface would launch automatically into an Electron window (embedded Chrome, see \url{https://www.electronjs.org/}) but unfortunately realized partway through that the effort required to get it working was likely to be disproportionate to the improvement in functionality.
\section{Design and Implementation}
I will cover a few of the more important functions in some detail in this section. The comments included in the source files should be sufficient to explain the simpler function.
\subsection{Basic Minesweeper Model}
The model for the game is implemented in Minesweeper.hs.
I modelled the game board as an ADT with 4 fields:
\begin{lstlisting}
data Board = Board { size :: Int, mines :: Grid, uncovered :: Grid, flagged :: Grid }
\end{lstlisting}
\textbf{size} defines the horizontal and vertical length in squares of the game grid (all grids are squares).
\textbf{mines}, \textbf{uncovered} and \textbf{flagged} hold data structures that respectively indicate the squares that have mines, have been uncovered by the user and have been flagged by the user.
The Grid type is a 2D list of Booleans with the outer list denoting rows and the inner list denoting columns:
\begin{lstlisting}
type Grid = [[Bool]]
\end{lstlisting}
With this structure, you can determine whether the 2nd row down, 4th column across has a mine with the following simple expression: (N.B. rows and columns are 0-indexed)
\begin{lstlisting}
(mines !! 1) !! 3
\end{lstlisting}
And indeed this is how the hasMine function is implemented in my code:
\begin{lstlisting}
hasMine :: Board -> Square -> Bool
hasMine b (r,c) | validSquare b (r,c) = (mines b !! r) !! c
\end{lstlisting}
Throughout my implementation, particular squares are referred to with a 2-tuple defining first the row and then the column as 0-indexed integers, with (0,0) being the square at the top left of the board:
\begin{lstlisting}
type Square = (Int, Int)
\end{lstlisting}
\newpage
\subsection{Creating a Game}
A fresh game board is initialised with the createBoard function:
\begin{lstlisting}
createBoard :: Int -> Float -> StdGen -> Board
createBoard size mineRatio rng = Board size (seedGrid rng mineRatio (createGrid False size))
(createGrid False size)
(createGrid False size)
\end{lstlisting}
The function requires a size (number of squares in both horizontal and vertical directions), a "mine ratio" and a random number generator instance. It then produces a Board instance with three initialised grids. The uncovered and flagged grids are initialised with all False values (since the user will not have uncovered or flagged any squares yet).
The mines grid is initialised with all False values, but then the seedGrid function is used to randomly seed mines into the grid by making a random decision with probability of the provided mineRatio for every square on the grid.
For example, with a mine ratio of 0.1, every square will have a one in ten chance of having a mine, and after the decisions have been made for every square, roughly one tenth of the grid will have mines.
seedGrid works by splitting the random number generator repeatedly, one instance for each row of the grid, and then calling seedList on each row. The seeded rows are then joined back together at the end of the recursion. The full source for seedGrid, seedList and seedList' can be found in the appendix and project files.
\subsection{Handling Game Moves}
\subsubsection{Uncover}
Uncover is triggered in the UI by left clicking on a square. It triggers the following function:
\begin{lstlisting}
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
\end{lstlisting}
The first guard handles cases where the provided Square is not valid (lies outside the edge of the Board), in this case, the Board is returned unchanged.
The second guard handles cases where the provided Square is already uncovered, and again the board is returned unchanged.
The third guard handles cases where a user clicks on a mine. In this case the game has ended and the player has lost, therefore the function simply replaces the uncovered Grid with an all True Grid. The user will therefore immediately see the entire grid, including all of the mines.
The final guard handles normal cases where the Square clicked is safe. It reconstructs the uncovered Grid, replacing the Square at s with a True status using the modSquare function. It then also calls the uncoverRecurse function on the modified Board:
\newpage
\begin{lstlisting}
uncoverRecurse :: Board -> Square -> Board
uncoverRecurse b s | adjacentMines b s == 0 = uncoverAll b $ adjacentSquares b s
| otherwise = b
\end{lstlisting}
uncoverRecurse checks if the newly uncovered Square has 0 adjacent mines, and if so, uncovers all of them. This can trigger recursion where large parts of the Board will be uncovered.
\subsubsection{Flag}
Flag is triggered in the UI by right clicking on a square. It is intended to be used when a user wants to mark a square they think has a mine. It functions as a toggle, so a user can also unflag a square. It triggers the following function:
\begin{lstlisting}
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)
\end{lstlisting}
Flag works similarly to uncover.
If the square is not valid or already uncovered then the board is returned unchanged. If the square is already flagged then we toggle it to unflagged, and if it doesn't match any of the guards then we toggle it to flagged.
\subsection{Program Startup}
The entry point for the program is the main function. It calls startGUI with the setup function as a parameter. ThreePenny then initialises using the setup function.
Setup registers two stylesheets: the minified bootstrap.min.css I use in all of my web related projects and a minesweeper.css file I wrote to give some styling to the page and the game board.
Setup then creates a new pseudo random number generator and initialises a new game board. It then stores the game board state into a global IORef. This IORef will be modified when updating state due to a user action, and read from during a re-render of the board. The unwrapped Board instance (b) is also maintained and passed to the rendering functions for the initial render:
\begin{lstlisting}
rng <- liftIO newStdGen
let b = createBoard 20 0.08 rng :: Board
iob <- liftIO $ newIORef b
\end{lstlisting}
The body of the page is then rendered, one part to note is the custom JS I include at the bottom of the body:
\begin{lstlisting}
mkElement "script" # set (attr "src") "/static/custom.js"]
\end{lstlisting}
This custom.js script is a one-liner which prevents right clicks from opening a menu when playing the game:
\begin{lstlisting}
document.addEventListener('contextmenu', event => event.preventDefault());
\end{lstlisting}
\newpage
\subsection{Rendering the Game Board}
The board itself is rendered as a table with ID "table" in a div with ID "gameCont":
\begin{lstlisting}
UI.div # set UI.id_ "gameCont" #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0]
\end{lstlisting}
This calls the rows function with an IORef Board and an already unwrapped copy of the Board. Rows then recursively calls cells to render each row of cells, and cells calls the cell function to render the individual cells:
\begin{lstlisting}
rows iob b r | r < size b = (mkElement "tr" #+ cells iob b r 0) : rows iob b (r+1)
| otherwise = []
cells iob b r c | c < size b = cell iob b (r,c) : cells iob b r (c+1)
| otherwise = []
\end{lstlisting}
The cell function receives an (r,c) pair and renders that specific cell, calling functions from Minesweeper.hs to determine the desired background colour, text colour and text to display in each cell.
Two event handlers are also attached on to the cell to handle left and right clicks, triggering an update of the IORef Board by uncovering or flagging a square respectively.
\begin{lstlisting}
cell iob b (r,c) = do
cell <- mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
#+ [string $ squareAscii b (r,c)]
on UI.click cell $ \_ -> do
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
refresh iob
on UI.contextmenu cell $ \_ -> do
liftIO $ modifyIORef' iob $ \oldB -> flag oldB (r,c)
refresh iob
return cell
\end{lstlisting}
You will note that after an update to the IORef Board due to a player move, the refresh function is called. This function reads an up to date copy of the Board state from the IORef Board and re-renders the game board, replacing the old copy:
\begin{lstlisting}
refresh iob = do
b <- liftIO $ readIORef iob
table <- getElementById w "table"
cont <- getElementById w "gameCont"
let cont' = return $ fromJust cont
cont' #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0]
when (isJust table) $ delete (fromJust table)
-- workaround
newTable <- getElementById w "table"
when (isNothing newTable) $ do
liftIO $ putStrLn "Render failed, triggering repeat"
refresh iob
\end{lstlisting}
The final section of this refresh function is a workaround for an issue I had with ThreePenny. ThreePenny occasionally (approx 1 in every 20 moves or so) fails to re-render the table when asked, instead producing an empty container. Despite extensive debugging I have been unable to pinpoint the cause. I suspect there is a bug in ThreePenny itself at this point, though I cannot rule out a mistake of my own. The workaround tests if the new table was created, and if not, repeats the refresh (this always fixes the problem). Theoretically I suspect the issue could occur twice in a row (though I have not seen this happen), in the case that it does the function should recursively run until a successful render occurs.
\newpage
\subsection{Autosolver}
My autosolving code is implemented in Autosolver.hs. When a user clicks the Autoplay button it fires a call to playAutoMove, which calls nextMove to determine a move and then plays it, returning the modified board:
\begin{lstlisting}
playAutoMove :: Board -> Board
playAutoMove b | fst (nextMove b) == Uncover = uncover b $ snd (nextMove b)
| fst (nextMove b) == Flag = flag b $ snd (nextMove b)
| otherwise = b
nextMove :: Board -> (MoveType, Square)
nextMove b | not . null $ uncoverStrat b = (Uncover, head $ uncoverStrat b)
| not . null $ flagStrat b = (Flag, head $ flagStrat b)
| not . null $ uncoverStratFallback b = (Uncover, head $ uncoverStratFallback b)
| otherwise = (None, (0,0))
\end{lstlisting}
The prioritisation for strategies is shown in nextMove, first it will attempt a move from the uncoverStrat, if none are available then it will try a move from flagStrat, and finally it will fallback to the uncoverStratFallback, which simply uncovers the first covered square on the board.
The strategies work by returning a list of possible moves that could be made in the form of 2-tuples with the first element being either Uncover, Flag or None, and the second the square to perform the move on.
uncoverStrat looks for an uncovered square with at least 1 covered square adjacent to it, and any possible mines have already been accounted for by flagging. It then uncovers all adjacent squares (since they must be safe).
flagStrat looks for an uncovered square with at least 1 covered square adjacent to it, where the number of adjacent squares is equal to the number of adjacent mines. It can then flag all of those squares (since they are guaranteed to be mines).
Together these two strategies consistently solve any game with a relatively low mine ratio.
As an example of the code, here is the uncoverStrat:
\begin{lstlisting}
uncoverStrat :: Board -> [Square]
uncoverStrat b =
filter (not. isFlagged b) $
filter (isCovered b) $
concatMap (adjacentSquares b) $
filter (\s -> adjacentCovereds b s > adjacentFlags b s) $
filter (\s -> adjacentFlags b s == adjacentMines b s) $
filter (\s -> adjacentMines b s > 0) $
uncoveredSquares b
\end{lstlisting}
As you can see it works quite elegantly (in my opinion) by progressively filtering and transforming sets of squares to a safe set to uncover. The logic for each step of the processes are detailed in textual form in comments above the strategies.
\newpage
\section{Reflection}
This was an interesting project and I have learned a lot from it. I think Haskell worked excellently for the project, it continues to feel slightly magical to me after I've finished producing a set of functions and they all neatly slot into each other in such an intuitive way.
On reflection I'm not hugely happy with the core data structures I chose to represent the game state and believe I fell into the trap of thinking like an imperative programmer when designing them. 2D lists initially seemed like an intuitive and efficient way to store the state. However, when it came to writing the uncover and flag functions I realised it was not a particularly optimal choice. Modification of a single element required splitting the lists up two levels deep which made for some overly complex code. I also suspect that this approach is not particularly efficient for data access or modification.
If I was to entirely redesign the project I would try implementing it with a different core data structure. Possible options include a 2D Data.Array structure that would function somewhat similarly to the current approach, or possible an association list or Data.Map based structure (which would be indexed by the (row,col) tuples).
I found working with ThreePenny difficult initially, there are limited examples on the web for usage and it took me quite a bit of time wrestling with it before I had some code with a reasonable structure for the main interface setup section. I would've liked to see a method of including static HTML into a page without having to write all of it in the ThreePenny eDSL and an ability to prevent the default action triggered by a browser event occurring (in my case right click opening a context menu) without having to embed a custom script.
In general, I'm also not a huge fan of user interfaces in HTML using a browser/embedded Chromium (Electron) to execute them. I think these apps are quite wasteful in terms of memory usage. If I produce a GUI app in the future with Haskell I think I'll look into GTK/Qt bindings, particularly since I have experience using them with other languages.
\end{document}

BIN
report/screenshot.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 49 KiB

58
src/Autosolver.hs
View File

@ -1,58 +0,0 @@
module Autosolver where
import Minesweeper
data MoveType = Uncover | Flag | None deriving (Eq, Show)
playAutoMove :: Board -> Board
playAutoMove b | fst (nextMove b) == Uncover = uncover b $ snd (nextMove b)
| fst (nextMove b) == Flag = flag b $ snd (nextMove b)
| otherwise = b
nextMove :: Board -> (MoveType, Square)
nextMove b | not . null $ uncoverStrat b = (Uncover, head $ uncoverStrat b)
| not . null $ flagStrat b = (Flag, head $ flagStrat b)
| not . null $ uncoverStratFallback b = (Uncover, head $ uncoverStratFallback b)
| otherwise = (None, (0,0))
-- Strategy:
-- uncovered squares
-- WITH at least one adjacent mine
-- WHERE the number of adjacent mines == number of adjacent flags
-- WHERE number of adjacent covered squares > number of adjacent flags
-- FIND adjacent squares
-- WHICH are covered
-- WHICH are not flagged
uncoverStrat :: Board -> [Square]
uncoverStrat b =
filter (not. isFlagged b) $
filter (isCovered b) $
concatMap (adjacentSquares b) $
filter (\s -> adjacentCovereds b s > adjacentFlags b s) $
filter (\s -> adjacentFlags b s == adjacentMines b s) $
filter (\s -> adjacentMines b s > 0) $
uncoveredSquares b
-- Strategy:
-- covered squares
-- WHICH are not flagged
uncoverStratFallback :: Board -> [Square]
uncoverStratFallback b =
filter (not. isFlagged b) $
coveredSquares b
-- Strategy:
-- uncovered squares
-- WITH at least one adjacent mine
-- WHERE the number of adjacent mines == number of adjacent covered squares
-- FIND adjacent squares
-- WHICH are covered
-- WHICH are not already flagged
flagStrat :: Board -> [Square]
flagStrat b =
filter (not. isFlagged b) $
filter (isCovered b) $
concatMap (adjacentSquares b) $
filter (\s -> adjacentMines b s == adjacentCovereds b s) $
filter (\s -> adjacentMines b s > 0) $
uncoveredSquares b

85
src/Main.hs
View File

@ -1,6 +1,7 @@
module Main where
import Control.Monad
import Control.Concurrent (threadDelay)
import Data.IORef
import Data.Maybe
@ -10,10 +11,10 @@ import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core
import Minesweeper
import Autosolver
main :: IO ()
main = startGUI defaultConfig {jsStatic = Just "view"} setup
main = do
startGUI defaultConfig {jsStatic = Just "view"} setup
setup :: Window -> UI ()
setup w = void $ do
@ -23,39 +24,16 @@ setup w = void $ do
UI.addStyleSheet w "minesweeper.css"
rng <- liftIO newStdGen
let b = createBoard 20 0.08 rng
let b = createBoard 30 0.15 rng :: Board
iob <- liftIO $ newIORef b
getBody w #+ [
UI.div #. "container" #+ [
UI.div #. "row" #+ [
UI.h1 #+ [string "Minesweeper"],
UI.h4 #+ [string "Jack Harley jharley@tcd.ie"]
],
UI.div #. "row" #+ [
UI.div # set UI.id_ "gameCont" #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0],
UI.div # set UI.id_ "infoCont" #+ [
UI.p #+ [string "Instructions: Click on a square to uncover it. Right click a square to flag/unflag it."],
UI.p #+ [string "Flagged squares will turn yellow."],
UI.p #+ [string "If you hit a mine, you lose and all mines will instantly be revealed as red squares."],
UI.p #+ [string "You win the game once you have uncovered all squares that do not have mines. If this occurs, the board will turn green to indicate your win!"],
UI.p #+ [string "At any time, you can refresh the page to start a new game."],
UI.p #+ [string "Good luck!"]
]
],
UI.div #. "row" #+ [
UI.div #. "panel panel-primary" # set UI.id_ "autoplay" #+ [
UI.div #. "panel-heading" #+ [string "Autoplayer"],
UI.div #. "panel-body" #+ [
UI.p #+ [string "Not sure what to do? Click the Autoplay button below to let the computer make a move for you!"],
autoPlayButton iob
]
]
]
],
-- include custom JS at end of body to stop right clicks opening a menu
mkElement "script" # set (attr "src") "/static/custom.js"]
UI.div #. "container" # set UI.id_ "cont" #+ [
UI.h1 #+ [string "Minesweeper"],
UI.h4 #+ [string "Jack Harley jharley@tcd.ie"],
mkElement "table" # set UI.id_ "table" #+ rows iob b 0
]]
where
rows iob b r | r < size b = (mkElement "tr" #+ cells iob b r 0) : rows iob b (r+1)
@ -70,42 +48,15 @@ setup w = void $ do
on UI.click cell $ \_ -> do
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
refresh iob
on UI.contextmenu cell $ \_ -> do
liftIO $ modifyIORef' iob $ \oldB -> flag oldB (r,c)
refresh iob
return cell
-- auto play move button
autoPlayButton iob = do
button <- UI.button #. "btn btn-primary" #+ [string "Autoplay"]
on UI.click button $ \_ -> do
liftIO $ modifyIORef' iob $ \b -> playAutoMove b
refresh iob
return button
-- refresh the board on screen (rerender)
refresh iob = do
b <- liftIO $ readIORef iob
b <- liftIO $ readIORef iob
table <- getElementById w "table"
table <- getElementById w "table"
let table' = fromJust table
cont <- getElementById w "gameCont"
let cont' = return $ fromJust cont
cont' #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0]
when (isJust table) $ delete (fromJust table)
cont <- getElementById w "cont"
let cont' = return $ fromJust cont
cont' #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0]
-- Ocassionally threepenny will fail to render the table after a change.
-- Despite extensive debugging I cannot determine why, I believe there may be some type of
-- bug in threepenny causing this, the underlying data structures all appear fine and
-- simply forcing a second refresh always fixes it.
-- Therefore: to workaround, we'll check if the render failed and if so, render again
delete table'
newTable <- getElementById w "table"
when (isNothing newTable) $ do
liftIO $ putStrLn "Render failed, triggering repeat"
refresh iob
return cell

207
src/Minesweeper.hs
View File

@ -11,27 +11,15 @@ data Board = Board { size :: Int
, 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)
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 given boolean
createGrid :: Bool -> Int -> Grid
createGrid b size = replicate size (replicate size b)
-- 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 _ _ [] = []
@ -47,181 +35,94 @@ seedList' _ _ [] = []
seedList' rng p (l:ls) = newBool : seedList' newRng p ls
where (newBool, newRng) = weightedRandomBool rng p
-- returns True with probability p, otherwise False
-- 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
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"
| 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 = error "square out of board bounds"
| otherwise = True
-- 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"
isFlagged b (r,c) = (flagged b !! r) !! c
-- 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
squareAscii :: Board -> Square -> String
squareAscii b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "X"
| isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c)
| otherwise = ""
squareBgColour :: Board -> Square -> String
squareBgColour b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "bomb"
| isUncovered b (r,c) = "uncovered"
| otherwise = "covered"
squareTextColour :: Board -> Square -> String
squareTextColour 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"
| otherwise = ""
adjacentMines :: Board -> Square -> Int
adjacentMines b s = sum $ map (boolToInt . hasMine b) $ adjacentSquares b s
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 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
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 :: 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)]
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) && not (any (hasMine b) (uncoveredSquares b))
-- Functions for changing the status of square(s)
-- 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
-- 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 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
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 uncoverAdjacentsIfSafe (Board s m newRows f) (r,c)
-- 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
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 (s:ss) = uncoverAll newB ss where newB = uncover b s
uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c)
-- 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
--
printBoard :: Board -> String
printBoard b = printBoardGrid (mines b)
printBoardGrid :: Grid -> String
printBoardGrid [] = ""

38
view/css/minesweeper.css
View File

@ -11,12 +11,17 @@ td {
font-weight: bold;
}
.bg-blue { background-color: blue; }
.bg-red { background-color: red; }
.bg-yellow { background-color: yellow; }
.bg-dark { background-color: darkgray; }
.bg-light { background-color: lightgray; }
.bg-green { background-color: lime; }
.bomb {
background-color: red;
}
.covered {
background-color: darkgray;
}
.uncovered {
background-color: lightgray;
}
.text-blue { color: blue; }
.text-green { color: green; }
@ -25,23 +30,4 @@ td {
.text-maroon { color: maroon; }
.text-turquoise { color: turquoise; }
.text-black { color: black; }
.text-gray { color: gray; }
.row {
padding-top: 10px;
}
#gameCont {
float: left;
}
#infoCont {
float: left;
margin-left: 20px;
font-size: 1.2em;
max-width: 350px;
}
#autoplay {
max-width: 300px;
}
.text-gray { color: gray; }

1
view/custom.js
View File

@ -1 +0,0 @@
document.addEventListener('contextmenu', event => event.preventDefault());