JavaScriptのゲームをjs_of_ocamlでOCamlに移植しようとしてみた

こちらの記事↓を読んで面白そうだったので、前作ったPhantasmal IslandのJavaScriptクライアントを移植しようとしてみた。

ウェブブラウザで関数型プログラミング! js_of_ocaml - Oh, you `re no (fun _ → more)

移植元のクライアントとソースはこちら。

JSPhi (Phantasmal Island Client)
napthats / JSPhi

で、JavaScriptファイルのうちjsphi.jsをjs_of_ocamlに移植してみたのがこれ(適当に書いてるところが多いので注意。一応動く……はず)

napthats / JSPhi_of_ocaml

移植はわりと機械的にできるかなーと思ったけどそうでもなかった。js_of_ocaml自体もちょっと難しいし、「え、このJavaScriptのコード、OCamlだとどう書くの……？」というのも結構あった(これは多分OCaml慣れてないからもあるけど)。あとミスした時のエラーメッセージが分かりにくい(特にOCamlでは通ったけどJavaScriptでエラーが出るとき)。場合によっては最初から作り直す方がいいかもしれない。
以下は移植してる時にハマったところとか。まだまだ他にも詰まりそうだけど……。

関数の引数の数が定義と合わないときの挙動
JavaScriptで定義より少ない数の引数で関数を呼び出すと、残りの引数はundefinedになる。例えば、

function f(a,b) {alert(a); alert(b);}
f("hi");

これを実行すると、hiとundefinedが順に表示される。これをjs_of_ocamlでこう書いてしまうと、

let f a b = Dom_html.window##alert(a); Dom_html.window##alert(b)
let _ = f (Js.string "hi")

何も表示されない。何故なら二行目は部分適用(?)とみなされて以下のような感じに変換される(たぶん)から。

function f(a,b) {alert(a); alert(b);}
(funtion(b) {f("hi", b);})

fが外部のJavaScriptライブラリの関数だったりしても似たようなことが起こる。例えばJQueryを使って

$(document).ready( ...

と書いてあるとすると、

let jq = Unsafe.variable "$"
let _ = Unsafe.meth_call (jq Dom_html.document) "ready" ...

というふうに変換できそうだけど、$は実は2引数関数なので変なエラーが出る。
こういう風にJavaScriptで引数の数が合わない使い方してる場合は、Unsafe.fun_callを使うと上手くいく。

let jq = Unsafe.variable "$"
let _ = Unsafe.meth_call (Unsafe.fun_call jq [| Unsafe.inject Dom_html.document |]) "ready" ...

循環参照で困ったらrefでごまかす
例えば、単純に書くと以下のようになってしまう場合、

(* createAとかcreateBとかは外部JavaScriptライブラリの関数 *)
let componentA = createA componentB
let componentB = createB (fun msg -> componentA##do(msg))

こう書き直す。

let componentA = ref (Unsafe.variable "0")
let componentB = createB (fun msg -> (!componentA)##do(msg))
let _ = componentA := createA componentB

createBの中で渡した関数呼ばれたら死ぬけど、その状況はJavaScriptでも同じだったはずなので、多分問題にならないはず。

OCamlの型とJavaScriptの型をごっちゃにしない
関数の引数の型はなるべくOCamlの型にする(例えばJs.js_stringじゃなくてstringを使う)ようにした方がいいと思うけど、JavaScriptから呼ばれる可能性のある関数の引数はJavaScriptの型にしておかないとエラーになる。例えば、JavaScriptのライブラリにコールバックとして関数渡す場合とか。

オブジェクトobjの無引数メソッド(OCaml上ではunitが引数のmeth)fを呼ぶときはobj##f()じゃなくてobj##f(())
書いてある通り。よく考えたら当たり前だけど……。

Hashtblは使えない
と、思う。のでassoc listで我慢。

OCamlのmodule(.mli)の循環依存をなんとかする

OCamlは.mliの依存関係が循環してるとコンパイルできない。例えば、

(* a.mli *)
type a = A
val a_f : a -> B.b

(* b.mli *)
type b = B
val b_f : b -> A.a

こうなってるとダメ。この状態の一番簡単な解決法は二つを同じファイルに纏めてしまうことで、

(* a.mli *)
type a = A

type b = B
val b_f : b -> a

val a_f : a -> b

こうすればコンパイルできるようになる。この方法はmodule AとBを書き始めたばかりの時ならいいけど、他のmoduleで既にmodule Bを使っている場合、B.bとB.b_fをA.bとA.b_fに書きかえなきゃいけない。例えば、

(* c.mli *)
type c = C
val c_f : A.a -> B.b -> c

こういうmodule Cを既に書いていた場合、

(* c.mli *)
type c = C
val c_f : A.a -> A.b -> c

こう直す必要がある。これは面倒な上に、元のmodule AとBは(あまり)関係ないものだろうからごっちゃにするのも良くない。ごっちゃになってしまうのを回避するには内部module(?)を使って、

(* a.mli *)
type a = A

module B : sig
  type b = B
  val b_f : b -> a
end

val a_f : a -> B.b

こうしておけば、他のmoduleでは以下のように書けるのでちょっとはマシになる。

(* c.mli *)
type c = C
val c_f : A.a -> A.B.b -> c

これでも書き直しめんどいのは変わらないので、さらにこうする。

(* a.mli *)
type a = A

module B_open : sig
module B : sig
  type b = B
  val b_f : b -> a
end
end

open B_open

val a_f : a -> B.b

で、module Bを使っている他のmoduleに、

(* c.mli *)
open A.B_open

type c = C
val c_f : A.a -> B.b -> c

一行目にopen A.B_openを付け加えれば、中身は書きかえなくてもいい(上の方にある最初のc.mliと同じ)。

というわけで一応なんとかなったけど、誰かもっといい方法あったら教えてください……。

JSXでアクションゲームを作ってみた

JSXが面白そうだったのでゲームを作ってみた。

jsx action
napthats / jsx_action (github)

書いてみた感想は、JavaScriptにクラスベースの静的型付けを追加したような感じ。静的型付けだけど、型推論も付いてるのでさくさく書ける。ただしOCamlやHaskellみたいな関数型言語ほど型推論が賢くないので、型を明示しなきゃいけないことが結構ある(多分Scalaより多いぐらい？)。
例えば、

var inout = Stage.checkInner(this.pc.x, this.pc.y);

こういうのは関数の返り値の型を見てくれるのでvarで済む(変数の型は書かなくていい)けど、

static function checkInner(x : number, y : number) : Region {
  ...
}

関数(メソッド？)の定義では引数も返り値も型を書く必要があるし、

var newEnemies = [] : Array.<Enemy>; 

空配列は型が解らないので明示しなきゃいけなかったりする(関数型言語だとnewEnemiesがこの後どう使われてるかを見て推論してくれたりするけど……)。

mixinもある(多重継承できる)し実装の継承は楽にできる。作ったゲームでもキャラの特徴ごとにmixinや抽象クラス作ったりして書きやすかった。ただあんまり多用するとカオスになるかも。

mixin Obj {
  ...
}
abstract class WalkingObj implements Obj {
  ...
}
class WalkingEnemy extends WalkingObj implements Enemy {
  ...
}

こんな感じ。ふつう。

JavaScriptベースなので関数はfirst-class objectで、そのまま変数に代入したり、関数の引数として受け取ったりできる。ちゃんと型も付くし安心。ゲーム中では敵キャラ(FlyingEnemy)の移動アルゴリズムを受け取るのに使ってる。

class FlyingEnemy implements Obj, Enemy {
  ...
  function constructor(
        _x : number, _y : number, _get_delta : function(:number) : Map.<number>
  ) {
    this.x = _x;
    this.y = _y;
    this.character = "F";
    this.get_delta = _get_delta;
    this.tick_count = 0;
    this.hp = 3;
  }
  override function tick() : void {
    var delta = this.get_delta(this.tick_count);
    assert(delta["dx"] != null);
    assert(delta["dy"] != null);
    if (!this.hitGround(delta["dx"], delta["dy"])) {
      this.x += delta["dx"];
      this.y += delta["dy"];
    }
    ++this.tick_count;
  }
  ...
}

こんな感じ(constructorはそのまんまコンストラクタ)。関数の型の書き方がちょっと気持ち悪い……かも(と思ったら -> を使った記法にも対応してるらしい？)。

JavaScriptとの連携、例えば既存のJavaScriptライブラリをどの程度再利用できるのかはよく知らないけど、asで後から型付けできたり、variantという色んな型の値を保持できる型があるし、多分いけそう？

というわけで、全体的に使いやすく纏まってる印象。今後はJavaScriptの代わりにJSX書こう。

Haskellでゲーム用TCPサーバ

Haskellでゲーム作ろうと思ってTCPサーバを探したら、クライアント同士のやり取りとかがやりにくいのしか見つからなかったので書いた。

napthats / SimpleTCPServer

使い方はtest.hsとSimpleTCPServer.hs参照。だいたい以下のような感じ。
・runTCPServerで起動してクライアントを自動で受け付けつづける。
・クライアントからのメッセージはget〜系関数を使うと取れる。MaybeかListで取ってくるのでブロックはしない。
　-getClientMessageで(どれかは分からない)あるクライアントの未取得のメッセージのうち最も古いものを(クライアントID, メッセージ)の形式で取ってくる。
　-getEachClientMessagesで未取得のメッセージを持ってる全クライアントから(クライアントID, メッセージ)を一つずつ取ってくる。
　-getClientMessageFromでクライアントIDを指定してそのクライアントの最も古いメッセージを取ってくる
・broadcastMessage/sendMessageToで全ての/あるクライアントにメッセージを送る。
　-sendMessageToはboolを返し、クライアントがもう居ないなどで送信に失敗した場合はfalseを返す。
・disconnectClientでクライアント強制切断。
・shutdownServerで終了。

unsafePerformIOでunsafeなグローバル変数を作る。

newIORefしたものをunsafePerformIOすればできる。

import Data.IORef (IORef, newIORef, readIORef, modifyIORef)
import System.IO.Unsafe (unsafePerformIO)

globalIntRef :: IORef Int
globalIntRef = unsafePerformIO $ newIORef 0

main :: IO ()
main = do
  x <- readIORef globalIntRef
  putStrLn $ show x
  succGlobal
  y <- readIORef globalIntRef
  putStrLn $ show y

succGlobal :: IO ()
succGlobal = do
  modifyIORef globalIntRef (+ 1)

実行結果。

0
1

ただしunsafeを使っているので上手く行く保証は無い。例えばこの手法はglobalIntRef関数の中身が一回しか計算されないという事実に依存している(たぶん)が、コンパイルオプションやらなんやらでそうはならない場合もあるらしい。例えばさっきのコードに一行足した、

import Data.IORef (IORef, newIORef, readIORef, modifyIORef)
import System.IO.Unsafe (unsafePerformIO)

globalIntRef :: IORef Int
{-# INLINE globalIntRef #-}
globalIntRef = unsafePerformIO $ newIORef 0

main :: IO ()
main = do
  x <- readIORef globalIntRef
  putStrLn $ show x
  succGlobal
  y <- readIORef globalIntRef
  putStrLn $ show y

succGlobal :: IO ()
succGlobal = do
  modifyIORef globalIntRef (+ 1)

これがunsafe.hsファイルに書かれているとして、以下のようにしてghcでコンパイルすると、

ghc unsafe.hs -O

こうなる。(ちなみにghcのバージョンは7.0.4)

0
0

Conduitを使ってみる

なんかIO扱ったりするのにConduitが熱いらしいので使ってみた。まだよく分かってないのでたぶん色々間違ってる。
ConduitではSourceから一つずつ流れてくるデータをConduitで流れ方を変えたり加工したりしてSinkに流す。SourceとSinkがファイルでConduitが無い場合(つまりファイルの中身を全部コピーするだけ)の例は以下の通り。

import Data.Conduit (($$))
import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB

main :: IO ()
  C.runResourceT
  $ CB.sourceFile "in.txt"
  $$ CB.sinkFile "out.txt"

sourceFileでファイルの中身をまとめて流すSourceを作り、sinkFileでファイルに書き出すSinkを作り、それらを$$で繋ぎ合わせて、runResourceTで実行する。次はConduitを挟んで加工する例。(ちなみにこのコード、out.txtに余計な改行が一つ入ってしまうのでどこか間違えてるはずなんだけどよく分からない……)

import Data.Conduit (($=),($$))
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Binary as CB
import qualified Data.ByteString as DB
import qualified Data.ByteString.UTF8 as BU
    
main :: IO ()
main =
  C.runResourceT
  $ CB.sourceFile "in.txt"
  $= CB.lines --一行ごとに区切って流す
  $= CL.isolate 6 --六個の要素(＝六行)だけ流して残りは無視(その時点で終了)
  $= (C.sequence $ CL.take 2) --二個ずつ纏めたリストにして流す
  $= CL.map (foldl DB.append (BU.fromString "")) --各要素について、リストの中身を結合
  $= CL.map (`DB.append` (BU.fromString "\n")) --各要素について、末尾に改行を付ける
  $$ CB.sinkFile "out.txt"

新しく追加された行で$=の右側にあるのは全部Conduit。$=はSourceとConduitを引数に取って新しいSourceを返すので、結局CB.sourceFileからCL.map (`DB.append` (BU.fromString "\n"))までがSourceということになる。
in.txtの中身が一行目に1、二行目に2……と十行続くようなファイルだったとする(改行コードはLF)と、各SourceとConduitの後で以下のように流れてる。なお「a→b→c ...」という表記は要素a, b, c,...が順に流れているということ。

main =
  C.runResourceT
  $ CB.sourceFile "in.txt" --「"1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n"」
  $= CB.lines --「"1"→"2"→"3"→"4"→"5"→"6"→"7"→"8"→"9"→"10"」
  $= CL.isolate 6 --「"1"→"2"→"3"→"4"→"5"→"6"」
  $= (C.sequence $ CL.take 2) --「["1","2"]→["3","4"]→["5","6"]」
  $= CL.map (foldl DB.append (BU.fromString "")) --「"12"→"34"→"56"」
  $= CL.map (`DB.append` (BU.fromString "\n")) --「"12\n"→"34\n"→"56\n"」
  $$ CB.sinkFile "out.txt"

network-conduitのrunTCPServerというのを使うと、今ファイルでやっていることをTCPサーバにすることもできる(クライアントからメッセージを受け取って(Source)、クライアントにメッセージを返す(Sink))。

import Data.Conduit (($=),($$))
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Binary as CB
import qualified Data.ByteString as DB
import qualified Data.ByteString.UTF8 as BU
import Text.Regex
import Data.Conduit.Network

main :: IO ()
main =
  runTCPServer (ServerSettings 20017 (Host "127.0.0.1"))
    (\src -> \sink ->
      src
      $= CB.lines
      $= CL.isolate 6
      $= (C.sequence $ CL.take 2)
      $= CL.map (foldl DB.append (BU.fromString ""))
      $= CL.map (`DB.append` (BU.fromString "\n"))
      $$ sink
    )

ここに接続して1,2,3...と順にメッセージを送っていけば、ファイルの例と同じ結果が得られるはず。

Haskellで並行処理

forkIOでスレッドを起動できる。forkIOは(IOモナドに包まれた)スレッドIDを返すので、取っておいて後でkillThreadするとThreadKilled例外を投げて終了できる。

import Control.Concurrent

main :: IO ()
main = do
  id <- forkIO $ subThread 0
  threadDelay 5000000
  killThread id

subThread :: Int -> IO ()
subThread num = do
  putStrLn $ "loop " ++ (show num)
  threadDelay 1000000
  subThread $ num + 1

スレッド間でメッセージを送受信したい場合は、MVarを使う。MVarは容量1のメッセージボックスで、既にメッセージが入ってる時に更に書き込もうとするとブロックするし、逆にメッセージが無い時に読み込もうとしてもブロックする。ChanはMVarの容量無制限バージョンで、書き込みはブロックしない。

import Control.Concurrent

main :: IO ()
main = do
  numMVar <- newEmptyMVar
  id <- forkIO $ subThread numMVar
  threadDelay 1000000
  putMVar numMVar 0
  threadDelay 4000000
  currentNum <- takeMVar numMVar --空の場合はブロック
  putStrLn $ "numMVar: " ++ (show currentNum)
  killThread id

--subThread :: f Int -> IO ()
subThread numMVar = do
  currentNum <- takeMVar numMVar --上のputMVar numMVar 0が来るまでは空なのでブロック
  putStrLn $ "loop " ++ (show currentNum)
  threadDelay 1000000
  putMVar numMVar $ currentNum + 1
  subThread $ numMVar

スレッド間で変数を共有したい場合は、IORefを使ってatomicModifyIORefで更新する。atomicModifyIORefには「IORef型の変数」と「IORefが持つ値を受け取って(更新後の値, atomicModifyIORefの戻り値にしたい値)を返す関数」を渡す。

import Control.Concurrent
import Data.IORef

main :: IO ()
main = do
  numRef <- newIORef 0
  id <- forkIO $ subThread numRef
  threadDelay 1000000
  _ <- atomicModifyIORef numRef (\x -> (x+10, x))
  threadDelay 4000000
  currentNum <- readIORef numRef
  putStrLn $ "numRef: " ++ (show currentNum)
  killThread id

subThread :: IORef Int -> IO ()
subThread numRef = do
  currentNum <- atomicModifyIORef numRef (\x -> (x+1, x))
  putStrLn $ "loop " ++ (show currentNum)
  threadDelay 1000000
  subThread $ numRef

IORefの場合アトミックにできるのはatomicModifyIORefに渡した関数だけなので、複数のIORefを扱いたい時はSTMを使うといいらしい……けどややこしいので略。