(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." ;; 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)))) (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)) (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. `>clock` is a signal representing the current time." [] (let [clock (atom 0) >clock (m/signal (m/watch clock))] [>clock clock]))