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