diff options
Diffstat (limited to 'src/unheard/clock.clj')
| -rw-r--r-- | src/unheard/clock.clj | 104 |
1 files changed, 50 insertions, 54 deletions
diff --git a/src/unheard/clock.clj b/src/unheard/clock.clj index d38b52a..b711ebe 100644 --- a/src/unheard/clock.clj +++ b/src/unheard/clock.clj @@ -2,30 +2,23 @@ (: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))))))) +(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))))) +(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/signal - (m/watch mono-clock-freq))) +(defonce >mono-clock-freq (m/signal (m/watch mono-clock-freq))) (def >mono-clock "This is the base monotonic clock used for driving playback. @@ -38,57 +31,60 @@ 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))))) + (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)) - + (def cancel ((m/reduce prn nil >mono-clock) prn prn)) (reset! mono-clock-freq 50) (reset! mono-clock-freq 10) (reset! mono-clock-freq 1) (cancel)) (defonce bpm (atom 120)) -(defonce >bpm - (m/signal - (m/watch bpm))) +(defonce >bpm (m/signal (m/watch bpm))) (def >beat-clock "Counts beats at `bpm`. Guaranteed not to lose or gain time." (m/signal - (m/relieve - (let [init-beat 0] - (m/reductions {} init-beat - (m/ap - (let [state (object-array 2) - last-beat-time-idx 0 - last-beat-number-idx 1 - _ (aset state last-beat-time-idx (System/nanoTime)) - _ (aset state last-beat-number-idx init-beat) - [t bpm] (m/?< (m/latest vector >mono-clock >bpm)) - last-beat-time (aget state last-beat-time-idx) - next-beat-time (+ last-beat-time (* 1000000000 (/ 60 bpm))) - last-beat-number (aget state last-beat-number-idx) - t-since-beat-start (- t last-beat-time) - pct-through-current-beat (/ t-since-beat-start (- next-beat-time last-beat-time))] - (when (<= next-beat-time t) - ;; TODO confirm this won't lose or gain time - (aset state last-beat-time-idx next-beat-time) - (aset state last-beat-number-idx (inc last-beat-number))) - (+ last-beat-number pct-through-current-beat)))))))) + (m/relieve + (let [init-beat 0] + (m/reductions + {} + init-beat + (m/ap + (let [state (object-array 2) + last-beat-time-idx 0 + last-beat-number-idx 1 + _ (aset state last-beat-time-idx (System/nanoTime)) + _ (aset state last-beat-number-idx init-beat) + ;; BUG 8a32cde: BPM changes can cause non-monotonic + ;; behavior! + [t bpm] (m/?< (m/latest vector >mono-clock >bpm))] + (if (= bpm 0) + (m/amb) + (let [last-beat-time (aget state last-beat-time-idx) + next-beat-time (+ last-beat-time + (* 1000000000 (/ 60 bpm))) + last-beat-number (aget state last-beat-number-idx) + t-since-beat-start (- t last-beat-time) + pct-through-current-beat (/ t-since-beat-start + (- next-beat-time + last-beat-time))] + (when (<= next-beat-time t) + ;; TODO confirm this won't lose or gain time + (aset state last-beat-time-idx next-beat-time) + (aset state last-beat-number-idx (inc last-beat-number))) + (+ last-beat-number pct-through-current-beat)))))))))) (comment - (def cancel - ((m/reduce prn nil >beat-clock) prn prn)) - + (def cancel ((m/reduce prn nil >beat-clock) prn prn)) (reset! bpm 60) (reset! bpm 120) (reset! mono-clock-freq 120) |