blob: b711ebe823f1acfdc2a2bca74ae04b420889b431 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
(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/signal (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 50)
(reset! mono-clock-freq 10)
(reset! mono-clock-freq 1)
(cancel))
(defonce bpm (atom 120))
(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)
;; 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))
(reset! bpm 60)
(reset! bpm 120)
(reset! mono-clock-freq 120)
(reset! mono-clock-freq 1)
(cancel))
|
