aeolus.lsp Version 1.04 06 February 2005 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 Aeolus is a generalized model of an Aeolian harp. The intent is to create a sound like piano string resonance when a loud sound is produced in proximity to the piano. Without access to a real Aeolian harp the following parameters were selected intuitively. Each harp string resonates to a fixed set of harmonic frequencies. Strings with greater resonance are louder, have more harmonics, have shorter attacks and longer decay times. The harp is generalized by allowing arbitrary parameters to be functions of resonance. In fact the only "built in" parameters are delay and amplitude. Another generalization allows each string to have its own sound generating function which may or may not respond to any the resonance derived parameters. A final generalization deals with how the "strings" are set into motion. A real harp has a finite number of fixed tuned strings. Consequently the model by default only produce a finite number of frequencies. The resonance of each string is calculated to determine how much it contributes to the output A second mode, called relative, allows the strings to change pitch providing a form of additive synthesis. In this mode a strings "resonance" is determined by its position within the harp. A third mode, random, is like relative but the string order is randomly altered on each note. See dulcimer.lsp for practical examples of abs mode. See cdulcimer.lsp for practical example of rel mode.
function
(aeolus:fn pitch dur [:vel][:rc][:rm][:i][:attack][:decay])
Default sound function for aeolus
pitch - flonum. MIDI key number
dur - flonum. Tones duration in seconds. Note the actual duration is
dur + decay
:vel - flonum. MIDI velocity, default 64
:rc - flonum. Relative FM carrier frequency, default 1.000
:rm - flonum. Relative FM modulator frequency, default 1.001
:i - flonum. FM modulation index, default 1
:attack - flonum. Attack time, default 0.050 sec
:decay - flonum. Decay time, default 1.500 sec
return - sound.
class
A generalized Aeolian harp. Each harp contains a list of strings, list of synthesis parameters, a rendering mode, base delay time and mapping objects for delay and amplitude as functions of string resonance.
method
(send aeolus:class :new [mode])
Create new aeolus:class object. Initially the harp contains neither strings
nor synthesis parameters other then delay and amplitude. Use the :string
method to add strings and the :key method to add parameters.
mode - symbol. Determines the rendering mode. Three modes are recognized.
'REL - Relative mode, all strings are rendered, the string order
within the harp determines it's "resonance". Relative mode
could be considered a form of additive synthesis.
'RND - Random mode, like relative but string resonance is randomized.
'ABS - Absolute mode, the default. In absolute mode the harp has a
finite number of frequencies from which to draw upon. During
rendering the resonance of each string is used to determine
how much the string contributes to the output.
return - object. A new instance of aeolus:class
method
(send /aeolus:class/ :delay [val]) Retrieve and optionally update base delay time. The base delay time is the delay amount applied to the highest resonant strings (resonance 1). By default 0. delay - flonum return - flonum
method
(send /aeolus:class/ :delay-map [val]) Retrieve and optionally update delay as function of resonance map. val - map. return - map.
method
(send /aeolus:class/ :db-map [val]) Retrieve and optionally update amplitude (in db) as function of resonance map val - map. return - map.
method
(send /aeolus:class/ :string frq [:fn][:plist])
Add new string to harp.
frq - flonum. The strings frequency. If the harps rendering mode is ABS
(absolute) The strings frequency is specified directly in Hertz.
For REL (relative) and RND (random) modes the strings frequency
is specified as a ratio.
:fn - closure. The function used to produce the string's sound.
The function must have the form
(lambda (pitch dur [keywords...]))
and return sound. The default is aeolus:fn
:plist - list. A list of the form
((p0 a0)(p1 a1)(p2 a2)...(pn an))
used to specify the relative harmonic resonances for the sting.
The plist argument is ignored in REL and RND modes.
return - object. A new instance of aeolus:string.
method
(send /aeolus:class/ :key keysym basevalue [map])
Add a new keyword parameter.
When a sound is rendered the keyword arguments are calculated as a
function of each strings resonance and then aggregated to an argument list
for the string's sound function. The keywords which the default
string function responds to are :attack :decay :fc :fm and :i
These arguments must be explicitly added to the harp to have any effect.
keysym - symbol. The keyword symbol.
basevalue - flonum. The parameter value for resonance 1.
map - map. (See map.lsp) Defines the scaling of basevalue as a
function of resonance. The maps domain should be
0 (for low resonance) to 1 (high resonance).
return - object. A new instance of aeolus:keyarg
method
(send /aeolus:class/ :render frq dur aux)
Instruct harp to create sound.
frq - flonum. Frequency in Hertz. For absolute (ABS) mode frq may not
actually appear in the result. Instead the frequencies of the
harp strings which are highly resonant to frq are used. In
relative and random modes the strings frequencies are relative
and multiplied by frq.
dur - flonum. Duration in seconds, using the default string function the
decay time extends beyond dur.
aux - list. List of optional keyword arguments. The exact compliment of
recognized keywords is dependent on calling the :key method. The
following keywords are always recognized.
:discrim - integer > 1, how discriminating the resonance function is
:delay - flonum. delay >= 0
Keywords added via the :key method may be included in aux to
provide a new default value.
return - sound.
;; aeolus.lsp
;; Version 1.04 06 February 2005
;; 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
;;
;; Aeolus is a generalized model of an Aeolian harp. The intent is to create a
;; sound like piano string resonance when a loud sound is produced in
;; proximity to the piano.
;;
;; Without access to a real Aeolian harp the following parameters were
;; selected intuitively. Each harp string resonates to a fixed set of harmonic
;; frequencies. Strings with greater resonance are louder, have more
;; harmonics, have shorter attacks and longer decay times. The harp is
;; generalized by allowing arbitrary parameters to be functions of
;; resonance. In fact the only "built in" parameters are delay and
;; amplitude. Another generalization allows each string to have its own sound
;; generating function which may or may not respond to any the resonance
;; derived parameters.
;;
;; A final generalization deals with how the "strings" are set into motion. A
;; real harp has a finite number of fixed tuned strings. Consequently the
;; model by default only produce a finite number of frequencies. The resonance
;; of each string is calculated to determine how much it contributes to the
;; output
;;
;; A second mode, called relative, allows the strings to change pitch providing
;; a form of additive synthesis. In this mode a strings "resonance" is
;; determined by its position within the harp. A third mode, random, is like
;; relative but the string order is randomly altered on each note.
;;
;; See dulcimer.lsp for practical examples of abs mode.
;; See cdulcimer.lsp for practical example of rel mode.
;;
(require 'map)
(require 'map-id)
(require 'xenvelope)
(provide 'aeolus)
(current-file "aeolus")
;; If true be verbose when rendering sound.
;;
(setf aeolus:*debug* 'nil)
;; @doc function aeolus:fn
;; (aeolus:fn pitch dur [:vel][:rc][:rm][:i][:attack][:decay])
;; Default sound function for aeolus
;;
;; pitch - flonum. MIDI key number
;; dur - flonum. Tones duration in seconds. Note the actual duration is
;; dur + decay
;; :vel - flonum. MIDI velocity, default 64
;; :rc - flonum. Relative FM carrier frequency, default 1.000
;; :rm - flonum. Relative FM modulator frequency, default 1.001
;; :i - flonum. FM modulation index, default 1
;; :attack - flonum. Attack time, default 0.050 sec
;; :decay - flonum. Decay time, default 1.500 sec
;; return - sound.
;;
(defun aeolus:fn (pitch dur &key vel rc rm i attack decay)
(let* ((hz (step-to-hz pitch))
(chz (* (or rc 1.000) hz))
(mhz (* (or rm 1.001) hz))
(i (* (or i 1.00)(map:ctrl 0.50 (or vel 64) 3.00)))
(attack (or attack 0.050))
(decay (or decay 2.000)))
(mult (fmosc (hz-to-step chz)
(scale (* i chz)(mult (osc (hz-to-step mhz)(+ dur decay))
(xad attack (+ dur decay)))))
(xasd attack (max 0 (- dur attack)) decay))))
; ***************************************************************************
;; Calculates the relative "resonance" of two pure tones at frequencies a and b
;; The domains of a and b are the positive real numbers and the range
;; is the interval [0,1] with 1 indicating a = b. Values less
;; then 1 progressively indicate a != b.
;;
;; a - flonum. a > 0
;; b - flonum. b > 0
;; discrimination - flonum. Sets curve steepness., discrimination >= 2
;; limit - flonum. Values less the limit are set to 0.
;; ISSUE: There is a minor bug, values less then limit do
;; appear in the result. Why?
;;
;;
(defun aeolus:_resonance (a b &optional (discrimination 4.0)(limit 0.20))
(let (rs)
(setf rs (expt (/ 1.0 (+ 1 (abs (- 1 (/ (max a b)(float (min a b))))))) discrimination))
(if (>= rs limit) rs 0)
))
;; Calculates the relative resonance of non-pure tone A and pure tone B.
;; The relative resonant partials of A are specified by plist, a list
;; of the form ((r0 a0)(r1 a1)(r2 a2)...(rn an))
;; Where ri is relative frequency and ai the associated amplitude. 0<=ai<=1
;; Sublist ordering within plist is not important.
;;
;; A - flonum. Fundamental frequency of harp string.
;; B - flonum. Test frequency
;; plist - list. List of string harmonics.
;; discrimination - integer. Sets the steepness of the resulting curve.
;; return - flonum. 0 <= result <=1 with 1 indicating exact match
;; between A and B.
;;
(defun aeolus:resonance (a b plist discrimination)
(let* (absfrqlst reslst)
(setf absfrqlst (mapcar #'* (copies (length plist) a)(sublist-extract plist 0)))
(setf reslst (mapcar #'aeolus:_resonance absfrqlst (copies (length plist) b)(copies (length plist) discrimination)))
(apply #'max (mapcar #'* reslst (sublist-extract plist 1)))))
;; The default string harmonic list, strong unison and octaves, moderately
;; strong 5ths (with octaves), progressively weaker 4ths, 3rds, 6ths and 7ths.
;;
(setf aeolus:*default-plist* '((1.000 1.000) ;unison and octaves
(2.000 0.970)
(0.500 0.970)
(1.500 0.800) ;5ths
(0.750 0.300)
(3.000 0.300)
(1.333 0.700) ;4th
(1.250 0.350) ;3rd
(1.200 0.400) ;3rd
(1.667 0.300) ;6th
(1.875 0.100) ;7th
))
;; **************************************************************************
;; aeolus:string class
;;
;; Aeolus:string is a "helper" class which contains information about a single
;; harp "string". A string consist of a frequency (either relative or
;; absolute), a sound generation function, and a list of partials. The
;; :resonance method is used to calculates the strings resonance to a given
;; frequency.
;;
;; **************************************************************************
(setf aeolus:string (send class :new '(.frq .fn .plist)))
(send aeolus:string :answer :isnew '(frq &optional fn plist)
'((setf .frq frq
.fn (or fn #'aeolus:fn)
.plist (or plist aeolus:*default-plist*))))
(send aeolus:string :answer :frq '(&optional val)
'((if val (setf .frq val))
.frq))
(send aeolus:string :answer :fn '(&optional val)
'((if val (setf .fn val))
.fn))
(send aeolus:string :answer :plist '(&optional val)
'((if val (setf .plist val))
.plist))
(send aeolus:string :answer :resonance '(frq discrimination)
'((aeolus:resonance .frq frq .plist discrimination)))
(send aeolus:string :answer :rep '(&optional echo)
'((format echo "~%AEOLUS:STRING frq ~a ~a" .frq .fn)))
;; **************************************************************************
;; aeolus:keyarg class
;;
;; Aeolus:keyarg is a "helper" class which holds a single synthesis
;; parameter. Each parameter consist of a symbol, a default value used for
;; maximum resonance strings, and a map which shows how the value changes as a
;; function of resonance. See map.lsp. The :get method is used to determine
;; the parameter value for a given resonance.
;;
;; **************************************************************************
(setf aeolus:keyarg (send class :new '(.keysym .basevalue .map)))
(send aeolus:keyarg :answer :isnew '(keysym basevalue &optional map)
'((setf .keysym keysym
.basevalue basevalue
.map (or map map:*id*))))
(send aeolus:keyarg :answer :keysym '(&optional val)
'((if val (setf .keysym val))
.keysym))
(send aeolus:keyarg :answer :basevalue '(&optional val)
'((if val (setf .basevalue val))
.basevalue))
(send aeolus:keyarg :answer :map '(&optional val)
'((if val (setf .map val))
.map))
(send aeolus:keyarg :answer :get '(resonance &optional rbase rmap)
'((* (or rbase .basevalue)
(send (or rmap .map) :get resonance))))
(send aeolus:keyarg :answer :rep '(&optional echo)
'((format echo "~%AEOLUS:KEYARG ~a base ~a map ~a" .keysym .basevalue .map)))
;; **************************************************************************
;; aeolus:class class
;;
;; **************************************************************************
;; @doc class aeolus:class
;; A generalized Aeolian harp. Each harp contains a list of strings, list of
;; synthesis parameters, a rendering mode, base delay time and mapping objects
;; for delay and amplitude as functions of string resonance.
;;
(setf aeolus:*default-delay-map* (map:linear 1 2 1 0))
(setf aeolus:*default-db-map* (map:linear 0 -66 1 0))
(setf aeolus:class (send class :new '(.strings
.keyargs
.mode
.base-delay
.map-delay
.map-db-amp
)))
;; @doc method aeolus:class :new
;; (send aeolus:class :new [mode])
;; Create new aeolus:class object. Initially the harp contains neither strings
;; nor synthesis parameters other then delay and amplitude. Use the :string
;; method to add strings and the :key method to add parameters.
;;
;; mode - symbol. Determines the rendering mode. Three modes are recognized.
;;
;; 'REL - Relative mode, all strings are rendered, the string order
;; within the harp determines it's "resonance". Relative mode
;; could be considered a form of additive synthesis.
;;
;; 'RND - Random mode, like relative but string resonance is randomized.
;;
;; 'ABS - Absolute mode, the default. In absolute mode the harp has a
;; finite number of frequencies from which to draw upon. During
;; rendering the resonance of each string is used to determine
;; how much the string contributes to the output.
;;
;; return - object. A new instance of aeolus:class
;;
;;
(send aeolus:class :answer :isnew '(&optional (mode 'ABS))
'((setf .strings '()
.keyargs '()
.mode mode
.base-delay 0
.map-delay aeolus:*default-delay-map*
.map-db-amp aeolus:*default-db-map*
)))
;; @doc method aeolus:class :delay
;; (send /aeolus:class/ :delay [val])
;; Retrieve and optionally update base delay time. The base delay time is the
;; delay amount applied to the highest resonant strings (resonance 1). By
;; default 0.
;;
;; delay - flonum
;; return - flonum
;;
(send aeolus:class :answer :delay '(&optional val)
'((if val (setf .base-delay val))
.base-delay))
;; @doc method aeolus:class :delay-map
;; (send /aeolus:class/ :delay-map [val])
;; Retrieve and optionally update delay as function of resonance map.
;;
;; val - map.
;; return - map.
;;
(send aeolus:class :answer :delay-map '(&optional val)
'((if val (setf .map-delay val))
.map-delay))
;; @doc method aeolus:class :db-map
;; (send /aeolus:class/ :db-map [val])
;; Retrieve and optionally update amplitude (in db) as function of resonance
;; map
;;
;; val - map.
;; return - map.
;;
(send aeolus:class :answer :db-map '(&optional val)
'((if val (setf .map-db-amp val))
.map-db-amp))
;; @doc method aeolus:class :string
;; (send /aeolus:class/ :string frq [:fn][:plist])
;; Add new string to harp.
;;
;; frq - flonum. The strings frequency. If the harps rendering mode is ABS
;; (absolute) The strings frequency is specified directly in Hertz.
;; For REL (relative) and RND (random) modes the strings frequency
;; is specified as a ratio.
;;
;; :fn - closure. The function used to produce the string's sound.
;; The function must have the form
;; (lambda (pitch dur [keywords...]))
;; and return sound. The default is aeolus:fn
;;
;; :plist - list. A list of the form
;; ((p0 a0)(p1 a1)(p2 a2)...(pn an))
;; used to specify the relative harmonic resonances for the sting.
;; The plist argument is ignored in REL and RND modes.
;;
;; return - object. A new instance of aeolus:string.
;;
(send aeolus:class :answer :string '(frq &key fn plist)
'((let (strobj)
(setf strobj (send aeolus:string :new frq (or fn #'aeolus:fn)(or plist aeolus:*default-plist*)))
(setf .strings (append .strings (list strobj)))
strobj)))
;; @doc method aeolus:class :key
;; (send /aeolus:class/ :key keysym basevalue [map])
;; Add a new keyword parameter.
;; When a sound is rendered the keyword arguments are calculated as a
;; function of each strings resonance and then aggregated to an argument list
;; for the string's sound function. The keywords which the default
;; string function responds to are :attack :decay :fc :fm and :i
;; These arguments must be explicitly added to the harp to have any effect.
;;
;; keysym - symbol. The keyword symbol.
;;
;; basevalue - flonum. The parameter value for resonance 1.
;;
;; map - map. (See map.lsp) Defines the scaling of basevalue as a
;; function of resonance. The maps domain should be
;; 0 (for low resonance) to 1 (high resonance).
;;
;; return - object. A new instance of aeolus:keyarg
(send aeolus:class :answer :key '(keysym basevalue &optional map)
'((let (keyobj)
(setf keyobj (send aeolus:keyarg :new keysym basevalue
(or map map:*id*)))
(setf .keyargs (cons keyobj .keyargs ))
keyobj)))
(send aeolus:class :answer :build-abs-arglist '(res sfrq frq dur aux)
'((let (arglist)
(setf arglist (list (hz-to-step sfrq) dur))
(dolist (keyarg .keyargs)
(setf arglist
(append arglist
(list (send keyarg :keysym)
(send keyarg :get res
(get-keyword-value
(send keyarg :keysym)
aux
(send keyarg :basevalue)))))))
arglist)))
;; keywords
;; :discrim 0 1 2 ....
;; :delay
(send aeolus:class :answer :render-abs '(frq dur aux)
'((if aeolus:*debug*
(format t
"~%AEOULS :RENDER-ABS frq ~a dur ~a aux ~a"
frq dur aux))
(let (strobj res delay db fn arglist discrim)
(setf discrim (get-keyword-value ':discrim aux 4.0))
(simrep (n (length .strings))
(progn
(setf strobj (nth n .strings ))
(setf res (send strobj :resonance frq discrim))
(setf delay (* (get-keyword-value ':delay aux .base-delay)
(send .map-delay :get res)))
(setf db (send .map-db-amp :get res))
(setf fn (send strobj :fn))
(setf arglist (send self :build-abs-arglist
res (send strobj :frq) frq dur aux))
(if aeolus:*debug*
(format t
"~%index ~a discrim ~a res ~a delay ~a db ~a arglist ~a"
n discrim res delay db arglist))
(if (plusp res)
(at delay (cue (scale-db db (apply fn arglist))))
(s-rest)))))))
;; res - "resonance" of strobj is determined by its position in .strings
;; rfrq - relative frequency (derived from strobj)
;; frq - rendering frequency
;; dur - duration
;; aux - keyword argument list
;; arglist - the return object
;;
(send aeolus:class :answer :build-rel-arglist '(res rfrq frq dur aux)
'((let (arglist)
(setf arglist (list (hz-to-step (* rfrq frq)) dur))
(dolist (keyarg .keyargs)
(setf arglist
(append arglist
(list (send keyarg :keysym)
(send keyarg :get res
(get-keyword-value
(send keyarg :keysym)
aux
(send keyarg :basevalue)))))))
arglist)))
(send aeolus:class :answer :render-rel '(frq dur aux)
'((if aeolus:*debug*
(format t
"~%AEOLUS :RENDER-REL frq ~a dur ~a aux ~a"
frq dur aux))
(let (strobj res delay db fn arglist)
(simrep (n (length .strings))
(progn
(setf strobj (nth n .strings))
(setf res (- 1 (/ (float n)
(max 1 (- (length .strings) 1)))))
(setf delay (* (get-keyword-value ':delay aux .base-delay)
(send .map-delay :get res)))
(setf db (send .map-db-amp :get res))
(setf fn (send strobj :fn))
(setf arglist (send self :build-rel-arglist
res (send strobj :frq) frq dur aux))
(if aeolus:*debug*
(format t
"~%index ~a delay ~a db ~a arglist ~a"
n delay db arglist))
(at delay (cue (scale-db db (apply fn arglist))))
)))))
(send aeolus:class :answer :render-rnd '(frq dur aux)
'((if aeolus:*debug*
(format t
"~%AEOLUS :RENDER-RND frq ~a dur ~a aux ~a"
frq dur aux))
(let (slist strobj res delay db fn arglist)
(setf slist (permute .strings))
(simrep (n (length slist))
(progn
(setf strobj (nth n slist))
(setf res (- 1 (/ (float n)(max 1 (- (length .strings) 1)))))
(setf delay (* (get-keyword-value ':delay aux .base-delay)
(send .map-delay :get res)))
(setf db (send .map-db-amp :get res))
(setf fn (send strobj :fn))
(setf arglist (send self :build-rel-arglist res (send strobj :frq) frq dur aux))
(if aeolus:*debug*
(format t "~%index ~a delay ~a db ~a arglist ~a" n delay db arglist))
(at delay (cue (scale-db db (apply fn arglist))))
)))))
;; @doc method aeolus:class :render
;; (send /aeolus:class/ :render frq dur aux)
;; Instruct harp to create sound.
;;
;; frq - flonum. Frequency in Hertz. For absolute (ABS) mode frq may not
;; actually appear in the result. Instead the frequencies of the
;; harp strings which are highly resonant to frq are used. In
;; relative and random modes the strings frequencies are relative
;; and multiplied by frq.
;;
;; dur - flonum. Duration in seconds, using the default string function the
;; decay time extends beyond dur.
;;
;; aux - list. List of optional keyword arguments. The exact compliment of
;; recognized keywords is dependent on calling the :key method. The
;; following keywords are always recognized.
;;
;; :discrim - integer > 1, how discriminating the resonance function is
;; :delay - flonum. delay >= 0
;;
;; Keywords added via the :key method may be included in aux to
;; provide a new default value.
;;
;; return - sound.
(send aeolus:class :answer :render '(frq dur aux)
'((cond ((eq .mode 'REL)
(send self :render-rel frq dur aux))
((eq .mode 'RND)
(send self :render-rnd frq dur aux))
(t
(send self :render-abs frq dur aux)))))
(send aeolus:class :answer :rep '(&optional (echo t))
'((let (acc frmt)
(setf frmt "~%AEOLUS:CLASS mode ~a delay ~a")
(setf acc (format nil frmt .mode .base-delay))
(dolist (ka .keyargs)
(setf acc (strcat acc (send ka :rep nil))))
(dolist (so .strings)
(setf acc (strcat acc (send so :rep nil))))
(format echo "~a~%" acc))))