ArcJSを使って、Webページ上にミニゲームを作る
これは、2014年Lispアドベントカレンダーの最後12/25に投稿されるはずだった記事です。
年末が特に忙しく、5日も遅れてしましいました。すみません。「遅れちゃったしもういいかなー」とも思ったのですが、
このような記事も見つけてしまいまして、ほかでやりたい人もいたのに、さすがに放置はまずいかなと思って書きました。（それにしても素晴らしい奥さんですね...）
以下記事 -----
ArcJS紹介
皆さんはArcというLisp方言をご存知でしょうか。著名なLisperであるPaul Grahamさんが2009年に発表した次世代のLisp方言でシンプルな特徴を持っています。チュートリアル
出た当時は第三のLispとして注目度もあったのですが、最近は、第三のLispの座はClojureに奪われ、めっきりと話を聞かなくなってしまいました。
とはいえ、私は好きで使っています。
前のエントリで紹介しましたが、ブラウザ上で動くArc処理系を作りました。
smihica/arc-js · GitHub
こだわったところは、
- VM型の処理系でJavaScriptでStackVMを作って動かしているところ。
- コンパイラのセルフホスティングを実現しているところ。
- Macro, Object, ファーストクラス継続など めぼしい機能は一通り実現されているところ。
などです。
schemeでは、有名なBiwaSchemeというのがありますが、それのArc版と思っていただけるとわかりやすいです。
今回はArcJSの「Webページ上で動かせる」という特徴をつかって、
Arcで簡単なゲームを作って遊んでみましょう。
題材は 『テトリス』 にしてみます。
ベース
<!doctype html> <html lang="ja"> <head> <style> #c1 {float:left;border:1px solid #ddd;background:#000;} #editor {float:left;width:850px;height:600px;} #holder { width:850px;height:550px;font-family:Consolas,Monaco,monospace;font-size:14px; } #run { float:left; font-size:20px; } </style> <script src="arc.min.js"></script> </head> <body> <canvas id="c1" width="300" height="600"></canvas> <div id="editor"> <textarea id="holder"></textarea> <button id="run" onclick="run()">実行</button> </div> </body> <script> var arcjs = ArcJS.context(); function run() { var code = document.getElementById("holder").value; arcjs.evaluate(code); } </script> </html>
まずは、こんな HTMLを書いてみました。 0.html
ArcJSを使うには、このHTMLにあるように、arc.min.js をインクルードして、
ArcJS.context();でArc処理系を受け取り、context.eval(";; arc code ;;")でArcコードを実行します。
( arc.min.js は githubやnpmでダウンロードできます )
では、左側のフォームにArcコードを打ち込んで試してみましょう。
(prn 'HelloWorld)
試しに、上のように打ち込んで実行すると、consoleに HelloWorld と書き出されることがわかります。
1.html
では、右側の黒い画面にゲーム画面が表示されるようにして、左側に打ち込んだArcコードが描画するようにします。このままでは画面に絵を出すことができないので、canvasタグへのJSブリッジを書いてみましょう。
var arcjs = ArcJS.context(); function run() { var code = document.getElementById("holder").value; arcjs.evaluate(code); } // -- 追加 var canvas = document.getElementById('c1'); var ctx = canvas.getContext('2d'); ArcJS.Primitives('user').define({ 'draw': [{dot: -1}, function(x, y, color) { ctx.fillStyle = color; ctx.fillRect(x*30, y*30, 30, 30); return ArcJS.nil; }], 'clear': [{dot: -1}, function () { ctx.fillStyle = "#000"; ctx.fillRect(0, 0, 300, 600); return ArcJS.nil; }], 'alert': [{dot: -1}, function (x) { alert(x); return ArcJS.nil; }] }); // --
これで、canvasにブロックを書き込む draw という関数と 全消去する clear という関数、alertを出す関数がArc内で使用できるようになります。
(draw 1 1 "#F00")
と打ち込んで実行すると、右上に赤い四角が出るのが見えると思います。3.html
ArcJSでは以下のようにプリミティブ関数を定義できます。
ArcJS.Primitives( /*ネームスペース名*/ ).define({
'関数名': [{dot:-1}, /* リスト引数の開始位置(なければ-1) */
function( ... ) { ... }],
});
テトロミノを作る
さて、画面にブロックを出すことができるようになったので、まずテトリスのブロック(テトロミノ)を作ってみます。
(def make-tetromino (typ) (withs ((base color) (case typ I '(((0 . 0) (1 . 0) (-1 . 0) (-2 . 0)) "#0FF") O '(((0 . 0) (1 . 0) (1 . 1) (0 . 1)) "#FF0") T '(((0 . 0) (0 . 1) (1 . 0) (-1 . 0)) "#F0F") J '(((0 . 0) (-2 . 0) (-1 . 0) (0 . 1)) "#00F") L '(((0 . 0) (0 . 1) (1 . 0) (2 . 0)) "#F70") S '(((0 . 0) (1 . 0) (0 . 1) (-1 . 1)) "#0F0") Z '(((0 . 0) (-1 . 0) (0 . 1) (1 . 1)) "#F00")) p '(4 . 0) origin (fn (p) (fn ((x . y)) (cons (+ car.p x) (+ cdr.p y)))) get (fn (p r) (map1 origin.p base))) (rfn tetromino (cmd (o arg nil)) (case cmd color color get (get p r) draw (each pn (get p r) (draw car.pn cdr.pn color))))))
ちょっとオブジェクト指向っぽくしてみました。
(make-tetromino type) をすると、関数が帰ってきます。
関数は color get draw などのコマンドを受け取ることができます。
それぞれ、colorは色を"#F00"のような形で返します。
getはブロックの位置を (x . y) のリストで返します。
drawはブロックをスクリーンに描きます。
以下のように書き加えて実行してみましょう。
(= t1 (make-tetromino 'Z nil)) (t1 'draw)
赤いZブロックが表示されたでしょうか。4.html
移動・回転させる
さて、ブロックはできたのですが、まだ動かす関数がありません。
ブロックは回転させたり移動させたりできなくてはいけません。
でも、移動・回転は、すでに溜まっているブロックにぶつからないようにしなければなりません。
なので、stageという関数を受け取って、移動や回転の前にその位置におけるかどうか確認しましょう。
(stage 'can-put? new-positions)
このような関数が作れると仮定して、移動と回転の処理も書き加えてみます。
まずは移動です。
引数にstageを受け取るようにして、
(def make-tetromino (typ stage) ;; stage 追加 (withs ((base color) (case typ I '(((0 . 0) (1 . 0) (-1 . 0) (-2 . 0)) "#0FF") O '(((0 . 0) (1 . 0) (1 . 1) (0 . 1)) "#FF0") T '(((0 . 0) (0 . 1) (1 . 0) (-1 . 0)) "#F0F") J '(((0 . 0) (-2 . 0) (-1 . 0) (0 . 1)) "#00F") L '(((0 . 0) (0 . 1) (1 . 0) (2 . 0)) "#F70") S '(((0 . 0) (1 . 0) (0 . 1) (-1 . 1)) "#0F0") Z '(((0 . 0) (-1 . 0) (0 . 1) (1 . 1)) "#F00")) p '(4 . 0) origin (fn (p) (fn ((x . y)) (cons (+ car.p x) (+ cdr.p y)))) get (fn (p) (map1 origin.p base))) (rfn tetromino (cmd (o arg nil)) (case cmd color color get (get p) ;; 追加 move (let np (case arg left (cons (- car.p 1) cdr.p) right (cons (+ car.p 1) cdr.p) down (cons car.p (+ cdr.p 1))) (when (stage 'can-put? (get np)) (= p np) t)) draw (each pn (get p) (draw car.pn cdr.pn color))))))
(tetromino 'move 'down) で、もし下に動かせれば動かし、t が帰ってきます。
動かせなければ、nilが帰ってきます。
次に、回転の処理も書き加えてみましょう。
(def make-tetromino (typ stage) (withs ((base color) (case typ I '(((0 . 0) (1 . 0) (-1 . 0) (-2 . 0)) "#0FF") O '(((0 . 0) (1 . 0) (1 . 1) (0 . 1)) "#FF0") T '(((0 . 0) (0 . 1) (1 . 0) (-1 . 0)) "#F0F") J '(((0 . 0) (-2 . 0) (-1 . 0) (0 . 1)) "#00F") L '(((0 . 0) (0 . 1) (1 . 0) (2 . 0)) "#F70") S '(((0 . 0) (1 . 0) (0 . 1) (-1 . 1)) "#0F0") Z '(((0 . 0) (-1 . 0) (0 . 1) (1 . 1)) "#F00")) p '(4 . 0) origin (fn (p) (fn ((x . y)) (cons (+ car.p x) (+ cdr.p y)))) ;; 追加 r idfn rotate (fn (r) (compose (fn ((x . y)) (cons y (- x))) r)) ;; 変更 get (fn (p r) (map1 (compose origin.p r) base))) (rfn tetromino (cmd (o arg nil)) (case cmd color color get (get p r) move (let np (case arg left (cons (- car.p 1) cdr.p) right (cons (+ car.p 1) cdr.p) down (cons car.p (+ cdr.p 1))) (when (stage 'can-put? (get np r)) (= p np) t)) ;; 追加 rotate (let nr (rotate r) (when (stage 'can-put? (get p nr)) (= r nr) t)) draw (each pn (get p r) (draw car.pn cdr.pn color))))))
現在の回転をrという関数で表しています。
(get)するときに、baseへ当てる関数にrもcomposeするようにしました。
rotate時にはrに x y -> y -x とする関数をcomposeしています。
(tetromino 'rotate) で回転できれば回転し、t が帰ってきます。
ステージを作る
さて、できましたが、肝心のstageがありません。
(stage 'can-put? new-positions)
このようなことができるstageを作ってみましょう。
(def make-stage () (withs (field {} positions (mappend (fn (y) (map1 [cons _ y] (range 0 9))) (nrev (range 0 19))) target (fn _) overflow? (fn (x y) (no (and (<= 0 x 9) (<= 0 y 19))))) (rfn stage (cmd (o o1 nil) (o o2 nil)) (case cmd can-put? (no (ccc (fn (cc) (each p o1 (when (or (overflow? car.p cdr.p) (field p)) (cc t)))))) tick (unless (do1 (target 'move 'down) (stage 'draw)) (let c (target 'color) (each p (target 'get) (= (field p) c))) (stage 'add (make-tetromino (rand-elt '(I O T J L S Z)) stage))) add (if (stage 'can-put? (o1 'get)) (= target o1) (game-over 'over)) draw (do (clear) (target 'draw) (each p positions (aif (field p) (draw car.p cdr.p it))))))))
できました。
それぞれ can-put? tick add draw をコマンドとして受け取る関数ができます。
フィールドはテーブルで表してみました。 { (x1 . y1) "color" ... } の形で入ります。
- can-put? では、その位置に、重ならずにブロックをおけるか確かめます。
- tick では、一つブロックが落ちていくようにして、一番下に行ったらブロックをフィールドに転写し、新しいブロックを追加します。これを一定時間ごとに呼び出して、動かそうと思います。
- add では、新しいブロックを追加します。
- draw では、現在のブロックと積み上がったフィールドを描写しています。
メインの関数も作ってみましょう。
(when (is 'over (ccc (fn (cc) (= game-over cc stage (make-stage)) ((afn (stage) (stage 'tick) (stage 'draw) (arc.time::set-timer self 800 nil stage)) stage)))) (alert "GAME OVER"))
継続を作って、ゲームオーバー時に戻ってくる場所をグローバル環境に保存しています。
(stage 'tick) と (stage 'draw) が0.8秒ごとに呼ばれます。
ゲームオーバーになると、(stage 'add) 内部で継続が呼ばれて、処理が戻ってきます。
ご覧の通り、arcではcccで継続を作ります。
まだ入力を受け付けるようになっていませんが、これで、一度動かしてみましょう。
キーボードで動かせるようにする
さて、ブロックは落ちてくるようになったものの、今のままでは、ただブロックが落ちるだけで何もできません。キーボードイベントをとってブロックを操作できるようにしてみましょう。
HTMLに以下のコードを追記します。
<head> 内部に追記 (keyeventの為にjqueryを入れる)
<script src="//ajax.googleapis.com/ajax/libs/jquery/1.11.2/jquery.min.js"></script>
<script> 内部に追記
$(window).keydown(function(e){ arcjs.evaluate("(keydown " + e.which + ")"); });これで
(def keydown (code) (prn code))
このような式実行すると、consoleに押したキーコードがプリントされるようになります。
6.html
ということで、stage関数をちょっと改造してキーコードを受け取れるようにします。
(def make-stage () (withs (field {} positions (mappend (fn (y) (map1 [cons _ y] (range 0 9))) (nrev (range 0 19))) target (fn _) overflow? (fn (x y) (no (and (<= 0 x 9) (<= 0 y 19))))) (rfn stage (cmd (o o1 nil) (o o2 nil)) (case cmd can-put? (no (ccc (fn (cc) (each p o1 (when (or (overflow? car.p cdr.p) (field p)) (cc t)))))) tick (unless (do1 (target 'move 'down) (stage 'draw)) (each p (target 'get) (= (field p) (target 'color))) (stage 'add (make-tetromino (rand-elt '(I O T J L S Z)) stage))) add (if (stage 'can-put? (o1 'get)) (= target o1) (game-over 'over)) draw (do (clear) (target 'draw) (each p positions (aif (field p) (draw car.p cdr.p it)))) ;; 追加 keydown (do (case o1 37 (target 'move 'left) ;left 38 (target 'rotate) ;up 39 (target 'move 'right) ;right 40 (target 'move 'down)) ;down (stage 'draw))))))
このようにしてみました。keydown関数は以下のようにします。
(def keydown (c) (stage 'keydown c))
これで、keyを使ってブロックが動かせるようになりました。もう一度動かしてみましょう。
7.html
これでブロックが自由に動かせるようになりました。
ブロックを消す処理
さて、最後に、ブロックを消す処理です。
先ほども書いたように、フィールドにブロックを転写した直後にフィールド内の各行をチェックして、全て埋まっている行があれば、削除していけばよいでしょう。
(def make-stage () (withs (field {} positions (mappend (fn (y) (map1 [cons _ y] (range 0 9))) (nrev (range 0 19))) target (fn _) overflow? (fn (x y) (no (and (<= 0 x 9) (<= 0 y 19))))) (rfn stage (cmd (o o1 nil) (o o2 nil)) (case cmd can-put? (no (ccc (fn (cc) (each p o1 (when (or (overflow? car.p cdr.p) (field p)) (cc t)))))) tick (unless (do1 (target 'move 'down) (stage 'draw)) (each p (target 'get) (= (field p) (target 'color))) ;; 追加 (stage 'line-clear) (stage 'add (make-tetromino (rand-elt '(I O T J L S Z)) stage))) add (if (stage 'can-put? (o1 'get)) (= target o1) (game-over 'over)) draw (do (clear) (target 'draw) (each p positions (aif (field p) (draw car.p cdr.p it)))) keydown (do (case o1 37 (target 'move 'left) ;left 38 (target 'rotate) ;up 39 (target 'move 'right) ;right 40 (target 'move 'down)) ;down (stage 'draw)) ;; 追加 line-clear ((afn (lines) (when lines (let line car.lines (if (no (pos [no (field _)] line)) ;; 埋まっている行である (do (map (fn (l1 l2) (map (fn (p1 p2) (= (field p1) (field p2))) l1 l2)) lines cdr.lines) ;; 一つ上の行をくり下げていく。 (each p (car:last lines) (= (field p) nil)) ;; 一番上の行は空白にする (self lines)) (self cdr.lines))))) (tuples positions 10))))))
できました！
これで基本的なゲームはできましたが、最後に速度とスコアも追加してみましょう。
(= score 0 span 800) ;; ... stage内 (each p (car:last lines) (= (field p) nil)) ;; 一番上の行は空白にする ;; 追加 (= score (+ score 100) span (int (* span 0.9))) ;; ... main関数 (when (is 'over (ccc (fn (cc) (= game-over cc) (= stage (make-stage)) ((afn (stage) (stage 'tick) (stage 'draw) (arc.time::set-timer self span nil stage)) stage)))) (alert (+ "GAME OVER - SCORE " score)))
できました！
全体はこんな感じです。
(= score 0 span 800) (def keydown (c) (stage 'keydown c)) (def make-tetromino (typ stage) (withs ((base color) (case typ I '(((0 . 0) (1 . 0) (-1 . 0) (-2 . 0)) "#0FF") O '(((0 . 0) (1 . 0) (1 . 1) (0 . 1)) "#FF0") T '(((0 . 0) (0 . 1) (1 . 0) (-1 . 0)) "#F0F") J '(((0 . 0) (-2 . 0) (-1 . 0) (0 . 1)) "#00F") L '(((0 . 0) (0 . 1) (1 . 0) (2 . 0)) "#F70") S '(((0 . 0) (1 . 0) (0 . 1) (-1 . 1)) "#0F0") Z '(((0 . 0) (-1 . 0) (0 . 1) (1 . 1)) "#F00")) p '(4 . 0) origin (fn (p) (fn ((x . y)) (cons (+ car.p x) (+ cdr.p y)))) r idfn rotate (fn (r) (compose (fn ((x . y)) (cons y (- x))) r)) get (fn (p r) (map1 (compose origin.p r) base))) (rfn tetromino (cmd (o arg nil)) (case cmd color color get (get p r) move (let np (case arg left (cons (- car.p 1) cdr.p) right (cons (+ car.p 1) cdr.p) down (cons car.p (+ cdr.p 1))) (when (stage 'can-put? (get np r)) (= p np) t)) rotate (let nr (rotate r) (when (stage 'can-put? (get p nr)) (= r nr) t)) draw (each pn (get p r) (draw car.pn cdr.pn color)))))) (def make-stage () (withs (field {} positions (mappend (fn (y) (map1 [cons _ y] (range 0 9))) (nrev (range 0 19))) target (fn _) overflow? (fn (x y) (no (and (<= 0 x 9) (<= 0 y 19))))) (rfn stage (cmd (o o1 nil) (o o2 nil)) (case cmd can-put? (no (ccc (fn (cc) (each p o1 (when (or (overflow? car.p cdr.p) (field p)) (cc t)))))) tick (unless (do1 (target 'move 'down) (stage 'draw)) (each p (target 'get) (= (field p) (target 'color))) (stage 'line-clear) (stage 'add (make-tetromino (rand-elt '(I O T J L S Z)) stage))) add (if (stage 'can-put? (o1 'get)) (= target o1) (game-over 'over)) draw (do (clear) (target 'draw) (each p positions (aif (field p) (draw car.p cdr.p it)))) keydown (do (case o1 37 (target 'move 'left) ;left 38 (target 'rotate) ;up 39 (target 'move 'right) ;right 40 (target 'move 'down)) ;down (stage 'draw)) line-clear ((afn (lines) (when lines (let line car.lines (if (no (pos [no (field _)] line)) (do (map (fn (l1 l2) (map (fn (p1 p2) (= (field p1) (field p2))) l1 l2)) lines cdr.lines) (each p (car:last lines) (= (field p) nil)) (= score (+ score 100) span (int (* span 0.9))) (self lines)) (self cdr.lines))))) (tuples positions 10)))))) (when (is 'over (ccc (fn (cc) (= game-over cc stage (make-stage)) ((afn (stage) (stage 'tick) (stage 'draw) (arc.time::set-timer self span nil stage)) stage)))) (alert (+ "GAME OVER - SCORE " score)))
全体で80行程度で簡単なテトリスができました。
まとめ
いかがでしたでしょうか。今回はテトリスの作成を題材にArcJSを使って見ることをしました。
こんな感じに、ブラウザでちょっとLispを使いたい時のBiwaSchemeとは違うもう一つの選択肢になるかもしれません。
今回はわかりやすくするために、ゲームっぽいものを作りましたが、仕事では、弊社システム管理のためのDSLを作るために、ArcJSを使っていたりします。
DSLはS式の形であわらされ、リアルタイムにコードチェックされ、Fixすると実コードにコンパイルされ、弊社システムにコンフィギュレートされます。
実際、JavaScriptで書くよりLispで書いたほうがアドバンテージがあるのは、今回のゲームのような処理よりむしろ、DSL実装などの処理なのかなぁとテトリス作ってて思いました。
以上です。ではみなさま良いお年を。
