;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-

;;; FM VIOLIN ----------------------------------------------
;;;
;;; a lot of this instrument is the result of nearly 20 years of use
;;; in 3 or 4 very different environments -- if I were to start all
;;; over, it would be simpler.  See fmviolin.clm for some old examples.

(defun v-normalize-to-power-of-two (coeffs)
  (let ((maxval (abs (aref coeffs 0)))
	(arrsiz (array-total-size coeffs))
	(scaler 0.0))
    (loop for i from 1 below arrsiz do
      (setf maxval (max maxval (abs (aref coeffs i)))))
    (setf maxval (expt 2 (+ 2 (ceiling (/ (log maxval) (log 2))))))
    ;; 2 here to give us plenty of headroom (to accomodate fractional arithmetic on 56000)
    (setf scaler (/ 1.0 maxval))
    (loop for i from 0 below arrsiz do
      (setf (aref coeffs i) (make-short-float (* scaler (aref coeffs i)))))
    maxval))

(defun bit20 (x)			;Samson box modifier got 2's complement 20 bit interpreted as fraction 
  (if (>= x (expt 2 19))                ;(this needed to keep fm-violin backwards compatible with old note lists)
      (float (/ (- x (expt 2 20)) (expt 2 19)))
    (float (/ x (expt 2 19)))))

(defun make-frobber-function (beg end frobl)
  (let ((result (list beg))
	(val (bit20 (cadr frobl))))
    (loop for x in frobl by #'cddr and 
              y in (cdr frobl) by #'cddr do
      (when (and (>= x beg)
		 (<= x end))
	(push val result)
	(push x result)
	(setf val (bit20 y))))
    (push val result)
    (push end result)
    (push val result)
    (nreverse result)))

;;; these variables mimic to some extent the Mus10 notion of "sticky" parameters
(defvar fm-violin-fm-index 1.0)
(defvar fm-violin-amp-env '(0 0  25 1  75 1  100 0))
(defvar fm-violin-periodic-vibrato-rate 5.0)
(defvar fm-violin-random-vibrato-rate 16.0)
(defvar fm-violin-periodic-vibrato-amplitude 0.0025)
(defvar fm-violin-random-vibrato-amplitude 0.005)
(defvar fm-violin-noise-amount 0.0)
(defvar fm-violin-noise-freq 1000.0)
(defvar fm-violin-ind-noise-amount 0.0)
(defvar fm-violin-ind-noise-freq 10.0)
(defvar fm-violin-amp-noise-amount 0.0)
(defvar fm-violin-amp-noise-freq 20.0)
(defvar fm-violin-gliss-env '(0 0  100 0))
(defvar fm-violin-glissando-amount 0.0)
(defvar fm-violin-fm1-env '(0 1  25 .4  75 .6  100 0))
(defvar fm-violin-fm2-env fm-violin-fm1-env)
(defvar fm-violin-fm3-env fm-violin-fm1-env)
(defvar fm-violin-fm1-rat 1.0)
(defvar fm-violin-fm2-rat 3.0)
(defvar fm-violin-fm3-rat 4.0)
(defvar fm-violin-base nil)
(defvar fm-violin-frobber nil)
(defvar fm-violin-reverb-amount 0.01)
(defvar fm-violin-index-type :violin)
(defvar fm-violin-denoise nil)
(defvar fm-violin-index1 nil)
(defvar fm-violin-index2 nil)
(defvar fm-violin-index3 nil)
(defvar fm-violin-cutoff-freq 8000)
(defvar fm-violin-resonance 0.7)

(defun restore-fm-violin-defaults ()
  (setf fm-violin-fm-index 1.0)
  (setf fm-violin-amp-env '(0 0  25 1  75 1  100 0))
  (setf fm-violin-periodic-vibrato-rate 5.0)
  (setf fm-violin-random-vibrato-rate 16.0)
  (setf fm-violin-periodic-vibrato-amplitude 0.0025)
  (setf fm-violin-random-vibrato-amplitude 0.005)
  (setf fm-violin-noise-amount 0.0)
  (setf fm-violin-noise-freq 1000.0)
  (setf fm-violin-ind-noise-amount 0.0)
  (setf fm-violin-ind-noise-freq 10.0)
  (setf fm-violin-gliss-env '(0 0  100 0))
  (setf fm-violin-glissando-amount 0.0)
  (setf fm-violin-fm1-env '(0 1  25 .4  75 .6  100 0))
  (setf fm-violin-fm2-env fm-violin-fm1-env)
  (setf fm-violin-fm3-env fm-violin-fm1-env)
  (setf fm-violin-fm1-rat 1.0)
  (setf fm-violin-fm2-rat 3.0)
  (setf fm-violin-fm3-rat 4.0)
  (setf fm-violin-base nil)
  (setf fm-violin-frobber nil)
  (setf fm-violin-reverb-amount 0.01)
  (setf fm-violin-index-type :violin)
  (setf fm-violin-denoise nil)
  (setf fm-violin-index1 nil)
  (setf fm-violin-index2 nil)
  (setf fm-violin-index3 nil))

(definstrument fm-violin
  (startime dur frequency amplitude &key
	    (fm-index                   fm-violin-fm-index)
	    (amp-env                    fm-violin-amp-env)
	    (periodic-vibrato-rate      fm-violin-periodic-vibrato-rate)
	    (random-vibrato-rate        fm-violin-random-vibrato-rate)
	    (periodic-vibrato-amplitude fm-violin-periodic-vibrato-amplitude)
	    (random-vibrato-amplitude   fm-violin-random-vibrato-amplitude)
	    (noise-amount               fm-violin-noise-amount)
	    (ind-noise-freq             fm-violin-ind-noise-freq)
	    (ind-noise-amount           fm-violin-ind-noise-amount)
	    (amp-noise-freq             fm-violin-amp-noise-freq)
	    (amp-noise-amount           fm-violin-amp-noise-amount)
	    (noise-freq                 fm-violin-noise-freq)
	    (gliss-env                  fm-violin-gliss-env)
	    (glissando-amount           fm-violin-glissando-amount)
	    (fm1-env                    fm-violin-fm1-env)
	    (fm2-env                    fm-violin-fm2-env)
	    (fm3-env                    fm-violin-fm3-env)
	    (fm1-rat                    fm-violin-fm1-rat)
	    (fm2-rat                    fm-violin-fm2-rat)
	    (fm3-rat                    fm-violin-fm3-rat)
	    (fm1-index                  fm-violin-index1)
	    (fm2-index                  fm-violin-index2)
	    (fm3-index                  fm-violin-index3)
	    (base                       fm-violin-base)
	    (frobber                    fm-violin-frobber)
	    (reverb-amount              fm-violin-reverb-amount)
	    (index-type                 fm-violin-index-type)

	    (cutoff-freq                fm-violin-cutoff-freq)
	    (resonance                  fm-violin-resonance)

	    (degree                     nil)
	    (distance                   1.0)
	    (no-waveshaping             nil)
	    (denoise                    fm-violin-denoise)
	    (denoise-dur                .1) ;used to be .5 
	    (denoise-amp                .005)
	    &allow-other-keys)
  (if (> (abs amplitude) 1.0) (setf amplitude (clm-cerror ".1?" .1 #'numberp "amplitude = ~A?" amplitude)))
  (if (< (abs frequency) 1.0) (setf frequency (clm-cerror "440.0?" 440.0 #'numberp "frequency = ~A?" frequency)))
  (let* ((beg (floor (* startime sampling-rate)))
	 (end (+ beg (floor (* dur sampling-rate))))
	 (frq-scl (in-hz frequency))
	 (modulate (not (zerop fm-index)))
	 (maxdev (* frq-scl fm-index))
	 (vln (not (eq index-type :cello)))
	 (easy-case (and (not no-waveshaping)
			 (zerop noise-amount)
			 (eq fm1-env fm2-env)
			 (eq fm1-env fm3-env)
			 (zerop (- fm1-rat (floor fm1-rat)))
			 (zerop (- fm2-rat (floor fm2-rat)))
			 (zerop (- fm3-rat (floor fm3-rat)))))
	 ;; if the envelopes are all the same, and each ratio is an integer, we can use
	 ;; waveshaping to get the modulation very cheaply

	 (logfreq (log frequency))
	 (sqrtfreq (sqrt frequency))
	 (index1 (or fm1-index (min one-pi (* maxdev (/ (if vln 5.0 7.5) logfreq)))))
	 (index2 (or fm2-index (min one-pi (* maxdev 3.0 (if vln 
							     (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001)))
							   (/ 15.0 sqrtfreq))))))
	 (index3 (or fm3-index (min one-pi (* maxdev (/ (if vln 4.0 8.0) sqrtfreq)))))

	 (coeffs (and easy-case modulate
		      (get-chebychev-coefficients 
		       (list fm1-rat index1
			     fm2-rat index2
			     fm3-rat index3))))
	 (norm (or (and easy-case modulate (v-normalize-to-power-of-two coeffs)) index1))
v	 
	 (carrier (make-oscil frequency))
	 (fmosc1  (and modulate (make-oscil (* fm1-rat frequency))))
	 (fmosc2  (and modulate (or easy-case (make-oscil (* fm2-rat frequency)))))
	 (fmosc3  (and modulate (or easy-case (make-oscil (* fm3-rat frequency)))))
	 (ampf  (make-env (if denoise (reduce-amplitude-quantization-noise amp-env dur amplitude denoise-dur denoise-amp) amp-env)
			  amplitude :base base))
	 (indf1 (and modulate (make-env fm1-env norm)))
	 (indf2 (and modulate (or easy-case (make-env fm2-env index2))))
	 (indf3 (and modulate (or easy-case (make-env fm3-env index3))))
	 (frqf (make-env gliss-env (* glissando-amount frq-scl)))
	 (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
	 (ranvib (make-randi random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
	 (fm-noi (if (and (/= 0.0 noise-amount)
			  (null frobber))
		     (make-randh noise-freq (* one-pi noise-amount))))
	 (ind-noi (if (and (/= 0.0 ind-noise-amount) (/= 0.0 ind-noise-freq))
		      (make-randi ind-noise-freq ind-noise-amount)))
	 (amp-noi (if (and (/= 0.0 amp-noise-amount) (/= 0.0 amp-noise-freq))
		      (make-randi amp-noise-freq amp-noise-amount)))
	 (frb-env (if (and (/= 0.0 noise-amount) frobber)
		      (make-env (make-frobber-function startime (+ startime dur) frobber)
				:base 0	:scaler (* two-pi noise-amount))))
	 (vib 0.0) 
	 (modulation 0.0)
	 (loc (make-locsig :degree (or degree (random 90.0)) :revscale reverb-amount :distance distance))
	 (fuzz 0.0)
	 (ind-fuzz 1.0)
	 (amp-fuzz 1.0)
	 (mf (make-moog-filter))
	 (fenv (make-env :envelope (if (listp cutoff-freq)
				       cutoff-freq
				     `(0 ,cutoff-freq 1 ,cutoff-freq))
			 :start-time startime
			 :duration dur))
	 (qenv (make-env :envelope (if (listp resonance)
				       resonance
				     `(0 , resonance 1 ,resonance))
			 :start-time startime
			 :duration dur)))
    (run
     (loop for i from beg to end do
       (if (/= 0.0 noise-amount)
	   (if (null frobber)
	       (setf fuzz (randh fm-noi))
	     (setf fuzz (env frb-env))))
       (setf vib (+ (env frqf) (triangle-wave pervib) (randi ranvib)))
       (if ind-noi (setf ind-fuzz (+ 1.0 (randi ind-noi))))
       (if amp-noi (setf amp-fuzz (+ 1.0 (randi amp-noi))))
       (if modulate
	   (if easy-case
	       (setf modulation
		 (* (env indf1) 
		    (polynomial coeffs (oscil fmosc1 vib))))
	     (setf modulation
	       (+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
		  (* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
		  (* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))
       (setf (moog-Q mf)(env qenv)
	     (moog-frequency mf)(env fenv))
       (locsig loc i
	     (moog-filter mf (* (env ampf) amp-fuzz
				(oscil carrier (+ vib (* ind-fuzz modulation))))))))))


;;; the "fuzz" term is not scaled to fit each modulator (this is the way the SAM version worked)