You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

jcvoi.scm 16KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263
  1. ;;; from VOIDAT.SAI[220,JDC] and GLSVOI.SAI[220,JDC], then (30 years later) jcvoi.ins
  2. (provide 'snd-jcvoi.scm)
  3. (require snd-env.scm)
  4. (define fnc #f) ;; fnc[sex,vowel,formant number,formant freq,amp or fm index]
  5. (define vibfreqfun #f)
  6. (define i3fun1 #f)
  7. (define i3fun2 #f)
  8. (define (flipxy data) ; SEG functions expected data in (y x) pairs.
  9. (let ((unseg ())
  10. (len (length data)))
  11. (do ((i 0 (+ i 2)))
  12. ((>= i len)
  13. (reverse unseg))
  14. (let ((x (data (+ 1 i)))
  15. (y (data i)))
  16. (set! unseg (cons y (cons x unseg)))))))
  17. (define (addenv env1 sc1 off1 env2 sc2 off2)
  18. (add-envelopes (scale-envelope env1 sc1 off1)
  19. (scale-envelope env2 sc2 off2)))
  20. (define (checkpt att dur)
  21. (if (not (positive? att))
  22. (* 100 (/ .01 dur))
  23. (if (< att dur)
  24. (* 100 (/ att dur))
  25. 100)))
  26. (define (setf-aref vect a b c d val)
  27. (set! (vect (+ a (* 3 b) (* 18 c) (* 72 d))) val))
  28. (define (aref vect a b c d)
  29. (vect (+ a (* 3 b) (* 18 c) (* 72 d))))
  30. (define (fillfnc)
  31. (unless fnc
  32. (set! fnc (make-vector 288 ())) ; 288 = (* 3 6 4 4)
  33. (set! vibfreqfun (make-vector 3 ()))
  34. (set! i3fun1 (make-vector 3 ()))
  35. (set! i3fun2 (make-vector 3 ()))
  36. (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)))
  37. (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)))
  38. (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)))
  39. (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)))
  40. (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)))
  41. (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)))
  42. (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)))
  43. (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)))
  44. (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)))
  45. (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)))
  46. (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)))
  47. (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)))
  48. (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)))
  49. (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)))
  50. (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)))
  51. (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)))
  52. (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)))
  53. (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)))
  54. (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)))
  55. (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)))
  56. (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)))
  57. (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)))
  58. (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)))
  59. (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)))
  60. (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)))
  61. (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)))
  62. (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)))
  63. (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)))
  64. (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)))
  65. (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)))
  66. (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)))
  67. (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)))
  68. (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)))
  69. (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)))
  70. (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)))
  71. (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)))
  72. (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)))
  73. (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)))
  74. (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)))
  75. (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)))
  76. (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)))
  77. (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)))
  78. (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)))
  79. (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)))
  80. (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)))
  81. (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)))
  82. (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)))
  83. (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)))
  84. (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)))
  85. (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)))
  86. (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)))
  87. (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)))
  88. (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)))
  89. (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)))
  90. (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)))
  91. (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)))
  92. (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)))
  93. (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)))
  94. (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)))
  95. (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)))
  96. (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)))
  97. (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)))
  98. (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)))
  99. (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)))
  100. (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)))
  101. (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)))
  102. (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)))
  103. (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)))
  104. (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)))
  105. (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)))
  106. (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)))
  107. (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)))
  108. (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)))
  109. (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)))
  110. (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)))
  111. (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)))
  112. (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)))
  113. (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)))
  114. (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)))
  115. (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)))
  116. (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)))
  117. ;; (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)))
  118. (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)))
  119. (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)))
  120. (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)))
  121. (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)))
  122. (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)))
  123. (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)))
  124. (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)))
  125. (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)))
  126. (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)))
  127. ;; these are vibrato frequencies functions (pitch dependent);
  128. (set! (vibfreqfun 1) (flipxy '(4.5 138.8 5 1568)))
  129. (set! (vibfreqfun 2) (flipxy '(4.5 16.5 5 130.8)))
  130. ;; these are index functions for cascade modulater (pitch dependent);
  131. (set! (i3fun1 1) (flipxy '(4 138.8 4 784 1 1568)))
  132. (set! (i3fun1 2) (flipxy '(4 16.5 4 65.41 1 130.8)))
  133. (set! (i3fun2 1) (flipxy '(.4 138.8 .1 1568)))
  134. (set! (i3fun2 2) (flipxy '(.4 16.5 .1 130.8)))))
  135. (define (fncval ptr pitch)
  136. (envelope-interp pitch ptr))
  137. (definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
  138. dis pcrev deg vibscl pcran skewscl glissfun glissamt)
  139. (fillfnc)
  140. (let ((c 261.62)
  141. (vowel (floor vowel-1))
  142. (sex (floor sex-1))
  143. (ampref (expt amp .8))
  144. (deg (- deg 45))
  145. (ranfreq 20)
  146. (fm2 3)
  147. (mscale 1)
  148. (mconst 0)
  149. (indx1 1))
  150. (let ((vibfreq (fncval (vibfreqfun sex) pitch))
  151. (vibpc (* .01 (log pitch 2) (+ .15 (sqrt amp)) vibscl))
  152. (ranpc (* .002 (log pitch 2) (- 2 (expt amp .25)) pcran))
  153. (skewpc (* skewscl (sqrt (+ .1 (* .05 ampref (if (= sex 1) (- 1568 130.8) (- 130.8 16.5)))))))
  154. (form1 (/ (fncval (aref fnc sex vowel 1 1) pitch) pitch))
  155. (form2 (/ (fncval (aref fnc sex vowel 2 1) pitch) pitch))
  156. (form3 (/ (fncval (aref fnc sex vowel 3 1) pitch) pitch)))
  157. (let ((fmntfreq1 (round form1))
  158. (fmntfreq2 (round form2))
  159. (fmntfreq3 (round form3))
  160. (mfq (+ (* pitch mscale) mconst)))
  161. (let ((amp1 (sqrt amp))
  162. (amp2 (expt amp 1.5))
  163. (amp3 (* amp amp))
  164. (formscl1 (abs (- form1 fmntfreq1)))
  165. (formscl2 (abs (- form2 fmntfreq2)))
  166. (formscl3 (abs (- form3 fmntfreq3)))
  167. (i3 (fncval ((if (< pitch (/ c 2)) i3fun1 i3fun2) sex) pitch))
  168. (indx0 (if (memv vowel '(3 4)) 0 1.5)))
  169. (let ((caramp1sc (* (fncval (aref fnc sex vowel 1 2) pitch) (- 1 formscl1) amp1))
  170. (caramp2sc (* (fncval (aref fnc sex vowel 2 2) pitch) (- 1 formscl2) amp2))
  171. (caramp3sc (* (fncval (aref fnc sex vowel 3 2) pitch) (- 1 formscl3) amp3))
  172. (scdev1 (fncval (aref fnc sex vowel 1 3) pitch))
  173. (scdev2 (fncval (aref fnc sex vowel 2 3) pitch))
  174. (scdev3 (fncval (aref fnc sex vowel 3 3) pitch))
  175. (dev (hz->radians (* i3 mfq)))
  176. (dev0 (hz->radians (* indx0 mfq)))
  177. (dev1 (hz->radians (* (- indx1 indx0) mfq))))
  178. (let ((gens1 (make-oscil 0))
  179. (gens2 (make-oscil 0 (/ pi 2.0)))
  180. (gens2ampenv (make-env indxfun :duration dur
  181. :scaler (* scdev1 dev1)
  182. :offset (* scdev1 dev0)))
  183. (gens3 (make-oscil 0 (/ pi 2.0)))
  184. (gens3ampenv (make-env indxfun :duration dur
  185. :scaler (* scdev2 dev1)
  186. :offset (* scdev2 dev0)))
  187. (gens4 (make-oscil 0 (/ pi 2.0)))
  188. (gens4ampenv (make-env indxfun :duration dur
  189. :scaler (* scdev3 dev1)
  190. :offset (* scdev3 dev0)))
  191. (gens5 (make-oscil 0))
  192. (gens5ampenv (make-env ampfun1 :duration dur
  193. :scaler (* amp caramp1sc .75)))
  194. (gens6 (make-oscil 0))
  195. (gens6ampenv (make-env ampfun2 :duration dur
  196. :scaler (* amp caramp2sc .75)))
  197. (gens7 (make-oscil 0))
  198. (gens7ampenv (make-env ampfun3 :duration dur
  199. :scaler (* amp caramp3sc .75)))
  200. (freqenv (make-env (addenv glissfun (* glissamt pitch) 0 skewfun (* skewpc pitch) pitch) :duration dur
  201. :scaler (hz->radians 1.0)))
  202. (pervenv (make-env vibfun :duration dur
  203. :scaler vibpc))
  204. (ranvenv (make-env :envelope ranfun :duration dur
  205. :scaler ranpc))
  206. (per-vib (make-triangle-wave :frequency vibfreq
  207. :amplitude (hz->radians pitch)))
  208. (ran-vib (make-rand-interp :frequency ranfreq
  209. :amplitude (hz->radians pitch)))
  210. (loc (make-locsig :degree deg :distance dis :reverb pcrev))
  211. (start (floor (* *clm-srate* beg)))
  212. (end (floor (* *clm-srate* (+ beg dur)))))
  213. (do ((i start (+ i 1)))
  214. ((= i end))
  215. (let* ((vib (+ (env freqenv)
  216. (* (env pervenv)
  217. (triangle-wave per-vib))
  218. (* (env ranvenv)
  219. (rand-interp ran-vib))))
  220. (cascadeout (* dev (oscil gens1 (* vib fm2)))))
  221. (locsig loc i (+ (* (env gens5ampenv)
  222. (oscil gens5 (+ (* vib fmntfreq1)
  223. (* (env gens2ampenv)
  224. (oscil gens2 (+ cascadeout (* vib mscale)))))))
  225. (* (env gens6ampenv)
  226. (oscil gens6 (+ (* vib fmntfreq2)
  227. (* (env gens3ampenv)
  228. (oscil gens3 (+ cascadeout (* vib mscale)))))))
  229. (* (env gens7ampenv)
  230. (oscil gens7 (+ (* vib fmntfreq3)
  231. (* (env gens4ampenv)
  232. (oscil gens4 (+ cascadeout (* vib mscale))))))))))))))))))
  233. #|
  234. (let ((ampf '(0 0 1 1 2 1 3 0)))
  235. (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)))
  236. (definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
  237. dis pcrev deg vibscl pcran skewscl glissfun glissamt)
  238. (define-macro (voi beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
  239. dis pcrev deg vibscl skewscl)
  240. `(fm-voice ,beg ,dur ,pitch ,amp ,vowel-1 ,sex-1 ,ampfun1 ,ampfun2 ,ampfun3 ,indxfun ,skewfun ,vibfun ,ranfun
  241. ,dis ,pcrev ,deg ,vibscl 0 ,skewscl '(0 0 100 0)))
  242. |#