はてなダイアリーのシンタックス・ハイライトが Haskell に対応してると聞きました。。。
hscurses ライブラリを入れてコンパイルしたら、TTY コンソールからこんな感じでお楽しみください。(移動:hjkl、マーク:x、開く：スペース）
#################### # 1x-1 # #11 12-1 # #x1 111 # #11111 11# #----1 1221 1111-# #--211 1--1 1----# #111 1221 12----# # 1-----# ####################
当方は、この環境です。
$ ghc --version The Glorious Glasgow Haskell Compilation System, version 6.10.2
-- hinesweeper.hs -- Mine Sweeper written in Haskell -- -- 2009/05/31 ver1.0 (Need hscurses library) -- -- Usage : hinesweeper [number of mines] -- Keys : [ijkl] Move / [x] Mark / [Space] Open -- {-# LANGUAGE ScopedTypeVariables #-} import UI.HSCurses.Curses import System import System.Random import System.Posix import Data.Array.IO import Control.Exception import Prelude hiding (catch) type Board = IOArray Int Int xMax = 20 :: Int yMax = 10 :: Int -- misc functions -- nop = putStr "" myFst (a,_,_) = a mySnd (_,b,_) = b myTrd (_,_,c) = c rand :: Int -> IO Int rand n = getStdRandom(randomR (0, n)) dualMap :: (Int -> Int -> IO a) -> [Int] -> [Int] -> IO [[a]] dualMap f rangeX rangeY = mapM (\x -> mapM (\y -> f x y) rangeY) rangeX -------------------- getBoard :: Board -> Int -> Int -> IO Int getBoard arr x y = readArray arr (y*xMax+x) setBoard :: Board -> Int -> Int -> Int -> IO () setBoard arr x y i = writeArray arr (y*xMax+x) i showBoard :: Board -> Window -> IO () showBoard brd scr = do dualMap (\x y -> readBoard brd x y >>= mvWAddStr scr y x) [0..(xMax-1)] [0..(yMax-1)] return () readBoard :: Board -> Int -> Int -> IO String readBoard brd x y = do i <- getBoard brd x y case i of -1 -> return "#" -9 -> return "x" -99 -> return "*" 0 -> return " " 9 -> return "-" otherwise -> return $ show i setMines :: Board -> Int -> IO () setMines brd n | n == 0 = return () | otherwise = do x <- rand (xMax-3) y <- rand (yMax-3) setBoard brd (x+1) (y+1) 1 setMines brd (n-1) -- Tail Recursion getKey :: IO (Int, Int, Int) getKey = do key <- getCh case key of KeyChar 'j' -> return ( 0, 1, 0) KeyChar 'k' -> return ( 0,-1, 0) KeyChar 'h' -> return (-1, 0, 0) KeyChar 'l' -> return ( 1, 0, 0) KeyChar ' ' -> return ( 0, 0, 1) KeyChar 'x' -> return ( 0, 0, 9) otherwise -> return ( 0, 0, 0) countMine :: Board -> Int -> Int -> IO Int countMine mField px py = do a <- dualMap (\x y -> getBoard mField (px+x) (py+y)) [-1..1] [-1..1] return $ sum (concat a) openEdges :: Board -> Board -> Int -> Int -> IO () openEdges mPanel mField px py = do dualMap (\x y -> openPanel mPanel mField (px+x) (py+y)) [-1..1] [-1..1] return () openPanel :: Board -> Board -> Int -> Int -> IO () openPanel mPanel mField px py = do p <- getBoard mPanel px py if ( p /= 9 || px == 0 || py == 0 || px == xMax - 1 || py == yMax -1 ) then return () else openPanel' mPanel mField px py where openPanel' :: Board -> Board -> Int -> Int -> IO () openPanel' mPanel mField px py = do f <- getBoard mField px py c <- countMine mField px py if f == 1 then setBoard mPanel px py (-99) else setBoard mPanel px py c if c == 0 then openEdges mPanel mField px py else return () markMine :: Board -> Int -> Int -> IO () markMine mPanel px py = do p <- getBoard mPanel px py if abs p == 9 then setBoard mPanel px py (-p) else nop isOver :: Board -> Board -> IO (Maybe String) isOver mField mPanel = do f <- dualMap (\x y -> getBoard mField x y) [1..(xMax-2)] [1..(yMax-2)] p <- dualMap (\x y -> getBoard mPanel x y) [1..(xMax-2)] [1..(yMax-2)] let over = elem (-99) (concat p) let clear = isClear (concat f) (concat p) if over then return $ Just "Game Over..." else if clear then return $ Just "Congratulations!" else return Nothing where isClear :: [Int] -> [Int] -> Bool isClear f p = if not $ elem 9 p -- all opened then if length ( filter (1==) f ) == length ( filter (-9==) p ) then True else False else False gameOver :: Window -> String -> IO Bool gameOver scr mes = do mvWAddStr scr yMax 0 mes mvWAddStr scr (yMax+1) 0 "Replay? (y/n)" refresh key <- getCh case key of KeyChar 'y' -> return True KeyChar 'n' -> return False otherwise -> gameOver scr mes -- Tail Recursion game :: Window -> Board -> Board -> Int -> Int -> IO Bool game scr mField mPanel px py = do showBoard mPanel scr mvWAddStr scr py px "" refresh key <- getKey case myTrd key of 9 -> markMine mPanel px py 1 -> openPanel mPanel mField px py otherwise -> nop let xx = handleB px (myFst key) (xMax-1) let yy = handleB py (mySnd key) (yMax-1) res <- isOver mField mPanel case res of Just mes -> showBoard mPanel scr >> gameOver scr mes -- Finish otherwise -> game scr mField mPanel (px+xx) (py+yy) -- Tail Recursion where handleB p i m | (p + i) < 1 || (p + i) >= m = 0 | otherwise = i main :: IO () main = do args <- getArgs let n = head args nMines <- handle (\(_ :: SomeException) -> return 10) $ evaluate (read n) mField <- newArray (0, xMax*yMax) 0 :: IO(Board) mPanel <- newArray (0, xMax*yMax) (-1) :: IO(Board) dualMap (\x y -> setBoard mPanel x y 9) [1..(xMax-2)] [1..(yMax-2)] setMines mField nMines initCurses scr <- initScr wclear scr replay <- game scr mField mPanel 1 1 endWin if replay then main -- Tail Recursion else nop
