Clojure Script と core.async で、ブロック崩し
core.asyncでメインループを手に入れる #Clojure – Qiita を見ておもしろそうだったので、以前から気になっていたcore.asyncでブロック崩しを作ってみました。
まずはイベントドリブンで作成
shadow-cljsでプロジェクトを作成
$ npx create-cljs-project breackout
srcフォルダ構成を変更して、shadow-cljs.ednも変更
;; shadow-cljs configuration
{:source-paths
["src"]
:dependencies
[]
:dev-http {8080 "public"}
:builds
{:app
{:target :browser
:modules {:main {:init-fn breakout.core/init}}}}}
ブラウザでcanvasを使ってゲームを作るのは初めてなので、純粋な JavaScript を使ったブロック崩しゲーム – ゲーム開発 | MDN ｋ(mozilla.org) を参考に。/public/index.htmlを作成。
全部で step 10 までだけど、ひとまず完成となっている step 8 までの内容を参考に、以下のように作成してみました。
(ns breakout.core)
(def canvas (.getElementById js/document "myCanvas"))
(def ctx (.getContext canvas "2d"))
;;定数
(def left-key 37)
(def right-key 39)
(def ball-radius 10)
(def paddle-height 10)
(def paddle-width 75)
(def paddle-y (- canvas.height paddle-height))
(def paddle-speed 7)
(def brick-row-count 3)
(def brick-column-count 5)
(def brick-width 75)
(def brick-height 20)
(def brick-padding 10)
(def brick-offset-top 30)
(def brick-offset-left 30)
;; 状態の保持
(def interval-id (atom nil))
(def game-state (atom {}))
;; キーイベント
(defn keydown [state event]
(condp = (.-keyCode event)
left-key (assoc state :left-key-pressed true)
right-key (assoc state :right-key-pressed true)
state))
(defn keyup [state event]
(condp = (.-keyCode event)
left-key (assoc state :left-key-pressed false)
right-key (assoc state :right-key-pressed false)
state))
(.addEventListener js/document "keydown" #(swap! game-state merge (keydown @game-state %)) false)
(.addEventListener js/document "keyup" #(swap! game-state merge (keyup @game-state %)) false)
;; 描画
(defn draw-ball [ball-x ball-y]
(.beginPath ctx)
(.arc ctx ball-x ball-y ball-radius 0 (* Math/PI 2))
(set! (.-fillStyle ctx) "#0095DD")
(.fill ctx)
(.closePath ctx))
(defn draw-rect [x y width height color]
(.beginPath ctx)
(.rect ctx x y width height)
(set! (.-fillStyle ctx) color)
(.fill ctx)
(.closePath ctx))
(defn draw-paddle [paddle-x]
(draw-rect paddle-x paddle-y paddle-width paddle-height "#0095DD"))
(defn draw-brick [x y]
(draw-rect x y brick-width brick-height "#0095DD"))
(defn draw-score [score]
(set! (.-font ctx) "16px Arial")
(set! (.-fillStyle ctx) "#0095DD")
(.fillText ctx (str "Score: " score) 8 20))
(defn clear-screen []
(.clearRect ctx 0 0 canvas.width canvas.height))
;;
(defn collision? [brick-x brick-y brick-width brick-height ball-x ball-y]
(and (<= brick-x ball-x (+ brick-x brick-width))
(<= brick-y ball-y (+ brick-y brick-height))))
;;
(defn setup
"最初に一回だけ呼ばれ、初期の状態を返す"
[]
{:ball-x (/ canvas.width 2)
:ball-y (- canvas.height 30)
:ball-dx 2
:ball-dy -2
:paddle-x (/ (- canvas.width paddle-width) 2)
:bricks (for [x (range brick-column-count)
y (range brick-row-count)]
{:x (+ (* x (+ brick-width brick-padding))
brick-offset-left)
:y (+ (* y (+ brick-height brick-padding))
brick-offset-top)})
:right-key-pressed false
:left-key-pressed false
:gameover false
:score 0})
(defn update-state
"引数で状態を受け取って、更新した状態を返す"
[state]
(let [update-ball-position (fn [{:keys [ball-dx ball-dy] :as state}]
(-> state
(update :ball-x + ball-dx)
(update :ball-y + ball-dy)))
bounce-wall-or-paddle (fn [{:keys [ball-x ball-y paddle-x] :as state}]
(-> state
;;top wall
(#(if (< ball-y ball-radius)
(update % :ball-dy -)
%))
;;bottom wall or paddle
(#(if (< (- canvas.height ball-radius) (:ball-y %))
(if (< paddle-x ball-x (+ paddle-x paddle-width))
(update % :ball-dy -)
(assoc % :gameover true))
%))
;;left or right wall
(#(if (or (< ball-x ball-radius)
(< (- canvas.width ball-radius) (:ball-x %)))
(update % :ball-dx -)
%))))
update-paddle-position (fn [{:keys [paddle-x right-key-pressed left-key-pressed] :as state}]
(-> state
(#(if right-key-pressed
(assoc % :paddle-x (min (+ paddle-x paddle-speed)
(- canvas.width paddle-width)))
%))
(#(if left-key-pressed
(assoc % :paddle-x (max (- paddle-x paddle-speed)
0))
%))))
collision-brick (fn [{:keys [bricks ball-x ball-y] :as state}]
(let [surviving-bricks (remove (fn [{:keys [x y]}]
(collision? x y brick-width brick-height ball-x ball-y))
bricks)]
(if (not= bricks surviving-bricks)
(-> state
(assoc :bricks surviving-bricks)
(update :ball-dy -)
(update :score inc))
state)))]
(-> state
(update-ball-position)
(update-paddle-position)
(bounce-wall-or-paddle)
(collision-brick))))
(defn draw-state
"引数で受け取った状態をもとに描画"
[state]
(clear-screen)
(let [{:keys [ball-x ball-y paddle-x gameover bricks score]} state]
(cond
gameover (do
(js/alert "game over")
(js/document.location.reload)
(js/clearInterval @interval-id))
(empty? bricks) (do
(js/alert "you win. congratuaion!")
(js/document.location.reload)
(js/clearInterval @interval-id))
:else (do
(draw-ball ball-x ball-y)
(draw-paddle paddle-x)
(doseq [{:keys [x y]} bricks]
(draw-brick x y))
(draw-score score)))))
;;
(defn game-loop []
(let [new-state (update-state @game-state)]
(draw-state new-state)
(swap! game-state merge new-state)))
(defn init []
(reset! game-state merge (setup))
(reset! interval-id (js/setInterval game-loop 10)))
Clojure版のProcessing である Quil にならって、初期状態を設定して返す「setup」、引数で受け取った状態を変更して返す「update-state」、引数で受け取った状態をもとに描画する「draw-state」に処理を分けました。
$ npx shadow-cljs watch appで、動作確認OK。
core.asyncを使ってみる
ここから、core.async に置き換えていきます。
shadow-cljs.edn に core.async の依存を追加。
;shadow-cljs.edn
:dependencies
[[org.clojure/core.async "1.6.681"]] ;変更
core.cljs に、core.asyncのrequireを追加。
(ns breakout.core
(:require [cljs.core.async :refer [chan timeout put! alts! go-loop]] ;追加
[goog.events :as gevent]))
まずは、init の中に go-loop を作り、その中で setup, update-state, draw-state を回します。ウェイトを入れるためにtimeouを使います。
ボールが動くようになりました。
(defn init []
(go-loop [state (setup)]
(let [new-state (update-state state)]
(draw-state new-state)
(<! (timeout 10))
(recur new-state))))
次に、キー操作でパドルが動くように変更します。チャネルを２つ作成し、keydown, keyupイベント発生時の情報をそこに入れます。
(def keydown-ch
(let [c (chan)]
(gevent/listen js/document "keydown" #(put! c %))
c))
(def keyup-ch
(let [c (chan)]
(gevent/listen js/document "keyup" #(put! c %))
c))
go-loopの中でalts!を使って、keydownとkeyupのチャンネルとtimeout のどれかから情報を受け取って、それをもとに状態を更新する処理を追加して、キー操作でパドルが動くようになりました。
(defn init []
(go-loop [state (setup)]
(let [[event ch] (alts! [keydown-ch keyup-ch (timeout 10)])
new-state (-> state
(#(condp = ch
keydown-ch (keydown % event)
keyup-ch (keyup % event)
%))
(update-state))]
(draw-state new-state)
(recur new-state))))
まとめ
とりあえず動くようにはなったけど、課題としては
- go-loop の中で呼んでいる関数内で game over などの alert を出しているので、モーダルダイアログが連続で表示される。
- チャネルに transducer を設定したり、pipe を使ったりして、もっとcore.asyncっぽく作れないか？