Scheme and Ruby Functions included with Snd |
|
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.
autosave.scm |
auto-save cancel-auto-save
The auto-save code sets up a background process that checks periodically for
unsaved edits, and if any are found it saves them in a temporary file.
The time between checks
is set by the variable auto-save-interval which defaults to 60.0 seconds.
To start auto-saving, (load "autosave.scm"). Thereafter (cancel-auto-save)
stops autosaving, and (auto-save) restarts it.
bess.scm, bess.rb |
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, bess1.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.scm |
bird start dur frequency freqskew amplitude freq-envelope amp-envelope bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials one-bird beg maxdur func birdname make-birds #:optional (output-file "test.snd")
bird.scm is a translation of 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.
The lines
...
(coeffs (partials->polynomial (normalize-partials partials)))
...
(polynomial coeffs
(oscil os (env gls-env))))))
setup and run the waveshaping synthesis (in this case it's just a fast additive synthesis). partials->polynomial calculates the Chebyshev polynomial coefficients given the desired spectrum; the spectrum then results from driving that polynomial with an oscillator. Besides the bird guides, there are now numerous recordings of birds that could easily be turned into sonograms and transcribed as envelopes.
In 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
The Forth version (written by Michael Scholz) is:
instrument: bird { f: start f: dur f: freq f: freq-skew f: amp freq-env amp-envel }
freq make-oscil-1 { os }
amp-envel amp dur make-env { amp-env }
freq-env freq-skew hz>radians dur make-env { gls-env }
90e random 1e make-locsig { loc }
start dur run amp-env env gls-env env os oscil-1 f* i loc locsig loop
;instrument
clm-ins.scm, clm-ins.rb |
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.
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. clm23.scm is a translation of the CLM test instruments in ug2.ins and ug3.ins. It has some comments about the differences between the CL and Scheme instruments.
debug.scm |
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 |
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.
dlp directory entries |
The dlp directory contains a variety of useful additions written by Dave Phillips. These include:
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!) 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.
draw.scm |
draw.scm has examples of graphics additions; some of these are shown in extsnd.html.
display-energy is a lisp-graph-hook procedure that displays the current time domain data as energy, not amplitude, using the y zoom slider to control the 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. If you're using a line cursor (cursor-style is cursor-line), it will draw itself in the little graph; to get a more polite cursor, use smart-line-cursor, defined in draw.scm.
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?
dsp.scm |
A DSP grabbag, mostly filters.
| dolph n gamma | Dolph-Chebyshev fft data window |
| down-oct n, stretch-sound-via-dft | move sound down a factor of n using fft/dft |
| 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 |
| kosine-summation | more sum-of-cosines stuff |
| legendre-sum | |
| fejer-sum | |
| brighten-slightly amount | add harmonics |
| spectrum->coeffs order spectrum-envelope | frequency-response envelope -> FIR coeffs |
| 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-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 | |
| 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 |
| notch-channel freqs order beg dur s c e trunc width | arbitrary notch filter applied to channel |
| notch-sound freqs order s c width | arbitrary notch filter applied to sound |
| notch-selection freqs order width | arbitrary notch filter applied to selection |
| fractional-fourier-transform rl im size angle | fractional dft |
| z-transform rl size z | |
| dht data | slow Hartley transform |
| find-sine freq beg dur | DFT at a particular frequency |
| goertzel freq beg dur | same as find-sine but faster |
| make-spencer-filter | return FIR filter with Spencer coefficients |
| any-random | random numbers of arbitrary distribution using rejection method |
| channel-variance etc | miscellaneous funcs from Julius Smith, Mathematics of the DFT |
| channel-distance s0 c0 s1 c1 | a measure of the difference between two sounds (Euclidean distance) |
| shift-channel-pitch | shift all components by some frequency ("single-sideband amplitude modulation") |
| ssb-bank | time/pitch changes using ssb-am gens |
| ssb-bank-env | time/pitch changes using ssb-am gens and a frequency envelope |
| make-ssb-fm, ssb-fm | quasi-single-sideband FM |
| periodogram N | periodogram displayed in "lisp graph" |
| vct-polynomial v coeffs | polynomial evaluation of entire vct |
| channel-polynomial coeffs snd chn | polynomial evaluation of entire channel |
| spectral-polynomialcoeffs snd chn | polynomial evaluation of entire channel in frequency domain (convolution) |
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.
A faster version is goertzel. (car (find-sine 440.0 0 (frames)))
is the same as (* 2 (/ (goertzel 440.0 0 (frames)) (frames))).
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-channel (fltit-1 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0)))
down-oct tries to move a sound down n (a power of 2) by goofing with the fft data,
then inverse ffting. A more general version of this is stretch-sound-via-dft, but it's
extremely slow.
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-sum and fejer-sum produce a band-limited pulse-train whose cosine components have a decreasing amplitude. Three other similar functions are sum-of-n-sines, sum-of-n-odd-sines, and sum-of-n-odd-cosines. kosine-summation is a variation on cosine-summation; it includes a sort of "FM index" parameter (named "k", hence the generator name) to vary the harmonic content at run-time.
brighten-slightly is a slight simplification of contrast-enhancement.
make-hilbert-transform and hilbert-transform provide an FIR filter approach to the Hilbert transform (see ssb-am). 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.
notch-channel and notch-selection are aimed at noise reduction. Each takes a list of frequencies (in Hz), and an optional filter order, and notches out each frequency. The sharpness of the notch is settable explicitly via the width argument, and implicitly via the filter order. A common application cancels 60 Hz hum:
(notch-channel (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)))
Here we've built a list of multiples of 60 and passed it to notch-channel. Its default notch width is 2 Hz, and its default order tries to maintain that width given the channel's sampling rate, so the default filter order can be very high (65536). The filtering is normally done via convolutuion (CLM's convolve generator), so a high filter order is not a big deal. In ideal cases, this can reduce the hum and its harmonics by about 90%. But, if the hum is not absolutely stable, you'll probably want wider notches:
(notch-channel (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) 1024)
The order of 1024 means we get 20 Hz width minima (44100 Hz srate), so this notches out much bigger chunks of the spectrum. You get 98% cancellation, but also lose more of the original signal.
fractional-fourier-transform is the slow (dft) version of the fractional Fourier Transform. z-transform performs a z transform. Some of the functions from Julius Smith's "Mathematics of the DFT" are included: channel-mean, channel-rms, channel-variance, etc. A similar function is channel-distance that returns the Euclidean distance between two sounds.
vct-polynomial returns the evaluation of the polynomial (given its coefficients) over an entire vct, each element being treated as "x". channel-polynomial performs the same operation over a sound channel. spectral-polynomial is similar, but operates in the frequency domain (each multiply being a convolution).
:(vct-polynomial (vct 0.0 2.0) (vct 1.0 2.0)) ; x*2 + 1 #<vct[len=2]: 1.000 5.000> :(channel-polynomial (vct 0.0 1.0 1.0 1.0)) ; x*x*x + x*x + x
The "constant" (coeff 0) term in spectral polynomial is treated as a dither amount (that is, it has the given magnitude, but its phase is randomized, rather than being simple DC).
The ssb-* functions provide single-sideband amplitude modulation, and pitch/time changes
based on the ssb-am generator.
If you run ssb-am on some input signal, the result is that that signal is shifted in pitch by
the freq amount. The higher the order, the better the low frequency cancellation
is (amplitude modulation creates symmetrical sidebands, one of which is cancelled by the ssb-am
generator). The ssb-bank uses a bank of ssb-am generators, each with its bandpass filter to
shift a sound's pitch without changing its duration;
the ssb-am generators do the pitch
shift, and the filters pick out successive harmonics,
so each harmonic gets shifted individually.
For an oboe at 557 Hz, good values are:
(ssb-bank 557 new-freq 6 40 50).
For a person talking at ca. 150 Hz:
(ssb-bank 150 300 30 100 30) or
(ssb-bank 150 100 40 100 20).
To get a duration change without a pitch change, use this functions
followed by sampling rate conversion back to the original pitch:
(define (stretch-oboe factor) (ssb-bank 557 (* factor 557) 7 40 40) (src-sound (/ 1.0 factor)))
A similar idea is used in make-ssb-fm and ssb-fm to implement
a sort of asymmetric FM.
ssb-bank-env is the same as ssb-bank, but includes a frequency envelope:
(ssb-bank-env 557 880 '(0 0 1 100.0) 7).
There is a dialog that runs ssb-bank in snd-motif.scm: create-ssb-dialog.
any-random provides the same output as rand if the latter's envelope (distribution function) argument is used, but using a slightly different method to generate the numbers. Also included is inverse-integrate, a Scheme version of CLM's distribution-to-weighting function, and gaussian-envelope which makes a gaussian distribution envelope suitable for rand.
|
edit-menu.scm |
edit-menu.scm adds some useful options to the Edit menu:
trim front and trim back (to/from marks) crop (first and last marks) selection->new cut selection->new append selection (and append sound)
edit123.scm, snd_conffile.scm |
These two files are examples of Snd customization files, suitable for inclusion in ~/.snd. edit123.scm is by Tom Roth, and snd_conffile.scm is by Kjetil S. Matheussen.
new-effects.scm, gtk-effects.scm, effects.rb |
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). 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) filter 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.
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 straightforward, and it's not hard to try them out.
The Ruby/Motif version of this is in effects.rb.
env.scm, env.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) rms-envelope file #:key (beg 0.0) (dur #f) (rfreq 30.0) (db #f)
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.
:(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 .1 .9 1 1 1.3 .2 2 0) 2) (0 0 0.1 0.9 1.0 1 1.3 0.2 2.0 0 2.1 0.9 3.0 1 3.3 0.2 4.0 0) | 
|
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. rms-envelope returns an rms envelope of a file; it is based on rmsenv.ins in the CLM package.
enved.scm |
start-enveloping stop-enveloping channel-envelope snd chn play-with-envs snd play-panned snd
enved.scm implements an independent envelope editor in each channel. (start-enveloping)
sets this in progress (for subsequently opened sounds), (stop-enveloping) turns it off.
Each envelope can be read or written via (channel-envelope snd chn).
There are also two examples that use these envelopes: play-with-envs and
play-panned. The former sets the channel's amplitude from its envelope
during playback (it should be obvious how to apply the envelope to any of the
control panel fields); the latter pans a mono sound into stereo following
the envelope. The lines:
(define channel-envelope
(make-procedure-with-setter
(lambda (snd chn)
...)
(lambda (snd chn new-env)
...)))
use a feature of Guile 1.4 that provides a set! function for channel-envelope. The first lambda is called if you're asking for the current value of that channel-envelope:
(channel-envelope s c)
and the second if you're setting it to something new:
(set! (channel-envelope s c) e)
event.scm |
event.scm has functions used by snd-test.scm to exercise the user interface. These functions depend on the xm module and XSendEvent primarily, but there are also Scheme implementations of some of the built-in functions (window-property).
examp.scm |
examp.scm has become a bit of a grab-bag; rather than get organized, I just appended new stuff as it came to mind. The following documentation is a quick overview of the code; most of the examples are very simple, so (as the saying goes) "the code is the documentation". Also, there's some overlap between these examples, other .scm files, and discussions in other documents. I'm slowly dividing out related groups of procedures to separate files.
filters |
comb-filter scaler size comb-chord scaler size amp zcomb scaler size pm notch-filter scaler size formant-filter radius frequency formants r1 f1 r2 f2 r3 f3 moving-formant radius move-envelope osc-formants radius bases amounts freqs remove-click
The two versions of comb-filter implement a comb filter, "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-channel (comb-filter .8 32)) (map-channel (comb-chord .95 100 .3)) (map-channel (comb-chord .95 60 .3)) (map-channel (zcomb .8 32 '(0 0 1 10))) (map-channel (notch-filter .8 32)) (map-channel (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-channel (formants .99 900 .98 1800 .99 2700)) (map-channel (moving-formant .99 '(0 1200 1 2400))) (map-channel (osc-formants .99 '(400 800 1200) '(400 800 1200) '(4 2 3)))
filtered-env envelope
filtered-env creates an amplitude envelope and a one-pole filter, and moves them in parallel over a sound; as the sound gets softer, the low-pass filter's cutoff frequency gets lower, a sort of poor-man's distance effect. When envelope is at 1.0, no filtering takes place.
fltit remove-clicks
fltit is a simple FIR filter call. remove-clicks looks for obvious clicks and uses smooth-sound to remove them.
ffts |
correlate snd chn y0 y1 superimpose-ffts snd chn y0 y1 fft-edit low-freq high-freq fft-env-edit env fft-env-interp env1 env2 interp fft-squelch squelch 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.
user-interface |
show-draggable-graph, in imitation of Snd's FFT display, implements a draggable X axis in the lisp graph window. (This is slightly messier than it ought to be). Two of the examples are imitations of Xemacs: a Buffers menu and an auto-save hook (now in autosave.scm).
open-buffer filename close-buffer snd
The Buffers menu provides a list of currently open sounds; selecting one in the menu causes it to become the selected sound; open-buffer adds a menu item that will select a file, close-buffer removes it. To activate this, we need to:
(add-hook! open-hook open-buffer) (add-hook! close-hook close-buffer)
A similar menu is the "reopen menu"; it presents a list of previously closed (and not subsequently re-opened) files in reverse order of closing.
snd-out
A minor irritation in the current Guile system is that Scheme's "display" function writes to current-output-port, but there's no simple way to redirect that elsewhere (and with-output-to-string is not completely integrated with Guile's help system). So, if your code calls display, the result may be invisible. One way around this is to reset the current-output-port to be a soft port that actually calls snd-print instead:
(define stdout (current-output-port)) ;save it in case we want to go back to it
(define snd-out
(make-soft-port
(vector ;soft port is a vector of procedures:
(lambda (c) (snd-print c)) ; procedure accepting one character for output
(lambda (s) (snd-print s)) ; procedure accepting a string for output
(lambda () #f) ; thunk for flushing output (not needed here)
#f ; thunk for getting one character (also not needed)
(lambda () #f)) ; thunk for closing port -- hmm should this go back to the previous?
"w"))
(set-current-output-port snd-out)
You could also (set! display snd-print), if you're willing to
live dangerously; this replaces Guile's built-in display procedure with
Snd's snd-print.
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 |
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 () "move window to align with mark"
(first-mark-in-window-at-left)))
first-mark-in-window-at-left moves the (time domain) graph so that the leftmost visible mark is at the left edge; mark-loops places marks at any loop points found in the selected sound's header. Only a few headers support loop points (these are apparently used in synthesizers to mark portions of a waveform that can be looped without causing clicks, thereby lengthening a sound as a key is held down).
selections |
all-chans swap-selection-channels selection-rms-1 selection-rms region-rms region replace-with-selection explode-sf2
swap-selection-channels swaps the currently selected data's channels. The various rms functions return the rms value of the desired data in a variety of ways. The fastest and simplest uses CLM's dot-product function:
(define (region-rms n)
"(region-rms n) -> rms of region n's data (chan 0)"
(if (region? n)
(let* ((data (region->vct 0 0 n)))
(sqrt (/ (dot-product data data) (vct-length data))))
(throw 'no-such-region (list "region-rms" n))))
replace-with-selection replaces data at the cursor with the current selection. explode-sf2 turns a soundfont file (assuming it is the currently selected sound) into a bunch of files of the form sample-name.aif.
mixes |
mix.scm has mix and track related functions.
place-sound mono-snd stereo-snd panning-envelope-or-degree
If panning-envelope-or-degree is a number (in degrees), the place-sound function has the same effect as using CLM's locate generator; it mixes a mono sound into a stereo sound, splitting it into two copies whose amplitudes depend on the desired location. 0 degrees: all in channel 0, 90: all in channel 1. If panning-envelope-or-degree is an envelope, the split depends on the panning envelope (0 = all in chan 0, etc).
|
sound effects |
Most of these sound effects are based on CLM generators.
echo scaler secs
zecho scaler secs frq amp ; modulated echo
flecho scaler secs ; filtered echo
ring-mod freq gliss-env ; ring-modulation
am freq ; amplitude modulation
hello-dentist frq amp ; randomized sampling rate changes
fp sr osamp osfrq ; osc-driven src ("Forbidden Planet")
compand
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"
chain-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-channel (echo .5 .5) 0 44100) (map-channel (zecho .5 .75 6 10.0) 0 65000) (map-channel (flecho .5 .9) 0 75000) (map-channel (ring-mod 100 '(0 0 1 0))) (map-channel (ring-mod 10 (list 0 0 1 (hz->radians 100)))) (map-channel (am 440)) (hello-dentist 40.0 .1) (fp 1.0 .3 20) (map-channel (compand)) (expsnd '(0 1 2 .4)) (expsnd '(0 .5 2 2.0)) (map-channel (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.
miscellaneous extensions |
do? finfo filename shell cmd mpg mpgfile rawfile read-ogg file write-ogg snd read-speex file write-speex snd read-flac file write-flac snd read-ascii file out-file out-type out-format out-srate
do? provides an interruptible "do" that can be continued from the point of the C-g interrupt.
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: see read-ogg and write-ogg. For Speeex files: read-speex and write-speex. For FLAC files: read-flac and write-flac. For ASCII files (as in Octave/WaveLab), read-ascii.
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.
smooth-channel-via-ptree #:optional beg dur snd chn edpos ring-modulate-channel freq #:optional beg dur snd chn edpos
The first is smooth-channel as a virtual op, and the second applies ring-modulation (multiplication by a sine wave, similar to Craig Sapp's ring-modulate.ins in CLM), also as a virtual op. scramble-channels uses swap-channels to return the current sound with the channels reordered arbitrarily. scramble-channelsearches for silences, sets up a list of segments based on those silences, and randomly re-orders the segments.
extensions.scm, extensions.rb |
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 channel-sync snd chn make-selection beg end snd chn delete-selection-and-smooth eval-over-selection func #:optional 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 (check #t) remember-sound-state mix-channel filedat #:optional beg dur snd chn edpos insert-channel filedat #:optional beg dur snd chn edpos redo-channel #:optional (edits 1) snd chn undo-channel #:optional (edits 1) snd chn any-env-channel env func #:optional beg dur snd chn edpos sine-ramp a0 a1 #:optional beg dur snd chn edpos sine-env-channel env #:optional beg dur snd chn edpos blackman4-ramp a0 a1 #:optional beg dur snd chn edpos blackman4-env-channel env #:optional beg dur snd chn edpos ramp-squared a0 a1 #:optional (symmetric #t) beg dur snd chn edpos env-squared-channel env #:optional (symmetric #t) beg dur snd chn edpos ramp-expt a0 a1 exponent #:optional (symmetric #t) beg dur snd chn edpos env-expt-channel env exponent #:optional (symmetric #t) beg dur snd chn edpos offset-channel amount #:optional beg dur snd chn edpos dither-channel #:optional (amount .00006) beg dur snd chn edpos contrast-channel index #:optional beg dur snd chn edpos channels-equal? snd1 chn1 snd2 chn2 allowable-difference channels=? snd1 chn1 snd2 chn2 allowable-difference mono->stereo new-name snd1 chn1 snd2 chn2 mono-files->stereo new-name chan1-file chan2-file stereo->mono orig-snd chan1-name chan2-name
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. channel-sync uses the channel-properties list to implement a channel-local sync field.
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. A better name might be map-selection. The code:
(bind-key (char->integer #\x) 4 (lambda () "eval over selection" (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. The func is passed one argument, the sound file name. 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. offset-channel adds a constant to a sound, using ptree-channel. dither-channel adds "dithering" (noise) which supposedly makes everything copacetic. contrast-channel is the CLM contrast-enhancement function, equivalent to the control panel Contrast slider. channels=? returns #t is the two specified channels are the same within the given tolerance (which can be 0.0). channels-equal? returns #t if channels=? and the channels are the same length. In the "=" case, the trailing (extra) samples in one channel are checked against 0.0. mono->stereo combines two mono sounds (currently open in Snd) into one (new) stereo file. mono-files->stereo is the same, but the source sounds are files, not necessarily already open in Snd. stereo->mono takes a stereo sound and produces two new mono sounds. (The corresponding stereo->mono-files can be based on the existing extract-channel function).
any-env-channel takes an envelope and a function to produce the connection between successive
breakpoints, and applies the two to the current channel as an envelope. This packages up most of
the "boilerplate" associated with applying an envelope to a sound. It is used by the other three
enveloping functions, sine-env-channel, blackman4-env-channel, and env-squared-channel.
sine-ramp and sine-env-channel are the sinusoidal versions of ramp-channel
and env-channel.
(sine-env-channel '(0 0 1 1 2 -.5 3 1)) applies the given envelope to the current channel,
connecting the points with a sinusoidal curve. It uses ptree-channel,
so it's just as fast as env-channel. Similarly, blackman4-env-channel connects the dots with
a sum of cosines, and env-squared-channel connects the dots with an x^2 curve. For any
positive exponent, use env-expt-channel. The symmetric argument determines whether the
up and down moving ramps look symmetrical around a break point.
fade.scm |
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 |
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 (channel->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.
freeverb.scm, freeverb.rb |
These are translations by Michael Scholz of CLM's freeverb.ins.
hooks.scm, hooks.rb |
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 and hooks.rb have 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.
index.scm, index.rb |
html obj ? obj
index.scm provides a connection between mozilla or 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 mozilla 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.
inf-snd.el, DotEmacs |
These two files provide support for Snd as an Emacs subjob. inf-snd.el is by Michael Scholz, and DotEmacs is by Fernando Lopez-Lezcano.
jcrev.scm |
jc-reverb is a reverberator developed by John Chowning a long time ago (I can't actually remember when -- before 1976 probably). It "colors" the sound much more than nrev, and has noticeable echos, but I liked the effect a lot. new-effects.scm has a version of jc-reverb that run as a normal snd editing function (via map-channel), whereas the jcrev.scm version assumes it is being called within with-sound:
(with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .1))
It is possible to use the CLM/with-sound reverbs (or any such instrument) as an ordinary editing function:
(if (not (defined? '*output*)) (load-from-path "ws.scm"))
(define* (clm-reverb-sound reverb-amount reverb #:optional (reverb-data '()) snd)
(let ((output (snd-tempnam))
(revout (snd-tempnam))
(len (+ (frames snd) (srate snd))))
(scale-by (- 1.0 reverb-amount) snd)
(save-sound-as output snd)
(undo 1 snd)
(scale-by reverb-amount snd)
(save-sound-as revout snd)
(undo 1 snd)
(set! *output* (continue-sample->file output))
(set! (mus-srate) (srate snd))
(set! *reverb* (make-file->sample revout))
(apply reverb reverb-data)
(mus-close *reverb*)
(mus-close *output*)
(delete-file revout)
(set! (samples 0 len snd #f #f #f 0 #f #t) output)))
;;; (clm-reverb-sound .1 (lambda (dur) (jc-reverb #f 1.0 #f dur)))
Another approach to this problem would be to use snd->sample to redirect the *reverb* input (without any change to the reverberator), getting its data from the current sound (probably after scaling it by the reverb amount).
|
ladspa.scm, ladspa-help.scm |
This file takes your LADSPA library and builds a set of dialogs to control and preview each effect. The related help strings are in ladspa-help.scm.
maraca.scm |
This file has a translation to Snd/Scheme of Perry Cook's maraca physical model.
marks.scm |
marks.scm is a collection of mark-related functions.
mark-name->id name describe-mark id syncup ids fit-selection-between-marks m1 m2 pad-marks ids secs move-syncd-marks sync samples-to-move play-syncd-marks sync eval-between-marks func snd snap-marks define-selection-via-marks m1 m2 snap-mark-to-beat mark-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 () "eval between marks" (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.
maxf.scm, maxf.rb |
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 |
mix.scm provides various mix and track related utilities.
mix-sound file start mix-property key id mix-click-sets-amp mix->vct id pan-mix file (frame 0) (env 1.0) snd (chn 0) pan-mix-selection (frame 0) (env 1.0) snd (chn 0) pan-mix-region region (frame 0) (env 1.0) snd (chn 0) pan-mix-vct vct (frame 0) (env 1.0) snd (chn 0) snap-mix-to-beat (at-anchor) delete-all-mixes find-mix sample snd chn mix-maxamp id save-mix id filename mix-click-info id
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 1, 1: all chan 0). The resultant mixes (if more than one) are placed in their own track, and the track amp env is interpreted as a panning envelope. To tie this into C-x C-q, in place of the default "mix" function,
(bind-key (char->integer #\q) 4 ; C-q
(lambda () "pan mix"
(prompt-in-minibuffer "mix:" (lambda (str) ; use pan-mix at cursor
(pan-mix str (or (cursor) 0)) #f #t)))
#t ; an extended (C-x) command
"C-x C-q")
See use-pan-mix-in-mix-menu to change the File:Mix menu to use pan-mix. The other pan-mix-* functions perform the same operation on a region (pan-mix-region), the current selection (pan-mix-selection), or a vct assumed to represent one channel of sound (pan-mix-vct).
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. mix-property associates a property list with each mix. track-property associates a property list with each track. 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. find-mix returns the identifier of the mix at sample sample (or anywhere in the given channel if sample is not specified), or #f if no mix is found. mix-maxamp returns the maxamp in the given mix. mix-click-info is a mix-click-hook function that posts a description of the clicked mix in the help dialog. save-mix saves a given mix's data in a file.
track->vct track (chan 0) save-track track filename (chan #t) transpose-track track semitones retempo-track track tempo reverse-track track filter-track track coeffs delete-all-tracks track-property key id track-maxamp id chan
track->vct places all the mix samples in the track into a vct. Similarly, save-track places the track's samples into a file. If the 'chan' arg is #t, all channels are saved. 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
filter-track applies a filter to each mix sound at the pre-mix point (that is, the mixed in sound is filtered, then the mix takes place). reverse-track reverses the order in which a track's member mixes occur. track-maxamp returns the maxamp in the given track.
moog.scm |
make-moog-filter frequency Q moog-filter gen input
moog.scm is a translation of CLM's moog.lisp (written by Fernando Lopez-Lezcano -- http://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-channel (moog 1200.0 .7))
The Ruby version of this is in examp.rb.
musglyphs.scm |
musglyphs.scm provides Scheme/Snd wrappers to load CMN's cmn-glyphs.lisp (directly!),
thereby defining most of the standard music notation symbols. Each of the original
functions (e.g. draw-bass-clef) becomes a Snd/Scheme procedure of the form
(name #:optional x y size style snd chn context).
(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, and Rick Taube's loop.scm (from Common Music).
(The dot size bug in this picture has been fixed, but I'm too lazy to make a new version of the picture).
nb.scm, nb.rb |
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.
noise.scm, noise.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.
oscope.scm |
oscope.scm sets up a dialog with a standard Snd channel window (time domain, fft etc) that displays the data read from the microphone in "real time".
peak-env.scm |
The functions in peak-env.scm provide relatively robust access to peak envelope files. These files save Snd's overall amplitude envelopes for a given sound so that a subsequent re-open of that sound has the waveform immediately. For very large sounds, this can save as much as a minute during which Snd is running the amplitude envelope builders in the background and displaying whatever it can. That is, it makes opening a large sound much faster after the initial read and save. The file has a variable save-peak-env-info (default #t) which determines whether these envelopes are being saved. The procedure
(define (peak-env-info-file-name snd chn) (format #f "~A/~A-peaks-~D" save-peak-env-info-directory (short-file-name snd) chn))
determines the saved peak env file name; in the default case, it looks for the directory ~/peaks, but this could be changed to suit your situation.
piano.scm, piano.rb |
These files are translations of CLM's piano.ins, a piano physical model by Scott van Duyne.
play.scm |
These functions play sounds in various ways.
play-sound func play-sine freq amp play-sines freqs-and-amps open-play-output chans srate format buffer-size
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. The following doubles each sample in channel 0 during playback:
(play-sound
(lambda (data)
(let ((len (sound-data-length data)))
(do ((i 0 (1+ i)))
((= i len))
(sound-data-set! data 0 i (* 2.0 (sound-data-ref data 0 i)))))))
This calls open-dac-output to open an output audio port. open-dac-output
takes the desired number of channels, sampling rate, data format, and DAC buffer size (in samples),
and returns a list containing the audio port (-1 on failure), the opened output channels,
and the actual DAC buffer size (these can differ from the requested amounts in various hardware
situations).
play-sine plays a one-second sine wave at the given frequency and amplitude: (play-sine 440 .1)
and play-sines produces a spectrum given a list of lists of frequency and amplitude:
(play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
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" (play "oboe.snd"))) (bind-key (char->integer #\p) 0 (lambda () "play pistol" (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" (play-often (max 1 n)))) (bind-key (char->integer #\r) 0 (lambda (n) "play region forever" (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. 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-between-marks mark1 mark2 buffer-size
which loops continuously between the two specified marks. The marks can be moved as the sound is played; C-g stops loop-between-marks. If you want the DAC to be held open in the background,
start-dac stop-dac
The vector-synthesis idea (and weird name) came from a linux-audio-development mailing list. Apparently some commercial synths (or software?) provide this. It reads any number of sound files, using a function to decide which one to send to the DAC.
popup.scm and gtk-popup.scm |
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 |
prc95.scm is a translation to Snd of Perry Cook's (1995) physical modelling toolkit; prc-toolkit95.lisp in CLM. One starting point for physical modelling is Smith, "Music Applications of Digital Waveguides", CCRMA, Stan-M-39, 1987, or Julius's home page, or any of several classic papers also by Julius Smith. Perry's own version of this code can be found in STK. The example instruments are:
plucky beg dur freq amplitude maxa
bow beg dur frq amplitude maxa
brass beg dur freq amplitude maxa
clarinet beg dur freq amplitude maxa
flute beg dur freq amplitude maxa
(define (test-prc95)
(plucky 0 .3 440 .2 1.0)
(bow .5 .3 220 .2 1.0)
(brass 1 .3 440 .2 1.0)
(clarinet 1.5 .3 440 .2 1.0)
(flute 2 .3 440 .2 1.0))
|
|
pvoc.scm |
This is the same as the CLM phase-vocoder generator, but implemented in Scheme. If you're interested in how the thing works, I think the Scheme version is easiest to understand; the Common Lisp version is in mus.lisp, and the C version is in clm.c.
make-pvocoder fftsize overlap interp analyze edit synthesize pvocoder gen input pvoc #:key (fftsize 512) (overlap 4) (time 1.0) (pitch 1.0) (gate 0.0) (hoffset 0.0) (snd 0) (chn 0)
The analyze, edit, and synthesize arguments to make-pvocoder are functions that are applied as needed during pvocoder processing; similarly, the input argument to pvocoder can be a function. pvoc.scm also contains a few examples of using the CLM phase-vocoder generator:
(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 (phase-vocoder-amp-increments v) i) gate)
(vct-set! (phase-vocoder-amp-increments v) i 0.0)))
#t))
#f ;no change to synthesis))
(reader (make-sample-reader 0)))
(map-channel (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.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.
rmsgain.scm |
rmsgain.scm is an implementation of the balance generators of CLM (based on CSound originals). I assume, from a glance at the code, that they're used something like this:
(define gen (make-instance <rmsgain>)) (map-channel (lambda (y) (balance gen y (rms gen y))))
rtio.scm |
rtio.scm has a collection of functions oriented loosely around "real-time" operations.
show-input #:optional (in-sys 0) show-input-fft #:optional (in-sys 0) show-draggable-input-fft #:optional (in-sys 0) in-out func in-sys out-sys
These three functions show how to read incoming data (from the adc), write data (to the dac), and interpose a function while reading and writing data. There are several example functions (for the "func" argument) that filter the data or change its amplitude. show-input-fft displays the input data's spectrum. show-draggable-input-fft is the same, but the X axis (the frequency axis in this case) is draggable, as in Snd's FFT display.
Here's some info from Michael Scholz about the Ruby version of rtio:
rt = make_rtio rt.show_input rt.show_input_fft rt.chans = 2 rt.show_drag rt.amplify(1.5).in_out(1, 0) rt.lp.in_out rt.hp(1150).in_out rt.close
rubber.scm, rubber.rb |
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 |
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.
snd4|5|6|7.scm |
These files contain a number of the procedures that were removed from or renamed in earlier versions of Snd. Some of them are:
| backward-graph (count snd chn) | |
| move the selected channel back (up or left) count graphs (C-x C-o), returning a list of the new sound index and channel number. | |
| backward-mark (count snd chn) | |
| move the cursor back count marks (C-j), returning mark id, or #f if none. | |
| backward-mix (count snd chn) | |
| move the cursor back count mix tags (C-x C-j), returning the mix id. | |
| backward-sample (count snd chn) | |
| move back count samples (C-b), return new cursor position. | |
| forward-graph (count snd chn) | |
| move the selected channel forward (down or right) count graphs (C-x C-o), returning a list of the new sound index and channel number. | |
| forward-mark (count snd chn) | |
| move the cursor forward count marks (C-j), returning mark id, or #f if none. | |
| forward-mix (count snd chn) | |
| move the cursor forward count mix tags (C-x C-j), returning the mix id. | |
| forward-sample (count snd chn) | |
| move forward count samples (C-f), return new cursor position. | |
| samples->vct (samp samps snd chn v edpos) | |
| return vct struct with the data specified. Use channel->vct instead. | |
| scale-sound-by (scaler beg num snd chn edpos) | |
| scales the samples in the given channel between beg and beg + num by scaler. If the channel argument is omitted, scale-sound-by scales the entire sound. beg defaults to 0; num defaults to the length of the channel. snd defaults to the selected sound, and chn to the selected channel. Unlike scale-by, this ignores the sync setting. | |
| scale-sound-to (norm beg num snd chn) | |
| normalizes the samples in the given channel between beg and beg + num to norm. If the channel argument is omitted, scale-sound-to normalizes the entire sound. beg defaults to 0; num defaults to the length of the channel. snd defaults to the selected sound, and chn to the selected channel. Unlike scale-to, this ignores the sync setting. | |
| vct->samples (samp samps data snd chn) | |
| A synonym for set-samples, but you can also pass just a vct as the first argument, or a start sample and a vct as the second argument. Use vct->channel instead. | |
| 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.
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.
dismiss-all-dialogs deactivates all active dialogs.
mix-name asociates a name with a mix, and mix-name->id returns the id given a mix name.
snd-gl.scm |
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 complexify
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. complexify shows the FFT data in the complex plane; each bin is rotated so that they all stack along the "x" axis, with a line drawn from the x axis to the current real/imaginary point (as (z, y)), so as you move (slowly) through a file, you'll see the phase info as well as the magnitude -- the vectors whirl around in each slice of the complex plane. Use the View:Orientation dialog to change the viewing angle. To move one sample at a time through a sound, you could bind the arrow keys:
(bind-key #xff51 0 (lambda ()
(set! (left-sample) (max 0 (1- (left-sample))))
keyboard-no-action))
(bind-key #xff53 0 (lambda ()
(set! (left-sample) (min (frames) (1+ (left-sample))))
keyboard-no-action))
snd-motif.scm |
install-searcher proc zync for-each-child w func make-hidden-controls-dialog create-fmv-dialog create-ssb-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 use-pan-mix-in-mix-menu add-amp-controls 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-widget-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 set-root-window-color color notebook-with-top-tabs make-font-selector-dialog make-color-selector-dialog
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. keep-mix-file-dialog-open-upon-ok does the same for the File:Mix dialog. use-pan-mix-in-mix-menu changes the File:Mix dialog to use pan-mix rather than mix.
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-widget-font uses that function to show what fonts are associated with a widget.
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.
snd-gtk.scm also defines make-font-selector-dialog that creates a dialog showing a list of available fonts with sample output, and a set of toggle buttons; to start the dialog, click the Options:Choose Font menu option; choose which of Snd's fonts you want to change, then click 'ok'. This isn't available in snd-motif.scm because the corresponding font selection widget in Motif is still under development. The corresponding color selector is make-color-selector-dialog, but some of the color variables don't actually work.
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. set-root-window-color sets the background color of the root window. notebook-with-top-tabs originally changed an existing notebook window (assuming Snd was started with the -notebook switch) so that its orientation mimics Xemacs, but that's now the default.
create-fmv-dialog sets up a controller that runs the FM violin (v.scm), letting you change various aspects of the algorithm as it plays. Similarly, create-ssb-dialog sets up an ssb-am + bandpass filter bank (like ssb-bank in dsp.scm) that can change the pitch of a (well-behaved) sound without changing its duration. It is important to get the "old freq" setting as close as possible to the actual original frequency. If this were slightly faster and smarter, I'd replace the "expand" control (which currently uses granular synthesis) with this idea.
snd-test.scm and event.scm |
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, strad.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.
spectr.scm, spectr.rb |
The spectr files were translated by Michael Scholz from CLM's spectr.clm. They contain a large set of instrument steady-state spectra, gathered many years ago (before 1976) by James A Moorer. The variable names are taken from the file names used by JAM, but by the time I got around to rescuing the data from mouldering magtapes, he had long since moved on, so I don't actually know what instrument some of the labels refer to.
v.scm |
The fm violin was my favorite instrument while working in the 70's and 80's, primarily on the Samson box. It was developed in Mus10 (ca 1977) based on ideas of John Chowning; a Mus10 version was (in this code ":=" is used in place of the original SAIL left arrow character, and so on):
ARRAY GlissFunc, DecayFunc, AttackFunc, SineWave, AmpFunc(512);
SYNTH(Sinewave); 1,1 999;
SEG(AmpFunc); 0,0 1,25 1,50 0,75 0,100;
SEG(GlissFunc);0,1 1,50, 0,100;
SEG(AttackFunc);0,0 1,100;
SEG(DecayFunc);1,1 .6,5 .3,10 .15,25 .07,50 0,100;
INSTRUMENT VN1;
VARIABLE Reset1,Noise,/NewMag,OtherFreq,/Gliss,Distance,Stereo,
Freq,Amp1,Amp2,Duration,AttackTime,DecayTime,Memory1,
Index1,Index2,Index3,scFreq,DecayLength,Switch1,Switch2,
/Mod1,/Mod2,/Mod3,/Env,/Att,/Vibrato,IMult,/Snd,
/Flutter,VibRate,VibAmp,/Ramp,/Decay,VibSwitch,LogFreq,
GlissLength,Bowing,DecayCall,VibCall,GlissCall,RampCall;
Memory1:=1;
I_ONLY BEGIN
Duration:=P2;
Freq:=P3;
Amp1:=P4;
Amp2:=P5;
OtherFreq:=P6;
IF Freq>=C THEN Freq:=Freq+Freq/100;
IF Freq<C THEN Freq:=Freq-20/Freq;
Switch1:=P14;
Switch2:=1-Switch1;
IMult:=P7-(Switch2/4);
VibSwitch:=P8;
Bowing:=P9;
Distance:=P10;
Stereo:=P11;
Noise:=P12;
GlissLength:=P13;
LogFreq:=ALOG(Freq);
DecayCall:=VibCall:=RampCall:=GlissCall:=20;
IF Amp1=Amp2 THEN RampCall:=SRATE;
IF Freq=OtherFreq THEN GlissCall:=SRATE;
IF VibSwitch=0 THEN VibCall:=SRATE;
IF Switch1=1 THEN DecayCall:=SRATE;
Vibrate:=5.25+RAND*.75;
VibAmp:=.006+RAND*.001;
IF Bowing=0
THEN
IF Memory1>.08
THEN
BEGIN
DecayTime:=.7;
AttackTime:=.2;
END
ELSE
BEGIN
DecayTime:=.7;
AttackTime:=.05;
Noise:=0;
END
ELSE
IF Memory1>.05
THEN
BEGIN
DecayTime:=.05;
AttackTime:=.2;
END
ELSE
BEGIN
DecayTime:=.05;
AttackTime:=.05;
Noise:=0;
END;
Memory1:=DecayTime;
IF AttackTime+DecayTime>=Duration
THEN
BEGIN
AttackTime:=Duration*AttackTime;
DecayTime:=DecayTime*Duration;
IF AttackTime<=.05 THEN AttackTime:=Duration-DecayTime-.01;
END;
ScFreq:=Freq*MAG;
DecayLength:=1000/Freq;
IF Switch1=0 THEN Noise:=.1;
Index1:=7.5*IMult/LogFreq;
Index2:=5/SQRT(Freq);
Index3:=IMult*30*(8.5-LogFreq)/Freq;
END;
Decay:=Switch1+EXPEN[DecayCall](Switch2,MAG*20/DecayLength,DecayFunc);
ENV:=Switch2+LINEN[20](Switch1,AttackTime/20,DecayTime/20,Duration/20,AmpFunc,Reset1:=0);
Ramp:=Amp1+NOSCIL[RampCall](Amp2-Amp1,20*MAG/Duration,AttackFunc);
Gliss:=Freq+EXPEN[GlissCall](OtherFreq-Freq,20*MAG/GlissLength,GlissFunc);
FLutter:=RANDI[VibCall](1,200*Mag);
Vibrato:=NOSCIL[VibCall](ENV,Vibrate*MAG*20,SineWave);
Att:=1-EXPEN[20](1,MAG*640,AttackFunc);
NewMag:=(1+Flutter*.005)*(1+Vibrato*VibAmp)*(1+RANDI(Noise*Att,2000*Mag))*Gliss*Mag;
Mod1:=NOSCIL(Decay*ScFreq*(Att+Index1),NewMag,Sinewave);
Mod2:=NOSCIL(Decay*ScFreq*(Att+Index2),4*NewMag,Sinewave);
Mod3:=NOSCIL(Decay*ScFreq*(Att+Index3),3*NewMag,Sinewave);
Snd:=ZOSCIL(Decay*ENV*Ramp,NewMag+Mod1+Mod2+Mod3,Sinewave);
OUTA:=OUTA+Snd*0.5;
END;
This instrument required about 60 seconds of computing on a PDP-10 (a $250,000 minicomputer) for 1 second of sound (our normal sampling rate was 12800). Since the PDP was massively time-shared, 60 seconds of computing could involve many minutes of sitting around watching AI scientists play Space War. Mus10 was an extension of Music V for the PDP-10 family of computers. To give a feel for how one worked in those days, here's a brief quote from the Mus10 manual (by Tovar and Leland Smith, May 1977):
The following generates 1 second of a 440 Hz sine wave followed by 1/2 sec. of a 660Hz sine wave. The output goes to a file, MUSIC.MSB, which is written on DSKM. COMMENT Fill array with sine wave; ARRAY SINETABLE[511]; FOR I:=0 STEP 1 UNTIL 511 DO SINETABLE[I]:=SIN(2*PI/512); INSTRUMENT SINE; COMMENT Generate simple sine wave. P4 = Amplitude, P3 = frequency; OUTA:=OUTA+OSCIL(P4,P3*MAG,SINETABLE); END; COMMENT Now, generate the sound; PLAY ; SIMP 0, 1, 440, 1000; SIMP 1, 1/2, 660, 1000; FINISH;
The computation involved was considered so burdensome, that the names of the main users were posted in the AI lab halls, apparently to try to get us to go away. I was normally the primary user (in terms of computrons) for the entire lab, and I had no intention of going away. In the Samson box world, this (in its initial "chorus" version) was:
Instrument(Violin); RECORD_POINTER(seg) nullfunc; INTEGER ARRAY gens[1:4],indgens[1:6], GensA[1:4],AmpGens[1:2]; ! synthesizer addresses; REAL ARRAY ratsA[1:4],Indrats[1:6],ratsB[1:4],AmpRats[1:2]; ! envelope data; INTEGER ModGens1Sum,i,FuncOffSet,k,GenOutLoc,GenInLoc,ModGens2Sum,x1,x2; Pars(<(InsName,Beg,Dur,Freq,Amp,Function AmpFunc,Function IndFunc,IndMult, SkewMult,Nothing,PcRev,No11,No12,No13,Function SkewFunc)>); ! the parameters of this instrument; Dbugit(Pns); ! debugging aid; GenOutLoc:=CASE (Pn[1] MOD 4) OF (Outma,Outmb,Outmc,Outmd); ! OUTMA is channel 1, OUTMB channel 2, etc; if freq>srate/3 then return; ! note too high, so leave it out; x1:=3; ! modulating frequency checks; x2:=4; ! (we want them less than srate/2); If x1*freq>srate/2 Then x1:=1; If x2*freq>srate/2 then x2:=1; amp:=Amp/2; ! two carriers, so halve the amplitude; waiter(Beg); ! wait for the beginning of the note; indRats[1]:=(x1*Freq*IndMult*((8.5-log(freq))/(3+(freq/1000)))*4/srate) MIN .999; indRats[2]:=(x2*Freq*IndMult*(1/(freq^.5))*4/srate) MIN .999; indRats[3]:=(freq*IndMult*(5/log(freq))*4/srate) MIN .999; indrats[4]:=indrats[1]; indrats[5]:=indrats[2]; indrats[6]:=indrats[3]; ratsA[1]:=x1; ratsA[2]:=x2; ratsA[3]:=1; ratsA[4]:=1; ratsB[1]:=x1+.002; ratsB[2]:=x2+.003; ratsB[3]:=1.002; ratsB[4]:=1; ! this is the skewing for the chorus effect; Gens[1]:=Osc(Pns,ModGens1Sum); ! now set up the oscillators; Gens[2]:=Osc(Pns,ModGens1Sum); Gens[3]:=Osc(Pns,ModGens1Sum); Gens[4]:=Osc(Pns,genInLoc,ModGens1Sum); ! carrier 1; GensA[1]:=Osc(Pns,ModGens2Sum); GensA[2]:=Osc(Pns,ModGens2Sum); GensA[3]:=Osc(Pns,ModGens2Sum); GensA[4]:=Osc(Pns,genInLoc,ModGens2Sum);! carrier 2; indgens[1]:=gens[1]; indgens[2]:=gens[2]; indgens[3]:=gens[3]; indgens[4]:=gensA[1]; indgens[5]:=gensA[2]; indgens[6]:=gensA[3]; ! set up envelope addressing; ModSig(Pns,GenOutLoc,GenInLoc,1-pcRev); ! send signal to DACs; ModSig(Pns,RevIn,GenInLoc,pcRev); ! and signal to reverberator; AmpGens[1]:=Gens[4]; AmpGens[2]:=GensA[4]; AmpRats[1]:=1; AmpRats[2]:=1; ! now add the envelopes; AddArrEnv(Pns,AmpGens,2,"A",0,Amp/2,AmpFunc,AmpRats); AddArrEnv(Pns,IndGens,6,"A",0,1,IndFunc,Indrats); AddArrEnv(Pns,Gens,4,"F",freq,Freq*skewmult,skewfunc,ratsA, 5,.011,.011,nullfunc,6,.017,.017,nullfunc,0,0); AddArrEnv(Pns,GensA,4,"F",freq,Freq*skewmult,skewfunc,ratsA, 6,.010,.010,nullfunc,5,.017,.017,nullfunc,1,0); End!Instrument(Pns); ! deallocation;
The Sambox version eventually became incredibly complicated, mainly to try to handle note list problems in the instrument. The Samson box could run about 5 or 6 of these in "real-time", similar to a modern-day 500 MHz Pentium running CLM. The parallel in the Sambox world to the SIMP example above is (this is taken from SAMBOX.BIL, November 1984):
Instrument(Simp);
Integer Gen1;
Gen1:=Osc(Pns,OutA,Zero,SineMode,0,0,Pn[3]);
AddEnv(Pns,Gen1,"A",0,Pn[4],Pf[5]);
End_Instrument(Pns);
The CLM version of this is:
(definstrument simp (start-time duration frequency amplitude
&optional (amp-env '(0 0 50 1 100 0)))
(multiple-value-bind (beg end) (times->samples start-time duration)
(let ((s (make-oscil frequency))
(amp (make-env amp-env :scaler amplitude :duration duration)))
(run
(loop for i from beg below end do
(outa i (* (env amp) (oscil s))))))))
In CLM, the fm-violin became (fm.html, 1989):
(definstrument violin (beg end frequency amplitude fm-index)
(let* ((frq-scl (in-hz frequency))
(maxdev (* frq-scl fm-index))
(index1 (* maxdev (/ 5.0 (log frequency))))
(index2 (* maxdev 3.0 (/ (- 8.5 (log frequency)) (+ 3.0 (/ frequency 1000)))))
(index3 (* maxdev (/ 4.0 (sqrt frequency))))
(carrier (make-oscil frequency))
(fmosc1 (make-oscil frequency))
(fmosc2 (make-oscil (* 3 frequency)))
(fmosc3 (make-oscil (* 4 frequency)))
(ampf (make-env '(0 0 25 1 75 1 100 0) :scaler amplitude))
(indf1 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index1))
(indf2 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index2))
(indf3 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index3))
(pervib (make-triangle-wave :frequency 5 :amplitude (* .0025 frq-scl)))
(ranvib (make-randi :frequency 16 :amplitude (* .005 frq-scl)))
(vib 0.0))
(run
(loop for i from beg to end do
(setf vib (+ (triangle-wave pervib) (randi ranvib)))
(outa i (* (env ampf)
(oscil carrier
(+ vib
(* (env indf1) (oscil fmosc1 vib))
(* (env indf2) (oscil fmosc2 (* 3.0 vib)))
(* (env indf3) (oscil fmosc3 (* 4.0 vib)))))))))))
or in its actual (non-simplified) form:
(defun bit20 (x) ;Samson box modifier got 2's complement 20 bit interpreted as fraction
(if (>= x (expt 2 19)) ;(this needed to keep fm-violin backwards compatible with old note lists)
(float (/ (- x (expt 2 20)) (expt 2 19)))
(float (/ x (expt 2 19)))))
(defun make-frobber-function (beg end frobl)
(let ((result (list beg))
(val (bit20 (cadr frobl))))
(loop for x in frobl by #'cddr and
y in (cdr frobl) by #'cddr do
(when (and (>= x beg)
(<= x end))
(push val result)
(push x result)
(setf val (bit20 y))))
(push val result)
(push end result)
(push val result)
(nreverse result)))
(definstrument fm-violin
(startime dur frequency amplitude &key
(fm-index 1.0)
(amp-env '(0 0 25 1 75 1 100 0))
(periodic-vibrato-rate 5.0)
(random-vibrato-rate 16.0)
(periodic-vibrato-amplitude 0.0025)
(random-vibrato-amplitude 0.005)
(noise-amount 0.0) (noise-freq 1000.0)
(ind-noise-freq 10.0) (ind-noise-amount 0.0)
(amp-noise-freq 20.0) (amp-noise-amount 0.0)
(gliss-env '(0 0 100 0)) (glissando-amount 0.0)
(fm1-env '(0 1 25 .4 75 .6 100 0))
(fm2-env '(0 1 25 .4 75 .6 100 0))
(fm3-env '(0 1 25 .4 75 .6 100 0))
(fm1-rat 1.0) (fm2-rat 3.0) (fm3-rat 4.0)
(fm1-index nil) (fm2-index nil) (fm3-index nil)
(base nil) (frobber nil)
(reverb-amount 0.01)
(index-type :violin)
(degree nil) (distance 1.0) (degrees nil)
(no-waveshaping nil) (denoise nil)
(denoise-dur .1) (denoise-amp .005)
&allow-other-keys)
(if (> (abs amplitude) 1.0)
(setf amplitude (clm-cerror ".1?" .1 #'numberp "amplitude = ~A?" amplitude)))
(if (<= (abs frequency) 1.0)
(setf frequency (clm-cerror "440.0?" 440.0 #'numberp "frequency = ~A?" frequency)))
(let* ((beg (floor (* startime *srate*)))
(end (+ beg (floor (* dur *srate*))))
(frq-scl (hz->radians frequency))
(modulate (not (zerop fm-index)))
(maxdev (* frq-scl fm-index))
(vln (not (eq index-type :cello)))
(logfreq (log frequency))
(sqrtfreq (sqrt frequency))
(index1 (or fm1-index (min pi (* maxdev (/ (if vln 5.0 7.5) logfreq)))))
(index2 (or fm2-index (min pi (* maxdev 3.0 (if vln
(/ (- 8.5 logfreq) (+ 3.0 (* frequency .001)))
(/ 15.0 sqrtfreq))))))
(index3 (or fm3-index (min pi (* maxdev (/ (if vln 4.0 8.0) sqrtfreq)))))
(easy-case (and (not no-waveshaping)
(zerop noise-amount)
(eq fm1-env fm2-env)
(eq fm1-env fm3-env)
(zerop (- fm1-rat (floor fm1-rat)))
(zerop (- fm2-rat (floor fm2-rat)))
(zerop (- fm3-rat (floor fm3-rat)))
(zerop (nth-value 1 (floor fm2-rat fm1-rat)))
(zerop (nth-value 1 (floor fm3-rat fm1-rat)))))
(coeffs (and easy-case modulate
(partials->polynomial
(list fm1-rat index1
(floor fm2-rat fm1-rat) index2
(floor fm3-rat fm1-rat) index3))))
;; that is, we're doing the polynomial evaluation using fm1osc running at fm1-rat * frequency
;; so everything in the polynomial table should be in terms of harmonics of fm1-rat
(norm (or (and easy-case modulate 1.0) index1))
(carrier (make-oscil frequency))
(fmosc1 (and modulate (make-oscil (* fm1-rat frequency))))
(fmosc2 (and modulate (or easy-case (make-oscil (* fm2-rat frequency)))))
(fmosc3 (and modulate (or easy-case (make-oscil (* fm3-rat frequency)))))
(ampf (make-env
(if denoise
(reduce-amplitude-quantization-noise amp-env dur amplitude denoise-dur denoise-amp)
amp-env)
amplitude :base base :duration dur))
(indf1 (and modulate (make-env fm1-env norm :duration dur)))
(indf2 (and modulate (or easy-case (make-env fm2-env index2 :duration dur))))
(indf3 (and modulate (or easy-case (make-env fm3-env index3 :duration dur))))
(frqf (make-env gliss-env (* glissando-amount frq-scl) :duration dur))
(pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
(ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
(fm-noi (if (and (/= 0.0 noise-amount)
(null frobber))
(make-rand noise-freq (* pi noise-amount))))
(ind-noi (if (and (/= 0.0 ind-noise-amount) (/= 0.0 ind-noise-freq))
(make-rand-interp ind-noise-freq ind-noise-amount)))
(amp-noi (if (and (/= 0.0 amp-noise-amount) (/= 0.0 amp-noise-freq))
(make-rand-interp amp-noise-freq amp-noise-amount)))
(frb-env (if (and (/= 0.0 noise-amount) frobber)
(make-env (make-frobber-function startime (+ startime dur) frobber) :duration dur
:base 0 :scaler (* two-pi noise-amount))))
(vib 0.0)
(modulation 0.0)
(loc (make-locsig :degree (or degree degrees (random 90.0)) :reverb reverb-amount :distance distance))
(fuzz 0.0)
(ind-fuzz 1.0)
(amp-fuzz 1.0))
(run
(loop for i from beg to end do
(if (/= 0.0 noise-amount)
(if (null frobber)
(setf fuzz (rand fm-noi))
(setf fuzz (env frb-env))))
(setf vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
(if ind-noi (setf ind-fuzz (+ 1.0 (rand-interp ind-noi))))
(if amp-noi (setf amp-fuzz (+ 1.0 (rand-interp amp-noi))))
(if modulate
(if easy-case
(setf modulation
(* (env indf1)
(polynomial coeffs (oscil fmosc1 vib)))) ;(* vib fm1-rat)??
(setf modulation
(+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
(* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
(* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))
(locsig loc i
(* (env ampf) amp-fuzz
(oscil carrier (+ vib (* ind-fuzz modulation)))))))))
which is very similar to the Scheme version (v.scm). It's basically setting up several parallel modulators of one carrier (see fm.html for details, or (ah nostalgia...) Schottstaedt, "The Simulation of Natural Instrument Tones Using Frequency Modulation with a Complex Modulating Wave", CMJ vol 1 no 4 1977 p46-50). The modulators themselves are modulated (vibrato, noise, etc). The FM indices were chosen to try to mimic violin or cello sounds over a wide range of frequencies. There's no limit on what this instrument can do; nearly all my compositions in the 80's used it. In CLM, there's fmviolin.clm which shows some of the effects (although it's unfortunately hard to read due to the way the Sambox system worked). And I just found this out on the net; I'm no csound expert, so I merely quote what I find:
;ORC
; edited by R. Pinkston, modified for use with MIDI2CS by R. Borrmann
;
;==========================================================================;
; Schottstaedt FM String Instrument from Dodge ;
; ;
;p4 = amp p5 = pch p6 = rise p7 = dec p8 = vibdel p9 = vibwth p10 = vibrte ;
;==========================================================================;
; sr = 44100
; kr = 4410
; ksmps = 10
; nchnls = 1
;
; instr 1
par
p_maxamplitude 32000
p_cps
endpar
iamp = p4
irise = .2 ;p6
idec = .2 ;p7
ivibdel = .75 ;p8
ivibwth = .03 ;p9
ivibrte = 5.5 ;p10
ifc = p5
ifm1 = ifc
ifm2 = ifc*3
ifm3 = ifc*4
indx1 = 7.5/log(ifc) ;range from ca 2 to 1
indx2 = 15/sqrt(ifc) ;range from ca 2.6 to .5
indx3 = 1.25/sqrt(ifc) ;range from ca .2 to .038
kvib init 0
timout 0,ivibdel,transient ;delays vibrato for p8 seconds
kvbctl linen 1,.5,p3-ivibdel,.1 ;vibrato control envelope
krnd randi .0075,15 ;random deviation in vib width
kvib oscili kvbctl*ivibwth+krnd,ivibrte*kvbctl,1 ;vibrato generator
transient:
timout .2,p3,continue ;execute for .2 secs only
ktrans linseg 1,.2,0,1,0 ;transient envelope
anoise randi ktrans,.2*ifc ;noise...
attack oscil anoise,2000,1 ;...centered around 2kHz
continue:
amod1 oscili ifm1*(indx1+ktrans),ifm1,1
amod2 oscili ifm2*(indx2+ktrans),ifm2,1
amod3 oscili ifm3*(indx3+ktrans),ifm3,1
asig oscili iamp,(ifc+amod1+amod2+amod3)*(1+kvib),1
asig linen asig+attack,irise,p3,idec
; out asig
;
; endin
aright = asig
aleft = asig
There's a C/CLM version of this instrument in sndlib.html. The body of the fm-violin in C/CLM is:
if (noise_amount != 0.0) fuzz = mus_rand(fmnoi,0.0);
if (frqf) vib = mus_env(frqf); else vib = 0.0;
vib += mus_triangle_wave(pervib, 0.0) +
mus_rand_interp(ranvib, 0.0);
if (easy_case)
modulation = mus_env(indf1) *
mus_polynomial(coeffs, mus_oscil(fmosc1, vib, 0.0), npartials);
else
modulation = mus_env(indf1) * mus_oscil(fmosc1, (fuzz + fm1_rat * vib), 0.0) +
mus_env(indf2) * mus_oscil(fmosc2, (fuzz + fm2_rat * vib), 0.0) +
mus_env(indf3) * mus_oscil(fmosc3, (fuzz + fm3_rat * vib), 0.0);
mus_locsig(loc, i, mus_env(ampf) *
mus_oscil(carrier, vib + indfuzz * modulation, 0.0));
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
ws.scm, ws.rb |
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))
ws.scm also has a lightly tested translation of CLM's def-optkey-fun.
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!
xm-enved.scm, xm-enved.rb |
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))
zip.scm |
make-zipper ramp-env frame-size frame-env zipper gen in1 in2 zip-sound beg dur file1 file2 ramp size
The zipper generator performs a kind of cross fade, but not one that tries to be smooth! It marches through the two sounds taking equal short portions of each, then abutting them while resampling so that as one takes less overall frame space, the other takes more. The frame-size argument is the maximum length of each twosome in seconds (for initial array allocation), the frame-env argument determines the current such length as new frames are needed, and the ramp-env argument determines which of the files gets more space in the frame (0: all first, 1: all second). 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->channel data 0 10000 0)
(new-sound "new-1.snd")
(do ((i 0 (1+ i))) ((= i 10000))
(vct-set! data i (- 1.0 (* i .0001))))
(vct->channel data 0 10000 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-channel (lambda (val) (zipper zp reader0 reader1))))))
Needless to say, this is not intended to be a suave, romantic gesture!
A Note on Scheme variables in Snd |
At first glance, Snd's use of functions for nearly all variable accesses, i.e. (listener-prompt)
rather than the simpler listener-prompt, seems unmotivated. The following little
program defines "counter" as a scheme variable, accessible in C:
#include <stdio.h>
#include <libguile.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 <libguile.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 <libguile.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]);
A Note on "As-Needed" input functions |
Several CLM generators work internally on buffers of data; only the code internal to the generator knows when it needs input, and how much it needs. So, src, granulate, convolve, and phase-vocoder are passed a function either at run-time or when the generator is allocated that they can call whenever a new value is needed. A simple C case is:
#include <stdio.h>
#include "clm.h"
typedef struct {
float val;
} src_state;
float src_input_as_needed(void *arg, int dir)
{
src_state *sr = (src_state *)arg;
sr->val += (dir * .01); /* just return a ramp */
return(sr->val);
}
int main(int argc, char **argv)
{
mus_any *gen;
src_state *input;
int i;
input = (src_state *)calloc(1, sizeof(src_state));
input->val = 0.0;
gen = mus_make_src(&src_input_as_needed, 0.5, 10, (void *)input);
for (i=0; i < 100; i++)
fprintf(stdout, "%f ", mus_src(gen, 0.0, NULL));
/* or: fprintf(stdout, "%f ", mus_src(gen, 0.0, src_input_as_needed)); */
mus_free(gen);
free(input);
return(0);
}
/* cc g1.c -o g1 -L/usr/local/lib -lguile /home/bil/sndlib/sndlib.a */
/* g1: 0.010000 0.015440 0.020000 0.024761 0.029999 0.035170 0.039999 ... */
To put that code in words, the src generator uses the function
src_input_as_needed to fill its internal buffer (convolving
it with sinc); in this case, the "srate" argument is 0.5, so src will
pick up a new input sample (calling src_input_as_needed) on every other
output sample. In the Scheme CLM (and Snd), the "as-needed" input
function is a Scheme function passed in as Scheme code:
#include <stdio.h>
#include <libguile.h>
#include "clm.h"
typedef struct {
SCM input_func;
} src_state;
float src_input_as_needed(void *ptr, int direction)
{
src_state *sr = (src_state *)ptr;
return(scm_num2dbl(scm_call_1(sr->input_func, scm_long2num(direction)), "input-as-needed"));
}
void inner_main(void *closure, int argc, char **argv)
{
mus_any *gen;
src_state *input;
int i;
int size = 512;
char **buffer = NULL;
buffer = (char **)calloc(1, sizeof(char *));
buffer[0] = (char *)calloc(size, sizeof(char));
input = (src_state *)calloc(1, sizeof(src_state));
fprintf(stdout, "input function: ");
getline(buffer, &size, stdin);
input->input_func = scm_eval_str0(buffer[0]);
gen = mus_make_src(&src_input_as_needed, 0.5, 10, (void *)input);
for (i=0; i < 100; i++)
fprintf(stdout, "%f ", mus_src(gen, 0.0, src_input_as_needed));
mus_free(gen);
free(input);
}
int main(int argc, char *argv[])
{
scm_boot_guile(argc, argv, inner_main, 0);
return(0);
}
/* cc g1.c -o g1 -L/usr/local/lib -lguile /home/bil/sndlib/sndlib.a */
/* g1
input function: (let ((val 0.0)) (lambda (dir) (set! val (+ val (* dir .01))) val))
0.010000 0.015440 0.020000 0.024761 0.029999 0.035170 0.039999
*/
In this case, src_input_as_needed is calling the
user-supplied Scheme function (via scm_call_1).
A Note on User-defined Generators in C-CLM |
To define a new generator type in Scheme is not difficult. For example, here is a comb filter with a low-pass filter on the feedback:
(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))))))
If we weren't concerned with the "run" optimizer, 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))
To do the same thing in CLM-in-C (clm.c) takes a bit more effort:
#include <stddef.h>
#include <math.h>
#include <stdio.h>
#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)(mus_any *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 bool mus_fcomb_p(mus_any *ptr) {return((ptr) && ((ptr->core)->type == MUS_FCOMB));}
static char *describe_fcomb(mus_any *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 bool fcomb_equalp(mus_any *p1, mus_any *p2) {return(p1 == p2);}
static off_t fcomb_length(mus_any *ptr) {return(((fcomb *)ptr)->size);}
static Float *fcomb_data(mus_any *ptr) {return(((fcomb *)ptr)->line);}
static Float fcomb_scaler(mus_any *ptr) {return(((fcomb *)ptr)->xscl);}
static Float set_fcomb_scaler(mus_any *ptr, Float val) {((fcomb *)ptr)->xscl = val; return(val);}
static int free_fcomb(mus_any *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 */
&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 */
MUS_NOT_SPECIAL, /* type extension */
NULL,
0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 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 Note on Noise Reduction |
There is no built-in noise reduction function in Snd. There are so many kinds of noise (clicks, pops, rumble, hiss, hum, crackle, clips, flutter, "distortion", modulation, echoes, etc), and what is noise in one context is signal in another (consonants, percussion, etc) that it's hard to write a single function that can handle every case. As far as I can tell, looking at other programs that offer noise reduction, the main trick used is similar to Perry Cook's Scrubber program, translated to Scheme as anoi in clm-ins.scm or fft-squelch in examp.scm. Secondary tricks involve smoothing functions similar to smooth-channel, and enveloping to silence stuff between tracks, etc. I'd certainly be happy to include in Snd an all-inclusive function for noise reduction, if anyone sends me one as a gift! But in the meantime, the tools exist to do most of what you normally want to do in this situation.
In my case, I blithely offered to clean up some recorded telephone conversations. The first step was to find the clipped locations (where the conversation was accidentally over-recorded). I did this first because there were places in the recordings where the DC offset was huge, causing clipping in a signal that would otherwise have been safe. I hoped to reconstruct the signal at the clipped points, but these would be hard to find once the DC was removed. A quick check:
(count-matches (lambda (y) (or (> y .9999) (< y -.9999))))
returned 5437 (in 18 minutes of sound). That seemed high, and I thought "maybe those are just one sample clicks that can easily be smoothed over", so
(define* (count-clips #:optional snd chn)
(let ((y0 0.0))
(count-matches
(lambda (y) (let ((val (and (or (> y0 .9999) (< y0 -.9999))
(or (> y .9999) (< y -.9999)))))
(set! y0 y)
val))
0 snd chn)))
But this returned 4768! So, it's time to make a list of clipped portions (this function has at least one bug, but I plowed past it -- no time for perfection...):
(define* (list-clips #:optional snd chn)
(let* ((max-clips (count-clips snd chn))
(clip-data (make-vector (* 2 max-clips) 0))
(clip-ctr 0)
(clip-beg 0)
(clip-end 0)
(clip-max-len 0)
(in-clip #f)
(samp 0))
(scan-channel
(lambda (y)
(if (or (> y .9999) (< y -.9999))
(if in-clip
(set! clip-end samp)
(begin
(set! in-clip #t)
(set! clip-beg samp)
(set! clip-end samp)))
(if in-clip
(begin
(set! in-clip #f)
(vector-set! clip-data clip-ctr clip-beg)
(vector-set! clip-data (1+ clip-ctr) clip-end)
(set! clip-max-len (max clip-max-len (1+ (- clip-end clip-beg))))
(set! clip-ctr (+ clip-ctr 2)))))
(set! samp (1+ samp))
#f)) ; make sure scan doesn't quit prematurely
(list clip-ctr clip-max-len clip-data)))
which returned a vector of 669 clipped portions, the worst being 42 samples long! I saved that data in a separate file, just in case of disaster:
(with-output-to-file "clips" (display (list-clips)))
Since filtering can pad the sound at the beginning, and tends to change the clipped portions, I decide reconstruct them first. This will produce sample values outside -1.0 to 1.0, but I can scale everything back down at the end. To see how things look, I reset the graph y bounds:
(set! (y-bounds) (list -1.5 1.5))
Now to conjure up a plausible sine wave between the clip begin and end points. (This is also "just-good-enough" software).
(if (not (defined? 'pi)) (define pi 3.141592653589793))
(define (fix-clip clip-beg-1 clip-end-1)
(if (> clip-end-1 clip-beg-1)
(let* ((dur (1+ (- clip-end-1 clip-beg-1)))
(samps (channel->vct (- clip-beg-1 4) (+ dur 9)))
(clip-beg 3)
(clip-end (+ dur 4)))
(let ((samp0 (vct-ref samps clip-beg))
(samp1 (vct-ref samps clip-end)))
(if (or (> samp0 .99) (< samp0 -.99))
(begin
;; weird! some of the clipped passages have "knees"
;; this looks nuts, but no time to scratch my head
(set! clip-beg (1- clip-beg))
(set! samp0 (vct-ref samps clip-beg))
(if (or (> samp0 .99) (< samp0 -.99))
(begin
(set! clip-beg (1- clip-beg))
(set! samp0 (vct-ref samps clip-beg))))))
(if (or (> samp1 .99) (< samp1 -.99))
(begin
(set! clip-end (1+ clip-end))
(set! samp1 (vct-ref samps clip-end))
(if (or (> samp1 .99) (< samp1 -.99))
(begin
(set! clip-end (1+ clip-end))
(set! samp1 (vct-ref samps clip-end))))))
;; now we have semi-plausible bounds
;; make sine dependent on rate of change of current
(let* ((samp00 (vct-ref samps (1- clip-beg)))
(samp11 (vct-ref samps (1+ clip-end)))
(dist (- clip-end clip-beg))
(incr (/ pi dist))
(amp (* .125 (+ (abs (- samp0 samp00)) (abs (- samp1 samp11))) dist)))
(if (> samp0 0.0)
;; clipped at 1.0
(do ((i (1+ clip-beg) (1+ i))
(angle incr (+ angle incr)))
((= i clip-end))
(vct-set! samps i (+ 1.0 (* amp (sin angle)))))
;; clipped at -1.0
(do ((i (1+ clip-beg) (1+ i))
(angle incr (+ angle incr)))
((= i clip-end))
(vct-set! samps i (- -1.0 (* amp (sin angle))))))
(vct->channel samps (- clip-beg-1 4))))
#t) ; return values so I can tell when I hit a 1-sample section during testing
#f))
(define (fix-it n)
;; turn off graphics and fix all the clipped sections
(set! (squelch-update) #t)
(do ((i 0 (1+ i)))
((or (= i n) (c-g?)))
;; "clips" here is a list form of the earlier vector of clip locations
(fix-clip (list-ref clips (* i 2))
(list-ref clips (1+ (* i 2)))))
(set! (squelch-update) #f))
(fix-it 669)
This produced 418 edits, with a maxamp of 2.26. So scale it back down:
(scale-to .9).
Next I ran some large ffts to see what sort of overall spectrum I had:
(set! (transform-size) (expt 2 23)).
This showed a massive DC component, and numerous harmonics of 60 Hz.
I decided to get rid of the portions that were clearly noise. Since I was dealing with
telephone recordings, I assumed anything under 40 Hz or above
4000 Hz was extraneous.
(define* (notch-out-rumble-and-hiss #:optional (snd #f) (chn #f))
(let* ((cur-srate (exact->inexact (srate snd))))
(filter-sound
(list 0.0 0.0 ; get rid of DC
(/ 80.0 cur-srate) 0.0 ; get rid of anything under 40 Hz (1.0=srate/2 here)
(/ 90.0 cur-srate) 1.0 ; now the passband
(/ 7000.0 cur-srate) 1.0
(/ 8000.0 cur-srate) 0.0 ; end passband (40..4000)
1.0 0.0) ; get rid of some of the hiss
;; since I'm the minimum band is 10 Hz here,
;; cur-srate/10 rounded up to next power of 2 seems a safe filter size
;; filter-sound will actually use overlap-add convolution in this case
(inexact->exact (expt 2 (ceiling (/ (log (/ cur-srate 10.0)) (log 2.0)))))
snd chn)))
(notch-out-rumble-and-hiss)
By now it was obvious I needed a simple way to play portions of the sound before and after an edit, sometimes with a tracking cursor. So I bound a few keys:
(define (play-from-cursor current)
(play (cursor) #f #f #f #f (if current #f (1- (edit-position)))))
(define (play-from-cursor-with-tracking current)
;; patterned after pfc in extsnd.html
(let ((old-tracking (cursor-follows-play)))
(set! (cursor-follows-play) #t)
(add-hook! stop-playing-hook
(lambda (snd)
(set! (cursor-follows-play) old-tracking)))
(play (cursor) #f #f #f #f (if current #f (1- (edit-position))))))
(bind-key (char->integer #\p) 0 (lambda () "play from cursor" (play-from-cursor #t) keyboard-no-action))
(bind-key (char->integer #\P) 1 (lambda () "play previous from cursor" (play-from-cursor #f) keyboard-no-action))
(bind-key (char->integer #\p) 4 (lambda () "play from cursor with tracking" (play-from-cursor-with-tracking #t) keyboard-no-action))
So, if the mouse is in the channel graph, 'p' plays from the cursor, 'P' plays the previous version from the cursor, and 'C-p' plays from the cursor with a "tracking cursor".
In several of the sections (the overall sound consisted of a couple dozen separate conversations), there was some very loud mid-range tone that I dubbed "transformer noise". To figure out what frequencies it represented, I FFT'd a portion containing only that noise and got this spectrum (plus a zillion other peaks that didn't look interesting):
((425 .05) (450 .01) (546 .02) (667 .01) (789 .034) (910 .032) (470 .01))
To hear that, I took play-sound from play.scm, and changed it to play a list of sine tones generated on the fly (the changes are in red):
(define (play-sines freqs-and-amps)
;; (play-sines '((440 .4) (660 .3)))
(let* ((size 256)
(audio-info (open-play-output 1 22050 #f size))
(audio-fd (car audio-info)))
(set! size (caddr audio-info))
(if (not (= audio-fd -1))
(let ((len 22050) ; play a one-second tone
(oscs (map make-oscil (map car freqs-and-amps)))
(amps (map cadr freqs-and-amps))
(data (make-sound-data outchans size))) ; the data buffer passed to the function (func above), then to mus-audio-write
(set! (dac-size) outbytes)
(do ((beg 0 (+ beg size)))
((or (c-g?) ; C-g to stop in mid-stream
(< beg len)))
(do ((i 0 (1+ i)))
((= i size))
(sound-data-set! data 0 i (apply + (map (lambda (o a) (* a (oscil o))) oscs amps))))
(mus-audio-write audio-fd data size))
(mus-audio-close audio-fd))
#f)))
The only changes to the original function set up and use a list of oscillators, each with its own amplitude, rather than opening and reading a sound file. (I added this function to play.scm). I could then resynthesize the suspect tone with:
(play-sines '((425 .05) (450 .01) (546 .02) (667 .01) (789 .034) (910 .032) (470 .01)))
And to my surprise, the result was close to the main portion of the hum. So now to notch out those frequencies, and see what is left:
(define* (make-notch-frequency-response cur-srate freqs #:optional (notch-width 2))
(let ((freq-response (list 0.0 0.0)))
(for-each
(lambda (i)
(set! freq-response (cons (/ (* 2 (- i notch-width)) cur-srate) freq-response)) ; left upper y hz
(set! freq-response (cons 1.0 freq-response)) ; left upper y resp
(set! freq-response (cons (/ (* 2 (- i (/ notch-width 2))) cur-srate) freq-response)) ; left bottom y hz
(set! freq-response (cons 0.0 freq-response)) ; left bottom y resp
(set! freq-response (cons (/ (* 2 (+ i (/ notch-width 2))) cur-srate) freq-response)) ; right bottom y hz
(set! freq-response (cons 0.0 freq-response)) ; right bottom y resp
(set! freq-response (cons (/ (* 2 (+ i notch-width)) cur-srate) freq-response)) ; right upper y hz
(set! freq-response (cons 1.0 freq-response))) ; right upper y resp
freqs)
(set! freq-response (cons 1.0 freq-response))
(set! freq-response (cons 1.0 freq-response))
(reverse freq-response)))
(define* (notch-channel freqs #:optional (filter-order #f) (snd #f) (chn #f) (notch-width 2))
(filter-sound (make-notch-frequency-response (exact->inexact (srate snd)) freqs notch-width)
(or filter-order (inexact->exact (expt 2 (ceiling (/ (log (/ (srate snd) notch-width)) (log 2.0))))))
snd chn))
(define* (notch-sound freqs #:optional (filter-order #f) (snd #f) (notch-width 2))
(filter-sound (make-notch-frequency-response (exact->inexact (srate snd)) freqs notch-width)
(or filter-order (inexact->exact (expt 2 (ceiling (/ (log (/ (srate snd) notch-width)) (log 2.0))))))
snd))
(define* (notch-selection freqs #:optional (filter-order #f) (notch-width 2))
(filter-selection (make-notch-frequency-response (exact->inexact (selection-srate)) freqs notch-width)
(or filter-order (inexact->exact (expt 2 (ceiling (/ (log (/ (selection-srate) notch-width)) (log 2.0))))))))
(notch-sound (list 425 450 470 546 667 789 910) #f 1 10)
And the steady hum was largely erased. (I added these functions to dsp.scm, with some subsequent changes). Unfortunately, in many cases, this also changed the timbre of the voices, and that wasn't acceptable in this context. I goofed around with the notch-width and filter-size parameters, looking for something that that would still do the trick without removing half the personal side of the voices, but in only a few cases was the result usable. (The human ear is so attuned to the voice, that you can remove all but a small passband and still get understandable speech). In my case, what was being said was not very important, but the individual characteristics of each voice were.
The next step was to take out noisy sections between snipits, mostly
using (env-selection '(0 1 1 0 10 0 11 1))
and equalizing each snipit, more or less, with scale-selection-by.
There were a few "you-are-being-recorded" beeps which I deleted (via the Edit
menu delete selection option).
In some of the conversations,
between sections of speech the background hum would gradually increase, then
the voice would abruptly start with a large peak amplitude. These
were fixed mostly with small-section scale-by's and envelopes.
In the female voice sections, it seemed to help to:
(filter-selection '(0 0 .01 0 .02 1 1 1) 1024)
which got rid of some of the rumble without noticeably affecting
the vocal timbre.
This may seem like a lot of programming for a simple problem, but I hadn't previously thought about noise reduction (so nothing was already written), and once this stuff is written, no one else has to do anything but load it. Most of the functions mentioned here are now in play.scm or dsp.scm.
|
|