[foo-cvs] foo/elkfoo/scm/control/interface-lib Makefile.am,NONE,1.1 sp-components.foo,NONE,1.1 sp-datapack-funs.foo,NONE,1.1 sp-inoutmatrix.foo,NONE,1.1 sp-patchgen-funs.foo,NONE,1.1 sp-sigpack-type.foo,NONE,1.1 sp-sndpack-type.foo,NONE,1.1

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

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

Added Files:
	Makefile.am sp-components.foo sp-datapack-funs.foo 
	sp-inoutmatrix.foo sp-patchgen-funs.foo sp-sigpack-type.foo 
	sp-sndpack-type.foo 
Log Message:
initial checkin of scheme files, control, tools

--- NEW FILE: sp-components.foo ---
(define (Bln Dur Frq . args)
   (let* ((Frq  (Sigpar-fun Frq Dur))
    	  (args (flatout args))
	  (taps 10) (seed 1993))
	(if (not (null? args))
	  (begin
	      (if (not (null? (car args)))  (set! taps (car args)))
       	      (if (not (null? (cadr args))) (set! seed (cadr args)))))
	(bln~ Frq taps seed)))

(define (Cfilter Dur Frq Bdw Input)
   (let ((Input (Input-fun Input Dur)))
	(c2pf~ Input Frq Bdw)))

(define (CPZfilter Dur C0 C1 C2 D0 D1 D2 Input)
   (let ((Input (Input-fun Input Dur)))
	(c2p2zf~ Input C0 C1 C2 D0 D1 D2)))

(define (Fof Dur Fnd Frq Bdw Amp Tex Dbt Att)
   (let ((Fnd   (Sigpar-fun Fnd Dur))
	 (Frq   (Sigpar-fun Frq Dur))
	 (Bdw   (Sigpar-fun Bdw Dur))
	 (Amp	(Sigpar-fun Amp Dur))
	 (Tex	(Sigpar-fun Tex Dur))
	 (Dbt	(Sigpar-fun Dbt Dur))
	 (Att	(Sigpar-fun Att Dur)))

	(fof~ Fnd Frq Bdw Amp Tex Dbt Att)))

(define (FVEfilter Dur F1 Q Input)
   (let ((Input (Input-fun Input Dur))
	 (F1	(Sigpar-fun F1 Dur))	    ; F1 = (sin (* 2 pi (/ Frq SR)))
	 (Q	(Sigpar-fun Q Dur)))	    ; Q  = (/ Bdw (/ Frq 2))
	(fve~ Input F1 Q)))

(define (Lookup Dur Snd Pos . taps)
   (let ((Snd  (Sndpar-fun Snd))
         (Pos  (Sigpar-fun Pos Dur))
   	 (taps (cleanlist taps)))
      (if (pair? Snd)  (apply add~ 
      				(map
				 (lambda (x)
				   (if (not (null? taps))
				   	 (lookup-snd~ x Pos (car taps))
		 			 (lookup~snd~ x Pos))) Snd))
		       (if (not (null? taps))
		             (lookup-snd~ Snd Pos (car taps))
				(lookup-snd~ Snd Pos)))))

(define (Module Dur K-expr . Input) ;(prn Input)
  (let ((Input (if (null? Input) #f (car Input)))) ;(prn Input)
     (if Input 
        (begin
	   (if (and (pair? Input)
	       (= (length Input) 1)) (set! Input (car Input)))
	   (set! Input
	   	(if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
				  (Input-fun Input Dur)))
	   (K-expr Dur Input))
        (K-expr Dur))))

(define (Noise . seed)
   (let ((seed (cleanlist seed)))
	(if (not (null? seed))  (noise~ (car seed))
		  (noise~))))

(define (Reverb Dur NCh Ndl Rvt0 Damp Input . delays)
  (let ((Input (if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
				 (list (Input-fun Input Dur))))
    	(delays (if (not (null? delays)) (list (flatten delays)) #f))
	(rin) (rout))
    (set! rin 
	  (if delays (apply reverb~ (append (list Ndl Rvt0 Damp) Input delays))
		     (apply reverb~ (append (list Ndl Rvt0 Damp) Input))))
       (do ((c NCh (- c 1))) ((= c 0) (if (= (length rout) 1) (car rout) rout))
	    (set! rout (cons (revout~ c rin) rout)))))

(define (Revrb8 Dur NCh Rvt0 Damp Input)
    (let ((Input (if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
				   (list (Input-fun Input Dur))))
	  (rin) (rout))
      (set! rin (apply reverb~ (append (list 8 Rvt0 Damp) Input)))
      (do ((c NCh (- c 1))) ((= c 0) (if (= (length rout) 1) (car rout) rout))
	   (set! rout (cons (revout~ c rin) rout)))))

(define (Revrb12 Dur NCh Rvt0 Damp Input)
    (let ((Input (if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
				   (list (Input-fun Input Dur))))
	  (rin) (rout))
      (set! rin (apply reverb~ (append (list 12 Rvt0 Damp) Input)))
      (do ((c NCh (- c 1))) ((= c 0) (if (= (length rout) 1) (car rout) rout))
	   (set! rout (cons (revout~ c rin) rout)))))

(define (Revrb16 Dur NCh Rvt0 Damp Input)
    (let ((Input (if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
				   (list (Input-fun Input Dur))))
	  (rin) (rout))
      (set! rin (apply reverb~ (append (list 16 Rvt0 Damp) Input)))
      (do ((c NCh (- c 1))) ((= c 0) (if (= (length rout) 1) (car rout) rout))
	   (set! rout (cons (revout~ c rin) rout)))))

(define (Sampler Dur Frq Snd . taps)
  (let ((Snd  (Sndpar-fun Snd))
        (Frq  (Sigpar-fun Frq Dur))
	(taps (if (not (null? (cleanlist taps))) (cleanlist taps) #f)))
     (if (pair? Snd)
	(apply add~ (map (lambda (x) (if taps (transp-snd~ Snd Frq (car taps))
	  	 			      (transp-snd~ Snd Frq))) Snd))
	(if taps (transp-snd~ Snd Frq (car taps))
		 (transp-snd~ Snd Frq)))))

(define (Sine Dur Frq . initphas)
   (let ((Frq      (Sigpar-fun Frq Dur))
         (initphas (cleanlist initphas)))
	(if (not (null? initphas))  (sine~ Frq (car initphas))
		     		    (sine~ Frq))))

(define (Sndread Snd)
   (let ((Snd (Sndpar-fun Snd)))
      (if (pair? Snd)  (apply add~ (map (lambda (x) (read-snd~ x)) Snd))
		       (read-snd~ Snd))))

(define (Vfilter Dur Frq Bdw Input)
   (let ((Input (Input-fun Input Dur))
	 (Frq   (Sigpar-fun Frq Dur))
	 (Bdw   (Sigpar-fun Bdw Dur)))
	(v2pf~ Input Frq Bdw)))


--- NEW FILE: Makefile.am ---
# foo/elkfoo/scm/control/interface-lib/Makefile.am
# 2004 rumori

# $Id: Makefile.am,v 1.1 2004/08/07 22:53:01 rumori Exp $

NULL = 

pkginterface_DATA = $(ELKFOO_INTERFACE_FILES)

pkginterfacedir = $(pkgdatadir)/control/interface-lib

ELKFOO_INTERFACE_FILES = \
	sp-components.foo \
	sp-datapack-funs.foo \
	sp-inoutmatrix.foo \
	sp-patchgen-funs.foo \
	sp-sigpack-type.foo \
	sp-sndpack-type.foo \
	$(NULL)

--- NEW FILE: sp-inoutmatrix.foo ---
;
;Mtx === (Out1 Out2 Out3 ...)
;	    wherein Out1=(ValInput1 ValInput2 ...)
;
(define (Totalclean ListofSignals)
    (if (pair? ListofSignals) (cleanlist ListofSignals)
    		    	      (list ListofSignals)))

(define (Addupsig ListofSignals)
    (apply add~ (Totalclean ListofSignals)))

(define (Panfun Position Dur Input)
    (let ((Pos (Sigpar-fun Position Dur)))
	(list (mul~ Input (sub~ (~ 1) Pos))
	      (mul~ Input Pos))))

(define (Pan4fun Position Dur Input)
  (let ((Pos (min~ (~ 4.) (abs~ (Sigpar-fun Position Dur))))
	(vo1) (vo2) (vo3) (vo4))
      (set! vo1 (add~ (max~ (~ 0) (sub~ (~ 1) Pos))
      		      (max~ (~ 0) (sub~ Pos (~ 3)))))
      (set! vo2 (max~ (~ 0) (min~ Pos (sub~ (~ 2) Pos))))
      (set! vo3 (max~ (~ 0) (min~ (sub~ Pos (~ 1)) (sub~ (~ 3) Pos))))
      (set! vo4 (max~ (~ 0) (min~ (sub~ Pos (~ 2)) (sub~ (~ 4) Pos))))
      (list (mul~ Input vo1) (mul~ Input vo2) 
      	    (mul~ Input vo3) (mul~ Input vo4))))

(define (Outmapin Mtx Dur Input) ;(prn "Outmapin" Input Mtx)
 (if (null? Mtx) Input
  (define aux
    (cond
     ((null? Input)           (~ 0))
     ((null? Mtx)             Input)
     ((number? Mtx)           (cond
				 ((= Mtx 0)	(~ 0))
			         ((= Mtx 1)	(Addupsig Input))
				 (#t     (mul~ (~ Mtx) (Addupsig Input)))))
     ((signal? Mtx)           (mul~ Mtx (Addupsig Input)))
     ((sigpack? Mtx)          (mul~ (Sigpar-fun Mtx Dur) (Addupsig Input)))
     ((envelope? Mtx)         (mul~ (Sigpar-fun Mtx Dur) (Addupsig Input)))

     ((equal? (car Mtx) 'Pan) 	   (Panfun (cadr Mtx) Dur (Addupsig Input)))
     ((equal? (car Mtx) 'Pan4) 	   (Pan4fun (cadr Mtx) Dur (Addupsig Input)))
     ((equal? (car Mtx) 'All) 
     	  (if (not (pair? Input)) (set! Input (list Input)))
	  (Addupsig (map (lambda (x) (Outmapin1 (cadr Mtx) Dur x)) Input)))
     ((equal? (car Mtx) 'Map)
     	          (if (not (pair? Input)) (set! Input (list Input)))
     	          (map (lambda (x y) (Outmapin1 x Dur y)) (cdr Mtx) Input))
     ((equal? (car Mtx) 'Struct)
     	      (map
     	       (lambda (x)
     	        (clean (Outmapin1 (list 'struct x) Dur Input))) (cdr Mtx)))
     ((equal? (car Mtx) 'Inpstruct)
     	         (map
     	          (lambda (x)
     	           (clean
	            (Outmapin1 (list 'inpstruct x) Dur Input))) (cdr Mtx)))

     (#t	 (map (lambda (x) (Addupsig (Outmapin1 x Dur Input))) Mtx))))

  (if (and (pair? aux) (= (length aux) 1) (signal? (car aux))) (car aux) aux)))

(define (Outmapin1 Mtx Dur Input) ;(prn "Outmapin1" Input Mtx)
  (define aux
    (cond
     ((null? Input)           (~ 0))
     ((null? Mtx)             Input)
     ((number? Mtx)           (cond
				 ((= Mtx 0)	(~ 0))
			         ((= Mtx 1)	(Addupsig Input))
				 (#t     (mul~ (~ Mtx) (Addupsig Input)))))
     ((signal? Mtx)           (mul~ Mtx (Addupsig Input)))
     ((sigpack? Mtx)          (mul~ (Sigpar-fun Mtx Dur) (Addupsig Input)))
     ((envelope? Mtx)         (mul~ (Sigpar-fun Mtx Dur) (Addupsig Input)))

     ((equal? (car Mtx) 'Pan) 	   (Panfun (cadr Mtx) Dur (Addupsig Input)))
     ((equal? (car Mtx) 'Pan4) 	   (Pan4fun (cadr Mtx) Dur (Addupsig Input)))
     ((equal? (car Mtx) 'All)
			(if (not (pair? Input)) (set! Input (list Input)))
			(Addupsig
			  (map
			     (lambda (x)
			             (Outmapin1 (cadr Mtx) Dur x)) Input)))
     ((equal? (car Mtx) 'Map)
			(if (not (pair? Input)) (set! Input (list Input)))
			(map
			    (lambda (x y)
			             (Outmapin1 x Dur y)) (cdr Mtx) Input))
     ((equal? (car Mtx) 'struct)
     			(if (pair? (cadr Mtx))
     				(map
				  (lambda (x)
				      (Outmapin1 x Dur Input)) (cadr Mtx))
				(Outmapin1 (cadr Mtx) Dur Input)))
     ((equal? (car Mtx) 'inpstruct)
		(if (not (pair? Input)) 	
		    (Outmapin1 (cadr Mtx) Dur Input)
		    (map (lambda (x) (Outmapin1 (cadr Mtx) Dur x)) Input)))

      (#t
          (if (not (pair? Input))
	    (Addupsig (map (lambda (x) (Outmapin1 x Dur Input)) Mtx))
	    (Addupsig (map (lambda (x y) (Outmapin1 x Dur y)) Mtx Input))))))

  (if (and (pair? aux) (= (length aux) 1) (signal? (car aux))) (car aux) aux))

--- NEW FILE: sp-sndpack-type.foo ---
(define make-sndpack)
(define sndpack?)
(define sndpack.name)
(define sndpack.channel)
(define sndpack.region)
(define sndpack.reverse)

(let ((sndpack-tag (vector 'sndpack)))

    (set! sndpack?
	(lambda (obj)
	    (and (pair? obj) (eq? (car obj) sndpack-tag))))

    (define (check-name arg)
        (if (or (snd? arg)
		(procedure? arg)
	        (string? arg)
		(symbol? arg)) arg #f))
    (define (check-chan arg)
    	(if (or (null? arg)
		(number? arg)
		(numerical? arg)) arg #f))
    (define (check-regn arg)
        (if (or (null? arg)
		(string? arg)
		(symbol? arg)
		(number? arg)
		(and (pair? arg)
		     (= (length arg) 2)
		     (numerical? arg))) arg #f))
    (define (check-rvrs arg)
    	(if (and arg (not (null? arg))) #t #f))

    (define (check-sndpack-fields fields)
      (let ((fld1 (car fields)) (fld2 (cadr fields))
            (fld3 (caddr fields)) (fld4 (car (last-pair fields))))
	 
	 (set! fld1 (check-name fld1))
	 (set! fld2 (check-chan fld2))
	 (set! fld3 (check-regn fld3))
	 (set! fld4 (check-rvrs fld4))
	 (if (and fld1
	 	  (or fld2
		      (null? fld2))
		  (or fld3
		      (null? fld3))) (list fld1 fld2 fld3 fld4) #f)))

    (define (check-sndpack args)
      (let ((flg #t) (aux))
	(if (sndpack? args)
		(list (sndpack.name args) (sndpack.channel args)
		      (sndpack.region args) (sndpack.reverse args))
	(if (> (length args) 4)
	    #f
	    (set! args (append args (make-list (- 4 (length args)) '())))
	    (set! args (check-sndpack-fields args))
	    args))))

    (set! make-sndpack
	(lambda args
	   (if (and (= (length args) 1)
	   	    (sndpack? (car args))) (car args)
	    (define aux (check-sndpack args))
	    (if (not aux) (error 'sndpack-type "Wrong Data : ~s" args)
	    	 (cons sndpack-tag aux)))))

    (set! sndpack.name    (lambda (obj) (list-ref (cdr obj) 0)))
    (set! sndpack.channel (lambda (obj) (list-ref (cdr obj) 1)))
    (set! sndpack.region  (lambda (obj) (list-ref (cdr obj) 2)))
    (set! sndpack.reverse (lambda (obj) (list-ref (cdr obj) 3)))
)
--- NEW FILE: sp-sigpack-type.foo ---
(define make-sigpack)
(define sigpack?)
(define sigpack.rfr)
(define sigpack.env)
(define sigpack.mod)
(define sigpack.cal)

(define set-sigpack.rfr)
(define set-sigpack.env)
(define set-sigpack.mod)
(define set-sigpack.cal)

(let ((sigpack-tag (vector 'sigpack)))

    (set! sigpack?
	(lambda (obj)
	    (and (pair? obj) (eq? (car obj) sigpack-tag))))

    (define (gudComp? arg)
      (if (or (signal? arg)
      	      (procedure? arg)
      	      (node? arg)
	      (sigpack? arg)
	      (check-cmplx arg)
	      (null? arg)
              (and (pair? arg)
      	           (= (length arg) 2)
	           (gudtyps? (car arg))
	           (gudtyps? (cadr arg)))) #t #f))

    (define (gudtyps? arg)
     (if (or  (number? arg)
     	      (equal? 'Jitter arg)
 	      (signal? arg)
 	      (sigpack? arg)
 	      (procedure? arg)
 	      (node? arg)
	      (check-cmplx arg)
	      (check-sigpack arg)) #t #f))

    (define (check-cmplx arg) (if (and (pair? arg)
    				       (procedure? (car arg))) arg #f))

    (define (check-rfr arg)
	(cond
	    ((null? arg)	'n)
	    ((number? arg)	arg)
	    ((signal? arg)	arg)
	    ((sigpack? arg)	arg)
	    ((procedure? arg)	arg)
	    ((node? arg)	arg)
	    ((check-cmplx arg)	arg)
	    (#t			#f)))
 
     (define (check-env arg)

        (cond
	    ((null? arg)		     		'n)
	    ((signal? arg)				arg)
	    ((sigpack? arg)				arg)
	    ((envelope? arg)				arg)
	    ((bpf? arg)					arg)
	    ((and (pair? arg)
		  (or (equal? 'env (car arg))
		      (equal? 'line (car arg))
		      (equal? 'expon (car arg))
		      (equal? 'make-bpf (car arg))
		      (equal? 'read-bpf (car arg))
		      (equal? 'bpf (car arg)))
		  (numerical? (cdr arg)))		arg)
	    ((envlike-pair? arg)			arg)
	    ((procedure? arg)				arg)
	    ((node? arg)				arg)
	    ((check-cmplx arg)				arg)
	    ((and (pair? arg)
	    	  (or (equal? 'mod (car arg))
		      (equal? 'pmod (car arg))
		      (equal? 'rmod (car arg))))	#f)
;	    ((pair? arg)				arg)
	    (#t						#f)))

    (define (check-mod obj)
    	(cond
	
	  ((null? obj)					'n)
	  ((sigpack? obj)				(list 'mod obj '()))
	  ((signal? obj)				(list 'mod obj '()))
	  ((procedure? obj)				(list 'mod obj '()))
	  ((node? obj)					(list 'mod obj '()))
	  ((check-cmplx obj)				(list 'mod obj '()))
	  ((and (pair? obj)
	  	(= (length obj) 4)
		(gudComp? (list (car obj) (cadr obj)))
		(gudComp? (cddr obj)))
			 (list 'mod (list (car obj) (cadr obj)) (cddr obj)))
	  ((and (pair? obj)
	  	(= (length obj) 2)
		(gudComp? (car obj))
		(gudComp? (cadr obj)))	   (list 'mod (car obj) (cadr obj)))
	  ((and (pair? obj)
	  	(equal? (car obj) 'mod)
		(= (length obj) 5)
		(gudComp? (list (cadr obj) (caddr obj)))
		(gudComp? (cdddr obj)))
		      (list 'mod (list (cadr obj) (caddr obj)) (cdddr obj)))
	  ((and (pair? obj)
	  	(equal? (car obj) 'mod)
		(= (length obj) 3)
		(gudComp? (cadr obj))
		(gudComp? (caddr obj)))					obj)
	  ((and (pair? obj)
	  	(equal? (car obj) 'pmod)
		(= (length obj) 3)
		(gudtyps? (cadr obj))
		(gudtyps? (caddr obj)))		  (list 'mod (cdr obj) '()))
	  ((and (pair? obj)
	  	(equal? (car obj) 'rmod)
		(= (length obj) 3)
		(gudtyps? (cadr obj))
		(gudtyps? (caddr obj)))		  (list 'mod '() (cdr obj)))
	  ((and (pair? obj)
	  	(equal? (car obj) 'mod)
		(= (length obj) 3)
		(pair? (cadr obj))
		(pair? (caddr obj))
		(equal? (car (cadr obj)) 'pmod)
		(equal? (car (caddr obj)) 'rmod)
		(gudComp? (cdr (cadr obj)))
		(gudComp? (cdr (caddr obj))))						
				       (list 'mod (cdadr obj) (cdaddr obj)))
	  ((and (pair? obj)
	  	(equal? (car obj) 'mod)
		(= (length obj) 2)
		(pair? (cadr obj))
		(equal? (car (cadr obj)) 'pmod)
		(gudComp? (cdr (cadr obj))))    (list 'mod (cdadr obj) '()))
	  ((and (pair? obj)
	  	(equal? (car obj) 'mod)
		(= (length obj) 2)
		(pair? (cadr obj))
		(equal? (car (cadr obj)) 'rmod)
		(gudComp? (cdr (cadr obj))))    (list 'mod '() (cdadr obj)))
	  (#t								#f)))

    (define (check-cal arg)
	(cond
	    ((null? arg)			'n)
	    ((node? arg)			arg)
	    ((procedure? arg)			arg)
	    ((and (pair? arg)
	    	 (equal? 'cal (car arg))
		 (or (node? (cadr arg))
		     (procedure? (cadr arg))))	(cadr arg))
	    (#t					#f)))

    (define (check-sigpack-fields fields numb)
      (let ((fld1 (car fields)) (fld2 (cadr fields))
      	    (fld3 (caddr fields)) (fld4 (cadddr fields)))
	(cond
	   ((= numb 1)
	    (cond
	      ((not (null? (car fld1)))
	      	      (list (car fld1) (car fld2)  (car fld3)   (car fld4)))
	      ((not (null? (cadr fld1)))
	      	      (list (car fld2) (cadr fld1) (car fld3)   (car fld4)))
	      ((not (null? (caddr fld1)))
	      	      (list (car fld2) (car fld3)  (caddr fld1) (car fld4)))))
	   ((= numb 2)
	    (cond
	      ((and (not (null? (car fld1)))
	   	    (not (null? (cadr fld2))))
	      	      (list (car fld1) (cadr fld2) (car fld3)   (car fld4)))
	      ((and (not (null? (car fld1)))
	   	    (not (null? (caddr fld2))))
	      	      (list (car fld1) (car fld3)  (caddr fld2) (car fld4)))
	      ((and (not (null? (cadr fld1)))
	   	    (not (null? (caddr fld2))))
	      	      (list (car fld3) (cadr fld1) (caddr fld2) (car fld4)))))
	   ((= numb 3)
	    (cond
	      ((and (not (null? (car fld1)))
	   	    (not (null? (cadr fld2)))
		    (not (null? (caddr fld3))))
	      	      (list (car fld1) (cadr fld2) (caddr fld3)  (car fld4)))
	      ((and (not (null? (car fld1)))
	   	    (not (null? (cadr fld2)))
		    (not (null? (cadddr fld3))))
	      	      (list (car fld1) (cadr fld2) (car fld4) (cadddr fld3)))
	      ((and (not (null? (car fld1)))
	   	    (not (null? (caddr fld2)))
		    (not (null? (cadddr fld3))))
	      	      (list (car fld1) (car fld4) (caddr fld2) (cadddr fld3)))
	      ((and (not (null? (cadr fld1)))
	   	    (not (null? (caddr fld2)))
		    (not (null? (cadddr fld3))))
	      	    (list (car fld4) (cadr fld1) (caddr fld2) (cadddr fld3)))))
	   (#t	  (list (car fld1) (cadr fld2) (caddr fld3) (cadddr fld4))))))


    (define (check-sigpack-arg arg i n pul)
      (let ((aux) (sgpk.rfr) (sgpk.env) (sgpk.mod) (sgpk.cal))
        (cond
	  ((= n 4)
	     (cond
		((= i 0)    (set! sgpk.rfr (check-rfr arg))
			    (if sgpk.rfr (list 0 (list sgpk.rfr '() '() '()))
				    #f))
		((= i 1)    (set! sgpk.env (check-env arg))
			    (if sgpk.env (list 1 (list '() sgpk.env '() '()))
				    #f))
		((= i 2)    (set! sgpk.mod (check-mod arg))
			    (if sgpk.mod (list 2 (list '() '() sgpk.mod '()))
				    #f))
		((= i 3)    (set! sgpk.cal (check-cal arg))
			    (if sgpk.cal (list 3 (list '() '() '() sgpk.cal))
				    #f))))
	  ((= n 3)
	    (cond
		((= i 0)    (set! sgpk.rfr (check-rfr arg))
			    (if sgpk.rfr (list 0 (list sgpk.rfr '() '() '()))
			      (set! sgpk.env (check-env arg))
			      (if sgpk.env (list 1 (list '() sgpk.env '() '()))
				            #f)))
		((= i 1)    (set! sgpk.env (check-env arg))
			    (if (and (= pul 0) sgpk.env)
			      (list 1 (list '() sgpk.env '() '()))
			      (set! sgpk.mod (check-mod arg))
			      (if sgpk.mod (list 2 (list '() '() sgpk.mod '()))
				            #f)))
		((= i 2)    (set! sgpk.mod (check-mod arg))
			    (if (and (= pul 1) sgpk.mod)
			      (list 2 (list '() '() sgpk.mod '()))
			      (set! sgpk.cal (check-cal arg)) 
			      (if sgpk.cal (list 3 (list '() '() '() sgpk.cal))
				            #f)))
		(#t	     (list 5 (list 'n 'n 'n 'n)))))
	  ((= n 2)
	    (cond
		((= i 0)    (set! sgpk.rfr (check-rfr arg))
			    (if sgpk.rfr (list 0 (list sgpk.rfr '() '() '()))
			      (set! sgpk.env (check-env arg))
			      (if sgpk.env (list 1 (list '() sgpk.env '() '()))
				            #f)))
		((= i 1)    (set! sgpk.env (check-env arg))
			    (if (and (= pul 0) sgpk.env)
			      (list 1 (list '() sgpk.env '() '()))
			      (set! sgpk.mod (check-mod arg))
			      (if sgpk.mod (list 2 (list '() '() sgpk.mod '()))
				            #f)))
		(#t	     (list 5 (list 'n 'n 'n 'n)))))
	  ((= n 1)
	    (if (= i 0)
	        (begin
			(set! sgpk.rfr (check-rfr arg))
			(if sgpk.rfr (list 0 (list sgpk.rfr '() '() '()))
			   (set! sgpk.env (check-env arg))
			   (if sgpk.env (list 1 (list '() sgpk.env '() '()))
			      (set! sgpk.mod (check-mod arg))
			      (if sgpk.mod (list 2 (list '() '() sgpk.mod '())) 
				                #f))))
		(list 5 (list 'n 'n 'n 'n)))))))

    (define (check-sigpack args)
      (let ((flg #t) (aux) (i -1) (numb)
      	    (sgpk.rfr) (sgpk.env) (sgpk.mod) (sgpk.cal) (pul -1))
        (if (or (not (pair? args))
		(and (pair? args)
		     (symbol? (car args)))) (set! args (list args)))
	(if (sigpack? args)
		(list (sigpack.rfr args) (sigpack.env args)
		      (sigpack.mod args) (sigpack.cal args))
	(set! numb (length args))
	(if (> numb 4)
	    #f
	    (set! args (append args (make-list (- 4 (length args)) '())))
	    (set! args (map
	    	        (lambda (x)
	    		 (set! i (1+ i))
	    		 (set! aux (check-sigpack-arg x i numb pul))
	    		 (if (not aux)
	    		    (set! flg #f)
	    		    (set! pul (car aux)) (cadr aux))) args))
	    (if flg (set! args (check-sigpack-fields args numb)))
	    (if (and flg args)
	       (begin
	    	(set! args (map (lambda (x) (if (equal? x 'n) '() x)) args))
		args)
		#f)))))

    (set! make-sigpack
	(lambda args
	   (if (and (= (length args) 1)
	   	    (sigpack? (car args))) (car args)
	    (define aux (check-sigpack args))
	    (if (not aux) (error 'sigpack-type "Wrong Data : ~a" args)
	    	          (cons sigpack-tag aux)))))

    (set! sigpack.rfr
	(lambda (obj) (if (sigpack? obj) (list-ref (cdr obj) 0)
		      (error 'SigPack ": ~a is Not a sigpack"obj))))
    (set! sigpack.env 
	(lambda (obj) (if (sigpack? obj) (list-ref (cdr obj) 1)
		      (error 'SigPack ": ~a is Not a sigpack"obj))))
    (set! sigpack.mod 
	(lambda (obj) (if (sigpack? obj) (list-ref (cdr obj) 2)
		      (error 'SigPack ": ~a is Not a sigpack"obj))))
    (set! sigpack.cal 
	(lambda (obj) (if (sigpack? obj) (list-ref (cdr obj) 3)
		      (error 'SigPack ": ~a is Not a sigpack"obj))))


 (set! set-sigpack.rfr
    (lambda (obj val)
     (make-sigpack val (sigpack.env obj) (sigpack.mod obj) (sigpack.val obj))))
 (set! set-sigpack.env
    (lambda (obj val)
     (make-sigpack (sigpack.rfr obj) val (sigpack.mod obj) (sigpack.val obj))))
 (set! set-sigpack.mod
    (lambda (obj val)
     (make-sigpack (sigpack.rfr obj) (sigpack.env obj) val (sigpack.val obj))))
 (set! set-sigpack.cal
    (lambda (obj val)
     (make-sigpack (sigpack.rfr obj) (sigpack.env obj) (sigpack.mod obj) val)))

)

--- NEW FILE: sp-patchgen-funs.foo ---
(define (SP-Entity Vars . Input)
  (let ((Body) (s1)
        (Type   (car Vars))
  	(Off    (cadr Vars))
    	(Dur    (car (cddr Vars)))
    	(Amp    (cadr (cddr Vars)))
    	(Mtxout (car (cddr (cddr Vars))))
    	(Mtxin  (cadr (cddr (cddr Vars))))
    	(Args   (cddr (cddr (cddr Vars))))
    	(Input  (if (null? (flatout Input)) '() (flatout Input))))

    (if (and (not (null? Args)) (= (length Args) 1)) (set! Args (car Args)))		
    (time Off
	(if (not (null? Input))
		(set! Input (Outmapin Mtxin Dur Input)))
	(set! Body (SP-Uncode Type Dur Args))
	(set! s1 ((car Body) (cdr Body) Input))

	(set! s1 (Outmapin Mtxout Dur s1))
	(Atten (Sigpar-fun Amp Dur) s1))))

(define (Atten Amp Input)
  (cond
    ((pair? Input)	(map (lambda (x) (Atten Amp x)) Input))
    (#t			(mul~ Amp Input))))
     
(define (SP-Component Vars Input)
   (let* ((Type (car Vars))
    	  (Dur  (cadr Vars))
    	  (Args (cddr Vars)))
    (set! Args (SP-Discuss Type Args Input))
    (if (or (equal? (car Args) Noise)
	    (equal? (car Args) Sndread))
			(apply (car Args) (cdr Args))
			(apply (car Args) (append (list Dur) (cdr Args))))))

(define (SP-Serial Vars Input)
   (set! Vars (if (not (pair? (car Vars))) (list Vars)
   					   (reverse Vars)))
   (for-each (lambda (x) (set! Input (SP-Entity x Input))) Vars)
   Input)

(define (SP-Parallel Vars Input)
   (if (not (pair? (car Vars))) (set! Vars (list Vars)))
   (if (and (pair? Input)
   	    (= (length Vars) (length Input)))
		(map (lambda (x y) (SP-Entity x y)) Vars Input)
		(map (lambda (x) (SP-Entity x Input)) Vars)))

(define (SP-Transmit Dur Input)
	Input)

;
(define (SP-context-aux Off Dur Chans Mtxout Mtxin Sp-data Input . Pflg)
   (let ((i 1) (s1)
   	 (Input  (cond ((not (pair? Input)) (list Input))
	 	       ((null? (flatout Input)) '())
		       (#t			Input))))
  (if (and (not (null? Pflg))
  	   (boolean? (car Pflg))) (set! Input (append Pflg Input)))
  (apply SP-context (append (list Off Dur Chans Mtxout Mtxin Sp-data) Input))))
;
(define (SP-context Off Dur Chans Mtxout Mtxin Sp-data . Input)
 (let ((i 1) (s1) (Pflg #f))
  (if (null? (flatout Input))
     (set! Input '())
     (if (boolean? (car Input))
	(begin
	    (set! Pflg (car Input))
	    (set! Input (cdr Input)))))
  (context Chans
   (time Off
     (if (abstraction? Sp-data) (set! Sp-data (compute-abstraction Sp-data)))
     (if (procedure? Sp-data) (set! Sp-data (Sp-data)))
     (if (not (null? Input))
          (begin
	    (set! Input (map (lambda (x) (Input-fun x Dur)) Input))
	    (set! Input (Outmapin Mtxin Dur Input))))
;     (prn " Creation of the Kernel-Patch ........................")
     (set! s1
       (if (not (null? Input))
          (begin
	     (if (not (pair? Input)) (set! Input (list Input)))
             (if (or (compound? (car Sp-data))
		     (symbol? (car Sp-data)))
		 (apply SP-Entity (append (list Sp-data) Input))
	         (map (lambda (x y) (SP-Entity x y)) Sp-data Input)))
           (if (or (compound? (car Sp-data))
	           (symbol? (car Sp-data)))
	         (SP-Entity Sp-data)
	         (map (lambda (x) (SP-Entity x)) Sp-data))))
     (set! s1 (Outmapin Mtxout Dur s1))
     (if (not (pair? s1)) (set! s1 (list s1)))
     (while (and (<= i Chans) (< i (+ 1 (length s1))))
        (if Pflg (output~ i (print~ (Addupsig (list-ref s1 (- i 1)))))
	         (output~ i (Addupsig (list-ref s1 (- i 1)))))
	(set! i (+ 1 i)))))))
;

(define (ParseMode Mode)
   (if (symbol? Mode) (set! Mode (symbol->string Mode)))
   (cond
	((string-ci=? Mode "Undo")		'Undo)
	((string-ci=? Mode "Save")		'Save)
	((string-ci=? Mode "Write")		'Write)
	((string-ci=? Mode "Punch")		'punch)
	((string-ci=? Mode "Blend")		'blend)
	((string-ci=? Mode "Save&Blend")	'Save&Blend)
	((string-ci=? Mode "Modify")		'Modify)
	(#t	(error 'SP-run "Unknown Mode ~s" Mode))))

(define (ParseType Type)
   (if (symbol? Type) (set! Type (symbol->string Type)))
   (cond
	((string-ci=? Type "Incremental")	'incremental)
	((string-ci=? Type "Float")		'float)
	((string-ci=? Type "Short")		'short)
	((string-ci=? Type "Long")		'long)
	((string-ci=? Type "Double")		'double)
	((string-ci=? Type "Char")		'char)
	(#t	(error 'SP-run "Unknown Snd-Type ~s" Type))))

(define (putimx filnam)
   (let ((aux (string->list filnam)))
     (set! aux (list->string (list-tail aux (- (length aux) 4))))
     (if (equal? aux ".imx") filnam (format #f "~a.imx" filnam))))

(define (SPrun-Undo filnam num)
   (let* ((filnam (make-sndname (putimx filnam)))
          (num (number->string num))
	  (zeros (make-string (- 4 (string-length num)) #\0))
	  (name (string-append filnam "/mix" zeros num))
	  (context (with-input-from-file
		    (string-append name "c") read-context))
	  (header (with-input-from-file (string-append name "t") read)))
	(define (field name)
	    (cadr (assq name header)))
	(run-task
	    (make-task
		(/ (field 'reference) (field 'srate))
		(/ (field 'offset) (field 'srate))
		filnam context 'blend
		(field 'srate) (field 'blocksize))
	    (/ (field 'duration) (field 'srate)) (- (field 'factor)))))

(define (SPrun-Modify filnam Lst)
   (let* ((filnam (make-sndname (putimx filnam)))
   	  (num (car Lst))
	  (Ls2 (clean (cdr Lst)))
          (num (number->string num))
	  (zeros (make-string (- 4 (string-length num)) #\0))
	  (name (string-append filnam "/mix" zeros num))
	  (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
	      (make-task
		  (/ (field 'reference) (field 'srate))
		  offset filnam context2 'blend
		  (field 'srate) (field 'blocksize))
	          (/ (field 'duration) (field 'srate)) factor)))

(define (SP-run Data . Args)
  (let ((Args (clean Args))
  	(Blk (foo-default-bsize)) (Dur)
	(foo:name (string-append "foo" (number->string (getpid))))
	(Filename)
	(Workfile) (FileRS)
   	(Mode 'punch) (Off 0) (Ref 0) (Sclr 1) (Nfctr 1)
	(Chns) (Type 'float) (SRat) (SRc)  
	(Offctxt) (Durctxt) (Chnctxt) (Pflg #t)
	(aux) (ctxt) (DUM) (strm) (tsk) (flg #t)
	(com (make-string 511)))

    (set! Filename foo:name)

    (if (and (not (null? Args))
             (symbol? (car Args))) (set! Args (list Args)))

    (set! DUM (assq 'Blocksize Args))	(if DUM (set! Blk (cadr DUM)))
    (set! DUM (assq 'Duration Args))	(if DUM (set! Dur (cadr DUM)))
    (set! DUM (assq 'Factor Args))	(if DUM (set! Sclr (cadr DUM)))
    (set! DUM (assq 'Filename Args))	(if DUM (set! Filename (cadr DUM)))
    (set! DUM (assq 'Mode Args))	(if DUM (set! Mode (cadr DUM)))
    (set! DUM (assq 'Normfactor Args))	(if DUM (set! Nfctr (cadr DUM)))
    (set! DUM (assq 'Offset Args))	(if DUM (set! Off (cadr DUM)))
    (set! DUM (assq 'Reference Args))	(if DUM (set! Ref (cadr DUM)))
    (set! DUM (assq 'Snd-Chns Args))	(if DUM (set! Chns (cadr DUM)))
    (set! DUM (assq 'Snd-Type Args))	(if DUM (set! Type (cadr DUM)))
    (set! DUM (assq 'Snd-SR Args))	(if DUM (set! SRat (cadr DUM)))
    (set! DUM (assq 'Task-SR Args))	(if DUM (set! SRc (cadr DUM)))
    (set! DUM (assq 'Print Args))	(if DUM (set! Pflg (cadr DUM)))
    (if (symbol? Filename) (set! Filename (symbol->string Filename)))
    (set! Mode (ParseMode Mode))
    (set! Type (ParseType Type))
    (cond
      ((equal? Mode 'Undo)
           (if (number? Data) (SPrun-Undo Filename Data)
	   		(error 'SP-run "Cannot Undo with this data ~a"Data)))
      ((equal? Mode 'Modify)
       	   (cond
	     ((pair? Data)   (SPrun-Modify Filename Data))
	     ((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))))
      ((task? Data)
	   (if (null? Dur)
	      (error 'SP-run "Cannot run a task without Duration")
	      (if Pflg
	         (prn " Synthesizing = <<Duration Factor>> ==> " Dur Sclr))
	      (run-task Data Dur Sclr) #t))
      (#t
	 (set! ctxt
	   (if (context? Data) Data
	     (if (or (string? Data)
		     (symbol? Data)) (with-input-from-file Data read-context)
				     (apply SP-context Data))))
	 (if (or (equal? Mode 'Write)
	    	 (equal? Mode 'Save)
		 (equal? Mode 'Save&Blend))
	    (begin
	       (set! Workfile (string-append Filename ".ctxt"))
	       (set! strm (open-output-file Workfile))
	       (with-output-to-file (string-append Filename ".ctxt")
				    (lambda () (write-context ctxt)))
		(if (equal? Mode 'Save) (set! Mode 'punch))
		(if (equal? Mode 'Save&Blend) (set! Mode 'blend))))

	 (if (equal? Mode 'Write) #t
	    (set! aux (context-interval ctxt))
	    (set! Offctxt (car aux))
	    (set! Durctxt (cdr aux))
	    (set! Chnctxt (context-channels ctxt))
	    (if Pflg
	       (begin
	         (newline)
	         (prn " Context : (Offset Duration) NumofChans :"aux Chnctxt)))
	    (if (null? Dur)
	       (if Durctxt (set! Dur Durctxt)
		     (error 'SP-run "Can't run this task without Duration")))
	    (if (null? Chns) (set! Chns Chnctxt))
	    (if (null? SRc)
	       (if (not (null? SRat)) (set! SRc  SRat)
				      (set! SRc  (foo-default-srate))
				      (set! SRat (foo-default-srate))))

	    (set! Workfile
	      (make-sndname
	    	(if (equal? Type 'incremental)
		   (begin (set! Mode 'blend) (string-append Filename ".imx"))
		   Filename)))
	    (if (file-exists? Workfile)
	       (if (not (equal? Mode 'blend))
	          (if (or (equal? Filename foo:name)
	       	          (SP-Demand Workfile))
		     (begin
		        (system (string-append "rm -rf "Workfile))
                        (make-soundfile Workfile Type Chns SRat))
                     (set! flg #f)))
		(make-soundfile Workfile Type Chns SRat))

	    (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))
	        (run-task tsk Dur Sclr)
	        (if (and (equal? Type 'float)
	       		 (not (equal? Mode 'blend)))
	          (begin
		     (set! FileRS (string-append Filename ".rs.snd"))
		     (set! FileRS (make-sndname FileRS))
		     (sndnorm Workfile FileRS Nfctr)
		     (system (string-append "mv -f " FileRS " "Workfile)))))))
	 (kill-context ctxt)
	 Workfile))))

(define (SP-Demand Name)
   (let ((answer))
       (format #t "~s exists.  Overwrite? [y/n] "Name)
       (set! answer (read))
       (if (or (equal? answer 'y)
       	       (equal? answer 'yes)) #t #f)))

(define (SP-Uncode Type Dur Args)
  (if (not (pair? Args)) (set! Args (list Args)))
  (cond
    ((or (equal? Type SP-Parallel)
	 (equal? Type 'SP-Parallel)) (cons SP-Parallel Args))
    ((or (equal? Type SP-Serial)
	 (equal? Type 'SP-Serial))   (cons SP-Serial Args))    
    ((or (equal? Type SP-Transmit)
	 (equal? Type 'SP-Transmit)) (list SP-Transmit Dur))
    ((or (equal? Type 'SP-Component)
	 (equal? Type SP-Component)) (set! Args (clean Args))
	     			     (append
					(list SP-Component (car Args) Dur)
					(cdr Args)))
    ((or (equal? Type sine~)
	 (equal? Type 'sine)
	 (equal? Type 'Sine)
	 (equal? Type Sine))	(append (list SP-Component Sine Dur) Args))
    ((or (equal? Type fof~)
	 (equal? Type 'fof)
	 (equal? Type 'FOF)
	 (equal? Type 'Fof)
	 (equal? Type Fof))	(append (list SP-Component Fof Dur) Args))
    ((or (equal? Type noise~)
	 (equal? Type 'noise)
	 (equal? Type 'Noise)
	 (equal? Type Noise))	(append (list SP-Component Noise Dur) Args))
    ((or (equal? Type read-snd~)
	 (equal? Type 'read-snd)
	 (equal? Type 'sndread)
	 (equal? Type 'Sndread)
	 (equal? Type Sndread))	(append (list SP-Component Sndread Dur) Args))
    ((or (equal? Type lookup-snd~)
	 (equal? Type 'lookup-snd)
	 (equal? Type 'lookup)
	 (equal? Type 'Lookup)
	 (equal? Type Lookup))	(append (list SP-Component Lookup Dur) Args))
    ((or (equal? Type transp-snd~)
	 (equal? Type 'transp-snd)
	 (equal? Type 'sampler)
	 (equal? Type 'Sampler)
	 (equal? Type Sampler))	(append (list SP-Component Sampler Dur) Args))
    ((or (equal? Type c2pf~)
	 (equal? Type 'c2pf)
	 (equal? Type 'cfilter)
	 (equal? Type 'Cfilter)
	 (equal? Type Cfilter))	(append (list SP-Component Cfilter Dur) Args))
    ((or (equal? Type v2pf~)
	 (equal? Type 'v2pf)
	 (equal? Type 'filter)
	 (equal? Type 'vfilter)
	 (equal? Type 'Vfilter)
	 (equal? Type 'Filter)
	 (equal? Type Vfilter))	(append (list SP-Component Vfilter Dur) Args))
    ((or (equal? Type fve~)
	 (equal? Type 'fve)
	 (equal? Type 'FVE)
	 (equal? Type 'fvefilter)
	 (equal? Type 'FVEfilter)
	 (equal? Type FVEfilter)) (append (list SP-Component FVEfilter Dur)
		 				      Args))
    ((or (equal? Type c2p2zf~)
	 (equal? Type 'c2p2zf)
	 (equal? Type 'c2p2zfilter)
	 (equal? Type 'C2P2Zfilter)
	 (equal? Type 'cpzfilter)
	 (equal? Type 'CPZfilter)
	 (equal? Type CPZfilter)) (append (list SP-Component CPZfilter Dur)
		 				      Args))
    ((or (equal? Type reverb~)
	 (equal? Type 'reverb)
	 (equal? Type 'Reverb)
	 (equal? Type Reverb))	(append (list SP-Component Reverb Dur) Args))
    ((or (equal? Type 'Reverb8)
	 (equal? Type 'reverb8)
	 (equal? Type 'Revrb8)
	 (equal? Type Revrb8))	(append (list SP-Component Revrb8 Dur) Args))
    ((or (equal? Type 'Reverb12)
	 (equal? Type 'reverb12)
	 (equal? Type 'Revrb12)
	 (equal? Type Revrb12))	(append (list SP-Component Revrb12 Dur) Args))
    ((or (equal? Type 'Reverb16)
	 (equal? Type 'reverb16)
	 (equal? Type 'Revrb16)
	 (equal? Type Revrb16))	(append (list SP-Component Revrb16 Dur) Args))
    ((or (equal? Type bln~)
	 (equal? Type 'bln)
	 (equal? Type 'Bln)
	 (equal? Type Bln))	(append (list SP-Component Bln Dur) Args))
    ((or (equal? Type 'Module)
	 (equal? Type Module))	(append (list SP-Component Module Dur) Args))
    (#t		    	      (error 'SP-Patch "Unknwon SP-Element ~s"Type))))


(define (SP-Discuss Type Args Inp)
    (if (sigpack? Args) (set! Args (list Args)))
    (if (sndpack? Args) (set! Args (list Args)))
    (cond
	((or (equal? Type  sine~)
	     (equal? Type 'sine)
	     (equal? Type 'Sine)
	     (equal? Type  Sine))	(append (list Sine) Args))
	((or (equal? Type  fof~)
	     (equal? Type 'fof)
	     (equal? Type 'Fof)
	     (equal? Type 'FOF)
	     (equal? Type  Fof))	(append (list Fof) Args))
	((or (equal? Type noise~)
	     (equal? Type 'noise)
	     (equal? Type 'Noise)
	     (equal? Type Noise))	(list Noise Args))
	((or (equal? Type read-snd~)
	     (equal? Type 'read-snd)
	     (equal? Type 'sndread)
	     (equal? Type 'Sndread)
	     (equal? Type Sndread))	(if (not (null? Args))
	     					 (append (list Sndread) Args)
	    				 	 (append (list Sndread) Inp)))
	((or (equal? Type lookup-snd~)
	     (equal? Type 'lookup-snd)
	     (equal? Type 'lookup)
	     (equal? Type 'Lookup)
	     (equal? Type Lookup))	(append (list Lookup) Args))
	((or (equal? Type transp-snd~)
	     (equal? Type 'transp-snd)
	     (equal? Type 'sampler)
	     (equal? Type 'Sampler)
	     (equal? Type Sampler))	(append (list Sampler) Args))
	((or (equal? Type c2pf~)
	     (equal? Type 'c2pf)
	     (equal? Type 'cfilter)
	     (equal? Type 'Cfilter)
	     (equal? Type Cfilter)) (append (list Cfilter) Args (list Inp)))
	((or (equal? Type v2pf~)
	     (equal? Type 'v2pf)
	     (equal? Type 'filter)
	     (equal? Type 'vfilter)
	     (equal? Type 'Vfilter)
	     (equal? Type 'Filter)
	     (equal? Type Vfilter)) (append (list Vfilter) Args (list Inp)))
	((or (equal? Type fve~)
	     (equal? Type 'fve)
	     (equal? Type 'FVE)
	     (equal? Type 'fvefilter)
	     (equal? Type 'FVEfilter)
	     (equal? Type FVEfilter)) (append (list FVEfilter) Args
	     						      (list Inp)))
	((or (equal? Type c2p2zf~)
	     (equal? Type 'c2p2zf)
	     (equal? Type 'c2p2zfilter)
	     (equal? Type 'C2P2Zfilter)
	     (equal? Type 'cpzfilter)
	     (equal? Type 'CPZfilter)
	     (equal? Type CPZfilter))   (append (list CPZfilter) Args
	     							(list Inp)))
	((or (equal? Type reverb~)
	     (equal? Type 'reverb)
	     (equal? Type 'Reverb)
	     (equal? Type Reverb))	(append (list Reverb) Args (list Inp)))
	((or (equal? Type 'Reverb8)
	     (equal? Type 'reverb8)
	     (equal? Type 'Revrb8)
	     (equal? Type Revrb8))    (append (list Revrb8) Args (list Inp)))
	((or (equal? Type 'Reverb12)
	     (equal? Type 'reverb12)
	     (equal? Type 'Revrb12)
	     (equal? Type Revrb12))   (append (list Revrb12) Args (list Inp)))
	((or (equal? Type 'Reverb16)
	     (equal? Type 'reverb16)
	     (equal? Type 'Revrb16)
	     (equal? Type Revrb16))   (append (list Revrb16) Args (list Inp)))
	((or (equal? Type bln~)
	     (equal? Type 'bln)
	     (equal? Type 'Bln)
	     (equal? Type Bln))		(append (list Bln) Args))
	((or (equal? Type 'Module)
	     (equal? Type Module)) (if (not (null? Inp))
					(append (list Module) Args (list Inp))
					(append (list Module) Args)))
	(#t	(error 'SP-Component "Do not know this function ~s" Type))))


--- NEW FILE: sp-datapack-funs.foo ---
;==============================================================================
;	Sigpack Evaluation Functions
;==============================================================================

;
;;
;;;	Main Functionalities
;;
;

(define (Sigpar-fun Pack Dur)
  (let ((Dur (if (number? Dur) Dur 1)))

     (cond
	((null? Pack)       		(~ 0))
	((signal? Pack)     		Pack)
	((number? Pack)     		(~ Pack))

	((envelope? Pack)		(Envpack Pack Dur))
	((bpf? Pack)			(Envpack Pack Dur))
	((bpflike-pair? Pack)		(Envpack Pack Dur))
	((envlike-pair? Pack)		(Envpack Pack Dur))

	((procedure? Pack)		(Pack))
	((node? Pack)			(compute-node Pack))
	((and (pair? Pack)
	      (procedure? (car Pack)))	(Decode-spk Pack Dur))

	((sigpack? Pack)    		(Eval-sigpack Pack Dur))

	((pair? Pack)	 	(Eval-sigpack (apply make-sigpack Pack) Dur))

	(#t		(error 'Sigpar-fun "Wrong argument : ~s"Pack)))))

(define (Eval-sigpack Pack Dur)
  (let ((Rfr (Rfrpack (sigpack.rfr Pack) Dur))
  	(Env (Envpack (sigpack.env Pack) Dur))
	(Mod (Modpack (sigpack.mod Pack) Dur))
	(Cal (sigpack.cal Pack)))
    (if (not (null? Cal))
	(if (node? Cal) (apply compute-node (list Cal Rfr Env Mod))
	   		(apply Cal (list Rfr Env Mod)))
	(if (null? Mod) (set! Mod (~ 0)))
	(cond
	     ((and (null? Rfr)
		   (null? Env))	Mod)
	     ((null? Rfr)	(mul~ Env (add~ (~ 1) Mod)))
	     ((null? Env)	(mul~ Rfr (add~ (~ 1) Mod)))
	     (#t		(mul~ Rfr Env (add~ (~ 1) Mod)))))))

;
;;
;;;	Element Functionalities
;;
;


(define (Rfrpack Rfr Dur)
  (let ((aux))
    (cond
	((or (null? Rfr)
	     (signal? Rfr))	Rfr)
	((number? Rfr)		(~ Rfr))
	((sigpack? Rfr)		(Sigpar-fun Rfr Dur))
	((procedure? Rfr)	(Rfr))
	((node? Rfr)		(compute-node Rfr))
	((pair? Rfr)		(set! aux (Decode-spk Rfr Dur))
				(if aux aux '()))
	(#t			'()))))

(define (strch env dur)
  (let ((x0 (caar env)))
      (map (lambda (x) (cons (+ x0 (* dur (- (car x) x0))) (cdr x))) env)))

(define (Envpack Env Dur)
 (let ((aux))
  (if (or (null? Dur)
  	  (and (not (number? Dur))
	       (not (signal? Dur)))) (set! Dur 1.))
  (cond
    ((or (null? Env)
	 (signal? Env))		Env)
    ((sigpack? Env)		(Sigpar-fun Env Dur))
    ((procedure? Env)		(Env))
    ((node? Env)		(compute-node Env))
    ((signal? Dur)		(Envpack0 Env Dur))
    ((bpf? Env)			(transp-bpf~ Env (~ (/ 1 Dur))))
    ((envelope? Env)	  (send Env 'stretch Dur)
    			  (set! aux (read-bpf~ (make-bpf (send Env 'get-bpf))))
    			  (send Env 'stretch (/ 1 Dur)) 
    			  aux)
    ((envlike-pair? Env)  (set! Env (make-envelope Env))
    			  (send Env 'stretch Dur)
    			  (set! aux (read-bpf~ (make-bpf (send Env 'get-bpf))))
    			  (send Env 'stretch (/ 1 Dur)) 
    			  aux)
    ((and (pair? Env)
    	  (or (equal? (car Env) 'bpf)
	      (equal? (car Env) make-bpf)
	      (equal? (car Env) 'make-bpf)
	      (equal? (car Env) 'env)))
	  			(read-bpf~ (make-bpf (strch (cadr Env)  Dur))))
    ((and (pair? Env)
    	  (equal? (car Env) read-bpf~)
	  (bpf? (cadr Env)))	(transp-bpf~ Env (~ (/ 1. Dur))))
    ((and (pair? Env)
    	  (or (equal? (car Env) read-bpf~)
    	      (equal? (car Env) 'read-bpf)))
	  			(read-bpf~ (make-bpf (strch (cadr Env)  Dur))))
    ((and (pair? Env)
    	  (or (equal? 'line  (car Env))
	      (equal? line~  (car Env))))
;	  (= (length Env) 4)
;(;	  (numerical? (cdr Env)))
	  		  (line~ (cadr Env) (caddr Env) (* (cadddr Env) Dur)))
    ((and (pair? Env)
    	   (or (equal? 'expon  (car Env))
    	       (equal? expon~  (car Env))))
;	  (= (length Env) 4)
;(;	  (numerical? (cdr Env)))
	  		  (expon~ (cadr Env) (caddr Env) (* (cadddr Env) Dur)))
    ((bpflike-pair? Env)	  (read-bpf~ (make-bpf (strch Env  Dur))))

    ((pair? Env)		  (set! aux (Decode-spk Env Dur))
				  (if aux aux '()))
    (#t			          '()))))

(define (Envpack0 Env Dur)
  (set! Dur (div~ (~ 1) Dur))
  (cond
    ((bpf? Env)		(transp-bpf~ Env Dur))
    ((envelope? Env)	(transp-bpf~ (make-bpf (send Env 'get-bpf)) Dur))
    (#t		  	(transp-bpf~ (make-bpf Env) Dur))))

(define (Modpack Mod Dur)
    (cond
    	((or (null? Mod)
	     (signal? Mod))		Mod)
	((sigpack? Mod)			(Sigpar-fun Mod Dur))
	((procedure? Mod)		(Mod))
	((node? Mod)			(compute-node Mod))
	((and (pair? Mod)
	     (equal? (car Mod) 'mod)
	     (= (length Mod) 3))	(add~ (Perdmod (cadr Mod) Dur)
					      (Randmod (caddr Mod) Dur)))
	((and (pair? Mod)
	     (equal? (car Mod) 'mod)
	     (= (length Mod) 2))
	     	(cond
		   ((or (null? (cadr Mod))
	                (signal? (cadr Mod)))	(cadr Mod))
		   ((sigpack? (cadr Mod)) 	(Sigpar-fun (cadr Mod) Dur))
		   ((procedure? (cadr Mod)) 	((cadr Mod)))
		   (#t			    (let ((aux (Decode-spk Mod Dur)))
							  (if aux aux '())))))
	((pair? Mod)			(let ((aux (Decode-spk Mod Dur)))
							(if aux aux '())))
	(#t			'())))

(define (Perdmod Pack Dur)
    (cond
    	((null? Pack)		(~ 0))
	((signal? Pack) 	Pack)
	((number? Pack) 	(sine~ Pack))
	((sigpack? Pack)	(sine~ (Sigpar-fun Pack Dur)))
	((procedure? Pack)	(Pack))
	((node? Pack)		(compute-node Pack))
	((and (pair? Pack)
	      (procedure? (car Pack)))	(let ((aux (Decode-spk Pack Dur)))
					     (if aux aux '())))
	(#t			(let ((Amp (Sigpar-fun (car Pack)  Dur))
			      	      (Frq (Sigpar-fun (cadr Pack) Dur)))
				   (mul~ Amp (sine~ Frq))))))

(define (Randmod Pack Dur)
    (cond
    	((null? Pack)		(~ 0))
	((signal? Pack) 	Pack)
	((number? Pack) 	(bln~ Pack))
	((sigpack? Pack)	(bln~ (Sigpar-fun Pack Dur)))
	((procedure? Pack)	(Pack))
	((node? Pack)		(compute-node Pack))
	((and (pair? Pack)
	      (procedure? (car Pack)))	(let ((aux (Decode-spk Pack Dur)))
					     (if aux aux '())))
	((and (pair? Pack)
	      (equal? 'Jitter (cadr Pack))) (Jittermod Pack Dur))
	(#t			(let ((Amp (Sigpar-fun (car Pack) Dur))
			      	      (Frq (Sigpar-fun (cadr Pack) Dur)))
				   (mul~ Amp  (bln~ Frq 4 1993))))))

(define (Jittermod Pack Dur)
   (let ((Amp (Sigpar-fun (car Pack) Dur)))
       (mul~ Amp (~ 2.13) (div~ (add~ (bln~ (~ 20.134) 4 1993)
       				      (bln~ (~ 9.109) 4 1994)
       				      (bln~ (~ 0.821) 4 1995)) (~ 3)))))

(define (Decode-spk arg Dur)
  (let ((aux) (aux1) (aux0) (flg #t))
     (cond
	((equal? 'mod (car arg))    (apply Modpack (list arg Dur)))
	((equal? 'pmod (car arg))   (apply Modpack (list (list 'mod (cdr arg)) 
							Dur)))
	((equal? 'rmod (car arg))   (apply Modpack (list (cons 'mod
							(list '() (cdr arg)))
							  Dur)))
	((or (envelope? (car arg))
	     (bpf? (car arg))
	     (envlike-pair? (car arg))
	     (equal? 'env (car arg))
	     (equal? 'envelope (car arg))
	     (equal? 'bpf  (car arg))
	     (equal? make-bpf  (car arg))
	     (equal? read-bpf~  (car arg))
	     (equal? 'line (car arg))
	     (equal?  line~ (car arg))
	     (equal? 'expon (car arg))
	     (equal?  expon~ (car arg))) (apply Envpack (list arg Dur)))
	((or (equal? 'gate (car arg))
	     (equal? gate~ (car arg)))   (gate~ (Sigpar-fun (cadr arg) Dur)
	    				        (* (caddr arg) Dur)))
	((sigpack? arg)		    (Sigpar-fun arg Dur))
	((sndpack? arg)		    (Input-fun arg Dur))

     	((procedure? (car arg))	 (set! aux (map
				            (lambda (x)
				             (Decode-spk-sb x Dur)) (cdr arg)))
				 (apply (car arg) aux))
     	((node? (car arg))	 (set! aux (map
				            (lambda (x)
				             (Decode-spk-sb x Dur)) (cdr arg)))
				 (apply compute-node (cons (car arg) aux)))
	(#t			    #f))))

(define (Decode-spk-sb arg Dur)
     (cond
	((signal? arg)		arg)
	((number? arg)		arg)
;	((number? arg)		(~ arg))
	((envelope? arg)        (apply Envpack (list arg Dur)))
	((bpf? arg)	        (apply Envpack (list arg Dur)))
	((envlike-pair? arg)	(apply Envpack (list arg Dur)))
	((procedure? arg)	(arg))
	((node? arg)		(compute-node arg))
	((sigpack? arg)		(Sigpar-fun arg Dur))
	((sndpack? arg)		(Input-fun arg Dur))
	((pair? arg)		(Decode-spk arg Dur))
	(#t			arg)))

;==============================================================================
;	Sndpack Evaluation Functions
;==============================================================================
					   
(define (Sndpar-fun Pack)
   (cond
   	((snd? Pack)	    	Pack)
	((or (string? Pack)
	     (symbol? Pack)) 	(open-snd Pack))
	((procedure? Pack)	(Pack))
	((node? Pack)		(compute-node Pack))
	((sndpack? Pack)	(Eval-sndpack Pack))
	((pair? Pack)	     	(Eval-sndpack (apply make-sndpack Pack)))
	(#t		     (error 'Sndpar-fun "Wrong argument : ~s"Pack))))

(define (get-Sound Pack)
  (let ((Snd  (sndpack.name Pack))
  	(Chnl (sndpack.channel Pack)))

    (set! Snd
	    (cond
	        ((procedure? Snd)		(Snd))
		((or (string? Snd)
		     (symbol? Snd))		(open-snd Snd))
		((snd? Snd)			Snd)))
    (set! Chnl
	    (cond
		((number? Chnl)			Chnl)
		((and (pair? Chnl)
		      (numerical? Chnl))	Chnl)))

    (cond
	((number? Chnl)		(snd-extract Snd Chnl))
	((pair? Chnl)		(map (lambda (x) (snd-extract Snd x)) Chnl))
	(#t			Snd))))

(define (get-Region Region Segments)
  (let ((i -1))
    (cond
      ((and (pair? Region)
	    (numerical? Region)) (set! Region (cleanlist Region))
				 (list (car Region) (cadr Region)))
      ((string? Region)	         (for-each 
				   (lambda (x) 
				     (if (and (string? Region)
				     	      (equal? (car x) Region))
					      (set! Region (cdr x)))) Segments)
				 Region)
      ((number? Region)	         (for-each
				   (lambda (x)
				     (set! i (+ i 1))
				     (if (and (number? Region)
				     	      (= i Region))
					      (set! Region (cdr x)))) Segments)
				 Region)
      (#t			 '()))))

(define (Eval-sndpack Pack)
  (let* ((Snd (get-Sound Pack))
  	 (Region)
	 (Rvrsflg (sndpack.reverse Pack)))

   (set!  Region
   	(if (pair? Snd)
		(get-Region (sndpack.region Pack) (snd-segments (car Snd)))
		(get-Region (sndpack.region Pack) (snd-segments Snd))))

   (cond
      ((and  (null? Region)
      	     (not Rvrsflg)) Snd)
      ((not Rvrsflg)	    (if (snd? Snd)
				(apply snd-region
				    (cons Snd
					    (map (lambda (x) (abs x)) Region)))
				(map
				  (lambda (x)
				    (apply snd-region
				       (cons x
					  (map
					    (lambda (y)
					    	(abs y)) Region)))) Snd)))
      ((null? Region)	    (if (snd? Snd)
      				(snd-reverse Snd)
				(map (lambda (x) (snd-reverse x)) Snd)))
      (#t 
      	   (if (snd? Snd)
	   	(if (< (car Region) 0)
			(apply snd-region
				(cons (snd-reverse Snd)
					(map (lambda (y) (abs y)) Region)))
			(snd-reverse
			    (apply snd-region
			    	  (cons Snd
     					  (map (lambda (y) (abs y)) Region)))))
	   	(if (< (car Region) 0)
		    (map
		      (lambda (x)
		      	 (apply snd-region
			    (cons (snd-reverse x)
				    (map (lambda (y) (abs y)) Region)))) Snd)
		    (map
		      (lambda (x)
		      	(snd-reverse
			  (apply snd-region
			    (cons x
			      (map (lambda (y) (abs y)) Region))))) Snd)))))))

;==============================================================================
;	Inputpack Evaluation Functions
;==============================================================================
	      
(define (Input-fun Pack Dur)
  (let ((Snd))
    (cond
      ((signal? Pack)			Pack)
      ((sigpack? Pack)			(Sigpar-fun Pack Dur))
      ((procedure? Pack)		(Pack))
      ((node? Pack)			(compute-node Pack))
      ((and (pair? Pack)
      	    (procedure? (car Pack)))	(Decode-spk Pack Dur))

      ((and (pair? Pack)
            (or  (equal? 'dirac (car Pack))
      	         (equal? dirac~ (car Pack)))
	    (number? (cadr Pack)))		(dirac~ (cadr Pack)))
      ((and (pair? Pack)
      	    (or (equal? 'noise (car Pack))
      	        (equal? noise~ (car Pack)))
	    (number? (cadr Pack)))		(noise~ (cadr Pack)))
      ((or (equal? 'noise Pack)
      	   (equal? 'Noise Pack)
           (equal? noise~ Pack))		(noise~))

      ((snd? Pack)	(read-snd~ Pack))
      ((sndpack? Pack)	(set! Snd (Sndpar-fun Pack))
      			(if (pair? Snd)
			    (apply add~ (map (lambda (x) (read-snd~ x)) Snd))
			    (read-snd~ Snd)))
      ((string? Pack)   (read-snd~ (Sndpar-fun Pack)))
      ((symbol? Pack)	(read-snd~ (Sndpar-fun Pack)))
      ((and (pair? Pack)
      	    (or (snd? (car Pack))
	    	(string? (car Pack))
		(symbol? (car Pack)))) (set! Snd (Sndpar-fun Pack))
				       (if (pair? Snd)
			    		  (apply add~ 
					    (map
					       (lambda (x) (read-snd~ x)) Snd))
			    		  (read-snd~ Snd)))

      ((pair? Pack)	(Addupsig (map (lambda (x) (Input-fun x Dur)) Pack)))
      (#t		(~ 0)))))