dom
/
tonalisa
Observar 1
Favorito 0
Fork 0
Código Issues 0 Pull requests 0 Versões 0 Wiki Atividade
Você não pode selecionar mais de 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.
1 Commit
1 Branch
Branch: master
Branches Tags
${ item.name }
Criar branch ${ searchTerm }
de master
${ noResults }
tonalisa/lib/sndlib/jcvoi.scm

264 linhas
16KB
Original Link permanente Anotar Histórico 

  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 ((c 261.62)

  159. 	(vowel (floor vowel-1))

  160. 	(sex (floor sex-1))

  161. 	(ampref (expt amp .8))

  162. 	(deg (- deg 45))

  163. 	(ranfreq 20)

  164. 	(fm2 3)

  165. 	(mscale 1)

  166. 	(mconst 0)

  167. 	(indx1 1))

  168.     (let ((vibfreq (fncval (vibfreqfun sex) pitch))

  169. 	  (vibpc (* .01 (log pitch 2) (+ .15 (sqrt amp)) vibscl))

  170. 	  (ranpc (* .002 (log pitch 2) (- 2 (expt amp .25)) pcran))

  171. 	  (skewpc (* skewscl (sqrt (+ .1 (* .05 ampref (if (= sex 1) (- 1568 130.8) (- 130.8 16.5)))))))

  172. 	  (form1 (/ (fncval (aref fnc sex vowel 1 1) pitch) pitch))

  173. 	  (form2 (/ (fncval (aref fnc sex vowel 2 1) pitch) pitch))

  174. 	  (form3 (/ (fncval (aref fnc sex vowel 3 1) pitch) pitch)))

  175.       (let ((fmntfreq1 (round form1))

  176. 	    (fmntfreq2 (round form2))

  177. 	    (fmntfreq3 (round form3))

  178. 	    (mfq (+ (* pitch mscale) mconst)))

  179. 	(let ((amp1 (sqrt amp))

  180. 	      (amp2 (expt amp 1.5))

  181. 	      (amp3 (* amp amp))

  182. 	      (formscl1 (abs (- form1 fmntfreq1)))

  183. 	      (formscl2 (abs (- form2 fmntfreq2)))

  184. 	      (formscl3 (abs (- form3 fmntfreq3)))

  185. 	      (i3 (fncval ((if (< pitch (/ c 2)) i3fun1 i3fun2) sex) pitch))

  186. 	      (indx0 (if (memv vowel '(3 4)) 0 1.5)))

  187. 	  (let ((caramp1sc (* (fncval (aref fnc sex vowel 1 2) pitch) (- 1 formscl1) amp1))

  188. 		(caramp2sc (* (fncval (aref fnc sex vowel 2 2) pitch) (- 1 formscl2) amp2))

  189. 		(caramp3sc (* (fncval (aref fnc sex vowel 3 2) pitch) (- 1 formscl3) amp3))

  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. 	    (let ((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. 	      (do ((i start (+ i 1)))

  232. 		  ((= i end))

  233. 		(let* ((vib (+ (env freqenv) 

  234. 			       (* (env pervenv) 

  235. 				  (triangle-wave per-vib)) 

  236. 			       (* (env ranvenv) 

  237. 				  (rand-interp ran-vib))))

  238. 		       (cascadeout (* dev (oscil gens1 (* vib fm2)))))

  239. 		  (locsig loc i (+ (* (env gens5ampenv) 

  240. 				      (oscil gens5 (+ (* vib fmntfreq1)

  241. 						      (* (env gens2ampenv) 

  242. 							 (oscil gens2 (+ cascadeout (* vib mscale)))))))

  243. 				   (* (env gens6ampenv) 

  244. 				      (oscil gens6 (+ (* vib fmntfreq2)

  245. 						      (* (env gens3ampenv) 

  246. 							 (oscil gens3 (+ cascadeout (* vib mscale)))))))

  247. 				   (* (env gens7ampenv) 

  248. 				      (oscil gens7 (+ (* vib fmntfreq3)

  249. 						      (* (env gens4ampenv) 

  250. 							 (oscil gens4 (+ cascadeout (* vib mscale))))))))))))))))))

  251. 

  252. #|

  253. (let ((ampf '(0 0 1 1 2 1 3 0))) 

  254.   (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)))

  255. 

  256. (definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun

  257. 			 dis pcrev deg vibscl pcran skewscl glissfun glissamt)

  258. 

  259. (define-macro (voi beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun

  260. 		   dis pcrev deg vibscl skewscl)

  261.   `(fm-voice ,beg ,dur ,pitch ,amp ,vowel-1 ,sex-1 ,ampfun1 ,ampfun2 ,ampfun3 ,indxfun ,skewfun ,vibfun ,ranfun

  262. 	     ,dis ,pcrev ,deg ,vibscl 0 ,skewscl '(0 0 100 0)))

  263. |#