;;; sopNR.cl
;;; Non-real-time vocal formant synthesis
;;; producing vocal like sounds
;;; with vibrato-- rate & range
;;; can do the experiments of logistic map on this instrument


#|

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

;;; instrument
(definstrument sopNR (start-time dur freq amp &key 
				 (amp-env '(0 0 .2 .8 .8 1 1 0))
				 (v-rate 4)
				 (v-depth 5)
				 (frq1 800.0) (frq2 1150.0) (frq3 2900.0)
				 (bw1 80.0) (bw2 90.0) (bw3 120.0)
				 (gain1 1.0) (gain2 0.5) (gain3 0.025))

  (multiple-value-bind (beg end) (get-beg-end start-time dur)
  (let* ((pulse (make-sum-of-cosines :cosines 30      ;;; pulse train generator
				     :frequency freq))
	 (vibrato (make-oscil :frequency v-rate)) ;;; make an oscil for vibrato
	 (amplitude (make-env :envelope amp-env :scaler amp))
	
	
	 ;;; filters
	 (filter-1 (make-formant (compute-radius bw1) frq1 gain1))
	 (filter-2 (make-formant (compute-radius bw2) frq2 gain2))
	 (filter-3 (make-formant (compute-radius bw3) frq3 gain3)))
	
  
    (run
     (loop for i from beg to end do
	   (let* ((in-val 
		   (sum-of-cosines pulse (in-hz (* v-depth (oscil vibrato)))))
		    
       ;;; add output of the filters together
		  (out-val (+ (formant filter-1 in-val) 
			      (formant filter-2 in-val)
			      (formant filter-3 in-val))))
	   ;;; send scaled value to the output
	     (outa i (* (env amplitude) out-val)) 
	   ))))))
  


;;; calls to the instrument

(with-sound (:srate 22050) (sopNR 0.0 4.0 440.0 .1))


|#



(algorithm logistic sopNR (length 20)
	  (vars (x 0.1) (r 3.5))
	  (setf x (* r x (- 1.0 x)))
	  (setf freq (+ 200.0 (* 100 x))
		rhythm (item (rhythms e e e. e q))
		dur rhythm
		v-rate (* 10 x)
		v-depth (+ 2.3 (- 1.0 x))
		amp (* 0.2 x)
		frq2 (+ 200.0 (* 800 x))
		frq3 (+ 500.0 (* 1000 (- 1 x)))
		bw1 (* 200 x)
		gain2 (* 1 (- 1 x)))
	  (if (> v-rate 9) (setf v-rate 3))
	  (if (< gain2 1) (setf gain2 0.99)))
	  

(algorithm logistic1 sopNR (length 20)
	  (vars (x 0.1) (r 3.5) (y 0.2))	  
	  (setf x (* r x (- 1.0 x)))
	  (setf y (* r x (- 2.0 x)))
	  (setf freq (+ 200.0 (* 100 y))
		rhythm (* 3 y)		
		dur rhythm
		v-rate (* 10 x)
		v-depth (+ 2.3 (- 1.0 x))
		amp (* 1 x)
		frq2 (+ 200.0 (* 800 x))
		bw1 (* 200 x)
		gain2 (* 1 (- 1 y)))
	  (if (> v-rate 9) (setf v-rate 3))
	  (if (< gain2 1) (setf gain2 0.99)))