From 1f9f56f04c8bbe10bd74f94366869751b1289566 Mon Sep 17 00:00:00 2001 From: Jack Harley Date: Thu, 28 Jan 2021 21:31:29 +0000 Subject: [PATCH] Now obeys actual minesweeper rules, added colours --- src/Main.hs | 4 ++-- src/Minesweeper.hs | 40 +++++++++++++++++++++++++++------------- view/css/minesweeper.css | 16 +++++++++++++--- 3 files changed, 42 insertions(+), 18 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 397ea86..6a94b23 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -23,7 +23,7 @@ setup w = void $ do rng <- liftIO newStdGen --let board = createBoard 10 0.2 rng - let board = uncover (createBoard 10 0.2 rng) (4,4) + let board = uncover (createBoard 30 0.1 rng) (4,4) --let board = uncoverSafeAdjacents board (4,4) --let board = uncoverSafe board [(3,4)] @@ -44,5 +44,5 @@ rows2 b r | r < size b = (mkElement "tr" #+ cells b r) : rows2 b (r+1) cells :: Board -> Int -> [UI Element] cells b r = cells2 b r 0 -cells2 b r c | c < size b = mkElement "td" #. squareColour b (r,c) #+ [string $ squareAscii b (r,c)] : cells2 b r (c+1) +cells2 b r c | c < size b = mkElement "td" #. (squareColour b (r,c) ++ " " ++ squareTextColour b (r,c)) #+ [string $ squareAscii b (r,c)] : cells2 b r (c+1) | otherwise = [] \ No newline at end of file diff --git a/src/Minesweeper.hs b/src/Minesweeper.hs index f0f1e1b..f2eb0d1 100644 --- a/src/Minesweeper.hs +++ b/src/Minesweeper.hs @@ -49,7 +49,7 @@ hasMine b (r,c) | validSquare b (r,c) = (mines b !! r) !! c isUncovered :: Board -> Square -> Bool isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c - | otherwise = False + | otherwise = True isFlagged :: Board -> Square -> Bool isFlagged b (r,c) = (flagged b !! r) !! c @@ -57,10 +57,12 @@ 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 +onEdge :: Board -> Square -> Bool +onEdge b (r,c) = r == 0 || c == 0 || r+1 == size b || c+1 == 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) + | isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentBombs b (r,c) | otherwise = "" squareColour :: Board -> Square -> String @@ -68,11 +70,24 @@ squareColour 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 adjacentBombs 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 = "" + 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) +adjacentToCovered :: Board -> Square -> Bool +adjacentToCovered b (r,c) = not $ all (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)] @@ -91,16 +106,15 @@ uncover b (r,c) | not $ validSquare b (r,c) = b (cellsA, _ : cellsB) = splitAt c row newRow = cellsA ++ True : cellsB newRows = rowsA ++ newRow : rowsB - in uncoverSafeAdjacents (Board s m newRows f) (r,c) + in uncoverAdjacentsIfSafe (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 +uncoverAdjacentsIfSafe :: Board -> Square -> Board +uncoverAdjacentsIfSafe b (r,c) | adjacentBombs b (r,c) == 0 = uncoverAll 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 +uncoverAll :: Board -> [Square] -> Board +uncoverAll b [] = b +uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c) -- Functions for turning a board into a string for debug purposes diff --git a/view/css/minesweeper.css b/view/css/minesweeper.css index c1fcdea..033a598 100644 --- a/view/css/minesweeper.css +++ b/view/css/minesweeper.css @@ -3,11 +3,12 @@ body { } td { - width: 30px !important; - height: 30px !important; + width: 20px !important; + height: 20px !important; text-align: center; color: black; border: 1px solid black; + font-weight: bold; } .bomb { @@ -20,4 +21,13 @@ td { .uncovered { background-color: lightgray; -} \ No newline at end of file +} + +.text-blue { color: blue; } +.text-green { color: green; } +.text-red { color: red; } +.text-purple { color: purple; } +.text-maroon { color: maroon; } +.text-turquoise { color: turquoise; } +.text-black { color: black; } +.text-gray { color: gray; } \ No newline at end of file