ライフゲームを書く

　Facebook/Reason でライフゲームをやっていきます。バックエンドは BuckleScript です。

インストールする

　webpack と bs-loader を使うのが楽そうだったので、そのようにします。

パッケージを追加します。

$ yarn add -D webpack bs-loader bs-platform

設定を書きます。

bsconfig.json

{
  "name": "lifegame",
  "sources": [
    "src"
  ]
}

webpack.config.js

const path = require('path');

module.exports = {
  entry: {
    main: './main.re',
  },
  output: {
    path: path.join(__dirname, 'dist'),
    filename: '[name].js'
  },
  module: {
    rules: [
      { test: /\.(re|ml)$/, use: 'bs-loader' },
    ],
  },
  resolve: {
    extensions: ['.re', '.ml', '.js'],
  },
};

Hello, World! の様子です。

main.re

Js.log "Hello, World!"

ビルドして実行します。

$ yarn run webpack
$ node dist/main.js 
Hello, World!

楽しい！₍₍ (ง╹◡╹)ว ⁾⁾

バインディングする

　DOM を触るためにメソッドをいくつかバインディングします。

module Element = {
  type t;
};

module Context = {
  type t;
  external setFillStyle : t => string => unit = "fillStyle" [@@bs.set];
  external fillRect : int => int => int => int => unit = "" [@@bs.send.pipe: t];
};

module Canvas = {
  type t = Element.t;
  external width : t => int = "" [@@bs.get];
  external height : t => int = "" [@@bs.get];
  external getContext : string => Context.t = "" [@@bs.send.pipe: t];
};

module Document = {
  external getElementById : string => option Element.t = "document.getElementById" [@@bs.val] [@@bs.return null_to_opt];
};

module Window = {
  external requestAnimationFrame : (unit => unit) => unit = "" [@@bs.val];
};

こんな感じに使う。

let canvas = switch (Document.getElementById "canvas") {
  | None => failwith "Cannot find the canvas"
  | Some canvas => canvas
};

let context = canvas |> Canvas.getContext "2d";
Context.setFillStyle context "#F36";
context |> fillRect 0 0 100 100;

bs.send.pipe というアノテーションをつけると引数の順序が入れ替わって便利ですね。

module Array = {
    external forEach1: array 'a => ('a => unit) => unit = "forEach" [@@bs.send];
    external forEach2: ('a => unit) => unit = "forEach" [@@bs.send.pipe: array 'a];
};

let array = [|0, 1, 2, 3, 4|];

/* インスタンスが最初の引数になる */
Array.forEach1 array Js.log;

/* インスタンスが最後の引数になる */
Array.forEach2 Js.log array;
/* つまり */
array |> Array.forEach2 Js.log;

楽しい！₍₍ (ง╹◡╹)ว ⁾⁾

ライフゲームを書く

　書きました。

main.re

type cell = Dead | Alive;

let size = 2;
let foregroundColor = "#F36";
let backgroundColor = "#000";

let clear canvas context => {
  Context.setFillStyle context backgroundColor;
  context |> Context.fillRect 0 0 (canvas |> Canvas.width) (canvas |> Canvas.height);
};

let draw grid context => {
  Context.setFillStyle context foregroundColor;
  grid |> Array.iteri @@ fun x cells =>
  cells |> Array.iteri @@ fun y cell => switch cell {
    | Alive => context |> Context.fillRect (x * size) (y * size) size size
    | _ => ()
  }
};

let rows grid => Array.length grid;

let columns grid => switch (Array.length grid) {
  | length when 0 < length => Array.length @@ Array.get grid 0
  | _ => -1
};

let index min max n => switch n {
  | n when n < min => max
  | n when max < n => min
  | n => n
};

let neighbours x y grid =>
  [|(-1, -1), (-1, 0), (-1, 1), (0, -1), (0, 1), (1, -1), (1, 0), (1, 1)|]
  |> Array.map @@ fun (a, b) => {
    let m = index 0 (rows grid - 1) (x + a);
    let n = index 0 (columns grid - 1) (y + b);
    Array.get (Array.get grid m) n
  };

let next grid =>
  grid |> Array.mapi @@ fun x cells =>
    cells |> Array.mapi @@ fun y cell =>
      switch (neighbours x y grid |> Array.filter ((==) Alive) |> Array.length) {
        | 3 => Alive
        | 2 => cell
        | _ => Dead
      };

let rec run canvas grid => {
  let context = canvas |> Canvas.getContext "2d";
  context |> clear canvas;
  context |> draw grid;

  Window.requestAnimationFrame @@ fun () => run canvas @@ next grid
};

let () = {
  let canvas = switch (Document.getElementById "canvas") {
    | None => failwith "Cannot find the canvas"
    | Some canvas => canvas
  };

  let rows = (canvas |> Canvas.width) / size;
  let columns = (canvas |> Canvas.height) / size;

  Random.self_init ();
  let grid =
    Array.make_matrix rows columns () |> Array.map @@ fun cells =>
      cells |> Array.map @@ fun _ => if (Random.bool ()) { Alive } else { Dead };

  run canvas grid
};

様子です。

楽しい！₍₍ (ง╹◡╹)ว ⁾⁾

出力する

　Reason (BuckleScript) の吐いた JavaScript の一部です。

var foregroundColor = "#F36";

var backgroundColor = "#000";

function clear(canvas, context) {
  context.fillStyle = backgroundColor;
  context.fillRect(0, 0, canvas.width, canvas.height);
  return /* () */0;
}

function draw(grid, context) {
  context.fillStyle = foregroundColor;
  return $$Array.iteri(function (x, cells) {
              return $$Array.iteri(function (y, cell) {
                          if (cell !== 0) {
                            context.fillRect((x << 1), (y << 1), 2, 2);
                            return /* () */0;
                          } else {
                            return /* () */0;
                          }
                        }, cells);
            }, grid);
}

function rows(grid) {
  return grid.length;
}

function columns(grid) {
  var length = grid.length;
  if (0 < length) {
    return Caml_array.caml_array_get(grid, 0).length;
  } else {
    return -1;
  }
}

function index(min, max, n) {
  if (Caml_obj.caml_lessthan(n, min)) {
    return max;
  } else if (Caml_obj.caml_lessthan(max, n)) {
    return min;
  } else {
    return n;
  }
}

function neighbours(x, y, grid) {
  return $$Array.map(function (param) {
              var m = index(0, grid.length - 1 | 0, x + param[0] | 0);
              var n = index(0, columns(grid) - 1 | 0, y + param[1] | 0);
              return Caml_array.caml_array_get(Caml_array.caml_array_get(grid, m), n);
            }, Caml_obj.caml_obj_dup(/* array */[
                  /* tuple */[
                    -1,
                    -1
                  ],
                  /* tuple */[
                    -1,
                    0
                  ],
                  /* tuple */[
                    -1,
                    1
                  ],
                  /* tuple */[
                    0,
                    -1
                  ],
                  /* tuple */[
                    0,
                    1
                  ],
                  /* tuple */[
                    1,
                    -1
                  ],
                  /* tuple */[
                    1,
                    0
                  ],
                  /* tuple */[
                    1,
                    1
                  ]
                ]));
}

function next(grid) {
  return $$Array.mapi(function (x, cells) {
              return $$Array.mapi(function (y, cell) {
                          var prim = neighbours(x, y, grid);
                          var prim$1 = function (param) {
                            return Caml_obj.caml_equal(/* Alive */1, param);
                          };
                          var match = prim.filter(prim$1).length;
                          if (match !== 2) {
                            if (match !== 3) {
                              return /* Dead */0;
                            } else {
                              return /* Alive */1;
                            }
                          } else {
                            return cell;
                          }
                        }, cells);
            }, grid);
}

function run(canvas, grid) {
  var context = canvas.getContext("2d");
  clear(canvas, context);
  draw(grid, context);
  requestAnimationFrame(function () {
        return run(canvas, next(grid));
      });
  return /* () */0;
}

var match = document.getElementById("canvas");

var canvas = match !== null ? match : Pervasives.failwith("Cannot find the canvas");

var rows$1 = canvas.width / 2 | 0;

var columns$1 = canvas.height / 2 | 0;

Random.self_init(/* () */0);

var grid = $$Array.map(function (cells) {
      return $$Array.map(function () {
                  if (Random.bool(/* () */0)) {
                    return /* Alive */1;
                  } else {
                    return /* Dead */0;
                  }
                }, cells);
    }, $$Array.make_matrix(rows$1, columns$1, /* () */0));

run(canvas, grid);

var size = 2;

名前も構造もほぼそのままで、人間に優しいことがわかります。

終わりに

　静的型付けや言語機能の恩恵を受けてシュッと書けるので良さそうです、やっていきましょう。

コードは Gist にあります。

• https://gist.github.com/woxtu/610b88dd09a3856bcb77899314e16039