1 files changed, 54 insertions, 0 deletions
diff --git a/src/unheard/clock.clj b/src/unheard/clock.clj
index 4011919..af6c32d 100644
--- a/src/unheard/clock.clj
+++ b/src/unheard/clock.clj
@@ -1,6 +1,60 @@
 (ns unheard.clock
   (:require [missionary.core :as m]))
 
+;; TODO: Put in missionary util
+(defn poll [init task]
+  (m/ap (m/? (m/?> (m/seed (concat [(m/sp init)]
+                                   (repeat task)))))))
+
+;; TODO: Put in missionary util
+(defn feedback [f init & args]
+  (m/ap
+   (m/amb
+    init
+    (let [rdv (m/rdv)
+          x (m/?> (apply f (poll init rdv) args))]
+      (m/amb
+       (do
+         (m/? (rdv x))
+         (m/amb))
+       x)))))
+
+;; Return value
+
+;; TODO: Make part of public API
+(defonce mono-clock-freq (atom 120)) ;; hz
+(defonce >mono-clock-freq
+  (m/watch mono-clock-freq))
+
+(def >mono-clock
+  "This is the base monotonic clock used for driving playback.
+  It makes a best-effort attempt to tick at `mono-clock-freq`.
+  It makes no guarantees that it will tick a given number of
+  times in any unit of time.
+
+  When `mono-clock-freq` changes, it will wait for the
+  completion of the current tick prior to adopting the new
+  frequency."
+  (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))))
+              (System/nanoTime)))))
+
+(comment
+ (def cancel
+   ((m/reduce prn nil >mono-clock) prn prn))
+
+ (reset! mono-clock-freq 10)
+ (reset! mono-clock-freq 1)
+ (cancel))
+
+(defonce bpm (atom 120))
+(defonce >bpm (m/watch bpm))
+
 (defn clock
   "Returns a tuple of [`>clock` `clock`].
   `clock` is an atom representing the current time.