1;;; from VOIDAT.SAI[220,JDC] and GLSVOI.SAI[220,JDC], then (30 years later) jcvoi.ins
2
3(provide 'snd-jcvoi.scm)
4(require snd-env.scm)
5
6(define fnc #f)  ;; fnc[sex,vowel,formant number,formant freq,amp or fm index]
7(define vibfreqfun #f)
8(define i3fun1 #f)
9(define i3fun2 #f)
10
11(define (flipxy data)			; SEG functions expected data in (y x) pairs.
12  (let ((unseg ())
13	(len (length data)))
14    (do ((i 0 (+ i 2)))
15	((>= i len)
16	 (reverse unseg))
17      (let ((x (data (+ 1 i)))
18	    (y (data i)))
19	(set! unseg (cons y (cons x unseg)))))))
20
21(define (addenv env1 sc1 off1 env2 sc2 off2)
22  (add-envelopes (scale-envelope env1 sc1 off1)
23		 (scale-envelope env2 sc2 off2)))
24
25(define (checkpt att dur)
26  (if (not (positive? att))
27      (* 100 (/ .01 dur))
28      (if (< att dur)
29	  (* 100 (/ att dur))
30	  100)))
31
32(define (setf-aref vect a b c d val)
33  (set! (vect (+ a (* 3 b) (* 18 c) (* 72 d))) val))
34
35(define (aref vect a b c d)
36  (vect (+ a (* 3 b) (* 18 c) (* 72 d))))
37
38(define (fillfnc)
39  (unless fnc
40    (set! fnc (make-vector 288 ())) ; 288 = (* 3 6 4 4)
41    (set! vibfreqfun (make-vector 3 ()))
42    (set! i3fun1 (make-vector 3 ()))
43    (set! i3fun2 (make-vector 3 ()))
44
45    (setf-aref fnc 1 1 1 1 (flipxy '(350  130.8 524  261.6 392  392 523 523.2 784 784 1046 1064 1568 1568)))
46    (setf-aref fnc 1 1 1 2 (flipxy '(.3   130.8   .8 261.6   .9 392  .9 523.2  .7 784   .86 1064 .86  1568)))
47    (setf-aref fnc 1 1 1 3 (flipxy '(1.4  130.8  1.4 261.6  1.0 392  .8 523.2  .5 784   .3 1064 .2 1568)))
48    (setf-aref fnc 1 1 2 1 (flipxy '(1100 130.8 1100 261.6 1100 392 1200 523.2 1500 784 1800 1064 2200 1568)))
49    (setf-aref fnc 1 1 2 2 (flipxy '(.1   130.8   .2 261.6   .3 392   .3 523.2   .1 784  .05 1064 .05  1568)))
50    (setf-aref fnc 1 1 2 3 (flipxy '(1.0  130.8  1.0 261.6   .4 392   .4 523.2   .2 784   .2 1064 .1 1568)))
51    (setf-aref fnc 1 1 3 1 (flipxy '(3450 130.8 3400 261.6 3400 392 3600 523.2 4500 784 5000 1064 5800 1568)))
52    (setf-aref fnc 1 1 3 2 (flipxy '(.04  130.8  .04 261.6  .04 392 .045 523.2  .03 784  .02 1064 .02  1568)))
53    (setf-aref fnc 1 1 3 3 (flipxy '(3.5  130.8  2.0 261.6  1.5 392  1.2 523.2   .8 784   .8 1064 1.0  1568)))
54    (setf-aref fnc 1 2 1 1 (flipxy '(175  130.8 262  261.6 392  392 523 523.2 784 784 1046 1064 1568 1568)))
55    (setf-aref fnc 1 2 1 2 (flipxy '(.25  130.8   .6 261.6   .6 392  .6 523.2  .7 784   .86 1064 .86  1568)))
56    (setf-aref fnc 1 2 1 3 (flipxy '(0.5  130.8  0.3 261.6  0.1 392 .05 523.2 .04 784  .03 1064 .02 1568)))
57    (setf-aref fnc 1 2 2 1 (flipxy '(2900 130.8 2700 261.6 2600 392 2400 523.2 2300 784 2200 1064 2100 1568)))
58    (setf-aref fnc 1 2 2 2 (flipxy '(.01  130.8  .05 261.6  .08 392   .1 523.2   .1 784  .1  1064 .05  1568)))
59    (setf-aref fnc 1 2 2 3 (flipxy '(1.5  130.8  1.0 261.6  1.0 392  1.0 523.2  1.0 784  1.0 1064 .5 1568)))
60    (setf-aref fnc 1 2 3 1 (flipxy '(4200 130.8 3900 261.6 3900 392 3900 523.2 3800 784 3700 1064 3600 1568)))
61    (setf-aref fnc 1 2 3 2 (flipxy '(.01  130.8  .04 261.6  .03 392 .03  523.2  .03 784  .03 1064 .02  1568)))
62    (setf-aref fnc 1 2 3 3 (flipxy '(1.2  130.8   .8 261.6   .8 392   .8 523.2   .8 784   .8 1064 .5  1568)))
63    (setf-aref fnc 1 3 1 1 (flipxy '(175  130.8 262  261.6 392  392 523 523.2 784 784 1046 1064 1568 1568)))
64    (setf-aref fnc 1 3 1 2 (flipxy '(.3   130.8   .7 261.6   .8 392  .6 523.2  .7 784   .86 1064 .86  1568)))
65    (setf-aref fnc 1 3 1 3 (flipxy '(0.4  130.8  0.2 261.6  0.4 392 .4  523.2 .7  784  .5  1064 .2  1568)))
66    (setf-aref fnc 1 3 2 1 (flipxy '(1000 130.8 1000 261.6 1100 392 1200 523.2 1400 784 1800 1064 2200 1568)))
67    (setf-aref fnc 1 3 2 2 (flipxy '(.055 130.8  .1  261.6  .15 392  .13 523.2   .1 784  .1  1064 .05  1568)))
68    (setf-aref fnc 1 3 2 3 (flipxy '(0.3  130.8  0.4 261.6  0.4 392  0.4 523.2  0.3 784  0.2 1064 0.1  1568)))
69    (setf-aref fnc 1 3 3 1 (flipxy '(2600 130.8 2600 261.6 3000 392 3400 523.2 4500 784 5000 1064 5800 1568)))
70    (setf-aref fnc 1 3 3 2 (flipxy '(.005 130.8  .03 261.6  .04 392  .04 523.2  .02 784  .02 1064 .02  1568)))
71    (setf-aref fnc 1 3 3 3 (flipxy '(1.1  130.8  1.0 261.6  1.2 392 1.2  523.2  0.8 784  0.8 1064 1.0  1568)))
72    (setf-aref fnc 1 4 1 1 (flipxy '(353  130.8 530  261.6 530  392 523 523.2 784 784 1046 1064 1568 1568)))
73    (setf-aref fnc 1 4 1 2 (flipxy '(.5   130.8   .8 261.6   .8 392  .6 523.2  .7 784   .86 1064 .86  1568)))
74    (setf-aref fnc 1 4 1 3 (flipxy '(0.6  130.8  0.7 261.6  1.0 392 0.8 523.2  .7 784  .5  1064 .2  1568)))
75    (setf-aref fnc 1 4 2 1 (flipxy '(1040 130.8 1040 261.6 1040 392 1200 523.2 1400 784 1800 1064 2200 1568)))
76    (setf-aref fnc 1 4 2 2 (flipxy '(.050 130.8  .05 261.6  .1  392  .2  523.2   .1 784  .1  1064 .05  1568)))
77    (setf-aref fnc 1 4 2 3 (flipxy '(0.1  130.8  0.1 261.6  0.1 392  0.4 523.2  0.3 784  0.2 1064 0.1  1568)))
78    (setf-aref fnc 1 4 3 1 (flipxy '(2695 130.8 2695 261.6 2695 392 3400 523.2 4500 784 5000 1064 5800 1568)))
79    (setf-aref fnc 1 4 3 2 (flipxy '( .05 130.8  .05 261.6  .04 392  .04 523.2  .02 784  .02 1064 .02  1568)))
80    (setf-aref fnc 1 4 3 3 (flipxy '(1.2  130.8  1.2 261.6  1.2 392 1.2  523.2  0.8 784  0.8 1064 1.0  1568)))
81    (setf-aref fnc 1 5 1 1 (flipxy '(175  130.8 262  261.6 392  392 523 523.2 784 784 1046 1064 1568 1568)))
82    (setf-aref fnc 1 5 1 2 (flipxy '(.4   130.8   .4 261.6   .8 392  .8 523.2  .8 784   .8 1064 .8   1568)))
83    (setf-aref fnc 1 5 1 3 (flipxy '(0.1  130.8  0.1 261.6  0.1 392 0.1 523.2  .0 784  .0  1064 .0  1568)))
84    (setf-aref fnc 1 5 2 1 (flipxy '( 350 130.8  524 261.6  784 392  950 523.2 1568 784 2092 1064 3136 1568)))
85    (setf-aref fnc 1 5 2 2 (flipxy '(.8   130.8  .8  261.6  .4  392  .2  523.2   .1 784  .1  1064 .0   1568)))
86    (setf-aref fnc 1 5 2 3 (flipxy '(0.5  130.8  0.1 261.6  0.1 392  0.1 523.2  0.0 784  0.0 1064 0.0  1568)))
87    (setf-aref fnc 1 5 3 1 (flipxy '(2700 130.8 2700 261.6 2500 392 2450 523.2 2400 784 2350 1064 4500 1568)))
88    (setf-aref fnc 1 5 3 2 (flipxy '( .1  130.8  .15 261.6  .15 392  .15 523.2  .15 784  .1  1064 .1   1568)))
89    (setf-aref fnc 1 5 3 3 (flipxy '(2.0  130.8  1.6 261.6  1.6 392 1.6  523.2  1.6 784  1.6 1064 1.0  1568)))
90    (setf-aref fnc 2 1 1 1 (flipxy '( 33   16.5  33   24.5  33 32.7  49  49.0  65 65.41    98   98 131 130.8)))
91    (setf-aref fnc 2 1 1 2 (flipxy '( .3   16.5  .5   24.5  .6 32.7  .5  49.0  .47 65.41   .135 98 .2  130.8)))
92    (setf-aref fnc 2 1 1 3 (flipxy '(2.4   16.5  2.0  24.5 1.8 32.7 1.6  49.0  1.5 65.41    1.2 98 .8  130.8)))
93    (setf-aref fnc 2 1 2 1 (flipxy '(400   16.5  400  24.5 400 32.7  400 49.0 400 65.41    400  98 400 130.8)))
94    (setf-aref fnc 2 1 2 2 (flipxy '( .2   16.5  .2   24.5 .35 32.7  .37 49.0  .4  65.41   .6   98 .8  130.8)))
95    (setf-aref fnc 2 1 2 3 (flipxy '(6.0   16.5  5.0  24.5 4.0 32.7 3.0  49.0  2.7 65.41    2.2 98 1.8  130.8)))
96    (setf-aref fnc 2 1 3 1 (flipxy '(2142  16.5  2142 24.5 2142 32.7 2142 49.0 2142 65.41 2142 98 2142 130.8)))
97    (setf-aref fnc 2 1 3 2 (flipxy '(.02   16.5  .025 24.5 .05  32.7  .09 49.0  .13 65.41  .29 98 .4  130.8)))
98    (setf-aref fnc 2 1 3 3 (flipxy '(9.0   16.5  8.0  24.5 7.2  32.7 5.5  49.0  3.9 65.41   3.0 98 1.8  130.8)))
99    (setf-aref fnc 2 2 1 1 (flipxy '( 33   16.5  33   24.5  33 32.7  49  49.0  65  65.41    98  98 131 130.8)))
100    (setf-aref fnc 2 2 1 2 (flipxy '( .75  16.5  .83  24.5 .91 32.7 .91  49.0  .91 65.41   .79  98 .67 130.8)))
101    (setf-aref fnc 2 2 1 3 (flipxy '(2.5   16.5  2.5  24.5 2.5 32.7 2.1  49.0  1.8 65.41    1.4 98 1.0  130.8)))
102    (setf-aref fnc 2 2 2 1 (flipxy '(1500  16.5 1500 24.5 1500 32.7 1500 49.0 1500 65.41   1500 98 1500 130.8)))
103    (setf-aref fnc 2 2 2 2 (flipxy '( .01  16.5  .02  24.5 .02 32.7  .02 49.0  .02 65.41   .08  98 .08 130.8)))
104    (setf-aref fnc 2 2 2 3 (flipxy '(1.5   16.5  1.37 24.5 1.25 32.7 1.07 49.0 0.9 65.41    0.7 98 0.5  130.8)))
105    (setf-aref fnc 2 2 3 1 (flipxy '(2300  16.5  2300 24.5 2300 32.7 2325 49.0 2350 65.41 2375 98 2400 130.8)))
106    (setf-aref fnc 2 2 3 2 (flipxy '(.05   16.5  .065 24.5 .70  32.7  .07 49.0  .07 65.41  .16 98 .2  130.8)))
107    (setf-aref fnc 2 2 3 3 (flipxy '(11.0  16.5  10.0 24.5 10.0 32.7 7.7  49.0  5.4 65.41   3.7 98 2.0  130.8)))
108    (setf-aref fnc 2 3 1 1 (flipxy '( 33   16.5  33   24.5  33 32.7  49  49.0  65  65.41    98  98 131 130.8)))
109    (setf-aref fnc 2 3 1 2 (flipxy '( .75  16.5  .83  24.5 .87 32.7 .88  49.0  .90 65.41   .87  98 .85 130.8)))
110    (setf-aref fnc 2 3 1 3 (flipxy '(1.4   16.5  1.4  24.5 1.4 32.7 1.4  49.0  1.4 65.41    1.4 98 1.4  130.8)))
111    (setf-aref fnc 2 3 2 1 (flipxy '( 450  16.5  450 24.5  450 32.7  450 49.0  450 65.41    450 98 450 130.8)))
112    (setf-aref fnc 2 3 2 2 (flipxy '( .01  16.5  .02  24.5 .08 32.7 .065 49.0  .05 65.41   .05  98 .05 130.8)))
113    (setf-aref fnc 2 3 2 3 (flipxy '(3.0   16.5  2.6  24.5 2.1  32.7 1.75 49.0 1.4 65.41   1.05 98 0.7  130.8)))
114    (setf-aref fnc 2 3 3 1 (flipxy '(2100  16.5  2100 24.5 2100 32.7 2125 49.0 2150 65.41 2175 98 2100 130.8)))
115    (setf-aref fnc 2 3 3 2 (flipxy '(.05   16.5  .05  24.5 .05  32.7  .05 49.0  .05 65.41 .075 98 .1  130.8)))
116    (setf-aref fnc 2 3 3 3 (flipxy '( 9.0  16.5   8.0 24.5  7.0 32.7 4.5  49.0  2.1 65.41  1.75 98 1.4  130.8)))
117    (setf-aref fnc 2 4 1 1 (flipxy '( 33   16.5  33   24.5  33 32.7  49  49.0  65  65.41    98  98 131 130.8)))
118    (setf-aref fnc 2 4 1 2 (flipxy '( .35  16.5  .40  24.5 .43 32.7 .47  49.0  .50 65.41   .57  98 .45 130.8)))
119    (setf-aref fnc 2 4 1 3 (flipxy '(1.4   16.5  1.4  24.5 1.0 32.7 1.0  49.0  1.0 65.41    1.1 98 1.0  130.8)))
120    (setf-aref fnc 2 4 2 1 (flipxy '( 300  16.5  300 24.5  300 32.7  300 49.0  300 65.41    300 98 300 130.8)))
121    (setf-aref fnc 2 4 2 2 (flipxy '( .75  16.5  .80  24.5 .85 32.7 .90  49.0  .95 65.41   .99  98 .99 130.8)))
122    (setf-aref fnc 2 4 2 3 (flipxy '(3.0   16.5  2.5  24.5 2.0  32.7 1.9  49.0 1.8 65.41   1.65 98 0.25 130.8)))
123    (setf-aref fnc 2 4 3 1 (flipxy '(2200  16.5  2200 24.5 2200 32.7 2225 49.0 2250 65.41 2275 98 2300 130.8)))
124    (setf-aref fnc 2 4 3 2 (flipxy '(.02   16.5  .02  24.5 .02  32.7 .035 49.0  .05 65.41 .07  98 .05  130.8)))
125    (setf-aref fnc 2 4 3 3 (flipxy '( 5.0  16.5   4.0 24.5  3.0 32.7 2.8  49.0  2.6 65.41  1.9  98 1.2  130.8)))
126
127    ;;   (sef-(aref fnc 2 5 1 1 (flipxy '(175   16.5  262  24.5 392 32.7  523 49.0  784 65.41  1046  98 1568 130.8)))
128    (setf-aref fnc 2 5 1 1 (flipxy '( 33   16.5  33   24.5  33 32.7  49 49.0  65  65.41    98  98 131 130.8)))
129
130    (setf-aref fnc 2 5 1 2 (flipxy '( .40  16.5  .40  24.5 .80 32.7 .80  49.0  .80 65.41   .80  98 .80 130.8)))
131    (setf-aref fnc 2 5 1 3 (flipxy '(0.1   16.5  0.1  24.5 0.1 32.7 0.1  49.0  0.0 65.41    0.0 98 0.0  130.8)))
132    (setf-aref fnc 2 5 2 1 (flipxy '( 350  16.5  524 24.5  784 32.7  950 49.0 1568 65.41   2092 98 3136 130.8)))
133    (setf-aref fnc 2 5 2 2 (flipxy '( .80  16.5  .80  24.5 .40 32.7 .20  49.0  .10 65.41   .10  98 .00 130.8)))
134    (setf-aref fnc 2 5 2 3 (flipxy '(0.5   16.5  0.1  24.5 0.1  32.7 0.1  49.0 0.0 65.41   0.0  98 0.0  130.8)))
135    (setf-aref fnc 2 5 3 1 (flipxy '(2700  16.5  2700 24.5 2500 32.7 2450 49.0 2400 65.41 2350 98 4500 130.8)))
136    (setf-aref fnc 2 5 3 2 (flipxy '(.10   16.5  .15  24.5 .15  32.7 .15  49.0  .15 65.41 .10  98 .10  130.8)))
137    (setf-aref fnc 2 5 3 3 (flipxy '( 2.0  16.5   1.6 24.5  1.6 32.7 1.6  49.0  1.6 65.41  1.5  98 1.0  130.8)))
138
139    ;; these are vibrato frequencies functions (pitch dependent);
140
141    (set! (vibfreqfun 1) (flipxy '(4.5 138.8 5 1568)))
142    (set! (vibfreqfun 2) (flipxy '(4.5  16.5 5 130.8)))
143
144    ;; these are index functions for cascade modulater (pitch dependent);
145
146    (set! (i3fun1 1) (flipxy '(4 138.8 4 784 1 1568)))
147    (set! (i3fun1 2) (flipxy '(4  16.5 4 65.41 1 130.8)))
148
149    (set! (i3fun2 1) (flipxy '(.4 138.8 .1 1568)))
150    (set! (i3fun2 2) (flipxy '(.4  16.5 .1 130.8)))))
151
152(define (fncval ptr pitch)
153  (envelope-interp pitch ptr))
154
155(definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
156			 dis pcrev deg vibscl pcran skewscl glissfun glissamt)
157  (fillfnc)
158  (let* ((vowel (floor vowel-1))
159	 (sex (floor sex-1))
160	 (ampref (expt amp .8))
161	 (deg (- deg 45))
162	 (fm2 3)
163	 (mscale 1)
164	 (vibfreq (fncval (vibfreqfun sex) pitch))
165	 (vibpc (* .01 (log pitch 2) (+ .15 (sqrt amp)) vibscl))
166	 (ranpc (* .002 (log pitch 2) (- 2 (expt amp .25)) pcran))
167	 (skewpc (* skewscl (sqrt (+ .1 (* .05 ampref (if (= sex 1) (- 1568 130.8) (- 130.8 16.5)))))))
168	 (form1 (/ (fncval (aref fnc sex vowel 1 1) pitch) pitch))
169	 (form2 (/ (fncval (aref fnc sex vowel 2 1) pitch) pitch))
170	 (form3 (/ (fncval (aref fnc sex vowel 3 1) pitch) pitch))
171	 (mconst 0)
172	 (fmntfreq1 (round form1))
173	 (fmntfreq2 (round form2))
174	 (fmntfreq3 (round form3))
175	 (mfq (+ (* pitch mscale) mconst))
176	 (c 261.62)
177	 (amp1 (sqrt amp))
178	 (amp2 (expt amp 1.5))
179	 (amp3 (* amp amp))
180	 (indx1 1)
181	 (formscl1 (abs (- form1 fmntfreq1)))
182	 (formscl2 (abs (- form2 fmntfreq2)))
183	 (formscl3 (abs (- form3 fmntfreq3)))
184	 (i3 (fncval ((if (< pitch (/ c 2)) i3fun1 i3fun2) sex) pitch))
185	 (indx0 (if (memv vowel '(3 4)) 0 1.5))
186	 (caramp1sc (* (fncval (aref fnc sex vowel 1 2) pitch) (- 1 formscl1) amp1))
187	 (caramp2sc (* (fncval (aref fnc sex vowel 2 2) pitch) (- 1 formscl2) amp2))
188	 (caramp3sc (* (fncval (aref fnc sex vowel 3 2) pitch) (- 1 formscl3) amp3))
189	 (ranfreq 20)
190	 (scdev1 (fncval (aref fnc sex vowel 1 3) pitch))
191	 (scdev2 (fncval (aref fnc sex vowel 2 3) pitch))
192	 (scdev3 (fncval (aref fnc sex vowel 3 3) pitch))
193	 (dev (hz->radians (* i3 mfq)))
194	 (dev0 (hz->radians (* indx0 mfq)))
195	 (dev1 (hz->radians (* (- indx1 indx0) mfq)))
196	 (gens1 (make-oscil 0))
197	 (gens2 (make-oscil 0 (/ pi 2.0)))
198	 (gens2ampenv (make-env indxfun  :duration dur
199				:scaler (* scdev1 dev1)
200				:offset (* scdev1 dev0)))
201	 (gens3 (make-oscil 0 (/ pi 2.0)))
202	 (gens3ampenv (make-env indxfun  :duration dur
203				:scaler (* scdev2 dev1)
204				:offset (* scdev2 dev0)))
205	 (gens4 (make-oscil 0 (/ pi 2.0)))
206	 (gens4ampenv (make-env indxfun  :duration dur
207				:scaler (* scdev3 dev1)
208				:offset (* scdev3 dev0)))
209	 (gens5 (make-oscil 0))
210	 (gens5ampenv (make-env ampfun1 :duration dur
211				:scaler (* amp caramp1sc .75)))
212	 (gens6 (make-oscil 0))
213	 (gens6ampenv (make-env ampfun2 :duration dur
214				:scaler (* amp caramp2sc .75)))
215	 (gens7 (make-oscil 0))
216	 (gens7ampenv (make-env ampfun3 :duration dur
217				:scaler (* amp caramp3sc .75)))
218	 (freqenv (make-env (addenv glissfun (* glissamt pitch) 0 skewfun (* skewpc pitch) pitch) :duration dur
219			    :scaler (hz->radians 1.0)))
220	 (pervenv (make-env vibfun :duration dur
221			    :scaler vibpc))
222	 (ranvenv (make-env :envelope ranfun :duration dur
223			    :scaler ranpc))
224	 (per-vib (make-triangle-wave :frequency vibfreq
225				      :amplitude (hz->radians pitch)))
226	 (ran-vib (make-rand-interp :frequency ranfreq
227				    :amplitude (hz->radians pitch)))
228	 (loc (make-locsig :degree deg :distance dis :reverb pcrev))
229	 (start (floor (* *clm-srate* beg)))
230	 (end (floor (* *clm-srate* (+ beg dur)))))
231
232    (do ((i start (+ i 1)))
233	((= i end))
234      (let* ((vib (+ (env freqenv)
235		     (* (env pervenv)
236			(triangle-wave per-vib))
237		     (* (env ranvenv)
238			(rand-interp ran-vib))))
239	     (cascadeout (* dev (oscil gens1 (* vib fm2)))))
240	(locsig loc i (+ (* (env gens5ampenv)
241			    (oscil gens5 (+ (* vib fmntfreq1)
242					    (* (env gens2ampenv)
243					       (oscil gens2 (+ cascadeout (* vib mscale)))))))
244			 (* (env gens6ampenv)
245			    (oscil gens6 (+ (* vib fmntfreq2)
246					    (* (env gens3ampenv)
247					       (oscil gens3 (+ cascadeout (* vib mscale)))))))
248			 (* (env gens7ampenv)
249			    (oscil gens7 (+ (* vib fmntfreq3)
250					    (* (env gens4ampenv)
251					       (oscil gens4 (+ cascadeout (* vib mscale)))))))))))))
252
253#|
254(let ((ampf '(0 0 1 1 2 1 3 0)))
255  (with-sound (:play #t) (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 .01 0 ampf .01)))
256
257(definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
258			 dis pcrev deg vibscl pcran skewscl glissfun glissamt)
259
260(define-macro (voi beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
261		   dis pcrev deg vibscl skewscl)
262  `(fm-voice ,beg ,dur ,pitch ,amp ,vowel-1 ,sex-1 ,ampfun1 ,ampfun2 ,ampfun3 ,indxfun ,skewfun ,vibfun ,ranfun
263	     ,dis ,pcrev ,deg ,vibscl 0 ,skewscl '(0 0 100 0)))
264|#
265