[foo-cvs] foo/elkfoo/scripts Makefile.am, NONE, 1.1 foocat, NONE, 1.1 foodiary, NONE, 1.1 foofold, NONE, 1.1 foosine, NONE, 1.1

[Martin R. <ru...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scripts
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv1235

Added Files:
	Makefile.am foocat foodiary foofold foosine 
Log Message:
initial checkin!

--- NEW FILE: foosine ---
#!/usr/local/bin/foo -- --unload control

;; foo scripting example
;; (c) 2004-2005 rumori

(require 'cmdline)

;; checking command line
(let*
    ;; single-opt or equiv-opts-list | mandatory? | with-params? | help-string
    ((option-list '(("--help" #f #f "this help screen")
		    (("--freq" "-f") #t #t "frequency (hz)")
		    (("--amp" "-a") #t #t "amplitude (0...1)")
		    (("--dur" "-d") #t #t "duration (s)")))
     (help
      (lambda ()
	(format #t "usage: ~a [options]\noptions understood:\n" (car (foo:script-args)))
	(format #t "~a\n" (cmdline:help-message option-list))
	(exit)))
     (number-check
      (lambda (arg description)
	(if (not (number? arg))
	    (begin
	      (format #t "~a has to be number!\n" description)
	      (help)))))
     (freq)
     (amp)
     (dur))

  ;; help needed?
  (if (cmdline:option-given? (foo:script-args) option-list "--help")
      (help))
  ;; validate cmdline
  (if (not (cmdline:cmdline-valid? (cdr (foo:script-args)) option-list #t))
      (help))
  ;; get parameters (take in account just 1st param of each option)
  (set! freq (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--freq"))))
  (set! amp (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--amp"))))
  (set! dur (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--dur"))))
  ;; check parameters
  (number-check freq "frequency")
  (number-check amp "amplitude")
  (number-check dur "duration")

  (format #t "~a script example~%" (car (foo:script-args)))
  (format #t "creating, playing and removing a test-file.~%")

  (format #t "frequency: ~a amplitude: ~a duration: ~a~%" freq amp dur)

  (format #t "synthesizing...~%")

  ;; here we do the major work
  (syn 1 dur (output~ 1 (mul~ (~ amp) (sine~ (~ freq)))))

  (format #t "~%playing using '~a'~%" foo-default-play-command)

  (play)

  (format #t "exiting (will remove temporary file as well)~%"))

(quit)

;; done

--- NEW FILE: foodiary ---
#!/usr/local/bin/foo -- --unload control

;; foodiary: make your sound diary
;; (c) 2007 plessas, rumori

(require 'cmdline)

(let*
    ;; check commandline

    ;; single-opt or equiv-opts-list | mandatory? | with-params? | help-string
    ((option-list '((("--help" "-h") #f #f "this help screen")
		    (("--outfile" "-o") #t #t "output file")
		    (("--type" "-t") #f #t "output file type [guessed]")
		    (("--sformat" "-s") #f #t "output file sample format [1st input file]")
		    (("--srate" "-r") #f #t "output file sample rate [1st input file]")
		    (("--channels" "-c") #f #t "output file channels [1st input file]")
		    (("--quality" "-q") #f #t "resampling quality (2...50) [16]")
		    (("--force" "-f") #f #f "overwrite output file if existing")
		    (("--period" "-p") #t #t "period interval in source (s)")
		    (("--duration" "-d") #f #t "slice duration in source (s) [period interval]")
		    (("--xfadelength" "-l") #f #t "cross fade length (s) [0]")
		    (("--xfadetype" "-x") #f #t "cross fade type (log|expon|line) [log]")
		    (("--begin" "-b") #f #t "begin position in source (s) [0]")
		    (("--end" "-e") #f #t "end position (s) [file end]")))

     (help
      (lambda ()
	(format #t "~a: make diary out of soundfile(s)~%" (car (foo:script-args)))
	(format #t "usage: ~a [options] -o outfile infile [infile ...]~%options understood:~%" (car (foo:script-args)))
	(format #t "~a~%" (cmdline:help-message option-list))
	(exit)))

     (error
      (lambda (error-msg . print-help)
	(display (format #t "~a: ~a~%" (car (foo:script-args)) error-msg))
	(if (and (not (null? print-help)) (eq? (car print-help) #t))
	    (begin
	      (newline)
	      (help))
	    (exit))))
     
     (infiles)
     (outfile)
     (type)
     (format)
     (srate)
     (channels)
     (period)
     (duration)
     (xfadelength)
     (xfadeinalpha)			; encodes xfadetype
     (xfadeoutalpha)			; encodes xfadetype
     (begint)				; start offset in infile
     (endt)				; end offset in infile
     (curinpos)				; current infile position
     (curoutpos)			; current outfile position
     (outinc)				; outputfile increment
     (normenv~)				; slice envelope
     (startenv~)			; slice env (first slice)
     (endenv~)				; slice env (last slice)
     (noenv~)				; slice env (only slice: no env)
     (overalldur 0)
     (c)				; context
     (t)				; task
     )

  ;; help requested?
  (if (cmdline:option-given? (foo:script-args) option-list "--help")
      (help))
  ;; validate cmdline
  (if (not (cmdline:cmdline-valid? (foo:script-args) option-list #t))
      (help))

  ;; get parameters (take in account just 1st param of each option)

  ;; input files
  (set! infiles (cmdline:get-arguments (cdr (foo:script-args)) option-list))
  (if (null? infiles)
      (error "no input files given on commandline!")
      (letrec
	  ((exists (lambda (files)
		     (cond ((null? files) #f)
			   ((file-exists? (car files)) (exists (cdr files)))
			   (else
			    (error (string-append "input file not found: " (car files))))))))
	(exists infiles)))
  
  ;; FIXME
  (if (> (length infiles) 1)
      (error "multiple input files not yet supported."))

  ;; outfile name
  (set! outfile (car (cmdline:get-option-param (foo:script-args) option-list "--outfile")))

  ;; filetype
  (if (cmdline:option-given? (foo:script-args) option-list "--type")
      (set! type (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--type"))))
      (set! type
	    ;; guess type from extension
	    (let*
		((rev (list->string (reverse! (string->list outfile))))
		 (guess (substring? "." rev))
		 (ext (if guess
			  (foo:soundfile-extension-type (list->string (reverse! (string->list (substring rev 0 (1+ guess))))))
			  #f)))
	      (if ext
		  ext
		  (soundfile-filetype (car infiles))))))
  
  ;; sample format
  (if (cmdline:option-given? (foo:script-args) option-list "--sformat")
      (set! format (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--sformat"))))
      (set! format (soundfile-format (car infiles))))

  ;; samplerate
  (if (cmdline:option-given? (foo:script-args) option-list "--srate")
      (set! srate (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--srate"))))
      (set! srate (soundfile-srate (car infiles))))

  ;; channels
  (if (cmdline:option-given? (foo:script-args) option-list "--channels")
      (set! channels (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--channels"))))
      (set! channels (soundfile-channels (car infiles))))

  ;; taps
  (if (cmdline:option-given? (foo:script-args) option-list "--quality")
      (let ((taps (* 2 (inexact->exact (/ (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--quality"))) 2)))))
	(cond ((< taps 4) (set! taps 4))
	      ((> taps 50) (set! taps 50)))
	(foo:set-default-taps! taps))
      (foo:set-default-taps! 16))

  ;; period
  (set! period (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--period"))))
  (if (< period 0)
      (error "negative period not allowed!"))

  ;; duration
  (if (cmdline:option-given? (foo:script-args) option-list "--duration")
      (begin
	(set! duration (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--duration"))))
	(if (< duration 0)
	    (error "negative duration not allowed!")))
      (set! duration period))
  
  ;; xfadelength
  (if (cmdline:option-given? (foo:script-args) option-list "--xfadelength")
      (begin
	(set! xfadelength (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--xfadelength"))))
	(cond
	 ((< xfadelength 0)
	  (error "negative xfadelength not allowed!"))
	 ((> (* 2 xfadelength) duration)
	  (error "xfadelength longer than half of duration!"))))
      (set! xfadelength 0))
  
  ;; xfadetype
  (if (cmdline:option-given? (foo:script-args) option-list "--xfadetype")
      (let ((xfadetype (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--xfadetype")))))
	(cond ((eq? xfadetype 'log)
	       (set! xfadeinalpha 0.1) ;; FIXME
	       (set! xfadeoutalpha 9.9)) ;; FIXME
	      ((eq? xfadetype 'expon)
	       (set! xfadeinalpha 9.9) ;; FIXME
	       (set! xfadeoutalpha 0.1) ;; FIXME
	      ((eq? xfadetype 'line)
	       (set! xfadeinalpha 1)
	       (set! xfadeoutalpha 1))
	      (else
	       (error "xfadetype not valid!" #t)))))
      (begin
	(set! xfadeinalpha 0.1) ;; FIXME
	(set! xfadeoutalpha 9.9))) ;; FIXME
  
  ;; begint
  (if (cmdline:option-given? (foo:script-args) option-list "--begin")
      (set! begint (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--begin"))))
      (set! begint 0))

  ;; endt
  (if (cmdline:option-given? (foo:script-args) option-list "--end")
      (begin
	(set! endt (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--end"))))
	(if (> endt (soundfile-length (car infiles)))
	    (error "end position beyond end of input file!")))
      (set! endt (soundfile-length (car infiles)))) ;; needs further attention

  (if (< (- endt begint) duration)
      (error "interval between begin and end positions shorter than one slice!"))
  
  ;; outfile increment
  (set! outinc (- duration xfadelength))

  ;; prepare context
  (set! c (context channels))

  ;; make envelope signals
  (cond
   ;; make-bpf needs strictly ascending time values
   ;; this is a workaround for zero-length-crossfades: FIXME!
   ((= xfadelength 0)
    (with-context c (lambda ()
		      (set! normenv~ (lambda () (~ 1)))
		      (set! startenv~ (lambda () (~ 1)))
		      (set! endenv~ (lambda () (~ 1)))
		      (set! noenv~ (lambda () (~ 1))))))
   ;; make-bpf needs strictly ascending time values
   ;; this is a workaround for a corner-case: no sustain phase
   ((= (* 2 xfadelength) duration)
    (with-context c (lambda ()
		      (set! normenv~ (lambda () (read-bpf~ (make-bpf `((0 0) (,xfadelength 1 ,xfadeinalpha) (,duration 0 ,xfadeoutalpha))))))
		      (set! startenv~ (lambda () (read-bpf~ (make-bpf `((0 1) (,outinc 1) (,duration 0 ,xfadeoutalpha))))))
		      (set! endenv~ (lambda () (read-bpf~ (make-bpf `((0 0) (,xfadelength 1 ,xfadeinalpha) (,duration 1))))))
		      (set! noenv~ (lambda () (~ 1))))))
   ;; in a better foo world, this should be sufficient for all cases
   (else
    (with-context c (lambda ()
;;		      (set! normenv~ (lambda () (read-bpf~ (make-bpf (list '(0 0) (list xfadelength 1 xfadeinalpha) (list outinc 1) (list duration 0 xfadeoutalpha))))))
		      (set! normenv~ (lambda () (read-bpf~ (make-bpf `((0 0) (,xfadelength 1 ,xfadeinalpha) (,outinc 1) (,duration 0 ,xfadeoutalpha))))))
		      (set! startenv~ (lambda () (read-bpf~ (make-bpf `((0 1) (,outinc 1) (,duration 0 ,xfadeoutalpha))))))
		      (set! endenv~ (lambda () (read-bpf~ (make-bpf `((0 0) (,xfadelength 1 ,xfadeinalpha) (,duration 1))))))
		      (set! noenv~ (lambda () (~ 1)))))))

  (letrec
      ;; process all channels for one slice
      ((cat-slice (lambda (slice chan off env~)
		    (if (> chan 0)
			(begin
			  (if (>= (snd-channels slice) chan)
			      ;; do the actual work per channel
			      (output~ chan (time off (gate~ (mul~ (env~) (read-snd~ (snd-extract slice chan))) (snd-length slice)))))
			  (cat-slice slice (1- chan) off env~)))))
		      
       ;; process all slices of input sound
       (cat-slices (lambda (snd curinpos curoutpos)
		     (cond
		      ;; corner case: first slice is the only slice
		      ((and (= curoutpos 0)
			    (>= (+ curinpos period) (snd-length snd)))
		       (cat-slice (snd-region snd curinpos duration)
				  channels
				  curoutpos
				  noenv~))
		      ;; first slice
		      ((= curoutpos 0)
		       ;; current slice
		       (cat-slice (snd-region snd curinpos duration)
				  channels
				  curoutpos
				  startenv~)
		       ;; next slice(s)
		       (cat-slices snd
				   (+ curinpos period)
				   (+ curoutpos outinc)))
		      ;; last slice truncated
		      ((>= (+ curinpos duration) (snd-length snd))
		       (cat-slice (snd-region snd curinpos (- (snd-length snd) curinpos))
				  channels
				  curoutpos
				  endenv~))
		      ;; last slice complete
		      ((>= (+ curinpos period) (snd-length snd))
		       (cat-slice (snd-region snd curinpos duration)
				  channels
				  curoutpos
				  endenv~))
		      ;; normal slice
		      (else
		       ;; current slice
		       (cat-slice (snd-region snd curinpos duration)
				  channels
				  curoutpos
				  normenv~)
		       ;; next slice(s)
		       (cat-slices snd
				   (+ curinpos period)
				   (+ curoutpos outinc)))))))

    ;; kick the ass off
    (with-context c (lambda ()
		      (let*
			  ((snd (snd-region (open-snd (car infiles))
					    begint
					    (- endt begint)))
			   (numslices (/ (snd-length snd)
					 period))
			   (lastslice (* (- numslices (trunc numslices))
					 (/ period duration)))
			   (dur (+ (* (ceiling (1- numslices))
				      (- duration xfadelength))
				   ;; truc de malade
				   (* (if (or (= lastslice 0) (>= lastslice 1))
					  duration
					  (* lastslice duration))))))
			(set! overalldur (+ overalldur dur))
			(cat-slices snd
				    0
				    0)))))

  ;; soundfile
  (if (cmdline:option-given? (foo:script-args) option-list "--force")
      (create-soundfile outfile type format srate channels)
      (make-soundfile outfile type format srate channels))
    
  ;; task
  (set! t (make-task 0 0 outfile c 'punch srate))

  ;; do it
  (run-task t overalldur))

(quit)

;; EOF

--- NEW FILE: foofold ---
#!/usr/local/bin/foo -- --unload control

;; foofold: fold soundfiles
;; (c) 2006 rumori

(require 'cmdline)

(let*
    ;; check commandline

    ;; single-opt or equiv-opts-list | mandatory? | with-params? | help-string
    ((option-list '((("--help" "-h") #f #f "this help screen")
		    (("--outfile" "-o") #t #t "output file")
		    (("--type" "-t") #f #t "output file type [guessed]")
		    (("--sformat" "-s") #f #t "output file sample format [input file]")
		    (("--srate" "-r") #f #t "output file sample rate [input file]")
		    (("--channels" "-c") #f #t "output file channels [input file]")
		    (("--parts" "-p") #f #t "foldover factor [1]")
		    (("--quality" "-q") #f #t "resampling quality (2...50) [16]")
		    (("--force" "-f") #f #f "overwrite output file if existing")))
     (help
      (lambda ()
	(format #t "~a: fold soundfiles~%" (car (foo:script-args)))
	(format #t "usage: ~a [options] -o outfile infile~%options understood:~%" (car (foo:script-args)))
	(format #t "~a~%" (cmdline:help-message option-list))
	(exit)))
     (infiles)
     (outfile)
     (type)
     (format)
     (srate)
     (channels)
     (numparts 1)
     (c) ; context
     (t) ; task
     (maxdur) ; overall duration
     )

  ;; help requested?
  (if (cmdline:option-given? (foo:script-args) option-list "--help")
      (help))
  ;; validate cmdline
  (if (not (cmdline:cmdline-valid? (foo:script-args) option-list #t))
      (help))

  ;; get parameters (take in account just 1st param of each option)

  ;; input files
  (set! infiles (cmdline:get-arguments (cdr (foo:script-args)) option-list))
  (cond ((null? infiles)
	 (begin
	   (display "no input file given on commandline!")
	   (newline)
	   (help)))
	((> (length infiles) 1)
	 (begin
	   (display "more than one input file given on commandline!")
	   (newline)
	   (help)))
	(else
	 (letrec
	     ((exists (lambda (files)
			(cond ((null? files) #f)
			      ((file-exists? (car files)) (exists (cdr files)))
			      (else
			       (display (string-append "input file not found: " (car files)))
			       (newline)
			       (exit))))))
	   (exists infiles))))
  
  ;; outfile name
  (set! outfile (car (cmdline:get-option-param (foo:script-args) option-list "--outfile")))

  ;; filetype
  (if (cmdline:option-given? (foo:script-args) option-list "--type")
      (set! type (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--type"))))
      (set! type
	    ;; guess type from extension
	    (let*
		((rev (list->string (reverse! (string->list outfile))))
		 (guess (substring? "." rev))
		 (ext (if guess
			  (foo:soundfile-extension-type (list->string (reverse! (string->list (substring rev 0 (1+ guess))))))
			  #f)))

	      (if ext
		  ext
		  (soundfile-filetype (car infiles))))))
  
  ;; sample format
  (if (cmdline:option-given? (foo:script-args) option-list "--sformat")
      (set! format (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--sformat"))))
      (set! format (soundfile-format (car infiles))))

  ;; samplerate
  (if (cmdline:option-given? (foo:script-args) option-list "--srate")
      (set! srate (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--srate"))))
      (set! srate (soundfile-srate (car infiles))))

  ;; channels
  (if (cmdline:option-given? (foo:script-args) option-list "--channels")
      (set! channels (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--channels"))))
      (set! channels (soundfile-channels (car infiles))))

  ;; taps
  (if (cmdline:option-given? (foo:script-args) option-list "--quality")
      (let ((taps (* 2 (inexact->exact (/ (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--quality"))) 2)))))
	(cond ((< taps 4) (set! taps 4))
	      ((> taps 50) (set! taps 50)))
	(foo:set-default-taps! taps))
      (foo:set-default-taps! 16))

  ;; numparts
  (if (cmdline:option-given? (foo:script-args) option-list "--parts")
      (set! numparts (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--parts")))))

  ;; prepare context
  (set! c (context channels))

  ;; part length
  (set! maxdur (/ (soundfile-length (car infiles)) numparts))

  ;; parts
  (with-context c (lambda ()
		    (let loop ((i numparts)
			       (c 0))
		      (if (> i 0)
			  (let*
			      ((snd (snd-region (open-snd (car infiles)) (* (1- i) maxdur) maxdur))
;;			       (normfact (* (/ (/ 1 (cdr (snd-absolute-maximum snd))) numparts) channels)))
			       (normfact (* (/ 1 numparts) channels)))
			    (output~ (1+ c) (mul~ (~ normfact) (read-snd~ snd)))
			    (loop (1- i)
				  (modulo (1+ c) channels)))))))

  ;; soundfile
  (if (cmdline:option-given? (foo:script-args) option-list "--force")
      (create-soundfile outfile type format srate channels)
      (make-soundfile outfile type format srate channels))
  
  ;; task
  (set! t (make-task 0 0 outfile c 'punch srate))

  ;; do it
  (run-task t maxdur)

  (quit))

;; EOF

--- NEW FILE: Makefile.am ---
# foo/elkfoo/scripts/Makefile.am
# 2007 rumori

# $Id: Makefile.am,v 1.1 2007/12/14 19:36:39 rumori Exp $

NULL = 

EXTRA_DIST = $(SCRIPTS_FILES)

noinst_DATA = $(SCRIPTS_FILES)

SCRIPTS_FILES = \
	foosine \
	foocat \
	foofold \
	foodiary \
	$(NULL)

--- NEW FILE: foocat ---
#!/usr/local/bin/foo -- --unload control

;; foocat: concatenate soundfiles
;; (c) 2004-2005 rumori

(require 'cmdline)

(let*
    ;; check commandline

    ;; single-opt or equiv-opts-list | mandatory? | with-params? | help-string
    ((option-list '((("--help" "-h") #f #f "this help screen")
		    (("--outfile" "-o") #t #t "output file")
		    (("--type" "-t") #f #t "output file type [guessed]")
		    (("--sformat" "-s") #f #t "output file sample format [1st input file]")
		    (("--srate" "-r") #f #t "output file sample rate [1st input file]")
		    (("--channels" "-c") #f #t "output file channels [1st input file]")
		    (("--quality" "-q") #f #t "resampling quality (2...50) [16]")
		    (("--gap" "-g") #f #t "gap between concatenated soundfiles [0s]")
		    (("--force" "-f") #f #f "overwrite output file if existing")))
     (help
      (lambda ()
	(format #t "~a: concatenate soundfiles~%" (car (foo:script-args)))
	(format #t "usage: ~a [options] -o outfile infile [infile ...]~%options understood:~%" (car (foo:script-args)))
	(format #t "~a~%" (cmdline:help-message option-list))
	(exit)))
     (infiles)
     (outfile)
     (type)
     (format)
     (srate)
     (channels)
     (gap 0)
     (c) ; context
     (t) ; task
     (maxdur) ; overall duration
     )

  ;; help requested?
  (if (cmdline:option-given? (foo:script-args) option-list "--help")
      (help))
  ;; validate cmdline
  (if (not (cmdline:cmdline-valid? (foo:script-args) option-list #t))
      (help))

  ;; get parameters (take in account just 1st param of each option)

  ;; input files
  (set! infiles (cmdline:get-arguments (cdr (foo:script-args)) option-list))
  (if (null? infiles)
      (begin
	(display "no input files given on commandline!")
	(newline)
	(help))
      (letrec
	  ((exists (lambda (files)
		     (cond ((null? files) #f)
			   ((file-exists? (car files)) (exists (cdr files)))
			   (else
			    (display (string-append "input file not found: " (car files)))
			    (newline)
			    (exit))))))
	(exists infiles)))
  
  ;; outfile name
  (set! outfile (car (cmdline:get-option-param (foo:script-args) option-list "--outfile")))

  ;; filetype
  (if (cmdline:option-given? (foo:script-args) option-list "--type")
      (set! type (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--type"))))
      (set! type
	    ;; guess type from extension
	    (let*
		((rev (list->string (reverse! (string->list outfile))))
		 (guess (substring? "." rev))
		 (ext (if guess
			  (foo:soundfile-extension-type (list->string (reverse! (string->list (substring rev 0 (1+ guess))))))
			  #f)))

	      (if ext
		  ext
		  (soundfile-filetype (car infiles))))))
  
  ;; sample format
  (if (cmdline:option-given? (foo:script-args) option-list "--sformat")
      (set! format (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--sformat"))))
      (set! format (soundfile-format (car infiles))))

  ;; samplerate
  (if (cmdline:option-given? (foo:script-args) option-list "--srate")
      (set! srate (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--srate"))))
      (set! srate (soundfile-srate (car infiles))))

  ;; channels
  (if (cmdline:option-given? (foo:script-args) option-list "--channels")
      (set! channels (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--channels"))))
      (set! channels (soundfile-channels (car infiles))))

  ;; taps
  (if (cmdline:option-given? (foo:script-args) option-list "--quality")
      (let ((taps (* 2 (inexact->exact (/ (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--quality"))) 2)))))
	(cond ((< taps 4) (set! taps 4))
	      ((> taps 50) (set! taps 50)))
	(foo:set-default-taps! taps))
      (foo:set-default-taps! 16))

  ;; gap
  (if (cmdline:option-given? (foo:script-args) option-list "--gap")
      (set! gap (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--gap")))))

  (set! maxdur (- gap)) ;; gap gets added once more
  
  ;; prepare context
  (set! c (context channels))

  (letrec
      ((cat-channel (lambda (snd chan off dur)
		      (if (> chan 0)
			  (begin
			    (if (>= (snd-channels snd) chan)
				;; do the actual work per channel
				(output~ chan (time off (gate~ (read-snd~ (snd-extract snd chan)) dur))))
			    (cat-channel snd (1- chan) off dur)))))
		      
       (cat-file (lambda (files lastoff)
		   (if (not (null? files))
		       (let*
			   ((snd (open-snd (car files)))
			    (dur (snd-length snd)))
			 (set! maxdur (+ maxdur dur gap))
			 (cat-channel snd channels lastoff dur)
			 (cat-file (cdr files) (+ lastoff dur gap)))))))

    (with-context c (lambda () (cat-file infiles 0))))

  ;; soundfile
  (if (cmdline:option-given? (foo:script-args) option-list "--force")
      (create-soundfile outfile type format srate channels)
      (make-soundfile outfile type format srate channels))
  
  ;; task
  (set! t (make-task 0 0 outfile c 'punch srate))

  ;; do it
  (run-task t maxdur)

  (quit))

;; EOF