beethoven.clj

(ns explore-overtone.beethoven
  (:use [overtone.live]))

;; Starting with this example
;; https://github.com/overtone/overtone/blob/master/src/overtone/examples/timing/internal_sequencer.clj
;; lets see about trying to get rid of the limitation on sequence
;; length.
;;
;; I'd like to create a composition outside the server in "beat space"
;; (play note N at beat B).  I really enjoy working with the
;; abstraction that a library like https://github.com/ctford/leipzig
;; provides.  But, I don't like the java-side timing troubles that
;; will come when there are two time bases.  So, I want to send some
;; notes just ahead of time to the server for precise timing.
;;
;; I think something like this provides realtime control of
;; tempo/timing with clojure abstraction:
;;
;; clojure process  |  scsynth process
;; -----------------+------------------------
;;               <--|<-- ready for another on-deck buffer
;;                  |                             |
;; create notes  -->|--> [on-deck buffer] --> [active buffer]
;;                  |                             |
;;               -->|--> tempo & control signals -+
;;                  |                             |
;;                  |                             V
;;                  |                         [note-synth]
;;                  |                             V
;;                  |                         [audio synth] --> audio
;;                  |
;;
;; So, you'd send a few notes to the on-deck buffer.  You could adjust
;; the tempo information in real time.  The scsynth process would play
;; from the active buffer normally.  But, when a valid, new on-deck
;; buffer was available, it would be copied to the active buffer at
;; the right time and a signal would be sent back to the clojure
;; process (or it could be polled) to indicate that you could create
;; new music.  Repeat until your song is complete.
;;
;; To make the abstraction a bit more concrete, the left-hand side
;; would be both the composer (note & sequence creation) and the
;; conductor (realtime control of timing).  The right hand side is the
;; performer.  The performer looks at the current phrase in front of
;; them and the most-recent instructions from the composer to create a
;; live audio performance.

;; ======================================================================
;; SERVER-SIDE PERFORMER
;;
;; these are the buffers containing the notes in the sequence played by
;;
;; max (:control-rate (server-info)) => 689.0625
(def TICKS-PER-SEC 500) ;; gives max resolution of 1/500 of a second for note on/off.
(def NOTES-PER-SEQ 4)
(def EPSILON 1e-9) ;; some tiny number.  for comparison with 0.0 in buffer  FIXME?
(def performer-tempo-atom (atom 120))
(defn set-performer-tempo
  "adjust the realtime tempo of the performer"
  [bpm]
  (swap! performer-tempo-atom (fn [_] bpm)))
(defn beats-per-tick [] (/ TICKS-PER-SEC (/ @performer-tempo-atom 60)))

;; next or on-deck sequence
;; write via buf-wr
(defonce next-note-on-seq-buf  (buffer NOTES-PER-SEQ))
(defonce next-note-off-seq-buf (buffer NOTES-PER-SEQ))
(defonce next-note-val-seq-buf (buffer NOTES-PER-SEQ))
(defonce next-seq-vld-buf      (buffer 1)) ;; count the # of valid notes
;; active sequence of notes
;; update via trigger that causes
;;   note-on-seq-buf.copyData(next-note-on-seq-buf)
(defonce note-on-seq-buf  (buffer NOTES-PER-SEQ))
(defonce note-off-seq-buf (buffer NOTES-PER-SEQ))
(defonce note-val-seq-buf (buffer NOTES-PER-SEQ))
(defonce seq-vld-buf      (buffer 1))

;; Next let's create some timing buses.
;;(defonce nano-trg-bus (audio-bus))   ;; audio-rate trigger
(defonce tick-trg-bus (control-bus)) ;; global metronome pulse
(defonce tick-cnt-bus (control-bus)) ;; global metronome count
(defonce beat-trg-bus (control-bus)) ;; beat pulse (fraction of tick)
(defonce beat-cnt-bus (control-bus)) ;; beat count
(defonce seq-trg-bus  (control-bus)) ;; next in sequence
(defonce seq-cnt-bus  (control-bus)) ;; sequence count

;; Here we design synths that will drive our pulse buses.

;; we need a trigger that is fast enough to copy buffer to buffer in
;; between tick impulses.  As long as this is less than the true audio rate
;; we should be good.  (< 32 notes in a seq)
;; ???
;;(defsynth nano-trg [rate (* 2 TICKS-PER-SEC NOTES-PER-SEQ)]
;;  (out:kr nano-trg-bus (impulse:kr rate)))

(defsynth tick-trg [rate TICKS-PER-SEC]
  (out:kr tick-trg-bus (impulse:kr rate)))

(defsynth tick-cnt [reset-cnt 0]
  (out:kr tick-cnt-bus (pulse-count:kr (in:kr tick-trg-bus) reset-cnt)))

(defsynth beat-trg [div 100]
  (out:kr beat-trg-bus (pulse-divider (in:kr tick-trg-bus) div)))

(defsynth beat-cnt [reset-cnt 0]
  (out:kr beat-cnt-bus (pulse-count (in:kr beat-trg-bus) reset-cnt)))

(defsynth seq-cnt [reset-cnt 0]
  (out:kr seq-cnt-bus (pulse-count (in:kr seq-trg-bus) reset-cnt)))

(defsynth update-seq-synth
  "on every tick, check to see if active note sequence should get
  updated.  If so, copy next-note-* data to note-* buffers"
  []
  (let [;;nano-trg     (in:ar nano-trg-bus)
        tick-trg     (in:kr tick-trg-bus)
        seq-not-vld  (= (buf-rd:kr 1 seq-vld-buf 0.0 0 1) 0.0)
        next-seq-vld (> (buf-rd:kr 1 next-seq-vld-buf 0.0 0 1) 0.0)
        update       (and tick-trg seq-not-vld next-seq-vld)
        ;;cur-index (pulse-count:ar nano-trg (t2a:ar update))
        ;; okay, the phasor allows all indexes to be
        ;; written. pulse-count only wrote index 0
        cur-index    (phasor:ar update 1 0 NOTES-PER-SEQ 0)
        stop-update  (>= cur-index (- NOTES-PER-SEQ 1))
        ;; fixme active does not get reset!
        active       (set-reset-ff:ar (t2a:ar update) stop-update)]
    ;;(tap "active" 10 active)
    ;;(tap "update" 10 update)
    ;;(tap "stop-update" 10 stop-update)
    ;; this if/when doesn't seem to work.   buf-wr is always happening
    (if (> active 0.5)
      (do
        ;; just want to do the copy over a few :ar ticks.  well before
        ;; the :kr tick will come and require the buffer be updated
        (buf-wr:ar (buf-rd:ar 1 next-note-on-seq-buf cur-index 0 1) note-on-seq-buf cur-index 0)
        (buf-wr:ar (buf-rd:ar 1 next-note-off-seq-buf cur-index 0 1) note-off-seq-buf cur-index 0)
        (buf-wr:ar (buf-rd:ar 1 next-note-val-seq-buf cur-index 0 1) note-val-seq-buf cur-index 0)
        (when (= cur-index (- NOTES-PER-SEQ 1.0))
          (buf-wr:ar (buf-rd:ar 1 next-seq-vld-buf (mod cur-index 1) 0 1) seq-vld-buf (mod cur-index 1) 0))
        ;; there is some race-condition here, I think
        (when (= cur-index NOTES-PER-SEQ)
          (buf-wr:ar [0.0] next-seq-vld-buf (mod cur-index 1) 0))))))

;;(show-graphviz-synth update-seq-synth)


;; unfinished...
;; (defsynth sequence-saw-player
;;   [out-bus amp]
;;   (let [beat-cnt (in:kr beat-cnt-bus)
;;
;;         snd (env-gen (adsr 0.1 0.01 1.0 0.15) trg-snd)
;;         snd (* snd (saw note-freq))]
;;     (out out-bus (* amp snd))))

;; ======================================================================
;; CLOJURE-SIDE COMPOSER/CONDUCTOR
;; this seems to be working.
(defn reset-performer
  []
  (buffer-write! seq-vld-buf [0.0])
  (buffer-write! next-seq-vld-buf [0.0])
  (Thread/sleep 1))

(defn performer-has-room?
  []
  (let [performer-on-deck-count (nth (buffer-data next-seq-vld-buf) 0)]
    (println "  performer on deck count:" performer-on-deck-count)
    (<= performer-on-deck-count EPSILON)))

(defn get-note-ons-offs
  "given a list of durations, calculate the times for the note on/off"
  [cur-lens cur-durs]
  (let [ons  (butlast (reductions + 0 cur-lens))
        offs (map + ons cur-durs)]
    [ons offs]))

(defn send-notes
  "the performer has room, send some notes.  return remaining notes, lengths & durations"
  [cur-notes cur-lens cur-durs]
  (let [performer-buf-count NOTES-PER-SEQ
        [cur-note-ons cur-note-offs] (get-note-ons-offs cur-lens cur-durs)
        num-notes-sent (min performer-buf-count (count cur-notes))]
    (println "  sent" num-notes-sent "notes")
    (buffer-write! next-note-val-seq-buf (take performer-buf-count cur-notes))
    (buffer-write! next-note-on-seq-buf  (take performer-buf-count cur-note-ons))
    (buffer-write! next-note-off-seq-buf (take performer-buf-count cur-note-offs))
    (buffer-write! next-seq-vld-buf      [num-notes-sent])
    ;; return remaining notes
    [(drop performer-buf-count cur-notes)
     (drop performer-buf-count cur-lens)
     (drop performer-buf-count cur-durs)]))

(defn try-send-notes
  "try sending notes to the performer.  return remaining notes, lengths & durations"
  [cur-notes cur-lens cur-durs]
  (if (performer-has-room?)
    (send-notes cur-notes cur-lens cur-durs)
    ;; else
    (do
      (println "  no room for notes")
      [cur-notes cur-lens cur-durs])))

(def CONDUCTOR-SLEEP-TIME 500)

(defn beethoven ;; a bit of ode-to-joy
  []
  (let [all-notes (map note [:e3 :e3 :f3 :g3
                             :g3 :f3 :e3 :d3
                             :c3 :c3 :d3 :e3
                             :e3 :d3 :d3    ])
        all-notes (range 15) ;; FIXME for debug
        ;; length is distance from note-on to next note-on (?name?)
        all-lens  [1   1   1   1
                   1   1   1   1
                   1   1   1   1
                   1   1   2]
        ;; duration is distance from note-on to note-off (?name?)
        all-durs  [0.8 0.8 0.8 0.8
                   0.8 0.8 0.8 0.8
                   0.8 0.8 0.8 0.8
                   0.5 0.5 1.8]
        ]
    (reset-performer)
    (loop [cur-notes all-notes
           cur-lens  all-lens
           cur-durs  all-durs]
      ;;(println "loop" cur-notes cur-lens cur-durs)
      (assert (== (count cur-notes) (count cur-lens) (count cur-durs)))
      (if (empty? cur-notes)
        nil ;; be done, else play your notes
        (let [_ (println (count cur-notes) "notes remain")
              [nxt-notes nxt-lens nxt-durs] (try-send-notes cur-notes cur-lens cur-durs)]
          (Thread/sleep CONDUCTOR-SLEEP-TIME)
          (recur nxt-notes nxt-lens nxt-durs))))))

(comment
  (do
    (stop)
    (reset-performer)
    ;;(def nt (nano-trg))
    (def tt (tick-trg))
    (def tc (tick-cnt [:after tt]))
    (def bt (beat-trg [:after tt]))
    (def bc (beat-cnt [:after bt]))
    (def uss (update-seq-synth))
    )

  ;;(get-in uss [:taps "active"])
  ;;(get-in uss [:taps "update"])
  ;;(get-in uss [:taps "stop-update"])

  (beethoven)
  ;; I should have to force this to make beethoven advance
  ;; but, since there is a bug, I don't have to.
  (buffer-write! seq-vld-buf [0.0])
  ;; this should not get to note-val-seq-buf...but it does!
  (buffer-write! next-note-val-seq-buf [-1.0])

  (do
    (println)
    (println "next-notes" (map #(nth (buffer-read next-note-val-seq-buf) %) (range 4)))
    (println "next-ons  " (map #(nth (buffer-read next-note-on-seq-buf) %) (range 4)))
    (println "next-offs " (map #(nth (buffer-read next-note-off-seq-buf) %) (range 4)))
    (println "notes     " (map #(nth (buffer-read note-val-seq-buf) %) (range 4)))
    (println "ons       " (map #(nth (buffer-read note-on-seq-buf) %) (range 4)))
    (println "offs      " (map #(nth (buffer-read note-off-seq-buf) %) (range 4)))
    (println "next-vld  " (nth (buffer-read next-seq-vld-buf) 0) "vld" (nth (buffer-read seq-vld-buf) 0))
    )
)

stdout.txt

[oops killed nrepl before I got this.]