;;; 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 *srate*)))
	 (nd (+ st (floor (* dur *srate*))))
	 (pit1 (if (zerop pitch1) pitch0 pitch1))
	 (loc (make-locsig :degree deg :distance dis :reverb 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-rand-interp :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-env :envelope (stretch-envelope (or pvibfun '(0 1 100 1)) 25 pvbap 75 pvbdp) :duration dur
			     :scaler (hz->radians (* pvibpc pitch0))))
	 (rvibenv (make-env :envelope (or rvibfun '(0 1 100 1)) :duration dur
			     :scaler (hz->radians (* rvibpc pitch0))))
	 (glisenv (make-env :envelope (stretch-envelope (or glissfun '(0 0 100 0)) 25 glsap 75 glsdp) :duration dur
			     :scaler (hz->radians (- pit1 pitch0))))
	 (amplenv (make-env :envelope (stretch-envelope ampfun 25 ampap 75 ampdp) :scaler amp :duration dur))
	 (betaenv (make-env :envelope (stretch-envelope betafun 25 betap 75 betdp) :duration dur
			     :scaler (- beta1 beta0) :offset beta0)))
    (run 
     (loop for i from st to nd do
       (setf vib (+ (* (env pvibenv) (triangle-wave pvib))
		    (* (env rvibenv) (rand-interp 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)))
|#
