fm-histrings.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

 String ensemble sound

function

 (fm-histrings plst dur [:vel][:release][:vib][:vfrq][:vdelay][:arpeg][:r])
 String ensemble instrument 

 plst    - list or flonum. List of MIDI key numbers. Alternatively a single pitch
           may be specified.

 dur      - flonum. Duration in seconds

 :vel     - flonum. Velocity  0 <= vel < 128, default 64

 :release - flonum. Release time, default 1.50 

 :vib     - flonum. Vibrato depth, 0 <= vib <= 127. Default 16

 :vfrq    - flonum. Vibrato frequency, default 7.00

 :vdelay  - flonum. Vibrato delay time, default 0.533 seconds

 :arpeg   - flonum. Time interval between notes in plst, default 0

 :r       - flonum. FM m/c frequency ratio, default 1.
            non-sine waveforms are used, small integer values of r 
            essentially produce the same sound.

 return  - Sound vector.

;; fm-histrings.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
;;
;; String ensemble sound
;; 

(require 'definst)
(require 'fmop)
;(require 'txwave)
(require 'txwav2)
(require 'txwav4)
(require 'dlfo)
(require 'map)
(provide 'fm-histrings)
(current-file "fm-histrings")


(defun fm-histrings:voice (pitch dur &key  iscale release vib vfrq vdelay r)
  (let* ((iscale (or iscale 1.00))
	 (r (or r 1.001))
	                                ; Carrier op #1
	 (r1   1.000)
	 (att1 0.333)
	 (dcy1 1.000)
	 (rel1 (or release 1.50))
	 (tab1 *txwav2*)
	 (env1 (adsr att1 dcy1 0 rel1 0.70 dur))

	                                ; Mod op #2
	 (r2   r)
	 (i2   (* iscale 1.500))
	 (tab2 *txwav4*)
	 (env2 env1)
	 
					;Carrier op #3
	 (r3   (* 0.999 r2))
	 (att3 0.100)
	 (dcy3 0.333)
         (rel3 (or release 1.5))
         (tab3 *txwav4*)
	 (env3 (adsr att3 dcy3 0 rel3 0.80 dur))
	 
					;Modulator op #4
	 (r4   0.998)
	 (i4   (* iscale 1.000))
	 (tab4 *sine-table*)
	 (env4 env3)
	 
					;Vibrato
	 (vibamp (or vib 16))
	 (vfrq (or vfrq 7.00))
	 (vdelay (or vdelay 0.533))
	 (vattack 0.533)
	 (vibsig (dlfo vfrq dur :delay vdelay :attack vattack :phase 'RND)))

    (sum (fm1 pitch dur :r1 r1 :t1 tab1 :env1 env1 :r2 r2 :t2 tab2 :env2 env2 :i2 i2 
	      :vib vibamp :vibsig vibsig)
	 (fm1 pitch dur :r1 r1 :t1 tab3 :env1 env3 :r2 r4 :t2 tab4 :env2 env4 :i2 i4 
	      :vib vibamp :vibsig vibsig)
	 )))


;; @doc function fm-histrings
;; (fm-histrings plst dur [:vel][:release][:vib][:vfrq][:vdelay][:arpeg][:r])
;; String ensemble instrument 
;;
;; plst    - list or flonum. List of MIDI key numbers. Alternatively a single pitch
;;           may be specified.
;;
;; dur      - flonum. Duration in seconds
;;
;; :vel     - flonum. Velocity  0 <= vel < 128, default 64
;;
;; :release - flonum. Release time, default 1.50 
;;
;; :vib     - flonum. Vibrato depth, 0 <= vib <= 127. Default 16
;;
;; :vfrq    - flonum. Vibrato frequency, default 7.00
;;
;; :vdelay  - flonum. Vibrato delay time, default 0.533 seconds
;;
;; :arpeg   - flonum. Time interval between notes in plst, default 0
;;
;; :r       - flonum. FM m/c frequency ratio, default 1.
;;            non-sine waveforms are used, small integer values of r 
;;            essentially produce the same sound.
;;
;; return  - Sound vector.
;;

(setq fm-histrings:*v-mi-map* (map:linear 0.250 4.0))
(setq fm-histrings:*v-lp-map* (map:linear 300 5000))

(defun fm-histrings (plst dur &key vel release vib vfrq vdelay arpeg r)
  (setq plst (->list plst))
  (let* ((ncount (length plst))
	 (vel (or vel 64))
	 (iscale (send fm-histrings:*v-mi-map* :get vel))
	 (lp (send fm-histrings:*v-lp-map* :get vel))
	 (pos 0.333)
	 (db (definst:comp ncount))
	 (lst1 (every-odd plst))
	 (lst2 (every-even plst))
	 (pinc (/ (or arpeg 0.200)(float ncount))))
    (scale-db db
	       (sim 
		(pan (lowpass4
		      (simrep (n (length lst1))
			      (at (* n pinc)
				  (cue (fm-histrings:voice (nth n lst1) dur
							  :r r
							  :iscale iscale 
							  :release release
							  :vib vib 
							  :vfrq vfrq 
							  :vdelay vdelay))))
		      lp) pos)
	       (pan (lowpass4
		     (simrep (n (length lst2))
			     (at (* n pinc)
				 (cue (fm-histrings:voice (nth n lst2) dur
							 :r r
							 :iscale iscale
							 :release release
							 :vib vib
							 :vfrq vfrq
							 :vdelay vdelay))))
		     lp)(- 1 pos))))))