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 9 years ago
parent daef10075f
commit 5a0079eafd
  1. 5
      resources/public/index.html
  2. 330
      src/cljs/frpong/core.cljs
  3. 67
      src/cljs/frpong/helpers.cljs

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

@ -1,6 +1,6 @@
(ns frpong.core
(:require [frpong.helpers :as h]
[cljs.core.async :refer [<! >! chan put!]]
(:require [frpong.helpers :as h :refer (mult tap)]
[cljs.core.async :refer [<! >! chan put! close! sliding-buffer]]
[domina :as dom :refer [log]])
(:require-macros [cljs.core.async.macros :as m :refer [go]]
[frpong.core :refer (go-loop)]))
@ -34,163 +34,173 @@
(let [c (chan)]
(go
(loop [prev (<! frames)]
(let [t (<! frames)]
(when (< t (* 10 prev))
(>! c t))
(recur t))))
(if-let [t (<! frames)]
(do (when (< t (* 10 prev)) (>! c t))
(recur t))
(close! c))))
c))
(defn ticker [[frames stop-frames] ticks game-state]
(let [ticks-in (tick-chan (h/diff-chan frames))]
(go-loop
(if-not (= :gameover (<! game-state))
(>! ticks (<! ticks-in))
(stop-frames)))))
(defn ball-positioner [ticks vel pos-in pos-out]
(go-loop
(let [tick (<! ticks)
[vel-x vel-y] (<! vel)
[x y] (<! pos-in)
pos-next [(+ x (* vel-x tick)) (+ y (* vel-y tick))]]
(>! pos-out pos-next))))
(defn paddle-positioner [keycodes max-y movement pos-in pos-out]
(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
[{:keys [width height padding paddle-size paddle-width]}
ticks game-state pos vel-in vel-out pl-pos pr-pos]
(let [ef-paddle-width (+ paddle-width padding)
adjust-v (fn [state v] [(condp = state
:collision-left (abs v)
:collision-right (- (abs v))
:moving v
: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]
(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")]
(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
frames game-state pos vel pl-pos pr-pos]
(let [max-y (- height paddle-size)
ticks (chan)
[tick-pos tick-collsion tick-pl tick-pr] (h/multiplex ticks 4)
[pos-in pos-collision pos-render] (h/multiplex pos 3)
[vel-pos vel-collision] (h/multiplex vel 2)
[pl-pos-in pl-pos-collision pl-pos-render] (h/multiplex pl-pos 3)
[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}
{:keys [init-pos init-vel paddle-movement]} frames]
(let [init-paddle-pos (/ (- height paddle-size) 2)
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
(game-setup layout paddle-movement frames game-state pos vel pl-pos pr-pos))))
(defn ^:export init []
(let [layout {:width 800
:height 400
:padding 5
:paddle-size 100
: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)
[frames-fps frames-count frames-game] (h/multiplex frames 3)
fps (h/map-chan #(/ 1000 %) (h/diff-chan frames-fps))
frames-count (h/counting-chan frames-count)
fps-el (dom/by-id "fps")
frame-el (dom/by-id "frame")]
(doto (dom/by-id "canvas")
(dom/set-style! "width" (str (:width layout) "px"))
(dom/set-style! "height" (str (:height layout) "px")))
(doto (dom/by-id "ball")
(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
(dom/set-text! fps-el (<! fps))
(dom/set-text! frame-el (<! frames-count)))
(game-init layout init-vals [frames-game stop-frames])))
(defn next-pos [[x y] [vel-x vel-y] tick]
[(+ x (* vel-x tick)) (+ y (* vel-y tick))])
(defn ^:export frpong []
(let [width 800
height 400
padding 5
paddle-size 100
paddle-width 10
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)
[frames stop-frames] (h/frame-chan)]
(defn ticker [frames game-state ticks]
(let [ticks-in (tick-chan (h/diff-chan frames))]
(go (loop []
(let [gs (<! game-state)]
(do (>! ticks (<! ticks-in))
(if (= :gameover gs)
(stop-frames)
(recur))))))))
(defn ball-positioner [ticks vel pos-in pos-out]
(go-loop
(let [tick (<! ticks)
pos-next (next-pos (<! pos-in) (<! vel) tick)]
(>! pos-out pos-next))))
(defn paddle-positioner [keycodes pos-in pos-out]
(let [keys (h/key-chan keycodes)]
(go-loop
(let [pos (<! pos-in)]
(>! pos-out
(condp = (<! keys)
:up (max (- pos paddle-step) 0)
:down (min (+ pos paddle-step) max-paddle-y)))))))
(defn collision-detector [ticks pos vel-in pl-pos pr-pos game-state vel-out]
(defn in-y-range? [y paddle-y]
(and (> y (+ paddle-y padding)) (< y (- (+ paddle-y paddle-size) padding))))
(defn detect-x-collision [x y lpaddle-y rpaddle-y]
(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 detect-y-collision [y]
(cond
(< y padding) :collision-left
(> y (- height padding)) :collision-right
:else :moving))
(defn collision? [x-state y-state]
(or (= x-state :collision-left) (= x-state :collision-right)
(= y-state :collision-left) (= y-state :collision-right)))
(defn adjust-vel [state v]
(condp = state
:collision-left (abs v)
:collision-right (- (abs v))
:moving v
:gameover 0))
(go-loop
(let [tick (<! ticks)
[vel-x vel-y] (<! vel-in)
[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)))

@ -195,3 +195,70 @@
(recur (rem (inc count) n)))
(close! 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))
Loading…
Cancel
Save