phfroidmont/minesweeper-haskell
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add revealTile function

Browse source
This commit is contained in:
Paul-Henri Froidmont 2019-11-24 15:36:52 +01:00 • committed by Paul-Henri Froidmont
parent 4e77f37a5f
commit 88864c45b4
2 changed files with 64 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/Lib.hs
View file

@ -1,5 +1,6 @@
module Lib module Lib
( flagTile ( flagTile
, revealTile
, printBoard , printBoard
, Board(..) , Board(..)
, Tile(..) , Tile(..)
@ -18,15 +19,15 @@ data Tile
deriving (Eq, Show) deriving (Eq, Show)
data TileState data TileState
= Revealed = Hidden
| Flagged | Flagged
| Hidden | Revealed
deriving (Eq, Show) deriving (Eq, Show)
type Coordinates = (Int, Int) type Coordinates = (Int, Int)
flagTile :: Board -> Coordinates -> Board flagTile :: Coordinates -> Board -> Board
flagTile (Board board) (x, y) = flagTile (x, y) (Board board) =
case findTile (Board board) (x, y) of case findTile (Board board) (x, y) of
(Just tile) -> flagHiddenTile tile (Just tile) -> flagHiddenTile tile
Nothing -> Board board Nothing -> Board board
@ -35,6 +36,31 @@ flagTile (Board board) (x, y) =
flagHiddenTile (Bomb Hidden) = replaceTile (Board board) (x, y) (Bomb Flagged) flagHiddenTile (Bomb Hidden) = replaceTile (Board board) (x, y) (Bomb Flagged)
flagHiddenTile _ = Board board flagHiddenTile _ = Board board
revealTile :: Coordinates -> Board -> Board
revealTile (x, y) (Board board) =
case findTile (Board board) (x, y) of
(Just tile) -> revealHiddenTile tile
Nothing -> Board board
where
revealHiddenTile (Value 0 Hidden) =
revealTile (x - 1, y - 1) .
revealTile (x, y - 1) .
revealTile (x + 1, y - 1) .
revealTile (x - 1, y) .
revealTile (x + 1, y) . revealTile (x - 1, y + 1) . revealTile (x, y + 1) . revealTile (x + 1, y + 1) $
replaceTile (Board board) (x, y) (Value 0 Revealed)
revealHiddenTile (Value value Hidden) = replaceTile (Board board) (x, y) (Value value Revealed)
revealHiddenTile (Bomb Hidden) = revealAll (Board board)
revealHiddenTile _ = Board board
revealAll :: Board -> Board
revealAll (Board board) = Board $ map revealLine board
where
revealLine = map revealSingleTile
revealSingleTile (Value value Hidden) = Value value Revealed
revealSingleTile (Bomb Hidden) = Bomb Revealed
revealSingleTile tile = tile
replaceTile :: Board -> Coordinates -> Tile -> Board replaceTile :: Board -> Coordinates -> Tile -> Board
replaceTile (Board board) (x, y) tile = replaceTile (Board board) (x, y) tile =
let (firstRows, line:lastRows) = splitAt y board let (firstRows, line:lastRows) = splitAt y board

35
test/Spec.hs
View file

@ -3,7 +3,7 @@ import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
main :: IO () main :: IO ()
main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest] main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest]
emptyBoard :: Board emptyBoard :: Board
emptyBoard = Board [[]] emptyBoard = Board [[]]
@ -28,22 +28,45 @@ flagTileTest :: TestTree
flagTileTest = flagTileTest =
testGroup testGroup
"Flag tile" "Flag tile"
[ testCase "Empty board" $ flagTile emptyBoard (1, 1) @?= emptyBoard [ testCase "Empty board" $ flagTile (1, 1) emptyBoard @?= emptyBoard
, testCase "Flag bomb tile" $ , testCase "Flag bomb tile" $
flagTile hiddenBoard (0, 0) @?= flagTile (0, 0) hiddenBoard @?=
Board Board
[ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden] [ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
] ]
, testCase "Flag value tile" $ , testCase "Flag value tile" $
flagTile hiddenBoard (2, 0) @?= flagTile (2, 0) hiddenBoard @?=
Board Board
[ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged] [ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden] , [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden] , [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
] ]
, testCase "Flag revealed bomb tile" $ flagTile revealedBoard (0, 0) @?= revealedBoard , testCase "Flag revealed bomb tile" $ flagTile (0, 0) revealedBoard @?= revealedBoard
, testCase "Flag revealed value tile" $ flagTile revealedBoard (1, 2) @?= revealedBoard , testCase "Flag revealed value tile" $ flagTile (1, 2) revealedBoard @?= revealedBoard
] ]
revealTileTest :: TestTree
revealTileTest =
testGroup
"Reveal tile"
[ testCase "Empty board" $ revealTile (1, 1) emptyBoard @?= emptyBoard
, testCase "Reveal bomb tile" $ revealTile (0, 0) hiddenBoard @?= revealedBoard
, testCase "Flag 0 value tile" $
revealTile (2, 0) hiddenBoard @?=
Board
[ [Bomb Hidden, Value 1 Revealed, Value 0 Revealed]
, [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed]
]
, testCase "Flag non 0 value tile" $
revealTile (1, 0) hiddenBoard @?=
Board
[ [Bomb Hidden, Value 1 Revealed, Value 0 Hidden]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
]
, testCase "Flag revealed bomb tile" $ revealTile (0, 0) revealedBoard @?= revealedBoard
, testCase "Flag revealed value tile" $ revealTile (1, 2) revealedBoard @?= revealedBoard
]