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