foo-cvs — mailing list for CVS commit messages.

[foo-cvs] foo/libfoo/modules/orthodox FOOMLookup.h,1.3,1.4

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

Update of /cvsroot/foo/foo/libfoo/modules/orthodox
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10948

Modified Files:
	FOOMLookup.h 
Log Message:
fixed signature of header according to implementation

Index: FOOMLookup.h
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMLookup.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** FOOMLookup.h	15 Aug 2004 16:48:55 -0000	1.3
--- FOOMLookup.h	30 Aug 2004 14:33:53 -0000	1.4
***************
*** 53,57 ****
  }
  
! - initializeWithSubstrate: (FOOSubstrate *)substr taps: (int)n;
  
  @end
--- 53,57 ----
  }
  
! - initializeWith: (FOOSubstrate *)substr taps: (int)n;
  
  @end

[foo-cvs] foo/elkfoo/scm Makefile.am,1.4,1.5

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

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

Modified Files:
	Makefile.am 
Log Message:
Makefile now doesn't look into the tools directory.
 
This dorectory should be removed

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/Makefile.am,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Makefile.am	11 Aug 2004 11:26:28 -0000	1.4
--- Makefile.am	30 Aug 2004 13:45:51 -0000	1.5
***************
*** 6,10 ****
  NULL = 
  
! SUBDIRS = kernel tools control
  
  EXTRA_DIST = $(FOO_FILES) toplevel.foo.in
--- 6,10 ----
  NULL = 
  
! SUBDIRS = kernel control
  
  EXTRA_DIST = $(FOO_FILES) toplevel.foo.in

[foo-cvs] foo/elkfoo/scm toplevel.foo.in,1.6,1.7

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

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

Modified Files:
	toplevel.foo.in 
Log Message:
new tree to include tools within control.
 
altered order of loading, so that control & tools are loaded before the customiztion files

Index: toplevel.foo.in
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/toplevel.foo.in,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** toplevel.foo.in	26 Aug 2004 08:20:25 -0000	1.6
--- toplevel.foo.in	30 Aug 2004 13:44:58 -0000	1.7
***************
*** 214,220 ****
  ;; std list of initialization files
  (define foo-init-files
!   (list "tools/init-tools.foo"
  	"control/init-control.foo"))
  
  ;; load customization files
  (if (feature? 'elkfoo)
--- 214,223 ----
  ;; std list of initialization files
  (define foo-init-files
!   (list "control/init-tools.foo"
  	"control/init-control.foo"))
  
+ ;; load init files
+ (map load foo-init-files)
+ 
  ;; load customization files
  (if (feature? 'elkfoo)
***************
*** 240,245 ****
  	  (load ".init.foo"))))
  
! ;; load init files
! (map load foo-init-files)
  
  (provide 'foo)
--- 243,248 ----
  	  (load ".init.foo"))))
  
! ;;; load init files
! ;(map load foo-init-files)
  
  (provide 'foo)

[foo-cvs] foo/elkfoo/scm/control init-control.foo,1.2,1.3

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

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

Modified Files:
	init-control.foo 
Log Message:
removed require struct, probably also could remove require foops since it is done in topelevel

Index: init-control.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/init-control.foo,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** init-control.foo	11 Aug 2004 12:26:17 -0000	1.2
--- init-control.foo	30 Aug 2004 13:43:45 -0000	1.3
***************
*** 5,12 ****
  
  (require 'foops)
- (require 'struct)
  
  (if (not (feature? 'foo-tools))
!     (global-load "tools/init-tools.foo"))
  
  (global-load "control/interface-lib/sp-sigpack-type.foo")
--- 5,11 ----
  
  (require 'foops)
  
  (if (not (feature? 'foo-tools))
!     (global-load "control/init-tools.foo"))
  
  (global-load "control/interface-lib/sp-sigpack-type.foo")

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

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

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

Added Files:
	init-tools.foo 
Log Message:
initialization of tools files

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

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

;; EOF

[foo-cvs] foo/elkfoo/scm/control Makefile.am,1.2,1.3

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

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

Modified Files:
	Makefile.am 
Log Message:
Makefile of control to include tools and init-tools

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/Makefile.am,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Makefile.am	8 Aug 2004 00:33:21 -0000	1.2
--- Makefile.am	30 Aug 2004 13:42:07 -0000	1.3
***************
*** 12,15 ****
--- 12,16 ----
  	node \
  	processes \
+ 	tools \
  	$(NULL)
  
***************
*** 22,24 ****
--- 23,26 ----
  ELKFOO_CONTROL_FILES = \
  	init-control.foo \
+ 	init-tools.foo \
  	$(NULL)

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

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

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

Added Files:
	Makefile.am 
Log Message:
makefile of tools

--- NEW FILE: Makefile.am ---
# foo/elkfoo/scm/tools/Makefile.am
# 2004 rumori

# $Id: Makefile.am,v 1.1 2004/08/30 13:41:32 rgbach Exp $

NULL = 

SUBDIRS = mixsnd util

EXTRA_DIST = $(ELKFOO_TOOLS_FILES)

pkgtools_DATA = $(ELKFOO_TOOLS_FILES)

pkgtoolsdir = $(pkgdatadir)/control/tools

ELKFOO_TOOLS_FILES = \
	pitch.foo \
	$(NULL)

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

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

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

Added Files:
	Makefile.am mix-auxfun.foo mixsnd.foo 
Log Message:
mixsnd makefile and files

--- NEW FILE: mixsnd.foo ---
;
;;
;;;
;;;;
;;;;;	Mixsnd : General Mixing-Function
;;;;
;;;
;;
;
(load  'control/Tools/Mixsnd/Mix-auxfun.foo)
;
;;
;;;
;;
;
(define (Mixsnd filnam . Mode)
 (let ((indata) (cdir (get-SFDIR)) (aux) (dum) (chns 2) (norm 1)
       (nam (make-sndname (string-append "/foo" (number->string (getpid))) #t))
       (Mode (if (null? Mode) 'Blend (car Mode))))

      (set! indata (Mix:decoder filnam))
      (if (> (length indata) 1)
         (begin
      	    (set! aux (nth indata 1))
            (set! dum (assq 'cdsf aux)) (if dum (set-SFDIR (cadr dum)))
	    (set! dum (assq 'out aux))
	    (if dum (set! nam (make-sndname (cadr dum) #t)))
	    (set! dum (assq 'cha aux))  (if dum (set! chns (cadr dum)))
	    (set! dum (assq 'fac aux))  (if dum (set! norm (cadr dum)))
	    (set! dum (assq 'nor aux))  (if dum (set! norm (cadr dum)))
	    (set! indata (nth indata 0))))

      (cond
        ((equal? Mode 'Punch)  (Mixsnd1 indata nam chns norm cdir 'float))
        ((equal? Mode 'ShPunch) (Mixsnd1 indata nam chns norm cdir 'short))
        ((equal? Mode 'Incrm)  (Mixsnd2 indata nam chns norm cdir))
        ((equal? Mode 'Blend)  (Mixsnd3 indata nam chns norm cdir 'float))
        ((equal? Mode 'ShBlend)  (Mixsnd3 indata nam chns norm cdir 'short))
	(#t
	   (prn "Unknown Mixing-Mode {Punch, ShPunch, Incrm, Blend, ShBlend} :" 
	         Mode) #f))))
;
;
;;
;;;
;;;;
;;;;;	Mixsnd1 : Punch (float or short) file / all input files in one context
;;;;
;;;
;;
;
(define (Mixerabs Nchns Elmnts)
  (let ((Mtx (make-MixOmtx Nchns)))
      (list SP-Parallel 0 1 1 Mtx '() (make-MixElms Elmnts Nchns))))
;
;;
;;;
;;
;
(define (Mixsnd1 indata nam chns norm cdir filtyp)
  (let ((mixer) (off) (dur) (aux) (dum))
      (set! mixer (lambda () (Mixerabs chns indata)))
      (SP-run (SP-context-aux 0 1 chns '() '() mixer '())
      	      (list 'Filename nam)
	      (list 'Snd-Format filtyp)
	      (list 'Normfactor norm))
      (set! nam (make-sndname nam))
      (set-SFDIR cdir)
      nam))
;
;;
;;;
;;;;
;;;;;	Mixsnd2 : incremental file / a new context per input file
;;;;
;;;
;;
;
(define (Mixsnd2  indata nam chns norm cdir)
  (let ((mixer) (off) (dur #f) (fac) (aux) (dum))

    (for-each
     (lambda (x)
       (set! aux (assq 'und x))
	(if aux
	   (begin
	      (prn "Removing sound "(cadr aux))
	      (SP-run (cadr aux) (list 'Filename nam) (list 'Mode 'Undo)))
	   (set! aux (assq 'mod x))
	   (if aux
	      (begin
		(prn "Modifying sound " (cadr aux))
		(set! off (assq 'off x))
		(if off (set! off (list 'offset (cadr off))))
		(set! fac (assq 'fac x))
		(set! fac (list 'factor (if fac (cadr fac) 1)))
		(SP-run (list (cadr aux) (if off off) fac)
			(list 'Filename nam)
		     	(list 'Mode 'Modify)))
	      (set! aux '())
	      (set! off #f)
	      (set! dur #f)
	      (for-each
	       (lambda (y) (if (member 'dur y) (set! dur (cadr y)))
	      		   (if (member 'off y) (set! off (cadr y))
	      				       (set! aux (cons y aux)))) x)
	      (set! mixer (lambda () (make-MixElms2 aux chns)))
	      (SP-run (SP-context-aux 0 1 chns '() '() mixer '())
      	              (list 'Filename nam)
	              (list 'Snd-Type 'incremental)
		      (if off (list 'Offset off))
		      (if dur (list 'Duration dur)))))) indata)
    (sndnorm (make-sndname (string-append nam ".imx/mixfloat"))
       	     (make-sndname nam) norm) 
    (set! nam (make-sndname nam))
    (set-SFDIR cdir)
    nam))
;
;;
;;;
;;;;
;;;;;	Mixsnd3 : blend (float or short) file / a new context per input file
;;;;
;;;
;;
;
(define (Mixsnd3 indata nam chns norm cdir filtyp)
  (let ((mixer) (off) (dur #f) (fac) (aux) (dum) (fctr))

      (for-each
        (lambda (x)
	    (set! fctr 1)
	    (set! dur #f)
	    (set! off #f)
	    (cond
	       ((assq 'und x)	(set! fctr -1))
	       ((assq 'mod x)	(set! aux (assq 'fac x))
	      			(if aux (set! fctr (cadr aux))
					(set! fctr -1))))
	    (set! aux '())
	    (for-each
	      (lambda (y) (if (member 'dur y) (set! dur (cadr y)))
	      		  (if (member 'off y) (set! off (cadr y))
	      				      (set! aux (cons y aux)))) x)
	    (set! mixer (lambda () (make-MixElms2 aux chns)))
	    (SP-run (SP-context-aux 0 1 chns '() '() mixer '())
      	            (list 'Filename nam)
      	            (list 'Snd-Format filtyp)
      	            (list 'Mode 'Blend)
      	            (list 'Factor fctr)
		    (if off (list 'Offset off))
		    (if dur (list 'Duration dur)))) indata)
;      (if (equal? filtyp 'float)
;      	 (begin
;	    (sndnorm (make-sndname nam) 
;		     (make-sndname (string-append nam ".rs")) norm)
;	    (set-SFDIR cdir)
;	    (make-sndname (string-append nam ".rs")))
	 (set-SFDIR cdir)
	 (make-sndname nam)));)
;
(provide 'Mixsnd)

--- NEW FILE: Makefile.am ---
# foo/elkfoo/scm/tools/mixsnd/Makefile.am
# 2004 rumori

# $Id: Makefile.am,v 1.1 2004/08/30 13:40:57 rgbach Exp $

NULL = 

EXTRA_DIST = $(ELKFOO_MIXSND_FILES)

pkgmixsnd_DATA = $(ELKFOO_MIXSND_FILES)

pkgmixsnddir = $(pkgdatadir)/control/tools/mixsnd

ELKFOO_MIXSND_FILES = \
	mix-auxfun.foo \
	mixsnd.foo \
	$(NULL)

--- NEW FILE: mix-auxfun.foo ---
;
;;
;;;
;;;;
;;;;;		Mixer General Functions
;;;;
;;;
;;
;
;
;;
;;;
;;	Related to the Input Format : Keywords and Functions
;
(define Mix:keywords0 (list "cdsf"))
(define Mix:keywords1 (list "input" "modify" "undo"))
(define Mix:keywords2 (list "output"))
(define Mix:keywords3 (list "begin" "end" "reverse"
			    "start" "offset" "duration" "amplitude" "transpose"
			    "send"
			    "factor"
			    "channels" "normalize"))
;
(define (belong val reflst)
   (let ((flg #f) (aux))
     (if (symbol? val) (set! val (symbol->string val)))
     (if (or (not (string? val))
     	     (<= (string-length val) 1)) #f
        (for-each
          (lambda (x)
	     (set! aux (substring-ci? val x))
	     (if (and aux (= aux 0)) (set! flg #t))) reflst)
        flg)))
;
(define (unif val reflst)
   (let ((rsl) (aux))
      (if (symbol? val) (set! val (symbol->string val)))
      (for-each
        (lambda (x)
	   (set! aux (substring-ci? val x))
	   (if (and aux (= aux 0))
	      (set! rsl 
	       (if (equal? x "start") 'off
	     	     (string->symbol (substring x 0 3)))))) reflst)                    
      rsl))
;
(define (Mix:decoder data)
  (let ((strm #f) (cnt 0) (txt) (ltxt) (aux) (rsl) (aux2) (flg #t))
   (if (pair? data)
      (begin
;      	  (set! data (flatten data))
	  (define getVal (lambda () (let ((val (nth data cnt)))
					(set! cnt (1+ cnt)) val)))
	  (define finito? (lambda () (= cnt (length data)))))
      (set! strm (open-input-file data))
      (define getVal (lambda () (read strm)))
      (define finito? (lambda () (eof-object? txt))))
   (while flg
     (set! txt (getVal))
     (cond
       ((belong txt Mix:keywords0) (set! ltxt (list 'cdsf (getVal))))
       ((belong txt Mix:keywords1)
       		 (if (not (null? aux2)) (set! aux (cons (reverse aux2) aux)))
		 (if (not (null? aux)) (set! rsl (cons (reverse aux) rsl)))
		 (set! aux
		      (list (list (unif txt Mix:keywords1) (getVal)) ltxt))
		 (set! aux2 '()))
       ((belong txt Mix:keywords2)
		 (if (not (null? aux2)) (set! aux (cons (reverse aux2) aux)))
		 (if (not (null? aux)) (set! rsl (cons (reverse aux) rsl)))
		 (set! rsl (list (reverse rsl)))
		 (set! aux
		     (list (list 'out (getVal)) ltxt))
		 (set! aux2 '()))
       ((belong txt Mix:keywords3)
		  (if (not (null? aux2)) (set! aux (cons (reverse aux2) aux)))
		  (set! aux2 (list (unif txt Mix:keywords3))))
       ((finito?)
		  (set! flg #f)
		  (set! aux2 (cons txt aux2))
		  (set! aux (cons (reverse aux2) aux))
		  (set! rsl (cons (reverse aux) rsl)))
       (#t	  (set! aux2 (cons txt aux2)))))
   (if strm (close-port strm))
   (reverse rsl)))
;
;;
;;;	Preparing the Data
;;
;
(define (make-MixElms2 Lst Ochns)
 (let ((Vars) (Mtx))
   (for-each
     (lambda (y)
      (cond
        ((null? y)	'())
	((equal? (car y) 'cdsf)	(set! Vars (cons (cons 'Dir (cdr y)) Vars)))
	((equal? (car y) 'inp)	(set! Vars (cons (cons 'Name (cdr y)) Vars)))
	((equal? (car y) 'und)	(set! Vars (cons (cons 'Name (cdr y)) Vars)))
	((equal? (car y) 'mod)	(set! Vars (cons (cons 'Name (cdr y)) Vars)))
	((equal? (car y) 'off)	(set! Vars (cons (cons 'Off (cdr y)) Vars)))
	((equal? (car y) 'dur)	(set! Vars (cons (cons 'Dur (cdr y)) Vars)))
	((equal? (car y) 'beg)	(set! Vars (cons (cons 'Beg (cdr y)) Vars)))
	((equal? (car y) 'end)	(set! Vars (cons (cons 'End (cdr y)) Vars)))
	((equal? (car y) 'rev)	(set! Vars (cons (cons 'Rev (cdr y)) Vars)))
	((equal? (car y) 'amp)	(set! Vars (cons (cons 'Amp (cdr y)) Vars)))
	((equal? (car y) 'tra)	(set! Vars (cons (cons 'SI (cdr y)) Vars)))
	((equal? (car y) 'sen)	(set! Mtx (cons (cdr y) Mtx))))) Lst)
   (if (not (null? Mtx)) (set! Vars (cons (list 'Mtx Mtx) Vars)))
   (set! Vars (cons (list 'Ochns Ochns) Vars))
   (apply Mixcomponent Vars)))
;
(define (make-MixElms Lst Ochns)
   (map (lambda (x) (make-MixElms2 x Ochns)) Lst))
;
;;
;;;	Processing of each individual input
;;;	returns the Interface-Library "Patch"
;;
;
(define (Mixcomponent . Vars)
  (let ((Dir (get-SFDIR)) (Name) (Off 0) (Dur #f)
        (Beg 0) (End) (Rev #f) (Amp 1) (SI 1) (Mtx 1) (Ochns)
	(aux) (Odur) (Chn) (Snd) (OMtx) (Lst))
   (set! aux (assq 'Dir Vars))     (if aux (set! Dir (cadr aux)))
   (set! aux (assq 'Name Vars))   (if aux (set! Name (cadr aux)))
   (set! aux (assq 'Off Vars))     (if aux (set! Off (cadr aux)))
   (set! aux (assq 'Dur Vars))     (if aux (set! Dur (cadr aux)))
   (set! aux (assq 'Beg Vars))     (if aux (set! Beg (cadr aux)))
   (set! aux (assq 'End Vars))     (if aux (set! End (cadr aux)))
   (set! aux (assq 'Rev Vars))     (if aux (set! Rev #t))
   (set! aux (assq 'Mtx Vars))	   (if aux (set! Mtx (cadr aux)))
   (set! aux (assq 'Ochns Vars)) (if aux (set! Ochns (cadr aux)))
   (set! aux (assq 'Amp Vars)) 
   (if aux  (set! Amp (if (= (length aux) 2) (cadr aux) (cdr aux))))
   (set! aux (assq 'SI Vars))
   (if aux  (set! SI (if (= (length aux) 2) (cadr aux) (cdr aux))))

   (set! aux  (make-Mixobj Dir Name SI Beg End))
   (set! Name (car aux))
   (set! SI   (cadr aux))
   (set! Odur (caddr aux))
   (set! Dur  (find-Mixdur Dur Odur))
   (set! Mtx  (make-MixMtx Mtx Name Ochns Dur))
   (set! Chn  (car Mtx))
   (set! Mtx  (cadr Mtx))
   (set! Snd  (open-snd Name))
   (set! Amp  (make-Mixamp Amp))
   (set! SI   (make-Mixfrq SI))
   (set! OMtx (make-MixOmtx Ochns))
   (set! Lst
    (map
      (lambda (x1 x2)
       (let ((Sndnw Snd))
	(if (number? x2) (set! Sndnw (snd-extract Snd x2)))
	(set! Sndnw (make-Mixsnd Sndnw Beg End Rev))
	(if (and (number? SI)
		 (= 1 SI)) (list Sndread Off Dur Amp x1 '() Sndnw)
			(list Sampler Off Dur Amp x1 '() SI Sndnw)))) Mtx Chn))
  (if (= (length Chn) 1) (car Lst)
	       		 (list SP-Parallel 0 1 1 OMtx '() Lst))))
;
;;
;;;	From input data finds the correct values to make an Sndpack
;;
;
(define (make-Mixobj dir nam frq beg end)
  (let ((odir (get-SFDIR)) (odur #f))
     (if (not (null? dir)) (set-SFDIR dir))
     (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))
     (set! odur  (if (and (number? beg)
			  (number? end))  (abs (- end beg))
			  		  (soundfile-length nam)))
     (set! odur (if (number? frq) (/ odur frq) (if (null? frq) odur #f)))
     (set-SFDIR odir)
     (list nam frq odur)))
;
;;
;;;	Try to be smart and guess a duration if it is not given
;;
;
(define (find-Mixdur dur odur)
    (cond
    	(dur		dur)
	(odur		odur)
	(#t		1)))
;
;;
;;;	Dealing with the Matrix for Output (heavy)
;;
;
(define (prepval val)
  (if (sigpack? val) val
  	(if (or (number? val)
  	  	(envelope? val)
	  	(envlike-pair? val)) (make-sigpack val)
				     (apply make-sigpack val))))
; 
(define (trnsltmtrx mtx Ochns dur)
  (let ((aux) (aux2) (fch) (lch))
   (cond
      ((and (= Ochns 1)
      	    (= (length mtx) 1))  (list (prepval (car mtx))))
      ((number? (car mtx)) (append (make-list (- (car mtx) 1) 0)
      				   (list (prepval (cadr mtx)))
      				   (make-list (- Ochns (car mtx)) 0)))
      ((number? (car mtx)) (append (make-list (- (car mtx) 1) '(0))
      				   (list (list (prepval (cadr mtx))))
      				   (make-list (- Ochns (car mtx)) '(0))))
      ((and (> Ochns 2)
            (= (length mtx) 2)
	    (pair? (car mtx))
	    (= (length (car mtx)) 3)
	    (equal? (caar mtx) 'Pan)
	    (numerical? (cdar mtx)))
	    		(set! aux  (cadr mtx))
			(set! aux (prepval aux))
			(set! aux2 (make-sigpack (list sub~ (list ~ 1) aux)))
			(set! fch (nth (car mtx) 1))
			(set! lch (nth (car mtx) 2))
			(append (make-list (- fch 1) '(0))
				(list (list aux2))
				(make-list (- lch fch 1) '(0))
				(list (list aux))
				(make-list (- Ochns lch) '(0))))
      ((and (= Ochns 2)
      	    (equal? (car mtx) 'Pan)
	    (= (length mtx) 2))	    (list 'Pan (prepval (cadr mtx)))))))
;
(define (make-MixMtx1 chns)
  (let ((mtx))
   (do ((c 0 (+ c 1))) ((= c chns) (reverse mtx))
     (set! mtx (cons
     (append (make-list c '(0)) (list '(1)) (make-list (- chns c 1) '(0)))
     	mtx)))))
;
(define (make-MixMtx1 chns)
  (let ((mtx))
   (do ((c 0 (+ c 1))) ((= c chns) (reverse mtx))
     (set! mtx (cons
     (append (make-list c  0) (list 1) (make-list (- chns c 1) 0))
     	mtx)))))
;
(define (make-MixMtx mtx filnam Ochns dur)
   (let ((ichn (soundfile-channels filnam)) (chn) (aux) (aux1) (aux2))
      (cond
        ((and (number? mtx)
	      (= mtx 1))
		  (cond
		    ((= ichn Ochns)
		    	(if (= ichn 1)
			   (begin (set! chn '(all))
				  (set! mtx '((1))))
			   (set! chn (mk-ordrlst ichn 1))
			   (set! mtx (make-MixMtx1 Ochns))))
		    (#t	(set! chn '(all))
		        (if (= Ochns 1) (set! mtx '((1)))
		    	(set! mtx (list (map (lambda (x) (list 1))
				             (mk-ordrlst Ochns 1))))))))
	((and (pair? mtx)
	      (= (length mtx) 1)
	      (= Ochns 1))	(set! chn '(all))
	      			(set! mtx (list (trnsltmtrx mtx Ochns dur))))
	((and (pair? mtx)
	      (= (length mtx) 2)
	      (number? (car mtx))
	      (= ichn 1))	  (set! chn '(all))
	      		  (set! mtx (list (trnsltmtrx mtx Ochns dur))))
	((and (pair? mtx)
	      (number? (car mtx)))  (set! chn (list (car mtx)))
	      		    (set! mtx (list (trnsltmtrx (cdr mtx) Ochns dur))))
	((and (pair? mtx)
	      (= 2 (length mtx))
	      (or (equal? 'Pan (car mtx))
	      	  (equal? 'pan (car mtx))))	(set! chn '(all))
		  		  (set! mtx (list (trnsltmtrx mtx Ochns dur))))
	((and (pair? mtx)
	      (pair? (car mtx))
	      (= 3 (length (car mtx)))
	      (or (equal? 'Pan (caar mtx))
	      	  (equal? 'pan (caar mtx))))	(set! chn '(all))
		  		  (set! mtx (list (trnsltmtrx mtx Ochns dur))))
	((pair? mtx)
		(set! aux  (map (lambda (x) (make-MixMtx x filnam Ochns dur)) 
				 mtx))
		(for-each (lambda (x) (set! aux1 (append (car x) aux1))
				      (set! aux2 (append (cadr x) aux2))) aux)
		(set! chn (reverse aux1))
		(set! mtx (reverse aux2)))
	(#t
		  (cond
		    ((= ichn Ochns)
		    	(if (= ichn 1)
			   (begin (set! chn '(all))
				  (set! mtx '((1))))
			   (set! chn (mk-ordrlst ichn 1))
			   (set! mtx (make-MixMtx1 Ochns))))
		    (#t	(set! chn '(all))
		        (if (= Ochns 1) (set! mtx '((1)))
		    	(set! mtx (list (map (lambda (x) (list 1))
				             (mk-ordrlst Ochns 1)))))))))
	(list chn mtx)))
;
;;
;;;	All parameters decoded
;;
;
(define (make-Mixsnd name beg end rev)
  (if (or (null? end)
  	  (null? beg)
	  (and (= end 0)
	       (= beg 0))) (if rev (snd-reverse name) name)
   (if (> end beg)
   	(if rev (snd-reverse (snd-region name beg (- end beg)))
		(snd-region name beg (- end beg)))
        (snd-reverse (snd-region name end (- beg end))))))
;
(define (make-Mixamp amp)
;
;;
;;:	I use a database for dynamic notation, also compound symbols
;;	{Only in my Version}
;
  (if (symbol? amp) (set! amp (dbdyn.fun amp)))
;
;;
;;;
;;
;
  (cond
   ((envlike-pair? amp) (make-sigpack (list gate~  amp 1)))
   ((pair? amp)	 	(make-sigpack (list gate~ (apply make-sigpack amp) 1)))
   (#t			(make-sigpack (list gate~  amp 1)))))
;
;;
;;	I leave frq as a number (when possible), because if it is one I
;;	will use sndread and not transpose-snd
;;
(define (make-Mixfrq frq)
   (cond
     ((number? frq) 		frq)
     ((envlike-pair? frq)	(make-sigpack frq))
     ((pair? frq)		(apply make-sigpack frq))
     (#t			(make-sigpack frq))))
;
;;
;;	I need an external matrix, when there were many sends
;;
(define (make-MixOmtx chns)
  (let ((mtx))
   (do ((c 0 (+ c 1))) ((= c chns) (reverse mtx))
     (set! mtx (cons
     (list 'All (append (make-list c 0) (list 1) (make-list (- chns c 1) 0)))
     	mtx)))))
;

[foo-cvs] foo/elkfoo/scm/control/tools pitch.foo,NONE,1.1

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

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

Added Files:
	pitch.foo 
Log Message:
pitch back into control/tools

--- NEW FILE: pitch.foo ---
(define (kw sbdv)
    (if (<= sbdv 0) 1.
		    (exp (/ (log 2) sbdv))))
;
(define (nwnt frq intv sbdv)
   (let ((n) (frq (pitch frq)))
    (if (= intv 0) frq
    		   (set! n (pow  (kw sbdv) (abs intv)))
		   (if (> intv 0) (* frq n)
			    	  (/ frq n)))))
;
(define (xpose frq intv sbdv)
   (let ((frq (pitch frq)))
      (* frq (exp (* (/ intv sbdv) (log 2))))))
;
(define (decodepitch note)
   (let ((note (if (symbol? note) (symbol->string note) note))
   	 (pitchclass) (octvsign) (octv) (accidental)
	 (xst) (xsy) (xnu) (i) (num))
    (for-each
    	(lambda (x)
	    (set! xst (make-string 1 x))
	    (set! xsy (string->symbol xst))
	    (set! xnu (string->number xst))
	    (if (not (or (equal? '- xsy)
			 (equal? '+ xsy)
			  xnu))
		(if (or (equal? "b" xst)
			(equal? "h" xst)
			(equal? "q" xst)
			(equal? "#" xst)
			(equal? "z" xst)
			(equal? "x" xst))
		    (set! accidental (cons xst accidental))
		    (set! pitchclass (cons x pitchclass)))
		    (if (null? octvsign)
		  	(if xnu (begin (set! octv (cons xnu octv))
				       (set!  octvsign 1))
		      		(set! octvsign (if (equal? '- xsy) -1 +1)))
			(set! octv (cons xnu octv))))) (string->list note))
    (set! pitchclass (string->symbol (list->string (reverse pitchclass))))
    (set! accidental
      		(map (lambda (x) (string->symbol x)) (reverse accidental)))
    (set! i -1)
    (set! num 0)
    (if (not (null? octv))
      (begin
        (for-each
    	   (lambda (x) (set! i (1+ i))
		       (set! num (+ num (* x (pow 10 i))))) octv)
      (list pitchclass accidental (* num octvsign)))
      (list pitchclass accidental))))

(define (decodepitchclass symb)

   (cond
     ((string? symb)	#t)
     ((symbol? symb)	(set! symb (symbol->string symb)))
     (#t		(error 'decodepitchclass "Not a pitch-class ~s"symb)))

   (cond
     ((equal? symb "do")	0)
     ((equal? symb "re")	8)
     ((equal? symb "mi")	16)
     ((equal? symb "fa")	20)
     ((equal? symb "sol")	28)
     ((equal? symb "la")	36)
     ((equal? symb "si")	44)
     (#t			symb)))

(define (decodeaccidental acc)
  (if (list? acc) 
     (map (lambda (x) (decodeaccidental x)) acc)
     (cond
	((string? acc)	#t)
	((symbol? acc)	(set! acc (symbol->string acc)))
	((char?   acc)	(set! acc (make-string 1 acc)))
	(#t		(error 'decodeaccidental "Not an accidental ~s"acc)))
     (cond
	((equal? acc "b")	-4)

	((equal? acc "")	0)

	((equal? acc "h")	1)
	((equal? acc "q")	2)

	((equal? acc "#")	4)
	((equal? acc "z")	4)

	((equal? acc "x")	8)
	
	(#t 		(error 'decodeaccidental "Not an accidental ~s"acc)))))

(define foo:pitchreference (list 'la 4 440.))

(define (Relativefrequency intv octave . Reference)
   (let* ((Reference (if (not (null? Reference)) (clean Reference)))
   	  (Reference (if (and (pair? Reference)
			      (symbol? (car Reference))
			      (number? (cadr Reference))
			      (number? (caddr Reference))) Reference
			      				   foo:pitchreference))
	 (frqreference  (caddr Reference))
	 (octvreference (cadr Reference))
	 (intvreference (decodepitchclass (car Reference)))
	 (frq) (nwintv))

	    (set! frq (* frqreference (pow 2 (- octave octvreference))))
	    (set! nwintv (- intv intvreference))
	    (xpose frq nwintv 48)))

(define (pitch->frq note)
   (cond
      ((or (symbol? note)
      	   (string? note))
      	  (let* ((auxy (decodepitch note))
      		 (pit (decodepitchclass (car auxy)))
      		 (accs (decodeaccidental (cadr auxy)))
		 (octv))
	     (if (< (length auxy) 3)
	        note
		(set! octv (caddr auxy))
	        (if (and (number? octv)
	     	         (number? pit)
		         (or (numerical? accs)
		      	     (null? accs)))
		   (Relativefrequency (apply + (cons pit accs)) octv)
		   note))))
      ((and (pair? note)
      	    (or (stringed? note)
      	        (symbolic? note))) (map (lambda (x) (pitch->freq x)) note))
      (#t		note)))
;
(define pitch->freq pitch->frq)
(define pitch pitch->frq)
;
;;
;;;
;;
;
(define (decodepitnumb posit)
   (cond
      ((= posit 0 )	'do)
      ((= posit 1 )	'doh)
      ((= posit 2 )	'doq)
      ((= posit 3 )	'doqh)
      ((= posit 4 )	'doz)
      ((= posit 5 )	'dozh)
      ((= posit 6 )	'dozq)
      ((= posit 7 )	'dozqh)
      ((= posit 8 )	're)
      ((= posit 9 )	'reh)
      ((= posit 10)	'req)
      ((= posit 11)	'reqh)
      ((= posit 12)	'mib)
      ((= posit 13)	'rezh)
      ((= posit 14)	'rezq)
      ((= posit 15)	'rezqh)
      ((= posit 16)	'mi)
      ((= posit 17)	'mih)
      ((= posit 18)	'miq)
      ((= posit 19)	'miqh)
      ((= posit 20)	'fa)
      ((= posit 21)	'fah)
      ((= posit 22)	'faq)
      ((= posit 23)	'faqh)
      ((= posit 24)	'faz)
      ((= posit 25)	'fazh)
      ((= posit 26)	'fazq)
      ((= posit 27)	'fazqh)
      ((= posit 28)	'sol)
      ((= posit 29)	'solh)
      ((= posit 30)	'solq)
      ((= posit 31)	'solqh)
      ((= posit 32)	'lab)
      ((= posit 33)	'solzh)
      ((= posit 34)	'solzq)
      ((= posit 35)	'solzqh)
      ((= posit 36)	'la)
      ((= posit 37)	'lah)
      ((= posit 38)	'laq)
      ((= posit 39)	'laqh)
      ((= posit 40)	'sib)
      ((= posit 41)	'lazh)
      ((= posit 42)	'lazq)
      ((= posit 43)	'lazqh)
      ((= posit 44)	'si)
      ((= posit 45)	'sih)
      ((= posit 46)	'siq)
      ((= posit 47)	'siqh)
      ((= posit 48)	'do)))
;
(define (freq2pitch1 frq . Rfrnz)
  (let* ((Rfrnz (if (not (null? Rfrnz)) (flatten Rfrnz))) (Pitref) (Sbdvref)
  	 (frqref) (ocvref) (refpos) (sbdvfac) (factor) (steps)
	 (posit) (octav) (pitsym) (frq (abs frq)))

    (if (and (pair? Rfrnz)		
    	     (or (number? (car Rfrnz))
	     	 (and (symbol? (car Rfrnz))
		      (number? (decodepitchclass (car Rfrnz)))))
	     (number? (cadr Rfrnz))
	     (number? (caddr Rfrnz)))
       (begin
	 (set! Pitref (list-head Rfrnz 3))
	 (set! Sbdvref (cadddr Rfrnz))
	 (if (not (number? Sbdvref)) (set! Sbdvref 48)))
       (set! Pitref foo:pitchreference)
       (if (and (not (null? Rfrnz))
       		(number? (car Rfrnz)))	(set! Sbdvref (car Rfrnz))
					(set! Sbdvref 48)))
    (set! frqref (caddr Pitref))
    (set! ocvref (cadr Pitref))
    (if (number? (car Pitref))
    	(set! refpos (car Pitref))
	(set! refpos (* (decodepitchclass (car Pitref)) (/ Sbdvref 48))))
    (set! sbdvfac (kw Sbdvref))

    (while (> frqref frq)
    	(set! frqref (/ frqref 2))
	(set! ocvref (- ocvref 1)))
    (while (< (* frqref 2) frq)
    	(set! frqref (* frqref 2))
	(set! ocvref (+ ocvref 1)))
    
    (set! factor (/ frq frqref))
    (set! steps  (/ (log factor) (log sbdvfac)))
    (set! posit  (round (+ refpos steps)))
    (set! octav  ocvref)

    (if (>= posit Sbdvref)
    	(begin
	   (set! posit (- posit Sbdvref))
	   (set! octav (+ octav 1))))

    (if (not (number? Pitref))
       (begin
	  (set! pitsym (decodepitnumb (round (* posit (/ 48 Sbdvref)))))
	  (string->symbol (format #f "~a~a" pitsym octav)))
       (list posit octav))))
;
(define (frq->pitch frq . Rfrnz)
   (cond
      ((number? frq)		(freq2pitch1 frq Rfrnz))
      ((and (pair? frq)
      	    (numerical? frq))	(map (lambda (x) (freq2pitch1 x Rfrnz)) frq))
      (#t			frq)))
;
(define pitchsymbol frq->pitch)
(define freq->pitch frq->pitch)

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

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

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

Added Files:
	Makefile.am 
Log Message:
the makefile of control/tools/util

--- NEW FILE: Makefile.am ---
# foo/elkfoo/scm/tools/util/Makefile.am
# 2004 rumori

# $Id: Makefile.am,v 1.1 2004/08/30 13:39:54 rgbach Exp $

NULL = 

EXTRA_DIST = $(ELKFOO_UTILITIES_FILES)

pkgutilities_DATA = $(ELKFOO_UTILITIES_FILES)

pkgutilitiesdir = $(pkgdatadir)/control/tools/util

ELKFOO_UTILITIES_FILES = \
	misc-funs.foo \
	soundfile-funs.foo \
	$(NULL)

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

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

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

Added Files:
	misc-funs.foo 
Log Message:
misc-funs back into control/util

--- NEW FILE: misc-funs.foo ---
(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 pi (* 4 (atan 1)))

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

(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 (open file)
    (system (string-append "open " file)))

(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)))

(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)))))

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

(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)))))

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

;
;;
;

(provide 'util)

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

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

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

Added Files:
	soundfile-funs.foo 
Log Message:
the soundfile functions file

--- 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 '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
;;                                      foo-default-soundfile-extension TO BE REMOVED
;
(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? type))
       (begin
 	  (foo:set-soundfile-extension?! 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 'short
	(soundfile-channels input)
	(soundfile-srate input)
	(soundfile-comment 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/control/tools/util - New directory

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

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

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

[foo-cvs] foo/elkfoo/scm/control/tools/mixsnd - New directory

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

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

Log Message:
Directory /cvsroot/foo/foo/elkfoo/scm/control/tools/mixsnd added to the repository

[foo-cvs] foo/elkfoo/scm/control/tools - New directory

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

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

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

[foo-cvs] foo/libfoo/modules/orthodox FOOMLookup.m,1.6,1.7 FOOMReadTranspSnd.m,1.5,1.6 FOOMTransposeSnd.m,1.5,1.6

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

Update of /cvsroot/foo/foo/libfoo/modules/orthodox
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17755

Modified Files:
	FOOMLookup.m FOOMReadTranspSnd.m FOOMTransposeSnd.m 
Log Message:
corrected sinc lookup loops

Index: FOOMLookup.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMLookup.m,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** FOOMLookup.m	27 Aug 2004 07:00:46 -0000	1.6
--- FOOMLookup.m	27 Aug 2004 17:02:47 -0000	1.7
***************
*** 169,173 ****
  	  }
  	tdelta = 1 - tdelta;
! 	for (si = 1; si < tot; si++, ti2 += tinc)
  	  {
  	    sum += s[si] * (base[ti2] + delta[ti2] * tdelta);
--- 169,173 ----
  	  }
  	tdelta = 1 - tdelta;
! 	for (si = 1; si <= tot; si++, ti2 += tinc)
  	  {
  	    sum += s[si] * (base[ti2] + delta[ti2] * tdelta);

Index: FOOMTransposeSnd.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMTransposeSnd.m,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** FOOMTransposeSnd.m	15 Aug 2004 17:42:37 -0000	1.5
--- FOOMTransposeSnd.m	27 Aug 2004 17:02:47 -0000	1.6
***************
*** 199,203 ****
  	  P = 1. / lp - P;
  						
! 	  for (fti = P * tinc, si = 1; si < ptot; si++, fti += ptinc) 
  	    {
  	      ti = (int)fti;
--- 199,203 ----
  	  P = 1. / lp - P;
  						
! 	  for (fti = P * tinc, si = 1; si <= ptot; si++, fti += ptinc) 
  	    {
  	      ti = (int)fti;
***************
*** 235,239 ****
  	  tdelta = 1 - tdelta;
  						
! 	  for (si = 1; si < tot; si++, ti2 += tinc)
  	    {
  	      sum += s[si] * (base[ti2] + delta[ti2] * tdelta);
--- 235,239 ----
  	  tdelta = 1 - tdelta;
  						
! 	  for (si = 1; si <= tot; si++, ti2 += tinc)
  	    {
  	      sum += s[si] * (base[ti2] + delta[ti2] * tdelta);

Index: FOOMReadTranspSnd.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMReadTranspSnd.m,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** FOOMReadTranspSnd.m	15 Aug 2004 17:42:37 -0000	1.5
--- FOOMReadTranspSnd.m	27 Aug 2004 17:02:47 -0000	1.6
***************
*** 288,292 ****
  	    }
  	  P = 1. / lp - P;
! 	  for (fti = P * tinc, si = 1; si < ptot; si++, fti += ptinc) 
  	    {
  	      ti = (int) fti;
--- 288,292 ----
  	    }
  	  P = 1. / lp - P;
! 	  for (fti = P * tinc, si = 1; si <= ptot; si++, fti += ptinc) 
  	    {
  	      ti = (int) fti;
***************
*** 315,319 ****
  	    }
  	  tdelta = 1 - tdelta;
! 	  for (si = 1; si < tot; si++, ti2 += tinc)
  	    {
  	      sum += s[si] * (base[ti2] + delta[ti2] * tdelta);
--- 315,319 ----
  	    }
  	  tdelta = 1 - tdelta;
! 	  for (si = 1; si <= tot; si++, ti2 += tinc)
  	    {
  	      sum += s[si] * (base[ti2] + delta[ti2] * tdelta);

[foo-cvs] foo/libfoo/src FOOSineXoverXTable.m,1.5,1.6

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

Update of /cvsroot/foo/foo/libfoo/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17674

Modified Files:
	FOOSineXoverXTable.m 
Log Message:
enabled kaiser windowing, xMax now _taps / 2

Index: FOOSineXoverXTable.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOSineXoverXTable.m,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** FOOSineXoverXTable.m	27 Aug 2004 07:09:51 -0000	1.5
--- FOOSineXoverXTable.m	27 Aug 2004 17:02:01 -0000	1.6
***************
*** 38,42 ****
  #include "FOO/FOOSineXoverXTable.h"
  
! // #define KAISER_WINDOW // hann window otherwise
  
  #ifdef KAISER_WINDOW
--- 38,42 ----
  #include "FOO/FOOSineXoverXTable.h"
  
! #define KAISER_WINDOW // hann window otherwise
  
  #ifdef KAISER_WINDOW
***************
*** 96,101 ****
  - (double) function: (double)x
  {
!   double xMax = _taps / 2 - .5; // bug ???
!   // double xMax = _taps / 2;
    double y;
  
--- 96,100 ----
  - (double) function: (double)x
  {
!   double xMax = _taps / 2;
    double y;
  
***************
*** 113,118 ****
  
        y = x * M_PI;
!       y = sin(y) / y;
!       y *= bessel0(KAISER_KOEFF * sqrt(1 - (x * _scaler / _size) * (x * _scaler / _size))) / _besselconst;
  
  #else // hann window
--- 112,117 ----
  
        y = x * M_PI;
!       y = sin(y) / y; // sinc
!       y *= bessel0(KAISER_KOEFF * sqrt(1 - (x * _scaler / _size) * (x * _scaler / _size))) / _besselconst; // window
  
  #else // hann window

[foo-cvs] foo/libfoo/src FOOSineXoverXTable.m,1.4,1.5

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

Update of /cvsroot/foo/foo/libfoo/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31631

Modified Files:
	FOOSineXoverXTable.m 
Log Message:
corrected bug when specifying odd tap size.  was reported by ramon MONTHs ago, IIRC

Index: FOOSineXoverXTable.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOSineXoverXTable.m,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** FOOSineXoverXTable.m	27 Aug 2004 06:19:10 -0000	1.4
--- FOOSineXoverXTable.m	27 Aug 2004 07:09:51 -0000	1.5
***************
*** 84,88 ****
    if (n & 1 || n < 4)
      {
!       FOO_ERROR(YES, self);
      }
    _taps = n;
--- 84,90 ----
    if (n & 1 || n < 4)
      {
!       n += 1;
!       fprintf(stderr, "odd tap size.  using %d taps.\n", n);
!       FOO_ERROR(NO, self);
      }
    _taps = n;

[foo-cvs] foo/libfoo/modules/orthodox FOOMLookup.m,1.5,1.6

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

Update of /cvsroot/foo/foo/libfoo/modules/orthodox
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30147

Modified Files:
	FOOMLookup.m 
Log Message:
rerenamed init function.  new name violated openstep naming guidelines anyway.

Index: FOOMLookup.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMLookup.m,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** FOOMLookup.m	15 Aug 2004 17:42:37 -0000	1.5
--- FOOMLookup.m	27 Aug 2004 07:00:46 -0000	1.6
***************
*** 47,51 ****
  
  
! - initializeWithSubstrate: (FOOSubstrate *)substr taps: (int)n
  {
    if ([substr isKindOfClass: [FOOSoundFile class]] == NO &&
--- 47,51 ----
  
  
! - initializeWith: (FOOSubstrate *)substr taps: (int)n
  {
    if ([substr isKindOfClass: [FOOSoundFile class]] == NO &&

[foo-cvs] foo/libfoo/src FOOBreakpointFunction.m,1.3,1.4

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

Update of /cvsroot/foo/foo/libfoo/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27346

Modified Files:
	FOOBreakpointFunction.m 
Log Message:
added increment of segment index to print method

Index: FOOBreakpointFunction.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOBreakpointFunction.m,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** FOOBreakpointFunction.m	13 Aug 2004 21:38:01 -0000	1.3
--- FOOBreakpointFunction.m	27 Aug 2004 06:42:21 -0000	1.4
***************
*** 176,179 ****
--- 176,180 ----
        [FOOGlobalsManager schemeOutput: b];
        ++sp;
+       ++i;
      }
  

[foo-cvs] foo/libfoo/src FOOGlobalsManager.m,1.7,1.8 FOOModule.m,1.7,1.8 FOOSineXoverXTable.m,1.3,1.4

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

Update of /cvsroot/foo/foo/libfoo/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23620

Modified Files:
	FOOGlobalsManager.m FOOModule.m FOOSineXoverXTable.m 
Log Message:
FOOGlobalsManager: let schemeOutput: print to stdout instead of stderr.
FOOModule: ommit first 4 characters when printing (FOOM),
reenabled value printing of FOOMConstant (ugly, printing should be handled by subclasses later).
FOOSineXOverXTable: correct bug in bessel approximation. kaiser window still #undef.  marked suspected bugs, but let alone so far.





Index: FOOModule.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOModule.m,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** FOOModule.m	17 Aug 2004 05:51:56 -0000	1.7
--- FOOModule.m	27 Aug 2004 06:19:10 -0000	1.8
***************
*** 41,47 ****
--- 41,50 ----
  #include "FOO/FOONilModule.h"
  
+ // for printing.  not nice.
+ #include "../modules/orthodox/FOOMConstant.h"
  
  // static FOONilModule *_nilModule = nil;
  
+ 
  @implementation FOOModule
  
***************
*** 196,211 ****
      {
        /* this is not the right place
!        * should be overloaded in FOOConstant
         */
! //       if ([self isKindOfClass: [FOOConstant class]])
! // 	{
! // 	  sprintf(printBuffer + level, "(%s [%.6lg]",
! // 		  [[[self class] description] cString],
! // 		  (double)[((FOOConstant*)self) getValue]);
! // 	}
! //       else
! 
  	{
! 	  sprintf(printBuffer + level, "(%s", [[[self class] description] cString]);
  	}
      }
--- 199,213 ----
      {
        /* this is not the right place
!        * should be overloaded in FOOMConstant
         */
!       if ([self isKindOfClass: [FOOMConstant class]])
  	{
! 	  sprintf(printBuffer + level, "(%s [%.6lg]",
! 		  [[[self class] description] cString] + 4,
! 		  (double)[((FOOMConstant*)self) getValue]);
! 	}
!       else
! 	{
! 	  sprintf(printBuffer + level, "(%s", [[[self class] description] cString] + 4);
  	}
      }

Index: FOOSineXoverXTable.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOSineXoverXTable.m,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** FOOSineXoverXTable.m	26 Aug 2004 09:47:52 -0000	1.3
--- FOOSineXoverXTable.m	27 Aug 2004 06:19:10 -0000	1.4
***************
*** 38,46 ****
  #include "FOO/FOOSineXoverXTable.h"
  
! // #define KAISER_WINDOW // hanning window otherwise
  
  #ifdef KAISER_WINDOW
  
! #define KAISER_KOEFF 5.6
  
  static double
--- 38,48 ----
  #include "FOO/FOOSineXoverXTable.h"
  
! // #define KAISER_WINDOW // hann window otherwise
  
  #ifdef KAISER_WINDOW
  
! // what is the best value here?
! // #define KAISER_KOEFF 5.6
! #define KAISER_KOEFF 8.1
  
  static double
***************
*** 54,58 ****
    for (i = 1; i < 26; ++i)
      {
!       de *= y / x;
        sde = de * de;
        e += sde;
--- 56,60 ----
    for (i = 1; i < 26; ++i)
      {
!       de *= y / (double)i;
        sde = de * de;
        e += sde;
***************
*** 92,119 ****
  - (double) function: (double)x
  {
!   double xMax = _taps / 2 - .5;
  
    if (x > xMax)
!     { 
!       return 0;
      }
!   if (x == 0)
      {
!       return 1;
      }
! 
  #ifdef KAISER_WINDOW
  
!   double y = x * M_PI;
!   y = sin(y) / y;
!   y *= bessel0(KAISER_KOEFF * sqrt(1 - (2 * x * _scaler / ((_size - 1) * 2)) * (2 * x * _scaler / ((_size - 1) * 2)))) / _besselconst;
!   return y;
  
! #else // hanning window
  
!   x *= M_PI;
!   return ((sin(x) / x) * (cos(x / xMax) / 2. + .5));
  
  #endif
  }
  
--- 94,126 ----
  - (double) function: (double)x
  {
!   double xMax = _taps / 2 - .5; // bug ???
!   // double xMax = _taps / 2;
!   double y;
  
    if (x > xMax)
!     {
!       y = 0;
      }
!   else if (x == 0)
      {
!       y = 1;
      }
!   else
!     {
  #ifdef KAISER_WINDOW
  
!       y = x * M_PI;
!       y = sin(y) / y;
!       y *= bessel0(KAISER_KOEFF * sqrt(1 - (x * _scaler / _size) * (x * _scaler / _size))) / _besselconst;
  
! #else // hann window
  
!       x *= M_PI;
!       y = (sin(x) / x) * (cos(x / xMax) / 2. + .5);
  
  #endif
+     }
+ 
+   return y;
  }
  

Index: FOOGlobalsManager.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/src/FOOGlobalsManager.m,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** FOOGlobalsManager.m	19 Aug 2004 20:51:05 -0000	1.7
--- FOOGlobalsManager.m	27 Aug 2004 06:19:09 -0000	1.8
***************
*** 103,108 ****
  + (void) schemeOutput: (NSString *)string
  {
!   fprintf(stderr, "%s", [string cString]);
!   fflush(stderr);
  }
  
--- 103,108 ----
  + (void) schemeOutput: (NSString *)string
  {
!   printf("%s", [string cString]);
!   fflush(stdout);
  }
  

[foo-cvs] foo/elkfoo configure.ac,1.12,1.13

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

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

Modified Files:
	configure.ac 
Log Message:
added -Wall flag

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/configure.ac,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** configure.ac	13 Aug 2004 21:35:36 -0000	1.12
--- configure.ac	26 Aug 2004 09:52:38 -0000	1.13
***************
*** 102,106 ****
  
     # get rid of warnings regarding #import
!    ELKFOO_OBJCFLAGS="${ELKFOO_OBJCFLAGS} -Wno-import"
  
  else
--- 102,106 ----
  
     # get rid of warnings regarding #import
!    ELKFOO_OBJCFLAGS="${ELKFOO_OBJCFLAGS} -Wall -Wno-import"
  
  else

[foo-cvs] foo/elkfoo/src Makefile.am,1.8,1.9 modules.m,1.6,1.7

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

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

Modified Files:
	Makefile.am modules.m 
Log Message:
added support for experimental 'banff' modules

Index: modules.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/modules.m,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** modules.m	16 Aug 2004 04:42:26 -0000	1.6
--- modules.m	26 Aug 2004 09:52:02 -0000	1.7
***************
*** 37,40 ****
--- 37,41 ----
  #include <FOO/FOOBreakpointFunction.h>
  
+ // orthodox modules
  #include "FOOMAdd.h"
  #include "FOOMBandlimitedNoise.h"
***************
*** 69,72 ****
--- 70,77 ----
  #include "FOOMVariableTwoPole.h"
  
+ // banff edition
+ #include "FOOMAllpass.h"
+ #include "FOOMComb.h"
+ 
  #include <sys/types.h>
  #include <sys/timeb.h>
***************
*** 1210,1213 ****
--- 1215,1265 ----
  
  
+ static SchemeObject
+ P_Make_Allpass (SchemeObject in1,
+ 		SchemeObject in2,
+ 		SchemeObject in3)
+ {
+   SchemeObject module;
+   id input = A_Get_Input(in1);
+   id rho = A_Get_Input(in2);
+   int order = Get_Integer(in3);
+     
+   module = A_Make_Module([FOOMAllpass class]);
+   [IdOf(module) initWithOrder: order];
+   [IdOf(module) connectInput: 0 to: input];
+   [IdOf(module) connectInput: 1 to: rho];
+ 
+   return A_Make_Terminal_Signal(module, 0, 0.);
+ }
+ 
+ 
+ static SchemeObject
+ P_Make_Comb (SchemeObject in1,
+ 	     SchemeObject in2,
+ 	     SchemeObject in3,
+ 	     SchemeObject in4,
+ 	     SchemeObject in5,
+ 	     SchemeObject in6)
+ {
+   SchemeObject module;
+   id input = A_Get_Input(in1);
+   id delay = A_Get_Input(in2);
+   id feedback = A_Get_Input(in3);
+   id wetdry = A_Get_Input(in4);
+   int taps = Get_Integer(in5);
+   double max_delay = Get_Double(in6);
+     
+   module = A_Make_Module([FOOMComb class]);
+   [IdOf(module) initWithTaps: taps maxDelay: max_delay];
+   [IdOf(module) connectInput: 0 to: input];
+   [IdOf(module) connectInput: 1 to: delay];
+   [IdOf(module) connectInput: 2 to: feedback];
+   [IdOf(module) connectInput: 3 to: wetdry];
+ 
+   return A_Make_Terminal_Signal(module, 0, 0.);
+ }
+ 
+ 
+ 
  //
  // math modules
***************
*** 1308,1311 ****
--- 1360,1366 ----
    DP(P_Make_Min,		"foo:make-min",			2, 2, EVAL);
    DP(P_Make_Max,		"foo:make-max",			2, 2, EVAL);
+   // banff edition
+   DP(P_Make_Allpass,		"foo:make-allpass",		3, 3, EVAL);
+   DP(P_Make_Comb,		"foo:make-comb",		6, 6, EVAL);
  
    P_Provide(Intern("modules"));

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/Makefile.am,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Makefile.am	9 Aug 2004 01:42:05 -0000	1.8
--- Makefile.am	26 Aug 2004 09:52:02 -0000	1.9
***************
*** 48,52 ****
  elkfoo_la_OBJCFLAGS =	$(ELKFOO_OBJCFLAGS) \
  			$(FND_DEFINE) \
! 			-I../../libfoo/modules/orthodox
  elkfoo_la_LDFLAGS =	$(ELKFOO_LDFLAGS) \
  			-module -avoid-version
--- 48,54 ----
  elkfoo_la_OBJCFLAGS =	$(ELKFOO_OBJCFLAGS) \
  			$(FND_DEFINE) \
! 			-I../../libfoo/modules/orthodox \
! 			-I../../libfoo/modules/banff \
! 			$(NULL)
  elkfoo_la_LDFLAGS =	$(ELKFOO_LDFLAGS) \
  			-module -avoid-version

[foo-cvs] foo/libfoo/modules Makefile.am,1.1,1.2

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

Update of /cvsroot/foo/foo/libfoo/modules
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28078/modules

Modified Files:
	Makefile.am 
Log Message:
added banff modules subdir to build system

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/Makefile.am,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Makefile.am	1 Aug 2004 02:05:11 -0000	1.1
--- Makefile.am	26 Aug 2004 09:51:05 -0000	1.2
***************
*** 4,6 ****
  # $Id$
  
! SUBDIRS = orthodox
--- 4,6 ----
  # $Id$
  
! SUBDIRS = orthodox banff

[foo-cvs] foo/libfoo configure.ac,1.14,1.15

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

Update of /cvsroot/foo/foo/libfoo
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28078

Modified Files:
	configure.ac 
Log Message:
added banff modules subdir to build system

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/configure.ac,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** configure.ac	13 Aug 2004 21:39:15 -0000	1.14
--- configure.ac	26 Aug 2004 09:51:05 -0000	1.15
***************
*** 134,138 ****
  
     # get rid of warnings regarding #import
!    FOO_OBJCFLAGS="${FOO_OBJCFLAGS} -Wno-import"
  
  else
--- 134,138 ----
  
     # get rid of warnings regarding #import
!    FOO_OBJCFLAGS="${FOO_OBJCFLAGS} -Wall -Wno-import"
  
  else
***************
*** 184,187 ****
--- 184,188 ----
    modules/Makefile
    modules/orthodox/Makefile
+   modules/banff/Makefile
    tests/Makefile
    tests/foosine/Makefile