;;; -*- syntax: common-lisp; package: clm; base: 10; mode: lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; File: env.lsp ;;; ;;; Purpose: Various envelope manipulation functions. ;;; ;;; Author: Michael Edwards - m@michael-edwards.org ;;; ;;; $$ Last modified: 10:35:53 Tue Jul 5 2011 BST ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun env-plus (env add) (loop for x in env by #'cddr and y in (cdr env) by #'cddr collect x collect (+ y add))) (defun env-expt (env expt) (loop for x in env by #'cddr and y in (cdr env) by #'cddr collect x collect (expt y expt))) (defun new-lastx (env x) "new-lastx will take an envelope and return it with scaled x values, the maximum of which is the value of new-lastx's second argument. e.g. (new-lastx '(0 0 30 2 100 0) 20) => (0.0 0 6.0 2 20.0 0)" (let ((scaler (float (/ x (lastx env))))) (loop for x in env by #'cddr and y in (cdr env) by #'cddr collect (* x scaler) collect y))) (defun env-ed (env) "Tidies up the numbers in an envelope that the Envelope Editor returns (gets rid of all those unwanted zeros). e.g. (0.000 0.000 0.416 0.562 0.689 0.489 1.000 0.000) => (0 0 0.416 0.562 0.689 0.489 1 0)" (loop for i in env collect (tidy-float (round-float i)))) ;; This is now in the CLM distribution so don't need it here. or is it? (defun lastx (env) "lastx returns the last x value in the given envelope. e.g. (lastx '(0 0 20 4 30 5 100 0)) => 100" (let ((len (length env))) (if (oddp len) (error "lastx: Wrong number of elements in ~a." env)) (nth (- len 2) env))) (defun reverse-env (env) "reverse-env returns the reverse of the envelope supplied to it. e.g. (reverse-env '(0 0 60 .3 100 1)) => (0 1 40 0.3 100 0)." (let ((x-max (lastx env)) (result nil)) (loop for x in env by #'cddr and y in (cdr env) by #' cddr do (push y result) (push (- x-max x) result)) result)) (defun scale-env (env scaler &optional (offset 0)) (let ((scaled (scale-envelope env scaler))) (if (zerop offset) scaled (loop for x in scaled by #'cddr and y in (cdr scaled) by #'cddr collect x collect (+ y offset))))) (defun repeat-env (env num-times &optional reflected) "repeat-env will repeat an envelope the number of times specified by its second argument. e.g. (repeat-env '(0 0 100 1) 2) => (0 0 50 1 51 0 100 1). Because the final y value was different to the first y value, a quick ramp was inserted between repeats. Every other repeat can be a reflection of the given envelope by setting the optional variable to t. e.g. (repeat-env '(0 0 100 1) 2 t) => (0 0 50 1 100 0)." (let* ((result nil) (x-inc 0.0) (x-max (lastx env)) (base (/ x-max num-times)) (starting (if (and reflected (evenp num-times)) (reverse-env env) env)) (copy (reverse starting)) (first-y-is-last-y (when (numberp (cadr env)) (= (cadr env) (car (last env))))) (offset (/ x-max 100))) (dotimes (count num-times) (setq x-inc (* base (- num-times count 1.0))) (loop for y in copy by #'cddr and x in (cdr copy) by #'cddr do (push y result) (push (+ x-inc (/ x num-times)) result)) (setf copy (cond ((and (not reflected) (not first-y-is-last-y)) copy) ((and reflected (evenp count)) (cddr (reverse (reverse-env starting)))) ((or (and reflected (oddp count)) first-y-is-last-y) (cddr (reverse starting)))) (car result) (if (or (= count (- num-times 1)) reflected first-y-is-last-y) (car result) (+ (car result) offset)))) result)) (defun symmetrical (env &key (centre .5)) "Returns an envelope that is symmetrical around the key variable 'centre'. e.g. (symmetrical '(0 0 30 .2 70 .95 100 .5)) => (0 1.0 30 0.8 70 0.05 100 0.5)" (loop for x in env by #'cddr and y in (cdr env) by #'cddr collect x collect (- (* 2.0 centre) y))) (defun ramp-down (env &key (percent 5)) "Inserts a quick ramp down to 0 in any envelope that doesn't have 0 as it's final y value. Key variable 'percent' is the percentage ramp that should be added (calculation based on the last x value e.g. last x is 100, therefore the ramp down will be to 105). e.g. (ramp-down '(0 0 10 2 30 4 70 4 80 2))) => (0 0 10 2 30 4 70 4 80 2 84 0)" (if (= 0 (car (last env))) env (append env (list (round-float (* (lastx env) (+ 1.0 (/ percent 100)))) 0)))) (defun waves (x-vals &key (max 1) (min 0.001)) "Takes a list of x values and splices in first the MIN key argument then the MAX key argument after each successive x value. If the first x value in the list argument wasn't 0 then this will be consed onto the front of the list. e.g. (waves '(30 50 70 100)) => (0 0.001 30 1 50 0.001 70 1)" (let ((real-x-vals (if (= (car x-vals) 0) x-vals (cons 0 x-vals)))) (loop for i in real-x-vals by #'cddr and j in (cdr real-x-vals) by #'cddr collect i collect min collect j collect max))) (defun clm-to-rt (env) "Converts a CLM type envelope to one suitable to be handled by the RT Mixer. e.g. (clm-to-rt '(0 0 20 .5 50 .8 100 1)) => amp(0,0, 20,0.5, 50,0.8, 100,1)," (format t "~%amp(~{~a,~a~^, ~}),~%" env)) (defun repeat-env-env (env duration speed-env &key (exp 1) (file nil)) "Returns an envelope that contains many copies of (like repeat-env) but instead of at regular, consistent intervals they are repeated at a rate specified by . This argument is a normal envelope that tells the function how many times per second to repeat . E.g. a of '(0 1 100 7) specifies that occupies one second at the beginning of a note and it's duration gets shorter and shorter (as it is repeated) over the length of the note, until at the end it is being repeated 7 times per second. Of course, the envelope can have as many breakpoints as desired. The argument is the duration of the note and is necessary for the interpolation of the . Obviously, if the duration is short, the transition of repeat rates will be much quicker than if the duration is long. The key variable is an optional exponent that can be passed to the interpolation routine." (let* ((scaler (/ duration (lastx speed-env))) ;; Stretch so that it's x values represent real time ;; i.e they go from 0 to (fitted-env (loop for x in speed-env by #'cddr and y in (cdr speed-env) by #'cddr collect (* scaler x) collect y)) (first-y-isnt-last-y (/= (cadr env) (car (last env)))) ;; Get the points at which the envelope will be restarted. ;; Again in real time. This is done by interpolating the ;; start point of the envelope in the fitted-env. This will ;; give the duration of the envelope which then becomes the ;; next x value to interpolate etc. etc. until is ;; used up. (x-list (loop with i = 0 collect i into list do (incf i (/ 1 (interpolate i fitted-env :exp exp))) when (> i duration) collect duration into list and do (return list))) result) ;; Local function to take and copy it but within the x ;; bounds imposed by the two arguments. If first and last y ;; values are not the same it will shift the first x value along ;; the x-axis by a factor of one percent of the new scale. (flet ((shift-env (first-x last-x) (let* ((orig-scale (lastx env)) (new-scale (- last-x first-x)) (scaler (float (/ new-scale orig-scale))) ;; shift by one percent. (real-first-x (if first-y-isnt-last-y (+ first-x (/ new-scale 100)) first-x))) ;; push first x and y value separately because ;; of shift. (push (+ real-first-x (* scaler (car env))) result) (push (cadr env) result) ;; now push the rest of the x and y values. (loop for x in (cddr env) by #'cddr and y in (cdddr env) by #'cddr do (push (+ first-x (* scaler x)) result) (push y result))))) ;; Do all the envelopes. (loop for i in x-list and j in (cdr x-list) do (shift-env i j)) ;; Replace the first x value with 0 to avoid the shifting ;; that may have taken place. (setq result (rplaca (nreverse result) 0)) (if file (with-open-file (stream file :direction :output :if-does-not-exist :create :if-exists :supersede) (format stream "~a" result)) result)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; EOF env.lsp