envelope.lsp
 Version 1.00 31 October 2004
 Author  Steven Jones

 Contact jones57@swbell.net include the word "nyquist" in subject line

 The contents of this file are released under the terms of the GNU General
 Public License. See the file LICENSE.txt

 Some common enveloping functions.

function

 (rgate [dur [amp]])
 Simple rectangular "gate" envelope
 
 dur    - flonum. Duration in seconds, default 1
 amp    - flonum. Amplitude, default 1
 return - sound at crate

function

 (iramp [decay [amp]])
 Linearly decaying ramp

 decay  - flonum. Decay time in seconds, default 1
 amp    - flonum, amplitude, default 1
 return - sound at control sample rate

function

 (dramp [decay [attack [hold]]])
 Delayed onset linear ramp with hold time

 decay  - flonum. Initial decay time, default 0
 attack - flonum. Attack time, default 0
 hold   - flonum. Hold time in seconds, default 1
 return - sound at control sample rate

function

 (segment [dur [p1 [p2]]])
 Linear segment between two points
 
 dur    - flonum. Duration in seconds. default 1
 p1     - flonum. Initial amplitude, default 0
 p2     - flonum. Final amplitude, default 1
 return - sound at control sample rate

function

 (ad [dur [ratio])
 Two stage attack/decay envelope
 
 dur    - flonum. Total duration in seconds. Default 1
 ratio  - flonum. Attack/decay ratio. 0 <= ratio 1. default 0.1
 return - sound at control sample rate

function

 (asd [a [s [d]]])
 Three stage attack-sustain-decay envelope
 
 a      - flonum. Attack time, default 0
 s      - flonum. Sustain time, default 1
 d      - flonum. Decay time, default 1
 return - sound at control sample rate

function

 (adsr [a [d [s [r [sl [dur]]]]]])
 Four stage ADSR style envelope
 
 a      - flonum. Attack time, default 0
 d      - flonum. Decay time, default 0
 s      - flonum. Sustain time, default 1
 r      - flonum. Release time, default 0
 sl     - flonum. Sustain level 0 <= sl <= 1. Default 0.75
 dur    - flonum. Explicit duration. If dur is not specified the duration is
          implicit from the sum of the four stages a+d+s+r. If dur is 
          specified, s is extended or contracted as needed to make the 
          total duration equal to dur. If s is contracted to less then zero, 
          we switch to a two stage envelope with total duration of dur 
          seconds. See standard Nyquist env function. 
 return - sound at control sample rate

function

 (dasd [decay [a [s [d]]]])
 ASD style envelope with initial delay

 delay  - flonum. Initial delay. Default 0
 a      - flonum. Attack time. default 0
 s      - flonum. Sustain time. default 1
 d      - flonum. Decay time. default 0
 return - sound at control sample rate

function

 (soft-gate [dur [tran]])
 A "soft" rectangular gate envelope. Actually a special case ASD envelope.

 dur    - flonum. Total duration. Default 1
 tran   - flonum. Transition time. 0 <= tran <= dur/2. Default 0.001
 return - sound at control sample rate

function

 (percussion [dur [half-life]])
 Exponential percussion envelope

 dur       - flonum. Total duration, default 1
 half-life - flonum. The decay half-life. The default half-life is a
             function of the total duration fn(x)= 2^(log2(x)-3)
 return    - sound at control sample rate

function

 (gpercussion [decay [gate [pinch [half-life]]]]) 
 A gated percussion envelope

 decay     - flonum. Percussion component decay time, default 1
 gate      - flonum. Rectangular gate time. Default same as decay
 pinch     - flonum. Gate closing time in seconds, default 0.001
 half-life - flonum. Percussion half-life
 return    - sound at control sample rate

function

 (uenv arg)
 A "universal envelope"

 arg    - sound | list. May be either a sound or a list.
          If a sound it is returned directly as the envelope curve. 
          If a list the first element must be a 
          sound-generating function, the list cdr is then used as 
          arguments to the function.

 return - sound

;; envelope.lsp
;; Version 1.00 31 October 2004
;; Author  Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; Some common enveloping functions.
;;

(provide 'envelope)
(current-file "envelope")


;; @doc function rgate
;; (rgate [dur [amp]])
;; Simple rectangular "gate" envelope
;; 
;; dur    - flonum. Duration in seconds, default 1
;; amp    - flonum. Amplitude, default 1
;; return - sound at crate
;;

(defun rgate (&rest args)
  (let ((amp (or (second args) 1)))
    (stretch (or (car args) 1)
	     (pwl 0 amp 1 amp 1))))


;; @doc function iramp
;; (iramp [decay [amp]])
;; Linearly decaying ramp
;;
;; decay  - flonum. Decay time in seconds, default 1
;; amp    - flonum, amplitude, default 1
;; return - sound at control sample rate
;;

(defun iramp (&rest args)
  (let ((amp (or (second args) 1)))
    (stretch (or (car args) 1)
	     (sim amp (scale (- amp) (ramp))))))


;; @doc function dramp
;; (dramp [decay [attack [hold]]])
;; Delayed onset linear ramp with hold time
;;
;; decay  - flonum. Initial decay time, default 0
;; attack - flonum. Attack time, default 0
;; hold   - flonum. Hold time in seconds, default 1
;; return - sound at control sample rate
;;

(defun dramp (&rest args)
  (let* ((delay (or (car args) 0))
	 (attack (or (second args) 0))
	 (hold (or (third args) 1))
	 (amp (or (fourth args) 1))
	 (t1 (+ delay attack))
	 (t2 (+ t1 hold)))
    (pwl delay 0 t1 amp t2 amp))) 


;; @doc function segment
;; (segment [dur [p1 [p2]]])
;; Linear segment between two points
;; 
;; dur    - flonum. Duration in seconds. default 1
;; p1     - flonum. Initial amplitude, default 0
;; p2     - flonum. Final amplitude, default 1
;; return - sound at control sample rate
;;

(defun segment (&rest args)
  (let ((dur (or (car args) 1)))
    (pwl 0 (or (second args) 0) dur (or (third args) 1) dur)))


;; @doc function ad
;; (ad [dur [ratio])
;; Two stage attack/decay envelope
;; 
;; dur    - flonum. Total duration in seconds. Default 1
;; ratio  - flonum. Attack/decay ratio. 0 <= ratio 1. default 0.1
;; return - sound at control sample rate
;;

(defun ad (&rest args)
  (stretch (or (car args) 1)
	   (pwl (clamp (or (second args) 0.1) 0 1) 1 1)))


;; @doc function asd
;; (asd [a [s [d]]])
;; Three stage attack-sustain-decay envelope
;; 
;; a      - flonum. Attack time, default 0
;; s      - flonum. Sustain time, default 1
;; d      - flonum. Decay time, default 1
;; return - sound at control sample rate
;;

(defun asd (&rest args)
  (let* ((a (or (car args) 0))
	 (s (max (or (second args) 1)))
	 (d (max (or (third args) 2))))
    (pwl a 1 (+ a s) 1 (+ a s d))))


;; @doc function adsr
;; (adsr [a [d [s [r [sl [dur]]]]]])
;; Four stage ADSR style envelope
;; 
;; a      - flonum. Attack time, default 0
;; d      - flonum. Decay time, default 0
;; s      - flonum. Sustain time, default 1
;; r      - flonum. Release time, default 0
;; sl     - flonum. Sustain level 0 <= sl <= 1. Default 0.75
;; dur    - flonum. Explicit duration. If dur is not specified the duration is
;;          implicit from the sum of the four stages a+d+s+r. If dur is 
;;          specified, s is extended or contracted as needed to make the 
;;          total duration equal to dur. If s is contracted to less then zero, 
;;          we switch to a two stage envelope with total duration of dur 
;;          seconds. See standard Nyquist env function. 
;; return - sound at control sample rate
;;

(defun adsr (&rest args)
  (let* ((mintime (min-control-time))
	 (a (or (car args) 0))
	 (d (or (second args) 0))
	 (s (max mintime (or (third args) 1)))
	 (r (max mintime (or (fourth args) 0)))
	 (sl (clamp (or (fifth args) 0.75) 0 1))
	 (dur (or (sixth args) (+ a d s r))))
    (stretch dur (env a d r 1 sl sl 1))))


;; @doc function dasd
;; (dasd [decay [a [s [d]]]])
;; ASD style envelope with initial delay
;;
;; delay  - flonum. Initial delay. Default 0
;; a      - flonum. Attack time. default 0
;; s      - flonum. Sustain time. default 1
;; d      - flonum. Decay time. default 0
;; return - sound at control sample rate
;;

(defun dasd (&rest args)
  (let* ((delay (or (car args) 0))
	 (a (or (second args) 0))
	 (s (or (third args) 1))
	 (d (or (fourth args) 0)))
    (pwlr delay 0 a 1 s 1 d 0 0)))

;;
;;(defun dadsr (&rest args)
;;  (let* ((delay (or (car args) 0)))
;;    (at delay (cue (apply #'adsr (cdr args))))))
;;

;; @doc function soft-gate
;; (soft-gate [dur [tran]])
;; A "soft" rectangular gate envelope. Actually a special case ASD envelope.
;;
;; dur    - flonum. Total duration. Default 1
;; tran   - flonum. Transition time. 0 <= tran <= dur/2. Default 0.001
;; return - sound at control sample rate
;;

(defun soft-gate (&rest args)
  (let* ((dur (or (car args) 1))
	 (tran (clamp (or (second args) 0.001) 0 (* dur 0.5))))
    (asd tran (- dur (* 2 tran)) tran)))


;; @doc function percussion
;; (percussion [dur [half-life]])
;; Exponential percussion envelope
;;
;; dur       - flonum. Total duration, default 1
;; half-life - flonum. The decay half-life. The default half-life is a
;;             function of the total duration fn(x)= 2^(log2(x)-3)
;; return    - sound at control sample rate
;;

(defun percussion (&rest args)
  (let* ((dur (or (car args) 1))
	 (half-life (or (second args) (expt 2.0 (- (log2 dur) 3)))))
    (exp-dec 0 half-life dur)))


;; @doc function gpercussion
;; (gpercussion [decay [gate [pinch [half-life]]]]) 
;; A gated percussion envelope
;;
;; decay     - flonum. Percussion component decay time, default 1
;; gate      - flonum. Rectangular gate time. Default same as decay
;; pinch     - flonum. Gate closing time in seconds, default 0.001
;; half-life - flonum. Percussion half-life
;; return    - sound at control sample rate
;;

(defun gpercussion (&rest args)
  (let (decay gate-time pinch half-life)
    (setq decay (or (car args) 1))
    (setq gate-time (or (second args) decay))
    (setq pinch (or (third args) 0.001))
    (setq half-life (fourth args))
    (mult (percussion decay half-life)
	  (asd 0 gate-time pinch))))


;; @doc function uenv
;; (uenv arg)
;; A "universal envelope"
;;
;; arg    - sound | list. May be either a sound or a list.
;;          If a sound it is returned directly as the envelope curve. 
;;          If a list the first element must be a 
;;          sound-generating function, the list cdr is then used as 
;;          arguments to the function.
;;
;; return - sound
;;

(defun uenv (arg)
  (if (soundp arg)
      arg
    (apply (car arg)(cdr arg))))