Significant work

report/report.tex

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

src/Autosolver.hs

@@ -4,17 +4,15 @@ import Minesweeper
 
 data MoveType = Uncover | Flag | None deriving (Eq, Show)
 
-probabilityOfMine :: Board -> Square -> Float 
+playAutoMove :: Board -> Board
-probabilityOfMine _ _ = 1.0
+playAutoMove b | fst (nextMove b) == Uncover = uncover b $ snd (nextMove b)
-
-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
 
 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

src/Main.hs

@@ -30,25 +30,25 @@ setup w = void $ do
         UI.div #. "container" #+ [
             UI.div #. "row" #+ [
                 UI.h1 #+ [string "Minesweeper"],
-                UI.br,
+                UI.h4 #+ [string "Jack Harley jharley@tcd.ie"]
-                UI.p #+ [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 "Instructions: Click on a square to uncover it. Right click a square to flag/unflag 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 "Flagged squares will turn yellow."],
-                    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 "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 #. "panel panel-primary" # set UI.id_ "autoplay" #+ [
-                    UI.div #. "card-header" #+ [string "Autoplayer"],
+                    UI.div #. "panel-heading" #+ [string "Autoplayer"],
-                    UI.div #. "card-body" #+ [
+                    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.

src/Minesweeper.hs

@@ -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]
+matchingSquares :: Int -> Bool -> Grid -> [Square]
-booleanSquares _ _ [] = []
+matchingSquares _ _ [] = []
-booleanSquares r status (row:rows) = booleanSquares' r 0 status row ++ booleanSquares (r+1) status rows
+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]
+matchingSquares' :: Int -> Int -> Bool -> [Bool] -> [Square]
-booleanSquares' _ _ _ [] = []
+matchingSquares' _ _ _ [] = []
-booleanSquares' r c status (col:cols) | col == status = (r,c) : booleanSquares' r (c+1) status cols
+matchingSquares' r c status (col:cols) | col == status = (r,c) : matchingSquares' r (c+1) status cols
-                                      | otherwise = booleanSquares' 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
+                | hasMine b (r,c) = Board (size b) (mines b) (createGrid True (size b)) (flagged b)
-                                    in Board s m (createGrid True s) f
+                | otherwise = uncoverAdjacentsIfSafe 
-                | otherwise = let Board s m u f = b
+                      (Board (size b) (mines b) (modSquare (uncovered b) (r,c) True) (flagged b)) 
-                                  (rowsA, row : rowsB) = splitAt r u
+                      (r,c)
-                                  (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)
@@ -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
+             | isFlagged b (r,c) = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) (r,c) False)
-             | otherwise = let Board s m u f = b
+             | otherwise = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) (r,c) True)
-                               (rowsA, row : rowsB) = splitAt r f
+
+modSquare :: Grid -> Square -> Bool -> Grid
+modSquare grid (r,c) newStatus = let (rowsA, row : rowsB) = splitAt r grid
                                      (cellsA, _ : cellsB) = splitAt c row
-                               newRow = cellsA ++ True : cellsB
+                                     newRow = cellsA ++ newStatus : cellsB
-                               newRows = rowsA ++ newRow : rowsB
+                                 in 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

view/css/minesweeper.css

@@ -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;
+}