psynth.lsp
 Version 1.00  31 October 2004
 Author Steven Jones

 Contact jones57@swbell.net include the word "nyquist" in subject line

 The contents of this file are released under the terms of the GNU General
 Public License. See the file LICENSE.txt

 psynth is a duel modulator single carrier FM instrument with portamento
 and delayed vibrato

function

 (psynth prtlst [:gate][:vel][:pos][:rc][:r1][:mi1][:r2][:mi2][:vib][:vfrq][:vdelay][:vtab])
 A two modulator fm instrument with portamento

 prtlst - List of portamento break points. See port.lsp
 :gate   - flonum. Normally the tones duration is determined by the 
           "duration" of prtlst. The gate parameter may be used to 
           terminate the sound prematurely. Default nil
 :vel    - flonum. Velocity 0<= vel <= 127. Default 64
 :pos    - flonum or sound. Pan position. 0 <= pos <= 1, default 0.5
 :rc     - flonum. Relative carrier frequency, defualt 1.0
 :r1     - flonum. Relative frequency of modulator 1, default 1.0
 :mi1    - flonum. Modulation index for modulator 1, default 4.00
 :r2     - flonum. Relative frequency for modulator 2, default 3.003
 :mi2    - flonum. Modulation index for modulator 2, default 4.00
 :vib    - flonum. Vibrato depth, 0 <= vib < 128, default 1
 :vfrq   - flonum. Vibrato frequency, default 7.0 Hz
 :vdelay - flonum. Vibrato delay, default 0 seconds
 :vtab   - table. Vibrato wave table, default *tri-table*

 return  - sound vector

;; psynth.lsp
;; Version 1.00  31 October 2004
;; Author Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; psynth is a duel modulator single carrier FM instrument with portamento
;; and delayed vibrato
;; 

(require 'map)
(require 'map-psynth)
(require 'port)
(require 'linfn)
(provide 'psynth)
(current-file "psynth.lsp")

(deflin2 psynth:v-mi-map  0 0.5 127 2)
(setq psynth:*v-db-map* map:*vel6*)


;; penv  - Portamento envelope
;; dur   - duration
;; r     - frequency ratio
;; mi    - modulation index
;; fm    - fm signal
;; env   - envelope parameter list
;; envfn - envelope function
;;

(defun psynth:mop (penv dur r mi fm env envfn)
  (port:fm-mop penv dur r mi :fm fm :tab *sine-table*
	       :am (apply envfn (flatten (list env dur)))))


;; @doc function psynth
;; (psynth prtlst [:gate][:vel][:pos][:rc][:r1][:mi1][:r2][:mi2][:vib][:vfrq][:vdelay][:vtab])
;; A two modulator fm instrument with portamento
;;
;; prtlst - List of portamento break points. See port.lsp
;; :gate   - flonum. Normally the tones duration is determined by the 
;;           "duration" of prtlst. The gate parameter may be used to 
;;           terminate the sound prematurely. Default nil
;; :vel    - flonum. Velocity 0<= vel <= 127. Default 64
;; :pos    - flonum or sound. Pan position. 0 <= pos <= 1, default 0.5
;; :rc     - flonum. Relative carrier frequency, defualt 1.0
;; :r1     - flonum. Relative frequency of modulator 1, default 1.0
;; :mi1    - flonum. Modulation index for modulator 1, default 4.00
;; :r2     - flonum. Relative frequency for modulator 2, default 3.003
;; :mi2    - flonum. Modulation index for modulator 2, default 4.00
;; :vib    - flonum. Vibrato depth, 0 <= vib < 128, default 1
;; :vfrq   - flonum. Vibrato frequency, default 7.0 Hz
;; :vdelay - flonum. Vibrato delay, default 0 seconds
;; :vtab   - table. Vibrato wave table, default *tri-table*
;;
;; return  - sound vector
;;

(defun psynth (prtlst &key gate vel pos
			rc            	     ;carrier
			r1 mi1               ;modulator 1
			r2 mi2               ;modulator 2
			vib vfrq vdelay vtab);vibrato
  (let* ((dur (port:get-bplist-duration prtlst))
	 (gate (or gate dur))
	 (dur (min dur gate))
	 (penv (port prtlst))
	 (vel (or vel 64))
	 (vscale (psynth:v-mi-map vel))
	 (pos (or pos 0.5))
	 (rc (or rc 1.000))
	 (envc (list 0 1 0.25 0.5 dur))
	 (envfnc #'adsr)
	 (r1 (or r1 1.00))
	 (mi1 (* vscale (or mi1 4.00)))
	 (env1 (list 0 1 0.25 0.5 dur))
	 (envfn1 #'adsr)
	 (r2 (or r2 3.003))
	 (mi2 (* vscale (or mi2 4.00)))
	 (env2 (list 1 0.5 0.5 0.8 dur))
	 (envfn2 #'adsr)
	 (vibamp (* (or vib 1) 0.0005))
	 (vfrq (or vfrq 7.00))
	 (vdelay (or vdelay 0.5))
	 (vattack (* vdelay 0.25))
	 (vsig (port:lfo vfrq penv dur :mi vibamp :tab (or vtab *tri-table*) :delay vdelay :attack vattack)))
    (pan
     (scale-db (send psynth:*v-db-map* :get vel)
	       (port:fm-cop penv dur :r rc :am (apply envfnc (flatten (list envc dur)))
			    :fm (sum vsig
				     (port:fm-mop penv dur r1 mi1 :fm vsig 
						  :am (apply envfn1 (flatten (list env1 dur))))
				     (port:fm-mop penv dur r2 mi2 :fm vsig 
						  :am (apply envfn2 (flatten (list env2 dur))))
				     )))
     pos)))