First working version

master
Abhinav Sarkar 9 years ago
parent bcc7e28747
commit f88bd57999
  1. 7
      resources/public/index.html
  2. 129
      src/cljs/frpong/core.cljs
  3. 163
      src/cljs/frpong/helpers.cljs

@ -12,10 +12,11 @@
<div>FPS: <span id="fps"></span></div>
<div>Position: <span id="pos"></span></div>
<div>Velocity: <span id="vel"></span></div>
<div>State: <span id="state"></span></div>
<svg style="border: 1px black solid" id="canvas">
<circle id="ball" r="5" cx="5" cy="100" />
<rect id="lpaddle" x="0" y="160" width="10" height="80" />
<rect id="rpaddle" x="590" y="160" width="10" height="80" />
<circle id="ball" />
<rect id="lpaddle" />
<rect id="rpaddle" />
</svg>
<!-- pointing to cljsbuild generated js file -->

@ -50,14 +50,32 @@
pos-next [(+ x (* vel-x tick)) (+ y (* vel-y tick))]]
(>! pos-out pos-next))))
(defn collision-detector
[{:keys [width height padding]}
ticks ball-state pos pl-pos pr-pos vel-in vel-out]
(let [adjust-v (fn [p v size]
(cond
(< p padding) [(abs v) :collision]
(> p (- size padding)) [(- (abs v)) :collision]
:else [v :moving]))]
(defn collision-detector
[{:keys [width height padding paddle-size paddle-width]}
ticks game-state pos pl-pos pr-pos vel-in vel-out]
(let [adjust-v (fn [state v] [(condp = state
:collision-left (abs v)
:collision-right (- (abs v))
:moving v
:gameover 0)
state])
detect-y-collision (fn [y] (cond
(< y padding) :collision-left
(> y (- height padding)) :collision-right
:else :moving))
detect-x-collision (fn [x y pl-pos pr-pos]
(cond
(< x (+ paddle-width padding))
(if (and (> y (+ pl-pos padding))
(< y (- (+ pl-pos paddle-size) padding)))
:collision-left
:gameover)
(> x (- width (+ paddle-width padding)))
(if (and (> y (+ pr-pos padding))
(< y (- (+ pr-pos paddle-size) padding)))
:collision-right
:gameover)
:else :moving))]
(go-loop
(let [tick (<! ticks)
[vel-x vel-y] (<! vel-in)
@ -65,96 +83,125 @@
pl-pos (<! pl-pos)
pr-pos (<! pr-pos)
[xn yn] [(+ x (* vel-x tick)) (+ y (* vel-y tick))]
[vel-xn bs-x] (adjust-v xn vel-x width)
[vel-yn bs-y] (adjust-v yn vel-y height)]
[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])
(>! ball-state
(if (or (= bs-x :collision) (= bs-y :collision)) :collision :moving))))))
(>! 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 paddle-positioner [keycodes max-y movement pos-in pos-out]
(let [keys (h/key-chan keycodes)]
(go-loop
(let [dir (<! keys)
pos (<! pos-in)]
(let [pos (<! pos-in)]
(>! pos-out
(condp = dir
(condp = (<! keys)
:up (max (- pos movement) 0)
:down (min (+ pos movement) max-y)))))))
(defn renderer [ball-state pos vel pl-pos pr-pos]
(defn renderer [game-state pos vel pl-pos pr-pos]
(let [pos-el (dom/by-id "pos")
vel-el (dom/by-id "vel")
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)]
(let [[x y] (<! pos)
gs (<! game-state)]
(dom/set-text! pos-el (map int [x y]))
(dom/set-text! vel-el (<! vel))
(dom/set-text! state-el (name gs))
(doto ball-el
(dom/set-attr! "cx" x)
(dom/set-attr! "cy" y)
(dom/set-style! "fill" (if (= :collision (<! ball-state)) "#0f0" "#000")))))
(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 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 game-setup [{:keys [width height padding paddle-size] :as layout} paddle-movement
frames ball-state pos vel pl-pos pr-pos]
frames stop-frames game-state pos vel pl-pos pr-pos]
(let [max-y (- height paddle-size)
[tick-pos tick-collsion tick-pl tick-pr] (h/multiplex (tick-chan (h/diff-chan frames)) 4)
[pos-pos pos-collision pos-render] (h/multiplex pos 3)
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 vel-render] (h/multiplex vel 3)
[pl-pos-pos pl-pos-collision pl-pos-render] (h/multiplex pl-pos 3)
[pr-pos-pos pr-pos-collision pr-pos-render] (h/multiplex pr-pos 3)]
(ball-positioner tick-pos vel-pos pos-pos pos)
(collision-detector layout tick-collsion ball-state pos-collision
[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/dup-chan game-state)]
(ticker frames stop-frames ticks game-state-ticker)
(ball-positioner tick-pos vel-pos pos-in pos)
(collision-detector layout tick-collsion game-state pos-collision
(h/sustain pl-pos-collision tick-pl)
(h/sustain pr-pos-collision tick-pr)
vel-collision vel)
(paddle-positioner {83 :down 87 :up} max-y paddle-movement pl-pos-pos pl-pos)
(paddle-positioner {38 :up 40 :down} max-y paddle-movement pr-pos-pos pr-pos)
[ball-state pos-render vel-render pl-pos-render pr-pos-render]))
(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 vel-render pl-pos-render pr-pos-render]))
(defn game-init [{:keys [height paddle-size] :as layout}
{:keys [init-pos init-vel paddle-movement]} frames]
{:keys [init-pos init-vel paddle-movement]} frames stop-frames]
(let [init-paddle-pos (/ (- height paddle-size) 2)
pos (chan 1)
vel (chan 1)
pl-pos (chan 1)
pr-pos (chan 1)
ball-state (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 ball-state pos vel pl-pos pr-pos))))
(game-setup layout paddle-movement frames stop-frames game-state pos vel pl-pos pr-pos))))
(defn ^:export init []
(let [frames (h/map-chan first (h/frame-chan))
(let [[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)
layout {:width 600
:height 300
layout {:width 800
:height 400
:padding 5
:paddle-size 80}
init-vals {:init-pos [5 100]
:init-vel [0.2 0.22]
:paddle-movement 10}
:paddle-size 100
:paddle-width 10
:ball-radius 5}
init-vals {:init-pos [50 100]
:init-vel [0.3 0.33]
:paddle-movement 20}
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)))
(game-init layout init-vals frames-game stop-frames)))

@ -13,20 +13,14 @@
(doseq [c cs]
(put! c x)))
(defn cconj [v c1]
(let [c2 (chan)]
(go
(>! c2 v)
(while true
(>! c2 (<! c1))))
c2))
(defn probe [ch probe-name]
(let [c (chan)]
(go-loop
(let [v (<! ch)]
(log (str (now) " " probe-name ": " v))
(>! c v)))
(go (loop []
(if-let [v (<! ch)]
(do (log (str (now) " " probe-name ": " v))
(>! c v)
(recur))
(close! c))))
c))
(defn multiplex [in cs-or-n]
@ -36,86 +30,72 @@
(go (loop []
(let [x (<! in)]
(if-not (nil? x)
(do
(put-all! cs x)
(recur))
(do (put-all! cs x) (recur))
:done))))
cs))
(defn copy-chan
([c]
(first (multiplex c 1)))
([out c]
(first (multiplex c [out]))))
(defn dup-chan [c]
(multiplex c 2))
(defn map-chan
([f source] (map-chan (chan) f source))
([c f source]
(go-loop
(>! c (f (<! source))))
(defn map-chan [f source]
(let [c (chan)]
(go (loop []
(if-let [v (<! source)]
(do (>! c (f v)) (recur))
(close! c))))
c))
(defn filter-chan
([f source] (filter-chan (chan) f source))
([c f source]
(go-loop
(let [v (<! source)]
(when (f v)
(>! c v))))
(defn filter-chan [f source]
(let [c (chan)]
(go (loop []
(if-let [v (<! source)]
(do (when (f v) (>! c v)) (recur))
(close! c))))
c))
(defn interval-chan
([msecs]
(interval-chan msecs :leading))
([msecs type]
(interval-chan (chan (dropping-buffer 1)) msecs type))
([c msecs type]
(condp = type
:leading (go-loop
(>! c (now))
(<! (timeout msecs)))
:falling (go-loop
(<! (timeout msecs))
(>! c (now))))
c))
(defn throttle
([source control]
(throttle (chan) source control))
([c source control]
(let [c (chan (dropping-buffer 1))]
(condp = type
:leading (go-loop
(>! c (now))
(<! (timeout msecs)))
:falling (go-loop
(<! (timeout msecs))
(>! c (now))))
c)))
(defn throttle [source control]
(let [c (chan)]
(go
(loop [state ::init last nil]
(let [[v sc] (alts! [source control])]
(condp = sc
source (condp = state
::init (do (>! c v)
(recur ::throttling last))
::init (do (>! c v) (recur ::throttling last))
::throttling (recur state v))
control (if last
(do (>! c last)
(recur state nil))
(do (>! c last) (recur state nil))
(recur ::init last))))))
c))
(defn sustain
([source control]
(sustain (chan) source control))
([c source control]
(defn sustain [source control]
(let [c (chan)]
(go
(loop [last nil]
(let [[v ch] (alts! [source control] :priority true)]
(condp = ch
source (do (>! c v) (recur v))
control (do (when last (>! c last)) (recur last))))))
(if (nil? v)
(close! c)
(condp = ch
source (do (>! c v) (recur v))
control (do (when last (>! c last)) (recur last)))))))
c))
(defn debounce
([source msecs]
(debounce (chan) source msecs))
([c source msecs]
(defn debounce [source msecs]
(let [c (chan)]
(go
(loop [state ::init cs [source]]
(let [[_ threshold] cs]
@ -132,10 +112,8 @@
threshold (recur ::init (pop cs)))))))
c))
(defn after-last
([source msecs]
(after-last (chan) source msecs))
([c source msecs]
(defn after-last [source msecs]
(let [c (chan)]
(go
(loop [cs [source]]
(let [[_ toc] cs]
@ -147,22 +125,19 @@
toc (do (>! c (now)) (pop cs))))))))
c))
(defn fan-in
([ins] (fan-in (chan) ins))
([c ins]
(go (while true
(let [[x] (alts! ins)]
(>! c x))))
(defn fan-in [ins]
(let [c (chan)]
(go-loop
(let [[x] (alts! ins)]
(>! c x)))
c))
(defn distinct-chan
([source] (distinct-chan (chan) source))
([c source]
(defn distinct-chan [source]
(let [c (chan)]
(go
(loop [last ::init]
(let [v (<! source)]
(when-not (= last v)
(>! c v))
(when-not (= last v) (>! c v))
(recur v))))
c))
@ -181,20 +156,28 @@
c))
(defn frame-chan []
(let [c (chan (sliding-buffer 1000))
(let [fc (chan (sliding-buffer 1000))
rc (chan (sliding-buffer 10))
step (fn step [ts]
(let [req-id (.requestAnimationFrame js/window step)]
(put! c [ts req-id])))]
(put! fc ts)
(put! rc req-id)))
stop-fn (fn []
(go (loop []
(if-let [id (<! rc)]
(do (.cancelAnimationFrame js/window id) (recur)))))
(close! fc)
(close! rc))]
(.requestAnimationFrame js/window step)
c))
[fc stop-fn]))
(defn counting-chan [source]
(let [c (chan)]
(go
(loop [count 0]
(<! source)
(>! c count)
(recur (inc count))))
(if-let [v (<! source)]
(do (>! c count) (recur (inc count)))
(close! c))))
c))
(defn diff-chan [source]
@ -202,17 +185,17 @@
(go
(let [start (<! source)]
(loop [start start]
(let [ts (<! source)]
(>! c (- ts start))
(recur ts)))))
(if-let [v (<! source)]
(do (>! c (- v start)) (recur v))
(close! c)))))
c))
(defn dropping-chan [source n]
(let [c (chan)]
(go
(loop [count 0]
(if (= count 0)
(>! c (<! source))
(<! source))
(recur (rem (inc count) n))))
(if-let [v (<! source)]
(do (when (= count 0) (>! c v))
(recur (rem (inc count) n)))
(close! c))))
c))

Loading…
Cancel
Save