;;; -*- Lisp -*-
;;;
;;; STK's feedback-fm instrument named CelloN in Sambox-land

(definstrument celloN (beg dur pitch0 amp ampfun betafun 
		       beta0 beta1 betaAt betaDc AmpAt AmpDc Dis PcRev Deg
		       Pitch1 GlissFun GlissAt GlissDc
		       pvibfreq pvibpc pvibfun pvibat pvibdc
		       rvibfreq rvibpc rvibfun)
  (let* ((st (floor (* beg sampling-rate)))
	 (nd (+ st (floor (* dur sampling-rate))))
	 (pit1 (if (zerop pitch1) pitch0 pitch1))
	 (loc (make-locsig :degree deg :distance dis :revscale pcrev))
	 (car (make-oscil :frequency pitch0))
	 (low (make-one-zero .5 -.5))
	 (fmosc (make-oscil :frequency pitch0))
	 (pvib (make-triangle-wave :frequency pvibfreq :amplitude 1.0))
	 (rvib (make-randi :frequency rvibfreq :amplitude 1.0))
	 (fm 0.0)
	 (vib 0.0)
	 (AmpAp (if (plusp AmpAt) (* 100 (/ AmpAt Dur)) 25))
	 (AmpDp (if (plusp AmpDc) (* 100 (- 1.0 (/ AmpDc dur))) 75))
	 (GlsAp (if (plusp GlissAt) (* 100 (/ GlissAt Dur)) 25))
	 (GlsDp (if (plusp GlissDc) (* 100 (- 1.0 (/ GlissDc dur))) 75))
	 (BetAp (if (plusp BetaAt) (* 100 (/ BetaAt Dur)) 25))
	 (BetDp (if (plusp BetaDc) (* 100 (- 1.0 (/ BetaDc dur))) 75))
	 (pvbAp (if (plusp pvibAt) (* 100 (/ pvibAt Dur)) 25))
	 (pvbDp (if (plusp pvibDc) (* 100 (- 1.0 (/ pvibDc dur))) 75))
	 (pvibenv (make-func :envelope (divseg (or pvibfun '(0 1 100 1)) 25 pvbap 75 pvbdp)
			     :scaler (in-Hz (* pvibpc pitch0))
			     :start-time beg :duration dur))
	 (rvibenv (make-func :envelope (or rvibfun '(0 1 100 1))
			     :scaler (in-Hz (* rvibpc pitch0))
			     :start-time beg :duration dur))
	 (glisenv (make-func :envelope (divseg (or glissfun '(0 0 100 0)) 25 glsap 75 glsdp)
			     :scaler (in-Hz (- pit1 pitch0))
			     :start-time beg :duration dur))
	 (amplenv (make-func :envelope (divseg ampfun 25 ampap 75 ampdp)
			     :scaler amp
			     :start-time beg :duration dur))
	 (betaenv (make-func :envelope (divseg betafun 25 betap 75 betdp)
			     :scaler (- beta1 beta0) :offset beta0
			     :start-time beg :duration dur)))
    (Run 
     (loop for i from st to nd do
       (setf vib (+ (* (env pvibenv) (triangle-wave pvib))
		    (* (env rvibenv) (randi rvib))
		    (env glisenv)))
       (setf fm (one-zero low (* (env betaenv) (oscil fmosc (+ fm vib)))))
       (locsig loc i (* (env amplenv) 
			(oscil car (+ fm vib))))))))


#|
(with-sound () (cellon 0 1 220 .1 '(0 0 25 1 75 1 100 0) '(0 0 25 1 75 1 100 0) .75 1.0 0 0 0 0 1 0 0 220 '(0 0 25 1 75 1 100 0) 0 0 0 0 '(0 0 100 0) 0 0 0 0 '(0 0 100 0)))
|#
