Add >beat-clock

1 files changed, 40 insertions, 8 deletions

diff --git a/src/unheard/clock.clj b/src/unheard/clock.clj
index af6c32d..42e7930 100644
--- a/src/unheard/clock.clj
+++ b/src/unheard/clock.clj
@@ -35,26 +35,58 @@
   When `mono-clock-freq` changes, it will wait for the
   completion of the current tick prior to adopting the new
   frequency."
+  ;; TODO: Change this behavior. I don't want to wait for
+  ;; the current tick to complete during a frequency change..
   (m/signal
    (m/relieve
     (feedback (fn [v]
                 (m/ap
-                  (let [[t freq] (m/?< (m/latest vector v >mono-clock-freq))]
-                    (m/? (m/compel (m/sleep (/ 1000 freq))))
-                    (System/nanoTime))))
+                 (let [[t freq] (m/?< (m/latest vector v >mono-clock-freq))]
+                   (m/? (m/compel (m/sleep (/ 1000 freq))))
+                   (System/nanoTime))))
               (System/nanoTime)))))
 
 (comment
- (def cancel
-   ((m/reduce prn nil >mono-clock) prn prn))
+  (def cancel
+    ((m/reduce prn nil >mono-clock) prn prn))
 
- (reset! mono-clock-freq 10)
- (reset! mono-clock-freq 1)
- (cancel))
+  (reset! mono-clock-freq 10)
+  (reset! mono-clock-freq 1)
+  (cancel))
 
 (defonce bpm (atom 120))
 (defonce >bpm (m/watch bpm))
 
+(def >beat-clock
+  (m/signal
+   (m/relieve
+    (let [init-beat 1]
+      (m/reductions {} init-beat
+                    (m/ap
+                      ;; Doesn't need to be atom
+                     (let [state (object-array 2)
+                           _ (aset state 0 (System/nanoTime))
+                           _ (aset state 1 init-beat)
+                           [t bpm] (m/?< (m/latest vector >mono-clock >bpm))
+                           last-tick (aget state 0)
+                           last-beat (aget state 1)
+                           next-tick (+ last-tick (* 100000000000 (/ 1 bpm)))]
+                       (if (< next-tick t)
+                         (do (aset state 0 next-tick)
+                             (aset state 1 (inc last-beat))
+                             (inc last-beat))
+                         (m/amb)))))))))
+
+(comment
+  (def cancel
+    ((m/reduce prn nil >beat-clock) prn prn))
+
+  (reset! bpm 60)
+  (reset! bpm 120)
+  (reset! mono-clock-freq 120)
+  (reset! mono-clock-freq 1)
+  (cancel))
+
 (defn clock
   "Returns a tuple of [`>clock` `clock`].
   `clock` is an atom representing the current time.