fuxoft/audiotest.janet

## audiotest.janet
# Sound device for Chromebook: hw:CARD=SoundCard,DEV=0
(def sample-rate 48000)

(defn is-generator? [x]
  (and (dictionary? x) (x :is-generator)))

(defn- msg-format [args]
  (string/join
    (map
      (fn [thing]
        (if (= :string (type thing))
          thing
          (if (is-generator? thing)
            (string "[" (thing :name) "]")
            (string/format "%p" thing)))) args)))

(defn debug [& args]
  (print "DBG> " (msg-format args)))

(defn ferror [& args]
  (error (msg-format args)))

(defn interpolate [from1 from2 to1 to2 x]
  (+ to1 (* (- x from1) (/ (- to2 to1) (- from2 from1)))))

(def unique-number-channel (ev/thread-chan))
(ev/spawn-thread
  (for n 1 math/inf
    (ev/give unique-number-channel n)))

(defn unique-number []
  (ev/take unique-number-channel))

(def math/2pi (* 2 math/pi))
(def math/root-2-12 (math/pow 2 (/ 1 12)))
(defn note-to-step [note]
  "Converts midi note number to step size
  (i.e. what fraction of one cycle is advanced during the rendering of one sample)."
  # note 69 = 440 Hz. This formula is hardcoded for 48000 Hz sample rate!!!
  (* 0.00017033 (math/exp2 (/ note 12))))

(defn float-to-word
  "Converts float between -1 and 1 to two bytes."
  [float]
  (assert (and (<= float 1) (>= float -1)) "Audio clipping.")
  (def signed (math/round (* 32767 float)))
  (def bytes (if (neg? signed) (+ 0x10000 signed) signed))
  (def upper (brshift bytes 8))
  (def lower (band 0xff bytes))
  #  (print lower " " upper)
  (def buf (buffer/push @"" lower upper))
  #(pp buf)
  buf)

(def aplay-channel (ev/chan))

(def fname "out.raw")

(ev/spawn
  (file/close (file/open fname :w))
  # 16 bit little endian, 48000, stereo
  (def args @["aplay" "-f" "S16_LE" "-c" "2" "-r" (string sample-rate)])
  # Command line argument "chrome" switches output to Chrome sound device
  (if (= "chrome" (get (dyn *args*) 1))
    (array/insert args 1 "-Dhw:CARD=SoundCard,DEV=0"))
  (def proc (os/spawn args :px {:in :pipe}))
  (def stream (assert (proc :in)))
  (forever
    (def word (float-to-word (ev/take aplay-channel)))
    # First comes left channel, then the right
    (def f (file/open fname :ab))
    (file/write f word)
    (file/close f)
    (ev/write stream word)))

(defn- table/filter [fun tbl]
  (def result @{})
  (eachp [k v] tbl
    (if (fun v)
      (put result k v)))
  result)

(defn new-generator
  [coro0 &opt name]
  (assert (= :fiber (type coro0)))
  (def obj @{:is-generator true})
  (def cor
    (coro
      (def self obj) #todo
      (forever
        (when (empty? (self :inputs))
          (yield :bye)
          (error "Should never reach here!"))
        (var min-wait math/inf)
        (each inp (self :inputs)
          (if (< (inp :wait) min-wait)
            (set min-wait (inp :wait))))
        (if (neg? min-wait) (error "Negative :wait value."))
        (if (zero? min-wait)
          #Some input(s) can execute
          (do
            # Find all inputs with lowest :wait
            (def lowest-waits
              (table/filter
                (fn [inp] (= (inp :wait) min-wait)) (self :inputs)))
            (assert (not (empty? lowest-waits)))
            (def current-key
              (do
                (var [found highest] [false math/-inf])
                (eachp [k v] lowest-waits
                  (when (> (v :priority) highest)
                    (set found k)
                    (set highest (v :priority))))
                found))
            (assert current-key)
            (def current-coro (get-in self [:inputs current-key :coroutine]))
            (def incoming (resume current-coro))
            #(debug self " received " incoming " from its " current-key)
            (match incoming
              nil
              (ferror self "'s " current-key " has terminated without yielding :bye.")
              :bye
              # Input coro has finished, disconnect this input
              (put (self :inputs) current-key nil)
              [:do fun]
              (fun self)
              [:set-stream cor]
              (do
                #(debug "Output stream for " current-key " in " self " set to " cor)
                (put-in self [:inputs current-key :stream] cor))
              [:wait time]
              (put-in self [:inputs current-key :wait] time)
              (ferror "Invalid incoming directive for " self ": " incoming)))
          #All inputs are waiting for at least <min-wait> ticks
          (do
            #(def stream-coro (self :stream-coroutine))
            (def streams @{})
            (eachp [k v] (self :inputs)
              (if (v :stream)
                (put streams k v)))
            #(debug self " inputs: " (self :inputs))
            #(debug "Streams: " streams)
            (if (empty? streams)
              (comment)
              (if (self :combine-streams)
                (:combine-streams self streams)
                (ferror "There are " (length streams) " active streams in " self
                        " but :combine-streams is undefined.")))
            (yield [:wait min-wait])
            # (debug self " has waited for " min-wait " ticks.")
            (eachp [k v] (self :inputs)
              (assert (>= (v :wait) min-wait))
              (put v :wait (- (v :wait) min-wait))))))))
  #(def obj (table/setproto @{} proto))
  (put obj :output cor)
  (default name "Generator")
  (put obj :name (string name " #" (unique-number)))
  (def inputs @{})
  (put obj :inputs inputs)
  (put inputs :init @{:priority 0 :coroutine coro0 :wait 0})
  obj)

# (envelope [[1 0] [0.5 0.2] [0.5 0.8] [0 1] :hold] ... returns coro
# Unless there is :hold at the end, it REPEATS FOREVER
(defn envelope-coroutine
  [env]
  (coro
    (forever
      (var value 0)
      (each item env
        (match item
          :hold
          (forever (yield value))
          [new-value time]
          (do
            (assert (>= time 0))
            (if (zero? time)
              (set value new-value)
              (let [step (/ (- new-value value) time)]
                (if (zero? step)
                  (repeat time
                    (yield value))
                  (do
                    (repeat time
                      (yield value)
                      (set value (+ value step)))
                    (set value new-value))))))
          (ferror "Invalid envelope pair:  item"))))))

(defn oscillator [note-n]
  (coro
    (def env (envelope-coroutine [[0.2 0] [0.07 20000] :hold]))
    (def mo (envelope-coroutine [[0.1 0] [0.5 10000] [0.1 10000]]))
    (def step (note-to-step note-n))
    (var position 0)
    (forever
      #(yield (* (resume env) (math/sin (* position math/2pi))))
      #(yield (* (dec (* 2 position)) (resume env))) # saw
      #(yield (* (resume env) (if (< position 0.5) (dec (* 4 position)) (+ 3 (* -4 position))))) #triangle
      (yield (if (< position (resume mo)) (- (resume env)) (resume env))) #mod
      (set position (% (+ position step) 1))
      #(print (string (self :name) " " position))
      #(set count (if (> count 1) (- count 2) count))
)))

(defn gen-do [fun]
  (yield [:do fun]))

(defn gen-bye []
  (yield :bye))

# Sets the audio stream for THIS WHOLE GENERATOR (not just this coroutine) in the parent generator.
(defn gen-my-stream [cor]
  (yield [:do (fn [self]
                (assert (fiber? cor))
                (yield [:set-stream cor]))]))

(defn gen-wait [time]
  (yield [:wait time]))

(defn gen-wait-forever []
  (yield [:wait math/inf]))

(defn gen-add-input [thing &opt name?]
  (gen-do
    (fn [self]
      (def [name cor]
        (if (is-generator? thing)
          [(string "<Gen:" (thing :name) ">") (thing :output)]
          [(or name? (string "Coro#" (unique-number))) thing]))
      (assert (= :fiber (type cor)))
      (def name2
        (if (get-in self [:inputs name])
          (string name " " (unique-number))
          name))
      #(debug "Connected input " name2 " to " self)
      (put-in self [:inputs name2] @{:coroutine cor :priority 0 :wait 0}))))

(defn play-note [note-n len]
  (def release 10000)
  (def note-gen
    (new-generator
      (coro
        (def wavegen (oscillator note-n))
        (def wavegen2 (oscillator (- note-n 0.01)))
        (gen-my-stream
          (coro
            (repeat len
              (yield (+ (resume wavegen) (resume wavegen2))))
            (def fader (envelope-coroutine [[1 0] [0 release]]))
            # (debug "release " release)
            (repeat release
              (def f (resume fader))
              (yield (* f (+ (resume wavegen) (resume wavegen2)))))
            (forever (yield 0))))
        (gen-wait (+ len release))
        (gen-bye))
      "Note"))
  (gen-add-input note-gen))

(def mixer1
  (new-generator
    (coro
      # Reverb and filter test
      (def buf @[])
      (def rng (math/rng))
      (repeat 65536
        (array/push buf 0))
      (var rev-pointer 0)
      (defn rev-add [index value multiply]
        (def ind (band 65535 (+ rev-pointer index)))
        (put buf ind (+ (* multiply value) (buf ind))))
      (var s0 0)
      (def mod (envelope-coroutine [[1 0] [0.01 300000] [1 300000]]))
      (defn reverb [input]
        (coro
          (forever
            (def inp (resume input))
            (def out (+ inp (buf rev-pointer)))
#            (rev-add 7941 out 0.3)
#            (rev-add 6141 out 0.3)
#            (rev-add 5141 out 0.3)
            #(def out2 (+ (* (resume mod) (- out s0)) s0))
            (yield out)
            #(set s0 out2)
            (put buf rev-pointer 0)
            (set rev-pointer (band 65535 (inc rev-pointer))))))

      (gen-do
        # Initialize mixer
        (fn [self]
          # (debug "Setting combine-streams hook.")
          (put self :combine-streams
               (fn [self streams]
                 # (debug "Mixing streams!!!!")
                 (def mixed-stream
                   (if (empty? streams)
                     (coro (forever (yield 0)))
                     (if (= 1 (length streams))
                       (assert (get-in streams [(next streams) :stream]))
                       (coro
                         (def mix
                           (map (fn [st] (get st :stream)) streams))
                         (forever
                           (yield
                             (reduce (fn [acc co] (+ acc (resume co))) 0 mix)))))))
                 (assert mixed-stream)
                 # (debug "Streams mixed into " mixed-stream)
                 (gen-my-stream (reverb mixed-stream))))))

      # End of mixer init

      (forever
        (each base [60 62 64]
          (each note [0 4 7]
            (play-note (+ base note) 30000)
            (gen-wait 18000)))))
    "Mixer"))

(def master-out
  (new-generator
    (coro
      (gen-add-input mixer1)
      (gen-wait-forever))
    "Master out"))

(var st nil)
(var cnt 0)
(def time0 (os/clock))
(forever
  (def incoming (resume (master-out :output)))
  # (debug "Incoming from master-out: " incoming)
  (match incoming
    [:set-stream str]
    (set st str)
    [:wait samples]
    (do
      (repeat samples
        (def mono-sample (resume st))
        (++ cnt)
        #        (print cnt " " mono-sample)
        (when (> cnt 48000000000000)
          (print "10 seconds rendered in " (- (os/clock) time0))
          (os/exit))
        #(print "mono sample " mono-sample)
        (ev/give aplay-channel mono-sample)
        (ev/give aplay-channel mono-sample)
        #23 notes, took 1.29-1.34 secs
))))
	# Sound device for Chromebook: hw:CARD=SoundCard,DEV=0
	(def sample-rate 48000)

	(defn is-generator? [x]
	(and (dictionary? x) (x :is-generator)))

	(defn- msg-format [args]
	(string/join
	(map
	(fn [thing]
	(if (= :string (type thing))
	thing
	(if (is-generator? thing)
	(string "[" (thing :name) "]")
	(string/format "%p" thing)))) args)))

	(defn debug [& args]
	(print "DBG> " (msg-format args)))

	(defn ferror [& args]
	(error (msg-format args)))

	(defn interpolate [from1 from2 to1 to2 x]
	(+ to1 (* (- x from1) (/ (- to2 to1) (- from2 from1)))))

	(def unique-number-channel (ev/thread-chan))
	(ev/spawn-thread
	(for n 1 math/inf
	(ev/give unique-number-channel n)))

	(defn unique-number []
	(ev/take unique-number-channel))

	(def math/2pi (* 2 math/pi))
	(def math/root-2-12 (math/pow 2 (/ 1 12)))
	(defn note-to-step [note]
	"Converts midi note number to step size
	(i.e. what fraction of one cycle is advanced during the rendering of one sample)."
	# note 69 = 440 Hz. This formula is hardcoded for 48000 Hz sample rate!!!
	(* 0.00017033 (math/exp2 (/ note 12))))

	(defn float-to-word
	"Converts float between -1 and 1 to two bytes."
	[float]
	(assert (and (<= float 1) (>= float -1)) "Audio clipping.")
	(def signed (math/round (* 32767 float)))
	(def bytes (if (neg? signed) (+ 0x10000 signed) signed))
	(def upper (brshift bytes 8))
	(def lower (band 0xff bytes))
	# (print lower " " upper)
	(def buf (buffer/push @"" lower upper))
	#(pp buf)
	buf)

	(def aplay-channel (ev/chan))

	(def fname "out.raw")

	(ev/spawn
	(file/close (file/open fname :w))
	# 16 bit little endian, 48000, stereo
	(def args @["aplay" "-f" "S16_LE" "-c" "2" "-r" (string sample-rate)])
	# Command line argument "chrome" switches output to Chrome sound device
	(if (= "chrome" (get (dyn args) 1))
	(array/insert args 1 "-Dhw:CARD=SoundCard,DEV=0"))
	(def proc (os/spawn args :px {:in :pipe}))
	(def stream (assert (proc :in)))
	(forever
	(def word (float-to-word (ev/take aplay-channel)))
	# First comes left channel, then the right
	(def f (file/open fname :ab))
	(file/write f word)
	(file/close f)
	(ev/write stream word)))

	(defn- table/filter [fun tbl]
	(def result @{})
	(eachp [k v] tbl
	(if (fun v)
	(put result k v)))
	result)

	(defn new-generator
	[coro0 &opt name]
	(assert (= :fiber (type coro0)))
	(def obj @{:is-generator true})
	(def cor
	(coro
	(def self obj) #todo
	(forever
	(when (empty? (self :inputs))
	(yield :bye)
	(error "Should never reach here!"))
	(var min-wait math/inf)
	(each inp (self :inputs)
	(if (< (inp :wait) min-wait)
	(set min-wait (inp :wait))))
	(if (neg? min-wait) (error "Negative :wait value."))
	(if (zero? min-wait)
	#Some input(s) can execute
	(do
	# Find all inputs with lowest :wait
	(def lowest-waits
	(table/filter
	(fn [inp] (= (inp :wait) min-wait)) (self :inputs)))
	(assert (not (empty? lowest-waits)))
	(def current-key
	(do
	(var [found highest] [false math/-inf])
	(eachp [k v] lowest-waits
	(when (> (v :priority) highest)
	(set found k)
	(set highest (v :priority))))
	found))
	(assert current-key)
	(def current-coro (get-in self [:inputs current-key :coroutine]))
	(def incoming (resume current-coro))
	#(debug self " received " incoming " from its " current-key)
	(match incoming
	nil
	(ferror self "'s " current-key " has terminated without yielding :bye.")
	:bye
	# Input coro has finished, disconnect this input
	(put (self :inputs) current-key nil)
	[:do fun]
	(fun self)
	[:set-stream cor]
	(do
	#(debug "Output stream for " current-key " in " self " set to " cor)
	(put-in self [:inputs current-key :stream] cor))
	[:wait time]
	(put-in self [:inputs current-key :wait] time)
	(ferror "Invalid incoming directive for " self ": " incoming)))
	#All inputs are waiting for at least <min-wait> ticks
	(do
	#(def stream-coro (self :stream-coroutine))
	(def streams @{})
	(eachp [k v] (self :inputs)
	(if (v :stream)
	(put streams k v)))
	#(debug self " inputs: " (self :inputs))
	#(debug "Streams: " streams)
	(if (empty? streams)
	(comment)
	(if (self :combine-streams)
	(:combine-streams self streams)
	(ferror "There are " (length streams) " active streams in " self
	" but :combine-streams is undefined.")))
	(yield [:wait min-wait])
	# (debug self " has waited for " min-wait " ticks.")
	(eachp [k v] (self :inputs)
	(assert (>= (v :wait) min-wait))
	(put v :wait (- (v :wait) min-wait))))))))
	#(def obj (table/setproto @{} proto))
	(put obj :output cor)
	(default name "Generator")
	(put obj :name (string name " #" (unique-number)))
	(def inputs @{})
	(put obj :inputs inputs)
	(put inputs :init @{:priority 0 :coroutine coro0 :wait 0})
	obj)

	# (envelope [[1 0] [0.5 0.2] [0.5 0.8] [0 1] :hold] ... returns coro
	# Unless there is :hold at the end, it REPEATS FOREVER
	(defn envelope-coroutine
	[env]
	(coro
	(forever
	(var value 0)
	(each item env
	(match item
	:hold
	(forever (yield value))
	[new-value time]
	(do
	(assert (>= time 0))
	(if (zero? time)
	(set value new-value)
	(let [step (/ (- new-value value) time)]
	(if (zero? step)
	(repeat time
	(yield value))
	(do
	(repeat time
	(yield value)
	(set value (+ value step)))
	(set value new-value))))))
	(ferror "Invalid envelope pair: item"))))))

	(defn oscillator [note-n]
	(coro
	(def env (envelope-coroutine [[0.2 0] [0.07 20000] :hold]))
	(def mo (envelope-coroutine [[0.1 0] [0.5 10000] [0.1 10000]]))
	(def step (note-to-step note-n))
	(var position 0)
	(forever
	#(yield (* (resume env) (math/sin (* position math/2pi))))
	#(yield (* (dec (* 2 position)) (resume env))) # saw
	#(yield (* (resume env) (if (< position 0.5) (dec (* 4 position)) (+ 3 (* -4 position))))) #triangle
	(yield (if (< position (resume mo)) (- (resume env)) (resume env))) #mod
	(set position (% (+ position step) 1))
	#(print (string (self :name) " " position))
	#(set count (if (> count 1) (- count 2) count))
	)))

	(defn gen-do [fun]
	(yield [:do fun]))

	(defn gen-bye []
	(yield :bye))

	# Sets the audio stream for THIS WHOLE GENERATOR (not just this coroutine) in the parent generator.
	(defn gen-my-stream [cor]
	(yield [:do (fn [self]
	(assert (fiber? cor))
	(yield [:set-stream cor]))]))

	(defn gen-wait [time]
	(yield [:wait time]))

	(defn gen-wait-forever []
	(yield [:wait math/inf]))

	(defn gen-add-input [thing &opt name?]
	(gen-do
	(fn [self]
	(def [name cor]
	(if (is-generator? thing)
	[(string "<Gen:" (thing :name) ">") (thing :output)]
	[(or name? (string "Coro#" (unique-number))) thing]))
	(assert (= :fiber (type cor)))
	(def name2
	(if (get-in self [:inputs name])
	(string name " " (unique-number))
	name))
	#(debug "Connected input " name2 " to " self)
	(put-in self [:inputs name2] @{:coroutine cor :priority 0 :wait 0}))))

	(defn play-note [note-n len]
	(def release 10000)
	(def note-gen
	(new-generator
	(coro
	(def wavegen (oscillator note-n))
	(def wavegen2 (oscillator (- note-n 0.01)))
	(gen-my-stream
	(coro
	(repeat len
	(yield (+ (resume wavegen) (resume wavegen2))))
	(def fader (envelope-coroutine [[1 0] [0 release]]))
	# (debug "release " release)
	(repeat release
	(def f (resume fader))
	(yield (* f (+ (resume wavegen) (resume wavegen2)))))
	(forever (yield 0))))
	(gen-wait (+ len release))
	(gen-bye))
	"Note"))
	(gen-add-input note-gen))

	(def mixer1
	(new-generator
	(coro
	# Reverb and filter test
	(def buf @[])
	(def rng (math/rng))
	(repeat 65536
	(array/push buf 0))
	(var rev-pointer 0)
	(defn rev-add [index value multiply]
	(def ind (band 65535 (+ rev-pointer index)))
	(put buf ind (+ (* multiply value) (buf ind))))
	(var s0 0)
	(def mod (envelope-coroutine [[1 0] [0.01 300000] [1 300000]]))
	(defn reverb [input]
	(coro
	(forever
	(def inp (resume input))
	(def out (+ inp (buf rev-pointer)))
	# (rev-add 7941 out 0.3)
	# (rev-add 6141 out 0.3)
	# (rev-add 5141 out 0.3)
	#(def out2 (+ (* (resume mod) (- out s0)) s0))
	(yield out)
	#(set s0 out2)
	(put buf rev-pointer 0)
	(set rev-pointer (band 65535 (inc rev-pointer))))))

	(gen-do
	# Initialize mixer
	(fn [self]
	# (debug "Setting combine-streams hook.")
	(put self :combine-streams
	(fn [self streams]
	# (debug "Mixing streams!!!!")
	(def mixed-stream
	(if (empty? streams)
	(coro (forever (yield 0)))
	(if (= 1 (length streams))
	(assert (get-in streams [(next streams) :stream]))
	(coro
	(def mix
	(map (fn [st] (get st :stream)) streams))
	(forever
	(yield
	(reduce (fn [acc co] (+ acc (resume co))) 0 mix)))))))
	(assert mixed-stream)
	# (debug "Streams mixed into " mixed-stream)
	(gen-my-stream (reverb mixed-stream))))))

	# End of mixer init

	(forever
	(each base [60 62 64]
	(each note [0 4 7]
	(play-note (+ base note) 30000)
	(gen-wait 18000)))))
	"Mixer"))

	(def master-out
	(new-generator
	(coro
	(gen-add-input mixer1)
	(gen-wait-forever))
	"Master out"))

	(var st nil)
	(var cnt 0)
	(def time0 (os/clock))
	(forever
	(def incoming (resume (master-out :output)))
	# (debug "Incoming from master-out: " incoming)
	(match incoming
	[:set-stream str]
	(set st str)
	[:wait samples]
	(do
	(repeat samples
	(def mono-sample (resume st))
	(++ cnt)
	# (print cnt " " mono-sample)
	(when (> cnt 48000000000000)
	(print "10 seconds rendered in " (- (os/clock) time0))
	(os/exit))
	#(print "mono sample " mono-sample)
	(ev/give aplay-channel mono-sample)
	(ev/give aplay-channel mono-sample)
	#23 notes, took 1.29-1.34 secs
	))))