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