File: maraca.scm

package info (click to toggle)
snd 26.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 44,044 kB
  • sloc: ansic: 291,996; lisp: 260,569; ruby: 71,134; sh: 3,293; fortran: 2,342; csh: 1,067; cpp: 294; makefile: 294; python: 87; xml: 27; javascript: 1
file content (136 lines) | stat: -rw-r--r-- 4,579 bytes parent folder | download | duplicates (6)
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))