Created
October 15, 2012 01:45
-
-
Save apstndb/3890426 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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