abhin4v
/
frpong
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changed to use signals terminology instead of core.async channels and functions

master
Abhinav Sarkar 2013-10-16 21:21:32 +05:30
parent 54a3a321eb
commit d06311c730
3 changed files with 135 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/clj/frpong/core.clj
View File

@ -4,3 +4,7 @@
`(cljs.core.async.macros/go `(cljs.core.async.macros/go
(while true (while true
~@body))) ~@body)))
(defmacro rd [& body] `(cljs.core.async/<! ~@body))
(defmacro wt [& body] `(cljs.core.async/>! ~@body))

171
src/cljs/frpong/core.cljs
View File

@ -1,35 +1,34 @@
(ns frpong.core (ns frpong.core
(:require [frpong.helpers :refer (mult tap map-chan diff-chan key-chan frame-chan tick-chan event-chan)] (:require [frpong.signals :refer (signal keyboard ticks dom-events mult tap)]
[cljs.core.async :refer [<! >! chan put! close! sliding-buffer]]
[domina :as dom :refer [log]] [domina :as dom :refer [log]]
[domina.events :as ev]) [domina.events :as ev])
(: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 rd wt)]))
;; ;;
;; Signal Diagram ;; Signal Diagram
;; ;;
;; +-d-----------+--------------------------+ ;; +-d-----------+--------------------------+
;; v | | ;; v | |
;; keyboard +-e-> sampler +---k---> paddle-postnr +-d-+ +-> gravitation +--+ | ;; keyboard +-e-> sampler +---k---> paddle-postnr +-d-+ +-> gravitation +--+ |
;; ^ | p a | ;; ^ | p a |
;; t | | | | ;; t | | | |
;; | | | | | ;; | | | | |
;; +-------+ +-p----------+-|---+ | d ;; +-------+ +-p----------+-|---+ | d
;; | | +-a-------|-|------+---------------+ | ;; | | +-a-------|-|------+---------------+ |
;; | v v | | | v ;; | v v | | | v
;; browser +-f--> ticker +-+--t--> ball-postnr +-p-+-|------|------------p-> renderer ;; browser +-b--> ticker +-+--t--> ball-postnr +-p-+-|------|------------p-> renderer
;; ^ | ^ | | | ^ ^ ;; ^ | ^ | | | ^ ^
;; Signals | | +-----|---------+ | | | | ;; Signals | | +-----|---------+ | | | |
;; ------- s | | l +--d--+ | s t ;; ------- s | | l +--d--+ | s t
;; e: keyboard events | | | +-+-----|-------+ | | | ;; b: browser ticks | | | +-+-----|-------+ | | |
;; k: keydowns | | p l +-a-|-------|----+ | | ;; t: game ticks | | p l +-a-|-------|----+ | |
;; f: frames | | v v v v +-l--+ | | ;; e: keyboard events | | v v v v +-l--+ | |
;; t: ticker | +---t-> collision-detr | | ;; k: keydowns (at rate of t) | +---t-> collision-detr | |
;; p: ball position | | ^ +-s--+-----------------------+ | ;; p: ball position | | ^ +-s--+-----------------------+ |
;; l: ball velocity | | s | | ;; l: ball velocity | | s | |
;; a: ball acceleration +-----|-------------+-------------+ | ;; a: ball acceleration +-----|-------------+-------------+ |
;; d: paddle positions | | ;; d: paddle positions | |
;; s: game state +------------------------------------------------------+ ;; s: game state +------------------------------------------------------+
;; ;;
;; All signals except the signal e are at the rate of the signal f. The signal e is at the rate ;; All signals except the signal e are at the rate of the signal f. The signal e is at the rate
;; at which the keyboard issues events. ;; at which the keyboard issues events.
@ -74,11 +73,11 @@
(defn setup-gravity-controls (defn setup-gravity-controls
"Sets up keyboard controls for changing gravity." "Sets up keyboard controls for changing gravity."
[] []
(let [keydowns (first (event-chan :keydown)) (let [keydowns (first (dom-events :keydown))
actions { 37 #(- % *gravity-step*) 39 #(+ % *gravity-step*) } actions { 37 #(- % *gravity-step*) 39 #(+ % *gravity-step*) }
mass-el (dom/by-id "mass")] mass-el (dom/by-id "mass")]
(go-loop (go-loop
(let [k (:keyCode (<! keydowns))] (let [k (:keyCode (rd keydowns))]
(when (contains? actions k) (when (contains? actions k)
(do (swap! *gravity* #(max 0 (min 0.1 ((actions k) %)))) (do (swap! *gravity* #(max 0 (min 0.1 ((actions k) %))))
(dom/set-attr! mass-el "r" (mass-radius)))))))) (dom/set-attr! mass-el "r" (mass-radius))))))))
@ -122,22 +121,21 @@
(defn start-game (defn start-game
"Sets up the game by creating the signals and setting up the components and starts the game." "Sets up the game by creating the signals and setting up the components and starts the game."
[] []
(let [frames (frame-chan) ;; frames signal (let [br-ticks (ticks) ;; ticks signal from the browser
keydowns (event-chan :keydown) ;; keydowns signal pos (signal) ;; ball position signal
keyups (event-chan :keyup) ;; keyups signal vel (signal) ;; ball velocity signal
pos (chan 1) ;; ball position signal acc (signal) ;; ball acceleration signal
vel (chan 1) ;; ball velocity signal pd-pos (signal) ;; paddles position signal
acc (chan 1) ;; ball acceleration signal game-state (signal) ;; game state signal, the state of the game and the current score
pd-pos (chan 1) ;; paddles position signal
game-state (chan 1) ;; game state signal, the state of the game and the current score
init-vel (initial-velocity)] init-vel (initial-velocity)]
(setup-components frames keydowns keyups game-state pos vel acc pd-pos) (setup-components br-ticks game-state pos vel acc pd-pos)
;; start the game by setting the initial values of the signals ;; start the game by setting the initial values of the signals
(put! pos *center*) (go
(put! vel init-vel) (wt pos *center*)
(put! pd-pos [*init-paddle-pos* *init-paddle-pos*]) (wt vel init-vel)
(put! game-state [:moving 0]))) (wt pd-pos [*init-paddle-pos* *init-paddle-pos*])
(wt game-state [:moving 0]))))
(defn start-on-space [] (defn start-on-space []
(ev/listen-once! :keypress #(if (= (:keyCode %) 32) (start-game) (start-on-space)))) (ev/listen-once! :keypress #(if (= (:keyCode %) 32) (start-game) (start-on-space))))
@ -146,28 +144,26 @@
"Creates mult(iple)s of the signals and sets up the components by connecting them using "Creates mult(iple)s of the signals and sets up the components by connecting them using
the signals tapped from the mults. the signals tapped from the mults.
The signals and their stop functions are taken as parameters." The signals and their stop functions are taken as parameters."
[[frames stop-frames] [keydowns stop-keydowns] [keyups stop-keyups] [[br-ticks stop-ticks] game-state pos vel acc pd-pos]
game-state pos vel acc pd-pos] (let [ticks (signal) ;; game ticks signal
(let [ticks (chan) ;; ticks signal ticks-m (mult ticks) ;; mult(iple)s for all signals
ticks-m (mult ticks) ;; mult(iple)s for all signals pos-m (mult pos)
keydowns-m (mult keydowns) vel-m (mult vel)
keyups-m (mult keyups) acc-m (mult acc)
pos-m (mult pos) pd-pos-m (mult pd-pos)
vel-m (mult vel) game-state-m (mult game-state)
acc-m (mult acc)
pd-pos-m (mult pd-pos)
game-state-m (mult game-state)
;; calling this will stop the frames, keydowns and keyups signals and hence stop the game ;; keyboard signal for w, s, up and down keys
stop-game #(do (stop-frames) (stop-keydowns) (stop-keyups))] [keyboard stop-keyboard] (keyboard (tap ticks-m) {83 :s 87 :w 38 :up 40 :down})
;; calling this will stop the ticks and the keyboard signals and hence stop the game
stop-game #(do (stop-ticks) (stop-keyboard))]
;; set up the components by tapping into mults ;; set up the components by tapping into mults
(ticker frames stop-game (tap game-state-m) ticks) (ticker br-ticks stop-game (tap game-state-m) ticks)
(gravitation (tap pos-m) acc) (gravitation (tap pos-m) acc)
(ball-positioner (tap ticks-m) (tap pos-m) (tap vel-m) (tap acc-m) pos) (ball-positioner (tap ticks-m) (tap pos-m) (tap vel-m) (tap acc-m) pos)
(paddle-positioner (paddle-positioner keyboard (tap pd-pos-m) pd-pos)
(key-chan (tap keydowns-m) (tap keyups-m) (tap ticks-m) {83 :s 87 :w 38 :up 40 :down})
(tap pd-pos-m) pd-pos)
(collision-detector (tap ticks-m) (tap pos-m) (tap vel-m) (tap acc-m) (collision-detector (tap ticks-m) (tap pos-m) (tap vel-m) (tap acc-m)
(tap pd-pos-m) (tap game-state-m) game-state vel) (tap pd-pos-m) (tap game-state-m) game-state vel)
@ -176,18 +172,17 @@
(defn ticker (defn ticker
"Ticker component. "Ticker component.
Converts `frames` signal to ticks and outputs them to the `ticks` signal Reads ticks generated by the browser from the `br-ticks` signal and outputs them to the
as long as the `game-state` signal is not :gameover. Once the `game-state` signal is `game-ticks` signal as long as the `game-state` signal is not :gameover.
:gameover, stops the game by calling the `stop-game` function. Once the `game-state` signal is :gameover, stops the game by calling the `stop-game` function.
Each tick is the number of milliseconds since the last tick was generated." Each tick is the number of milliseconds since the last tick was generated."
[frames stop-game game-state ticks] [br-ticks stop-game game-state game-ticks]
(let [ticks-in (tick-chan (diff-chan frames))] (go (loop []
(go (loop [] (let [[state _] (rd game-state)]
(let [[state _] (<! game-state)] (do (wt game-ticks (rd br-ticks))
(do (>! ticks (<! ticks-in)) (if-not (= :gameover state)
(if-not (= :gameover state) (recur)
(recur) (stop-game)))))))
(stop-game))))))))
(defn gravity-acc (defn gravity-acc
"Calculates acceleration due to gravitation for the ball caused by the mass placed at the "Calculates acceleration due to gravitation for the ball caused by the mass placed at the
@ -209,7 +204,7 @@
it to the `acc` signal." it to the `acc` signal."
[pos-in acc] [pos-in acc]
(go-loop (go-loop
(>! acc (gravity-acc (<! pos-in))))) (wt acc (gravity-acc (rd pos-in)))))
(defn next-pos [[x y] [vel-x vel-y] [acc-x acc-y] tick] (defn next-pos [[x y] [vel-x vel-y] [acc-x acc-y] tick]
[(+ x (* vel-x tick) (* acc-x (sq tick))) (+ y (* vel-y tick) (* acc-y (sq tick)))]) [(+ x (* vel-x tick) (* acc-x (sq tick))) (+ y (* vel-y tick) (* acc-y (sq tick)))])
@ -221,9 +216,9 @@
`ticks` signal) and outputs it to the `pos-out` signal." `ticks` signal) and outputs it to the `pos-out` signal."
[ticks pos-in vel acc pos-out] [ticks pos-in vel acc pos-out]
(go-loop (go-loop
(let [tick (<! ticks) (let [tick (rd ticks)
pos-next (next-pos (<! pos-in) (<! vel) (<! acc) tick)] pos-next (next-pos (rd pos-in) (rd vel) (rd acc) tick)]
(>! pos-out pos-next)))) (wt pos-out pos-next))))
(defn paddle-positioner (defn paddle-positioner
"Paddle Positioner component. "Paddle Positioner component.
@ -232,14 +227,14 @@
and outputs it to the `pos-out` signal." and outputs it to the `pos-out` signal."
[keys pos-in pos-out] [keys pos-in pos-out]
(go-loop (go-loop
(let [[lpos rpos] (<! pos-in) (let [[lpos rpos] (rd pos-in)
ks (<! keys) ks (rd keys)
move (fn [pos up down] move (fn [pos up down]
(cond (cond
(contains? ks up) (max (- pos *paddle-step*) 0) (contains? ks up) (max (- pos *paddle-step*) 0)
(contains? ks down) (min (+ pos *paddle-step*) *max-paddle-y*) (contains? ks down) (min (+ pos *paddle-step*) *max-paddle-y*)
:else pos))] :else pos))]
(>! pos-out [(move lpos :w :s) (move rpos :up :down)])))) (wt pos-out [(move lpos :w :s) (move rpos :up :down)]))))
(defn in-y-range? [y paddle-y] (defn in-y-range? [y paddle-y]
(and (> y (- paddle-y *padding*)) (< y (+ paddle-y *paddle-size* *padding*)))) (and (> y (- paddle-y *padding*)) (< y (+ paddle-y *paddle-size* *padding*))))
@ -280,13 +275,13 @@
signals respectively." signals respectively."
(go-loop (go-loop
(let [;; get all current values (let [;; read all current values
tick (<! ticks) tick (rd ticks)
[vel-x vel-y] (<! vel-in) [vel-x vel-y] (rd vel-in)
[x y] (<! pos) [x y] (rd pos)
[gx gy] (<! acc) [gx gy] (rd acc)
[lpaddle-y rpaddle-y] (<! pd-pos) [lpaddle-y rpaddle-y] (rd pd-pos)
[_ score] (<! game-state-in) [_ score] (rd game-state-in)
;; calculate next position and detect collision ;; calculate next position and detect collision
[xn yn] (next-pos [x y] [vel-x vel-y] [gx gy] tick) [xn yn] (next-pos [x y] [vel-x vel-y] [gx gy] tick)
@ -308,8 +303,8 @@
[vel-xn vel-yn] (if x-collision [vel-xn vel-yn] (if x-collision
(map perturb [vel-xn vel-yn]) (map perturb [vel-xn vel-yn])
[vel-xn vel-yn])] [vel-xn vel-yn])]
(>! vel-out [vel-xn vel-yn]) (wt vel-out [vel-xn vel-yn])
(>! game-state [state-n score-n])))) (wt game-state [state-n score-n]))))
(defn renderer (defn renderer
"Renderer component. "Renderer component.
@ -325,10 +320,10 @@
(dom/set-style! ball-el "fill" "orange") (dom/set-style! ball-el "fill" "orange")
(dom/set-text! msg-el "") (dom/set-text! msg-el "")
(go (loop [fps-p nil score-p nil] (go (loop [fps-p nil score-p nil]
(let [fps (int (/ 1000 (<! ticks))) (let [fps (int (/ 1000 (rd ticks)))
[x y] (<! pos) [x y] (rd pos)
[lpaddle-y rpaddle-y] (<! pd-pos) [lpaddle-y rpaddle-y] (rd pd-pos)
[state score] (<! game-state)] [state score] (rd game-state)]
(doto ball-el (doto ball-el
(dom/set-attr! "cx" x) (dom/set-attr! "cx" x)
(dom/set-attr! "cy" y)) (dom/set-attr! "cy" y))

99
src/cljs/frpong/helpers.cljs → src/cljs/frpong/signals.cljs
View File

@ -1,4 +1,4 @@
(ns frpong.helpers (ns frpong.signals
(:require [cljs.core.async :as async (:require [cljs.core.async :as async
:refer [<! >! chan put! close! sliding-buffer dropping-buffer timeout]] :refer [<! >! chan put! close! sliding-buffer dropping-buffer timeout]]
[domina :as dom :refer [log]] [domina :as dom :refer [log]]
@ -9,6 +9,8 @@
(defn now [] (defn now []
(.valueOf (js/Date.))) (.valueOf (js/Date.)))
(defn signal [] (chan 1))
(defn put-all! [cs x] (defn put-all! [cs x]
(doseq [c cs] (doseq [c cs]
(put! c x))) (put! c x)))
@ -23,7 +25,7 @@
(close! c)))) (close! c))))
c)) c))
(defn map-chan [f source] (defn smap [f source]
(let [c (chan)] (let [c (chan)]
(go (loop [] (go (loop []
(if-let [v (<! source)] (if-let [v (<! source)]
@ -31,7 +33,7 @@
(close! c)))) (close! c))))
c)) c))
(defn filter-chan [f source] (defn sfilter [f source]
(let [c (chan)] (let [c (chan)]
(go (loop [] (go (loop []
(if-let [v (<! source)] (if-let [v (<! source)]
@ -39,9 +41,9 @@
(close! c)))) (close! c))))
c)) c))
(defn interval-chan (defn interval-signal
([msecs] ([msecs]
(interval-chan msecs :leading)) (interval-signal msecs :leading))
([msecs type] ([msecs type]
(let [c (chan (dropping-buffer 1))] (let [c (chan (dropping-buffer 1))]
(condp = type (condp = type
@ -117,16 +119,36 @@
(>! c x))) (>! c x)))
c)) c))
(defn distinct-chan [source] (defn scounter [source]
(let [c (chan)] (let [c (chan)]
(go (go
(loop [last ::init] (loop [count 0]
(let [v (<! source)] (if-let [v (<! source)]
(when-not (= last v) (>! c v)) (do (>! c count) (recur (inc count)))
(recur v)))) (close! c))))
c)) c))
(defn event-chan (defn sdiff [source]
(let [c (chan)]
(go
(let [start (<! source)]
(loop [start start]
(if-let [v (<! source)]
(do (>! c (- v start)) (recur v))
(close! c)))))
c))
(defn sampler [source n]
(let [c (chan)]
(go
(loop [count 0]
(if-let [v (<! source)]
(do (when (= count 0) (>! c v))
(recur (rem (inc count) n)))
(close! c))))
c))
(defn dom-events
([event-type] ([event-type]
(let [c (chan) (let [c (chan)
[lkey] (ev/listen! event-type #(put! c %))] [lkey] (ev/listen! event-type #(put! c %))]
@ -136,10 +158,12 @@
[lkey] (ev/listen! node event-type #(put! c %))] [lkey] (ev/listen! node event-type #(put! c %))]
[c #(do (ev/unlisten-by-key! lkey) (close! c))]))) [c #(do (ev/unlisten-by-key! lkey) (close! c))])))
(defn key-chan [keydowns keyups sampler keycodes] (defn keyboard [sampler keycodes]
(let [c (chan) (let [[keydowns kd-stop-fn] (dom-events :keydown) ;; keydowns signal
ops { keydowns conj [keyups ku-stop-fn] (dom-events :keyup) ;; keyups signal
keyups disj }] c (chan)
ops { keydowns conj
keyups disj }]
(go (loop [keys #{}] (go (loop [keys #{}]
(let [[v ch] (alts! [keydowns keyups sampler] :priority true)] (let [[v ch] (alts! [keydowns keyups sampler] :priority true)]
(if-not (nil? v) (if-not (nil? v)
@ -150,9 +174,9 @@
(recur keys))) (recur keys)))
(do (>! c keys) (recur keys))) (do (>! c keys) (recur keys)))
(close! c))))) (close! c)))))
c)) [c #(do (kd-stop-fn) (ku-stop-fn))]))
(defn frame-chan [] (defn frames []
(let [fc (chan (sliding-buffer 1000)) (let [fc (chan (sliding-buffer 1000))
rc (chan (sliding-buffer 10)) rc (chan (sliding-buffer 10))
step (fn step [ts] step (fn step [ts]
@ -168,44 +192,17 @@
(.requestAnimationFrame js/window step) (.requestAnimationFrame js/window step)
[fc stop-fn])) [fc stop-fn]))
(defn tick-chan [frames] (defn ticks []
(let [c (chan)] (let [c (chan)
[frames stop-fn] (frames)
frames-diff (sdiff frames)]
(go (go
(loop [prev (<! frames)] (loop [prev (<! frames-diff)]
(if-let [t (<! frames)] (if-let [t (<! frames-diff)]
(do (when (< t (* 10 prev)) (>! c t)) (do (when (< t (* 10 prev)) (>! c t))
(recur t)) (recur t))
(close! c)))) (close! c))))
c)) [c stop-fn]))
(defn counting-chan [source]
(let [c (chan)]
(go
(loop [count 0]
(if-let [v (<! source)]
(do (>! c count) (recur (inc count)))
(close! c))))
c))
(defn diff-chan [source]
(let [c (chan)]
(go
(let [start (<! source)]
(loop [start start]
(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-let [v (<! source)]
(do (when (= count 0) (>! c v))
(recur (rem (inc count) n)))
(close! c))))
c))
(defprotocol Mux (defprotocol Mux
(muxch* [_])) (muxch* [_]))