Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137
  1. ;;; Perry Cook's maraca from CMJ vol 21 no 3 (Fall 97) p 44
  2. ;;; translated from CLM's maraca.ins
  3. (provide 'snd-maraca.scm)
  4. (if (provided? 'snd)
  5. (require snd-ws.scm)
  6. (require sndlib-ws.scm))
  7. (define two-pi (* 2 pi))
  8. (definstrument (maraca beg dur (amp .1)
  9. (sound-decay 0.95)
  10. (system-decay 0.999)
  11. (probability .0625)
  12. (shell-freq 3200.0)
  13. (shell-reso 0.96))
  14. (let ((num-beans 64))
  15. (let ((st (seconds->samples beg))
  16. (nd (seconds->samples (+ beg dur)))
  17. (temp 0.0)
  18. (shake-energy 0.0)
  19. (snd-level 0.0)
  20. (input 0.0)
  21. (stop 0)
  22. (h20 (hz->radians 20.0))
  23. (sndamp (/ amp 16384.0))
  24. (srate4 (floor (/ *clm-srate* 4)))
  25. (gain (/ (* (log num-beans 4.0) 40) num-beans))
  26. (tz (make-two-pole 1.0 (* -2.0 shell-reso (cos (hz->radians shell-freq))) (* shell-reso shell-reso)))
  27. (oz (make-one-zero 1.0 -1.0))
  28. ;; gourd resonance filter
  29. )
  30. (do ((i st (+ i srate4)))
  31. ((>= i nd))
  32. (set! temp 0.0)
  33. (set! stop (min nd (+ i srate4)))
  34. (do ((k i (+ k 1)))
  35. ((= k stop))
  36. (if (< temp two-pi)
  37. (begin
  38. ;; shake over 50msec and add shake energy
  39. (set! temp (+ temp h20))
  40. (set! shake-energy (- (+ shake-energy 1.0) (cos temp)))))
  41. (set! shake-energy (* shake-energy system-decay))
  42. ;; if collision, add energy
  43. (if (< (random 1.0) probability)
  44. (set! snd-level (+ snd-level (* gain shake-energy))))
  45. ;; actual sound is random
  46. (set! input (mus-random snd-level))
  47. ;; compute exponential sound decay
  48. (set! snd-level (* snd-level sound-decay))
  49. ;; gourd resonance filter calc
  50. (outa k (* sndamp (one-zero oz (two-pole tz input)))))))))
  51. ;;; maraca: (with-sound (:statistics #t :play #t) (maraca 0 5 .5))
  52. ;;; cabasa: (with-sound (:statistics #t :play #t) (maraca 0 5 .5 0.95 0.997 0.5 3000.0 0.7))
  53. (definstrument (big-maraca beg dur (amp .1)
  54. (sound-decay 0.95)
  55. (system-decay 0.999)
  56. (probability .0625)
  57. (shell-freqs '(3200.0))
  58. (shell-resos '(0.96))
  59. (randiff .01)
  60. (with-filters #t))
  61. ;; like maraca, but takes a list of resonances and includes low-pass filter (or no filter)
  62. (let ((num-beans 64)
  63. (resn (length shell-freqs)))
  64. (let ((st (seconds->samples beg))
  65. (nd (seconds->samples (+ beg dur)))
  66. (temp 0.0)
  67. (shake-energy 0.0)
  68. (snd-level 0.0)
  69. (input 0.0)
  70. (sum 0.0)
  71. (last-sum 0.0)
  72. (tzs (make-vector resn))
  73. (h20 (hz->radians 20.0))
  74. (stop 0)
  75. (sndamp (/ amp (* 16384.0 resn)))
  76. (srate4 (floor (/ *clm-srate* 4)))
  77. (gain (/ (* (log num-beans 4) 40) num-beans))
  78. (oz (make-one-zero (/ amp (* resn 16384.0)) (/ amp (* resn 16384.0)))))
  79. ;; we need to fixup Perry's frequency dithering amount since we're going through our mus-frequency method
  80. (set! randiff (radians->hz randiff))
  81. ;; gourd resonance filters
  82. (do ((i 0 (+ i 1)))
  83. ((= i resn))
  84. (vector-set! tzs i (make-two-pole 1.0
  85. (* -2.0 (shell-resos i) (cos (hz->radians (shell-freqs i))))
  86. (* (shell-resos i) (shell-resos i)))))
  87. (do ((i st (+ i srate4)))
  88. ((>= i nd))
  89. (set! temp 0.0)
  90. (set! stop (min nd (+ i srate4)))
  91. (do ((k i (+ k 1)))
  92. ((= k stop))
  93. (if (< temp two-pi)
  94. (begin
  95. ;; shake over 50msec and add shake energy
  96. (set! temp (+ temp h20))
  97. (set! shake-energy (- (+ shake-energy 1.0) (cos temp)))))
  98. (set! shake-energy (* shake-energy system-decay))
  99. ;; if collision, add energy
  100. (if (< (random 1.0) probability)
  101. (begin
  102. (set! snd-level (+ snd-level (* gain shake-energy)))
  103. ;; randomize res freqs a bit
  104. (do ((j 0 (+ j 1)))
  105. ((= j resn))
  106. (set! (mus-frequency (vector-ref tzs j)) (+ (shell-freqs j) (mus-random randiff))))))
  107. ;; actual sound is random
  108. (set! input (mus-random snd-level))
  109. ;; compute exponential sound decay
  110. (set! snd-level (* snd-level sound-decay))
  111. ;; gourd resonance filter calcs
  112. (set! last-sum sum)
  113. (set! sum 0.0)
  114. (do ((j 0 (+ j 1)))
  115. ((= j resn))
  116. (set! sum (+ sum (two-pole (vector-ref tzs j) input))))
  117. (outa k (if with-filters
  118. (one-zero oz (- sum last-sum))
  119. (* sndamp sum))))))))
  120. ;;; tambourine: (with-sound (:play #t :statistics #t) (big-maraca 0 1 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01))
  121. ;;; sleighbells: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .15 0.97 0.9994 0.03125 '(2500 5300 6500 8300 9800) '(0.999 0.999 0.999 0.999 0.999)))
  122. ;;; sekere: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .5 0.96 0.999 .0625 '(5500) '(0.6)))
  123. ;;; windchimes: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .5 0.99995 0.95 .001 '(2200 2800 3400) '(0.995 0.995 0.995) .01 #f))