Created
October 14, 2012 17:16
-
-
Save apstndb/3889226 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 | |
numBoms :: Int | |
numBoms = 15 | |
-- セルの中身は爆弾か空(周囲の爆弾の数を記録) | |
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 :: [a] -> Int -> (a -> a)-> [a] | |
swapElemByFunc xs n f = left ++ [f e] ++ right | |
where (left, e:right) = splitAt n xs | |
-- リストxsのn番目の要素をelemと交換したリストを返す | |
swapElem :: [a] -> Int -> a -> [a] | |
swapElem xs n e = swapElemByFunc xs n (\_ -> e) | |
-- posの周辺の位置のリストを返す | |
enumNeighbors :: (Int, Int) -> [(Int, Int)] | |
enumNeighbors pos@(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] | |
-- Fieldを文字列化 | |
showField :: Field -> String | |
showField field = unlines $ map (concat . map show) field | |
-- posに爆弾を配置し,周りのBlankのカウントを加算 | |
addBomb :: (Int, Int) -> Field -> Field | |
addBomb pos field = foldl addCount (changeCell field pos (Closed Bomb)) (enumNeighbors pos) | |
-- posが空ならのカウントを増やす | |
addCount :: Field -> (Int, Int) -> Field | |
addCount field pos = changeCellByFunc field 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::Field -> (Int, Int) -> (Cell -> Cell) -> Field | |
changeCellByFunc field pos@(x, y) f = swapElemByFunc field x (\col -> swapElemByFunc col y f) | |
-- fieldの中の(x, y)のセルをcellに置き換えたものを返す | |
changeCell::Field -> (Int, Int) -> Cell -> Field | |
changeCell field pos cell = changeCellByFunc field pos $ const cell | |
-- posのセルを取得 | |
getPos :: (Int, Int) -> Field -> Cell | |
getPos pos@(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 | |
_ -> openedField | |
where neighbors = enumNeighbors pos | |
openedField = changeCellByFunc field pos openCell | |
-- cellを開いた結果を返す | |
openCell :: Cell -> Cell | |
openCell (Closed content) = Opened content | |
openCell cell = cell | |
-- fieldの全てのセルをOpenedにする | |
openField :: Field -> Field | |
openField field = map (map openCell) field | |
-- n個の座標を重複無しで乱択する | |
genBombsPos :: StdGen -> Int -> [(Int, Int)] | |
genBombsPos gen n = genBombsPos' gen n [] | |
where genBombsPos' gen n 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 n . nub $ (x, y):acc | |
-- 空のFieldを作成する | |
initField :: Field | |
initField = replicate maxX (replicate maxY (Closed $ Blank 0)) | |
main :: IO Field | |
main = do | |
gen <- getStdGen | |
let bombsPos = genBombsPos gen numBoms | |
minesweeper $ foldr addBomb initField bombsPos | |
minesweeper :: Field -> IO Field | |
minesweeper field = do | |
putStrLn $ showField field | |
putStrLn "input: \"x y\" (0 origin, x is up to down, y is left to right)" | |
putStr "> " | |
(x:y:_) <- map read . words <$> getLine | |
minesweeper $ openPos (x, y) field |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
11章までの知識縛りで書いたつもり.Monad等使って書きなおしたい.