[CM] extract track regions

[Anders Vinjar]

--=-=-=

Heres a version of Ricks parse-samples to do similar things with
Snd.  It works in the same manner: placing marks at the onsets,
ready to edit if needed, leaving to mark-explode or some such to
actually cut out the samples to sound-files.

; might be useful to do some normalizing or something first

(compand-channel) ; from examp.scm or somewhere


(map (lambda (x) (add-mark (seconds->samples (car x))))
   (parse-attacks #:len 1000 #:on 0.1 :off 0.1))

;; edit placement if needed, and do the splicing out

(mark-explode)

; ive used a modified version of mark-explode which splices from
; first mark onwards, and takes last cut from last mark to
; end-of-file, as well as small enveloping on start and end.

This leaves file-0.snd, file-1.snd... etc


--=-=-=
Content-Type: application/octet-stream
Content-Disposition: attachment; filename=parse-attacks.scm
Content-Description: parse-attacks for Snd

(define (buf-rms data)
  (let ((len (vct-length data)))
    (sqrt (/ (dot-product data data) len))))

(define (seconds->samples secs)
  "innebygget versjon er buggy"
  (inexact->exact (round (* secs (srate)))))

(define (samples->seconds samps)
  "innebygget versjon er buggy"
   (/ samps (srate)))


(define* (parse-attacks #&key
			(start 0)
			(len 512)
			(on 0.2)
			(off 0.2) 
			(file 0)
			(channel 0)
			(dur -1)
			(min-duration most-negative-fixnum)
			(bad '()))
  (let ((maxdur (and file (frames file))))
    (if (negative? dur) (set! dur (samples->seconds maxdur)))
    (format #t "dur: ~A ~&" dur)
    (let* ((times '())
	   (*srate* (srate file))
	   (beg (seconds->samples start))
	   (end (seconds->samples (min (+ start dur) maxdur)))
	   (buf (make-vct len))		; window for amp averaging
	   (sum 0.0)
	   (val 0.0)
	   (avr 0.0)
	   (j 0)
	   (k -1)
	   (on? #f)
	   (middle 0)
	   (ontime 0.0)
	   (offtime 0.0))

      ;; fill buf with first window
    
      (set! j 0)

      (do ((i beg (+ i len)))
	  ((>= i end) #f)
	(set! buf (samples->vct i len file channel))
	(set! avr (buf-rms buf))
	(if (not on?)
	    (if (>= avr on)
		(begin
		  (set! ontime (samples->seconds (1+ (- i len))))
		  (set! on? #t))
		#f)
	    (begin
	      (if (and (>= i middle) (<= avr off))
		  (let ((sdur 0))
		    (set! offtime (samples->seconds (- i len)))
		    (set! sdur (- offtime ontime))
		    (while (< sdur min-duration)
			   (set! bad (cons k bad)))
		    (set! times  (cons (list ontime offtime sdur)  times))
		    (set! on? #f))
		  #f))))
      (if (or times (not (null? bad)))
	  (if (not (null? bad))
	      (list (reverse times) (reverse bad))
	      (reverse times))
	  #f))))


--=-=-=


I need the functions 'seconds->samples and 'samples->seconds
included here because the default ones in snd seem to be
hardwired at srate=22050 or something.

Heres the version of mark-explode ive used here:


--=-=-=
Content-Type: application/octet-stream
Content-Disposition: attachment; filename=mark-explode.scm
Content-Transfer-Encoding: base64
Content-Description: tilted mark-explode

Cjs7OyB0aGlzIG9uZSBtYWtlcyBzZWxlY3Rpb25zIGZyb20gZmlyc3QgbWFyayBvbndhcmRz
LCBlbmRzIHdpdGgKOzs7IHNlbGVjdGlvbiBmcm9tIGxhc3QgbWFyayAtPiBlbmQgb2Ygc291
bmQuCgoKCihkZWZpbmUqIChtYXJrLWV4cGxvZGUgIzpvcHRpb25hbCAoc25kIChvciAoc2Vs
ZWN0ZWQtc291bmQpIChjYXIgKHNvdW5kcykpKSkKCQkgICAgICAgKGh0eXBlIG11cy1uZXh0
KSAoZGZvcm1hdCBtdXMtYmZsb2F0KQoJCSAgICAgICAoYWVudiAnKDAgMCAxIDEgOTkgMSAx
MDAgMCkpKQogICIobWFyay1leHBsb2RlIDpvcHRpb25hbCBoZWFkZXItdHlwZSBkYXRhLWZv
cm1hdCkgc3BsaXRzIGEgc291bmQgaW50byBhIGJ1bmNoIG9mIHNvdW5kcyBiYXNlZCBvbiBt
YXJrIHBsYWNlbWVudHMiCiAgKGxldCogKChmaWxlLWN0ciAwKQoJIChzdGFydCAobWFyay1z
YW1wbGUgKGNhciAoY2FyIChtYXJrcyBzbmQpKSkpKQoJIChlbmQgMCkKCSAobmFtZSAoYmFz
ZW5hbWUgKHNob3J0LWZpbGUtbmFtZSBzbmQpICIud2F2IikpKQogICAgKGZvci1lYWNoCiAg
ICAgKGxhbWJkYSAobWFyaykKICAgICAgIChzZXQhIGVuZCAobWFyay1zYW1wbGUgbWFyaykp
CiAgICAgICAoaWYgKD4gZW5kIHN0YXJ0KQoJICAgKGxldCAoKGZpbGVuYW1lIChmb3JtYXQg
I2YgIn5BLWV4cGxvZGUtfkQuc25kIiBuYW1lIGZpbGUtY3RyKSkpCgkgICAgIChzZXQhIGZp
bGUtY3RyICgxKyBmaWxlLWN0cikpCgkgICAgIChkbyAoKGkgMCAoMSsgaSkpKQoJCSAoKD0g
aSAoY2hhbnMgc25kKSkpCgkgICAgICAgKHNldCEgKHNlbGVjdGlvbi1tZW1iZXI/IHNuZCBp
KSAjdCkKCSAgICAgICAoc2V0ISAoc2VsZWN0aW9uLXBvc2l0aW9uIHNuZCBpKSBzdGFydCkK
CSAgICAgICAoc2V0ISAoc2VsZWN0aW9uLWZyYW1lcyBzbmQgaSkgKC0gZW5kIHN0YXJ0KSkp
CgkgICAgIChlbnYtc2VsZWN0aW9uIGFlbnYpCgkgICAgIChzYXZlLXNlbGVjdGlvbiBmaWxl
bmFtZSA6aGVhZGVyLXR5cGUgaHR5cGUgOmRhdGEtZm9ybWF0IGRmb3JtYXQgOnNyYXRlIChz
cmF0ZSBzbmQpKQoJICAgICAoZG8gKChpIDAgKDErIGkpKSkKCQkgKCg9IGkgKGNoYW5zIHNu
ZCkpKQoJICAgICAgIChzZXQhIChzZWxlY3Rpb24tbWVtYmVyPyBzbmQgaSkgI2YpKSkpCiAg
ICAgICAoc2V0ISBzdGFydCBlbmQpKQogICAgIChjZHIgKGNhciAobWFya3Mgc25kKSkpKQog
ICAgKGxldCAoKGZpbGVuYW1lIChmb3JtYXQgI2YgIn5BLWV4cGxvZGUtfkQuc25kIiBuYW1l
IGZpbGUtY3RyKSkpCiAgICAgIChzZXQhIGZpbGUtY3RyICgxKyBmaWxlLWN0cikpCiAgICAg
IChkbyAoKGkgMCAoMSsgaSkpKQoJICAoKD0gaSAoY2hhbnMgc25kKSkpCgkoc2V0ISAoc2Vs
ZWN0aW9uLW1lbWJlcj8gc25kIGkpICN0KQoJKHNldCEgKHNlbGVjdGlvbi1wb3NpdGlvbiBz
bmQgaSkgc3RhcnQpCgkoc2V0ISAoc2VsZWN0aW9uLWZyYW1lcyBzbmQgaSkgKC0gKGZyYW1l
cyBzbmQpIHN0YXJ0KSkpCiAgICAgIChzYXZlLXNlbGVjdGlvbiBmaWxlbmFtZSA6aGVhZGVy
LXR5cGUgaHR5cGUgOmRhdGEtZm9ybWF0IGRmb3JtYXQgOnNyYXRlIChzcmF0ZSBzbmQpKQog
ICAgICAoZG8gKChpIDAgKDErIGkpKSkKCSAgKCg9IGkgKGNoYW5zIHNuZCkpKQoJKHNldCEg
KHNlbGVjdGlvbi1tZW1iZXI/IHNuZCBpKSAjZikpKQogICAgKHVwZGF0ZS10aW1lLWdyYXBo
IHNuZCkpKQo=
--=-=-=--