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