SnakeゲームでClojure入門 その２
「SnakeゲームでClojure入門 - oknknicの日記」のSnakeゲームを少し改良してみたので以下に貼っておく。
; Snakeゲーム（改良版）
; 【改良点】
; 1)機能追加、キー割当追加
; s: ゲーム開始/一時停止/一時停止解除
; r: ゲームリセット
; n: ゲーム一時停止中に、1時間単位進める
; 2)壁の導入
(ns reader.snake
(:import (java.awt Color Dimension)
(javax.swing JPanel JFrame Timer JOptionPane)
(java.awt.event ActionListener KeyListener KeyEvent)))
; ----------------------------------------------------------
; 関数モデル(functional model)層
; ----------------------------------------------------------
(def width 30) ; 有効範囲は 0 〜 width-1
(def height 30) ; 有効範囲は 0 〜 height-1
(def point-size 10)
(def turn-millis 75) ; heart-beat
(def win-length 30)
(def dirs {KeyEvent/VK_LEFT [-1 0] ; Event#getKeyCodeの戻り値に応じた方向を定義
KeyEvent/VK_RIGHT [ 1 0]
KeyEvent/VK_UP [ 0 -1]
KeyEvent/VK_DOWN [ 0 1]})
(defn add-points
"移動前の座標と移動量から、移動後の座標を算出します。
useage: (add-points [3 5] [1 1])
=> [4 6]"
[& pts]
(vec (apply map + pts)))
(defn point-to-screen-rect
"座標から、ビットマップ上の正方形表現（x,y,横幅,縦幅からなるベクタ）を算出します。
useage: (point-to-screen-rect [3 5])
=> (30 50 10 10) ※point-size が 10 の場合の例"
[pt]
(map #(* point-size %)
[(pt 0) (pt 1) 1 1]))
(defn create-apple
"新規のリンゴ（座標,色,タイプからなるマップ）を算出します。
useage: (create-apple)
=> {:location [73 44], :color #<Color java.awt.Color[r=210,g=50,b=90]>, :type :apple} ※locationの値は乱数"
[]
{:location [(rand-int width) (rand-int height)]
:color (Color. 210 50 90)
:type :apple})
(defn create-snake
"新規のヘビ(座標リスト,方向,色,タイプからなるマップ)を算出します。
useage: (create-snake)
=> {:body ([1 1]), :dir [1 0], :type :snake, :color #<Color java.awt.Color[r=15,g=160,b=70]>}"
[]
{:body (list [1 1])
:dir [1 0]
:type :snake
:color (Color. 15 160 70)})
(defn create-wall
"ゲーム領域境界の壁を算出します。
useage: (create-wall)"
[]
{:body (for [x (range -1 (inc width)) y (range -1 (inc height)) :when (or (= x -1) (= x width) (= y -1) (= y height))] [x y]) ; リスト内包表記
:type :wall
:color (Color. 153 76 0)})
(defn move
"移動前のヘビから移動後のヘビを算出します。
useage: (move (create-snake))
=> {:body ([2 1]), :dir [1 0], :type :snake, :color #<Color java.awt.Color[r=15,g=160,b=70]>}"
[{:keys [body dir] :as snake} & grow] ; 分配束縛。body, dir には引数のそれぞれのキー値を、snakeには引数本体を束縛
(assoc snake :body ; ヘビの体を置き換えたシーケンスを生成
(cons (add-points (first body) dir) ; ヘビの体の先頭に、移動後の座標を追加する
(if grow body (butlast body))))) ; 引数にgrow（成長フラグ）が渡されなかった場合は、ヘビの体の末尾を除去（移動であるため）
(defn win?
"ヘビから、ゲームに勝利済であるかを算出します。
useage: (win? {:body [[1 1] [1 2]]})
=> false ※win-lengthが3以上の場合の例"
[{body :body}]
(>= (count body) win-length))
(defn head-overlaps-body?
"ヘビから、頭が体に被っているかを算出します。
useage: (head-overlaps-body? {:body [[3 1] [3 1] [2 1] [1 1]]})
=> true"
[{[head & body] :body}]
(contains? (set body) head))
(defn head-overlaps-wall?
"ヘビと壁から、ヘビの頭が壁に被っているかを算出します。
useage: (head-overlaps-wall? {:body [[1 0] [1 1]]} {:body [[0 0] [0 1] [0 2] [1 0] [1 2] [2 0] [2 1] [2 2]]})
=> true"
[{[snake-head] :body} {wall :body}]
(contains? (set wall) snake-head))
(defn lose?
"ヘビと壁から、ゲームに敗北済であるかを算出します。
useage: (lose? {:body [[3 1] [3 1] [2 1] [1 1]]} {:body [[0 0] [0 1] [0 2] [1 0] [1 2] [2 0] [2 1] [2 2]]})
=> true"
[snake wall]
(or (head-overlaps-body? snake)
(head-overlaps-wall? snake wall)))
(defn eats?
"ヘビとリンゴから、ヘビがリンゴを食べられるか（ヘビの頭の座標にリンゴが存在するか）を算出します。
useage: (eats? {:body [[1 1] [2 1]]} {:location [1 1]})
=> true"
[{[snake-head] :body} {apple :location}] ; 分配束縛。snake-headはヘビの体の１番目の座標
(= snake-head apple))
(defn turn
"方向変更前のヘビと新しい方向から、方向変更後のヘビを算出します。
useage: (turn (create-snake) [0 -1])
=> {:body ([1 1]), :dir [0 -1], :type :snake, :color #<Color java.awt.Color[r=15,g=160,b=70]>}"
[snake newdir]
(assoc snake :dir newdir))
; ----------------------------------------------------------
; 変更可能モデル(mutable model)層
; ----------------------------------------------------------
(defn reset-game
"ゲームを初期状態に戻します（引数のリファレンス（ヘビとリンゴ）を初期化します）。
useage: (#(let [snake (ref nil) apple (ref nil)] (reset-game snake apple) {:snake @snake :apple @apple}))
=> {:snake {:body ([1 1]), :dir [1 0], :type :snake, :color #<Color java.awt.Color[r=15,g=160,b=70]>}, :apple {:location [20 23], :color #<Color java.awt.Color[r=210,g=50,b=90]>, :type :apple}}"
[snake apple wall]
(dosync (ref-set apple (create-apple))
(ref-set snake (create-snake))
(ref-set wall (create-wall)))
nil)
(defn update-direction
"ヘビの方向を変更します。
useage: (#(let [snake (ref nil)] (dosync (ref-set snake (create-snake)) (update-direction snake [0 -1])) @snake))
=> {:body ([1 1]), :dir [0 -1], :type :snake, :color #<Color java.awt.Color[r=15,g=160,b=70]>}"
[snake newdir]
(when ((complement nil?) newdir) ; 方向未指定の場合は何もしない
(dosync (alter snake turn newdir))))
(defn update-positions
"1ターン進めます。
useage: (#(let [snake (ref nil) apple (ref nil)] (dosync (ref-set snake (create-snake)) (update-positions snake apple)) {:snake @snake :apple @apple}))
=> {:snake {:body ([2 1]), :dir [1 0], :type :snake, :color #<Color java.awt.Color[r=15,g=160,b=70]>}, :apple nil}"
[snake apple]
(dosync
(if (eats? @snake @apple)
(do (ref-set apple (create-apple))
(alter snake move :grow))
(alter snake move)))
nil)
; ----------------------------------------------------------
; GUI層
; ----------------------------------------------------------
(defn fill-point
"座標に色を塗ります。"
[g pt color]
(let [[x y width height] (point-to-screen-rect pt)]
(.setColor g color)
(.fillRect g x y width height)))
(defmulti paint
"オブジェクトを描画します。"
(fn [g object & _] (:type object))) ; マルチメソッド。オブジェクトのタイプで呼び分ける
(defmethod paint :apple [g {:keys [location color]}]
(fill-point g location color))
(defmethod paint :snake [g {:keys [body color]}]
(doseq [point body]
(fill-point g point color)))
(defmethod paint :wall [g {:keys [body color]}]
(doseq [point body]
(fill-point g point color)))
(defn toggle-timer
"タイマーの開始/終了状態をトグルします。"
[timer]
(if (. timer isRunning)
(. timer stop)
(. timer start)))
(defn action-once
"1度だけアクションを起こします。"
[timer]
(dorun (map #(. % actionPerformed nil) (. timer getActionListeners)))) ; dorunにより、遅延シーケンスを強制評価
(defmulti key-action
"キー入力に応じて動作します。"
(fn [key-code & _]
(if ((complement nil?) (dirs key-code))
:dirs
key-code)))
(defmethod key-action :dirs ;ヘビの方向を変更します。
[key-code snake & _]
(update-direction snake (dirs key-code)))
(defmethod key-action KeyEvent/VK_S ;ゲームの一時停止/再開をトグルします。
[_ _ _ _ _ _ timer & _]
(toggle-timer timer))
(defmethod key-action KeyEvent/VK_R ;ゲームをリセットします。
[_ snake apple wall _ panel timer & _]
(reset-game snake apple wall)
(. timer stop)
(. panel repaint))
(defmethod key-action KeyEvent/VK_N ;1時間単位進めます。
[_ _ _ _ _ _ timer & _]
(action-once timer))
(defmethod key-action :default [& _] ;動作未定義のため、何もしません。
nil)
(defn game-panel
"ゲーム画面用のパネルを生成します。"
[snake apple wall]
(proxy [JPanel] []
(paintComponent [g] ; パネル描画の際に呼びされる関数
(proxy-super paintComponent g)
(paint g @snake)
(paint g @apple)
(paint g @wall))
(getPreferredSize [] ; パネルの初期サイズを決定する関数
(Dimension. (* width point-size)
(* height point-size)))))
(defn game-listener
"ゲーム画面用のリスナーを生成します。"
[snake apple wall frame panel timer]
(proxy [ActionListener KeyListener] []
(actionPerformed [e] ; タイマー割り込み毎に呼び出される関数
(update-positions snake apple)
(when (lose? @snake @wall)
(reset-game snake apple wall)
(JOptionPane/showMessageDialog frame "You lose!")
(. timer stop))
(when (win? @snake)
(reset-game snake apple wall)
(JOptionPane/showMessageDialog frame "You win!")
(. timer stop))
(.repaint panel))
(keyPressed [e]
(key-action (.getKeyCode e) snake apple wall frame panel timer))
(keyReleased [e]) ; 何もしない
(keyTyped [e]))) ; 何もしない
(defn game
"Snakeゲームを開始します。"
[]
(let [snake (ref (create-snake))
apple (ref (create-apple))
wall (ref (create-wall))
frame (JFrame. "Snake")
panel (game-panel snake apple wall)
timer (Timer. turn-millis nil) ; timerとlistenerは相互参照関係のため、timerへのlistenerの設定は別途実施
listener (game-listener snake apple wall frame panel timer)]
(doto panel
(.setFocusable true)
(.addKeyListener listener))
(doto frame
(.add panel)
(.pack)
(.setVisible true))
(. timer addActionListener listener)
[snake, apple, timer]))
