Clojure Script と core.async で、ブロック崩し

2024-01-30

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 k(mozilla.org) を参考に。

全部で 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」に処理を分けました。

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))))

次に、キー操作でパドルが動くように変更します。チャネルを2つ作成し、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っぽく作れないか?