Cleaned up code.

1. Moved from multiplex to mult
2. Moved functions inside a global function to avoid passing settings as parameters
3. Added some comments and changed some binding names.
master
Abhinav Sarkar 2013-10-12 15:12:08 +05:30
parent daef10075f
commit 5a0079eafd
3 changed files with 228 additions and 152 deletions

View File

@ -2,13 +2,12 @@
<html lang="en"> <html lang="en">
<head> <head>
<meta charset="utf-8"> <meta charset="utf-8">
<title>Simple CLJS</title> <title>Functional Reactive Pong in Clojure using core.async</title>
<!--[if lt IE 9]> <!--[if lt IE 9]>
<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script> <script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
<![endif]--> <![endif]-->
</head> </head>
<body> <body>
<div>Frame: <span id="frame"></span></div>
<div>FPS: <span id="fps"></span></div> <div>FPS: <span id="fps"></span></div>
<div>State: <span id="state"></span></div> <div>State: <span id="state"></span></div>
<svg style="border: 1px black solid" id="canvas"> <svg style="border: 1px black solid" id="canvas">
@ -19,6 +18,6 @@
<!-- pointing to cljsbuild generated js file --> <!-- pointing to cljsbuild generated js file -->
<script src="js/frpong.js"></script> <script src="js/frpong.js"></script>
<script type="text/javascript">frpong.core.init()</script> <script type="text/javascript">frpong.core.frpong()</script>
</body> </body>
</html> </html>

View File

@ -1,6 +1,6 @@
(ns frpong.core (ns frpong.core
(:require [frpong.helpers :as h] (:require [frpong.helpers :as h :refer (mult tap)]
[cljs.core.async :refer [<! >! chan put!]] [cljs.core.async :refer [<! >! chan put! close! sliding-buffer]]
[domina :as dom :refer [log]]) [domina :as dom :refer [log]])
(:require-macros [cljs.core.async.macros :as m :refer [go]] (:require-macros [cljs.core.async.macros :as m :refer [go]]
[frpong.core :refer (go-loop)])) [frpong.core :refer (go-loop)]))
@ -34,163 +34,173 @@
(let [c (chan)] (let [c (chan)]
(go (go
(loop [prev (<! frames)] (loop [prev (<! frames)]
(let [t (<! frames)] (if-let [t (<! frames)]
(when (< t (* 10 prev)) (do (when (< t (* 10 prev)) (>! c t))
(>! c t)) (recur t))
(recur t)))) (close! c))))
c)) c))
(defn ticker [[frames stop-frames] ticks game-state] (defn next-pos [[x y] [vel-x vel-y] tick]
(let [ticks-in (tick-chan (h/diff-chan frames))] [(+ x (* vel-x tick)) (+ y (* vel-y tick))])
(go-loop
(if-not (= :gameover (<! game-state))
(>! ticks (<! ticks-in))
(stop-frames)))))
(defn ball-positioner [ticks vel pos-in pos-out] (defn ^:export frpong []
(go-loop (let [width 800
(let [tick (<! ticks) height 400
[vel-x vel-y] (<! vel) padding 5
[x y] (<! pos-in) paddle-size 100
pos-next [(+ x (* vel-x tick)) (+ y (* vel-y tick))]] paddle-width 10
(>! pos-out pos-next)))) ball-radius 5
init-pos [50 100]
init-vel [0.2 0.23]
paddle-step 20
max-paddle-y (- height paddle-size)
ef-paddle-width (+ paddle-width padding)
(defn paddle-positioner [keycodes max-y movement pos-in pos-out] [frames stop-frames] (h/frame-chan)]
(let [keys (h/key-chan keycodes)]
(go-loop
(let [pos (<! pos-in)]
(>! pos-out
(condp = (<! keys)
:up (max (- pos movement) 0)
:down (min (+ pos movement) max-y)))))))
(defn collision-detector (defn ticker [frames game-state ticks]
[{:keys [width height padding paddle-size paddle-width]} (let [ticks-in (tick-chan (h/diff-chan frames))]
ticks game-state pos vel-in vel-out pl-pos pr-pos] (go (loop []
(let [ef-paddle-width (+ paddle-width padding) (let [gs (<! game-state)]
adjust-v (fn [state v] [(condp = state (do (>! ticks (<! ticks-in))
:collision-left (abs v) (if (= :gameover gs)
:collision-right (- (abs v)) (stop-frames)
:moving v (recur))))))))
:gameover 0)
state])
in-y-range? (fn [y p-pos] (and (> y (+ p-pos padding))
(< y (- (+ p-pos paddle-size) padding))))
detect-x-collision (fn [x y pl-pos pr-pos]
(cond
(< x ef-paddle-width)
(if (in-y-range? y pl-pos) :collision-left :gameover)
(> x (- width ef-paddle-width))
(if (in-y-range? y pr-pos) :collision-right :gameover)
:else :moving))
detect-y-collision (fn [y] (cond
(< y padding) :collision-left
(> y (- height padding)) :collision-right
:else :moving))]
(go-loop
(let [tick (<! ticks)
[vel-x vel-y] (<! vel-in)
[x y] (<! pos)
pl-pos (<! pl-pos)
pr-pos (<! pr-pos)
[xn yn] [(+ x (* vel-x tick)) (+ y (* vel-y tick))]
[vel-xn bs-x] (adjust-v (detect-x-collision xn yn pl-pos pr-pos) vel-x)
[vel-yn bs-y] (adjust-v (detect-y-collision yn) vel-y)]
(>! vel-out [vel-xn vel-yn])
(>! game-state
(cond
(= bs-x :gameover) :gameover
(or (= bs-x :collision-left) (= bs-x :collision-right)
(= bs-y :collision-left) (= bs-y :collision-right)) :collision
:else :moving))))))
(defn renderer [game-state pos pl-pos pr-pos] (defn ball-positioner [ticks vel pos-in pos-out]
(let [ball-el (dom/by-id "ball") (go-loop
state-el (dom/by-id "state") (let [tick (<! ticks)
lpaddle-el (dom/by-id "lpaddle") pos-next (next-pos (<! pos-in) (<! vel) tick)]
rpaddle-el (dom/by-id "rpaddle")] (>! pos-out pos-next))))
(go-loop
(let [[x y] (<! pos)
gs (<! game-state)]
(dom/set-text! state-el (name gs))
(doto ball-el
(dom/set-attr! "cx" x)
(dom/set-attr! "cy" y))))
(go-loop
(dom/set-attr! lpaddle-el "y" (<! pl-pos)))
(go-loop
(dom/set-attr! rpaddle-el "y" (<! pr-pos)))))
(defn game-setup [{:keys [width height padding paddle-size] :as layout} paddle-movement (defn paddle-positioner [keycodes pos-in pos-out]
frames game-state pos vel pl-pos pr-pos] (let [keys (h/key-chan keycodes)]
(let [max-y (- height paddle-size) (go-loop
ticks (chan) (let [pos (<! pos-in)]
[tick-pos tick-collsion tick-pl tick-pr] (h/multiplex ticks 4) (>! pos-out
[pos-in pos-collision pos-render] (h/multiplex pos 3) (condp = (<! keys)
[vel-pos vel-collision] (h/multiplex vel 2) :up (max (- pos paddle-step) 0)
[pl-pos-in pl-pos-collision pl-pos-render] (h/multiplex pl-pos 3) :down (min (+ pos paddle-step) max-paddle-y)))))))
[pr-pos-in pr-pos-collision pr-pos-render] (h/multiplex pr-pos 3)
[game-state-ticker game-state-render] (h/multiplex game-state 2)]
(ticker frames ticks game-state-ticker)
(ball-positioner tick-pos vel-pos pos-in pos)
(collision-detector layout tick-collsion game-state pos-collision vel-collision vel
(h/sustain pl-pos-collision tick-pl)
(h/sustain pr-pos-collision tick-pr))
(paddle-positioner {83 :down 87 :up} max-y paddle-movement pl-pos-in pl-pos)
(paddle-positioner {38 :up 40 :down} max-y paddle-movement pr-pos-in pr-pos)
[game-state-render pos-render pl-pos-render pr-pos-render]))
(defn game-init [{:keys [height paddle-size] :as layout} (defn collision-detector [ticks pos vel-in pl-pos pr-pos game-state vel-out]
{:keys [init-pos init-vel paddle-movement]} frames] (defn in-y-range? [y paddle-y]
(let [init-paddle-pos (/ (- height paddle-size) 2) (and (> y (+ paddle-y padding)) (< y (- (+ paddle-y paddle-size) padding))))
pos (chan 1)
vel (chan 1)
pl-pos (chan 1)
pr-pos (chan 1)
game-state (chan 1)]
(put! pos init-pos)
(put! vel init-vel)
(put! pl-pos init-paddle-pos)
(put! pr-pos init-paddle-pos)
(put! game-state :moving)
(apply renderer (defn detect-x-collision [x y lpaddle-y rpaddle-y]
(game-setup layout paddle-movement frames game-state pos vel pl-pos pr-pos)))) (cond
(< x ef-paddle-width)
(if (in-y-range? y lpaddle-y) :collision-left :gameover)
(> x (- width ef-paddle-width))
(if (in-y-range? y rpaddle-y) :collision-right :gameover)
:else :moving))
(defn ^:export init [] (defn detect-y-collision [y]
(let [layout {:width 800 (cond
:height 400 (< y padding) :collision-left
:padding 5 (> y (- height padding)) :collision-right
:paddle-size 100 :else :moving))
:paddle-width 10
:ball-radius 5}
init-vals {:init-pos [50 100]
:init-vel [0.3 0.33]
:paddle-movement 20}
[frames stop-frames] (h/frame-chan) (defn collision? [x-state y-state]
[frames-fps frames-count frames-game] (h/multiplex frames 3) (or (= x-state :collision-left) (= x-state :collision-right)
fps (h/map-chan #(/ 1000 %) (h/diff-chan frames-fps)) (= y-state :collision-left) (= y-state :collision-right)))
frames-count (h/counting-chan frames-count)
fps-el (dom/by-id "fps") (defn adjust-vel [state v]
frame-el (dom/by-id "frame")] (condp = state
(doto (dom/by-id "canvas") :collision-left (abs v)
(dom/set-style! "width" (str (:width layout) "px")) :collision-right (- (abs v))
(dom/set-style! "height" (str (:height layout) "px"))) :moving v
(doto (dom/by-id "ball") :gameover 0))
(dom/set-attr! "r" (:ball-radius layout))
(dom/set-attr! "cx" (first (:init-pos init-vals)))
(dom/set-attr! "cy" (second (:init-pos init-vals))))
(doseq [id ["lpaddle" "rpaddle"]]
(doto (dom/by-id id)
(dom/set-attr! "width" (:paddle-width layout))
(dom/set-attr! "height" (:paddle-size layout))
(dom/set-attr! "y" (/ (- (:height layout) (:paddle-size layout)) 2))))
(dom/set-attr! (dom/by-id "lpaddle") "x" 0)
(dom/set-attr! (dom/by-id "rpaddle") "x" (- (:width layout) (:paddle-width layout)))
(go-loop (go-loop
(dom/set-text! fps-el (<! fps)) (let [tick (<! ticks)
(dom/set-text! frame-el (<! frames-count))) [vel-x vel-y] (<! vel-in)
(game-init layout init-vals [frames-game stop-frames]))) [x y] (<! pos)
lpaddle-y (<! pl-pos)
rpaddle-y (<! pr-pos)
[xn yn] (next-pos [x y] [vel-x vel-y] tick)
x-state (detect-x-collision xn yn lpaddle-y rpaddle-y)
vel-xn (adjust-vel x-state vel-x)
y-state (detect-y-collision yn)
vel-yn (adjust-vel y-state vel-y)]
(>! vel-out [vel-xn vel-yn])
(>! game-state
(cond
(= x-state :gameover) :gameover
(collision? x-state y-state) :collision
:else :moving)))))
(defn renderer [ticks game-state pos pl-pos pr-pos]
(let [ball-el (dom/by-id "ball")
state-el (dom/by-id "state")
lpaddle-el (dom/by-id "lpaddle")
rpaddle-el (dom/by-id "rpaddle")
fps-el (dom/by-id "fps")]
(go-loop
(let [fps (/ 1000 (<! ticks))
[x y] (<! pos)
gs (<! game-state)]
(dom/set-text! fps-el fps)
(dom/set-text! state-el (name gs))
(doto ball-el
(dom/set-attr! "cx" x)
(dom/set-attr! "cy" y))))
(go-loop
(dom/set-attr! lpaddle-el "y" (<! pl-pos)))
(go-loop
(dom/set-attr! rpaddle-el "y" (<! pr-pos)))))
(defn setup-components [frames game-state pos vel pl-pos pr-pos]
(let [ticks (chan)
ticks-m (mult ticks)
pos-m (mult pos)
vel-m (mult vel)
pl-pos-m (mult pl-pos)
pr-pos-m (mult pr-pos)
game-state-m (mult game-state)]
(ticker frames (tap game-state-m) ticks)
(ball-positioner (tap ticks-m) (tap vel-m) (tap pos-m) pos)
(paddle-positioner {83 :down 87 :up} (tap pl-pos-m) pl-pos)
(paddle-positioner {38 :up 40 :down} (tap pr-pos-m) pr-pos)
(collision-detector (tap ticks-m) (tap pos-m) (tap vel-m)
(h/sustain (tap pl-pos-m) (tap ticks-m (chan (sliding-buffer 1000))))
(h/sustain (tap pr-pos-m) (tap ticks-m (chan (sliding-buffer 1000))))
game-state vel)
(renderer (tap ticks-m) (tap game-state-m) (tap pos-m) (tap pl-pos-m) (tap pr-pos-m))))
(defn layout-game []
(doto (dom/by-id "canvas")
(dom/set-style! "width" (str width "px"))
(dom/set-style! "height" (str height "px")))
(doto (dom/by-id "ball")
(dom/set-attr! "r" ball-radius)
(dom/set-attr! "cx" (first init-pos))
(dom/set-attr! "cy" (second init-pos)))
(doseq [id ["lpaddle" "rpaddle"]]
(doto (dom/by-id id)
(dom/set-attr! "width" paddle-width)
(dom/set-attr! "height" paddle-size)
(dom/set-attr! "y" (/ (- height paddle-size) 2))))
(dom/set-attr! (dom/by-id "lpaddle") "x" 0)
(dom/set-attr! (dom/by-id "rpaddle") "x" (- width paddle-width)))
(defn start-game []
(let [init-paddle-pos (/ (- height paddle-size) 2) ;; initial paddle position
pos (chan 1) ;; ball position signal
vel (chan 1) ;; ball velocity signal
pl-pos (chan 1) ;; paddle left position signal
pr-pos (chan 1) ;; paddle right position signal
game-state (chan 1)] ;; game state signal
(layout-game)
(setup-components frames game-state pos vel pl-pos pr-pos)
;; start the game by setting the initial values of the signals
(put! pos init-pos)
(put! vel init-vel)
(put! pl-pos init-paddle-pos)
(put! pr-pos init-paddle-pos)
(put! game-state :moving)))
(start-game)))

View File

@ -195,3 +195,70 @@
(recur (rem (inc count) n))) (recur (rem (inc count) n)))
(close! c)))) (close! c))))
c)) c))
(defprotocol Mux
(muxch* [_]))
(defprotocol Mult
(tap* [m ch close?])
(untap* [m ch])
(untap-all* [m]))
(defn mult
"Creates and returns a mult(iple) of the supplied channel. Channels
containing copies of the channel can be created with 'tap', and
detached with 'untap'.
Each item is distributed to all taps in parallel and synchronously,
i.e. each tap must accept before the next item is distributed. Use
buffering/windowing to prevent slow taps from holding up the mult.
Items received when there are no taps get dropped.
If a tap put throws an exception, it will be removed from the mult."
[ch]
(let [cs (atom {}) ;;ch->close?
m (reify
Mux
(muxch* [_] ch)
Mult
(tap* [_ ch close?] (swap! cs assoc ch close?) nil)
(untap* [_ ch] (swap! cs dissoc ch) nil)
(untap-all* [_] (reset! cs {}) nil))
dchan (chan 1)
dctr (atom nil)
done #(when (zero? (swap! dctr dec))
(put! dchan true))]
(go (loop []
(let [val (<! ch)]
(if (nil? val)
(doseq [[c close?] @cs]
(when close? (close! c)))
(let [chs (keys @cs)]
(reset! dctr (count chs))
(doseq [c chs]
(put! c val done))
;;wait for all
(when (seq chs)
(<! dchan))
(recur))))))
m))
(defn tap
"Copies the mult source onto the supplied channel.
By default the channel will be closed when the source closes,
but can be determined by the close? parameter."
([mult] (tap mult (chan)))
([mult ch] (tap mult ch true))
([mult ch close?] (tap* mult ch close?) ch))
(defn untap
"Disconnects a target channel from a mult"
[mult ch]
(untap* mult ch))
(defn untap-all
"Disconnects all target channels from a mult"
[mult] (untap-all* mult))