[foo-cvs] foo/elkfoo/examples/scripts sndcat.foo,1.1,1.2

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

Update of /cvsroot/foo/foo/elkfoo/examples/scripts
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8813

Modified Files:
	sndcat.foo 
Log Message:
cleaned up, added parameters

Index: sndcat.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/examples/scripts/sndcat.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** sndcat.foo	12 Aug 2004 23:15:38 -0000	1.1
--- sndcat.foo	11 Dec 2005 23:21:03 -0000	1.2
***************
*** 1,43 ****
! #!/usr/local/bin/foo
  
  ;; sndcat: concatenate soundfiles
! ;; (c) 2004 rumori
  
! (if (< (length (command-line-args)) 3)
!     (begin
!       (format #t "usage: ~a <dest-file> <src-file> [<src-file> ...]\n" (car (command-line-args)))
!       (quit)))
  
! (define dest-file (list-ref (command-line-args) 1))
! (define source-files (cddr (command-line-args)))
  
! (define src-snds '())
! (define (dest-dur source-file)
!   (if (null? source-file)
!       0
!       (+ (soundfile-length (car source-file))
! 	 (dest-dur (cdr source-file)))))
  
! (define dest-channels (soundfile-channels (car source-files)))
  
! (define (cat-snd-channel snd channel offset)
!   (output~ channel (time offset (read-snd~ (snd-extract snd channel))))
!   (if (> channel 1)
!       (cat-snd-channel snd (1- channel) offset)))
  
! (define (cat-snd-file file offset)
!   (cat-snd-channel (open-snd (car file)) dest-channels offset)
!   (if (not (null? (cdr file)))
!       (cat-snd-file (cdr file) (+ offset (soundfile-length (car file))))))
  
! (define (sndcat)
!   (cat-snd-file source-files 0))
  
! (define cat-context
!   (context dest-channels (sndcat)))
  
! (create-soundfile dest-file 'short dest-channels (foo-default-srate) 'aiff)
  
! (define cat-task (make-task 0 0 dest-file cat-context))
  
! (run-task cat-task (dest-dur source-files))
--- 1,149 ----
! #!/usr/local/bin/foo --
  
  ;; sndcat: 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 from extension]")
! 		    (("--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 "insert 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)) ;; remove "trailing" gap after last sndfile
!   
!   ;; 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