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