|
From: Martin R. <ru...@us...> - 2008-01-07 21:20:05
|
Update of /cvsroot/foo/foo/elkfoo/scripts In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv11430 Modified Files: Makefile.am Added Files: foojoin Log Message: added foojoin script Index: Makefile.am =================================================================== RCS file: /cvsroot/foo/foo/elkfoo/scripts/Makefile.am,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Makefile.am 14 Dec 2007 19:55:42 -0000 1.2 --- Makefile.am 7 Jan 2008 21:20:02 -0000 1.3 *************** *** 17,19 **** --- 17,20 ---- foofold \ foodiary \ + foojoin \ $(NULL) --- NEW FILE: foojoin --- #!/usr/local/bin/foo -- --unload control ;; foojoin: make multichannel file out of mono files ;; (c) 2008 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 [number of input files]") (("--duration" "-d") #f #t "output file duration [1st input file]") (("--quality" "-q") #f #t "resampling quality (2...50) [16]") (("--force" "-f") #f #f "overwrite output file if existing") (("--zick" "-z") #f #f "check for equal samplerate, length and mono of input files [false]"))) (help (lambda () (format #t "~a: make multichannel file out of mono files~%" (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) (duration) (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))) ;; 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") (begin (set! channels (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--channels")))) (if (< channels (length infiles)) ;; truncate infiles list to number of channels (set! infiles (list-head infiles channels)))) (set! channels (length 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)) ;; duration (if (cmdline:option-given? (foo:script-args) option-list "--duration") (set! duration (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--duration")))) (set! duration (soundfile-length (car infiles)))) ;; zick (if (cmdline:option-given? (foo:script-args) option-list "--zick") (letrec ((length (soundfile-length (car infiles))) (srate (soundfile-srate (car infiles))) (check (lambda (files) (cond ((null? files) #f) ((not (= 1 (soundfile-channels (car files)))) (error (string-append "input file not mono: " (car files)))) ((not (= length (soundfile-length (car files)))) (error (string-append "input file length mismatch: " (car files)))) ((not (= srate (soundfile-srate (car files)))) (error (string-append "input file samplerate mismatch: " (car files)))) (else (check (cdr files))))))) (check infiles))) ;; prepare context (set! c (context channels)) ;; process files (with-context c (lambda () (letrec ((cat-file (lambda (files chan) (if (not (null? files)) (begin (output~ chan (read-snd~ (open-snd (car files)))) (cat-file (cdr files) (1+ chan))))))) (cat-file infiles 1)))) ;; 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 duration)) (quit) ;; EOF |