Scheme Functions included with Snd


related documentationsnd.htmlextsnd.htmlgrfsnd.htmlclm.htmlsndlib.htmlindex.html

This file contains notes upon the various *.scm files included with Snd. To use any of these files, (load <file>); for example (load "bell.scm"). To start Snd with the file already loaded, snd -l bell.scm.

autosave.scm

  auto-save
  cancel-auto-save

The auto-save code sets up a background process that checks periodically for unsaved edits, and if any are found it saves them in a temporary file. The time between checks is set by the variable auto-save-interval which defaults to 60.0 seconds. To start auto-saving, (load "autosave.scm"). Thereafter (cancel-auto-save) stops autosaving, and (auto-save) restarts it.

bell.scm

  fm-bell startime dur frequency amplitude amp-env index-env index

The FM bell was developed by Michael McNabb in Mus10 in the late '70s. It is intended for low bell sounds (say middle C or so). The lines

	   (mod1 (make-oscil (* frequency 2)))
	   (mod2 (make-oscil (* frequency 1.41)))
	   (mod3 (make-oscil (* frequency 2.82)))
	   (mod4 (make-oscil (* frequency 2.4)))
	   (car1 (make-oscil frequency))
	   (car2 (make-oscil frequency))
	   (car3 (make-oscil (* frequency 2.4)))

set up three FM pairs, car1+mod1 handling the basic harmonic spectra, car2+mod2 creating inharmonic spectra (using the square root of 2 more or less at random), and car3+mod3 putting a sort of formant at the minor third (2.4 = a ratio of 12/5 = octave+6/5 = minor tenth).

  (define fbell '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 ))
  (define abell '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0 ))
  (fm-bell 0.0 1.0 220.0 .5 abell fbell 1.0)

bird.scm

  bird start dur frequency freqskew amplitude freq-envelope amp-envelope
  bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials
  one-bird beg maxdur func birdname
  make-birds &optional (output-file "test.snd")

bird.scm is a translation of Sambox/CLM bird songs. The two instruments set up a simple sine wave (bird) and simple waveshaping synthesis (bigbird). Use a low-pass filter for distance effects (a bird song sounds really silly reverberated). All the real information is in the amplitude and frequency envelopes. These were transcribed from sonograms found in some bird guides and articles from the Cornell Ornithology Lab. The variable with-editable-mixes controls whether each bird is tagged so that you can move it around later (for a pretty picture of the result, check this out). The function one-bird mixes in one complete birdsong, using the bird's name for the edit history list. Many of these birds were used in "Colony". To hear all the birds, call (make-birds). This writes the sequence out as "test.snd"; give the desired file name as the (optional) argument to make-birds: (make-birds "birds.snd"). Waveshaping is described in Le Brun, "Digital Waveshaping Synthesis", JAES 1979 April, vol 27, no 4, p250.

(define (one-bird beg maxdur func birdname)
  ;; it would be better if this could get the needed mix length automatically
  ;; saving the individual squeaks in one vector saves us zillions of temp files (and is faster)
  (set! out-data (make-vct (round (* (srate) maxdur))))
  (func)
  (as-one-edit 
   (lambda ()
     (mix-vct out-data (round (* beg (srate))) out-file 0 with-editable-mixes))
   birdname))

The one-bird function collects all the individual tweets of a given bird song into one vct object, then mixes that into the output sound. The beg and maxdur arguments set the begin time and maximum duration in seconds of the mix; the duration is used to allocate the global vct object (out-data. The func argument is a Scheme function of no arguments (known in Scheme as a "thunk"). It is called via (func); the assumption is that func will actually provide a complete bird song. For example:

(define (bobwhite beg)
  (let ((bobup1 '(.00 .00 .40 1.00 1.00 1.0))
	(bobup2 '(.00 .00 .65 .50 1.00 1.0)))
    (one-bird beg 2.0
     (lambda ()
       (bigbird .4 .2 1800 200 .1 bobup1 main-amp '(1 1 2 .02))
       (bigbird 1 .20 1800 1200 .2 bobup2 main-amp '(1 1 2 .02)))
     (report-in-minibuffer "bobwhite"))))

defines a Bobwhite call (a kind of mid-western quail, Colinus virginianus -- I grew up in Oklahoma and heard these calls every day). The func in this case is:

     (lambda ()
       (bigbird .4 .2 1800 200 .1 bobup1 main-amp '(1 1 2 .02))
       (bigbird 1 .20 1800 1200 .2 bobup2 main-amp '(1 1 2 .02)))

which calls bigbird twice (the "bob" and the "white"). It also reports the name "bobwhite" in the minibuffer (this is mostly to let the caller know that something is happening -- since we aren't calling update-graph, there's no visual indication that a bird has been mixed in). one-bird uses as-one-edit mostly to package up the birdsong with any possible file extension (if beg is beyond the current end-of-file) which would otherwise appear as a separate edit in the edit history list. In bigbird the lines

           ...
	   (coeffs (partials->polynomial (normalize-partials partials)))
           ...
		     (polynomial coeffs
				 (oscil os (env gls-env))))))

setup and run the waveshaping synthesis (in this case it's just a fast additive synthesis). partials->polynomial calculates the Chebyshev polynomial coefficients given the desired spectrum; the spectrum then results from driving that polynomial with an oscillator. Besides the bird guides, there are now numerous recordings of birds that could easily be turned into sonograms and transcribed as envelopes. In fact, in Snd this could be automated...

In CLM, the bird 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))))))))))

The bird.scm version could easily include the one-pole filter and so on. The Ruby version of this file is bird.rb. Just for comparison, the bird instrument in Ruby is:

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

draw.scm

draw.scm has examples of graphics additions; some of these are shown in extsnd.html. display-energy is a lisp-graph-hook procedure that displays the current time domain data as energy, not amplitude, using the y zoom slider to control the lisp graph y axis. The other procedures in draw.scm are intended for use with the after-graph-hook. display-colored-samples (color beg dur snd chn) displays samples from beg for dur in color whenever they're in the current view. This is intended for use with color-samples. (color-samples color &optional beg dur snd chn) causes samples from beg to beg+dur to be displayed in color; to undo this, use uncolor-samples. display-previous-edits displays all edits of the current sound, with older versions gradually fading away. overlay-sounds overlays onto its first argument all subsequent arguments: (overlay-sounds 1 0 3). make-current-window-display displays in the upper right corner the overall current sound and where the current window fits in it. This info is implicit in the x sliders, but a redundant graph doesn't hurt. If you click in that graph, the cursor is moved to the clicked point.

display-current-window-location


dsp.scm

These are DSP-related procedures that aren't closely tied to CLM.

  dolph n gamma
  dht data
  butter gen
  make-butter-high-pass freq
  make-butter-low-pass freq
  make-butter-band-pass freq bandwidth
  make-butter-band-reject freq bandwidth
  fltit-1
  spectrum->coeffs order spectrum-envelope
  down-oct
  freqdiv n
  adsat size
  spike
  compute-uniform-circular-string size x0 x1 x2 mass xspring damp
  compute-stringsize x0 x1 x2 masses xsprings esprings damps haptics
  spot-freq
  zero-phase, rotate-phase
  both forms of asymmetric-fm
  cosine-summation
  legendre-summation

dolph is the Dolph-Chebyshev fft data window, taken from Richard Lyons, "Understanding DSP". dht is the slow form of the Hartley transform, taken from Perry Cook's SignalProcessor.m. The built-in function fht is the fast form of this transform. The Hartley transform is a kind of Fourier transform. The Butterworth filters are taken from Sam Heisz's CLM version of Paris Smaragdis's Csound version of Charles Dodge's code from "Computer Music: synthesis, composition, and performance". See also the notch filter in new-effects.scm. spectrum->coeffs is a Scheme version of Snd's very simple spectrum->coefficients procedure ("frequency sampling"). It returns the FIR filter coefficients given the filter order and desired spectral envelope.

(map-chan (fltit-1 10 (list->vct '(0 1.0 0 0 0 0 0 0 1.0 0))))

down-oct tries to move a sound down an octave by goofing with the fft data, then inverse ffting. freqdiv implements "frequency division", taken from an effects package of sed_sed@my-dejanews.com.

(freqdiv 8)

Also from that package is adsat, "adaptive saturation". spike performs a product of samples (as opposed to the more common sum); that is, it multiplies together several successive samples, causing a more spikey output. compute-uniform-circular-string and compute-string implement scanned synthesis of Bill Verplank and Max Mathews. To watch the wave, open some sound (so Snd has some place to put the graph), turn off the time domain display (to give our graph all the window) then (testunif 1.0 0.1 0.0) or whatever. The spot-freq function is a simple first-pass at using autocorrelation for pitch tracking; it's easily fooled, but could probably be made relatively robust. The code:

 (let* ((logla (log10 (/ (+ cor-peak (vct-ref data i)) (* 2 cor-peak))))
	(logca (log10 (/ (+ cor-peak (vct-ref data (+ i 1))) (* 2 cor-peak))))
	(logra (log10 (/ (+ cor-peak (vct-ref data (+ i 2))) (* 2 cor-peak))))
	(offset (/ (* 0.5 (- logla logra))
		   (+ logla logra (* -2.0 logca)))))
   (return (/ (srate snd)
	      (* 2 (+ i 1 offset)))))

is using Xavier Serra's interpolation technique to find the "true" location of the autocorrelation peak. The cor-peak business is making sure the log10 arguments fall between 0.0 and 1.0.

zero-phase and rotate-phase are fft-manipulators taken from the phazor package of Scott McNab.

asyfm-J is a Scheme version of the CLM asymmetric-fm generator; asyfm-I is the Modifier Bessel version of this generator. In both cases, the "r" variable is accessible, so it's easy to experiment with the moving formant idea mentioned in the original article.

cosine-summation is a variation on J.A.Moorer's sine-summation; the generating formula is much simpler, but the result is basically the same. This could also be viewed as a version of the sum-of-cosines generator, giving control on the ratio between successive cosines in the sum (i.e. the "r" parameter in sine-summation, applied within the sum-of-cosines output). legendre-summation uses the sum-of-cosines generator to produce a band-limited pulse-train whose cosine components have a decreasing amplitude (as if it were a sum of Lengendre Polynomials driven by a cosine).

edit-menu.scm

edit-menu.scm adds some useful options to the Edit menu:

  trim front and trim back (to/from marks)
  crop (first and last marks)
  selection->new
  cut selection->new
  append selection (and append sound)

new-effects.scm

new-effects.scm implements an "Effects" menu. If you have Motif, you can load xm.so (or build Snd with it preloaded), and get sliders to control most of the effects. The actual list of effects changes relatively frequently, but probably has:

  reverse
  normalize (normalization)
  gain (gain-amount)
  invert
  chordalize (chordalize-amount, chordalize-base)
  flange (increase speed and amount to get phasing, flange-speed, flange-amount, flange-time)
  compand
  reverberate (reverb-amount)
  intensify (contrast-amount)
  echo (echo-length, echo-amount)
  squelch (squelch-amount, omit-silence)
  add silence (at cursor) (silence-amount)
  remove DC
  expsrc (independent pitch/time scaling) (time-scale and pitch-scale)
  various filters
  cross synthesis

Most of these are either simple calls on Snd functions ("invert" is (scale-by -1)), or use functions in the other scm files. The actual operations follow the sync chain of the currently active channel.

One possibly interesting part of new-effects.scm is the implementation of the Effects menu. If you change one of the variables, you'll notice that the menu updates its notion of that variable as well. This is handled through update-callback argument to add-to-main-menu function. Each effect is added (when new-effects.scm is loaded) to the effects-list. Then each time you click the Effects menu, causing its options to be dispayed, the update-callback function itself calls each effect's update function to get its current option label. That is,

(define effects-list '())
(define effects-menu 
  (add-to-main-menu "Effects" 
                    (lambda ()
 		      (define (update-label effects)
		        (if (not (null? effects))
			    (begin
			      ((car effects))
			      (update-label (cdr effects)))))
		      (update-label effects-list))))

defines the update-callback to be a "thunk" (the outer lambda) that itself defines a local function (update-label) that runs through the effects-list calling each one via ((car effects)). Each effect that wants to recalculate its option label then adds its update function to the effects-list when it is loaded:

(set! effects-list (cons (lambda ()
			   (let ((new-label (format #f "gain (~1,2F)" gain-amount)))
			     (change-menu-label effects-menu gain-label new-label)
			     (set! gain-label new-label)))
			 effects-list))

The sound effect itself is the callback function of the given option:

(add-to-menu effects-menu "reverse" (lambda () (reverse-sound)))

I can't decide whether it would be useful to describe some of these effects in more detail. The code is mostly straight-forward, and it's not hard to try them out.


env.scm

An envelope in Snd/CLM is simply a list of breakpoint pairs. (In the function names, I try to remember to use "envelope" to be a list of breakpoints, and "env" to be the result of make-env, a CLM env structure passed to the env generator). In an envelope, the x axis extent is arbitrary, though it's simplest to use 0.0 to 1.0. env.scm provides several envelope functions that are often useful:

  envelope-interp x env base
  window-envelope beg end env
  map-envelopes func env1 env2
  multiply-envelopes env1 env2
  add-envelopes env1 env2
  max-envelope env
  integrate-envelope env
  stretch-envelope env old-attack new-attack old-decay new-decay
  envelope-last-x env
  scale-envelope env scl (offset 0.0)
  reverse-envelope env
  concatenate-envelopes #:rest envs

These are translated from CLM's env.lisp. (envelope-interp x env base) returns value of env at x. If base is 0, env is treated as a step function; if base is 1.0 (the default), its breakpoints are connected by a straight line, and any other base connects the breakpoints with a kind of exponential curve:

:(envelope-interp .1 '(0 0 1 1))
0.1
:(envelope-interp .1 '(0 0 1 1) 32.0)
0.0133617278184869
:(envelope-interp .1 '(0 0 1 1) .012)
0.361774730775292

The corresponding function for a CLM env generator is env-interp. If you'd rather think in terms of e^-kt, set the base to (exp k).

window-envelope returns (as an envelope) the portion of its envelope argument that lies between the X axis values beg and end. This is useful when you're treating an envelope as a phrase-level control, applying successive portions of it to many underlying notes.

:(window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0))
(1.0 0.2 3.0 0.6)

map-envelopes applies its func argument to the breakpoints in the two envelope arguments, returning a new envelope. A simple application of this is multiply-envelopes which multiplies two envelopes:

:(multiply-envelopes '(0 0 1 1) '(0 0 1 1 2 0))
(0 0 0.5 0.5 1 0)

As this example shows, the new envelope goes from 0.0 to 1.0 along the X axis; the multiplied envelopes are stretched or contracted to fit 0.0 to 1.0, and wherever one has a breakpoint, the corresponding point in the other envelope is interpolated, if necessary. The code for multiply envelopes is simply:

(define multiply-envelopes
  (lambda (e1 e2)
    (map-envelopes * e1 e2)))

max-envelope returns the maximum Y value in env, and envelope-last-x returns the maximum X value:

:(max-envelope '(0 0 1 1 2 3 4 0))
3.0

integrate-envelope returns the area under the envelope; this is useful when you need to know in advance the overall effect of an envelope controlling the sampling rate, for example.

:(integrate-envelope '(0 0 1 1))
0.5
:(integrate-envelope '(0 1 1 1))
1.0
:(integrate-envelope '(0 0 1 1 2 .5))
1.25

stretch-envelope applies attack and optionally decay times to an envelope, much like divseg in clm-1.

:(stretch-envelope '(0 0 1 1) .1 .2)
(0 0 0.2 0.1 1.0 1)
:(stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6)
(0 0 0.2 0.1 1.1 1 1.6 0.5 2.0 0)

scale-envelope scales the y values of an envelope by scl, add-envelope adds two envelopes together, reverse-envelope reverses an envelope.

enved.scm

channel enveds
  start-enveloping
  stop-enveloping
  channel-envelope snd chn
  play-with-envs snd
  play-panned snd

enved.scm implements an independent envelope editor in each channel. (start-enveloping) sets this in progress (for subsequently opened sounds), (stop-enveloping) turns it off. Each envelope can be read or written via (channel-envelope snd chn). There are also two examples that use these envelopes: play-with-envs and play-panned. The former sets the channel's amplitude from its envelope during playback (it should be obvious how to apply the envelope to any of the control panel fields); the latter pans a mono sound into stereo following the envelope. The lines:

(define channel-envelope
  (make-procedure-with-setter
    (lambda (snd chn)
      ...)
    (lambda (snd chn new-env)
      ...)))

use a feature of Guile 1.4 that provides a set! function for channel-envelope. The first lambda is called if you're asking for the current value of that channel-envelope:

(channel-envelope s c)

and the second if you're setting it to something new:

(set! (channel-envelope s c) e)

event.scm

event.scm has functions used by snd-test.scm to exercise the user interface. These functions use the xm module and XSendEvent primarily, but there are also scheme implementations of some of the built-in functions (change-prop). Once the xg module is stable, I'll start moving most of the graphics extensions out of C and into Scheme.

examp.scm

examp.scm has become a bit of a grab-bag; rather than get organized, I just appended new stuff as it came to mind. The following documentation is mostly a quick overview of the code; most of the examples are very simple, so (as the saying goes) "the code is the documentation". Also, there's some overlap between these examples, other .scm files, and discussions in other documents. I'm slowly dividing out related groups of procedures to separate files.

filters

  comb-filter scaler size
  comb-chord scaler size amp
  zcomb scaler size pm
  notch-filter scaler size
  formant-filter radius frequency
  formants r1 f1 r2 f2 r3 f3
  moving-formant radius move-envelope
  osc-formants radius bases amounts freqs
  remove-click

The two versions of comb-filter implement a comb filter both "by hand" and using CLM. comb-chord uses comb filters at harmonically related sizes to create a chord (see also chordalize in new-effects.scm). amp here is an overall amplitude scaler. zcomb is a time-varying comb filter using the envelope pm. notch-filter parallels comb-filter. formant-filter applies a formant to its input. Some examples:

(map-chan (comb-filter .8 32))
(map-chan (comb-chord .95 100 .3))
(map-chan (comb-chord .95 60 .3))
(map-chan (zcomb .8 32 '(0 0 1 10)))
(map-chan (notch-filter .8 32))
(map-chan (formant-filter .99 2400))

In all these cases, however, it's actually much faster to pass the filter to filter-sound:

(filter-sound (make-formant .99 2400))

formants applies three formants in parallel. moving-formant moves a formant according to an envelope. osc-formants sets up any number of independently oscillating formants.

(map-chan (formants .99 900 .98 1800 .99 2700))
(map-chan (moving-formant .99 '(0 1200 1 2400)))
(map-chan (osc-formants .99 '(400 800 1200) '(400 800 1200) '(4 2 3)))
  filtered-env envelope

filtered-env creates an amplitude envelope and a one-pole filter, and moves them in parallel over a sound; as the sound gets softer, the low-pass filter's cutoff frequency gets lower, a sort of poor-man's distance effect. When envelope is at 1.0, no filtering takes place.

  fltit
  remove-clicks

fltit is a simple FIR filter call. remove-clicks looks for obvious clicks and uses smooth-sound to remove them.

ffts

  correlate snd chn y0 y1
  superimpose-ffts snd chn y0 y1
  fft-edit low-freq high-freq
  fft-env-edit env
  fft-env-interp env1 env2 interp
  fft-squelch squelch
  squelch-vowels
  fft-smoother cutoff start samps snd chn

correlate graphs the correlation of snd's 2 channels. To make this happen automatically as you move the time domain position slider, (add-hook! graph-hook correlate). superimpose-ffts is a similar graph-hook function that superimposes the ffts of multiple (syncd) sounds. fft-edit is a simple example of fft-based editing. It takes an fft of the entire sound, removes all energy below low-freq and above high-freq, then inverse fft's. fft-env-edit is the same, but applies an envelope to the spectral magnitudes; fft-env-interp takes two such filtered versions and mixes them following the interpolation envelope. Another similar function is fft-smoother that uses fft-filtering to smooth a portion of a sound. fft-squelch is similar, but removes all energy below the squelch amount (normalized to be between 0.0 and 1.0). This is sometimes useful for noise-reduction. squelch-vowels uses fft data to distinguish the steady state portion (a vowel in speech) from noise (a consonant, sometimes), and does whatever you want based on that (remove vowels, remove consonants, make consonants louder, etc). Finally there are two examples of using graph-hook to set the fft size based on the current time domain window size. The simpler one is:

(add-hook! graph-hook 
	   (lambda (snd chn y0 y1)
	     (if (and (graph-transform? snd chn) 
                      (= (transform-graph-type snd chn) graph-transform-once))
		 (begin
		   (set! (transform-size snd chn)
			 (expt 2 (ceiling 
				  (/ (log (- (right-sample snd chn) (left-sample snd chn))) 
				     (log 2.0)))))
		   (set! (spectro-cutoff snd chn) (y-zoom-slider snd chn))))))

The expt... code is rounding the current window size (right-sample - left-sample) up to the nearest power of 2.

user-interface

show-draggable-graph, in imitation of Snd's FFT display, implements a draggable X axis in the "lisp" graph window. (This is slightly messier than it ought to be). Two of the examples are imitations of Xemacs: a "Buffers" menu and an auto-save hook (now in autosave.scm).

  open-buffer filename
  close-buffer snd

The Buffers menu provides a list of currently open sounds; selecting one in the menu causes it to become the selected sound; open-buffer adds a menu item that will select a file, close-buffer removes it. To activate this, we need to:

(add-hook! open-hook open-buffer)
(add-hook! close-hook close-buffer)

A similar menu is the "reopen menu"; it presents a list of previously closed (and not subsequently re-opened) files in reverse order of closing.

  snd-out

A minor irritation in the current Guile system is that Scheme's "display" function writes to current-output-port, but there's no simple way to redirect that elsewhere (and with-output-to-string is not completely integrated with Guile's help system). So, if your code calls display, the result may be invisible. One way around this is to reset the current-output-port to be a "soft port" that actually calls snd-print instead:

(define stdout (current-output-port)) ;save it in case we want to go back to it
(define snd-out
  (make-soft-port
   (vector                      ;soft port is a vector of procedures:
    (lambda (c) (snd-print c))  ;  procedure accepting one character for output 
    (lambda (s) (snd-print s))  ;  procedure accepting a string for output 
    (lambda () #f)              ;  thunk for flushing output (not needed here)
    #f                          ;  thunk for getting one character (also not needed)
    (lambda () #f))             ;  thunk for closing port -- hmm should this go back to the previous?
   "w"))
(set-current-output-port snd-out)

You could also (set! display snd-print), if you're willing to live dangerously; this replaces Guile's built-in display procedure with Snd's snd-print. Another example of this is snd-debug.

There are also a few brief examples showing simple display customizations. For example, the following makes the graph dot size dependent on the number of samples in the graph:

  auto-dot snd chn y0 y1

(add-hook! graph-hook auto-dot)

There are also examples tying the channel graph sliders to the fft display. Finally there are several somewhat frivolous examples:

  title-with-date
  flash-selected-data time-interval

(title-with-date) adds a clock to the Snd window's title bar. Set the variable retitle-time to 0 to turn this off. flash-selected-data cause the selected channel's graph to flash red and green. And the there are functions to display colored text in rxvt:

(display (format #f "~Athis is red!~Abut this is not" red-text normal-text))
(display (format #f "~A~Ahiho~Ahiho" yellow-bg red-fg normal-text))

It's possible to use the same escape sequences in a normal shell script, of course:

echo '\e[41m This is red! \e[0m'

  files-popup-buffer

This is a mouse-enter-label-hook function for the View:Files dialog; it hides all sounds but the one the mouse is pointing to in the current files list. The "pointer-focus" style of interaction uses similar hooks. There is also a first stab at Emacs-like C-x b support here; the file name in the prompt should be a string (i.e. in quotes), unlike Emacs. This still needs work especially for multichannel sounds.

marks

marks.scm has most of the mark-related extensions. The two in examp.scm are:

  first-mark-in-window-at-left
  mark-loops

(bind-key (char->integer #\l) 0 
          (lambda () 
            (first-mark-in-window-at-left)))

first-mark-in-window-at-left moves the (time domain) graph so that the leftmost visible mark is at the left edge; mark-loops places marks at any loop points found in the selected sound's header. Only a few headers support loop points (these are apparently used in synthesizers to mark portions of a waveform that can be looped without causing clicks, thereby lengthening a sound as a key is held down).

selections

  all-chans
  swap-selection-channels
  selection-rms-1
  selection-rms
  region-rms region
  replace-with-selection
  explode-sf2

swap-selection-channels swaps the currently selected data's channels. The various rms functions return the rms value of the desired data in a variety of ways. The fastest and simplest uses CLM's dot-product function:

(define (region-rms n)
  "(region-rms n) -> rms of region n's data (chan 0)"
  (if (region? n)
      (let* ((data (region-samples->vct 0 0 n)))
	(sqrt (/ (dot-product data data) (vct-length data))))
      (throw 'no-such-region (list "region-rms" n))))

replace-with-selection replaces data at the cursor with the current selection. explode-sf2 turns a soundfont file (assuming it is the currently selected sound) into a bunch of files of the form sample-name.aif.

mixes

mix.scm has mix and track related functions.

  place-sound mono-snd stereo-snd panning-envelope-or-degree

If panning-envelope-or-degree is a number (in degrees), the place-sound function has the same effect as using CLM's locate generator; it mixes a mono sound into a stereo sound, splitting it into two copies whose amplitudes depend on the desired location. 0 degrees: all in channel 0, 90: all in channel 1. If panning-envelope-or-degree is an envelope, the split depends on the panning envelope (0 = all in chan 0, etc).

sound effects

Most of these sound effects are based on CLM generators.

  echo scaler secs
  zecho scaler secs frq amp      ; modulated echo
  flecho scaler secs             ; filtered echo
  ring-mod freq gliss-env        ; ring-modulation
  am freq                        ; amplitude modulation
  hello-dentist frq amp          ; randomized sampling rate changes
  fp sr osamp osfrq              ; osc-driven src ("Forbidden Planet")
  compand
  expsrc rate snd chn
  expsnd rate-envelope
  cross-synthesis cross-snd amp fftsize radius
  voiced->unvoiced amp fftsize r tempo
  cnvtest snd0 snd1 amp
  jc-reverb decay-dur low-pass volume amp-env
  "vector synthesis"	

expsrc uses sampling rate conversion (the src gen) and granular synthesis (granulate) to lengthen or shorten a sound without changing its pitch. The same idea is used in the effects menu. expsnd is the same but the change follows an envelope. In cross-synthesis, cross-snd is the index of the sound that controls the spectra, not the affected sound. voiced->unvoiced is essentially the same idea, but drives the synthesis with white noise. cnvtest demonstrates convolution. jc-reverb is an old Mus10 reverberator written originally by John Chowning; see jcrev.ins in CLM. Here are some sample calls:

(map-chan (echo .5 .5) 0 44100)
(map-chan (zecho .5 .75 6 10.0) 0 65000)
(map-chan (flecho .5 .9) 0 75000)
(map-chan (ring-mod 100 '(0 0 1 0)))
(map-chan (ring-mod 10 (list 0 0 1 (hz->radians 100))))
(map-chan (am 440))
(hello-dentist 40.0 .1)
(fp 1.0 .3 20)
(map-chan (compand))
(expsnd '(0 1 2 .4))
(expsnd '(0 .5 2 2.0))
(map-chan (cross-synthesis 1 .5 128 6.0))
(voiced->unvoiced 1.0 256 2.0 2.0)
(cnvtest 0 1 .1)
(jc-reverb 2.0 #f .1 #f)

There are lots more sound effects scattered around the Snd distribution. "vector synthesis" cycles through a collection of incoming audio streams, playing whatever happens to be on the chosen one, with fade-ins and fade-outs to avoid clicks.

synthesis

The synthesis examples are taken primarily from CLM:

  scissor begin-time
  fm-violin ...many args...
  fofins ...many args...
  pluck start dur freq amp weighting lossfact
  voxbeg dur freq amp ampfun freqfun freqscl voxfun index vibscl

scissor synthesizes the squawk of the scissor-tailed flycatcher (state bird of Oklahoma, Tyrannus forficatus); see bird.scm for more birds. The fm-violin is discussed in v.scm. fofins is an implementation of FOF synthesis, taken originally from fof.c of Perry Cook and the article "Synthesis of the Singing Voice" by Bennett and Rodet in "Current Directions in Computer Music Research" (MIT Press). pluck is based on the Karplus-Strong algorithm as extended by David Jaffe and Julius Smith -- see Jaffe and Smith, "Extensions of the Karplus-Strong Plucked-String Algorithm" CMJ vol 7 no 2 Summer 1983, reprinted in "The Music Machine". Another physical model is Nicky Hind's flute in flute.scm. vox is a translations of Marc LeBrun's MUS10 waveshaping voice instrument using FM in this case. The waveshaping version can be found in pqwvox.scm.

miscellaneous extensions

  finfo filename
  shell cmd
  mpg mpgfile rawfile 

finfo returns a description of the file filename. shell is similar to Guile's system function, but output is sent to Snd's listener, rather than stdout. mpg uses the system function to call the program mpg123 to translate an MPEG format sound file to a headerless ("raw") file containing 16-bit samples.

(shell "df")
(add-hook! close-hook (lambda (snd) (shell \"sndplay wood16.wav\")))
(mpg "mpeg.mpg" "mpeg.raw")

Presumably a similar function could be written to call TiMidity to translate MIDI files to something Snd can read, but I'm not having any luck getting it to work.

Several of the functions in this section are slight robustifications of the corresponding code in extsnd.html. These include:

  do-chans func origin
  do-all-chans func origin
  do-sound-chans func origin
  update-graphs
  every-sample? func
  sort-samples bins
  window-samples snd chn
  display-energy snd chn y0 y1
  window-rms
  no-startup-file? ind file
  fft-peak snd chn scale

do-chans applies func to all syncd channels using origin as the edit history indication. do-all-chans is the same but applies func to all active channels. do-sound-chans applies func to all selected channels. update-graphs updates (redraws) all graphs. every-sample? applies func to each sample in the current channel and returns #t if func is not #f for all samples; otherwise it moves the cursor to the first offending sample. sort-samples provides a histogram of the samples (by amplitude) in bins bins. window-samples returns (via the function samples) the samples displayed in the current window for snd's channel chn. display-energy is a graph-hook function to display the time domain data squared. window-rms returns the rms of the data in currently selected graph window. no-startup-file? is a start-hook function that causes Snd to exit immediately if a file is specified on Snd's invocation line, but that file doesn't exist. fft-peak is a transform-hook function that returns the peak spectral magnitude.

  locate-zero limit

locate-zero looks for the next sample where adjacent samples together are less than limit and moves the cursor to that sample. It can be interrupted by C-g.

  make-sound-interp start &optional snd chn
  sound-interp reader loc
  env-sound-interp envelope &optional (time-scale 1.0) snd chn) 

make-sound-interp returns an interpolating reader for snd's channel chn. The "interpolating reader" reads a channel at an arbitary location, interpolating between samples if necessary. The corresponding "generator" is sound-interp. The function test-interp shows one way to use this, using a sine wave to lookup the current sound. env-sound-interp reads snd's channel chn (via a sound-interp generator) according to envelope and time-scale. It takes an envelope that goes between 0 and 1 (y-axis), and a time-scaler (1.0 = original length) and returns a new version of the data in the specified channel that follows that envelope (that is, when the envelope is 0 we get sample 0, when the envelope is 1 we get the last sample, envelope = .5 we get the middle sample of the sound and so on). (env-sound-interp '(0 0 1 1)) returns a copy of the current sound; (env-sound-interp '(0 0 1 1 2 0) 2.0) returns a new sound with the sound copied first in normal order, then reversed. src-sound with an envelope could be used for this effect, but it is much more direct to apply the envelope to sound sample positions.

  search-for-click
  zero+
  next-peak
  find-pitch pitch

These are examples of searching procedures (to be used with C-s and so on). zero+ finds the next positive-going zero crossing (if searching forwards), next-peak finds the next max or min in the waveform, and find-pitch finds the next place where the given pitch is predominate.

  sound-data->list sdata

This converts a sound-data object into a list of lists, each inner list holding the samples of one channel.


extensions.scm

These were originally scattered around examp.scm; I thought it would be more convenient if they were in one file.

  channel-property key snd chn
  sound-property key snd

  time-graph-style snd chn
  transform-graph-style snd chn
  lisp-graph-style snd chn

  snd-debug
  read-listener-line prompt
  snd-trace

  make-selection &optional beg end snd chn
  delete-selection-and-smooth
  eval-over-selection func snd
  selection-members

  map-sound-files func &optional dir
  for-each-sound-file func &optional dir
  match-sound-files func &optional dir

  normalized-mix filename beg in-chan snd chn
  enveloped-mix filename beg env
  enveloped-mix-1 filename beg env

  check-for-unsaved-edits on
  remember-sound-state

  mix-channel filedat beg dur snd chn edpos
  insert-channel filedat beg dur snd chn edpos
  c-channel func beg dur snd chn edpos

channel-property returns the value associated with key in the given channel's property list. To add or change a property, use set! with this procedure. Similarly, sound-property provides access to a sound's property list.

The graph-style functions provide accessors for the channel-specific graph styles. Each is of the form:

(define time-graph-style
  (make-procedure-with-setter
   (lambda (snd chn)
     (logand (graph-style snd chn) #xff))
   (lambda (snd chn val)
     (set! (graph-style snd chn)
	   (logior (logand (graph-style snd chn) #xffff00)
		   val)))))

This uses the generalized set! support in Guile; make-procedure-with-setter takes two arguments, the reader and the writer of the field. The reader picks off the bits that are of interest (in this case (logand (graph-style snd chn) #xff)); the writer sets those bits without affecting the other two fields. Normally all three fields are accessed at the same time (by graph-style). To return to this mode after setting a specific field, set that field to -1.

:graph-dots
1
:(set! (transform-graph-style 0 0) graph-dots) ;now the time-domain uses lines, the fft dots
512
:(transform-graph-style 0 0)
1
:(time-graph-style 0 0)
0
:(set! (transform-graph-style 0 0) -1)
0
:(transform-graph-style 0 0)
0

In snd-debug we're redirecting the Guile debugger's stdin and stdout IO via a read-write soft-port and Snd's read-hook. If you hit an error, call (snd-debug) rather than (debug). read-listener-line is somewhat like read-line but gets its input from the listener. snd-trace activates any tracing that you may have requested and redirects its output to the Snd listener.

selection-members returns a list of lists of (snd chn) indicating the channels participating in the current selection. It is very similar to all-chans which returns a list of lists of all (snd chn)'s. delete-selection-and-smooth deletes the current selection and smooths the splice.

eval-over-selection evaluates func on each sample in the current selection. The code:

(bind-key (char->integer #\x) 4
	  (lambda ()
	    (if (selection?)
		(prompt-in-minibuffer "selection eval:" eval-over-selection)
		(report-in-minibuffer "no selection")))
	  #t)

binds the key sequence C-x x to a function that checks for an active selection, then prompts (in the minibuffer) for the function to apply, and when the user eventually replies with a function, applies that function to each sample in the selection. make-selection makes a selection (like make-region but without creating a region).

map-sound-files applies func to each sound file in dir. match-sound-files applies func to each sound file in dir and returns a list of files for which func does not return #f.

(for-each-sound-file
  (lambda (n) 
    (if (> (mus-sound-duration n) 10.0) 
      (snd-print n)))
  (sound-files-in-directory "."))

We can use Guile's regexp support here to search for all .snd and .wav files:

(let ((reg (make-regexp "\\.(wav|.snd)$")))
  (match-sound-files (lambda (file) (regexp-exec reg file))))

In fact, we could replace the built-in procedures add-sound-file-extension and sound-files in directory. We're using some procedures written by Dirk Herrman here.

(define (filter-list pred? objects)
  (let loop ((objs objects)
	     (result '()))
    (cond ((null? objs) (reverse! result))
	  ((pred? (car objs)) (loop (cdr objs) (cons (car objs) result)))
	  (else (loop (cdr objs) result)))))

(define (grep rx strings)
  (let ((r (make-regexp rx)))
    (filter-list (lambda (x) (regexp-exec r x)) strings)))

(define (directory->list dir)
  (let ((dport (opendir dir)))
    (let loop ((entry (readdir dport))
	       (files '()))
      (if (not (eof-object? entry))
	  (loop (readdir dport) (cons entry files))
	  (begin
	    (closedir dport)
	    (reverse! files))))))

;;; and now the Snd replacements
(define sound-file-extensions (list "snd" "aiff" "aif" "wav" "au" "aifc" "voc" "wve"))

(define (add-sound-file-extension-1 ext) 
  (set! sound-file-extensions (cons ext sound-file-extensions)))

(define* (sound-files-in-directory-1 #:optional (dir "."))
  (sort (grep
	 (format #f "\\.(~{~A~^|~})$" sound-file-extensions)
	 (directory->list dir))
	string<?))

normalized-mix is like mix but the mixed result has same peak amplitude as the original data. enveloped-mix is like mix-sound, but includes an amplitude envelope over the mixed-in data.

(enveloped-mix "pistol.snd" 0 '(0 0 1 1 2 0))

check-for-unsaved-edits adds functions to the exit-hook and close-hook to check for unsaved edits before exiting Snd or closing a file. If its argument is #f, it removes those hooks.

remember-sound-state saves most of a sound's display state when it is closed, and if that same sound is subsquently re-opened, restores the previous state.

mix-channel is a "regularized" version of the file mixing functions (mix and mix-sound). It's first argument can be either a filename (a string) or a list containing the filename, the start point in the file, and (optionally) the channel of the file to mix. For example:

  (mix-channel "pistol.snd")
  (mix-channel "pistol.snd" 10000)       ; mixing starts at sample 10000 in current sound
  (mix-channel (list "pistol.snd" 1000)) ; mixed data starts at sample 1000 in pistol.snd
  (mix-channel (list "2.snd" 0 1))       ; mixed data reads channel 1 in 2.snd

insert-channel is the same as mix-channel, but inserts the specified data. c-channel calls a raw C function, passing it the current sample as a float.



fmv.scm

fmv.scm implements the fm-violin (v.scm) as a CLM-style generator, making it possible to call the violin anywhere a generator could be called; since each call on the fm-violin function produces the next sample of the given violin, this form of the fm-violin is easy to call in "real-time" situations. Any other CLM-style instrument could be rewritten in the same form.

  make-fm-violin
    frequency amplitude #:key (fm-index 1.0) (amp-env #f) (periodic-vibrato-rate 5.0) (random-vibrato-rate 16.0)
    (periodic-vibrato-amplitude 0.0025) (random-vibrato-amplitude 0.005) (noise-amount 0.0) (noise-freq 1000.0)
    (ind-noise-freq 10.0) (ind-noise-amount 0.0) (amp-noise-freq 20.0) (amp-noise-amount 0.0) (gliss-env #f)
    (fm1-env #f) (fm2-env #f) (fm3-env #f) (fm1-rat 1.0) (fm2-rat 3.0) (fm3-rat 4.0) (fm1-index #f) (fm2-index #f) 
    (fm3-index #f) (base 1.0) #:allow-other-keys)

  fm-violin gen
  fm-violin-ins [same args as original violin in v.scm]

fm-violin-ins shows how this generator can be fitted into the original fm-violin code. The make-fm-violin function uses the optional arguments support from Guile (optargs.scm, loaded via (use-modules (ice-9 optargs))). The plethora of arguments is an historical artifact; normally only a few of them are used at a time. There are two examples of calling this generator in fmv.scm, the simpler one being:

(define test-v 
  (lambda (beg dur freq amp amp-env)
    (let ((v (make-fm-violin 
	      freq amp 
	      :amp-env (let ((e (make-env :envelope (or amp-env '(0 0 1 1 2 0)) 
					  :scaler amp 
					  :end dur)))
			 (lambda () (env e)))))
	  (data (samples->vct beg dur)))
      (do ((i 0 (1+ i)))
	  ((= i dur))
	(vct-set! data i (+ (vct-ref data i)
			    (v))))
      (set-samples beg dur data))))

Here we are setting up an fm-violin generator (via make-fm-violin), then calling it dur times, mixing its output into the current data (this could also use mix-vct and so on). The generator is called via (v). As can be seen here, each envelope is treated as a function called on each sample very much like the "as-needed" input in src or granulate; the envelopes could actually be any arbitrary function you like (see test-v1 in fmv.scm which uses an oscillator as one of the fm index envelopes). One complication in some "real-time" situations is that you don't know in advance how long a note will be; in this case, the envelope generating functions should have attack and decay ramps, triggered by note-on and note-off; once the ramp has reached its end point, the end value should be held; the note itself should be called until it has had time to ramp off; an exercise for the interested reader.

glfft.scm

  start-gl
  stop-gl
  cleanup-gl

glfft.scm and glfft.c implement a way for Snd to display spectra using OpenGL. Due to the way Mesa (the open source OpenGL) connects with the X server, I decided not to try to imbed this in Snd itself. Snd and glfft communicate through shared files, one being a "lock" file and the other containing the data to be displayed. Snd writes "glfft.data", then "glfft.lock". glfft (the reader) waits until it sees glfft.lock, then reads glfft.data and deletes both files. If Snd has data ready to go but sees glfft.lock, it does not try to write glfft.data (it assumes glfft is reading the previous version). The OpenGL code in glfft.c is very primitive; someday I'll learn about OpenGL, or even better some OpenGL expert will take a look at it! To use this code, build glfft.c, invoke glfft, go to Snd, set up a spectrogram, and (start-gl). (stop-gl) turns it off. (cleanup-gl) calls stop-gl and then removes the glfft communication files.

gm.scm

gm.scm provides a simple way to get gmeteor to run in Snd. See Snd with gmeteor for details.

goopsnd.scm

goopsnd.scm goofs around with goops, the Guile Object System. As it stands, it might provide simple examples of goops syntax, but I'm not sure it's of any value yet. There are days when it seems to me that there must be something neat we could do here.

hooks.scm

  describe-hook hook
  with-local-hook hook local-hook-procs thunk
  reset-all-hooks
  snd-hooks

hooks.scm has various hook-related functions. describe-hook tries to decipher the functions on the hook list. with-local-hook is a kind of "let" for hooks. snd-hooks returns a list of all Snd-specific hooks; this is used by reset-all-hooks which returns all hooks to the empty state.

index.scm

  *html-reader* "netscape"
  html obj
  ? obj

index.scm provides a connection between an HTML reader (default: netscape, determined by the value of *html-reader*) and the Snd documentation. The index itself is built by index.cl, then accessed through the html and ? functions. (html arg) where arg can be a string, symbol, or procedure looks for a corresponding url in the various Snd documents, and if one is found, calls *html-reader* with it. (? obj) prints out any help it can find for obj, and tries to find obj in the documentation. The function that actually passes the url to the reader is send-netscape defined in snd-gxutils.c. Since it uses X window properties specific to netscape, it's not obvious how any other HTML reader can work. All the following forms are acceptable:

  (html "open-sound")
  (html 'open-sound)
  (html open-sound)

Similarly, (c? arg) tries to find and print out the location of the C code that defines arg.

marks.scm

marks.scm is a collection of mark-related functions.

  mark-name->id name
  describe-mark id
  syncup ids
  fit-selection-between-marks m1 m2
  pad-marks ids secs
  move-syncd-marks sync samples-to-move
  play-syncd-marks sync
  eval-between-marks func snd
  snap-marks
  define-selection-via-marks m1 m2
  snap-mark-to-beat

mark-name->id is like find-mark but searches all currently accessible channels. describe-mark returns a description of the movements of mark id over the channel's edit history:

:(describe-mark 0)
((mark 0 sound 0 "oboe.snd" channel 0) 654 478)

Here I placed a mark in oboe.snd at sample 654, then deleted a few samples before it, causing it to move to sample 478. pad-marks inserts secs seconds of silence before each in a list of marks (ids). fit-selection-between-marks tries to squeeze the current selection between two marks, using the granulate generator to fix up the selection duration (this still is not perfect). syncup synchronizes a list of marks by inserting silences as needed. move-syncd-marks moves any marks sharing the sync value sync by samples-to-move samples. Similarly, play-syncd-marks starts playing from all marks sharing its sync argument.

marks.scm also has code that tries to make it simpler to sync marks together (see start-sync and stop-sync), and report-mark-names that causes any named mark to display its name in the minibuffer when the underlying sample happens to be played. There are also many mark-related functions in examp.scm and scattered around the documentation.

eval-between-marks evaluates func between the leftmost marks in snd.

(bind-key (char->integer #\m) 0 
	  (lambda ()
	    (prompt-in-minibuffer "mark eval:" eval-between-marks)))

snap-marks places marks at the start and end of the current selection. define-selection-via-marks selects the portion between the given marks. snap-mark-to-beat forces a dragged mark to end up on a beat.

mix.scm

mix.scm provides various mix-related utilities, including support for "tracks". The latter were originally called groups in Snd, with their own elaborate dialog and what-not. That was jettisoned soon after it was written. The next thing to go were the "mix consoles" -- originally each mix encapsulated the current Mix Panel in a little (but incredibly complicated) widget set that followed the mix around in the time domain graph. This was too hard to implement in Gtk+, and too hard to use in any case. The current version has only the "tag" to drag a mix around, the Mix Panel to set mix amplitudes and so on, and a bunch of hooks. These hooks are used in mix.scm to implement one view of "tracks", which I assume are groups of related mixes (I've actually never looked at a "real" sound editor to find out what all the fuss is about).

  mix-name->id name
  mix->vct id
  pan-mix file frame env
  snap-mix-to-beat
  delete-mix id
  delete-all-mixes
  delete-track id
  delete-all-tracks
  set-all-tracks new-id

These are the mix utilities in mix.scm (unrelated to tracks). mix-name->id returns the id of a given (named) mix. mix->vct returns the current samples of mix id (taking into account its current amplitude an so on). pan-mix mixes file into the current (stereo) sound starting at frame using the envelope env to pan the mixed samples (0: all chan 0, 1: all chan 1). snap-mix-to-beat forces a dragged mix to end up on a beat. delete-mix deletes the mix referred to by its argument; this operation can be undone (bringing the mix back to life).

picture of panning
  make-track id mixes
  track id
  track->vct track
  save-track track filename

  track-color track
  set-track-color track color
  set-track-amp track amp
  incf-track-amp track amp-increment
  set-track-speed track speed
  transpose-track track semitones
  track-position track
  set-track-position track position
  track-end track
  track-length track
  set-track-tempo track tempo
  set-track-amp-env track chan env
  reverse-track track
  filter-track track coeffs

A track is a list of mixes, each member mix having its track set to the track id. The make-track function takes the track id and the list of member mixes, returning the list of mixes. Thereafter, the track function returns the mix list given the track id. The rest of the track functions take the track mix list as their initial argument. track->vct places all the mix samples in the track into a vct object. Similarly, save-track places the track's samples into a file.

The track-color refers to the color of the mix waveform (the thing displayed to the right of the red tag). set-track-color sets this color using Snd colors.

  
:(define hi (make-track 1 (list 0 1)))
#<unspecified>
:(track 1)
(0 1)
:(mix-track 0)
1
:(set-track-color (track 1) (make-color 0 0 1))
(#<color: (0.00 0.00 1.00)> #<color: (0.00 0.00 1.00)>)

The track-position is the position (begin sample) of the first mix in the track. set-track-position moves all the mixes in the track so that its first sample is position:

:(track-position (track 1))
10748
:(mix-position 0)
10748
:(mix-position 1)
23287
:(set-track-position (track 1) 1500)
(1500 14039)
:(mix-position 0)
1500
:(mix-position 1)
14039

The track-amp reflects the mix amps (unless you set them individually, but I guess that quibble is true of all these settings). set-track-amp sets each mix channel's chan amplitude to amp. Similarly, incf-track-amp increments each amplitude by amp-increment. The track-speed refers to its mix's speeds: set-track-speed sets all of them to speed, and transpose-track moves them all by semitones. track-length returns the total duration (samples) of the track, track-end returns the last sample:

:(track-length (track 1))
16346
:(- (+ (mix-position 1) (mix-length 1)) (mix-position 0))
16346
:(track-end (track 1))
17846
:(max (+ (mix-position 0) (mix-length 0)) (+ (mix-position 1) (mix-length 1)))
17846

set-track-tempo affects the time between the successive mix begin points (tempo > 1.0 makes the mixes happen more quickly):

:(set-track-tempo (track 1) 2.0)
(1500 7770)
:(mix-position 0)
1500
:(mix-position 1)
7770
:(+ 1500 (* .5 (- 14039 1500))) ; 14039 is the former mix 1 begin time (see above)
7769.5

set-track-amp-env applies an amplitude envelope over the entire track, setting each mix's amp env(s) to match the portion of that envelope that happens to fall over them (multiplying envelopes if the mix aready has one). filter-track applies a filter to each mix sound at the pre-mix point (that is, the mixed in sound is being edited, then the mix takes place); any kind of edit can follow the same sequence. reverse-track reverses the order in which a track's members occur.

Finally, the various mix hooks can be tied into these functions so that (for example) the entire track moves when you drag one mix in it, or all the amplitudes change at once. sync-multichannel-mixes causes multichannel mixes to be syncd together automatically (this is normally what people expect). Most of the "set-" functions also exist in the generalized set! form, for example (set! (track-position trk) 0).

moog.scm

  make-moog-filter frequency Q
  moog-filter gen input

moog.scm is a translation of CLM's moog.lisp (written by Fernando Lopez-Lezcano -- http://www-ccrma.stanford.edu/~nando/clm/moog), itself a translation of Tim Stilson's original C code. The functions provide a kind of CLM generator view of the filter. Fernando describes it as a "Moog style four pole lowpass (24db/Oct) filter clm unit generator, variable resonance, warm, analog sound ;-)". In make-moog-filter "frequency" is the cutoff frequency in Hz (more or less) and "Q" is the resonance: 0 = no resonance, 1 causes the filter to oscillate at frequency. My translation is a bit simple-minded; with a little effort, this could run much faster.

  (define (moog freq Q)
    (let ((gen (make-moog-filter freq Q)))
      (lambda (inval)
        (moog-filter gen inval))))

  (map-chan (moog 1200.0 .7))

musglyphs.scm

musglyphs.scm provides Scheme/Snd wrappers to load CMN's cmn-glyphs.lisp (directly!), thereby defining most of the standard music notation symbols. Each of the original functions (e.g. draw-bass-clef) becomes a Snd/Scheme procedure of the form (name &optional x y size style snd chn context). For example, (draw-bass-clef 100 100 50) draws a bass clef in the current graph at position (100 100) of size 50; since the style argument defaults to #f, the clef is displayed as a filled polygon; use #t to get an outline of the clef instead. You need CMN, or at least the CMN file cmn-glyphs.lisp before loading this file.

Snd with music symbols

(The dot size bug in this picture has been fixed, but I'm too lazy to make a new version of the picture).


nb.scm

nb.scm provides "popup" help for files in the View:Files dialog; as you move the mouse through the lists, the help dialog posts information about the file underneath the mouse. This uses a slightly fancier file information procedure than 'finfo' in examp.scm. If you have the guile-gdbm package, you can use its database procedures to associate arbitrary information with files which will be posted along with the header info:

  nb file note
  unb file
  prune-db

(nb "test.snd" "this is a test") adds the note "this is a test" to the data associated with "test.snd". (unb "test.snd") erases anything associated with "test.snd". (prune-db) erases anything associated with any files that no longer exist. (nb.scm will work fine without guile-gdbm; to load guile-gdbm, set the variable use-gdbm to #t).

peak-env.scm

The functions in peak-env.scm provide relatively robust access to peak envelope files. These files save Snd's overall amplitude envelopes for a given sound so that a subsequent re-open of that sound has the waveform immediately. For very large sounds, this can save as much as a minute during which Snd is running the amplitude envelope builders in the background and displaying whatever it can. That is, it makes opening a large sound much faster after the initial read and save. The file has a variable save-peak-env-info (default #t) which determines whether these envelopes are being saved. The procedure

(define (peak-env-info-file-name snd chn)	
  (format #f "~A/~A-peaks-~D" save-peak-env-info-directory (short-file-name snd) chn))

determines the saved peak env file name; in the default case, it looks for the directory ~/peaks, but obviously this could be changed to suit your situation.

play.scm

These functions play sounds in various ways.

  playsound func

play-sound plays the current sound, calling (func data) on each buffer if func is passed. It is also an example of calling the low level mus-audio functions, rather than calling play-channel and friends. The latter are easier to use, in most cases. For example, to set up the keyboard as a kind of extended piano, we could map keys to sounds:

(bind-key (char->integer #\o) 0 (lambda () (play "oboe.snd")))
(bind-key (char->integer #\p) 0 (lambda () (play "pistol.snd")))

The various play hooks can be used to play sounds over and over.

  play-often times
  play-until-c-g
  play-region-forever region

(bind-key (char->integer #\p) 0 (lambda (n) (play-often (max 1 n))))
(bind-key (char->integer #\r) 0 (lambda (n) (play-region-forever (max 0 n))))

Now C-u 31 p plays the current sound 31 times; C-u 3 r plays region 3 until we type C-g. play-often uses stop-playing-hook, and play-region-forever uses stop-playing-region-hook. With a sufficiently fast computer, it's possible to create the samples to be played in "real-time". play-fun starts and stops the DAC, ampit and amprt fill up the audio buffer with data.

(play-fun (ampit (frames) 2.0) 256)

scales sound 0's samples by 2 and sends them to the DAC. (These three functions are now obsolete). More useful is:

  loop-it mark1 mark2 buffer-size

which loops continuously between the two specified marks. The marks can be moved as the sound is played; C-g stops loop-between-marks. If you want the DAC to be held open in the background,

  start-dac
  stop-dac

The "vector-synthesis" idea (and weird name) came from a linux-audio-development mailing list. Apparently some commercial synths (or software?) provide this. It reads any number of sound files, using a function to decide which one to send to the DAC.

popup.scm

  add-selection-popup 
  add-listener-popup 

add-selection-popup creates a selection-oriented popup menu that is posted if you click button3 in the selected portion, as well as a time-domain popup menu, and an fft-specific menu. add-listener-popup creates a listener-oriented popup menu that is posted if you click button3 in the listener.

pqwvox.scm

  pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes

pqwvox ("phase-quadrature waveshaping voice") was originally written by Marc LeBrun in the late 70's using waveshaping. It was changed to use FM for the Samson Box since the box had trouble performing waveshaping, then changed back to waveshaping in this version. The basic idea is that each of the three vocal formants is created by two sets of waveshapers, one centered on the even multiple of the base frequency closest to the desired formant frequency, and the other on the nearest odd multiple. As the base frequency moves (vibrato, glissando), these center frequencies are recalculated (one each sample), and the respective amplitudes set from the distance to the desired frequency. If a center frequency moves (for example, the base frequency moves down far enough that the previous upper member of the pair has to become the lower member), the upper waveshaper (which has ramped to zero amplitude), jumps down to its new center. The formant table was provided by Robert Poor. The "phase-quadrature" part of the business creates single side-band spectra. For details on waveshaping, see Le Brun, "Digital Waveshaping Synthesis", JAES 1979 April, vol 27, no 4, p250. It might be simpler to set up three formant generators and drive them with the waveshapers, but the "leap-frog" idea was a neat hack -- such things are worth keeping even when they aren't all that sensible anymore. (Also, I noticed while writing this paragraph that the single-sideband cancellation is not working as I expected -- another bug to track down...)

prc95.scm

prc95.scm is a translation to Snd of Perry Cook's (1995) physical modelling toolkit; prc-toolkit95.lisp in CLM. One starting point for physical modelling is Smith, "Music Applications of Digital Waveguides", CCRMA, Stan-M-39, 1987, or Julius's home page, or any of several classic papers also by Julius Smith. Perry's own version of this code can be found in STK. The example instruments are:

  plucky beg dur freq amplitude maxa
  bow beg dur frq amplitude maxa
  brass beg dur freq amplitude maxa
  clarinet beg dur freq amplitude maxa
  flute beg dur freq amplitude maxa

(define (test-prc95)
  (plucky 0 .3 440 .2 1.0)
  (bow .5 .3 220 .2 1.0)
  (brass 1 .3 440 .2 1.0)
  (clarinet 1.5 .3 440 .2 1.0)
  (flute 2 .3 440 .2 1.0))

pvoc.scm

This is the same as the CLM phase-vocoder generator, but implemented in Scheme. If you're interested in how the thing works, I think the Scheme version is easiest to understand; the Common Lisp version is in mus.lisp, and the C version is in clm.c.

  make-pvocoder fftsize overlap interp analyze edit synthesize
  pvocoder gen input
  pvoc #:key (fftsize 512) (overlap 4) (time 1.0) (pitch 1.0) (gate 0.0) (hoffset 0.0) (snd 0) (chn 0)

The analyze, edit, and synthesize arguments to make-pvocoder are functions that are applied as needed during pvocoder processing; similarly, the input argument to pvocoder can be a function. pvoc.scm also contains a few examples of using the CLM phase-vocoder generator. For example:

(define test-pv-4
  (lambda (gate)
    (let ((pv (make-phase-vocoder #f
				  512 4 128 1.0
				  #f ;no change to analysis
				  (lambda (v)
				    (let ((N (mus-length v)))
				      (do ((i 0 (1+ i)))
					  ((= i N))
					(if (< (pv-ampinc v i) gate)
					    (set-pv-ampinc v i 0.0)))
				      #t))
				  #f ;no change to synthesis))
	  (reader (make-sample-reader 0)))
      (map-chan (lambda (val)
		  (phase-vocoder pv (lambda (dir) 
				      (reader)))))
      (free-sample-reader reader))))

sets up a phase-vocoder generator whose edit function is squelching soft partials. In this case, the input function is reading the currently selected channel. The fastest way to try out this generator is to use it as the argument to filter-sound. I can't think of good names for the internal arrays (such as pv-ampinc above). pvoc is yet another a phase-vocoder; it applies the phase-vocoder (i.e. fft analysis, oscil bank resynthesis) to the current sound; pitch specifies the pitch transposition ratio, time specifies the time dilation ratio, gate specifies a resynthesis gate in dB (partials with amplitudes lower than the gate value will not be synthesized), hoffset is a pitch offset in Hz.

rgb.scm

rgb.scm is a simple translation of the standard X11 color names into Snd color objects.

(define snow (make-color 1.00 0.98 0.98))

is taken from the line

255 250 250             snow

/usr/lib/X11/rgb.txt. The choice of a float between 0.0 and 1.0 (rather than an integer between 0 and 255) mimics PostScript; as video hardware has improved over the years, there's less and less need for these elaborate color names, and less reason (except perhaps psychophysical) to limit these numbers to bytes. There is one gotcha in this file -- X11 defines a color named "tan" which is already used by Scheme, so (at the suggestion of Dave Phillips) this color is named "tawny" in rgb.scm.

rtio.scm

rtio.scm has a collection of functions oriented loosely around "real-time" operations.

  show-input &optional (in-sys 0)
  show-input-fft &optional (in-sys 0)
  show-draggable-input-fft &optional (in-sys 0)
  in-out func in-sys out-sys

These three functions show how to read incoming data (from the adc), write data (to the dac), and interpose a function while reading and writing data. There are several example functions (for the "func" argument) that filter the data or change its amplitude. show-input-fft displays the input data's spectrum. show-draggable-input-fft is the same, but the X axis (the frequency axis in this case) is draggable, as in Snd's FFT display.

rubber.scm

  rubber-sound stretch-factor

rubber-sound tries to stretch or contract a sound (in time); it scans the sound looking for stable (periodic) sections, then either deletes periods or interpolates new ones to shorten or lengthen the sound. It still needs a lot of robustification. The algorithm is 1) remove all frequencies below 16 Hz, 2) resample the file to be ten times longer (interpolating samples), 3) make a list of upward zero crossings, 4) using autocorrelation decide where the next fundamental zero crossing probably is and see how much difference there is between the current period and the next, 5) check intermediate crossing weights and if the autocorrelation weight is not the smallest, throw away this crossing, 6) sort the remaining crossings by least weight, 7) interpolate or delete periods until the sound has been sufficiently lengthened or shortened.

snd4.scm

The Snd-4 compatibilty file contains a number of the procedures that were removed from or renamed in Snd-5.

snd-motif.scm

  install-searcher proc
  zync 
  for-each-child w func
  make-hidden-controls-dialog 
  create-fmv-dialog 
  make-pixmap strs
  display-scanned-synthesis 
  disable-control-panel 
  add-mark-pane 
  select-file func title dir filter help
  snd-clock-icon snd hour
  make-sound-box name parent select-func peak-func sounds args
  show-smpte-label on-or-off
  make-level-meter parent width height
  show-disk-space
  keep-file-dialog-open-upon-ok
  add-amp-controls
  add-very-useful-icons
  add-delete-option, add-rename-option
  mark-sync-color new-color
  add-tooltip widget tip
  menu-option menu-name

snd-motif.scm has procedures that rely on the Motif module (xm.c). install-searcher places our own search procedure into the "filter" mechanism in the File:Open dialog. The pair zync and unzync cause the y-axis zoom sliders of a multi-channel file to move together or separately. make-hidden-controls-dialog adds "Hidden controls" to the Option menu. If you click it, it creates a dialog that controls all the "hidden" control-panel variables. The "expand-hop" control sets the hop size (per grain), "expand-length" sets the grain length, "expand-ramp" sets the slope, essentially, of the grain amplitude envelope, "contrast-amp" sets the prescaler for the contrast effect, "reverb-feedback" sets the feedback amount in the reverberator (it sets all the comb filter scalers), and "reverb-lowpass" sets the lowpass filter coefficient in the reverberator. create-fmv-dialog sets up a very simple dialog with amplitude control on the fm-violin (fmv.scm) running (interpreted!) in "real-time". make-pixmap turns xpm-style description into pixmap. display-scanned-synthesis opens a pane for experimenting with scanned synthesis. disable-control-panel does away with the control panel. add-mark-pane adds a pane to each channel giving the current mark locations (sample values). These can be edited to move the mark, or deleted to delete the mark. select-file starts a file selection dialog, running func if a file is selected.

 (add-to-menu 0 "Insert File" 
   (lambda () 
     (select-file 
       (lambda (filename)
         (insert-sound filename))
       "Insert File" "." "*" "file will be inserted at cursor")))

snd-clock-icon replaces Snd's hourglass with a clock. make-sound-box makes a container of sound file icons, each icon containing a little sketch of the waveform, the length of the file, and the filename. What happens when an icon is selected is up to the caller-supplied procedure.

(make-sound-box "sounds"
		(list-ref (main-widgets) 3)
		(lambda (file) (snd-print file))
		peak-env-info-filename ; this points to ~/peaks in my case
		(list "oboe.snd" "pistol.snd" "cardinal.snd" "storm.snd")
		'())

show-smpte-label shows the current SMPTE frame number in a box in the upper left corner of the graph. make-level-meter creates A VU meter of any width and height, returning a list of information associated with that meter. Pass that list to display-level to move the needle and the red bubble. This meter assumes you'll call it periodically so that the momentum needle and viscosity of the bubble will appear to behave naturally. with-level-meters adds any number of these meters to the topmost pane in the Snd main window, then adds a dac-hook function to display the current playback volume in the respective meter. show-disk-space adds a label in the minibuffer area which shows the current amount of disk space available on the partition of the associated sound. keep-file-dialog-open-upon-ok changes File:Open so that clicking "ok" does not "unmanage" the dialog. add-amp-controls adds amp sliders to the control panel for multi-channel sounds. add-very-useful-icons adds some very useful icons. (It is now commented out, replaced by contrib/dlp/new-buttons.scm). add-rename-option adds a "Rename" option to the File menu; similarly add-delete-option adds a "Delete" option. mark-sync-color uses the draw-mark-hook to set the color of sync'd marks. add-tooltip adds a tooltip (also known as bubble-help) to a widget. Once added, set the variable with-tooltips to #f to turn it off. menu-option returns the widget associated with a given menu item name ("Print" for example)

snd-test.scm and event.scm

snd-test.scm is a large test suite for Snd. The simplest use is:

snd -l snd-test

which will run all the tests, assuming you have the various sound files it is expecting to find. I assume that for most users snd-test.scm will provide more of a set of examples than anything directly useful. event.scm has some XEvent-related functions used by snd-test.scm. The Ruby version (very incomplete) is snd.rb.

v.scm

The fm violin was my favorite instrument while working in the 70's and 80's, primarily on the Samson box. It was developed in Mus10 (ca 1977) based on ideas of John Chowning; a Mus10 version was (in this code ":=" is used in place of the original SAIL left arrow character, and so on):

ARRAY GlissFunc, DecayFunc, AttackFunc, SineWave, AmpFunc(512);
SYNTH(Sinewave); 1,1 999;
SEG(AmpFunc); 0,0 1,25 1,50 0,75 0,100;
SEG(GlissFunc);0,1 1,50, 0,100;
SEG(AttackFunc);0,0 1,100;
SEG(DecayFunc);1,1 .6,5 .3,10 .15,25 .07,50 0,100;
	
INSTRUMENT VN1;
VARIABLE Reset1,Noise,/NewMag,OtherFreq,/Gliss,Distance,Stereo,
	Freq,Amp1,Amp2,Duration,AttackTime,DecayTime,Memory1,
	Index1,Index2,Index3,scFreq,DecayLength,Switch1,Switch2,
	/Mod1,/Mod2,/Mod3,/Env,/Att,/Vibrato,IMult,/Snd,
	/Flutter,VibRate,VibAmp,/Ramp,/Decay,VibSwitch,LogFreq,
	GlissLength,Bowing,DecayCall,VibCall,GlissCall,RampCall;
	
Memory1:=1;
	
I_ONLY BEGIN
  Duration:=P2;
  Freq:=P3;
  Amp1:=P4;
  Amp2:=P5;
  OtherFreq:=P6;
  IF Freq>=C THEN Freq:=Freq+Freq/100;
  IF Freq<C THEN Freq:=Freq-20/Freq;
	
  Switch1:=P14;
  Switch2:=1-Switch1;
  IMult:=P7-(Switch2/4);
  VibSwitch:=P8;
  Bowing:=P9;
	
  Distance:=P10;
  Stereo:=P11;
  Noise:=P12;
  GlissLength:=P13;
  LogFreq:=ALOG(Freq);
  
  DecayCall:=VibCall:=RampCall:=GlissCall:=20;
  IF Amp1=Amp2 THEN RampCall:=SRATE;
  IF Freq=OtherFreq THEN GlissCall:=SRATE;
  IF VibSwitch=0 THEN VibCall:=SRATE;
  IF Switch1=1 THEN DecayCall:=SRATE;
	
  Vibrate:=5.25+RAND*.75;
  VibAmp:=.006+RAND*.001;
	
  IF Bowing=0
    THEN
      IF Memory1>.08
	THEN
	  BEGIN
	  DecayTime:=.7;
	  AttackTime:=.2;
	  END
	ELSE
	  BEGIN
	  DecayTime:=.7;
	  AttackTime:=.05;
	  Noise:=0;
	  END
    ELSE
      IF Memory1>.05
	THEN
	  BEGIN
	  DecayTime:=.05;
	  AttackTime:=.2;
	  END
	ELSE
	  BEGIN
	  DecayTime:=.05;
	  AttackTime:=.05;
	  Noise:=0;
	  END;
	
  Memory1:=DecayTime;
	
  IF AttackTime+DecayTime>=Duration
    THEN
      BEGIN
      AttackTime:=Duration*AttackTime;
      DecayTime:=DecayTime*Duration;
      IF AttackTime<=.05 THEN AttackTime:=Duration-DecayTime-.01;
      END;
	
  ScFreq:=Freq*MAG;
  DecayLength:=1000/Freq;
  IF Switch1=0 THEN Noise:=.1;
  Index1:=7.5*IMult/LogFreq;
  Index2:=5/SQRT(Freq);
  Index3:=IMult*30*(8.5-LogFreq)/Freq;
END;
	
Decay:=Switch1+EXPEN[DecayCall](Switch2,MAG*20/DecayLength,DecayFunc);
ENV:=Switch2+LINEN[20](Switch1,AttackTime/20,DecayTime/20,Duration/20,AmpFunc,Reset1:=0);
Ramp:=Amp1+NOSCIL[RampCall](Amp2-Amp1,20*MAG/Duration,AttackFunc);
Gliss:=Freq+EXPEN[GlissCall](OtherFreq-Freq,20*MAG/GlissLength,GlissFunc);
FLutter:=RANDI[VibCall](1,200*Mag);
Vibrato:=NOSCIL[VibCall](ENV,Vibrate*MAG*20,SineWave);
Att:=1-EXPEN[20](1,MAG*640,AttackFunc);
	
NewMag:=(1+Flutter*.005)*(1+Vibrato*VibAmp)*(1+RANDI(Noise*Att,2000*Mag))*Gliss*Mag;
	
Mod1:=NOSCIL(Decay*ScFreq*(Att+Index1),NewMag,Sinewave);
Mod2:=NOSCIL(Decay*ScFreq*(Att+Index2),4*NewMag,Sinewave);
Mod3:=NOSCIL(Decay*ScFreq*(Att+Index3),3*NewMag,Sinewave);
Snd:=ZOSCIL(Decay*ENV*Ramp,NewMag+Mod1+Mod2+Mod3,Sinewave);
OUTA:=OUTA+Snd*0.5;
END;

This instrument required about 60 seconds of computing on a PDP-10 (a $250,000 minicomputer) for 1 second of sound (our normal sampling rate was 12800). Since the PDP was massively time-shared, 60 seconds of computing could involve many minutes of sitting around watching AI scientists play Space War. Mus10 was an extension of Music V for the PDP-10 family of computers. To give a feel for how one worked in those days, here's a brief quote from the Mus10 manual (by Tovar and Leland Smith, May 1977):

The following generates  1 second of a  440 Hz sine wave  followed by
1/2 sec. of a  660Hz sine wave. The output goes to a file, MUSIC.MSB,
which is written on DSKM.  

COMMENT Fill array with sine wave;
ARRAY SINETABLE[511];
FOR I:=0 STEP 1 UNTIL 511 DO SINETABLE[I]:=SIN(2*PI/512);

INSTRUMENT SINE;
  COMMENT Generate simple sine wave.  P4 = Amplitude, P3 = frequency;
  OUTA:=OUTA+OSCIL(P4,P3*MAG,SINETABLE);
  END;

COMMENT Now, generate the sound;
PLAY ;
  SIMP 0, 1, 440, 1000;
  SIMP 1, 1/2, 660, 1000;
  FINISH;

The computation involved was considered so burdensome, that the names of the main users were posted in the AI lab halls, apparently to try to get us to go away. I was normally the primary user (in terms of computrons) for the entire lab, and I had no intention of going away. In the Samson box world, this (in its initial "chorus" version) was:

Instrument(Violin);
RECORD_POINTER(seg) nullfunc;
INTEGER ARRAY gens[1:4],indgens[1:6], GensA[1:4],AmpGens[1:2];
					! synthesizer addresses;
REAL ARRAY ratsA[1:4],Indrats[1:6],ratsB[1:4],AmpRats[1:2];
					! envelope data;
INTEGER ModGens1Sum,i,FuncOffSet,k,GenOutLoc,GenInLoc,ModGens2Sum,x1,x2;

Pars(<(InsName,Beg,Dur,Freq,Amp,Function AmpFunc,Function IndFunc,IndMult,
	SkewMult,Nothing,PcRev,No11,No12,No13,Function SkewFunc)>);
					! the parameters of this instrument;

Dbugit(Pns);				! debugging aid;
GenOutLoc:=CASE (Pn[1] MOD 4) OF (Outma,Outmb,Outmc,Outmd);
					! OUTMA is channel 1, OUTMB channel 2, etc;
if freq>srate/3 then return;		! note too high, so leave it out;
x1:=3;					! modulating frequency checks;
x2:=4;					! (we want them less than srate/2);
If x1*freq>srate/2 Then x1:=1;
If x2*freq>srate/2 then x2:=1;
amp:=Amp/2;				! two carriers, so halve the amplitude;

waiter(Beg);				! wait for the beginning of the note;

indRats[1]:=(x1*Freq*IndMult*((8.5-log(freq))/(3+(freq/1000)))*4/srate) MIN .999;
indRats[2]:=(x2*Freq*IndMult*(1/(freq^.5))*4/srate) MIN .999;
indRats[3]:=(freq*IndMult*(5/log(freq))*4/srate) MIN .999;
indrats[4]:=indrats[1]; indrats[5]:=indrats[2]; indrats[6]:=indrats[3];

ratsA[1]:=x1; ratsA[2]:=x2;     ratsA[3]:=1;     ratsA[4]:=1;	
ratsB[1]:=x1+.002; ratsB[2]:=x2+.003;     ratsB[3]:=1.002;     ratsB[4]:=1;	
					! this is the skewing for the chorus effect;
Gens[1]:=Osc(Pns,ModGens1Sum);		! now set up the oscillators;
Gens[2]:=Osc(Pns,ModGens1Sum);
Gens[3]:=Osc(Pns,ModGens1Sum);
Gens[4]:=Osc(Pns,genInLoc,ModGens1Sum);	! carrier 1;

GensA[1]:=Osc(Pns,ModGens2Sum);
GensA[2]:=Osc(Pns,ModGens2Sum);
GensA[3]:=Osc(Pns,ModGens2Sum);
GensA[4]:=Osc(Pns,genInLoc,ModGens2Sum);! carrier 2;

indgens[1]:=gens[1];   indgens[2]:=gens[2];  indgens[3]:=gens[3];
indgens[4]:=gensA[1];   indgens[5]:=gensA[2];  indgens[6]:=gensA[3];
					! set up envelope addressing;

ModSig(Pns,GenOutLoc,GenInLoc,1-pcRev);	! send signal to DACs;
ModSig(Pns,RevIn,GenInLoc,pcRev);	! and signal to reverberator;

AmpGens[1]:=Gens[4]; AmpGens[2]:=GensA[4]; AmpRats[1]:=1; AmpRats[2]:=1;
					! now add the envelopes;
AddArrEnv(Pns,AmpGens,2,"A",0,Amp/2,AmpFunc,AmpRats);
AddArrEnv(Pns,IndGens,6,"A",0,1,IndFunc,Indrats);
AddArrEnv(Pns,Gens,4,"F",freq,Freq*skewmult,skewfunc,ratsA,
	5,.011,.011,nullfunc,6,.017,.017,nullfunc,0,0);
AddArrEnv(Pns,GensA,4,"F",freq,Freq*skewmult,skewfunc,ratsA,
	6,.010,.010,nullfunc,5,.017,.017,nullfunc,1,0);
End!Instrument(Pns);			! deallocation;

The Sambox version eventually became incredibly complicated, mainly to try to handle note list problems in the instrument. The Samson box could run about 5 or 6 of these in "real-time", similar to a modern-day 500 MHz Pentium running CLM. The parallel in the Sambox world to the SIMP example above is (this is taken from SAMBOX.BIL, November 1984):

    Instrument(Simp);
    Integer Gen1;
    Gen1:=Osc(Pns,OutA,Zero,SineMode,0,0,Pn[3]);
    AddEnv(Pns,Gen1,"A",0,Pn[4],Pf[5]);
    End_Instrument(Pns);

The CLM version of this is:

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

In CLM, the fm-violin became (fm.html, 1989):

(definstrument violin (beg end frequency amplitude fm-index)
  (let* ((frq-scl (in-hz frequency))
         (maxdev (* frq-scl fm-index))
         (index1 (* maxdev (/ 5.0 (log frequency))))
         (index2 (* maxdev 3.0 (/ (- 8.5 (log frequency)) (+ 3.0 (/ frequency 1000)))))
         (index3 (* maxdev (/ 4.0 (sqrt frequency))))
         (carrier (make-oscil frequency))
         (fmosc1 (make-oscil frequency))
         (fmosc2 (make-oscil (* 3 frequency)))
         (fmosc3 (make-oscil (* 4 frequency)))
         (ampf  (make-env '(0 0 25 1 75 1 100 0) :scaler amplitude))
         (indf1 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index1))
         (indf2 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index2))
         (indf3 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index3))
         (pervib (make-triangle-wave :frequency 5 :amplitude (* .0025 frq-scl)))
         (ranvib (make-randi :frequency 16 :amplitude (* .005 frq-scl)))
         (vib 0.0))
    (run
     (loop for i from beg to end do
       (setf vib (+ (triangle-wave pervib) (randi ranvib)))
       (outa i (* (env ampf)
                  (oscil carrier
                         (+ vib 
                            (* (env indf1) (oscil fmosc1 vib))
                            (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
                            (* (env indf3) (oscil fmosc3 (* 4.0 vib))))))))))))

or in its actual (non-simplified) form):

(defun bit20 (x)			;Samson box modifier got 2's complement 20 bit interpreted as fraction 
  (if (>= x (expt 2 19))                ;(this needed to keep fm-violin backwards compatible with old note lists)
      (float (/ (- x (expt 2 20)) (expt 2 19)))
    (float (/ x (expt 2 19)))))

(defun make-frobber-function (beg end frobl)
  (let ((result (list beg))
	(val (bit20 (cadr frobl))))
    (loop for x in frobl by #'cddr and 
              y in (cdr frobl) by #'cddr do
      (when (and (>= x beg)
		 (<= x end))
	(push val result)
	(push x result)
	(setf val (bit20 y))))
    (push val result)
    (push end result)
    (push val result)
    (nreverse result)))

(definstrument fm-violin 
  (startime dur frequency amplitude &key
	    (fm-index 1.0)
	    (amp-env '(0 0  25 1  75 1  100 0))
	    (periodic-vibrato-rate 5.0) 
            (random-vibrato-rate 16.0)
	    (periodic-vibrato-amplitude 0.0025) 
            (random-vibrato-amplitude 0.005)
	    (noise-amount 0.0) (noise-freq 1000.0)
	    (ind-noise-freq 10.0) (ind-noise-amount 0.0)
	    (amp-noise-freq 20.0) (amp-noise-amount 0.0)
	    (gliss-env '(0 0  100 0)) (glissando-amount 0.0) 
	    (fm1-env '(0 1  25 .4  75 .6  100 0)) 
            (fm2-env '(0 1  25 .4  75 .6  100 0)) 
            (fm3-env '(0 1  25 .4  75 .6  100 0))
	    (fm1-rat 1.0) (fm2-rat 3.0)	 (fm3-rat 4.0)                    
	    (fm1-index nil) (fm2-index nil) (fm3-index nil)
	    (base nil) (frobber nil)
	    (reverb-amount 0.01)
	    (index-type :violin)
	    (degree nil) (distance 1.0) (degrees nil)
	    (no-waveshaping nil) (denoise nil)
	    (denoise-dur .1) (denoise-amp .005)
	    &allow-other-keys)
  (if (> (abs amplitude) 1.0) 
      (setf amplitude (clm-cerror ".1?" .1 #'numberp "amplitude = ~A?" amplitude)))
  (if (<= (abs frequency) 1.0) 
      (setf frequency (clm-cerror "440.0?" 440.0 #'numberp "frequency = ~A?" frequency)))
  (let* ((beg (floor (* startime *srate*)))
	 (end (+ beg (floor (* dur *srate*))))
	 (frq-scl (hz->radians frequency))
	 (modulate (not (zerop fm-index)))
	 (maxdev (* frq-scl fm-index))
	 (vln (not (eq index-type :cello)))
	 (logfreq (log frequency))
	 (sqrtfreq (sqrt frequency))
	 (index1 (or fm1-index (min pi (* maxdev (/ (if vln 5.0 7.5) logfreq)))))
	 (index2 (or fm2-index (min pi (* maxdev 3.0 (if vln 
							     (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001)))
							   (/ 15.0 sqrtfreq))))))
	 (index3 (or fm3-index (min pi (* maxdev (/ (if vln 4.0 8.0) sqrtfreq)))))

	 (easy-case (and (not no-waveshaping)
			 (zerop noise-amount)
			 (eq fm1-env fm2-env)
			 (eq fm1-env fm3-env)
			 (zerop (- fm1-rat (floor fm1-rat)))
			 (zerop (- fm2-rat (floor fm2-rat)))
			 (zerop (- fm3-rat (floor fm3-rat)))
			 (zerop (nth-value 1 (floor fm2-rat fm1-rat)))
			 (zerop (nth-value 1 (floor fm3-rat fm1-rat)))))
	 (coeffs (and easy-case modulate
	 	      (partials->polynomial
	 	       (list fm1-rat index1
	 		     (floor fm2-rat fm1-rat) index2
	 		     (floor fm3-rat fm1-rat) index3))))
	 ;; that is, we're doing the polynomial evaluation using fm1osc running at fm1-rat * frequency
	 ;; so everything in the polynomial table should be in terms of harmonics of fm1-rat
	 
	 (norm (or (and easy-case modulate 1.0) index1))
	 
	 (carrier (make-oscil frequency))
	 (fmosc1  (and modulate (make-oscil (* fm1-rat frequency))))
	 (fmosc2  (and modulate (or easy-case (make-oscil (* fm2-rat frequency)))))
	 (fmosc3  (and modulate (or easy-case (make-oscil (* fm3-rat frequency)))))
	 (ampf  (make-env 
                  (if denoise
                       (reduce-amplitude-quantization-noise amp-env dur amplitude denoise-dur denoise-amp) 
                     amp-env)
	          amplitude :base base :duration dur))
	 (indf1 (and modulate (make-env fm1-env norm :duration dur)))
	 (indf2 (and modulate (or easy-case (make-env fm2-env index2 :duration dur))))
	 (indf3 (and modulate (or easy-case (make-env fm3-env index3 :duration dur))))
	 (frqf (make-env gliss-env (* glissando-amount frq-scl) :duration dur))
	 (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
	 (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
	 (fm-noi (if (and (/= 0.0 noise-amount)
			  (null frobber))
		     (make-rand noise-freq (* pi noise-amount))))
	 (ind-noi (if (and (/= 0.0 ind-noise-amount) (/= 0.0 ind-noise-freq))
		      (make-rand-interp ind-noise-freq ind-noise-amount)))
	 (amp-noi (if (and (/= 0.0 amp-noise-amount) (/= 0.0 amp-noise-freq))
		      (make-rand-interp amp-noise-freq amp-noise-amount)))
	 (frb-env (if (and (/= 0.0 noise-amount) frobber)
		      (make-env (make-frobber-function startime (+ startime dur) frobber) :duration dur
				:base 0	:scaler (* two-pi noise-amount))))
	 (vib 0.0) 
	 (modulation 0.0)
	 (loc (make-locsig :degree (or degree degrees (random 90.0)) :reverb reverb-amount :distance distance))
	 (fuzz 0.0)
	 (ind-fuzz 1.0)
	 (amp-fuzz 1.0))
    (run
     (loop for i from beg to end do
       (if (/= 0.0 noise-amount)
	   (if (null frobber)
	       (setf fuzz (rand fm-noi))
	     (setf fuzz (env frb-env))))
       (setf vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
       (if ind-noi (setf ind-fuzz (+ 1.0 (rand-interp ind-noi))))
       (if amp-noi (setf amp-fuzz (+ 1.0 (rand-interp amp-noi))))
       (if modulate
	   (if easy-case
	       (setf modulation
		 (* (env indf1) 
		    (polynomial coeffs (oscil fmosc1 vib)))) ;(* vib fm1-rat)??
	     (setf modulation
	       (+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
		  (* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
		  (* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))
       (locsig loc i
	     (* (env ampf) amp-fuzz
		(oscil carrier (+ vib (* ind-fuzz modulation)))))))))

which is very similar to the Scheme version (v.scm). It's basically setting up several parallel modulators of one carrier (see fm.html for details, or (ah nostalgia...) Schottstaedt, "The Simulation of Natural Instrument Tones Using Frequency Modulation with a Complex Modulating Wave", CMJ vol 1 no 4 1977 p46-50). The modulators themselves are modulated (vibrato, noise, etc). The FM indices were chosen to try to mimic violin or cello sounds over a wide range of frequencies. There's no limit on what this instrument can do; nearly all my compositions in the 80's used it. In CLM, there's fmviolin.clm which shows some of the effects (although it's unfortunately hard to read due to the way the Sambox system worked). And I just found this out on the net; I'm no csound expert, so I merely quote what I find:

;ORC
; edited by R. Pinkston, modified for use with MIDI2CS by R. Borrmann
;
;==========================================================================;
;                Schottstaedt FM String Instrument from Dodge              ;
;                                                                          ;
;p4 = amp p5 = pch p6 = rise p7 = dec p8 = vibdel p9 = vibwth p10 = vibrte ;
;==========================================================================;
;        sr      =       44100
;        kr      =       4410
;        ksmps   =       10
;        nchnls  =       1
;
;                instr   1

par
  p_maxamplitude 32000
  p_cps
endpar

        iamp    =       p4

        irise   = .2    ;p6
        idec    = .2    ;p7
        ivibdel = .75   ;p8
        ivibwth = .03   ;p9
        ivibrte = 5.5   ;p10

        ifc     =       p5
        ifm1    =       ifc
        ifm2    =       ifc*3
        ifm3    =       ifc*4
        indx1   =       7.5/log(ifc)    ;range from ca 2 to 1
        indx2   =       15/sqrt(ifc)    ;range from ca 2.6 to .5
        indx3   =       1.25/sqrt(ifc)  ;range from ca .2 to .038
        kvib    init    0 

                timout  0,ivibdel,transient  ;delays vibrato for p8 seconds
        kvbctl  linen   1,.5,p3-ivibdel,.1   ;vibrato control envelope
        krnd    randi   .0075,15        ;random deviation in vib width 
        kvib    oscili  kvbctl*ivibwth+krnd,ivibrte*kvbctl,1 ;vibrato generator
               
transient:
        timout  .2,p3,continue          ;execute for .2 secs only
        ktrans  linseg  1,.2,0,1,0      ;transient envelope 
        anoise  randi   ktrans,.2*ifc   ;noise... 
        attack  oscil   anoise,2000,1   ;...centered around 2kHz

continue: 
        amod1   oscili  ifm1*(indx1+ktrans),ifm1,1
        amod2   oscili  ifm2*(indx2+ktrans),ifm2,1
        amod3   oscili  ifm3*(indx3+ktrans),ifm3,1
        asig    oscili  iamp,(ifc+amod1+amod2+amod3)*(1+kvib),1
        asig    linen   asig+attack,irise,p3,idec
;                out     asig
; 
;                endin
        aright  = asig
        aleft   = asig

There's a C/CLM version of this instrument in sndlib.html. The body of the fm-violin in C/CLM is:

      if (noise_amount != 0.0) fuzz = mus_rand(fmnoi,0.0);
      if (frqf) vib = mus_env(frqf); else vib = 0.0;
      vib += mus_triangle_wave(pervib, 0.0) + 
             mus_rand_interp(ranvib, 0.0);
      if (easy_case)
        modulation = mus_env(indf1) * 
                     mus_polynomial(coeffs, mus_oscil(fmosc1, vib, 0.0), npartials);
      else
        modulation = mus_env(indf1) * mus_oscil(fmosc1, (fuzz + fm1_rat * vib), 0.0) +
                     mus_env(indf2) * mus_oscil(fmosc2, (fuzz + fm2_rat * vib), 0.0) +
                     mus_env(indf3) * mus_oscil(fmosc3, (fuzz + fm3_rat * vib), 0.0);
      mus_locsig(loc, i, mus_env(ampf) *
                         mus_oscil(carrier, vib + indfuzz * modulation, 0.0));

ws.scm

with-sound is the primary sound producing macro in CLM (in a sense, it is CLM's user-interface). In Common Lisp it's defined as:

 (defmacro with-sound ((&key (srate 22050) ...) &body body) 
   (unwind-protect
     (let (...) ,.body)
     (progn (cleanup...))))

and makes extensive use of Lisp's dynamic binding to handle nested with-sound calls and so on. Optional argument syntax has changed slightly in Guile; my first attempt to implement this macro (in Guile 1.4) was:

(defmacro with-sound (args . body) 
  `((lambda* (#&key (srate 22050)
		    (output "test.snd")
		    (channels 1)
		    (explode #f))
      (let ((old-srate (mus-srate)))
	(dynamic-wind
	 (lambda ()
	   (set! (mus-srate) srate))
	 (lambda () 
	   (if (find-sound output) 
               (close-sound (find-sound output)))
	   (new-sound output (default-output-type) (default-output-format) srate channels)
	   ,@body)
	 (lambda ()
	   (set! (mus-srate) old-srate)))))
    ,@args))

but in the newer Guile (1.4.1) it's possible to make this prettier (this version is thanks to Kalle Olavi Niemitalo):

(define* (with-sound-helper thunk #&key (srate 22050) (explode #f))
  (let ((old-srate (mus-srate)))
    (dynamic-wind 
      (lambda () 
        (set! (mus-srate) srate))
      thunk
      (lambda () 
        (set! (mus-srate) old-srate)))))

(defmacro with-sound (args . body)
  `(with-sound-helper (lambda () ,@body)
                      ,@args))

lambda* and define* are extensions of Scheme from Guile's ice-9/optargs.scm. The version in ws.scm is simply an amplification of this code. The global variables that parallel CLM's *clm-...* are:

  *srate* (default-output-srate)
  *file-name* "test.snd"
  *channels* (default-output-chans)
  *explode* #f                          
  *data-format* (default-output-format)
  *header-type* (default-output-type)

*explode* here refers to the with-mix-tags setting.

 with-sound
    #:key (srate *srate*) 
          (output *file-name*) 
	  (channels *channels*)
	  (explode *explode*)
	  (header-type *header-type*)
	  (data-format *data-format*)
	  (comment #f)
	  (continue-old-file #f)
  	  (reverb #f)
  	  (revfile #f)
	  (statistics #f)
	  (scaled-to #f)
	  (scaled-by #f))

As far as possible, this parallels CLM's with-sound.

  (with-sound (:srate 44100) (fm-violin 0 1 440 .1))

This code is highly unstable! I originally set it up to run its body within the Snd editing context, but this required the use of temporary files (even if using as-one-edit or saving state every now and then), made reverb awkward, and made individual instruments messy, since they now needed to call Snd editing functions such as mix-vct, whereas the rest of the instrument was pure CLM-code. So, in the current version, with-sound opens its output file (output above) via make-sample->file, setting the global variable *output*. This is equivalent to CLM's *output* variable, and can be used the same way in outa or locsig. If reverb is specified, *reverb* is also opened (corresponding to CLM's *reverb*). So the cooperating instrument code should be:

  (define (ins args)
    (let ...
      (do ((i start (1+ i)))
	  ((= i end))
        (outa i ... *output*))))

which is essentially the same as in the standard CLM.

xm-enved.scm

  xe-create-enved name parent args axis
  xe-envelope xe-editor

This file implements an envelope editor using the xm module. xe-create-enved returns a new envelope editor whose X axis label is name, the X and Y axis bounds are in the list axis, the editor's parent widget is parent, and the Xt-style resource argument list is args. The editor's current envelope is accessible (read and write) via xe-envelope. For example,

(define outer (add-main-pane "hiho" |xmFormWidgetClass '()))
(define editor (xe-create-enved "a name" outer 
			     (list |XmNleftAttachment   |XmATTACH_FORM
				   |XmNtopAttachment    |XmATTACH_FORM
				   |XmNbottomAttachment |XmATTACH_FORM
				   |XmNrightAttachment  |XmATTACH_FORM)
			     '(0.0 1.0 0.0 1.0)))))
(set! (xe-envelope editor) (list 0.0 1.0 1.0 0.5))

zip.scm

  make-zipper ramp-env frame-size frame-env
  zipper gen in1 in2
  zip-sound beg dur file1 file2 ramp size

The zipper generator performs a kind of cross fade, but not one that tries to be smooth! It marches through the two sounds taking equal short portions of each, then abutting them while resampling so that as one takes less overall "frame" space, the other takes more. The frame-size argument is the maximum length of each twosome in seconds (for initial array allocation), the frame-env argument determines the current such length as new "frames" are needed, and the ramp-env argument determines which of the files gets more space in the frame (0: all first, 1: all second). For example, the following function sets up two sounds, an upward ramp and a downward ramp, then zips them together:

(define (ramp-test)
  (let ((data (make-vct 10000)))
    (new-sound "new-0.snd")
    (do ((i 0 (1+ i))) ((= i 10000)) 
      (vct-set! data i (* i .0001)))
    (vct->samples 0 10000 data 0)
    (new-sound "new-1.snd")
    (do ((i 0 (1+ i))) ((= i 10000)) 
      (vct-set! data i (- 1.0 (* i .0001))))
    (vct->samples 0 10000 data 1)
    (let* ((dur (frames))
	   (zp (make-zipper (let ((e (make-env '(0 0 1 1) :end dur)))
			      (lambda () (env e)))))
	  (reader0 (make-sample-reader 0 0 0))
	  (reader1 (make-sample-reader 0 1 0)))
      (map-chan (lambda (val) (zipper zp reader0 reader1))))))
zipper ramp output

Needless to say, this is not intended to be a suave, romantic gesture!


A Note on Scheme variables in Snd

At first glance, Snd's use of functions for nearly all variable accesses, i.e. (listener-prompt) rather than the simpler listener-prompt, seems unmotivated. For example, the following little program defines "counter" as a scheme variable, accessible in C:

#include <stdio.h>
#include <guile/gh.h>

void inner_main(void *closure, int argc, char **argv)
{
  SCM counter;
  int size = 512;
  char **buffer = NULL;
  buffer = (char **)calloc(1, sizeof(char *));
  buffer[0] = (char *)calloc(size, sizeof(char));
  counter = scm_permanent_object(scm_c_define("counter", scm_long2num(0)));
  while (1)
    {
      getline(buffer, &size, stdin);
      scm_eval_str0(buffer[0]);
      fprintf(stdout, "counter is %d\n", scm_num2int(SCM_VARIABLE_REF(counter), 0, "main"));
    }
}

int main(int argc, char *argv[])
{
  scm_boot_guile(argc, argv, inner_main, 0);
  return(0);
}

Now we compile and load it (in Linux: cc g.c -o g -lguile), and it sits in a loop reading a line at a time, evaluating it, and printing the current value of our counter:

/home/bil/cl/ g
(+ 1 2)
counter is 0
(set! counter 123)
counter is 123
(set! counter (* counter 2))
counter is 246

But the C code itself doesn't see the set!, and there's no way to tell set! in Guile to call an auxiliary function when (for example) our counter is set. We need to see that set! as soon as it happens to make the user interface responsive. (set! basic-color red) would have no effect unless our C code could be informed that the basic-color variable's value had changed. In addition, in Snd, there are perhaps several hundred such variables, and our C code will run faster if we access C variables as much as possible, rather than calling scm_num2int (or whatever) every time the value is needed. So, we first defined each variable along these lines:

#include <stdio.h>
#include <guile/gh.h>

int counter = 0;

SCM g_counter(void)
{
  return(scm_long2num(counter));
}

SCM g_set_counter(SCM newval)
{
  counter = scm_num2int(newval, 0, "set-counter");
  return(newval);
}

void inner_main(void *closure, int argc, char **argv)
{
  int size = 512;
  char **buffer = NULL;
  buffer = (char **)calloc(1, sizeof(char *));
  buffer[0] = (char *)calloc(size, sizeof(char));
  scm_c_define_gsubr("counter", 0, 0, 0, g_counter);
  scm_c_define_gsubr("set-counter", 1, 0, 0, g_set_counter);
  while (1)
    {
      getline(buffer, &size, stdin);
      scm_eval_str0(buffer[0]);
      fprintf(stdout, "counter is %d\n", counter);
    }
}

int main(int argc, char *argv[])
{
  scm_boot_guile(argc,argv, inner_main, 0);
  return(0);
}

Now we have two functions: counter returns (to the Scheme world) the current value of the C variable counter, and set-counter sets it:

/home/bil/cl/ g
(+ 1 2)
counter is 0
(set-counter 123)
counter is 123
(set-counter (* (counter) 2))
counter is 246

Now the g_set_counter procedure can reflect counter's new value within C, and the variable lives in C, so two of our problems are solved. But we don't really want the extra name "set-counter". So, we use Guile's generalized set! by replacing the two scm_c_define_gsubr calls above with:

  scm_c_define("counter",
    scm_make_procedure_with_setter(
      scm_c_define_gsubr("", 0, 0, 0, g_counter),
      scm_c_define_gsubr("", 1, 0, 0, g_set_counter)));

Now we have Snd's way of handling things:

/home/bil/cl/ g
(+ 1 2)
counter is 0
(set! (counter) 123)
counter is 123
(set! (counter) (* (counter) 2)) 
counter is 246

It's not completely ideal, but it's close enough that I don't find it painful to use. If you run the program above, you'll be annoyed to discover that any error causes it to exit! Guile's default is to have no error handler installed, so the "throw" that an error generates is not "caught", causing the program to exit. The next version of our program adds error handling, a cleaner exit mechanism (you can call the exit procedure to exit), and a simple procedure that adds some amount to the counter:

#include <stdio.h>
#include <guile/gh.h>

int counter = 0;
SCM g_counter(void) {return(scm_long2num(counter));}

SCM g_set_counter(SCM newval)
{
  counter = scm_num2int(newval, 0, "set-counter");
  return(newval);
}

/* this code needs the Guile 1.5 or later */
/* the error handler:  it prints out whatever information the error sent us and returns */

static SCM report_error(void *data, SCM tag, SCM throw_args)
{
  if (SCM_EQ_P(tag, scm_str2symbol("quit"))) exit(0);
  fprintf(stdout, "%s: %s\n", 
	  SCM_STRING_CHARS(scm_object_to_string(tag, SCM_UNDEFINED)), 
	  SCM_STRING_CHARS(scm_object_to_string(throw_args, SCM_UNDEFINED)));
  return(tag);
}

static SCM add_to_counter(SCM val)
{
  SCM_ASSERT_TYPE(SCM_EQ_P(scm_integer_p(val), SCM_BOOL_T), val, SCM_ARGn, "add-to-counter", "an integer");
  counter += scm_num2int(val, 0, "add-to-counter");   /* convert from Scheme to C */
  return(scm_long2num(counter));  /* return our new counter value */
}

static void inner_main(void *closure, int argc, char **argv)
{
  SCM result;
  int size = 512;
  char **buffer = NULL;
  scm_c_define_gsubr("add-to-counter", 1, 0, 0, add_to_counter);

  scm_c_define("counter",
    scm_make_procedure_with_setter(
      scm_c_define_gsubr("", 0, 0, 0, g_counter),
      scm_c_define_gsubr("", 1, 0, 0, g_set_counter)));

  buffer = (char **)calloc(1, sizeof(char *));
  buffer[0] = (char *)calloc(size, sizeof(char));
  while (1)
    {
      /* (exit) to exit */
      fprintf(stdout, ">");
      getline(buffer, &size, stdin);
      result = scm_internal_stack_catch(SCM_BOOL_T, /* this is our "catch" */
					scm_eval_str0, 
					(void *)(buffer[0]), 
					report_error,
					buffer[0]);
      fprintf(stdout, "%s\n",
	      SCM_STRING_CHARS(scm_object_to_string(result, SCM_UNDEFINED)));
    }
}

int main(int argc, char *argv[])
{
  scm_boot_guile(argc, argv, inner_main, 0);
  return(0);
}

Now we have our own "read-eval-print" loop:

/home/bil/cl/ g
>(+ 1 2)
3
>counter 
#<procedure-with-setter>
>(counter)
0
>(add-to-counter 32)
32
>(counter)
32
>(add-to-counter 1)
33
>(counter)
33
>(add-to-counter 3.41)
wrong-type-arg: ("add-to-counter" "Wrong type argument (expecting ~A): ~S" ("an integer" 3.41) #f)
wrong-type-arg
>asdf
unbound-variable: (#f "Unbound variable: ~S" (asdf) #f)
unbound-variable
>(exit)

But now the scm_eval_str0 use generates a compiler complaint about type mismatches (though it works). We can fix that by:

static SCM eval_str_wrapper(void *data) {return(scm_eval_str0((char *)data));}

/* ... */

      result = scm_internal_stack_catch(SCM_BOOL_T,
					eval_str_wrapper, 
					(void *)(buffer[0]), 
					report_error,
					buffer[0]);

A Note on "As-Needed" input functions

Several CLM generators work internally on buffers of data; only the code internal to the generator knows when it needs input, and how much it needs. So, src, granulate, convolve, and phase-vocoder are passed a function either at run-time or when the generator is allocated that they can call whenever a new value is needed. A simple C case is:

#include <stdio.h>
#include "clm.h"

typedef struct {
  float val;
} src_state;

float src_input_as_needed(void *arg, int dir) 
{
  src_state *sr = (src_state *)arg;
  sr->val += (dir * .01); /* just return a ramp */
  return(sr->val);
}

int main(int argc, char **argv)
{
  mus_any *gen;
  src_state *input;
  int i;
  input = (src_state *)calloc(1, sizeof(src_state));
  input->val = 0.0;
  gen = mus_make_src(&src_input_as_needed, 0.5, 10, (void *)input);
  for (i=0; i < 100; i++)
    fprintf(stdout, "%f ", mus_src(gen, 0.0, NULL));
    /* or: fprintf(stdout, "%f ", mus_src(gen, 0.0, src_input_as_needed)); */
  mus_free(gen);
  free(input);
  return(0);
}

/* cc g1.c -o g1 -L/usr/local/lib -lguile /home/bil/sndlib/sndlib.a */
/* g1: 0.010000 0.015440 0.020000 0.024761 0.029999 0.035170 0.039999 ... */

To put that code in words, the src generator uses the function src_input_as_needed to fill its internal buffer (convolving it with sinc); in this case, the "srate" argument is 0.5, so src will pick up a new input sample (calling src_input_as_needed) on every other output sample. In the Scheme CLM (and Snd), the "as-needed" input function is a Scheme function passed in as Scheme code. A highly simplified example is:

#include <stdio.h>
#include <guile/gh.h>
#include "clm.h"

typedef struct {
  SCM input_func;
} src_state;

float src_input_as_needed(void *ptr, int direction)
{
  src_state *sr = (src_state *)ptr;
  return(scm_num2dbl(scm_call_1(sr->input_func, scm_long2num(direction)), "input-as-needed"));
}

void inner_main(void *closure, int argc, char **argv)
{
  mus_any *gen;
  src_state *input;
  int i;
  int size = 512;
  char **buffer = NULL;
  buffer = (char **)calloc(1, sizeof(char *));
  buffer[0] = (char *)calloc(size, sizeof(char));
  input = (src_state *)calloc(1, sizeof(src_state));
  fprintf(stdout, "input function: ");
  getline(buffer, &size, stdin);
  input->input_func = scm_eval_str0(buffer[0]);
  gen = mus_make_src(&src_input_as_needed, 0.5, 10, (void *)input);
  for (i=0; i < 100; i++)
    fprintf(stdout, "%f ", mus_src(gen, 0.0, src_input_as_needed));
  mus_free(gen);
  free(input);
}

int main(int argc, char *argv[])
{
  scm_boot_guile(argc, argv, inner_main, 0);
  return(0);
}

/* cc g1.c -o g1 -L/usr/local/lib -lguile /home/bil/sndlib/sndlib.a */
/* g1
   input function: (let ((val 0.0)) (lambda (dir) (set! val (+ val (* dir .01))) val))
   0.010000 0.015440 0.020000 0.024761 0.029999 0.035170 0.039999
*/

In this case, src_input_as_needed is calling the user-supplied Scheme function (via scm_call_1).


A Note on User-defined Generators in C-CLM

In the Common Lisp version of CLM, it's relatively easy to define a new generator. Take for example, Fernando Lopez-Lezcano's fcomb (a comb filter with a low-pass filter on the feedback), defined as a part of his translation of Jezar Wakefield's freeverb reverberator:

(def-clm-struct fcomb
  delay
  filter
  (feedback 0.0))
  
(defmacro fcomb (comb input)
  `(delay (fcomb-delay ,comb)
	  (+ ,input (* (one-zero (fcomb-filter ,comb)
				 (tap (fcomb-delay ,comb)))
		       (fcomb-feedback ,comb)))))

An fcomb generator is then created (in freeverb) via:

(make-fcomb :delay (make-delay len)
            :feedback room-decay-val
            :filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))

and called at run-time with:

(fcomb (aref combs c j) (frame-ref in c))

(In this case we have a two dimensional array of these generators). This, of course, does not make fcomb a full-fledged generator like oscil -- it doesn't respond to mus-scaler or the other methods, for example. To do that requires a bit of defclass/defmethod overhead in Lisp, something along the lines of:

 
(in-package :clm)

(defclass fcomb (comb one-zero) ())

(defmethod fcomb? ((g fcomb)) t)
(defmethod fcomb? ((g t)) nil)

(defun fcomb (gen input)
  (delay gen
	 (+ input (* (one-zero gen (tap gen))
		     (mus-feedback gen)))))

(def-optkey-fun make-fcomb (length feedback a0 a1)
  (make-instance 'fcomb :loc 0 :xscl feedback :size length :zsize length :zdly nil
		 :line (make-double-float-array length)
		 :a0 a0 :a1 a1 :x1 0.0))

(defmethod print-object ((d fcomb) stream)
  (format stream "#<(fcomb: size: ~A, loc: ~A, feedback: ~A, a0: ~A, a1: ~A, x1: ~A, line: ~A>"
	  (dly-size d) (dly-loc d) (dly-xscl d)
	  (mus-a0 d) (mus-a1 d) (mus-x1 d)
	  (prettified-array (dly-line d))))

And to get the new (lisp-side, non-macro) generator to be callable within the run macro is yet another set of headaches (see user-defined generators). In CLM-in-Scheme, the first (simpler) fcomb above might be:

(define (fcomb gen input)
  (delay (car gen)
	 (+ input (* (one-zero (cadr gen) (tap (car gen)))
		     (caddr gen)))))

(define (make-fcomb length feedback a0 a1)
  (list (make-delay length)
	(make-one-zero a0 a1)
	feedback))

Or perhaps a more Schemey (Schemish?) method would be:

(define (fcomb gen input)
  (gen input))	

(define (make-fcomb length feedback a0 a1)
  (let ((dly (make-delay length))
        (flt (make-one-zero a0 a1)))
    (lambda (input)
      (dly (+ input (* (flt (tap dly)) feedback))))))

(Here we're returning a closure that packages up the generator's state). We could use Guile's object system to conjure up fcomb classes and methods in Scheme:

(use-modules (oop goops))

(define-class fcmb ()
  (dly :accessor fcomb-delay)
  (flt :accessor fcomb-filter)
  (fdb :accessor fcomb-feedback))

(define (fcomb gen input)
  ((fcomb-delay gen) 
   (+ input (* ((fcomb-filter gen) 
		(tap (fcomb-delay gen)))
	       (fcomb-feedback gen)))))

(define-method (initialize (obj fcmb) initargs)
  (next-method)
  (let* ((len (get-keyword :length initargs 0))
	 (feedback (get-keyword :feedback initargs 0.5))
	 (a0 (get-keyword :a0 initargs 0.5))
	 (a1 (get-keyword :a1 initargs 0.5)))
    (set! (fcomb-delay obj) (make-delay len))
    (set! (fcomb-filter obj) (make-one-zero a0 a1))
    (set! (fcomb-feedback obj) feedback)
    obj))

(define-method (write (obj fcmb) port)
  (display (format #f "#<fcomb: delay: ~A, filter: ~A, feedback: ~A>"
		   (fcomb-delay obj)
		   (fcomb-filter obj)
		   (fcomb-feedback obj))
	   port))

But our real interest here is how to do the same thing in CLM-in-C (clm.c). The following is extracted from snd-dac.c's translation of Fernando's translation of Wakefield's freeverb. It implements fcomb and ties it into CLM so it can be treated just like oscil or comb or whatever.

#include "sndlib.h"
#include "clm.h"
#include "sg.h"
#include "xen.h"
#include "clm2xen.h"

static int MUS_FCOMB = 0; /* this will be our fcomb type identifier */

typedef struct {
  mus_any_class *core;
  int loc, size;
  Float *line;
  Float xscl, a0, a1, x1;
} fcomb;

/* each CLM-in-C generator has mus_any_class *core as the first thing in its structure.
 *   it defines most of the built-in "generic" functions like mus-describe.
 * The next set of functions implement the core functions/
 *   The address of the function is stored in the class's core struct.
 *   For example, the scaler method is defined as Float (*scaler)(void *ptr);
 *   in the mus_any_class declaration (clm.h); for fcomb it will correspond
 *   to the fcomb_scaler function below; it is invoked via mus_scaler(gen)
 *   where gen is an fcomb generator (the actual call is (*((gen->core)->scaler))(gen)).
 *   the core->scaler pointer (the function address) is set in the declaration
 *   of mus_any_class FCOMB_CLASS below.  If a method doesn't apply to a given
 *   generator class, just set its slot to 0.
 */

static int mus_fcomb_p(mus_any *ptr) {return((ptr) && ((ptr->core)->type == MUS_FCOMB));}

static char *describe_fcomb(void *ptr) 
{
  char *desc = NULL;
  fcomb *gen = (fcomb *)ptr;
  desc = (char *)calloc(1024, sizeof(char));
  if (desc)
    {
      if (mus_fcomb_p((mus_any *)ptr))
	sprintf(desc, "fcomb: scaler: %.3f,  a0: %.3f,  a1: %.3f,  line[%d]", 
		gen->xscl, gen->a0, gen->a1, gen->size);
      else sprintf(desc, "not an fcomb gen");
    }
  return(desc);
}

static int fcomb_equalp(void *p1, void *p2) {return(p1 == p2);}
static int fcomb_length(void *ptr) {return(((fcomb *)ptr)->size);}
static Float *fcomb_data(void *ptr) {return(((fcomb *)ptr)->line);}
static Float fcomb_scaler(void *ptr) {return(((fcomb *)ptr)->xscl);}
static Float set_fcomb_scaler(void *ptr, Float val) {((fcomb *)ptr)->xscl = val; return(val);}

static int free_fcomb(void *uptr) 
{
  fcomb *ptr = (fcomb *)uptr;
  if (ptr)
    {
      if (ptr->line) 
        free(ptr->line);
      free(ptr); 
    }
  return(0);
}

/* now the actual run-time code executed by fcomb */
/* the extra "ignored" argument is for the run method */

static Float mus_fcomb (mus_any *ptr, Float input, Float ignored) 
{
  fcomb *gen = (fcomb *)ptr;
  Float tap_result, filter_result;
  tap_result = gen->line[gen->loc];
  filter_result = (gen->a0 * tap_result) + (gen->a1 * gen->x1);
  gen->x1 = tap_result;
  gen->line[gen->loc] = input + filter_result * gen->xscl;
  gen->loc++;
  if (gen->loc >= gen->size) gen->loc = 0;
  return(tap_result);
}

/* this is our core class descriptor */

static mus_any_class FCOMB_CLASS = {
  -1, /* MUS_FCOMB eventually */ /* mus_type: this is assigned at run-time via mus_make_class_tag below */
  "fcomb",                       /* mus_name: class name (used in descriptive/error messages */
  &free_fcomb,                   /* mus_free: free gen's struct etc */
  &describe_fcomb,               /* mus_describe: user-friendly description */
  &describe_fcomb,               /* mus_inspect: internal debugging description */
  &fcomb_equalp,                 /* mus_equalp: check equality of fcomb gens */
  &fcomb_data,                   /* mus_data: the fcomb delay line, a float array */
  0,                             /* mus_set_data: not implemented for fcomb */
  &fcomb_length,                 /* mus_length: delay line length */
  0,                             /* mus_set_length: not implemented for fcomb */
  0,0,                           /* mus_frequency, mus_set_frequency */
  0,0,                           /* mus_phase, mus_set_phase */
  &fcomb_scaler,                 /* mus_scaler: the feedback term */
  &set_fcomb_scaler,             /* mus_set_scaler */
  &mus_fcomb,                    /* mus_run: the run-time fcomb function, MUS_RUN(gen) for speed */
  0                              /* type extension (normally 0) */
};

/* now a function to make a new generator */

static mus_any *mus_make_fcomb (Float scaler, int size, Float a0, Float a1)
{
  fcomb *gen = NULL;
  gen = (fcomb *)calloc(1, sizeof(fcomb));
  if (gen == NULL) 
    mus_error(MUS_MEMORY_ALLOCATION_FAILED, 
              "can't allocate struct for mus_make_fcomb!");
  else
    {
      gen->core = &FCOMB_CLASS;
      if (MUS_FCOMB == 0) 
        {
          MUS_FCOMB = mus_make_class_tag();  /* this gives us a unique fcomb type id */
          gen->core->type = MUS_FCOMB;
        }
      gen->loc = 0;
      gen->xscl = scaler;
      gen->x1 = 0.0;
      gen->a0 = a0;
      gen->a1 = a1;
      gen->size = size;
      gen->line = (Float *)calloc(size, sizeof(Float));
      if (gen->line == NULL) 
	mus_error(MUS_MEMORY_ALLOCATION_FAILED, 
		  "can't allocate %d bytes for fcomb delay line in mus_make_fcomb!",
		  (int)(size * sizeof(Float)));
    }
  return((mus_any *)gen);
}

/* that is the end of the C side; the rest ties this generator into Guile/Ruby via the Xen package */
/*   in Snd's case, it's actually not needed because the generator is only called from C */

static XEN g_fcomb(XEN obj, XEN input)
{
  return(C_TO_XEN_DOUBLE(mus_fcomb(MUS_XEN_TO_CLM(obj), XEN_TO_C_DOUBLE(input), 0.0)));
}

static XEN g_fcomb_p(XEN obj)
{
  return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_fcomb_p(MUS_XEN_TO_CLM(obj)))));
}

static XEN g_make_fcomb(XEN scaler, XEN size, XEN a0, XEN a1)
{
  mus_xen *gn;
  gn = (mus_xen *)CALLOC(1,sizeof(mus_xen));
  gn->gen = mus_make_fcomb(XEN_TO_C_DOUBLE(scaler),
                           XEN_TO_C_INT(size),
                           XEN_TO_C_DOUBLE(a0),
                           XEN_TO_C_DOUBLE(a1));
  gn->nvcts = 0;
  return(mus_xen_to_object(gn));
}

static void init_fcomb(void)
{
  XEN_DEFINE_PROCEDURE("fcomb?", g_fcomb_p, 1, 0, 0, "(fcomb? gen) -> #t if gen is an fcomb generator");
  XEN_DEFINE_PROCEDURE("make-fcomb", g_make_fcomb, 4, 0, 0, "(make-fcomb scaler size a0 a1) -> new fcomb gen");
  XEN_DEFINE_PROCEDURE("fcomb", g_fcomb, 2, 0, 0, "(fcomb gen input) returns result of running fcomb gen");
}

About Continuations

Here are a few simple examples of Scheme continuations:


(define (con-return)
  "use call/cc to break out of a loop"
  (call-with-current-continuation
   (lambda (return)              ; declare our "escape" procedure
     (let ((i 0))
       (while (< i 123)
	 (if (= i 3) 
	     (return 'quitting)) ; goto end of continuation form
	 (display i)
	 (set! i (+ i 1)))
       'oops)))
   )                             ; i.e. here (with value 'quitting)

;;; (con-return)
;;;  => 'quitting

;;; don't use a continuation named "break" in while -- while
;;; itself defines a break continuation that will shadow your break:

(define (con-broken)
  "use call/cc to break out of a loop"
  (call-with-current-continuation
   (lambda (break)
     (let ((i 0))
       (while (< i 123)
	 (if (= i 3) 
	     (break 'quitting)) ; this is while's break, not ours
	 (display i)
	 (set! i (+ i 1)))
       'oops)                   ; so we end up here
      ))
  )                             ; not here as we intended

;;; (con-broken)
;;;  => 'oops


(define (con-go-on)
  "use call/cc to continue where we left off if a non-serious error is reported"
  (catch #t
	 (lambda ()
	   (do ((i 0 (1+ i)))
	       ((= i 123) 'oops)
	     (if (= i 3)
		 (call-with-current-continuation
		  (lambda (keep-going)
		    (throw 'not-really-an-error keep-going)))
		 (if (= i 6)
		     (throw 'an-error)))
	     (display i)))
	 (lambda args
	     (if (eq? (car args) 'not-really-an-error)
		 ((cadr args) #f)  ;; here we are invoking the continuation passed as an arg to throw
		                   ;;   it will effectively "goto" the "display i" statement with i = 3
		 (display "got a real error")))))

;;; (con-go-on)
;;;   prints "012345got a real error"
related documentationsnd.htmlextsnd.htmlgrfsnd.htmlclm.htmlsndlib.htmlindex.html