Skip to content

Instantly share code, notes, and snippets.

@apstndb
Created October 15, 2012 01:45
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save apstndb/3890426 to your computer and use it in GitHub Desktop.
Save apstndb/3890426 to your computer and use it in GitHub Desktop.
import Control.Applicative
import Data.List
import System.Random
-- XとYの数(TODO: 決め打ちしない)
maxX :: Int
maxX = 9
maxY :: Int
maxY = 9
-- セルの中身は爆弾か空(周囲の爆弾の数を記録)
data CellContent = Bomb | Blank Int
instance Show CellContent where
show Bomb = "*"
show (Blank x) = show x
-- セルは開いているか閉じている(TODO: 旗)
data Cell = Opened CellContent | Closed CellContent
instance Show Cell where
show (Opened content) = show content
show (Closed _) = "."
-- FieldはCellの二次元リスト
type Field = [[Cell]]
-- リストxsのn番目の要素をelemとしてelem fと交換したリストを返す
swapElemByFunc :: Int -> (a -> a) -> [a] -> [a]
swapElemByFunc n f xs = left ++ [f e] ++ right
where (left, e:right) = splitAt n xs
-- リストのn番目の要素をelemと交換したリストを返す
-- swapElem :: Int -> a -> [a] -> [a]
-- swapElem n e = swapElemByFunc n $ \_ -> e
-- posの周辺の位置のリストを返す
enumNeighbors :: (Int, Int) -> [(Int, Int)]
enumNeighbors (x, y) = [(newX, newY) | newX <- [x-1..x+1], newY <- [y-1..y+1],
newX /= x || newY /= y,
newX >= 0, newY >= 0,
newX < maxX, newY < maxY]
-- フィールドを文字列化
showField :: Field -> String
showField = unlines . map (concatMap show)
-- posに爆弾を配置し,周りのBlankのカウントを加算
addBomb :: (Int, Int) -> Field -> Field
addBomb pos field = foldr addCount (changeCell pos (Closed Bomb) field) $ enumNeighbors pos
-- posが空ならカウントを増やす
addCount :: (Int, Int) -> Field -> Field
addCount pos = changeCellByFunc pos addCount'
where addCount' (Closed (Blank n)) = Closed (Blank (n+1))
addCount' (Opened (Blank n)) = Opened (Blank (n+1))
addCount' cell = cell
-- fieldの中の(x, y)のセルcellをf cellに置き換えたものを返す
changeCellByFunc :: (Int, Int) -> (Cell -> Cell) -> Field -> Field
changeCellByFunc (x, y) = swapElemByFunc x . swapElemByFunc y
-- フィールドの中のposのセルを置き換えて返す
changeCell :: (Int, Int) -> Cell -> Field -> Field
changeCell pos = changeCellByFunc pos . const
-- posのセルを取得
getPos :: (Int, Int) -> Field -> Cell
getPos (x, y) field = field !! x !! y
-- posを開く
openPos :: (Int, Int) -> Field -> Field
openPos pos field = case getPos pos field of
(Closed (Blank 0)) -> foldr openPos openedField neighbors
(Closed Bomb) -> openField field
_ -> openedField
where neighbors = enumNeighbors pos
openedField = changeCellByFunc pos openCell field
-- cellを開いた結果を返す
openCell :: Cell -> Cell
openCell (Closed content) = Opened content
openCell cell = cell
-- フィールドの全てのセルをOpenedにする
openField :: Field -> Field
openField = map $ map openCell
-- n個の座標を重複無しで乱択する
genBombsPos :: StdGen -> Int -> [(Int, Int)]
genBombsPos initGen n = genBombsPos' initGen []
where genBombsPos' gen acc
| length acc == n = acc
| otherwise = do
let (x, newGen1) = randomR (0, maxX-1) gen :: (Int, StdGen)
let (y, newGen2) = randomR (0, maxY-1) newGen1 :: (Int, StdGen)
genBombsPos' newGen2 . nub $ (x, y):acc
-- 空のFieldを作成する
initField :: Field
initField = replicate maxX . replicate maxY . Closed $ Blank 0
-- 勝利条件を満たしているかを判定する
isWinState :: Field -> Bool
isWinState = not . any isClosedBlank . concat
where isClosedBlank (Closed (Blank _)) = True
isClosedBlank _ = False
-- 敗北条件を満たしているかを判定する
isLoseState :: Field -> Bool
isLoseState = any isOpenedBomb . concat
where isOpenedBomb (Opened Bomb) = True
isOpenedBomb _ = False
main :: IO Field
main = do
gen <- getStdGen
putStr "num of boms> "
numBoms <- read <$> getLine
let bombsPos = genBombsPos gen numBoms
minesweeper $ foldr addBomb initField bombsPos
minesweeper :: Field -> IO Field
minesweeper field = do
putStrLn $ showField field
if isLoseState field then do putStrLn "YOU LOSE"
main
else if isWinState field then do putStrLn "YOU WIN"
main
else do
putStrLn "input: \"x y\" (0 origin, x is up to down, y is left to right)"
putStr "> "
(x:y:_) <- map read . words <$> getLine
if x < 0 || y < 0 then main
else minesweeper $ openPos (x, y) field
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment