自作SDLバインディングでライフゲーム作ってみた

いい加減に秋が来てくれないもんでしょうか。今年の残暑は115年間で最も暑い残暑だったようですが、もう10月なんですからもうちょっと日中が涼しくなってくれてもいいかと。

さて、昨日自分でSDLバインディングを作っていると書いていましたが、実際に使ってみないと色々わからんだろう、ということで、簡単に出来そうな予感がしたライフゲームを作ってみることにしました。
ライフゲームとは何か、というのはwikipediaの記事に詳しいのでそちらを参照してください。簡単に言えば、単純なルールの上での生命活動のシミュレーションです。

とりあえず以下のような実装としました。

• ルールは一番シンプルなもので
• マウスで左クリックすれば生きてるマスを作れる
• 左クリックしたまま動かせば、軌跡に沿って生きてるマスを作れる
• ESCで閉じる

open Sdlcaml

(* configurations *)
let width = 800
let height = 600
let cell_width = 20
let cell_height = 20

let cell_x_num = width / cell_width
let cell_y_num = height / cell_height

let fps = 1000 / 60

type cell =
  Live
| Dead

let board = ref (Array.make_matrix (width / cell_width)
  (height / cell_height) Dead)

let rec keyfunc _ =
  match Sdl_event.poll_event () with
      Some e ->
        begin
          match e with
            | Sdl_event.KeyDown e ->
              begin
                match e.Sdl_event.keysym.Sdl_key.synonym with
                  | Sdl_key.SDLK_ESCAPE -> false;
                  | _ -> true;
              end
            | Sdl_event.Quit _ -> false
            | Sdl_event.Motion e ->
              begin
                let x = e.Sdl_event.motion_x / cell_width
                and y = e.Sdl_event.motion_y / cell_height in
                let buttons s =
                  match s.Sdl_mouse.index with
                  | Sdl_mouse.MOUSE_LEFT ->
                    if s.Sdl_mouse.state then
                      !board.(x).(y) <- Live
                    else
                      ()
                  | _ -> ()
                in List.iter buttons e.Sdl_event.motion_states;
                keyfunc ();
              end
            | _ -> true;
        end
    | _ -> true

let ring_pos (base_x, base_y) (x, y) =
  let correct_x = if base_x + x < 0 then
      cell_x_num - 1
    else if base_x + x >= cell_x_num then
      0
    else
      base_x + x
  and correct_y = if base_y + y < 0 then
      cell_y_num - 1
    else if base_y + y >= cell_y_num then
      0
    else
      base_y + y
  in
  (correct_x, correct_y)

let around = [
  (1,1); (1,0); (1,-1);
  (0,1); (0,-1);
  (-1,1); (-1, 0); (-1, -1);
]

let is_live = function
  | Live -> true
  | _ -> false

let next_cell around_cells cell =
  let get_cell (x, y) = !board.(x).(y) in
  match cell with
      Live ->
        begin
          let lives = List.filter is_live
            (List.map get_cell around_cells) in
          let lives_num = List.length lives in
          if lives_num = 2 || lives_num = 3 then
            Live
          else
            Dead
        end
    | Dead ->
      begin
        let lives = List.filter is_live
          (List.map get_cell around_cells) in
        if (List.length lives) = 3 then
          Live
        else
          Dead
      end

let life_time_tick _ =
  let next_lifetime x y cell =
    let around_cells = List.map (ring_pos (x,y)) around in
    next_cell around_cells cell
  in
  let next_board = Array.mapi
    (fun x yar ->
      Array.mapi (fun y cell -> next_lifetime x y cell) yar)
    !board
  in
  board := next_board

let life_time_draw surface =
  let draw_dead x y =
    let rect = {Sdl_video.x = x * cell_width;
                y = y * cell_height;
                w = cell_width; h = cell_height}
    and col = {Sdl_video.red = 0; green = 0; blue = 255; alpha = 0} in
    Sdl_video.fill_rect ~dist:surface ~drect:rect ~fill:col ()
  and draw_live x y =
    let rect = {Sdl_video.x = x * cell_width;
                y = y * cell_height;
                w = cell_width; h = cell_height}
    and col = {Sdl_video.red = 255; green = 0; blue = 0; alpha = 0} in
    Sdl_video.fill_rect ~dist:surface ~drect:rect ~fill:col ()
  in
  let draw x y = function
      Live -> draw_live x y
    | Dead -> draw_dead x y
  in
  Sdl_video.clear surface;
  Array.iteri (fun x col ->
    Array.iteri (fun y cell -> draw x y cell) col)
    !board;
  Sdl_video.flip surface

let tick = ref 0

let rec loop surface timer =
  timer := Sdl_timer.get_ticks ();

  if keyfunc () then
    begin
      if !tick > 20 then
        begin
          life_time_tick ();
          tick := 0;
        end
      else
        tick := succ !tick;

      life_time_draw surface;

      let current = Sdl_timer.get_ticks () in
      begin
        if current - !timer < fps then
        let wait = fps  - (current - !timer) in Sdl_timer.delay wait;
      end;
      loop surface timer;
    end
  else
    ()

let _ =
  Sdl.init ~flags:[`VIDEO] ~auto_clean:true;

  Random.init 0;
  ignore (List.map (fun _ -> !board.(Random.int cell_x_num).(Random.int
                                                              cell_y_num) <-
    Live) (Mylib.Prelude.range (Num.num_of_int 0, Num.num_of_int 100)));

  let screen = Sdl_video.set_video_mode ~width ~height ~depth:32
    ~flags:[Sdl_video.SDL_HWSURFACE; Sdl_video.SDL_HWACCEL;Sdl_video.SDL_DOUBLEBUF] in

  let timer = ref (Sdl_timer.get_ticks ()) in
  loop screen timer;

  print_string "end"

とりあえず実装したみたものなので、初期盤面は常に同一です。というか経過時間を取得する関数がUnixモジュールにしかなかったのでどうしようか、といったところです。一応標準モジュール以外はすべて自前で用意したものだけで作ってみました。

で、肝心の速度の方ですが、これくらいなら余裕で60FPSは維持できそうです。Windows(MinGW)だとどうなるかはわかりませんが・・・。flipだとハードウェアアクセラレーションが効くようですが、二つのサーフェイスをBlitする形式だと、ただBlitするだけでも40FPSも出なかったりしました。

ひとまず基本的に必要になるものが動くことは確認できましたが、まだまだ必須のもの(Joystick, audio)や、事実上必須の外部ライブラリ(ttf, mixer, image)など、実用にはほど遠いです。それと、最低限のインターフェースしかもたないように作っているので、ひたすら泥臭いです。上を見てもらえればすぐわかると思いますが。これについては、もうちょっと高水準なインターフェースを用意するつもりです。

後1週間くらいのうちに、Joystick/audio/cdromあたりは実装してしまって、肝心のOpenGLに進んでみたいものです。一日ひたすらプログラムを進めていられるのは、ニート生活万歳ですね(ぉ

蛇足

私はOCamlのコンパイル後がどれくらい速いのかをあまり把握せずにOCamlでガシガシ進めてしまっていますが、一応試しにC/SDLと自作ライブラリとで簡単なものを作って速度を比較してみました。
ただひたすら10秒間FillRectしてFlipしつづける、というプログラムを作成し、1秒ごとにFPSをタイトルに表示させるようにしておいて、5回ほど相互で測ってみましたが、結果は

• OCaml : 1050FPS前後
• C : 1070FPS前後

くらいでした。思ったよりもCに肉薄していてびっくりです。プログラムのほとんどがHardware accelerationにしか絡まないような部分なのでこれくらいだったのかもしれませんが、それでも速度についてはそれほどまで心配しなくてもいいのかなっと。GCとかが絡んできたら知りまですが。