;;; FINS.CLM:  Non-real time version of vocal formant instrument
;;; Contains three formants driven by bandlimited pulse train
;;; Inputs: Start time, dur, amplitude (linear scale); Pulse train frequency
;;; (Hz) db-Gains, center freq's and Q's for three formants, plus 
;;; envelope-controlled vibrato rate and depth. We control this instrument in
;;; Stella using experiments on the logistic map.

;;; Important note: Formant gains in DBS.  Overall instrument amplitude is
;;; controlled linearly.

;;; macro needed to properly compute filter's radius
;;; from a given bandwidth in Hertz
(defmacro compute-radius (bw)
  `(- 1 (/ (* pi ,bw) ,sampling-rate)))

;;; macro needed to compute floating point "scaler" gain 
;;; from value in dB
(defmacro in-db (dbval)
  `(expt 10.0 (/ ,dbval 20.0)))


;;; clips x to range (a.b)
(defmacro clip (a b x)
   `(max(min ,x ,b) ,a))

(definstrument fins (start dur fade amp freq fc1 q1 g1 fc2 q2 g2 fc3 q3 g3
    &optional (vdepth 0) (vspeed 0))
   (let* ((eps (clip 0 0.5 (* dur fade)))
          (st1 (max (- start eps) 0))
          (st2 (+ start eps))
          (st3 (- (+ start dur) eps))
          (st4 (+ start dur eps))
          (true-dur (- st4 st1)) 
          (ampenv (make-env :envelope 
            (let* ((k1 (- st2 st1)) (k2 (- st3 st1)))  
               (list 0 0 k1 1 k2 1 true-dur 0)) 
            :scaler amp :duration true-dur))
          (vdepthenv (make-env :envelope 
            (let* ((k1 (- st2 st1)) (k2 (- (+ (* .75 st2) (* .25 st3)) st1))
                  (k3 (- st3 st1))) 
               (list 0 0 k1 0.25 k2 1.1 k3 1 true-dur 0)) 
            :scaler vdepth  :duration true-dur))
          (vspeedenv (make-env :envelope 
            (let* ((k1 (- (+ (* .75 st2) (* .25 st3)) st1)) 
                   (k2 (- (+ (* .5 st2) (* .5 st3)) st1))) 
               (list 0 0 k1 1.25 k2 1 true-dur 1)) 
            :scaler vspeed :duration true-dur))
          (beg (floor (* sampling-rate st1)))
          (end (floor (* sampling-rate st4)))
          (nyquist-freq (/ sampling-rate 2.0))
          (vtri (make-triangle-wave))
          (sincm (make-sum-of-cosines))
          (f1 (make-formant 0.9 100))
          (f2 (make-formant 0.9 200))
          (f3 (make-formant 0.9 300))
          (r1 (compute-radius (/ fc1 q1)))
          (r2 (compute-radius (/ fc2 q2)))
          (r3 (compute-radius (/ fc3 q3)))
          (a1 (in-db g1))
          (a2 (in-db g2))
          (a3 (in-db g3))
          (num-cosines 0)
          (psrc 0)  )

;; Stuff to compute once
   (setf (formant-radius f1) r1)
   (setf (formant-radius f2) r2)
   (setf (formant-radius f3) r3)
   (setf (frmnt-g f1) a1)
   (setf (frmnt-g f2) a2)
   (setf (frmnt-g f3) a3)     

;; Stuff to compute per-sample       
   (Run
      (loop for i from beg to end do
         (setf (frequency vtri) (env vspeedenv))
         (setf num-cosines (floor (+ (/ nyquist-freq freq) 0.5)))  
         (setf (cosp-cosines sincm) num-cosines)
         (setf (cosp-scaler sincm) (/ 1.0 (+ 1 (* 2 (cosp-cosines sincm)))))
         (setf (frequency sincm) 
            (* freq (+ 1 (* (env vdepthenv) (triangle-wave vtri)))))
         (setf psrc (sum-of-cosines sincm))
         (setf (frequency f1) fc1)
         (setf (frequency f2) fc2)
         (setf (frequency f3) fc3)
         (outa i (* (env ampenv) (+ (formant f1 psrc) (formant f2 psrc) 
            (formant f3 psrc)))))))) 
         

(definstrument nulli (start dur)
   (let* ((beg (floor (* start sampling-rate)))
         (end (+ beg (floor (* dur sampling-rate)))))
   (Run
      (loop for i from beg to end do
         (outa i 0)))))

;;Run: (with-sound (:srate 44100) (fins 1.0 2.0 0.25 0.08 440 800 10 0 1150 12.7 -6 2900 24.2 -32))