This file contains notes on the Scheme and Ruby files included with Snd.
To use any of these files, (load <file>); for example (load "v.scm")
. To start Snd with
the file already loaded, snd -l v.scm
, or put the load statement in ~/.snd.
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.
bess.scm is a Guile script (independent of Snd) that loads sndlib and xmlib into Guile, opens the DAC, puts up a bunch of scale widgets, and starts two CLM oscils doing frequency modulation in semi-real-time (how "real-time" it is depends on your audio setup). This is a translation to the Sndlib/Libxm system of bess.cl in CLM. Michael Scholz has contributed a Ruby translation of this with many improvements: bess.rb.
bess1.scm and bess1.rb are scripts (independent of Snd), similar to bess.scm and bess.rb, that give you real-time GUI-based control over the fm-violin while it cycles around in a simple compositional algorithm. Both were written by Michael Scholz, based on CLM's bess5.cl and rt.lisp.
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 the 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.
Many of these birds were used in "Colony". To hear all the
birds, (make-birds)
. This writes the sequence out as "test.snd" using with-sound.
Waveshaping is described in Le Brun, "Digital Waveshaping Synthesis", JAES 1979 April, vol 27, no 4, p250.
... (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 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
These are instruments from the CLM tarball translated for use in Snd.
anoi file (etc) attract beg dur amp c bes-fm beg dur freq amp ratio index canter beg dur freq amp (etc) cellon beg dur freq amp (etc) drone beg dur freq amp (etc) expfil start duration hopsecs rampsecs steadysecs file1 file2 exp-snd file beg dur amp (etc) fm-bell beg dur frequency amplitude amp-env index-env index fm-drum beg dur freq amp ind (etc) fm-insect beg dur freq amp (etc) fm-trumpet beg dur (etc) fofins beg dur frq amp uvib f0 a0 f1 a1 f2 a2 (amp-env '(0 0 1 1 2 1 3 0)) fullmix infile (etc) gong beg dur freq amp (etc) gran-synth beg dur freq grain-dur grain-hop amp graphEq file (etc) hammondoid beg dur freq amp jl-reverb lbj-piano beg dur freq amp (etc) metal beg dur freq amp nrev (reverb-factor 1.09) (lp-coeff 0.7) (volume-1 1.0) pins beg dur file amp (transposition 1.0) (time-scaler 1.0) (etc) pluck beg dur freq amp (weighting .5) (lossfact .9) pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes pqw beg dur freq (etc) resflt beg dur driver (etc) reson beg dur freq amp (etc) rhodey beg dur freq amp (base .5) scratch beg file src-ratio turnlist spectra beg dur freq amp (etc) stereo-flute beg dur freq flow (etc) touch-tone beg number tubebell beg dur freq amp (base 32.0) two-tab beg dur freq amp (etc) vox beg dur freq amp ampfun freqfun freqscl voxfun index vibscl wurley beg dur freq amp zc time dur freq amp length1 length2 feedback zn time dur freq amp length1 length2 feedforward za time dur freq amp length1 length2 feedback feedforward
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 stereo-flute.
vox is a translations of Marc LeBrun's MUS10 waveshaping voice instrument using FM in this case. The waveshaping version is pqwvox ("phase-quadrature waveshaping voice"). 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 (on 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...)
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)
scratch moves back and forth in a sound file according to a list of turn times (see also env-sound-interp).
pins is a simple implementation of thje spectral modeling synthesis of Xavier Serra and Julius Smith. It is similar to the phase vocoder.
The "z" instruments demonstrate "zdelay" effects -- interpolating comb, notch, and all-pass filters.
exp-snd is a granular synthesis instrument with envelopes on nearly every variable. expfile interleaves two granulate processes.
graphEq mimics a graphical equalizer by setting up a bank of formant generators, with an optional envelope on each formant.
anoi is a stab at noise reduction based on Perry Cook's Scrubber.m.
fullmix is a complicated way to mix stuff.
snd-debug snd-trace snd-break (message #f)
debug.scm is a package of debugging aids. snd-break sets a breakpoint; if it is called, you drop into the Snd debugger. You can continue from the breakpoint, optionally returning any value you like. While in the break context (while the listener prompt says "break"), these functions are available:
break-go (returned-value #f) break-locals (stack-location 0) break-local local-var (stack-location 0) break-backtrace (all #f) break-help break-quit break-quit!
break-locals prints out the local variables and their values. break-local prints one such variable's value (the local-var argument should be a symbol or a string). break-help prints out help. break-backtrace shows the stack at the point of the snd-break call. The stack trace is normally truncated to show just the 5 or so inner frames; to get the full backtrace, call break-backtrace with an argument of #t. break-quit exits the current break level. break-quit! exits all break levels, returning you to the true top-level. break-go continues from the point of the breakpoint. The 'returned-value' is the value to return from the original call on snd-break. Here is a brief session in Snd's listener:
:(define (test-break a) (let ((b (+ a (snd-break "hiho")))) b)) #<unspecified> :(define hi 123) #<unspecified> :(set! hi (test-break 1)) break:("hiho") break:hi 123 break:(break-go 32) :#<unspecified> :hi 33
In words, we put a breakpoint in the midst of an expression in the test-break function, asking it to type "hiho" and drop into the debugger if it is executed. Then we call test-break in an expression that sets the variable hi. The breakpoint is hit, "hiho" gets reported, and we're placed in the debugger. As you can probably tell, this is just the Snd listener, but with some extra context to implement the break support. After poking around, we call break-go with an argument of 32. This causes the original set! to continue with 32 plugged in where the snd-break call was, setting hi to 33.
snd-debug sets up a debugger. You can examine the stack or local variables etc. After calling snd-debug, there are functions similar to the break functions listed above:
bt -- show backtrace lv (obj) -- show local vars
snd-trace activates any tracing that you may have requested and redirects its output to the Snd listener. Here's how to trace fm-violin calls in a notelist:
(trace fm-violin) (snd-trace (with-sound () (fm-violin 0 1 440 .1)))
To turn off the trace
(untrace fm-violin)
dlocsig.rb is Michael Scholz's translation to Ruby of Fernando Lopez-Lezcano's dlocsig in CLM. Fernando's documentation can be found in the CLM tarball (dlocsig/index.html). dlocsig is a CLM generator that can produce moving sounds.
See dlocsig.rb for documentation and examples.
The dlp directory contains a variety of useful additions written by Dave Phillips. These include:
dp-new-effects.scm a version of new-effects.scm misc.scm loads files for enhanced interface, many new menu options new-icons.scm icon box entries special-menu.scm the Special menu (OGG/MP3 etc) mix-menu.scm the Mix menu panic.scm the Panic menu (to stop sound output) track-colors.scm track color choices (for mixing) fft-menu.scm FFT-based editing new-backgrounds.scm background choices (granite Snd!) plugins-menu.scm ladspa menu marks-menu.scm the Marks menu new-buttons.scm sets the icon box actions README loading info
See the individual files and Dave's tutorial (in the tutorial directory) for more details.
There are a few other files in the main directory that I haven't documented yet:
DotEmacs Emacs init file (Fernando Lopez-Lezcano) edit123.scm Handy editing sequences (Tom Roth) inf-snd.el Ruby/Guile Emacs connection (Michael Scholz) rmsgain.scm amplitude via rms (Fabio Furlanete)
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 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.
click-for-listener-help is intended as a listener-click-hook entry. It posts help about the closest entity it can find whenever you double click in the listener. Unfortunately, the help dialog is a bit clunky for a use like this, but the minibuffer has only one line, and tooltips are irritating in their own way; perhaps it should post the help at the bottom of the listener?
A DSP grabbag, mostly filters.
dolph n gamma | Dolph-Chebyshev fft data window |
dht data | slow Hartley transform |
find-sine freq beg dur | DFT at a particular frequency |
make-butter-high-pass freq | 2nd order Butterworth highpass |
make-butter-low-pass freq | 2nd order Butterworth lowpass |
make-butter-band-pass freq bandwidth | 2nd order Butterworth bandpass |
make-butter-band-reject freq bandwidth | 2nd order Butterworth bandstop |
fltit-1 | |
spectrum->coeffs order spectrum-envelope | frequency-response envelope -> FIR coeffs |
down-oct | move sound down 8ve using fft |
freqdiv n | "frequency division" effect |
adsat size | "adaptive saturation" effect |
spike | spikey sound effect |
compute-uniform-circular-string size ... | scanned synthesis |
compute-string size ... | |
spot-freq | easily-fooled autocorrelation-based pitch tracker |
zero-phase, rotate-phase | phase-based effects |
both forms of asymmetric-fm | |
cosine-summation | sum-of-cosines stuff |
legendre-summation | |
brighten-slightly amount | add harmonics |
make-hilbert-transform length | Hilbert transform |
make-lowpass fc length | FIR lowpass |
make-highpass fc length | FIR highpass |
make-bandpass flo fhi length | FIR bandpass |
make-bandstop flo fhi length | FIR bandstop |
make-differentiator length | FIR differentiator |
make-biquad a0 a1 a2 b1 b2 | IIR cascade section |
make-iir-low-pass-1 fc | IIR 1st order lowpass |
make-iir-high-pass-1 fc | IIR 1st order highpass |
make-iir-low-pass-2 fc d | IIR 2nd order lowpass |
make-iir-high-pass-2 fc d | IIR 2nd order highpass |
make-iir-band-pass-2 f1 f2 | IIR 2nd order bandpass |
make-iir-band-stop-2 f1 f2 | IIR 2nd order bandstop |
make-eliminate-hum freq ... | hum eliminator (cascaded bandstops) |
make-peaking-2 f1 f2 m | slight resonance effect |
cascade->canonical coeffs | convert cascade coeffs to canonical (for CLM's filter gen) |
make-butter-lp M fc | any even order Butterworth lowpass |
make-butter-hp M fc | any even order Butterworth highpass |
make-butter-bp M f1 f2 | any even order Butterworth bandpass |
make-butter-bs M f1 f2 | any even order Butterworth bandstop |
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 Hartley transform is a kind of Fourier transform. A similar function, using the DFT, is find-sine. It returns the amplitude and initial-phase (for sin) at freq between beg and dur. The simple 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". The second set (make-butter-lp et al) provide arbitrary order Butterworths. 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)
.
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 Moorer's sine-summation; the generating formula is much simpler, but the result is the same. This can 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). Three other similar functions are sum-of-n-sines, sum-of-n-odd-sines, and sum-of-n-odd-cosines.
brighten-slightly is a slight simplification of contrast-enhancement. make-hilbert-transform and hilbert-transform provide an FIR filter approach to the Hilbert transform. make-lowpass and lowpass provide FIR low pass filtering. make-highpass and highpass provide FIR high pass filtering. make-bandpass and bandpass provide FIR band pass filtering. make-bandstop and bandstop provide FIR notch filtering. make-differentiator and differentiator provide an FIR filter-based differentiator.
The Ruby version of this is in examp.rb.
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 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. (Use gtk-effects.scm with Gtk, obviously). The effects include:
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, compand-channel 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 straightforward, and it's not hard to try them out.
The Ruby/Motif version of this is in effects.rb.
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 min-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 repeat-envelope env repeats #:optional (reflected #f) (normalized #f) power-env e make-power-env e #:key (scaler 1.0) (offset 0.0) duration power-env-channel pe #:optional (beg 0) dur snd chn edpos (edname "power-env-channel") envelope-exp e #:optional (power 1.0) (xgrid 100)
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
Similarly, min-envelope returns the minimum y value.
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.
:(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. repeat-envelope repeats an envelope (concatenates copies of itself).
:(repeat-envelope '(0 0 100 1) 2) (0 0 100 1 101 0 201 1)
If the final y value is different from the first y value (as above), a quick ramp is inserted between repeats. 'normalized' causes the new envelope's x axis to have the same extent as the original's. 'reflected' causes every other repetition to be in reverse.
make-power-env and power-env implement an extension of exponential envelopes; each segment has its own base. power-env-channel uses the same mechanism as an extension of env-channel.
(let ((pe (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1) :duration 1.0))) (map-channel (lambda (y) (* y (power-env pe))))) (let ((pe1 (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1.0 3 .5 3.0 4 0 0) :duration 1.0))) (power-env-channel pe1))
envelope-exp interpolates segments into envelope to approximate exponential curves.
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 has functions used by snd-test.scm to exercise the user interface. These functions depend on the xm module and XSendEvent primarily, but there are also Scheme implementations of some of the built-in functions (change-window-property).
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 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.
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, "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.
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 fft-cancel lo-freq hi-freq 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.
fft-cancel ffts an entire sound, sets the bin(s) representing lo-freq to hi-freq to 0.0, then inverse ffts,
giving a high quality notch filter.
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 (transform-graph? snd chn) (= (transform-graph-type snd chn) graph-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.
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.
There are also a few brief examples showing simple display customizations. 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.
open-next-file-in-directory
This is a mouse-click-hook function. If you call
(click-middle-button-to-open-next-file-in-directory)
it sets up the mouse-click-hook and open-hook so that clicking the middle mouse button closes the current file and opens for the next (alphabetical by filename) in the current directory.
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).
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.
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).
Panning or Sound Placement Place sound: place-sound above. Pan mix: pan-mix, or via the amplitude and envelope controls in the mix dialog Place mix: mus-mix Play sound with panning: play-panned CLM placement generator: locsig CLM moving sound generator: dlocsig Move sound via flanging: see flanging effect in new-effects.scm Cross fade in frequency domain: fade.scm
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 compand-channel beg dur snd chn edpos expsrc rate snd chn expsnd rate-envelope cross-synthesis cross-snd amp fftsize radius voiced->unvoiced amp fftsize r tempo cnvtest snd0 snd1 amp "vector synthesis" chained-dsps beg dur #:rest dsps
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. 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)
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. chain-dsps creates a patch of chained generators from its arguments.
finfo filename shell cmd mpg mpgfile rawfile read-ogg file write-ogg snd
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. OGG Vorbis files can be handled in a similar manner: read-ogg and write-ogg are examples.
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 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. 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. A similar function is scratch in clm-ins.scm.
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.
smooth-channel-via-ptree #:optional beg dur snd chn edpos
This is smooth-channel as a virtual op.
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 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 #:optional (on #t) remember-sound-state mix-channel filedat beg dur snd chn edpos insert-channel filedat beg dur snd chn edpos redo-channel edits snd chn undo-channel edits snd chn
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. These properties are normally saved when Snd's state is saved (via save-state or the Options:Save State menu). To omit a given property at that time, add its name (a symbol) to the property 'save-state-ignore (a list of symbols); see 'inset-envelope in extensions.scm.
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 you eventually reply 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:
(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.
redo-channel and undo-channel are regularized versions of redo and undo.
The two instruments in fade.scm perform frequency-domain cross-fades, that is, the cross-fade is handled by a bank of bandpass filters (formant generators). The effect is sometimes only slightly different from a normal (time-domain) cross-fade, but there are some interesting possibilities ("sound evaporation", etc).
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.
These are translations by Michael Scholz of CLM's freeverb.ins.
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. Fabio Furlanete's rmsgain.scm uses goops.
describe-hook hook remove-local-hook! hook func with-local-hook hook local-hook-procs thunk reset-all-hooks snd-hooks hook-member func hook
hooks.scm has various hook-related functions. describe-hook tries to decipher the functions on the hook list. remove-local-hook! is a kludge to get around a bug in Guile's remove-hook! function; it makes it possible to remove a locally-defined function from a hook. 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. hook-member returns #t if func is already on the hook list.
*html-reader* "netscape" html obj ? obj
index.scm provides a connection between netscape
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 sends netscape to the corresponding url
in the Snd documents.
(? 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.
This file has a translation to Snd/Scheme of Perry Cook's maraca physical model.
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-explode mark-property key id mark-click-info id save-mark-properties
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.
mark-explode splits a sound into a bunch of separate files based on mark placements.
mark-property associates a property list with each mark. There is also some code (look for "eval-header") that saves mark info in the sound file header, and reads it when the file is subsequently reopened.
mark-click-info is a mark-click-hook function that describes a mark and its properties. It is used by with-marked-sound in ws.scm.
save-mark-properties sets up an after-save-state-hook function to save any mark-properties.
These files are translations (thanks to Michael Scholz!) of CLM's maxf.ins (thanks to Juan Reyes!). They implement a new kind of resonator designed by Max Mathews.
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.
mix-sound file start mix-property key id mix-click-sets-amp mix->vct id pan-mix file (frame 0) (env 1.0) snd snap-mix-to-beat (at-anchor) 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-sound mixes file (all chans) into the currently selected sound at start. 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 sound starting at frame using the envelope env to pan the mixed samples (0: all chan 0, 1: all chan 1). The resultant mixes (if more than one) are syncd together tand any change to the position, speed, amplitude, or amplitude envelope of one, affects the other(s) to keep the notion of panning in effect. snap-mix-to-beat forces a dragged mix to end up on a beat. If at-anchor is #t, the anchor point, rather than the mix beginning falls on the beat. delete-mix deletes the mix referred to by its argument; this operation can be undone (bringing the mix back to life). mix-property associates a property list with each mix. mix-click-sets-amp uses the property lists to keep track of whether the next click should set the mix amps to zero, or to the pre-zero value.
make-track id mixes track id track->vct track save-track track filename next-mix-in-track id previous-mix-in-track id track-color track [settable] track-amp track [settable] incf-track-amp track amp-increment track-speed track [settable] transpose-track track semitones track-position track [settable] track-end track track-length track retempo-track track tempo env-track track chan env reverse-track track filter-track track coeffs sync-multichannel-mixes
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. Similarly, save-track places the track's samples into a file.
next-mix-in-track selects and returns the id of the next mix in the track (given its id number), or #f is there isn't one; previous-mix-in-track is its reverse. These make it easy to move through the mixes in a given track, or all the mixes in track 0 (the "untrack", so to speak) -- just bind some key to:
(lambda () (next-mix-in-track (if (selected-mix) (mix-track (selected-mix)) 0)))
The track-color refers to the color of the mix waveform (the thing displayed to the right of the red tag). set! (track-color trk) 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 trk) 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 trk) 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 trk) 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-frames 1)) (mix-position 0)) 16346 :(track-end (track 1)) 17846 :(max (+ (mix-position 0) (mix-frames 0)) (+ (mix-position 1) (mix-frames 1))) 17846
retempo-track affects the time between the successive mix begin points (tempo > 1.0 makes the mixes happen more quickly):
:(retempo-track (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
env-track 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 the entire track moves when you drag one mix in it, or all the amplitudes change at once. sync-multichannel-mixes is the multichannel-mix-hook entry that syncs together multichannel mixes.
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))
The Ruby version of this is in examp.rb.
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)
.
(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.
(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 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).
Michael Scholz's translation of this to Ruby is included in examp.rb.
The noise files are translations (thanks to Michael Scholz) of CLM's noise.ins. noise.ins has a very long pedigree; I think it dates back to about 1978. It can produce those all-important whooshing sounds.
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.
These files are translations of CLM's piano.ins, a piano physical model by Scott van Duyne.
These functions play sounds in various ways.
play-sound 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. 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.
add-selection-popup add-listener-popup
gtk-popup.scm is the Gtk/xg version; popup.scm is Motif/xm based. 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.
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))
See also: maraca: maraca.scm piano: piano.scm, piano.rb singer: singer.scm bowed string: strad.scm, strad.rb flute: clm-ins.scm string: compute-string plucked string: pluck in clm-ins.scm plate-reverb: plugins-menu.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:
(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 (< (vct-ref (pv-amp-increments v) i) gate) (vct-set! (pv-amp-increments 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. 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.rb) 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 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-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.
singer.scm is a translation of CLM's singer.ins. It implements a physical model of the vocal tract described in
Cook, Perry R. "Synthesis of the Singing Voice Using a Physically Parameterized Model of the Human Vocal Tract" Published in the Proceedings of the International Computer Music Conference, Ohio 1989 and as Stanford University Department of Music Technical Report Stan-M-57, August 1989. ---- "Identification of Control Parameters in an Articulatory Vocal Tract Model, with Applications to the Synthesis of Singing," Ph.D. Thesis, Stanford University Department of Music Technical Report Stan-M-68, December 1990. ---- "SPASM, a Real-time Vocal Tract Physical Model Controller; and Singer, the Companion Software Synthesis System", Computer Music Journal, vol 17 no 1 Spring 1993.
There are a couple example calls at the end of the instrument code.
The Snd-4 compatibilty file contains a number of the procedures that were removed from or renamed in Snd-5.
The Snd-5 compatibilty file contains a number of the procedures that were moved from C to Scheme during Snd-5 development.
backward-sample (count snd chn)
| |
move back count samples (C-b), return new cursor position. | |
forward-sample (count snd chn)
| |
move forward count samples (C-f), return new cursor position. | |
vct-do! (vobj proc) |
vobj[i] = (funcall proc i) . |
vcts-do! (vobj... proc) |
vobj[vi][i] = (nth vi (funcall proc num i)) . |
vcts-map! (vobj... proc) |
vobj[vi][i] = (nth vi (funcall proc num)) . |
vct-do! is the same as vct-map! except that the called function should take one argument, the current loop index. Similarly, vcts-map! and vcts-do! take any number of vcts, followed by a trailing function, and map the function's results (assumed to be a list that matches the current number of vcts) into the vct array. In the map! case, the function takes one argument, the current number of vcts awaiting values; in the do! case, it takes two arguments, the vct number and the current loop index. We could rewrite the cnvtest function to take stereo sounds:
(define cnvtest (lambda (snd0 snd1 amp0 amp1) (if (and (= (channels snd0) 2) (= (channels snd1) 2)) (let* ((flt-len (frames snd0)) (total-len (+ flt-len (frames snd1))) (cnv10 (make-convolve :filter (samples->vct 0 flt-len snd0 0))) (cnv11 (make-convolve :filter (samples->vct 0 flt-len snd0 1))) (sf10 (make-sample-reader 0 snd1 0)) (sf11 (make-sample-reader 0 snd1 1)) (out-data10 (make-vct total-len)) (out-data11 (make-vct total-len))) (vcts-map! out-data10 out-data11 (lambda (num) (list (convolve cnv10 (lambda (dir) (read-sample sf10))) (convolve cnv11 (lambda (dir) (read-sample sf11)))))) (free-sample-reader sf10) (free-sample-reader sf11) (vct-scale! out-data10 amp0) (vct-scale! out-data11 amp1) (vct->samples 0 total-len out-data10 snd1 0) (vct->samples 0 total-len out-data11 snd1 1)) (snd-print "oops -- need stereo input")))) |
As with snd5.scm and snd4.scm, snd6.scm has functions that provide backwards compatibility within version 6. Currently, these are just some old (untypable) constant names, and some slightly inconsistent old function names. clear-audio-inputs in Linux/OSS, tries to reduce soundcard background racket. append-to-minibuffer (msg snd) appends msg to whatever is in snd's minibuffer. select-mix sets the selected mix (#f = none). dismiss-all-dialogs deactivates all active dialogs. with-html sets up Help menu callbacks to send netscape a url to open, rather than opening Snd's help dialog. mix-name asociates a name with a mix, and mix-name->id returns the id given a mix name.
snd-gl.scm has examples of using OpenGL.
gl-info start-waterfall #:optional (scl 1.0) (pc-spectrum 0.2) (fft-size 512) stop-waterfall gl-dump-state
gl-info prints out information about the current GL system setup. start-waterfall starts a waterfall spectrum display of the incoming audio data. stop-waterfall turns it off. gl-dump-state displays much of the current GL graphics state.
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-sounds-in-directory (dir ".") 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 show-all-atoms make-channel-drop-site snd chn set-channel-drop drop snd chn show-font-name font show-minibuffer-font add-find-to-listener upon-save-yourself, upon-take-focus add-text-to-status-area make-variable-display page-name variable-name (type 'text) (range (list 0.0 1.0)) variable-display val widget with-minmax-button
snd-motif.scm has procedures that rely on the Motif module (xm.c). Some of these have been translated to Gtk and xg.c -- snd-gtk.scm.
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 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 an 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. However, if you drag (via button 2) the icon to the menubar, that sound will be opened, and if you drag it to a channel graph, it will be mixed at the mouse location in that channel.
(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-sounds-in-directory calls make-sound-box, filling it with any sounds found in the directory passed as its argument, defaulting to the current directory.
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 of the needle and the 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 various dac-hook functions 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 (dismiss) the dialog.
add-amp-controls adds amp sliders to the control panel for multi-channel sounds (each channel gets its own amp control slider).
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).
show-all-atoms displays (via Guile's display) all current X atom names.
make-channel-drop-site shows how to add a drop site panel to a channel. set-channel-drop changes the channel's graph's drop function to drop, a function of 3 arguments, the dropped filename (a string) and the current sound index and channel number.
show-font-name shows the Snd-related name and the X-related name of each font in a font list (it searches for the XA_FULL_NAME associated with an XFontStruct). show-minibuffer-font uses that function to show what fonts are associated with the minibuffer.
add-find-to-listener activates C-s and C-r in the listener via a separate dialog.
upon-save-yourself causes a thunk (a function of no args) to be called if the window manager sends a SAVE_YOURSELF message; similarly upon-take-focus causes a thunk to be called whenever Snd receives focus from the window manager.
add-text-to-status-area puts a text widget in the notebook's status area (the lower left portion of the main Snd window when using the -notebook invocation switch). It returns the widget; you can write to it via XmTextFieldSetString.
make-variable-display sets up a display point for an arbitrary expression which is updated via variable-display. The latter returns its argument, so it acts as a sort of probe, picking out any arbitrary point in an instrument and displaying it as the instrument is running. Display points can be organized as pages in a notebook widget:
(define wid (make-variable-display "do-loop" "i*2" 'text)) (define wid1 (make-variable-display "do-loop" "i" 'text)) (do ((i 0 (1+ i))) ((= i 10)) (variable-display (* (variable-display i wid1) 2) wid))
The 'graph and 'spectrum cases create legitimate Snd channel displays, accessible via a sound index (and channel 0); these respond to the various channel-related functions such as show-transform-peaks, although you have to give the sound index explicitly:
(define wid2 (make-variable-display "do-loop" "x" 'spectrum)) (set! (show-transform-peaks (car wid2)) #t)
Each graph or spectrum display is placed in its own pane (this is a desperate kludge), whereas all the others are ordered vertically in a single pane. The 'scale choice has an additional argument that gives the range of the scale as a list (low high):
(define wid2 (make-variable-display "do-loop" "i*2" 'scale '(-1.0 1.0)))
You can watch a generator's state on a sample-by-sample basis by putting it in a text display:
(define wid1 (make-variable-display "do-loop" "beg" 'text)) (define wid2 (make-variable-display "do-loop" "oscil" 'text)) (definstrument (simp) (let* ((beg 0) (dur 1000) (end (+ beg dur)) (osc (make-oscil 440.0))) (do ((i beg (1+ i))) ((= i end)) (variable-display i wid1) (oscil (variable-display osc wid2) 0.0)))) (simp)
variable-display doesn't work within the run macro, but if you're debugging an instrument, you're presumably not primarily concerned with optimization.
with-minmax-button adds an open/close button to each sound's pane.
snd-test.scm is a 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. event.scm has some XEvent-related functions used by snd-test.scm. The Ruby version (very incomplete) is snd_test.rb.
strad.scm is a translation (by Michael Scholz) of CLM's strad.ins (by Juan Reyes). It implements a physical model of a bowed string with stiffness.
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));
And here is the Ruby version, written by Michael Scholz (see examp.rb):
# # fm_violin([start=0.0[, dur=1.0[, freq=440.0[, amp=0.3[, *args]]]]]) # def fm_violin(start = 0.0, dur = 1.0, freq = 440.0, amp = 0.3, *args) include Math; # PI usage = "fm_violin([start=0.0[, dur=1.0[, freq=440.0[, amp=0.3[, *args]]]]]) [: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_amp, 0.0025] [:random_vibrato_amp, 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]] [:gliss_amount, 0.0] [:fm1_env, [0, 1, 25, 0.4, 75, 0.6, 100, 0]] [:fm2_env, [0, 1, 25, 0.4, 75, 0.6, 100, 0]] [:fm3_env, [0, 1, 25, 0.4, 75, 0.6, 100, 0]] [:fm1_rat, 1.0] [:fm2_rat, 3.0] [:fm3_rat, 4.0] [:fm1_index, false] [:fm2_index, false] [:fm3_index, false] [:base, 1.0] [:reverb_amount, 0.01] [:index_type, :violin] [:degree, false] [:distance, 1.0] [:degrees, false] Ruby: fm_violin(0, 1, 440, .1, [[:fm_index, 2.0]]) Guile: (fm-violin 0 1 440 .1 :fm-index 2.0)\n\n"; fm_index = (args.assoc(:fm_index)[1] rescue 1.0); amp_env = (args.assoc(:amp_env)[1] rescue [0, 0, 25, 1, 75, 1, 100, 0]); periodic_vibrato_rate = (args.assoc(:periodic_vibrato_rate)[1] rescue 5.0); random_vibrato_rate = (args.assoc(:random_vibrato_rate)[1] rescue 16.0); periodic_vibrato_amp = (args.assoc(:periodic_vibrato_amp)[1] rescue 0.0025); random_vibrato_amp = (args.assoc(:random_vibrato_amp)[1] rescue 0.005); noise_amount = (args.assoc(:noise_amount)[1] rescue 0.0); noise_freq = (args.assoc(:noise_freq)[1] rescue 1000.0); ind_noise_freq = (args.assoc(:ind_noise_freq)[1] rescue 10.0); ind_noise_amount = (args.assoc(:ind_noise_amount)[1] rescue 0.0); amp_noise_freq = (args.assoc(:amp_noise_freq)[1] rescue 20.0); amp_noise_amount = (args.assoc(:amp_noise_amount)[1] rescue 0.0); gliss_env = (args.assoc(:gliss_env)[1] rescue [0, 0, 100, 0]); gliss_amount = (args.assoc(:gliss_amount)[1] rescue 0.0); fm1_env = (args.assoc(:fm1_env)[1] rescue [0, 1, 25, 0.4, 75, 0.6, 100, 0]); fm2_env = (args.assoc(:fm2_env)[1] rescue [0, 1, 25, 0.4, 75, 0.6, 100, 0]); fm3_env = (args.assoc(:fm3_env)[1] rescue [0, 1, 25, 0.4, 75, 0.6, 100, 0]); fm1_rat = (args.assoc(:fm1_rat)[1] rescue 1.0); fm2_rat = (args.assoc(:fm2_rat)[1] rescue 3.0); fm3_rat = (args.assoc(:fm3_rat)[1] rescue 4.0); fm1_index = (args.assoc(:fm1_index)[1] rescue false); fm2_index = (args.assoc(:fm2_index)[1] rescue false); fm3_index = (args.assoc(:fm3_index)[1] rescue false); base = (args.assoc(:base)[1] rescue 1.0); reverb_amount = (args.assoc(:reverb_amount)[1] rescue 0.01); index_type = (args.assoc(:index_type)[1] rescue :violin); degree = (args.assoc(:degree)[1] rescue false); distance = (args.assoc(:distance)[1] rescue 1.0); degrees = (args.assoc(:degrees)[1] rescue false); srate = (srate() rescue $rbm_srate); chans = (channels() rescue $rbm_channels); beg = (srate * start).round; len = (srate * dur).round; frq_scl = hz2radians(freq); modulate = fm_index.nonzero?; maxdev = frq_scl * fm_index; vln = (not (index_type == :cello)) logfreq = log(freq); sqrtfreq = sqrt(freq); index1 = (fm1_index or [PI, maxdev * (vln ? 5.0 : 7.5) / logfreq].min); index2 = (fm2_index or [PI, maxdev * 3.0 * (vln ? ((8.5 - logfreq) / (3.0 + freq * 0.001)) : (15.0 / sqrtfreq))].min); index3 = (fm3_index or [PI, maxdev * (vln ? 4.0 : 8.0) / sqrtfreq].min); easy_case = (noise_amount.zero? and (fm1_env == fm2_env) and (fm1_env == fm3_env) and (fm1_rat - fm1_rat.floor).zero? and (fm2_rat - fm2_rat.floor).zero? and (fm3_rat - fm3_rat.floor).zero?); coeffs = (easy_case and modulate and partials2polynomial([fm1_rat, index1, (fm2_rat / fm1_rat).floor, index2, (fm3_rat / fm1_rat).floor, index3])); norm = ((easy_case and modulate and 1.0) or index1); carrier = make_oscil(freq); fmosc1 = (modulate and make_oscil(fm1_rat * freq)); fmosc2 = (modulate and (easy_case or make_oscil(fm2_rat * freq))); fmosc3 = (modulate and (easy_case or make_oscil(fm3_rat * freq))); ampf = make_env(amp_env, amp, dur, 0.0, base); indf1 = (modulate and make_env(fm1_env, norm, dur)); indf2 = (modulate and (easy_case or make_env(fm2_env, index2, dur))); indf3 = (modulate and (easy_case or make_env(fm3_env, index3, dur))); frqf = make_env(gliss_env, gliss_amount * frq_scl, dur); pervib = make_triangle_wave(periodic_vibrato_rate, periodic_vibrato_amp * frq_scl); ranvib = make_rand_interp(random_vibrato_rate, random_vibrato_amp * frq_scl); fm_noi = (noise_amount.nonzero? and make_rand(noise_freq, PI * noise_amount)); ind_noi = ((ind_noise_amount.nonzero? and ind_noise_freq.nonzero?) and make_rand_interp(ind_noise_freq, ind_noise_amount)); amp_noi = ((amp_noise_amount.nonzero? and amp_noise_freq.nonzero?) and make_rand_interp(amp_noise_freq, amp_noise_amount)); vib = 0.0; modulation = 0.0; # make_locsig(degree=0.0, distance=1.0, reverb=0.0, output, revout, chans=1, type=Mus_linear) # Ruby's rand() is shadowed by CLM's rand(), that's why mus_random().abs. loc = make_locsig((degree or degrees or mus_random(90.0).abs), distance, reverb_amount, false, false, chans); fuzz = 0.0; ind_fuzz = 1.0; amp_fuzz = 1.0; out_data = make_vct(len); vct_map!(out_data, lambda { | | fuzz = rand(fm_noi) if noise_amount.nonzero?; vib = env(frqf) + triangle_wave(pervib) + rand_interp(ranvib); ind_fuzz = 1.0 + rand_interp(ind_noi) if ind_noi; amp_fuzz = 1.0 + rand_interp(amp_noi) if amp_noi; if(modulate) if(easy_case) modulation = env(indf1) * polynomial(coeffs, oscil(fmosc1, vib)); else 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); end end env(ampf) * amp_fuzz * oscil(carrier, vib + ind_fuzz * modulation); }); if(chans == 2) mix_vct(vct_scale!(vct_copy(out_data), locsig_ref(loc, 1)), beg, $rbm_snd, 1, false); mix_vct(vct_scale!(out_data, locsig_ref(loc, 0)), beg, $rbm_snd, 0, false); else mix_vct(out_data, beg, $rbm_snd, 0, false); end rescue die(usage + "fm_violin()"); end
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. Kalle Olavi Niemitalo came up with this Scheme/Guile replacement:
(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))
The version in ws.scm is simply an amplification of this code. The global variables that parallel CLM's *clm-...* are:
*clm-srate* (default-output-srate) ; default srate *clm-file-name* "test.snd" ; default output file name *clm-channels* (default-output-chans) ; default number of output chans *clm-data-format* (default-output-format) ; default output data format *clm-header-type* (default-output-type) ; default output header type *clm-delete-reverb* #f ; should reverb stream be deleted? *clm-verbose* #f ; currently unused *clm-play* #f ; should the output be played at the end *clm-statistics* #f ; should stats be printed out at the end *clm-reverb* #f ; reverb function, if any *clm-reverb-channels* 1 ; reverb stream chans *clm-reverb-data* '() ; args pass to reverb function with-sound #:key (srate *clm-srate*) (output *clm-file-name*) (channels *clm-channels*) (header-type *clm-header-type*) (data-format *clm-data-format*) (comment #f) ;(verbose *clm-verbose*) (reverb *clm-reverb*) (revfile "test.rev") (reverb-data *clm-reverb-data*) (reverb-channels *clm-reverb-channels*) (continue-old-file #f) (statistics *clm-statistics*) (scaled-to #f) (play *clm-play*) (to-snd *to-snd*) (scaled-by #f)
As far as possible, this parallels CLM's with-sound.
(with-sound (:srate 44100) (fm-violin 0 1 440 .1))
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 is:
(definstrument (ins args) (let ... (ws-interrupt?) ; see below (run (lambda () (do ((i start (1+ i))) ((= i end)) (outa i ... *output*))))))
which parallels the Common Lisp CLM (change the loop statement to a do statement, add the lambda wrapper (needed by the run macro unfortunately), and you're ready to go). If the run macro can handle the instrument code (and it can handle anything the CL version can handle, I think), then the Snd with-sound should run within a factor of four of the fastest CL-based CLM, even though the latter is going through the C intermediate file and the (very good) C compiler! The easiest way to mix an existing file into the with-sound output is to use mus-mix with *output*:
(with-sound () (fm-violin 0 .1 440 .1) (mus-mix *output* "oboe.snd") (fm-violin .1 .1 660 .1))
To continue adding notes to an existing file, set continue-old-file:
(with-sound (:continue-old-file #t) (fm-violin 0 1 440 .1))
with-sound returns the output file name. If a previous file of the same name is currently open, it is closed before the new version is opened.
ws.scm also has a version of def-clm-struct, sound-let, and with-mix. with-sounds and sound-lets can be nested -- see clm.html. def-clm-struct in Snd/Guile provides a way to package up heterogenous data for user-defined generators. In pure-Scheme it just sets up functions to make and access such a list, but in Snd's run macro, it also provides type declarations:
(def-clm-struct hiho i x (s "hiho") (ii 3 :type int) (xx 0.0 :type float))
defines a structure type ("hiho") with 5 fields. "hiho-s" defaults to the string "hiho", "hiho-ii" defaults to 3, and declares that its type will always be int (so it can be used without restriction in run), and so on.
(define hi (make-hiho :xx 3.14))
defines a variable named hi whose value is a hiho structure (a list) with
all the fields taking their default value except "xx" which is set to 3.14.
So, hi's value is (list 'hiho #f #f "hiho" 3 3.14)
.
init-with-sound and finish-with-sound split with-sound into two pieces, primarily for Common Music's benefit.
(define w (init-with-sound :scaled-to .5)) (fm-violin 0 1 440 .1) (finish-with-sound w)
is equivalent to
(with-sound (:scaled-to .5) (fm-violin 0 1 440 .1))
with-sound establishes a catch for debugging: 'with-sound-interrupt. If you place the macro ws-interrupt? in your instrument, C-g will be caught at each such point, and control transferred to the with-sound debugging context. Currently, ws-interrupt? is not supported by the run macro, but each of the clm-ins.scm instruments includes it just before the run loop. Once in the debugger, you are simply in the standard listener loop, but there are several additional functions to help with debugging:
ws-go (returned-value #f) ws-locals (stack-location 0) ws-local local-var (stack-location 0) ws-backtrace (all #f) ws-help ws-quit ws-quit! ws-stop ws-stop!
ws-locals prints out the current instrument's local variables and their values. ws-local prints one such variable's value (the local-var argument should be a symbol or a string). ws-help prints out help. ws-backtrace shows the stack at the point of the interrupt. The stack trace is normally truncated to show just the 5 or so inner frames; to get the full backtrace, call ws-backtrace with an argument of #t. ws-quit exits with-sound without running the reverb (it does, however, close the current output file). ws-quit! exits all interrupt levels (in case you called with-sound while in a previous interrupted one, then interrupted that one as well), returning you to the true top-level. ws-stop jumps out of the notelist at the interrupted point, but goes ahead and runs any reverb before closing the output. ws-stop! is similar to ws-stop, but it also makes sure you're back at the top level at the end. ws-go continues from the point of the interrupt. The 'returned-value' is the value to return from the original call on ws-interrupt? (or its equivalent).
Toward the end of ws.scm is an example, with-marked-sound, that is just like with-sound except that it adds a mark at the start of each note in the output sound; the corresponding code in your instrument sets the mark's :ws property to contain any info you might find amusing. You then click the mark to see that info.
Also defined in ws.scm are the CLM functions seconds->samples and time->samples, and the saved-state-prettification functions mus-data-format->string and mus-header-type->string. The *clm-* variables are saved in the save-state file by ws-save-state, which may not be a good idea -- feedback welcome!
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:
(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))
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). 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))))))
Needless to say, this is not intended to be a suave, romantic gesture!
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. 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 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 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]);
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:
#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
).
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. 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 code implements a comb filter with a one-zero filter on the feedback.
#include "sndlib.h" #include "clm.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 */ 0, 0, &mus_fcomb, /* mus_run: the run-time fcomb function, MUS_RUN(gen) for speed */ 0, /* type extension (normally 0) */ NULL, 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"); }
A continuation is a kind of GOTO, a jump to the end of the defining call-with-current-continuation form:
(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 (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 "goto" the "display i" statement with i = 3 (display "got a real error"))))) ;;; (con-go-on) ;;; prints "012345got a real error" ;;; here's one that is not just a simple exit: (let ((a 1) (b 1)) (let ((cont1 #f) (cont2 #f)) (call-with-current-continuation (lambda (x) (set! cont1 x))) ; set cont1 ;; this is now where (cont1) will jump: label it CONT1 (set! a (+ a 2)) (display "a") (if cont2 (cont2) ; if cont2 has been set, use it to jump to CONT2 below (begin (call-with-current-continuation (lambda (x) (set! cont2 x) ; set cont2 (set! b (+ b 1)) (display "b"))) ;; this is where (cont2) will jump: CONT2 (set! b (+ b 2)) (display "!") (if (< b 6) (cont1) ; goto CONT1 above #f))))) ;;; this prints "ab!a!"