ライフゲーム

• http://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4%E3%83%95%E3%82%B2%E3%83%BC%E3%83%A0
• http://d.hatena.ne.jp/lamuu/20060825/1156520199

Wikipedia見ててグライダーガンを作ってみたくなったので、ライフゲームをHaskellで作りました。wxHaskellの箇所はほとんどid:lamuuさんの記事をパクりました。

import Data.Maybe
import qualified Data.Map as M
import Graphics.UI.WXCore
import Graphics.UI.WX

type Cells = M.Map Pos Cell
type Cell = Char
type Pos = (Int,Int)

mkCells :: [String] -> Cells
mkCells = M.fromAscList . concat . zipWith (\x y -> zipWith (\p q -> ((x,p), q)) [0..] y) [0..]

step :: Pos -> Cells -> Cell
step p cells | c == '0' && alives == 3                  = '1' -- birth
             | c == '1' && (alives == 2 || alives == 3) = '1' -- keep
             | otherwise                                = '0'
  where alives = isAlive p cells
        c = fromJust $ p `M.lookup` cells

isAlive :: Pos -> Cells -> Int
isAlive (r,c) = M.size . arounds
  where arounds = M.filterWithKey $ \(r',c') cell -> cond (r',c') && '1' == cell
        cond (r',c') = (r /= r' || c /= c') && abs (r-r') <= 1 && abs (c-c') <= 1

steps :: Cells -> Cells
steps cells = M.fromAscList $ zip keys $ map (\k -> step k cells) keys
  where keys = M.keys cells

game :: [String] -> IO ()
game xs = do
    frame <- frameCreate objectNull idAny "LifeGame" rectNull frameSize
    windowSetClientSize frame (sz 320 250)
    panel <- panelCreate frame idAny rectNull 0
    timer <- windowTimerCreate frame
    timerOnCommand timer (nextStep fs panel timer)
    windowOnPaintRaw panel (drawCells fs)
    windowShow frame
    timerStart timer 500 False
    return ()
  where fs = mkCells xs
        frameSize = wxSYSTEM_MENU + wxCAPTION + wxNO_FULL_REPAINT_ON_RESIZE

nextStep fs p t = do
    windowOnPaintRaw p (drawCells fs)
    timerOnCommand t (nextStep (steps fs) p t)
    windowRefresh p True

drawCells fs dc _ _ = mapM_ (\((x,y),v) -> drawRect dc (rec x y) (prop v)) $ M.toAscList $ fs
  where rec x y = rect (pt (y * 8) (x * 8)) (sz 8 8)
        prop v  = [color := c, brushColor := c, brushKind := BrushSolid]
          where c = if v == '1' then black else white

main = start $ game $ glider_guns

glider_guns = [
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000001000000000000000000000",
  "0000000000000000000000101000000000000000000000",
  "0000000000001100000011000000000000110000000000",
  "0000000000010001000011000000000000110000000000",
  "1100000000100000100011000000000000000000000000",
  "1100000000100010110000101000000000000000000000",
  "0000000000100000100000001000000000000000000000",
  "0000000000010001000000000000000000000000000000",
  "0000000000001100000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000",
  "0000000000000000000000000000000000000000000000"]