clm-ins.scm 119 KB
Newer Older
1 2 3 4
;;; CLM instruments translated to Snd/Scheme

(provide 'snd-clm-ins.scm)

5 6 7 8 9
(if (provided? 'snd)
    (require snd-ws.scm)
    (require sndlib-ws.scm))
(require snd-env.scm snd-dsp.scm snd-fullmix.scm snd-expandn.scm)

10 11 12 13 14 15 16 17 18


;;; -------- pluck
;;;
;;; The Karplus-Strong algorithm as extended by David Jaffe and Julius Smith -- see 
;;;  Jaffe and Smith, "Extensions of the Karplus-Strong Plucked-String Algorithm"
;;;  CMJ vol 7 no 2 Summer 1983, reprinted in "The Music Machine".
;;;  translated from CLM's pluck.ins

19
(definstrument (pluck start dur freq amp (weighting .5) (lossfact .9))
20 21 22
  "(pluck start dur freq amp weighting lossfact) implements the Jaffe-Smith plucked string physical model. 
'weighting' is the ratio of the once-delayed to the twice-delayed samples.  It defaults to .5=shortest decay. 
Anything other than .5 = longer decay.  Must be between 0 and less than 1.0. 
23
'lossfact' can be used to shorten decays.  Most useful values are between .8 and 1.0. (with-sound () (pluck 0 1 330 .3 .7 .995))"
24

25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
  (define tuneIt 
    (let ((getOptimumC (lambda (S o p)
			 (let* ((pa (* (/ 1.0 o) 
				       (atan (* S (sin o))
					     (- (+ 1.0 (* S (cos o))) S))))
				(tmpInt (floor (- p pa)))
				(pc (- p pa tmpInt)))
			   (if (< pc .1)
			       (do ()
				   ((>= pc .1))
				 (set! tmpInt (- tmpInt 1))
				 (set! pc (+ pc 1.0))))
			   (list tmpInt (/ (- (sin o) (sin (* o pc)))
					   (sin (+ o (* o pc)))))))))
      (lambda (f s1)
	(let ((p (/ *clm-srate* f))	;period as float
	      (s (if (= s1 0.0) 0.5 s1))
	      (o (hz->radians f)))
	  (let ((vals (getOptimumC s o p))
		(vals1 (getOptimumC (- 1.0 s) o p)))
	    (if (and (not (= s 1/2))
		     (< (abs (cadr vals)) (abs (cadr vals1))))
		(list (- 1.0 s) (cadr vals) (car vals))
		(list s (cadr vals1) (car vals1))))))))
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
  
  (let ((vals (tuneIt freq weighting)))
    (let ((wt0 (car vals))
	  (c (cadr vals))
	  (dlen (caddr vals))
	  (beg (seconds->samples start))
	  (end (seconds->samples (+ start dur)))
	  (lf (if (= lossfact 0.0) 1.0 (min 1.0 lossfact))))

      (let ((wt (if (= wt0 0.0) 0.5 (min 1.0 wt0)))
	    (tab (make-float-vector dlen)))

	;; get initial waveform in "tab" -- here we can introduce 0's to simulate different pick
	;; positions, and so on -- see the CMJ article for numerous extensions.  The normal case
	;; is to load it with white noise (between -1 and 1).
	(let ((allp (make-one-zero (* lf (- 1.0 wt)) (* lf wt)))
	      (feedb (make-one-zero c 1.0)) ;or (feedb (make-one-zero 1.0 c))
	      (c1 (- 1.0 c)))
	  
	  (do ((i 0 (+ i 1)))
	      ((= i dlen))
	    (float-vector-set! tab i (mus-random 1.0)))

	  (do ((i beg (+ i 1))
	       (ctr 0 (modulo (+ ctr 1) dlen)))
	      ((= i end))
	    (outa i (* amp (float-vector-set! tab ctr (* c1 (one-zero feedb (one-zero allp (float-vector-ref tab ctr)))))))))))))
#|
	    (let ((val (float-vector-ref tab ctr)))	;current output value
	      (float-vector-set! tab ctr (* c1 (one-zero feedb (one-zero allp val))))
	      (outa i (* amp val)))))))))
|#
81 82 83 84 85 86 87


;;; -------- mlbvoi
;;;
;;; translation from MUS10 of Marc LeBrun's waveshaping voice instrument (using FM here)
;;; this version translated (and simplified slightly) from CLM's mlbvoi.ins

88
(definstrument (vox beg dur freq amp ampfun freqfun freqscl phonemes formant-amps formant-indices (vibscl .1) (deg 0) (pcrev 0))  
89

90 91
  (define vox-fun 
    (let ((formants   ; formant center frequencies for a male speaker
92 93 94 95 96 97 98 99 100 101 102
	   '((I 390 1990 2550)  (E 530 1840 2480)  (AE 660 1720 2410)
	     (UH 520 1190 2390) (A 730 1090 2440)  (OW 570 840 2410)
	     (U 440 1020 2240)  (OO 300 870 2240)  (ER 490 1350 1690)
	     (W 300 610 2200)   (LL 380 880 2575)  (R 420 1300 1600)
	     (Y 300 2200 3065)  (EE 260 3500 3800) (LH 280 1450 1600)
	     (L 300 1300 3000)  (I2 350 2300 3340) (B 200 800 1750)
	     (D 300 1700 2600)  (G 250 1350 2000)  (M 280 900 2200)
	     (N 280 1700 2600)  (NG 280 2300 2750) (P 300 800 1750)
	     (T 200 1700 2600)  (K 350 1350 2000)  (F 175 900 4400)
	     (TH 200 1400 2200) (S 200 1300 2500)  (SH 200 1800 2000)
	     (V 175 1100 2400)  (THE 200 1600 2200)(Z 200 1300 2500)
103 104 105 106 107 108 109 110 111 112 113 114
	     (ZH 175 1800 2000) (ZZ 900 2400 3800) (VV 565 1045 2400)))
	  (find-phoneme (lambda (phoneme forms)
			  (do ((forms forms (cdr forms)))
			      ((eq? phoneme (caar forms)) 
			       (cdar forms))))))
      (lambda (phons which)
	(let ((f1 ())
	      (len (length phons)))
	  (do ((i 0 (+ i 2)))
	      ((>= i len))
	    (set! f1 (cons ((find-phoneme (phons (+ i 1)) formants) which) (cons (phons i) f1))))
	  (reverse f1)))))
115
    
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(car-os (make-oscil 0))
	(fs (length formant-amps))
	(per-vib (make-triangle-wave :frequency 6 :amplitude (hz->radians (* freq vibscl))))
	(ran-vib (make-rand-interp :frequency 20 :amplitude (hz->radians (* freq .5 vibscl))))
	(freqf (make-env freqfun :duration dur :scaler (hz->radians (* freqscl freq)) :offset (hz->radians freq))))
    
    (if (and (= fs 3)
	     (= (channels *output*) 1))
	;; optimize the common case
	(let ((a0 (make-env ampfun :scaler (* amp (formant-amps 0)) :duration dur))
	      (a1 (make-env ampfun :scaler (* amp (formant-amps 1)) :duration dur))
	      (a2 (make-env ampfun :scaler (* amp (formant-amps 2)) :duration dur))
	      (o0 (make-oscil 0.0))
	      (o1 (make-oscil 0.0))
	      (o2 (make-oscil 0.0))
	      (e0 (make-oscil 0.0))
	      (e1 (make-oscil 0.0))
	      (e2 (make-oscil 0.0))
	      (ind0 (formant-indices 0))
	      (ind1 (formant-indices 1))
	      (ind2 (formant-indices 2))
	      (f0 (make-env (vox-fun phonemes 0) :scaler (hz->radians 1.0) :duration dur))
	      (f1 (make-env (vox-fun phonemes 1) :scaler (hz->radians 1.0) :duration dur))
	      (f2 (make-env (vox-fun phonemes 2) :scaler (hz->radians 1.0) :duration dur)))
	  (do ((i start (+ i 1)))
	      ((= i end))
	    (let* ((frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
		   (carg (oscil car-os frq))
		   (frm0 (/ (env f0) frq))
		   (frm1 (/ (env f1) frq))
		   (frm2 (/ (env f2) frq)))
	      (outa i (+ 
		       (* (env a0) 
			  (+ (* (even-weight frm0) (oscil e0 (+ (* ind0 carg) (even-multiple frm0 frq))))
			     (* (odd-weight frm0) (oscil o0 (+ (* ind0 carg) (odd-multiple frm0 frq))))))
		       (* (env a1) 
			  (+ (* (even-weight frm1) (oscil e1 (+ (* ind1 carg) (even-multiple frm1 frq))))
			     (* (odd-weight frm1) (oscil o1 (+ (* ind1 carg) (odd-multiple frm1 frq))))))
		       (* (env a2) 
			  (+ (* (even-weight frm2) (oscil e2 (+ (* ind2 carg) (even-multiple frm2 frq))))
			     (* (odd-weight frm2) (oscil o2 (+ (* ind2 carg) (odd-multiple frm2 frq)))))))))))
	
	(let ((evens (make-vector fs))
	      (odds (make-vector fs))
	      (ampfs (make-vector fs))
163
	      (indices (make-float-vector fs))
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
	      (frmfs (make-vector fs))
	      (carrier 0.0)
	      (frm-int 0)
	      (rfrq 0.0)
	      (frm0 0.0)
	      (frac 0.0)
	      (fracf 0.0)
	      (loc (make-locsig deg 1.0 pcrev)))
	  (do ((i 0 (+ i 1)))
	      ((= i fs))
	    (set! (evens i) (make-oscil 0))
	    (set! (odds i) (make-oscil 0))
	    (set! (ampfs i) (make-env ampfun :scaler (* amp (formant-amps i)) :duration dur))
	    (set! (indices i) (formant-indices i))
	    (set! (frmfs i) (make-env (vox-fun phonemes i) :scaler (hz->radians 1.0) :duration dur)))
179
	  
180 181 182 183 184 185
	  (if (= fs 3)
	      (let ((frmfs0 (frmfs 0))   (frmfs1 (frmfs 1))   (frmfs2 (frmfs 2))
		    (index0 (indices 0)) (index1 (indices 1)) (index2 (indices 2))
		    (ampfs0 (ampfs 0))   (ampfs1 (ampfs 1))   (ampfs2 (ampfs 2))
		    (evens0 (evens 0))   (evens1 (evens 1))   (evens2 (evens 2))
		    (odds0 (odds 0))     (odds1 (odds 1))     (odds2 (odds 2)))
186 187 188
		(do ((i start (+ i 1))) 
		    ((= i end))
		  (set! rfrq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
189
		  (set! carrier (oscil car-os rfrq))
190
		  
191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
		  (set! frm0 (/ (env frmfs0) rfrq))
		  (set! frm-int (floor frm0))
		  (set! frac (- frm0 frm-int))
		  (set! fracf (+ (* index0 carrier) (* frm-int rfrq)))
		  (locsig loc i 
			  (* (env ampfs0) 
			     (if (even? frm-int)
				 (+ (* (- 1.0 frac) (oscil evens0 fracf)) (* frac (oscil odds0 (+ fracf rfrq))))
				 (+ (* frac (oscil evens0 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds0 fracf))))))
		  
		  (set! frm0 (/ (env frmfs1) rfrq))
		  (set! frm-int (floor frm0))
		  (set! frac (- frm0 frm-int))
		  (set! fracf (+ (* index1 carrier) (* frm-int rfrq)))
		  (locsig loc i
			  (* (env ampfs1) 
			     (if (even? frm-int)
				 (+ (* (- 1.0 frac) (oscil evens1 fracf)) (* frac (oscil odds1 (+ fracf rfrq))))
				 (+ (* frac (oscil evens1 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds1 fracf))))))

		  (set! frm0 (/ (env frmfs2) rfrq))
		  (set! frm-int (floor frm0))
		  (set! frac (- frm0 frm-int))
		  (set! fracf (+ (* index2 carrier) (* frm-int rfrq)))
		  (locsig loc i 
			  (* (env ampfs2)
			     (if (even? frm-int)
				 (+ (* (- 1.0 frac) (oscil evens2 fracf)) (* frac (oscil odds2 (+ fracf rfrq))))
				 (+ (* frac (oscil evens2 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds2 fracf))))))))
	      
	      (do ((i start (+ i 1))) 
		  ((= i end))
		(set! rfrq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
		(set! carrier (oscil car-os rfrq)) ; better name: modulator or perhaps perceived-carrier?
		
		(do ((k 0 (+ k 1))) 
		    ((= k fs))
		  (set! frm0 (/ (env (vector-ref frmfs k)) rfrq))
		  (set! frm-int (floor frm0))
		  (set! frac (- frm0 frm-int))
		  (set! fracf (+ (* (float-vector-ref indices k) carrier) (* frm-int rfrq)))
		  (locsig loc i 
			  (* (env (vector-ref ampfs k))
			     (if (even? frm-int)
				 (+ (* (- 1.0 frac) (oscil (vector-ref evens k) fracf))
				    (* frac (oscil (vector-ref odds k) (+ fracf rfrq))))
				 (+ (* frac (oscil (vector-ref evens k) (+ fracf rfrq)))
				    (* (- 1.0 frac) (oscil (vector-ref odds k) fracf)))))))))))))
239 240 241 242

;;; (with-sound (:statistics #t) (vox 0 2 170 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 E 25 AE 35 ER 65 ER 75 I 100 UH) '(.8 .15 .05) '(.005 .0125 .025) .05 .1))
;;; (with-sound () (vox 0 2 300 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .15 .05) '(.05 .0125 .025) .02 .1))
;;; (with-sound () (vox 0 5 600 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .16 .04) '(.01 .01 .1) .01 .1))
243

244

245 246 247 248 249 250 251
;;; -------- PQWVOX
;;; translation of CLM pqwvox.ins (itself translated from MUS10 of MLB's waveshaping voice instrument (using phase quadrature waveshaping))

(definstrument (pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes)
  "(pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes) produces 
vocal sounds using phase quadrature waveshaping"

252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
  (letrec ((vox-fun
    (let ((formants '((I 390 1990 2550)  (E 530 1840 2480)  (AE 660 1720 2410)
		      (UH 520 1190 2390) (A 730 1090 2440)  (OW 570 840 2410)
		      (U 440 1020 2240)  (OO 300 870 2240)  (ER 490 1350 1690)
		      (W 300 610 2200)   (LL 380 880 2575)  (R 420 1300 1600)
		      (Y 300 2200 3065)  (EE 260 3500 3800) (LH 280 1450 1600)
		      (L 300 1300 3000)  (I2 350 2300 3340) (B 200 800 1750)
		      (D 300 1700 2600)  (G 250 1350 2000)  (M 280 900 2200)
		      (N 280 1700 2600)  (NG 280 2300 2750) (P 300 800 1750)
		      (T 200 1700 2600)  (K 350 1350 2000)  (F 175 900 4400)
		      (TH 200 1400 2200) (S 200 1300 2500)  (SH 200 1800 2000)
		      (V 175 1100 2400)  (THE 200 1600 2200)(Z 200 1300 2500)
		      (ZH 175 1800 2000) (ZZ 900 2400 3800) (VV 565 1045 2400))))
      ;; formant center frequencies for a male speaker

      (lambda (phons which newenv)
	;; make an envelope from which-th entry of phoneme data referred to by phons
	(if (null? phons)
	    newenv
	    (vox-fun (cddr phons) which
		     (append newenv
			     (list (car phons)
274 275 276 277
				   ((do ((phoneme (cadr phons))
					 (form formants (cdr form)))
					((eq? (caar form) phoneme) 
					 (cdar form)))
278
				    which)))))))))
279

280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (car-sin (make-oscil 0))
	  (car-cos (make-oscil 0 :initial-phase (/ pi 2.0)))
	  (frq-ratio (/ spacing-freq freq))
	  (fs (length formant-amps))
	  (freqf (make-env freqfun :duration dur :scaler (* freqscl freq) :offset freq))
	  (per-vib (make-triangle-wave :frequency 6.0 :amplitude (* freq .1)))
	  (ran-vib (make-rand-interp :frequency 20.0 :amplitude (* freq .05))))
      (let ((sin-evens (make-vector fs))
	    (cos-evens (make-vector fs))
	    (sin-odds (make-vector fs))
	    (cos-odds (make-vector fs))
	    (ampfs (make-vector fs))
	    (frmfs (make-vector fs))
	    (sin-coeffs (make-vector fs))
	    (cos-coeffs (make-vector fs))
	    (frq 0.0) (rfrq 0.0) (carcos 0.0) (carsin 0.0)
	    (frac 0.0) (fracf 0.0) (frm0 0.0) (frm-int 0) (fax 0.0) (yfax 0.0))
	(do ((i 0 (+ i 1)))
	    ((= i fs))
	  (let ((shape (normalize-partials (formant-shapes i))))
	    (set! (sin-evens i) (make-oscil 0))
	    (set! (sin-odds i) (make-oscil 0))
	    (set! (cos-evens i) (make-oscil 0 :initial-phase (/ pi 2.0)))
	    (set! (cos-odds i) (make-oscil 0 :initial-phase (/ pi 2.0)))
	    (set! (ampfs i) (make-env ampfun :scaler (* amp (formant-amps i)) :duration dur))
	    (set! (cos-coeffs i) (partials->polynomial shape mus-chebyshev-first-kind))
	    (set! (sin-coeffs i) (partials->polynomial shape mus-chebyshev-second-kind))
	    (set! (frmfs i) (make-env (vox-fun phonemes i ()) :duration dur))))
	
	(if (= fs 3) ; unroll the inner loop in the most common case
	    (let ((frmfs0 (frmfs 0))   (frmfs1 (frmfs 1))   (frmfs2 (frmfs 2))
		  (ampfs0 (ampfs 0))   (ampfs1 (ampfs 1))   (ampfs2 (ampfs 2))
		  (sin-evens0 (sin-evens 0))   (sin-evens1 (sin-evens 1))   (sin-evens2 (sin-evens 2))
		  (sin-odds0 (sin-odds 0))     (sin-odds1 (sin-odds 1))     (sin-odds2 (sin-odds 2))
		  (cos-evens0 (cos-evens 0))   (cos-evens1 (cos-evens 1))   (cos-evens2 (cos-evens 2))
		  (cos-odds0 (cos-odds 0))     (cos-odds1 (cos-odds 1))     (cos-odds2 (cos-odds 2))
		  (cos-coeffs0 (cos-coeffs 0)) (cos-coeffs1 (cos-coeffs 1)) (cos-coeffs2 (cos-coeffs 2)) 
		  (sin-coeffs0 (sin-coeffs 0)) (sin-coeffs1 (sin-coeffs 1)) (sin-coeffs2 (sin-coeffs 2)))
	      (do ((i start (+ i 1)))
		  ((= i end))
		(set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
		(set! rfrq (hz->radians frq))
		(set! carsin (oscil car-sin (* rfrq frq-ratio)))
		(set! carcos (oscil car-cos (* rfrq frq-ratio)))
		
		(set! frm0 (/ (env frmfs0) frq))
		(set! frm-int (floor frm0))
		(set! frac (- frm0 frm-int))
		(set! fracf (* frm-int rfrq))
		(set! fax (polynomial cos-coeffs0 carcos))
		(set! yfax (* carsin (polynomial sin-coeffs0 carcos)))
		(outa i 
		      (* (env ampfs0)
			 (if (even? frm-int)
			     (+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens0 fracf)) (* fax (oscil cos-evens0 fracf))))
				(* frac (- (* yfax (oscil sin-odds0 (+ fracf rfrq))) (* fax (oscil cos-odds0 (+ fracf rfrq))))))
			     (+ (* frac (- (* yfax (oscil sin-evens0 (+ fracf rfrq))) (* fax (oscil cos-evens0 (+ fracf rfrq)))))
				(* (- 1.0 frac) (- (* yfax (oscil sin-odds0 fracf)) (* fax (oscil cos-odds0 fracf))))))))
		
		(set! frm0 (/ (env frmfs1) frq))
		(set! frm-int (floor frm0))
		(set! frac (- frm0 frm-int))
		(set! fracf (* frm-int rfrq))
		(set! fax (polynomial cos-coeffs1 carcos))
		(set! yfax (* carsin (polynomial sin-coeffs1 carcos)))
		(outa i 
		      (* (env ampfs1)
			 (if (even? frm-int)
			     (+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens1 fracf)) (* fax (oscil cos-evens1 fracf))))
				(* frac (- (* yfax (oscil sin-odds1 (+ fracf rfrq))) (* fax (oscil cos-odds1 (+ fracf rfrq))))))
			     (+ (* frac (- (* yfax (oscil sin-evens1 (+ fracf rfrq))) (* fax (oscil cos-evens1 (+ fracf rfrq)))))
				(* (- 1.0 frac) (- (* yfax (oscil sin-odds1 fracf)) (* fax (oscil cos-odds1 fracf))))))))
		
		(set! frm0 (/ (env frmfs2) frq))
		(set! frm-int (floor frm0))
		(set! frac (- frm0 frm-int))
		(set! fracf (* frm-int rfrq))
		(set! fax (polynomial cos-coeffs2 carcos))
		(set! yfax (* carsin (polynomial sin-coeffs2 carcos)))
		(outa i 
		      (* (env ampfs2)
			 (if (even? frm-int)
			     (+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens2 fracf)) (* fax (oscil cos-evens2 fracf))))
				(* frac (- (* yfax (oscil sin-odds2 (+ fracf rfrq))) (* fax (oscil cos-odds2 (+ fracf rfrq))))))
			     (+ (* frac (- (* yfax (oscil sin-evens2 (+ fracf rfrq))) (* fax (oscil cos-evens2 (+ fracf rfrq)))))
				(* (- 1.0 frac) (- (* yfax (oscil sin-odds2 fracf)) (* fax (oscil cos-odds2 fracf))))))))))
	    
369 370 371 372 373 374
	    (do ((i start (+ i 1)))
		((= i end))
	      (set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
	      (set! rfrq (hz->radians frq))
	      (set! carsin (oscil car-sin (* rfrq frq-ratio)))
	      (set! carcos (oscil car-cos (* rfrq frq-ratio)))
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393
	      (do ((k 0 (+ k 1)))
		  ((= k fs))
		(set! frm0 (/ (env (vector-ref frmfs k)) frq))
		(set! frm-int (floor frm0))
		(set! frac (- frm0 frm-int))
		(set! fracf (* frm-int rfrq))
		(set! fax (polynomial (vector-ref cos-coeffs k) carcos))
		(set! yfax (* carsin (polynomial (vector-ref sin-coeffs k) carcos)))
		(outa i (* (env (vector-ref ampfs k))
			   (if (even? frm-int)
			       (+ (* (- 1.0 frac) (- (* yfax (oscil (vector-ref sin-evens k) fracf))
						     (* fax (oscil (vector-ref cos-evens k) fracf))))
				  (* frac (- (* yfax (oscil (vector-ref sin-odds k) (+ fracf rfrq)))
					     (* fax (oscil (vector-ref cos-odds k) (+ fracf rfrq))))))
			       (+ (* frac (- (* yfax (oscil (vector-ref sin-evens k) (+ fracf rfrq)))
					     (* fax (oscil (vector-ref cos-evens k) (+ fracf rfrq)))))
				  (* (- 1.0 frac) (- (* yfax (oscil (vector-ref sin-odds k) fracf))
						     (* fax (oscil (vector-ref cos-odds k) fracf)))))))))))))))
  
394 395 396 397 398 399 400
;;; (with-sound (:statistics #t) (pqw-vox 0 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 0) 0 '(0 L 100 L) '(.33 .33 .33) '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5))))
;;; (a test to see if the cancellation is working -- sounds like a mosquito)

;;; (with-sound () (pqw-vox 0 2 200 200 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5))))
;;; (with-sound () (pqw-vox 0 2 100 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5))))
;;; (with-sound () (pqw-vox 0 2 200 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 4 .1) (1 1 2 .1 4 .05))))
;;; (with-sound () (pqw-vox 0 2 100 414 .2 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 OW 50 E 100 ER) '(.8 .15 .05) '((1 1 2 .5 3 .1 4 .01) (1 1 4 .1) (1 1 2 .1 4 .05))))
401

402 403 404


;;; -------- FOF
405

406 407
(definstrument (fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 (ae '(0 0 25 1 75 1 100 0)) ve)
  "(fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 (ampenv '(0 0 25 1 75 1 100 0)) vibenv) produces FOF 
408
synthesis: (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)"
409 410 411 412
  (let ((foflen (if (= *clm-srate* 22050) 100 200)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (ampf (make-env ae :scaler amp :duration dur))
413
	  (vibf (make-env (or ve '(0 1 100 1)) :scaler vib :duration dur))
414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431
	  (frq0 (hz->radians f0))
	  (frq1 (hz->radians f1))
	  (frq2 (hz->radians f2))
	  (vibr (make-oscil 6))
	  (win-freq (/ (* 2.0 pi) foflen))
	  (wt0 (make-wave-train :size foflen :frequency frq)))
      (let ((foftab (mus-data wt0)))
	(do ((i 0 (+ i 1)))
	    ((= i foflen))
	  (float-vector-set! foftab i (* (+ (* a0 (sin (* i frq0)))
				   (* a1 (sin (* i frq1)))
				   (* a2 (sin (* i frq2))))
				.5 (- 1.0 (cos (* i win-freq)))))))
      (do ((i start (+ i 1)))
	  ((= i end))
	(outa i (* (env ampf) 
		   (wave-train wt0 (* (env vibf) 
				      (oscil vibr)))))))))
432 433 434 435 436 437 438 439



;;; FM TRUMPET ---------------------------------------------------
;;; Dexter Morrill's FM-trumpet:
;;; from CMJ feb 77 p51

(definstrument (fm-trumpet startime dur
440
			   (frq1 250.0)
441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
			   (frq2 1500.0)
			   (amp1 0.5)
			   (amp2 0.1)
			   (ampatt1 0.03)
			   (ampdec1 0.35)
			   (ampatt2 0.03)
			   (ampdec2 0.3)
			   (modfrq1 250.0)
			   (modind11 0.0)
			   (modind12 2.66)
			   (modfrq2 250.0)
			   (modind21 0.0)
			   (modind22 1.8)
			   (rvibamp 0.007)
			   (rvibfrq 125.0)
			   (vibamp 0.007)
			   (vibfrq 7.0)
			   (vibatt 0.6)
			   (vibdec 0.2)
			   (frqskw 0.03)
			   (frqatt 0.06)
			   (ampenv1 '(0 0  25 1  75 .9  100 0))
			   (ampenv2 '(0 0  25 1  75 .9  100 0))
			   (indenv1 '(0 0  25 1  75 .9  100 0))
			   (indenv2 '(0 0  25 1  75 .9  100 0))
			   (degree 0.0)
			   (distance 1.0)
			   (reverb-amount 0.005))
469 470 471 472
  (let ((dec-01 (max 75 (* 100 (- 1.0 (/ .01 dur))))))
    (let ((beg (seconds->samples startime))
	  (end (seconds->samples (+ startime dur)))
	  (loc (make-locsig degree distance reverb-amount))
473 474 475 476
	  (per-vib-f (let ((vibe (stretch-envelope '(0 1  25 .1  75 0  100 0)
						   25 (min (* 100 (/ vibatt dur)) 45)
						   75 (max (* 100 (- 1.0 (/ vibdec dur))) 55))))
		       (make-env vibe :scaler vibamp :duration dur)))
477 478
	  (ran-vib (make-rand-interp :frequency rvibfrq :amplitude rvibamp))
	  (per-vib (make-oscil vibfrq))
479 480 481 482
	  (frq-f (let ((frqe (stretch-envelope '(0 0  25 1  75 1  100 0)
					       25 (min 25 (* 100 (/ frqatt dur)))
					       75 dec-01)))
		   (make-env frqe :scaler frqskw :offset 1.0 :duration dur)))
483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513
	  (ampattpt1 (min 25 (* 100 (/ ampatt1 dur))))
	  (ampdecpt1 (max 75 (* 100 (- 1.0 (/ ampdec1 dur)))))
	  (ampattpt2 (min 25 (* 100 (/ ampatt2 dur))))
	  (ampdecpt2 (max 75 (* 100 (- 1.0 (/ ampdec2 dur))))))
      (let ((mod1-f (make-env (stretch-envelope indenv1 25 ampattpt1 75 dec-01)
			      :scaler (* modfrq1 (- modind12 modind11)) :duration dur))
	    (mod1 (make-oscil 0.0))
	    (car1 (make-oscil 0.0))
	    ;; set frequency to zero here because it is handled multiplicatively below
	    (car1-f (make-env (stretch-envelope ampenv1 25 ampattpt1 75 ampdecpt1)
			      :scaler amp1 :duration dur))
	    
	    (mod2-f (make-env (stretch-envelope indenv2 25 ampattpt2 75 dec-01)
			      :scaler (* modfrq2 (- modind22 modind21)) :duration dur))
	    (mod2 (make-oscil 0.0))
	    (car2 (make-oscil 0.0))
	    (car2-f (make-env (stretch-envelope ampenv2 25 ampattpt2 75 ampdecpt2)
			      :scaler amp2 :duration dur)))
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (let ((frq-change (hz->radians (* (+ 1.0 (rand-interp ran-vib))
					    (+ 1.0 (* (env per-vib-f) (oscil per-vib)))
					    (env frq-f)))))
	    (locsig loc i (+ (* (env car1-f) 
				(oscil car1 (* frq-change 
					       (+ frq1 (* (env mod1-f) 
							  (oscil mod1 (* modfrq1 frq-change)))))))
			     (* (env car2-f) 
				(oscil car2 (* frq-change 
					       (+ frq2 (* (env mod2-f) 
							  (oscil mod2 (* modfrq2 frq-change)))))))))))))))
514 515 516


;;; -------- STEREO-FLUTE
517

518 519 520 521 522 523 524 525 526 527 528 529 530
(definstrument (stereo-flute start dur freq flow 
			     (flow-envelope '(0  1 100 1))
			     (decay 0.01) 		; additional time for instrument to decay
			     (noise 0.0356) 
			     (embouchure-size 0.5)
			     (fbk-scl1 0.5)		; these two are crucial for good results
			     (fbk-scl2 0.55)
			     (offset-pos 0.764264) ; from 0.0 to 1.0 along the bore
			     (out-scl 1.0)
			     (a0 0.7) (b1 -0.3)	 ; filter coefficients
			     (vib-rate 5) (vib-amount 0.03)
			     (ran-rate 5) (ran-amount 0.03))
  "(stereo-flute dur freq flow 
531
     (flow-envelope '(0  1 100 1)) (decay 0.01)
532 533 534 535 536 537 538
	   (noise 0.0356) (embouchure-size 0.5) (fbk-scl1 0.5)
	   (fbk-scl2 0.55) (offset-pos 0.764264) (out-scl 1.0)
	   (a0 0.7) (b1 -0.3) (vib-rate 5) (vib-amount 0.03)
           (ran-rate 5) (ran-amount 0.03))
is a physical model of a flute:
  (stereo-flute 0 1 440 .55 :flow-envelope '(0 0 1 1 2 1 3 0))"

539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584
  (let ((period-samples (floor (/ *clm-srate* freq))))
    (let ((embouchure-samples (floor (* embouchure-size period-samples))))
      (let ((current-excitation 0.0)
	    (current-difference 0.0)
	    (current-flow 0.0)
	    (out-sig 0.0)
	    (tap-sig 0.0)
	    (previous-out-sig 0.0)
	    (previous-tap-sig 0.0)
	    (dc-blocked-a 0.0)
	    (dc-blocked-b 0.0)
	    (previous-dc-blocked-a 0.0)
	    (previous-dc-blocked-b 0.0) 
	    (delay-sig 0.0)
	    (emb-sig 0.0)
	    (beg (seconds->samples start))
	    (end (seconds->samples (+ start dur)))
	    (flowf (make-env flow-envelope 
			     :scaler flow 
			     :duration (- dur decay)))
	    (periodic-vibrato (make-oscil vib-rate))
	    (random-vibrato (make-rand-interp :frequency ran-rate :amplitude ran-amount))
	    (breath (make-rand :frequency (/ *clm-srate* 2) :amplitude noise))
	    
	    
	    (embouchure (make-delay embouchure-samples :initial-element 0.0))
	    (bore (make-delay period-samples))
	    (offset (floor (* period-samples offset-pos)))
	    (reflection-lowpass-filter (make-one-pole a0 b1)))
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (set! delay-sig (delay bore out-sig))
	  (set! emb-sig (delay embouchure current-difference))
	  (set! current-flow (+ (* vib-amount (oscil periodic-vibrato)) 
				(rand-interp random-vibrato)
				(env flowf)))
	  (set! current-difference 
		(+ current-flow 
		   (* current-flow (rand breath))
		   (* fbk-scl1 delay-sig)))
	  (set! current-excitation (- emb-sig (* emb-sig emb-sig emb-sig)))
	  (set! out-sig (one-pole reflection-lowpass-filter 
				  (+ current-excitation (* fbk-scl2 delay-sig))))
	  (set! tap-sig (tap bore offset))
	  ;; NB the DC blocker is not in the cicuit. It is applied to the out-sig 
	  ;; but the result is not fed back into the system.
585 586
	  (set! dc-blocked-a (- (+ out-sig (* 0.995 previous-dc-blocked-a)) previous-out-sig))
	  (set! dc-blocked-b (- (+ tap-sig (* 0.995 previous-dc-blocked-b)) previous-tap-sig))
587 588 589 590 591 592
	  (outa i (* out-scl dc-blocked-a))
	  (outb i (* out-scl dc-blocked-b))
	  (set! previous-out-sig out-sig)
	  (set! previous-dc-blocked-a dc-blocked-a)
	  (set! previous-tap-sig tap-sig)
	  (set! previous-dc-blocked-b dc-blocked-b))))))
593 594 595

		  
;;; -------- FM-BELL
596 597
(definstrument (fm-bell startime dur frequency amplitude amp-env index-env index)
  "(fm-bell startime dur frequency amplitude amp-env index-env index) mixes in one fm bell note"
598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613
  (let ((fmInd2 (hz->radians (* 4.0 (- 8.0 (/ frequency 50.0))))))
    (let ((beg (seconds->samples startime))
					;(len (seconds->samples dur))
	  (end (seconds->samples (+ startime dur)))
	  (fmInd1 (hz->radians (* 32.0 frequency)))
	  
	  (fmInd3 (* fmInd2 0.705 (- 1.4 (/ frequency 250.0))))  
	  (fmInd4 (hz->radians (* 32.0 (- 20 (/ frequency 20)))))
	  (mod1 (make-oscil (* frequency 2)))
	  (mod2 (make-oscil (* frequency 1.41)))
	  (mod3 (make-oscil (* frequency 2.82)))
	  (mod4 (make-oscil (* frequency 2.4)))
	  (car1 (make-oscil frequency))
	  (car2 (make-oscil frequency))
	  (car3 (make-oscil (* frequency 2.4)))
	  (indf (make-env (or index-env 
614
			      '(0 1 2 1.1 25 .75 75 .5 100 .2))
615 616
			  (or index 1.0) dur))
	  (ampf (make-env (or amp-env 
617
			      '(0 0 .1 1 10 .6 25 .3 50 .15 90 .1 100 0))
618 619 620 621 622 623 624 625 626 627 628 629 630
			  amplitude dur)))
      (do ((i beg (+ i 1)))
	  ((= i end))
	(let ((fmenv (env indf)))
	  (outa i (* (env ampf)
		     (+ (oscil car1 (* fmenv fmInd1 (oscil mod1)))
			(* .15 (oscil car2 (* fmenv 
					      (+ (* fmInd2 (oscil mod2))
						 (* fmInd3 
						    (oscil mod3))))))
			(* .15 (oscil car3 (* fmenv 
					      fmInd4 
					      (oscil mod4))))))))))))
631 632 633 634 635 636 637 638 639 640 641


;(define fbell '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 ))
;(define abell '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0 ))
;(fm-bell 0.0 1.0 220.0 .5 abell fbell 1.0)


;;; -------- FM_INSECT
(definstrument (fm-insect startime dur frequency amplitude amp-env 
			  mod-freq mod-skew mod-freq-env mod-index mod-index-env 
			  fm-index fm-ratio
642
			  (degree 0.0)
643 644
		     	       (distance 1.0)
		               (reverb-amount 0.005))
645 646
  (let ((beg (seconds->samples startime))
	 (end (seconds->samples (+ startime dur)))
647 648 649 650 651 652 653 654
	 (loc (make-locsig degree distance reverb-amount))
	 (carrier (make-oscil frequency))
	 (fm1-osc (make-oscil mod-freq))
	 (fm2-osc (make-oscil (* fm-ratio frequency)))
	 (ampf (make-env amp-env :scaler amplitude :duration dur))
	 (indf (make-env mod-index-env :scaler (hz->radians mod-index) :duration dur))
	 (modfrqf (make-env mod-freq-env :scaler (hz->radians mod-skew) :duration dur))
	 (fm2-amp (hz->radians (* fm-index fm-ratio frequency))))
655 656
     (do ((i beg (+ i 1)))
	 ((= i end))
657 658
       (let ((garble-in (* (env indf)
			    (oscil fm1-osc (env modfrqf)))))
659
	 (locsig loc i (* (env ampf) 
660 661
			  (oscil carrier (+ (* fm2-amp (oscil fm2-osc garble-in))
					    garble-in))))))))
662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682

#|
(with-sound (:srate 22050) 
  (let ((locust '(0 0 40 1 95 1 100 .5))
	(bug_hi '(0 1 25 .7 75 .78 100 1))
	(amp    '(0 0 25 1 75 .7 100 0)))
    (fm-insect 0      1.699  4142.627  .015 amp 60 -16.707 locust 500.866 bug_hi  .346  .500)
    (fm-insect 0.195   .233  4126.284  .030 amp 60 -12.142 locust 649.490 bug_hi  .407  .500)
    (fm-insect 0.217  2.057  3930.258  .045 amp 60 -3.011  locust 562.087 bug_hi  .591  .500)
    (fm-insect 2.100  1.500   900.627  .06  amp 40 -16.707 locust 300.866 bug_hi  .346  .500)
    (fm-insect 3.000  1.500   900.627  .06  amp 40 -16.707 locust 300.866 bug_hi  .046  .500)
    (fm-insect 3.450  1.500   900.627  .09  amp 40 -16.707 locust 300.866 bug_hi  .006  .500)
    (fm-insect 3.950  1.500   900.627  .12  amp 40 -10.707 locust 300.866 bug_hi  .346  .500)
    (fm-insect 4.300  1.500   900.627  .09  amp 40 -20.707 locust 300.866 bug_hi  .246  .500)))
|#


;;; -------- FM-DRUM
;;; Jan Mattox's fm drum:

(definstrument (fm-drum start-time duration frequency amplitude index 
683 684 685 686 687 688 689 690 691
			high (degree 0.0) (distance 1.0) (reverb-amount 0.01))
  (let (;; many of the following variables were originally passed as arguments
	(indxfun '(0  0     5  .014  10 .033  15 .061  20 .099  
		      25 .153  30 .228  35 .332  40 .477  
		      45 .681  50 .964  55 .681  60 .478  65 .332  
		      70 .228  75 .153  80 .099  85 .061  
		      90 .033  95 .0141 100 0))
	(indxpt (- 100 (* 100 (/ (- duration .1) duration))))
	(atdrpt (* 100 (/ (if high .01 .015) duration))))
692 693 694 695 696
    (let ((divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt))
	  (ampfun '(0 0  3 .05  5 .2  7 .8  8 .95  10 1.0  12 .95  20 .3  30 .1  100 0))
	  (casrat (if high 8.525 3.515))
	  (fmrat (if high 3.414 1.414))
	  (glsfun '(0 0  25 0  75 1  100 1)))
697 698 699
      (let ((beg (seconds->samples start-time))
	    (end (seconds->samples (+ start-time duration)))
	    (glsf (make-env glsfun :scaler (if high (hz->radians 66) 0.0) :duration duration))
700 701 702 703 704
	    (ampf (let ((ampe (stretch-envelope ampfun 
						10 atdrpt 
						15 (max (+ atdrpt 1) 
							(- 100 (* 100 (/ (- duration .2) duration)))))))
		    (make-env ampe :scaler amplitude :duration duration)))
705 706
	    (indxf (make-env divindxf :scaler (min (hz->radians (* index fmrat frequency)) pi) :duration duration))
	    (mindxf (make-env divindxf :scaler (min (hz->radians (* index casrat frequency)) pi) :duration duration))
707 708 709 710 711
	    (devf (let ((deve (stretch-envelope ampfun 
						10 atdrpt 
						90 (max (+ atdrpt 1) 
							(- 100 (* 100 (/ (- duration .05) duration)))))))
		    (make-env deve :scaler (min pi (hz->radians 7000)) :duration duration)))
712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729
	    (loc (make-locsig degree distance reverb-amount))
	    (rn (make-rand :frequency 7000 :amplitude 1.0))
	    (carrier (make-oscil frequency))
	    (fmosc (make-oscil (* frequency fmrat)))
	    (cascade (make-oscil (* frequency casrat))))
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (let ((gls (env glsf)))
	    (locsig loc i (* (env ampf) 
			     (oscil carrier 
				    (+ gls 
				       (* (env indxf)
					  (oscil fmosc 
						 (+ (* gls fmrat)
						    (* (env mindxf) 
						       (oscil cascade 
							      (+ (* gls casrat)
								 (* (env devf) (rand rn))))))))))))))))))
730 731
#|
(with-sound ()
732 733
	    (fm-drum 0 1.5 55 .3 5 #f)
	    (fm-drum 2 1.5 66 .3 4 #t))
734 735 736 737 738 739 740
|#


;;; -------- FM-GONG
;;; Paul Weineke's gong.

(definstrument (gong start-time duration frequency amplitude
741
		     (degree 0.0) (distance 1.0) (reverb-amount 0.005))
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777
  (let ((mfq1 (* frequency 1.16))
	(mfq2 (* frequency 3.14))
	(mfq3 (* frequency 1.005)))
    (let ((indx01 (hz->radians (* .01 mfq1)))
	  (indx11 (hz->radians (* .30 mfq1)))
	  (indx02 (hz->radians (* .01 mfq2)))
	  (indx12 (hz->radians (* .38 mfq2)))
	  (indx03 (hz->radians (* .01 mfq3)))
	  (indx13 (hz->radians (* .50 mfq3)))
	  (atpt 5)
	  (atdur (* 100 (/ .002 duration)))
	  (expf '(0 0  3 1  15 .5  27 .25  50 .1  100 0))  
	  (rise '(0 0  15 .3  30 1.0  75 .5  100 0))
	  (fmup '(0 0  75 1.0  98 1.0  100 0))
	  (fmdwn '(0 0  2 1.0  100 0)))
      (let ((ampfun (make-env (stretch-envelope expf atpt atdur)
			      :scaler amplitude :duration duration))
	    (indxfun1 (make-env fmup :duration duration
				:scaler (- indx11 indx01) :offset indx01))
	    (indxfun2 (make-env fmdwn :duration duration
				:scaler (- indx12 indx02) :offset indx02))
	    (indxfun3 (make-env rise :duration duration
				:scaler (- indx13 indx03) :offset indx03))
	    (loc (make-locsig degree distance reverb-amount))
	    (carrier (make-oscil frequency))
	    (mod1 (make-oscil mfq1))
	    (mod2 (make-oscil mfq2))
	    (mod3 (make-oscil mfq3))
	    (beg (seconds->samples start-time))
	    (end (seconds->samples (+ start-time duration))))
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (locsig loc i (* (env ampfun) 
			   (oscil carrier (+ (* (env indxfun1) (oscil mod1))
					     (* (env indxfun2) (oscil mod2))
					     (* (env indxfun3) (oscil mod3)))))))))))
778 779 780 781 782 783

;;; (with-sound () (gong 0 3 261.61 .6))


(definstrument (attract beg dur amp c-1) ;c from 1 to 10 or so
  ;; by James McCartney, from CMJ vol 21 no 3 p 6
784 785
  (let ((st (seconds->samples beg))
	 (nd (seconds->samples (+ beg dur)))
786
	 (c c-1) (a .2) (b .2) (dt .04)
787
	 (scale (/ (* .5 amp) c-1))
788
	 (x -1.0) (y 0.0) (z 0.0))
789 790 791 792 793 794
     (do ((i st (+ i 1)))
	 ((= i nd))
       (let ((x1 (- x (* dt (+ y z)))))
	 (set! y (+ y (* dt (+ x (* a y)))))
	 (set! z (+ z (* dt (- (+ b (* x z)) (* c z)))))
	 (set! x x1)
795
	 (outa i (* scale x))))))
796 797


798

799 800
;;; -------- PQW
(definstrument (pqw start dur spacing-freq carrier-freq amplitude ampfun indexfun partials
801
		    (degree 0.0)
802 803 804 805 806
			 (distance 1.0)
			 (reverb-amount 0.005))
  ;; phase-quadrature waveshaping used to create asymmetric (i.e. single side-band) spectra.
  ;; The basic idea here is a variant of sin x sin y - cos x cos y = cos (x + y)

807 808 809 810 811 812 813
  (define (clip-env e)
    (do ((x e (cddr x)))
	((null? x) e)
      (if (> (cadr x) 1.0)
	  (list-set! x 1 1.0))))

  (let ((normalized-partials (normalize-partials partials))
814 815 816
	 (spacing-cos (make-oscil spacing-freq :initial-phase (/ pi 2.0)))
	 (spacing-sin (make-oscil spacing-freq))
	 (carrier-cos (make-oscil carrier-freq :initial-phase (/ pi 2.0)))
817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840
	 (carrier-sin (make-oscil carrier-freq)))
    (let ((sin-coeffs (partials->polynomial normalized-partials mus-chebyshev-second-kind))
	  (cos-coeffs (partials->polynomial normalized-partials mus-chebyshev-first-kind))
	  (amp-env (make-env ampfun :scaler amplitude :duration dur))
	  (ind-env (make-env (clip-env indexfun) :duration dur))
	  (loc (make-locsig degree distance reverb-amount))
	  (r (/ carrier-freq spacing-freq))
	  (tr (make-triangle-wave :frequency 5 :amplitude (hz->radians (* .005 spacing-freq))))
	  (rn (make-rand-interp :frequency 12 :amplitude (hz->radians (* .005 spacing-freq))))
	  (beg (seconds->samples start))
	  (end (seconds->samples (+ start dur))))
      (do ((i beg (+ i 1)))
	  ((= i end))
	(let* ((vib (+ (triangle-wave tr) (rand-interp rn)))
	       (ax (* (env ind-env) (oscil spacing-cos vib))))
	  (locsig loc i (* (env amp-env)
			   (- (* (oscil carrier-sin (* vib r)) 
				 (oscil spacing-sin vib) 
				 (polynomial sin-coeffs ax))
			      (* (oscil carrier-cos (* vib r)) 
				 (polynomial cos-coeffs ax))))))))))

;; (with-sound () (pqw 0 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5)))
;; to see the asymmetric spectrum most clearly, set the index function above to '(0 1 100 1)
841 842 843 844


;;; taken from Perry Cook's stkv1.tar.Z (Synthesis Toolkit), but I was
;;; in a bit of a hurry and may not have made slavishly accurate translations.
845
;;; Please let me know of any errors.
846

847
(definstrument (tubebell beg dur freq amp (base 32.0))
848
  ;; from Perry Cook's TubeBell.cpp
849
  (let ((osc0 (make-oscil (* freq 0.995)))
850 851 852
	 (osc1 (make-oscil (* freq 1.414 0.995)))
	 (osc2 (make-oscil (* freq 1.005)))
	 (osc3 (make-oscil (* freq 1.414)))
853 854
	 (ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur :scaler (* amp .5 .707)))
	 (ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* 2 base) :duration dur :scaler (* .5 amp)))
855 856
	 (ampmod (make-oscil 2.0))
	 (st (seconds->samples beg))
857
	 (nd (seconds->samples (+ beg dur))))
858 859 860
     (do ((i st (+ i 1)))
	 ((= i nd))
       (outa i (* (+ (* .007 (oscil ampmod)) .993)
861 862
		  (+ (* (env ampenv1) (oscil osc0 (* .203 (oscil osc1))))
		     (* (env ampenv2) (oscil osc2 (* .144 (oscil osc3))))))))))
863 864 865 866


(definstrument (wurley beg dur freq amp)
  ;; from Perry Cook's Wurley.cpp
867
  (let ((osc0 (make-oscil freq))
868 869 870 871 872 873
	 (osc1 (make-oscil (* freq 4.0)))
	 (osc2 (make-oscil 510.0))
	 (osc3 (make-oscil 510.0))
	 (ampmod (make-oscil 8.0))
	 (g0 (* .5 amp))
	 (ampenv (make-env '(0 0 1 1 9 1 10 0) :duration dur))
874 875
	 (indenv (make-env (list 0 0 .001 1 .15 0 (max dur .16) 0) :duration dur :scaler .117))
	 (resenv (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :duration dur :scaler (* .5 .307 amp)))
876
	 (st (seconds->samples beg))
877
	 (nd (seconds->samples (+ beg dur))))
878 879 880 881
     (do ((i st (+ i 1)))
	 ((= i nd))
       (outa i (* (env ampenv)
		  (+ 1.0 (* .007 (oscil ampmod)))
882 883
		  (+ (* g0 (oscil osc0 (* .307 (oscil osc1))))
		     (* (env resenv) (oscil osc2 (* (env indenv) (oscil osc3))))))))))
884 885


886
(definstrument (rhodey beg dur freq amp (base .5))
887
  ;; from Perry Cook's Rhodey.cpp
888
  (let ((osc0 (make-oscil freq))
889 890 891
	 (osc1 (make-oscil (* freq 0.5)))
	 (osc2 (make-oscil freq))
	 (osc3 (make-oscil (* freq 15.0)))
892 893 894
	 (ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur :scaler (* amp .5)))
	 (ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* base 1.5) :duration dur :scaler (* amp .5)))
	 (ampenv3 (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :base (* base 4) :duration dur :scaler .109))
895
	 (st (seconds->samples beg))
896
	 (nd (seconds->samples (+ beg dur))))
897 898
     (do ((i st (+ i 1)))
	 ((= i nd))
899 900
       (outa i (+ (* (env ampenv1) (oscil osc0 (* .535 (oscil osc1))))
		  (* (env ampenv2) (oscil osc2 (* (env ampenv3) (oscil osc3)))))))))
901 902 903 904


(definstrument (hammondoid beg dur freq amp)
  ;; from Perry Cook's BeeThree.cpp
905
  (let ((osc0 (make-oscil (* freq 0.999)))
906 907 908 909
	 (osc1 (make-oscil (* freq 1.997)))
	 (osc2 (make-oscil (* freq 3.006)))
	 (osc3 (make-oscil (* freq 6.009)))
	 (ampenv1 (make-env (list 0 0 .005 1 (- dur .008) 1 dur 0) :duration dur))
910
	 (ampenv2 (make-env (list 0 0 .005 1 dur 0) :duration dur :scaler (* .5 .75 amp)))
911 912 913 914
	 (g0 (* .25 .75 amp))
	 (g1 (* .25 .75 amp))
	 (g2 (* .5 amp))
	 (st (seconds->samples beg))
915
	 (nd (seconds->samples (+ beg dur))))
916 917 918 919 920 921
     (do ((i st (+ i 1)))
	 ((= i nd))
       (outa i (+ (* (env ampenv1)
		     (+ (* g0 (oscil osc0))
			(* g1 (oscil osc1))
			(* g2 (oscil osc2))))
922
		  (* (env ampenv2) (oscil osc3)))))))
923 924 925 926


(definstrument (metal beg dur freq amp)
  ;; from Perry Cook's HeavyMtl.cpp
927
  (let ((osc0 (make-oscil freq))
928 929 930
	 (osc1 (make-oscil (* freq 4.0 0.999)))
	 (osc2 (make-oscil (* freq 3.0 1.001)))
	 (osc3 (make-oscil (* freq 0.50 1.002)))
931 932 933 934
	 (ampenv0 (make-env (list 0 0 .001 1 (- dur .002) 1 dur 0) :duration dur :scaler (* amp .615)))
	 (ampenv1 (make-env (list 0 0 .001 1 (- dur .011) 1 dur 0) :duration dur :scaler .202))
	 (ampenv2 (make-env (list 0 0 .01 1 (- dur .015) 1 dur 0) :duration dur :scaler .574))
	 (ampenv3 (make-env (list 0 0 .03 1 (- dur .040) 1 dur 0) :duration dur :scaler .116))
935
	 (st (seconds->samples beg))
936
	 (nd (seconds->samples (+ beg dur))))
937 938
     (do ((i st (+ i 1)))
	 ((= i nd))
939
       (outa i (* (env ampenv0) 
940
		  (oscil osc0 
941 942
			 (+ (* (env ampenv1) (oscil osc1 (* (env ampenv2) (oscil osc2))))
			    (* (env ampenv3) (oscil osc3)))))))))
943 944 945


(definstrument (drone startime dur frequency amp ampfun synth ampat ampdc amtrev deg dis rvibamt rvibfreq)
946
  (let ((beg (seconds->samples startime))
947 948 949 950
	(end (seconds->samples (+ startime dur)))
	(waveform (partials->wave synth))
	(amplitude (* amp .25))
	(freq (hz->radians frequency)))
951
    (let ((s (make-table-lookup :frequency frequency :wave waveform))
952 953 954
	  (amp-env (let ((ampe (stretch-envelope ampfun 25 (* 100 (/ ampat dur)) 75 (- 100 (* 100 (/ ampdc dur))))))
		     (make-env ampe :scaler amplitude :duration dur)))
	  (ran-vib (make-rand :frequency rvibfreq :amplitude (* rvibamt freq)))
955 956 957 958
	  (loc (make-locsig deg dis amtrev)))
      (do ((i beg (+ i 1)))
	  ((= i end))
	(locsig loc i (* (env amp-env) (table-lookup s (rand ran-vib))))))))
959 960 961 962 963 964 965 966


(definstrument (canter beg dur pitch amp-1 deg dis pcrev ampfun ranfun skewfun
		       skewpc ranpc ranfreq indexfun atdr dcdr
		       ampfun1 indfun1 fmtfun1
		       ampfun2 indfun2 fmtfun2
		       ampfun3 indfun3 fmtfun3
		       ampfun4 indfun4 fmtfun4)
967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019
  (let ((amp (* amp-1 .25))		;pvc's amplitudes in bag.clm are very high (overflows)
	(rangetop 910.0)
	(rangebot 400.0))
    (let ((k (floor (* 100 (log (/ pitch rangebot) (/ rangetop rangebot)))))
	  (atpt (* 100 (/ atdr dur)))
	  (dcpt (- 100 (* 100 (/ dcdr dur)))))
      (let ((lfmt1 (envelope-interp k fmtfun1))
	    (lfmt2 (envelope-interp k fmtfun2))
	    (lfmt3 (envelope-interp k fmtfun3))
	    (lfmt4 (envelope-interp k fmtfun4))
	    (dev11 (hz->radians (* (envelope-interp k indfun1) pitch)))
	    (dev12 (hz->radians (* (envelope-interp k indfun2) pitch)))
	    (dev13 (hz->radians (* (envelope-interp k indfun3) pitch)))
	    (dev14 (hz->radians (* (envelope-interp k indfun4) pitch))))
	(let ((start (seconds->samples beg))
	      (end (seconds->samples (+ beg dur)))
	      (dev01 (* dev11 .5))
	      (dev02 (* dev12 .5))
	      (dev03 (* dev13 .5))
	      (dev04 (* dev14 .5))
	      (harm1 (floor (+ .5 (/ lfmt1 pitch))))
	      (harm2 (floor (+ .5 (/ lfmt2 pitch))))
	      (harm3 (floor (+ .5 (/ lfmt3 pitch))))
	      (harm4 (floor (+ .5 (/ lfmt4 pitch)))))
	  (let ((lamp1 (* (envelope-interp k ampfun1) amp (- 1 (abs (- harm1 (/ lfmt1 pitch))))))
		(lamp2 (* (envelope-interp k ampfun2) amp (- 1 (abs (- harm2 (/ lfmt2 pitch))))))
		(lamp3 (* (envelope-interp k ampfun3) amp (- 1 (abs (- harm3 (/ lfmt3 pitch))))))
		(lamp4 (* (envelope-interp k ampfun4) amp (- 1 (abs (- harm4 (/ lfmt4 pitch))))))
		(tidx-stretched (stretch-envelope indexfun 25 atpt 75 dcpt)))
	    (let ((tampfun (make-env (stretch-envelope ampfun 25 atpt 75 dcpt) :duration dur))
		  (tskwfun (make-env (stretch-envelope skewfun 25 atpt 75 dcpt) :scaler (hz->radians (* pitch skewpc)) :duration dur))
		  (tranfun (make-env (stretch-envelope ranfun 25 atpt 75 dcpt) :duration dur))
		  (d1env (make-env tidx-stretched :offset dev01 :scaler dev11 :duration dur))
		  (d2env (make-env tidx-stretched :offset dev02 :scaler dev12 :duration dur))
		  (d3env (make-env tidx-stretched :offset dev03 :scaler dev13 :duration dur))
		  (d4env (make-env tidx-stretched :offset dev04 :scaler dev14 :duration dur))
		  (modgen (make-oscil pitch))
		  (ranvib (make-rand :frequency ranfreq :amplitude (hz->radians (* ranpc pitch))))
		  (loc (make-locsig deg dis pcrev))
		  (gen1 (make-oscil (* pitch harm1)))
		  (gen2 (make-oscil (* pitch harm2)))
		  (gen3 (make-oscil (* pitch harm3)))
		  (gen4 (make-oscil (* pitch harm4))))
	      (do ((i start (+ i 1)))
		  ((= i end))
		(let* ((frqval (+ (env tskwfun) (* (env tranfun) (rand ranvib))))
		       (modval (oscil modgen frqval)))
		  (locsig loc i (* (env tampfun)
				   (+ (* lamp1 (oscil gen1 (* (+ (* (env d1env) modval) frqval) harm1)))
				      (* lamp2 (oscil gen2 (* (+ (* (env d2env) modval) frqval) harm2)))
				      (* lamp3 (oscil gen3 (* (+ (* (env d3env) modval) frqval) harm3)))
				      (* lamp4 (oscil gen4 (* (+ (* (env d4env) modval) frqval) harm4)))))))))))))))

1020 1021 1022 1023


;;; NREV (the most popular Samson box reverb)

1024
(definstrument (nrev (reverb-factor 1.09) (lp-coeff 0.7) (volume 1.0))
1025 1026 1027
  ;; reverb-factor controls the length of the decay -- it should not exceed (/ 1.0 .823)
  ;; lp-coeff controls the strength of the low pass filter inserted in the feedback loop
  ;; output-scale can be used to boost the reverb output
1028

1029
  (define (next-prime val)
1030 1031 1032 1033 1034 1035 1036 1037 1038
    (do ((val val (+ val 2)))
	((or (= val 2)
	     (and (odd? val)
		  (do ((i 3 (+ i 2))
		       (lim (sqrt val)))
		      ((or (= 0 (modulo val i))
			   (> i lim))
		       (> i lim)))))
           val)))
1039
  
1040 1041 1042 1043 1044
  (let ((srscale (/ *clm-srate* 25641))
	(dly-len (list 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19))
	(chan2 (> (channels *output*) 1))
	(chan4 (= (channels *output*) 4)))
	
1045 1046
    (do ((i 0 (+ i 1)))
	((= i 15))
1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057
      (let ((val (floor (* srscale (dly-len i)))))
	(if (even? val) (set! val (+ val 1)))
	(set! (dly-len i) (next-prime val))))

    (let ((len (+ (floor *clm-srate*) (framples *reverb*)))
	   (comb1 (make-comb (* .822 reverb-factor) (dly-len 0)))
	   (comb2 (make-comb (* .802 reverb-factor) (dly-len 1)))
	   (comb3 (make-comb (* .773 reverb-factor) (dly-len 2)))
	   (comb4 (make-comb (* .753 reverb-factor) (dly-len 3)))
	   (comb5 (make-comb (* .753 reverb-factor) (dly-len 4)))
	   (comb6 (make-comb (* .733 reverb-factor) (dly-len 5)))
1058
	   (low (make-one-pole lp-coeff (- lp-coeff 1.0)))
1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081
	   (allpass1 (make-all-pass -0.700 0.700 (dly-len 6)))
	   (allpass2 (make-all-pass -0.700 0.700 (dly-len 7)))
	   (allpass3 (make-all-pass -0.700 0.700 (dly-len 8)))
	   (allpass4 (make-all-pass -0.700 0.700 (dly-len 9))) ; 10 for quad
	   (allpass5 (make-all-pass -0.700 0.700 (dly-len 11)))
	   (allpass6 (and chan2 (make-all-pass -0.700 0.700 (dly-len 12))))
	   (allpass7 (and chan4 (make-all-pass -0.700 0.700 (dly-len 13))))
	   (allpass8 (and chan4 (make-all-pass -0.700 0.700 (dly-len 14)))))

      (let ((filts (if (not chan2)
		       (vector allpass5)
		       (if (not chan4)
			   (vector allpass5 allpass6)
			   (vector allpass5 allpass6 allpass7 allpass8))))
	    (combs (make-comb-bank (vector comb1 comb2 comb3 comb4 comb5 comb6)))
	    (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
	(do ((i 0 (+ i 1)))
	    ((= i len))
	  (out-bank filts i
		    (all-pass allpass4
			      (one-pole low
					(all-pass-bank allpasses
						       (comb-bank combs (* volume (ina i *reverb*))))))))))))
1082 1083 1084 1085

(definstrument (reson startime dur pitch amp numformants indxfun skewfun pcskew skewat skewdc
		      vibfreq vibpc ranvibfreq ranvibpc degree distance reverb-amount data)
  ;; data is a list of lists of form '(ampf resonfrq resonamp ampat ampdc dev0 dev1 indxat indxdc)
1086
  (let ((beg (seconds->samples startime))
1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102
	(end (seconds->samples (+ startime dur)))
	(carriers (make-vector numformants))
	(modulator (make-oscil pitch))
	(ampfs (make-vector numformants))
	(indfs (make-vector numformants))
	(c-rats (make-vector numformants))
	(totalamp 0.0)
	(loc (make-locsig degree distance reverb-amount))
	(pervib (make-triangle-wave :frequency vibfreq
				    :amplitude (hz->radians (* vibpc pitch))))
	(ranvib (make-rand-interp :frequency ranvibfreq
				  :amplitude (hz->radians (* ranvibpc pitch))))
	(frqf (let ((frqe (stretch-envelope skewfun 
						      25 (* 100 (/ skewat dur)) 
						      75 (- 100 (* 100 (/ skewdc dur))))))
		(make-env frqe :scaler (hz->radians (* pcskew pitch)) :duration dur))))
1103 1104 1105
    ;; initialize the "formant" generators
    (do ((i 0 (+ i 1)))
	((= i numformants))
1106
      (set! totalamp (+ totalamp ((data i) 2))))
1107 1108
    (do ((i 0 (+ i 1)))
	((= i numformants))
1109
      (let* ((frmdat (data i))
1110
	     (freq (cadr frmdat))
1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131
	     (harm (round (/ freq pitch))))
	(let ((rfamp  (frmdat 2))
	      (ampat (* 100 (/ (frmdat 3) dur)))
	      (ampdc (- 100 (* 100 (/ (frmdat 4) dur))))
	      (dev0 (hz->radians (* (frmdat 5) freq)))
	      (dev1 (hz->radians (* (frmdat 6) freq)))
	      (indxat (* 100 (/ (frmdat 7) dur)))
	      (indxdc (- 100 (* 100 (/ (frmdat 8) dur))))
	      (ampf (car frmdat))
	      (rsamp (- 1.0 (abs (- harm (/ freq pitch)))))
	      (cfq (* pitch harm)))
	  (if (zero? ampat) (set! ampat 25))
	  (if (zero? ampdc) (set! ampdc 75))
	  (if (zero? indxat) (set! indxat 25))
	  (if (zero? indxdc) (set! indxdc 75))
	  (set! (indfs i) (make-env (stretch-envelope indxfun 25 indxat 75 indxdc) :duration dur
				    :scaler (- dev1 dev0) :offset dev0))
	  (set! (ampfs i) (make-env (stretch-envelope ampf 25 ampat 75 ampdc) :duration dur
				    :scaler (/ (* rsamp amp rfamp) totalamp)))
	  (set! (c-rats i) harm)
	  (set! (carriers i) (make-oscil cfq)))))
1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165
    (if (= numformants 2)
	(let ((e1 (ampfs 0))
	      (e2 (ampfs 1))
	      (c1 (carriers 0))
	      (c2 (carriers 1))
	      (i1 (indfs 0))
	      (i2 (indfs 1))
	      (r1 (c-rats 0))
	      (r2 (c-rats 1)))
	  (do ((i beg (+ i 1)))
	      ((= i end))
	    (let* ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
		   (modsig (oscil modulator vib)))
	      (locsig loc i (+ (* (env e1)
				  (oscil c1 (+ (* vib r1)
					       (* (env i1) modsig))))
			       (* (env e2)
				  (oscil c2 (+ (* vib r2)
					       (* (env i2) modsig)))))))))
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (let* ((outsum 0.0)
		 (vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
		 (modsig (oscil modulator vib)))
	    (do ((k 0 (+ k 1)))
		((= k numformants))
	      (set! outsum (+ outsum
			      (* (env (ampfs k))
				 (oscil (carriers k) 
					(+ (* vib (c-rats k))
					   (* (env (indfs k)) modsig)))))))
	    (locsig loc i outsum))))))

;; (with-sound (:statistics #t) (reson 0 1.0 440 .1 2 '(0 0 100 1) '(0 0 100 1) .1 .1 .1 5 .01 5 .01 0 1.0 0.01 '(((0 0 100 1) 1200 .5 .1 .1 0 1.0 .1 .1) ((0 1 100 0) 2400 .5 .1 .1 0 1.0 .1 .1))))
1166 1167 1168 1169 1170 1171 1172 1173 1174


;;; 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)
1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193
  (let ((st (seconds->samples beg))
	(nd (seconds->samples (+ beg dur)))
	(pit1 (if (zero? pitch1) pitch0 pitch1))
	(loc (make-locsig deg dis pcrev))
	(carrier (make-oscil pitch0))
	(low (make-one-zero .5 -.5))
	(fm 0.0)
	(fmosc (make-oscil pitch0))
	(pvib (make-triangle-wave :frequency pvibfreq :amplitude 1.0))
	(rvib (make-rand-interp :frequency rvibfreq :amplitude 1.0))
	(ampap (if (> ampat 0.0) (* 100 (/ ampat dur)) 25))
	(ampdp (if (> ampdc 0.0) (* 100 (- 1.0 (/ ampdc dur))) 75))
	(glsap (if (> glissat 0.0) (* 100 (/ glissat dur)) 25))
	(glsdp (if (> glissdc 0.0) (* 100 (- 1.0 (/ glissdc dur))) 75))
	(betap (if (> betaat 0.0) (* 100 (/ betaat dur)) 25))
	(betdp (if (> betadc 0.0) (* 100 (- 1.0 (/ betadc dur))) 75))
	(pvbap (if (> pvibat 0.0) (* 100 (/ pvibat dur)) 25))
	(pvbdp (if (> pvibdc 0.0) (* 100 (- 1.0 (/ pvibdc dur))) 75)))
    (let ((pvibenv (make-env (stretch-envelope (or pvibfun '(0 1 100 1)) 25 pvbap 75 pvbdp) :duration dur
1194
			     :scaler (hz->radians (* pvibpc pitch0))))
1195
	  (rvibenv (make-env (or rvibfun '(0 1 100 1)) :duration dur
1196
			     :scaler (hz->radians (* rvibpc pitch0))))
1197
	  (glisenv (make-env (stretch-envelope (or glissfun '(0 0 100 0)) 25 glsap 75 glsdp) :duration dur
1198
			     :scaler (hz->radians (- pit1 pitch0))))
1199 1200
	  (amplenv (make-env (stretch-envelope ampfun 25 ampap 75 ampdp) :scaler amp :duration dur))
	  (betaenv (make-env (stretch-envelope betafun 25 betap 75 betdp) :duration dur
1201
			     :scaler (- beta1 beta0) :offset beta0)))
1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237
      (if (and (= pitch0 pitch1)
	       (or (zero? pvibfreq)
		   (zero? pvibpc))
	       (or (zero? rvibfreq)
		   (zero? rvibpc)))
	  (do ((i st (+ i 1)))
	      ((= i nd))
	    (set! fm (one-zero low (* (env betaenv) (oscil fmosc fm))))
	    (locsig loc i (* (env amplenv) (oscil carrier fm))))
	  (do ((i st (+ i 1)))
	      ((= i nd))
	    (let ((vib (+ (* (env pvibenv) (triangle-wave pvib))
			  (* (env rvibenv) (rand-interp rvib))
			  (env glisenv))))
	      (set! fm (one-zero low (* (env betaenv) (oscil fmosc (+ fm vib)))))
	      (locsig loc i (* (env amplenv) 
			       (oscil carrier (+ fm vib))))))))))


(definstrument (jl-reverb (decay 3.0) (volume 1.0))
  (let ((allpass1 (make-all-pass -0.700 0.700 2111))
	(allpass2 (make-all-pass -0.700 0.700  673))
	(allpass3 (make-all-pass -0.700 0.700  223))
	(comb1 (make-comb 0.742 9601))
	(comb2 (make-comb 0.733 10007))
	(comb3 (make-comb 0.715 10799))
	(comb4 (make-comb 0.697 11597))
	(outdel1 (make-delay (seconds->samples .013)))
	(outdel2 (make-delay (seconds->samples .011)))
	(len (floor (+ (* decay *clm-srate*) (length *reverb*)))))
    (let ((filts (vector outdel1 outdel2))
	  (combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
	  (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
      (do ((i 0 (+ i 1)))
	  ((= i len))
	(out-bank filts i (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*)))))))))
1238 1239 1240


(definstrument (gran-synth start-time duration audio-freq grain-dur grain-interval amp)
1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254
  (let ((grain-size (ceiling (* (max grain-dur grain-interval) *clm-srate*))))
    (let ((beg (seconds->samples start-time))
	  (end (seconds->samples (+ start-time duration)))
	  (grain-env (make-env '(0 0 25 1 75 1 100 0) :duration grain-dur))
	  (carrier (make-oscil audio-freq))
	  (grains (make-wave-train :size grain-size :frequency (/ 1.0 grain-interval))))
      (let ((grain (mus-data grains)))
	(do ((i 0 (+ i 1)))
	    ((= i grain-size))
	  (set! (grain i) (* (env grain-env) (oscil carrier)))))
      (do ((i beg (+ i 1)))
	  ((= i end))
	(outa i (* amp (wave-train grains)))))))

1255 1256 1257 1258 1259 1260 1261 1262
;;; (with-sound () (gran-synth 0 2 100 .0189 .02 .4))


(definstrument (touch-tone start telephone-number)
  (let ((touch-tab-1 '(0 697 697 697 770 770 770 852 852 852 941 941 941))
	(touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477)))
    (do ((i 0 (+ i 1)))
	((= i (length telephone-number)))
1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276
      (let ((k (telephone-number i))
	    (beg (seconds->samples (+ start (* i .4)))))
	(let ((end (+ beg (seconds->samples .3)))
	      (i (if (number? k)
		     (if (not (= 0 k)) k 11)
		     (if (eq? k '*) 10 12))))
	  (let ((frq1 (make-oscil (touch-tab-1 i)))
		(frq2 (make-oscil (touch-tab-2 i))))
	    (do ((j beg (+ j 1)))
		((= j end))
	      (outa j (* 0.1 (+ (oscil frq1) 
				(oscil frq2)))))))))))

;;; (with-sound () (touch-tone 0.0 '(7 2 3 4 9 7 1)))
1277 1278 1279 1280 1281
;;; I think the dial tone is 350 + 440
;;; http://www.hackfaq.org/telephony/telephone-tone-frequencies.shtml


(definstrument (spectra start-time duration frequency amplitude
1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309
			(partials '(1 1 2 0.5))
			(amp-envelope '(0 0 50 1 100 0))
			(vibrato-amplitude 0.005)
			(vibrato-speed 5.0)
			(degree 0.0)
			(distance 1.0)
			(reverb-amount 0.005))
  (let ((beg (seconds->samples start-time))
	(end (seconds->samples (+ start-time duration)))
	(waveform (partials->wave partials))
	(freq (hz->radians frequency)))
    (let ((s (make-table-lookup :frequency frequency :wave waveform))
	  (amp-env (make-env amp-envelope :scaler amplitude :duration duration))
	  (per-vib (make-triangle-wave :frequency vibrato-speed
				       :amplitude (* vibrato-amplitude freq)))
	  (loc (make-locsig degree distance reverb-amount))
	  (ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
				     :amplitude (* vibrato-amplitude freq))))
      (do ((i beg (+ i 1)))
	  ((= i end))
	(locsig loc i (* (env amp-env) 
			 (table-lookup s (+ (triangle-wave per-vib)
					    (rand-interp ran-vib)))))))))
#|
    (with-sound (:play #t)
      (spectra 0 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1) 
               '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
|#
1310 1311 1312 1313 1314 1315


;;; interpolate between two waveforms (this could be extended to implement all the various
;;; wavetable-based synthesis techniques).

(definstrument (two-tab start-time duration frequency amplitude
1316
		        (partial-1 '(1.0 1.0 2.0 0.5))
1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346
			(partial-2 '(1.0 0.0 3.0 1.0))
			(amp-envelope '(0 0 50 1 100 0))
			(interp-func '(0 1 100 0))
			(vibrato-amplitude 0.005)
			(vibrato-speed 5.0)
			(degree 0.0)
			(distance 1.0)
			(reverb-amount 0.005))
  (let ((beg (seconds->samples start-time))
	(end (seconds->samples (+ start-time duration)))
	(waveform-1 (partials->wave partial-1))
	(waveform-2 (partials->wave partial-2))
	(freq (hz->radians frequency)))
    (let ((s-1 (make-table-lookup :frequency frequency :wave waveform-1))
	  (s-2 (make-table-lookup :frequency frequency :wave waveform-2))
	  (amp-env (make-env amp-envelope :scaler amplitude :duration duration))
	  (interp-env (make-env interp-func :duration duration))
	  (interp-env-1 (make-env interp-func :duration duration :offset 1.0 :scaler -1.0))
	  (loc (make-locsig degree distance reverb-amount))
	  (per-vib (make-triangle-wave :frequency vibrato-speed
				       :amplitude (* vibrato-amplitude freq)))
	  (ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
				     :amplitude (* vibrato-amplitude freq))))
      (do ((i beg (+ i 1)))
	  ((= i end))
	(let ((vib (+ (triangle-wave per-vib) (rand-interp ran-vib))))
	  (locsig loc i (* (env amp-env) 
			   (+ (* (env interp-env) (table-lookup s-1 vib))
			      (* (env interp-env-1) (table-lookup s-2 vib))))))))))

1347 1348


1349
(definstrument (lbj-piano begin-time duration frequency amplitude pfreq
1350 1351
			  (degree 45) (reverb-amount 0) (distance 1))

1352
  (define get-piano-partials
1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753
    (let ((piano-spectra #((1.97 .0326  2.99 .0086  3.95 .0163  4.97 .0178  5.98 .0177  6.95 .0315  8.02 .0001
				 8.94 .0076  9.96 .0134 10.99 .0284 11.98 .0229 13.02 .0229 13.89 .0010 15.06 .0090 16.00 .0003
				 17.08 .0078 18.16 .0064 19.18 .0129 20.21 .0085 21.27 .0225 22.32 .0061 23.41 .0102 24.48 .0005
				 25.56 .0016 26.64 .0018 27.70 .0113 28.80 .0111 29.91 .0158 31.06 .0093 32.17 .0017 33.32 .0002
				 34.42 .0018 35.59 .0027 36.74 .0055 37.90 .0037 39.06 .0064 40.25 .0033 41.47 .0014 42.53 .0004
				 43.89 .0010 45.12 .0039 46.33 .0039 47.64 .0009 48.88 .0016 50.13 .0006 51.37 .0010 52.70 .0002
				 54.00 .0004 55.30 .0008 56.60 .0025 57.96 .0010 59.30 .0012 60.67 .0011 61.99 .0003 62.86 .0001
				 64.36 .0005 64.86 .0001 66.26 .0004 67.70 .0006 68.94 .0002 70.10 .0001 70.58 .0002 72.01 .0007
				 73.53 .0006 75.00 .0002 77.03 .0005 78.00 .0002 79.57 .0006 81.16 .0005 82.70 .0005 84.22 .0003
				 85.41 .0002 87.46 .0001 90.30 .0001 94.02 .0001 95.26 .0002 109.39 .0003)
			   
			   (1.98 .0194  2.99 .0210  3.97 .0276  4.96 .0297  5.96 .0158  6.99 .0207  8.01 .0009
				 9.00 .0101 10.00 .0297 11.01 .0289 12.02 .0211 13.04 .0127 14.07 .0061 15.08 .0174 16.13 .0009
				 17.12 .0093 18.16 .0117 19.21 .0122 20.29 .0108 21.30 .0077 22.38 .0132 23.46 .0073 24.14 .0002
				 25.58 .0026 26.69 .0035 27.77 .0053 28.88 .0024 30.08 .0027 31.13 .0075 32.24 .0027 33.36 .0004
				 34.42 .0004 35.64 .0019 36.78 .0037 38.10 .0009 39.11 .0027 40.32 .0010 41.51 .0013 42.66 .0019
				 43.87 .0007 45.13 .0017 46.35 .0019 47.65 .0021 48.89 .0014 50.18 .0023 51.42 .0015 52.73 .0002
				 54.00 .0005 55.34 .0006 56.60 .0010 57.96 .0016 58.86 .0005 59.30 .0004 60.75 .0005 62.22 .0003
				 63.55 .0005 64.82 .0003 66.24 .0003 67.63 .0011 69.09 .0007 70.52 .0004 72.00 .0005 73.50 .0008
				 74.95 .0003 77.13 .0013 78.02 .0002 79.48 .0004 82.59 .0004 84.10 .0003)
			   
			   (2.00 .0313  2.99 .0109  4.00 .0215  5.00 .0242  5.98 .0355  7.01 .0132  8.01 .0009
				 9.01 .0071 10.00 .0258 11.03 .0221 12.02 .0056 13.06 .0196 14.05 .0160 15.11 .0107 16.11 .0003
				 17.14 .0111 18.21 .0085 19.23 .0010 20.28 .0048 21.31 .0128 22.36 .0051 23.41 .0041 24.05 .0006
				 25.54 .0019 26.62 .0028 27.72 .0034 28.82 .0062 29.89 .0039 30.98 .0058 32.08 .0011 33.21 .0002
				 34.37 .0008 35.46 .0018 36.62 .0036 37.77 .0018 38.92 .0042 40.07 .0037 41.23 .0011 42.67 .0003
				 43.65 .0018 44.68 .0025 45.99 .0044 47.21 .0051 48.40 .0044 49.67 .0005 50.88 .0019 52.15 .0003
				 53.42 .0008 54.69 .0010 55.98 .0005 57.26 .0013 58.53 .0027 59.83 .0011 61.21 .0027 62.54 .0003
				 63.78 .0003 65.20 .0001 66.60 .0006 67.98 .0008 69.37 .0019 70.73 .0007 72.14 .0004 73.62 .0002
				 74.40 .0003 76.52 .0006 77.97 .0002 79.49 .0004 80.77 .0003 81.00 .0001 82.47 .0005 83.97 .0001
				 87.27 .0002)
			   
			   (2.00 .0257  2.99 .0142  3.97 .0202  4.95 .0148  5.95 .0420  6.95 .0037  7.94 .0004
				 8.94 .0172  9.95 .0191 10.96 .0115 11.97 .0059 12.98 .0140 14.00 .0178 15.03 .0121 16.09 .0002
				 17.07 .0066 18.08 .0033 19.15 .0022 20.18 .0057 21.22 .0077 22.29 .0037 23.33 .0066 24.97 .0002
				 25.49 .0019 26.55 .0042 27.61 .0043 28.73 .0038 29.81 .0084 30.91 .0040 32.03 .0025 33.14 .0005
				 34.26 .0003 35.38 .0019 36.56 .0037 37.68 .0049 38.86 .0036 40.11 .0011 41.28 .0008 42.50 .0004
				 43.60 .0002 44.74 .0022 45.99 .0050 47.20 .0009 48.40 .0036 49.68 .0004 50.92 .0009 52.17 .0005
				 53.46 .0007 54.76 .0006 56.06 .0005 57.34 .0011 58.67 .0005 59.95 .0015 61.37 .0008 62.72 .0004
				 65.42 .0009 66.96 .0003 68.18 .0003 69.78 .0003 71.21 .0004 72.45 .0002 74.22 .0003 75.44 .0001
				 76.53 .0003 78.31 .0004 79.83 .0003 80.16 .0001 81.33 .0003 82.44 .0001 83.17 .0002 84.81 .0003
				 85.97 .0003 89.08 .0001 90.70 .0002 92.30 .0002 95.59 .0002 97.22 .0003 98.86 .0001 108.37 .0001
				 125.54 .0001)
			   
			   (1.99 .0650  3.03 .0040  4.03 .0059  5.02 .0090  5.97 .0227  6.98 .0050  8.04 .0020
				 9.00 .0082  9.96 .0078 11.01 .0056 12.01 .0095 13.02 .0050 14.04 .0093 15.08 .0064 16.14 .0017
				 17.06 .0020 18.10 .0025 19.14 .0023 20.18 .0015 21.24 .0032 22.29 .0029 23.32 .0014 24.37 .0005
				 25.43 .0030 26.50 .0022 27.60 .0027 28.64 .0024 29.76 .0035 30.81 .0136 31.96 .0025 33.02 .0003
				 34.13 .0005 35.25 .0007 36.40 .0014 37.51 .0020 38.64 .0012 39.80 .0019 40.97 .0004 42.09 .0003
				 43.24 .0003 44.48 .0002 45.65 .0024 46.86 .0005 48.07 .0013 49.27 .0008 50.49 .0006 52.95 .0001
				 54.23 .0005 55.45 .0004 56.73 .0001 58.03 .0003 59.29 .0002 60.59 .0003 62.04 .0002 65.89 .0002
				 67.23 .0002 68.61 .0002 69.97 .0004 71.36 .0005 85.42 .0001)
			   
			   (1.98 .0256  2.96 .0158  3.95 .0310  4.94 .0411  5.95 .0238  6.94 .0152  7.93 .0011
				 8.95 .0185  9.92 .0166 10.93 .0306 11.94 .0258 12.96 .0202 13.97 .0403 14.95 .0228 15.93 .0005
				 17.01 .0072 18.02 .0034 19.06 .0028 20.08 .0124 21.13 .0137 22.16 .0102 23.19 .0058 23.90 .0013
				 25.30 .0039 26.36 .0039 27.41 .0025 28.47 .0071 29.64 .0031 30.60 .0027 31.71 .0021 32.84 .0003
				 33.82 .0002 35.07 .0019 36.09 .0054 37.20 .0038 38.33 .0024 39.47 .0055 40.55 .0016 41.77 .0006
				 42.95 .0002 43.27 .0018 44.03 .0006 45.25 .0019 46.36 .0033 47.50 .0024 48.87 .0012 50.03 .0016
				 51.09 .0004 53.52 .0017 54.74 .0012 56.17 .0003 57.40 .0011 58.42 .0020 59.70 .0007 61.29 .0008
				 62.56 .0003 63.48 .0002 64.83 .0002 66.12 .0012 67.46 .0017 68.81 .0003 69.13 .0003 70.53 .0002
				 71.84 .0001 73.28 .0002 75.52 .0010 76.96 .0005 77.93 .0003 78.32 .0003 79.73 .0003 81.69 .0002
				 82.52 .0001 84.01 .0001 84.61 .0002 86.88 .0001 88.36 .0002 89.85 .0002 91.35 .0003 92.86 .0002
				 93.40 .0001 105.28 .0002 106.22 .0002 107.45 .0001 108.70 .0003 122.08 .0002)
			   
			   (1.97 .0264  2.97 .0211  3.98 .0234  4.98 .0307  5.96 .0085  6.94 .0140  7.93 .0005
				 8.96 .0112  9.96 .0209 10.98 .0194 11.98 .0154 12.99 .0274 13.99 .0127 15.01 .0101 15.99 .0002
				 17.04 .0011 18.08 .0032 19.14 .0028 20.12 .0054 21.20 .0053 22.13 .0028 23.22 .0030 24.32 .0006
				 25.24 .0004 26.43 .0028 27.53 .0048 28.52 .0039 29.54 .0047 30.73 .0044 31.82 .0007 32.94 .0008
				 34.04 .0012 35.13 .0018 36.29 .0007 37.35 .0075 38.51 .0045 39.66 .0014 40.90 .0004 41.90 .0002
				 43.08 .0002 44.24 .0017 45.36 .0013 46.68 .0020 47.79 .0015 48.98 .0010 50.21 .0012 51.34 .0001
				 53.82 .0003 55.09 .0004 56.23 .0005 57.53 .0004 58.79 .0005 59.30 .0002 60.03 .0002 61.40 .0003
				 62.84 .0001 66.64 .0001 67.97 .0001 69.33 .0001 70.68 .0001 73.57 .0002 75.76 .0002 76.45 .0001
				 79.27 .0001 80.44 .0002 81.87 .0002)
			   
			   (2.00 .0311  2.99 .0086  3.99 .0266  4.97 .0123  5.98 .0235  6.97 .0161  7.97 .0008
				 8.96 .0088  9.96 .0621 10.99 .0080 11.99 .0034 12.99 .0300 14.03 .0228 15.04 .0105 16.03 .0004
				 17.06 .0036 18.09 .0094 18.95 .0009 20.17 .0071 21.21 .0161 22.25 .0106 23.28 .0104 24.33 .0008
				 25.38 .0030 26.46 .0035 27.50 .0026 28.59 .0028 29.66 .0128 30.75 .0139 31.81 .0038 32.93 .0006
				 34.04 .0004 35.16 .0005 36.25 .0023 37.35 .0012 38.46 .0021 39.59 .0035 40.71 .0006 41.86 .0007
				 42.42 .0001 43.46 .0003 44.17 .0032 45.29 .0013 46.57 .0004 47.72 .0011 48.79 .0005 50.11 .0005
				 51.29 .0003 52.47 .0002 53.68 .0004 55.02 .0005 56.18 .0003 57.41 .0003 58.75 .0007 59.33 .0009
				 60.00 .0004 61.34 .0001 64.97 .0003 65.20 .0002 66.48 .0002 67.83 .0002 68.90 .0003 70.25 .0003
				 71.59 .0002 73.68 .0001 75.92 .0001 77.08 .0002 78.45 .0002 81.56 .0002 82.99 .0001 88.39 .0001)
			   
			   ( .97 .0059  1.98 .0212  2.99 .0153  3.99 .0227  4.96 .0215  5.97 .0153  6.98 .0085
				 7.98 .0007  8.97 .0179  9.98 .0512 10.98 .0322 12.00 .0098 13.02 .0186 14.00 .0099 15.05 .0109
				 15.88 .0011 17.07 .0076 18.11 .0071 19.12 .0045 20.16 .0038 21.23 .0213 22.27 .0332 23.34 .0082
				 24.34 .0014 25.42 .0024 26.47 .0012 27.54 .0014 28.60 .0024 29.72 .0026 30.10 .0008 31.91 .0021
				 32.13 .0011 33.02 .0007 34.09 .0014 35.17 .0007 36.27 .0024 37.39 .0029 38.58 .0014 39.65 .0017
				 40.95 .0012 41.97 .0004 42.43 .0002 43.49 .0001 44.31 .0012 45.42 .0031 46.62 .0017 47.82 .0013
				 49.14 .0013 50.18 .0010 51.54 .0003 53.90 .0006 55.06 .0010 56.31 .0003 57.63 .0001 59.02 .0003
				 60.09 .0004 60.35 .0004 61.62 .0009 63.97 .0001 65.19 .0001 65.54 .0002 66.92 .0002 67.94 .0002
				 69.17 .0003 69.60 .0004 70.88 .0002 72.24 .0002 76.12 .0001 78.94 .0001 81.75 .0001 82.06 .0001
				 83.53 .0001 90.29 .0002 91.75 .0001 92.09 .0002 93.28 .0001 97.07 .0001)
			   
			   (1.98 .0159  2.98 .1008  3.98 .0365  4.98 .0133  5.97 .0101  6.97 .0115  7.97 .0007
				 8.99 .0349 10.01 .0342 11.01 .0236 12.00 .0041 13.02 .0114 14.05 .0137 15.06 .0100 16.05 .0007
				 17.04 .0009 18.12 .0077 19.15 .0023 20.12 .0017 21.24 .0113 22.26 .0126 23.30 .0093 24.36 .0007
				 25.43 .0007 26.47 .0009 27.55 .0013 28.59 .0025 29.61 .0010 30.77 .0021 31.86 .0023 32.96 .0003
				 34.03 .0007 35.06 .0005 36.20 .0006 37.34 .0006 38.36 .0009 39.60 .0016 40.69 .0005 41.77 .0002
				 42.92 .0002 44.02 .0003 45.24 .0006 46.33 .0004 47.50 .0007 48.71 .0007 49.87 .0002 51.27 .0002
				 53.42 .0003 55.88 .0003 57.10 .0004 58.34 .0002 59.86 .0003 61.13 .0003 67.18 .0001 68.50 .0001
				 71.17 .0001 83.91 .0001 90.55 .0001)
			   
			   ( .98 .0099  2.00 .0181  2.99 .0353  3.98 .0285  4.97 .0514  5.96 .0402  6.96 .0015
				 7.98 .0012  8.98 .0175  9.98 .0264 10.98 .0392 11.98 .0236 13.00 .0153 14.04 .0049 15.00 .0089
				 16.01 .0001 17.03 .0106 18.03 .0028 19.05 .0024 20.08 .0040 21.11 .0103 22.12 .0104 23.20 .0017
				 24.19 .0008 25.20 .0007 26.24 .0011 27.36 .0009 27.97 .0030 29.40 .0044 30.37 .0019 31.59 .0017
				 32.65 .0008 33.59 .0005 34.79 .0009 35.75 .0027 36.88 .0035 37.93 .0039 39.00 .0031 40.08 .0025
				 41.16 .0010 43.25 .0004 44.52 .0012 45.62 .0023 45.85 .0012 47.00 .0006 47.87 .0008 48.99 .0003
				 50.48 .0003 51.62 .0001 52.43 .0001 53.56 .0002 54.76 .0002 56.04 .0002 56.68 .0006 57.10 .0003
				 58.28 .0005 59.47 .0003 59.96 .0002 60.67 .0001 63.08 .0002 64.29 .0002 66.72 .0001 67.97 .0001
				 68.65 .0001 70.43 .0001 79.38 .0001 80.39 .0001 82.39 .0001)
			   
			   (1.00 .0765  1.99 .0151  2.99 .0500  3.99 .0197  5.00 .0260  6.00 .0145  6.98 .0128
				 7.97 .0004  8.98 .0158  9.99 .0265 11.02 .0290 12.02 .0053 13.03 .0242 14.03 .0103 15.06 .0054
				 16.04 .0006 17.08 .0008 18.10 .0058 19.16 .0011 20.16 .0055 21.18 .0040 22.20 .0019 23.22 .0014
				 24.05 .0005 25.31 .0019 26.38 .0018 27.44 .0022 28.45 .0024 29.57 .0073 30.58 .0032 31.66 .0071
				 32.73 .0015 33.85 .0005 34.96 .0003 36.00 .0020 37.11 .0018 38.18 .0055 39.23 .0006 40.33 .0004
				 41.52 .0003 43.41 .0028 45.05 .0003 45.99 .0002 47.07 .0003 48.52 .0002 49.48 .0003 50.63 .0003
				 51.81 .0002 54.05 .0002 55.24 .0001 56.62 .0001 57.81 .0004 59.16 .0013 60.23 .0003 66.44 .0001
				 68.99 .0004 75.49 .0001 87.56 .0004)
			   
			   ( .98 .0629  1.99 .0232  2.98 .0217  4.00 .0396  4.98 .0171  5.97 .0098  6.99 .0167
				 7.99 .0003  8.98 .0192  9.98 .0266 10.99 .0256 12.01 .0061 13.02 .0135 14.02 .0062 15.05 .0158
				 16.06 .0018 17.08 .0101 18.09 .0053 19.11 .0074 20.13 .0020 21.17 .0052 22.22 .0077 23.24 .0035
				 24.00 .0009 25.32 .0016 26.40 .0022 27.43 .0005 28.55 .0026 29.60 .0026 30.65 .0010 31.67 .0019
				 32.77 .0008 33.81 .0003 34.91 .0003 36.01 .0005 37.11 .0010 38.20 .0014 39.29 .0039 40.43 .0012
				 41.50 .0006 43.38 .0017 43.75 .0002 44.94 .0005 46.13 .0002 47.11 .0003 48.28 .0005 48.42 .0005
				 49.44 .0003 50.76 .0004 51.93 .0002 54.15 .0003 55.31 .0005 55.50 .0003 56.98 .0003 57.90 .0004
				 60.33 .0002 61.39 .0001 61.59 .0001 65.09 .0002 66.34 .0001 68.85 .0001 70.42 .0002 71.72 .0001
				 73.05 .0003 79.65 .0001 85.28 .0002 93.52 .0001)
			   
			   (1.02 .0185  1.99 .0525  2.98 .0613  3.99 .0415  4.98 .0109  5.97 .0248  6.99 .0102
				 7.98 .0005  8.98 .0124  9.99 .0103 10.99 .0124 12.00 .0016 13.01 .0029 14.03 .0211 15.04 .0128
				 16.07 .0021 17.09 .0009 18.09 .0043 19.14 .0022 20.13 .0016 21.20 .0045 22.21 .0088 23.26 .0046
				 24.29 .0013 25.35 .0009 26.39 .0028 27.49 .0009 28.51 .0006 29.58 .0012 30.70 .0010 31.74 .0019
				 32.75 .0002 33.85 .0001 34.95 .0005 36.02 .0003 37.16 .0009 38.25 .0018 39.35 .0008 40.54 .0004
				 41.61 .0002 43.40 .0004 43.74 .0003 45.05 .0001 46.11 .0003 47.40 .0002 48.36 .0004 49.55 .0004
				 50.72 .0002 52.00 .0001 55.58 .0002 57.02 .0001 57.98 .0002 59.13 .0003 61.56 .0001 66.56 .0001
				 87.65 .0002)
			   
			   (1.00 .0473  1.99 .0506  2.99 .0982  3.99 .0654  5.00 .0196  5.99 .0094  6.99 .0118
				 7.93 .0001  8.99 .0057 10.01 .0285 11.01 .0142 12.03 .0032 13.03 .0056 14.06 .0064 15.06 .0059
				 16.11 .0005 17.09 .0033 18.14 .0027 19.15 .0014 20.17 .0010 21.21 .0059 22.26 .0043 23.31 .0031
				 24.31 .0018 25.33 .0009 26.41 .0005 27.47 .0015 28.53 .0015 29.58 .0041 30.65 .0025 31.73 .0011
				 32.83 .0010 34.98 .0003 36.07 .0009 37.23 .0001 38.26 .0020 39.41 .0014 40.53 .0005 41.40 .0003
				 42.80 .0002 43.48 .0028 43.93 .0001 45.03 .0003 46.18 .0007 47.41 .0001 48.57 .0002 49.67 .0001
				 50.83 .0002 54.39 .0001 55.58 .0002 57.97 .0005 58.11 .0002 59.21 .0001 60.42 .0002 61.66 .0001)
			   
			   (1.00 .0503  2.00 .0963  2.99 .1304  3.99 .0218  4.98 .0041  5.98 .0292  6.98 .0482
				 7.99 .0005  8.99 .0280 10.00 .0237 11.00 .0152 12.02 .0036 12.95 .0022 14.06 .0111 15.07 .0196
				 16.08 .0016 17.11 .0044 18.13 .0073 19.17 .0055 20.19 .0028 21.20 .0012 22.27 .0068 23.30 .0036
				 24.35 .0012 25.35 .0002 26.46 .0005 27.47 .0005 28.59 .0009 29.65 .0021 30.70 .0020 31.78 .0012
				 32.89 .0010 35.06 .0005 36.16 .0008 37.27 .0010 38.36 .0010 39.47 .0014 40.58 .0004 41.43 .0007
				 41.82 .0003 43.48 .0008 44.53 .0001 45.25 .0003 46.43 .0002 47.46 .0002 48.76 .0005 49.95 .0004
				 50.96 .0002 51.12 .0002 52.33 .0001 54.75 .0001 55.75 .0002 56.90 .0002 58.17 .0002 59.40 .0004
				 60.62 .0002 65.65 .0001 66.91 .0002 69.91 .0001 71.25 .0002)
			   
			   (1.00 .1243  1.98 .1611  3.00 .0698  3.98 .0390  5.00 .0138  5.99 .0154  7.01 .0287
				 8.01 .0014  9.01 .0049 10.00 .0144 11.01 .0055 12.05 .0052 13.01 .0011 14.05 .0118 15.07 .0154
				 16.12 .0028 17.14 .0061 18.25 .0007 19.22 .0020 20.24 .0011 21.27 .0029 22.30 .0046 23.34 .0049
				 24.35 .0004 25.45 .0003 26.47 .0007 27.59 .0008 28.16 .0009 29.12 .0002 29.81 .0006 30.81 .0009
				 31.95 .0004 33.00 .0011 34.12 .0005 35.18 .0003 36.30 .0008 37.38 .0003 38.55 .0003 39.64 .0006
				 40.77 .0007 41.52 .0006 41.89 .0006 43.04 .0011 43.60 .0009 44.31 .0002 45.68 .0002 46.56 .0003
				 47.60 .0001 48.83 .0006 50.01 .0003 51.27 .0003 56.04 .0005 57.21 .0003 58.56 .0004 59.83 .0003
				 61.05 .0001 62.20 .0001 67.37 .0002 76.53 .0001)
			   
			   ( .99 .0222  1.99 .0678  2.99 .0683  4.00 .0191  5.00 .0119  6.01 .0232  6.98 .0336
				 7.99 .0082  9.01 .0201 10.01 .0189 11.01 .0041 12.01 .0053 13.05 .0154 14.04 .0159 15.06 .0092
				 16.11 .0038 17.12 .0014 18.15 .0091 19.16 .0006 20.30 .0012 21.25 .0061 22.28 .0099 23.34 .0028
				 24.38 .0012 25.43 .0016 26.49 .0048 27.55 .0025 28.62 .0015 29.71 .0032 30.78 .0077 31.88 .0011
				 32.97 .0007 34.08 .0006 35.16 .0008 36.28 .0004 37.41 .0006 38.54 .0005 39.62 .0002 40.80 .0003
				 41.93 .0001 43.06 .0002 44.21 .0003 45.38 .0002 46.54 .0007 47.78 .0003 48.95 .0004 50.10 .0003
				 51.37 .0002 53.79 .0003 56.20 .0001 58.71 .0002 66.47 .0003)
			   
			   (1.01 .0241  1.99 .1011  2.98 .0938  3.98 .0081  4.99 .0062  5.99 .0291  6.99 .0676
				 7.59 .0004  8.98 .0127  9.99 .0112 10.99 .0142 12.00 .0029 13.02 .0071 14.02 .0184 15.03 .0064
				 16.07 .0010 17.09 .0011 18.11 .0010 19.15 .0060 20.19 .0019 21.24 .0025 22.29 .0013 23.31 .0050
				 25.41 .0030 26.50 .0018 27.53 .0006 28.63 .0012 29.66 .0013 30.77 .0020 31.84 .0006 34.04 .0001
				 35.14 .0001 36.32 .0004 37.41 .0007 38.53 .0007 39.67 .0009 40.85 .0003 45.49 .0002 46.65 .0001
				 47.81 .0004 49.01 .0002 53.91 .0002 55.14 .0002 57.69 .0002)
			   
			   (1.00 .0326  2.00 .1066  2.99 .1015  4.00 .0210  4.97 .0170  5.99 .0813  6.98 .0820
				 7.96 .0011  8.99 .0248 10.03 .0107 11.01 .0126 12.01 .0027 13.01 .0233 14.04 .0151 15.05 .0071
				 16.04 .0002 17.10 .0061 18.12 .0059 19.15 .0087 20.23 .0005 21.25 .0040 22.30 .0032 23.35 .0004
				 24.40 .0001 25.45 .0030 26.54 .0022 27.60 .0003 28.70 .0009 29.80 .0029 30.85 .0006 31.97 .0006
				 34.19 .0004 35.30 .0003 36.43 .0007 37.56 .0005 38.68 .0019 39.88 .0013 41.00 .0003 43.35 .0003
				 44.51 .0002 45.68 .0006 46.93 .0010 48.11 .0006 49.29 .0003 55.58 .0002)
			   
			   ( .98 .0113  1.99 .0967