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

Significant work

This commit is contained in:
Jack Harley 2021-01-31 20:17:24 +00:00
parent 6432099c45
commit 1ff9279f66
7 changed files with 56 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
report/autoplay.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 9.1 KiB

BIN
report/report.pdf
View File

Binary file not shown.

2
report/report.tex
View File

@ -45,7 +45,7 @@
\begin{document}
\maketitle
\includegraphics[width=12cm]{screenshot.png}
\includegraphics[width=12cm]{screenshot.png} \qquad \includegraphics[width=4cm]{autoplay.png}
\tableofcontents

20
src/Autosolver.hs
View File

@ -4,17 +4,15 @@ import Minesweeper
data MoveType = Uncover | Flag | None deriving (Eq, Show)
probabilityOfMine :: Board -> Square -> Float
probabilityOfMine _ _ = 1.0
autoplay :: Board -> Board
autoplay b | fst (nextMove b) == Uncover = uncover b $ snd (nextMove b)
| fst (nextMove b) == Flag = flag b $ snd (nextMove b)
| otherwise = b
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 $ uncoverStrat1 b = (Uncover, head $ uncoverStrat1 b)
| not . null $ flagStrat1 b = (Flag, head $ flagStrat1 b)
| not . null $ uncoverStratFallback b = (Uncover, head $ uncoverStratFallback b)
| otherwise = (None, (0,0))
-- filter:
@ -37,6 +35,14 @@ uncoverStrat1 b =
filter (\s -> adjacentMines b s > 0) $
uncoveredSquares b
-- filter: (first covered square)
-- covered squares
-- WHICH are not flagged
uncoverStratFallback :: Board -> [Square]
uncoverStratFallback b =
filter (not. isFlagged b) $
coveredSquares b
-- filter:
-- uncovered squares
-- WITH at least one adjacent mine

21
src/Main.hs
View File

@ -30,25 +30,25 @@ setup w = void $ do
UI.div #. "container" #+ [
UI.div #. "row" #+ [
UI.h1 #+ [string "Minesweeper"],
UI.br,
UI.p #+ [string "Jack Harley jharley@tcd.ie"]
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 it."],
UI.p #+ [string "Flagged squares will turn yellow. If you hit a mine 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 entire board will turn green (except the bomb) to indicate your win!"],
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 #. "card" #+ [
UI.div #. "card-header" #+ [string "Autoplayer"],
UI.div #. "card-body" #+ [
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!"],
UI.p #+ [autoPlayButton iob]
autoPlayButton iob
]
]
]
@ -85,7 +85,7 @@ setup w = void $ do
button <- UI.button #. "btn btn-primary" #+ [string "Autoplay"]
on UI.click button $ \_ -> do
liftIO $ modifyIORef' iob $ \b -> autoplay b
liftIO $ modifyIORef' iob $ \b -> playAutoMove b
refresh iob
return button
@ -99,7 +99,6 @@ setup w = void $ do
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)
-- For some reason, ocassionally threepenny will fail to render the table after a change.

60
src/Minesweeper.hs
View File

@ -12,7 +12,7 @@ data Board = Board { size :: Int
}
instance Show Board where
show b = printBoard b
show b = printBoardGrid (mines b)
--
-- Functions related to creating and initialising a board
@ -101,7 +101,7 @@ adjacentCovereds b (r,c) = sum $ map (boolToInt . isCovered b) $ adjacentSquares
-- 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)
adjacentToCovered b (r,c) = adjacentCovereds b (r,c) > 0
-- returns a list of all the squares directly adjacent to the given square (using arithmetic)
adjacentSquares :: Square -> [Square]
@ -114,26 +114,26 @@ boolToInt x | x = 1
-- 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)
gameWon b = all (hasMine b) (coveredSquares b) && not (any (hasMine b) (uncoveredSquares b))
-- returns a list of all squares on a board currently still covered
coveredSquares :: Board -> [Square]
coveredSquares (Board _ _ u _) = booleanSquares 0 False u
coveredSquares (Board _ _ u _) = matchingSquares 0 False u
-- returns a list of all squares on a board currently uncovered
uncoveredSquares :: Board -> [Square]
uncoveredSquares (Board _ _ u _) = booleanSquares 0 True u
uncoveredSquares (Board _ _ u _) = matchingSquares 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
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
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
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]
@ -156,7 +156,7 @@ squareAscii b (r,c) | gameWon b = ""
-- 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"
squareBgColour b (r,c) | gameWon b && hasMine b (r,c) = "bg-blue"
| gameWon b = "bg-green"
| isUncovered b (r,c) && hasMine b (r,c) = "bg-red"
| isUncovered b (r,c) = "bg-light"
@ -185,18 +185,14 @@ squareTextColour b (r,c) | hasMine b (r,c) || isFlagged b (r,c) = ""
--
-- 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
-- if the uncovered square has a mine, uncovers the entire board (lost)
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)
| hasMine b (r,c) = Board (size b) (mines b) (createGrid True (size b)) (flagged b)
| otherwise = uncoverAdjacentsIfSafe
(Board (size b) (mines b) (modSquare (uncovered b) (r,c) True) (flagged b))
(r,c)
uncoverAdjacentsIfSafe :: Board -> Square -> Board
uncoverAdjacentsIfSafe b (r,c) | adjacentMines b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
@ -207,25 +203,23 @@ 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
-- toggles a square's flagged status
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
| isFlagged b (r,c) = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) (r,c) False)
| otherwise = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) (r,c) True)
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 [] = ""
printBoardGrid (l:ls) = printBoardLine l ++ "\n" ++ printBoardGrid ls

6
view/css/minesweeper.css
View File

@ -11,6 +11,7 @@ td {
font-weight: bold;
}
.bg-blue { background-color: blue; }
.bg-red { background-color: red; }
.bg-yellow { background-color: yellow; }
.bg-dark { background-color: darkgray; }
@ -32,7 +33,6 @@ td {
#gameCont {
float: left;
margin-left: 17px;
}
#infoCont {
@ -41,3 +41,7 @@ td {
font-size: 1.2em;
max-width: 350px;
}
#autoplay {
max-width: 300px;
}