Create user interractions
This commit is contained in:
parent
fd1aef44ef
commit
9a1cf149df
3 changed files with 58 additions and 45 deletions
35
app/Main.hs
35
app/Main.hs
|
|
@ -3,6 +3,7 @@ module Main where
|
|||
import Lib
|
||||
import System.Environment
|
||||
import System.Random
|
||||
import Text.Read
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
@ -11,5 +12,35 @@ main = do
|
|||
boardLength = read (args !! 1)
|
||||
bombs = read (args !! 2)
|
||||
generator <- newStdGen
|
||||
putStrLn . printBoard . revealAll . createBoard boardWidth boardLength $
|
||||
generateRandomCoordinates (boardWidth-1) (boardLength-1) bombs generator
|
||||
gameStep . createBoard boardWidth boardLength $
|
||||
generateRandomCoordinates (boardWidth - 1) (boardLength - 1) bombs generator
|
||||
|
||||
gameStep :: Board -> IO ()
|
||||
gameStep board = do
|
||||
putStrLn . convertBoardToString $ board
|
||||
coordinates <- getCoordinates
|
||||
let nextBoard = revealTile coordinates board
|
||||
if isGameLost nextBoard
|
||||
then gameLost nextBoard
|
||||
else if isGameWon nextBoard
|
||||
then gameWon nextBoard
|
||||
else gameStep nextBoard
|
||||
|
||||
getCoordinates :: IO (Int, Int)
|
||||
getCoordinates = do
|
||||
putStrLn "Enter the coordinates of the tile to reveal (X then Y, zero indexed):"
|
||||
xString <- getLine
|
||||
yString <- getLine
|
||||
case (readMaybe xString, readMaybe yString) of
|
||||
(Just x, Just y) -> return (x,y)
|
||||
_ -> putStrLn "Invalid coordinates!" >> getCoordinates
|
||||
|
||||
gameLost :: Board -> IO ()
|
||||
gameLost board = do
|
||||
putStrLn . convertBoardToString . revealAll $ board
|
||||
putStrLn "Boom! You lost!"
|
||||
|
||||
gameWon :: Board -> IO ()
|
||||
gameWon board = do
|
||||
putStrLn . convertBoardToString $ board
|
||||
putStrLn "You won! All the bombs were found!"
|
||||
|
|
|
|||
45
src/Lib.hs
45
src/Lib.hs
|
|
@ -1,10 +1,11 @@
|
|||
module Lib
|
||||
( createBoard
|
||||
, generateRandomCoordinates
|
||||
, flagTile
|
||||
, revealTile
|
||||
, printBoard
|
||||
, convertBoardToString
|
||||
, revealAll
|
||||
, isGameLost
|
||||
, isGameWon
|
||||
, Board
|
||||
, Tile(..)
|
||||
, TileState(..)
|
||||
|
|
@ -22,7 +23,6 @@ data Tile
|
|||
|
||||
data TileState
|
||||
= Hidden
|
||||
| Flagged
|
||||
| Revealed
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
|
@ -39,16 +39,6 @@ createBoard boardWidth boardLength = foldr placeBomb createClearBoard
|
|||
(Just (Value value Hidden)) -> replaceTile board (x, y) (Value (value + 1) Hidden)
|
||||
_ -> board
|
||||
|
||||
flagTile :: Coordinates -> Board -> Board
|
||||
flagTile (x, y) board =
|
||||
case findTile board (x, y) of
|
||||
(Just tile) -> flagHiddenTile tile
|
||||
Nothing -> board
|
||||
where
|
||||
flagHiddenTile (Value value Hidden) = replaceTile board (x, y) (Value value Flagged)
|
||||
flagHiddenTile (Bomb Hidden) = replaceTile board (x, y) (Bomb Flagged)
|
||||
flagHiddenTile _ = board
|
||||
|
||||
revealTile :: Coordinates -> Board -> Board
|
||||
revealTile (x, y) board =
|
||||
case findTile board (x, y) of
|
||||
|
|
@ -87,16 +77,15 @@ coordinatesExists board (x, y) = isPositive && isYWithinTheBoard board && isXWit
|
|||
isYWithinTheBoard = (> y) . length
|
||||
isXWithinTheBoard = any ((> x) . length)
|
||||
|
||||
printBoard :: Board -> String
|
||||
printBoard = concatMap printLine
|
||||
convertBoardToString :: Board -> String
|
||||
convertBoardToString = concatMap printLine
|
||||
where
|
||||
printLine line = concatMap printTile line ++ "\n"
|
||||
printTile (Bomb Hidden) = "#"
|
||||
printTile (Bomb Revealed) = "B"
|
||||
printTile (Value _ Hidden) = "#"
|
||||
printLine line = concatMap ((' ' :) . printTile) line ++ "\n"
|
||||
printTile (Bomb Hidden) = "■"
|
||||
printTile (Bomb Revealed) = "✸"
|
||||
printTile (Value _ Hidden) = "■"
|
||||
printTile (Value 0 Revealed) = "□"
|
||||
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) =
|
||||
|
|
@ -109,3 +98,17 @@ generateRandomCoordinates maxX maxY count generator = take count . nub $ zip ran
|
|||
(xGen, yGen) = split generator
|
||||
randomXs = randomRs (0, maxX) xGen
|
||||
randomYs = randomRs (0, maxY) yGen
|
||||
|
||||
isGameLost :: Board -> Bool
|
||||
isGameLost = any isRevealedBomb . concat
|
||||
where
|
||||
isRevealedBomb :: Tile -> Bool
|
||||
isRevealedBomb (Bomb Revealed) = True
|
||||
isRevealedBomb _ = False
|
||||
|
||||
isGameWon :: Board -> Bool
|
||||
isGameWon = all isRevealedValueOrHidden . concat
|
||||
where
|
||||
isRevealedValueOrHidden (Value _ Revealed) = True
|
||||
isRevealedValueOrHidden (Bomb Hidden) = True
|
||||
isRevealedValueOrHidden _ = False
|
||||
|
|
|
|||
23
test/Spec.hs
23
test/Spec.hs
|
|
@ -3,7 +3,7 @@ import Test.Tasty
|
|||
import Test.Tasty.HUnit
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest, revealTileTest, createBoardTest]
|
||||
main = defaultMain $ testGroup "Minesweeper tests" [revealTileTest, createBoardTest]
|
||||
|
||||
hiddenBoard :: Board
|
||||
hiddenBoard =
|
||||
|
|
@ -19,27 +19,6 @@ revealedBoard =
|
|||
, [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed]
|
||||
]
|
||||
|
||||
flagTileTest :: TestTree
|
||||
flagTileTest =
|
||||
testGroup
|
||||
"Flag tile"
|
||||
[ testCase "Empty board" $ flagTile (1, 1) [] @?= []
|
||||
, testCase "Flag bomb tile" $
|
||||
flagTile (0, 0) hiddenBoard @?=
|
||||
[ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden]
|
||||
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
|
||||
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
|
||||
]
|
||||
, testCase "Flag value tile" $
|
||||
flagTile (2, 0) hiddenBoard @?=
|
||||
[ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged]
|
||||
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
|
||||
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
|
||||
]
|
||||
, testCase "Flag revealed bomb tile" $ flagTile (0, 0) revealedBoard @?= revealedBoard
|
||||
, testCase "Flag revealed value tile" $ flagTile (1, 2) revealedBoard @?= revealedBoard
|
||||
]
|
||||
|
||||
revealTileTest :: TestTree
|
||||
revealTileTest =
|
||||
testGroup
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue