lispbuilder-sdlでライフゲーム書いてみた

Common Lispでゲーム開発するときはlispbuilder-sdlを使うのが定石らしい。実際CLのライブラリとしてはドキュメントも充実してるし移植性もそれなりにあり、完成度は高いように思える。とりあえず簡単な例をつくってみることにした。
思えばライフゲームを作ったことがなかったので、ウィキペディアを見ながら次の基本的なルールで実装してみることにする。

  • 誕生: 死んでいるセルに隣接する生きたセルがちょうど3つあれば、次の世代が誕生する。
  • 生存: 生きているセルに隣接する生きたセルが2つか3つならば、次の世代でも生存する。
  • 過疎: 生きているセルに隣接する生きたセルが1つ以下ならば、過疎により死滅する。
  • 過密: 生きているセルに隣接する生きたセルが4つ以上ならば、過密により死滅する。

生物を配置するフィールドは二次元配列で表現する。0が死んでいる状態で、1が生きている状態。フィールドはトーラス状になっていて、端っこをはみ出すと反対側の端っこから出てくる。隣接する8個のセルにいる生物の数を関数count-neighboring-individualでカウントして、それに応じて生物の生死を決め、次の世代のフィールドを返す関数がupdate-next-generationということになっている。
lisp-builder-sdlの部分はサンプルコードをいじったらすぐできた。2Dグラフィクスだけの場合はとりあえずlispbuilder-sdlとlispbuilder-sdl-gfxをrequireしておけばいい。1フレームごとの更新をつかさどるのはwith-eventsの:idleキーワード以下の部分で、フィールドの更新と画面描画、画面更新の3つをここでやっている。

(ql:quickload 'lispbuilder-sdl)
(ql:quickload 'lispbuilder-sdl-gfx)
(ql:quickload 'alexandria)

(defparameter world (make-array '(100 100) :element-type 'fixnum))

;; フィールドの初期化
(defun init-world! (world)
  (loop for i from 0 to (1- (array-dimension world 0)) do
    (loop for j from 0 to (1- (array-dimension world 1)) do
      (setf (aref world i j) (if (zerop (random 7)) 1 0)))))

;; 生きている個体が隣接する8個のセルにどれだけいるかをカウントする
(defun count-neighboring-individual (i j world)
  (let ((next-i (if (= i (1- (array-dimension world 0))) 0 (1+ i)))
	(prev-i (if (= i 0) (1- (array-dimension world 0)) (1- i)))
	(next-j (if (= j (1- (array-dimension world 1))) 0 (1+ j)))
	(prev-j (if (= j 0) (1- (array-dimension world 1)) (1- j))))
    (+ (aref world prev-i prev-j) (aref world prev-i j) (aref world prev-i next-j)
       (aref world i prev-j) (aref world i next-j)
       (aref world next-i prev-j) (aref world next-i j) (aref world next-i next-j))))

;; 1世代後のフィールドを返す
(defun update-next-generation (world)
  (let ((next-world (alexandria:copy-array  world)))
    (loop for i from 0 to (1- (array-dimension world 0)) do
      (loop for j from 0 to (1- (array-dimension world 1)) do
	(cond ((and (zerop (aref world i j)) ; 誕生
		    (= (count-neighboring-individual i j world) 3))
	       (setf (aref next-world i j) 1))
	      ((and (= (aref world i j) 1)   ; 過疎or過密
		    (or (<= (count-neighboring-individual i j world) 1)
			(>= (count-neighboring-individual i j world) 4)))
	       (setf (aref next-world i j) 0)))))
    next-world))

(defun life ()
  (sdl:with-init ()
    (sdl:window 400 400) ; ウンドウのサイズ
    (setf (sdl:frame-rate) 60) ; フレームレートを60fpsに
    (init-world! world)
    (sdl:with-events ()
      (:quit-event () t) ; ウインドウが閉じられたときの処理
      (:idle ()
	     (setf world (update-next-generation world))
	     (loop for i from 0 to (1- (array-dimension world 0)) do
	       (loop for j from 0 to (1- (array-dimension world 1)) do
		 (if (= (aref world i j) 0)
		     (sdl-gfx:draw-box (sdl:rectangle :x (* i 4) :y (* j 4) :w 4 :h 4)
                                       :color sdl:*black*)
		     (sdl-gfx:draw-box (sdl:rectangle :x (* i 4) :y (* j 4) :w 4 :h 4)
                                       :color sdl:*white*))))
	     (sdl:update-display)))))

(life)

実行結果はこんな感じになる。