;;; vowels.cl
;;; real-time subtractive synthesis
;;; producing vocal like sounds
;;; formant data is stored as a set of presets

;;; instrument on/off
(defparameter vowels-recon 1100)
;;; input level control
(defparameter vowels-in-level 1101)
;;; filter frequencies
(defparameter vowels-1-frq 1102)
(defparameter vowels-2-frq 1103)
(defparameter vowels-3-frq 1104)
;;; filter radius
(defparameter vowels-1-bw 1105)
(defparameter vowels-2-bw 1106)
(defparameter vowels-3-bw 1107)
;;; filter gains
(defparameter vowels-1-g 1108)
(defparameter vowels-2-g 1109)
(defparameter vowels-3-g 1110)
;;; input monitor
(defparameter vowels-in-frq 1111)
(defparameter vowels-in-sel 1112)
(defparameter vowels-line-in 1113)
;;; output level
(defparameter vowels-out 1114)
;;; presets
(defparameter vowels-set-1 1115)
(defparameter vowels-set-2 1116)
(defparameter vowels-set-3 1117)
(defparameter vowels-set-4 1118)
(defparameter vowels-set-5 1119)

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

;;; instrument
(defpinstrument vowels (&key (tester nil))
  (let* ((noi (make-randh :frequency 5000 :amplitude .1)) ;;; noise generator
	 (pulse (make-sum-of-cosines :cosines 30           ;;; pulse train generator
				     :frequency 5000))
	 ;;; filters
	 (filter-1 (make-formant 0.99 175.0))
	 (filter-2 (make-formant 0.99 610.0))
	 (filter-3 (make-formnt 0.99 1600.0))
	 ;;; input level contol
	 (levelf (make-fcontrol vowels-in-level))
	 ;;; noise/pulses frequency
	 (frq-inf (make-fcontrol vowels-in-frq))
	 ;;; output level control
	 (outf (make-fcontrol vowels-out))
	 ;;; frequency controls
	 (frqf-1 (make-fcontrol vowels-1-frq))
	 (frqf-2 (make-fcontrol vowels-2-frq))
	 (frqf-3 (make-fcontrol vowels-3-frq))
	 ;;; radius controls
	 (rf-1 (make-fcontrol vowels-1-bw))
	 (rf-2 (make-fcontrol vowels-2-bw))
	 (rf-3 (make-fcontrol vowels-3-bw))
	 ;;; gain controls
	 (gf-1 (make-fcontrol vowels-1-g))
	 (gf-2 (make-fcontrol vowels-2-g))
	 (gf-3 (make-fcontrol vowels-3-g)))
  (run
   (loop for i from 0 do
	 (when (= (control vowels-recon) 0.0) (loop-finish))
	 ;;; some male bass formants as presets
	 ;;; A
	 (cond ((= (control vowels-set-1) 1.0)
		;;; frq
		(setf (control vowels-1-frq) 600.0)
		(setf (control vowels-2-frq) 1040.0)
		(setf (control vowels-3-frq) 2250.0)
		;;; bw
		(setf (control vowels-1-bw) 60.0)
		(setf (control vowels-2-bw) 70.0)
		(setf (control vowels-3-bw) 110.0)
		;;; g
		(setf (control vowels-1-g) 1.0)
		(setf (control vowels-2-g) 0.5)
		(setf (control vowels-3-g) 0.35)
		;;; release button
		(setf (control vowels-set-1) 0.0)
		)
	       ;;; E
	       ((= (control vowels-set-2) 1.0)
		;;; frq
		(setf (control vowels-1-frq) 400.0)
		(setf (control vowels-2-frq) 1620.0)
		(setf (control vowels-3-frq) 2400.0)
		;;; bw
		(setf (control vowels-1-bw) 40.0)
		(setf (control vowels-2-bw) 80.0)
		(setf (control vowels-3-bw) 100.0)
		;;; g
		(setf (control vowels-1-g) 1.0)
		(setf (control vowels-2-g) 0.25)
		(setf (control vowels-3-g) 0.35)
		;;; release button
		(setf (control vowels-set-2) 0.0))
	       ;;; I
	       ((= (control vowels-set-3) 1.0)
		;;; frq
		(setf (control vowels-1-frq) 250.0)
		(setf (control vowels-2-frq) 1750.0)
		(setf (control vowels-3-frq) 2600.0)
		;;; bw
		(setf (control vowels-1-bw) 60)
		(setf (control vowels-2-bw) 90.0)
		(setf (control vowels-3-bw) 100.0)
		;;; g
		(setf (control vowels-1-g) 1.0)
		(setf (control vowels-2-g) 0.1)
		(setf (control vowels-3-g) 0.2)
		;;; release button
		(setf (control vowels-set-3) 0.0))
	       ;;; O
	       ((= (control vowels-set-4) 1.0)
		;;; frq
		(setf (control vowels-1-frq) 400.0)
		(setf (control vowels-2-frq) 750.0)
		(setf (control vowels-3-frq) 2400.0)
		;;; bw
		(setf (control vowels-1-bw) 40.0)
		(setf (control vowels-2-bw) 80.0)
		(setf (control vowels-3-bw) 100.0)
		;;; g
		(setf (control vowels-1-g) 1.0)
		(setf (control vowels-2-g) 0.3)
		(setf (control vowels-3-g) 0.1)
		;;; release button
		(setf (control vowels-set-4) 0.0))
	       ;;; U
	       ((= (control vowels-set-5) 1.0)
		;;; frq
		(setf (control vowels-1-frq) 350.0)
		(setf (control vowels-2-frq) 600.0)
		(setf (control vowels-3-frq) 2400.0)
		;;; bw
		(setf (control vowels-1-bw) 40.0)
		(setf (control vowels-2-bw) 80.0)
		(setf (control vowels-3-bw) 100.0)
		;;; g
		(setf (control vowels-1-g) 1.0)
		(setf (control vowels-2-g) 0.1)
		(setf (control vowels-3-g) 0.03)
		;;; release button
		(setf (control vowels-set-5) 0.0))
	       (t nil))
	 ;;; set noise/pulses frq input
	 (if (= (control vowels-in-sel) 1.0)
	     (setf (frequency noi)(fcontrol frq-inf))
	   (setf (frequency pulse)(fcontrol frq-inf)))
	 ;;; set frequencies
	 (setf (frequency filter-1)(fcontrol frqf-1))
	 (setf (frequency filter-2)(fcontrol frqf-2))
	 (setf (frequency filter-3)(fcontrol frqf-3))
	 ;;; set radius
 	 (setf (formant-radius filter-1)(compute-radius (fcontrol rf-1)))
	 (setf (formant-radius filter-2)(compute-radius (fcontrol rf-2)))
	 (setf (formant-radius filter-3)(compute-radius (fcontrol rf-3)))
	 ;;; set gains
	 (setf (frmnt-g filter-1)(/ (fcontrol gf-1) 10.0))
	 (setf (frmnt-g filter-2)(/ (fcontrol gf-2) 10.0))
	 (setf (frmnt-g filter-3)(/ (fcontrol gf-3) 10.0))
	 ;;; select the input we want
	 (let* ((in-val (* (fcontrol levelf) 
			   (if (= (control vowels-line-in) 1.0)
			       (rec-any 0)
			     (if (= (control vowels-in-sel) 1.0)
				 (randh noi)
			       (sum-of-cosines pulse)))))
		;;; 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 (* (fcontrol outf) out-val)) 
	   ;;; if tester is on send output to it
	   (if tester (setf (tester-in) out-val)))))))
  
(make-controller "vowels_lnx" 2048 
		 '(vowels-recon "play" :toggle t)
		 '(vowels-line-in "Line-in on/off" :toggle nil)
		 '(vowels-in-sel "Noise/Pulse-Train" :toggle t)
		 '(vowels-in-level "input" :slider 0.0 1.0)
		 '(vowels-out "output" :slider 0.0 1.0)
		 '(vowels-in-frq "input frequency" :slider 0.0 5000.0)
		 '(0 "" :separator 8)
		 '(vowels-set-1 "A" :push)
		 '(vowels-set-2 "E" :push)
		 '(vowels-set-3 "I" :push)
		 '(vowels-set-4 "O" :push)
		 '(vowels-set-5 "U" :push)
		 '(0 "" :separator 5)
		 ;;; frq sliders
		 '(vowels-1-frq "filter-1-frq" :slider 0.0 11025.0)
		 '(vowels-2-frq "filter-2-frq" :slider 0.0 11025.0)
		 '(vowels-3-frq "filter-3-frq" :slider 0.0 11025.0)
		 ;;; bw sliders
		 '(vowels-1-bw "filter-1-bw" :slider 20.0 200.0)
		 '(vowels-2-bw "filter-2-bw" :slider 20.0 200.0)
		 '(vowels-3-bw "filter-3-bw" :slider 20.0 200.0)
		 ;;; g sliders
		 '(vowels-1-g "filter-1-g" :slider 0.0 1.0)
		 '(vowels-2-g "filter-2-g" :slider 0.0 1.0)
		 '(vowels-3-g "filter-3-g" :slider 0.0 1.0))

#|
;;; calls to the instrument

(with-psound (:srate 22050)(vowels))

(with-psound (:srate 22050)(tester) (vowels :tester t))


|#