-- Mine Sweeper Lab -- Import section import Data.Char import Data.Set ( Set ) import qualified Data.Set as S import Data.Universe.Helpers ( cartesianProduct ) -- Need to be installed : `cabal install universe` import Data.List ( foldl1' ) -- Types data Cell = Covered Int Bool Bool -- number of bombs around ; has bomb ; has flag | Uncovered Int -- number of bombs around | Selected data Grid = Grid [[Cell]] data StdGen = SG -- TODO : replace type Mat = [[Int]] -- Methods instance Show Cell where show ( Covered _ _ hasFlag ) = if hasFlag then "[F]" else "[ ]" show ( Uncovered n ) = ['(', intToDigit n, ')'] show Selected = ">x<" instance Show Grid where show (Grid a) = unlines $ map (unwords . map show) a -- Functions randSet::Int -> StdGen -> StdGen -> Int -> Int -> Set (Int, Int) randSet n sg1 sg2 h w = let byl = randomRs (0, h - 1) sg1 in let bxl = randomRs (0, w - 1) sg2 in let bl = zip byl bxl in let biggerSets = scanl (flip S.insert) S.empty bl in head (dropWhile (\s -> S.size s < n) biggerSets) grid::Int -> Int -> Set (Int, Int) -> Grid grid h w s = Grid [ [Covered 0 (S.member (y, x) s) False | x <- [0..w-1] ] | y <- [0..h-1] ] randomRs (x, y) sg = [x + mod k (y - x) | k <- [1..y] ] -- TODO : replace mineIndic::Cell -> Int mineIndic c = let Covered _ b _ = c in if b then 1 else 0 mines::Grid -> Mat mines g = let Grid m = g in map (map mineIndic) m moveUp::Mat -> Mat moveUp m = concat [tail m, [[0 | _ <- [1..length (m!!0)]]]] moveDown::Mat -> Mat moveDown m = concat [[[0 | _ <- [1..length (m!!0)]]], init m] moveRight::Mat -> Mat moveRight m = map (\l -> 0 : init l) m moveLeft::Mat -> Mat moveLeft m = map (\l -> concat [tail l, [0]]) m gridMoves::Mat -> [Mat] gridMoves m = let hMov = [id, moveUp, moveDown] in let wMov = [id, moveLeft, moveRight] in let allMov = tail $ cartesianProduct (.) hMov wMov in map (\f -> f m) allMov matrixSum::Mat -> Mat -> Mat matrixSum m1 m2 = zipWith (zipWith (+)) m1 m2 neighbourMap::Grid -> Mat neighbourMap g = let Grid cm = g in let m = map (map mineIndic) cm in foldl1' matrixSum (gridMoves m) updateCell::Cell -> Int -> Cell updateCell c n = case c of Covered _ bomb flag -> Covered n bomb flag Uncovered _ -> Uncovered n Selected -> Selected updateGrid::Grid -> Mat -> Grid updateGrid g m = let Grid cm = g in Grid (zipWith (zipWith updateCell) cm m) applyi::(a -> a) -> Int -> [a] -> [a] applyi f i xs = let (xs1, xs2) = splitAt i xs in concat [xs1, ( (f (head xs2)) : tail xs2 )] applyij::(a -> a) -> Int -> Int -> [[a]] -> [[a]] applyij f i j xss = applyi (applyi f j) i xss uncover::(Int, Int) -> Grid -> Grid uncover (i, j) g = let Grid cm = g in let neighbours = tail [(i', j') | i' <- [0, -1, 1], j' <- [0, -1, 1]] in let uncoverOneCell = \c -> case c of Covered 0 _ _ -> Uncovered 0 -- TODO : recursion Covered n _ _ -> Uncovered n in Grid (applyij uncoverOneCell i j cm) -- Testing data dtTinyGrid = Grid [ [Covered 2 True False, Uncovered 2, Covered 0 True False], [Selected, Uncovered 0, Covered 2 True True] ] dtRS = randSet 3 SG SG 4 5 dtGridCover = grid 4 5 dtRS dtMines = mines dtGridCover