[CM] CLM power-env

[Michael Klingbeil]

I think I have managed to get the power-env stuff in "env.lisp" to 
work (at least with C compilation). The idea of power-env is to allow 
each envelope segment to have a base parameter to control the 
concavity.

Anyway the version in env.lisp didn't seem to work. There were two 
problems: envelope class type is now "seg" rather than "envelope", 
and "seg-end" is not supported by the run macro.

So I tried something like this to support seg-end in run:

(def-clm-fun 'seg-end      #'(lambda (var x) (pushnew 'seg-end 
methods) (package-op '<seg-end> var x :clm-integer)))

(add-clm-method
    'seg-end +env+
    #'(lambda () "clm_int[gen_addr+5]")
    nil)

But this didn't seem to quite work. I concluded that I would have 
needed to to change this in cmus.lisp

(defun method-type (method)
   (if (member method '(mus-length mus-channel mus-location 
mus-channels mus-order mus-cosines))
       'int
     (if (member method '(mus-data mus-xcoeffs mus-ycoeffs seg-end))
	'int
       'double)))

I didn't really want to mess around with cmus.lisp (Also shouldn't 
the return type be stored in the clm-methods table?? package-op seems 
to take a return type parameter as well, so the method-type defun 
looks like a hack to me... but maybe I am wrong about that!)

Anyway, I decided to just use mus-length instead of seg-end since 
there was no mus-length method for envelopes. There is probably a 
better way to do this and I'm open to suggestions!

So here is my result:


(in-package :clm)

;;; extension of env to provide individual base on each segment 
(include 1 and 0 => linear and step)
;;; (make-power-env (envelope (scaler 1.0) (offset 0.0) duration)
;;;    returns a penv struct containing an array of envelopes
;;;    where the envelope is a sequence of triples [x y base]

(def-clm-struct penv envs total-envs current-env current-pass)

(add-clm-method
    'mus-length +env+
    #'(lambda () "clm_int[gen_addr+5]")
    nil)

(defmacro power-env (pe1)
   `(let* ((pe ,pe1)
	  (val (env (aref (penv-envs pe) (penv-current-env pe)))))
     (decf (penv-current-pass pe))
     (when (zerop (penv-current-pass pe))
       (when (< (penv-current-env pe) (penv-total-envs pe))
	(incf (penv-current-env pe))
	(setf (penv-current-pass pe) (mus-length (aref (penv-envs pe) 
(penv-current-env pe))))))
     val))

(defun make-power-env (&key envelope (scaler 1.0) (offset 0.0) duration)
   (let* ((len (1- (floor (length envelope) 3)))
	 (pe (make-penv :envs (make-array len :element-type 'seg)
			:total-envs len
			:current-env 0
			:current-pass 0))
	 (xext (- (nth (- (length envelope) 3) envelope) (first envelope))))
     (loop for i from 0 below len and
	      x0 in envelope by #'cdddr and y0 in (cdr envelope) by 
#'cdddr and base in (cddr envelope) by #'cdddr and
	      x1 in (cdddr envelope) by #'cdddr and y1 in (cddddr 
envelope) by #'cdddr do
       (setf (aref (penv-envs pe) i)
	    (make-env :envelope (list 0.0 y0 1.0 y1)
		      :base base
		      :scaler scaler
		      :offset offset
		      :duration (* duration (/ (- x1 x0) xext)))))
     (setf (penv-current-pass pe) (seg-end (aref (penv-envs pe) 0)))
     pe))