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

Add createBoard function

Browse source
This commit is contained in:
Paul-Henri Froidmont 2019-11-24 16:59:18 +01:00 • committed by Paul-Henri Froidmont
parent 88864c45b4
commit 4030ae7699
2 changed files with 44 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

27
src/Lib.hs
View file

@ -1,5 +1,6 @@
module Lib
( flagTile
( createBoard
, flagTile
, revealTile
, printBoard
, Board(..)
@ -26,6 +27,18 @@ data TileState
type Coordinates = (Int, Int)
createBoard :: Int -> Int -> [Coordinates] -> Board
createBoard boardWidth boardLength bombs = Board $ foldr placeBomb createClearBoard bombs
where
createClearBoard = replicate boardLength createClearLine
createClearLine = replicate boardWidth (Value 0 Hidden)
placeBomb (x, y) board =
unBoard $ mapAroundTile incrementValueTile (x, y) $ replaceTile (Board board) (x, y) (Bomb Hidden)
incrementValueTile (x, y) (Board board) =
case findTile (Board board) (x, y) of
(Just (Value value Hidden)) -> replaceTile (Board board) (x, y) (Value (value + 1) Hidden)
_ -> Board board
flagTile :: Coordinates -> Board -> Board
flagTile (x, y) (Board board) =
case findTile (Board board) (x, y) of
@ -43,12 +56,7 @@ revealTile (x, y) (Board board) =
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)
mapAroundTile revealTile (x, y) $ 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
@ -90,3 +98,8 @@ printBoard (Board board) = concatMap printLine board
printTile (Value x Revealed) = show x
printTile (Bomb Flagged) = "F"
printTile (Value _ Flagged) = "F"
mapAroundTile :: (Coordinates -> Board -> Board) -> Coordinates -> Board -> Board
mapAroundTile f (x, y) =
f (x - 1, y - 1) .
f (x, y - 1) . f (x + 1, y - 1) . f (x - 1, y) . f (x + 1, y) . f (x - 1, y + 1) . f (x, y + 1) . f (x + 1, y + 1)

26
test/Spec.hs
View file

@ -3,10 +3,10 @@ import Test.Tasty
import Test.Tasty.HUnit
main :: IO ()
main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest]
main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest, createBoardTest]
emptyBoard :: Board
emptyBoard = Board [[]]
emptyBoard = Board []
hiddenBoard :: Board
hiddenBoard =
@ -70,3 +70,25 @@ revealTileTest =
, testCase "Flag revealed bomb tile" $ revealTile (0, 0) revealedBoard @?= revealedBoard
, testCase "Flag revealed value tile" $ revealTile (1, 2) revealedBoard @?= revealedBoard
]
createBoardTest :: TestTree
createBoardTest =
testGroup
"Create board"
[ testCase "Empty board" $ createBoard 0 0 [] @?= emptyBoard
, testCase "3x3 single bomb" $ createBoard 3 3 [(0, 0)] @?= hiddenBoard
, testCase "3x3 three bombs" $
createBoard 3 3 [(0, 0), (1, 1), (2, 2)] @?=
Board
[ [Bomb Hidden, Value 2 Hidden, Value 1 Hidden]
, [Value 2 Hidden, Bomb Hidden, Value 2 Hidden]
, [Value 1 Hidden, Value 2 Hidden, Bomb Hidden]
]
, testCase "3x3 four bombs" $
createBoard 3 3 [(0, 1), (1, 1), (2, 1), (1, 0)] @?=
Board
[ [Value 3 Hidden, Bomb Hidden, Value 3 Hidden]
, [Bomb Hidden, Bomb Hidden, Bomb Hidden]
, [Value 2 Hidden, Value 3 Hidden, Value 2 Hidden]
]
]