Guest User

Untitled

a guest
Jul 17th, 2018
67
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.68 KB | None | 0 0
  1. module SHiNKiROU.Minesweeper where
  2.  
  3. import Data.Set (Set)
  4. import qualified Data.Set as Set
  5. import List(transpose)
  6. import Random
  7.  
  8. data Flag = Flag | Close | Open
  9.  
  10. type Number = Int
  11.  
  12. mine :: Number
  13. mine = 9
  14. empty :: Number
  15. empty = 0
  16.  
  17. type Config = [[Bool]]
  18. type Over = [[Flag]]
  19. type Under = [[Number]]
  20. type Coord = (Int, Int)
  21. data Minesweeper = Minsweeper { boardWidth :: Int, boardHeight :: Int,
  22. boardTotalMines :: Int, boardFlags :: Over,
  23. boardNumbers :: Under }
  24.  
  25. member :: (Eq a) => a -> [a] -> Bool
  26. member x [] = False
  27. member x (y:ys) | x == y = True
  28. | otherwise = member x ys
  29.  
  30. -- 2D Functions
  31.  
  32. width :: [[a]] -> Int
  33. width = length
  34.  
  35. height :: [[a]] -> Int
  36. height = length . (!! 0)
  37.  
  38. inZone :: [[a]] -> Int -> Int -> Bool
  39. inZone xss x y = (x `member` [0..(width xss - 1)]) && (y `member` [0..(height xss - 1)])
  40.  
  41. arounds :: [[a]] -> Int -> Int -> [Coord]
  42. arounds xss x y = filter (uncurry $ inZone xss) [ (x + x', y + y') | x' <- [-1..1], y' <- [-1..1], x' /= 0 || x' - y' /= 0 ]
  43.  
  44. box :: [[a]] -> Int -> Int -> [Coord]
  45. box xss x y = (x, y):(arounds xss x y)
  46.  
  47. new2D :: (Int -> Int -> a) -> Int -> Int -> [[a]]
  48. new2D f x y = [ [ f x' y' | y' <- [0..y - 1] ] | x' <- [0..x - 1] ]
  49.  
  50. init2D :: Int -> Int -> a -> [[a]]
  51. init2D w h a = new2D (const . const a) w h
  52.  
  53. mapi2D :: (Int -> Int -> a -> b) -> [[a]] -> [[b]]
  54. mapi2D f xss = new2D (\x y -> f x y $ at xss x y) (width xss) (height xss)
  55.  
  56. at :: [[a]] -> Int -> Int -> a
  57. at xss x y = xss !! x !! y
  58.  
  59. -- Board Functions
  60.  
  61. randomCoord :: Int -> Int -> StdGen -> (Coord, StdGen)
  62. randomCoord w h g =
  63. let (r1, g') = randomR (0, w - 1) g
  64. (r2, g'') = randomR (0, h - 1) g'
  65. in ((r1, r2), g'')
  66.  
  67. randomCoordExcept :: [Coord] -> Int -> Int -> StdGen -> (Coord, StdGen)
  68. randomCoordExcept ts w h g =
  69. let (t, g') = randomCoord w h g
  70. in
  71. if t `member` ts
  72. then randomCoordExcept ts w h g'
  73. else (t, g')
  74.  
  75. randomCoords :: [Coord] -> Int -> Int -> Int -> StdGen -> ([Coord], StdGen)
  76. randomCoords ts w h 0 g = ([], g)
  77. randomCoords es w h m g =
  78. if w * h <= m then
  79. error ("randomCoords: Domain too small. ("
  80. ++ (show w) ++ " * " ++ (show h) ++ " <= " ++ (show m) ++ ")")
  81. else
  82. let (t, g') = randomCoordExcept es w h g
  83. (ts, g'') = randomCoords (t:es) w h (m - 1) g'
  84. in (t:ts, g'')
  85.  
  86. makeBoard :: [Coord] -> Int -> Int -> Int -> StdGen -> ([[Bool]], StdGen)
  87. makeBoard ts w h m gen =
  88. let (coords, gen') = randomCoords ts w h m gen
  89. in (new2D (curry (`member` coords)) w h, gen')
  90.  
  91. --labelBoard :: [[Coord]] -> [[Number]]
  92. labelBoard b =
  93. mapi2D (\x y i ->
  94. if at b x y
  95. then 9
  96. else
  97. let as = arounds b x y
  98. in (length . filter id . (map $ uncurry $ at b)) as
  99. ) b
Add Comment
Please, Sign In to add comment