summaryrefslogtreecommitdiff
path: root/src/unheard/clock.clj
blob: af6c32d6bd6998715548b9a67d55c29051585137 (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
(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.
  `>clock` is a signal representing the current time."
  []
  (let [clock (atom 0)
        >clock (m/signal (m/watch clock))]
    [>clock clock]))