ゲームをつくろう その3 ライフゲーム

どう書く.orgのお題にライフゲームがあがっていたので実装してみよう。
まずはセルの表現。

type Grid = (GLdouble, GLdouble) -- 座標
type Cell = (Grid, Int)          -- 座標と生死

Gridが座標、Cellが座標と生死をあらわすフラグをもった型。
自身の周りの座標の生死の数で次回の自身の生死がきまるので、まずは周りのIndexを得る関数を作ろう。

-- 自身の周りの、自身を含めない座標のリストをえる
makeAroundIndices :: Grid -> [ Grid ]
makeAroundIndices (m, n) = [(x + m, y + n)| x <- [(-1), 0, 1], y <- [(-1), 0, 1], ((x, y) /= (0, 0))]

リスト内包表記って便利だー。
つぎに座標の生死を得る関数。これはもうちょっとスマートに書けそう。

-- ある座標が生きているか、死んでいるか 生きていたら1、死んでいたら0
getValue :: [ Cell ] -> Grid -> Int
getValue es (x, y) = let r = filter (\ ((m, n), _) -> (m == x) && (n == y)) es in
                     case r of        
                       [] ->  0
                       otherwise -> (\ ((_, _), v') -> v') $ head r

そして自身のまわりの生の数を数える関数と次回の自身の生死をとる関数。

-- 自身の周りの生きているマスの数をえる
getValueSum :: [ Grid ] -> [ Cell ] -> Int
getValueSum ps vs = sum $ map (getValue vs) ps

-- 自身の生死とまわりの生きている数から自身が次回どうなるかをえる
nextRule :: Int -> Int -> Int
nextRule a m = if a == 3 || a + m == 3 then 1 else 0

で最後に現在の状態から次の状態への変換。

-- 次回をえる
getNext :: [ Cell ] -> [ Cell ]
getNext cs = [((x, y), let a = getValueSum (makeAroundIndices (x, y)) cs in nextRule a v)| ((x, y), v) <- cs]

では、結果を表示してみよう。もちろんOpenGLでやろう。
現在の値の保持は今回はIORefを使おう。
modifyIORefは[a]->[a]型の関数を引数にとって値の更新をしてくれるのでこれにgetNextを渡す。
できた。

-- ライフゲーム
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU
import System
import Data.IORef

timerInterval = 200

main :: IO()
main = do
  cells <- newIORef []
  -- 初期配置決めるのめんどい
  writeIORef cells ([((0.0,0.0),0),((1.0,0.0),1),((2.0,0.0),0),((3.0,0.0),0),((4.0,0.0),0),((5.0,0.0),0),((6.0,0.0),0),
                     ((0.0,1.0),0),((1.0,1.0),0),((2.0,1.0),0),((3.0,1.0),1),((4.0,1.0),0),((5.0,1.0),0),((6.0,1.0),0),
                     ((0.0,2.0),1),((1.0,2.0),1),((2.0,2.0),0),((3.0,2.0),0),((4.0,2.0),1),((5.0,2.0),1),((6.0,2.0),1)] 
                    ++ [((x, y),0)| x <- [7.0..10.0], y <- [0.0..2.0]] ++ [((x, y),0)|x <- [0.0..10.0], y <- [3.0..10.0]]
                    ++ [((x, y),0)| x <- [(-10.0)..(-1.0)], y <- [0.0..10.0]] ++ [((x, y),0)| x <- [(-10)..10.0], y <- [(-10.0)..(-1.0)]])

  -- 初期化
  initialDisplayMode $= [RGBAMode, DoubleBuffered, WithDepthBuffer]
  initialWindowSize $= Size 640 480
  getArgsAndInitialize
  -- 窓の生成
  createWindow "Life Game at Haskell"
  -- 描画コールバックの登録
  keyboardMouseCallback $= Just keyboardProc
  displayCallback $= (display cells)
  -- ウィンドウサイズが変更された時に呼ぶコールバック関数の指定
  reshapeCallback $= Just reshape
  -- タイマー関数の登録
  addTimerCallback timerInterval $ timer (display cells)
  -- GLUTのメインループへ
  mainLoop

--ライフゲーム
type Grid = (GLdouble, GLdouble) -- 座標
type Cell = (Grid, Int)          -- 座標と生死

-- 自身の周りの、自身を含めない座標のリストをえる
makeAroundIndices :: Grid -> [ Grid ]
makeAroundIndices (m, n) = [(x + m, y + n)| x <- [(-1), 0, 1], y <- [(-1), 0, 1], ((x, y) /= (0, 0))]

-- ある座標が生きているか、死んでいるか 生きていたら1、死んでいたら0
getValue :: [ Cell ] -> Grid -> Int
getValue es (x, y) = let r = filter (\ ((m, n), _) -> (m == x) && (n == y)) es in
                     case r of        
                       [] ->  0
                       otherwise -> (\ ((_, _), v') -> v') $ head r

-- 自身の周りの生きているマスの数をえる
getValueSum :: [ Grid ] -> [ Cell ] -> Int
getValueSum ps vs = sum $ map (getValue vs) ps

-- 自身の生死とまわりの生きている数から自身が次回どうなるかをえる
nextRule :: Int -> Int -> Int
nextRule a m = if a == 3 || a + m == 3 then 1 else 0

-- 次回をえる
getNext :: [ Cell ] -> [ Cell ]
getNext cs = [((x, y), let a = getValueSum (makeAroundIndices (x, y)) cs in nextRule a v)| ((x, y), v) <- cs]

display' ((x, y), v) = if v == 1 
                       then preservingMatrix $ do -- 生きていたらSolidで
                         translate (Vector3 (x * 2) (y * 2) 0  :: Vector3 GLdouble)
                         renderObject Solid (Cube 1.0)
                       else preservingMatrix $ do -- 死んでいたらWireframeで
                         translate (Vector3 (x * 2) (y * 2) 0  :: Vector3 GLdouble)
                         renderObject Wireframe (Cube 1.0)
display cells = 
  modifyIORef cells getNext >>
  -- 背景を黒で塗り潰し
  clearColor $= Color4 0.0 0.0 0.0 0.0 >>
  clear [ColorBuffer, DepthBuffer] >>
  -- 単位行列の読み込み
  loadIdentity >>
  -- 表示
  readIORef cells >>= (\cs -> mapM_ display' cs) >>
  --  mapM_ display' cs
  swapBuffers

timer act = do
  act
  addTimerCallback timerInterval $ timer act

reshape size@(Size w h) = do
  viewport $= (Position 0 0, size)
  matrixMode $= Projection
  loadIdentity
  -- fov アスペクト比 ニアクリップ ファークリップ
  perspective 80 (fromIntegral w / fromIntegral h) 0.1 200.0
  -- 視点 注視点 カメラの上方向
  lookAt (Vertex3 0.0 0.0 30.0) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)
  matrixMode $= Modelview 0

  -- ライト設定
  lighting $= Enabled
  -- ディフューズ
  position (Light 0) $= Vertex4 0.0 0.0 100.0 1.0
  specular (Light 0) $= Color4 0.0 0.0 100.0 1.0
  light (Light 0) $= Enabled
  materialSpecular Back $= Color4 1.0 1.0 1.0 1.0

  -- これをしないとDepthバッファが有効にならない
  depthFunc $= Just Less

keyboardProc ch state _ _
    | ch     == Char 'q'              = exitWith ExitSuccess        --qが押されたら終了
    | otherwise                       = return ()

初期配置はWikipediaにのってた長寿型の「ドングリ」とよばれる配置で。
初期配置をあたえるのがとてもめんどくさい。ので、次回は乱数をさわってみようかなぁ。