Commit 110d59c3 authored by IOhannes m zmölnig's avatar IOhannes m zmölnig

Imported Upstream version 16.1

parent e5328e59
This diff is collapsed.
Snd is a sound editor written by Bill Schottstaedt (
Except where otherwise noted, it is Copyright 1996-2006 The Board of Trustees
of Stanford University.
Except where otherwise noted, it is Copyright 1996-2013 Bill Schottstaedt.
Snd change log
30-Nov: Snd 16.1.
19-Oct: Snd 16.0.
11-Sep: Snd 15.9.
1-Aug: Snd 15.8.
15-Jun: Snd 15.7.
11-May: Snd 15.6.
3-Apr: Snd 15.5.
20-Mar: changed the no-gui repl to use repl.scm in the s7 case.
27-Feb: Snd 15.4.
25-Jan: Snd 15.3.
2015 ----------------------------------------------------------------
18-Dec: Snd 15.2.
5-Nov: moved all the motif stuff (xm.c, snd-motif.scm etc) to the *motif* environment,
OpenGL (gl.c, snd-gl.scm) to *gl*, and gtk (xg.c, snd-gtk.scm etc) to *gtk*.
4-Nov: Snd 15.1.
25-Sep: Snd 15.0.
17-Sep: moved snd-x*.c to snd-motif.c
18-Aug: Snd 14.9.
9-July: Snd 14.8.
31-May: Snd 14.7.
23-Apr: Snd 14.6.
18-Mar: Snd 14.5.
12-Feb: Snd 14.4.
4-Jan: Snd 14.3.
2014 ----------------------------------------------------------------
22-Nov: Snd 14.2.
15-Oct: Snd 14.1.
11-Oct: removed frame.scm and mixer.scm: frames and mixers are obsolete in the scheme version of Snd.
11-Sep: Snd 14.0. Homogenous vectors, write readably, libc.scm, libgsl.scm.
5-Sep: removed kmenu.scm and oscope.scm.
9-Aug: write.scm, removed pretty-print.scm.
3-Aug: Snd 13.9.
17-Jul: many changes to the configure script, added tools/make-config-pc.rb.
30-Jun: Snd 13.8.
11-Jun: removed the view files dialog from the gtk version, including all the
related extension language functions, and view-files-select-hook.
25-May: Snd 13.7.
14-May: glistener.c/h (gtk listener).
22-Apr: Snd 13.6.
12-Mar: Snd 13.5.
4-Feb: Snd 13.4.
2013 ----------------------------------------------------------------
25-Dec: Snd 13.3.
30-Oct: Snd 13.2.
20-Sep: Snd 13.1.
8-Aug: Snd 13.0.
3-July: removed ptree-channel and max-virtual-ptrees, optimization, run.c.
(clm 5.0, sndlib 22.0).
26-Jun: Snd 12.12.
4-Jun: removed the --with-static-* configuration switches.
21-May: Snd 12.11.
11-May: all scheme-side hook code changed. removed print-hook.
1-May: removed mus-audio-describe, ESD audio support, audinfo.
12-Apr: Snd 12.10.
5-Mar: Snd 12.9.
Feb: s7: added random-state?, hash-table-iterator?, and morally-equal?
clm/cmn/snd/s7: removed snd1.html and snd-contents.html (these were
using Javascript for stuff that is now built into html), and
translated the rest of the html files to html5.
snd: removed the recorder, recorder-dialog, snd-g|xrec.c,
changed various menu names and added a view:with-grid menu
moved dialog buttons around at random,
removed save-macros and named keyboard macros,
added context-sensitive tooltips to the gtk version,
changed the gtk listener default font to Monospace 11,
the "minibuffer" is now a "statusbar". This means it is not
editable, so all the key sequences that used to prompt for
info are either undefined now, or use a dialog instead.
removed minibuffer-history-length, prompt-in-minibuffer, clear-minibuffer,
and report-in-minibuffer. Replaced the latter two with status-report.
removed sound-specific search-procedures (i.e. there is only one search procedure)
removed the bomb function
2-Feb: Snd 12.8.
27-Jan: removed snd10.scm.
2012 ----------------------------------------------------------------
30-Dec: Snd 12.7.
8-Nov: Snd 12.6.
29-Sep: Snd 12.5.
19-Aug: Snd 12.4.
18-Aug: removed snd9.scm.
14-Jul: removed thread stuff.
11-Jul: Snd 12.3.
30-May: Snd 12.2.
24-Apr: Snd 12.1.
5-Apr: lint.scm.
25-Mar: show-full-range, info-popup-hook.
21-Mar: with-interrupts.
18-Mar: Snd 12.0.
18-Mar: removed time-graph-hook; replaced by combined-data-color.
10-Mar: space=play or pause, tracking-cursor stuff changed.
......@@ -169,7 +264,7 @@ Snd change log
track-colors.scm, mix-menu.scm
moved mix-properties into C.
added edit-properties, mix-sync.
spokenword.scm thanks to Ville Koskinen.\n\
spokenword.scm thanks to Ville Koskinen.
23-Mar: recorder dialog removed.
22-Mar: Snd 8.9.
14-Mar: cairo graphics backend (--with-cairo configure choice).
......@@ -1068,7 +1163,7 @@ Snd change log
11-Nov: insert-silence.
10-Nov: snd 4.8.
8-Nov: filter text field also has history (M-p) now.
7-Nov: shell (readline) style M-p and M-n in minibuffer with variable minibuffer-history-length (8).
7-Nov: shell style M-p and M-n in minibuffer with variable minibuffer-history-length (8).
6-Nov: various cosmetic changes for the new g++ (Redhat 7.0).
insert-sound arguments changed (to match mix-sound more closely).
Snd 12.0
Snd 16.1:
selection has a loop play triangle
mix and cursor have play triangles
if mouse click would trigger play, the cursor is a right or left arrow.
removed draggable mark play triangle and mark-drag-triangle-hook.
added variable play-arrow-size (default: 10)
most of my time went into lint.scm, but the harder I work
on it, the longer my TODO list.
added Edit:Unselect menu option
added with-menu-icons (gtk only).
added optional "alpha" arg to make-color.
moved delete-selection-and-smooth from selection.scm to C.
added delete-samples-and-smooth.
typing space in a graph plays from the cursor, space while playing = pause/continue
startup window size is 700x300
auto-resize defaults to false in Gtk, true in Motif.
in gtk, the trailing cr argument to draw-axes in not optional.
in Motif, libXpm is no longer optional.
the Region browser print option has been removed.
removed click-for-listener-help.
removed Snd.gtkrc,, and the obsolete X resources stuff.
removed time-graph-hook; replaced by combined-data-color.
s7: :key and :optional removed.
tracking-cursor-style defaults to cursor-line.
cursor-follows-play moved to snd11.scm.
with-tracking-cursor is now a global (not sound-local).
checked: gtk 3.19.1|2|3, sbcl 1.3.0|1, GSL 2.0
removed c-g! function; it can be replaced by stop-playing.
removed c-g? in Scheme -- it is superfluous.
Thanks!: Norman Gray
added 'src' and 'auto' buttons to the Save-as dialogs for automatic srate conversion
and a blog-style commentary. In the extension language, these are
save-as-dialog-src and save-as-dialog-auto-comment.
added sync-style variable: sync-none, sync-all, or sync-by-sound (now the default).
this used to be handled in extensions.* under names like global-sync-choice.
sync-none was the previous default. examp.scm sync-all function renamed sync-everything.
moved with-reopen-menu to snd11.scm, and removed it from the preferences dialog.
This menu is almost the same as the built-in File:Open recent menu.
moved make-hidden-controls-dialog from snd-motif|gtk.scm to snd11.scm, and removed it
from the preferences dialog. It is now built-in as Options:Controls
moved show-selection from extensions.* to C, added unselect-all (in C)
which replaces clear-selection (selection.scm).
added show-full-duration, initial-beg, initial-dur, ask-about-unsaved-edits,
with-toolbar, remember-sound-state, with-smpte-label. removed old
show-smpte-label in *.scm.
remember-sound-state in extensions has been moved to C (old scheme code is in snd11.scm).
it now reads/writes a file named "remembered-<soundfile-name>.scm|fs|rb" where
<soundfile-name> is the current sound's file name.
with-toolbar defaults to true in gtk, false otherwise. It replaces toolbar.scm
and panic.scm. Also with-tooltips to turn tooltips on or off.
The built-in popup menus are now context sensitive, and the files popup.scm
and gtk-popup.scm have been removed. In s7/Motif, the listener popup can
show a stacktrace of code as it is running!
In the beginning, before the libxm library, I thought it made sense to include
functions like draw-line which would draw a line, no matter what graphics
environment Snd was built with. Unfortunately, cairo needs an explicitly
handled cairo_t structure. So, draw-line, draw-lines, draw-dot, draw-dots,
draw-string, fill-rectangle, and fill-polygon now have a required trailing
cairo_t argument (it's ignored in Motif). Also two new kludges to get and
free this structure: make-cairo and free-cairo. There aren't that many
uses of these functions (most the fancy graphic stuff uses direct cairo
or Motif calls from libxm), so perhaps eventually, they'll be removed.
To make it easier to zoom in on the FFT, the keypad arrow keys are bound
to zoom and move the FFT bounds, analogous to the normal arrow keys which
affect the time domain graph. (There isn't any place to put sliders for
this, and the Options:Transform sliders aren't always handy).
in s7, random-state->list and a C tie-in for the random number functions.
Snd now needs Gtk 2.12 or later.
checked: sbcl 1.0.46, gtk 3.0.1|2|3, mpc 0.9
Thanks!: Louis Gorenfeld, Hartmut Noack, Philipp Uberbacher, Fernando Lopez-Lezcano,
Mike Scholz, Rick Taube.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
/* audinfo decribes the current audio hardware state */
#include <mus-config.h>
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include "sndlib.h"
int main(int argc, char *argv[])
This diff is collapsed.
......@@ -5,75 +5,75 @@
(define auto-save-interval 60.0) ;seconds between auto-save checks
(define auto-saving #f)
(define (cancel-auto-save)
"(cancel-auto-save) turns off the auto-save mechanism"
(set! auto-saving #f))
(define (auto-save)
"(auto-save) starts watching files, automatically saving backup copies as edits accumulate"
(define (auto-save-temp-name snd)
(string-append (if (and (string? (temp-dir))
(> (string-length (temp-dir)) 0))
(string-append (temp-dir) "/")
"#" (short-file-name snd) "#"))
(define (unsaved-edits snd)
(or (sound-property 'auto-save snd)
(define cancel-auto-save
(let ((documentation "(cancel-auto-save) turns off the auto-save mechanism"))
(lambda ()
(set! auto-saving #f))))
(define (clear-unsaved-edits snd)
(set! (sound-property 'auto-save snd) 0))
(define (increment-unsaved-edits snd)
(set! (sound-property 'auto-save snd) (+ 1 (sound-property 'auto-save snd))))
(define (upon-edit snd)
(define auto-save
(let ((documentation "(auto-save) starts watching files, automatically saving backup copies as edits accumulate"))
(lambda ()
(increment-unsaved-edits snd)))
(define (auto-save-open-func snd)
(let ((temp-file (auto-save-temp-name snd)))
(if (and (file-exists? temp-file)
(< (file-write-date (file-name snd)) (file-write-date temp-file)))
(snd-warning (format #f "auto-saved version of ~S (~S) is newer"
(short-file-name snd)
(do ((i 0 (+ 1 i)))
((= i (channels snd)))
(if (null? (hook-functions (edit-hook snd i)))
(hook-push (edit-hook snd i) (upon-edit snd))))
(clear-unsaved-edits snd)))
(define (auto-save-done snd)
(let ((temp-file (auto-save-temp-name snd)))
(if (file-exists? temp-file)
(delete-file temp-file))
(clear-unsaved-edits snd)))
(define (auto-save-func)
(if auto-saving
(for-each (lambda (snd)
(if (> (unsaved-edits snd) 0)
(let ((save-name (auto-save-temp-name snd)))
(report-in-minibuffer (string-append "auto-saving as " save-name "...") snd)
(in (* 1000 3) (lambda () (report-in-minibuffer "" snd)))
(save-sound-as save-name snd)
(clear-unsaved-edits snd))))
(in (* 1000 auto-save-interval) auto-save-func))))
(if (not (member auto-save-done (hook-functions close-hook)))
(if (not (null? (sounds)))
(for-each auto-save-open-func (sounds)))
(hook-push after-open-hook auto-save-open-func)
(hook-push close-hook auto-save-done)
(hook-push save-hook (lambda (snd name) (auto-save-done snd)))
(hook-push exit-hook (lambda () (for-each auto-save-done (sounds))))))
(set! auto-saving #t)
(in (* 1000 auto-save-interval) auto-save-func))
(define (auto-save-temp-name snd)
(string-append (if (and (string? *temp-dir*)
(> (length *temp-dir*) 0))
(string-append *temp-dir* "/")
"#" (short-file-name snd) "#"))
(define (unsaved-edits snd)
(or (sound-property 'auto-save snd)
(define (clear-unsaved-edits snd)
(set! (sound-property 'auto-save snd) 0))
(define (increment-unsaved-edits snd)
(set! (sound-property 'auto-save snd) (+ 1 (sound-property 'auto-save snd))))
(define (upon-edit snd)
(lambda ()
(increment-unsaved-edits snd)))
(define (auto-save-open-func snd)
(let ((temp-file (auto-save-temp-name snd)))
(if (and (file-exists? temp-file)
(< (file-write-date (file-name snd)) (file-write-date temp-file)))
(snd-warning (format #f "auto-saved version of ~S (~S) is newer"
(short-file-name snd)
(do ((i 0 (+ 1 i)))
((= i (channels snd)))
(if (null? (hook-functions (edit-hook snd i)))
(hook-push (edit-hook snd i) (lambda (hook) (upon-edit (hook 'snd))))))
(clear-unsaved-edits snd)))
(define (auto-save-done snd)
(let ((temp-file (auto-save-temp-name snd)))
(if (file-exists? temp-file)
(delete-file temp-file))
(clear-unsaved-edits snd)))
(define (auto-save-func)
(if auto-saving
(for-each (lambda (snd)
(if (> (unsaved-edits snd) 0)
(let ((save-name (auto-save-temp-name snd)))
(status-report (string-append "auto-saving as " save-name "...") snd)
(in (* 1000 3) (lambda () (status-report "" snd)))
(save-sound-as save-name snd)
(clear-unsaved-edits snd))))
(in (* 1000 auto-save-interval) auto-save-func))))
(if (not (member auto-save-done (hook-functions close-hook)))
(for-each auto-save-open-func (sounds))
(hook-push after-open-hook (lambda (hook) (auto-save-open-func (hook 'snd))))
(hook-push close-hook (lambda (hook) (auto-save-done (hook 'snd))))
(hook-push save-hook (lambda (hook) (auto-save-done (hook 'snd))))
(hook-push exit-hook (lambda (hook) (for-each auto-save-done (sounds))))))
(set! auto-saving #t)
(in (floor (* 1000 auto-save-interval)) auto-save-func))))
;;; Banded Waveguide Instrument based on
;;; ====== =========
;;; Essl, G. and Cook, P. "Banded
;;; Waveguides: Towards Physical Modelling of Bar
;;; Percussion Instruments", Proceedings of the
;;; 1999 International Computer Music Conference.
;;; Also, Essl, Serafin, Cook, and Smith J.O.,
;;; "Theory of Banded Waveguides", CMJ, 28:1,
;;; pp37-50, Spring 2004.
;;; NOTES:
;;; As with all physical models, initial conditions matter.
;;; Frequency range is not too broad. 220Hz. is a good
;;; starting point.
;;; Tuned bar, Glass Harmonica and Uniform Bar for now.
;;; 08/22/2013 update bandpass filters with CLM's filter generator (juanig)
;;; 08/24/2013 replaced delay line macros with DelayL using clm's delay ug
;;; 08/29/2014 fixed waveguide with feed and reflections
;;; 08/30/2014 Try different delay line lengths. Fixing bandpass radius param.
;;; 09/04/2014 This SND's S7 version
(define* (make-bowtable (offset 0.0) (slope 1.0))
(float-vector offset slope))
(define (bowtable b samp)
(max 0.0 (- 1.0 (abs (* (b 1) (+ samp (b 0)))))))
(define (make-bandpassbq freq radius)
(let ((arra (make-float-vector 3))
(arrb (make-float-vector 3)))
(set! (arra 1) (* -1.998 radius (cos (hz->radians freq))))
(set! (arra 2) (* radius radius))
;;; gain gets normalized
(set! (arrb 0) (- 0.5 (* 0.5 (arra 2))))
(set! (arrb 2) (- (arrb 0) ))
(make-filter 3 arra arrb) ))
;;; To handle bandpass filter
(define (bandpassbq f sample0)
(filter f sample0))
;;; Delay line structures and functions using SND's delay generator (as per prc95.scm)
(defgenerator dlya (outp 0) (input #f))
(define (make-delayl len lag)
(make-dlya :input (make-delay len :max-size (ceiling (+ len lag 1)))
:outp (- lag len)))
(define (delayl d samp)
(delay-tick (d 'input) samp)
(tap (d 'input) (d 'outp)))
(definstrument (bandedwg beg dur freq amplitude
;; vibration modes
;; 1=tuned Bar; 2=Glass Harmonica;
;; 3= Uniform bar
(mode 3)
(maxa 0.9998) ;; max bow velocity
(bv 1.0) ;; bow velocity scaler
;; velocity envelope
(vel-env '(0 1.0 .95 1.1 1 1.0))
(amp-env '(0 1 1 1)) ;;'(0 0.0 .95 1.0 .99 0.00))
(rev-amount .08) )
(let ((nrmodes 4))
(cond ((= mode 1)
(set! nrmodes 4))
((= mode 2)
(set! nrmodes 6))
(set! nrmodes 4))
(let* ((start (seconds->samples beg))
(baselen (/ *clm-srate* freq)) ;; original Stk delayl length
(baselag (- (/ *clm-srate* freq) 0.5))
(dtapoffs 0.0) ;; tap offset is 0.0 in StK's version
(bandpass (make-vector nrmodes))
(delayslft (make-vector nrmodes))
(delaysrfl (make-vector nrmodes))
(modes (make-float-vector nrmodes))
(gains (make-float-vector nrmodes))
(basegains (make-float-vector nrmodes))
(excitations (make-float-vector nrmodes))
(delastout (make-float-vector nrmodes))
(fradius 0.0) ;; radius for bandpass filter
(dlength 0.0) ;; delay-line length
(dlag 0.0) ;; delay lag (for tap)
(bowtab (make-bowtable :slope 3.0 :offset 0.001))
(ampenv (make-env amp-env :scaler amplitude :duration dur))
;; (vel-env (make-env vel-env :scaler bv :duration dur))
(maxvelocity maxa)
(end (+ start (seconds->samples dur)))
(cond ((= mode 1) ;; Tuned Bar
(set! (modes 0) 1.000)
(set! (modes 1) 4.0198391420)
(set! (modes 2) 10.7184986595)
(set! (modes 3) 18.0697050938)
(do ((i 0 (+ i 1)))
((= i nrmodes))
(set! (basegains i) (expt 0.998 (+ i 1)))
(set! (excitations i) 1.0) )
((= mode 2) ;; Glass Harmonica
(set! (modes 0) 1.000)
(set! (modes 1) 2.32)
(set! (modes 2) 4.25)
(set! (modes 3) 6.63)
(set! (modes 4) 9.38)
(set! (modes 5) 12.22)
(do ((i 0 (+ i 1)))
((= i nrmodes))
(set! (basegains i ) (expt 0.988 (+ i 1)))
(set! (excitations i) 1.0))
(else ;; Uniform Bar
(set! (modes 0) 1.000)
(set! (modes 1) 2.756)
(set! (modes 2) 5.404)
(set! (modes 3) 8.933)
(do ((i 0 (+ i 1)))
((= i nrmodes))
(set! (basegains i ) (expt 0.9 (+ i 1)))
(set! (excitations i) 1.0))
;; set-frequency method in STK's BandedWG
;; (set! fradius (- 1.0 (* pi (/ 32 *clm-srate*))))
(set! fradius (- 0.3998 (* pi (/ 32 *clm-srate*))))
(do ((i 0 (+ i 1)))
((= i nrmodes))
(set! dlength (floor (/ baselen (modes i))))
(set! dlag (floor (/ baselag (modes i)))) ;; (- lag len) --> tap offset
(set! (delayslft i) (make-delayl dlength dlag))
(set! (delaysrfl i) (make-delayl dlength dlag))
(set! (gains i) (basegains i))
(set! (bandpass i)
(make-bandpassbq (* freq (modes i)) fradius)) )
(do ((i start (+ i 1)))
((= i end))
(let ((input 0.0)
(velinput 0.0)
(bowvelocity 0.0)
(bplastout 0.0)
(dlastsampl 0.0)
(outsampl 0.0)
(do ((k 0 (+ k 1)))
((= k nrmodes))
(set! velinput (+ velinput (* (basegains k) (delastout k))) )
;; (set! bowvelocity (* 0.3 (env vel-env) maxvelocity))
(set! bowvelocity (* 0.3 maxvelocity))
(set! input (- bowvelocity velinput))
(set! input (* input (bowtable bowtab input)))
(set! input (/ input nrmodes ))
;; Here the waveguide
(do ((j 0 (+ j 1)))
((= j nrmodes))
(set! bplastout (+ bplastout (bandpassbq (bandpass j)
(delayl (delayslft j)
(+ input (* (gains j) dlastsampl)) ))))
(set! dlastsampl (+ dlastsampl (delayl (delaysrfl j) bplastout)))
(set! (delastout j) dlastsampl)
(set! outsampl (* 4.0 (env ampenv) bplastout))
(outa i outsampl)
(if *reverb*