diff --git a/src/Main.hs b/src/Main.hs index 6a94b23..692c292 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,10 +22,7 @@ setup w = void $ do UI.addStyleSheet w "minesweeper.css" rng <- liftIO newStdGen - --let board = createBoard 10 0.2 rng - let board = uncover (createBoard 30 0.1 rng) (4,4) - --let board = uncoverSafeAdjacents board (4,4) - --let board = uncoverSafe board [(3,4)] + let board = uncover (createBoard 30 0.15 rng) (4,4) getBody w #+ [ UI.div #. "container" #+ [ @@ -38,11 +35,12 @@ gameGridTable :: Board -> UI Element gameGridTable b = mkElement "table" #+ rows b rows :: Board -> [UI Element] -rows b = rows2 b 0 -rows2 b r | r < size b = (mkElement "tr" #+ cells b r) : rows2 b (r+1) +rows b = rows' b 0 +rows' b r | r < size b = (mkElement "tr" #+ cells b r) : rows' b (r+1) | otherwise = [] 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) ++ " " ++ squareTextColour b (r,c)) #+ [string $ squareAscii b (r,c)] : cells2 b r (c+1) +cells b r = cells' b r 0 +cells' b r c | c < size b = mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c)) + #+ [string $ squareAscii b (r,c)] : cells' b r (c+1) | otherwise = [] \ No newline at end of file diff --git a/src/Minesweeper.hs b/src/Minesweeper.hs index f2eb0d1..eabde00 100644 --- a/src/Minesweeper.hs +++ b/src/Minesweeper.hs @@ -9,7 +9,7 @@ data Board = Board { size :: Int , mines :: Grid , uncovered :: Grid , flagged :: Grid - } deriving (Show) + } -- Creates a board given a size (width/height), mine ratio and random generator createBoard :: Int -> Float -> StdGen -> Board @@ -28,16 +28,16 @@ seedGrid rng p (l:ls) = newL : seedGrid rng2 p ls (newL, _) = seedList rng1 p l seedList :: StdGen -> Float -> [Bool] -> ([Bool], StdGen) -seedList rng p (l:ls) = (newBool : seedList2 newRng p ls, newRng) - where (newBool, newRng) = randomlyTrue rng p +seedList rng p (l:ls) = (newBool : seedList' newRng p ls, newRng) + where (newBool, newRng) = weightedRandomBool rng p +seedList' :: StdGen -> Float -> [Bool] -> [Bool] +seedList' _ _ [] = [] +seedList' rng p (l:ls) = newBool : seedList' newRng p ls + where (newBool, newRng) = weightedRandomBool rng p -seedList2 :: StdGen -> Float -> [Bool] -> [Bool] -seedList2 _ _ [] = [] -seedList2 rng p (l:ls) = newBool : seedList2 newRng p ls - where (newBool, newRng) = randomlyTrue rng p - -randomlyTrue :: StdGen -> Float -> (Bool, StdGen) -randomlyTrue rng p = (generatedFloat <= p, newRng) +-- Returns true with probability p, otherwise false +weightedRandomBool :: StdGen -> Float -> (Bool, StdGen) +weightedRandomBool rng p = (generatedFloat <= p, newRng) where (generatedFloat, newRng) = randomR (0.0, 1.0) rng -- Functions for determing statuses and info on square(s) @@ -62,17 +62,17 @@ 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) && adjacentToCovered b (r,c) = show $ adjacentBombs b (r,c) + | isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c) | otherwise = "" -squareColour :: Board -> Square -> String -squareColour b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "bomb" - | isUncovered b (r,c) = "uncovered" - | otherwise = "covered" +squareBgColour :: Board -> Square -> String +squareBgColour 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 + case adjacentMines b (r,c) of 1 -> "text-blue" 2 -> "text-green" 3 -> "text-red" @@ -83,8 +83,8 @@ squareTextColour b (r,c) | isUncovered b (r,c) && adjacentToCovered b (r,c) = 8 -> "text-gray" | otherwise = "" -adjacentBombs :: Board -> Square -> Int -adjacentBombs b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c) +adjacentMines :: Board -> Square -> Int +adjacentMines b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c) adjacentToCovered :: Board -> Square -> Bool adjacentToCovered b (r,c) = not $ all (isUncovered b) $ adjacentSquares (r,c) @@ -98,6 +98,8 @@ boolToInt x | x = 1 -- Functions for changing the status of square(s) +-- uncovers a square and recursively uncovers adjacent squares iff the square has zero adjacent mines +-- N.B. not very efficient due to lots of splitting and remerging uncover :: Board -> Square -> Board uncover b (r,c) | not $ validSquare b (r,c) = b | isUncovered b (r,c) = b @@ -107,11 +109,12 @@ uncover b (r,c) | not $ validSquare b (r,c) = b newRow = cellsA ++ True : cellsB newRows = rowsA ++ newRow : rowsB in uncoverAdjacentsIfSafe (Board s m newRows f) (r,c) - + uncoverAdjacentsIfSafe :: Board -> Square -> Board -uncoverAdjacentsIfSafe b (r,c) | adjacentBombs b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c) +uncoverAdjacentsIfSafe b (r,c) | adjacentMines b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c) | otherwise = b +-- uncovers all squares given in a list uncoverAll :: Board -> [Square] -> Board uncoverAll b [] = b uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c)