File: fade.scm

package info (click to toggle)
snd 19.1-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 52,736 kB
  • sloc: ansic: 390,251; lisp: 242,546; ruby: 71,383; sh: 3,284; fortran: 2,342; csh: 1,259; cpp: 294; makefile: 287; python: 47
file content (281 lines) | stat: -rw-r--r-- 9,617 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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
;;; cross fade instruments
;;;
;;; cross-fade sweeps up, down, or from mid-spectrum outwards,
;;; dissolve-fade chooses randomly -- like a graphical dissolve
;;; neither is exactly spectacular, but they work -- use similar sounds if possible (speech is problematic)
;;;
;;; translated from fade.ins

(provide 'snd-fade.scm)

(if (provided? 'snd)
    (require snd-ws.scm)
    (require sndlib-ws.scm))

(definstrument (cross-fade beg dur amp file1 file2 ramp-beg ramp-dur ramp-type bank-dur fs fwidth)
  ;; ramp-type 0=sweep up, 1=sweep down, 2=split from middle

  (if (> (+ (max bank-dur ramp-beg) ramp-dur bank-dur) dur)
      (begin
	(set! ramp-beg (* 0.25 dur))
	(set! ramp-dur (* dur 0.49))
	(set! bank-dur (* dur 0.24))))
	
  (let ((fil1 (make-sampler 0 file1))
	(fil2 (make-sampler 0 file2))
	(start (seconds->samples beg))
	(ramp-samps (seconds->samples ramp-dur))
	(bank-samps (seconds->samples bank-dur))
	(fs1 (make-vector fs)))

    (let ((bin (/ *clm-srate* (* 2 fs)))
	  (radius (- 1.0 (/ fwidth (* 2 fs)))))
      (do ((k 0 (+ k 1)))
	  ((= k fs))
	(set! (fs1 k) (make-formant (* k bin) radius))))
    (set! fs1 (make-formant-bank fs1))
    
    (let ((end (+ start (seconds->samples dur)))
	  (bank-incr (/ 1.0 bank-samps))
	  (ramp-incr (/ 1.0 ramp-samps))
	  (ramp-start (+ start (seconds->samples ramp-beg))))
      (let ((bank1-start (- ramp-start bank-samps))
	    (ramp-end (+ ramp-start ramp-samps))
	    (bank2-start (+ ramp-start ramp-samps)))
	
	(do ((i start (+ i 1)))
	    ((= i bank1-start))
	  ;; in first section -- just mix in file1
	  (outa i (* amp (read-sample fil1))))
	
	(let ((bank2-end (+ bank2-start bank-samps))
	      (ramp 0.0)
	      (outval 0.0)
	      (inputs (make-float-vector fs))
	      (ifs (/ 1.0 fs))
	      (mid 0))
	  
	  (do ((i bank1-start (+ i 1))
	       (bank1 0.0 (+ bank1 bank-incr)))
	      ((= i ramp-start))
	    ;; in bank1 section -- fire up the resonators
	    (let ((inval (read-sample fil1)))
	      (set! outval (formant-bank fs1 inval))
	      (outa i (* amp (+ (* bank1 outval) (* (- 1.0 bank1) inval))))))
	  
	  ;; in the ramp
	  (case ramp-type
	    ((0)
	     (do ((i ramp-start (+ i 1)))
		 ((= i ramp-end))
	       (let ((inval1 (read-sample fil1))
		     (inval2 (read-sample fil2)))
		 ;; now the choice of spectral fade -- we should end with all bank1 0.0 and all bank2 1.0
		 (set! ramp (+ ramp ramp-incr))
		 
		 ;; low freqs go first
		 (if (>= ramp 0.5)
		     (begin
		       (set! mid (floor (* (- (* 2.0 ramp) 1.0) fs)))
		       (fill! inputs inval2 0 mid)
		       (float-vector-interpolate inputs mid fs 1.0 (- ifs) inval2 inval1)
		       ;; (do ((k mid (+ k 1)) (ks 1.0 (- ks ifs))) ((>= k fs)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
		       )
		     (begin
		       (set! mid (min fs (floor (* 2.0 ramp fs))))
		       (fill! inputs inval1 mid)
		       (float-vector-interpolate inputs 0 mid (* 2.0 ramp) (- ifs) inval2 inval1)
		       ;; (do ((k 0 (+ k 1)) (ks (* 2.0 ramp) (- ks ifs))) ((= k mid)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
		       ))
		 (outa i (* amp (formant-bank fs1 inputs))))))
	    
	    ((1)
	     (do ((i ramp-start (+ i 1)))
		 ((= i ramp-end))
	       (let ((inval1 (read-sample fil1))
		     (inval2 (read-sample fil2)))
		 (set! ramp (+ ramp ramp-incr))
		 
		 ;; high freqs go first
		 (if (>= ramp 0.5)
		     (let ((r2 (- (* 2.0 ramp) 1.0)))
		       (set! mid (min fs (ceiling (* (- 1.0 r2) fs))))
		       (fill! inputs inval2 mid)
		       (float-vector-interpolate inputs 0 mid r2 ifs inval2 inval1)
		       ;; (do ((k 0 (+ k 1)) (ks r2 (+ ks ifs))) ((= k mid)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
		       )
		     (begin
		       (set! mid (ceiling (* (- 1.0 (* 2.0 ramp)) fs)))
		       (fill! inputs inval1 0 mid)
		       (float-vector-interpolate inputs mid fs 0.0 ifs inval2 inval1)
		       ;; (do ((k mid (+ k 1)) (ks 0.0 (+ ks ifs))) ((>= k fs)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
		       ))
		 (outa i (* amp (formant-bank fs1 inputs))))))
	    
	    (else
	     (let ((half-fs (/ fs 2)))
	       (do ((i ramp-start (+ i 1)))
		   ((= i ramp-end))
		 (let ((inval1 (read-sample fil1))
		       (inval2 (read-sample fil2)))
		   ;; now the choice of spectral fade -- we should end with all bank1 0.0 and all bank2 1.0
		   (set! ramp (+ ramp ramp-incr))
		   ;; sweep from midpoint out
		   (fill! inputs inval1)
		   (set! mid (min half-fs (floor (* fs ramp))))
		   (do ((k (- half-fs mid) (+ k 1))
			(hk (+ half-fs mid -1) (- hk 1))
			(ks (max 0.0 (- (* 2.0 ramp) 1.0)) (+ ks ifs)))
		       ((= k half-fs))
		     (let ((rfs (min 1.0 ks)))
		       (set! (inputs k) (+ (* rfs inval2) (* (- 1.0 rfs) inval1)))
		       (set! (inputs hk) (inputs k))))
		   (outa i (* amp (formant-bank fs1 inputs))))))))
	  
	  (do ((i ramp-end (+ i 1))
	       (bank2 1.0 (- bank2 bank-incr)))
	      ((= i bank2-end))
	    ;; in bank2 section -- ramp out resonators
	    (let ((inval (read-sample fil2)))
	      (set! outval (formant-bank fs1 inval))
	      (outa i (* amp (+ (* bank2 outval) (* (- 1.0 bank2) inval))))))
	  
	  (do ((i bank2-end (+ i 1)))
	      ((= i end))
	    ;; in last section -- just mix file2
	    (outa i (* amp (read-sample fil2))))
	  )))))



;;; (float-vector->channel (with-sound ((make-float-vector 22050)) (cross-fade 0 .1 1 0 1 .01 .01 0 .1 256 2)))
;;; (float-vector->channel (with-sound ((make-float-vector 44100)) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2)))
;;; (with-sound (:statistics #t) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
;;; (with-sound () (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
;;; these fades seem more successful to me when done relatively quickly (the opposite of the dissolve below
;;; which is best if done as slowly as possible).  I like the sweep up best -- a sort of "evaporation" effect.


(definstrument (dissolve-fade beg dur amp file1 file2 fsize r lo hi)
  (let ((fil1 (make-sampler 0 file1))
	(fil2 (make-sampler 0 file2))
	(start (seconds->samples beg))
	(freq-inc (floor (/ fsize 2)))
	(ramp-inc (/ 1.0 1024.0)))
    (let ((end (+ start (seconds->samples dur)))
	  (spectr (make-vector freq-inc #f))
	  (trigger (floor (/ (* dur *clm-srate*) freq-inc)))
	  (fs (make-vector freq-inc #f))
	  (amps (make-float-vector freq-inc amp))
	  (ctr 0)
	  (inputs (make-float-vector freq-inc))
	  (ramps (make-vector freq-inc -1))
	  (in2s (make-int-vector freq-inc))
	  (in2-ctr 0)
	  (ramp-ctr 0))
    
      (if (not (number? hi)) (set! hi freq-inc))
      (let ((bin (floor (/ *clm-srate* fsize)))
	    (radius (- 1.0 (/ r fsize)))) 
	(do ((k lo (+ k 1)))
	    ((= k hi))
	  (set! (fs k) (make-formant (* k bin) radius))))
      (set! fs (make-formant-bank fs amps)) ; wrap it up...
 
      (do ((i start (+ i 1)))
	  ((= i end))

	;; once a ramp is set in motion, it takes care of itself -- we need only choose which to trigger
	(set! ctr (+ ctr 1))
	(if (> ctr trigger)
	    (let ((next (floor (random freq-inc))))
	      ;; find next randomly chosen resonator to flip
	      (if (not (spectr next))
		  (set! (spectr next) (- 1.0 ramp-inc))
		  (call-with-exit
		   (lambda (bbreak)
		     (do ((j next (+ j 1))
			  (k next (- k 1)))
			 ()
		       (if (and (< j freq-inc) 
				(not (spectr j)))
			   (begin 
			     (set! (spectr j) (- 1.0 ramp-inc))
			     (set! next j)
			     (bbreak)))
		       (if (and (>= k 0) 
				(not (spectr k)))
			   (begin 
			     (set! (spectr k) (- 1.0 ramp-inc))
			     (set! next k)
			     (bbreak)))))))
	      (set! (ramps ramp-ctr) next)
	      (set! ramp-ctr (+ ramp-ctr 1))
	      (set! ctr 0)))
	
	(let ((inval1 (read-sample fil1))
	      (inval2 (read-sample fil2)))
	  (fill! inputs inval1)
	  (float-vector-spatter inputs in2s in2-ctr inval2)
	  ;; (do ((k 0 (+ k 1))) ((= k in2-ctr)) (float-vector-set! inputs (int-vector-ref in2s k) inval2))

	  (when (> ramp-ctr 0)
	    (let ((rk 0)
		  (sp 0.0)
		  (fixup-ramps #f))
	      (do ((k 0 (+ k 1)))
		  ((= k ramp-ctr))
		(set! rk (ramps k))
		(set! sp (vector-ref spectr rk))
		(float-vector-set! inputs k (+ (* sp inval1) (* (- 1.0 sp) inval2)))
		(set! sp (- sp ramp-inc))
		(if (> sp 0.0)
		    (vector-set! spectr rk sp)
		    (begin
		      (set! (in2s in2-ctr) rk)
		      (set! in2-ctr (+ in2-ctr 1))
		      (set! fixup-ramps #t)
		      (set! (ramps k) -1))))
	      (if fixup-ramps
		  (let ((j 0))
		    (do ((k 0 (+ k 1)))
			((= k ramp-ctr))
		      (if (>= (ramps k) 0)
			  (begin
			    (set! (ramps j) (ramps k))
			    (set! j (+ j 1)))))
		    (set! ramp-ctr j)))))
	  
	  (outa i (formant-bank fs inputs)))))))


;;; (with-sound (:statistics #t) (dissolve-fade 0 1 1.0 "oboe.snd" "trumpet.snd" 256 2 0 128))
;;; (float-vector->channel (with-sound ((make-float-vector 44100)) (dissolve-fade 0 2 1 0 1 4096 2 2 #f)))
;;;
;;; another neat effect here is to simply let the random changes float along with no
;;; direction -- if the hit is 1.0 send it toward 0.0 and vice versa -- strange
;;; pitches emerge from noises etc



#|
;;; make it easy to see and hear:

(with-sound ("p1.snd") 
  (let ((g (make-ncos 200 100)))
    (do ((i 0 (+ i 1)))
	((= i 100000))
      (outa i (ncos g)))))

(with-sound ("p2.snd") 
  (let ((g (make-ncos 123 100)))
    (do ((i 0 (+ i 1)))
	((= i 100000))
      (outa i (ncos g)))))

(with-sound (:statistics #t) 
  (cross-fade 0 2 1.0 "p1.snd" "p2.snd" 0.5 1.0 0 .1 256 2))

(with-sound (:statistics #t) 
  (dissolve-fade 0 2 1.0 "p1.snd" "p2.snd" 256 2 0 128))
|#