First working version

resources/public/index.html

@@ -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 -->

src/cljs/frpong/core.cljs

@@ -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)))

src/cljs/frpong/helpers.cljs

@@ -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))