;;; -*- Lisp -*-

;;; FM TRUMPET ---------------------------------------------------
;;; Dexter Morrill's FM-trumpet:
;;; from CMJ feb 77 p51

(defvar fm-trumpet-frq1 250) 
(defvar fm-trumpet-frq2 1500) 
(defvar fm-trumpet-amp1 .5) 
(defvar fm-trumpet-amp2 .1)
(defvar fm-trumpet-ampatt1 .03) 
(defvar fm-trumpet-ampdec1 .35) 
(defvar fm-trumpet-ampatt2 .03) 
(defvar fm-trumpet-ampdec2 .3)
(defvar fm-trumpet-modfrq1 250) 
(defvar fm-trumpet-modind11 0) 
(defvar fm-trumpet-modind12 2.66)
(defvar fm-trumpet-modfrq2 250) 
(defvar fm-trumpet-modind21 0) 
(defvar fm-trumpet-modind22 1.8)
(defvar fm-trumpet-rvibamp .007) 
(defvar fm-trumpet-rvibfrq 125) 
(defvar fm-trumpet-vibamp .007) 
(defvar fm-trumpet-vibfrq 7)
(defvar fm-trumpet-vibatt .6) 
(defvar fm-trumpet-vibdec .2) 
(defvar fm-trumpet-frqskw .03) 
(defvar fm-trumpet-frqatt .06)
(defvar fm-trumpet-ampenv1 '(0 0  25 1  75 .9  100 0))
(defvar fm-trumpet-ampenv2 '(0 0  25 1  75 .9  100 0))
(defvar fm-trumpet-indenv1 '(0 0  25 1  75 .9  100 0))
(defvar fm-trumpet-indenv2 '(0 0  25 1  75 .9  100 0))
(defvar fm-trumpet-degree 0.0)
(defvar fm-trumpet-distance 1.0)
(defvar fm-trumpet-reverb-amount 0.005)

(definstrument FM-trumpet (start-time duration
			   &key (frq1 fm-trumpet-frq1)
				(frq2 fm-trumpet-frq2)
				(amp1 fm-trumpet-amp1)
				(amp2 fm-trumpet-amp2)
				(ampatt1 fm-trumpet-ampatt1)
				(ampdec1 fm-trumpet-ampdec1)
				(ampatt2 fm-trumpet-ampatt2)
				(ampdec2 fm-trumpet-ampdec2)
				(modfrq1 fm-trumpet-modfrq1)
				(modind11 fm-trumpet-modind11)
				(modind12 fm-trumpet-modind12)
				(modfrq2 fm-trumpet-modfrq2)
				(modind21 fm-trumpet-modind21)
				(modind22 fm-trumpet-modind22)
				(rvibamp fm-trumpet-rvibamp)
				(rvibfrq fm-trumpet-rvibfrq)
				(vibamp fm-trumpet-vibamp)
				(vibfrq fm-trumpet-vibfrq)
				(vibatt fm-trumpet-vibatt)
				(vibdec fm-trumpet-vibdec)
				(frqskw fm-trumpet-frqskw)
				(frqatt fm-trumpet-frqatt)
				(ampenv1 fm-trumpet-ampenv1)
				(ampenv2 fm-trumpet-ampenv2)
				(indenv1 fm-trumpet-indenv1)
				(indenv2 fm-trumpet-indenv2)
				(degree fm-trumpet-degree)
				(distance fm-trumpet-distance)
				(reverb-amount fm-trumpet-reverb-amount))
  (let* ((beg (floor (* start-time sampling-rate)))
	 (end (+ beg (floor (* duration sampling-rate))))

	 (loc (make-locsig :degree degree :distance distance :revscale reverb-amount))
	 (per-vib-f (make-func :envelope (divseg '(0 1  25 .1  75 0  100 0)
						 25 (* 100 (/ vibatt duration))
						 75 (* 100 (- 1.0 (/ vibdec duration))))
			       :scaler vibamp
			       :start-time start-time :duration duration))
	 (ran-vib (make-randi :frequency rvibfrq :amplitude rvibamp))
	 (per-vib (make-oscil :frequency vibfrq))
	 (dec-01 (* 100 (- 1.0 (/ .01 duration))))
	 (frq-f (make-func :envelope (divseg '(0 0  25 1  75 1  100 0)
					     25 (* 100 (/ frqatt duration))
					     75 dec-01)
			   :scaler frqskw
			   :start-time start-time :duration duration))

	 (ampattpt1 (* 100 (/ ampatt1 duration)))
	 (ampdecpt1 (* 100 (- 1.0 (/ ampdec1 duration))))
	 (ampattpt2 (* 100 (/ ampatt2 duration)))
	 (ampdecpt2 (* 100 (- 1.0 (/ ampdec2 duration))))
	 (frq-change 0.0)
	 
	 (mod1-f (make-func :envelope (divseg indenv1 25 ampattpt1 75 dec-01)
			    :scaler (* modfrq1 (- modind12 modind11))
			    :start-time start-time :duration duration))
	 (mod1 (make-oscil :frequency 0.0))
	 (car1 (make-oscil :frequency 0.0))
	 ;; set frequency to zero here because it is handled multiplicatively below
	 (car1-f (make-func :envelope (divseg ampenv1 25 ampattpt1 75 ampdecpt1)
			    :scaler amp1 :start-time start-time :duration duration))
	 
	 (mod2-f (make-func :envelope (divseg indenv2 25 ampattpt2 75 dec-01)
			    :scaler (* modfrq2 (- modind22 modind21))
			    :start-time start-time :duration duration))
	 (mod2 (make-oscil :frequency 0.0))
	 (car2 (make-oscil :frequency 0.0))
	 (car2-f (make-func :envelope (divseg ampenv2 25 ampattpt2 75 ampdecpt2)
			    :scaler amp2 :start-time start-time :duration duration)))
    (Run
     (loop for i from beg to end do
      
       (setf frq-change (in-Hz (* (+ 1.0 (randi ran-vib))
				  (+ 1.0 (* (env per-vib-f) (oscil per-vib)))
				  (+ 1.0 (env frq-f)))))
       
      ;;  per-vib-env (linen vibamp vibatt vibdec dur F3) '(0 1 25 .1  75 0 100 0) -- LINEN is 0..75!
      ;;  ran-vib (randi rvibamp rvibfrq*mag)
      ;;  per-vib (oscil per-vib-env vibfrq*mag)
      ;;  frq-env (linen frqskw frqatt .01 dur F4 ) '(0 0  25 1  75 1  100 0) = frqskw env [F4]
      ;;  aa = (1+ran-vib)*(1+per-vib)*(1+frq-env) 
      
       (locsig loc i (+ (* (env car1-f) 
			   (oscil car1 (* frq-change 
					  (+ frq1 (* (env mod1-f) 
						     (oscil mod1 (* modfrq1 frq-change)))))))
			(* (env car2-f) 
			   (oscil car2 (* frq-change 
					  (+ frq2 (* (env mod2-f) 
						     (oscil mod2 (* modfrq2 frq-change)))))))))))))
      
      ;;  mod1-env (linen (modind12-modind11)*modfrq1*mag*aa ampatt1 .01 dur indenv1)
      ;;  mod1 (oscil mod1-env+(modfrq1*modind11*mag*aa) modfrq1*mag*aa)
      ;;  car1-env (linen amp1 ampatt1 ampdec1 dur ampenv1)
      ;;  car1 (oscil car1-env frq1*mag*aa+mod1)
      
      ;;  mod2-env (linen (modind22-modind21)*modfrq2*mag*aa ampatt1 .01 dur indenv2)
      ;;  mod2 (oscil mod2-env+(modfrq2*modind21*mag*aa modfrq2*mag*aa)
      ;;  car2-env (linen amp2 ampatt2 ampdec2 dur ampenv2)
      ;;  car2 (oscil car2-env frq2*mag*aa+mod2)
      ;;  outa car1 + car2

;;; DIVSEG scales breakpoint x-axis values to return a new envelope that produces the desired "attack" and
;;; "decay" times.  Decay times aren't usually vital. but attack times are.
