Life Game完成

Haskell ソフトウェア開発

lamuu2006-08-25

描画ループ

最初、"sleepして描画する"をループさせりゃいい、なんてトンチンカンなこと考えてたので、
Haskell＆sleepでググってると、『ふつうのHaskellプログラミング ふつうのプログラマのための関数型言語入門』の青木氏のブログに行き着く。
http://www.loveruby.net/d/20060306.html
青木氏が言うくらいだから、こんな方法しかないのかorz、と絶望してた。


でも、灯台下暗し。
wxHaskellのサンプルを見直してみると、タイマーイベントのコールバック関数が登録できるじゃん。
wxhaskell\samples\wxcore\BouncingBalls.hs
http://wxhaskell.sourceforge.net/doc/Graphics.UI.WXH.Events.html
そりゃそうだ、Haskellにループなんて無いし。

さらに寄り道（モナディウス）

実はもっと寄り道してて、有名なモナディウスにヒントがないかと少しソース読んでた。
『http://www.geocities.jp/takascience/haskell/monadius_ja.html』
うーむ、すごいな。
モナディウスと言いつつ、モナドをほとんど使ってないあたりがスゴイ。
この村主氏って、いつぞや話題だった、”LEGOで作った全自動ブックスキャナ”を作った人なんだ。
『http://www.geocities.jp/takascience/index_ja.html』
うーむ、すごい。


さらに、村主氏が2005関西オープンソースで発表したスライドを読んでみると、
http://www.geocities.jp/takascience/doc/monadius-kof.pdf

. IOモナド
- 命令を実行する計算のモナド
- 使いたい命令だけマニュアルからコピー
- よく分からないまま当て勘で使う

少し勇気付けられたｗ

IORef？Stateモナド？

現世代のIOUArrayを元に、次世代のIOUArrayを求め、次世代を描画し終わったら、次世代が次の現世代になる…。
簡単だと思ったのに、”現世代であるIOUArray”をどうやって決定すべきか？悩む。


やはり「状態を保持する変数」を導入せざるを得ないのか。
それなら、と、IORefとかStateモナドの使い方をいろいろと検討する。
けど、IOUArrayの使用に続き、なんだか負けた気分。


いろいろ考えて、”コールバック関数内で現世代と次世代を逆転させて、
自分自身をタイマーに再登録する”ことを思いつく。
間接的な再帰？でひとまず解決。

完成

やっと完成。
グライダーのお遊びをやめて、WXCoreの冗長な部分をWXで書くことができれば、他言語に比べ最短ステップでいけるか。
『色々な言語でライフゲーム』
Haskellの強力さを実感した夏休みの宿題？でした。
めでたし、めでたし。

module Main where

import System.Random
import Data.Array.IO
import Data.Array.Base
import Graphics.UI.WXCore
import Graphics.UI.WX

--1から10までの乱数
randInt :: IO (Int)
randInt = getStdRandom (randomR (1,10))

--ランダムにセルの生死を決める
randField :: Int -> Int -> IOUArray (Int, Int) Bool -> IO ()
randField x y field = randInt >>= (\r -> writeArray field (x,y) (r == 1))

--あるセルの周辺セルの相対位置
around = [(-1,-1),(0,-1),(1,-1),(-1,0),(1,0),(-1,1),(0,1),(1,1)]

--グライダーパターンを作る
glider = [False, True, False, False, True, True, True, True]
createGlider x0 y0 field
  = do writeArray field (x0,y0) False
       mapM (\((x,y),b) -> writeArray field (x0+x,y0+y) b) $ zip around glider

--セルの次世代の生死を決める
--誕生: 死んでいるセルの周囲に3つの生きているセルがあれば次の世代では生きる
--維持: 生きているセルの周囲に2つか3つの生きているセルがあれば次の世代でも生き残る
--死亡: 上以外の場合には次の世代では死ぬ
nextField :: Int ->Int ->IOUArray (Int,Int) Bool ->IOUArray (Int,Int) Bool ->IO()
nextField x0 y0 now next
     = do alive <- readArray now (x0,y0)
          aroundAlive <- mapM (\(x,y) -> readArray now (x0+x,y0+y)) around
          case (count aroundAlive) of
            3 -> writeArray next (x0,y0) True
            2 -> writeArray next (x0,y0) alive
            _ -> writeArray next (x0,y0) False
       where
         count [] = 0
         count (x:xs) = if x then 1 + count xs else count xs

--全てのx,y座標
points = [(x, y)| x <- [0..99], y <- [0..99]]

--ライフゲーム本体
game :: IO ()
game = do --現世代、次世代のフィールドを用意
          field1 <- newArray ((0,0),(99,99)) False :: IO (IOUArray (Int, Int) Bool)
          field2 <- newArray ((0,0),(99,99)) False :: IO (IOUArray (Int, Int) Bool)
          --最初はランダムにセルを生成
          mapM_ (\(x,y) -> randField x y field1) points
          --何も無かったら寂しいので(^^;グライダーを３台生成
          mapM_ (\(x,y) -> createGlider x y field1) [(10,10),(20,20),(30,30)]

          frame <- frameCreate objectNull idAny "Lifegame" rectNull
                (wxSYSTEM_MENU + wxCAPTION + wxNO_FULL_REPAINT_ON_RESIZE)
          windowSetClientSize frame (sz 100 100)
          panel <- panelCreate frame idAny rectNull 0
          timer <- windowTimerCreate frame
          timerOnCommand timer (nextGen field1 field2 panel timer)
          windowOnPaintRaw panel (drawCells field1)
          windowShow frame
          timerStart timer 500 False
          return ()
       where
          --タイマーに登録する世代交代処理
          nextGen now next w t
            = do mapM_ (\(x,y) -> nextField x y now next) 
　　　　　　　　　　　　　　　　　　　　　　　　　[(x,y)|x <- [1..98],y <- [1..98]]
                 timerOnCommand t (nextGen next now w t) --世代をスワップして再登録
                 windowRefresh w True

          --全てのセルを描画する
          drawCells field dc viewRect updateAreas
            = do mapM_ (\(x,y) -> 
                   do alive <- readArray field (x,y)
                      when alive (drawPoint dc (pt x y) [color := black])) points

main :: IO ()
main = start game