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
parent
daef10075f
commit
5a0079eafd
|
|
@ -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,84 +34,112 @@
|
|||
(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]
|
||||
(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
|
||||
(if-not (= :gameover (<! game-state))
|
||||
(>! ticks (<! ticks-in))
|
||||
(stop-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)
|
||||
[vel-x vel-y] (<! vel)
|
||||
[x y] (<! pos-in)
|
||||
pos-next [(+ x (* vel-x tick)) (+ y (* vel-y tick))]]
|
||||
pos-next (next-pos (<! pos-in) (<! vel) tick)]
|
||||
(>! pos-out pos-next))))
|
||||
|
||||
(defn paddle-positioner [keycodes max-y movement pos-in pos-out]
|
||||
(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 movement) 0)
|
||||
:down (min (+ pos movement) max-y)))))))
|
||||
:up (max (- pos paddle-step) 0)
|
||||
:down (min (+ pos paddle-step) max-paddle-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
|
||||
(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)
|
||||
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))]
|
||||
:gameover 0))
|
||||
|
||||
(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)]
|
||||
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
|
||||
(= bs-x :gameover) :gameover
|
||||
(or (= bs-x :collision-left) (= bs-x :collision-right)
|
||||
(= bs-y :collision-left) (= bs-y :collision-right)) :collision
|
||||
:else :moving))))))
|
||||
(= x-state :gameover) :gameover
|
||||
(collision? x-state y-state) :collision
|
||||
:else :moving)))))
|
||||
|
||||
(defn renderer [game-state pos pl-pos pr-pos]
|
||||
(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")]
|
||||
rpaddle-el (dom/by-id "rpaddle")
|
||||
fps-el (dom/by-id "fps")]
|
||||
(go-loop
|
||||
(let [[x y] (<! pos)
|
||||
(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)
|
||||
|
|
@ -121,76 +149,58 @@
|
|||
(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 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)
|
||||
|
||||
(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)]
|
||||
(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)
|
||||
(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])))
|
||||
(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…
Reference in New Issue