1;;; SNDWARP
2
3(provide 'snd-sndwarp.scm)
4(if (not (provided? 'snd-env.scm)) (load "env.scm")) ; normalize-envelope
5
6;;;
7;;; CLM 3 implementation of Richard Karpen's SNDWARP Csound Ugen.
8;;; By Bret Battey. http://www.BatHatMedia.com
9;;; translated to Scheme by Bill S Feb-05
10;;;   changes for the optimizer 24-Oct-06
11;;;
12;;; Except as noted below, the parameters are modeled directly after
13;;; the Csound version of sndwarp.
14
15;;; ISSUES
16;;;
17;;; Output in this new CLM version is seeming quite noisy/clipped (?)
18;;; Varying stereo/mono input/output has not been tested in clm2 alterations.
19;;; Hasn't been tested with differing input and output file sampling rates.
20;;; Uses half-sine envelope only; doesn't support alternative windowing envs.
21;;; Csound-style attack doesn't strictly match Csound results
22
23;;; SNDWARP KEY PARAMETERS
24;;;
25;;; amp = Amplitude
26;;;       [number]
27;;;
28;;; amp-env = Amplitude envelope
29;;;           [envelope]
30;;;
31;;; stretch = Stretch value or time pointer envelope (see 'time-ptr')
32;;;           [number or envelope expressed in either stretch values
33;;;            (for stretch mode) or in seconds (in time-ptr mode)]
34;;;
35;;; srate = Resampling scalar (1 = same pitch, .5 = 1 octave lower, etc.)
36;;;         A negative srate will read backwards into the soundfile from
37;;;         the start of each read window (not available in Csound version).
38;;;         [number or envelope]
39;;;
40;;; inputbeg = Source file input offset. In 'stretch' mode (see 'time-ptr'),
41;;;            soundfile read will begin at inputbeg. In 'time-ptr' mode,
42;;;            inputbeg will be added to the time pointer.
43;;;            [number, in seconds]
44;;;
45;;; wsize = Size of the sndwarp windows.
46;;;         [number, in seconds]
47;;;
48;;; randw = Range of random values to be added to wsize
49;;;         [number, in seconds]
50;;;
51;;; overlaps = number of window overlaps
52;;;            [number per second]
53;;;
54;;; time-ptr = Flag to determine whether stretching or time-pointer mode
55;;;            is to be used in interpreting the 'stretch' parameter.
56;;;               In stretch mode, the value of 'stretch' will scale the time
57;;;            of the sound. For example, a value of 2 will stretch the sound
58;;;            by 2 times. Note that stretch values of or near 0 are not
59;;;            viable since window advance times are determined by dividing
60;;;            by the stretch value.
61;;;               In time-ptr mode, the value(s) of stretch are readin pointers
62;;;            into the soundfile. For example, to read through a file
63;;;            backwards from 2 seconds at half speed, one would use a
64;;;            stretch envelope like [0 2 1 0] with a 4 second note duration.
65;;;            [NIL = stretch mode, T = time-ptr mode]
66;;;
67;;; scale-time-ptr = Flag to determine whether the time-ptr envelope will be
68;;;                  interpreted in absolute seconds or rescaled to fit the
69;;;                  duration of the input sound file.
70;;;                  {not part of csound implementation}
71;;;                  [NIL = absolute, T = rescale]
72;;;
73;;; zero-start-time-ptr = Flag to determine when in time-ptr mode whether
74;;;                       the first section of windows will start at
75;;;                       time-ptr = 0.
76;;;                       The csound sndwarp makes this assumption, so you
77;;;                       always get a bit of the attack of the sound even
78;;;                       if you try to run the time pointer starting in
79;;;                       the middle or end.
80;;;                       [NIL = first section starts according to time-ptr,
81;;;                        T = first section always starts at time-ptr = 0]
82;;;
83;;; sndwarp-window-offset = Flag to determine how the windows are offset
84;;;                         in time. T = Csound sndwarp style, windows
85;;;                         in different layers line up.
86;;;                         NIL = spread evenly.
87;;;
88;;; loc =  Stereo panning position, where 0 = left and 1 = right.
89;;;        Uses simple sqrt method.
90;;;        [number or envelope]
91;;;
92;;; rev = Scalar for reverb sending to a CLM  reverb instrument.
93;;;       [number or envelope]
94;;;
95;;; status = Flag to control whether SNDWARP prints a window %-complete count
96;;;          while working.
97;;;          [NIL = no status printing, T = status printing]
98;;;
99;;; srcwidth = width of the sinc function used in the interpolation function of
100;;;            CLM's "src" -- which provides the resampling in sndwarp. Defaults to
101;;;            5. If you hear high-frequency artifacts in the output sound, try
102;;;            increasing this number.
103;;;
104
105;;; SNDWARP DEFAULTS
106
107(define sndwarp-amp 1.0)
108(define sndwarp-amp-env '(0 1 100 1))
109(define sndwarp-stretch 1.0)
110(define sndwarp-srate 1.0)
111(define sndwarp-inputbeg 0.0)
112(define sndwarp-wsize 0.1) ; csound manual recommended start = .1
113(define sndwarp-randw 0.02) ; csound manual recommended start = .02
114(define sndwarp-overlaps 15) ; csound manual recommended start = 15
115(define sndwarp-time-ptr #f)
116(define sndwarp-scale-time-ptr #f)
117(define sndwarp-zero-start-time-ptr #f) ; #t to match csound
118(define sndwarp-window-offset #f) ; #t to match csound
119(define sndwarp-loc 0.5)
120(define sndwarp-rev 0.1)
121(define sndwarp-srcwidth 5)
122
123;;; UTILITY FUNCTIONS
124
125(define clmsw-2pi (* 2 pi))
126
127;;; SNDWARP
128
129(define* (sndwarp begtime dur file
130		  (amp sndwarp-amp)
131		  (amp-env sndwarp-amp-env)
132		  (stretch sndwarp-stretch)
133		  (srate sndwarp-srate)
134		  (inputbeg sndwarp-inputbeg)
135		  (wsize sndwarp-wsize)
136		  (randw sndwarp-randw)
137		  (overlaps sndwarp-overlaps)
138		  (time-ptr sndwarp-time-ptr)
139		  (scale-time-ptr sndwarp-scale-time-ptr)
140		  (zero-start-time-ptr sndwarp-zero-start-time-ptr)
141		  (window-offset sndwarp-window-offset)
142		  (loc sndwarp-loc)
143		  (rev sndwarp-rev)
144		  (srcwidth sndwarp-srcwidth))
145
146  (let* ((stereo-i (= (mus-sound-chans file) 2))
147	 (f-a (make-readin file :channel 0))
148	 (f-b (and stereo-i
149		   (make-readin file :channel 1)))
150	 (clmsw-envelope-or-number
151	  (lambda (in)
152	    (if (number? in) (list 0 in 1 in) in)))
153
154	 (beg (seconds->samples begtime))
155	 (fsr (mus-sound-srate file))
156	 (rdA (make-src :input (lambda (dir) (readin f-a)) :srate 0.0 :width srcwidth))
157	 (rdB (and stereo-i
158		   (make-src :input (lambda (dir) (readin f-b)) :srate 0.0 :width srcwidth)))
159	 (windf (make-oscil))
160	 (wsizef (make-env (clmsw-envelope-or-number wsize) :duration dur))
161
162	 (ampf (make-env amp-env :scaler amp :duration dur))
163	 (sratef (make-env (clmsw-envelope-or-number srate) :duration dur))
164	 (timef (let ((time-env (clmsw-envelope-or-number stretch))
165		      (fdur (mus-sound-duration file)))
166		  (make-env
167		   (if (and time-ptr scale-time-ptr)
168		       (normalize-envelope time-env (- fdur inputbeg))
169		       time-env)
170		   :duration dur)))
171	 (locf (make-env (clmsw-envelope-or-number loc) :duration dur))
172
173	 (end (+ beg (seconds->samples dur)))
174         (stereo-o #f)
175         (writestart 0)
176         (readstart (round (* fsr inputbeg)))
177         (eow-flag #f)
178         (overlap-ratio 0.0000)
179         (overlap-ratio-compl 0.0000)
180         (outa-val 0.0000)
181         (outb-val 0.0000))
182
183    (do ((overlap 0 (+ 1 overlap)))
184	((or eow-flag (= overlap overlaps)))
185      (set! overlap-ratio (/ overlap overlaps))
186      (set! overlap-ratio-compl (- 1 overlap-ratio))
187      (set! eow-flag #f)
188      (set! writestart beg)
189      (set! (mus-location ampf) beg)
190      (set! (mus-location locf) beg)
191      (do ((section 0 (+ 1 section)))
192	  ((or eow-flag (= overlap overlaps)))
193	(set! (mus-location timef) writestart)
194	(set! (mus-location sratef) writestart)
195	(set! (mus-location wsizef) writestart)
196	(set! wsize (env wsizef))
197	(let* ((winlen (if (= overlap 0 section) ; first section of first overlap isn't randomized
198			   wsize
199			   (+ wsize (random randw))))
200	       (winsamps (seconds->samples winlen))
201	       (srate-val (env sratef)))
202	  (let ((time-val (env timef)))
203	    ;; Even for the first section's truncated envelopes, the frequency of the envelope must be as if the envelope were full duration.
204	    (set! (mus-frequency windf) (* .5 (/ fsr winsamps)))
205	    ;; Set windowing oscillator to starting phase and appropriate frequency to provide half-sine envelope over window.
206	    ;; Phase must be altered for first envelope of each overlap stream.
207	    (set! (mus-phase windf)
208		  (if (and (= section 0)
209			   (not (= overlap 0)))
210		      (* .5 clmsw-2pi overlap-ratio-compl)
211		      0.0))
212	    ;; Either use the absolute time pointer or a scaled increment.
213	    ;; If first section in scaled mode, must initialize section readstart to beginning plus first overlap position.
214	    ;; In both cases, need to alter readstart and length of first section's windows based on phase of overlap
215	    (if time-ptr
216		;; TIME-PTR mode
217		(if (= section 0)
218		    ;; initial section
219		    (let ((overlap-start
220			   (if (and window-offset
221				    (not (= overlap 0)))
222			       ;; Csound style - start each overlap series further into the soundfile
223			       (round (* winlen overlap-ratio-compl))
224			       ;; Alternative style - start each overlap series at 0
225			       0))
226			  ;; To match csound version, first section must start reading at 0. Using zero-start-time-ptr
227			  ;; flag = #f,  however, allows first section to start as determined by time-ptr instead.
228			  (adj-time-val (if zero-start-time-ptr 0.0 time-val)))
229		      (set! readstart (round (* fsr (+ inputbeg overlap-start adj-time-val))))
230		      (if (not (= overlap 0)) (set! winsamps (floor (* winsamps overlap-ratio)))))
231		    ;; remaining sections
232		    (set! readstart (round (* fsr (+ inputbeg time-val)))))
233		;; STRETCH mode
234		(if (= section 0)
235		    ;; initial section
236		    (let ((init-read-start
237			   (if (and window-offset
238				    (not (= overlap 0)))
239			       ;; Csound style - start each overlap series further into the soundfile
240			       (round (* winlen overlap-ratio-compl))
241			       ;; Alternative style - start each overlap series at 0
242			       0)))
243		      (set! readstart (round (* fsr (+ inputbeg init-read-start))))
244		      (if (not (= overlap 0)) (set! winsamps (floor (* winsamps overlap-ratio)))))
245		    ;; remaining sections
246		    (set! readstart (round (+ readstart (* fsr (/ winlen time-val))))))))
247	  ;; Set readin position and sampling rate
248	  (set! (mus-location f-a) readstart)
249	  (set! (mus-increment rdA) srate-val)
250	  (mus-reset rdA)
251	  (if stereo-i
252	      (begin
253		(set! (mus-location f-b) readstart)
254		(set! (mus-increment rdB) srate-val)
255		(mus-reset rdB)))
256	  ;; Write window out
257	  (do ((k 0 (+ 1 k))
258	       (i writestart (+ i 1)))
259	      ((or eow-flag (= k winsamps)))
260	    (if (> i end)
261		(begin
262		  (set! eow-flag #t)
263		  (set! overlap (+ 1 overlaps)))
264		(let* ((amp-val (env ampf))
265		       (loc-val (env locf))
266		       (win-val (oscil windf))
267		       (sampa (* (src rdA) win-val))
268		       (sampb (if stereo-i (* (src rdB) win-val))))
269		  ;; channel panning
270		  (if stereo-o
271		      (let ((apan (sqrt loc-val))
272			    (bpan (sqrt (- 1 loc-val))))
273			(set! outa-val (* amp-val apan sampa))
274			(set! outb-val (* amp-val bpan (if stereo-i sampb sampa))))
275		      ;; stereo in, mono out
276		      (set! outa-val (* amp-val (if stereo-i
277						    (* (+ sampa sampb) .75)
278						    ;; mono in, mono out
279						    sampa))))
280		  ;; output
281		  (outa i outa-val)
282		  (if stereo-o
283		      (begin
284			(outb i outb-val)
285			(if *reverb* (outa i (* rev outa-val) *reverb*)))))))
286	  (if (and (not eow-flag)   ;; For first section, have to backup readstart
287		   (= section 0)
288		   (> overlap 0)
289		   (not time-ptr))
290	      (set! readstart (- readstart (round (* fsr winlen overlap-ratio-compl)))))
291	  (set! writestart (+ writestart winsamps)))))))
292