Now obeys actual minesweeper rules, added colours
This commit is contained in:
parent
2f1dc1f658
commit
1f9f56f04c
|
@ -23,7 +23,7 @@ setup w = void $ do
|
||||||
|
|
||||||
rng <- liftIO newStdGen
|
rng <- liftIO newStdGen
|
||||||
--let board = createBoard 10 0.2 rng
|
--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 = uncoverSafeAdjacents board (4,4)
|
||||||
--let board = uncoverSafe board [(3,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 :: Board -> Int -> [UI Element]
|
||||||
cells b r = cells2 b r 0
|
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 = []
|
| otherwise = []
|
|
@ -49,7 +49,7 @@ hasMine b (r,c) | validSquare b (r,c) = (mines b !! r) !! c
|
||||||
|
|
||||||
isUncovered :: Board -> Square -> Bool
|
isUncovered :: Board -> Square -> Bool
|
||||||
isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c
|
isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c
|
||||||
| otherwise = False
|
| otherwise = True
|
||||||
|
|
||||||
isFlagged :: Board -> Square -> Bool
|
isFlagged :: Board -> Square -> Bool
|
||||||
isFlagged b (r,c) = (flagged b !! r) !! c
|
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 :: Board -> Square -> Bool
|
||||||
validSquare b (r,c) = r >= 0 && c >= 0 && r < size b && c < size b
|
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 :: Board -> Square -> String
|
||||||
squareAscii b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "X"
|
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
|
| isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentBombs b (r,c)
|
||||||
| adjacentToUncovered b (r,c) = show $ adjacentBombs b (r,c)
|
|
||||||
| otherwise = ""
|
| otherwise = ""
|
||||||
|
|
||||||
squareColour :: Board -> Square -> String
|
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"
|
| isUncovered b (r,c) = "uncovered"
|
||||||
| otherwise = "covered"
|
| 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 :: Board -> Square -> Int
|
||||||
adjacentBombs b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
|
adjacentBombs b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
|
||||||
|
|
||||||
adjacentToUncovered :: Board -> Square -> Bool
|
adjacentToCovered :: Board -> Square -> Bool
|
||||||
adjacentToUncovered b (r,c) = any (isUncovered b) $ adjacentSquares (r,c)
|
adjacentToCovered b (r,c) = not $ all (isUncovered b) $ adjacentSquares (r,c)
|
||||||
|
|
||||||
adjacentSquares :: Square -> [Square]
|
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)]
|
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
|
(cellsA, _ : cellsB) = splitAt c row
|
||||||
newRow = cellsA ++ True : cellsB
|
newRow = cellsA ++ True : cellsB
|
||||||
newRows = rowsA ++ newRow : rowsB
|
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
|
uncoverAdjacentsIfSafe :: Board -> Square -> Board
|
||||||
uncoverSafeAdjacents b (r,c) | adjacentBombs b (r,c) == 0 = uncoverSafe b $ adjacentSquares (r,c)
|
uncoverAdjacentsIfSafe b (r,c) | adjacentBombs b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
|
||||||
| otherwise = b
|
| otherwise = b
|
||||||
|
|
||||||
uncoverSafe :: Board -> [Square] -> Board
|
uncoverAll :: Board -> [Square] -> Board
|
||||||
uncoverSafe b [] = b
|
uncoverAll b [] = b
|
||||||
uncoverSafe b ((r,c):xs) | adjacentBombs b (r,c) == 0 = uncoverSafe (uncover b (r,c)) xs
|
uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c)
|
||||||
| otherwise = uncoverSafe b xs
|
|
||||||
|
|
||||||
-- Functions for turning a board into a string for debug purposes
|
-- Functions for turning a board into a string for debug purposes
|
||||||
|
|
||||||
|
|
|
@ -3,11 +3,12 @@ body {
|
||||||
}
|
}
|
||||||
|
|
||||||
td {
|
td {
|
||||||
width: 30px !important;
|
width: 20px !important;
|
||||||
height: 30px !important;
|
height: 20px !important;
|
||||||
text-align: center;
|
text-align: center;
|
||||||
color: black;
|
color: black;
|
||||||
border: 1px solid black;
|
border: 1px solid black;
|
||||||
|
font-weight: bold;
|
||||||
}
|
}
|
||||||
|
|
||||||
.bomb {
|
.bomb {
|
||||||
|
@ -21,3 +22,12 @@ td {
|
||||||
.uncovered {
|
.uncovered {
|
||||||
background-color: lightgray;
|
background-color: lightgray;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
.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; }
|
Loading…
Reference in New Issue