CLM

"The most apparent difference between animals and vegetables is that animals have the powers of sound" -- William Bartram, "Travels", 1791.

CLM (originally an acronym for Common Lisp Music) is a sound synthesis package in the Music V family. It provides much the same functionality as Stk, Csound, SuperCollider, PD, CMix, cmusic, and Arctic -- a collection of functions that create and manipulate sounds, aimed primarily at composers (in CLM's case anyway). The instrument builder plugs together these functions (called generators here), along with general programming glue to make computer instruments. These are then called in a note list or through some user interface (provided by Snd, for example).

CLM exists in several forms: the original Common Lisp implementation (clm-3.tar.gz), a C version (sndlib.tar.gz), a Scheme version (sndlib.tar.gz with Guile), Ruby (sndlib again but using Ruby), and Forth (sndlib/gfm). The Scheme and Ruby versions are also built into the Snd editor (snd-7.tar.gz). There are a variety of unavoidable differences between these versions, but in general, the differences are obvious and consistent: Lisp "-" becomes C "_", "?" becomes "_p", "->" becomes "_to_", and so on, so the function named mus_oscil in C, becomes oscil elsewhere, mus_oscil_p becomes oscil?, and mus_hz_to_radians becomes hz->radians in Lisp/Scheme. For historical reasons, this document is based on the Common Lisp version, with a few examples from other versions scattered around. If you'd like to compare a standard instrument in the various implementations, check out the fm-violin exists: v.ins (Common Lisp), v.scm (Scheme), v.rb (Ruby), and sndlib.html (C).

CLM has several sections: "generators", instruments (definstrument and *.ins), examples of note lists (with-sound, *.clm), a "make" facility for sound files (with-mix), various functions that are useful in sound file work (sound-let, mix), and a connection to the Snd sound editor. CLM is available free, via anonymous ftp (pub/Lisp/clm-3.tar.gz at ccrma-ftp.stanford.edu; the Snd editor is snd-7.tar.gz).

Bill Schottstaedt (bil@ccrma.stanford.edu)

related documentation:snd.html extsnd.htmlgrfsnd.htmlfm.htmlsndlib.htmlsndscm.htmllibxm.htmlindex.html

Contents


Introduction

CLM provides functions to experiment with sounds. The easiest way to make a new sound is with-sound. Say we want to hear one second of the fm violin (in v.ins, named fm-violin) at 440 Hz, and a somewhat soft amplitude. Compile and load v.ins, then call with-sound:

    (compile-file "v.ins")
    (load "v")
    (with-sound () (fm-violin 0 1 440 .1)) 

and the note should emerge from the speakers. The compile and load sequence can be abbreviated in most lisps. In ACL:cl v.ins or perhaps even :cl v will call compile-file if needed, then load. Once loaded, we don't need to reload v unless we change it in some way. (In CMU-CL, load v.cmucl, not v.x86f, and in SBCL, load v.sbcl). To get an arpeggio:

    (with-sound ()
      (loop for i from 0 to 7 do
        (fm-violin (* i .25) .5 (* 100 (1+ i)) .1))) 

clm-example.lisp shows how to create such a note list algorithmically. To listen to the last computed sound again:

(play)

or, if you have some saved sound file:

(play "a-great.snd")

Although you can use CLM simply as a bunch of canned functions, it's a lot more fun to make your own. In CLM, these are called instruments, and a sequence of instrumental calls is a note list. To create your own instruments, you need to write the function that expresses in CLM's terms the sound processing actions you want. In the simplest case, you can just calculate your new value, and add it into the current output (the examples in this file are mostly in Common Lisp):

(definstrument simp (start-time duration frequency amplitude)
  (let* ((beg (floor (* start-time *srate*)))
	 (end (+ beg (floor (* duration *srate*))))
	 (j 0))
    (run
      (loop for i from beg below end do
        (outa i (* amplitude (sin (* j 2.0 pi (/ frequency *srate*)))))
	(incf j)))))

Now to hear our sine wave:

(with-sound () (simp 0 0.25 440.0 0.2))

This creates a sine-wave at 440.0 Hz, 0.2 amplitude, between times 0 and 0.25 seconds. The line:

(definstrument simp (start-time duration frequency amplitude) 

says that we are defining an instrument (definstrument) named simp which takes the four parameters start-time, duration, frequency, and amplitude. The next two lines:

  (let* ((beg (floor (* start-time *srate*)))
	 (end (+ beg (floor (* duration *srate*))))) 

turn the start-time and duration values, passed by the caller in terms of seconds, into samples. The variable *srate* holds the current sampling rate. The "run" macro is an optimizer; in Common Lisp it turns its body into a C foreign function call. The next line:

    (loop for i from beg below end and j from 0 by 1 do 

uses the Lisp loop construct to loop through the samples between the start time in samples (beg) and the end point (end) calculating simp's output on each sample. We are also using the variable j to increment the current phase in the last line:

      (outa i (* amplitude (sin (* j 2.0 pi (/ frequency *srate*)))))))) 

This is the heart of our instrument. The call (outa i ...) adds its third argument (in this case a complicated expression) into channel 0 of the current output stream at sample i. The expression itself:

(* amplitude (sin (* j 2.0 pi (/ frequency *srate*)))))))) 

is creating a sinusoid (via the "sin" function) at the specified volume ("amplitude" is passed as an argument to simp), and the desired frequency ("frequency" is also an argument to simp). The caller passes simp a frequency in cycles per second (440.0 for example), but we need to turn that into the corresponding phase value for the "sin" function. We do that by translating from cycles per second to radians per sample by multiplying by two pi (this multiply gives us radians per second), then dividing by the sampling rate (samples per second) to give us radians per sample (i.e. radians/second divided by samples/second gives radians/sample); we then multiply by "j" to step forward on each sample. All this is far more detailed and explicit than would be the case in any real instrument. Finally, the line:

(with-sound () (simp 0 0.25 440.0 0.2))

opens an output sound file, calls simp, closes the file, and plays the result. In Common Lisp, we need to put the instrument definition in a separate file and compile and load it; we can't just paste it into the listener (as in Scheme or Ruby).

We can simplify simp by using oscil for the sinusoid and hz->radians. make-oscil creates an oscil generator; similarly make-env creates an envelope generator:

(definstrument simp (start-time duration frequency amplitude &optional (amp-env '(0 0 .5 1.0 1.0 0)))
  (multiple-value-bind (beg end) (times->samples start-time duration)
    (let ((osc (make-oscil :frequency frequency))
	  (amp-env (make-env :envelope amp-env :scaler amplitude :duration duration)))
      (run 
       (loop for i from beg below end do
	 (outa i (* (env amp-env) (oscil osc))))))))

Our envelope is a list of (x y) break-point pairs. The x-axis bounds are arbitrary, but it is conventional (here at ccrma) to go from 0 to 1.0. The y-axis values are normally between -1.0 and 1.0, to make it easier to figure out how to apply the envelope in various different situations. In this case, our envelope is a ramp up to the middle of the note: "(0.0 0.0 0.5 1.0)", then a ramp down to 0. The env generator produces the envelope on a sample-by-sample basis.

If you make a change to an instrument, just recompile and reload it to use the changed version; there's no need to restart lisp, or unload the old version (in most lisps there's actually no way to unload it).

In Scheme (Snd with Guile, for example), the same sequence can be used: with-sound has the same syntax, and the run macro optimizes the body of the instrument. The main difference is that run in Scheme takes a function:

(definstrument (scm-simp start-time duration frequency amplitude)
  (let* ((beg (inexact->exact (floor (* start-time (mus-srate)))))
         (dur (inexact->exact (floor (* duration (mus-srate)))))
         (osc (make-oscil :frequency frequency)))
    (run
      (lambda ()
        (do ((i 0 (1+ i)))
            ((= i dur))
          (outa (+ i beg) (* amplitude (oscil osc)) *output*))))))

CLM instruments

The normal structure of an instrument is:

(definstrument name (args) (setup code (run run-time code)))

The setup code creates any needed generators for the run-time code which actually generates the samples. The run-time code can contain any of the lisp functions (generators etc) described in the next several sections. Since life is short, not every feature of lisp is supported by the run macro; I've concentrated on those that have been useful in the past, so let me know if you need something new!

Lisp functions can occur within the body of the run macro:

    +  /  *  -  1+  1-  incf decf setf setq
     =  /=  <  >  <=  >=  zerop plusp  
    minusp oddp evenp max min abs mod rem identity
    floor ceiling round truncate signum sqrt random float
    ash log expt exp sin cos tan asin acos atan cosh sinh tanh asinh acosh atanh 
    or and not null if unless when cond progn prog1 prog2 case tagbody go 
    error warn print princ terpri probe-file
    block return return-from let let* loop do do* dotimes declare
    lambda apply loop-finish
    aref elt svref array-total-size array-in-bounds-p array-rank array-dimension
    integerp numberp floatp realp eq eql arrayp

In Scheme, this list is much longer (all the generator "make" functions are included, for example); see grfsnd.html for more details. Also, the Scheme names are often slightly different from the Lisp names ("begin" for "progn", "zero?" for "zerop" etc).

The function clm-print stands in for Lisp's format -- I don't support all of format's options, but enough to be useful, I hope. clm-print's syntax is (clm-print format-string &rest args). In Scheme, clm-print falls back on whatever version of format is loaded, so it is much less limited in that regard.

Loop (CL only) is expanded as a macro and anything in the loop syntax is ok if it expands into something else mentioned above (i.e. a lambda form with go's and so forth).

Declare can be used to set the variable types and debugging options. Since the run macro can't always tell what type a variable is, it will generate run-time code to figure out the type. The generated code will be faster and tighter (and a lot easier to read) if you use declare to tell run what the types are. In Common Lisp, the recognized types are :integer, :float, :string, :boolean, :bignum (sample number), :double*, :int*, :mus-any, and :mus-any-array (the keyword package is used to avoid endless CL package name troubles). In Scheme (in the Snd run macro), the declarable types are: int, float, boolean, char, string, vct, reader, clm, number, vector, integer, real, string, bignum (sample number), mus-any (i.e. a generator), and any def-clm-struct name.


Generators


all-passall-pass filter
asymmetric-fmasymmetric fm
averagemoving window average
combcomb filter
convolveconvolution
delaydelay line
envline segment envelope
filterdirect form FIR/IIR filter
fir-filterFIR filter
formantresonance
granulategranular synthesis
iir-filterIIR filter
in-anysound file input
locsigstatic sound placement
notchnotch filter
one-poleone pole filter
one-zeroone zero filter
oscilsine wave and FM
out-anysound output
phase-vocodervocoder analysis and resynthesis
pulse-trainpulse train
rand,rand-interprandom numbers, noise
readinsound input
sawtooth-wavesawtooth
sine-summationsine summation synthesis
square-wavesquare wave
srcsampling rate conversion
ssb-amsingle sideband amplitude modulation
sum-of-cosinesband-limited pulse train
sum-of-sinessum of sines
table-lookupinterpolated table lookup
tapdelay line tap
triangle-wavetriangle wave
two-poletwo pole filter
two-zerotwo zero filter
wave-trainwave train
waveshapewaveshaping


A generator is a function that returns the next sample in an infinite stream of samples each time it is called. An oscillator, for example, returns an endless sine wave, one sample at a time. Each generator consists of a set of functions: Make-<gen> sets up the data structure associated with the generator at initialization time; <gen> produces a new sample; <gen>? checks whether a variable is that kind of generator. Internal fields are accessible via various generic functions such as mus-frequency:

    (setf oscillator (make-oscil :frequency 330))

prepares oscillator to produce a sine wave when set in motion via

    (oscil oscillator)

(oscil? oscillator) returns t, and (mus-frequency oscillator) returns 330. The initialization function normally takes a number of optional arguments, setting whatever state the given generator needs to operate on. The run-time function's first argument is always its associated structure. Its second argument is nearly always something like an FM input, whatever run-time modulation might be desired; in other cases it can be a function to provide input data or editing operations. Amplitude envelopes are handled with a separate env generator. Frequency sweeps of all kinds (vibrato, glissando, breath noise, FM proper) are all forms of run-time frequency modulation. So, in normal usage, our oscillator looks something like:

    (oscil oscillator (+ vibrato glissando frequency-modulation))

Frequencies are always in cycles per second (also known as Hz), internal table size is two pi. The fm (or frequency change) argument is assumed to be a phase change in radians, applied on each sample. Normally composers would rather think in terms of Hz, so the function hz->radians can be used to convert from units of cycles per second to radians per sample. Since all the generators agree that their internal period length is two-pi, you can always use hz->radians to convert the frequency change (or fm) argument from a more easily interpreted value.

Finally, one special aspect of the make-<gen> functions is the way they read their arguments. I use the word optional-key in the function definitions in this document to indicate that the arguments are keywords, but the keywords themselves are optional. Take the make-oscil call, defined as:

  make-oscil &optional-key (frequency 440.0) (initial-phase 0.0)

When make-oscil is called, it scans its arguments; if a keyword is seen, that argument and all following arguments are passed unchanged, but if a value is seen, the corresponding keyword is prepended in the argument list:

  (make-oscil :frequency 440.0)
  (make-oscil :frequency 440.0 :initial-phase 0.0)
  (make-oscil 440.0)
  (make-oscil)
  (make-oscil 440.0 :initial-phase 0.0)
  (make-oscil 440.0 0.0)

are all equivalent, but

  (make-oscil :frequency 440.0 0.0)
  (make-oscil :initial-phase 0.0 440.0)

are in error, because once we see any keyword, all the rest of the arguments have to use keywords too (we can't reliably make any assumptions after that point about argument ordering). If this is confusing, just use the keywords all the time. I implemented this somewhat unusual argument interpretation because in many cases it is silly to insist on the keyword; for example, in make-env, the envelope argument is obvious and can't be confused with any other argument, so it's an annoyance to have to say ":envelope" over and over. Keyword arguments are also useful when there are so many arguments to a function that it becomes impossible to remember what they are and what order they come in.


OSCIL (sinusoids)

  make-oscil &optional-key (frequency 440.0) (initial-phase 0.0)
  oscil os &optional (fm-input 0.0) (pm-input 0.0)
  oscil? os

oscil produces a sine wave (using sin) with optional frequency change (i.e. fm). Its first argument is an oscil created by make-oscil. Oscil's second (optional) argument is the current (sample-wise) frequency change (it defaults to 0). The optional third argument is the (sample-wise) phase change (in addition to the carrier increment and so on). So the second argument can be viewed as FM, while the third is PM (phase modulation). The initial-phase argument to make-oscil is in radians. You can use degrees->radians to convert from degrees to radians. To get a cosine (as opposed to sin), set the initial-phase to (/ pi 2).

oscil methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-cosines1 (no setf)

  (prog1
    (sin (+ phase pm-input))
    (incf phase (+ (hz->radians frequency) fm-input)))

oscil takes both FM and PM arguments; here is an example of FM:

(definstrument simple-fm (beg dur freq amp mc-ratio index &optional amp-env index-env)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (cr (make-oscil freq))                     ; our carrier
         (md (make-oscil (* freq mc-ratio)))        ; our modulator
         (fm-index (hz->radians (* index mc-ratio freq)))
         (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :end end))
         (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :end end)))
    (run
      (loop for i from start to end do
        (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))

See fm.html for a discussion of fm. The standard additive synthesis instruments use an array of oscillators to create the individual spectral components:

(definstrument simple-osc (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (arr (make-array 20))) ; we'll create a tone with 20 harmonics
    (do ((i 0 (1+ i)))
	((= i 20))
      (setf (aref arr i) (make-oscil (* (1+ i) 100))))
    (run
     (loop for i from start to end do
       (let ((sum 0.0))
	 (do ((i 0 (1+ i)))
	     ((= i (length arr)))
	   (incf sum (oscil (aref arr i))))
	 (outa i (* amp .05 sum)))))))

Here are equivalent phase-modulation and frequency-modulation instruments, using Scheme (Snd/CLM) syntax:

(definstrument (pm beg end freq amp mc-ratio index)
  (let ((pm (make-oscil (* freq mc-ratio)))
	(carrier (make-oscil freq)))
   (run
     (lambda ()
       (do ((i beg (1+ i)))
	   ((= i end))
	 (outa i (* amp (oscil carrier 0.0 (* index (oscil pm)))) *output*))))))

(definstrument (fm beg end freq amp mc-ratio index)
  (let ((fm (make-oscil (* freq mc-ratio) :initial-phase (/ 3.14159 2.0)))
	(carrier (make-oscil freq))
        (fm-index (* (hz->radians freq) mc-ratio index)))
    (run
     (lambda ()
       (do ((i beg (1+ i)))
	   ((= i end))
	 (outa i (* amp (oscil carrier (* fm-index (oscil fm)))) *output*))))))

#!
(with-sound () (pm 0 10000 1000 .25 0.1 4))
(with-sound () (fm 0 10000 1000 .25 0.1 4))

(with-sound () (pm 0 10000 100 .25 1.0 8))
(with-sound () (fm 0 10000 100 .25 1.0 8))
!#

ENV (envelopes)

  make-env &optional-key 
      envelope      ; list of x,y break-point pairs
      (scaler 1.0)  ; scaler on every y value (before offset is added)
      duration      ; seconds
      (offset 0.0)  ; value added to every y value
      base          ; type of connecting line between break-points
      end           ; (- end start) => duration in samples (can be used instead of duration)
      (start 0)     ; can be used in conjunction with end
      dur           ; duration in samples (can be used instead of start and end)
  env e
  env? e
  restart-env e     ; return to start of envelope
  env-interp x env &optional (base 1.0)
  envelope-interp x envelope &optional (base 1.0)
env methods
mus-locationcall counter value (number of calls so far on env)
mus-incrementbase value (no setf)
mus-dataoriginal breakpoint list
mus-scaleroriginal scaler
mus-offsetoriginal offset
mus-lengthoriginal duration in samples

An envelope is a list of break point pairs: '(0 0 100 1) is a ramp from 0 to 1 over an x-axis excursion from 0 to 100. This list is passed to make-env along with the scaler applied to the y axis, the offset added to every y value, and the time in samples or seconds that the x axis represents. make-env returns an env generator which returns the next sample of the envelope each time it is called. The actual envelope value, leaving aside the base is offset + scaler * envelope-value. The kind of interpolation used to get y-values between the break points is determined by the envelope's base. Say we want a ramp moving from .3 to .5 over 1 second. The corresponding make-env call would be

  (make-env '(0 0 100 1) :scaler .2 :offset .3 :duration 1.0)

Base determines how the break-points are connected. If it is 1.0 (the default), you get straight line segments. base = 0.0 gives a step function (the envelope changes its value suddenly to the new one without any interpolation). Any other positive value becomes the exponent of the exponential curve connecting the points (see env.lisp). base < 1.0 gives convex curves (i.e. bowed out), and base > 1.0 gives concave curves (i.e. sagging). If you'd rather think in terms of e^-kt, set the base to (exp k). To get arbitrary connecting curves between the break points, treat the output of env as the input to the connecting function. Here's an instrument that maps the line segments into sin x^3:

(definstrument mapenv (beg dur frq amp en)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (osc (make-oscil frq))
         (half-pi (* pi 0.5))
	 (zv (make-env en 1.0 dur)))
    (run
     (loop for i from start below end do
       (let ((zval (env zv))) ;zval^3 is [0.0..1.0], as is sin between 0 and half-pi.
	 (outa i (* amp (sin (* half-pi zval zval zval)) (oscil osc))))))))

(with-sound () (mapenv 0 1 440 .4 '(0 0 50 1 75 0 86 .5 100 0)))

Or create your own generator that traces out the curve you want. J.C.Risset's bell curve could be:

(defmacro bell-curve (x)
  ;; x from 0.0 to 1.0 creates bell curve between .64e-4 and nearly 1.0
  ;; if x goes on from there, you get more bell curves; x can be
  ;; an envelope (a ramp from 0 to 1 if you want just a bell curve)
  `(+ .64e-4 (* .1565 (- (exp (- 1.0 (cos (* two-pi ,x)))) 1.0))))

restart-env causes an envelope to start all over again from the beginning. To jump to any position in an envelope, use mus-location (there's an example of this in ug.ins).

(definstrument restartable-simp (beg dur env-dur)
  (let* ((os (make-oscil))
	 (en (make-env '(0 0 50 1 100 0) :end env-dur :scaler .1))
	 (j beg)
	 (env-stop (+ beg env-dur)))
    (run
     (loop for i from beg below (+ beg dur) do 
       (let ((val (* (env en) (oscil os))))
	 (incf j)
	 (when (> j env-stop)
	   (incf env-stop env-dur)
	   (restart-env en))
	 (outa i val))))))

env-interp and envelope-interp return the value of the envelope at some point on the x axis; env-interp operates on an 'env' (the output of make-env), whereas envelope-interp operates on an 'envelope' (a list of breakpoints). To get weighted random numbers, use the output of random(100.0) as the lookup index into an envelope whose x axis goes from 0 to 100. Then the envelope y values are the numbers returned, and the amount of the x-axis taken by a given value is its weight. Say we want 40% .5, and 60% 1.0,

(loop for i from 0 to 10 collect 
  (envelope-interp (random 100.0) (list 0 .5 40 .5 40.01 1.0 100 1.0)))
=> '(1.0 1.0 0.5 1.0 1.0 0.5 0.5 1.0 0.5 1.0 1.0) 

This idea is also available in the rand and rand-interp generators. Other env-related functions are:

  envelope-reverse e                         reverse an envelope
  envelope-repeat e num &optional refl xnorm repeat an envelope
  envelope-concatenate &rest es              concatenate any number of envelopes
  envelope+ es                               add together any number of envelopes
  envelope* es                               same but multiply
  envelope-simplify e &optional yg xg        simplify an evelope
  meld-envelopes e0 e1                       meld two envelopes together
  map-across-envelopes func es               map a function across any number of envelopes
  envelope-exp  e &optional pow xg           create exponential segments of envelopes
  window-envelope beg end e                  return portion of e between two x values
  stretch-envelope e a0 a1 &optional d0 d1   attack and decay portions
  scale-envelope e scale &optional offset    scale e
  normalize-envelope e &optional norm        normalize e

See env.lisp for more such functions. To copy an existing envelope while changing one aspect (say duration), it's simplest to use make-env:

(defun change-env-dur (e dur)
  (make-env (mus-data e)            ; the original breakpoints
	    :scaler (mus-scaler e)  ; these are the original values passed to make-env
	    :offset (mus-offset e)
            :base (mus-increment e) ; the base (using "mus-increment" because it was available...)
	    :duration dur))

TABLE-LOOKUP

  make-table-lookup &optional-key 
        (frequency 440.0)   ; in Hz
        (initial-phase 0.0) ; in radians 
        wave                ; double-float array
        size                ; table size if wave not specified
        type                ; interpolation type (mus-interp-linear)
  table-lookup tl &optional (fm-input 0.0)
  table-lookup? tl

table-lookup performs interpolating table lookup. Indices are first made to fit in the current table (fm input can produce negative indices), then interpolation returns the table value. Table-lookup scales its frequency change argument (fm-input) to fit whatever its table size is (that is, it assumes the caller is thinking in terms of a table size of two pi, and fixes it up). The wave table should be an array of double-floats (the function make-double-array can be used to create it). type sets the type of interpolation used: mus-interp-none, mus-interp-linear, mus-interp-lagrange, or mus-interp-hermite.

table-lookup methods
mus-frequencyfrequency in Hz
mus-phasephase in radians (wave-size/(2*pi))
mus-datawave array
mus-lengthwave size (no setf)
mus-interp-typeinterpolation choice (no setf)

(prog1 (array-interp wave phase) (incf phase (+ (hz->radians frequency) (* fm-input (/ (length wave) (* 2 pi))))))

There are two functions that make it easier to load up various wave forms:

 partials->wave synth-data table &optional (norm t)
 phase-partials->wave synth-data table &optional (norm t)

The synth-data argument is a list of (partial amp) pairs: '(1 .5 2 .25) gives a combination of a sine wave at the carrier (1) at amplitude .5, and another at the first harmonic (2) at amplitude .25. The partial amplitudes are normalized to sum to a total amplitude of 1.0 unless the argument norm is nil. If the initial phases matter (they almost never do), you can use phase-partials->wave; in this case the synth-data is a list of (partial amp phase) triples with phases in radians.

(definstrument simple-table (dur)
  (let ((tab (make-table-lookup :wave (partials->wave '(1 .5 2 .5)))))
    (run
     (loop for i from 0 to dur do
       (outa i (* .3 (table-lookup tab)))))))

spectr.clm has a steady state spectra of several standard orchestral instruments, courtesy of James A. Moorer. bird.clm (using bird.ins and bigbird.ins) has about 50 North American bird songs.


WAVESHAPE (waveshaping synthesis)

  make-waveshape &optional-key (frequency 440.0) (partials '(1 1)) wave size
  waveshape w &optional (index 1.0) (fm 0.0)
  waveshape? w

  partials->waveshape &optional-key partials (norm t) (size *clm-table-size*)
  partials->polynomial partials &optional (kind 1)

waveshape performs waveshaping; see "Digital Waveshaping Synthesis" by Marc Le Brun in JAES 1979 April, vol 27, no 4, p250.

waveshape methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-datawave array (no setf)
mus-lengthwave size (no setf)

(prog1 (array-interp wave (* (length wave) (+ 0.5 (* index 0.5 (sin phase))))) (incf phase (+ (hz->radians frequency) fm)))

In its simplest use, waveshaping is just an inexpensive way to get additive synthesis:

(definstrument simp ()
  (let ((wav (make-waveshape :frequency 440 :partials '(1 .5 2 .3 3 .2))))
    (run (loop for i from 0 to 1000 do (outa i (waveshape wav))))))

It is sometimes simpler to save the Chebyshev polynomial coefficients (returned by partials->polynomial), and use polynomial at run-time, rather than using waveshape with its built-in table. Bigbird is an example:

(definstrument bigbird (start duration frequency freqskew amplitude freq-env amp-env partials)
  (multiple-value-bind (beg end) (times->samples start duration)
    (let* ((gls-env (make-env freq-env (hz->radians freqskew) duration))
           (os (make-oscil frequency))
           (fil (make-one-pole .1 .9))
           (coeffs (partials->polynomial (normalize-partials partials)))
           (amp-env (make-env amp-env amplitude duration)))
      (run
        (loop for i from beg below end do
          (outa i 
            (one-pole fil   ; for distance effects
              (* (env amp-env) 
                 (polynomial coeffs (oscil os (env gls-env)))))))))))

(with-sound ()
  (bigbird beg .05 1800 1800 .2
           '(.00 .00 .40 1.00 .60 1.00 1.00 .0)         ; freq env
           '(.00 .00 .25 1.00 .60 .70 .75 1.00 1.00 .0) ; amp env
           '(1 .5 2 1 3 .5 4 .1 5 .01)))                ; partials (chirp spectrum)

Partials->polynomial takes a list of harmonic amplitudes and returns a list of Chebyshev polynomial coefficients. We then use polynomial to evaluate the polynomial at run-time, getting the same effect as if we had use waveshape instead. See also pqw.ins for phase quadrature waveshaping (single-sideband tricks).


SAWTOOTH-WAVE, TRIANGLE-WAVE, PULSE-TRAIN, SQUARE-WAVE

  make-triangle-wave &optional-key (frequency 440.0) (amplitude 1.0) (initial-phase pi)
  triangle-wave s &optional (fm 0.0)
  triangle-wave? s

  make-square-wave &optional-key (frequency 440.0) (amplitude 1.0) (initial-phase 0)
  square-wave s &optional (fm  0.0)
  square-wave? s

  make-sawtooth-wave &optional-key (frequency 440.0) (amplitude 1.0) (initial-phase pi)
  sawtooth-wave s &optional (fm 0.0)
  sawtooth-wave? s

  make-pulse-train &optional-key (frequency 440.0) (amplitude 1.0) (initial-phase two-pi)
  pulse-train s &optional (fm 0.0)
  pulse-train? s

These generators produce some standard old-timey wave forms that are still occasionally useful (well, triangle-wave is useful; the others are silly). sawtooth-wave ramps from -1 to 1, then goes immediately back to -1. Use a negative frequency to turn the "teeth" the other way. triangle-wave ramps from -1 to 1, then ramps from 1 to -1. pulse-train produces a single sample of 1.0, then zeros. square-wave produces 1 for half a period, then 0. All have a period of two-pi, so the fm argument should have an effect comparable to the same fm applied to the same waveform in table-lookup. These are not band-limited; if the frequency is too high, you can get foldover, but as far as I know, no-one uses these as audio frequency tone generators -- who would want to listen to a square wave? I should remove these generators from CLM!

saw-tooth and friends' methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-scaleramplitude arg used in make-<gen>
mus-widthwidth of square-wave pulse (0.0 to 1.0)

One popular kind of vibrato is: (+ (triangle-wave pervib) (rand-interp ranvib))

Just for completeness, here's an example:

(definstrument simple-saw (beg dur amp)
  (let* ((os (make-sawtooth-wave 440.0))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (sawtooth-wave os)))))))

SUM-OF-COSINES

  make-sum-of-cosines &optional-key (cosines 1) (frequency 440.0) (initial-phase 0.0)
  sum-of-cosines cs &optional (fm 0.0)
  sum-of-cosines? cs

sum-of-cosines produces a band-limited pulse train containing cosines cosines. See also legendre-summation and friends in dsp.scm. "Trigonometric Delights" by Eli Maor has a derivation of a very similar formula (producing a sum of sines) and a neat geometric explanation. For a derivation of the formula, see "Fourier Analysis" by Stein and Shakarchi.

sum-of-cosines methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-scaler(/ 1.0 cosines)
mus-cosinescosines arg used in make-<gen>
mus-lengthsame as mus-cosines

based on: cos(x) + cos(2x) + ... cos(nx) = (sin((n + .5)x) / (2 * sin(x / 2))) - 1/2 known as the Dirichlet kernel see "Special Functions", Andrews, Askey, Roy, 5.1.10 also cosine-summation in dsp.scm for an extension a similar sum involves cos for sin above, AAR 5.6.2 see also "Table of Integrals...", Gradshteyn and Ryzhik, 1.341 and 1.342

Unfortunately, there's no (reasonable) way to sweep sum-of-cosines in frequency, and keep the result from folding over. That is, the number of cosines is a part of the generating formula, and tricks that change it (for example, when the waveform is near 0), only work when it doesn't matter.

(definstrument simple-soc (beg dur freq amp)
  (let* ((os (make-sum-of-cosines 10 freq 0.0))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (sum-of-cosines os)))))))

SUM-OF-SINES

  make-sum-of-sines &optional-key 
        (sines 1) (frequency 440.0) (initial-phase 0.0)
  sum-of-sines cs &optional (fm 0.0)
  sum-of-sines? cs

sum-of-sines produces a sum of sines sines. It is very similar (good and bad) to sum-of-cosines.

sum-of-sines methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-scalerdependent on number of sines
mus-cosinessines arg used in make-<gen>
mus-lengthsame as mus-cosines

based on: sin(x) + sin(2x) + ... sin(nx) = sin(n * x / 2) * (sin((n + .5)x) / sin(x / 2)) known as the conjugate Dirichlet kernel


SSB-AM (pitch shifting via single-sideband AM)

  make-ssb-am &optional-key (frequency 440.0) (order 40)
  ssb-am gen &optional (insig 0.0) (fm 0.0)
  ssb-am? gen

ssb-am provides single sideband suppressed carrier amplitude modulation, normally used for frequency shifting.

ssb-am methods
mus-frequencyfrequency in Hz
mus-phasephase (of embedded sin osc) in radians
mus-orderembedded delay line size
mus-cosines1
mus-lengthsame as mus-order
mus-interp-typemus-interp-none
mus-xcoeffFIR filter coeff
mus-xcoeffsembedded Hilbert transform FIR filter coeffs
mus-dataembedded filter state

based on: cos(freq) * delay(insig) +/- sin(freq) * hilbert(insig) which shifts insig spectrum by freq and cancels upper/lower sidebands

See the instrument under amplitude-modulate for an explicit version of thus generator. In Snd (dsp.scm), this generator is used to provide time-stretching, pitch-shifting, etc. Here's a complicated way to get a sine wave at 550 Hz:

(definstrument shift-pitch (beg dur freq amp shift)
  (let* ((os (make-oscil freq))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (am (make-ssb-am shift)))
    (run
     (loop for i from start to end do
       (outa i (* amp (ssb-am am (oscil os))))))))

WAVE-TRAIN

  make-wave-train &optional-key (frequency 440.0) (initial-phase 0.0) wave size type
  wave-train w &optional (fm 0.0)
  wave-train? w

wave-train produces a wave train (an extension of pulse-train and table-lookup). Frequency is the repetition rate of the wave found in wave. Successive waves can overlap. With some simple envelopes, or filters, you can use this for VOSIM and other related techniques.

wave-train methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-datawave array (no setf)
mus-lengthlength of wave array (no setf)
mus-interp-typeinterpolation choice (no setf)

Here is a FOF instrument based loosely on fof.c of Perry Cook and the article "Synthesis of the Singing Voice" by Bennett and Rodet in "Current Directions in Computer Music Research".

(definstrument fofins (beg dur frq amp vib f0 a0 f1 a1 f2 a2 &optional ve ae)
  (let* ((start (floor (* beg *srate*)))
         (end (+ start (floor (* dur *srate*))))
         (ampf (make-env :envelope (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
         (frq0 (hz->radians f0))
         (frq1 (hz->radians f1))
         (frq2 (hz->radians f2))
         (foflen (if (= *srate* 22050) 100 200))
         (vibr (make-oscil :frequency 6))
	 (vibenv (make-env :envelope (or ve (list 0 1 100 1)) :scaler vib :duration dur))
         (win-freq (/ two-pi foflen))
         (foftab (make-double-float-array foflen))
         (wt0 (make-wave-train :wave foftab :frequency frq)))
    (loop for i from 0 below foflen do
      (setf (aref foftab i) (double-float      
        ;; this is not the pulse shape used by B&R
            (* (+ (* a0 (sin (* i frq0))) 
                  (* a1 (sin (* i frq1))) 
                  (* a2 (sin (* i frq2)))) 
               .5 (- 1.0 (cos (* i win-freq)))))))
    (run
     (loop for i from start below end do
       (outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr)))))))))

(with-sound () (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)) ;"Ahh"

(with-sound () 
  (fofins 0 4 270 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
          '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
  (fofins 0 4 (* 6/5 540) .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
          '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
  (fofins 0 4 135 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
          '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0)))

RAND, RAND-INTERP (random numbers)

  make-rand &optional-key 
        (frequency 440.0)          ;freq at which new random numbers occur
        (amplitude 1.0)            ;numbers are between -amplitude and amplitude
        (envelope '(-1 1 1 1))     ;distribution envelope (uniform distribution between -1 and 1 is default)
        distribution               ;pre-computed distribution
  rand r &optional (sweep 0.0)
  rand? r
  make-rand-interp &optional-key (frequency 440.0) (amplitude 1.0) (envelope '(-1 1 1 1) distribution)
  rand-interp r &optional (sweep 0.0)
  rand-interp? r
  centered-random amp 
  clm-random amp
  mus-random amp ;same as centered-random (for C-side compatibility)
  mus-set-rand-seed seed

rand returns a sequence of random numbers between -amplitude and amplitude (it produces a sort of step function). rand-interp interpolates between successive random numbers. Lisp's function random returns a number between 0.0 and its argument. In both cases, the envelope argument determines the random number distribution. centered-random returns a number between -amp and amp. clm-random returns a random number between 0 and amp. In the latter two cases, mus-set-rand-seed sets the seed for the random number generator. This provides a way around Lisp's clumsy mechanism for repeating a random number sequence.

rand and rand-interp methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-scaleramplitude arg used in make-<gen>
mus-lengthdistribution table length
mus-datadistribution table, if any

rand: (if (>= phase (* 2 pi)) (setf output (centered-random amplitude))) (incf phase (+ (hz->radians frequency) sweep))

There are a variety of ways to change rand's uniform distribution to some other: (random (random 1.0)) or (sin (random 3.14159)) are simple examples. Exponential distribution could be:

(/ (log (max .01 (random 1.0))) (log .01))

where the ".01"'s affect how tightly the resultant values cluster toward 0.0 -- set it to .0001 for example to get most of the random values close to 0.0. The central-limit theorem says that you can get closer and closer to gaussian noise simply by adding rand's together. Orfanidis in "Introduction to Signal Processing" says 12 calls on rand will do perfectly well. We could define our own generator:

(defmacro gaussian-noise (r)
  ;; r=a rand generator allocated via make-rand
  `(let ((val 0.0))
     (dotimes (i 12) (incf val (rand ,r)))
     val))

For a discussion of the central limit theorem, see Korner "Fourier Analysis" and Miller Puckette's dissertation: http://www-crca.ucsd.edu/~msp/Publications/thesis.ps. Another method is the "rejection method" in which we generate random number pairs until we get a pair that falls within the desired distribution; see random-any in dsp.scm (Snd) for code to do this. It is faster at run time, however, to use the "transformation method". The make-rand and make-rand-interp envelope arguments specify the desired distribution function; the generator takes the inverse of the integral of the envelope, loads that into an array, and uses (array-interp (rand array-size)) at run time. This gives random numbers of any arbitrary distribution at a computational cost equivalent to the waveshape generator (which is very similar). The x axis sets the output range (before scaling by amplitude), and the y axis sets the relative weight of the corresponding x axis value. So, the default is '(-1 1 1 1) which says "output numbers between -1 and 1, each number having the same chance of being chosen". An envelope of '(0 1 1 0) outputs values between 0 and 1, denser toward 0. If you already have the distribution table (the result of (inverse-integrate envelope)), you can pass it through the distribution argument. Here is gaussian noise using the distribution argument (this is Scheme, but the CL version should be self-evident):

(define (gaussian-envelope s)
  (let ((e '())
	(den (* 2.0 s s)))
    (do ((i 0 (1+ i))
	 (x -1.0 (+ x .1))
	 (y -4.0 (+ y .4)))
	((= i 21))
      (set! e (cons x e))
      (set! e (cons (exp (- (/ (* y y) den))) e)))
    (reverse e)))

(make-rand :envelope (gaussian-envelope 1.0))

You can, of course, filter the output of rand to get a different frequency distribution (as opposed to the "value distribution" above, all of which are forms of white noise). Orfanidis also mentions a clever way to get reasonably good 1/f noise: sum together n rand's, where each rand is running an octave slower than the preceding:

(defun make-1f-noise (n)
  ;; returns an array of rand's ready for the 1f-noise generator
  (let ((rans (make-array n)))
    (dotimes (i n) (setf (aref rans i) (make-rand :frequency (/ *srate* (expt 2 i)))))
    rans))

(defmacro 1f-noise (rans)
  `(let ((val 0.0)
         (len (length ,rans)))
     (dotimes (i len) (incf val (rand (aref ,rans i))))
     (/ val len)))

See also green.cl (bounded brownian noise that can mimic 1/f noise in some cases). And we can't talk about noise without mentioning fractals:

(definstrument fractal (start duration m x amp)
  ;; use formula of M J Feigenbaum
  (let* ((beg (floor (* *srate* start)))
	 (end (+ beg (floor (* *srate* duration)))))
    (run
     (loop for i from beg below end do
       (outa i (* amp x))
       (setf x (- 1.0 (* m x x)))))))

;;; quickly reaches a stable point for any m in[0,.75], so:
(with-sound () (fractal 0 1 .5 0 .5)) 
;;; is just a short "ftt"
(with-sound () (fractal 0 1 1.5 .20 .2))

With this instrument you can easily hear the change over from the stable equilibria, to the period doublings, and finally into the combination of noise and periodicity that has made these curves famous. See appendix 2 to Ekeland's "Mathematics and the Unexpected" for more details. Another instrument based on similar ideas is:

(definstrument attract (beg dur amp c) ;c from 1 to 10 or so
  ;; by James McCartney, from CMJ vol 21 no 3 p 6
  (let* ((st (floor (* beg *srate*)))
	 (nd (+ st (floor (* dur *srate*))))
	 (a .2) (b .2) (dt .04)
	 (scale (/ (* .5 amp) c))
	 (x1 0.0) (x -1.0) (y 0.0) (z 0.0))
    (run
     (loop for i from st below nd do
       (setf x1 (- x (* dt (+ y z))))
       (incf y (* dt (+ x (* a y))))
       (incf z (* dt (- (+ b (* x z)) (* c z))))
       (setf x x1)
       (outa i (* scale x))))))

which gives brass-like sounds! rand-interp could be defined as (average agen (rand rgen)) where the averager has the same period (length) as the rand.


ONE-POLE, ONE-ZERO, TWO-POLE, TWO-ZERO (simple filters)

   make-one-pole &optional-key a0 b1    ; b1 < 0.0 gives lowpass, b1 > 0.0 gives highpass
   one-pole f input 
   one-pole? f

   make-one-zero &optional-key a0 a1    ; a1 > 0.0 gives weak lowpass, a1 < 0.0 highpass
   one-zero f input 
   one-zero? f

   make-two-pole &optional-key a0 b1 b2
   two-pole f input 
   two-pole? f

   make-two-zero &optional-key a0 a1 a2
   two-zero f input 
   two-zero? f

   make-zpolar radius frequency  ; another name for make-two-zero
   make-ppolar radius frequency  ; another name for make-two-pole

simple filter methods
mus-xcoeffa0, a1, a2 in equations
mus-ycoeffb1, b2 in equations
mus-order1 or 2 (no setf)
one-zero  y(n) = a0 x(n) + a1 x(n-1)
one-pole  y(n) = a0 x(n) - b1 y(n-1)
two-pole  y(n) = a0 x(n) - b1 y(n-1) - b2 y(n-2)
two-zero  y(n) = a0 x(n) + a1 x(n-1) + a2 x(n-2)

The "a0, b1" nomenclature is taken from Julius Smith's "An Introduction to Digital Filter Theory" in Strawn "Digital Audio Signal Processing", and is different from that used in the more general filters such as fir-filter.

In make-ppolar ("poles polar") you can specify the radius and angle of a pole whereas make-two-pole requires actual filter coefficients. The filter provided by make-ppolar has two poles, one at (radius, frequency), the other at (radius, -frequency). Radius is between 0 and 1 (but less than 1), and frequency is between 0 and srate/2. This is the standard resonator form with poles specified by the polar coordinates of one pole. Similar remarks apply to make-two-zero and make-zpolar. Use two-pole in conjunction with make-ppolar. These are such simple filters that they might seem useless, but one-pole and one-zero pop up unexpectedly; the "fcomb" generator used by freeverb is:

(defmacro fcomb (dly flt input fdbck)
  `(delay ,dly
	  (+ ,input (* (one-zero ,flt
				 (tap ,dly))
		       ,fdbck))))

This is a comb filter with a one-zero filter in the feedback loop.


FORMANT (resonances)

  make-formant &optional-key radius frequency (gain 1.0)
  formant f input       ; resonator centered at frequency, bandwidth set by r
  formant? f
simple filter methods
mus-xcoeffa0, a1, a2 in equations
mus-ycoeffb1, b2 in equations
mus-formant-radiusformant radius
mus-frequencyformant center frequency
mus-order2 (no setf)
mus-scalergain

y(n) = x(n) - 
       r * x(n-2) + 
       2 * r * cos(2 * pi * frequency / srate) * y(n-1) - 
       r * r * y(n-2)

As Julius Smith says, formant is recommended for resonators (simple bandpass filters), vocal tract or instrument cavity simulations, etc. It provides bandpass filtering (a simple resonance) using a two-pole and a two-zero filter. Only one coefficient need be changed in order to move the filter center frequency. The filter coefficients are set as a function of desired pole-radius radius (set by desired bandwidth from radius=1-bw/2), center frequency frequency, and peak gain gain. To change the frequency in the run loop use (setf (mus-frequency f) freq). The radius is the field (mus-formant-radius) which can be set at run time using (setf (mus-formant-radius f) val). For details see "A Constant-gain Digital Resonator Tuned By a Single Coefficient" by Julius O. Smith and James B. Angell in Computer Music Journal Vol. 6 No. 4 (winter 1982). There radius ~= e^(-pi*Bw*T) where Bw is the bandwidth in Hz and T is the sampling period (1/sampling-rate); see also "A note on Constant-Gain Digital Resonators" by Ken Steiglitz, CMJ vol 18 No. 4 pp.8-10 (winter 1994). The bandwidth can be specified in the run loop in Hz by using a macro such as:

  (defmacro compute-radius (bw) ; bw in Hz
    `(exp (/ (* (- pi) ,bw) *srate*)))

The gain argument to make-formant is not used directly; it becomes gain * (1 - radius) or some variation thereof (see make-formant in mus.lisp). When you set the mus-formant-radius in the run-loop, the gain is also adjusted. grapheq.ins uses a bank of formant generators to implement a graphic equalizer, and fade.ins uses it for frequency domain mixing. Here is an instrument for cross-synthesis with a bank of 128 formants:

(definstrument cross-synthesis (beg dur file1 file2 amp &optional (fftsize 128) (r two-pi) (lo 2) (hi nil))
  ;; file1: input sound, file2: gives spectral shape
  ;; r: controls width of formants (1.0 is another good value here)
  ;; lo and hi: which of the formants are active (a sort of filter on top of the filter)
  ;; we use the on-going spectrum of file2 to scale the outputs of the formant array
  (let* ((fil1 (open-input* file1))
	 (fil2 (and fil1 (open-input* file2))))
    (when fil1
      (if (not fil2)
          (close-input fil1)
        (unwind-protect
	  (let* ((start (floor (* beg *srate*)))
	         (end (+ start (floor (* dur *srate*))))
	         (freq-inc (floor fftsize 2))
	         (fdr (make-double-float-array fftsize))
	         (fdi (make-double-float-array fftsize))
	         (diffs (make-double-float-array freq-inc))
	         (spectrum (make-double-float-array freq-inc))
	         (filptr 0)
	         (ctr freq-inc)
	         (radius (- 1.0 (/ r fftsize)))
	         (bin (float (/ *srate* fftsize)))
	         (fs (make-array freq-inc)))
	    (if (null hi) (setf hi freq-inc))
	    (loop for k from lo below hi do 
              (setf (aref fs k) (make-formant radius (* k bin))))
	    (run
	     (loop for i from start below end do
	       (when (= ctr freq-inc)
	         (dotimes (k fftsize)
		   (setf (aref fdr k) (ina filptr fil2))
		   (incf filptr))
	         (clear-array fdi)
	         (decf filptr freq-inc)
	         (fft fdr fdi fftsize 1)
	         (rectangular->polar fdr fdi)
	         (dotimes (k freq-inc) 
                   (setf (aref diffs k) 
                     (/ (- (aref fdr k) (aref spectrum k)) freq-inc)))
	         (setf ctr 0))
	       (incf ctr)
	       (dotimes (k freq-inc) 
                 (incf (aref spectrum k) (aref diffs k)))
	       (let ((outval 0.0)
		     (inval (ina i fil1)))
	         (loop for k from lo below hi do 
                   (incf outval (* (aref spectrum k) (formant (aref fs k) inval))))
	         (outa i (* amp outval))))))
        (progn
	  (close-input fil1)
	  (close-input fil2)))))))

(with-sound () (cross-synthesis 0 1 "oboe" "fyow" .5 256 1.0 3 100))

FILTER, IIR-FILTER, FIR-FILTER

   make-filter &optional-key order xcoeffs ycoeffs
   filter fl inp 
   filter? fl

   make-fir-filter &optional-key order xcoeffs
   fir-filter fl inp 
   fir-filter? fl

   make-iir-filter &optional-key order ycoeffs
   iir-filter fl inp 
   iir-filter? fl

   envelope->coeffs &key order envelope dc

These are the general FIR/IIR filters of arbitrary order. The order argument is one greater than the nominal filter order (it is the size of the arrays).

general filter methods
mus-orderfilter order
mus-xcoeffx (input) coeff
mus-xcoeffsx (input) coeffs
mus-ycoeffy (output) coeff
mus-ycoeffsy (output) coeffs
mus-datacurrent state (input values)
mus-lengthsame as mus-order

  (let ((xout 0.0))
    (setf (aref state 0) input)
    (loop for j from order downto 1 do
      (incf xout (* (aref state j) (aref xcoeffs j)))
      (decf (aref state 0) (* (aref ycoeffs j) (aref state j)))
      (setf (aref state j) (aref state (1- j))))
    (+ xout (* (aref state 0) (aref xcoeffs 0))))

dsp.scm in the Snd package has a number of filter design functions, and various specializations of the filter generators, including such perennial favorites as biquad, butterworth, hilbert transform, and notch filters. As a simple example, say we want to put a spectral envelope on a noise source.

(definstrument filter-noise (beg dur amp &key xcoeffs)
  (let* ((st (floor (* beg *srate*)))
         (noi (make-rand :frequency (* .5 *srate*) :amplitude amp))
         (flA (make-filter :xcoeffs xcoeffs))
         (nd (+ st (floor (* *srate* dur)))))
    (run
      (loop for i from st below nd do
        (outa i (filter flA (rand noi)))))))

(with-sound () 
  (filter-noise 0 1 .2 
    :xcoeffs (envelope->coeffs :order 12 :envelope '(0 0.0 .125 0.5 .2 0.0 .3 1.0 .5 0.0 1.0 0.0))))

envelope->coeffs translates a frequency response envelope into the corresponding FIR filter coefficients. The order of the filter determines how close you get to the envelope.

The Hilbert transform can be implemented with an fir-filter:

(defun make-hilbert (&optional (len 30))
  ;; create the coefficients of the Hilbert transformer of length len
  (let* ((arrlen (1+ (* 2 len)))
	 (arr (make-array arrlen)))
    (do ((i (- len) (1+ i)))
	((= i len))
      (let* ((k (+ i len))
	     (denom (* pi i))
	     (num (- 1.0 (cos (* pi i)))))
	(if (= i 0)
	    (setf (aref arr k) 0.0)
	    (setf (aref arr k) (/ num denom)))))
    (make-fir-filter arrlen (loop for i from 0 below arrlen collect (aref arr i)))))

(defmacro hilbert (f in) `(fir-filter ,f ,in))

DELAY, TAP

  make-delay &optional-key size initial-contents initial-element max-size type
  delay d input &optional (pm 0.0)
  delay? d
  tap d &optional (offset 0)
  delay-tick d input

delay is a delay line. size is in samples. Input fed into a delay line reappears at the output size samples later. initial-element defaults to 0.0. tap returns the current value of the delay generator. Its offset is the distance of the tap from the current delay line sample. If max-size is specified, and larger than size, the delay line can provide fractional delays. It should be large enough to accommodate the largest actual delay requested at run-time. pm determines how far from the normal index we are; that is, it is difference between the nominal delay length (size) and the current actual delay length (size + pm). A positive pm corresponds to a longer delay line. The type argument sets the interpolation type: mus-interp-none, mus-interp-linear, mus-interp-all-pass, mus-interp-lagrange, or mus-interp-hermite. delay-tick just puts a sample in the delay line. 'ticks' the delay forward, and returns its input argument. This is aimed at physical modeling instruments where a tap is doing the actual delay line read.

delay methods
mus-lengthlength of delay (no setf)
mus-ordersame as mus-length
mus-datadelay line itself (no setf)
mus-interp-typeinterpolation choice (no setf)

(prog1
  (array-interp line (- loc pm))
  (setf (aref line loc) input)
  (incf loc)
  (if (<= size loc) (setf loc 0)))


(definstrument echo (beg dur scaler secs file)
  (let ((del (make-delay (round (* secs *srate*))))
	(inf (open-input file))
	(j 0))
    (run
     (loop for i from beg below (+ beg dur) do
       (let ((inval (ina j inf)))
	 (outa i (+ inval (delay del (* scaler (+ (tap del) inval)))))
	 (incf j))))
    (close-input inf)))

;;; (with-sound () (echo 0 60000 .5 1.0 "pistol.snd"))

In the Scheme version of CLM, the Scheme built-in function delay is available as %delay.


COMB, NOTCH

  make-comb &optional-key scaler size initial-contents initial-element max-size
  comb cflt input &optional (pm 0.0)
  comb? cflt

  make-notch &optional-key scaler size initial-contents initial-element max-size
  notch cflt input &optional (pm 0.0)
  notch? cflt

comb is a delay line with a scaler on the feedback term. notch is a delay line with a scaler on the feedforward term. size is the length in samples of the delay line. Other arguments are handled as in delay.

comb and notch methods
mus-lengthlength of delay (no setf)
mus-ordersame as mus-length
mus-datadelay line itself (no setf)
mus-feedbackscaler (comb only)
mus-feedforwardscaler (notch only)
mus-interp-typeinterpolation choice (no setf)

 comb:  y(n) = x(n-size-1) + scaler * y(n-size)
 notch: y(n) = x(n-1) * scaler  + x(n-size-1)

As a rule of thumb, the decay time of the feedback part is 7.0 * size / (1.0 - scaler) samples, so to get a decay of dur seconds, scaler <= 1.0 - 7.0 * size / (dur * *srate*). The peak gain is 1.0 / (1.0 - (abs scaler)). The peaks (or valleys in notch's case) are evenly spaced at *srate* / size. The height (or depth) thereof is determined by scaler -- the closer to 1.0, the more pronounced. See Julius Smith's "An Introduction to Digital Filter Theory" in Strawn "Digital Audio Signal Processing", or Smith's "Music Applications of Digital Waveguides". The following instrument sweeps the comb filter using the pm argument:

(definstrument zc (time dur freq amp length1 length2 feedback)
  (multiple-value-bind
      (beg end) (times->samples time dur)
    (let ((s (make-pulse-train :frequency freq))  ; some raspy input so we can hear the effect easily
          (d0 (make-comb :size length1 :max-size (max length1 length2) :scaler feedback))
          (zenv (make-env :envelope '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
      (run
       (loop for i from beg to end do
	 (outa i (comb d0 (* amp (pulse-train s)) (env zenv))))))))

(with-sound () (zc 0 3 100 .1 20 100 .5) (zc 3.5 3 100 .1 90 100 .95))

ALL-PASS

  make-all-pass &optional-key feedback feedforward size initial-contents initial-element max-size
  all-pass f input &optional (pm 0.0)
  all-pass? f

all-pass or moving average comb is just like comb but with an added feedforward term. If feedback = 0, we get a moving average comb filter. If both scale terms = 0, we get a pure delay line.

all-pass methods
mus-lengthlength of delay (no setf)
mus-ordersame as mus-length
mus-datadelay line itself (no setf)
mus-feedbackfeedback scaler
mus-feedforwardfeedforward scaler
mus-interp-typeinterpolation choice (no setf)

 y(n) = feedforward * x(n-1) + x(n-size-1) + feedback * y(n-size)

all-pass filters are used extensively in reverberation; see jcrev.ins or nrev.ins for examples.


AVERAGE (moving window average)

  make-average &optional-key size initial-contents initial-element
  average f input
  average? f

average or moving window average returns the average of the last 'size' values input to it. This is used both to track rms values and to generate ramps between 0 and 1 in a "gate" effect in new-effects.scm and in rms-envelope in env.scm (Snd). It could also be viewed as a low-pass filter.

average methods
mus-lengthlength of table
mus-ordersame as mus-length
mus-datatable of last 'size' values

result = sum-of-last-n-inputs / n

Here is a Snd-based use of average (new-effects.scm) that implements a "squelch" effect, throwing away any samples below a treshhold, and ramping between portions that are squelched and those that are unchanged (to avoid clicks):

(define (squelch-channel amount snd chn gate-size)  ; gate-size = ramp length and rms window length
  (let ((gate (make-average gate-size))
        (ramp (make-average gate-size :initial-element 1.0)))
    (map-channel (lambda (y) 
                   (* y (average ramp                           ; ramp between 0 and 1
                          (if (< (average gate (* y y)) amount) ; local (r)ms value
                              0.0                               ; below amount so squelch
                            1.0))))
                 0 #f snd chn)))

SRC (sampling-rate conversion)

  make-src &optional-key input (srate 1.0) (width 5)
  src s &optional (sr-change 0.0) input-function
  src? s
src methods
mus-incrementsrate arg to make-src
mus-locationif file input, current location in file (CL clm only)
mus-channelif file input, channel of file (no setf) (CL clm only)

src performs sampling rate conversion by convolving its input with a sinc function. srate is the ratio between the new sampling rate and the old. width is how many neighboring samples to convolve with sinc. If you hear high-frequency artifacts in the conversion, try increasing this number; Perry Cook's default value is 40, and I've seen cases where it needs to be 100. The greater the width, the slower the src generator runs. The sr-change argument is the amount to add to the current srate on a sample by sample basis (if it's 0.0 and the original make-src srate argument was also 0.0, you get a constant output because the generator is not moving at all). Here's an instrument that provides time-varying sampling rate conversion (see also the srctst instrument below):

(definstrument simple-src (start-time duration amp srt srt-env filename)
  (let* ((senv (make-env :envelope srt-env :duration duration))
         (beg (floor (* start-time *srate*)))
         (end (+ beg (floor (* duration *srate*))))
         (src-gen (make-src :input filename :srate srt)))
    (run
      (loop for i from beg below end do
        (outa i (* amp (src src-gen (env senv))))))))

src can provide an all-purpose "Forbidden Planet" sound effect:

(definstrument srcer (start-time duration amp srt fmamp fmfreq filename)
  (let* ((os (make-oscil :frequency fmfreq))
         (beg (floor (* start-time *srate*)))
         (end (+ beg (floor (* duration *srate*))))
         (src-gen (make-src :input filename :srate srt)))
    (run
      (loop for i from beg below end do
        (outa i (* amp (src src-gen (* fmamp (oscil os)))))))))

(with-sound () (srcer 0 2 1.0   1 .3 20 "fyow.snd"))   
(with-sound () (srcer 0 25 10.0   .01 1 10 "fyow.snd"))
(with-sound () (srcer 0 2 1.0   .9 .05 60 "oboe.snd")) 
(with-sound () (srcer 0 2 1.0   1.0 .5 124 "oboe.snd"))
(with-sound () (srcer 0 10 10.0   .01 .2 8 "oboe.snd"))
(with-sound () (srcer 0 2 1.0   1 3 20 "oboe.snd"))    

(definstrument hello-dentist (beg dur file frq amp)
  (let ((rd (make-src :input file))
        (rn (make-rand-interp :frequency frq :amplitude amp))
        (end (+ beg dur)))
    (run
      (loop for i from beg below end do
        (outa i (src rd (rand-interp rn)))))))

The input argument to make-src and the input-function argument to src provide the generator with input as it is needed. The input function is a function of one argument (the desired read direction, if the reader can support it), that is funcall'd each time src needs another sample of input. The input argument to src can also be an input file structure, as returned by open-input, or as here, simply the filename itself. The simple-src instrument above could be written to use an input function instead:

(definstrument src-with-readin (start-time duration amp srt srt-env filename)
  (let* ((senv (make-env :envelope srt-env :duration duration))
         (beg (floor (* start-time *srate*)))
	 (rd (make-readin filename))
         (end (+ beg (floor (* duration *srate*))))
         (src-gen (make-src :srate srt)))
    (run
      (loop for i from beg below end do
        (outa i (* amp (src src-gen (env senv) #'(lambda (dir) (readin rd)))))))))

CONVOLVE

  make-convolve &optional-key input filter fft-size filter-size
   convolve ff &optional input-function
   convolve? ff
   convolve-files file1 file2 &optional (maxamp 1.0) (output-file "tmp.snd")
convolve methods
mus-lengthfft size used in the convolution

convolve convolves its input with the impulse response filter. The filter argument can be an array, the result of open-input, or a filename as a string. When not file based, input and input-function are functions of one argument (currently ignored) that are funcall'd whenever convolve needs input.

(definstrument convins (beg dur filter file &optional (size 128))
  (let* ((start (floor (* beg *srate*)))
         (end (+ start (floor (* dur *srate*))))
         (ff (make-convolve :input file :fft-size size :filter filter)))
    (run
      (loop for i from start below end do (outa i (convolve ff))))))

convolve-files handles a very common special case: you often want to convolve two files, normalizing the result to some maxamp. The convolve generator does not know in advance what its maxamp will be, and when the two files are more or less the same size, there's no real computational savings to using overlap-add (i.e. the generator), so a one-time giant FFT saved as a temporary sound file is much handier.


GRANULATE (granular synthesis)

  make-granulate &optional-key   
        input
        (expansion 1.0)   ;how much to lengthen or compress the file
        (length .15)      ;length of file slices that are overlapped
        (scaler .6)       ;amplitude scaler on slices (to avoid overflows)
        (hop .05)         ;speed at which slices are repeated in output
        (ramp .4)         ;amount of slice-time spent ramping up/down
        (jitter 1.0)      ;affects spacing of successive grains
        max-size          ;internal buffer size
        edit              ;grain editing function (Scheme/Ruby, not CL)
  granulate e &optional input-function edit-function
  granulate? e
granulate methods
mus-frequencytime (seconds) between output grains (hop)
mus-ramplength (samples) of grain envelope ramp segment
mus-hoptime (samples) between output grains (hop)
mus-scalergrain amp (scaler)
mus-incrementexpansion
mus-lengthgrain length (samples)
mus-datagrain samples (a vct)

result = overlap add many tiny slices from input

granulate "granulates" its input (normally a sound file). It is the poor man's way to change the speed at which things happen in a recorded sound without changing the pitches. It works by slicing the input file into short pieces, then overlapping these slices to lengthen (or shorten) the result; this process is sometimes known as granular synthesis, and is similar to the freeze function. The duration of each slice is length -- the longer the slice, the more like reverb the effect. The portion of the length (on a scale from 0 to 1.0) spent on each ramp (up or down) is ramp. This can control the smoothness of the result of the overlaps. The more-or-less average time between successive segments is hop. The accuracy at which we handle this hopping is set by the float jitter -- if jitter is very small, you may get an annoying tremolo. The overall amplitude scaler on each segment is scaler -- this is used to try to to avoid overflows as we add all these zillions of segments together. expansion determines the input hop in relation to the output hop; an expansion-amount of 2.0 should more or less double the length of the original, whereas an expansion-amount of 1.0 should return something close to the original speed. input and input-function are the same as in src and convolve.

(definstrument granulate-sound (file beg &optional dur (orig-beg 0.0) (exp-amt 1.0))
  (let* ((f-srate (sound-srate file))
	 (f-start (round (* f-srate orig-beg)))
         (f (open-input file :start f-start))
	 (st (floor (* beg *srate*)))
	 (new-dur (or dur (- (sound-duration file) orig-beg)))
	 (exA (make-granulate :input f :expansion exp-amt))
	 (nd (+ st (floor (* *srate* new-dur)))))
    (run
     (loop for i from st below nd do
       (outa i (granulate exA))))
    (close-input f)))

See expsrc.ins. Here's an instrument that uses the input-function argument to granulate. It cause the granulation to run backwards through the file:

(definstrument grev (beg dur exp-amt file file-beg)
  (let* ((exA (make-granulate :expansion exp-amt))
	 (fil (open-input* file file-beg))
	 (ctr file-beg))
    (run
     (loop for i from beg to (+ beg dur) do
       (outa i (granulate exA
			  #'(lambda (dir)
			      (let ((inval (ina ctr fil)))
				(if (> ctr 0) (setf ctr (1- ctr)))
				inval))))))
    (close-input fil)))

(with-sound () (grev 0 100000 2.0 "pistol.snd" 40000))

The edit argument can be a function of one argument, the current granulate generator. It is called just before a grain is added into the output buffer. The current grain is accessible via mus-data. The edit function, if any, should return the length in samples of the grain, or 0. In the following code, we use the edit function to reverse every other grain:

(let ((forward #t))
  (let ((grn (make-granulate :expansion 2.0
			     :edit (lambda (g)
				     (let ((grain (mus-data g))  ; current grain
					   (len (mus-length g))) ; current grain length
				       (if forward ; no change to data
				           (set! forward #f)
					   (begin
					     (set! forward #t)
					     (vct-reverse! grain len)))
				       len))))
	(rd (make-sample-reader 0)))
    (map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))))

PHASE-VOCODER

  make-phase-vocoder &optional-key input (fft-size 512) (overlap 4) interp (pitch 1.0) analyze edit synthesize
  phase-vocoder pv input-function analyze-function edit-function synthesize-function
  phase-vocoder? pv
phase-vocoder methods
mus-frequencypitch shift
mus-lengthfft-size ("N")
mus-incrementinterp
mus-hopfft-size / overlap ("D")

phase-vocoder provides a generator to perform phase-vocoder analysis and resynthesis. The process is split into three pieces, the analysis stage, editing of the amplitudes and phases, then the resynthesis. Each stage has a default that is invoked if the analyze, edit, or synthesize arguments are omitted from make-phase-vocoder or the phase-vocoder generator. The edit and synthesize arguments are functions of one argument, the phase-vocoder generator. The analyze argument is a function of two arguments, the generator and the input function. The default is to read the current input, take an fft, get the new amplitudes and phases (as the edit function default), then resynthesize using sine-bank (the synthesize function default); so, the default case simply returns a resynthesis of the original input. interp sets the time between ffts (for time stretching etc).

(definstrument simple-pvoc (beg dur amp size file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (sr (make-phase-vocoder file :fft-size size)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (phase-vocoder sr)))))))

See ug3.ins for instruments that use the various function arguments. In Snd, clm23.scm has a variety of instruments calling the phase-vocoder generator, including pvoc-e that specifies all of the functions with their default values (that is, it explicitly passes in functions that do what the phase-vocoder would have done without any function arguments).


SINE-SUMMATION (sum of sines with different amplitudes)

  make-sine-summation &optional-key (frequency 440.0) (initial-phase 0.0) (n 1) (a .5) (ratio 1.0)
  sine-summation s &optional (fm 0.0)
  sine-summation? s
sine-summation methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-scaler"a" parameter; sideband scaler
mus-cosines"n" parameter
mus-increment"ratio" parameter

(/ (- (sin phase) (* a (sin (- phase (* ratio phase))))
      (* (expt a (1+ n)) (- (sin (+ phase (* (+ N 1) (* ratio phase))))
			    (* a (sin (+ phase (* N (* ratio phase))))))))
   (- (+ 1 (* a a)) (* 2 a (cos (* ratio phase)))))

sine-summation provides a kind of additive synthesis. See J.A.Moorer, "Signal Processing Aspects of Computer Music" and "The Synthesis of Complex Audio Spectra by means of Discrete Summation Formulae" (Stan-M-5). n is the number of sidebands, a is the amplitude ratio between successive sidebands, ratio is the ratio between the carrier frequency and the spacing between successive sidebands. The basic idea is very similar to that used in the sum-of-cosines generator. (see "Special Functions", Andrews, Askey, Roy chapter 5 for lots of interesting stuff, including the cosine-summation formula used in dsp.scm). The output amplitude of this generator is hard to predict; see Moorer's paper for some normalization functions (and it is numerically a disaster -- don't set a to 1.0!).

(definstrument ss (beg dur freq amp &optional (N 1) (a .5) (B-ratio 1.0))
  (let* ((st (floor (* *srate* beg)))
         (nd (+ st (floor (* *srate* dur))))
         (sgen (make-sine-summation :n N :a a :ratio B-ratio :frequency freq)))
    (run
     (loop for i from st below nd do
       (outa i (* amp (sine-summation sgen)))))))

ASYMMETRIC-FM

  make-asymmetric-fm &optional-key (frequency 440.0) (initial-phase 0.0) (r 1.0) (ratio 1.0)
  asymmetric-fm af index &optional (fm 0.0)
  asymmetric-fm? af
asymmetric-fm methods
mus-frequencyfrequency in Hz
mus-phasephase in radians
mus-scaler"r" parameter; sideband scaler
mus-increment"ratio" parameter

(* (exp (* index (* 0.5 (- r (/ 1.0 r)))
	   (cos (* ratio phase))))
   (sin (+ phase (* index (* 0.5 (+ r (/ 1.0 r)))
		    (sin (* ratio phase))))))

asymmetric-fm provides a way around the symmetric spectra normally produced by FM. See Palamin and Palamin, "A Method of Generating and Controlling Asymmetrical Spectra" JAES vol 36, no 9, Sept 88, p671-685: this is another extension of the sine-summation and sum-of-cosines approach. The generator's output amplitude is not always easy to predict. r is the ratio between successive sideband amplitudes, r > 1.0 pushes energy above the carrier, r < 1.0 pushes it below. (r = 1.0 gives normal FM). ratio is the ratio between the carrier and modulator (i.e. sideband spacing). It's somewhat inconsistent that asymmetric-fm takes index (the fm-index) as its second argument, but otherwise it would be tricky to get time-varying indices.

(definstrument asy (beg dur freq amp index &optional (r 1.0) (ratio 1.0))
  (let* ((st (floor (* beg *srate*)))
         (nd (+ st (floor (* dur *srate*))))
         (asyf (make-asymmetric-fm :r r :ratio ratio :frequency freq)))
    (run
     (loop for i from st below nd do
       (outa i (* amp (asymmetric-fm asyf index 0.0)))))))

For the other kind of asymmetric-fm, and for asymmetric spectra via "single sideband FM", see dsp.scm.

Other Generators

There are a number of other generators in the CLM distribution that aren't loaded by default. Among these are:

  rms         ;trace the rms of signal
  gain        ;modify signal to match rms power
  balance     ;combination of rms and gain

Various special functions and their relatives are defined in bessel.lisp. green.cl defines several special purpose noise generators. butterworth.cl has several Butterworth filters.


Generic Functions

The generators have internal fields that are sometimes of interest at run-time. To get or set these fields, use these functions (they are described in conjunction with the associated generators):

mus-channelchannel being read/written
mus-channels channels open
mus-cosines sinusoids in output
mus-data array of data
mus-describe description of current state
mus-feedback feedback coefficient
mus-feedforwardfeedforward coefficient
mus-file-name file being read/written
mus-formant-radiuswidth of formant
mus-frequency frequency (Hz)
mus-hop hop size for block processing
mus-increment various increments
mus-interp-typeinterpolation type (mus-interp-linear, etc)
mus-length data array length
mus-location sample location for reads/writes
mus-name generator name ("oscil")
mus-offset envelope offset
mus-order filter order
mus-phase phase (radians)
mus-ramp granulate grain envelope ramp setting
mus-run run any generator
mus-scaler scaler, normally on an amplitude
mus-width width of interpolation tables, etc
mus-xcoeff x (input) coefficient
mus-xcoeffs array of x (input) coefficients
mus-ycoeff y (output, feedback) coefficient
mus-ycoeffs array of y (feedback) coefficients

Many of these are settable: (setf (mus-frequency osc1) 440.0) sets osc1's current frequency to (hz->radians 440.0).

(definstrument backandforth (onset duration file src-ratio)
  ;; read file forwards and backwards until dur is used up
  ;; a slightly improved version is 'scratch' in ug1.ins
  (let* ((last-sample (sound-frames file))
         (beg (floor (* *srate* onset)))
         (end (+ beg (floor (* *srate* duration))))
         (s (make-src :input file :srate src-ratio))
         (cs 0))
    (run
     (loop for i from beg below end do
       (declare (type :integer cs last-sample)
		(type :float src-ratio))
       (setf cs (mus-location s))
       (if (>= cs last-sample) (setf (mus-increment s) (- src-ratio)))
       (if (<= cs 0) (setf (mus-increment s) src-ratio))
       (outa i (src s))))))

;;; (with-sound () (backandforth 0 10 "pistol.snd" .5))

mus-location is useful in cases where you're doing some complicated processing on a file, and want to use envelopes, but for whatever reason can't easily say how long the output will be. The envelopes can be defined in terms of the input file's length, then applied by watching mus-location:

(definstrument srctst (file beg srcenv in-file-start)
  (let ((f (open-input file :start (floor (* in-file-start (sound-srate file))))))
    (unwind-protect
        (let* ((st (floor (* beg *srate*)))
               (dur (sound-duration file))
               (samples (1- (sound-frames file)))
               (srcA (make-src :input f :srate 0.0))
               (env-val 0.0)
               (pass 0)
               (senv (make-env :envelope srcenv :duration dur)))
	  (setf env-val (env senv))           ;get initial src value
          (run
           (loop for i from st do
             (let ((pos (mus-location srcA)))
               (when (/= pass pos)            ;position in input has changed
                 (let ((passes (- pos pass))) ;move env forward by same amount
                   (setf pass pos)
                   (dotimes (k passes) (setf env-val (env senv)))))
               (outa i (src srcA env-val))
               (if (>= pass samples) (loop-finish))))))
      (close-input f))))

This instrument puts an envelope on the sampling rate, and defines the envelope to apply over the entire input file:

  (with-sound () (srctst  "oboe.snd" 0 '(0 1 1 .5 2 1) .1))

Frames, Mixers, Sound IO


Frames and Mixers

There are two special data types in CLM: frames and mixers. A frame is an array that represents a multi-channel sample (that is, in a stereo file, at time 0.0, there are two samples, one for each channel, and the frame that represents it has 2 samples). A mixer is a array of arrays that represents a set of input to output scalers, as if it were the current state of a mixing console's volume controls. A frame (a multi-channel input) can be mixed into a new frame (a multi-channel output) by passing it through a mixer (a matrix, the operation being a (left) matrix multiply). These are combined with the notion of a sample (one datum of sampled music), and input/output ports (files, audio ports, etc) to handle all the underlying data IO.

  make-empty-frame chans             ;create frame of 0's
  make-frame chans &rest args        ;create frame and load it with args
  frame? obj                         ;is obj a frame
  frame+ f1 f2 &optional outf        ;add f1 and f2 element-wise, return new frame (or outf)
  frame* f1 f2 &optional outf        ;multiply f1 and f2 element-size, return new frame (or outf)
  frame-ref f1 chan                  ;return f1[chan]
  frame-set! f1 chan val             ;f1[chan] = val (also setf with frame-ref)

  make-empty-mixer chans             ;create a mixer of 0's
  make-identity-mixer chans          ;create a mixer of 1's on the diagonal
  make-scalar-mixer chans scl        ;create a mixer with scl on the diagonal
  make-mixer chans &rest args        ;create a mixer and load it with args
  mixer? obj                         ;is obj a mixer
  mixer* m1 m2 &optional outm        ;matrix multiply of m1 and m2, return new mixer (or outm)
  mixer+ m1 m2 &optional outm        ;matrix add of m1 and m2, return new mixer (or outm)
  mixer-scale m1 scl &optional outm  ;scale matrix m1 by scl, return new mixer (or outm)
  mixer-ref m1 in out                ;m1[in,out] (use setf to change)
  mixer-set! m1 in out val           ;m1[in,out] = val (also setf with mixer-ref)

  frame->frame mixer frame &optional outf
                                     ;pass frame through mixer, return new frame (or outf)
  frame->list frame                  ;return list of frame's contents
  sample->frame frame-or-mixer sample &optional outf
                                     ;pass sample through frame-or-mixer, return new frame (or outf)
  frame->sample frame-or-mixer frame ;pass frame through frame-or-mixer, return sample
frame and mixer methods
mus-channelsnumber of channels accommodated
mus-lengthsame as mus-channels
mus-datathe matrix data (float array)

In Ruby, frame* is frame_multiply, frame+ is frame_add, and mixer* is mixer_multiply.

fullmix.ins uses these functions to provide a mixer able to handle any number of channels of data in and out with optional scalers and envelopes on any in->out path. The heart of the instrument is:

       (frame->file *output* i 
         (frame->frame mx 
           (file->frame file inloc inframe) outframe))

Here the input file is read by file->frame producing a frame of data. That is then passed through the mixer frame->frame, and the resultant frame is written to the with-sound output file *output* by frame->file. Within run, the output frames of the various frame producing functions must be provided (I'm trying to avoid run-time memory management). In matrix terminology, a mixer is a square matrix, a frame is a column (or row) vector, mixer* is a matrix multiply, and so on.

Sound file IO is supported by a variety of low-level functions:

  mus-input? obj                ;t if obj performs sound input
  mus-output? obj               ;t if obj performs sound output
  file->sample? obj             ;t if obj reads a sound file returning a sample
  sample->file? obj             ;t if obj writes a sample to a sound file
  frame->file? obj              ;t if obj writes a frame to a sound file
  file->frame? obj              ;t if obj reads a sound file returning a frame
   
  make-file->sample name        ;return gen that reads samples from sound file name
  make-sample->file name chans &optional format type comment
                                ;return gen that writes samples to sound file name
  make-file->frame name         ;return gen that reads frames from sound file name
  make-frame->file name chans &optional format type comment
                                ;return gen that writes frames to sound file name

  file->sample obj samp &optional chan    ;return sample at samp in channel chan
  sample->file obj samp chan val;write (add) sample val at samp in channel chan
  file->frame obj samp &optional outf     ;return frame at samp
  frame->file obj samp val      ;write (add) frame val at samp

  file->array filename channel start-sample samples array
  array->file file data len srate channels
  ;; these two read and write entire files to or from float arrays

  continue-frame->file file      ;reopen file for more output
  continue-sample->file file     ;reopen file for more output

  mus-close obj                  ;close the output file associated with obj

In the Scheme version of CLM, the Guile built-in (but unused) function frame? is available as %frame?.

OUT-ANY (sound file output)

  out-any loc data &optional (channel 0) (o-stream *output*)

out-any adds data into o-stream at sample position loc. O-stream defaults to the current output file (it is an frame-file instance, not a file name). The reverb stream, if any, is named *reverb*; the direct output is *output*. You can output anywhere at any time, but because of the way data is buffered internally, your instrument will run much faster if it does sequential output. Locsig is another output function.

Many of the CLM examples and instruments use outa and outb. These are macros equivalent to (out-any loc data 0 *output*) etc.


INA, INB, IN-ANY (sound file input)

  in-any loc channel i-stream

in-any returns the sample at position loc in i-stream as a float. The data is normally between -1.0 and 1.0. See the digital zipper instrument zipper.ins.

Many of the CLM examples and instruments use ina and inb. These are macros equivalent to (in-any loc 0 stream) etc.

(definstrument simple-ina (beg dur amp file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file)))          ; actually make-file->sample
    (run
     (loop for i from start to end do
       (outa i (* amp (in-any i 0 fil))))) ; actually file->sample
    (close-input fil)))

It's probably better to use readin for file input.


READIN (sound file input)

 make-readin &optional-key file (channel 0) start (direction 1)
 readin rd
 readin? rd
readin methods
mus-channelchannel arg to make-readin (no setf)
mus-locationcurrent location in file
mus-incrementsample increment (direction arg to make-readin)
mus-file-namename of file associated with gen

readin returns successive samples (as floats) from file. file should be either an IO instance, as returned by open-input, or a filename. start is the frame at which to start reading file. Here is an instrument that applies an envelope to a sound file using readin and env (see also the fullmix instrument in fullmix.ins):

(definstrument env-sound (file beg &optional (amp 1.0) (amp-env '(0 1 100 1)))
  (let* ((st (floor (* beg *srate*)))
         (dur (sound-duration file))
         (rev-amount .01)
         (rdA (make-readin file))
         (ampf (make-env amp-env amp dur))
         (nd (+ st (floor (* *srate* dur)))))
    (run
      (loop for i from st below nd do
        (let ((outval (* (env ampf) (readin rdA))))
  	  (outa i outval)
	  (if *reverb* (outa i (* outval rev-amount) *reverb*)))))))

LOCSIG (sound placement)

 make-locsig &optional-key (degree 0.0) (distance 1.0) reverb channels type
 locsig loc i in-sig
 locsig? loc
 locsig-ref loc chan
 locsig-set! loc chan val
 locsig-reverb-ref loc chan
 locsig-reverb-set! loc chan val
 move-locsig loc degree distance
 locsig-type ()
locsig methods
mus-dataoutput scalers (a vct)
mus-xcoeffreverb scaler
mus-xcoeffsreverb scalers (a vct)
mus-channelsoutput channels
mus-lengthoutput channels

locsig normally takes the place of out-any in an instrument. It tries to place a signal between channels 0 and 1 (or 4 channels placed in a circle) in an extremely dumb manner: it just scales the respective amplitudes ("that old trick never works"). reverb determines how much of the direct signal gets sent to the reverberator. distance tries to imitate a distance cue by fooling with the relative amounts of direct and reverberated signal (independent of reverb). distance should be greater than or equal to 1.0. type (returned by the function locsig-type) can be mus-interp-linear (the default) or mus-interp-sinusoidal. This parameter can be set globally via *clm-locsig-type*. The mus-interp-sinusoidal case uses sin and cos to set the respective channel amplitudes (this is reported to help with the "hole-in-the-middle" problem).

Locsig is a kludge, but then so is any pretence of placement when you're piping the signal out a loudspeaker. It is my current belief that locsig does the right thing for all the wrong reasons; a good concert hall provides auditory spaciousness by interfering with the ear's attempt to localize a sound. A diffuse sound source is the ideal! By sending an arbitrary mix of signal and reverberation to various speakers, locsig gives you a very diffuse source; it does the opposite of what it claims to do, and by some perversity of Mother Nature, that is what you want. (See "Binaural Phenomena" by J Blauert).

Locsig can send output to any number of channels. If channels > 2, the speakers are assumed to be evenly spaced in a circle. You can use locsig-set! and locsig-ref to override the placement decisions. To have full output to both channels,

(setf (locsig-ref loc 0) 1.0) ;or (locsig-set! loc 0 1.0)
(setf (locsig-ref loc 1) 1.0)

These locations can be set via envelopes and so on within the run loop to pan between speakers (but see move-locsig below):

(definstrument space (file onset duration &key (distance-env '(0 1 100 10)) (amplitude-env '(0 1 100 1))
		     (degree-env '(0 45 50 0 100 90)) (reverb-amount .05))
  (let* ((beg (floor (* onset *srate*)))
	 (end (+ beg (floor (* *srate* duration))))
         (loc (make-locsig :degree 0 :distance 1 :reverb reverb-amount))
         (rdA (make-readin :file file))
         (dist-env (make-env distance-env :duration duration))
         (amp-env (make-env amplitude-env :duration duration))
         (deg-env (make-env (scale-envelope degree-env (/ 1.0 90.0)) :duration duration))
         (dist-scaler 0.0))
    (run
      (loop for i from beg below end do
        (let ((rdval (* (readin rdA) (env amp-env)))
	      (degval (env deg-env))
	      (distval (env dist-env)))
          (setf dist-scaler (/ 1.0 distval))
          (setf (locsig-ref loc 0) (* (- 1.0 degval) dist-scaler))
          (if (> (mus-channels *output*) 1) (setf (locsig-ref loc 1) (* degval dist-scaler)))
          (when *reverb* (setf (locsig-reverb-ref loc 0) (* reverb-amount (sqrt dist-scaler))))
          (locsig loc i rdval))))))

For a moving sound source, see either move-locsig, or Fernando Lopez Lezcano's dlocsig. Here is an example of move-locsig:

(definstrument move-osc (start dur freq amp &key (degree 0) (dist 1.0) (reverb 0))
  (let* ((beg (floor (* start *srate*)))
         (end (+ beg (floor (* dur *srate*))) )
         (car (make-oscil :frequency freq))
         (loc (make-locsig :degree degree :distance dist :channels 2))
	 (pan-env (make-env '(0 0 1 90) :duration dur)))
    (run
     (loop for i from beg to end do
       (let ((ut (* amp (oscil car))))
	 (move-locsig loc (env pan-env) dist)
         (locsig loc i ut))))))

Useful functions

There are several commonly-used functions, some of which can occur in the run macro. These include a few that look for all the world like generators.

  hz->radians freq               convert freq to radians per sample
  radians->hz rads               convert rads to Hz
  db->linear dB                  convert dB to linear value
  linear->db val                 convert val to dB
  times->samples start duration  convert start and duration from seconds to samples (beg+dur in latter case)
  samples->seconds samps         convert samps to seconds
  seconds->samples secs          convert secs to samples
  degrees->radians degs          convert degs to radians
  radians->degrees rads          convert rads to degrees
  clear-array arr                set all values in arr to 0.0
  sound-samples filename         samples of sound according to header (can be incorrect)
  sound-frames filename          samples per channel
  sound-datum-size filename      bytes per sample
  sound-data-location filename   location of first sample (bytes)
  sound-chans filename           number of channels (samples are interleaved)
  sound-srate filename           sampling rate
  sound-header-type filename     header type (aiff etc)
  sound-data-format filename     data format (alaw etc)
  sound-length filename          true file length (for error checks)
  sound-duration filename        file length in seconds
  mus-set-raw-header-defaults srate chans data-format
  sound-maxamp name vals         get max amp vals and times of file name
  sound-loop-info name vals      get loop info of file name in vals (make-integer-array 6)
  sound-set-loop-info name vals  set loop info of file name to vals
  sound-format-name format       format name as string
  sound-type-name type           type name as string
hz->radians converts its argument to radians/sample (for any situation where a frequency is used as an amplitude, glissando or FM). It can be used within run. hz->radians is equivalent to
  Freq-in-hz * 2 * pi / *srate*.  

Freq-in-hz * 2 * pi gives us the number of radians traversed per second; we then divide by the number of samples per second to get the radians per sample; in dimensional terms: (radians/sec) / (sample/sec) = radians/sample. We need this conversion whenever a frequency-related value is actually being accessed on every sample, as an increment of a phase variable. (We are also assuming our wave table size is 2 * pi). This conversion value was named "mag" in Mus10 and "in-hz" in CLM-1. The inverse is radians->hz.

These names are different from the underlying sndlib names mostly due to confusion and inattention. Nearly all the sndlib constants and functions are imported into clm under names that are the same as the C name except "_" is replaced by "-". So mus-sound-duration exists, and is the same as sound-duration mentioned above. See sndlib.html for some info.

POLYNOMIAL

   polynomial coeffs x

polynomial evaluates a polynomial, defined by giving its coefficients, at a particular point (x). coeffs is an array of coefficients where coeffs[0] is the constant term, and so on. For waveshaping, use the function partials->polynomial. Abramowitz and Stegun, "A Handbook of Mathematical Functions" is a treasure-trove of interesting polynomials. See also the brighten instrument.


ARRAY-INTERP, DOT-PRODUCT, SINE-BANK

  array-interp fn x &optional size
  dot-product in1 in2
  sine-bank amps phases
  edot-product freq data [Scheme/C versions]

These functions underlie some of the generators, and can be called within run. See mus.lisp for details. Array-interp can be used for companding and similar functions -- load the array (call it "compander" below) with the positive half of the companding function, then:

  (let ((in-val (readin rd))            ; in-coming signal
        (func-len (length compander)))  ; size of array
    (* (signum in-val) 
       (array-interp compander (abs (* in-val (1- func-len))) func-len)))

sine-bank simply loops through its arrays of amps and phases, summing (* amp (sin phase)) -- it is mostly a convenience function for additive synthesis. dot-product is also known as scalar product, and in orthogonal coordinate systems is the same as the usual inner product (as opposed to various unusual ones). edot-product returns a dot product, the sum of e^(freq*i) with data[i], i going from 0 to (1 less than) data's size. freq and data can be complex, as can the return value. (This is intended for DFT applications).


CONTRAST-ENHANCEMENT

   contrast-enhancement in-samp &optional (fm-index 1.0)

contrast-enhancement phase-modulates a sound file. It's like audio MSG. The actual algorithm is sin(in-samp*pi/2 + (fm-index*sin(in-samp*2*pi))). The result is to brighten the sound, helping it cut through a huge mix.

Waveshaping can provide a similar effect:

(definstrument brighten (start duration file file-maxamp partials)
  (multiple-value-bind (beg end) (times->samples start duration)
    (let ((fil (open-input* file)))
      (when fil
        (unwind-protect
	  (let ((coeffs (partials->polynomial (normalize-partials partials)))
		(rd (make-readin fil)))
	    (run (loop for i from beg below end do
		   (outa i (* file-maxamp (polynomial coeffs (/ (readin rd) file-maxamp)))))))
	  (close-input fil))))))

(with-sound () (brighten 0 3 "oboe" .15 '(1 1 3 .5 7 .1)))

In this case, it is important to scale the file input to the waveshaper to go from -1.0 to 1.0 to get the full effect of the Chebyshev polynomials. Unfortunately, if you don't add an overall amplitude envelope to bring the output to 0, you'll get clicks if you include even numbered partials. These partials create a non-zero constant term in the polynomial, so when the sound decays to 0, the polynomial output decays to some (possibly large) non-zero value. In the example above, I've used only odd partials for this reason. Another thing to note here is that the process is not linear; that is the sinusoids that make up the input are not independently expanded into the output spectrum, but instead you get sum and difference tones, (not to mention phase cancellations) much as in FM with a complex wave. One way to play with this is to use a simple instrument such as:

(define (waver spectr driver)
  (let ((v0 (make-vct 8192))
	(poly (partials->polynomial spectr)))
    (mix-vct (vct-map! v0 (lambda () (polynomial poly (driver)))) 0 0 0 #f)))

(waver '(1 .6 2 .4) 
       (let ((g0 (make-oscil 100)) 
             (g1 (make-oscil 1000)))
         (lambda ()
	   (* .5 (+ (g0) (g1))))))

RING-MODULATE, AMPLITUDE-MODULATE

  ring-modulate in1 in2
  amplitude-modulate am-carrier input1 input2
ring-modulate returns (* in1 in2). amplitude-modulate returns (* input1 (+ am-carrier input2))

ring-modulation is sometimes called "double-sideband-suppressed-carrier" modulation -- that is, amplitude modulation with the carrier subtracted out (set to 0.0 above). The nomenclature here is a bit confusing -- I can't remember now why I used these names; think of "carrier" as "carrier amplitude" and "input1" as "carrier". Normal amplitude modulation using this function would be:

  (defvar carrier (make-oscil carrier-freq (* .5 pi)))
  ...
  (amplitude-modulate 1.0 (oscil carrier) signal)

Since neither needs any state information, there are no associated make functions.

Both of these take advantage of the "Modulation Theorem"; since multiplying a signal by a phasor (e ^ (j w t)) translates its spectrum by w / two-pi Hz, multiplying by a sinusoid splits its spectrum into two equal parts translated up and down by w/two-pi Hz. The simplest case is:

   cos f1 * cos f2 = (cos (f1 + f2) + cos (f1 - f2)) / 2.

We can use these to shift all the components of a signal by the same amount up or down ("single-sideband modulation"). In Snd it would be:

(define* (ssb-am freq #:optional (order 40)) ; higher order = better cancellation
  (let* ((carrier-freq (abs freq))
	 (cos-carrier (make-oscil carrier-freq (* .5 pi)))
	 (sin-carrier (make-oscil carrier-freq))
	 (dly (make-delay order))
	 (hlb (make-hilbert-transform order))) ; in dsp.scm
    (map-channel (lambda (y)
		   (let ((ccos (oscil cos-carrier))
			 (csin (oscil sin-carrier))
			 (yh (hilbert-transform hlb y))
			 (yd (delay dly y)))
		     (if (> freq 0.0)
			 (- (* ccos yd) ; shift up
			    (* csin yh))
			 (+ (* ccos yd) ; shift down
			    (* csin yh))))))))

But this is exactly what the ssb-am generator provides.


FFT (Fourier Transform)

  fft rdat idat fftsize &optional sign
  make-fft-window &optional-key type size (beta 2.5)
  multiply-arrays rdat window
  rectangular->polar rdat idat
  polar->rectangular rdat idat
  spectrum rdat idat window norm-type
  convolution rdat idat size

These provide run-time access to the standard fft routines and their habitual companions. make-fft-window can return many of the standard windows including:

  rectangular-window   ;no change in data
  bartlett-window      ;triangle
  parzen-window        ;raised triangle
  welch-window         ;parzen squared
  hann-window          ;cosine (sometimes known as "hanning-window" -- a sort of in-joke)
  hamming-window       ;raised cosine
  blackman2-window     ;Blackman-Harris windows of various orders
  blackman3-window
  blackman4-window
  exponential-window
  kaiser-window        ;beta argument used here

The magnitude of the spectrum is returned by rectangular->polar. The data can be windowed with multiply-arrays. spectrum calls the fft, translates to polar coordinates, then returns the results (in the lower half of "rdat") in dB (norm-type = 0), or linear normalized to 1.0 (norm-type = 1), or linear unnormalized (norm-type not 0 or 1).

The following instrument implements fft overlap-add, but instead of scaling the various spectral components to filter a sound, it reverses a portion of the spectrum, a distortion that can be effective with speech sounds.

(definstrument inside-out (beg dur file amp lo hi &optional (fftsize 1024))
  ;; fft overlap-add (and buffer), but the fft bins between lo and hi are reversed
  (let ((fil (open-input* file)))
    (when fil
      (unwind-protect
        (let* ((start (floor (* beg *srate*)))
               (end (+ start (floor (* dur *srate*))))
               (fdr (make-double-float-array fftsize))
               (fdi (make-double-float-array fftsize))
               (wtb (make-double-float-array fftsize))
               (filptr 0)
               (fft2 (floor fftsize 2))
               (fft4 (floor fftsize 4))
               (ctr fft2)
               (fftn (/ 1.0 fftsize))
               (first-time 1)
               (mid (* .5 (+ hi lo))))
	  (when (zerop lo) (setf lo 1))
          (run
           (loop for i from start below end do
             (when (= ctr fft2)
               (clear-array fdr)
               (clear-array fdi)
               (dotimes (k fft2)
                 (setf (aref fdr (+ k fft4)) (* (ina filptr fil) fftn))
                 (incf filptr))
               (fft fdr fdi fftsize 1)
               (let ((j1 hi) ;now reverse bins between lo and hi
                     (k0 (- fftsize lo))
                     (k1 (- fftsize hi)))
                 (loop for j0 from lo to mid do
                   (let ((tmprj (aref fdr j0))
                         (tmprk (aref fdr k0))
                         (tmpij (aref fdi j0))
                         (tmpik (aref fdi k0)))
                     (setf (aref fdr j0) (aref fdr j1))
                     (setf (aref fdr j1) tmprj)
                     (setf (aref fdr k0) (aref fdr k1))
                     (setf (aref fdr k1) tmprk)
                     (setf (aref fdi j0) (aref fdi j1))
                     (setf (aref fdi j1) tmpij)
                     (setf (aref fdi k0) (aref fdi k1))
                     (setf (aref fdi k1) tmpik)
                     (incf k1)
                     (decf k0)
                     (decf j1))))
               (fft fdr fdi fftsize -1)
               (dotimes (k fft2)
                 (setf (aref wtb k) (aref wtb (+ k fft2)))
                 (setf (aref wtb (+ k fft2)) 0.0))
               (if (= first-time 1)
                   (progn
                     (dotimes (k fftsize) (setf (aref wtb k) (aref fdr k)))
                     (setf first-time 0)
		     (setf ctr fft4))
                 (progn
                   (dotimes (k fft2) (incf (aref wtb k) (aref fdr k)))
                   (dotimes (k fft2) (setf (aref wtb (+ k fft2)) (aref fdr (+ k fft2))))
		   (setf ctr 0))))
             (outa i (* amp (aref wtb ctr)))
             (incf ctr))))
        (close-input fil)))))

(with-sound () (inside-out 0 1.0 "fyow" 1.0 3 8))

There are many other examples of run-time FFTs: the cross-synthesis instrument above, san.ins, and anoi.ins.


def-clm-struct

def-clm-struct is syntactically like def-struct, but sets up the struct field names for the run macro. There are several examples in prc-toolkit95.lisp, and other instruments. def-clm-struct is "in flux" -- I may flush it.


Definstrument

definstrument defines an instrument in CLM. Its syntax is almost the same as defun; it has a few bizarre options (for miserable historical reasons), but they should be resolutely ignored. There are a bazillion example instruments included in CLM and Snd. The following instruments live in *.ins files in the CLM directory (see also the file ins):

complete-addadd.insadditive synthesis
addfltsaddflt.insfilters
add-soundaddsnd.insmix in a sound file
anoianoi.insnoise reduction
autocautoc.insautocorrelation-based pitch estimation (Bret Battey)
baddbadd.insfancier additive synthesis (Doug Fulton)
fm-bellbell.insfm bell sounds (Michael McNabb)
bessel stuffbessel.lispspecial functions and related instruments
bigbirdbigbird.inswaveshaping (bird.clm and bird.ins)
cantercanter.insfm (bag.clm -- bagpipes) (Peter Commons)
celloncellon.insfeedback fm (Stanislaw Krupowicz)
cnvrevcnv.insconvolution (aimed at reverb)
moving soundsdlocsig/dlocsig.lispquad sound movement (Fernando Lopez-Lezcano)
dronedrone.insadditive synthesis (bag.clm) (Peter Commons)
granulate-soundexpsrc.insexamples of the granulate generator (granular synthesis)
cross-fadefade.inscross-fades and dissolves in the frequency domain
filter-soundfltsnd.insfilter a sound file
stereo-fluteflute.insphysical model of a flute (Nicky Hind)
fm examplesfmex.insfm bell, gong, drum (Paul Weineke, Jan Mattox)
Jezar's reverbfreeverb/freeverb.insfancy reverb (Jezar Wakefield)
fullmixfullmix.insa mixer
granigrani.insgranular synthesis (Fernando Lopez-Lezcano)
grapheqgrapheq.insgraphic equalizer (Marco Trevisani)
fm-insectinsect.insfm
jc-reverbjcrev.insan old reverberator (jlrev is a cavernous version)
fm-voicejcvoi.insfm voice (John Chowning)
kiprevkiprev.insa fancier (temperamental) reverberator (Kip Sheeline)
lbj-pianolbjPiano.insadditive synthesis piano (Doug Fulton)
maracamaraca.insPerry Cook's maraca physical models
maxfiltermaxf.insJuan Reyes modular synthesis
mlb-voicemlbvoi.insfm (originally waveshaping) voice (Marc LeBrun)
moog filtersmoog.lispMoog filters (also filter-noise.ins) (Fernando Lopez-Lezcano)
fm-noisenoise.insnoise maker
nrevnrev.insa popular reverberator (Michael McNabb)
ppiano.insScott van Duyne's piano physical model
pluckpluck.insKarplus-Strong synthesis (David Jaffe)
pqwpqw.inswaveshaping
pqw-voxpqwvox.inswaveshaping voice
physical modelsprc-toolkit95.lispphysical modelling (Perry Cook)
various insprc96.insfm and aditive synthesis from Perry Cook's Synthesis Toolkit
pvocpvoc.insphase vocoder (Michael Klingbeil)
resfltresflt.insfilters (3 resonators) (Xavier Serra, Richard Karpen)
resonreson.insfm formants (John Chowning)
ring-modulatering-modulate.insring-modulation of sounds (Craig Sapp)
rmsenvrmsenv.insrms envelope of sound (Bret Battey)
track-rmsrmsp.insrms envelope of sound file (Michael Edwards)
pinssan.insspectral modelling
scannedscanned.insJuan Reyes scanned synthesis instrument
scentroidscentroid.insspectral scentroid envelope (Bret Battey)
singersinger.insPerry Cook's vocal tract physical model
sndwarpsndwarp.insCsound-like sndwarp generator (Bret Battey)
stochasticstochastic.insBill Sack's stochastic synthesis implementation
bowstrad.insJuan Reyes bowed string physical model
fm-trumpettrp.insfm trumpet (Dexter Morrill)
various insugex.insgranular synthesis, formants, etc
test insug(1,2,3,4).insCLM regression tests -- see clm-test.lisp
fm-violinv.insfm violin (fmviolin.clm, popi.clm)
voxvox.insfm voice (cream.clm)
zc, znzd.insinterpolating delays
zipperzipper.insThe 'digital zipper' effect.

The file clm-test.lisp exercises most of these instruments. If you develop an interesting instrument that you're willing to share, please send it to me (bil@ccrma.stanford.edu).

Although all the examples in this document use run followed by a loop, you can use other constructs instead:

(definstrument no-loop-1 (beg dur)
  (let ((o (make-oscil 660)))
    (run 
     (let ((j beg)) 
       (loop for i from 0 below dur do
	 (outa (+ i j) (* .1 (oscil o))))))))

(definstrument no-loop-2 (beg dur)
  (let ((o (make-oscil 440)))
    (run
     (dotimes (k dur)
       (outa (+ k beg) (* .1 (oscil o)))))))

And, of course, out-any and locsig can be called any number of times (including zero) per sample and at any output location. Except in extreme cases (spraying samples to random locations several seconds apart), there is almost no speed penalty associated with such output, so don't feel constrained to write an instrument as a sample-at-a-time loop. That form was necessary in the old days, so nearly all current instruments still use it (they are translations of older instruments), but there's no good reason not to write an instrument such as:

(definstrument noisey (beg dur)
  (run
   (dotimes (i dur)
     (dotimes (k (random 10))
       (outa (+ beg (floor (random dur))) (centered-random .01))))))

CLM in Guile, Ruby, C

Although this document is aimed at Common Lisp, CLM instruments can also be written in Scheme (via Guile), Ruby, or C. Most the standard CLM instruments are in the Snd tarball (clm-ins.scm primarily). To provide a quick overview, the CL bird instrument is

(definstrument bird (startime dur frequency freq-skew amplitude freq-envelope amp-envelope 
	             &optional (lpfilt 1.0) (degree 0) (reverb-amount 0))
  (multiple-value-bind (beg end) (times->samples startime dur)
    (let* ((amp-env (make-env amp-envelope amplitude dur))
	   (gls-env (make-env freq-envelope (hz->radians freq-skew) dur))
	   (loc (make-locsig :degree degree :distance 1.0 :reverb reverb-amount))
	   (fil (make-one-pole lpfilt (- 1.0 lpfilt)))
	   (s (make-oscil :frequency frequency)))
      (run
       (loop for i from beg to end do
	 (locsig loc i (one-pole fil (* (env amp-env) (oscil s (env gls-env))))))))))

Its (slightly simplified) Scheme counterpart is:

(define (bird start dur frequency freqskew amplitude freq-envelope amp-envelope)
  "(bird start dur frequency freqskew amplitude freq-envelope amp-envelope)"
  (let* ((gls-env (make-env freq-envelope (hz->radians freqskew) dur))
	 (os (make-oscil :frequency frequency))
	 (amp-env (make-env amp-envelope amplitude dur))
	 (len (inexact->exact (round (* (srate) dur))))
	 (beg (inexact->exact (round (* (srate) start))))
	 (local-data (make-vct len)))
    (vct-map! local-data (lambda () (* (env amp-env) (oscil os (env gls-env)))))
    (vct-add! out-data local-data beg)))

And in Ruby:

def bird(start, dur, frequency, freqskew, amplitude, freq_envelope, amp_envelope)
  gls_env = make_env(freq_envelope, hz2radians(freqskew), dur)
  os = make_oscil(frequency)
  amp_env = make_env(amp_envelope, amplitude, dur)
  beg = (srate() * start).round
  len = (srate() * dur).round
  local_data  = make_vct len
  vct_map!(local_data, Proc.new { || env(amp_env) * oscil(os, env(gls_env)) })
  vct_add!($out_data, local_data, beg)
end

In Scheme, a generator is itself a function: (oscil gen 0.0) is the same as (gen 0.0), if "gen" is an oscil. This can simplify instruments that leave the generator type decision until run time:

(define* (chain-dsps beg dur #:rest dsps)
  (let* ((dsp-chain (apply vector (reverse (map (lambda (gen)
						 (if (list? gen)
						     (make-env gen :duration dur)
						     gen))
					       dsps))))
	 (output (make-vct (inexact->exact (floor (* dur (mus-srate))))))
	 (len (vector-length dsp-chain)))
    (vct-map! output (lambda ()
		       (let ((val 0.0))
			 ;; using do and vector here for the run macro's benefit
			 (do ((i 0 (1+ i)))
			     ((= i len))
			   (let ((gen (vector-ref dsp-chain i)))
			     (if (env? gen)
				 (set! val (* (gen) val))
				 (if (readin? gen)
				     (set! val (+ val (gen)))
				     (set! val (gen val))))))
			 val)))
    (mix-vct output (inexact->exact (floor (* beg (mus-srate)))) #f #f #f)))

;(chain-dsps 0 1.0 '(0 0 1 1 2 0) (make-oscil 440))
;(chain-dsps 0 1.0 '(0 0 1 1 2 0) (make-one-zero .5) (make-readin "oboe.snd"))

The CLM test instruments in ug2.ins and ug3.ins have been translated to Scheme/Snd as the Snd file clm23.scm. It starts with some notes of differences between the CL and Scheme instruments.


Note Lists

A note list in CLM is any lisp expression that opens an output sound file and calls an instrument. The simplest way to do this is with with-sound or clm-load.


With-sound and clm-load

 with-sound &key 
   ;; "With-sound: check it out!" -- Duane Kuiper, Giants broadcaster after Strawberry homer
   (output *clm-file-name*)        ; name of output sound file ("test.snd" normally)
   (channels *clm-channels*)       ; can be any number (defaults to 1, see defaults.lisp)
   (srate *clm-srate*)             ; also 'sampling-rate' for backwards compatibility
   continue-old-file               ; open and continue old output file
   reverb                          ; name of the reverberator, if any.  The reverb
                                   ;   is a normal clm instrument (see nrev.ins)
   reverb-data                     ; arguments passed to the reverberator; an unquoted list
   (reverb-channels *clm-reverb-channels*) ; chans in temp reverb stream (input to reverb)
   revfile                         ; reverb file name
   (play *clm-play*)               ; play new sound automatically?
   (notehook *clm-notehook*)       ; function evaluated on each instrument call
   (statistics *clm-statistics*)   ; print out various fascinating numbers
   (decay-time 1.0)                ; ring time of reverb after end of piece
   comment                         ; comment placed in header
   info                            ; non-comment header string
   (header-type *clm-header-type*) ; output file type (see also header types)
   (data-format *clm-data-format*) ; output data format (see header types)
   save-body                       ; if t, copy the body (as a string) into the header
   scaled-to                       ; if a number, scale results to have that max amp
   scaled-by                       ; scale output by some number
   (clipped *clm-clipped*)         ; if t, clip output rather than allowing data to wrap-around
   (verbose *clm-verbose*)         ; some instruments use this to display info during computation
   (force-recomputation nil)       ; if t, force with-mix calls to recompute

with-sound is a macro that performs all the various services needed to produce and play a sound file; it also wraps an unwind-protect around its body to make sure that everything is cleaned up properly if you happen to interrupt computation; at the end it returns the output file name.

  (with-sound (:output "new.snd") (simp 0 1 440 .1))
  (with-sound (:srate 44100 :channels 2) ...)
  (with-sound (:comment (format nil 
     "This version is louder: ~A" (make-header))))
  (with-sound (:reverb jc-reverb) ...)
  (with-sound (:reverb nrev :reverb-data (:reverb-factor 1.2 :lp-coeff .95))...)

With-sound can be called within itself, so you can make an output sound file for each section of a piece as well as the whole thing, all in one run. Since it is the basis of with-mix and sound-let, all of these can be nested indefinitely:

(with-sound () 
  (mix (with-sound (:output "hiho.snd") 
            (fm-violin 0 1 440 .1))
          :amplitude .5))

(with-sound ()
  (with-mix () "s1" 0
    (sound-let ((tmp ()
                  (fm-violin 0 1 440 .1)))
      (mix tmp))))

(with-sound (:verbose t)
  (with-mix () "s6" 0
    (sound-let ((tmp ()
                  (fm-violin 0 1 440 .1))
                (tmp1 (:reverb nrev)
                  (mix "oboe.snd")))
      (mix tmp1)
      (mix tmp :amplitude .2 :output-frame *srate*))
    (fm-violin .5 .1 330 .1)))

(with-sound (:verbose t)
  (sound-let ((tmp ()
                (with-mix () "s7" 0
                  (sound-let ((tmp ()
                                (fm-violin 0 1 440 .1))
                              (tmp1 ()
                                (mix "oboe.snd")))
                   (mix tmp1)
                   (mix tmp :output-frame *srate*))
                 (fm-violin .5 .1 330 .1))))
    (mix tmp :amplitude .5)))

You can call with-sound within an instrument:

(definstrument msnd (beg dur freq amp)
  (let ((os (make-oscil freq)))
    (run
     (loop for i from beg below (+ beg dur) do
       (outa i (* amp (oscil os)))))))

(definstrument call-msnd (beg dur sr amp)
  (let* ((temp-file (with-sound (:output "temp.snd") (msnd 0 dur 440.0 .1)))
	 (tfile (open-input temp-file))
	 (reader (make-src :input tfile :srate sr))
	 (new-dur (/ dur sr)))
    (run
     (loop for i from beg below (+ beg new-dur) do
       (outa i (* amp (src reader)))))
    (close-input tfile)
    (delete-file temp-file)))

Besides the obvious options like :reverb and :srate, the most useful ones are :scaled-to and :statistics. statistics, if t, causes clm to keep track of a variety of interesting things and print them out at the end of the computation. scaled-to tells clm to make sure the final output file has a maxamp of whatever the argument is to :scaled-to -- that is,

(with-sound (:scaled-to .5) 
  (dotimes (i 32) (mix "oboe.snd" :output-frame (* i *srate*))))

will produce test.snd with a maxamp of .5, no matter how loud the intermediate mix actually is. Similarly, the scaled-by argument causes all the output to be scaled (in amplitude) by its value.

(with-sound (:scaled-by 2.0) (fm-violin 0 1 440 .1)) 

produces a note that is .2 in amplitude.

If revfile is specfied, but not reverb, the reverb stream is written to revfile, but not mixed with the direct signal in any way. Normally the reverb output is not deleted by with-sound; you can set *clm-delete-reverb* to t to have it deleted automatically.

The macro scaled-by scales its body by its first argument (much like with-offset):

(with-sound () 
  (fm-violin 0 1 440 .1)
  (scaled-by 2.0
    (fm-violin 0 .25 660 .1)) ;actual amp is .2
  (fm-violin .5 440 .1))

There is also the parallel macro scaled-to. These are built on the macro with-current-sound which sets up an embedded with-sound call with all the current with-sound arguments in place except output, comment, scaled-to, and scaled-by.

Other with-sound options that might need explanation are :notehook and :continue-old-file.

Notehook declares a function that is evaluated each time any instrument is called. The arguments passed to the notehook function are the current instrument name (a string) and all its arguments. The following prints out the instrument arguments for any calls on simp that are encountered:

(with-sound (:notehook
              #'(lambda (name &rest args) 
		  (when (string-equal name "simp")
	            (print (format nil "(simp ~{~A ~})" args))
                    (force-output))))
  (simp 0 1 440 .1)
  (toot .5 .5 660 .2))

If the notehook function returns :done, the instrument exits immediately.

Continue-old-file, if t, re-opens a previously existing file for further processing. Normally with-sound clobbers any existing file of the same name as the output file (see output above). By using continue-old-file, you can both add new stuff to an existing file, or (by subtracting) delete old stuff to any degree of selectivity. When you erase a previous note, remember that the subtraction has to be exact; you have to create exactly the same note again, then subtract it. By the same token, you can make a selected portion louder or softer by adding or subtracting a scaled version of the original. The option data-format underlies :scaled-to. CLM can read and write sound data in all the currently popular formats, leaving aside proprietary compression schemes. The names used in :data-format can be found in initmus.lisp, along with the headers CLM knows about.

You can make your own specialized versions of with-sound:

(defmacro with-my-sound ((&rest args) &body body)
  `(let ((filename (with-sound ,args ,.body)))
     ;; any post-processing you like here
     filename))

clm-load is the same as with-sound, but its first argument is the name of a file containing clm instrument calls (i.e. the body of with-sound), the reverb argument is the name of the reverb function, and the reverb-data argument is the list; that is, clm-load's arguments look like normal lisp, whereas with-sound's are unquoted in these two cases.

  (with-sound (:reverb jc-reverb :reverb-data (:volume .3)) ...)
  (clm-load "test.clm" :reverb 'jc-reverb :reverb-data '(volume .3))

The with-sound output is normally sent to the speakers via the play function. There are several associated functions:

  play &optional file start end wait
  dac &optional file start end wait
  sl-dac file &optional (output-device mus-audio-default)
  stop-playing
  stop-dac
  volume &optional (device mus-audio-default) channel

play (or dac) starts playing file (or the last file played, if no argument is given); in some cases (MCL and ACL) it then returns to the lisp listener; to interrupt the dac in those cases, use stop-playing (or stop-dac). To set the speaker volume (setf (volume) 1.0). Similarly (volume) returns the current volume settings. Currently, play calls the sndplay program if possible; sl-dac is the same thing, but calls the sl_dac function. The latter gives you control over the output device (sndplay will also someday). In some cases, sndplay's default buffer size is not ideal; you can use *clm-player* and sndplay's bufsize argument to set it to the correct value for your audio system. play's start and end arguments are in seconds, and default to playing the entire sound. The wait argument in some cases causes the play call to wait until the complete sound has been played before returning to the listener.

In both Scheme and CL, the *clm-* variables (like *clm-srate*) set the default values. In CL the corresponding un-clm'd versions (*srate*) hold the current values. So, if with-sound doesn't include the :srate argument, *srate* is the same as *clm-srate*; otherwise it reflects the :srate value for the duration of the with-sound call. The local variables (in CL) that are currently exported are: *srate*, *safety*, and *debug*. Unexported, but available in the clm package are *channels*, *data-format*, *header-type*, *notehook*, *clipped*, *verbose*, and *statistics*.


With-mix

  with-mix options file begin &body body

With-mix is a macro, callable within with-sound or clm-load, which saves the computation in its body in a separate file named file (without the .snd extension), and can tell when that file's data is up to date and does not need to be recomputed.

(with-sound () 
  (fm-violin 0 .1 440 .1)
  (with-mix () "sec1" .5 
    (fm-violin 0 .1 550 .1)
    (fm-violin .1 .1 660 .1))
  (with-mix (:reverb jc-reverb) "sec2" 1.0
    (fm-violin 0 .1 880 .1 :reverb-amount .2)
    (fm-violin .1 .1 1320 .1 :reverb-amount .2))
  (fm-violin 2 .1 220 .1)
  (mix "/zap/slow.snd"))

Now, if we change just the first note in the with-mix call, the second with-mix section will not be recomputed, but will be mixed in from the saved file "sec2.snd". By surrounding stable sections of a piece with calls on mix or with-mix, you can save a huge amount of time that would otherwise be spent waiting for these notes to be recomputed. This check-point or makefile capability is built on open-input.

With-mix performs a string comparison of its body to decide whether it needs to recompute its note calls. It then loads that body from a separate saved file. This can be confusing if global variables are present.

  > USER(2): (let ((rstr .1)) (with-sound () (with-mix () "sec" 0 (fm-violin 0 1 440 rstr))))
  > ; Loading /zap/sec.clm
  > Error: Attempt to take the value of the unbound variable `RSTR'.

Here the code evaluated is basically (let ((rstr .1)) (load "/zap/sec.clm")) where rstr has lexical scope. To make rstr visible within the load,

  (let ((rstr1 .1)) 
    (declare (special rstr1))
    (with-sound () (with-mix () "sec" 0 (fm-violin 0 1 440 rstr1))))

but if you then evaluate the same form again, changing rstr1 to (say) .5, with-mix does not notice that rstr1's value has changed, so it does not recompute its body, leaving the resultant amplitude at .1.

The fastest way to mix sound files is with mix:

  mix &optional-key filename (input-frame 0) (output-frame 0) frames output

  open-input &optional name &key start channel restartable
  close-input i-stream
  open-input* name &key start channel restartable

These functions open and close input sound files. open-input takes either a string or a pathname and returns an IO object. Various clm functions use that object as a handle on the file. The variable *clm-file-name*, used as the default name in most such calls, is "/zap/test.snd" at CCRMA.

Open-input normally opens the sound file name and returns a list or perhaps a structure that other clm functions can use to access the file. If you don't give a complete file name (name without the .snd extension), open-input checks to see if there's either no .snd file or a later .cm or .clm file, and in that case, suspends the current computation, makes the sound file from the sources, then resumes the old computation, opening the (newly computed) sound file. If you are working in sections, and keep the sections in separate files, the various layers of mixing can automatically notice when some section has changed, and update everything for you. Similarly, if all your sound files get deleted, the whole piece can still regenerate itself in one operation. If you want the convenience of the directory search (see *clm-search-list*) open-input*. Normally if open-input* can't find a file, it prints a warning and returns nil. If you would rather that it drop into the debugger with an option to specify a new file name at that time, set the restartable argument to t.

Open-input's &key parameters are patterned after Lisp's load function: verbose (the default is nil) turns on some informational printout; element-type can be nil (the default), or :sound. In the latter case, the file passed to open-input is assumed to contain sound data, no matter what extension it has, providing a way to override the check for out of date sound files and so on; if-does-not-exist can be nil or :error (the default). In the latter case, if no sound file associated with name can be found or created, you get an error message. start is the sample to start at when reading the first data buffer. end is the sample to stop at when reading the initial buffer (it defaults to buffer-size). If you are reading only a small portion of a file many times, you can save some time by setting explicitly the bounds of the initial read via start and end. The implicit load triggered by open-input with a non-specific file name sets *open-input-pathname* and *open-input-truename* and notices *open-input-verbose* (if t, print out informational messages).


Sound-let

sound-let is a form of let* that creates temporary sound streams within with-sound. Its syntax is like that of let and with-sound:

(sound-let ((temp-1 () (fm-violin 0 1 440 .1))
            (temp-2 () (fm-violin 0 2 660 .1)
                       (fm-violin .125 .5 880 .1)))
  (granulate-sound temp-1 0 2 0 2);temp-1's value is the name of the temp file
  (granulate-sound temp-2 1 1 0 2))

This creates two temporary files and passes them along to the subsequent calls on granulate-sound. The first list after the sound file identifier (i.e. after "temp-1" in the example) is the list of with-sound options to be passed along when creating this temporary file. These default to :output with a unique name generated internally, and all other variables are taken from the overall (enclosing) output file. The rest of the list is the body of the associated with-sound, which can contain embedded sound-lets. The difference between sound-let and a simple embedded with-sound is primarily that sound-let names and later deletes the temporary files it creates, whereas with-sound leaves its explicitly named output intact.


CLM Defaults

These are set in defaults.lisp. Generally, the default value is *clm-<var>, and the current dynamic value of that variable is *<var>*.

  *clm-array-print-length* number of IO data buffer elements printed
  *clm-channels*           default output channels (1)
  *clm-clipped*            default for clipped arg in with-sound
  *clm-dac-wait-default* default choice of whether play function should wait for completion
  *clm-data-format*        default output sound file data format
  *clm-date*               creation date of the current version
  *clm-delete-reverb*      should with-sound delete the temporary reverb output (default nil)
  *clm-file-buffer-size*   IO buffer sizes 
  *clm-file-name*          default sound file name
  *clm-header-type*        default output sound file header type
  *clm-init*               name of site-specific initializations (see clm-init.lisp)
  *clm-instruments*        list of the currently loaded clm instruments
  *clm-locsig-type*        locsig interpolation choice (mus-interp-linear or mus-interp-sinusoidal)
  *clm-news*               brief list of recent changes (HISTORY.clm)
  *clm-notehook*           default for notehook arg in with-sound
  *clm-play*               default for play arg in with-sound
  *clm-player*             user-supplied DAC function
  *clm-reverb-channels*    reverb stream chans in with-sound
  *clm-safety*             default safety setting (run loop debugging choices)
  *clm-search-list*        pathname list for file searches (open-input*)
  *clm-srate*              default sampling rate (22050)
  *clm-statistics*         default statistics arg in with-sound
  *clm-table-size*         default table-lookup table size (in Scheme, the associated function is clm-table-size)
  *clm-version*            version identifier (a number -- also *clm-revision*)
  *output*                 current output stream (for outa and friends)
  *reverb*                 current reverb stream
  two-pi                   2*pi

*clm-player* can be used to override CLM's normal play routine (which calls sndplay in most cases); say we want to send the sound to an ADAT output:

(setf *clm-player* (lambda (name) (sl-dac name mus-audio-adat-out)))
or change the sndplay buffer size:
(setf *clm-player* (lambda (name) (clm::run-in-shell "sndplay" (format nil "~A -bufsize 1024" name))))

On machines with plenty of memory and slow disks, you can speed up CLM computations by setting *clm-file-buffer-size* to some number larger than its default (65536). On ccrma's PC's running Linux with IDE drives and 64MBytes of RAM, CLM runs as much as 50% faster if you use:

  (let ((*clm-file-buffer-size* (* 1024 1024))) (with-sound ...) 

The macro with-offset can be used to set local begin time offsets. Its argument is in seconds:

(with-sound () 
  (fm-violin 0 1 440 .1)
  (with-offset 1.0
    (fm-violin 0 .25 660 .1)) ;actually starts at 1.0
  (fm-violin .5 440 .1))

CLM examples and whatnot

The file files describes briefly each of the files in the clm directory; clm-example.lisp shows one way to write notelists; cm-clm.lisp is a brief example of using Rick Taube's Common Music to drive CLM. There are several *.clm files included in the clm distribution. clm-test.lisp runs my standard set of regression tests, exercising many of the instruments. pitches.cl provides the standard pitch names as lisp variables (a4 = 440.0 and so on).


Run*

run* takes two arguments, a list of variables, and the usual run macro body. The run body is executed (in C normally) and then the variables are set to the values they had when the run loop exited. This extension of run is needed because in C instruments, everything that happens within the run loop is normally hidden from the lisp interpreter; if you set a global variable's value, for example, only the run-specific version of that variable is affected. You need run* to return such values back to Lisp.

(definstrument p (beg dur frq amp)
  (let* ((s (make-oscil frq))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (hi 0.0))
    (run* (amp hi)
      (loop for i from start below end do
	(incf hi .001)
	(outa i (* amp (oscil s)))))
    (print (format nil "~A ~A" hi amp))))

A more useful instrument is Michael Edwards' rmsp.ins; see also the sr3 instrument in ug.ins. Here's another instrument that implements legato between notes by using the previous note's phases:

(defstruct fmins carrier modulator)
(definstrument fmsimp (beg dur frq amp ind &optional previous-oscils)
  (let* ((start (floor (* *srate* beg)))
	 (end (+ start (floor (* *srate* dur))))
	 (carrier (if previous-oscils
		      (fmins-carrier previous-oscils)
		    (make-oscil)))
	 (modulator (if previous-oscils
			(fmins-modulator previous-oscils)
		      (make-oscil))))
    (setf (mus-frequency carrier) frq)
    (setf (mus-frequency modulator) frq)
    (run* (carrier modulator)
     (loop for i from start below end do
       (outa i (* amp (oscil carrier (* ind (oscil modulator)))))))
    (if previous-oscils
	(progn
	  (setf (fmins-carrier previous-oscils) carrier)
	  (setf (fmins-modulator previous-oscils) modulator)))))

;;; (defvar oscs (make-fmins :carrier (make-oscil) :modulator (make-oscil)))
;;; (with-sound () (fmsimp 0 1.01 440 .1 0.0 oscs) (fmsimp 1.01 1 660 .1 0.0 oscs))
;;; (with-sound () (fmsimp 0 1.01 440 .1 0.0) (fmsimp 1.01 1 660 .1 0.0))
;;;     the 1.01 (as opposed to 1.0) is needed because the phases line up just by chance in the 1.0 case
;;;     for portamento, the instrument could notice an in-coming osc set and
;;;     change the frequency envelope accordingly

Debugging

CLM provides several built-in data display and instrument debugging aids. But debugging an instrument is still too much pain. I suggest that you develop the algorithm in Snd/Scheme where there are elaborate and robust debugging tools. In Common Lisp you're lucky if the damned debuggers don't simply segfault, and there's no hope that they'll tell you anything useful.

The optimize safety option can be used to check for array index and null generator problems (these will be reported as bus errors and segmentation faults).

The Error Handler

When you hit an error within with-sound, depending on the context of the error and the lisp you're running, you'll see a variety of restart options:

  Restart actions (select using :continue):
   0: return from break.
   1: try to exit current note cleanly and go on.
   2: abort current note.
   3: close files and return to top-level.
   4: jump past remaining notes.

The last four are provided by CLM. The first tries to jump to the end of the current instrument, allowing open input files to be closed and so forth. The second jumps out of the current note, but tries to continue processing the body of with-sound. The third closes all files and jumps out of with-sound. The fourth jumps to the end of the body of with-sound and tries to handle all the usual with-sound closing options such as reverb, statistics, and scaling.

If you hit a C error (segfault, etc), start gdb with lisp ('gdb /usr/local/lisp/acl'), 'run', load clm, run your instrument, then when the error drops you into the gdb debugger, 'where'. This should give you some idea where the problem is. In the worst case, trace clm::run-in-shell and compile/load the instrument to find out what the C compilation sequence is on your machine; next, make whatever changes you like to the instrument C code (produced by the run macro, named clm_INSNAME.c); to add a print statement that will send its output to the lisp listener, use the function mus_error with a first argument of 0; next run the C compiler and loader, making a new instrument object file, start gdb with lisp, run lisp loading clm, load your instrument, and run it. This is incredibly tedious!


CLM and Snd

If the Snd sound editor is available (currently this is the case on the SGI and some Linux systems, and should work on the Sun, but I haven't been able to try it), there are a variety of hooks in clm-snd.lisp that enable CLM and Snd to talk to each other. This portion of CLM has changed drastically three times now, so it is only for good sports. Currently, the most useful of the functions are:

  start-snd
  send-snd code
  receive-snd 
  send-and-receive-snd code &optional with-eval

  snd-memo file format-string &rest args
  add-mark sample channel
  add-region beg end

  snd-sound &optional file-name
  snd-region &optional (reg 0)
  snd-cleanup &body body

  to-snd (&rest args) &body body
  snd-edit-sound new-name &optional old-name
  snd-edit (&optional file) &body body

  snd-envelope env
  clm-envelope env

snd-memo provides access to the ".scm" file that can be associated with any sound in Snd; the memo file can contain any Snd-related Scheme code you want; it will be loaded just after the sound it itself is loaded. The variable memo-sound is set during this process to the index of the current sound. You can save any arbitrary information you like at any time through this function; the predefined macro add-mark is just one simple example:

  (defmacro add-mark (samp &optional (chan 0))
    `(snd-memo *output* "(add-mark ~D memo-sound ~D)~%" ,samp ,chan))

It appends the (add-mark samp memo-sound chan) call to the current output's memo (.scm) file. Similarly, add-region defines a new region in Snd; it can be used to mark a note's begin and end points with a sound.

snd-sound returns the current edited state of the desired file in the Snd editor (or the currently active file if no file-name is given). This can be used anywhere a file name occurs in CLM:

  (with-sound () (mix (snd-sound)))

Similarly, snd-region returns the contents of region reg. snd-edit-sound passes sound data back to sound, causing it to appear in the editor as an edit of either the file passed as old-name, or the currently active file if no old-name is given.

(snd-edit-sound 
  (with-sound () 
    (mix (snd-sound)) 
    (fm-violin .1 .1 660 .1)))

takes the current state of the current active file in Snd (snd-sound), adds a short fm-violin note to it, then returns that to Snd as a kind of editing operation.

Nearly everything that Snd can do is accessible to CLM by sending the appropriate Snd code through the function send-snd and friends.

  (send-snd "(open-sound \"oboe.snd\")")
  (snd-edit () (with-sound () (mix (snd-sound)) (fm-violin .1 .1 660 .1)))
  (send-and-receive-snd "(save-sound 0)")

starts Snd, opens "oboe.snd", edits it by adding a fm-violin note, and saves the result under the same name, exiting Snd. All of this is compatible with the debugging and display uses of Snd. For example, 'display' starts Snd itself if one isn't started yet, and that same Snd process can handle the editing operations described above.

The Snd envelope editor can be used in conjunction with clm; clm-envelope passes its argument (assumed to be a list) to Snd, and snd-envelope returns Snd's notion of that envelope (presumably after it has been edited):

(defvar hi '(0 0 1 1))
(clm-envelope hi)
(setf hi (snd-envelope hi))

send-snd can also be called within the run loop, sending Snd any arbitrary command; the following instrument prints out the seconds as they go by in Snd's minibuffer:

(definstrument call-snd (beg dur frq)
  (let* ((bg (floor (* beg *srate*)))
         (nd (+ bg (floor (* dur *srate*))))
         (o (make-oscil frq))
	 (ctr 0)
	 (secs 0))
    (run
     (loop for i from bg below nd do
       (incf ctr)
       (when (>= ctr *srate*)
	 (incf secs)
	 (setf ctr 0)
	 (send-snd "(report-in-minibuffer (number->string ~D))" secs))
       (outa i (oscil o))))))

In this case, if send-snd has extra arguments, they are treated like format or clm-print arguments.

snd-sound creates a temporary file to pass the current state to CLM, and expects CLM to delete that file when it is done with it. The macros snd-cleanup and snd-edit provide this cleanup action for you. If you don't clean these files up as they are created, they are finally deleted when snd-stop is called, or when CLM is exited. If something goes wrong, just delete any file on the temp directory (/tmp or /var/tmp normally) whose name begins with "snd_".

to-snd is a version of with-sound that sends causes Snd to open the output file when with-sound is done.

  (to-snd (:statistics t) (fm-violin 0 1 440 .1))

There are two gotchas with to-snd, both occurring only when to-snd has to start a new Snd image itself (i.e. there's no Snd already running). In this case, while Snd is active, it gets stdin, so typing to the ACL listener is actually communicating with Snd, not CLM. And, with the change to sndplay (for CLM's dac function) in most cases, sndplay is playing the sound at the very moment that Snd is starting up in the background and trying to figure out what audio devices are available. I added mus-audio-reinitialize to clear this confusion (i.e. if Snd complains it can't play the sound, force it to reinitialize its notion of what's out there).

to-snd is just a simple macro (clm-snd.lisp) that calls send-snd opening the result of the with-sound call, so to open the new sound and make sure the control panel is open:

(defmacro to-snd-with-controls ((&rest args) &body body)
  `(send-snd (format nil 
	             "(let ((snd (open-sound ~S))) 
                        (set! (show-controls snd) #t))" 
	             (with-sound ,args ,@body))))

Appendices


Header and data types

CLM can write NeXT/Sun, AIFF/AIFC, RIFF ("wave"), raw (no header), NIST-sphere, and "old-style" IRCAM headers. The default choice is set by *clm-header-type* set in defaults.lisp. The output data format is normally 16-bit signed (2's complement) integer; the default is set by *clm-data-format*. CLM can read most standard headers, and can read and write most uncompressed data formats.

I am willing to add almost anything to this list. See headers.c for all the gory details. In with-sound, you can set the output header type with the keyword :header-type, and the data type with the :data-format keyword.

The CLM names for the output header types, as used with the :header-type argument to with-sound, are mus-aiff, mus-aifc, mus-next, mus-riff, and mus-ircam. The data-formats that are exported from the clm package are mus-bshort, mus-lshort, mus-bint, mus-lint, mus-bfloat, mus-lfloat, mus-mulaw, mus-alaw, mus-byte, mus-ubyte, mus-b24int, mus-l24int, mus-bdouble, and mus-ldouble. The "b" stands for big-endian, "l" for little-endian, "u" for unsigned. The other header and data format possibilities are listed in initmus.lisp.

If you are trying to read raw (no header) sound files, CLM's default settings for the sampling rate, channels, and data format are 44100, 2, and mus-bshort respectively. To change these, call (mus-set-raw-header-defaults srate chans format):

(mus-set-raw-header-defaults 8012 1 mus-mulaw)
(open-input "raw.snd")

treats "raw.snd" as mono µlaw data at 8012 Hz.


Sources of unwanted noise

The major source of unwanted noise in computer music is amplitude quantization. This means soft notes are buzzy. If these are later used as input to a reverberator, the buzziness can easily be magnified. If the soft notes are split between channels (via locsig), you may end up increasing the overall noisiness. My experience has been that anything under .003 in amplitude is asking for trouble unless it is covered up in some way. Since reverb amounts are often less than .01, even a loud note can produce noisy input to the reverberator. The simplest way around this in CLM is to make one run and get the reverb stream max amp (reported if :statistics is t in with-sound). Then scale all the reverb signals up by the inverse of this (leaving some room for slop, of course). For example, if the reverb max amp is .01, you're throwing away about 7 bits of amplitude resolution in the reverb input. So, in this case, multiply all the locsig reverb by (say) 50, then in the reverberator, divide the reverb output by 50 before sending it out. See jcrev.ins (the volume argument). Similarly, if your notes are soft, send them directly out channel 0 or 1; the spatial effects are going to add less to your piece than the noise will detract in this case. And if you're making repeated iterative passes over sound files, try to keep them scaled close to 1.0 in maxamp through all the passes. The exact maxamp is not important; the difference between 1.0 and .5 is one bit of resolution. If you want to hear this buzz, either run a slowly decaying envelope on a sine wave, or listen to the tail end of the standard reverbs as they decay into "silence"; you'll be horrified. The latter effect is so noticeable that many of the reverbs have an amplitude envelope argument that can be used to cut them off quickly at the end of the piece; it is against my religion to add noise (i.e. the dithering used currently by commercial CD's; the theory is that this dithering makes the buzz (a periodic toggling of the low order bits) uncorrelated, and therefore we're happier because we've come to expect tape noise anyway; but turn up the soft portions of your favorite CD, if it has any, and decide whether the cure is perhaps worse than the disease).

Next in importance, in my unhappy experience with headphones, speakers, and amplifiers has been that slow amplitude envelopes can cause annoying artifacts in less than perfect audio equipment. You may hear glissandos or chirps if a soft note is slowly ramping up or down. The function reduce-amplitude-quantization-noise in env.lisp makes the envelope jump through the initial or final section where there are too few bits, hopefully reducing the chirps (these are apparently caused by non-linearities in the audio equipment; I don't hear them in very good equipment). A similar trick is to use exponential envelopes that are bowed out (a base less than 1.0 in CLM); this is the default in the MusicKit. There may be some combination of problems here; see Robert Maher, "On the Nature of Granulation Noise in Uniform Quantization Systems", JAES vol 40 no 1/2, 1992, p12; he says "The common assumption that the quantization noise is additive, white, and uncorrelated with the input signal is simply incorrect for the case of sinusoidal input". Since the ramping portions are often sinusoidal, or nearly so, these chirps might be analyzable as FM caused by quantization.

Another source of noise is foldover. This is mostly a problem with FM when the sampling rate is low; you'll hear inharmonic artifacts caused by components that are beyond half the sampling rate. Then there are the obvious problems like discontinuities in the wave becoming clicks at the speaker, and clipping. Finally, avoid reverberating notes with sharp attacks.

The major sources of noise in audio equipment are bad connections and ground loops. In the latter case, various pieces of equipment are at slightly different ground voltages due to tiny resistances in ground wires; this sets up a sort of screen upon which all kinds of interference can be projected, so to speak. These loops are hard to avoid. In my house the grounds are real; that is, the third plug on the power cords is actually connected to a solid ground, but I still had to connect all the drives, audio equipment, and NeXT itself to the same outlet (representing altogether about 1000 watts of worst case power consumption). The problem was that the ground and neutral wires meander through the conduits alongside the power wires, so it becomes a serial connection of grounds along a given path; it's a low gauge wire, but even so, there is a slight resistance along that path, causing equipment connected to different outlets to be at a slightly different ground voltage. Even after putting everything on the same outlet, the external drive was the source of a slight hum; after unplugging it, I could turn all the volume knobs up all the way and hear only a small hiss which I attribute to the unavoidable randomness in any analog equipment (Johnson noise).

On the NeXT, the DACs are mounted near the monitor, so you can hear interference from that all the time. Similarly speaker cables can sometimes act as antennas; I think the theory here is that radio frequency interference (which can be picked up by a short wire like a speaker connection) can occur in pulses that become clicks or hiss in the speakers, and hum can apparently be caused by stray inductance from transformers. The simplest answer is to buy properly shielded computer equipment, route the wires away from that equipment, and use the shortest wires possible. If that's not an option, I'm told that it helps to use shielded cables. If there's still interference, you might be able to go to balanced connections, but this normally means investing in pro-audio equipment.

Here are some interesting comments from Lamar Owen (a radio engineer):

Properly designed balanced in and out A/D and D/A converters can be completely immune to the PC's internal noise. But it all goes to proper design. The Antex SX series of cards likewise contain internal A/D converters. I have measured the noise figures of the Antex SX-36 we have at WGCR using state of the art audio systems analyzers, and the noise floor is below the LSB threshold. All due to balanced I/O, sound PC layout techniques, and top of the line components. With unbalanced I/O all bets are off, of course.

In a high RF environment, unless the converters are optically isolated from the PC, you might be asking for trouble. When I say 'high RF' I'm talking 10KW of AM transmitter fifteen feet away, with a measured RF field intensity of 105V/m (the ANSI exposure limit is around 645V/m). This means a one meter piece of wire that isn't properly grounded can develop 105V of RF energy. I have suffered RF burns of appreciable intensity touching wires that weren't connected to anything on either end -- they were just oriented along the field gradient.

clm-init.lisp

If the file clm-init.lisp exists in the same directory as all.lisp, or if you set the clm variable *clm-init* to point to some file, then CLM loads that file upon initialization. Here is my clm-init.lisp:

(compile-and-load "v")
(compile-and-load "jcrev")
;;; my two favorite instruments

(setf (volume) 1.0)
;;; dac output volume

(setf *print-array* nil)
;;; keep lisp from printing out endless arrays in trace/zoom, etc

(setf *clm-search-list* 
  (append *clm-search-list* 
	  (list "/me/cl/oboe.snd" 
		"/me/mus/hdr/aiff-8.snd" 
		"/me/snd/now.snd" 
		"/snd1/zap/test.snd" 
		"/snd1/snds/test.snd")))
;;; these are my standard sound file directories -- by including 
;;; these in the search list I don't need to remember where each 
;;; file happens to be.  The file names are just fillers --
;;; the important part of the path is the directory.

About CLM in saved images

Many lisps have some mechanism to dump the current lisp image as an executable file. In ACL or MCL, some of CLM's state at run-time is handled in C-based foreign-function modules that are opaque to Lisp, so there are cases where the naive use of dumplisp (acl), or save-application (mcl) can fail with a segmentation fault or some other equally un-informative error message. This should only be a problem when the saved image has called clm-initialize-links (within with-sound or dac or some such function); if you build a clm image and immediately save it, everything should work without problem. Once clm-initialize-links has been called, the C modules assume they have been initialized; if code in the saved version of a module is then executed, the un-initialized variables may be accessed. To get around this problem, call restart-clm before doing anything in the newly executed image.


Index


add-markenv?make-mixermus-scalersend-snd
add-regionenvelope->coeffsmake-notchmus-set-rand-seedsine-bank
all-passenvelope-expmake-one-polemus-set-raw-header-defaultssine-summation
all-pass?envelope-interpmake-one-zeromus-widthsine-summation?
amplitude-modulateEnvelopesmake-oscilmus-xcoeffsl-dac
array->filefftmake-phase-vocodermus-xcoeffssnd-cleanup
array-interpfile->arraymake-ppolarmus-ycoeffsnd-edit
asymmetric-fmfile->framemake-pulse-trainmus-ycoeffssnd-edit-sound
asymmetric-fm?file->frame?make-randnormalize-envelopesnd-envelope
averagefile->samplemake-rand-interpnotchsnd-memo
average?file->sample?make-readinnotch?snd-region
Checkpointsfiltermake-sample->fileNote lists snd-sound
clear-arrayfilter?make-sawtooth-wavenotehookSound file formats
CLM Initialization Filtersmake-scalar-mixerone-poleSound file IO
*clm-array-print-length*fir-filtermake-sine-summationone-pole?Sound placement
*clm-channels*fir-filter?make-square-waveone-zerosound-chans
*clm-clipped*formantmake-srcone-zero?sound-data-format
*clm-dac-wait-default*formant?make-ssb-amopen-inputsound-data-location
*clm-data-format*Fourier transforms make-sum-of-cosinesopen-input*sound-datum-size
*clm-date*frame*make-sum-of-sines*open-input-pathname*sound-duration
*clm-delete-reverb*frame+make-table-lookup*open-input-truename*sound-format-name
clm-envelopeframe->filemake-triangle-wave*open-input-verbose*sound-frames
*clm-file-buffer-size*frame->file?make-two-poleoptional-keysound-header-type
*clm-file-name*frame->framemake-two-zerooscilsound-length
*clm-header-type*frame->listmake-wave-trainoscil?sound-let
*clm-init*frame->samplemake-waveshapeout-anysound-loop-info
*clm-instruments*frame-refmake-zpolar*output*sound-maxamp
clm-loadframe-set!mixpartials->polynomialsound-samples
*clm-locsig-type*frame?mixer*partials->wavesound-set-loop-info
*clm-news*Generatorsmixer+partials->waveshapesound-srate
*clm-notehook*Granular synthesismixer-refphase-partials->wavesound-type-name
*clm-play*granulatemixer-scalephase-vocoderspectrum
*clm-player*granulate?mixer-set!phase-vocoder?square-wave
clm-printHeaders mixer?polar->rectangularsquare-wave?
clm-randomhz->radiansmove-locsigpolynomialsrc
*clm-reverb-channels*iir-filtermultiply-arrayspulse-trainsrc?
*clm-safety*iir-filter?mus-aifcpulse-train?ssb-am
*clm-search-list*in-anymus-aiffradians->degreesssb-am?
*clm-srate*Input and outputmus-bshortradians->hzstart-snd
*clm-statistics*Instrumentsmus-channelrandstop-dac
*clm-table-size*linear->dbmus-channelsrand-interpstretch-envelope
*clm-version*locsigmus-closerand-interp?sum-of-cosines
close-inputlocsig-refmus-cosinesrand?sum-of-cosines?
comblocsig-reverb-refmus-dataRandom Numberssum-of-sines
comb?locsig-reverb-set!mus-describeraw data sum-of-sines?
continue-frame->filelocsig-set!mus-feedbackreadintable-lookup
continue-sample->filelocsig-typemus-feedforwardreadin?table-lookup?
contrast-enhancementlocsig?mus-file-namereceive-sndtap
convolutionmake-all-passmus-formant-radiusrectangular->polartimes->samples
convolvemake-asymmetric-fmmus-frequencyrestart-clmto-snd
convolve-filesmake-averagemus-hoprestart-envtriangle-wave
convolve?make-combmus-increment*reverb*triangle-wave?
cross synthesismake-convolvemus-input?ring-modulatetwo-pi
dacmake-delaymus-interp-typeruntwo-pole
Data formats make-envmus-ircamrun*two-pole?
db->linearmake-fft-windowmus-lengthRun support for Lisptwo-zero
Debugging make-file->framemus-locationsample->filetwo-zero?
def-clm-structmake-file->samplemus-namesample->file?volume
definstrumentmake-filtermus-nextsample->framewave-train
degrees->radiansmake-fir-filtermus-offsetsamples->secondswave-train?
delaymake-formantmus-ordersampling-rate conversionwaveshape
delay-tickmake-framemus-output?saved imageswaveshape?
delay?make-frame->filemus-phasesawtooth-wavewindow-envelope
dot-productmake-granulatemus-rampsawtooth-wave?with-mix
edot-productmake-identity-mixermus-randomscale-envelopewith-offset
envmake-iir-filtermus-riffseconds->sampleswith-sound
env-interpmake-locsigmus-runsend-and-receive-snd