foo-cvs — mailing list for CVS commit messages.

[foo-cvs] foo/elkfoo/examples/scripts fsdiary.foo,1.2,1.3

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

Update of /cvsroot/foo/foo/elkfoo/examples/scripts
In directory sc8-pr-cvs17:/tmp/cvs-serv15937

Modified Files:
	fsdiary.foo 
Log Message:
some fixes again

Index: fsdiary.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/examples/scripts/fsdiary.foo,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fsdiary.foo	30 Sep 2007 13:10:20 -0000	1.2
--- fsdiary.foo	5 Oct 2007 15:50:59 -0000	1.3
***************
*** 24,27 ****
--- 24,28 ----
  		    (("--begin" "-b") #f #t "begin position in source (s) [0]")
  		    (("--end" "-e") #f #t "end position (s) [file end]")))
+ 
       (help
        (lambda ()
***************
*** 30,33 ****
--- 31,44 ----
  	(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)
***************
*** 39,55 ****
       (duration)
       (xfadelength)
!      (xfadetype)
!      (begint)
!      (endt)
!      (curinpos) ;; current infile position
!      (curoutpos) ;; current outfile position
!      (outinc) ;; outputfile increment
!      (normenv~)
!      (startenv~)
!      (endenv~)
!      (overalldur)
!      (c) ; context
!      (t) ; task
!      ;;     (maxdur) ; overall duration
       )
  
--- 50,67 ----
       (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
       )
  
***************
*** 66,73 ****
    (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)
--- 78,82 ----
    (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)
***************
*** 75,83 ****
  			   ((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")))
--- 84,94 ----
  			   ((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")))
***************
*** 124,131 ****
    (set! period (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--period"))))
    (if (< period 0)
!       (begin
! 	(display "negative period not allowed!")
! 	(newline)
! 	(exit)))
  
    ;; duration
--- 135,139 ----
    (set! period (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--period"))))
    (if (< period 0)
!       (error "negative period not allowed!"))
  
    ;; duration
***************
*** 134,168 ****
  	(set! duration (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--duration"))))
  	(if (< duration 0)
! 	    (begin
! 	      (display "negative duration not allowed!")
! 	      (newline)
! 	      (exit))))
        (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"))))
! 	(if (< xfadelength 0)
! 	    (begin
! 	      (display "negative xfadelength not allowed!")
! 	      (newline)
! 	      (exit))))
        (set! xfadelength 0))
    
!  ;; xfadetype
    (if (cmdline:option-given? (foo:script-args) option-list "--xfadetype")
        (begin
! 	(set! xfadetype (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--xfadetype"))))
! 	(if (not (or (equal? xfadetype 'log)
! 		     (equal? xfadetype 'expon)
! 		     (equal? xfadetype 'line)))
! 	    (begin
! 	      (display "xfadetype not valid!")
! 	      (newline)
! 	      (help))))
!       (set! xfadetype 'log))
    
!  ;; 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"))))
--- 142,178 ----
  	(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"))))
***************
*** 171,205 ****
    ;; endt
    (if (cmdline:option-given? (foo:script-args) option-list "--end")
!       (set! endt (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--end"))))
        (set! endt (soundfile-length (car infiles)))) ;; needs further attention
  
    ;; outfile increment
    (set! outinc (- duration xfadelength))
  
-   ;; overall duration
-   (set! overalldur
- 	(let
- 	    ((numslices (/ (soundfile-length (car infiles)) period)))
- 	  (+ (* (- duration xfadelength)
- 		(trunc numslices))
- 	     (* duration (- numslices (trunc numslices))))))
- 
    ;; prepare context
    (set! c (context channels))
  
    ;; make envelope signals
!   (if (= xfadelength 0)
!       ;; make-bpf needs strictly ascending time values: FIXME!
!       (with-context c (lambda ()
! 			(set! normenv~ (lambda () (~ 1)))
! 			(set! startenv~ (lambda () (~ 1)))
! 			(set! endenv~ (lambda () (~ 1)))))
!       (with-context c (lambda ()
! 			(set! normenv~ (lambda () (read-bpf~ (make-bpf (list '(0 0) (list xfadelength 1) (list outinc 1) (list duration 0))))))
! 			(set! startenv~ (lambda () (read-bpf~ (make-bpf (list '(0 1) (list outinc 1) (list duration 0))))))
! 			(set! endenv~ (lambda () (read-bpf~ (make-bpf (list '(0 0) (list xfadelength 1) (list duration 1)))))))))
  
    (letrec
!       ;; write single slice per channels
        ((cat-slice (lambda (slice chan off env~)
  		    (if (> chan 0)
--- 181,228 ----
    ;; 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)
***************
*** 210,236 ****
  			  (cat-slice slice (1- chan) off env~)))))
  		      
!        ;; write input file per slice
!        (cat-slices (lambda (file curoutpos curinpos)
! 		     (let*
! 			 ((snd (open-snd file)))
! 		       (cond
! 			;; first slice
! 			((= curoutpos 0)
! 			 (begin
! 			   (cat-slice (snd-region snd curinpos duration) channels curoutpos startenv~)
! 			   (cat-slices file (+ curoutpos outinc) (+ curinpos period))))
! 			;; 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
! 			 (begin
! 			   (cat-slice (snd-region snd curinpos duration) channels curoutpos normenv~)
! 			   (cat-slices file (+ curoutpos outinc) (+ curinpos period)))))))))
  
!     (with-context c (lambda () (cat-slices (car infiles) 0 begint))))
  
    ;; soundfile
--- 233,301 ----
  			  (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
***************
*** 238,242 ****
        (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))
--- 303,307 ----
        (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))

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

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

Update of /cvsroot/foo/foo/elkfoo/examples/scripts
In directory sc8-pr-cvs17:/tmp/cvs-serv31285

Modified Files:
	fsdiary.foo 
Log Message:
first bugfixes

Index: fsdiary.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/examples/scripts/fsdiary.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** fsdiary.foo	30 Sep 2007 12:31:38 -0000	1.1
--- fsdiary.foo	30 Sep 2007 13:10:20 -0000	1.2
***************
*** 45,51 ****
       (curoutpos) ;; current outfile position
       (outinc) ;; outputfile increment
!      (normbpf)
!      (startbpf)
!      (endbpf)
       (overalldur)
       (c) ; context
--- 45,51 ----
       (curoutpos) ;; current outfile position
       (outinc) ;; outputfile increment
!      (normenv~)
!      (startenv~)
!      (endenv~)
       (overalldur)
       (c) ; context
***************
*** 123,135 ****
    ;; period
    (set! period (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--period"))))
  
    ;; 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 period))
    
   ;; xfadelength
    (if (cmdline:option-given? (foo:script-args) option-list "--xfadelength")
!       (set! xfadelength (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--xfadelength"))))
        (set! xfadelength 0))
    
--- 123,152 ----
    ;; period
    (set! period (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--period"))))
+   (if (< period 0)
+       (begin
+ 	(display "negative period not allowed!")
+ 	(newline)
+ 	(exit)))
  
    ;; 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)
! 	    (begin
! 	      (display "negative duration not allowed!")
! 	      (newline)
! 	      (exit))))
        (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"))))
! 	(if (< xfadelength 0)
! 	    (begin
! 	      (display "negative xfadelength not allowed!")
! 	      (newline)
! 	      (exit))))
        (set! xfadelength 0))
    
***************
*** 171,190 ****
    (set! c (context channels))
  
!   ;; make bpfs
!   (with-context c (lambda ()
! 		    (set! normbpf (make-bpf (list '(0 0) (list xfadelength 1) (list outinc 1) (list duration 0))))
! 		    (set! startbpf (make-bpf (list '(0 1) (list outinc 1) (list duration 0))))
! 		    (set! endbpf (make-bpf (list '(0 0) (list xfadelength 1) (list duration 1))))))
  
    (letrec
        ;; write single slice per channels
!       ((cat-slice (lambda (slice chan off bpf)
  		    (if (> chan 0)
  			(begin
  			  (if (>= (snd-channels slice) chan)
  			      ;; do the actual work per channel
! 			      (output~ chan (time off (gate~ (mul~ (read-bpf~ bpf) (read-snd~ (snd-extract slice chan))) (snd-length slice)))))
! ;;			      (output~ chan (time off (gate~ (read-snd~ (snd-extract slice chan)) (snd-length slice))))
! 			  (cat-slice slice (1- chan) off bpf)))))
  		      
         ;; write input file per slice
--- 188,212 ----
    (set! c (context channels))
  
!   ;; make envelope signals
!   (if (= xfadelength 0)
!       ;; make-bpf needs strictly ascending time values: FIXME!
!       (with-context c (lambda ()
! 			(set! normenv~ (lambda () (~ 1)))
! 			(set! startenv~ (lambda () (~ 1)))
! 			(set! endenv~ (lambda () (~ 1)))))
!       (with-context c (lambda ()
! 			(set! normenv~ (lambda () (read-bpf~ (make-bpf (list '(0 0) (list xfadelength 1) (list outinc 1) (list duration 0))))))
! 			(set! startenv~ (lambda () (read-bpf~ (make-bpf (list '(0 1) (list outinc 1) (list duration 0))))))
! 			(set! endenv~ (lambda () (read-bpf~ (make-bpf (list '(0 0) (list xfadelength 1) (list duration 1)))))))))
  
    (letrec
        ;; write single slice per channels
!       ((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~)))))
  		      
         ;; write input file per slice
***************
*** 196,211 ****
  			((= curoutpos 0)
  			 (begin
! 			   (cat-slice (snd-region snd curinpos duration) channels curoutpos startbpf)
  			   (cat-slices file (+ curoutpos outinc) (+ curinpos period))))
  			;; last slice truncated
  			((>= (+ curinpos duration) (snd-length snd))
! 			 (cat-slice (snd-region snd curinpos (- (snd-length snd) curinpos)) channels curoutpos endbpf))
  			;; last slice complete
  			((>= (+ curinpos period) (snd-length snd))
! 			 (cat-slice (snd-region snd curinpos duration) channels curoutpos endbpf))
  			;; normal slice
  			(else
  			 (begin
! 			   (cat-slice (snd-region snd curinpos duration) channels curoutpos normbpf)
  			   (cat-slices file (+ curoutpos outinc) (+ curinpos period)))))))))
  
--- 218,233 ----
  			((= curoutpos 0)
  			 (begin
! 			   (cat-slice (snd-region snd curinpos duration) channels curoutpos startenv~)
  			   (cat-slices file (+ curoutpos outinc) (+ curinpos period))))
  			;; 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
  			 (begin
! 			   (cat-slice (snd-region snd curinpos duration) channels curoutpos normenv~)
  			   (cat-slices file (+ curoutpos outinc) (+ curinpos period)))))))))
  

[foo-cvs] foo/elkfoo/examples/scripts Makefile.am,1.2,1.3

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

Update of /cvsroot/foo/foo/elkfoo/examples/scripts
In directory sc8-pr-cvs17:/tmp/cvs-serv17653

Modified Files:
	Makefile.am 
Log Message:
added new script files to makefile

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/examples/scripts/Makefile.am,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Makefile.am	12 Aug 2004 23:43:50 -0000	1.2
--- Makefile.am	30 Sep 2007 12:35:59 -0000	1.3
***************
*** 12,15 ****
  EXAMPLE_SCRIPTS_FILES = \
  	sine.foo \
! 	sndcat.foo \
  	$(NULL)
--- 12,18 ----
  EXAMPLE_SCRIPTS_FILES = \
  	sine.foo \
! 	stdin.foo \
! 	fscat.foo \
! 	fsfold.foo \
! 	fsdiary.foo \
  	$(NULL)

[foo-cvs] foo/elkfoo/examples/scripts stdin.foo,NONE,1.1

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

Update of /cvsroot/foo/foo/elkfoo/examples/scripts
In directory sc8-pr-cvs17:/tmp/cvs-serv17242

Added Files:
	stdin.foo 
Log Message:
added stdin.foo scripting example

--- NEW FILE: stdin.foo ---
#!/usr/local/bin/foo

;; read file list from stdin

(let*
  ((files
    (do ((file-list '()
                    (cons last-read file-list))
         (last-read))
        ((begin
           (set! last-read (read-string))
           (eof-object? last-read))
         (reverse file-list))))
   (num-files (length files)))

  (display files)
  (newline)
  (quit))

[foo-cvs] foo/elkfoo/examples/scripts fscat.foo, NONE, 1.1 fsdiary.foo, NONE, 1.1 fsfold.foo, NONE, 1.1 sndcat.foo, 1.2, NONE

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

Update of /cvsroot/foo/foo/elkfoo/examples/scripts
In directory sc8-pr-cvs17:/tmp/cvs-serv16089

Added Files:
	fscat.foo fsdiary.foo fsfold.foo 
Removed Files:
	sndcat.foo 
Log Message:
added some scripting examples

--- NEW FILE: fscat.foo ---
#!/usr/local/bin/foo --

;; fscat: 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

--- sndcat.foo DELETED ---

--- NEW FILE: fsfold.foo ---
#!/usr/local/bin/foo --

;; fsfold: 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: fsdiary.foo ---
#!/usr/local/bin/foo --

;; fsdiary: 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)))
     (infiles)
     (outfile)
     (type)
     (format)
     (srate)
     (channels)
     (period)
     (duration)
     (xfadelength)
     (xfadetype)
     (begint)
     (endt)
     (curinpos) ;; current infile position
     (curoutpos) ;; current outfile position
     (outinc) ;; outputfile increment
     (normbpf)
     (startbpf)
     (endbpf)
     (overalldur)
     (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))

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

  ;; 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 period))
  
 ;; xfadelength
  (if (cmdline:option-given? (foo:script-args) option-list "--xfadelength")
      (set! xfadelength (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--xfadelength"))))
      (set! xfadelength 0))
  
 ;; xfadetype
  (if (cmdline:option-given? (foo:script-args) option-list "--xfadetype")
      (begin
	(set! xfadetype (string->symbol (car (cmdline:get-option-param (foo:script-args) option-list "--xfadetype"))))
	(if (not (or (equal? xfadetype 'log)
		     (equal? xfadetype 'expon)
		     (equal? xfadetype 'line)))
	    (begin
	      (display "xfadetype not valid!")
	      (newline)
	      (help))))
      (set! xfadetype 'log))
  
 ;; 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")
      (set! endt (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--end"))))
      (set! endt (soundfile-length (car infiles)))) ;; needs further attention

  ;; outfile increment
  (set! outinc (- duration xfadelength))

  ;; overall duration
  (set! overalldur
	(let
	    ((numslices (/ (soundfile-length (car infiles)) period)))
	  (+ (* (- duration xfadelength)
		(trunc numslices))
	     (* duration (- numslices (trunc numslices))))))

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

  ;; make bpfs
  (with-context c (lambda ()
		    (set! normbpf (make-bpf (list '(0 0) (list xfadelength 1) (list outinc 1) (list duration 0))))
		    (set! startbpf (make-bpf (list '(0 1) (list outinc 1) (list duration 0))))
		    (set! endbpf (make-bpf (list '(0 0) (list xfadelength 1) (list duration 1))))))

  (letrec
      ;; write single slice per channels
      ((cat-slice (lambda (slice chan off bpf)
		    (if (> chan 0)
			(begin
			  (if (>= (snd-channels slice) chan)
			      ;; do the actual work per channel
			      (output~ chan (time off (gate~ (mul~ (read-bpf~ bpf) (read-snd~ (snd-extract slice chan))) (snd-length slice)))))
;;			      (output~ chan (time off (gate~ (read-snd~ (snd-extract slice chan)) (snd-length slice))))
			  (cat-slice slice (1- chan) off bpf)))))
		      
       ;; write input file per slice
       (cat-slices (lambda (file curoutpos curinpos)
		     (let*
			 ((snd (open-snd file)))
		       (cond
			;; first slice
			((= curoutpos 0)
			 (begin
			   (cat-slice (snd-region snd curinpos duration) channels curoutpos startbpf)
			   (cat-slices file (+ curoutpos outinc) (+ curinpos period))))
			;; last slice truncated
			((>= (+ curinpos duration) (snd-length snd))
			 (cat-slice (snd-region snd curinpos (- (snd-length snd) curinpos)) channels curoutpos endbpf))
			;; last slice complete
			((>= (+ curinpos period) (snd-length snd))
			 (cat-slice (snd-region snd curinpos duration) channels curoutpos endbpf))
			;; normal slice
			(else
			 (begin
			   (cat-slice (snd-region snd curinpos duration) channels curoutpos normbpf)
			   (cat-slices file (+ curoutpos outinc) (+ curinpos period)))))))))

    (with-context c (lambda () (cat-slices (car infiles) 0 begint))))

  ;; 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

[foo-cvs] foo/libfoo/FOO FOOSoundFile.h, 1.6, 1.7 FOOSoundStream.h, 1.4, 1.5 FOOSubstrate.h, 1.4, 1.5

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

Update of /cvsroot/foo/foo/libfoo/FOO
In directory sc8-pr-cvs17:/tmp/cvs-serv14088/FOO

Modified Files:
	FOOSoundFile.h FOOSoundStream.h FOOSubstrate.h 
Log Message:
partially unified substrates: allow (snd-extract) on snd-regions

Index: FOOSoundFile.h
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/FOO/FOOSoundFile.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** FOOSoundFile.h	28 Feb 2005 16:37:20 -0000	1.6
--- FOOSoundFile.h	30 Sep 2007 12:26:44 -0000	1.7
***************
*** 109,113 ****
  
  - (double) getSamplingRate;
! - (int) getChannelCount;
  - (int) getDataFormat;
  - (int) getFileType;
--- 109,113 ----
  
  - (double) getSamplingRate;
! //- (int) getChannelCount; // moved to FOOSubstrate
  - (int) getDataFormat;
  - (int) getFileType;

Index: FOOSoundStream.h
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/FOO/FOOSoundStream.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** FOOSoundStream.h	28 Feb 2005 16:37:20 -0000	1.4
--- FOOSoundStream.h	30 Sep 2007 12:26:44 -0000	1.5
***************
*** 42,46 ****
  #include <FOO/FOOSubstrate.h>
  
! @class FOOSoundFile;
  @class FOOGlobal;
  
--- 42,46 ----
  #include <FOO/FOOSubstrate.h>
  
! // @class FOOSoundFile;
  @class FOOGlobal;
  
***************
*** 48,53 ****
  @interface FOOSoundStream : FOOSubstrate <NSCoding>
  {
!     FOOSoundFile *_soundFile;
!     int _channelNumber;
  }
  
--- 48,55 ----
  @interface FOOSoundStream : FOOSubstrate <NSCoding>
  {
!   //    FOOSoundFile *_soundFile;
!   // generalized to FOOSubstrate
!   FOOSubstrate *_substrate;
!   int _channelNumber;
  }
  
***************
*** 55,59 ****
  
  /* to be removed
!  * no in FOOSubstrate.h
   * - (BOOL) getSamples: (sample_t *)buffer offset: (long)off size: (long)size;
   */
--- 57,61 ----
  
  /* to be removed
!  * now in FOOSubstrate.h
   * - (BOOL) getSamples: (sample_t *)buffer offset: (long)off size: (long)size;
   */

Index: FOOSubstrate.h
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/FOO/FOOSubstrate.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** FOOSubstrate.h	28 Feb 2005 16:37:20 -0000	1.4
--- FOOSubstrate.h	30 Sep 2007 12:26:44 -0000	1.5
***************
*** 54,58 ****
--- 54,60 ----
   */
  - (double) getSamplingRate;
+ - (BOOL) getSamples: (sample_t *)buffer offset: (long)fromFrame size: (long)frames channel: (int)channel;
  - (BOOL) getSamples: (sample_t *)buffer offset: (long)fromFrame size: (long)frames;
+ - (int) getChannelCount;
  
  @end

[foo-cvs] foo/libfoo/src FOORegion.m, 1.6, 1.7 FOOSoundStream.m, 1.6, 1.7 FOOSubstrate.m, 1.6, 1.7

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

Update of /cvsroot/foo/foo/libfoo/src
In directory sc8-pr-cvs17:/tmp/cvs-serv14088/src

Modified Files:
	FOORegion.m FOOSoundStream.m FOOSubstrate.m 
Log Message:
partially unified substrates: allow (snd-extract) on snd-regions

Index: FOOSubstrate.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOSubstrate.m,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** FOOSubstrate.m	28 Feb 2005 16:37:22 -0000	1.6
--- FOOSubstrate.m	30 Sep 2007 12:26:44 -0000	1.7
***************
*** 102,105 ****
--- 102,126 ----
  
  
+ /* we need a protocol here for FOOSoundFile, -Stream and -Region
+    instead of this method */
+ - (BOOL) getSamples: (sample_t *)buffer
+ 	     offset: (long)fromFrame
+ 	       size: (long)frames
+ 	    channel: (int)channel
+ {
+   //  [self subclassResponsibility: _cmd];
+ 
+   FOO_ERROR(YES, NO);
+ }
+ 
+ 
+ - (int) getChannelCount
+ {
+   //  [self subclassResponsibility: _cmd];
+ 
+   FOO_ERROR(YES, NO);
+ }
+ 
+ 
  /*
   * archiving methods

Index: FOORegion.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOORegion.m,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** FOORegion.m	20 Jun 2005 08:57:14 -0000	1.6
--- FOORegion.m	30 Sep 2007 12:26:44 -0000	1.7
***************
*** 80,83 ****
--- 80,84 ----
  	     offset: (long)off
  	       size: (long)size
+ 	    channel: (int)channel
  {
    sample_t tmp, *e, *b;
***************
*** 89,93 ****
        [_substrate getSamples: buffer
  		  offset: n
! 		  size: size];
        n = size / 2;
        b = buffer;
--- 90,95 ----
        [_substrate getSamples: buffer
  		  offset: n
! 		  size: size
! 		  channel: channel];
        n = size / 2;
        b = buffer;
***************
*** 105,111 ****
        return [_substrate getSamples: buffer
  			 offset: _offset + off
! 			 size: size];
      }
! }
  
  
--- 107,122 ----
        return [_substrate getSamples: buffer
  			 offset: _offset + off
! 			 size: size
! 			 channel: channel];
      }
! } // getSamples:offset:size:channel:
! 
! 
! - (BOOL) getSamples: (sample_t *)buffer
! 	     offset: (long)off
! 	       size: (long)size
! {
!   return [self getSamples: buffer offset: off size: size channel: -1];
! } // getSamples:offset:size:
  
  
***************
*** 122,125 ****
--- 133,141 ----
  
  
+ - (int) getChannelCount
+ {
+   return [_substrate getChannelCount];
+ }
+ 
  /*
   * archiving methods

Index: FOOSoundStream.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOSoundStream.m,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** FOOSoundStream.m	20 Jun 2005 08:57:14 -0000	1.6
--- FOOSoundStream.m	30 Sep 2007 12:26:44 -0000	1.7
***************
*** 38,41 ****
--- 38,42 ----
  #include "FOO/FOOSoundStream.h"
  #include "FOO/FOOSoundFile.h"
+ #include "FOO/FOORegion.h"
  
  #import <Foundation/NSKeyedArchiver.h>
***************
*** 47,57 ****
  			       channel: (int)channel
  {
!   if ([substrate isKindOfClass: [FOOSoundFile class]] == NO)
      {
        FOO_ERROR(YES, self);
      }
!   _soundFile = RETAIN((FOOSoundFile *)substrate); // RETAIN?
    _channelNumber = channel - 1;
!   if (_channelNumber < 0 || _channelNumber >= [_soundFile getChannelCount])
      {
        FOO_ERROR(YES, self);
--- 48,69 ----
  			       channel: (int)channel
  {
! //   if ([substrate isKindOfClass: [FOOSoundFile class]] == NO)
! //     {
! //       FOO_ERROR(YES, self);
! //     }
! //   _soundFile = RETAIN((FOOSoundFile *)substrate); // RETAIN?
! 
! // added for generalization to substrate
!   if ([substrate isKindOfClass: [FOOSoundFile class]] == NO &&
!       [substrate isKindOfClass: [FOOSoundStream class]] == NO &&
!       [substrate isKindOfClass: [FOORegion class]] == NO)
      {
        FOO_ERROR(YES, self);
      }
!   _substrate = RETAIN(substrate); // RETAIN?
!   //end added
    _channelNumber = channel - 1;
!   //  if (_channelNumber < 0 || _channelNumber >= [_soundFile getChannelCount])
!   if (_channelNumber < 0 || _channelNumber >= [_substrate getChannelCount])
      {
        FOO_ERROR(YES, self);
***************
*** 64,68 ****
  - (void) dealloc
  {
!   RELEASE(_soundFile);
    [super dealloc];
  } // dealloc
--- 76,81 ----
  - (void) dealloc
  {
!   //  RELEASE(_soundFile);
!   RELEASE(_substrate);
    [super dealloc];
  } // dealloc
***************
*** 70,80 ****
  
  - (BOOL) getSamples: (sample_t *)b
! 	     offset:(long)o
! 	       size:(long)s
  {
!   return [_soundFile getSamples: b
  		     offset: o
  		     size: s
  		     channel: _channelNumber];
  }
  
--- 83,112 ----
  
  - (BOOL) getSamples: (sample_t *)b
! 	     offset: (long)o
! 	       size: (long)s
! 	    channel: (int)channel
  {
!   if (channel - 1 != _channelNumber)
!     {
!       FOO_ERROR(YES, self);
!     }
!   return [self getSamples: b
! 	       offset: o
! 	       size: s];
! }
! 
! 
! - (BOOL) getSamples: (sample_t *)b
! 	     offset: (long)o
! 	       size: (long)s
! {
!   return [_substrate getSamples: b
  		     offset: o
  		     size: s
  		     channel: _channelNumber];
+ //   return [_soundFile getSamples: b
+ // 		     offset: o
+ // 		     size: s
+ // 		     channel: _channelNumber];
  }
  
***************
*** 82,86 ****
  - (long) size
  {
!   return [_soundFile size];
  }
  
--- 114,119 ----
  - (long) size
  {
!   //  return [_soundFile size];
!   return [_substrate size];
  }
  
***************
*** 88,92 ****
  - (double) getSamplingRate
  {
!   return [_soundFile getSamplingRate];
  }
  
--- 121,132 ----
  - (double) getSamplingRate
  {
!   //  return [_soundFile getSamplingRate];
!   return [_substrate getSamplingRate];
! }
! 
! 
! - (int) getChannelCount
! {
!   return 1; // FOOSoundStream is mono
  }
  
***************
*** 102,111 ****
    if ([coder allowsKeyedCoding])
      {
!       [coder encodeObject: _soundFile forKey: @"FOOSoundStream:soundFile"];
        [coder encodeInt: _channelNumber forKey: @"FOOSoundStream:channelNumber"];
      }
    else
      {
!       [coder encodeObject: _soundFile];
        [coder encodeValueOfObjCType: @encode(int) at: &_channelNumber];
      }
--- 142,153 ----
    if ([coder allowsKeyedCoding])
      {
!       //      [coder encodeObject: _soundFile forKey: @"FOOSoundStream:soundFile"];
!       [coder encodeObject: _substrate forKey: @"FOOSoundStream:soundFile"];
        [coder encodeInt: _channelNumber forKey: @"FOOSoundStream:channelNumber"];
      }
    else
      {
!       //      [coder encodeObject: _soundFile];
!       [coder encodeObject: _substrate];
        [coder encodeValueOfObjCType: @encode(int) at: &_channelNumber];
      }
***************
*** 121,130 ****
    if ([coder allowsKeyedCoding])
      {
!       _soundFile = RETAIN([coder decodeObjectForKey: @"FOOSoundStream:soundFile"]);
        _channelNumber = [coder decodeIntForKey: @"FOOSoundStream:channelNumber"];
      }
    else
      {
!       _soundFile = RETAIN([coder decodeObject]);
        [coder decodeValueOfObjCType: @encode(int) at: &_channelNumber];
      }
--- 163,174 ----
    if ([coder allowsKeyedCoding])
      {
!       //      _soundFile = RETAIN([coder decodeObjectForKey: @"FOOSoundStream:soundFile"]);
!       _substrate = RETAIN([coder decodeObjectForKey: @"FOOSoundStream:substrate"]);
        _channelNumber = [coder decodeIntForKey: @"FOOSoundStream:channelNumber"];
      }
    else
      {
!       //      _soundFile = RETAIN([coder decodeObject]);
!       _substrate = RETAIN([coder decodeObject]);
        [coder decodeValueOfObjCType: @encode(int) at: &_channelNumber];
      }

[foo-cvs] foo/elkfoo/scm/control/tools/util soundfile-funs.foo, 1.3, NONE misc-funs.foo, 1.1, NONE

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control/tools/util
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv27283

Removed Files:
	soundfile-funs.foo misc-funs.foo 
Log Message:
removing from here

--- misc-funs.foo DELETED ---

--- soundfile-funs.foo DELETED ---

[foo-cvs] foo/elkfoo/scm/control/tools/util Makefile.am,1.3,1.4

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control/tools/util
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv26499

Modified Files:
	Makefile.am 
Log Message:
removing util funs from here

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/tools/util/Makefile.am,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Makefile.am	27 Feb 2005 20:25:31 -0000	1.3
--- Makefile.am	10 Apr 2007 14:14:31 -0000	1.4
***************
*** 13,18 ****
  
  ELKFOO_UTILITIES_FILES = \
- 	misc-funs.foo \
  	pitch.foo \
- 	soundfile-funs.foo \
  	$(NULL)
--- 13,16 ----

[foo-cvs] foo/elkfoo/scm/control/tools/mixsnd mixsnd.foo, 1.1, 1.2 mix-auxfun.foo, 1.1, 1.2

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control/tools/mixsnd
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv26084

Modified Files:
	mixsnd.foo mix-auxfun.foo 
Log Message:
several corrections & addenda

Index: mixsnd.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/tools/mixsnd/mixsnd.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** mixsnd.foo	30 Aug 2004 13:40:57 -0000	1.1
--- mixsnd.foo	10 Apr 2007 14:13:24 -0000	1.2
***************
*** 8,12 ****
  ;;
  ;
! (load  'control/Tools/Mixsnd/Mix-auxfun.foo)
  ;
  ;;
--- 8,12 ----
  ;;
  ;
! (load  'control/tools/mixsnd/mix-auxfun.foo)
  ;
  ;;
***************
*** 41,44 ****
--- 41,45 ----
  	         Mode) #f))))
  ;
+ (define mixsnd Mixsnd)
  ;
  ;;

Index: mix-auxfun.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/tools/mixsnd/mix-auxfun.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** mix-auxfun.foo	30 Aug 2004 13:40:57 -0000	1.1
--- mix-auxfun.foo	10 Apr 2007 14:13:24 -0000	1.2
***************
*** 170,185 ****
       (if (symbol? frq) (set! frq (pitch frq)))
  ;
! ;;
! ;;;  I use a database of sounds {Only in my Version}
! ;;
  ;
!      (solicito 'DBSND)
!      (set! nam (dbsnd.fun nam frq))
       (set! frq (cadr nam))
       (set! nam (car nam))
  ;
  ;;
- ;;;
- ;;
  ;
       (set! nam (make-sndname nam))
--- 170,182 ----
       (if (symbol? frq) (set! frq (pitch frq)))
  ;
! ;;  In case nam is a label making reference to a database of sounds 
! ;;  [dependant on frq] the function getfromDB (a dummy function)
! ;;  can be overwritten by the user to suit his needs
  ;
!      (set! nam (getfromDB nam frq))
       (set! frq (cadr nam))
       (set! nam (car nam))
  ;
  ;;
  ;
       (set! nam (make-sndname nam))
***************
*** 190,193 ****
--- 187,193 ----
       (set-SFDIR odir)
       (list nam frq odur)))
+ 
+ (define (getfromDB nam frq)  (list nam frq))
+ 
  ;
  ;;

[foo-cvs] foo/elkfoo/scm/control/interface-lib sp-patchgen-funs.foo, 1.2, 1.3

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control/interface-lib
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv25676

Modified Files:
	sp-patchgen-funs.foo 
Log Message:
several corrections & addenda

Index: sp-patchgen-funs.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/interface-lib/sp-patchgen-funs.foo,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** sp-patchgen-funs.foo	27 Feb 2005 20:06:33 -0000	1.2
--- sp-patchgen-funs.foo	10 Apr 2007 14:12:12 -0000	1.3
***************
*** 24,28 ****
      ((pair? Input)	(map (lambda (x) (Atten Amp x)) Input))
      (#t			(mul~ Amp Input))))
!      
  (define (SP-Component Vars Input)
     (let* ((Type (car Vars))
--- 24,28 ----
      ((pair? Input)	(map (lambda (x) (Atten Amp x)) Input))
      (#t			(mul~ Amp Input))))
! 
  (define (SP-Component Vars Input)
     (let* ((Type (car Vars))
***************
*** 127,130 ****
--- 127,131 ----
     (cond
  ;	((string-ci=? Format "Incremental")	'incremental)
+ 	((string-ci=? Format "PCM24")		'pcm24)
  	((string-ci=? Format "Float")		'float)
  	((string-ci=? Format "Short")		'short)
***************
*** 140,143 ****
--- 141,145 ----
  	((string-ci=? Type "Wav")	'wav)
  	((string-ci=? Type "Aiff")	'aiff)
+ 	((string-ci=? Type "Aif")	'aiff)
  	((string-ci=? Type "Snd")	'snd)
  	((string-ci=? Type "Paf")	'paf)
***************
*** 176,179 ****
--- 178,188 ----
  	    (/ (field 'duration) (field 'srate)) (- (field 'factor)))))
  
+ (define (setorfflag sym Lst)
+     (if (eq? sym 'off)
+ 	(or (assq 'offset Lst) (assq 'off Lst) (assq 'Offset Lst))
+ 	(if (eq? sym 'ref)
+ 	    (or (assq 'reference Lst) (assq 'ref Lst) (assq 'Reference Lst))
+ 	    (or (assq 'factor Lst) (assq 'amp Lst) (assq 'Factor Lst)))))
+ 
  (define (SPrun-Modify filnam Lst)
     (let* ((filnam (make-sndname (putimx filnam)))
***************
*** 185,209 ****
  	  (context) (context2)
  	  (header)
! 	  (factor) (offset) (aux))
  	(if (symbol? (car Ls2))
  		(set! Ls2 (list (list-head Ls2 2) (clean (list-tail Ls2 2)))))
  	(define (field name)
  	    (cadr (assq name header)))
! 	(if (or (assq 'offset Ls2)
! 		(assq 'off Ls2)
! 		(assq 'Offset Ls2)) (SPrun-Undo filnam (car Lst)))
  	(set! context (with-input-from-file (string-append name "c") 
  					    read-context))
  	(set! header (with-input-from-file (string-append name "t") read))
! 	(set! aux (assq 'offset Ls2))
! 	(if (not aux) (set! aux (assq 'Offset Ls2)))
! 	(if (not aux) (set! aux (assq 'off Ls2)))
! 	(if aux (set! offset (+ (/ (field 'offset) (field 'srate)) (cadr aux)))
! 	        (set! offset (/ (field 'offset) (field 'srate))))
! 	(set! aux (assq 'factor Ls2))
! 	(if (not aux) (set! aux (assq 'Factor Ls2)))
! 	(if (not aux) (set! aux (assq 'amp Ls2)))
! 	(if aux (set! factor (cadr aux))
! 	        (set! factor (field 'factor)))
  	(set! context2 (copy-context context))
  	(run-task
--- 194,225 ----
  	  (context) (context2)
  	  (header)
! 	  (factor) (offset) (reference) (aux)
! 	  (offflg #f) (refflg #f) (facflg #f))
  	(if (symbol? (car Ls2))
  		(set! Ls2 (list (list-head Ls2 2) (clean (list-tail Ls2 2)))))
  	(define (field name)
  	    (cadr (assq name header)))
! 
! 	(set! offflg (setorfflag 'off Ls2))
! 	(set! refflg (setorfflag 'ref Ls2))
! 	(set! facflg (setorfflag 'fac Ls2))
! 
! 	(if (or offflg refflg) (SPrun-Undo filnam (car Lst)))
! 
  	(set! context (with-input-from-file (string-append name "c") 
  					    read-context))
  	(set! header (with-input-from-file (string-append name "t") read))
! 
! 	(set! offset 
! 	      (if offflg 
! 		  (+ (/ (field 'offset) (field 'srate)) (cadr offflg))
! 		  (/ (field 'offset) (field 'srate))))
! 	(set! reference
! 	      (if refflg 
! 		  (+ (/ (field 'reference) (field 'srate)) (cadr refflg))
! 		  (/ (field 'reference) (field 'srate))))
! 	(set! factor (if facflg (cadr facflg)
! 			        (field 'factor)))
! 
  	(set! context2 (copy-context context))
  	(run-task
***************
*** 213,217 ****
  		  (field 'srate) (field 'blocksize))
  	          (/ (field 'duration) (field 'srate)) factor)))
! 
  (define (SP-run Data . Args)
    (let ((Args (clean Args))
--- 229,241 ----
  		  (field 'srate) (field 'blocksize))
  	          (/ (field 'duration) (field 'srate)) factor)))
! ;
! ;; Dummy function which returns same data as given to allow in the
! ;; next-compat.foo file a redefinition in order to take into account
! ;; the confussion between reference and offset in all the older versions
! ;
! (define (help-RefOff-NextCompat Ref Off) (list Ref Off))
! ;
! ;;
! ;
  (define (SP-run Data . Args)
    (let ((Args (clean Args))
***************
*** 222,226 ****
     	(Mode 'punch) (Off 0) (Ref 0) (Sclr 1) (Nfctr 1)
  	(Chns) (SRat) (SRc)
- ;	(Format 'float) (Type 'aiff) 	
  	(Format #f) (Type #f) 
  	(Offctxt) (Durctxt) (Chnctxt) (Pflg #t)
--- 246,249 ----
***************
*** 266,272 ****
  	     ((number? Data)
  		   (set! Off (assq 'Offset Args))
  		   (set! Sclr (assq 'Factor Args))
! 		   (if (or Off Sclr)
! 		      (SPrun-Modify Filename (list Data Off Sclr))
  		      (error 'SP-run "Cannot Modify with this data ~a" Data)))
  	     (#t (error 'SP-run "Cannot Modify with this data ~a" Data))))
--- 289,296 ----
  	     ((number? Data)
  		   (set! Off (assq 'Offset Args))
+ 		   (set! Ref (assq 'Reference Args))
  		   (set! Sclr (assq 'Factor Args))
! 		   (if (or Off Ref Sclr)
! 		      (SPrun-Modify Filename (list Data Off Ref Sclr))
  		      (error 'SP-run "Cannot Modify with this data ~a" Data)))
  	     (#t (error 'SP-run "Cannot Modify with this data ~a" Data))))
***************
*** 333,340 ****
  	    (if flg
  	      (begin
  	        (if Pflg
  	           (prn " Making Task == <<Ref Off SRc Blk>> ==> "
  		   					Ref Off SRc Blk))
! 	        (set! tsk (make-task Ref Off Workfile ctxt Mode SRc Blk))
  	        (if Pflg
  	           (prn " Synthesizing = <<Duration Factor>> ==> "Dur Sclr))
--- 357,374 ----
  	    (if flg
  	      (begin
+ ;
+ ;;    We use a dummy function help-RefOff-NextCompat
+ ;;    which is redefined in the next-compat.foo
+ ;;    to solve the old confussion between reference and offset.
+ ;;    This dummy function is defined above and does nothing.
+ ;
+ 		(set! aux (help-RefOff-NextCompat Ref Off))
+ 		(set! Ref (car aux))
+ 		(set! Off (cadr aux))
  	        (if Pflg
  	           (prn " Making Task == <<Ref Off SRc Blk>> ==> "
  		   					Ref Off SRc Blk))
! 		(set! tsk (make-task Ref Off Workfile ctxt Mode SRc Blk))
! ;
  	        (if Pflg
  	           (prn " Synthesizing = <<Duration Factor>> ==> "Dur Sclr))

[foo-cvs] foo/elkfoo/scm/control/abstraction var-type.foo,1.3,1.4

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control/abstraction
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv24943

Modified Files:
	var-type.foo 
Log Message:
foops/oops type error

Index: var-type.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/abstraction/var-type.foo,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** var-type.foo	27 Feb 2005 20:06:31 -0000	1.3
--- var-type.foo	10 Apr 2007 14:10:55 -0000	1.4
***************
*** 1,3 ****
! (require 'oops)
  (define-class Var-Type (instance-vars  Variables
  				       (checkd #f)))
--- 1,3 ----
! (require 'foops)
  (define-class Var-Type (instance-vars  Variables
  				       (checkd #f)))

[foo-cvs] foo/elkfoo/scm/control init-control.foo,1.4,1.5

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv24489

Modified Files:
	init-control.foo 
Log Message:
cleaning up the load procedure

Index: init-control.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/init-control.foo,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** init-control.foo	27 Feb 2005 20:13:08 -0000	1.4
--- init-control.foo	10 Apr 2007 14:09:58 -0000	1.5
***************
*** 8,18 ****
  ;; init-tools.foo
  
! (autoload 'mixsnd "control/tools/mixsnd/mixsnd.foo")
! (autoload 'pitch "control/tools/pitch.foo")
! (autoload 'pitch->frq "control/tools/pitch.foo")
! (autoload 'frq->pitch "control/tools/pitch.foo")
! 
! (global-load "control/tools/util/misc-funs.foo")
! (global-load "control/tools/util/soundfile-funs.foo")
  
  (provide 'foo-tools)
--- 8,13 ----
  ;; init-tools.foo
  
! (global-load "control/tools/mixsnd/mixsnd.foo")
! (global-load "control/tools/util/pitch.foo")
  
  (provide 'foo-tools)

[foo-cvs] foo/elkfoo/scm next-compat.foo,1.3,1.4

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv23612

Modified Files:
	next-compat.foo 
Log Message:
dealing with the old Offset/Reference confussion

Index: next-compat.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/next-compat.foo,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** next-compat.foo	26 Jan 2005 23:19:50 -0000	1.3
--- next-compat.foo	10 Apr 2007 14:07:16 -0000	1.4
***************
*** 52,54 ****
--- 52,66 ----
    `(foo:synthesize ,c ,d ,s ,n ,f (lambda () ,@e)))
  
+ ;
+ ;;==> To avoid old error.
+ ;;    Offset & Reference were mixed up. 
+ ;;    Reference was almost never used because Offset was doing its function.
+ ;;    I set Reference to Offset value and set Offset to 0.
+ ;
+ ;               (set! tsk (make-task Ref Off Workfile ctxt Mode SRc Blk))
+ ;               (set! tsk (make-task Off 0. Workfile ctxt Mode SRc Blk))
+ 
+ (define (help-RefOff-NextCompat Ref Off) (list Off 0.))
+ 
+ 
  (provide 'next-compat)

[foo-cvs] foo/elkfoo configure.ac,1.15,1.16

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv22834

Modified Files:
	configure.ac 
Log Message:
including the new util branch

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/configure.ac,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** configure.ac	4 Apr 2007 14:36:03 -0000	1.15
--- configure.ac	10 Apr 2007 14:05:41 -0000	1.16
***************
*** 311,314 ****
--- 311,315 ----
    scm/Makefile
    scm/kernel/Makefile
+   scm/util/Makefile
    scm/control/Makefile
    scm/control/abstraction/Makefile

[foo-cvs] foo/elkfoo/scm initialize.foo,1.1,1.2

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv22424

Modified Files:
	initialize.foo 
Log Message:
including the new util branch & some other error

Index: initialize.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/initialize.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** initialize.foo	3 Feb 2005 15:28:39 -0000	1.1
--- initialize.foo	10 Apr 2007 14:04:57 -0000	1.2
***************
*** 23,27 ****
  
       (load-packages
!       (list "control"))		; oh happy day...
  
       (init-files
--- 23,27 ----
  
       (load-packages
!       (list "util" "control"))		; oh happy day...
  
       (init-files
***************
*** 80,84 ****
  (define (foo:load-file file . notify)
    (if (file-exists? (tilde-expand file))
!       (load file)
        (if (and (not (null? notify)) (car notify))
  	  (format #t "(foo:load-file ~a) not found\n" file))))
--- 80,84 ----
  (define (foo:load-file file . notify)
    (if (file-exists? (tilde-expand file))
!       (global-load (tilde-expand file))
        (if (and (not (null? notify)) (car notify))
  	  (format #t "(foo:load-file ~a) not found\n" file))))

[foo-cvs] foo/elkfoo/scm Makefile.am,1.6,1.7

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv22012

Modified Files:
	Makefile.am 
Log Message:
including the new util branch

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/Makefile.am,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Makefile.am	3 Feb 2005 15:28:39 -0000	1.6
--- Makefile.am	10 Apr 2007 14:03:37 -0000	1.7
***************
*** 6,10 ****
  NULL = 
  
! SUBDIRS = kernel control
  
  EXTRA_DIST = $(FOO_FILES) toplevel.foo.in
--- 6,10 ----
  NULL = 
  
! SUBDIRS = kernel util control
  
  EXTRA_DIST = $(FOO_FILES) toplevel.foo.in

[foo-cvs] foo/elkfoo/scm/util soundfile-funs.foo,NONE,1.1

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/util
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv21250/util

Added Files:
	soundfile-funs.foo 
Log Message:
new branch with utility functions formerly at control/tools/util

--- NEW FILE: soundfile-funs.foo ---
;
;;
;;;
;;;;                         soundfile-funs.foo
;;;
;;
;

;
;;
;;;  foo:SFDIR
;;
;
(define foo:SFDIR (foo:test-file-dir))

(define (get-SFDIR) foo:SFDIR)

(define (set-SFDIR paz)
   (if (symbol? paz) (set! paz (symbol->string paz)))
   (set! foo:SFDIR (tilde-expand paz)))

;
;;
;;;  soundfile extensions and types
;;
;

;
;; boolean for automatic extension mechanism
;
(define foo:default-soundfile-extension? #t)
(define (foo:soundfile-extension?) foo:default-soundfile-extension?)
(define (foo:set-soundfile-extension?! bul)
   (if (boolean? bul)
      (set!  foo:default-soundfile-extension? bul)
      (error 'foo:set-soundfile-extension?! "Not a boolean: ~a" bul)))

;
;;default & user database of type-extensions
;
(define foo:default-soundfile-extension-database
    (list
	(list 'aiff	(list ".aiff" ".aif"))
	(list 'snd	(list ".snd" ".au"))
	(list 'wav	(list ".wav"))
	(list 'pdf	(list ".pdf"))
	(list 'svx	(list ".svx"))
	(list 'nist	(list ".nist"))
	(list 'voc	(list ".voc"))
	(list 'ircam	(list ".sf" ".ircam"))
	(list 'wav64	(list ".wav64"))
	(list 'mat4	(list ".mat4"))
	(list 'mat5	(list ".mat5"))
	(list 'pvf	(list ".pvf"))
	(list 'xi	(list ".xi"))
	(list 'flac     (list ".flac"))
	(list 'imx      (list ".imx"))))
(define foo:user-soundfile-extension-database 
	foo:default-soundfile-extension-database)

;
;;default type (probably to be changed). Leaning on the definition in elkfoo.scm
;
(define (foo:default-soundfile-type) foo-default-soundfile-filetype)
(define (foo:set-default-soundfile-type! type)
    (if (symbol? type) (set! type (symbol->string type)))
    (set! foo-default-soundfile-filetype type))

;
;;get extension from type (see all database or see defaultdatabase)
;
(define (foo:soundfile-type-extension . type)
  (let ((xtn))
   (set! type (if (null? type) type (car type)))
   (if (string? type) (set! type (string->symbol type)))
   (cond
      ((eq? type 'default)    foo:default-soundfile-extension-database)
      ((or (null? type)
	   (eq? type 'all)) foo:user-soundfile-extension-database)
      (#t  (set! xtn (assq type foo:user-soundfile-extension-database))
	   (if xtn (caadr xtn) #f)))))

;
;;get type from extension
;
(define (foo:soundfile-extension-type extension)
   (let ((type #f))
       (if (symbol? extension) (set! extension (symbol->string extension)))
       (for-each
	   (lambda (x) (if (member extension (cadr x)) (set! type (car x))))
	   foo:user-soundfile-extension-database)
       type))

;
;; get type and extension from name of soundfile
;
(define (foo:find-name-type-extension name)
   (let ((aux) (k 0) (el 0) (nameext) (nametyp)
	)
     (if (symbol? name) (set! name (symbol->string name)))
     (set! aux (string->list name))
     (for-each
	 (lambda (x) (set! k (+ 1 k))
		     (if (equal? (string x) ".") (set! el k))) 
	 (cdr aux))
     (if (= el 0) #f
		  (begin
		     (set! nameext (list->string (list-tail aux el)))
		     (set! nametyp (foo:soundfile-extension-type nameext))
		     (if nametyp (list nametyp nameext) #f)))))

;
;;set extension from type (or recover default settings)
;
(define (foo:set-soundfile-type-extension! type extension)
  (if (string? type) (set! type (string->symbol type)))
  (if (symbol? extension) (set! extension (symbol->string extension)))
  (if (equal? extension "default") 
     (foo:set-default-soundfile-type-extension! type)
     (let ((aux) (flg #t) (flg2 #f))
         (if (pair? extension)
            (set! extension (map 
				(lambda (x) 
				    (if (symbol? x) (symbol->string x) x))
				extension))
            (set! flg #f))
         (set! aux 
		(map 
		  (lambda (x) 
		      (if (eq? type (car x))
			 (begin
			   (set! flg2 #t)
			   (list (car x) (if flg extension (list extension))))
			 x)) 
	        foo:user-soundfile-extension-database))
         (if flg2 (set! foo:user-soundfile-extension-database aux)
		  (error 'foo:set-soundfile-type-extension! "Unknown type : ~a~%" type)))))

(define (foo:set-default-soundfile-type-extension! type)
  (let ((aux) (flg #f))
    (if (eq? type 'all)
       (set! foo:user-soundfile-extension-database 
		foo:default-soundfile-extension-database)
       (begin
	  (set! aux
	          (map 
		     (lambda (x y) 
			(if (eq? type (car x)) (begin (set! flg #t) y) x)) 
		     foo:user-soundfile-extension-database
		     foo:default-soundfile-extension-database))
	  (if flg (set! foo:user-soundfile-extension-database aux)
	         (error 'foo:set-soundfile-type-extension! "Unknown type : ~a~%" type))))))


;
;;
;;; path-expand (tilde-expand + hat expand)
;;
;

;
;;hat-expand -> environment SFDIR or foo:SFDIR {not sure about this one}
;
(define (hat-expand naam)
  (if (symbol? naam) (set! naam (symbol->string naam)))
  (if (equal? (string (string-ref naam 0)) "^")
     (let ((dir (getenv "SFDIR"))
  	   (aux (list->string (cdr (string->list naam)))))
	 (if (not dir) (set! dir (get-SFDIR)))
	 (format #f "~a~a" dir aux))
     naam))

(define (path-expand naam) (hat-expand (tilde-expand naam)))

;
;;
;;; make-sndname (new definition)
;;
;
(define (make-sndname name . type)
  (let ((elem) (aux) (k 0) (el 0)
	(typeext) (nametyp #f) (nameext #f))

;backwards compatibility ->
    (if (and (not (null? type))
	     (boolean? (car type)))
       (begin
 	  (foo:set-soundfile-extension?! (car type))
	  (set! type '())))
;until here <-

    (if (not (null? type))
       (begin
	  (set! type (car type))
	  (if (string? type) (set! type (string->symbol type)))
          (set! typeext (foo:soundfile-type-extension type))
	  (if (not typeext) 
	     (error 'make-sndname "Second argument is not a soundfile-type: ~a~%" type)))
       (set! typeext (foo:soundfile-type-extension (foo:default-soundfile-type))))

    (if (symbol? name) (set! name (symbol->string name)))
    (set! elem (string (string-ref name 0)))
    (set! name (if (and (not (equal? elem "/"))
			(not (equal? elem "."))
			(not (equal? elem ".."))
			(not (equal? elem "~"))
			(not (equal? elem "^"))) (format #f "~a/~a" (get-SFDIR) name)
						 (path-expand name)))

    (if (not (foo:soundfile-extension?)) 
       name
       (begin
	  (set! nameext (foo:find-name-type-extension name))
	  (if (not nameext)
	     (format #f "~a~a" name typeext)
	     (begin 
		(set! nametyp (car nameext))
		(set! nameext (cadr nameext))
		(if (and (not (null? type))
			 (not (equal? nametyp type))) 
		   (begin 
	               (format #t "~%WARNING << make-sndname >> 1st arg's extension and 2nd arg (type) do not coincide : ~a ~a~%" nameext type) 
	               (format #f "~a~a" name typeext))
		   name)))))
     ))

;
;;
;;; sndnorm & fsndnorm {float->short / maximum is kept}
;;
;
(define (sndnorm input output . maximum)
    (set! input (make-sndname input))
    (set! output (make-sndname output))

    (set! maximum (if (null? maximum) 1 (car maximum)))
    (create-soundfile output
	(soundfile-filetype input)
	'short
	(soundfile-srate input)
	(soundfile-channels input))
    (run-task
	(make-task 0 0 output
	    (context (soundfile-channels input)
		(let* ((s (open-snd input))
		       (f (~ (/ maximum (cdr (snd-absolute-maximum s))))))
		    (do ((c 1 (+ c 1)))
			((> c (snd-channels s)) #t)
			(output~ c
			    (mul~ f (read-snd~ (snd-extract s c))))))))
	(soundfile-length input)) #v)

(define (fsndnorm input output)
  (let ((maxy (min 1.0 (soundfile-maximum (make-sndname input)))))
     (prn "Maximum is :"maxy)
     (sndnorm input output maxy)))

;
;;
;;; sndinfo & soundinfo
;;
;
(define sndinfo (lambda args (unix-command 'sndfile-info args)))

(define (soundinfo file)
  (let* ((s) (file (make-sndname file))
  	 (srate (soundfile-srate file)) (maxi) (sampi) (timi) (comm))
     (format #t "Filename  :	~a~%" file)
     (format #t "Type      :	~a~%" (soundfile-filetype file))
     (format #t "Size      :	~a~%" (soundfile-length file))
     (format #t "Format    :	~a~%" (soundfile-format file))
     (format #t "Sam. Rate :	~a~%" srate)
     (format #t "Channels  :	~a~%" (soundfile-channels file))
     (context (soundfile-channels file) (set! s (open-snd file)))
     (set! maxi (cdr (snd-absolute-maximum  s)))
     (set! sampi (car (snd-absolute-maximum  s)))
     (set! timi (sprintf "%.3f" (/ sampi srate)))
     (format #t "Abs. Max. :	~a,	at : ~a,	~a secs.~%"
     		 maxi sampi timi)
     (if (> (soundfile-channels file) 1)
       (begin
        (format #t "~%")
	(do ((c 1 (+ c 1))) ((> c (snd-channels s)) #t)
	    (if (> (abs (cdr (snd-minimum s c))) (cdr (snd-maximum s c)))
	       (begin
	       	  (set! maxi (abs (cdr (snd-minimum s c))))
		  (set! sampi (car (snd-minimum s c))))
	       (set! maxi (cdr (snd-maximum s c)))
	       (set! sampi (car (snd-maximum s c))))
	    (set! timi (sprintf "%.3f" (/ sampi srate)))
	    (format #t "Ch~a  Max. :	~a,	at : ~a,	~a secs.~%"
	    		c maxi sampi timi))
	(format #t "~%")))
;     (set! comm (soundfile-comment file))
;     (if (not (equal? comm ""))
;	(format #t  "Comment   :	~a~%" (soundfile-comment file))
	(format #t "~%")))

;
;;
;;; unix operations with soundfiles
;;
;
(define (unix-sndcp a b)
   (system (string-append "/bin/cp "(make-sndname a)" "(make-sndname b))))

(define (unix-sndmv a b)
   (system (string-append "/bin/mv -f "(make-sndname a)" "(make-sndname b))))

(define (unix-sndrm a)
   (system (string-append "/bin/rm -f "(make-sndname a))))

[foo-cvs] foo/elkfoo/scm/util misc-funs.foo,NONE,1.1

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/util
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv21189/util

Added Files:
	misc-funs.foo 
Log Message:
new branch with utility functions formerly at control/tools/util

--- NEW FILE: misc-funs.foo ---
;
;;
;;;                          misc-funs.foo
;;
;

;
;;      General & Unix
;
(define comment (macro l #v))

(define (identity x) x)

(define sh
    (macro list
	`(let ((port (open-output-string)))
	    (write '(,@list) port)
	    (let ((line (get-output-string port)))
		(system (substring line 1 (- (string-length line) 1))) #v))))

(define (open file)
    (system (string-append "open " file)))

(define-macro (repeat number . expressions)
    `(do ((_i_ 0 (1+ _i_))) ((= ,number _i_) #t) ,@expressions))

(define (iterate count thunk)
    (let ((result '()))
	(repeat count (set! result (cons (thunk) result)))
	(reverse result)))

(define (unix-command command args)
    (define (helper x)
	(string-append (if (symbol? x) (symbol->string x) x) " "))
    (system (apply string-append (map helper (cons command args)))))

;
;;	Numbers & functions
;
(define pi (* 4 (atan 1)))

(define (trunc num) (inexact->exact (truncate num)))
(define (rund num)  (inexact->exact (round num)))

(define (fmod val1 val2 . aproxval)
  (let ((aproxval (if (null? aproxval) #f (trunc (pow 10 (car aproxval)))))
  	(coef))
     (if aproxval (begin (set! val1 (round (* val1 aproxval)))
     			 (set! val2 (round (* val2 aproxval)))))
     (set! coef (truncate (/ val1 val2)))
     (if aproxval (/ (- val1 (* coef val2)) aproxval)
		  (- val1 (* coef val2)))))

;(define (pow a b)
;  (exp (* b (log a))))

(define log10
  (let ((log-of-10 (log 10)))
    (lambda (x)
      (/ (log x) log-of-10))))

(define log2
  (let ((log-of-2 (log 2)))
    (lambda (x)
      (/ (log x) log-of-2))))

(define (dodeca f n)
  (* f (exp (* (/ n 12) (log 2)))))

(define (linear x y0 y1) ; x: 0 -> 1
    (+ y0 (* x (- y1 y0))))

(define (expon x y0 y1 b) ; x: 0 -> 1
  (when (<= b 0)
	(error 'expon "base (~a) must be greater that zero" b))
  (+ y0 (if (equal? b 1)
	    (* x (- y1 y0))
	    (* (- y1 y0) (/ (- (pow b x) 1) (- b 1))))))

;;;;;	    (/ (* (- (pow b (+ x 1)) b) (- y1 y0)) (- (* b b) b)))))

(define (power x y0 y1 e) ; x: 0 -> 1
  (+ y0 (* (pow x e) (- y1 y0))))

(define (lin->dB x)
  (* 20 (log10 x)))

(define (dB->lin x)
  (pow 10 (/ x 20)))

(define (fun->env fun x0 x1 dx)
  (define (loop x)
    (if (< x x1)
	(cons (list x (fun x)) (loop (+ x dx)))
	(list (list x1 (fun x1)))))
  (loop x0))

(define (x->dx l)
    (define (helper s x)
	(if (null? x)
	    '()
	    (cons (- (car x) s) (helper (car x) (cdr x)))))
    (helper (car l) (cdr l)))

(define (dx->x f l)
    (define (helper s x)
	(if (null? x)
	    '()
	    (cons (+ (car x) s) (helper (+ (car x) s) (cdr x)))))
    (cons f (helper f l)))

(define (dx->dy fun x dx)
    (- (fun (+ x dx)) (fun x)))

(define (dy->dx fun inv x dy)
    (inv (/ (+ (fun x) dy) (fun x))))

(define (within a b)
    (+ a (* (/ (random) 2147483647) (- b a))))

(define (make-brownian a b c)
    (let* ((range (- b a))
	   (last (+ a (/ range 2)))
           (factor (* c (/ range 2147483647)))
	   (offset (* c (/ range -2))))
	(lambda ()
	    (set! last (+ last (* (random) factor) offset))
		(if (> last b)
		    (set! last (+ a (- (* range 2) last)))
		    (if (< last a)
			(set! last (- a last))))
	    last)))

;
;;	Printing functions
;
(define prn
    (lambda l (for-each (lambda (x) (format #t "~a " x)) l) (newline) #v))

(define prin
    (lambda l (for-each (lambda (x) (format #t "~a " x)) l) #v))

(define sprintf foo:num-sprintf)

;
;;	Predicates
;
(define (bpflike-pair? arg)
  (let ((flg #t))
      (if (pair? arg)
	(for-each
	  (lambda (x)
	     (if (and (pair? x)
		      (or (= (length x) 2)
			  (= (length x) 3)))
		 (for-each (lambda (y) (if (not (number? y)) (set! flg #f))) x)
		 (set! flg #f))) arg)
	(set! flg #f))
      flg))

(define (numerical? el)
  (let ((flg #t))
      (if (pair? el)
	(for-each (lambda (x) (if (not (numerical? x)) (set! flg #f))) el)
	(if (not (number? el)) (set! flg #f)))
      flg))

(define (symbolic? el)
  (let ((flg #t))
      (if (pair? el)
	(for-each (lambda (x) (if (not (symbolic? x)) (set! flg #f))) el)
	(if (not (symbol? el)) (set! flg #f)))
      flg))

(define (stringed? el)
  (let ((flg #t))
      (if (pair? el)
	(for-each (lambda (x) (if (not (stringed? x)) (set! flg #f))) el)
	(if (not (string? el)) (set! flg #f)))
      flg))

;
;;	Lists and Pairs
;
;(define (list? x)
;  (let loop ((fast x) (slow x))
;    (or (null? fast)
;	(and (pair? fast)
;	     (let ((fast (cdr fast)))
;	       (or (null? fast)
;		   (and (pair? fast)
;			(let ((fast (cdr fast))
;			      (slow (cdr slow)))
;			  (and (not (eq? fast slow))
;			       (loop fast slow))))))))))

(define (flatten l)
    (if (null? l)
	'()
	(if (pair? (car l))
	    (append (flatten (car l)) (flatten (cdr l)))
	    (cons (car l) (flatten (cdr l))))))

(define (clean Lst) 
   (while (and (pair? Lst)
               (= (length Lst) 1)
               (list? (car Lst))) (set! Lst (car Lst))) Lst)

(define (flatout l) (clean (flatten l)))

(define (cleanlist l)
    (if (null? l)
	'()
	(if (list? (car l))
	    (append (cleanlist (car l)) (cleanlist (cdr l)))
	    (cons (car l) (cleanlist (cdr l))))))

(define nth list-ref)

(define (list-head Lst num)
  (let* ((lnz (length Lst)) (num (- lnz num)))
      (reverse (list-tail (reverse Lst) num))))
     
(define (first-symbol Lst)
  (let ((val #f))
     (for-each (lambda (x) (if (and (not val)
     				    (symbol? x)) (set! val x))) (flatten Lst))
     val))
;
;;	Object Functionalities
;
(define (get-Name f) (class-name f))

(define (get-SuperName f) 
    (cond
    	((instance? f)	(vector-ref (eval (get-Name f)) 4))
	((class? f)	(vector-ref f 4))))

;
;;      Psychoacoustics & Frq related other
;
(define (Hz->Midics f)
    (+ 6900 (* 1200 (log2 (/ f 440)))))

(define (Midics->Hz f)
    (* 440 (pow 2 (/ (- f 6900) 1200))))

;;
;; center frequency (Hz) to f1 parameter for state variable filter (fve~)
;; fc = center frequency in Hz, fs = sampling frequency in Hz
;;

(define (fc->f1 fc fs)
    (sin (/ (* 2 pi fc) fs)))

;;
;; bandwidth to q1 parameter for state variable filter (fve~)
;; bw = bandwidth in Hz, fs = center frequency in Hz
;;

(define (bw->q1 bw cf)
    (/ bw cf 2))

;;
;; critical band width in Hz at frequency f in Hz
;; from: Zwicker, Psychoakustik, Springer 1982, p. 67
;;

(define (critical-band-width f)
    (+ 25 (* 75 (pow (+ 1 (* .0000014 f f)) .69))))

;; frequency depending damping in dB of uniformly exciting noise (f in Hz)
;; from: Feldkellter & Zwicker, Das Ohr als Nachrichtenempfaenger,
;; Hirzel 1967, p. 107

(define (agar f)
    (- (* 10 (log10 (critical-band-width f))) 20))

;; converts a frequency f in Hertz to the corresponding value in Bark
;; from: Zwicker, Psychoakustik, Springer 1982, p. 67

(define (Hz->Bark f)
    (+ (* 13. (atan (* 0.00076 f))) (* 3.5 (atan (/ (* f f) 56250000.)))))

;; iterative approximation of ferquency in Hz corresponding to value in Bark
;; uses Hz->Bark

(define (Bark->Hz z)
    (let ((hz 1) (zz) (dh) (dx 10))
	(if (> z 25) (set! z 25))
	(if (< z 0) (set! z 0))
	(define (helper)
	    (set! zz (- (Hz->Bark hz) z))
	    (if (= 0 zz)
	    hz
		(set! dh (/ dx (- 1 (/ (- (Hz->Bark (+ hz dx)) z) zz))))
		(set! hz (+ hz dh))
		(if (> dh dx)
		    (helper)
		    hz)))
	(helper)))
  
;; absolute threshold in dB SPL depending in frequency in Hz

(define (absolute-threshold f)
    (let* ((ff (/ f 1000)) (f4 (* ff ff ff ff)) (f3 (- ff 3.3)))
	(if (<= ff 0)
	    0
	    (+ (- (* 3.64 (pow ff -.8))
	          (* 6.5 (exp (* -.6 f3 f3)))) (* .001 f4)))))

;
;;
;
(provide 'util)

[foo-cvs] foo/elkfoo/scm/util Makefile.am,NONE,1.1

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/util
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv20826/util

Added Files:
	Makefile.am 
Log Message:
new branch with utility functions formerly at control/tools/util

--- NEW FILE: Makefile.am ---
# foo/elkfoo/scm/util/Makefile.am
# 2007 rgbach

#

NULL = 

EXTRA_DIST = $(ELKFOO_UTIL_FILES)

pkgutilities_DATA = $(ELKFOO_UTIL_FILES)

pkgutilitiesdir = $(pkgdatadir)/util

ELKFOO_UTIL_FILES = \
	init-util.foo \
	misc-funs.foo \
	soundfile-funs.foo \
	$(NULL)

[foo-cvs] foo/elkfoo/scm/util init-util.foo,NONE,1.1

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/util
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv20762/util

Added Files:
	init-util.foo 
Log Message:
new branch with utility functions formerly at control/tools/util

--- NEW FILE: init-util.foo ---
;;; -*-Scheme-*-
;;;

;; init-util.foo

(require 'foops)

;; init-tools.foo

(global-load "util/misc-funs.foo")
(global-load "util/soundfile-funs.foo")

(provide 'foo-util)

;; EOF

[foo-cvs] foo/elkfoo/scm/util - New directory

[Ramon Gonzalez-A. <rg...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/util
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv18437/util

Log Message:
Directory /cvsroot/foo/foo/elkfoo/scm/util added to the repository

[foo-cvs] foo README,1.1,1.2

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

Update of /cvsroot/foo/foo
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv7057

Modified Files:
	README 
Log Message:
updated README a bit

Index: README
===================================================================
RCS file: /cvsroot/foo/foo/README,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** README	7 Aug 2004 23:56:11 -0000	1.1
--- README	7 Apr 2007 13:25:48 -0000	1.2
***************
*** 4,8 ****
  --------------------------
  
! last edited 2004-08-07 rumori
  
  this readme contains information about the requirements, installation
--- 4,8 ----
  --------------------------
  
! last edited 2007-03-07 rumori
  
  this readme contains information about the requirements, installation
***************
*** 18,22 ****
    foo) and in soundfile read/write mode, which is heavily used in foo.
    the version of libsndfile coming with your distribution might be an
!   older one and therefore *TOO OLD*.
  - fooelk >= 0.0.3 or recent "ordinary" elk
  
--- 18,23 ----
    foo) and in soundfile read/write mode, which is heavily used in foo.
    the version of libsndfile coming with your distribution might be an
!   older one and therefore *TOO OLD*.  for the rudimentary flac support
!   you will need libsndfile >= 1.0.12.
  - fooelk >= 0.0.3 or recent "ordinary" elk
  
***************
*** 50,57 ****
  configure looks for an installation of fooelk first, after that it
  tries to find an "ordinary" elk installation.  if elk is not found,
! foo refuses to build.  you may specify the location of elk/fooelk with
  
! ./configure --with-elk-include=/path/to/elk/headers \
! 	--with-elk-library=/path/to/elk/lib
  
  make
--- 51,73 ----
  configure looks for an installation of fooelk first, after that it
  tries to find an "ordinary" elk installation.  if elk is not found,
! foo refuses to build.
  
! if you installed fooelk/elk in a non-standard location, you might
! specify the paths like this:
! 
! CPPFLAGS=/nonste/include LDFLAGS=/nonstd/lib ./configure
! 
! usually, foo will try to install its elk extension library (elkfoo.so)
! to the fooelk/elk library path (elk integration).  if you don't have
! write access to this location, you may also install the extension
! separatedly from elk by specifying
! 
! ./configure --disable-elk-integration
! 
! you may enable flac reading/writing support by specifying
! 
! ./configure --enable-flac-support
! 
! this is disabled by default so far.
  
  make
***************
*** 160,161 ****
--- 176,189 ----
  the default filetype is 'aiff.
  
+ 
+ flac file support
+ -----------------
+ 
+ with a libsndfile >= 1.0.12, foo is able to read and write flac files.
+ since flacs cannot be openend in read/write mode and since seeking in
+ flac files being written is not possible, not the full functionality
+ of foo can be used with flac files.  basically, it's only possible to
+ linearily write flac files once from start to end.  no 'blend at all,
+ no 'punch at another point than starting from the beginning.  flac
+ support is mainly meant for doing conversion from and to flac, not as
+ a file format for the workflow of sound synthesis or composing.

[foo-cvs] foo/elkfoo/src Makefile.am, 1.9, 1.10 snd.m, 1.8, 1.9 soundfile.m, 1.9, 1.10

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

Update of /cvsroot/foo/foo/elkfoo/src
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv18815/elkfoo/src

Modified Files:
	Makefile.am snd.m soundfile.m 
Log Message:
added rudimentary flac support

Index: soundfile.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/soundfile.m,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** soundfile.m	22 May 2006 22:18:35 -0000	1.9
--- soundfile.m	4 Apr 2007 14:36:04 -0000	1.10
***************
*** 114,117 ****
--- 114,122 ----
        s.format |= SF_FORMAT_XI;
        break;
+ #ifdef HAVE_SNDFILE_FLAC_SUPPORT
+     case SND_FILETYPE_FLAC:
+       s.format |= SF_FORMAT_FLAC;
+       break;
+ #endif // #ifdefHAVE_SNDFILE_FLAC_SUPPORT
      default:
        Primitive_Error("soundfile.m: internal inconsistency (filetype)");
***************
*** 195,198 ****
--- 200,211 ----
        }
  
+ //     { // write one frame silence: HACK
+ //       sample_t *tmpbuf;
+ 
+ //       tmpbuf = calloc(1, s.channels * sizeof(sample_t));
+ //       sf_writef_float(sfd, tmpbuf, 1);
+ //       free(tmpbuf);
+ //     }
+ 
      if (sf_close(sfd))
        {
***************
*** 323,326 ****
--- 336,344 ----
  	  ret = Intern("xi");
  	  break;
+ #ifdef HAVE_SNDFILE_FLAC_SUPPORT
+ 	case SF_FORMAT_FLAC:
+ 	  ret = Intern("flac");
+ 	  break;
+ #endif // #ifdef HAVE_SNDFILE_FLAC_SUPPORT
  	default:
  	  {

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/Makefile.am,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** Makefile.am	26 Aug 2004 09:52:02 -0000	1.9
--- Makefile.am	4 Apr 2007 14:36:04 -0000	1.10
***************
*** 35,38 ****
--- 35,39 ----
  
  if USE_GNUSTEP_BASE
+ include @GNUSTEP_MAKEFILES@/config.make
  include @GNUSTEP_MAKEFILES@/library-combo.make
  include @GNUSTEP_MAKEFILES@/common.make

Index: snd.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/snd.m,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** snd.m	22 May 2006 22:18:35 -0000	1.8
--- snd.m	4 Apr 2007 14:36:04 -0000	1.9
***************
*** 75,78 ****
--- 75,81 ----
  				 {"pvf", SND_FILETYPE_PVF},
  				 {"xi", SND_FILETYPE_XI},
+ #ifdef HAVE_SNDFILE_FLAC_SUPPORT
+ 				 {"flac", SND_FILETYPE_FLAC},
+ #endif // #ifdef HAVE_SNDFILE_FLAC_SUPPORT
  				 {0, 0} };
  
***************
*** 275,278 ****
--- 278,286 ----
  	  t = sndFileTypes[13].name;
  	  break;
+ #ifdef HAVE_SNDFILE_FLAC_SUPPORT
+ 	case SF_FORMAT_FLAC:
+ 	  t = sndFileTypes[14].name;
+ 	  break;
+ #endif // #ifdef HAVE_SNDFILE_FLAC_SUPPORT
  	default:
  	  Primitive_Error("unknown sound file filetype: ~a",

[foo-cvs] foo/libfoo/tests/foosine Makefile.am,1.5,1.6

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

Update of /cvsroot/foo/foo/libfoo/tests/foosine
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv18815/libfoo/tests/foosine

Modified Files:
	Makefile.am 
Log Message:
added rudimentary flac support

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/tests/foosine/Makefile.am,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Makefile.am	5 Aug 2004 21:18:03 -0000	1.5
--- Makefile.am	4 Apr 2007 14:36:04 -0000	1.6
***************
*** 13,16 ****
--- 13,17 ----
  
  if USE_GNUSTEP_BASE
+ include @GNUSTEP_MAKEFILES@/config.make
  include @GNUSTEP_MAKEFILES@/library-combo.make
  include @GNUSTEP_MAKEFILES@/common.make