Got paddle position sustain working, some refactoring

src/cljs/frpong/core.cljs

@@ -32,102 +32,113 @@
 
 (defn abs [x] (.abs js/Math x))
 
-(defn tick-chan [frame-chan]
+(defn tick-chan [frames]
   (let [c (chan)]
     (go
-      (loop [prev (<! frame-chan)]
-        (let [t (<! frame-chan)]
+      (loop [prev (<! frames)]
+        (let [t (<! frames)]
           (when (< t (* 10 prev))
             (>! c t))
             (recur t))))
     c))
 
-(defn ball-positioner [tick-chan vel-chan pos-chan-in pos-chan-out]
+(defn ball-positioner [ticks vel pos-in pos-out]
   (go-loop
-    (let [tick (<! tick-chan)
-          [vel-x vel-y] (<! vel-chan)
-          [x y] (<! pos-chan-in)
+    (let [tick (<! ticks)
+          [vel-x vel-y] (<! vel)
+          [x y] (<! pos-in)
           pos-next [(+ x (* vel-x tick)) (+ y (* vel-y tick))]]
-      (>! pos-chan-out pos-next))))
+      (>! pos-out pos-next))))
 
 (defn collision-detector 
-  [{:keys [width height padding]} tick-chan pos-chan vel-chan-in vel-chan-out]
+  [{: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)
-                        (> p (- size padding)) (- (abs v))
-                        :else v))]
+                        (< p padding) [(abs v) :collision]
+                        (> p (- size padding)) [(- (abs v)) :collision]
+                        :else [v :moving]))]
     (go-loop
-      (let [tick (<! tick-chan)
-            [vel-x vel-y] (<! vel-chan-in)
-            [x y] (<! pos-chan)
+      (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 (adjust-v xn vel-x width)
-            vel-yn (adjust-v yn vel-y height)]
-        (>! vel-chan-out [vel-xn vel-yn])))))
+            [vel-xn bs-x] (adjust-v xn vel-x width)
+            [vel-yn bs-y] (adjust-v yn vel-y height)]
+        (>! vel-out [vel-xn vel-yn])
+        (>! ball-state
+          (if (or (= bs-x :collision) (= bs-y :collision)) :collision :moving))))))
 
-(defn paddle-positioner [keycodes max-y movement pos-chan-in pos-chan-out]
-  (let [key-chan (h/key-chan keycodes)]
+(defn paddle-positioner [keycodes max-y movement pos-in pos-out]
+  (let [keys (h/key-chan keycodes)]
     (go-loop
-      (let [dir (<! key-chan)
-            pos (<! pos-chan-in)]
-        (condp = dir
-          :up (>! pos-chan-out (max (- pos movement) 0))
-          :down (>! pos-chan-out (min (+ pos movement) max-y)))))))
+      (let [dir (<! keys)
+            pos (<! pos-in)]
+        (>! pos-out
+          (condp = dir
+            :up (max (- pos movement) 0)
+            :down (min (+ pos movement) max-y)))))))
 
-(defn renderer [pos-chan vel-chan pl-pos-chan pr-pos-chan]
+(defn renderer [ball-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")
         lpaddle-el (dom/by-id "lpaddle")
         rpaddle-el (dom/by-id "rpaddle")]
   (go-loop
-    (let [[x y] (<! pos-chan)]
+    (let [[x y] (<! pos)]
       (dom/set-text! pos-el (map int [x y]))
-      (dom/set-text! vel-el (<! vel-chan))
+      (dom/set-text! vel-el (<! vel))
       (doto ball-el
         (dom/set-attr! "cx" x)
-        (dom/set-attr! "cy" y))))
+        (dom/set-attr! "cy" y)
+        (dom/set-style! "fill" (if (= :collision (<! ball-state)) "#0f0" "#000")))))
   (go-loop
-    (dom/set-attr! lpaddle-el "y" (<! pl-pos-chan)))
+    (dom/set-attr! lpaddle-el "y" (<! pl-pos)))
   (go-loop
-    (dom/set-attr! rpaddle-el "y" (<! pr-pos-chan)))))
+    (dom/set-attr! rpaddle-el "y" (<! pr-pos)))))
 
 (defn game-setup [{:keys [width height padding paddle-size] :as layout} paddle-movement
-                  frame-chan pos-chan vel-chan pl-pos-chan pr-pos-chan]
+                  frames ball-state pos vel pl-pos pr-pos]
   (let [max-y (- height paddle-size)
-        [tick-chan-pos tick-chan-collsion] (h/dup-chan (tick-chan (h/diff-chan frame-chan)))
-        [pos-chan-pos pos-chan-collision pos-chan-render] (h/multiplex pos-chan 3)
-        [vel-chan-pos vel-chan-collision vel-chan-render] (h/multiplex vel-chan 3)
-        [pl-pos-chan-pos pl-pos-chan-render] (h/dup-chan pl-pos-chan)
-        [pr-pos-chan-pos pr-pos-chan-render] (h/dup-chan pr-pos-chan)]
-    (ball-positioner tick-chan-pos vel-chan-pos pos-chan-pos pos-chan)
-    (collision-detector layout tick-chan-collsion pos-chan-collision vel-chan-collision vel-chan)
-    (paddle-positioner {83 :down 87 :up} max-y paddle-movement pl-pos-chan-pos pl-pos-chan)
-    (paddle-positioner {38 :up 40 :down} max-y paddle-movement pr-pos-chan-pos pr-pos-chan)
-    [pos-chan-render vel-chan-render pl-pos-chan-render pr-pos-chan-render]))
+        [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)
+        [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
+      (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]))
 
 (defn game-init [{:keys [height paddle-size] :as layout}
-                 {:keys [init-pos init-vel paddle-movement]} frame-chan]
-  (let [paddle-x (/ (- height paddle-size) 2)
-        pos-chan (chan 1)
-        vel-chan (chan 1)
-        pl-pos-chan (chan 1)
-        pr-pos-chan (chan 1)]
-    (put! pos-chan init-pos)
-    (put! vel-chan init-vel)
-    (put! pl-pos-chan paddle-x)
-    (put! pr-pos-chan paddle-x)
+                 {: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)
+        ball-state (chan 1)]
+    (put! pos init-pos)
+    (put! vel init-vel)
+    (put! pl-pos init-paddle-pos)
+    (put! pr-pos init-paddle-pos)
 
     (apply renderer
-      (game-setup layout paddle-movement frame-chan pos-chan vel-chan pl-pos-chan pr-pos-chan))))
+      (game-setup layout paddle-movement frames ball-state pos vel pl-pos pr-pos))))
 
 (defn ^:export init []
-  (let [frame-chan (h/frame-chan)
-        [frame-chan-fps frame-chan-count frame-chan-game] (h/multiplex frame-chan 3)
+  (let [frames (h/map-chan first (h/frame-chan))
+        [frames-fps frames-count frames-game] (h/multiplex frames 3)
 
-        fps-chan (h/map-chan #(/ 1000 %) (h/diff-chan frame-chan-fps))
-        frame-count-chan (h/counting-chan frame-chan-count)
+        fps (h/map-chan #(/ 1000 %) (h/diff-chan frames-fps))
+        frames-count (h/counting-chan frames-count)
 
         layout {:width 600
                 :height 300
@@ -144,6 +155,6 @@
       (dom/set-style! "height" (str (:height layout) "px")))
     
     (go-loop
-      (dom/set-text! fps-el (<! fps-chan))
-      (dom/set-text! frame-el (<! frame-count-chan)))
-    (game-init layout init-vals frame-chan-game)))
+      (dom/set-text! fps-el (<! fps))
+      (dom/set-text! frame-el (<! frames-count)))
+    (game-init layout init-vals frames-game)))

src/cljs/frpong/helpers.cljs

@@ -21,6 +21,14 @@
         (>! c2 (<! c1))))
     c2))
 
+(defn probe [ch probe-name]
+  (let [c (chan)]
+    (go-loop
+      (let [v (<! ch)]
+        (log (str (now) " " probe-name ": " v))
+        (>! c v)))
+    c))
+
 (defn multiplex [in cs-or-n]
   (let [cs (if (number? cs-or-n)
              (repeatedly cs-or-n chan)
@@ -92,6 +100,18 @@
                      (recur ::init last))))))
     c))
 
+(defn sustain
+  ([source control]
+    (sustain (chan) source control))
+  ([c source control]
+    (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))))))
+    c))
+
 (defn debounce
   ([source msecs]
     (debounce (chan) source msecs))
@@ -162,7 +182,9 @@
 
 (defn frame-chan []
   (let [c (chan (sliding-buffer 1000))
-        step (fn step [ts]  (do (put! c ts) (.requestAnimationFrame js/window step)))]
+        step (fn step [ts] 
+               (let [req-id (.requestAnimationFrame js/window step)]
+                 (put! c [ts req-id])))]
     (.requestAnimationFrame js/window step)
     c))