blob: 89f18c7ec7b3caa3614ba889ade06b6cf1f9ad62 (
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(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 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 1]
(m/reductions {} init-beat
(m/ap
(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]))
(defonce numerator (atom 4))
(defonce >numerator
(m/signal
(m/watch numerator)))
(def >measure-clock
"Emits measure count. Increases at the end of the current measure.
Follows changes to numerator."
(m/signal
(m/relieve
(let [init-measure 1]
(m/reductions {} init-measure
(m/ap
(let [state (object-array 2)
last-measure-idx 0
last-downbeat-idx 1
_ (aset state last-measure-idx init-measure)
_ (aset state last-downbeat-idx init-measure)
[beat numerator] (m/?< (m/latest vector >beat-clock >numerator))
last-measure (aget state last-measure-idx)
last-downbeat (aget state last-downbeat-idx)
next-downbeat (+ last-downbeat numerator)]
(if (<= next-downbeat beat)
(do (aset state last-measure-idx (inc last-measure))
(aset state last-downbeat-idx next-downbeat)
(inc last-measure))
(m/amb)))))))))
(comment
(def cancel
((m/reduce prn nil (m/latest vector >beat-clock >measure-clock)) prn prn))
(reset! mono-clock-freq 120)
(reset! bpm 120)
(reset! bpm -120)
(reset! bpm 160)
(reset! numerator 2)
(reset! numerator 3)
(reset! numerator 4)
(cancel))
|
