summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--HISTORY.Snd2
-rw-r--r--NEWS28
-rw-r--r--aclocal.m471
-rw-r--r--analog-filter.scm156
-rw-r--r--animals.scm269
-rw-r--r--audio.c4
-rw-r--r--bess.scm10
-rw-r--r--bess1.scm2
-rw-r--r--binary-io.scm274
-rw-r--r--clean.scm130
-rw-r--r--clm-ins.scm128
-rw-r--r--clm.c2
-rw-r--r--clm23.scm374
-rw-r--r--clm2xen.c8
-rwxr-xr-xconfigure334
-rw-r--r--configure.ac75
-rw-r--r--draw.scm33
-rw-r--r--dsp.scm410
-rw-r--r--edit123.scm24
-rw-r--r--env.scm8
-rw-r--r--enved.scm2
-rw-r--r--examp.scm352
-rw-r--r--extensions.scm73
-rw-r--r--extsnd.html423
-rw-r--r--fade.scm18
-rw-r--r--fft-menu.scm8
-rw-r--r--fm.html50
-rw-r--r--fmv.scm7
-rw-r--r--frame.scm90
-rw-r--r--freeverb.scm2
-rw-r--r--generators.scm93
-rw-r--r--grfsnd.html6
-rw-r--r--gtk-effects-utils.scm2
-rw-r--r--gtk-popup.scm12
-rw-r--r--index.html596
-rw-r--r--jcrev.scm2
-rw-r--r--jcvoi.scm24
-rw-r--r--maraca.scm2
-rw-r--r--misc.scm2
-rw-r--r--mix.scm9
-rw-r--r--mixer.scm20
-rw-r--r--mus-config.h.in1
-rw-r--r--musglyphs.scm20
-rw-r--r--noise.scm2
-rw-r--r--nrev.scm2
-rw-r--r--numerics.scm86
-rw-r--r--oscope.scm4
-rw-r--r--peak-phases.scm371
-rw-r--r--pix/8.pngbin0 -> 25427 bytes
-rw-r--r--pix/88.pngbin0 -> 35089 bytes
-rw-r--r--pix/sqrt.pngbin8505 -> 7283 bytes
-rw-r--r--pix/sqrt1.pngbin3990 -> 4006 bytes
-rw-r--r--play.scm45
-rw-r--r--poly.scm74
-rw-r--r--popup.scm14
-rw-r--r--rtio.scm2
-rw-r--r--rubber.scm30
-rw-r--r--run.c137
-rw-r--r--s7.c2805
-rw-r--r--s7.h26
-rw-r--r--s7.html743
-rw-r--r--s7test.scm10973
-rw-r--r--singer.scm286
-rw-r--r--snd-axis.c4
-rw-r--r--snd-chn.c15
-rw-r--r--snd-completion.c1
-rw-r--r--snd-contents.html2
-rw-r--r--snd-dac.c133
-rw-r--r--snd-fft.c2
-rw-r--r--snd-file.c12
-rw-r--r--snd-g0.h28
-rw-r--r--snd-gl.scm8
-rw-r--r--snd-gtk.scm42
-rw-r--r--snd-help.c9
-rw-r--r--snd-listener.c31
-rw-r--r--snd-motif.scm54
-rw-r--r--snd-sig.c121
-rw-r--r--snd-snd.c5
-rw-r--r--snd-test.scm39076
-rw-r--r--snd-xen.c2
-rw-r--r--snd-xref.c2351
-rw-r--r--snd-xsnd.c2
-rw-r--r--snd.c2
-rw-r--r--snd.h6
-rw-r--r--snd.html2
-rw-r--r--snd11.scm37
-rw-r--r--snd6.scm125
-rw-r--r--snd9.scm1
-rw-r--r--sndclm.html196
-rw-r--r--sndlib-ws.scm4
-rw-r--r--sndscm.html673
-rw-r--r--sndwarp.scm4
-rw-r--r--stochastic.scm8
-rw-r--r--test.sndbin0 -> 229348 bytes
-rw-r--r--toolbar.scm2
-rw-r--r--tools/index.cl5
-rw-r--r--tools/indexer.scm75
-rwxr-xr-xtools/makexg.scm123
-rw-r--r--tools/xgdata.scm87
-rw-r--r--v.scm9
-rw-r--r--ws.scm31
-rw-r--r--wz_data.js4
-rw-r--r--xg.c826
-rw-r--r--xm-enved.scm14
104 files changed, 35556 insertions, 28332 deletions
diff --git a/HISTORY.Snd b/HISTORY.Snd
index f63758a..f8f770f 100644
--- a/HISTORY.Snd
+++ b/HISTORY.Snd
@@ -1,5 +1,7 @@
Snd change log
+ 7-June: Snd 11.6.
+ 27-May: removed snd6.scm. added binary-io.scm.
29-Apr: Snd 11.5.
7-Apr: autoload support via s7's *unbound-variable-hook*.
20-Mar: Snd 11.4.
diff --git a/NEWS b/NEWS
index ef25ce7..e40dace 100644
--- a/NEWS
+++ b/NEWS
@@ -1,21 +1,23 @@
-Snd 11.5
+Snd 11.6
-autoload support via s7's *unbound-variable-hook*. If you try to
- use some undefined function, Snd first looks through a table
- of (nearly) everything defined in the scheme files that come
- with Snd, loading the needed files automatically. To turn this
- off, (set! *unbound-variable-hook* #f).
+in s7: *#readers* for your own #... readers
+ nan? and infinite?
+ #nD(...) multidimensional vector constant syntax
+ support for circular and shared structures
+ integer-decode-float and binary file IO (binary-io.scm).
-removed encapsulation from s7. Added augment-environment.
+play-skipping-silence in extsnd.html
-added make-type to s7: scheme-level type creation.
- symbol-access: trap/modify the symbol value lookup mechanism.
+removed snd6.scm.
-mix-notelists in ws.scm.
+if --with-gtk, the configure script looks first for gtk 3.0 now
+ (actually 2.90.n, but the libraries and headers use the name 3.0), then
+ falls back on 2.0.
-checked: gtk 2.20.0, sbcl 1.0.37
+added --without-audio configure switch.
-Thanks!: Rick Taube, Rick's students, Oded Ben-Tal, Cazzaniga Sandro,
- Mike Scholz
+checked: sbcl 1.0.38|39, gtk 2.20.1|21.0|90.0|1, mpc 0.8.2
+
+Thanks!: Fernando Lopez-Lezcano, Kjetil Matheussen
diff --git a/aclocal.m4 b/aclocal.m4
index bfaaaba..7d1dfdb 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -324,6 +324,7 @@ AC_DEFUN(AM_PATH_GTK_2_0,
[dnl
dnl Get the cflags and libraries from pkg-config
dnl
+
pkg_config_args=gtk+-2.0
for module in . $4
do
@@ -386,6 +387,76 @@ dnl
])
+dnl AM_PATH_GTK_3_0([MINIMUM-VERSION, [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND [, MODULES]]]])
+dnl Test for GTK+, and define GTK_CFLAGS and GTK_LIBS, if gthread is specified in MODULES,
+dnl pass to pkg-config
+dnl
+AC_DEFUN(AM_PATH_GTK_3_0,
+[dnl
+dnl Get the cflags and libraries from pkg-config
+dnl
+ pkg_config_args=gtk+-3.0
+ for module in . $4
+ do
+ case "$module" in
+ gthread)
+ pkg_config_args="$pkg_config_args gthread-3.0"
+ ;;
+ esac
+ done
+
+ no_gtk=""
+
+ AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
+
+ if test x$PKG_CONFIG != xno ; then
+ if pkg-config --atleast-pkgconfig-version 0.7 ; then
+ :
+ else
+ echo *** pkg-config too old; version 0.7 or better required.
+ no_gtk=yes
+ PKG_CONFIG=no
+ fi
+ else
+ no_gtk=yes
+ fi
+
+ min_gtk_version=ifelse([$1], ,1.3.3,$1)
+ AC_MSG_CHECKING(for GTK+ - version >= $min_gtk_version)
+
+ if test x$PKG_CONFIG != xno ; then
+ ## don't try to run the test against uninstalled libtool libs
+ if $PKG_CONFIG --uninstalled $pkg_config_args; then
+ echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
+ fi
+
+ if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
+ :
+ else
+ no_gtk=yes
+ fi
+ fi
+
+ if test x"$no_gtk" = x ; then
+ AC_MSG_RESULT(yes)
+ GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
+ GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
+ gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
+ sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\1/'`
+ gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
+ sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\2/'`
+ gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
+ sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\3/'`
+ ifelse([$2], , :, [$2])
+ AC_SUBST(GTK_CFLAGS)
+ AC_SUBST(GTK_LIBS)
+ else
+ AC_MSG_RESULT(no)
+ ifelse([$3], , :, [$3])
+ fi
+])
+
+
## fth.m4 -- Autoconf macros for configuring FTH -*- Autoconf -*-
## Copyright (C) 2006 Michael Scholz
diff --git a/analog-filter.scm b/analog-filter.scm
index 18e7390..c4e6d3c 100644
--- a/analog-filter.scm
+++ b/analog-filter.scm
@@ -27,39 +27,39 @@
;; x * h -> y
(do ((n 0 (+ n 1)))
((= n (+ L M)))
- (vct-set! y n 0.0)
+ (set! (y n) 0.0)
(do ((m (max 0 (- n (+ 1 L))) (+ 1 m)))
((> m (min n M)))
- (vct-set! y n (+ (vct-ref y n) (* (vct-ref h m) (vct-ref x (- n m))))))))
+ (set! (y n) (+ (y n) (* (h m) (x (- n m))))))))
(let* ((K (length A))
(d (make-vct (+ 1 (* 2 K))))
(a1 (make-vct (+ 1 (* 2 K)))))
- (vct-set! a1 0 1.0)
+ (set! (a1 0) 1.0)
(do ((i 0 (+ 1 i)))
((= i K))
(conv 2 (list-ref A i) (+ 1 (* 2 i)) a1 d)
(do ((j 0 (+ 1 j)))
((= j (+ 3 (* 2 i))))
- (vct-set! a1 j (vct-ref d j))))
+ (set! (a1 j) (d j))))
a1))
(do ((i 0 (+ i 2))
(j 0 (+ j 3))
(k 0 (+ k 4)))
((>= i n))
- (let* ((nt0 (/ (vct-ref num (+ j 0)) (* wc wc)))
- (nt1 (/ (vct-ref num (+ j 1)) wc))
- (nt2 (vct-ref num (+ j 2)))
- (dt0 (/ (vct-ref den (+ j 0)) (* wc wc)))
- (dt1 (/ (vct-ref den (+ j 1)) (* wc Q)))
- (dt2 (vct-ref den (+ j 2)))
+ (let* ((nt0 (/ (num (+ j 0)) (* wc wc)))
+ (nt1 (/ (num (+ j 1)) wc))
+ (nt2 (num (+ j 2)))
+ (dt0 (/ (den (+ j 0)) (* wc wc)))
+ (dt1 (/ (den (+ j 1)) (* wc Q)))
+ (dt2 (den (+ j 2)))
(kd (+ dt0 dt1 dt2))
(kn (+ nt0 nt1 nt2)))
- (vct-set! c (+ k 0) (/ (- (* 2.0 dt2) (* 2.0 dt0)) kd))
- (vct-set! c (+ k 1) (/ (+ dt0 (- dt1) dt2) kd))
- (vct-set! c (+ k 2) (/ (- (* 2.0 nt2) (* 2.0 nt0)) kn))
- (vct-set! c (+ k 3) (/ (+ nt0 (- nt1) nt2) kn))
+ (set! (c (+ k 0)) (/ (- (* 2.0 dt2) (* 2.0 dt0)) kd))
+ (set! (c (+ k 1)) (/ (+ dt0 (- dt1) dt2) kd))
+ (set! (c (+ k 2)) (/ (- (* 2.0 nt2) (* 2.0 nt0)) kn))
+ (set! (c (+ k 3)) (/ (+ nt0 (- nt1) nt2) kn))
(set! g (* g (/ kn kd)))))
(let ((a '())
@@ -67,8 +67,8 @@
(do ((i 0 (+ i 2))
(k 0 (+ k 4))) ; c
((>= i n))
- (set! a (cons (vct (vct-ref c (+ k 3)) (vct-ref c (+ k 2)) (vct-ref c (+ k 3))) a))
- (set! b (cons (vct 1.0 (vct-ref c k) (vct-ref c (+ k 1))) b)))
+ (set! a (cons (vct (c (+ k 3)) (c (+ k 2)) (c (+ k 3))) a))
+ (set! b (cons (vct 1.0 (c k) (c (+ k 1))) b)))
(list (vct-scale! (cascade->canonical a) g) ; scale entire numerator because this is the convolved form
(cascade->canonical b)))))
@@ -80,14 +80,14 @@
(do ((k 0 (+ k 2))
(i 0 (+ i 3)))
((>= k n))
- (set! g (* g (/ (vct-ref num (+ i 2)) (vct-ref den (+ i 2)))))
- (vct-set! numt (+ i 0) 1.0)
- (vct-set! numt (+ i 1) (/ (vct-ref num (+ i 1)) (vct-ref num (+ i 2))))
- (vct-set! numt (+ i 2) (/ (vct-ref num i) (vct-ref num (+ i 2))))
- (vct-set! dent (+ i 0) 1.0)
- (vct-set! dent (+ i 1) (/ (vct-ref den (+ i 1)) (vct-ref den (+ i 2))))
- (vct-set! dent (+ i 2) (/ (vct-ref den i) (vct-ref den (+ i 2)))))
- (vct-set! numt 0 g)
+ (set! g (* g (/ (num (+ i 2)) (den (+ i 2)))))
+ (set! (numt (+ i 0)) 1.0)
+ (set! (numt (+ i 1)) (/ (num (+ i 1)) (num (+ i 2))))
+ (set! (numt (+ i 2)) (/ (num i) (num (+ i 2))))
+ (set! (dent (+ i 0)) 1.0)
+ (set! (dent (+ i 1)) (/ (den (+ i 1)) (den (+ i 2))))
+ (set! (dent (+ i 2)) (/ (den i) (den (+ i 2)))))
+ (set! (numt 0) g)
(list numt dent)))
@@ -101,12 +101,12 @@
(do ((w 1 (+ w 2))
(j 0 (+ j 3)))
((>= w n))
- (vct-set! num j 0.0)
- (vct-set! num (+ j 1) 0.0)
- (vct-set! num (+ j 2) 1.0)
- (vct-set! den j 1.0)
- (vct-set! den (+ j 1) (* 2.0 (cos (/ (* w pi) (* 2.0 n)))))
- (vct-set! den (+ j 2) 1.0))
+ (set! (num j) 0.0)
+ (set! (num (+ j 1)) 0.0)
+ (set! (num (+ j 2)) 1.0)
+ (set! (den j) 1.0)
+ (set! (den (+ j 1)) (* 2.0 (cos (/ (* w pi) (* 2.0 n)))))
+ (set! (den (+ j 2)) 1.0))
(list num den)))
(define (make-butterworth-lowpass n fc)
@@ -151,7 +151,7 @@ are (1.0-based) edge freqs: (make-butterworth-bandstop 4 .1 .2)"
(define* (chebyshev-prototype n (ripple 1.0)) ; ripple in dB (positive)
(let* ((e (sqrt (- (expt 10.0 (* 0.1 ripple)) 1.0)))
- (v0 (/ (asinh (/ 1.0 e)) (exact->inexact n)))
+ (v0 (/ (asinh (/ 1.0 e)) n))
(len (/ (* n 3) 2))
(num (make-vct len))
(den (make-vct len)))
@@ -160,14 +160,14 @@ are (1.0-based) edge freqs: (make-butterworth-bandstop 4 .1 .2)"
((>= l n))
(let* ((u (- (* (sinh v0) (sin (/ (* l pi) (* 2.0 n))))))
(w (* (cosh v0) (cos (/ (* l pi) (* 2.0 n))))))
- (vct-set! num (+ j 0) 0.0)
- (vct-set! num (+ j 1) 0.0)
- (vct-set! num (+ j 2) 1.0)
- (vct-set! den (+ j 0) 1.0)
- (vct-set! den (+ j 1) (* -2.0 u))
- (vct-set! den (+ j 2) (+ (* u u) (* w w)))))
- (vct-set! num 2 (/ (expt 2.0 (- 2 n))
- (expt 3.2 (/ (log ripple) (log 10.0))))) ; whatever works...
+ (set! (num (+ j 0)) 0.0)
+ (set! (num (+ j 1)) 0.0)
+ (set! (num (+ j 2)) 1.0)
+ (set! (den (+ j 0)) 1.0)
+ (set! (den (+ j 1)) (* -2.0 u))
+ (set! (den (+ j 2)) (+ (* u u) (* w w)))))
+ (set! (num 2) (/ (expt 2.0 (- 2 n))
+ (expt 3.2 (/ (log ripple) (log 10.0))))) ; whatever works...
(list num den)))
(define* (make-chebyshev-lowpass n fc (ripple 1.0))
@@ -211,7 +211,7 @@ fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandstop 8 .1 .4 .01)"
(define* (inverse-chebyshev-prototype n (loss-dB 60.0)) ; stopband loss
(let* ((e (sqrt (/ 1.0 (- (expt 10.0 (* 0.1 loss-dB)) 1.0))))
- (v0 (/ (asinh (/ 1.0 e)) (exact->inexact n)))
+ (v0 (/ (asinh (/ 1.0 e)) n))
(len (/ (* n 3) 2))
(num (make-vct len))
(den (make-vct len)))
@@ -222,12 +222,12 @@ fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandstop 8 .1 .4 .01)"
(let* ((u (- (* (sinh v0) (sin (/ (* l pi) (* 2.0 n))))))
(w (* (cosh v0) (cos (/ (* l pi) (* 2.0 n)))))
(t (/ 1.0 (sin (/ (* (+ l pl) pi) (* 2.0 n))))))
- (vct-set! num (+ j 0) 1.0)
- (vct-set! num (+ j 1) 0.0)
- (vct-set! num (+ j 2) (* t t))
- (vct-set! den (+ j 0) 1.0)
- (vct-set! den (+ j 1) (/ (* -2.0 u) (+ (* u u) (* w w))))
- (vct-set! den (+ j 2) (/ 1.0 (+ (* u u) (* w w)))))))
+ (set! (num (+ j 0)) 1.0)
+ (set! (num (+ j 1)) 0.0)
+ (set! (num (+ j 2)) (* t t))
+ (set! (den (+ j 0)) 1.0)
+ (set! (den (+ j 1)) (/ (* -2.0 u) (+ (* u u) (* w w))))
+ (set! (den (+ j 2)) (/ 1.0 (+ (* u u) (* w w)))))))
(list num den
(expt 1.122 (- loss-dB))))) ; argh
@@ -281,10 +281,10 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
; (let ((cs (make-vct (+ n 1))))
; (do ((i 0 (+ 1 i)))
; ((> i n))
-; (vct-set! cs i (/ (fact (- (* 2 n) i))
-; (* (expt 2 (- n i))
-; (fact i)
-; (fact (- n i))))))
+; (set! (cs i) (/ (fact (- (* 2 n) i))
+; (* (expt 2 (- n i))
+; (fact i)
+; (fact (- n i))))))
; cs))
(define (bessel-i n)
(let ((cs (make-vct (+ n 1))))
@@ -295,7 +295,7 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(f (+ 1 (- n i)) (+ 1 f)))
((> k n))
(set! val (* val f)))
- (vct-set! cs i val)))
+ (set! (cs i) val)))
cs))
(let* ((len (/ (* n 3) 2))
@@ -305,16 +305,16 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(let* ((p (gsl-roots (vct->vector b2))))
(do ((i 0 (+ 1 i)))
((= i n))
- (vector-set! p i (/ (vector-ref p i) (expt (vct-ref b2 0) (/ 1.0 n)))))
+ (set! (p i) (/ (p i) (expt (b2 0) (/ 1.0 n)))))
(do ((j 0 (+ j 3))
(i 0 (+ i 2)))
((>= i n))
- (vct-set! num (+ j 0) 0.0)
- (vct-set! num (+ j 1) 0.0)
- (vct-set! num (+ j 2) 1.0)
- (vct-set! den (+ j 0) 1.0)
- (vct-set! den (+ j 1) (* -2.0 (real-part (vector-ref p i))))
- (vct-set! den (+ j 2) (real-part (* (vector-ref p i) (vector-ref p (+ i 1)))))))
+ (set! (num (+ j 0)) 0.0)
+ (set! (num (+ j 1)) 0.0)
+ (set! (num (+ j 2)) 1.0)
+ (set! (den (+ j 0)) 1.0)
+ (set! (den (+ j 1)) (* -2.0 (real-part (p i))))
+ (set! (den (+ j 2)) (real-part (* (p i) (p (+ i 1)))))))
(list num den)))
(define (make-bessel-lowpass n fc)
@@ -364,16 +364,16 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(do ((j 0 (+ 1 j))
(s xmin (+ s step)))
((= j (- n 1)))
- (vct-set! x j s))
- (vct-set! x (- n 1) xmax))
+ (set! (x j) s))
+ (set! (x (- n 1)) xmax))
(do ((j 0 (+ 1 j)))
((= j n))
- (let ((ft (f (vct-ref x j) arg1 arg2)))
+ (let ((ft (f (x j) arg1 arg2)))
(if (< ft fx)
(begin
(set! fx ft)
- (set! xmax (if (< j (- n 1)) (vct-ref x (+ 1 j)) (vct-ref x (- n 1))))
- (set! xmin (if (> j 0) (vct-ref x (- j 1)) (vct-ref x 0))))))))
+ (set! xmax (if (< j (- n 1)) (x (+ 1 j)) (x (- n 1))))
+ (set! xmin (if (> j 0) (x (- j 1)) (x 0))))))))
(/ (+ xmax xmin) 2.0)))
(define (findm m arg1 arg2)
@@ -395,26 +395,26 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(g 1.0)
(eps 0.0000001))
(if (> (abs (- 1.0 (* k1p k1p))) eps)
- (set! kr (* (exact->inexact n) (/ (gsl-ellipk (* k1 k1)) (gsl-ellipk (* k1p k1p))))))
+ (set! kr (* n (/ (gsl-ellipk (* k1 k1)) (gsl-ellipk (* k1p k1p))))))
(set! m (minimize-function findm 0.001 0.999 kr))
(set! k (gsl-ellipk m))
(let* ((cv (make-vct (floor (* 0.5 (* 3 (+ n 1)))))))
(do ((i 0 (+ i 2))
(j 0 (+ j 3)))
((>= i n))
- (let* ((vals (gsl-ellipj (/ (* (+ i 1) k) (exact->inexact n)) m))
+ (let* ((vals (gsl-ellipj (/ (* (+ i 1) k) (* 1.0 n)) m))
(sn (car vals))
(cn (cadr vals))
(dn (caddr vals)))
- (vct-set! cv (+ j 0) sn)
- (vct-set! cv (+ j 1) cn)
- (vct-set! cv (+ j 2) dn)
+ (set! (cv (+ j 0)) sn)
+ (set! (cv (+ j 1)) cn)
+ (set! (cv (+ j 2)) dn)
(let* ((z (/ 0.0-i (* (sqrt m) sn)))
(pz (real-part (* z (make-rectangular (real-part z) (- (imag-part z)))))))
(set! g (/ g pz))
- (vct-set! num (+ j 0) 1.0)
- (vct-set! num (+ j 1) (* -2.0 (real-part z)))
- (vct-set! num (+ j 2) pz))))
+ (set! (num (+ j 0)) 1.0)
+ (set! (num (+ j 1)) (* -2.0 (real-part z)))
+ (set! (num (+ j 2)) pz))))
(let* ((optarg0 (* k1p k1p))
(optarg1 (/ 1.0 e))
(minf (minimize-function findv 0.0 (/ 1.0 e) optarg0 optarg1))
@@ -427,15 +427,15 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(do ((i 0 (+ i 2))
(j 0 (+ j 3)))
((>= i n))
- (let* ((p (/ (- (+ (* (vct-ref cv (+ j 1)) (vct-ref cv (+ j 2)) sn cn)
- (* 0.0+i (vct-ref cv (+ j 0)) dn)))
- (- 1.0 (* (vct-ref cv (+ j 2)) sn
- (vct-ref cv (+ j 2)) sn)))))
+ (let* ((p (/ (- (+ (* (cv (+ j 1)) (cv (+ j 2)) sn cn)
+ (* 0.0+i (cv (+ j 0)) dn)))
+ (- 1.0 (* (cv (+ j 2)) sn
+ (cv (+ j 2)) sn)))))
(let ((pp (real-part (* p (make-rectangular (real-part p) (- (imag-part p)))))))
(set! g (* g pp))
- (vct-set! den (+ j 0) 1.0)
- (vct-set! den (+ j 1) (* -2.0 (real-part p)))
- (vct-set! den (+ j 2) pp))))))
+ (set! (den (+ j 0)) 1.0)
+ (set! (den (+ j 1)) (* -2.0 (real-part p)))
+ (set! (den (+ j 2)) pp))))))
(set! g (abs (/ g (sqrt (+ 1.0 (* e e))))))
(list num den g)))
diff --git a/animals.scm b/animals.scm
index bd5fe97..f72de12 100644
--- a/animals.scm
+++ b/animals.scm
@@ -274,13 +274,16 @@
(if (and (selection?)
(selection-member? snd))
(begin
- (play-selection)
+ (play (selection))
#t)
(if (> (frames snd) (* 10 (srate snd)))
(let ((chn (or (selected-channel) 0)))
(with-temporary-selection
- play-selection
- (left-sample snd chn) (- (right-sample snd chn) (left-sample snd chn)) snd chn)
+ (lambda () (play (selection)))
+ (left-sample snd chn)
+ (- (right-sample snd chn)
+ (left-sample snd chn))
+ snd chn)
#t)
#f))
#f))))
@@ -332,10 +335,10 @@
(if (> (- hi-pix lo-pix) samps-per-pixel)
(begin
(set! (left-sample) (+ lo samps-per-pixel))
- (set! (x-zoom-slider) (exact->inexact (/ (max samps-per-pixel (- hi lo (* 2 samps-per-pixel))) len)))))
+ (set! (x-zoom-slider) (* 1.0 (/ (max samps-per-pixel (- hi lo (* 2 samps-per-pixel))) len)))))
(begin
(set! (left-sample) (max 0 (- lo samps-per-pixel)))
- (set! (x-zoom-slider) (exact->inexact (/ (min len (+ (- hi lo) (* 2 samps-per-pixel))) len)))))
+ (set! (x-zoom-slider) (* 1.0 (/ (min len (+ (- hi lo) (* 2 samps-per-pixel))) len)))))
keyboard-no-action))
(bind-key "Up" 0 (lambda () "zoom out one pixel" (zoom-one-pixel (selected-sound) (selected-channel) #f))) ;up
@@ -726,7 +729,7 @@
(set! (mus-phase gen4) (* 0.5 pi))))
(let* ((noise (rand-interp rnd))
- (pulse-amp (vct-ref pulse-amps pulse-ctr)))
+ (pulse-amp (pulse-amps pulse-ctr)))
(outa i (* (env ampf)
(env pulsef)
pulse-amp
@@ -1370,7 +1373,7 @@
(pulse-ampf (make-env '(0.000 0.000 0.063 0.312 0.277 0.937 0.405 1.000 0.617 0.696 0.929 0.146 2.000 0.000) :length wave-len)))
(do ((i 0 (+ i 1)))
((= i wave-len))
- (vct-set! v i (env pulse-ampf)))
+ (set! (v i) (env pulse-ampf)))
v))
(pulse1 (make-wave-train 56.0 :wave pulse))
(pulse2 (make-delay (seconds->samples .0078))) ; pulses come in pairs
@@ -1420,13 +1423,13 @@
(do ((call 0 (+ 1 call)))
((= call 4))
- (let* ((start (seconds->samples (+ beg (vct-ref begs call))))
+ (let* ((start (seconds->samples (+ beg (begs call))))
(dur .01)
(stop (+ start (seconds->samples dur)))
(ampf (make-env '(0.000 0.000 0.082 0.967 0.149 1.000 0.183 0.977 0.299 0.529
0.334 0.595 0.451 0.312 0.520 0.176 0.639 0.155 0.753 0.077 1.000 0.000)
- :duration dur :scaler (* amp (vct-ref amps call))))
- (frq (hz->radians (* 0.5 (vct-ref frqs call))))
+ :duration dur :scaler (* amp (amps call))))
+ (frq (hz->radians (* 0.5 (frqs call))))
(gen1 (make-polywave :partials (list 1 .005 2 .97 3 .02 4 .01))))
(run
(do ((i start (+ i 1)))
@@ -1540,12 +1543,12 @@
(do ((call 0 (+ 1 call)))
((= call 5))
(amargosa-toad-1
- (+ beg1 (vct-ref begs call))
- (vct-ref durs call)
- (vct-ref frqs call)
- (vector-ref frqenvs call)
- (* amp1 (vct-ref amps call))
- (vector-ref ampenvs call)))))
+ (+ beg1 (begs call))
+ (durs call)
+ (frqs call)
+ (frqenvs call)
+ (* amp1 (amps call))
+ (ampenvs call)))))
;; (with-sound (:play #t) (amargosa-toad 0 .5))
@@ -1751,12 +1754,12 @@
(scl (apply + lst)))
(do ((i 0 (+ i 1)))
((= i num))
- (vct-set! v i (/ (list-ref lst i) scl)))
+ (set! (v i) (/ (list-ref lst i) scl)))
v))
(gens (let ((v (make-vector num #f)))
(do ((i 0 (+ i 1)))
((= i num))
- (vector-set! v i (make-oscil (list-ref freqs i))))
+ (set! (v i) (make-oscil (list-ref freqs i))))
v))
(pulse-dur .02)
(pulse-count 0)
@@ -1787,11 +1790,11 @@
(mus-reset pulsef)
(do ((k 0 (+ 1 k)))
((= k num))
- (mus-reset (vector-ref gens k)))))))
+ (mus-reset (gens k)))))))
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k num))
- (set! sum (+ sum (* (vct-ref amps k) (oscil (vector-ref gens k))))))
+ (set! sum (+ sum (* (amps k) (oscil (gens k))))))
(outa i (* (env ampf)
(env pulsef)
sum)))))))
@@ -2462,7 +2465,7 @@
(durs (let ((v (make-vector 10 0.0)))
(do ((i 0 (+ i 1)))
((= i 10))
- (vector-set! v i (- (vector-ref ends i) (vector-ref begs i))))
+ (set! (v i) (- (ends i) (begs i))))
v))
(scls (vector .09 .19 .22 .19 .27 .23 .21 .04 .17 .17))
(amps (vector (list 0.000 0.000 0.17 0.13 0.38 0.67 0.64 1.0 0.78 0.79 0.9 0.04 1.0 0.0)
@@ -2489,17 +2492,17 @@
(list 0 1 1 .3 2 0)))
(song-start start)
(next-song-start (+ start (seconds->samples (+ 8.75 (random .1)))))
- (next-peep (+ start (seconds->samples (vector-ref begs 1))))
+ (next-peep (+ start (seconds->samples (begs 1))))
(rnd (make-rand-interp 100 .01)))
(do ((i 0 (+ i 1)))
((= i 10))
- (vector-set! amp-envs i (make-env (vector-ref amps i)
- :scaler (/ (* amp (vector-ref scls i)) .27)
- :duration (vector-ref durs i)))
- (vector-set! frq-envs i (make-env (vector-ref frqs i)
- :scaler (hz->radians (- (vector-ref high-frqs i) (vector-ref low-frqs i)))
- :offset (hz->radians (vector-ref low-frqs i))
- :duration (vector-ref durs i))))
+ (set! (amp-envs i) (make-env (amps i)
+ :scaler (/ (* amp (scls i)) .27)
+ :duration (durs i)))
+ (set! (frq-envs i) (make-env (frqs i)
+ :scaler (hz->radians (- (high-frqs i) (low-frqs i)))
+ :offset (hz->radians (low-frqs i))
+ :duration (durs i))))
(run
(do ((i start (+ i 1)))
((= i stop))
@@ -2511,14 +2514,14 @@
(if (= i next-peep)
(begin
(set! peep (+ 1 peep))
- (mus-reset (vector-ref amp-envs peep))
- (mus-reset (vector-ref frq-envs peep))
+ (mus-reset (amp-envs peep))
+ (mus-reset (frq-envs peep))
(if (< peep 9)
- (set! next-peep (+ song-start (seconds->samples (vector-ref begs (+ 1 peep)))))
+ (set! next-peep (+ song-start (seconds->samples (begs (+ 1 peep)))))
(set! next-peep next-song-start))))
- (let ((frq (+ (env (vector-ref frq-envs peep))
+ (let ((frq (+ (env (frq-envs peep))
(rand-interp rnd))))
- (outa i (* (env (vector-ref amp-envs peep))
+ (outa i (* (env (amp-envs peep))
(oscil gen1 frq
(* .03 (oscil gen2 (* 2 frq)))))))))))
@@ -3237,29 +3240,29 @@
(ampfs (make-vector 4 #f))
(gen1 (make-oscil))
- (buzz-start (+ start (seconds->samples (vct-ref begs 4))))
- (buzz-end (+ buzz-start (seconds->samples (vct-ref durs 4))))
+ (buzz-start (+ start (seconds->samples (begs 4))))
+ (buzz-end (+ buzz-start (seconds->samples (durs 4))))
(buzz-ampf (make-env '(0.000 0.000 0.095 0.953 0.114 0.182 0.158 0.822 0.236 0.996 0.332 1.000 0.848 0.589 0.957 0.372 1.000 0.000)
- :duration (vct-ref durs 4) :scaler amp))
+ :duration (durs 4) :scaler amp))
(buzzer (make-nrxysin 40 :n 5 :r .5)) ; sawtooth not great here due to broad spectrum
(buzzer-index (hz->radians 2000))
(buzzer-amp (make-triangle-wave 40 0.8)))
(do ((i 0 (+ i 1)))
((= i 4))
- (vector-set! ampfs i (make-env '(0 0 1 .8 1.5 1 2 .8 3 0) :duration (vct-ref durs i) :scaler (* amp (vct-ref amps i))))
- (vector-set! starts i (+ start (seconds->samples (vct-ref begs i))))
- (vector-set! stops i (+ (vector-ref starts i) (seconds->samples (vct-ref durs i)))))
+ (set! (ampfs i) (make-env '(0 0 1 .8 1.5 1 2 .8 3 0) :duration (durs i) :scaler (* amp (amps i))))
+ (set! (starts i) (+ start (seconds->samples (begs i))))
+ (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
(run
;; first the 4 tones
(do ((tone 0 (+ 1 tone)))
((= tone 4))
- (set! (mus-frequency gen1) (vct-ref frqs tone))
- (let ((ampf (vector-ref ampfs tone))
- (end (vector-ref stops tone)))
- (do ((i (vector-ref starts tone) (+ i 1)))
+ (set! (mus-frequency gen1) (frqs tone))
+ (let ((ampf (ampfs tone))
+ (end (stops tone)))
+ (do ((i (starts tone) (+ i 1)))
((= i end))
(outa i (* (env ampf)
(oscil gen1))))))
@@ -3339,18 +3342,18 @@
(do ((i 0 (+ i 1)))
((= i 4))
- (vector-set! ampfs i (make-env (vector-ref amp-envs i) :duration (vct-ref durs i) :scaler (* amp (vct-ref amps i))))
- (vector-set! frqfs i (make-env (vector-ref frq-envs i) :duration (vct-ref durs i) :scaler (hz->radians 5000)))
- (vector-set! starts i (+ start (seconds->samples (vct-ref begs i))))
- (vector-set! stops i (+ (vector-ref starts i) (seconds->samples (vct-ref durs i)))))
+ (set! (ampfs i) (make-env (amp-envs i) :duration (durs i) :scaler (* amp (amps i))))
+ (set! (frqfs i) (make-env (frq-envs i) :duration (durs i) :scaler (hz->radians 5000)))
+ (set! (starts i) (+ start (seconds->samples (begs i))))
+ (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
(run
(do ((tone 0 (+ 1 tone)))
((= tone 4))
- (let ((ampf (vector-ref ampfs tone))
- (frqf (vector-ref frqfs tone))
- (end (vector-ref stops tone)))
- (do ((i (vector-ref starts tone) (+ i 1)))
+ (let ((ampf (ampfs tone))
+ (frqf (frqfs tone))
+ (end (stops tone)))
+ (do ((i (starts tone) (+ i 1)))
((= i end))
(outa i (* (env ampf)
(polywave gen1 (env frqf))))))))))
@@ -3494,20 +3497,20 @@
(do ((i 0 (+ i 1)))
((= i 3))
- (vector-set! ampfs i (make-env (vector-ref amp-envs i) :duration (vct-ref durs i) :scaler (* amp (vct-ref amps i))))
- (vector-set! frqf1s i (make-env (vector-ref frq1-envs i) :duration (vct-ref durs i) :scaler (hz->radians 10000)))
- (vector-set! frqf2s i (make-env (vector-ref frq2-envs i) :duration (vct-ref durs i) :scaler (hz->radians 10000)))
- (vector-set! starts i (+ start (seconds->samples (vct-ref begs i))))
- (vector-set! stops i (+ (vector-ref starts i) (seconds->samples (vct-ref durs i)))))
+ (set! (ampfs i) (make-env (amp-envs i) :duration (durs i) :scaler (* amp (amps i))))
+ (set! (frqf1s i) (make-env (frq1-envs i) :duration (durs i) :scaler (hz->radians 10000)))
+ (set! (frqf2s i) (make-env (frq2-envs i) :duration (durs i) :scaler (hz->radians 10000)))
+ (set! (starts i) (+ start (seconds->samples (begs i))))
+ (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
(run
(do ((tone 0 (+ 1 tone)))
((= tone 3))
- (let ((ampf (vector-ref ampfs tone))
- (frqf1 (vector-ref frqf1s tone))
- (frqf2 (vector-ref frqf2s tone))
- (end (vector-ref stops tone)))
- (do ((i (vector-ref starts tone) (+ i 1)))
+ (let ((ampf (ampfs tone))
+ (frqf1 (frqf1s tone))
+ (frqf2 (frqf2s tone))
+ (end (stops tone)))
+ (do ((i (starts tone) (+ i 1)))
((= i end))
(outa i (* (env ampf)
(+ (* .55 (polywave gen1 (env frqf1)))
@@ -3574,18 +3577,18 @@
(do ((i 0 (+ i 1)))
((= i 6))
- (vector-set! starts i (+ start (seconds->samples (vct-ref begs i)))))
- (vector-set! starts 6 (+ 1 stop))
+ (set! (starts i) (+ start (seconds->samples (begs i)))))
+ (set! (starts 6) (+ 1 stop))
(run
(do ((i start (+ i 1)))
((= i stop))
(if (>= i next-start)
(begin
- (set! peep-amp (vct-ref amps peep-ctr))
- (set! (mus-frequency gen1) (vct-ref frqs peep-ctr))
+ (set! peep-amp (amps peep-ctr))
+ (set! (mus-frequency gen1) (frqs peep-ctr))
(set! peep-ctr (+ 1 peep-ctr))
- (set! next-start (vector-ref starts peep-ctr))
+ (set! next-start (starts peep-ctr))
(mus-reset ampf)
(mus-reset frqf)))
(outa i (* (env ampf)
@@ -3631,7 +3634,7 @@
:scaler (hz->radians 1.0))))
(do ((i 0 (+ i 1)))
((= i buzz-size))
- (vct-set! v i (env bfrqf)))
+ (set! (v i) (env bfrqf)))
v))
(buzz-amp-table (let ((v (make-vct buzz-size 0.0))
(bampf (make-env (if gliss-up
@@ -3640,7 +3643,7 @@
:length buzz-size)))
(do ((i 0 (+ i 1)))
((= i buzz-size))
- (vct-set! v i (env bampf)))
+ (set! (v i) (env bampf)))
v))
(buzz-frqf (make-table-lookup buzz-frq0 :wave buzz-frq-table))
(buzz-ampf (make-table-lookup buzz-frq0 :wave buzz-amp-table))
@@ -3816,12 +3819,12 @@
(do ((call 0 (+ 1 call)))
((= call 4))
- (let* ((start (seconds->samples (+ beg (vct-ref begs call))))
- (stop (+ start (seconds->samples (vct-ref durs call))))
+ (let* ((start (seconds->samples (+ beg (begs call))))
+ (stop (+ start (seconds->samples (durs call))))
(gen (make-polywave :partials (list 1 .9 2 .12 3 .007 7 .003)))
(rnd (make-rand-interp 30 (hz->radians 5)))
- (ampf (make-env '(0 0 1 1 4 .9 5 0) :duration (vct-ref durs call) :scaler (* amp (vct-ref amps call))))
- (frqf (make-env '(0 1.25 .5 2 4.4 1.95 5 1) :base .1 :duration (vct-ref durs call) :scaler (hz->radians (* 0.5 328)))))
+ (ampf (make-env '(0 0 1 1 4 .9 5 0) :duration (durs call) :scaler (* amp (amps call))))
+ (frqf (make-env '(0 1.25 .5 2 4.4 1.95 5 1) :base .1 :duration (durs call) :scaler (hz->radians (* 0.5 328)))))
(run
(do ((i start (+ i 1)))
((= i stop))
@@ -3845,17 +3848,17 @@
(ampfs (vector
(make-env '(0.000 0.000 0.086 0.398 0.247 0.610 0.363 0.000 0.416 0.000 0.513 0.603 0.610 0.603
0.708 0.507 0.733 0.232 0.798 0.895 0.848 1.000 0.898 0.927 1.000 0.000)
- :duration (vct-ref durs 0) :scaler (* amp (vct-ref amps 0)))
+ :duration (durs 0) :scaler (* amp (amps 0)))
(make-env '(0.000 0.000 0.060 0.735 0.303 1.000 0.394 0.408 0.503 0.318 0.617 0.879 0.912 0.258
0.939 0.055 1.000 0.000)
- :duration (vct-ref durs 1) :scaler (* amp (vct-ref amps 1)))
+ :duration (durs 1) :scaler (* amp (amps 1)))
(make-env '(0.000 0.000 0.098 0.837 0.183 0.704 0.395 1.000 0.469 0.185 0.553 0.086 0.731 0.841
0.785 0.834 1.000 0.000)
- :duration (vct-ref durs 2) :scaler (* amp (vct-ref amps 2)))
+ :duration (durs 2) :scaler (* amp (amps 2)))
(make-env '(0.000 0.000 0.047 0.837 0.117 0.172 0.167 0.157 0.234 0.993 0.296 0.826 0.319 0.609
0.431 0.781 0.567 0.506 0.642 0.166 0.673 0.757 0.769 0.874 0.873 0.766 0.919 0.605
0.956 0.230 1.000 0.000)
- :duration (vct-ref durs 3) :scaler (* amp (vct-ref amps 3)))))
+ :duration (durs 3) :scaler (* amp (amps 3)))))
(frqfs (vector
(make-env '(0.000 0.437 0.056 0.561 0.075 0.558 0.094 0.459 0.109 0.536 0.128 0.411 0.142 0.521
@@ -3863,32 +3866,32 @@
0.409 0.313 0.491 0.461 0.614 0.461 0.665 0.428 0.702 0.340 0.718 0.406 0.739 0.331
0.756 0.470 0.772 0.336 0.803 0.510 0.818 0.353 0.845 0.536 0.862 0.415 0.886 0.545
0.903 0.470 0.924 0.534 0.945 0.442 1.000 0.395)
- :duration (vct-ref durs 0) :scaler (hz->radians 6000))
+ :duration (durs 0) :scaler (hz->radians 6000))
(make-env '(0.000 0.587 0.045 0.543 0.064 0.459 0.088 0.563 0.105 0.481 0.127 0.600 0.141 0.514
0.172 0.620 0.185 0.532 0.212 0.640 0.233 0.567 0.251 0.629 0.266 0.589 0.374 0.448
0.440 0.404 0.528 0.406 0.557 0.450 0.583 0.466 0.604 0.517 0.618 0.481 0.648 0.552
0.667 0.499 0.691 0.556 0.710 0.517 0.739 0.561 0.758 0.519 0.791 0.561 0.814 0.510
0.833 0.534 0.975 0.483 1.000 0.488)
- :duration (vct-ref durs 1) :scaler (hz->radians 6000))
+ :duration (durs 1) :scaler (hz->radians 6000))
(make-env '(0.000 0.247 0.059 0.539 0.073 0.556 0.131 0.490 0.150 0.444 0.172 0.501 0.199 0.402
0.222 0.512 0.249 0.430 0.279 0.552 0.304 0.464 0.340 0.600 0.360 0.479 0.383 0.567
0.496 0.311 0.611 0.320 0.635 0.470 0.655 0.331 0.680 0.492 0.703 0.349 0.742 0.534
0.770 0.373 0.797 0.536 0.823 0.419 0.856 0.536 0.881 0.433 0.910 0.506 0.950 0.397
0.978 0.508 1.000 0.514)
- :duration (vct-ref durs 2) :scaler (hz->radians 6000))
+ :duration (durs 2) :scaler (hz->radians 6000))
(make-env '(0.000 0.614 0.031 0.607 0.046 0.514 0.072 0.430 0.145 0.307 0.168 0.380 0.191 0.536
0.205 0.453 0.223 0.570 0.239 0.457 0.261 0.547 0.282 0.426 0.297 0.503 0.318 0.426
0.341 0.453 0.449 0.468 0.580 0.435 0.635 0.419 0.652 0.353 0.674 0.494 0.687 0.545
0.706 0.455 0.732 0.556 0.754 0.457 0.783 0.547 0.807 0.455 0.840 0.558 0.858 0.453
0.885 0.539 0.914 0.439 0.938 0.541 0.965 0.433 1.000 0.472)
- :duration (vct-ref durs 3) :scaler (hz->radians 6000)))))
+ :duration (durs 3) :scaler (hz->radians 6000)))))
(do ((call 0 (+ 1 call)))
((= call 4))
- (let* ((ampf (vector-ref ampfs call))
- (frqf (vector-ref frqfs call))
- (start (seconds->samples (+ beg (vct-ref begs call))))
- (stop (+ start (seconds->samples (vct-ref durs call)))))
+ (let* ((ampf (ampfs call))
+ (frqf (frqfs call))
+ (start (seconds->samples (+ beg (begs call))))
+ (stop (+ start (seconds->samples (durs call)))))
(run
(do ((i start (+ i 1)))
((= i stop))
@@ -4068,7 +4071,7 @@
(do ((call 0 (+ 1 call)))
((= call 6))
- (nashville-warbler-1 (+ beg (* .21 call)) (+ .15 (random .02)) (* amp (vct-ref amps1 call))))
+ (nashville-warbler-1 (+ beg (* .21 call)) (+ .15 (random .02)) (* amp (amps1 call))))
(do ((call 0 (+ 1 call)))
((= call 3))
@@ -4452,7 +4455,7 @@
(ampf2 (make-env '(0 0 .6 0 .7 1 1 1) :duration pulse-dur))
(gen1 (make-polywave :partials (list 1 .95 2 .04 3 .005)))
(gen2 (make-polywave :partials (list 1 .5 2 .5 4 .01)))
- (pulse-frq (vct-ref frqs 0))
+ (pulse-frq (frqs 0))
(pulse-ctr 1)
(rnd (make-rand-interp 500 .02)))
(run
@@ -4461,7 +4464,7 @@
(if (>= i next-pulse)
(begin
(set! next-pulse (+ next-pulse pulse-samps))
- (set! pulse-frq (vct-ref frqs pulse-ctr))
+ (set! pulse-frq (frqs pulse-ctr))
(set! pulse-ctr (+ pulse-ctr 1))
(mus-reset pulse-ampf)
(mus-reset ampf1)
@@ -4501,29 +4504,29 @@
(do ((i 0 (+ i 1)))
((= i 3))
- (vector-set! starts i (seconds->samples (+ beg (vct-ref begs i))))
- (vector-set! stops i (+ (vector-ref starts i) (seconds->samples (vct-ref durs i)))))
+ (set! (starts i) (seconds->samples (+ beg (begs i))))
+ (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
- (vector-set! gens 0 (make-nrxysin 530 1.0 8 .5))
- (vector-set! gens 1 (make-nrxysin 450 1.0 15 .6))
- (vector-set! gens 2 (make-nrxysin 400 1.0 8 .5))
+ (set! (gens 0) (make-nrxysin 530 1.0 8 .5))
+ (set! (gens 1) (make-nrxysin 450 1.0 15 .6))
+ (set! (gens 2) (make-nrxysin 400 1.0 8 .5))
- (vector-set! ampfs 0 (make-env '(0 0 1.25 1 1.75 1 3 0) :base 10 :duration (vct-ref durs 0) :scaler (* amp 0.25)))
- (vector-set! ampfs 1 (make-env '(0.000 0.000 0.208 0.719 0.292 0.965 0.809 0.869 0.928 0.682 1.000 0.000) :base 10 :duration (vct-ref durs 1) :scaler (* 0.5 amp)))
- (vector-set! ampfs 2 (make-env '(0 0 1 1 3 1 6 0) :base 10 :duration (vct-ref durs 2) :scaler (* amp .375)))
+ (set! (ampfs 0) (make-env '(0 0 1.25 1 1.75 1 3 0) :base 10 :duration (durs 0) :scaler (* amp 0.25)))
+ (set! (ampfs 1) (make-env '(0.000 0.000 0.208 0.719 0.292 0.965 0.809 0.869 0.928 0.682 1.000 0.000) :base 10 :duration (durs 1) :scaler (* 0.5 amp)))
+ (set! (ampfs 2) (make-env '(0 0 1 1 3 1 6 0) :base 10 :duration (durs 2) :scaler (* amp .375)))
- (vector-set! frqfs 0 (make-env '(0 0 1.3 1 2 0) :duration (vct-ref durs 0) :scaler (hz->radians 300)))
- (vector-set! frqfs 1 (make-env '(0 0 1.5 .8 2.5 1 4 .95 5 .25) :base .03 :duration (vct-ref durs 1) :scaler (hz->radians 520)))
- (vector-set! frqfs 2 (make-env '(0 0 .2 .7 .3 1 1 .5) :duration (vct-ref durs 2) :scaler (hz->radians 450.0)))
+ (set! (frqfs 0) (make-env '(0 0 1.3 1 2 0) :duration (durs 0) :scaler (hz->radians 300)))
+ (set! (frqfs 1) (make-env '(0 0 1.5 .8 2.5 1 4 .95 5 .25) :base .03 :duration (durs 1) :scaler (hz->radians 520)))
+ (set! (frqfs 2) (make-env '(0 0 .2 .7 .3 1 1 .5) :duration (durs 2) :scaler (hz->radians 450.0)))
(run
(do ((k 0 (+ 1 k)))
((= k 3))
- (let ((start (vector-ref starts k))
- (stop (vector-ref stops k))
- (ampf (vector-ref ampfs k))
- (frqf (vector-ref frqfs k))
- (gen (vector-ref gens k)))
+ (let ((start (starts k))
+ (stop (stops k))
+ (ampf (ampfs k))
+ (frqf (frqfs k))
+ (gen (gens k)))
(do ((i start (+ i 1)))
((= i stop))
(let ((val (* (env ampf)
@@ -6241,8 +6244,8 @@
(do ((i 0 (+ i 1))
(bg beg1 (+ bg .35)))
((= i 4))
- (oak-titmouse-1 bg (* amp1 (vct-ref amps i)))
- (oak-titmouse-2 (+ bg .156) (* amp1 (vct-ref amps i))))))
+ (oak-titmouse-1 bg (* amp1 (amps i)))
+ (oak-titmouse-2 (+ bg .156) (* amp1 (amps i))))))
;; (with-sound (:play #t) (oak-titmouse 0 .5))
@@ -6332,13 +6335,13 @@
(do ((note 0 (+ 1 note))
(bg beg1 (+ bg 0.18)))
((= note 5))
- (macgillivrays-warbler-1 bg (* amp1 (vct-ref amps note)))))
+ (macgillivrays-warbler-1 bg (* amp1 (amps note)))))
(let ((amps (vct 1.0 .9 .7)))
(do ((note 0 (+ 1 note))
(bg (+ beg1 0.93) (+ bg 0.17)))
((= note 3))
- (macgillivrays-warbler-2 bg (* amp1 (vct-ref amps note))))))
+ (macgillivrays-warbler-2 bg (* amp1 (amps note))))))
;; (with-sound (:play #t) (macgillivrays-warbler 0 .5))
@@ -6654,7 +6657,7 @@
(amps2 (vct .2 .4 .7 1 1 .8 1 1 1)))
(do ((i 0 (+ i 1)))
((= i 9))
- (wilsons-warbler-2 (+ beg1 0.285 (* i .13)) (vct-ref durs2 i) (vct-ref frqs2 i) (* amp1 (vct-ref amps2 i)))))
+ (wilsons-warbler-2 (+ beg1 0.285 (* i .13)) (durs2 i) (frqs2 i) (* amp1 (amps2 i)))))
(do ((i 0 (+ i 1)))
((= i 3))
@@ -7111,7 +7114,7 @@
(do ((i 0 (+ i 1))
(x 0.68 (+ x .1)))
((= i 7))
- (song-sparrow-sweep-tone (+ beg1 x) (* (vct-ref amps i) amp1))
+ (song-sparrow-sweep-tone (+ beg1 x) (* (amps i) amp1))
(song-sparrow-sweep-caw (+ beg1 x .05) (* 0.5 amp1))))
(song-sparrow-sweep-tone (+ beg1 1.37) (* .27 amp1))
@@ -7262,21 +7265,21 @@
(ampfs (make-vector 5)))
(do ((i 0 (+ i 1)))
((= i 5))
- (vector-set! oscs i (make-oscil)))
+ (set! (oscs i) (make-oscil)))
- (vector-set! ampfs 0 (make-env '(0.000 0.000 0.061 0.000 0.201 0.997 0.278 0.997 0.441 0.000 0.662 0.000
+ (set! (ampfs 0) (make-env '(0.000 0.000 0.061 0.000 0.201 0.997 0.278 0.997 0.441 0.000 0.662 0.000
0.783 0.456 0.864 0.459 0.970 0.000 1.000 0.000)
:duration dur :scaler .1))
- (vector-set! ampfs 1 (make-env '(0.000 0.000 0.153 0.639 0.307 0.639 0.457 0.109 0.617 0.107 0.739 1.000
+ (set! (ampfs 1) (make-env '(0.000 0.000 0.153 0.639 0.307 0.639 0.457 0.109 0.617 0.107 0.739 1.000
0.913 1.000 1.000 0.298)
:duration dur :scaler .4))
- (vector-set! ampfs 2 (make-env '(0.000 0.000 0.190 0.842 0.266 0.514 0.297 1.000 0.456 0.257 0.599 0.260
+ (set! (ampfs 2) (make-env '(0.000 0.000 0.190 0.842 0.266 0.514 0.297 1.000 0.456 0.257 0.599 0.260
0.670 0.702 0.707 0.579 0.739 0.710 0.808 0.325 0.865 0.519 1.000 0.402)
:duration dur :scaler .2))
- (vector-set! ampfs 3 (make-env '(0.000 0.000 0.064 0.077 0.157 0.653 0.255 0.699 0.311 0.995 0.352 0.615
+ (set! (ampfs 3) (make-env '(0.000 0.000 0.064 0.077 0.157 0.653 0.255 0.699 0.311 0.995 0.352 0.615
0.389 0.986 0.458 0.178 0.667 0.363 0.750 0.000 1.000 0.000)
:duration dur :scaler .07))
- (vector-set! ampfs 4 (make-env '(0.000 0.000 0.159 0.995 0.314 0.997 0.598 0.000 1.000 0.000)
+ (set! (ampfs 4) (make-env '(0.000 0.000 0.159 0.995 0.314 0.997 0.598 0.000 1.000 0.000)
:duration dur :scaler .01))
(run
@@ -7286,7 +7289,7 @@
(sum 0.0))
(do ((k 0 (+ 1 k)))
((= k 5))
- (set! sum (+ sum (* (env (vector-ref ampfs k)) (oscil (vector-ref oscs k) (* (+ 1 k) frq))))))
+ (set! sum (+ sum (* (env (ampfs k)) (oscil (oscs k) (* (+ 1 k) frq))))))
(outa i (* (env ampf) sum) )))))
;; part 2
@@ -7790,7 +7793,7 @@
(let ((amps (vct .3 .5 .8 .8 .8 .8 .8 1.0 .8 .8 .4)))
(do ((call 0 (+ 1 call)))
((= call 11))
- (dark-eyed-junco-1 (+ beg1 (* call .122)) (* amp1 (vct-ref amps call))))))
+ (dark-eyed-junco-1 (+ beg1 (* call .122)) (* amp1 (amps call))))))
;; (with-sound (:play #t) (dark-eyed-junco 0 .5))
@@ -8873,8 +8876,8 @@
(begs (vct 0.0 0.156 .311 .454 .594 .731)))
(do ((call 0 (+ 1 call)))
((= call 6))
- (chestnut-sided-warbler-1 (+ beg1 (vct-ref begs call))
- (* amp1 (vct-ref amps call)))))
+ (chestnut-sided-warbler-1 (+ beg1 (begs call))
+ (* amp1 (amps call)))))
(chestnut-sided-warbler-2 (+ beg1 .88) amp1)
@@ -9277,15 +9280,15 @@
(gen1 (make-polywave :partials (list 1 .98 2 .015 3 .005))))
(do ((call 0 (+ 1 call)))
((= call 3))
- (let* ((start (seconds->samples (+ beg (vct-ref begs call))))
- (dur (vct-ref durs call))
+ (let* ((start (seconds->samples (+ beg (begs call))))
+ (dur (durs call))
(stop (+ start (seconds->samples dur)))
(ampf (make-env '(0.000 0.000 0.016 0.207 0.079 0.402 0.131 0.348 0.224 0.562 0.255 0.592 0.316 0.757
0.367 0.637 0.407 0.664 0.428 0.613 0.474 0.751 0.495 0.757 0.522 0.898 0.609 1.000
0.701 0.778 0.738 0.967 0.770 0.892 0.797 0.898 0.819 0.790 0.835 0.931 0.852 0.892
0.874 0.997 0.903 0.775 0.928 0.718 0.957 0.736 1.000 0.000)
- :duration dur :scaler (* amp (vct-ref amps call))))
- (frqf (make-env (vector-ref frqs call) :duration dur :scaler (hz->radians 22000.0))))
+ :duration dur :scaler (* amp (amps call))))
+ (frqf (make-env (frqs call) :duration dur :scaler (hz->radians 22000.0))))
(run
(do ((i start (+ i 1)))
((= i stop))
@@ -10201,10 +10204,10 @@
(gen1 (make-oscil)))
(do ((call 0 (+ 1 call)))
((= call 4))
- (let* ((start (seconds->samples (+ beg (vct-ref begs call))))
- (dur (vct-ref durs call))
+ (let* ((start (seconds->samples (+ beg (begs call))))
+ (dur (durs call))
(stop (+ start (seconds->samples dur)))
- (ampf (make-env ampenv :duration dur :scaler (* amp (vct-ref amps call))))
+ (ampf (make-env ampenv :duration dur :scaler (* amp (amps call))))
(frqf (make-env frqenv :duration dur :scaler (hz->radians 22000))))
(run
(do ((i start (+ i 1)))
@@ -10295,12 +10298,12 @@
0.930 0.292 0.964 0.269 1.000 0.247))))
(do ((call 0 (+ 1 call)))
((= call 8))
- (kirtlands-warbler-1 (+ beg1 (vct-ref begs call))
- (vct-ref durs call)
- (vct-ref frqs call)
- (vector-ref frqenvs call)
- (* amp1 (vct-ref amps call))
- (vector-ref ampenvs call)))))
+ (kirtlands-warbler-1 (+ beg1 (begs call))
+ (durs call)
+ (frqs call)
+ (frqenvs call)
+ (* amp1 (amps call))
+ (ampenvs call)))))
;; (with-sound (:play #t) (kirtlands-warbler 0 .5))
diff --git a/audio.c b/audio.c
index c2e0c43..03006b2 100644
--- a/audio.c
+++ b/audio.c
@@ -5010,7 +5010,7 @@ static int osx_chans(int dev1)
AudioDeviceID dev = kAudioDeviceUnknown;
OSStatus err = noErr;
UInt32 size;
- int i, curdev;
+ int curdev;
bool in_case = false;
curdev = MUS_AUDIO_DEVICE(dev1);
@@ -6875,7 +6875,7 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
output_pars.suggestedLatency = Pa_GetDeviceInfo(output_pars.device)->defaultHighOutputLatency;
output_pars.hostApiSpecificStreamInfo = NULL;
- err = Pa_OpenStream(&out_stream, NULL, &output_pars, srate, 1024, paClipOff, NULL, NULL); /* TODO: 1024 = frames [dac_size] but can we use "size"? */
+ err = Pa_OpenStream(&out_stream, NULL, &output_pars, srate, 1024, paClipOff, NULL, NULL); /* 1024 = frames [dac_size] but can we use "size"? */
if (err == paNoError)
err = Pa_StartStream(out_stream);
diff --git a/bess.scm b/bess.scm
index 50e8ce1..e68789f 100644
--- a/bess.scm
+++ b/bess.scm
@@ -188,7 +188,7 @@
(set-flabel fm-label index))
(define (ratio-callback w c i)
- (set! ratio (inexact->exact (* (.value i) (/ high-ratio 100.0))))
+ (set! ratio (floor (* (.value i) (/ high-ratio 100.0))))
(set-ilabel cm-label ratio))
;; add scale-change (drag and value-changed) callbacks
@@ -212,10 +212,10 @@
(set-flabel fm-label index)
(set-ilabel cm-label ratio)
- (XmScaleSetValue freq-scale (inexact->exact (floor (* 100 (/ (- frequency low-frequency) (- high-frequency low-frequency))))))
- (XmScaleSetValue amp-scale (inexact->exact (* 100 amplitude)))
- (XmScaleSetValue fm-scale (inexact->exact (floor (* 100 (/ index high-index)))))
- (XmScaleSetValue cm-scale (inexact->exact (floor (* ratio (/ 100 high-ratio)))))
+ (XmScaleSetValue freq-scale (floor (* 100 (/ (- frequency low-frequency) (- high-frequency low-frequency)))))
+ (XmScaleSetValue amp-scale (floor (* 100 amplitude)))
+ (XmScaleSetValue fm-scale (floor (* 100 (/ index high-index))))
+ (XmScaleSetValue cm-scale (floor (* ratio (/ 100 high-ratio))))
(XtManageChild shell)
(XtRealizeWidget shell)
diff --git a/bess1.scm b/bess1.scm
index 32b076a..a033595 100644
--- a/bess1.scm
+++ b/bess1.scm
@@ -483,7 +483,7 @@
(set-flabel index-label cindex)
(XmScaleSetValue tempo-scale (floor (* 100 (/ (- ctempo low-tempo) (- high-tempo low-tempo)))))
(XmScaleSetValue freq-scale (floor (* 100 (/ (- cfreq low-freq) (- high-freq low-freq)))))
- (XmScaleSetValue amp-scale (inexact->exact (* 100 camp)))
+ (XmScaleSetValue amp-scale (floor (* 100 camp)))
(XmScaleSetValue index-scale (floor (* 100 (/ cindex high-index)))))
(XtManageChild radio)
diff --git a/binary-io.scm b/binary-io.scm
new file mode 100644
index 0000000..3e07a34
--- /dev/null
+++ b/binary-io.scm
@@ -0,0 +1,274 @@
+;;; read/write binary (sound) files
+;;;
+;;; names are read|write b|l int|float n,
+;;; so read-bint32 reads the next 4 bytes from the current input port,
+;;; interpreting them as a big-endian 32-bit integer
+
+(provide 'snd-binary-io.scm)
+
+
+;;; -------- strings (0-terminated)
+
+(define (read-string)
+ (let ((chars '()))
+ (do ((c (read-byte) (read-byte)))
+ ((or (= c 0)
+ (eof-object? c))
+ (apply string (reverse chars)))
+ (set! chars (cons (integer->char c) chars)))))
+
+(define (write-string str)
+ (for-each write-char str) ; or maybe (lambda (c) (write-byte (char->integer c)))
+ (write-byte 0))
+
+
+;;; -------- strings (unterminated)
+
+(define (read-chars len)
+ (let ((str (make-string len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) str)
+ (string-set! str i (read-char)))))
+
+(define (write-chars str)
+ (for-each write-char str))
+
+
+;;; -------- 16-bit ints
+
+(define (read-bint16)
+ (let ((int (+ (ash (read-byte) 8) (read-byte))))
+ (if (> int 32767)
+ (- int 65536)
+ int)))
+
+(define (read-lint16)
+ (let ((int (+ (read-byte) (ash (read-byte) 8))))
+ (if (> int 32767)
+ (- int 65536)
+ int)))
+
+(define (write-bint16 int)
+ (write-byte (logand (ash int -8) #xff))
+ (write-byte (logand int #xff)))
+
+(define (write-lint16 int)
+ (write-byte (logand int #xff))
+ (write-byte (logand (ash int -8) #xff)))
+
+
+;;; -------- 32-bit ints
+
+(define (read-bint32)
+ (let ((int (+ (ash (read-byte) 24) (ash (read-byte) 16) (ash (read-byte) 8) (read-byte))))
+ (if (> int 2147483647)
+ (- int 4294967296)
+ int)))
+
+(define (read-lint32)
+ (let ((int (+ (read-byte) (ash (read-byte) 8) (ash (read-byte) 16) (ash (read-byte) 24))))
+ (if (> int 2147483647)
+ (- int 4294967296)
+ int)))
+
+(define (write-bint32 int)
+ (write-byte (logand (ash int -24) #xff))
+ (write-byte (logand (ash int -16) #xff))
+ (write-byte (logand (ash int -8) #xff))
+ (write-byte (logand int #xff)))
+
+(define (write-lint32 int)
+ (write-byte (logand int #xff))
+ (write-byte (logand (ash int -8) #xff))
+ (write-byte (logand (ash int -16) #xff))
+ (write-byte (logand (ash int -24) #xff)))
+
+
+;;; -------- 64-bit ints
+
+(define (read-bint64)
+ (let ((int 0))
+ (do ((i 56 (- i 8)))
+ ((< i 0) int)
+ (set! int (logior int (ash (read-byte) i))))))
+
+(define (read-lint64)
+ (let ((int 0))
+ (do ((i 0 (+ i 8)))
+ ((= i 64) int)
+ (set! int (logior int (ash (read-byte) i))))))
+
+(define (write-bint64 int)
+ (do ((i 56 (- i 8)))
+ ((< i 0))
+ (write-byte (logand (ash int (- i)) #xff))))
+
+(define (write-lint64 int)
+ (do ((i 0 (+ i 8)))
+ ((= i 64))
+ (write-byte (logand (ash int (- i)) #xff))))
+
+
+;;; -------- 32-bit floats (IEEE 754, sign + 23(+1) bits significand + 8 bits exponent)
+
+(define (int_to_float32 int)
+ (if (zero? int)
+ 0.0
+ (* (if (zero? (ash int -31)) 1.0 -1.0)
+ (expt 2 (- (logand (ash int -23) #xff) 127))
+ (logior #x800000 (logand int #x7fffff))
+ (expt 2 -23))))
+
+(define (read-bfloat32)
+ (int_to_float32 (read-bint32)))
+
+(define (read-lfloat32)
+ (int_to_float32 (read-lint32)))
+
+(define (float64_to_int32 flt)
+ (let* ((data (integer-decode-float flt))
+ (signif (car data))
+ (expon (cadr data))
+ (sign (caddr data)))
+ (if (and (= expon 0)
+ (= signif 0))
+ 0
+ ;; we're assuming floats are (64-bit) doubles in s7, so this is coercing to a 32-bit float in a sense
+ ;; this causes some round-off error
+ (logior (if (negative? sign) #x80000000 0)
+ (ash (+ expon 52 127) 23)
+ (logand (ash signif -29) #x7fffff)))))
+
+(define (write-bfloat32 flt)
+ (write-bint32 (float64_to_int32 flt)))
+
+(define (write-lfloat32 flt)
+ (write-lint32 (float64_to_int32 flt)))
+
+
+
+;;; -------- 64-bit floats (IEEE 754, sign + 52(+1) bits significand + 11 bits exponent)
+
+(define (int_to_float64 int)
+ (if (zero? int)
+ 0.0
+ (* (if (zero? (ash int -63)) 1.0 -1.0)
+ (expt 2 (- (logand (ash int -52) #x7ff) 1023))
+ (logior #x10000000000000 (logand int #xfffffffffffff))
+ (expt 2 -52))))
+
+(define (read-bfloat64)
+ (int_to_float64 (read-bint64)))
+
+(define (read-lfloat64)
+ (int_to_float64 (read-lint64)))
+
+(define (float64_to_int64 flt)
+ (let* ((data (integer-decode-float flt))
+ (signif (car data))
+ (expon (cadr data))
+ (sign (caddr data)))
+ (if (and (= expon 0)
+ (= signif 0))
+ 0
+ (logior (if (negative? sign) #x8000000000000000 0)
+ (ash (+ expon 52 1023) 52)
+ (logand signif #xfffffffffffff)))))
+
+(define (write-bfloat64 flt)
+ (write-bint64 (float64_to_int64 flt)))
+
+(define (write-lfloat64 flt)
+ (write-lint64 (float64_to_int64 flt)))
+
+
+
+;;; -------- 80-bit floats (IEEE 754, sign + 63(+1) bits significand + 15 bits exponent, needed for aifc headers)
+
+(define (read-bfloat80->int)
+ (let* ((exp 0)
+ (mant1 0)
+ (mant0 0)
+ (sign 0)
+ (buf (make-vector 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (buf i) (read-byte)))
+ (set! exp (logior (ash (buf 0) 8) (buf 1)))
+ (set! sign (if (/= (logand exp #x8000) 0) 1 0))
+ (set! exp (logand exp #x7FFF))
+ (set! mant1 (+ (ash (buf 2) 24) (ash (buf 3) 16) (ash (buf 4) 8) (buf 5)))
+ (set! mant0 (+ (ash (buf 6) 24) (ash (buf 7) 16) (ash (buf 8) 8) (buf 9)))
+ (if (= mant1 mant0 exp sign 0)
+ 0
+ (round (* (if (= sign 1) -1 1)
+ (expt 2.0 (- exp 16383.0))
+ (+ (* (expt 2.0 -31.0) mant1)
+ (* (expt 2.0 -63.0) mant0)))))))
+
+(define (write-int->bfloat80 val)
+ (let ((exp 0)
+ (sign 0)
+ (mant1 0)
+ (mant0 0))
+ (if (negative? val)
+ (begin
+ (set! sign 1)
+ (set! val (abs val))))
+ (if (not (zero? val))
+ (begin
+ (set! exp (round (+ (log val 2.0) 16383.0)))
+ (set! val (* val (expt 2 (- (+ 16383 31) exp))))
+ (set! mant1 (floor val))
+ (set! val (- val mant1))
+ (set! mant0 (floor (* val (expt 2 32))))))
+ (write-byte (logior (ash sign 7) (ash exp -8)))
+ (write-byte (logand exp #xFF))
+ (do ((i 2 (+ i 1))
+ (j 24 (- j 8)))
+ ((= i 6))
+ (write-byte (logand (ash mant1 (- j)) #xFF)))
+ (do ((i 6 (+ i 1))
+ (j 24 (- j 8)))
+ ((= i 10))
+ (write-byte (logand (ash mant0 (- j)) #xFF)))))
+
+
+
+;;; -------- "au" (NeXT/Sun) header
+
+(define (read-au-header file)
+ (with-input-from-file file
+ (lambda ()
+ (let ((magic (read-chars 4)))
+ (if (not (string=? magic ".snd"))
+ (error 'bad-header "~A is not an au file: ~A" file)
+ (let* ((data-location (read-bint32))
+ (data-size (read-bint32))
+ (data-format (read-bint32))
+ (srate (read-bint32))
+ (chans (read-bint32))
+ (comment (read-string)))
+ (list magic data-location data-size data-format srate chans comment)))))))
+
+(define (write-au-header file chans srate data-size data-format comment) ; data-size in bytes
+ (with-output-to-file file
+ (lambda ()
+ (let* ((comlen (length comment))
+ (data-location (+ 24 (* 4 (floor (+ 1 (/ comlen 4))))))
+ (curloc 24))
+ (write-chars ".snd")
+ (write-bint32 data-location)
+ (write-bint32 data-size)
+ (write-bint32 data-format)
+ (write-bint32 srate)
+ (write-bint32 chans)
+ (if (> comlen 0)
+ (begin
+ (write-string comment)
+ (set! curloc (+ curloc comlen 1)))) ; write-string adds a trailing 0
+ (do ((i curloc (+ i 1)))
+ ((>= i data-location))
+ (write-byte 0))))))
+
+
diff --git a/clean.scm b/clean.scm
index f20bbfd..9e24bb1 100644
--- a/clean.scm
+++ b/clean.scm
@@ -23,8 +23,8 @@
(define* (check-freq freq snd chn)
(let ((hum 0.0))
- (do ((i 0 (1+ i))
- (loc 0.0 (+ loc (inexact->exact (round (/ (frames snd chn) 5))))))
+ (do ((i 0 (+ 1 i))
+ (loc 0.0 (+ loc (round (/ (frames snd chn) 5)))))
((= i 4))
(set! hum (+ hum (goertzel-channel freq loc 2048 snd chn))))
(/ hum 4.0)))
@@ -46,12 +46,12 @@
(block (make-vct block-size))
(block-changed #f))
(run
- (do ((ctr 0 (1+ ctr)))
+ (do ((ctr 0 (+ 1 ctr)))
((= ctr len))
(set! samp0 samp1)
(set! samp1 samp2)
(set! samp2 (next-sample reader))
- (vct-set! block block-ctr samp2)
+ (set! (block block-ctr) samp2)
(let* ((df1 (abs (- samp1 samp0)))
(df2 (abs (- samp2 samp1)))
(df3 (abs (- samp2 samp0)))
@@ -65,19 +65,19 @@
0.0))))
(begin
(set! samp1 (* .5 (+ samp0 samp2)))
- (vct-set! block (1- block-ctr) samp1)
+ (set! (block (- block-ctr 1)) samp1)
(set! block-changed #t)
- (set! fixed (1+ fixed)))))
- (set! block-ctr (1+ block-ctr))
+ (set! fixed (+ 1 fixed)))))
+ (set! block-ctr (+ 1 block-ctr))
(if (>= block-ctr block-size)
(begin
(if block-changed
(begin
(vct->channel block block-beg block-size snd chn)
(set! block-changed #f)))
- (set! block-beg (+ block-beg (1- block-size)))
+ (set! block-beg (+ block-beg (- block-size 1)))
(set! block-ctr 1)
- (vct-set! block 0 samp2))))
+ (set! (block 0) samp2))))
(if block-changed
(vct->channel block block-beg block-ctr snd chn)))
fixed))
@@ -88,47 +88,45 @@
(do ((i 2 (+ i 30))
(val .9 (- val .05)))
((>= i 1000))
- (vct-set! data i val))
- (vct-set! data 1000 .001)
+ (set! (data i) val))
+ (set! (data 1000) .001)
(vct->channel data)
(remove-single-sample-clicks)
(let ((mx (maxamp))
(loc (maxamp-position)))
(if (> mx 0.06)
- (snd-display ";remove-single-sample-clicks 0: ~A (at ~D)" mx loc)))
+ (format #t ";remove-single-sample-clicks 0: ~A (at ~D)" mx loc)))
(revert-sound)
- (do ((i 0 (1+ i))
+ (do ((i 0 (+ 1 i))
(ang 0.0 (+ ang .01)))
((= i 1000))
- (vct-set! data i (+ (vct-ref data i)
- (* .2 (sin ang)))))
+ (set! (data i) (+ (data i) (* .2 (sin ang)))))
(vct->channel data)
(remove-single-sample-clicks)
(if (fneq (maxamp) .2)
- (snd-display ";remove-single-sample-clicks sin max: ~A" (maxamp)))
+ (format #t ";remove-single-sample-clicks sin max: ~A" (maxamp)))
(let ((cur-data (channel->vct 0))
(diff 0.0))
- (do ((i 0 (1+ i))
+ (do ((i 0 (+ 1 i))
(ang 0.0 (+ ang .01)))
((= i 1000))
- (set! diff (max diff (abs (- (vct-ref cur-data i) (* .2 (sin ang)))))))
+ (set! diff (max diff (abs (- ( cur-data i) (* .2 (sin ang)))))))
(if (> diff .2)
- (snd-display ";remove-single-sample-clicks sine max diff: ~A" diff))))
+ (format #t ";remove-single-sample-clicks sine max diff: ~A" diff))))
(close-sound test)))
-
;;; -------- pops
(define* (smooth-vct data beg dur)
- (let* ((y0 (vct-ref data beg))
- (y1 (vct-ref data (+ beg dur)))
+ (let* ((y0 (data beg))
+ (y1 (data (+ beg dur)))
(angle (if (> y1 y0) pi 0.0))
(off (* .5 (+ y0 y1)))
(scale (* 0.5 (abs (- y1 y0))))
(incr (/ pi dur)))
- (do ((i 0 (1+ i)))
+ (do ((i 0 (+ 1 i)))
((= i dur))
- (vct-set! data (+ beg i) (+ off (* scale (cos (+ angle (* i incr)))))))))
+ (set! (data (+ beg i)) (+ off (* scale (cos (+ angle (* i incr)))))))))
(define* (remove-pops (size 8) snd chn)
(let* ((reader (make-sampler 0 snd chn))
@@ -164,7 +162,7 @@
(checked 0)
(checking #f)
(moving-start #t))
- (do ((ctr 0 (1+ ctr)))
+ (do ((ctr 0 (+ 1 ctr)))
((= ctr len))
(let* ((ahead-samp (next-sample reader))
(diff-ahead (abs (- ahead-samp last-ahead-samp)))
@@ -178,14 +176,14 @@
(set! last-ahead-samp ahead-samp)
(set! last-dly0-samp dly0-samp)
(set! last-dly1-samp dly1-samp)
- (vct-set! block block-ctr ahead-samp)
+ (set! (block block-ctr) ahead-samp)
(if checking
(begin
- (set! checked (1+ checked))
+ (set! checked (+ 1 checked))
(if (or (>= checked (* 2 size))
(< cur-avg check-val))
(begin
- (set! fixed (1+ fixed))
+ (set! fixed (+ 1 fixed))
(set! checking #f)
(smooth-vct block (- check-start block-beg) (+ size checker))
(set! block-changed #t)))
@@ -193,9 +191,9 @@
(begin
(set! moving-start (< cur-diff avg-behind))
(if moving-start
- (set! check-start (1+ check-start)))))
+ (set! check-start (+ 1 check-start)))))
(if (not moving-start)
- (set! checker (1+ checker))))
+ (set! checker (+ 1 checker))))
(if (and (> (- ctr last-case) (* 2 size))
(> cur-avg (* 4 avg-ahead))
(> cur-avg (* 4 avg-behind)))
@@ -204,14 +202,14 @@
(set! check-start (max 0 (- ctr (* 5 size))))
(set! moving-start (< cur-diff avg-behind))
(if moving-start
- (set! check-start (1+ check-start)))
+ (set! check-start (+ 1 check-start)))
(set! checking #t)
(set! check-val cur-avg)
(set! checker 0)
(set! checked 0)
(set! last-case ctr))))
- (set! block-ctr (1+ block-ctr))
+ (set! block-ctr (+ 1 block-ctr))
(if (>= (+ block-ctr pad) block-size)
(begin
(if block-changed
@@ -219,10 +217,10 @@
(vct->channel block block-beg (- block-ctr pad) snd chn)
(set! block-changed #f)))
(set! block-beg (+ block-beg (- block-ctr pad)))
- (do ((i 0 (1+ i))
- (j (- block-ctr pad) (1+ j)))
+ (do ((i 0 (+ 1 i))
+ (j (- block-ctr pad) (+ 1 j)))
((= i pad))
- (vct-set! block i (vct-ref block j)))
+ (set! (block i) (block j)))
(set! block-ctr pad)))))
(if block-changed
@@ -236,25 +234,25 @@
(do ((i 100 (+ i 200)))
((>= i 3800))
(let ((size (random 8)))
- (do ((k 0 (1+ k)))
+ (do ((k 0 (+ 1 k)))
((= k size))
- (vct-set! data (+ i k) (- 1.0 (random 2.0))))))
+ (set! (data (+ i k)) (- 1.0 (random 2.0))))))
(vct->channel data)
(remove-pops)
(let ((mx (maxamp)))
(if (> mx .01)
- (snd-display ";test remove-pops 0 case: ~A" mx)))
+ (format #t ";test remove-pops 0 case: ~A" mx)))
(revert-sound)
- (do ((i 0 (1+ i))
+ (do ((i 0 (+ 1 i))
(ang 0.0 (+ ang .01)))
((= i 4000))
- (vct-set! data i (+ (vct-ref data i)
- (* .2 (sin ang)))))
+ (set! (data i) (+ (data i)
+ (* .2 (sin ang)))))
(vct->channel data)
(remove-pops)
(let ((mx (maxamp)))
(if (fneq mx .2)
- (snd-display ";test remove-pops sine case: ~A" mx)))
+ (format #t ";test remove-pops sine case: ~A" mx)))
(close-sound)))
@@ -265,14 +263,14 @@
(let ((osc (make-oscil 60.0))
(e (make-env '(0 0 1 .5 9 .5 10 0) :length 44100)))
(run
- (do ((i 0 (1+ i)))
+ (do ((i 0 (+ 1 i)))
((= i 44100))
(outa i (* (env e) (oscil osc)))))))))
(notch-channel (list 60.0) #f #f #f #f #f #f #t 8)
(let ((mx (maxamp)))
(if (> mx .02)
- (snd-display ";notch hum 0: ~A" mx)))
+ (format #t ";notch hum 0: ~A" mx)))
(close-sound (find-sound test)))
(let ((test (with-sound (:output "test.snd" :srate 22050)
(let ((osc (make-oscil 60.0))
@@ -280,7 +278,7 @@
(osc2 (make-oscil 80.0))
(e (make-env '(0 0 1 .3 9 .3 10 0) :length 44100)))
(run
- (do ((i 0 (1+ i)))
+ (do ((i 0 (+ 1 i)))
((= i 44100))
(outa i (* (env e) (+ (oscil osc) (oscil osc1) (oscil osc2))))))))))
@@ -294,7 +292,7 @@
(if (or (fneq (/ e60 v60) 0.0)
(fneq (/ e40 v40) 1.0)
(fneq (/ e80 v80) 1.0))
- (snd-display ";notch 60: ~A ~A ~A -> ~A ~A ~A" v40 v60 v80 e40 e60 e80))))
+ (format #t ";notch 60: ~A ~A ~A -> ~A ~A ~A" v40 v60 v80 e40 e60 e80))))
(close-sound (find-sound test)))
(let ((test (with-sound (:output "test.snd" :srate 22050)
@@ -303,7 +301,7 @@
(osc2 (make-oscil 65.0))
(e (make-env '(0 0 1 .3 9 .3 10 0) :length 44100)))
(run
- (do ((i 0 (1+ i)))
+ (do ((i 0 (+ 1 i)))
((= i 44100))
(outa i (* (env e) (+ (oscil osc) (oscil osc1) (oscil osc2))))))))))
@@ -317,7 +315,7 @@
(if (or (> (/ e60 v60) 0.01)
(< (/ e40 v40) 0.99)
(< (/ e80 v80) 0.99))
- (snd-display ";notch 60 tight: ~A ~A ~A -> ~A ~A ~A" v40 v60 v80 e40 e60 e80))))
+ (format #t ";notch 60 tight: ~A ~A ~A -> ~A ~A ~A" v40 v60 v80 e40 e60 e80))))
(close-sound (find-sound test))))
@@ -326,12 +324,10 @@
(define (test-remove-DC)
(let ((test (new-sound "test.snd"))
(data (make-vct 4001)))
- (do ((i 0 (1+ i))
+ (do ((i 0 (+ 1 i))
(ang 0.0 (+ ang .01)))
((= i 4000))
- (vct-set! data i (+ .1
- (- 0.1 (random 0.2))
- (* .2 (sin ang)))))
+ (set! (data i) (+ .1 (- 0.1 (random 0.2)) (* .2 (sin ang)))))
(vct->channel data)
(let ((dc (goertzel 0.0))
(sig (goertzel 35.0)))
@@ -341,7 +337,7 @@
(nsig (goertzel 35.0)))
(if (or (> (/ ndc dc) .1)
(< (/ nsig sig) .4))
- (snd-display ";remove-DC: ~A -> ~A (~A), ~A -> ~A (~A)" dc ndc (/ ndc dc) sig nsig (/ nsig sig))))))
+ (format #t ";remove-DC: ~A -> ~A (~A), ~A -> ~A (~A)" dc ndc (/ ndc dc) sig nsig (/ nsig sig))))))
(close-sound test)))
@@ -363,7 +359,7 @@
(minK 1000.0)
)
- (do ((i 0 (1+ i)))
+ (do ((i 0 (+ 1 i)))
((= i avg-size))
(moving-sum del (formant frm (rd0))))
@@ -375,8 +371,8 @@
(set! K (min 1.0 (+ .1 (/ avg 100.0))))
; (set! K .5)
- (vct-set! avg-data ctr K)
- (set! ctr (1+ ctr))
+ (set! (avg-data ctr) K)
+ (set! ctr (+ 1 ctr))
(set! maxg (max maxg avg))
(set! ming (min ming avg))
@@ -391,7 +387,7 @@
(let ((mx1 (maxamp snd chn)))
(scale-channel (/ mx mx1) snd chn))
-; (snd-display ";K ~A to ~A, avg ~A to ~A" minK maxK ming maxg)
+; (format #t ";K ~A to ~A, avg ~A to ~A" minK maxK ming maxg)
; avg-data
))
@@ -402,17 +398,17 @@
;; look for obvious simple clicks
(let ((clicks (as-one-edit (lambda () (remove-single-sample-clicks 8 snd chn)))))
(if (> clicks 0)
- (snd-display "; fixed ~D single sample clicks" clicks)
- (snd-display "; no single-sample clicks found")))
+ (format #t "; fixed ~D single sample clicks" clicks)
+ (format #t "; no single-sample clicks found")))
;; look for obvious clipping and try to reconstruct
(let ((mx (maxamp snd chn)))
(if (>= mx 1.0)
(let ((clips (unclip-channel snd chn)))
(if (eq? clips 'no-clips)
- (snd-display "; no clipped portions found")
- (snd-display "; reconstructed ~D clipped portions" (list-ref clips 3))))
- (snd-display "; no obvious clipping (max amp: ~A)" mx)))
+ (format #t "; no clipped portions found")
+ (format #t "; reconstructed ~D clipped portions" (list-ref clips 3))))
+ (format #t "; no obvious clipping (max amp: ~A)" mx)))
;; look for pops
(let ((total-pops 0))
@@ -423,11 +419,11 @@
(let ((pops (as-one-edit (lambda () (remove-pops size snd chn)))))
(set! total-pops (+ total-pops pops))
(if (> pops 0)
- (snd-display "; fixed ~D ~D-sample ~A" pops size (if (= pops 1) "pop" "pops"))
+ (format #t "; fixed ~D ~D-sample ~A" pops size (if (= pops 1) "pop" "pops"))
(quit))))
(list 4 8 16 32))))
(if (= total-pops 0)
- (snd-display "; no pops found")))
+ (format #t "; no pops found")))
;; look for hum
(let* ((hum60 (check-freq 60.0 snd chn))
@@ -436,14 +432,14 @@
(if (> hum 30.0)
(let ((humf (if (> hum60 hum55) 60.0 55.0)))
(notch-channel (list humf) 4096 0 (frames snd chn) snd chn #f #t 4)
- (snd-display "; notch out ~D cycle hum: ~A -> ~A" (inexact->exact humf) hum (check-freq humf snd chn)))))
+ (format #t "; notch out ~D cycle hum: ~A -> ~A" (floor humf) hum (check-freq humf snd chn)))))
;; look for DC
(let ((dc (check-freq 0.0 snd chn)))
(if (> dc 30.0)
(let ((dcflt (make-filter 2 (vct 1 -1) (vct 0 -0.99))))
(map-channel (lambda (y) (filter dcflt y)) 0 (frames snd chn) snd chn)
- (snd-display "; block DC: ~A -> ~A" dc (check-freq 0.0 snd chn)))))
+ (format #t "; block DC: ~A -> ~A" dc (check-freq 0.0 snd chn)))))
;; time-varying low-pass filter
(tvf-channel snd chn)
@@ -455,6 +451,6 @@
(if (not (sound? index))
(throw 'no-such-sound (list "clean-sound" snd))
(let ((chns (channels index)))
- (do ((chn 0 (1+ chn)))
+ (do ((chn 0 (+ 1 chn)))
((= chn chns))
(clean-channel index chn))))))
diff --git a/clm-ins.scm b/clm-ins.scm
index ecdea5e..417f7fe 100644
--- a/clm-ins.scm
+++ b/clm-ins.scm
@@ -142,18 +142,18 @@ Anything other than .5 = longer decay. Must be between 0 and less than 1.0.
((= i fs))
(let ((amp (list-ref formant-amps i))
(index (list-ref formant-indices i)))
- (vector-set! evens i (make-oscil 0))
- (vector-set! odds i (make-oscil 0))
- (vct-set! amps i amp)
- (vct-set! indices i index)
- (vector-set! frmfs i (make-env (vox-fun phonemes i) :duration dur))))
+ (set! (evens i) (make-oscil 0))
+ (set! (odds i) (make-oscil 0))
+ (set! (amps i) amp)
+ (set! (indices i) index)
+ (set! (frmfs i) (make-env (vox-fun phonemes i) :duration dur))))
(run
(do ((i start (+ i 1))) ((= i end))
(set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
(set! carrier (oscil car-os (hz->radians frq)))
(set! sum 0.0)
(do ((k 0 (+ 1 k))) ((= k fs))
- (set! frm (env (vector-ref frmfs k)))
+ (set! frm (env (frmfs k)))
(set! frm0 (/ frm frq))
(set! frm-int (floor frm0))
(if (even? frm-int)
@@ -168,11 +168,11 @@ Anything other than .5 = longer decay. Must be between 0 and less than 1.0.
(set! even-amp (- frm0 frm-int))
(set! odd-amp (- 1.0 even-amp))))
(set! sum (+ sum
- (* (vct-ref amps k)
- (+ (* even-amp (oscil (vector-ref evens k)
- (+ even-freq (* (vct-ref indices k) carrier))))
- (* odd-amp (oscil (vector-ref odds k)
- (+ odd-freq (* (vct-ref indices k) carrier)))))))))
+ (* (amps k)
+ (+ (* even-amp (oscil (evens k)
+ (+ even-freq (* (indices k) carrier))))
+ (* odd-amp (oscil (odds k)
+ (+ odd-freq (* (indices k) carrier)))))))))
(locsig loc i (* (env ampf) sum)))))))
;;; (vox 0 2 170 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 E 25 AE 35 ER 65 ER 75 I 100 UH) '(.8 .15 .05) '(.005 .0125 .025) .05 .1)
@@ -361,14 +361,14 @@ vocal sounds using phase quadrature waveshaping"
(let* ((amp (list-ref formant-amps i))
(fshape (list-ref formant-shapes i))
(shape (normalize-partials fshape)))
- (vector-set! sin-evens i (make-oscil 0))
- (vector-set! sin-odds i (make-oscil 0))
- (vector-set! cos-evens i (make-oscil 0 :initial-phase (/ pi 2.0)))
- (vector-set! cos-odds i (make-oscil 0 :initial-phase (/ pi 2.0)))
- (vector-set! amps i amp)
- (vector-set! cos-coeffs i (partials->polynomial shape mus-chebyshev-first-kind))
- (vector-set! sin-coeffs i (partials->polynomial shape mus-chebyshev-second-kind))
- (vector-set! frmfs i (make-env (vox-fun phonemes i '()) :duration dur))))
+ (set! (sin-evens i) (make-oscil 0))
+ (set! (sin-odds i) (make-oscil 0))
+ (set! (cos-evens i) (make-oscil 0 :initial-phase (/ pi 2.0)))
+ (set! (cos-odds i) (make-oscil 0 :initial-phase (/ pi 2.0)))
+ (set! (amps i) amp)
+ (set! (cos-coeffs i) (partials->polynomial shape mus-chebyshev-first-kind))
+ (set! (sin-coeffs i) (partials->polynomial shape mus-chebyshev-second-kind))
+ (set! (frmfs i) (make-env (vox-fun phonemes i '()) :duration dur))))
(ws-interrupt?)
(run
(do ((i start (+ i 1)))
@@ -384,7 +384,7 @@ vocal sounds using phase quadrature waveshaping"
(sum 0.0))
(do ((k 0 (+ 1 k)))
((= k fs))
- (let* ((frm (env (vector-ref frmfs k)))
+ (let* ((frm (env (frmfs k)))
(frm0 (/ frm frq))
(frm-int (floor frm0)))
(if (even? frm-int)
@@ -398,13 +398,13 @@ vocal sounds using phase quadrature waveshaping"
(set! even-freq (hz->radians (* (+ frm-int 1) frq)))
(set! even-amp (- frm0 frm-int))
(set! odd-amp (- 1.0 even-amp))))
- (let* ((fax (polynomial (vector-ref cos-coeffs k) carcos))
- (yfax (* carsin (polynomial (vector-ref sin-coeffs k) carcos))))
- (set! sum (+ sum (* (vector-ref amps k)
- (+ (* even-amp (- (* yfax (oscil (vector-ref sin-evens k) even-freq))
- (* fax (oscil (vector-ref cos-evens k) even-freq))))
- (* odd-amp (- (* yfax (oscil (vector-ref sin-odds k) odd-freq))
- (* fax (oscil (vector-ref cos-odds k) odd-freq)))))))))))
+ (let* ((fax (polynomial (cos-coeffs k) carcos))
+ (yfax (* carsin (polynomial (sin-coeffs k) carcos))))
+ (set! sum (+ sum (* (amps k)
+ (+ (* even-amp (- (* yfax (oscil (sin-evens k) even-freq))
+ (* fax (oscil (cos-evens k) even-freq))))
+ (* odd-amp (- (* yfax (oscil (sin-odds k) odd-freq))
+ (* fax (oscil (cos-odds k) odd-freq)))))))))))
(outa i (* (env ampf) sum)))))))
;;; (pqw-vox 0 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 0) 0 '(0 L 100 L) '(.33 .33 .33) '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5)))
@@ -1065,12 +1065,12 @@ is a physical model of a flute:
(if (zero? ampdc) (set! ampdc 75))
(if (zero? indxat) (set! indxat 25))
(if (zero? indxdc) (set! indxdc 75))
- (vector-set! indfs i (make-env (stretch-envelope indxfun 25 indxat 75 indxdc) :duration dur
+ (set! (indfs i) (make-env (stretch-envelope indxfun 25 indxat 75 indxdc) :duration dur
:scaler (- dev1 dev0) :offset dev0))
- (vector-set! ampfs i (make-env (stretch-envelope ampf 25 ampat 75 ampdc) :duration dur
+ (set! (ampfs i) (make-env (stretch-envelope ampf 25 ampat 75 ampdc) :duration dur
:scaler (* rsamp amp (/ rfamp totalamp))))
- (vector-set! c-rats i harm)
- (vector-set! carriers i (make-oscil cfq))))
+ (set! (c-rats i) harm)
+ (set! (carriers i) (make-oscil cfq))))
(ws-interrupt?)
(run
(do ((i beg (+ i 1)))
@@ -1081,10 +1081,10 @@ is a physical model of a flute:
(do ((k 0 (+ 1 k)))
((= k numformants))
(set! outsum (+ outsum
- (* (env (vector-ref ampfs k))
- (oscil (vector-ref carriers k)
- (+ (* vib (vector-ref c-rats k))
- (* (env (vector-ref indfs k)) modsig)))))))
+ (* (env (ampfs k))
+ (oscil (carriers k)
+ (+ (* vib (c-rats k))
+ (* (env (indfs k)) modsig)))))))
(locsig loc i outsum))))))
@@ -1176,7 +1176,7 @@ is a physical model of a flute:
(grain (mus-data grains)))
(do ((i 0 (+ i 1)))
((= i grain-size))
- (vct-set! grain i (* (env grain-env) (oscil carrier))))
+ (set! (grain i) (* (env grain-env) (oscil carrier))))
(ws-interrupt?)
(run
(do ((i beg (+ i 1)))
@@ -1698,7 +1698,7 @@ is a physical model of a flute:
(*db-drop-per-second* -10.0))
(define (get-piano-partials freq)
- (let ((pitch (round (* 12 (/ (log (/ freq 32.703)) (log 2))))))
+ (let ((pitch (round (* 12 (log (/ freq 32.703) 2)))))
(list-ref piano-spectra pitch)))
(define (make-piano-ampfun dur)
@@ -1746,7 +1746,7 @@ is a physical model of a flute:
(j 0 (+ 1 j)))
((= i (length partials)))
(vct-set! alist j (vct-ref partials (+ i 1)))
- (vector-set! oscils j (make-oscil (* (vct-ref partials i) frequency))))
+ (set! (oscils j) (make-oscil (* (vct-ref partials i) frequency))))
(ws-interrupt?)
(run
(do ((i beg (+ i 1)))
@@ -1756,7 +1756,7 @@ is a physical model of a flute:
(do ((k 0 (+ 1 k)))
((= k siz))
(set! sum (+ sum (* (vct-ref alist k)
- (oscil (vector-ref oscils k))))))
+ (oscil (oscils k))))))
(locsig locs i (* sum
(if (> sktr env1samples)
(env ampenv2)
@@ -1928,7 +1928,7 @@ is a physical model of a flute:
(do ((i 0 (+ i 1)))
((= i max-oscils))
- (vector-set! resynth-oscils i (make-oscil 0)))
+ (set! (resynth-oscils i) (make-oscil 0)))
(set! trigger outhop)
(vct-scale! window fftscale)
(ws-interrupt?)
@@ -2084,7 +2084,7 @@ is a physical model of a flute:
(if (= ramp-ind ramped) (set! ramped 0))))
(do ((k 0 (+ 1 k)))
((= k cur-oscils))
- (set! sum (+ sum (* (vct-ref amps k) (oscil (vector-ref resynth-oscils k) (vct-ref freqs k)))))
+ (set! sum (+ sum (* (vct-ref amps k) (oscil (resynth-oscils k) (vct-ref freqs k)))))
(vct-set! amps k (+ (vct-ref amps k) (vct-ref rates k)))
(vct-set! freqs k (+ (vct-ref freqs k) (vct-ref sweeps k))))
(outa i (* amp sum))))))))
@@ -2423,15 +2423,15 @@ nil doesnt print anything, which will speed up a bit the process.
(fval (list-ref freq-list k)))
(if (list? gval)
(begin
- (vector-set! env-size k (make-env gval
- :scaler filt-gain-scale
- :duration durata :base filt-gain-base))
- (vector-set! frm-size k (make-formant fval a1)))
+ (set! (env-size k) (make-env gval
+ :scaler filt-gain-scale
+ :duration durata :base filt-gain-base))
+ (set! (frm-size k) (make-formant fval a1)))
(begin
- (vector-set! frm-size k (make-formant fval a1))
- (vct-set! gains k (if (< (+ offset-gain gval) 0)
- 0
- (+ offset-gain gval)))))))
+ (set! (frm-size k) (make-formant fval a1))
+ (set! (gains k) (if (< (+ offset-gain gval) 0)
+ 0
+ (+ offset-gain gval)))))))
(ws-interrupt?)
(run
(do ((i st (+ i 1)))
@@ -2447,9 +2447,9 @@ nil doesnt print anything, which will speed up a bit the process.
(do ((k 0 (+ 1 k)))
((= k half-list))
(if if-list-in-gain
- (vct-set! gains k (* (env (vector-ref env-size k)) (- 1.0 a1))))
- (set! outval (+ outval (* (vct-ref gains k)
- (formant (vector-ref frm-size k) inval)))))
+ (set! (gains k) (* (env (env-size k)) (- 1.0 a1))))
+ (set! outval (+ outval (* (gains k)
+ (formant (frm-size k) inval)))))
(outa i (* (env ampenv) outval)))))))
@@ -2477,7 +2477,7 @@ nil doesnt print anything, which will speed up a bit the process.
(samp 0))
(do ((ctr 0 (+ 1 ctr)))
((= ctr freq-inc))
- (vector-set! fs ctr (make-formant (* ctr bin) radius)))
+ (set! (fs ctr) (make-formant (* ctr bin) radius)))
(ws-interrupt?)
(run
(do ((i beg (+ i 1)))
@@ -2506,7 +2506,7 @@ nil doesnt print anything, which will speed up a bit the process.
(do ((ctr 1 (+ 1 ctr)))
((= ctr freq-inc))
(let ((cur-scale (vct-ref scales ctr)))
- (set! outval (+ outval (* cur-scale (formant (vector-ref fs ctr) inval))))
+ (set! outval (+ outval (* cur-scale (formant (fs ctr) inval))))
(vct-set! scales ctr (+ (vct-ref scales ctr) (vct-ref diffs ctr)))))
(outa i (* amp outval))))))))
@@ -2739,13 +2739,13 @@ mjkoskin@sci.fi
;; setup granulate generators
(do ((i 0 (+ i 1)))
((= i in-chans))
- (vector-set! ex-array i (make-granulate :input (make-readin fnam :start start :channel i)
- :expansion (if (list? expand) (cadr expand) expand)
- :max-size max-len
- :ramp (if (list? ramp) (cadr ramp) ramp)
- :hop (if (list? hop) (cadr hop) hop)
- :length (if (list? seglen) (cadr seglen) seglen)
- :scaler segment-scaler)))
+ (set! (ex-array i) (make-granulate :input (make-readin fnam :start start :channel i)
+ :expansion (if (list? expand) (cadr expand) expand)
+ :max-size max-len
+ :ramp (if (list? ramp) (cadr ramp) ramp)
+ :hop (if (list? hop) (cadr hop) hop)
+ :length (if (list? seglen) (cadr seglen) seglen)
+ :scaler segment-scaler)))
(if matrix
(begin
(do ((inp 0 (+ 1 inp)))
@@ -2758,7 +2758,7 @@ mjkoskin@sci.fi
;; split out 1 and 2 chan input
(if (= in-chans 1)
- (let ((ingen (vector-ref ex-array 0))
+ (let ((ingen (ex-array 0))
(sample-0 0.0)
(sample-1 0.0))
(run
@@ -2817,8 +2817,8 @@ mjkoskin@sci.fi
(sample-1-0 0.0)
(sample-0-1 0.0)
(sample-1-1 0.0)
- (ingen0 (vector-ref ex-array 0))
- (ingen1 (vector-ref ex-array 1)))
+ (ingen0 (ex-array 0))
+ (ingen1 (ex-array 1)))
(run
(do ((i beg (+ i 1)))
((= i end))
diff --git a/clm.c b/clm.c
index d8054ab..889253a 100644
--- a/clm.c
+++ b/clm.c
@@ -914,7 +914,7 @@ void mus_rectangular_to_polar(mus_float_t *rl, mus_float_t *im, mus_long_t size)
mus_long_t i;
for (i = 0; i < size; i++)
{
- mus_float_t temp; /* apparently floating underflows in sqrt are bringing us to a halt */
+ mus_float_t temp; /* apparently floating underflows (denormals?) in sqrt are bringing us to a halt */
temp = rl[i] * rl[i] + im[i] * im[i];
im[i] = -atan2(im[i], rl[i]); /* "-" here so that clockwise is positive? is this backwards? */
if (temp < .00000001)
diff --git a/clm23.scm b/clm23.scm
index 2069650..c50ea82 100644
--- a/clm23.scm
+++ b/clm23.scm
@@ -3,14 +3,12 @@
(provide 'snd-clm23.scm)
(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
-(if (not (provided? 'snd-snd9.scm)) (load "snd9.scm")) ; sine-bank
;;; definstrument -> define (+ change open paren placement)
;;; *srate* -> (mus-srate)
;;; run loop ... -> run (lambda () (do... + extra end close paren
-;;; floor, [round, ceiling] wrapped in inexact->exact
-;;; aref -> vct-ref
+;;; aref ->
;;; setf -> set!
;;; remove declare (or change order of args and remove ":")
;;; however in granulate run-time edit-func, the "(declare (g clm))" is necessary
@@ -30,11 +28,19 @@
;;; integerp -> integer? and others like it (null -> null?)
;;; sound-duration -> mus-sound-duration and similarly for others
;;; various array info procs like array-dimension
-;;; no length arg to sine-bank
;;; #'(lambda ...) to just (lambda...)
;;; nth -> list-ref
;;; loop -> do
+(define (clm23-sine-bank amps phases len)
+ (let ((sum 0.0))
+ (do ((i 0 (+ 1 i)))
+ ((= i len))
+ (set! sum (+ sum (* (vct-ref amps i)
+ (sin (vct-ref phases i))))))
+ sum))
+
+
(define* (make-double-array len initial-contents initial-element)
"(make-double-array len initial-contents initial-element) is for CL/Scheme compatibility; it makes a vct"
(let ((v (make-vct len (or initial-element 0.0))))
@@ -42,7 +48,7 @@
(let ((clen (min len (length initial-contents))))
(do ((i 0 (+ i 1)))
((= i clen))
- (vct-set! v i (list-ref initial-contents i)))))
+ (set! (v i) (list-ref initial-contents i)))))
v))
(define make-double-float-array make-double-array)
@@ -99,16 +105,16 @@
(start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
(arr (make-vector 3)))
- (vector-set! arr 0 os)
- (vector-set! arr 1 #f)
- (vector-set! arr 2 (make-ssb-am 660 40))
+ (set! (arr 0) os)
+ (set! (arr 1) #f)
+ (set! (arr 2) (make-ssb-am 660 40))
(run
(do ((i start (+ i 1))) ((= i end))
(let* ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i (length arr)))
- (if (ssb-am? (vector-ref arr i))
- (set! sum (+ sum (ssb-am (vector-ref arr i) 1.0)))))
+ (if (ssb-am? (arr i))
+ (set! sum (+ sum (ssb-am (arr i) 1.0)))))
(out-any i (* amp sum) 0))))))
(define (simple-multiarr beg dur freq amp)
@@ -118,15 +124,15 @@
(len (seconds->samples dur))
(end (+ start len))
(arr (make-vector 3)))
- (vector-set! arr 0 (make-oscil freq))
- (vector-set! arr 1 (make-env '(0 0 1 1) :scaler amp :duration dur))
- (vector-set! arr 2 (make-oscil (* freq 2)))
+ (set! (arr 0) (make-oscil freq))
+ (set! (arr 1) (make-env '(0 0 1 1) :scaler amp :duration dur))
+ (set! (arr 2) (make-oscil (* freq 2)))
(run
(do ((i start (+ i 1)))
((= i end))
- (out-any i (* (env (vector-ref arr 1))
- (oscil (vector-ref arr 0)
- (* .1 (oscil (vector-ref arr 2)))))
+ (out-any i (* (env (arr 1))
+ (oscil (arr 0)
+ (* .1 (oscil (arr 2)))))
0)))))
(define (simple-nsin beg dur amp)
@@ -172,14 +178,14 @@
(arr (make-vector 20)))
(do ((i 0 (+ i 1)))
((= i 20))
- (vector-set! arr i (make-oscil (* (+ i 1) 100))))
+ (set! (arr i) (make-oscil (* (+ i 1) 100))))
(run
(do ((i start (+ i 1))) ((= i end))
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i (length arr)))
- (if (oscil? (vector-ref arr i))
- (set! sum (+ sum (oscil (vector-ref arr i))))))
+ (if (oscil? (arr i))
+ (set! sum (+ sum (oscil (arr i))))))
(out-any i (* amp .05 sum) 0))))))
(define (simple-asy beg dur amp)
@@ -236,14 +242,14 @@
(freqs (make-double-array 3 :initial-element 0.0)))
(do ((i 0 (+ i 1)))
((= i 3))
- (set! (vct-ref freqs i) (double (* freq (+ i 1))))
- (set! (vct-ref amps i) (double (/ amp (+ i 2)))))
+ (set! (freqs i) (double (* freq (+ i 1))))
+ (set! (amps i) (double (/ amp (+ i 2)))))
(run
(do ((i start (+ i 1))) ((= i end))
(do ((i 0 (+ i 1)))
((= i (vct-length phases)))
- (set! (vct-ref phases i) (+ (vct-ref phases i) (hz->radians (vct-ref freqs i)))))
- (out-any i (sine-bank amps phases) 0)))))
+ (set! (phases i) (+ (phases i) (hz->radians (freqs i)))))
+ (out-any i (clm23-sine-bank amps phases 3) 0)))))
(define (simple-oz beg dur freq amp)
"(simple-oz beg dur freq amp) test instrument for one-zero"
@@ -409,7 +415,7 @@
(table (mus-data buf)))
(do ((i 0 (+ i 1)))
((= i table-size))
- (set! (vct-ref table i) (double (/ i table-size))))
+ (set! (table i) (double (/ i table-size))))
(run
(do ((i start (+ i 1))) ((= i end))
(out-any i (* amp (table-lookup buf)) 0)))))
@@ -422,8 +428,8 @@
(os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! (vct-ref (mus-xcoeffs flt) i) (double (/ i 16)))
- (set! (vct-ref (mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
+ (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
(run
(do ((i start (+ i 1))) ((= i end))
(out-any i (* amp (filter flt (oscil os))) 0)))))
@@ -436,7 +442,7 @@
(os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! (vct-ref (mus-xcoeffs flt) i) (double (/ i 16))))
+ (set! ((mus-xcoeffs flt) i) (double (/ i 16))))
(run
(do ((i start (+ i 1))) ((= i end))
(out-any i (* amp (fir-filter flt (oscil os))) 0)))))
@@ -449,7 +455,7 @@
(os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! (vct-ref (mus-ycoeffs flt) i) (double (/ i 16))))
+ (set! ((mus-ycoeffs flt) i) (double (/ i 16))))
(run
(do ((i start (+ i 1))) ((= i end))
(out-any i (* amp (iir-filter flt (oscil os))) 0)))))
@@ -529,7 +535,7 @@
(wt0 (make-wave-train :size foflen :frequency frq))
(foftab (mus-data wt0)))
(do ((i 0 (+ i 1))) ((= i foflen))
- (set! (vct-ref foftab i) (double
+ (set! (foftab i) (double
;; this is not the pulse shape used by B&R
(* (+ (* a0 (sin (* i frq0)))
(* a1 (sin (* i frq1)))
@@ -571,8 +577,8 @@
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
(filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (vct-ref filt i) (double 0.0)))
- (set! (vct-ref filt 4) (double 1.0))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
+ (set! (filt 4) (double 1.0))
(let ((ff (make-convolve :input (make-readin file) :filter filt)))
(run
(do ((i start (+ i 1))) ((= i end))
@@ -584,8 +590,8 @@
(end (+ start (seconds->samples dur)))
(rd (make-readin file))
(filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (vct-ref filt i) (double 0.0)))
- (set! (vct-ref filt 4) (double 1.0))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
+ (set! (filt 4) (double 1.0))
(let ((ff (make-convolve :filter filt)))
(run
(do ((i start (+ i 1))) ((= i end))
@@ -598,8 +604,8 @@
(end (+ start (seconds->samples dur)))
(rd (make-readin file))
(filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (vct-ref filt i) (double 0.0)))
- (set! (vct-ref filt 4) (double 1.0))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
+ (set! (filt 4) (double 1.0))
(let ((ff (make-convolve :filter filt)))
(run
(do ((i start (+ i 1))) ((= i end))
@@ -615,8 +621,8 @@
(end (+ start (seconds->samples dur)))
(rd (make-readin file))
(filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (vct-ref filt i) (double 0.0)))
- (set! (vct-ref filt 4) (double 1.0))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
+ (set! (filt 4) (double 1.0))
(let ((ff (make-convolve :filter filt))
(ff1 (make-convolve :filter filt :input (make-readin file))))
(run
@@ -841,10 +847,10 @@
(table (mus-data buf)))
(do ((i 0 (+ i 1)))
((= i table-size))
- (set! (vct-ref table i) (double (/ i table-size))))
+ (set! (table i) (double (/ i table-size))))
(run
(do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (vct-ref (mus-data buf) j) (table-lookup buf)) 0)
+ (out-any i (* amp ((mus-data buf) j) (table-lookup buf)) 0)
(set! j (+ 1 j))
(if (>= j table-size) (set! j 0))))))
@@ -856,13 +862,13 @@
(os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! (vct-ref (mus-xcoeffs flt) i) (double (/ i 16)))
- (set! (vct-ref (mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
+ (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
(run
(do ((i start (+ i 1))) ((= i end))
(out-any i (* amp
- (+ (vct-ref (mus-xcoeffs flt) 4)
- (vct-ref (mus-ycoeffs flt) 4))
+ (+ ((mus-xcoeffs flt) 4)
+ ((mus-ycoeffs flt) 4))
(filter flt (oscil os)))
0)))))
@@ -874,14 +880,14 @@
(os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! (vct-ref (mus-xcoeffs flt) i) (double (/ i 16)))
- (set! (vct-ref (mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
+ (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
(run
(do ((i start (+ i 1))) ((= i end))
- (set! (vct-ref (mus-xcoeffs flt) 0) .5)
- (set! (vct-ref (mus-ycoeffs flt) 0) .5)
+ (vct-set! (mus-xcoeffs flt) 0 .5)
+ (vct-set! (mus-ycoeffs flt) 0 .5)
(out-any i (* amp
- (+ (vct-ref (mus-xcoeffs flt) 0)
+ (+ ((mus-xcoeffs flt) 0)
(mus-ycoeff flt 0))
(filter flt (oscil os)))
0)))))
@@ -970,8 +976,8 @@
(rd (make-readin file))
(sr (make-src :srate speed))
(filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (vct-ref filt i) (double 0.0)))
- (set! (vct-ref filt 4) (double 1.0))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
+ (set! (filt 4) (double 1.0))
(let ((ff (make-convolve :filter filt)))
(run
(do ((i start (+ i 1))) ((= i end))
@@ -987,8 +993,8 @@
(rd (make-readin file))
(sr (make-src :srate speed :input rd))
(filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (vct-ref filt i) (double 0.0)))
- (set! (vct-ref filt 4) (double 1.0))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
+ (set! (filt 4) (double 1.0))
(let ((ff (make-convolve :filter filt)))
(run
(do ((i start (+ i 1))) ((= i end))
@@ -1048,17 +1054,17 @@
(set! k 0)
(do ()
((= k N2))
- (set! (vct-ref (phase-vocoder-amps sr) k)
- (+ (vct-ref (phase-vocoder-amps sr) k)
- (vct-ref (phase-vocoder-amp-increments sr) k)))
- (set! (vct-ref (phase-vocoder-phase-increments sr) k)
- (+ (vct-ref (phase-vocoder-phase-increments sr) k)
- (vct-ref (phase-vocoder-freqs sr) k)))
- (set! (vct-ref (phase-vocoder-phases sr) k)
- (+ (vct-ref (phase-vocoder-phases sr) k)
- (vct-ref (phase-vocoder-phase-increments sr) k)))
+ (vct-set! (phase-vocoder-amps sr) k
+ (+ ((phase-vocoder-amps sr) k)
+ ((phase-vocoder-amp-increments sr) k)))
+ (vct-set! (phase-vocoder-phase-increments sr) k
+ (+ ((phase-vocoder-phase-increments sr) k)
+ ((phase-vocoder-freqs sr) k)))
+ (vct-set! (phase-vocoder-phases sr) k
+ (+ ((phase-vocoder-phases sr) k)
+ ((phase-vocoder-phase-increments sr) k)))
(set! k (+ 1 k)))
- (sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))))
+ (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))))
0)))))
(define (sample-mxf beg dur freq amp)
@@ -1131,8 +1137,8 @@
(do ((k 0 (+ 1 k)))
((= k 2))
(mixer-set! nmx j k 0.0)
- (set! (mixer-ref mx1 j k) (exact->inexact (+ j k)))
- (set! (mixer-ref mx2 j k) (exact->inexact (* j k)))))
+ (set! (mixer-ref mx1 j k) (* 1.0 (+ j k)))
+ (set! (mixer-ref mx2 j k) (* 1.0 (* j k)))))
(mixer* mx1 mx2 nmx)
(if (or (> (abs (- (mixer-ref nmx 0 0) 0.0)) .001)
(> (abs (- (mixer-ref nmx 0 1) 1.0)) .001)
@@ -1161,19 +1167,19 @@
(arrfrq (make-double-array 20 :initial-element (double 0.0))))
(do ((i 0 (+ i 1)))
((= i 20))
- (set! (vct-ref arrfrq i) (double (* (+ i 1) 100.0)))
- (vector-set! arr i (make-oscil (* (+ i 1) 100))))
+ (set! (arrfrq i) (double (* (+ i 1) 100.0)))
+ (set! (arr i) (make-oscil (* (+ i 1) 100))))
(run
(do ((k start (+ 1 k))) ((= k end))
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i (length arr)))
- (if (oscil? (vector-ref arr i))
+ (if (oscil? (arr i))
(begin
- (set! (mus-frequency (vector-ref arr i)) (vct-ref arrfrq i))
- (if (> (abs (- (mus-frequency (vector-ref arr i)) (vct-ref arrfrq i))) .001)
- (clm-print "oops ~A ~A" (mus-frequency (vector-ref arr i)) (vct-ref arrfrq i)))
- (set! sum (+ sum (oscil (vector-ref arr i)))))))
+ (set! (mus-frequency (arr i)) (arrfrq i))
+ (if (> (abs (- (mus-frequency (arr i)) (arrfrq i))) .001)
+ (clm-print "oops ~A ~A" (mus-frequency (arr i)) (arrfrq i)))
+ (set! sum (+ sum (oscil (arr i)))))))
(out-any k (* amp .05 sum) 0))))))
(define (sample-ardcl beg dur freq amp)
@@ -1186,18 +1192,18 @@
(ints (make-vector 3 32)))
(do ((i 0 (+ i 1)))
((= i 3))
- (set! (vct-ref freqs i) (double (* freq (+ i 1))))
- (set! (vct-ref amps i) (double (/ amp (+ i 2)))))
+ (set! (freqs i) (double (* freq (+ i 1))))
+ (set! (amps i) (double (/ amp (+ i 2)))))
(run
(do ((i start (+ i 1))) ((= i end))
(do ((i 0 (+ i 1)))
((= i (vct-length phases)))
- (set! (vct-ref phases i) (+ (vct-ref phases i) (hz->radians (vct-ref freqs i)))))
- (if (not (= (vector-ref ints 0) 32)) (clm-print "int array trouble"))
- (vector-set! ints 1 3)
- (if (not (= (vector-ref ints 1) 3)) (clm-print "set int array trouble"))
+ (set! (phases i) (+ (phases i) (hz->radians (freqs i)))))
+ (if (not (= (ints 0) 32)) (clm-print "int array trouble"))
+ (set! (ints 1) 3)
+ (if (not (= (ints 1) 3)) (clm-print "set int array trouble"))
(if (not (= (length amps) 3)) (clm-print "amps len: ~A" (length amps)))
- (out-any i (sine-bank amps phases) 0)))))
+ (out-any i (clm23-sine-bank amps phases 3) 0)))))
(define (sample-strs beg dur freq amp)
"(sample-strs beg dur freq amp) test instrument for strings"
@@ -1234,20 +1240,20 @@
(os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! (vct-ref (mus-xcoeffs flt) i) (double (/ i 16)))
- (set! (vct-ref (mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
+ (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
(run
(do ((i start (+ i 1))) ((= i end))
(let ((xs (mus-xcoeffs flt)))
- (if (or (> (abs (- (vct-ref xs 1) (mus-xcoeff flt 1))) .001)
- (> (abs (- (vct-ref xs 1) 0.0625)) .001))
- (clm-print "~A ~A~%" (vct-ref xs 1) (mus-xcoeff flt 1))))
+ (if (or (> (abs (- (xs 1) (mus-xcoeff flt 1))) .001)
+ (> (abs (- (xs 1) 0.0625)) .001))
+ (clm-print "~A ~A~%" (xs 1) (mus-xcoeff flt 1))))
(let ((data (mus-data flt)))
- (if (> (vct-ref data 0) 1.0) (clm-print "data overflow? ~A~%" (vct-ref data 0))))
+ (if (> (data 0) 1.0) (clm-print "data overflow? ~A~%" (data 0))))
(let ((is intdat)
(fs fltdat))
- (if (not (= (vct-ref is 1) 3)) (clm-print "intdat let: ~A~%" (vct-ref is 1)))
- (if (> (abs (- (vct-ref fs 1) 3.14)) .001) (clm-print "fltdat let: ~A~%" (vct-ref fs 1))))
+ (if (not (= (is 1) 3)) (clm-print "intdat let: ~A~%" (is 1)))
+ (if (> (abs (- (fs 1) 3.14)) .001) (clm-print "fltdat let: ~A~%" (fs 1))))
(out-any i (* amp (filter flt (oscil os))) 0)))))
(define (sample-arrintp beg dur freq amp)
@@ -1262,7 +1268,7 @@
(do ((i 0 (+ i 1))
(x 0.0 (+ x .01)))
((= i 100))
- (set! (vct-ref arr i) (double x)))
+ (set! (arr i) (double x)))
(run
(do ((i start (+ i 1))) ((= i end))
(out-any i (* amp (array-interp arr loc) (oscil os)) 0)
@@ -1347,15 +1353,15 @@
(dir 1))
(do ((i 0 (+ i 1)))
((= i 100))
- (set! (vct-ref arr i) (double (* amp (+ -.5 (* i .01))))))
+ (set! (arr i) (double (* amp (+ -.5 (* i .01))))))
(array->file "testx.data" arr 100 22050 1)
(do ((i 0 (+ i 1)))
((= i 100))
- (set! (vct-ref arr i) (double 0.0)))
+ (set! (arr i) (double 0.0)))
(file->array "testx.data" 0 0 100 arr)
(run
(do ((i start (+ i 1))) ((= i end))
- (out-any i (* (vct-ref arr ctr) (oscil os)) 0)
+ (out-any i (* (arr ctr) (oscil os)) 0)
(set! ctr (+ ctr dir))
(if (>= ctr 99) (set! dir -1)
(if (<= ctr 0) (set! dir 1)))))))
@@ -1422,7 +1428,7 @@
(len (length g))) ; current grain length
(do ((i 0 (+ i 1)))
((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 2 (vct-ref grain i)))))
+ (set! (grain i) (* 2 (grain i)))))
0)))
0)))))
@@ -1579,16 +1585,16 @@
#f
#f
(lambda (closure)
- (let ((N2 (inexact->exact (/ size 2))))
+ (let ((N2 (floor (/ size 2))))
(do ((k 0 (+ 1 k)))
((= k N2))
- (set! (vct-ref (phase-vocoder-amps sr) k) (+ (vct-ref (phase-vocoder-amps sr) k)
- (vct-ref (phase-vocoder-amp-increments sr) k)))
- (set! (vct-ref (phase-vocoder-phase-increments sr) k) (+ (vct-ref (phase-vocoder-phase-increments sr) k)
- (vct-ref (phase-vocoder-freqs sr) k)))
- (set! (vct-ref (phase-vocoder-phases sr) k) (+ (vct-ref (phase-vocoder-phases sr) k)
- (vct-ref (phase-vocoder-phase-increments sr) k))))
- (sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2)))
+ (vct-set! (phase-vocoder-amps sr) k (+ ((phase-vocoder-amps sr) k)
+ ((phase-vocoder-amp-increments sr) k)))
+ (vct-set! (phase-vocoder-phase-increments sr) k (+ ((phase-vocoder-phase-increments sr) k)
+ ((phase-vocoder-freqs sr) k)))
+ (vct-set! (phase-vocoder-phases sr) k (+ ((phase-vocoder-phases sr) k)
+ ((phase-vocoder-phase-increments sr) k))))
+ (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2)))
))
0)))))
@@ -1606,11 +1612,10 @@
(end (+ start (seconds->samples dur)))
(rd (make-readin file))
(sr (make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4))
- (N2 (inexact->exact (/ size 2)))
+ (N2 (floor (/ size 2)))
(lastphases (make-vct N2 0.0))
(two-pi (* 2 pi)))
(run
- (declare (n2 integer))
(do ((i start (+ i 1))) ((= i end))
(out-any i
(* amp
@@ -1618,29 +1623,29 @@
(lambda (dir) (readin rd))
#f
(lambda (closure)
- (let* ((D (inexact->exact (/ size 4))) ; overlap = 4
+ (let* ((D (floor (/ size 4))) ; overlap = 4
(pscl (/ 1.0 D))
(kscl (/ two-pi size)))
(do ((k 0 (+ 1 k))
(ks 0.0 (+ ks kscl)))
((= k N2))
- (let* ((freq (vct-ref (phase-vocoder-freqs sr) k))
- (diff (- freq (vct-ref lastphases k))))
- (vct-set! lastphases k freq)
+ (let* ((freq ((phase-vocoder-freqs sr) k))
+ (diff (- freq (lastphases k))))
+ (set! (lastphases k) freq)
(if (> diff pi) (set! diff (- diff two-pi)))
(if (< diff (- pi)) (set! diff (+ diff two-pi)))
- (vct-set! (phase-vocoder-freqs sr) k (+ (* diff pscl) ks))))
+ (set! ((phase-vocoder-freqs sr) k) (+ (* diff pscl) ks))))
#f))
(lambda (closure)
(do ((k 0 (+ 1 k)))
((= k N2))
- (set! (vct-ref (phase-vocoder-amps sr) k) (+ (vct-ref (phase-vocoder-amps sr) k)
- (vct-ref (phase-vocoder-amp-increments sr) k)))
- (set! (vct-ref (phase-vocoder-phase-increments sr) k) (+ (vct-ref (phase-vocoder-phase-increments sr) k)
- (vct-ref (phase-vocoder-freqs sr) k)))
- (set! (vct-ref (phase-vocoder-phases sr) k) (+ (vct-ref (phase-vocoder-phases sr) k)
- (vct-ref (phase-vocoder-phase-increments sr) k))))
- (sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))
+ (vct-set! (phase-vocoder-amps sr) k (+ ((phase-vocoder-amps sr) k)
+ ((phase-vocoder-amp-increments sr) k)))
+ (vct-set! (phase-vocoder-phase-increments sr) k (+ ((phase-vocoder-phase-increments sr) k)
+ ((phase-vocoder-freqs sr) k)))
+ (vct-set! (phase-vocoder-phases sr) k (+ ((phase-vocoder-phases sr) k)
+ ((phase-vocoder-phase-increments sr) k))))
+ (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))
))
0)))))
@@ -1657,16 +1662,15 @@
(end (+ start (seconds->samples dur)))
(rd (make-readin file))
(sr (make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4))
- (N2 (inexact->exact (/ size 2)))
+ (N2 (floor (/ size 2)))
(lastphases (make-vct N2 0.0))
(in-data (make-vct size 0.0))
(two-pi (* 2 pi))
(filptr 0)
(window (make-fft-window hamming-window size 0.0))
- (D (inexact->exact (/ size 4)))) ; overlap = 4
+ (D (floor (/ size 4)))) ; overlap = 4
(vct-scale! window (/ 2.0 (* 0.54 size)))
(run
- (declare (n2 integer) (D integer))
(do ((i start (+ i 1))) ((= i end))
(out-any i
(* amp
@@ -1679,18 +1683,18 @@
(if (= filptr 0)
(do ((k 0 (+ 1 k)))
((= k size))
- (vct-set! in-data k (readin rd)))
+ (set! (in-data k) (readin rd)))
(begin
(do ((k 0 (+ 1 k))
(j D (+ 1 j)))
((= j size))
- (vct-set! in-data k (vct-ref in-data j)))
+ (set! (in-data k) (in-data j)))
(do ((k (- size D) (+ 1 k)))
((= k size))
- (vct-set! in-data k (readin rd)))))
+ (set! (in-data k) (readin rd)))))
(do ((k 0 (+ 1 k)))
((= k size))
- (vct-set! (phase-vocoder-amp-increments sr) buf (* (vct-ref in-data k) (vct-ref window k)))
+ (vct-set! (phase-vocoder-amp-increments sr) buf (* (in-data k) (window k)))
(set! buf (+ 1 buf))
(if (>= buf size) (set! buf 0)))
(set! filptr (+ filptr D))
@@ -1704,9 +1708,9 @@
(do ((k 0 (+ 1 k))
(ks 0.0 (+ ks kscl)))
((= k N2))
- (let* ((freq (vct-ref (phase-vocoder-freqs sr) k))
- (diff (- freq (vct-ref lastphases k))))
- (vct-set! lastphases k freq)
+ (let* ((freq ((phase-vocoder-freqs sr) k))
+ (diff (- freq (lastphases k))))
+ (set! (lastphases k) freq)
(if (> diff pi) (set! diff (- diff two-pi)))
(if (< diff (- pi)) (set! diff (+ diff two-pi)))
(vct-set! (phase-vocoder-freqs sr) k (+ (* diff pscl) ks))))
@@ -1715,13 +1719,13 @@
(lambda (closure)
(do ((k 0 (+ 1 k)))
((= k N2))
- (set! (vct-ref (phase-vocoder-amps sr) k) (+ (vct-ref (phase-vocoder-amps sr) k)
- (vct-ref (phase-vocoder-amp-increments sr) k)))
- (set! (vct-ref (phase-vocoder-phase-increments sr) k) (+ (vct-ref (phase-vocoder-phase-increments sr) k)
- (vct-ref (phase-vocoder-freqs sr) k)))
- (set! (vct-ref (phase-vocoder-phases sr) k) (+ (vct-ref (phase-vocoder-phases sr) k)
- (vct-ref (phase-vocoder-phase-increments sr) k))))
- (sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))
+ (vct-set! (phase-vocoder-amps sr) k (+ ((phase-vocoder-amps sr) k)
+ ((phase-vocoder-amp-increments sr) k)))
+ (vct-set! (phase-vocoder-phase-increments sr) k (+ ((phase-vocoder-phase-increments sr) k)
+ ((phase-vocoder-freqs sr) k)))
+ (vct-set! (phase-vocoder-phases sr) k (+ ((phase-vocoder-phases sr) k)
+ ((phase-vocoder-phase-increments sr) k))))
+ (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))
))
0)))))
@@ -1815,20 +1819,20 @@
(cond (e1 (set! ok1 (+ ok1 (env e1))))
(#t (clm-print ";or3 1~%")))
(if (or f1 f2)
- (set! ok1 (+ ok1 (vector-ref f2 0)))
+ (set! ok1 (+ ok1 (f2 0)))
(clm-print ";or3 a~%"))
(if (not (or f2 f1))
(clm-print ";or3 2~%"))
(if (and f2 f1)
- (set! ok1 (+ ok1 (vct-ref f1 1)))
+ (set! ok1 (+ ok1 (f1 1)))
(clm-print ";or3 b~%"))
(if (or i1 i2)
- (set! oki (+ oki (vector-ref i2 0)))
+ (set! oki (+ oki (i2 0)))
(clm-print ";or3 d~%"))
(if (not (or i2 i1))
(clm-print ";or3 3~%"))
(if (and i2 i1)
- (set! oki (+ oki (vector-ref i1 1)))
+ (set! oki (+ oki (i1 1)))
(clm-print ";or3 e~%"))))))
(define (or4)
@@ -1970,15 +1974,15 @@
(fm-indices (make-vct n)))
(do ((i 0 (+ i 1)))
((= i n))
- (vector-set! modulators i (make-oscil (* freq (list-ref mc-ratios i)) (list-ref mod-phases i)))
- (vct-set! fm-indices i (hz->radians (* freq (list-ref indexes i) (list-ref mc-ratios i)))))
+ (set! (modulators i) (make-oscil (* freq (list-ref mc-ratios i)) (list-ref mod-phases i)))
+ (set! (fm-indices i) (hz->radians (* freq (list-ref indexes i) (list-ref mc-ratios i)))))
(run
(do ((i start (+ i 1)))
((= i end))
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k n))
- (set! sum (+ sum (* (vct-ref fm-indices k) (oscil (vector-ref modulators k))))))
+ (set! sum (+ sum (* (fm-indices k) (oscil (modulators k))))))
(outa i (* amp (oscil cr sum))))))))
(define (fmdoc-violin beg dur frequency amplitude fm-index)
@@ -2052,12 +2056,12 @@
(ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02))))
(do ((i 0 (+ i 1)))
((= i 3))
- (vector-set! evens i (make-oscil 0))
- (vector-set! odds i (make-oscil 0)))
+ (set! (evens i) (make-oscil 0))
+ (set! (odds i) (make-oscil 0)))
- (vector-set! frmfs 0 (make-env '(0 520 100 490) :duration dur))
- (vector-set! frmfs 1 (make-env '(0 1190 100 1350) :duration dur))
- (vector-set! frmfs 2 (make-env '(0 2390 100 1690) :duration dur))
+ (set! (frmfs 0) (make-env '(0 520 100 490) :duration dur))
+ (set! (frmfs 1) (make-env '(0 1190 100 1350) :duration dur))
+ (set! (frmfs 2) (make-env '(0 2390 100 1690) :duration dur))
(run
(do ((i start (+ i 1)))
@@ -2067,9 +2071,9 @@
(sum 0.0))
(do ((k 0 (+ 1 k)))
((= k 3))
- (let* ((frm (env (vector-ref frmfs k)))
+ (let* ((frm (env (frmfs k)))
(frm0 (/ frm frq))
- (frm-int (inexact->exact (floor frm0)))
+ (frm-int (floor frm0))
(even-amp 0.0) (odd-amp 0.0)
(even-freq 0.0) (odd-freq 0.0))
(if (even? frm-int)
@@ -2083,13 +2087,13 @@
(set! even-freq (hz->radians (* (+ frm-int 1) frq)))
(set! even-amp (- frm0 frm-int))
(set! odd-amp (- 1.0 even-amp))))
- (set! sum (+ sum (+ (* (vct-ref amps k)
+ (set! sum (+ sum (+ (* (amps k)
(+ (* even-amp
- (oscil (vector-ref evens k)
- (+ even-freq (* (vct-ref indices k) car))))
+ (oscil (evens k)
+ (+ even-freq (* (indices k) car))))
(* odd-amp
- (oscil (vector-ref odds k)
- (+ odd-freq (* (vct-ref indices k) car)))))))))))
+ (oscil (odds k)
+ (+ odd-freq (* (indices k) car)))))))))))
(outa i (* (env ampf) sum)))))))
;;; --------------------------------------------------------------------------------
@@ -2153,12 +2157,12 @@
(define (make-my-oscil frequency) ; we want our own oscil!
(vct 0.0 (hz->radians frequency))) ; current phase and frequency-based phase increment
-(define (my-oscil gen fm) ; the corresponding generator
- (let ((result (sin (vct-ref gen 0)))) ; return sin(current-phase)
- (vct-set! gen 0 (+ (vct-ref gen 0) ; increment current phase
- (vct-ref gen 1) ; by frequency
- fm)) ; and FM
- result)) ; return sine wave
+(define (my-oscil gen fm) ; the corresponding generator
+ (let ((result (sin (gen 0)))) ; return sin(current-phase)
+ (set! (gen 0) (+ (gen 0) ; increment current phase
+ (gen 1) ; by frequency
+ fm)) ; and FM
+ result)) ; return sine wave
(define (sndclmdoc-simp-5 start end freq amp frq-env)
(let ((os (make-oscil freq))
@@ -2186,14 +2190,14 @@
(arr (make-vector 20))) ; we'll create a tone with 20 equal amplitude harmonics
(do ((i 0 (+ i 1))) ; use the 'f' button to check out the spectrum
((= i 20))
- (vector-set! arr i (make-oscil (* (+ i 1) freq))))
+ (set! (arr i) (make-oscil (* (+ i 1) freq))))
(run
(do ((i start (+ i 1)))
((= i end))
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k 20))
- (set! sum (+ sum (oscil (vector-ref arr k)))))
+ (set! sum (+ sum (oscil (arr k)))))
(out-any i (* amp .05 sum) 0))))))
(definstrument (sndclmdoc-mapenv beg dur frq amp en)
@@ -2314,7 +2318,7 @@
(* index (triangle-wave modulator)))))))))
(define* (sndclmdoc-make-sinc-train (frequency 440.0) (width #f))
- (let ((range (or width (* pi (- (* 2 (inexact->exact (floor (/ (mus-srate) (* 2.2 frequency))))) 1)))))
+ (let ((range (or width (* pi (- (* 2 (floor (/ (mus-srate) (* 2.2 frequency)))) 1)))))
;; 2.2 leaves a bit of space before srate/2, (* 3 pi) is the minimum width, normally
(list (- (* range 0.5))
range
@@ -2333,19 +2337,19 @@
val))
(define (sndclmdoc-make-sum-of-odd-sines frequency n)
- (vct 0.0 (hz->radians frequency) (exact->inexact n)))
+ (vct 0.0 (hz->radians frequency) (* 1.0 n)))
(define (sndclmdoc-sum-of-odd-sines gen fm)
- (let* ((angle (vct-ref gen 0))
+ (let* ((angle (gen 0))
(a2 (* angle 0.5))
- (n (vct-ref gen 2))
+ (n (gen 2))
(den (* n (sin a2)))
(result (if (< (abs den) 1.0e-9)
0.0
(/ (* (sin (* n a2))
(sin (* (+ 1 n) a2)))
den))))
- (vct-set! gen 0 (+ (vct-ref gen 0) (vct-ref gen 1) fm))
+ (set! (gen 0) (+ (gen 0) (gen 1) fm))
result))
(definstrument (sndclmdoc-shift-pitch beg dur file freq (order 40))
@@ -2370,8 +2374,8 @@
((> i pairs))
(let* ((aff (* i old-freq))
(bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (vector-set! ssbs (- i 1) (make-ssb-am (* i factor old-freq)))
- (vector-set! bands (- i 1) (make-bandpass (hz->radians (- aff bwf))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf))
(hz->radians (+ aff bwf))
order))))
(run
@@ -2381,8 +2385,8 @@
(y (readin rd)))
(do ((band 0 (+ 1 band)))
((= band pairs))
- (set! sum (+ sum (ssb-am (vector-ref ssbs band)
- (bandpass (vector-ref bands band) y)))))
+ (set! sum (+ sum (ssb-am (ssbs band)
+ (bandpass (bands band) y)))))
(outa i (* amp sum)))))))
(definstrument (sndclmdoc-fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae)
@@ -2400,7 +2404,7 @@
(wt0 (make-wave-train :wave foftab :frequency frq)))
(do ((i 0 (+ i 1)))
((= i foflen))
- (set! (vct-ref foftab i) ;; this is not the pulse shape used by B&R
+ (set! (foftab i) ;; this is not the pulse shape used by B&R
(* (+ (* a0 (sin (* i frq0)))
(* a1 (sin (* i frq1)))
(* a2 (sin (* i frq2))))
@@ -2486,7 +2490,7 @@
(definstrument (sndclmdoc-granulate-sound file beg dur (orig-beg 0.0) (exp-amt 1.0))
(let* ((f-srate (srate file))
- (f-start (inexact->exact (round (* f-srate orig-beg))))
+ (f-start (round (* f-srate orig-beg)))
(f (make-readin file :start f-start))
(st (seconds->samples beg))
(new-dur (or dur (- (mus-sound-duration file) orig-beg)))
@@ -2628,15 +2632,15 @@
(outa i (* (env ampf) (wave-train grains gliss)))
(let ((click (pulse-train click-track gliss)))
(if (> click 0.0)
- (let* ((scaler (max 0.1 (exact->inexact (/ (- i beg) len))))
+ (let* ((scaler (max 0.1 (* 1.0 (/ (- i beg) len))))
(comb-len 32)
(c1 (make-comb scaler comb-len))
- (c2 (make-comb scaler (inexact->exact (floor (* comb-len .75)))))
- (c3 (make-comb scaler (inexact->exact (floor (* comb-len 1.25))))))
+ (c2 (make-comb scaler (floor (* comb-len .75))))
+ (c3 (make-comb scaler (floor (* comb-len 1.25)))))
(do ((k 0 (+ 1 k)))
((= k grain-size))
- (let ((x (vct-ref original-grain k)))
- (vct-set! grain k (+ (comb c1 x) (comb c2 x) (comb c3 x))))))))))))))
+ (let ((x (original-grain k)))
+ (set! (grain k) (+ (comb c1 x) (comb c2 x) (comb c3 x))))))))))))))
(definstrument (move-formants start file amp radius move-env num-formants)
(let* ((frms (make-vector num-formants))
@@ -2648,7 +2652,7 @@
(let ((start-frq (env menv)))
(do ((i 0 (+ i 1)))
((= i num-formants))
- (vector-set! frms i (make-formant (* (+ i 1) start-frq) radius))))
+ (set! (frms i) (make-formant (* (+ i 1) start-frq) radius))))
(run
(do ((k beg (+ 1 k)))
((= k end))
@@ -2657,10 +2661,10 @@
(frq (env menv)))
(do ((i 0 (+ i 1)))
((= i num-formants))
- (set! sum (+ sum (formant (vector-ref frms i) x)))
+ (set! sum (+ sum (formant (frms i) x)))
(let ((curfrq (* (+ i 1) frq)))
(if (< (* 2 curfrq) (mus-srate))
- (set! (mus-frequency (vector-ref frms i)) curfrq))))
+ (set! (mus-frequency (frms i)) curfrq))))
(outa k (* amp sum)))))))
(define (test-filter flt)
@@ -2684,14 +2688,14 @@
(rd (make-readin file)))
(do ((k 0 (+ 1 k)))
((= k num-combs0))
- (vector-set! cmbs0 k
- (make-comb scaler
- (inexact->exact (floor (* comb-len (list-ref combs0 k)))))))
+ (set! (cmbs0 k)
+ (make-comb scaler
+ (floor (* comb-len (list-ref combs0 k))))))
(do ((k 0 (+ 1 k)))
((= k num-combs1))
- (vector-set! cmbs1 k
- (make-comb scaler
- (inexact->exact (floor (* comb-len (list-ref combs1 k)))))))
+ (set! (cmbs1 k)
+ (make-comb scaler
+ (floor (* comb-len (list-ref combs1 k))))))
(run
(do ((i beg (+ i 1)))
((= i end))
@@ -2701,10 +2705,10 @@
(x (readin rd)))
(do ((k 0 (+ 1 k)))
((= k num-combs0))
- (set! sum0 (+ sum0 (comb (vector-ref cmbs0 k) x))))
+ (set! sum0 (+ sum0 (comb (cmbs0 k) x))))
(do ((k 0 (+ 1 k)))
((= k num-combs1))
- (set! sum1 (+ sum1 (comb (vector-ref cmbs1 k) x))))
+ (set! sum1 (+ sum1 (comb (cmbs1 k) x))))
(outa i (+ (* interp sum0) (* (- 1.0 interp) sum1))))))))
@@ -2970,7 +2974,7 @@
(let ((sig (* .5 (oscil osc))))
(locsig loc j sig)
(set! j (+ 1 j))))
- (move-locsig loc (exact->inexact i) 1.0))))))
+ (move-locsig loc (* 1.0 i) 1.0))))))
(with-sound (:channels 4) (sndclmdoc-simple-dloc 0 2 440 .5))
(with-sound () (when? 0 4 2.0 8.0 "1a.snd"))
(with-sound ()
diff --git a/clm2xen.c b/clm2xen.c
index 110df98..60b9c45 100644
--- a/clm2xen.c
+++ b/clm2xen.c
@@ -2698,14 +2698,14 @@ static XEN g_mus_rand_seed(void)
#define H_mus_rand_seed "(" S_mus_rand_seed "): the random number seed; \
this can be used to re-run a particular random number sequence."
- return(C_TO_XEN_ULONG(mus_rand_seed()));
+ return(C_TO_XEN_INT(mus_rand_seed()));
}
static XEN g_mus_set_rand_seed(XEN a)
{
- XEN_ASSERT_TYPE(XEN_ULONG_P(a), a, XEN_ONLY_ARG, S_setB S_mus_rand_seed, "an unsigned integer");
- mus_set_rand_seed(XEN_TO_C_ULONG(a));
+ XEN_ASSERT_TYPE(XEN_INTEGER_P(a), a, XEN_ONLY_ARG, S_setB S_mus_rand_seed, "an integer");
+ mus_set_rand_seed((unsigned long)XEN_TO_C_INT(a));
return(a);
}
@@ -5446,7 +5446,7 @@ static XEN g_in_any_1(const char *caller, XEN frame, int in_chan, XEN inp)
if (XEN_VECTOR_P(inp))
{
if (pos < XEN_VECTOR_LENGTH(inp))
- return(XEN_VECTOR_REF(inp, pos)); /* TODO: doc/test vector in-any, and add chan arg if s7 and multidim vects */
+ return(XEN_VECTOR_REF(inp, pos));
}
return(C_TO_XEN_DOUBLE(0.0));
diff --git a/configure b/configure
index c2f8aa5..730269c 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.65 for snd 11.5.
+# Generated by GNU Autoconf 2.65 for snd 11.6.
#
# Report bugs to <bil@ccrma.stanford.edu>.
#
@@ -552,8 +552,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='snd'
PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-11.tar.gz'
-PACKAGE_VERSION='11.5'
-PACKAGE_STRING='snd 11.5'
+PACKAGE_VERSION='11.6'
+PACKAGE_STRING='snd 11.6'
PACKAGE_BUGREPORT='bil@ccrma.stanford.edu'
PACKAGE_URL=''
@@ -749,6 +749,7 @@ with_gmp
with_s7
with_extension_language
with_directfb
+with_audio
with_sample_width
with_motif_prefix
with_temp_dir
@@ -1319,7 +1320,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures snd 11.5 to adapt to many kinds of systems.
+\`configure' configures snd 11.6 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1389,7 +1390,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of snd 11.5:";;
+ short | recursive ) echo "Configuration of snd 11.6:";;
esac
cat <<\_ACEOF
@@ -1438,6 +1439,7 @@ Optional Packages:
--with-s7 use S7, default=yes
--with-extension-language use some extension language, default=yes
--with-directfb use directfb config scripts, rather than gtk, default=no
+ --without-audio don't include any audio functionality
--with-sample-width=N use N bits of samples
--with-motif-prefix=PFX where Motif is installed
--with-temp-dir directory to use for temp files
@@ -1529,7 +1531,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-snd configure 11.5
+snd configure 11.6
generated by GNU Autoconf 2.65
Copyright (C) 2009 Free Software Foundation, Inc.
@@ -2246,7 +2248,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by snd $as_me 11.5, which was
+It was created by snd $as_me 11.6, which was
generated by GNU Autoconf 2.65. Invocation command line was
$ $0 $@
@@ -3968,7 +3970,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
-VERSION=11.5
+VERSION=11.6
cat >>confdefs.h <<_ACEOF
#define SND_PACKAGE "$PACKAGE"
_ACEOF
@@ -3994,6 +3996,7 @@ _ACEOF
# --with-oss use OSS
# --with-jack use Jack
# --with-static-alsa use ALSA statically loaded (for RPM generation)
+# --without-audio stub out all audio
# --with-snd-as-widget make Snd a loadable widget, not a standalone program
# --with-doubles use doubles throughout (default is floats)
# --with-float-samples represent samples internally as floats or doubles (default=yes)
@@ -4232,6 +4235,12 @@ if test "${with_directfb+set}" = set; then :
fi
+# Check whether --with-audio was given.
+if test "${with_audio+set}" = set; then :
+ withval=$with_audio;
+fi
+
+
# -------- internal sample data type --------
@@ -7997,7 +8006,236 @@ fi
if test "$with_gtk" = yes ; then
- pkg_config_args=gtk+-2.0
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gtk+-3.0 --exists ; then
+
+ pkg_config_args=gtk+-3.0
+ for module in .
+ do
+ case "$module" in
+ gthread)
+ pkg_config_args="$pkg_config_args gthread-3.0"
+ ;;
+ esac
+ done
+
+ no_gtk=""
+
+ # Extract the first word of "pkg-config", so it can be a program name with args.
+set dummy pkg-config; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ case $PKG_CONFIG in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+ test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
+ ;;
+esac
+fi
+PKG_CONFIG=$ac_cv_path_PKG_CONFIG
+if test -n "$PKG_CONFIG"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
+$as_echo "$PKG_CONFIG" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+
+ if test x$PKG_CONFIG != xno ; then
+ if pkg-config --atleast-pkgconfig-version 0.7 ; then
+ :
+ else
+ echo *** pkg-config too old; version 0.7 or better required.
+ no_gtk=yes
+ PKG_CONFIG=no
+ fi
+ else
+ no_gtk=yes
+ fi
+
+ min_gtk_version=2.90.0
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTK+ - version >= $min_gtk_version" >&5
+$as_echo_n "checking for GTK+ - version >= $min_gtk_version... " >&6; }
+
+ if test x$PKG_CONFIG != xno ; then
+ ## don't try to run the test against uninstalled libtool libs
+ if $PKG_CONFIG --uninstalled $pkg_config_args; then
+ echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
+ fi
+
+ if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
+ :
+ else
+ no_gtk=yes
+ fi
+ fi
+
+ if test x"$no_gtk" = x ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
+ GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
+ gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
+ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\1/'`
+ gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
+ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\2/'`
+ gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
+ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\3/'`
+
+ with_gtk=yes
+
+
+
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&5
+$as_echo "$as_me: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&2;}
+ with_gtk=no
+
+ fi
+
+ else
+
+
+ pkg_config_args=gtk+-2.0
+ for module in .
+ do
+ case "$module" in
+ gthread)
+ pkg_config_args="$pkg_config_args gthread-2.0"
+ ;;
+ esac
+ done
+
+ no_gtk=""
+
+ # Extract the first word of "pkg-config", so it can be a program name with args.
+set dummy pkg-config; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ case $PKG_CONFIG in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+ test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
+ ;;
+esac
+fi
+PKG_CONFIG=$ac_cv_path_PKG_CONFIG
+if test -n "$PKG_CONFIG"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
+$as_echo "$PKG_CONFIG" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+
+ if test x$PKG_CONFIG != xno ; then
+ if pkg-config --atleast-pkgconfig-version 0.7 ; then
+ :
+ else
+ echo *** pkg-config too old; version 0.7 or better required.
+ no_gtk=yes
+ PKG_CONFIG=no
+ fi
+ else
+ no_gtk=yes
+ fi
+
+ min_gtk_version=2.0.0
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTK+ - version >= $min_gtk_version" >&5
+$as_echo_n "checking for GTK+ - version >= $min_gtk_version... " >&6; }
+
+ if test x$PKG_CONFIG != xno ; then
+ ## don't try to run the test against uninstalled libtool libs
+ if $PKG_CONFIG --uninstalled $pkg_config_args; then
+ echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
+ fi
+
+ if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
+ :
+ else
+ no_gtk=yes
+ fi
+ fi
+
+ if test x"$no_gtk" = x ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
+ GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
+ gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
+ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\1/'`
+ gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
+ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\2/'`
+ gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
+ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\3/'`
+
+ with_gtk=yes
+
+
+
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&5
+$as_echo "$as_me: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&2;}
+ with_gtk=no
+
+ fi
+
+ fi
+
+ else
+
+
+ pkg_config_args=gtk+-2.0
for module in .
do
case "$module" in
@@ -8092,7 +8330,7 @@ $as_echo "yes" >&6; }
gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\3/'`
- with_gtk=yes
+ with_gtk=yes
@@ -8100,12 +8338,14 @@ $as_echo "yes" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&5
$as_echo "$as_me: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&2;}
- with_gtk=no
+ with_gtk=no
fi
+ fi
+
if test "$with_gtk" = yes ; then
GX_FILES="G_O_FILES"
GX_HEADERS="SND_G_HEADERS"
@@ -8125,10 +8365,18 @@ $as_echo "$as_me: WARNING: trouble with gtk -- will try to make Snd without any
GTK_LD_LIBS="$GTK_LIBS"
if test x$PKG_CONFIG != xno ; then
- if test "$with_directfb" = yes ; then
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-2.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-2.0 --libs-only-l`"
+ if $PKG_CONFIG gtk+-3.0 --exists ; then
+ if test "$with_directfb" = yes ; then
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-3.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-3.0 --libs-only-l`"
+ else
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-3.0 --libs-only-L` `$PKG_CONFIG gtk+-3.0 --libs-only-l`"
+ fi
else
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
+ if test "$with_directfb" = yes ; then
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-2.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-2.0 --libs-only-l`"
+ else
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
+ fi
fi
pango_version="`$PKG_CONFIG pango --modversion`"
cat >>confdefs.h <<_ACEOF
@@ -9313,6 +9561,48 @@ if test "x$ac_cv_lib_m_gtk_entry_get_text_window" = x""yes; then :
fi
+ # for 2.90
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_scale_new in -lm" >&5
+$as_echo_n "checking for gtk_scale_new in -lm... " >&6; }
+if test "${ac_cv_lib_m_gtk_scale_new+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm $GTK_LIBS $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char gtk_scale_new ();
+int
+main ()
+{
+return gtk_scale_new ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_m_gtk_scale_new=yes
+else
+ ac_cv_lib_m_gtk_scale_new=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_scale_new" >&5
+$as_echo "$ac_cv_lib_m_gtk_scale_new" >&6; }
+if test "x$ac_cv_lib_m_gtk_scale_new" = x""yes; then :
+ $as_echo "#define HAVE_GTK_SCALE_NEW 1" >>confdefs.h
+
+fi
+
# for gdk|pango_cairo
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gdk_cairo_create in -lm" >&5
@@ -10359,6 +10649,9 @@ SO_LD="ld"
JACK_LIBS=""
JACK_FLAGS=""
+
+if test "$with_audio" != no ; then
+
# we need the sndlib.h equivalents to try to find the native sound support (see config.guess)
# this only matters for those cases where we've implemented the audio code in audio.c
# test for ALSA courtesy of Paul Davis
@@ -10803,6 +11096,8 @@ $as_echo "$alsa_ok" >&6; }
$as_echo "#define HAVE_OSS 1" >>confdefs.h
+ JACK_LIBS="$JACK_LIBS -lpthread"
+# added -lpthread 21-May-10 for FC13 (Bill S)
AUDIO_LIB="-lsamplerate"
;;
OSS)
@@ -10989,6 +11284,7 @@ $as_echo_n "checking for audio system... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $AUDIO_SYSTEM" >&5
$as_echo "$AUDIO_SYSTEM" >&6; }
fi
+fi
@@ -12087,6 +12383,10 @@ $as_echo "$as_me: WARNING: Snd needs either an extension language (s7, Fth, or R
fi
fi
+if test "$ac_snd_have_extension_language" = yes && test "$with_audio" = no && test "$ac_snd_have_gui" = no && test "$ac_cv_header_dlfcn_h" = yes ; then
+ LDFLAGS="$LDFLAGS -ldl"
+fi
+
@@ -12596,7 +12896,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by snd $as_me 11.5, which was
+This file was extended by snd $as_me 11.6, which was
generated by GNU Autoconf 2.65. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -12658,7 +12958,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-snd config.status 11.5
+snd config.status 11.6
configured by $0, generated by GNU Autoconf 2.65,
with options \\"\$ac_cs_config\\"
diff --git a/configure.ac b/configure.ac
index 6eb1929..35913e0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
# Configuration script for Snd
-AC_INIT(snd, 11.5, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-11.tar.gz)
+AC_INIT(snd, 11.6, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-11.tar.gz)
AC_CONFIG_SRCDIR(snd.c)
AC_CANONICAL_HOST
@@ -19,7 +19,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
-VERSION=11.5
+VERSION=11.6
AC_DEFINE_UNQUOTED(SND_PACKAGE, "$PACKAGE")
AC_DEFINE_UNQUOTED(SND_VERSION, "$VERSION")
AC_SUBST(SND_PACKAGE)
@@ -36,6 +36,7 @@ AC_DEFINE_UNQUOTED(SND_HOST, "$host")
# --with-oss use OSS
# --with-jack use Jack
# --with-static-alsa use ALSA statically loaded (for RPM generation)
+# --without-audio stub out all audio
# --with-snd-as-widget make Snd a loadable widget, not a standalone program
# --with-doubles use doubles throughout (default is floats)
# --with-float-samples represent samples internally as floats or doubles (default=yes)
@@ -113,6 +114,7 @@ AC_ARG_WITH(extension-language, [ --with-extension-language use some extension
# an experiment
AC_ARG_WITH(directfb, [ --with-directfb use directfb config scripts, rather than gtk, default=no])
+AC_ARG_WITH(audio, [ --without-audio don't include any audio functionality])
# -------- internal sample data type --------
@@ -967,14 +969,41 @@ else
if test "$with_gtk" = yes ; then
- AM_PATH_GTK_2_0(2.0.0,
- [
- with_gtk=yes
- ],
- [
- AC_MSG_WARN([trouble with gtk -- will try to make Snd without any GUI])
- with_gtk=no
- ])
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gtk+-3.0 --exists ; then
+
+ AM_PATH_GTK_3_0(2.90.0,
+ [
+ with_gtk=yes
+ ],
+ [
+ AC_MSG_WARN([trouble with gtk -- will try to make Snd without any GUI])
+ with_gtk=no
+ ])
+ else
+
+ AM_PATH_GTK_2_0(2.0.0,
+ [
+ with_gtk=yes
+ ],
+ [
+ AC_MSG_WARN([trouble with gtk -- will try to make Snd without any GUI])
+ with_gtk=no
+ ])
+ fi
+
+ else
+
+ AM_PATH_GTK_2_0(2.0.0,
+ [
+ with_gtk=yes
+ ],
+ [
+ AC_MSG_WARN([trouble with gtk -- will try to make Snd without any GUI])
+ with_gtk=no
+ ])
+ fi
+
if test "$with_gtk" = yes ; then
GX_FILES="G_O_FILES"
GX_HEADERS="SND_G_HEADERS"
@@ -993,10 +1022,18 @@ else
GTK_LD_LIBS="$GTK_LIBS"
if test x$PKG_CONFIG != xno ; then
- if test "$with_directfb" = yes ; then
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-2.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-2.0 --libs-only-l`"
+ if $PKG_CONFIG gtk+-3.0 --exists ; then
+ if test "$with_directfb" = yes ; then
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-3.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-3.0 --libs-only-l`"
+ else
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-3.0 --libs-only-L` `$PKG_CONFIG gtk+-3.0 --libs-only-l`"
+ fi
else
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
+ if test "$with_directfb" = yes ; then
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-2.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-2.0 --libs-only-l`"
+ else
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
+ fi
fi
pango_version="`$PKG_CONFIG pango --modversion`"
AC_DEFINE_UNQUOTED(MUS_PANGO_VERSION,"${pango_version}")
@@ -1082,6 +1119,8 @@ else
AC_CHECK_LIB(m, gtk_widget_get_visible, [AC_DEFINE(HAVE_GTK_WIDGET_GET_VISIBLE)], ,$GTK_LIBS)
# for 2.19.n
AC_CHECK_LIB(m, gtk_entry_get_text_window, [AC_DEFINE(HAVE_GTK_ENTRY_GET_TEXT_WINDOW)], ,$GTK_LIBS)
+ # for 2.90
+ AC_CHECK_LIB(m, gtk_scale_new, [AC_DEFINE(HAVE_GTK_SCALE_NEW)], ,$GTK_LIBS)
# for gdk|pango_cairo
AC_CHECK_LIB(m, gdk_cairo_create,
@@ -1461,6 +1500,9 @@ SO_LD="ld"
JACK_LIBS=""
JACK_FLAGS=""
+
+if test "$with_audio" != no ; then
+
# we need the sndlib.h equivalents to try to find the native sound support (see config.guess)
# this only matters for those cases where we've implemented the audio code in audio.c
# test for ALSA courtesy of Paul Davis
@@ -1626,6 +1668,8 @@ case "$host" in
JACK)
AC_DEFINE(HAVE_JACK_IN_LINUX)
AC_DEFINE(HAVE_OSS)
+ JACK_LIBS="$JACK_LIBS -lpthread"
+# added -lpthread 21-May-10 for FC13 (Bill S)
AUDIO_LIB="-lsamplerate"
;;
OSS)
@@ -1751,6 +1795,7 @@ esac
AC_MSG_CHECKING([for audio system])
AC_MSG_RESULT($AUDIO_SYSTEM)
fi
+fi
AC_SUBST(AUDIO_LIB)
AC_SUBST(JACK_LIBS)
@@ -2076,6 +2121,10 @@ if test "$ac_snd_have_extension_language" = no ; then
fi
fi
+if test "$ac_snd_have_extension_language" = yes && test "$with_audio" = no && test "$ac_snd_have_gui" = no && test "$ac_cv_header_dlfcn_h" = yes ; then
+ LDFLAGS="$LDFLAGS -ldl"
+fi
+
AC_SUBST(CFLAGS)
AC_SUBST(ORIGINAL_LDFLAGS)
AC_SUBST(LDFLAGS)
diff --git a/draw.scm b/draw.scm
index a27e7a6..ab39845 100644
--- a/draw.scm
+++ b/draw.scm
@@ -47,11 +47,11 @@
(define (grf-it val v)
(round
- (if (>= val (vct-ref v 1))
- (vct-ref v 3)
- (if (<= val (vct-ref v 0))
- (vct-ref v 2)
- (+ (vct-ref v 5) (* val (vct-ref v 4)))))))
+ (if (>= val (v 1))
+ (v 3)
+ (if (<= val (v 0))
+ (v 2)
+ (+ (v 5) (* val (v 4)))))))
(define* (make-moving-rms (size 128))
(make-moving-average size))
@@ -78,7 +78,6 @@
(set! (foreground-color snd chn) red))
(lambda ()
(run
- (declare (int-vector lines))
(if (< start left) ; check previous samples to get first rms value
(do ((i start (+ 1 i)))
((= i left))
@@ -86,24 +85,24 @@
(let ((first-sample (next-sample reader)))
(set! x0 (grf-it (* left sr) xdata))
(set! y0 (grf-it first-sample ydata))
- (vector-set! lines 0 x0) ; first graph point
- (vector-set! lines 1 y0))
+ (set! (lines 0) x0) ; first graph point
+ (set! (lines 1) y0))
(do ((i (+ left 1) (+ 1 i))) ; loop through all samples calling moving-rms
((= i right))
(let* ((x1 (grf-it (* i sr) xdata))
(y (moving-rms rms (next-sample reader))))
(if (> x1 x0) ; very often many samples are represented by one pixel
(let ((y1 (grf-it y ydata)))
- (vector-set! lines line-ctr x1)
- (vector-set! lines (+ 1 line-ctr) y1)
+ (set! (lines line-ctr) x1)
+ (set! (lines (+ 1 line-ctr)) y1)
(set! line-ctr (+ line-ctr 2))
(set! x0 x1)
(set! y0 y1)))))) ; else should we do "max" here? or draw a vertical line from min to max?
(if (< line-ctr (length lines))
(do ((j line-ctr (+ j 2))) ; off-by-one in vector size calc -- need to pad so we don't get a bogus line to (0, 0)
((>= j (length lines)))
- (vector-set! lines j x0)
- (vector-set! lines (+ j 1) y0)))
+ (set! (lines j) x0)
+ (set! (lines (+ j 1)) y0)))
(draw-lines lines snd chn)
(set! (channel-property 'rms-lines snd chn) lines) ; save current data for possible redisplay
(set! (channel-property 'rms-axis-info snd chn) axinf))
@@ -227,7 +226,7 @@ whenever they're in the current view."
(define (samples-1 cur-data)
(let* ((x0 (x->position (/ left (srate snd))))
- (y0 (y->position (vct-ref cur-data 0)))
+ (y0 (y->position (cur-data 0)))
(colors (make-vector (colormap-size) #f))
(len (length cur-data))
(incr (/ (+ 1 (- right left)) len)))
@@ -236,12 +235,12 @@ whenever they're in the current view."
((or (>= i right)
(>= j len)))
(let* ((x1 (x->position (/ i (srate snd))))
- (y1 (y->position (vct-ref cur-data j)))
- (x (abs (vct-ref cur-data j)))
+ (y1 (y->position (cur-data j)))
+ (x (abs (cur-data j)))
(ref (floor (* (colormap-size) x)))
- (color (or (vector-ref colors ref)
+ (color (or (colors ref)
(let ((new-color (apply make-color (colormap-ref (colormap) x))))
- (vector-set! colors ref new-color)
+ (set! (colors ref) new-color)
new-color))))
(set! (foreground-color snd chn) color)
(draw-line x0 y0 x1 y1)
diff --git a/dsp.scm b/dsp.scm
index ba02909..4302306 100644
--- a/dsp.scm
+++ b/dsp.scm
@@ -6,7 +6,7 @@
(define (log10 a)
"(log10 a) returns the log base 10 of 'a'"
- (/ (log a) (log 10)))
+ (log a 10))
;;; src-duration (see src-channel in extsnd.html)
@@ -50,15 +50,15 @@
(phase 0.0 (+ phase freq)))
((= i N))
(let ((val (* den (cos (* N (acos (* alpha (cos phase))))))))
- (vct-set! rl i (real-part val))
- (vct-set! im i (imag-part val)))) ;this is actually always essentially 0.0
+ (set! (rl i) (real-part val))
+ (set! (im i) (imag-part val)))) ;this is actually always essentially 0.0
(fft rl im -1) ;direction could also be 1
(let ((pk (vct-peak rl)))
(vct-scale! rl (/ 1.0 pk)))
(do ((i 0 (+ i 1))
(j (/ N 2)))
((= i N))
- (vct-set! im i (vct-ref rl j))
+ (set! (im i) (rl j))
(set! j (+ j 1))
(if (= j N) (set! j 0)))
im))
@@ -79,7 +79,7 @@
(do ((i 0 (+ i 1))
(phase (- (/ pi 2)) (+ phase freq)))
((= i N))
- (vector-set! vals i (* mult den (cos (* N (acos (* alpha (cos phase)))))))
+ (set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))
(set! mult (* -1 mult)))
;; now take the DFT
(do ((i 0 (+ i 1)))
@@ -87,13 +87,13 @@
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k N))
- (set! sum (+ sum (* (vector-ref vals k) (exp (/ (* 2.0 0+1.0i pi k i) N))))))
- (vector-set! w i (magnitude sum))
- (if (> (vector-ref w i) pk) (set! pk (vector-ref w i)))))
+ (set! sum (+ sum (* (vals k) (exp (/ (* 2.0 0+1.0i pi k i) N))))))
+ (set! (w i) (magnitude sum))
+ (if (> (w i) pk) (set! pk (w i)))))
;; scale to 1.0 (it's usually pretty close already, that is pk is close to 1.0)
(do ((i 0 (+ i 1)))
((= i N))
- (vector-set! w i (/ (vector-ref w i) pk)))
+ (set! (w i) (/ (w i) pk)))
w))
@@ -106,7 +106,7 @@
;; see stretch-sound-via-dft below for a general version
(let* ((len (frames snd chn))
(pow2 (ceiling (/ (log len) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(fftscale (/ 1.0 fftlen))
(rl1 (channel->vct 0 fftlen snd chn))
(im1 (make-vct fftlen)))
@@ -115,16 +115,16 @@
(vct-scale! im1 fftscale)
(let ((rl2 (make-vct (* n fftlen)))
(im2 (make-vct (* n fftlen))))
- (vct-set! rl2 0 (vct-ref rl1 0))
- (vct-set! im2 0 (vct-ref im1 0))
+ (set! (rl2 0) (rl1 0))
+ (set! (im2 0) (im1 0))
(do ((i 1 (+ i 1)) ; lower half
(k (- fftlen 1) (- k 1))
(j (- (* n fftlen) 1) (- j 1)))
((= i (/ fftlen 2)))
- (vct-set! rl2 i (vct-ref rl1 i))
- (vct-set! rl2 j (vct-ref rl1 k))
- (vct-set! im2 i (vct-ref im1 i))
- (vct-set! im2 j (vct-ref im1 k)))
+ (set! (rl2 i) (rl1 i))
+ (set! (rl2 j) (rl1 k))
+ (set! (im2 i) (im1 i))
+ (set! (im2 j) (im1 k)))
(fft rl2 im2 -1)
(vct->channel rl2 0 (* n len) snd chn #f (format #f "down-oct ~A" n)))))
@@ -143,13 +143,13 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
((or (c-g?) (= i n)))
;; DFT + split
(if (< i n2)
- (vector-set! fr i (edot-product (* freq 0.0-1.0i i) in-data))
- (vector-set! fr (+ i (- out-n n 1)) (edot-product (* freq 0.0-1.0i i) in-data))))
+ (set! (fr i) (edot-product (* freq 0.0-1.0i i) in-data))
+ (set! (fr (+ i (- out-n n 1))) (edot-product (* freq 0.0-1.0i i) in-data))))
(set! freq (/ (* 2 pi) out-n))
(do ((i 0 (+ i 1)))
((or (c-g?) (= i out-n)))
;; inverse DFT
- (vct-set! out-data i (real-part (/ (edot-product (* freq 0.0+1.0i i) fr) n))))
+ (set! (out-data i) (real-part (/ (edot-product (* freq 0.0+1.0i i) fr) n))))
(vct->channel out-data 0 out-n snd chn #f (format #f "stretch-sound-via-dft ~A" factor))))
@@ -166,10 +166,10 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define circle-vct-ref
(lambda (v i)
(if (< i 0)
- (vct-ref v (+ size i))
+ (v (+ size i))
(if (>= i size)
- (vct-ref v (- i size))
- (vct-ref v i)))))
+ (v (- i size))
+ (v i)))))
(let* ((dm (/ damp mass))
(km (/ xspring mass))
(denom (+ 1.0 dm))
@@ -178,9 +178,9 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(p3 (/ -1.0 denom)))
(do ((i 0 (+ i 1)))
((= i size))
- (vct-set! x0 i (+ (* p1 (vct-ref x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
- (* p3 (vct-ref x2 i)))))
+ (set! (x0 i) (+ (* p1 (x1 i))
+ (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
+ (* p3 (x2 i)))))
(vct-fill! x2 0.0)
(vct-add! x2 x1)
(vct-fill! x1 0.0)
@@ -192,28 +192,28 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define circle-vct-ref
(lambda (v i)
(if (< i 0)
- (vct-ref v (+ size i))
+ (v (+ size i))
(if (>= i size)
- (vct-ref v (- i size))
- (vct-ref v i)))))
+ (v (- i size))
+ (v i)))))
(do ((i 0 (+ i 1)))
((= i size))
- (let* ((dm (/ (vct-ref damps i) (vct-ref masses i)))
- (km (/ (vct-ref xsprings i) (vct-ref masses i)))
- (cm (/ (vct-ref esprings i) (vct-ref masses i)))
+ (let* ((dm (/ (damps i) (masses i)))
+ (km (/ (xsprings i) (masses i)))
+ (cm (/ (esprings i) (masses i)))
(denom (+ 1.0 dm cm))
(p1 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
(p2 (/ km denom))
(p3 (/ -1.0 denom))
- (p4 (/ (vct-ref haptics i) (* (vct-ref masses i) denom))))
- (vct-set! x0 i (+ (* p1 (vct-ref x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
- (* p3 (vct-ref x2 i))
- p4))))
+ (p4 (/ (haptics i) (* (masses i) denom))))
+ (set! (x0 i) (+ (* p1 (x1 i))
+ (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
+ (* p3 (x2 i))
+ p4))))
(do ((i 0 (+ i 1)))
((= i size))
- (vct-set! x2 i (vct-ref x1 i))
- (vct-set! x1 i (vct-ref x0 i)))))
+ (set! (x2 i) (x1 i))
+ (set! (x1 i) (x0 i)))))
;;; -------- "frequency division" -- an effect from sed_sed@my-dejanews.com
@@ -248,15 +248,15 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(begin
(do ((i 0 (+ i 1)))
((= i size))
- (if (>= (vct-ref vals i) 0.0)
- (vct-set! vals i mx)
- (vct-set! vals i mn)))
+ (if (>= (vals i) 0.0)
+ (set! (vals i) mx)
+ (set! (vals i) mn)))
(set! n 0)
(set! mx 0.0)
(set! mn 0.0)
vals)
(begin
- (vct-set! vals n val)
+ (set! (vals n) val)
(if (> val mx) (set! mx val))
(if (< val mn) (set! mn val))
(set! n (+ 1 n))
@@ -295,7 +295,7 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(snd (if (> (length args) 1) (list-ref args 1) #f))
(chn (if (> (length args) 2) (list-ref args 2) #f))
(pow2 (ceiling (/ (log (/ (srate snd) 20.0)) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(data (autocorrelate (channel->vct s0 fftlen snd chn)))
(cor-peak (vct-peak data)))
(if (= cor-peak 0.0)
@@ -304,12 +304,12 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(lambda (return)
(do ((i 1 (+ i 1)))
((= i (- fftlen 2)) 0)
- (if (and (< (vct-ref data i) (vct-ref data (+ i 1)))
- (> (vct-ref data (+ i 1)) (vct-ref data (+ i 2))))
+ (if (and (< (data i) (data (+ i 1)))
+ (> (data (+ i 1)) (data (+ i 2))))
(begin
- (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))))
+ (let* ((logla (log10 (/ (+ cor-peak (data i)) (* 2 cor-peak))))
+ (logca (log10 (/ (+ cor-peak (data (+ i 1))) (* 2 cor-peak))))
+ (logra (log10 (/ (+ cor-peak (data (+ i 2))) (* 2 cor-peak))))
(offset (/ (* 0.5 (- logla logra))
(+ logla logra (* -2.0 logca)))))
(return (/ (srate snd)
@@ -342,13 +342,13 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(let ((dlys (make-vector chorus-size)))
(do ((i 0 (+ i 1)))
((= i chorus-size))
- (vector-set! dlys i (make-flanger)))
+ (set! (dlys i) (make-flanger)))
(lambda (inval)
(do ((sum 0.0)
(i 0 (+ i 1)))
((= i chorus-size)
(* .25 sum))
- (set! sum (+ sum (flanger (vector-ref dlys i) inval)))))))
+ (set! sum (+ sum (flanger (dlys i) inval)))))))
;;; -------- chordalize (comb filters to make a chord using chordalize-amount and chordalize-base)
@@ -374,7 +374,7 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
"(zero-phase) calls fft, sets all phases to 0, and un-ffts"
(let* ((len (frames snd chn))
(pow2 (ceiling (/ (log len) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(fftscale (/ 1.0 fftlen))
(rl (channel->vct 0 fftlen snd chn))
(old-pk (vct-peak rl))
@@ -393,7 +393,7 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
"(rotate-phase func) calls fft, applies func to each phase, then un-ffts"
(let* ((len (frames snd chn))
(pow2 (ceiling (/ (log len) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(fftlen2 (floor (/ fftlen 2)))
(fftscale (/ 1.0 fftlen))
(rl (channel->vct 0 fftlen snd chn))
@@ -404,13 +404,13 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(fft rl im 1)
(rectangular->magnitudes rl im)
(vct-scale! rl fftscale)
- (vct-set! im 0 0.0)
+ (set! (im 0) 0.0)
(do ((i 1 (+ i 1))
(j (- fftlen 1) (- j 1)))
((= i fftlen2))
;; rotate the fft vector by func, keeping imaginary part complex conjgate of real
- (vct-set! im i (func (vct-ref im i)))
- (vct-set! im j (- (vct-ref im i))))
+ (set! (im i) (func (im i)))
+ (set! (im j) (- (im i))))
(polar->rectangular rl im)
(fft rl im -1)
(let ((pk (vct-peak rl)))
@@ -467,13 +467,13 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(do ((j 0 (+ 1 j))
(jj (- n 1) (- jj 1)))
((= j m) coeffs)
- (let ((xt (* 0.5 (vct-ref spectr 0))))
+ (let ((xt (* 0.5 (spectr 0))))
(do ((i 1 (+ i 1)))
((= i m))
- (set! xt (+ xt (* (vct-ref spectr i) (cos (* q i (- am j 1)))))))
+ (set! xt (+ xt (* (spectr i) (cos (* q i (- am j 1)))))))
(let ((coeff (* 2.0 (/ xt n))))
- (vct-set! coeffs j coeff)
- (vct-set! coeffs jj coeff))))))
+ (set! (coeffs j) coeff)
+ (set! (coeffs jj) coeff))))))
;; (filter-channel et al reflect around the midpoint, so to match exactly you need to take
;; the env passed and flip it backwards for the back portion -- that is to say, this function
@@ -490,8 +490,8 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;(map-channel (fltit-1 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0)))
;
;(let ((notched-spectr (make-vct 40)))
-; (vct-set! notched-spectr 2 1.0)
-; (vct-set! notched-spectr 37 1.0)
+; (set! (notched-spectr 2) 1.0)
+; (set! (notched-spectr 37) 1.0)
; (map-channel (fltit-1 40 notched-spectr)))
;
@@ -509,12 +509,12 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(num (- 1.0 (cos (* pi i)))))
(if (or (= num 0.0)
(= i 0))
- (vct-set! arr k 0.0)
+ (set! (arr k) 0.0)
;; this is the "ideal" -- rectangular window -- version:
- ;; (vct-set! arr k (/ num denom))
+ ;; (set! (arr k) (/ num denom))
;; this is the Hamming window version:
- (vct-set! arr k (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))) ; window
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))) ; window
)))
(make-fir-filter arrlen arr)))
@@ -547,19 +547,19 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(rd (make-sampler 0 snd chn)))
(do ((i 0 (+ i 1)))
((= i size))
- (vct-set! rl i (rd)))
+ (set! (rl i) (rd)))
(mus-fft rl im len)
(do ((i 0 (+ i 1)))
((= i len))
- (let* ((c (make-rectangular (vct-ref rl i) (vct-ref im i)))
+ (let* ((c (make-rectangular (rl i) (im i)))
(ph (angle c))
(mag (magnitude c)))
(if (< i (/ len 2))
(set! ph (+ ph (* 0.5 pi)))
(set! ph (- ph (* 0.5 pi))))
(set! c (make-polar mag ph))
- (vct-set! rl i (real-part c))
- (vct-set! im i (imag-part c))))
+ (set! (rl i) (real-part c))
+ (set! (im i) (imag-part c))))
(mus-fft rl im len -1)
(vct-scale! rl (/ 1.0 len))
(vct->channel rl 0 len snd chn #f "hilbert-transform-via-fft")))
@@ -577,9 +577,9 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(denom (* pi i))
(num (- (sin (* fc i)))))
(if (= i 0)
- (vct-set! arr k (- 1.0 (/ fc pi)))
- (vct-set! arr k (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (set! (arr k) (- 1.0 (/ fc pi)))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
(make-fir-filter arrlen arr)))
(define (highpass f in)
@@ -605,9 +605,9 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(denom (* pi i))
(num (sin (* fc i))))
(if (= i 0)
- (vct-set! arr k (/ fc pi))
- (vct-set! arr k (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (set! (arr k) (/ fc pi))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
(make-fir-filter arrlen arr)))
(define (lowpass f in)
@@ -632,9 +632,9 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(denom (* pi i))
(num (- (sin (* fhi i)) (sin (* flo i)))))
(if (= i 0)
- (vct-set! arr k (/ (- fhi flo) pi))
- (vct-set! arr k (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (set! (arr k) (/ (- fhi flo) pi))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
(make-fir-filter arrlen arr)))
(define (bandpass f in)
@@ -674,9 +674,9 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(denom (* pi i))
(num (- (sin (* flo i)) (sin (* fhi i)))))
(if (= i 0)
- (vct-set! arr k (- 1.0 (/ (- fhi flo) pi)))
- (vct-set! arr k (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (set! (arr k) (- 1.0 (/ (- fhi flo) pi)))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
(make-fir-filter arrlen arr)))
(define (bandstop f in)
@@ -699,9 +699,9 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
((= i len))
(let* ((k (+ i len)))
(if (= i 0)
- (vct-set! arr k 0.0)
- (vct-set! arr k (* (- (/ (cos (* pi i)) i) (/ (sin (* pi i)) (* pi i i)))
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (set! (arr k) 0.0)
+ (set! (arr k) (* (- (/ (cos (* pi i)) i) (/ (sin (* pi i)) (* pi i i)))
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
(make-fir-filter arrlen arr)))
(define (differentiator f in)
@@ -854,14 +854,14 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
((= i hum-harmonics))
(let ((center (* (+ i 1.0) hum-freq))
(b2 (* 0.5 bandwidth)))
- (vector-set! gen i (make-iir-band-stop-2 (- center b2) (+ center b2)))))
+ (set! (gen i) (make-iir-band-stop-2 (- center b2) (+ center b2)))))
gen))
(define (eliminate-hum gen x0)
(let ((val x0))
(do ((i 0 (+ i 1)))
((= i (length gen)))
- (set! val (filter (vector-ref gen i) val))) ; "cascade" n filters
+ (set! val (filter (gen i) val))) ; "cascade" n filters
val))
;;; (let ((hummer (make-eliminate-hum))) (map-channel (lambda (x) (eliminate-hum hummer x))))
@@ -890,21 +890,21 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
;; x * h -> y
(do ((n 0 (+ 1 n)))
((= n (+ L M)))
- (vct-set! y n 0.0)
+ (set! (y n) 0.0)
(do ((m (max 0 (- n (+ 1 L))) (+ 1 m))) ; m always starts at 0 here since the other expression is always <= 0
((> m (min n M)))
- (vct-set! y n (+ (vct-ref y n) (* (vct-ref h m) (vct-ref x (- n m))))))))
+ (set! (y n) (+ (y n) (* (h m) (x (- n m))))))))
(let* ((K (length A))
(d (make-vct (+ 1 (* 2 K))))
(a1 (make-vct (+ 1 (* 2 K)))))
- (vct-set! a1 0 1.0)
+ (set! (a1 0) 1.0)
(do ((i 0 (+ i 1)))
((= i K))
(conv 2 (list-ref A i) (+ 1 (* 2 i)) a1 d)
(do ((j 0 (+ 1 j)))
((= j (+ 3 (* 2 i))))
- (vct-set! a1 j (vct-ref d j))))
+ (set! (a1 j) (d j))))
a1))
@@ -1048,14 +1048,14 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(define* (notch-channel freqs (filter-order #f) beg dur snd chn edpos (truncate #t) (notch-width 2))
"(notch-channel freqs (filter-order #f) beg dur snd chn edpos (truncate #t) (notch-width 2)) -> notch filter removing freqs"
- (filter-channel (make-notch-frequency-response (exact->inexact (srate snd)) freqs notch-width)
+ (filter-channel (make-notch-frequency-response (* 1.0 (srate snd)) freqs notch-width)
(or filter-order (expt 2 (ceiling (/ (log (/ (srate snd) notch-width)) (log 2.0)))))
beg dur snd chn edpos truncate
(format #f "notch-channel '~A ~A ~A ~A" freqs filter-order beg dur)))
(define* (notch-sound freqs filter-order snd chn (notch-width 2))
"(notch-sound freqs filter-order snd chn (notch-width 2)) -> notch filter removing freqs"
- (filter-sound (make-notch-frequency-response (exact->inexact (srate snd)) freqs notch-width)
+ (filter-sound (make-notch-frequency-response (* 1.0 (srate snd)) freqs notch-width)
(or filter-order (expt 2 (ceiling (/ (log (/ (srate snd) notch-width)) (log 2.0)))))
snd chn #f
(format #f "notch-channel '~A ~A 0 #f" freqs filter-order)))
@@ -1063,7 +1063,7 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(define* (notch-selection freqs filter-order (notch-width 2))
"(notch-selection freqs filter-order (notch-width 2)) -> notch filter removing freqs"
(if (selection?)
- (filter-selection (make-notch-frequency-response (exact->inexact (selection-srate)) freqs notch-width)
+ (filter-selection (make-notch-frequency-response (* 1.0 (selection-srate)) freqs notch-width)
(or filter-order (expt 2 (ceiling (/ (log (/ (selection-srate) notch-width)) (log 2.0))))))))
@@ -1087,14 +1087,14 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(let* ((phase (* ph0 k w))
(c (cos phase))
(s (sin phase))
- (x (vct-ref fr k))
- (y (vct-ref fi k))
+ (x (fr k))
+ (y (fi k))
(r (- (* x c) (* y s)))
(i (+ (* y c) (* x s))))
(set! sr (+ sr r))
(set! si (+ si i))))
- (vct-set! hr w sr)
- (vct-set! hi w si)))
+ (set! (hr w) sr)
+ (set! (hi w) si)))
(list hr hi)))
(define (z-transform f n z)
@@ -1110,9 +1110,9 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
;; -w?? there seems to be confusion here -- slowzt.cc in the fxt package uses +w
(do ((k 0 (+ 1 k)))
((= k n))
- (set! sum (+ sum (* (vct-ref f k) t)))
+ (set! sum (+ sum (* (f k) t)))
(set! t (* t m)))
- (vector-set! res w sum)))
+ (set! (res w) sum)))
res))
@@ -1129,10 +1129,10 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
((= i len))
(do ((j 0 (+ 1 j)))
((= j len))
- (vct-set! arr i (+ (vct-ref arr i)
- (* (vct-ref data j)
- (+ (cos (* i j w))
- (sin (* i j w))))))))
+ (set! (arr i) (+ (arr i)
+ (* (data j)
+ (+ (cos (* i j w))
+ (sin (* i j w))))))))
arr))
(define* (find-sine freq beg dur snd)
@@ -1187,7 +1187,7 @@ the era when computers were human beings"
(letrec ((next-random
(lambda ()
(let* ((len (length e))
- (x (random (exact->inexact (list-ref e (- len 2)))))
+ (x (random (* 1.0 (list-ref e (- len 2)))))
(y (random 1.0)))
(if (or (<= y (envelope-interp x e))
(c-g?))
@@ -1228,12 +1228,12 @@ the era when computers were human beings"
(define* (inverse-integrate dist (data-size 512) (e-size 50))
(let* ((e '())
- (sum (exact->inexact (cadr dist)))
+ (sum (cadr dist))
(first-sum sum)
(data (make-vct data-size))
(x0 (car dist))
(x1 (list-ref dist (- (length dist) 2)))
- (xincr (exact->inexact (/ (- x1 x0) e-size))))
+ (xincr (/ (- x1 x0) e-size)))
(do ((i 0 (+ i 1))
(x x0 (+ x xincr)))
((> i e-size))
@@ -1245,7 +1245,7 @@ the era when computers were human beings"
(do ((i 0 (+ i 1))
(x first-sum (+ x incr)))
((= i data-size))
- (vct-set! data i (envelope-interp x e)))
+ (set! (data i) (envelope-interp x e)))
data)))
(define (gaussian-envelope s)
@@ -1370,13 +1370,13 @@ the era when computers were human beings"
(vct-scale! im 0.0)
(do ((k 0 (+ 1 k)))
((= k N))
- (vct-set! rl k (rd)))
+ (set! (rl k) (rd)))
(mus-fft rl im)
(do ((k 0 (+ 1 k)))
((= k N))
- (vct-set! average-data k (+ (vct-ref average-data k)
- (+ (* (vct-ref rl k) (vct-ref rl k))
- (* (vct-ref im k) (vct-ref im k)))))))
+ (set! (average-data k) (+ (average-data k)
+ (+ (* (rl k) (rl k))
+ (* (im k) (im k)))))))
(graph (vct-scale! average-data (/ 1.0 (ceiling (/ len N)))))))
@@ -1405,8 +1405,8 @@ shift the given channel in pitch without changing its length. The higher 'order
((> i pairs))
(let* ((aff (* i old-freq))
(bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (vector-set! ssbs (- i 1) (make-ssb-am (* i factor old-freq)))
- (vector-set! bands (- i 1) (make-bandpass (hz->2pi (- aff bwf))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
(hz->2pi (+ aff bwf))
order))))
(as-one-edit
@@ -1417,8 +1417,8 @@ shift the given channel in pitch without changing its length. The higher 'order
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i pairs))
- (set! sum (+ sum (ssb-am (vector-ref ssbs i)
- (bandpass (vector-ref bands i)
+ (set! sum (+ sum (ssb-am (ssbs i)
+ (bandpass (bands i)
y)))))
(set! nmx (max nmx (abs sum)))
sum))
@@ -1438,13 +1438,13 @@ shift the given channel in pitch without changing its length. The higher 'order
((> i pairs))
(let* ((aff (* i old-freq))
(bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (vector-set! ssbs (- i 1) (make-ssb-am (* i factor old-freq)))
- (vector-set! bands (- i 1) (make-bandpass (hz->2pi (- aff bwf))
- (hz->2pi (+ aff bwf))
- order))
- (vector-set! frenvs (- i 1) (make-env freq-env
- :scaler (hz->radians (exact->inexact i))
- :length (frames)))))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
+ (hz->2pi (+ aff bwf))
+ order))
+ (set! (frenvs (- i 1)) (make-env freq-env
+ :scaler (hz->radians (* 1.0 i))
+ :length (frames)))))
(as-one-edit
(lambda ()
(let ((nmx 0.0))
@@ -1453,10 +1453,10 @@ shift the given channel in pitch without changing its length. The higher 'order
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i pairs))
- (set! sum (+ sum (ssb-am (vector-ref ssbs i)
- (bandpass (vector-ref bands i)
+ (set! sum (+ sum (ssb-am (ssbs i)
+ (bandpass (bands i)
y)
- (env (vector-ref frenvs i))))))
+ (env (frenvs i))))))
(set! nmx (max nmx (abs sum)))
sum))
beg dur snd chn edpos)
@@ -1484,10 +1484,10 @@ shift the given channel in pitch without changing its length. The higher 'order
((> i pairs))
(let* ((aff (* i old-freq))
(bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (vector-set! ssbs (- i 1) (make-ssb-am (* i factor old-freq)))
- (vector-set! bands (- i 1) (make-bandpass (hz->radians (- aff bwf))
- (hz->radians (+ aff bwf))
- order))))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf))
+ (hz->radians (+ aff bwf))
+ order))))
(list ssbs bands)))
(define (transpose transposer input)
@@ -1497,8 +1497,8 @@ shift the given channel in pitch without changing its length. The higher 'order
(pairs (length ssbs)))
(do ((i 0 (+ i 1)))
((= i pairs) sum)
- (set! sum (+ sum (ssb-am (vector-ref ssbs i)
- (bandpass (vector-ref bands i)
+ (set! sum (+ sum (ssb-am (ssbs i)
+ (bandpass (bands i)
input)))))))
(define (fdelay gen input)
@@ -1543,10 +1543,10 @@ shift the given channel in pitch without changing its length. The higher 'order
;; Horner's rule applied to entire vct
(let* ((v-len (length v))
(num-coeffs (length coeffs))
- (new-v (make-vct v-len (vct-ref coeffs (- num-coeffs 1)))))
+ (new-v (make-vct v-len (coeffs (- num-coeffs 1)))))
(do ((i (- num-coeffs 2) (- i 1)))
((< i 0))
- (vct-offset! (vct-multiply! new-v v) (vct-ref coeffs i)))
+ (vct-offset! (vct-multiply! new-v v) (coeffs i)))
new-v))
(define* (channel-polynomial coeffs snd chn)
@@ -1572,14 +1572,14 @@ shift the given channel in pitch without changing its length. The higher 'order
(rl1 (make-vct fft-len 0.0))
(rl2 (make-vct fft-len 0.0))
(new-sound (make-vct fft-len)))
- (if (> (vct-ref coeffs 0) 0.0)
- (let ((dither (vct-ref coeffs 0)))
+ (if (> (coeffs 0) 0.0)
+ (let ((dither (coeffs 0)))
(do ((i 0 (+ i 1)))
((= i fft-len))
- (vct-set! new-sound i (mus-random dither)))))
+ (set! (new-sound i) (mus-random dither)))))
(if (> num-coeffs 1)
(begin
- (vct-add! new-sound (vct-scale! (vct-copy sound) (vct-ref coeffs 1)))
+ (vct-add! new-sound (vct-scale! (vct-copy sound) (coeffs 1)))
(if (> num-coeffs 2)
(let ((peak (maxamp snd chn)))
(vct-add! (vct-scale! rl1 0.0) sound)
@@ -1587,7 +1587,7 @@ shift the given channel in pitch without changing its length. The higher 'order
((= i num-coeffs))
(convolution rl1 (vct-add! (vct-scale! rl2 0.0) sound) fft-len)
(let ((pk (vct-peak rl1)))
- (vct-add! new-sound (vct-scale! (vct-copy rl1) (/ (* (vct-ref coeffs i) peak) pk)))))
+ (vct-add! new-sound (vct-scale! (vct-copy rl1) (/ (* (coeffs i) peak) pk)))))
(let ((pk (vct-peak new-sound)))
(vct-scale! new-sound (/ peak pk)))))))
(vct->channel new-sound 0 (max len (* len (- num-coeffs 1))) snd chn #f (format #f "spectral-polynomial ~A" (vct->string coeffs)))))
@@ -1630,13 +1630,13 @@ the rendering frequency, the number of measurements per second; 'db-floor' is th
(let* ((fsr (srate file))
(incrsamps (floor (/ fsr rfreq)))
(start (floor (* beg fsr)))
- (end (+ start (if dur (inexact->exact (* dur fsr)) (- (frames file) beg))))
+ (end (+ start (if dur (floor (* dur fsr)) (- (frames file) beg))))
(fdr (make-vct fftsize))
(fdi (make-vct fftsize))
(windows (+ 1 (floor (/ (- end start) incrsamps))))
(results (make-vct windows))
(fft2 (floor (/ fftsize 2)))
- (binwidth (exact->inexact (/ fsr fftsize)))
+ (binwidth (* 1.0 (/ fsr fftsize)))
(rd (make-readin file)))
(run
(do ((i start (+ i incrsamps))
@@ -1648,7 +1648,7 @@ the rendering frequency, the number of measurements per second; 'db-floor' is th
((= j fftsize))
(let ((val (readin rd)))
(set! sum-of-squares (+ sum-of-squares (* val val)))
- (vct-set! fdr j val)))
+ (set! (fdr j) val)))
(if (>= (linear->db (sqrt (/ sum-of-squares fftsize))) db-floor)
(let ((numsum 0.0)
(densum 0.0))
@@ -1657,9 +1657,9 @@ the rendering frequency, the number of measurements per second; 'db-floor' is th
(rectangular->magnitudes fdr fdi)
(do ((k 0 (+ 1 k)))
((= k fft2))
- (set! numsum (+ numsum (* k binwidth (vct-ref fdr k))))
- (set! densum (+ densum (vct-ref fdr k))))
- (vct-set! results loc (/ numsum densum)))))))
+ (set! numsum (+ numsum (* k binwidth (fdr k))))
+ (set! densum (+ densum (fdr k))))
+ (set! (results loc) (/ numsum densum)))))))
results))
@@ -1683,17 +1683,17 @@ the rendering frequency, the number of measurements per second; 'db-floor' is th
(order (length coeffs)))
(do ((i 0 (+ i 1)))
((= i flen))
- (vct-set! coeffs i (vct-ref fcoeffs i)))
+ (set! (coeffs i) (fcoeffs i)))
(let ((nfilt (make-vct order)))
- (vct-set! nfilt 0 (/ 1.0 (vct-ref coeffs 0)))
+ (set! (nfilt 0) (/ 1.0 (coeffs 0)))
(do ((i 1 (+ i 1)))
((= i order))
(let ((sum 0.0))
(do ((j 0 (+ 1 j))
(k i (- k 1)))
((= j i))
- (set! sum (+ sum (* (vct-ref nfilt j) (vct-ref coeffs k)))))
- (vct-set! nfilt i (/ sum (- (vct-ref coeffs 0))))))
+ (set! sum (+ sum (* (nfilt j) (coeffs k)))))
+ (set! (nfilt i) (/ sum (- (coeffs 0))))))
nfilt)))
@@ -1721,13 +1721,13 @@ the rendering frequency, the number of measurements per second; 'db-floor' is th
(x2len (length bs))
(sum 0.0))
(vct-move! xs (- xlen 1) (- xlen 2) #t)
- (vct-set! xs 0 x)
+ (set! (xs 0) x)
(set! sum (dot-product as xs x1len))
(do ((i 0 (+ i 1)))
((= i x2len))
(do ((j i (+ 1 j)))
((= j x2len))
- (set! sum (+ sum (* (vct-ref bs j) (vct-ref xs i) (vct-ref xs j))))))
+ (set! sum (+ sum (* (bs j) (xs i) (xs j))))))
sum))
;;; (define flt (make-volterra-filter (vct .5 .1) (vct .3 .2 .1)))
@@ -1755,11 +1755,11 @@ and replaces it with the spectrum given in coeffs"
((> i pairs))
(let* ((aff (* i freq))
(bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (vector-set! peaks (- i 1) (make-moving-max 128))
- (vector-set! avgs (- i 1) (make-moving-average 128))
- (vector-set! bands (- i 1) (make-bandpass (hz->2pi (- aff bwf))
- (hz->2pi (+ aff bwf))
- order))))
+ (set! (peaks (- i 1)) (make-moving-max 128))
+ (set! (avgs (- i 1)) (make-moving-average 128))
+ (set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
+ (hz->2pi (+ aff bwf))
+ order))))
(as-one-edit
(lambda ()
(map-channel
@@ -1767,9 +1767,9 @@ and replaces it with the spectrum given in coeffs"
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i pairs))
- (let* ((sig (bandpass (vector-ref bands i) y))
- (mx (moving-max (vector-ref peaks i) sig)))
- (let ((amp (moving-average (vector-ref avgs i) (if (> mx 0.0) (min 100.0 (/ 1.0 mx)) 0.0))))
+ (let* ((sig (bandpass (bands i) y))
+ (mx (moving-max (peaks i) sig)))
+ (let ((amp (moving-average (avgs i) (if (> mx 0.0) (min 100.0 (/ 1.0 mx)) 0.0))))
(if (> amp 0.0)
(set! sum (+ sum (* mx (polynomial pcoeffs (* amp sig)))))))))
(let ((val (filter flt sum))) ; get rid of DC
@@ -1846,7 +1846,7 @@ and replaces it with the spectrum given in coeffs"
(define (display-bark-fft-1 snd chn)
(let* ((ls (left-sample snd chn))
(rs (right-sample snd chn))
- (fftlen (inexact->exact (expt 2 (ceiling (/ (log (+ 1 (- rs ls))) (log 2)))))))
+ (fftlen (floor (expt 2 (ceiling (/ (log (+ 1 (- rs ls))) (log 2)))))))
(if (> fftlen 0)
(let ((data (channel->vct ls fftlen snd chn))
(normalized (not (= (transform-normalization snd chn) dont-normalize)))
@@ -1884,20 +1884,20 @@ and replaces it with the spectrum given in coeffs"
(run
(do ((i 0 (+ i 1)))
((= i data-len))
- (let* ((val (vct-ref fft i))
+ (let* ((val (fft i))
(frq (* sr (/ i fftlen)))
(bark-bin (round (* bark-frqscl (- (bark frq) bark-low))))
(mel-bin (round (* mel-frqscl (- (mel frq) mel-low))))
(erb-bin (round (* erb-frqscl (- (erb frq) erb-low)))))
(if (and (>= bark-bin 0)
(< bark-bin data-len))
- (vct-set! bark-data bark-bin (+ val (vct-ref bark-data bark-bin))))
+ (set! (bark-data bark-bin) (+ val (bark-data bark-bin))))
(if (and (>= mel-bin 0)
(< mel-bin data-len))
- (vct-set! mel-data mel-bin (+ val (vct-ref mel-data mel-bin))))
+ (set! (mel-data mel-bin) (+ val (mel-data mel-bin))))
(if (and (>= erb-bin 0)
(< erb-bin data-len))
- (vct-set! erb-data erb-bin (+ val (vct-ref erb-data erb-bin))))))
+ (set! (erb-data erb-bin) (+ val (erb-data erb-bin))))))
(if normalized
(let ((bmx (vct-peak bark-data))
@@ -2048,34 +2048,34 @@ and replaces it with the spectrum given in coeffs"
(wk1 (make-vector n 0.0))
(wk2 (make-vector n 0.0))
(wkm (make-vector n 0.0)))
- (vector-set! wk1 0 (vct-ref data 0))
- (vector-set! wk2 (- n 2) (vct-ref data (- n 1)))
+ (set! (wk1 0) (data 0))
+ (set! (wk2 (- n 2)) (data (- n 1)))
(do ((j 1 (+ 1 j)))
((= j (- n 1)))
- (vector-set! wk1 j (vct-ref data j))
- (vector-set! wk2 (- j 1) (vct-ref data j)))
+ (set! (wk1 j) (data j))
+ (set! (wk2 (- j 1)) (data j)))
(do ((k 0 (+ 1 k)))
((= k m) d)
(let ((num 0.0)
(denom 0.0))
(do ((j 0 (+ 1 j)))
((= j (- n k 1)))
- (set! num (+ num (* (vector-ref wk1 j) (vector-ref wk2 j))))
- (set! denom (+ denom (sqr (vector-ref wk1 j)) (sqr (vector-ref wk2 j)))))
+ (set! num (+ num (* (wk1 j) (wk2 j))))
+ (set! denom (+ denom (sqr (wk1 j)) (sqr (wk2 j)))))
(if (not (= denom 0.0))
- (vector-set! d k (/ (* 2.0 num) denom)))
+ (set! (d k) (/ (* 2.0 num) denom)))
(do ((i 0 (+ i 1)))
((= i k)) ; 1st time is skipped presumably
- (vector-set! d i (- (vector-ref wkm i) (* (vector-ref d k) (vector-ref wkm (- k i 1))))))
+ (set! (d i) (- (wkm i) (* (d k) (wkm (- k i 1))))))
(if (< k (- m 1))
(begin
(do ((i 0 (+ i 1)))
((= i (+ 1 k)))
- (vector-set! wkm i (vector-ref d i)))
+ (set! (wkm i) (d i)))
(do ((j 0 (+ 1 j)))
((= j (- n k 2)))
- (vector-set! wk1 j (- (vector-ref wk1 j) (* (vector-ref wkm k) (vector-ref wk2 j))))
- (vector-set! wk2 j (- (vector-ref wk2 (+ 1 j)) (* (vector-ref wkm k) (vector-ref wk1 (+ 1 j)))))))))))))
+ (set! (wk1 j) (- (wk1 j) (* (wkm k) (wk2 j))))
+ (set! (wk2 j) (- (wk2 (+ 1 j)) (* (wkm k) (wk1 (+ 1 j)))))))))))))
(define* (lpc-predict data n coeffs m nf clipped)
@@ -2091,16 +2091,16 @@ is assumed to be outside -1.0 to 1.0."
(do ((i 0 (+ i 1))
(j (- n 1) (- j 1)))
((= i m))
- (vct-set! reg i (vct-ref data j)))
+ (set! (reg i) (data j)))
(do ((j 0 (+ 1 j)))
((= j nf) future)
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k m))
- (set! sum (+ sum (* (vector-ref coeffs k) (vct-ref reg k)))))
+ (set! sum (+ sum (* (coeffs k) (reg k)))))
(do ((k (- m 1) (- k 1)))
((= k 0))
- (vct-set! reg k (vct-ref reg (- k 1))))
+ (set! (reg k) (reg (- k 1))))
;; added this block
(if clipped
@@ -2110,8 +2110,8 @@ is assumed to be outside -1.0 to 1.0."
(if (> sum -1.0)
(set! sum -1.0))))
- (vct-set! reg 0 sum)
- (vct-set! future j sum)))))
+ (set! (reg 0) sum)
+ (set! (future j) sum)))))
@@ -2158,8 +2158,8 @@ is assumed to be outside -1.0 to 1.0."
(if in-clip ; if we were in a clipped portion
(begin ; save the bounds in clip-data
(set! in-clip #f)
- (vector-set! clip-data cur-clip clip-beg)
- (vector-set! clip-data (+ 1 cur-clip) (- samp 1))
+ (set! (clip-data cur-clip) clip-beg)
+ (set! (clip-data (+ 1 cur-clip)) (- samp 1))
(set! cur-clip (+ cur-clip 2))))))
(set! samp (+ 1 samp))
#f)))
@@ -2173,8 +2173,8 @@ is assumed to be outside -1.0 to 1.0."
(lambda ()
(do ((clip 0 (+ clip 2))) ; so go through all...
((>= clip clips))
- (let* ((clip-beg (vector-ref clip-data clip)) ; clip-beg to clip-end inclusive are clipped
- (clip-end (vector-ref clip-data (+ 1 clip)))
+ (let* ((clip-beg (clip-data clip)) ; clip-beg to clip-end inclusive are clipped
+ (clip-end (clip-data (+ 1 clip)))
(clip-len (+ 1 (- clip-end clip-beg)))
(data-len (max min-data-len (* clip-len 4))))
@@ -2183,8 +2183,8 @@ is assumed to be outside -1.0 to 1.0."
(let ((forward-data-len data-len)
(backward-data-len data-len)
- (previous-end (if (= clip 0) 0 (vector-ref clip-data (- clip 1))))
- (next-beg (if (< clip (- clips 3)) (vector-ref clip-data (+ clip 2)) (frames snd chn))))
+ (previous-end (if (= clip 0) 0 (clip-data (- clip 1))))
+ (next-beg (if (< clip (- clips 3)) (clip-data (+ clip 2)) (frames snd chn))))
(if (< (- clip-beg data-len) previous-end) ; current beg - data collides with previous
(begin
@@ -2222,19 +2222,19 @@ is assumed to be outside -1.0 to 1.0."
(j (- clip-len 1) (- j 1)))
((= i clip-len))
(let* ((sn (* 0.5 (+ 1.0 (cos (* pi (/ i (- clip-len 1))))))))
- (vct-set! new-data i (+ (* sn
- (vct-ref future i))
- (* (- 1.0 sn)
- (vct-ref past j))))))
+ (set! (new-data i) (+ (* sn
+ (future i))
+ (* (- 1.0 sn)
+ (past j))))))
;; todo perhaps move this mix dependent on data-lens?
;; todo perhaps special case for 2 samps (what if both 1.0 for example?)
;; todo perhaps if multichannel and channels are correlated and one is not clipped -- use
;; its data to help reconstruct clipped case?
- (vct-set! new-data 0 (if (> (vct-ref future 0) 0.0)
- (max (vct-ref future 0) (vct-ref past 0))
- (min (vct-ref future 0) (vct-ref past 0)))))
+ (set! (new-data 0) (if (> (future 0) 0.0)
+ (max (future 0) (past 0))
+ (min (future 0) (past 0)))))
;; write reconstruction
(vct->channel new-data clip-beg clip-len snd chn))))))))
@@ -2272,7 +2272,7 @@ is assumed to be outside -1.0 to 1.0."
(run
(do ((k 1 (+ 1 k)))
((= k size))
- (let ((datum (vct-ref data k))
+ (let ((datum (data k))
(xhatminus xhat))
(let* ((res (formant frm datum))
@@ -2282,7 +2282,7 @@ is assumed to be outside -1.0 to 1.0."
;; so filter lp effect increases as apparent true signal decreases
;; "truth" here is based on vocal resonances
- (vct-set! data k xhatminus) ; filter output
+ (set! (data k) xhatminus) ; filter output
(set! Pminus (+ P Q))
(set! K (/ Pminus (+ Pminus R)))
@@ -2332,7 +2332,7 @@ is assumed to be outside -1.0 to 1.0."
((> m order))
(set! fac (* fac k))
(set! sum (+ sum (* (frame-ref b m) fac))))
- (vct-set! result i sum)))
+ (set! (result i) sum)))
(make-fir-filter :order size :xcoeffs result))))
(define savitzky-golay-filter fir-filter)
@@ -2453,7 +2453,7 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(do ((i 0 (+ i 1)))
((>= (+ p (* 2 i)) n))
(set! dsum (+ dsum (* (expt -1 i)
- (* (vct-ref coeffs (+ p (* 2 i)))
+ (* (coeffs (+ p (* 2 i)))
(+ (binomial (+ p i) i)
(binomial (+ p i -1) (- i 1))))))))
(set! sum (+ sum (* dsum
@@ -2483,7 +2483,7 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(do ((i 0 (+ i 1))
(bin 2 (+ bin 2)))
((= i n))
- (vct-set! fft-rl bin (vct-ref cur-amps i)))
+ (set! (fft-rl bin) (cur-amps i)))
(vct-peak (mus-fft fft-rl fft-im size -1))))
(let* ((partials (if (list? any-partials)
@@ -2495,8 +2495,8 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(original-sum (let ((sum 0.0))
(do ((i 0 (+ i 2)))
((>= i len) sum)
- (let ((hnum (vct-ref partials i))
- (amp (vct-ref partials (+ i 1))))
+ (let ((hnum (partials i))
+ (amp (partials (+ i 1))))
(if (= hnum 0)
(set! DC amp)
(begin
@@ -2506,9 +2506,9 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(original-partials (let ((v (make-vct topk)))
(do ((i 0 (+ i 2)))
((>= i len) v)
- (let ((hnum (vct-ref partials i)))
+ (let ((hnum (partials i)))
(if (not (= hnum 0))
- (vct-set! v (- hnum 1) (vct-ref partials (+ i 1))))))))
+ (set! (v (- hnum 1)) (partials (+ i 1))))))))
(min-partials (vct-copy original-partials)))
(if (<= topk (/ (log tries) (log 2)))
@@ -2520,7 +2520,7 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(do ((k 0 (+ 1 k)))
((= k topk))
(if (> (random 1.0) 0.5)
- (vct-set! new-partials k (- (vct-ref new-partials k)))))
+ (set! (new-partials k) (- (new-partials k)))))
(let ((new-sum (cos-fft-to-max topk new-partials)))
(if (< new-sum min-sum)
(begin
@@ -2532,10 +2532,10 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(do ((i 0 (+ i 2))
(k 0 (+ k 1)))
((>= i len))
- (let ((hnum (vct-ref new-partials i)))
+ (let ((hnum (new-partials i)))
(if (= hnum 0)
- (vct-set! new-partials (+ i 1) DC)
- (vct-set! new-partials (+ i 1) (vct-ref new-amps (- hnum 1))))))
+ (set! (new-partials (+ i 1)) DC)
+ (set! (new-partials (+ i 1)) (new-amps (- hnum 1))))))
new-partials)))
diff --git a/edit123.scm b/edit123.scm
index 1ad41cf..603e3bd 100644
--- a/edit123.scm
+++ b/edit123.scm
@@ -163,21 +163,21 @@
;(set! (x-bounds)
; (list (/ (selection-position) (srate))
; (/ (+ (selection-position) (selection-frames)) (srate))))
-(play-selection))
+(play (selection)))
(define (test-mark-forw name length)
(stop-playing)
(select-channel 0)
(goto-named-mark name)
(make-selection (cursor) (+ (cursor) length))
-(play-selection))
+(play (selection)))
(define (test-mark-backw name length)
(stop-playing)
(select-channel 0)
(goto-named-mark name)
(make-selection (- (cursor) length) (cursor) )
-(play-selection))
+(play (selection)))
@@ -189,7 +189,7 @@
(set! (cursor) (+ (cursor) dif))
(mark-named "start")
(make-selection (cursor) (+ (cursor) length))
-(play-selection))
+(play (selection)))
(define (move-end dif length)
(stop-playing)
@@ -199,7 +199,7 @@
(set! (cursor) (+ (cursor) dif))
(mark-named "end")
(make-selection (- (cursor) length) (cursor))
-(play-selection))
+(play (selection)))
@@ -211,7 +211,7 @@
;(set! (x-bounds)
; (list (/ (selection-position) (srate))
; (/ (+ (selection-position) (selection-frames)) (srate))))
-(play-selection))
+(play (selection)))
@@ -220,7 +220,7 @@
(select-channel 0)
(set! (cursor) (- (cursor) dif))
(make-selection (cursor) (+ (cursor) length))
-(play-selection))
+(play (selection)))
@@ -238,7 +238,7 @@
(stop-playing)
(eos)
(make-selection (cursor) (+ (cursor) (selection-frames)))))
- (play-selection))
+ (play (selection)))
(define (backward-selection)
@@ -255,7 +255,7 @@
(stop-playing)
(set! (cursor) (selection-position))))
(make-selection (- (cursor) (selection-frames)) (cursor) )
- (play-selection))
+ (play (selection)))
(define (mark-start length)
@@ -270,7 +270,7 @@
(make-selection (cursor) (+ (cursor) length))
(stop-playing)
(key (char->integer #\t) 4)
-(play-selection))
+(play (selection)))
(define (mark-end length)
(select-channel 0)
@@ -283,7 +283,7 @@
(set! status 3)
(make-selection (- (cursor) length) (cursor) )
(key (char->integer #\t) 4)
-(play-selection))
+(play (selection)))
(define (stop-song)
(set! curpos (cursor))
@@ -377,7 +377,7 @@
(bind-key (char->integer #\z) 0 (lambda () (double-selection)));english version
(bind-key (char->integer #\^) 0 (lambda () (my-play-selection-forw 50000 50000)))
(bind-key (char->integer #\^) 4 (lambda () (my-play-selection-backw 50000 50000)))
-(bind-key (char->integer #\t) 8 (lambda () (play-selection)))
+(bind-key (char->integer #\t) 8 (lambda () (play (selection))))
(bind-key (char->integer #\p) 0 (lambda () (play-song)))
(bind-key (char->integer #\P) 1 (lambda () (play-end)))
(bind-key (char->integer #\p) 8 (lambda () (toggle-play)))
diff --git a/env.scm b/env.scm
index fa55327..18e3b88 100644
--- a/env.scm
+++ b/env.scm
@@ -455,11 +455,11 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"
(define* (envelope-exp e (power 1.0) (xgrid 100))
"(envelope-exp e (power 1.0) (xgrid 100)) approximates an exponential curve connecting the breakpoints"
(let* ((mn (min-envelope e))
- (largest-diff (exact->inexact (- (max-envelope e) mn)))
+ (largest-diff (* 1.0 (- (max-envelope e) mn)))
(x-min (car e))
(len (length e))
(x-max (list-ref e (- len 2)))
- (x-incr (exact->inexact (/ (- x-max x-min) xgrid)))
+ (x-incr (* 1.0 (/ (- x-max x-min) xgrid)))
(new-e '()))
(do ((x x-min (+ x x-incr)))
((>= x x-max))
@@ -485,7 +485,7 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"
(incrsamps (round (* incr fsr)))
(start (round (* beg fsr)))
(reader (make-sampler start file))
- (end (if dur (min (inexact->exact (+ start (round (* fsr dur))))
+ (end (if dur (min (* 1.0 (+ start (round (* fsr dur))))
(mus-sound-frames file))
(mus-sound-frames file)))
(rms (make-moving-average incrsamps))) ; this could use make-moving-rms from dsp.scm
@@ -497,7 +497,7 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"
((= j incrsamps))
(let ((val (reader)))
(set! rms-val (moving-average rms (* val val)))))
- (set! e (cons (exact->inexact (/ i fsr)) e))
+ (set! e (cons (* 1.0 (/ i fsr)) e))
(set! rms-val (sqrt rms-val))
(if db
(if (< rms-val .00001)
diff --git a/enved.scm b/enved.scm
index e8f0782..2dc538b 100644
--- a/enved.scm
+++ b/enved.scm
@@ -181,7 +181,7 @@
((= chan chans))
(let ((player (make-player sound chan))
(e (make-env (channel-envelope sound chan)
- :length (floor (exact->inexact (/ (frames sound chan) (dac-size)))))))
+ :length (floor (/ (frames sound chan) (dac-size))))))
(add-player player 0 -1 -1 (lambda (reason) (reset-hook! play-hook)))
(add-hook! play-hook (lambda (fr)
;; if fr (dac buffer size in frames) is not dac-size, we should do something debonair
diff --git a/examp.scm b/examp.scm
index c94b48a..267b7d1 100644
--- a/examp.scm
+++ b/examp.scm
@@ -148,7 +148,7 @@
(* 20.0 (log10 val))))
(do ((i 0 (+ i 1)))
((= i len))
- (vct-set! data i (+ 60.0 (dB (abs (vct-ref data i))))))
+ (set! (data i) (+ 60.0 (dB (abs (data i))))))
(graph data "dB"
(/ (left-sample snd chn) sr) (/ (right-sample snd chn) sr)
0.0 60.0
@@ -189,8 +189,8 @@
(srate file)
(mus-header-type-name (mus-sound-header-type file))
(mus-data-format-name (mus-sound-data-format file))
- (exact->inexact (/ (mus-sound-samples file)
- (* (channels file) (srate file))))))
+ (/ (mus-sound-samples file)
+ (* 1.0 (channels file) (srate file)))))
;;; -------- Correlation --------
@@ -206,7 +206,7 @@
(rs (right-sample snd 0))
(ilen (+ 1 (- rs ls)))
(pow2 (ceiling (/ (log ilen) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(fftscale (/ 1.0 fftlen))
(rl1 (channel->vct ls fftlen snd 0))
(rl2 (channel->vct ls fftlen snd 1))
@@ -304,7 +304,7 @@
(let* ((ls (left-sample snd chn))
(rs (right-sample snd chn))
(pow2 (ceiling (/ (log (- rs ls)) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2))))
+ (fftlen (floor (expt 2 pow2))))
(if (> pow2 2)
(let ((ffts '()))
(for-each
@@ -517,7 +517,7 @@ read an ASCII sound file"
(let loop ((val (read in-fd)))
(or (eof-object? val)
(begin
- (vct-set! data loc (* (exact->inexact val) short->float))
+ (set! (data loc) (* val short->float))
(set! loc (+ 1 loc))
(if (= loc bufsize)
(begin
@@ -684,7 +684,7 @@ otherwise it moves the cursor to the first offending sample"
(scan-channel
(lambda (y)
(let ((bin (floor (* (abs y) nbins))))
- (vector-set! bins bin (+ (vector-ref bins bin) 1))
+ (set! (bins bin) (+ (bins bin) 1))
#f)))
bins))
@@ -736,23 +736,23 @@ then inverse ffts."
(fft rdata idata 1)
(if (> lo 0)
(begin
- (vct-set! rdata 0 0.0)
- (vct-set! idata 0 0.0)
+ (set! (rdata 0) 0.0)
+ (set! (idata 0) 0.0)
(do ((i 1 (+ i 1))
(j (- fsize 1) (- j 1)))
((= i lo))
- (vct-set! rdata i 0.0)
- (vct-set! rdata j 0.0)
- (vct-set! idata i 0.0)
- (vct-set! idata j 0.0))))
+ (set! (rdata i) 0.0)
+ (set! (rdata j) 0.0)
+ (set! (idata i) 0.0)
+ (set! (idata j) 0.0))))
(if (< hi (/ fsize 2))
(do ((i hi (+ i 1))
(j (- fsize hi) (- j 1)))
((= i (/ fsize 2)))
- (vct-set! rdata i 0.0)
- (vct-set! rdata j 0.0)
- (vct-set! idata i 0.0)
- (vct-set! idata j 0.0)))
+ (set! (rdata i) 0.0)
+ (set! (rdata j) 0.0)
+ (set! (idata i) 0.0)
+ (set! (idata j) 0.0)))
(fft rdata idata -1)
(vct-scale! rdata (/ 1.0 fsize))
(vct->channel rdata 0 (- len 1) snd chn #f (format #f "fft-edit ~A ~A" bottom top))))
@@ -772,20 +772,20 @@ then inverse ffts."
(rectangular->polar vr vi)
(set! scaler (vct-peak vr)))
(let ((scl-squelch (* squelch scaler)))
- (if (< (sqrt (+ (* (vct-ref rdata 0) (vct-ref rdata 0)) (* (vct-ref idata 0) (vct-ref idata 0)))) scl-squelch)
+ (if (< (sqrt (+ (* (rdata 0) (rdata 0)) (* (idata 0) (idata 0)))) scl-squelch)
(begin
- (vct-set! rdata 0 0.0)
- (vct-set! idata 0 0.0)))
+ (set! (rdata 0) 0.0)
+ (set! (idata 0) 0.0)))
(do ((i 1 (+ i 1))
(j (- fsize 1) (- j 1)))
((= i fsize2))
- (let ((magnitude (sqrt (+ (* (vct-ref rdata i) (vct-ref rdata i)) (* (vct-ref idata i) (vct-ref idata i))))))
+ (let ((magnitude (sqrt (+ (* (rdata i) (rdata i)) (* (idata i) (idata i))))))
(if (< magnitude scl-squelch)
(begin
- (vct-set! rdata i 0.0)
- (vct-set! rdata j 0.0)
- (vct-set! idata i 0.0)
- (vct-set! idata j 0.0)))))
+ (set! (rdata i) 0.0)
+ (set! (rdata j) 0.0)
+ (set! (idata i) 0.0)
+ (set! (idata j) 0.0)))))
(fft rdata idata -1)
(vct-scale! rdata (/ 1.0 fsize)))
(vct->channel rdata 0 (- len 1) snd chn #f (format #f "fft-squelch ~A" squelch))
@@ -806,10 +806,10 @@ then inverse ffts."
(do ((i lo-bin (+ i 1))
(j (- fsize lo-bin) (- j 1)))
((> i hi-bin))
- (vct-set! rdata i 0.0) ; ignoring window side lobes for now
- (vct-set! idata i 0.0)
- (vct-set! rdata j 0.0)
- (vct-set! idata j 0.0)))
+ (set! (rdata i) 0.0) ; ignoring window side lobes for now
+ (set! (idata i) 0.0)
+ (set! (rdata j) 0.0)
+ (set! (idata j) 0.0)))
(fft rdata idata -1)
(vct-scale! rdata (/ 1.0 fsize))
(vct->channel rdata 0 (- len 1) snd chn #f (format #f "fft-cancel ~A ~A" lo-freq hi-freq))))
@@ -825,10 +825,10 @@ then inverse ffts."
;; at 1.0, and a ramp down when 'up' is #f, sticking at 0.0
;;
;; this could use the moving-average generator, though the resultant envelopes would be slightly less bumpy
- (let* ((ctr (vct-ref gen 0))
- (size (vct-ref gen 1))
+ (let* ((ctr (gen 0))
+ (size (gen 1))
(val (/ ctr size)))
- (vct-set! gen 0 (min size (max 0 (+ ctr (if up 1 -1)))))
+ (set! (gen 0) (min size (max 0 (+ ctr (if up 1 -1)))))
val))
(define* (make-ramp (size 128))
@@ -849,10 +849,10 @@ then inverse ffts."
(in-vowel #f))
(do ((i 0 (+ i 1)))
((= i (- fft-size 1)))
- (vct-set! rl i (read-ahead)))
+ (set! (rl i) (read-ahead)))
(set! ctr (- fft-size 1))
(map-channel (lambda (y)
- (vct-set! rl ctr (read-ahead))
+ (set! (rl ctr) (read-ahead))
(set! ctr (+ 1 ctr))
(if (= ctr fft-size)
(begin
@@ -860,7 +860,7 @@ then inverse ffts."
(vct-multiply! rl rl)
(vct-multiply! im im)
(vct-add! rl im)
- (set! in-vowel (> (+ (vct-ref rl 0) (vct-ref rl 1) (vct-ref rl 2) (vct-ref rl 3)) peak))
+ (set! in-vowel (> (+ (rl 0) (rl 1) (rl 2) (rl 3)) peak))
;; fancier version checked here ratio of this sum and
;; sum of all rl vals, returned vowel if > 0.5
(set! ctr 0)
@@ -884,16 +884,16 @@ then inverse ffts."
(e (make-env fft-env :length fsize2)))
(fft rdata idata 1)
(let ((val (env e)))
- (vct-set! rdata 0 (* val (vct-ref rdata 0)))
- (vct-set! idata 0 (* val (vct-ref idata 0))))
+ (set! (rdata 0) (* val (rdata 0)))
+ (set! (idata 0) (* val (idata 0))))
(do ((i 1 (+ i 1))
(j (- fsize 1) (- j 1)))
((= i fsize2))
(let ((val (env e)))
- (vct-set! rdata i (* val (vct-ref rdata i)))
- (vct-set! idata i (* val (vct-ref idata i)))
- (vct-set! rdata j (* val (vct-ref rdata j)))
- (vct-set! idata j (* val (vct-ref idata j)))))
+ (set! (rdata i) (* val (rdata i)))
+ (set! (idata i) (* val (idata i)))
+ (set! (rdata j) (* val (rdata j)))
+ (set! (idata j) (* val (idata j)))))
(fft rdata idata -1)
(vct-scale! rdata (/ 1.0 fsize))))
@@ -914,9 +914,9 @@ spectral envelopes) following interp (an env between 0 and 1)"
(do ((i 0 (+ i 1)))
((= i len))
(let ((pan (env e)))
- (vct-set! new-data i
- (+ (* (- 1.0 pan) (vct-ref data1 i))
- (* pan (vct-ref data2 i))))))
+ (set! (new-data i)
+ (+ (* (- 1.0 pan) (data1 i))
+ (* pan (data2 i))))))
(vct->channel new-data 0 (- len 1) snd chn #f (format #f "fft-env-interp '~A '~A '~A" env1 env2 interp))))
@@ -932,24 +932,24 @@ current spectrum value. (filter-fft (lambda (y) (if (< y .01) 0.0 else y))) is
(idata (make-vct fsize))
(spect (snd-spectrum rdata rectangular-window fsize #t 1.0 #f normalize))) ; not in-place!
(fft rdata idata 1)
- (flt (vct-ref spect 0))
+ (flt (spect 0))
(do ((i 1 (+ i 1))
(j (- fsize 1) (- j 1)))
((= i fsize2))
- (let* ((orig (vct-ref spect i))
+ (let* ((orig (spect i))
(cur (flt orig)))
(if (> (abs orig) .000001)
(let ((scl (/ cur orig)))
- (vct-set! rdata i (* scl (vct-ref rdata i)))
- (vct-set! idata i (* scl (vct-ref idata i)))
- (vct-set! rdata j (* scl (vct-ref rdata j)))
- (vct-set! idata j (* scl (vct-ref idata j))))
+ (set! (rdata i) (* scl (rdata i)))
+ (set! (idata i) (* scl (idata i)))
+ (set! (rdata j) (* scl (rdata j)))
+ (set! (idata j) (* scl (idata j))))
(if (> (abs cur) .000001)
(let ((scl (/ cur (sqrt 2.0))))
- (vct-set! rdata i scl)
- (vct-set! idata i scl)
- (vct-set! rdata j scl)
- (vct-set! idata j (- scl)))))))
+ (set! (rdata i) scl)
+ (set! (idata i) scl)
+ (set! (rdata j) scl)
+ (set! (idata j) (- scl)))))))
(fft rdata idata -1)
(if (not (= mx 0.0))
(let ((pk (vct-peak rdata)))
@@ -977,17 +977,17 @@ current spectrum value. (filter-fft (lambda (y) (if (< y .01) 0.0 else y))) is
(lo 0.0 (+ lo .12)))
((= i 8))
(env-sound (list 0 0 lo 1 1 0) 0 #f 32.0 ind 0 (+ i 1))
- (vector-set! mixers i (make-sampler 0 ind 0 1 (edit-position ind 0))))
+ (set! (mixers i) (make-sampler 0 ind 0 1 (edit-position ind 0))))
(scale-by 0.0)
(map-channel
(lambda (y)
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i 8) sum)
- (set! sum (+ sum (read-sample (vector-ref mixers i))))))))
+ (set! sum (+ sum (read-sample (mixers i))))))))
(do ((i 0 (+ i 1)))
((= i 8))
- (free-sampler (vector-ref mixers i))))
+ (free-sampler (mixers i))))
(scale-to mx))
|#
@@ -996,18 +996,18 @@ current spectrum value. (filter-fft (lambda (y) (if (< y .01) 0.0 else y))) is
(define* (fft-smoother cutoff start samps snd chn)
"(fft-smoother cutoff start samps snd chn) uses fft-filtering to smooth a
section: (vct->channel (fft-smoother .1 (cursor) 400) (cursor) 400)"
- (let* ((fftpts (inexact->exact (expt 2 (ceiling (/ (log (+ 1 samps)) (log 2.0))))))
+ (let* ((fftpts (floor (expt 2 (ceiling (/ (log (+ 1 samps)) (log 2.0))))))
(rl (channel->vct start fftpts snd chn))
(im (make-vct fftpts))
(top (floor (* fftpts cutoff))))
- (let* ((old0 (vct-ref rl 0))
- (old1 (vct-ref rl (- samps 1)))
+ (let* ((old0 (rl 0))
+ (old1 (rl (- samps 1)))
(oldmax (vct-peak rl)))
(fft rl im 1)
(do ((i top (+ i 1)))
((= i fftpts))
- (vct-set! rl i 0.0)
- (vct-set! im i 0.0))
+ (set! (rl i) 0.0)
+ (set! (im i) 0.0))
(fft rl im -1)
(vct-scale! rl (/ 1.0 fftpts))
(let ((newmax (vct-peak rl)))
@@ -1016,15 +1016,15 @@ section: (vct->channel (fft-smoother .1 (cursor) 400) (cursor) 400)"
(begin
(if (> (/ oldmax newmax) 1.5)
(vct-scale! rl (/ oldmax newmax)))
- (let* ((new0 (vct-ref rl 0))
- (new1 (vct-ref rl (- samps 1)))
+ (let* ((new0 (rl 0))
+ (new1 (rl (- samps 1)))
(offset0 (- old0 new0))
(offset1 (- old1 new1))
(incr (if (= offset1 offset0) 0.0 (/ (- offset1 offset0) samps))))
(do ((i 0 (+ i 1))
(trend offset0 (+ trend incr)))
((= i samps))
- (vct-set! rl i (+ (vct-ref rl i) trend)))
+ (set! (rl i) (+ (rl i) trend)))
rl)))))))
@@ -1043,7 +1043,7 @@ in a hurry use: (clm-channel (make-comb .8 32)) instead"
(define (comb-chord scaler size amp)
"(comb-chord scaler size amp) returns a set of harmonically-related comb filters: (map-channel (comb-chord .95 100 .3))"
- (let ((c1 (make-comb scaler (inexact->exact size)))
+ (let ((c1 (make-comb scaler (floor size)))
(c2 (make-comb scaler (floor (* size .75))))
(c3 (make-comb scaler (floor (* size 1.2)))))
(lambda (x)
@@ -1060,7 +1060,7 @@ envelope: (map-channel (zcomb .8 32 '(0 0 1 10)))"
mx
(max-envelope-1 (cddr e) (max mx (abs (cadr e))))))
- (let ((cmb (make-comb scaler size :max-size (inexact->exact (+ size 1 (max-envelope-1 pm 0.0)))))
+ (let ((cmb (make-comb scaler size :max-size (floor (+ size 1 (max-envelope-1 pm 0.0)))))
(penv (make-env pm :length (frames))))
(lambda (x)
(comb cmb x (env penv)))))
@@ -1112,19 +1112,19 @@ formants, then calls map-channel: (osc-formants .99 (vct 400.0 800.0 1200.0) (vc
(oscs (make-vector len)))
(do ((i 0 (+ i 1)))
((= i len))
- (vector-set! frms i (make-formant (vct-ref bases i) radius))
- (vector-set! oscs i (make-oscil (vct-ref freqs i))))
+ (set! (frms i) (make-formant (bases i) radius))
+ (set! (oscs i) (make-oscil (freqs i))))
(map-channel
(lambda (x)
(let ((val 0.0))
(do ((i 0 (+ i 1)))
((= i len))
- (let ((frm (vector-ref frms i)))
+ (let ((frm (frms i)))
(set! val (+ val (formant frm x)))
(set! (mus-frequency frm)
- (+ (vct-ref bases i)
- (* (vct-ref amounts i)
- (oscil (vector-ref oscs i)))))))
+ (+ (bases i)
+ (* (amounts i)
+ (oscil (oscs i)))))))
val)))))
@@ -1142,7 +1142,7 @@ formants, then calls map-channel: (osc-formants .99 (vct 400.0 800.0 1200.0) (vc
"(zecho scaler secs freq amp) returns a modulated echo maker: (map-channel (zecho .5 .75 6 10.0) 0 65000)"
(let* ((os (make-oscil frq))
(len (round (* secs (srate))))
- (del (make-delay len :max-size (inexact->exact (+ len amp 1)))))
+ (del (make-delay len :max-size (floor (+ len amp 1)))))
(lambda (inval)
(+ inval
(delay del
@@ -1206,7 +1206,7 @@ formants, then calls map-channel: (osc-formants .99 (vct 400.0 800.0 1200.0) (vc
(rd (make-src :srate 1.0
:input (lambda (dir)
(let ((val (if (and (>= i 0) (< i len))
- (vct-ref in-data i)
+ (in-data i)
0.0)))
(set! i (+ i dir))
val)))))
@@ -1297,7 +1297,7 @@ to produce a sound at a new pitch but at the original tempo. It returns a funct
(lambda (dir)
(granulate gr
(lambda (dir)
- (let ((val (vct-ref v inctr)))
+ (let ((val (v inctr)))
(set! inctr (+ inctr dir))
(if (>= inctr vsize)
(begin
@@ -1348,7 +1348,7 @@ selected sound: (map-channel (cross-synthesis (integer->sound 1) .5 128 6.0))"
(formants (make-vector freq-inc)))
(do ((i 0 (+ i 1)))
((= i freq-inc))
- (vector-set! formants i (make-formant (* i bin) radius)))
+ (set! (formants i) (make-formant (* i bin) radius)))
(lambda (inval)
(if (= ctr freq-inc)
(begin
@@ -1385,7 +1385,7 @@ selected sound: (map-channel (cross-synthesis (integer->sound 1) .5 128 6.0))"
(new-peak-amp 0.0))
(do ((i 0 (+ i 1)))
((= i freq-inc))
- (vector-set! formants i (make-formant (* i bin) radius)))
+ (set! (formants i) (make-formant (* i bin) radius)))
(call-with-exit ; setup non-local exit (for C-g interrupt)
(lambda (break) ; now (break value) will exit the call-with-exit returning value
(do ((k 0 (+ 1 k)))
@@ -1407,7 +1407,7 @@ selected sound: (map-channel (cross-synthesis (integer->sound 1) .5 128 6.0))"
(vct-add! spectr fdr)
(set! outval (formant-bank spectr formants (rand noi)))
(if (> (abs outval) new-peak-amp) (set! new-peak-amp (abs outval)))
- (vct-set! out-data k outval)))
+ (set! (out-data k) outval)))
(vct-scale! out-data (* amp (/ old-peak-amp new-peak-amp)))
(vct->channel out-data 0 (max len outlen) snd chn #f
(format #f "voiced->unvoiced ~A ~A ~A ~A" amp fftsize r tempo))))))
@@ -1433,7 +1433,7 @@ selected sound: (map-channel (cross-synthesis (integer->sound 1) .5 128 6.0))"
(new-peak-amp 0.0))
(do ((i 0 (+ i 1)))
((= i freq-inc))
- (vector-set! formants i (make-formant (* i bin) radius)))
+ (set! (formants i) (make-formant (* i bin) radius)))
(call-with-exit ; setup non-local exit (for C-g interrupt)
(lambda (break)
(do ((k 0 (+ 1 k)))
@@ -1454,7 +1454,7 @@ selected sound: (map-channel (cross-synthesis (integer->sound 1) .5 128 6.0))"
(vct-add! spectr fdr)
(set! outval (formant-bank spectr formants (ncos pulse)))
(if (> (abs outval) new-peak-amp) (set! new-peak-amp (abs outval)))
- (vct-set! out-data k outval)))
+ (set! (out-data k) outval)))
(vct-scale! out-data (* amp (/ old-peak-amp new-peak-amp)))
(vct->channel out-data 0 (max len len) snd chn)))))
@@ -1492,14 +1492,14 @@ selected sound: (map-channel (cross-synthesis (integer->sound 1) .5 128 6.0))"
(es (make-vector 8)))
(do ((i 0 (+ i 1)))
((= i 8))
- (vector-set! es i (make-env (list 0 (list-ref coeffs i) 1 0) :length 100)))
- (vector-set! es 5 (make-env '(0 .4 1 1) :duration 1.0))
+ (set! (es i) (make-env (list 0 (list-ref coeffs i) 1 0) :length 100)))
+ (set! (es 5) (make-env '(0 .4 1 1) :duration 1.0))
(lambda (x)
(let ((val (fir-filter flt x))
(xcof (mus-xcoeffs flt)))
(do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! xcof i (env (vector-ref es i))))
+ (set! (xcof i) (env (es i))))
val))))
;;; for something this simple (like a notch filter), we can use a two-zero filter:
@@ -1622,7 +1622,7 @@ the given channel following 'envelope' (as in env-sound-interp), using grains to
(do ((i 0 (+ i 1)))
((= i num-readers))
- (vector-set! grain-envs i (make-env grain-envelope :length grain-frames)))
+ (set! (grain-envs i) (make-env grain-envelope :length grain-frames)))
(do ((i 0 (+ i 1)))
((= i newlen))
@@ -1630,9 +1630,9 @@ the given channel following 'envelope' (as in env-sound-interp), using grains to
(if (>= i next-reader-starts-at)
(begin
- (vector-set! readers next-reader
- (make-sampler (max 0 (round (+ position-in-original (mus-random jitter)))) snd chn))
- (mus-reset (vector-ref grain-envs next-reader)) ; restart grain env
+ (set! (readers next-reader)
+ (make-sampler (max 0 (round (+ position-in-original (mus-random jitter)))) snd chn))
+ (mus-reset (grain-envs next-reader)) ; restart grain env
(set! next-reader (+ 1 next-reader))
(if (>= next-reader num-readers) (set! next-reader 0))
(set! next-reader-starts-at (+ next-reader-starts-at hop-frames))))
@@ -1640,8 +1640,8 @@ the given channel following 'envelope' (as in env-sound-interp), using grains to
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i num-readers))
- (if (sampler? (vector-ref readers i))
- (set! sum (+ sum (* (env (vector-ref grain-envs i)) (next-sample (vector-ref readers i)))))))
+ (if (sampler? (readers i))
+ (set! sum (+ sum (* (env (grain-envs i)) (next-sample (readers i)))))))
(sound-data-set! data 0 data-ctr sum))
(set! data-ctr (+ 1 data-ctr))
@@ -1856,7 +1856,7 @@ as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount m
(set! samp0 samp1)
(set! samp1 samp2)
(set! samp2 (next-sample reader))
- (vct-set! samps samps-ctr samp0)
+ (set! (samps samps-ctr) samp0)
(if (< samps-ctr 9)
(set! samps-ctr (+ samps-ctr 1))
(set! samps-ctr 0))
@@ -1889,30 +1889,26 @@ as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount m
(samps (make-vct 10))
(sctr 0))
(lambda (val)
- (declare (val float))
(set! samp0 samp1)
(set! samp1 samp2)
(set! samp2 val)
- (vct-set! samps sctr val)
+ (set! (samps sctr) val)
(set! sctr (+ sctr 1))
(if (>= sctr 10) (set! sctr 0))
(let ((local-max (max .1 (vct-peak samps))))
- (if (and (>= (abs (- samp0 samp1)) local-max)
- (>= (abs (- samp1 samp2)) local-max)
- (<= (abs (- samp0 samp2)) (/ local-max 2)))
- -1
- #f)))))
+ (and (>= (abs (- samp0 samp1)) local-max)
+ (>= (abs (- samp1 samp2)) local-max)
+ (<= (abs (- samp0 samp2)) (/ local-max 2)))))))
(define (zero+)
"(zero+) finds the next positive-going zero crossing (if searching forward) (for use with C-s)"
(let ((lastn 0.0))
(lambda (n)
- (declare (n float))
(let ((rtn (and (< lastn 0.0)
(>= n 0.0))))
(set! lastn n)
- (if rtn -1 #f)))))
+ rtn))))
(define (next-peak)
@@ -1925,7 +1921,7 @@ as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount m
(and (> last0 last1) (< last1 n))))))
(set! last0 last1)
(set! last1 n)
- (if rtn -1 #f)))))
+ rtn))))
(define (find-pitch pitch)
@@ -1941,7 +1937,7 @@ In most cases, this will be slightly offset from the true beginning of the note"
(let ((data (make-vct (transform-size)))
(data-loc 0))
(lambda (n)
- (vct-set! data data-loc n)
+ (set! (data data-loc) n)
(set! data-loc (+ 1 data-loc))
(let ((rtn #f))
(if (= data-loc (transform-size))
@@ -1958,17 +1954,17 @@ In most cases, this will be slightly offset from the true beginning of the note"
(= peak-loc 0))
0.0
(/ (* (+ pkloc
- (interpolated-peak-offset (vct-ref spectr (- pkloc 1))
+ (interpolated-peak-offset (spectr (- pkloc 1))
pk
- (vct-ref spectr (+ 1 pkloc))))
+ (spectr (+ 1 pkloc))))
(srate))
(transform-size))))
- (if (> (vct-ref spectr i) pk)
+ (if (> (spectr i) pk)
(begin
- (set! pk (vct-ref spectr i))
+ (set! pk (spectr i))
(set! pkloc i))))))
(if (< (abs (- pitch pit)) (/ (srate) (* 2 (transform-size)))) ; uh... why not do it direct?
- (set! rtn (- (/ (transform-size) 2)))))))
+ (set! rtn #t)))))
(vct-fill! data 0.0)))
rtn))))
@@ -1982,7 +1978,7 @@ In most cases, this will be slightly offset from the true beginning of the note"
(data (make-vct len)))
(do ((i 0 (+ i 1)))
((= i len))
- (vct-set! data i (next-sample reader)))
+ (set! (data i) (next-sample reader)))
(free-sampler reader)
data))
@@ -2015,7 +2011,7 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
(let ((time (floor (* 1000 (cadr tone))))
(region (car tone)))
(if (region? region)
- (in time (lambda () (play-region region))))))
+ (in time (lambda () (play region))))))
data))
@@ -2171,7 +2167,7 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
;; using do and vector here for the run macro's benefit
(do ((i 0 (+ i 1)))
((= i len))
- (let ((gen (vector-ref dsp-chain i)))
+ (let ((gen (dsp-chain i)))
(if (env? gen)
(set! val (* (gen) val))
(if (readin? gen)
@@ -2250,20 +2246,20 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
(data (vct 0.0 0.0 init-angle off scale)))
(ptree-channel
(lambda (y data forward)
- (let* ((angle (vct-ref data 0))
- (incr (vct-ref data 1))
- (val (+ (vct-ref data 3)
- (* (vct-ref data 4)
- (cos (+ (vct-ref data 2) angle))))))
+ (let* ((angle (data 0))
+ (incr (data 1))
+ (val (+ (data 3)
+ (* (data 4)
+ (cos (+ (data 2) angle))))))
(if forward
- (vct-set! data 0 (+ angle incr))
- (vct-set! data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos #t
(lambda (frag-beg frag-dur)
(let ((incr (/ pi frag-dur)))
- (vct-set! data 1 incr)
- (vct-set! data 0 (* frag-beg incr))
+ (set! (data 1) incr)
+ (set! (data 0) (* frag-beg incr))
data))
(format #f "smooth-channel-via-ptree ~A ~A" beg dur))))
@@ -2274,12 +2270,12 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
"(ring-modulate-channel freq (beg 0) dur snd chn edpos) ring-modulates the given channel"
(ptree-channel
(lambda (y data forward)
- (let* ((angle (vct-ref data 0))
- (incr (vct-ref data 1))
+ (let* ((angle (data 0))
+ (incr (data 1))
(val (* y (sin angle))))
(if forward
- (vct-set! data 0 (+ angle incr))
- (vct-set! data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos #f
(lambda (frag-beg frag-dur)
@@ -2301,20 +2297,20 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(let ((pos #f))
(do ((i 0 (+ i 1)))
((or pos (= i len)) pos)
- (if (= (vector-ref chans i) chan)
+ (if (= (chans i) chan)
(set! pos i)))))
(define (scramble-channels-1 cur-chans end-chans chans loc)
(if (> chans loc)
- (let* ((end-chan (vector-ref end-chans loc)) ; we want this channel at loc
- (cur-chan (vector-ref cur-chans loc)) ; this (original) channel is currently at loc
+ (let* ((end-chan (end-chans loc)) ; we want this channel at loc
+ (cur-chan (cur-chans loc)) ; this (original) channel is currently at loc
(end-loc (find-chan cur-chans end-chan chans))) ; where is end-chan currently?
;; end-chan goes in cur-chan's slot
(if (not (= cur-chan end-chan))
(begin
(swap-channels #f end-loc #f loc)
- (vector-set! cur-chans end-loc cur-chan)
- (vector-set! cur-chans loc end-chan)))
+ (set! (cur-chans end-loc) cur-chan)
+ (set! (cur-chans loc) end-chan)))
(scramble-channels-1 cur-chans end-chans chans (+ 1 loc)))))
(let ((len (length new-order)))
@@ -2323,7 +2319,7 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(cur-chans (make-vector len)))
(do ((i 0 (+ i 1)))
((= i len))
- (vector-set! cur-chans i i))
+ (set! (cur-chans i) i))
(scramble-channels-1 cur-chans end-chans len 0)))))
@@ -2357,7 +2353,7 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(ctr 0))
(for-each
(lambda (end)
- (vector-set! pieces ctr (make-region start end))
+ (set! (pieces ctr) (make-region start end))
(set! ctr (+ 1 ctr))
(set! start end))
edges)
@@ -2368,21 +2364,21 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(do ((i 0 (+ i 1)))
((= i len))
(let* ((this (random len))
- (reg (vector-ref pieces this)))
- (vector-set! pieces this #f)
+ (reg (pieces this)))
+ (set! (pieces this) #f)
(if (not reg)
(begin
(do ((j (+ 1 this) (+ 1 j)))
((or (= j len)
reg))
- (set! reg (vector-ref pieces j))
- (if reg (vector-set! pieces j #f)))
+ (set! reg (pieces j))
+ (if reg (set! (pieces j) #f)))
(if (not reg)
(do ((j (- this 1) (- j 1)))
((or (< j 0)
reg))
- (set! reg (vector-ref pieces j))
- (if reg (vector-set! pieces j #f))))))
+ (set! reg (pieces j))
+ (if reg (set! (pieces j) #f))))))
(mix-region reg start)
(set! start (+ start (frames reg)))
(forget-region reg)))))))
@@ -2499,18 +2495,18 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(set! possible-end i)
(if (< lval low)
(begin
- (vct-set! segments segctr (+ possible-end 128))
+ (set! (segments segctr) (+ possible-end 128))
(set! segctr (+ 1 segctr))
(set! in-sound #f)))))
(if (> val high)
(begin
- (vct-set! segments segctr (- i 128))
+ (set! (segments segctr) (- i 128))
(set! segctr (+ 1 segctr))
(set! in-sound #t)))))))
(free-sampler reader)
(if in-sound
(begin
- (vct-set! segments segctr end)
+ (set! (segments segctr) end)
(list (+ 1 segctr) segments))
(list segctr segments))))
@@ -2526,8 +2522,8 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(format fd "~%(~A ~S" ins-name (string-append dir-name "/" sound))
(do ((bnd 0 (+ bnd 2)))
((>= bnd segments))
- (let* ((segbeg (inexact->exact (vct-ref boundaries bnd)))
- (segdur (inexact->exact (- (vct-ref boundaries (+ 1 bnd)) segbeg))))
+ (let* ((segbeg (floor (boundaries bnd)))
+ (segdur (floor (- (boundaries (+ 1 bnd)) segbeg))))
(format fd " (~A ~A ~A)" segbeg segdur (segment-maxamp sound-name segbeg segdur))))
(format fd ")")
(mus-sound-forget (string-append dir-name "/" sound))))
@@ -2623,24 +2619,24 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(lambda (y data forward)
(let* ((sum 0.0)
- (order (floor (vct-ref data 0)))
- (cur-loc (floor (vct-ref data 1)))
- (init-time (> (vct-ref data 2) 0.0))
- (last-forward (> (vct-ref data 3) 0.0))
+ (order (floor (data 0)))
+ (cur-loc (floor (data 1)))
+ (init-time (> (data 2) 0.0))
+ (last-forward (> (data 3) 0.0))
(coeffs-0 4)
(state-0 (+ coeffs-0 order)))
(if (eq? last-forward forward)
(if init-time
(begin
- (vct-set! data 2 -1.0))
+ (set! (data 2) -1.0))
(begin
(if forward
(begin
(do ((i (- order 1) (- i 1)))
((= i 0))
- (vct-set! data (+ i state-0) (vct-ref data (+ i -1 state-0))))
- (vct-set! data state-0 y)
+ (set! (data (+ i state-0)) (data (+ i -1 state-0))))
+ (set! (data state-0) y)
(set! cur-loc (+ 1 cur-loc)))
(let ((pos (max 0 (- cur-loc order))))
@@ -2649,18 +2645,18 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(set! y (sample pos snd chn edpos)))
(do ((i 0 (+ i 1)))
((= i (- order 1)))
- (vct-set! data (+ i state-0) (vct-ref data (+ i 1 state-0))))
- (vct-set! data (+ state-0 order -1) y)
+ (set! (data (+ i state-0)) (data (+ i 1 state-0))))
+ (set! (data (+ state-0 order -1)) y)
(set! cur-loc (- cur-loc 1))))))
)
(do ((i 0 (+ i 1)))
((= i order))
- (set! sum (+ sum (* (vct-ref data (+ coeffs-0 i))
- (vct-ref data (+ state-0 i))))))
+ (set! sum (+ sum (* (data (+ coeffs-0 i))
+ (data (+ state-0 i))))))
- (vct-set! data 1 cur-loc)
- (if forward (vct-set! data 3 1.0) (vct-set! data 3 -1.0))
+ (set! (data 1) cur-loc)
+ (if forward (set! (data 3) 1.0) (set! (data 3) -1.0))
sum))
@@ -2671,63 +2667,29 @@ passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, a
(coeffs-0 4)
(state-0 (+ order coeffs-0))
(d (make-vct (+ coeffs-0 (* 2 order)))))
- (vct-set! d 0 order)
- (vct-set! d 2 1.0) ; first sample flag
- (if forward (vct-set! d 3 1.0) (vct-set! d 3 -1.0))
+ (set! (d 0) order)
+ (set! (d 2) 1.0) ; first sample flag
+ (if forward (set! (d 3) 1.0) (set! (d 3) -1.0))
(do ((i 0 (+ i 1)))
((= i order))
- (vct-set! d (+ i coeffs-0) (vct-ref coeffs i)))
+ (set! (d (+ i coeffs-0)) (coeffs i)))
(let ((start (- (+ 1 frag-beg beg) order))
(i (- order 1)))
(if (< start 0)
(do ()
((= start 0))
- (vct-set! d (+ i state-0) 0)
+ (set! (d (+ i state-0)) 0)
(set! i (- i 1))
(set! start (+ 1 start))))
(if (>= i 0)
(let ((rd (make-sampler start snd chn 1 edpos)))
(do ()
((= i -1))
- (vct-set! d (+ i state-0) (rd))
+ (set! (d (+ i state-0)) (rd))
(set! i (- i 1)))
(free-sampler rd)))
- (vct-set! d 1 (+ frag-beg beg))
+ (set! (d 1) (+ frag-beg beg))
d)))))
-
-#|
-;;; if we could stack up ptrees like mixes:
-
-(define (add-channel scl orig-beg new-beg dur snd chn edpos)
- (ptree-channel
-
- (lambda (y data forward)
- (declare (y real) (data sampler) (forward boolean))
- (+ y (* scl (if forward
- (next-sample data)
- (previous-sample data)))))
-
- new-beg dur snd chn -1 #f
-
- (lambda (frag-beg frag-dur forward)
- (make-sampler (+ frag-beg orig-beg) snd chn
- (if forward 1 -1)
- (if (>= edpos 0) edpos (edit-position snd chn))))))
-
-;;; (add-channel 0.5 0 10000 (frames 0 0) 0 0 0)
-
-(define (virtual-filter-channel coeffs beg dur snd chn edpos)
- (let ((order (length coeffs))
- (pos (if (>= edpos 0) edpos (edit-position snd chn))))
- (as-one-edit
- (lambda ()
- (scale-channel 0.0 beg dur snd chn edpos) ; so that filter replaces original
- (do ((i 0 (+ i 1)))
- ((= i order))
- (add-channel (vct-ref coeffs i) beg (+ beg i) dur snd chn pos))))))
-
-;;; (virtual-filter-channel (vct 1.0 0.5 0.25) 0 (frames 0 0) 0 0 0)
-|#
diff --git a/extensions.scm b/extensions.scm
index ce2d5f2..360a991 100644
--- a/extensions.scm
+++ b/extensions.scm
@@ -81,8 +81,8 @@ two sounds open (indices 0 and 1 for example), and the second has two channels,
(envs (make-vector 1))
(inenvs (make-vector 1)))
(mus-sound-close-output tmpfil 0)
- (vector-set! inenvs 0 (make-env env :length len))
- (vector-set! envs 0 inenvs)
+ (set! (inenvs 0) (make-env env :length len))
+ (set! (envs 0) inenvs)
(mus-mix tmp-name filename 0 len 0 mx envs)
(mix tmp-name beg)
(delete-file tmp-name)))
@@ -234,8 +234,7 @@ If 'check' is #f, the hooks are removed."
(format fd "~S" field)
(format fd "\"~S\"" field)) ; sometimes format omits the double quotes!
(if (number? field)
- (if (and (exact? field)
- (rational? field)) ; get these out of our way before float stuff
+ (if (rational? field) ; get these out of our way before float stuff
(format fd "~A" field)
(format fd "~,4F" field))
(if (procedure? field)
@@ -528,13 +527,13 @@ connects them with 'func', and applies the result as an amplitude envelope to th
;; vct: angle incr off scl
(ptree-channel
(lambda (y data forward)
- (let* ((angle (vct-ref data 0))
- (incr (vct-ref data 1))
- (val (* y (+ (vct-ref data 2) (* (vct-ref data 3) (+ 0.5 (* 0.5 (cos angle))))))))
+ (let* ((angle (data 0))
+ (incr (data 1))
+ (val (* y (+ (data 2) (* (data 3) (+ 0.5 (* 0.5 (cos angle))))))))
;; this could be optimized into offset=off+scl/2 and scl=scl/2, then (* y (+ off (* scl cos)))
(if forward
- (vct-set! data 0 (+ angle incr))
- (vct-set! data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos #t
(lambda (frag-beg frag-dur)
@@ -563,16 +562,16 @@ connects them with 'func', and applies the result as an amplitude envelope to th
;; vct: angle incr off scl
(ptree-channel
(lambda (y data forward)
- (let* ((angle (vct-ref data 0))
- (incr (vct-ref data 1))
+ (let* ((angle (data 0))
+ (incr (data 1))
(cx (cos angle))
- (val (* y (+ (vct-ref data 2)
- (* (vct-ref data 3)
+ (val (* y (+ (data 2)
+ (* (data 3)
(+ .084037 (* cx (+ -.29145 (* cx (+ .375696 (* cx (+ -.20762 (* cx .041194)))))))))))))
;; blackman2 would be: (+ .34401 (* cx (+ -.49755 (* cx .15844))))
(if forward
- (vct-set! data 0 (+ angle incr))
- (vct-set! data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos #t
(lambda (frag-beg frag-dur)
@@ -601,12 +600,12 @@ connects them with 'func', and applies the result as an amplitude envelope to th
;; vct: start incr off scl
(ptree-channel
(lambda (y data forward)
- (let* ((angle (vct-ref data 0))
- (incr (vct-ref data 1))
- (val (* y (+ (vct-ref data 2) (* angle angle (vct-ref data 3))))))
+ (let* ((angle (data 0))
+ (incr (data 1))
+ (val (* y (+ (data 2) (* angle angle (data 3))))))
(if forward
- (vct-set! data 0 (+ angle incr))
- (vct-set! data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos #t
(lambda (frag-beg frag-dur)
@@ -637,12 +636,12 @@ connects them with 'func', and applies the result as an amplitude envelope to th
;; a^x = exp(x * log(a))
(ptree-channel
(lambda (y data forward)
- (let* ((angle (vct-ref data 0))
- (incr (vct-ref data 1))
- (val (* y (+ (vct-ref data 2) (* (exp (* (log angle) (vct-ref data 4))) (vct-ref data 3))))))
+ (let* ((angle (data 0))
+ (incr (data 1))
+ (val (* y (+ (data 2) (* (exp (* (log angle) (data 4))) (data 3))))))
(if forward
- (vct-set! data 0 (+ angle incr))
- (vct-set! data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos #t
(lambda (frag-beg frag-dur)
@@ -784,24 +783,24 @@ connects them with 'func', and applies the result as an amplitude envelope to th
(edit-position snd chn)
edpos)))
(ptree-channel (lambda (y data dir)
- (let* ((pos (floor (vct-ref data 0)))
- (len (floor (vct-ref data 1)))
- (val (vct-ref data (+ pos 2))))
- (vct-set! data (+ pos 2) y)
+ (let* ((pos (floor (data 0)))
+ (len (floor (data 1)))
+ (val (data (+ pos 2))))
+ (set! (data (+ pos 2)) y)
(set! pos (+ 1 pos))
- (if (>= pos len) (vct-set! data 0 0) (vct-set! data 0 pos))
+ (if (>= pos len) (set! (data 0) 0) (set! (data 0) pos))
val))
beg dur snd chn edpos #f
(lambda (fpos fdur)
(let ((data (make-vct (+ dly 2))))
- (vct-set! data 0 0.0)
- (vct-set! data 1 dly)
+ (set! (data 0) 0.0)
+ (set! (data 1) dly)
(if (= fpos 0)
data
(let* ((reader (make-sampler (- fpos 1) snd chn -1 cur-edpos)))
(do ((i (- dly 1) (- i 1)))
((< i 0))
- (vct-set! data (+ i 2) (reader)))
+ (set! (data (+ i 2)) (reader)))
data)))))))
|#
@@ -1021,19 +1020,19 @@ connects them with 'func', and applies the result as an amplitude envelope to th
(call 0))
(do ((i 0 (+ i 1)))
((= i (length st)))
- (let ((lst (vector-ref st i)))
+ (let ((lst (st i)))
(for-each
(lambda (sym)
(if (and (defined? sym)
(procedure? (symbol->value sym)))
(begin
- (vector-set! calls call (list sym (symbol-calls sym)))
+ (set! (calls call) (list sym (symbol-calls sym)))
(set! call (+ call 1)))))
lst)))
(let ((new-calls (make-vector call)))
(do ((i 0 (+ i 1)))
((= i call))
- (vector-set! new-calls i (vector-ref calls i)))
+ (set! (new-calls) i (calls i)))
(let ((sorted-calls (sort! new-calls
(lambda (a b)
(or (> (cadr a) (cadr b))
@@ -1044,5 +1043,5 @@ connects them with 'func', and applies the result as an amplitude envelope to th
(lambda ()
(do ((i 0 (+ i 1)))
((= i call))
- (let ((c (vector-ref sorted-calls i)))
+ (let ((c (sorted-calls i)))
(format #t "~A:~40T~A~%" (car c) (cadr c)))))))))))
diff --git a/extsnd.html b/extsnd.html
index 60d3fd0..7f74b7a 100644
--- a/extsnd.html
+++ b/extsnd.html
@@ -398,173 +398,176 @@ Extensions to Snd can be found in:
<tr><td><a href="sndscm.html#bessdoc">bess</a></td>
<td onmouseout="UnTip()" onmouseover="Tip(bess_doc_tip)">FM demo</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#birddoc">bird</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(bird_doc_tip)">North-American birds</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#binaryiodoc">binary-io</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(binary_io_doc_tip)">binary files</td></tr>
-<tr><td><a href="sndscm.html#cleandoc">clean</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(clean_doc_tip)">noise reduction</td></tr>
+<tr><td><a href="sndscm.html#birddoc">bird</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(bird_doc_tip)">North-American birds</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#clminsdoc">clm-ins, clm23</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(clm_ins_doc_tip)">various CLM instruments</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#cleandoc">clean</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(clean_doc_tip)">noise reduction</td></tr>
-<tr><td><a href="sndscm.html#dlocsigdoc">dlocsig</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(dlocsig_doc_tip)">moving sounds (Michael Scholz)</td></tr>
+<tr><td><a href="sndscm.html#clminsdoc">clm-ins, clm23</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(clm_ins_doc_tip)">various CLM instruments</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#drawdoc">draw</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(draw_doc_tip)">graphics additions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#dlocsigdoc">dlocsig</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dlocsig_doc_tip)">moving sounds (Michael Scholz)</td></tr>
-<tr><td><a href="sndscm.html#dspdoc">dsp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(dsp_doc_tip)">various DSP-related procedures</td></tr>
+<tr><td><a href="sndscm.html#drawdoc">draw</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(draw_doc_tip)">graphics additions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#envdoc">env</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(env_doc_tip)">envelope functions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#dspdoc">dsp</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dsp_doc_tip)">various DSP-related procedures</td></tr>
-<tr><td><a href="sndscm.html#enveddoc">enved</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(enved_doc_tip)">envelope editor</td></tr>
+<tr><td><a href="sndscm.html#envdoc">env</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(env_doc_tip)">envelope functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#exampdoc">examp</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(examp_doc_tip)">many examples</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#enveddoc">enved</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(enved_doc_tip)">envelope editor</td></tr>
-<tr><td><a href="sndscm.html#extensionsdoc">extensions</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(extensions_doc_tip)">various generally useful Snd extensions</td></tr>
+<tr><td><a href="sndscm.html#exampdoc">examp</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(examp_doc_tip)">many examples</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#fadedoc">fade</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(fade_doc_tip)">frequency-domain cross-fades</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#extensionsdoc">extensions</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(extensions_doc_tip)">various generally useful Snd extensions</td></tr>
-<tr><td><a href="sndscm.html#framedoc">frame</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(frame_doc_tip)">frames, vcts, sound-data objects</td></tr>
+<tr><td><a href="sndscm.html#fadedoc">fade</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(fade_doc_tip)">frequency-domain cross-fades</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#freeverbdoc">freeverb</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(freeverb_doc_tip)">a reverb</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#framedoc">frame</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(frame_doc_tip)">frames, vcts, sound-data objects</td></tr>
-<tr><td><a href="sndclm.html#othergenerators">generators</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(generators_doc_tip)">a bunch of generators</td></tr>
+<tr><td><a href="sndscm.html#freeverbdoc">freeverb</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(freeverb_doc_tip)">a reverb</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#granidoc">grani</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(grani_doc_tip)">CLM's grani (Fernando Lopez-Lezcano and Mike Scholz)</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndclm.html#othergenerators">generators</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(generators_doc_tip)">a bunch of generators</td></tr>
-<tr><td><a href="sndscm.html#heartdoc">heart</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(heart_doc_tip)">use Snd with non-sound (arbitrary range) data</td></tr>
+<tr><td><a href="sndscm.html#granidoc">grani</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(grani_doc_tip)">CLM's grani (Fernando Lopez-Lezcano and Mike Scholz)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#hooksdoc">hooks</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(hooks_doc_tip)">functions related to hooks</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#heartdoc">heart</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(heart_doc_tip)">use Snd with non-sound (arbitrary range) data</td></tr>
-<tr><td><a href="sndscm.html#indexdoc">index</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(index_doc_tip)">snd-help extension</td></tr>
+<tr><td><a href="sndscm.html#hooksdoc">hooks</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(hooks_doc_tip)">functions related to hooks</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#dotemacs">inf-snd.el, DotEmacs</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(inf_snd_doc_tip)">Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#indexdoc">index</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(index_doc_tip)">snd-help extension</td></tr>
-<tr><td><a href="sndscm.html#jcrevdoc">jcrev</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(jcrev_doc_tip)">John Chowning's ancient reverb</td></tr>
+<tr><td><a href="sndscm.html#dotemacs">inf-snd.el, DotEmacs</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(inf_snd_doc_tip)">Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#maracadoc">maraca</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(maraca_doc_tip)">Perry Cook's maraca physical model</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#jcrevdoc">jcrev</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(jcrev_doc_tip)">John Chowning's ancient reverb</td></tr>
-<tr><td><a href="sndscm.html#marksdoc">marks</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(marks_doc_tip)">functions related to marks</td></tr>
+<tr><td><a href="sndscm.html#maracadoc">maraca</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(maraca_doc_tip)">Perry Cook's maraca physical model</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#maxfdoc">maxf</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(maxf_doc_tip)">Max Mathews resonator</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#marksdoc">marks</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(marks_doc_tip)">functions related to marks</td></tr>
-<tr><td><a href="sndscm.html#menusdoc">menus</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(menus_doc_tip)">additional menus</td></tr>
+<tr><td><a href="sndscm.html#maxfdoc">maxf</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(maxf_doc_tip)">Max Mathews resonator</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#mixdoc">mix</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(mix_doc_tip)">functions related to mixes</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#menusdoc">menus</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(menus_doc_tip)">additional menus</td></tr>
-<tr><td><a href="sndscm.html#mixerdoc">mixer</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(mixer_doc_tip)">functions related to linear algebra</td></tr>
+<tr><td><a href="sndscm.html#mixdoc">mix</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(mix_doc_tip)">functions related to mixes</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#moogdoc">moog</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(moog_doc_tip)">Moog filter</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#mixerdoc">mixer</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(mixer_doc_tip)">functions related to linear algebra</td></tr>
-<tr><td><a href="sndscm.html#musglyphs">musglyphs</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(musglyphs_doc_tip)">Music notation symbols (from CMN)</td></tr>
+<tr><td><a href="sndscm.html#moogdoc">moog</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(moog_doc_tip)">Moog filter</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#nbdoc">nb</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(nb_doc_tip)">Popup File info etc</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#musglyphs">musglyphs</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(musglyphs_doc_tip)">Music notation symbols (from CMN)</td></tr>
-<tr><td><a href="sndscm.html#noisedoc">noise</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(noise_doc_tip)">noise maker</td></tr>
+<tr><td><a href="sndscm.html#nbdoc">nb</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(nb_doc_tip)">Popup File info etc</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#numericsdoc">numerics</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(numerics_doc_tip)">various numerical functions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#noisedoc">noise</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(noise_doc_tip)">noise maker</td></tr>
-<tr><td><a href="sndscm.html#oscopedoc">oscope</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(oscope_doc_tip)">an oscilloscope/spectrum analysis dialog</td></tr>
+<tr><td><a href="sndscm.html#numericsdoc">numerics</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(numerics_doc_tip)">various numerical functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#peakphasesdoc">peak-phases</a></td>
- <td bgcolor="#f2f4ff">phases for the unpulse-train</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#oscopedoc">oscope</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(oscope_doc_tip)">an oscilloscope/spectrum analysis dialog</td></tr>
-<tr><td><a href="sndscm.html#pianodoc">piano</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(piano_doc_tip)">piano physical model</td></tr>
+<tr><td><a href="sndscm.html#peakphasesdoc">peak-phases</a></td>
+ <td>phases for the unpulse-train</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#playdoc">play</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(play_doc_tip)">play-related functions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#pianodoc">piano</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(piano_doc_tip)">piano physical model</td></tr>
-<tr><td><a href="sndscm.html#polydoc">poly</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(poly_doc_tip)">polynomial-related stuff</td></tr>
+<tr><td><a href="sndscm.html#playdoc">play</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(play_doc_tip)">play-related functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#popupdoc">popup, gtk-popup</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(popup_doc_tip)">Popup menu specializations</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#polydoc">poly</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(poly_doc_tip)">polynomial-related stuff</td></tr>
-<tr><td><a href="sndscm.html#prc95doc">prc95</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(prc95_doc_tip)">Perry Cook's physical model examples</td></tr>
+<tr><td><a href="sndscm.html#popupdoc">popup, gtk-popup</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(popup_doc_tip)">Popup menu specializations</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#pvocdoc">pvoc</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(pvoc_doc_tip)">phase-vocoder</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#prc95doc">prc95</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(prc95_doc_tip)">Perry Cook's physical model examples</td></tr>
-<tr><td><a href="sndscm.html#rgbdoc">rgb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rgb_doc_tip)">color names</td></tr>
+<tr><td><a href="sndscm.html#pvocdoc">pvoc</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(pvoc_doc_tip)">phase-vocoder</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#rtiodoc">rtio</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(rtio_doc_tip)">real-time stuff</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#rgbdoc">rgb</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(rgb_doc_tip)">color names</td></tr>
-<tr><td><a href="sndscm.html#rubberdoc">rubber</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rubber_doc_tip)">rubber-sound</td></tr>
+<tr><td><a href="sndscm.html#rtiodoc">rtio</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(rtio_doc_tip)">real-time stuff</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#selectiondoc">selection</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(selection_doc_tip)">functions acting on the current selection</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#rubberdoc">rubber</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(rubber_doc_tip)">rubber-sound</td></tr>
-<tr><td><a href="sndscm.html#singerdoc">singer</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(singer_doc_tip)">Perry Cook's vocal-tract physical model</td></tr>
+<tr><td><a href="sndscm.html#selectiondoc">selection</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(selection_doc_tip)">functions acting on the current selection</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndolddoc">snd6|7|8|9|10|11.scm</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(sndold_doc_tip)">Backwards compatibility</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#singerdoc">singer</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(singer_doc_tip)">Perry Cook's vocal-tract physical model</td></tr>
-<tr><td><a href="sndscm.html#snddiffdoc">snddiff</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snddiff_doc_tip)">sound difference detection</td></tr>
+<tr><td><a href="sndscm.html#sndolddoc">snd6|7|8|9|10|11.scm</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(sndold_doc_tip)">Backwards compatibility</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndgldoc">snd-gl</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(snd_gl_doc_tip)">OpenGL examples (gl.c)</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#snddiffdoc">snddiff</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snddiff_doc_tip)">sound difference detection</td></tr>
-<tr><td><a href="sndscm.html#sndmotifdoc">snd-motif, snd-gtk, snd-xm</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snd_motif_doc_tip)">Motif/Gtk module (xm.c, xg.c)</td></tr>
+<tr><td><a href="sndscm.html#sndgldoc">snd-gl</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(snd_gl_doc_tip)">OpenGL examples (gl.c)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndtestdoc">snd-test</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(snd_test_doc_tip)">Snd regression tests</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndmotifdoc">snd-motif, snd-gtk, snd-xm</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snd_motif_doc_tip)">Motif/Gtk module (xm.c, xg.c)</td></tr>
-<tr><td><a href="sndscm.html#sndwarpdoc">sndwarp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(sndwarp_doc_tip)">Bret Battey's sndwarp instrument</td></tr>
+<tr><td><a href="sndscm.html#sndtestdoc">snd-test</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(snd_test_doc_tip)">Snd regression tests</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#spectrdoc">spectr</a></td>
- <td bgcolor="#f2f4ff">instrument steady state spectra</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndwarpdoc">sndwarp</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(sndwarp_doc_tip)">Bret Battey's sndwarp instrument</td></tr>
-<tr><td><a href="sndscm.html#stochasticdoc">stochastic</a></td>
- <td>Bill Sack's dynamic stochastic synthesis</td></tr>
+<tr><td><a href="sndscm.html#spectrdoc">spectr</a></td>
+ <td>instrument steady state spectra</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#straddoc">strad</a></td>
- <td bgcolor="#f2f4ff">string physical model (from CLM)</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#stochasticdoc">stochastic</a></td>
+ <td bgcolor="#f2f4ff">Bill Sack's dynamic stochastic synthesis</td></tr>
-<tr><td><a href="sndscm.html#vdoc">v</a></td>
- <td>fm-violin</td></tr>
+<tr><td><a href="sndscm.html#straddoc">strad</a></td>
+ <td>string physical model (from CLM)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#wsdoc">ws</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(ws_doc_tip)">with-sound</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#vdoc">v</a></td>
+ <td bgcolor="#f2f4ff">fm-violin</td></tr>
-<tr><td><a href="sndscm.html#zipdoc">zip</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(zip_doc_tip)">the zipper (the anti-cross-fader)</td></tr>
+<tr><td><a href="sndscm.html#wsdoc">ws</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(ws_doc_tip)">with-sound</td></tr>
+
+<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#zipdoc">zip</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(zip_doc_tip)">the zipper (the anti-cross-fader)</td></tr>
</table>
</td></tr></table>
@@ -1366,9 +1369,6 @@ and <a href="#sndsounds">sounds</a> (as objects or as integers).
<A NAME="genericsync">sync</A> accesses the '<a href="#sync">sync</a>' field of a sound, mark, or mix.
</td></tr><tr><td colspan=2 height=18></td></tr>
-
-
-
</table>
<br><br>
@@ -1719,7 +1719,7 @@ the fft starts from the left window edge. To have it start at mid-window:
<table border=0 cellpadding=5 vspace=10><tr><td><pre>
(<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_add_hook_tip)">add-hook!</a> <em class=red>before-transform-hook</em>
(lambda (snd chn) ; 0.5 * (left + right) = midpoint
- (inexact-&gt;exact (round (* 0.5 (+ (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn) (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn)))))))
+ (round (* 0.5 (+ (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn) (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn))))))
</pre></td></tr></table>
The following
@@ -2119,8 +2119,8 @@ and if the <a href="#marksync">mark-sync</a> is not 0, the hook is called on eac
(bps (/ (<a class=quiet href="#beatsperminute" onmouseout="UnTip()" onmouseover="Tip(extsnd_beatsperminute_tip)">beats-per-minute</a> snd chn) 60.0))
(sr (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd))
(beat (floor (/ (* samp bps) sr)))
- (lower (inexact-&gt;exact (/ (* beat sr) bps)))
- (higher (inexact-&gt;exact (/ (* (+ 1 beat) sr) bps))))
+ (lower (floor (/ (* beat sr) bps)))
+ (higher (floor (/ (* (+ 1 beat) sr) bps))))
(set! (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> mrk)
(if (&lt; (- samp lower) (- higher samp))
lower
@@ -2192,10 +2192,10 @@ This hook is called upon a mouse button release or click (with various exception
(define (click-to-center snd chn button state x y axis)
;; if mouse click in time domain graph, set cursor as normally, but also center the window
(if (= axis <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_time_graph_tip)">time-graph</a>)
- (let ((samp (inexact-&gt;exact (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd) (<a class=quiet href="#positiontox" onmouseout="UnTip()" onmouseover="Tip(extsnd_positiontox_tip)">position-&gt;x</a> x snd chn)))))
+ (let ((samp (floor (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd) (<a class=quiet href="#positiontox" onmouseout="UnTip()" onmouseover="Tip(extsnd_positiontox_tip)">position-&gt;x</a> x snd chn)))))
(set! (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a> snd chn) samp)
(set! (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn)
- (- samp (inexact-&gt;exact (* .5 (- (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn) (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn))))))
+ (- samp (floor (* .5 (- (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn) (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn))))))
(<a class=quiet href="#updatetimegraph" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatetimegraph_tip)">update-time-graph</a>)
#t)
#f))
@@ -2683,7 +2683,7 @@ found (this code has to be in the ~/.snd init file):
</td></tr><tr><td></td><td colspan=2>
This hook is called when a sound is about to be played.
If its function returns #t, Snd does not play.
-We can use this hook to replace "play" with "play-selection" if the
+We can use this hook to replace "play" with "play selection" if the
selection is active:
<table border=0 cellpadding=5 vspace=10><tr><td><pre>
@@ -3117,7 +3117,7 @@ read-region-sample returns the next sample read by the region-sampler 'obj'.
(data (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> len)))
(do ((i 0 (+ 1 i)))
((= i len) data)
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data i (<em class=red>reader</em>))))
+ (set! (data i) (<em class=red>reader</em>))))
(throw 'no-such-channel (list "region-&gt;vct" reg chn)))
(throw 'no-such-region (list "region-&gt;vct" reg))))
</pre></td></tr></table>
@@ -3226,7 +3226,7 @@ the added complexity.
<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> creates a new vct object. It is freed by the
garbage collector when it can't be referenced any further. To get
an element of a vct, use <a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a>; similarly <a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a>
-sets an element.
+sets an element. (vct's are applicable objects, so vct-ref can always be omitted, and set! can replace vct-set!).
Once created, a vct can be passed to a variety of built-in
functions:</p>
@@ -3595,10 +3595,10 @@ channel:
(define (vct-polynomial v coeffs)
(let* ((v-len (<em class=red>length</em> v))
(num-coeffs (<em class=red>length</em> coeffs))
- (new-v (<em class=red>make-vct</em> v-len (<em class=red>vct-ref</em> coeffs (- num-coeffs 1)))))
+ (new-v (<em class=red>make-vct</em> v-len (coeffs (- num-coeffs 1)))))
(do ((i (- num-coeffs 2) (- i 1)))
((&lt; i 0))
- (<em class=red>vct-offset!</em> (<em class=red>vct-multiply!</em> new-v v) (<em class=red>vct-ref</em> coeffs i)))
+ (<em class=red>vct-offset!</em> (<em class=red>vct-multiply!</em> new-v v) (coeffs i)))
new-v))
(define* (channel-polynomial coeffs snd chn)
@@ -4546,9 +4546,27 @@ in marks.scm finds a named mark in any channel (a global version of find-mark).
<!-- integer->mark -->
<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="integertomark">integer-&gt;mark</a> i</code>
</td></tr><tr><td></td><td>
-In olden times, a mark was handled in Snd code as an integer; nowadays, it's an object.
-This function, and its companion <a href="#marktointeger">mark-&gt;integer</a>, exist mainly to convert
-old code to the current style.
+<p>In olden times, a mark was handled in Snd code as an integer; nowadays, it's an object.
+Originally I said, "this function, and its companion <a href="#marktointeger">mark-&gt;integer</a>, exist mainly to convert
+old code to the current style", but that was premature. The mark-as-integer approach was handy
+because it's easy to type the mark's identifying integer. I changed from integers to mark objects to
+make it possible to treat marks in the various generic functions, but that meant
+that if you forget to save the mark object in some handy variable,
+you end up typing "integer-&gt;mark" over and over.
+One way out is to define
+a #-reader that sees something like "#m12" and expands that into <code>(integer-&gt;mark 12)</code>:
+</p>
+<pre>
+&gt; <em class=typing>(set! <a href="s7.html#sharpreaders">*#readers*</a>
+ (cons (cons #\m (lambda (str)
+ (integer-&gt;mark (string-&gt;number (substring str 1)))))
+ *#readers*))</em>
+<em class=listener>((#\m . #&lt;closure&gt;))</em>
+&gt; <em class=typing>#m1</em>
+<em class=listener>#&lt;mark 1&gt;</em>
+&gt; <em class=typing>(mark-sample #m1)</em>
+<em class=listener>38694</em>
+</pre>
</td></tr><tr><td colspan=2 height=16></td></tr>
@@ -5025,7 +5043,7 @@ feedback:
(if (not (provided? 'snd-ws.scm)) (load-from-path "ws.scm"))
(define (frequency-&gt;tag-y freq lo octs) ; tag height dependent on freq
- (inexact-&gt;exact (round (* 100 (- 1.0 (/ (log (/ freq lo)) (* (log 2.0) octs)))))))
+ (round (* 100 (- 1.0 (/ (log (/ freq lo)) (* (log 2.0) octs))))))
(let ((violin-sync 1)
(violin-color (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 1)) ; blue
@@ -5205,7 +5223,7 @@ higher tag-y values position the tag lower in the graph. For
example, if you know the frequency of the mix sound, you can reflect that in the tag height with:
<pre>
(set! (mix-tag-y mix-id)
- (inexact-&gt;exact (round (* 100 (- 1.0 (/ (log (/ freq 40.0)) (* (log 2.0) 7)))))))
+ (round (* 100 (- 1.0 (/ (log (/ freq 40.0)) (* (log 2.0) 7))))))
</pre>
See, for example, check-mix-tags in sndscm.html.
</td></tr><tr><td colspan=2 height=16></td></tr>
@@ -5628,7 +5646,7 @@ See popup.scm for an example.
(define (brksnd dur base)
"(brksnd dur base) divides the current sound into dur-sized pieces,
saving them in files named 'base'.n: (brksnd 1.0 \"sec\")"
- (let ((hop (inexact-&gt;exact (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) dur)))
+ (let ((hop (floor (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) dur)))
(len (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
(old-sync (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a>)))
(set! (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a>) 1) ; save all chans
@@ -6019,7 +6037,7 @@ could be:
(x1 (list-ref axinfo 4))
(axis-left (list-ref axinfo 10))
(axis-right (list-ref axinfo 12)))
- (inexact-&gt;exact
+ (floor
(+ axis-left
(* (- x x0)
(/ (- axis-right axis-left)
@@ -6435,7 +6453,7 @@ replaces the normal "+" cursor with an "x":
(let* ((point (<em class=red>cursor-position</em>))
(x (car point))
(y (cadr point))
- (size (inexact-&gt;exact (/ (<em class=red>cursor-size</em>) 2))))
+ (size (floor (/ (<em class=red>cursor-size</em>) 2))))
(<a class=quiet href="#drawline" onmouseout="UnTip()" onmouseover="Tip(extsnd_drawline_tip)">draw-line</a> (- x size) (- y size) (+ x size) (+ y size) snd chn <em class=red>cursor-context</em>)
(<a class=quiet href="#drawline" onmouseout="UnTip()" onmouseover="Tip(extsnd_drawline_tip)">draw-line</a> (- x size) (+ y size) (+ x size) (- y size) snd chn <em class=red>cursor-context</em>)))
@@ -7160,7 +7178,7 @@ channels are inserted. To append one sound to another, padding at the end with s
<pre>
(define* (<a name="appendsound">append-sound</a> file (silence 1.0))
(<em class=red>insert-sound</em> file (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (<em class=red>insert-silence</em> (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (inexact-&gt;exact (round (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) silence)))))
+ (<em class=red>insert-silence</em> (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (round (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) silence))))
</pre>
'file' is not deleted by Snd unless 'auto-delete' is #t.
</td></tr><tr><td colspan=2 height=18></td></tr>
@@ -7778,6 +7796,27 @@ function option to time the playing of each mix in a sequence of mixes. Another
(* amp (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc)))))))
</pre></td></tr></table>
+<p>Here's another example that plays a sound file, skipping any portion that looks like silence:
+</p>
+<table border=0 cellpadding=5><tr><td><pre>
+(define (play-skipping-silence file)
+ (let ((buffer (make-moving-average 128))
+ (silence (/ .001 128))
+ (rd (make-sampler 0 file))
+ (sum-of-squares 0.0)
+ (y 0.0))
+ (<em class=red>play</em> (lambda ()
+ (let loop ()
+ (set! y (rd))
+ (set! sum-of-squares (moving-average buffer (* y y)))
+ (if (sampler-at-end? rd)
+ #f
+ (if (&gt; sum-of-squares silence)
+ y
+ (loop))))))))
+</pre></td></tr></table>
+
+
<!-- INDEX playexamples:Playing -->
<A NAME="playexamples"></a>
@@ -7883,7 +7922,7 @@ This returns #t if 'obj' is an active <a href="#makeplayer">player</a>.
This returns the x axis value that corresponds to the graph (screen pixel) position 'xpos'.
To find the sample that the mouse is pointing at, given the current mouse position,
<pre>
- (inexact-&gt;exact (round (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd) (position-&gt;x x snd chn))))
+ (round (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd) (position-&gt;x x snd chn)))
</pre>
See gui.scm for examples.
</td></tr><tr><td colspan=2 height=18></td></tr>
@@ -8055,12 +8094,12 @@ Here is an example that mixes a sine wave into the current channel:
(define* (sine-channel freq amp (beg 0) dur snd chn edpos)
(<em class=red>ptree-channel</em>
(lambda (y data forward)
- (let* ((angle (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 0))
- (incr (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 1))
- (val (+ y (* (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 2) (sin angle)))))
+ (let* ((angle (data 0))
+ (incr (data 1))
+ (val (+ y (* (data 2) (sin angle)))))
(if forward
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data 0 (+ angle incr))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos #f
(lambda (frag-beg frag-dur)
@@ -8069,8 +8108,8 @@ Here is an example that mixes a sine wave into the current channel:
</pre></td></tr></table>
In the normal case,
-this function just mixes in a sine wave: <code>(+ y (* (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 2) (sin angle)))</code>
-where the amplitude scaler is stored in <code>(<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 2)</code>. In subsequent
+this function just mixes in a sine wave: <code>(+ y (* (data 2) (sin angle)))</code>
+where the amplitude scaler is stored in <code>(data 2)</code>. In subsequent
reads, the init-func sets up a vct with the current phase (dependent on the frequency
and the fragment begin sample), the phase increment (dependent on the frequency), and
the amplitude (passed as an argument to sine-channel, but stored in the vct since
@@ -8097,12 +8136,12 @@ version of cosine-channel given under
;; vct: angle increment
(<em class=red>ptree-channel</em>
(lambda (y data forward)
- (let* ((angle (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 0))
- (incr (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 1))
+ (let* ((angle (data 0))
+ (incr (data 1))
(val (* y (cos angle))))
(if forward
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data 0 (+ angle incr))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data 0 (- angle incr)))
+ (set! (data 0) (+ angle incr))
+ (set! (data 0) (- angle incr)))
val))
beg dur snd chn edpos <em class=red>#t</em>
(lambda (frag-beg frag-dur)
@@ -8181,8 +8220,8 @@ could in this case be:
<table border=0 cellpadding=5 vspace=10><tr><td><pre>
(<em class=red>ptree-channel</em> (lambda (y data forward)
- (let ((val (* 0.5 (+ y (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 0)))))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data 0 y)
+ (let ((val (* 0.5 (+ y (data 0)))))
+ (set! (data 0) y)
val))
0 (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) ind 0 #f #f ; "ind" is the sound
(let ((edpos (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> ind 0)))
@@ -8210,15 +8249,15 @@ Here are several more examples:
(let* ((base (if (&gt; r0 r1) (/ 1.0 ubase) ubase)))
(<em class=red>ptree-channel</em>
(lambda (y data forward)
- (let* ((lr0 (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 0))
- (lbase (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 1))
- (incr (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 2))
- (scl (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 3))
- (power (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data 4))
+ (let* ((lr0 (data 0))
+ (lbase (data 1))
+ (incr (data 2))
+ (scl (data 3))
+ (power (data 4))
(val (* y (+ lr0 (* scl (- (expt lbase power) 1.0))))))
(if forward
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data 4 (+ power incr))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data 4 (- power incr)))
+ (set! (data 4) (+ power incr))
+ (set! (data 4) (- power incr)))
val))
beg dur snd chn edpos #t
(lambda (frag-beg frag-dur)
@@ -8276,7 +8315,7 @@ result appear to be one operation in the edit history list.
(set! y0 y1)
(set! x1 (list-ref envelope i))
(set! y1 (list-ref envelope (+ i 1)))
- (let* ((curdur (inexact-&gt;exact (round (* fulldur (/ (- x1 x0) xrange))))))
+ (let* ((curdur (round (* fulldur (/ (- x1 x0) xrange)))))
(<em class=red>xramp-channel</em> y0 y1 base curbeg curdur snd chn edpos)
(set! curbeg (+ curbeg curdur)))
(set! base (list-ref envelope (+ i 2)))))))))
@@ -8486,7 +8525,7 @@ declare is modelled after Common Lisp's declare; it is specific to run.
<br><br>
The use of the run macro is hidden in many contexts: <a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>,
<a class=quiet href="#findchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_findchannel_tip)">find-channel</a>, etc. Internally the Snd run macro
-uses 64-bit ints and doubles, so large sounds should not present any numerical problems.
+uses 64-bit ints and doubles.
See <a href="#optimization">optimization</a>
for some timings. In Ruby, it's possible to use the <a href="http://www.zenspider.com/Languages/Ruby/">RubyInline</a> module instead.
</td></tr><tr><td colspan=2 height=18></td></tr>
@@ -8654,7 +8693,7 @@ There are approximately a bazillion ways to scale samples in Snd; here's a potpo
(begin (<a class=quiet href="#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> "temp.snd") (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "temp.snd" 0) (delete-file "temp.snd"))
(let ((flt (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 8)))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> flt 0 2.0)
+ (set! (flt 0) 2.0)
(let ((cnv (<a class=quiet href="sndclm.html#make-convolve" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_convolve_tip)">make-convolve</a> :filter flt))
(sf (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0)))
(<a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
@@ -9024,8 +9063,7 @@ the end points:
(scale (* 0.5 (abs (- y1 y0)))))
(do ((i 0 (+ 1 i)))
((= i num) v)
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> v i
- (+ off (* scale (cos (+ angle (* i (/ pi num))))))))))
+ (set! (v i) (+ off (* scale (cos (+ angle (* i (/ pi num))))))))))
</pre></td></tr></table>
<img src="pix/click.png" alt="smoother">
@@ -9442,7 +9480,7 @@ For example, the following function reverses the channel order:
(define* (<a name="reversechannels">reverse-channels</a> snd)
(let* ((ind (or snd (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (car (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
(chns (<a class=quiet href="#channels" onmouseout="UnTip()" onmouseover="Tip(extsnd_channels_tip)">channels</a> ind)))
- (let ((swaps (inexact-&gt;exact (floor (/ chns 2)))))
+ (let ((swaps (floor (/ chns 2))))
(<a class=quiet href="#asoneedit" onmouseout="UnTip()" onmouseover="Tip(extsnd_asoneedit_tip)">as-one-edit</a>
(lambda ()
(do ((i 0 (+ 1 i))
@@ -10822,12 +10860,10 @@ Here's an example that displays a histogram of the current values in 16 bins:
(do ((i 0 (+ 1 i)))
((= i len) v)
(let* ((val (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> fd))
- (bin (inexact-&gt;exact (* (abs val) 16.0))))
+ (bin (floor (* (abs val) 16.0))))
(do ((j 0 (+ 1 j)))
((= j steps))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> v
- (+ j bin)
- (+ step (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> v (+ j bin))))))))))
+ (set! (v (+ j bin)) (+ step (v (+ j bin))))))))))
</pre></td></tr></table>
This code ties the Hilbert transform in dsp.scm into the user-interface:
@@ -10851,7 +10887,7 @@ If GSL is included in Snd, the following code ties in the (slow) Hankel transfor
(<em class=red>add-transform</em> "Hankel" "Hankel" 0.0 1.0
(lambda (n rd)
(let ((v (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> n)))
- (do ((i 0 (+ 1 i))) ((= i n)) (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> v i (rd)))
+ (do ((i 0 (+ 1 i))) ((= i n)) (set! (v i) (rd)))
(gsl-dht n v 1.0 1.0)
v)))
</pre></td></tr></table></td></tr><tr><td colspan=2 height=16></td></tr>
@@ -10886,10 +10922,10 @@ and initial-phase:
(im (make-vct fft-size)))
(do ((i 0 (+ i 1)))
((= i len))
- (let ((amp (vct-ref amps i))
- (phase (vct-ref phases i)))
- (vct-set! rl (+ i 1) (* amp (sin phase)))
- (vct-set! im (+ i 1) (* amp (cos phase)))))
+ (let ((amp (amps i))
+ (phase (phases i)))
+ (set! (rl (+ i 1)) (* amp (sin phase)))
+ (set! (im (+ i 1)) (* amp (cos phase)))))
(<em class=red>fft</em> rl im -1)
rl))
</pre>
@@ -12098,7 +12134,7 @@ A similar set rebinds the arrow keys to give much more precise window position a
(hi (list-ref ax 1))
(lo-pix (list-ref ax 10))
(hi-pix (list-ref ax 12))
- (samps-per-pixel (max 1 (inexact-&gt;exact (round (/ (- hi lo) (- hi-pix lo-pix))))))
+ (samps-per-pixel (max 1 (round (/ (- hi lo) (- hi-pix lo-pix)))))
(change (if right
(- (min (+ hi samps-per-pixel) (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> s c)) hi)
(- (max 0 (- lo samps-per-pixel)) lo))))
@@ -12122,19 +12158,18 @@ A similar set rebinds the arrow keys to give much more precise window position a
(hi (list-ref ax 1))
(lo-pix (list-ref ax 10))
(hi-pix (list-ref ax 12))
- (samps-per-pixel (max 1 (inexact-&gt;exact (round (/ (- hi lo) (- hi-pix lo-pix))))))
+ (samps-per-pixel (max 1 (round (/ (- hi lo) (- hi-pix lo-pix)))))
(len (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> s c)))
(if in
(if (&gt; (- hi-pix lo-pix) samps-per-pixel)
(begin
(set! (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (+ lo samps-per-pixel))
(set! (<a class=quiet href="#xzoomslider" onmouseout="UnTip()" onmouseover="Tip(extsnd_xzoomslider_tip)">x-zoom-slider</a>)
- (exact-&gt;inexact
- (round (/ (max samps-per-pixel (- hi lo (* 2 samps-per-pixel))) len))))))
+ (* 1.0 (round (/ (max samps-per-pixel (- hi lo (* 2 samps-per-pixel))) len))))))
(begin
(set! (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (max 0 (- lo samps-per-pixel)))
(set! (<a class=quiet href="#xzoomslider" onmouseout="UnTip()" onmouseover="Tip(extsnd_xzoomslider_tip)">x-zoom-slider</a>)
- (exact-&gt;inexact (round (/ (min len (+ (- hi lo) (* 2 samps-per-pixel))) len))))))
+ (* 1.0 (round (/ (min len (+ (- hi lo) (* 2 samps-per-pixel))) len))))))
keyboard-no-action))
(<em class=red>bind-key</em> "Up" 0 ;up arrow
@@ -12290,7 +12325,7 @@ exit back to the top level, (break-exit):
(z (vct .1 .2 .3)))
(break)
(display y)
- (+ x (string-length y) (vct-ref z 1))))
+ (+ x (string-length y) (z 1))))
(hiho 1)
(break)
(* y 2)))</em>
@@ -12453,8 +12488,8 @@ is named "<a name="callin">call_in</a>".
<table border=0 cellpadding=5 vspace=10><tr><td><pre>
(define (at hour minute func)
(let* ((cur-time (localtime (current-time)))
- (cur-minute (vector-ref cur-time 1))
- (cur-hour (vector-ref cur-time 2))
+ (cur-minute (cur-time 1))
+ (cur-hour (cur-time 2))
(now (+ (* cur-hour 60) cur-minute))
(then (+ (* hour 60) minute)))
(<em class=red>in</em> (* 1000 60 (- then now)) func)))
@@ -12704,7 +12739,7 @@ to put the date and time in the Snd title bar.
<pre>
:<em class=typing>(window-property "SND_VERSION" "SND_VERSION")</em>
<em class=listener>"1-Jun-06"</em>
- :<em class=typing>(set! (<em class=red>window-property</em> "SND_VERSION" "WM_NAME") "a new name")</em>
+ :<em class=typing>(set! (window-property "SND_VERSION" "WM_NAME") "a new name")</em>
<em class=listener>#f</em>
</pre>
</td></tr>
@@ -13192,16 +13227,16 @@ of FractInt's royal colormap):
(let ((r (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
(g (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
(b (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (incr (exact-&gt;inexact (/ 256.0 size)))
+ (incr (/ 256.0 size))
(er (list 0 60 60 116 128 252 192 252 256 60))
(eg (list 0 0 64 0 128 252 192 252 256 0))
(eb (list 0 80 128 252 192 0 256 80)))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x incr)))
((= i size))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> r i (exact-&gt;inexact (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x er) 256.0))) ; from env.scm
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> g i (exact-&gt;inexact (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x eg) 256.0)))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> b i (exact-&gt;inexact (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x eb) 256.0))))
+ (set! (r i) (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x er) 256.0)) ; from env.scm
+ (set! (g i) (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x eg) 256.0))
+ (set! (b i) (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x eb) 256.0)))
(list r g b))))
;;; another amusing colormap from FractInt:
@@ -13210,13 +13245,13 @@ of FractInt's royal colormap):
(let ((r (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
(g (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
(b (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (incr (exact-&gt;inexact (/ 3.14159 size))))
+ (incr (/ 3.14159 size)))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x incr)))
((= i size))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> r i (abs (sin (* 1.5 x))))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> g i (abs (sin (* 3.5 x))))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> b i (abs (sin (* 2.5 x)))))
+ (set! (r i) (abs (sin (* 1.5 x))))
+ (set! (g i) (abs (sin (* 3.5 x))))
+ (set! (b i) (abs (sin (* 2.5 x)))))
(list r g b))))
</pre></td></tr></table>
@@ -13514,8 +13549,8 @@ This draws a filled polygon whose vertices are in the vector 'points'.
"draw an arrow pointing (from the left) at the point (x0 y0)"
(let ((points (make-vector 8)))
(define (point i x y)
- (vector-set! points (* i 2) x)
- (vector-set! points (+ (* i 2) 1) y))
+ (set! (points (* i 2)) x)
+ (set! (points (+ (* i 2) 1)) y))
(define (arrow-head x y)
(point 0 x y)
(point 1 (- x (* 2 size)) (- y size))
@@ -13524,9 +13559,9 @@ This draws a filled polygon whose vertices are in the vector 'points'.
(<em class=red>fill-polygon</em> points snd chn))
(arrow-head x0 y0)
(<a class=quiet href="#fillrectangle" onmouseout="UnTip()" onmouseover="Tip(extsnd_fillrectangle_tip)">fill-rectangle</a> (- x0 (* 4 size))
- (inexact-&gt;exact (- y0 (* .4 size)))
+ (floor (- y0 (* .4 size)))
(* 2 size)
- (inexact-&gt;exact (* .8 size))
+ (floor (* .8 size))
snd chn)))
</pre></td></tr></table>
@@ -13593,9 +13628,9 @@ sound over another at an arbitrary point, and so on (see draw.scm):
(size (length low-data))
(samps (- right left))
(left-offset (max 0 (- 1000 left)))
- (left-bin (inexact-&gt;exact (round (/ (* size left-offset) samps))))
+ (left-bin (round (/ (* size left-offset) samps)))
(right-offset (- (min 2000 right) left))
- (right-bin (inexact-&gt;exact (round (/ (* size right-offset) samps))))
+ (right-bin (round (/ (* size right-offset) samps)))
(new-low-data (<a class=quiet href="#vctsubseq" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctsubseq_tip)">vct-subseq</a> low-data left-bin right-bin))
(new-high-data (<a class=quiet href="#vctsubseq" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctsubseq_tip)">vct-subseq</a> high-data left-bin right-bin)))
(set! (<a class=quiet href="#foregroundcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_foregroundcolor_tip)">foreground-color</a> snd chn) red)
@@ -13663,7 +13698,7 @@ The result can be used in the lisp graph:
(* 20.0 (log10 val))))
(do ((i 0 (+ 1 i)))
((= i len))
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data i (+ 60.0 (dB (abs (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data i))))))
+ (set! (data i) (+ 60.0 (dB (abs (data i))))))
(<a class=quiet href="#graph" onmouseout="UnTip()" onmouseover="Tip(extsnd_graph_tip)">graph</a> data "dB"
(/ (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn) sr) (/ (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn) sr)
0.0 60.0
diff --git a/fade.scm b/fade.scm
index c995775..d341c31 100644
--- a/fade.scm
+++ b/fade.scm
@@ -33,7 +33,7 @@
(do ((k 0 (+ 1 k)))
((= k fs))
- (vector-set! fs1 k (make-formant (* k bin) radius)))
+ (set! (fs1 k) (make-formant (* k bin) radius)))
(run
(do ((i start (+ 1 i)))
@@ -54,7 +54,7 @@
(set! bank1 (+ bank1 bank-incr))
(do ((k 0 (+ 1 k)))
((= k (- fs 1)))
- (set! outval (+ outval (formant (vector-ref fs1 (+ 1 k)) inval))))
+ (set! outval (+ outval (formant (fs1 (+ 1 k)) inval))))
(set! val (+ (* bank1 outval) (* (- 1.0 bank1) inval))))
(if (> i ramp-end)
@@ -64,7 +64,7 @@
(set! bank2 (- bank2 bank-incr))
(do ((k 0 (+ 1 k)))
((= k (- fs 1)))
- (set! outval (+ outval (formant (vector-ref fs1 (+ 1 k)) inval))))
+ (set! outval (+ outval (formant (fs1 (+ 1 k)) inval))))
(set! val (+ (* bank2 outval) (* (- 1.0 bank2) inval))))
;; in the fade section
@@ -80,7 +80,7 @@
(do ((k 0 (+ 1 k)))
((= k (- fs 1)))
(let ((rfs (max 0.0 (min 1.0 (- r2 (* k ifs))))))
- (set! outval (+ outval (formant (vector-ref fs1 (+ 1 k))
+ (set! outval (+ outval (formant (fs1 (+ 1 k))
(+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
(set! val outval))
@@ -90,7 +90,7 @@
(do ((k 0 (+ 1 k)))
((= k (- fs 1)))
(let ((rfs (max 0.0 (min 1.0 (- r2 (* (- fs k) ifs))))))
- (set! outval (+ outval (formant (vector-ref fs1 (+ 1 k))
+ (set! outval (+ outval (formant (fs1 (+ 1 k))
(+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
(set! val outval))
@@ -99,12 +99,12 @@
(do ((k 0 (+ 1 k)))
((= k half-fs))
(let ((rfs (max 0.0 (min 1.0 (- (+ r2 0.5) (* (- fs k) ifs))))))
- (set! outval (+ outval (formant (vector-ref fs1 (+ 1 k))
+ (set! outval (+ outval (formant (fs1 (+ 1 k))
(+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
(do ((k 0 (+ 1 k)))
((= k (- half-fs 1)))
(let ((rfs (max 0.0 (min 1.0 (- r2 (/ k half-fs))))))
- (set! outval (+ outval (formant (vector-ref fs1 (+ k 1 half-fs))
+ (set! outval (+ outval (formant (fs1 (+ k 1 half-fs))
(+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
(set! val outval)))))))))
(outa i (* amp val))))))
@@ -134,7 +134,7 @@
(if (not (number? hi)) (set! hi freq-inc))
(do ((k 0 (+ 1 k)))
((= k hi))
- (vector-set! fs k (make-formant (* k bin) radius)))
+ (set! (fs k) (make-formant (* k bin) radius)))
(run
(do ((i start (+ 1 i)))
@@ -169,7 +169,7 @@
(do ((k lo (+ 1 k)))
((= k hi))
(let ((sp (vct-ref spectrum k)))
- (set! outval (+ outval (formant (vector-ref fs k) (+ (* sp inval1) (* (- 1.0 sp) inval2)))))
+ (set! outval (+ outval (formant (fs k) (+ (* sp inval1) (* (- 1.0 sp) inval2)))))
(if (> 1.0 sp 0.0)
(vct-set! spectrum k (- (vct-ref spectrum k) ramp-inc)))))
(outa i (* amp outval)))))))
diff --git a/fft-menu.scm b/fft-menu.scm
index 3c243f2..3176cff 100644
--- a/fft-menu.scm
+++ b/fft-menu.scm
@@ -66,16 +66,16 @@ removes all energy below the low frequency and above the high frequency, then co
(lambda (w data)
(set! fft-edit-low-frequency initial-fft-edit-low-frequency)
(set! fft-edit-high-frequency initial-fft-edit-high-frequency)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) (inexact->exact fft-edit-low-frequency))
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) (floor fft-edit-low-frequency))
;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) (inexact->exact fft-edit-high-frequency))
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) (floor fft-edit-high-frequency))
;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (cadr sliders)))
)
(lambda (w c i)
(set! fft-edit-low-frequency initial-fft-edit-low-frequency)
(set! fft-edit-high-frequency initial-fft-edit-high-frequency)
- (XtSetValues (car sliders) (list XmNvalue (inexact->exact fft-edit-low-frequency)))
- (XtSetValues (cadr sliders) (list XmNvalue (inexact->exact fft-edit-high-frequency)))))))
+ (XtSetValues (car sliders) (list XmNvalue (floor fft-edit-low-frequency)))
+ (XtSetValues (cadr sliders) (list XmNvalue (floor fft-edit-high-frequency)))))))
(set! sliders
(add-sliders
diff --git a/fm.html b/fm.html
index c410fac..4bb78ff 100644
--- a/fm.html
+++ b/fm.html
@@ -560,22 +560,22 @@ the 15 main components, with their sum in black:
(with-sound (:channels 1 :clipped #f)
(let* ((angle 0.0)
(incr (hz->radians 1.0))
- (n (inexact->exact (ceiling (+ index 5))))
+ (n (ceiling (+ index 5)))
(cur-phases (make-vct (* (+ n 1) 3 2))))
(do ((i 0 (+ i 1))
(j 0 (+ j 3)))
((> i n))
- (vct-set! cur-phases j (+ 10 i))
- (vct-set! cur-phases (+ j 1) (abs (bes-jn i index)))
- (vct-set! cur-phases (+ j 2) (/ pi 2)))
+ (set! (cur-phases j) (+ 10 i))
+ (set! (cur-phases (+ j 1)) (abs (bes-jn i index)))
+ (set! (cur-phases (+ j 2)) (/ pi 2)))
(do ((i 1 (+ i 1))
(j (* (+ n 1) 3) (+ j 3)))
((> i n))
- (vct-set! cur-phases j (- 10 i))
- (vct-set! cur-phases (+ j 1) (abs (bes-jn i index)))
- (vct-set! cur-phases (+ j 2) (/ pi 2)))
+ (set! (cur-phases j) (- 10 i))
+ (set! (cur-phases (+ j 1)) (abs (bes-jn i index)))
+ (set! (cur-phases (+ j 2)) (/ pi 2)))
(let ((gen (make-polyoid freq cur-phases)))
(run
@@ -1492,15 +1492,15 @@ In general:
(fm-indices (make-vct n)))
(do ((i 0 (+ 1 i)))
((= i n))
- (vector-set! modulators i (make-oscil (* freq (list-ref mc-ratios i)) (list-ref mod-phases i)))
- (vct-set! fm-indices i (hz-&gt;radians (* freq (list-ref indexes i) (list-ref mc-ratios i)))))
+ (set! (modulators i) (make-oscil (* freq (list-ref mc-ratios i)) (list-ref mod-phases i)))
+ (set! (fm-indices i) (hz-&gt;radians (* freq (list-ref indexes i) (list-ref mc-ratios i)))))
(run
(do ((i start (+ 1 i)))
((= i end))
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k n))
- (set! sum (+ sum (* (vct-ref fm-indices k) (oscil (vector-ref modulators k))))))
+ (set! sum (+ sum (* (fm-indices k) (oscil (modulators k))))))
(outa i (* amp (oscil cr sum))))))))
(with-sound () (fm 0 2.0 440 .3 '(1 3 4) '(1.0 0.5 0.1) 0.0 '(0.0 0.0 0.0)))
@@ -1546,7 +1546,7 @@ here's the code to get that info:
(if (not (null? wms))
(let* ((sum 0.0)
(index (car inds))
- (mx (inexact->exact (ceiling (* 5 index))))
+ (mx (ceiling (* 5 index)))
(wm (car wms)))
(do ((k (- mx) (+ 1 k)))
((>= k mx) sum)
@@ -1691,8 +1691,8 @@ set of initial phases that minimizes the modulating signal's peak amplitude:
(mod2 0.0))
(do ((k 0 (+ k 1)))
((= k n))
- (set! mod1 (+ mod1 (oscil (vector-ref mods1 k))))
- (set! mod2 (+ mod2 (oscil (vector-ref mods2 k)))))
+ (set! mod1 (+ mod1 (oscil (mods1 k))))
+ (set! mod2 (+ mod2 (oscil (mods2 k)))))
(outa i (/ mod1 n))
(outb i (oscil car1 (/ mod1 (* n n))))
(outc i (/ mod2 n))
@@ -2443,12 +2443,12 @@ used in "Colony" and other pieces:
(ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02))))
(do ((i 0 (+ 1 i)))
((= i 3))
- (vector-set! evens i (make-oscil 0))
- (vector-set! odds i (make-oscil 0)))
+ (set! (evens i) (make-oscil 0))
+ (set! (odds i) (make-oscil 0)))
- (vector-set! frmfs 0 (make-env '(0 520 100 490) :duration dur))
- (vector-set! frmfs 1 (make-env '(0 1190 100 1350) :duration dur))
- (vector-set! frmfs 2 (make-env '(0 2390 100 1690) :duration dur))
+ (set! (frmfs 0) (make-env '(0 520 100 490) :duration dur))
+ (set! (frmfs 1) (make-env '(0 1190 100 1350) :duration dur))
+ (set! (frmfs 2) (make-env '(0 2390 100 1690) :duration dur))
(run
(do ((i start (+ 1 i)))
@@ -2458,9 +2458,9 @@ used in "Colony" and other pieces:
(sum 0.0))
(do ((k 0 (+ 1 k)))
((= k 3))
- (let* ((frm (env (vector-ref frmfs k)))
+ (let* ((frm (env (frmfs k)))
(frm0 (/ frm frq))
- (frm-int (inexact-&gt;exact (floor frm0)))
+ (frm-int (floor frm0))
(even-amp 0.0) (odd-amp 0.0)
(even-freq 0.0) (odd-freq 0.0))
(if (even? frm-int)
@@ -2474,13 +2474,13 @@ used in "Colony" and other pieces:
(set! even-freq (hz-&gt;radians (* (+ frm-int 1) frq)))
(set! even-amp (- frm0 frm-int))
(set! odd-amp (- 1.0 even-amp))))
- (set! sum (+ sum (+ (* (vct-ref amps k)
+ (set! sum (+ sum (+ (* (amps k)
(+ (* even-amp
- (oscil (vector-ref evens k)
- (+ even-freq (* (vct-ref indices k) car))))
+ (oscil (evens k)
+ (+ even-freq (* (indices k) car))))
(* odd-amp
- (oscil (vector-ref odds k)
- (+ odd-freq (* (vct-ref indices k) car)))))))))))
+ (oscil (odds k)
+ (+ odd-freq (* (indices k) car)))))))))))
(outa i (* (env ampf) sum)))))))
(with-sound ()
diff --git a/fmv.scm b/fmv.scm
index 726cf37..653a34b 100644
--- a/fmv.scm
+++ b/fmv.scm
@@ -35,8 +35,7 @@
(fm1-index #f)
(fm2-index #f)
(fm3-index #f)
- (base 1.0)
- :allow-other-keys)
+ (base 1.0))
"(make-fm-violin frequency amplitude
(fm-index 1.0) (amp-env #f) (periodic-vibrato-rate 5.0)
@@ -157,8 +156,8 @@ fm-violin takes the value returned by make-fm-violin and returns a new sample ea
(vct->channel data beg dur))))
|#
-(define* (fm-violin-ins startime dur freq amp (degree #f) (reverb-amount 0.0) (distance 1.0) :allow-other-keys :rest args)
- "(fm-violin-ins startime dur freq amp (degree #f) (reverb-amount 0.0) (distance 1.0) :allow-other-keys :rest args)
+(define* (fm-violin-ins startime dur freq amp (degree #f) (reverb-amount 0.0) (distance 1.0) :rest args)
+ "(fm-violin-ins startime dur freq amp (degree #f) (reverb-amount 0.0) (distance 1.0) :rest args)
calls the fm-violin with the given args and mixes the results into the current sound"
(let* ((beg (floor (* startime (srate))))
(len (floor (* dur (srate))))
diff --git a/frame.scm b/frame.scm
index afda6b3..7da192d 100644
--- a/frame.scm
+++ b/frame.scm
@@ -87,7 +87,7 @@
(len (min flen (length nv))))
(do ((i 0 (+ i 1)))
((= i len))
- (vct-set! nv i (frame-ref fr i)))
+ (set! (nv i) (frame-ref fr i)))
nv)))
(define* (vct->frame v fr)
@@ -100,7 +100,7 @@
(len (min vlen (channels nfr))))
(do ((i 0 (+ i 1)))
((= i len))
- (frame-set! nfr i (vct-ref v i)))
+ (frame-set! nfr i (v i)))
nfr)))
@@ -210,19 +210,19 @@
(throw 'no-such-sound (list "make-frame-reader" snd))
(let* ((chns (if (sound? index) (channels index) (channels index)))
(fr (make-vector (+ chns +frame-reader0+))))
- (vector-set! fr +frame-reader-tag+ 'frame-reader)
- (vector-set! fr +frame-reader-snd+ index)
- (vector-set! fr +frame-reader-channels+ chns)
- (vector-set! fr +frame-reader-frame+ (make-frame chns))
+ (set! (fr +frame-reader-tag+) 'frame-reader)
+ (set! (fr +frame-reader-snd+) index)
+ (set! (fr +frame-reader-channels+) chns)
+ (set! (fr +frame-reader-frame+) (make-frame chns))
(do ((i 0 (+ i 1)))
((= i chns))
- (vector-set! fr (+ i +frame-reader0+) (make-sampler beg index i dir edpos)))
+ (set! (fr (+ i +frame-reader0+)) (make-sampler beg index i dir edpos)))
fr))))
(define (frame-reader? obj)
"(frame-reader? obj) -> #t if obj is a frame-reader"
(and (vector? obj)
- (eq? (vector-ref obj +frame-reader-tag+) 'frame-reader)))
+ (eq? (obj +frame-reader-tag+) 'frame-reader)))
(define (frame-reader-at-end? fr)
"(frame-reader-at-end? fr) -> #t if the samplers in frame-reader fr have reached the end of their respective channels"
@@ -230,73 +230,73 @@
(let ((at-end #t))
(do ((i 0 (+ i 1)))
((or (not at-end)
- (= i (vector-ref fr +frame-reader-channels+)))
+ (= i (fr +frame-reader-channels+)))
at-end)
- (set! at-end (sampler-at-end? (vector-ref fr (+ i +frame-reader0+))))))
+ (set! at-end (sampler-at-end? (fr (+ i +frame-reader0+))))))
(throw 'wrong-type-arg (list "frame-reader-at-end" fr))))
(define (frame-reader-position fr)
"(frame-reader-position fr) -> current read position of frame-reader fr"
(if (frame-reader? fr)
- (sampler-position (vector-ref fr +frame-reader0+))
+ (sampler-position (fr +frame-reader0+))
(throw 'wrong-type-arg (list "frame-reader-position" fr))))
(define (frame-reader-home fr)
"(frame-reader-home fr) -> sound object associated with frame-reader fr"
(if (frame-reader? fr)
- (vector-ref fr +frame-reader-snd+)
+ (fr +frame-reader-snd+)
(throw 'wrong-type-arg (list "frame-reader-home" fr))))
(define (frame-reader-chans fr)
"(frame-reader-chans fr) -> number of channels read by frame-reader fr"
(if (frame-reader? fr)
- (vector-ref fr +frame-reader-channels+)
+ (fr +frame-reader-channels+)
(throw 'wrong-type-arg (list "frame-reader-chans" fr))))
(define (free-frame-reader fr)
"(free-frame-reader fr) frees all readers associated with frame-reader fr"
(if (frame-reader? fr)
(do ((i 0 (+ i 1)))
- ((= i (vector-ref fr +frame-reader-channels+)))
- (free-sampler (vector-ref fr (+ i +frame-reader0+))))
+ ((= i (fr +frame-reader-channels+)))
+ (free-sampler (fr (+ i +frame-reader0+))))
(throw 'wrong-type-arg (list "free-frame-reader" fr))))
(define (copy-frame-reader fr)
"(copy-frame-reader fr) returns a copy of frame-reader fr"
(if (frame-reader? fr)
- (let* ((chns (vector-ref fr +frame-reader-channels+))
+ (let* ((chns (fr +frame-reader-channels+))
(nfr (make-vector (+ chns +frame-reader0+))))
- (vector-set! nfr +frame-reader-tag+ 'frame-reader)
- (vector-set! nfr +frame-reader-snd+ (vector-ref fr 1))
- (vector-set! nfr +frame-reader-channels+ chns)
+ (set! (nfr +frame-reader-tag+) 'frame-reader)
+ (set! (nfr +frame-reader-snd+) (fr 1))
+ (set! (nfr +frame-reader-channels+) chns)
(do ((i 0 (+ i 1)))
((= i chns))
- (vector-set! nfr (+ i +frame-reader0+) (copy-sampler (vector-ref fr (+ i +frame-reader0+)))))
+ (set! (nfr (+ i +frame-reader0+)) (copy-sampler (fr (+ i +frame-reader0+)))))
nfr)
(throw 'wrong-type-arg (list "copy-frame-reader" fr))))
(define (next-frame fr)
"(next-frame fr) returns the next frame as read by frame-reader fr"
- (let ((vals (vector-ref fr +frame-reader-frame+)))
+ (let ((vals (fr +frame-reader-frame+)))
(do ((i 0 (+ i 1)))
- ((= i (vector-ref fr +frame-reader-channels+)))
- (frame-set! vals i (next-sample (vector-ref fr (+ i +frame-reader0+)))))
+ ((= i (fr +frame-reader-channels+)))
+ (frame-set! vals i (next-sample (fr (+ i +frame-reader0+)))))
vals))
(define (previous-frame fr)
"(previous-frame fr) returns the previous frame as read by frame-reader fr"
- (let ((vals (vector-ref fr +frame-reader-frame+)))
+ (let ((vals (fr +frame-reader-frame+)))
(do ((i 0 (+ i 1)))
- ((= i (vector-ref fr +frame-reader-channels+)))
- (frame-set! vals i (previous-sample (vector-ref fr (+ i +frame-reader0+)))))
+ ((= i (fr +frame-reader-channels+)))
+ (frame-set! vals i (previous-sample (fr (+ i +frame-reader0+)))))
vals))
(define (read-frame fr)
"(read-frame fr) returns the next frame read by frame-reader fr taking its current read direction into account"
- (let ((vals (vector-ref fr +frame-reader-frame+)))
+ (let ((vals (fr +frame-reader-frame+)))
(do ((i 0 (+ i 1)))
- ((= i (vector-ref fr +frame-reader-channels+)))
- (frame-set! vals i (read-sample (vector-ref fr (+ i +frame-reader0+)))))
+ ((= i (fr +frame-reader-channels+)))
+ (frame-set! vals i (read-sample (fr (+ i +frame-reader0+)))))
vals))
@@ -306,13 +306,13 @@
(throw 'no-such-region (list "make-region-frame-reader" reg))
(let* ((chns (channels reg))
(fr (make-vector (+ chns +frame-reader0+))))
- (vector-set! fr +frame-reader-tag+ 'frame-reader)
- (vector-set! fr +frame-reader-snd+ reg)
- (vector-set! fr +frame-reader-channels+ chns)
- (vector-set! fr +frame-reader-frame+ (make-frame chns))
+ (set! (fr +frame-reader-tag+) 'frame-reader)
+ (set! (fr +frame-reader-snd+) reg)
+ (set! (fr +frame-reader-channels+) chns)
+ (set! (fr +frame-reader-frame+) (make-frame chns))
(do ((i 0 (+ i 1)))
((= i chns))
- (vector-set! fr (+ i +frame-reader0+) (make-region-sampler reg beg i dir)))
+ (set! (fr (+ i +frame-reader0+)) (make-region-sampler reg beg i dir)))
fr)))
(define* (make-sync-frame-reader (beg 0) snd dir edpos)
@@ -330,10 +330,10 @@
(set! chns (+ chns (channels s)))))
(sounds))
(let ((fr (make-vector (+ chns +frame-reader0+))))
- (vector-set! fr +frame-reader-tag+ 'frame-reader)
- (vector-set! fr +frame-reader-snd+ index)
- (vector-set! fr +frame-reader-channels+ chns)
- (vector-set! fr +frame-reader-frame+ (make-frame chns))
+ (set! (fr +frame-reader-tag+) 'frame-reader)
+ (set! (fr +frame-reader-snd+) index)
+ (set! (fr +frame-reader-channels+) chns)
+ (set! (fr +frame-reader-frame+) (make-frame chns))
(let ((ctr 0))
(for-each
(lambda (s)
@@ -341,7 +341,7 @@
(begin
(do ((i 0 (+ i 1)))
((= i (channels s)))
- (vector-set! fr (+ (+ i ctr) +frame-reader0+) (make-sampler beg s i dir edpos)))
+ (set! (fr (+ (+ i ctr) +frame-reader0+)) (make-sampler beg s i dir edpos)))
(set! ctr (+ ctr (channels s))))))
(sounds)))
fr)))))))
@@ -352,10 +352,10 @@
(throw 'no-active-selection (list "make-selection-frame-reader" beg))
(let* ((chns (selection-chans))
(fr (make-vector (+ chns +frame-reader0+))))
- (vector-set! fr +frame-reader-tag+ 'frame-reader)
- (vector-set! fr +frame-reader-snd+ -1)
- (vector-set! fr +frame-reader-channels+ chns)
- (vector-set! fr +frame-reader-frame+ (make-frame chns))
+ (set! (fr +frame-reader-tag+) 'frame-reader)
+ (set! (fr +frame-reader-snd+) -1)
+ (set! (fr +frame-reader-channels+) chns)
+ (set! (fr +frame-reader-frame+) (make-frame chns))
(let ((ctr 0))
(for-each
(lambda (snd)
@@ -363,7 +363,7 @@
((= chn (channels snd)))
(if (selection-member? snd chn)
(begin
- (vector-set! fr (+ ctr +frame-reader0+) (make-sampler (+ beg (selection-position snd chn)) snd chn))
+ (set! (fr (+ ctr +frame-reader0+)) (make-sampler (+ beg (selection-position snd chn)) snd chn))
(set! ctr (+ 1 ctr))))))
(sounds)))
fr)))
@@ -376,7 +376,7 @@
(data (make-vct len)))
(do ((i 0 (+ i 1)))
((= i len))
- (vct-set! data i (next-sample reader)))
+ (set! (data i) (next-sample reader)))
(free-sampler reader)
data))
diff --git a/freeverb.scm b/freeverb.scm
index 0507a9d..b0997c2 100644
--- a/freeverb.scm
+++ b/freeverb.scm
@@ -135,7 +135,7 @@
(let* ((tuning (list-ref allpasstuning i))
(len (floor (* srate-scale tuning))))
(if (odd? c)
- (set! len (+ len (floor (inexact->exact (* srate-scale stereo-spread))))))
+ (set! len (+ len (floor (* srate-scale stereo-spread)))))
(vector-set! allpasses (+ (* c numallpasses) i)
(make-all-pass :size len :feedforward -1 :feedback 0.5)))))
(ws-interrupt?)
diff --git a/generators.scm b/generators.scm
index 5ee95cc..1675ba5 100644
--- a/generators.scm
+++ b/generators.scm
@@ -29,7 +29,6 @@
-
(defmacro defgenerator (struct-name . fields)
;; an extension of def-clm-struct
@@ -68,7 +67,7 @@
(if (and (list? n)
(= (length n) 2))
(if (number? (cadr n))
- (if (exact? (cadr n))
+ (if (rational? (cadr n))
'int
'float)
(if (string? (cadr n))
@@ -341,7 +340,7 @@
(den (sin a2)))
(if (= den 0.0)
0.0
- (/ (* (sin (* n a2)) (sin (* (1+ n) a2))) den))))
+ (/ (* (sin (* n a2)) (sin (* (+ 1 n) a2))) den))))
(define (nodds x n)
(let* ((den (sin x))
@@ -947,7 +946,7 @@
(den (sin a2)))
(if (= den 0.0)
0.0
- (/ (* (sin (* n a2)) (sin (* (1+ n) a2))) den))))
+ (/ (* (sin (* n a2)) (sin (* (+ 1 n) a2))) den))))
(define (find-mid-max n lo hi)
(let ((mid (/ (+ lo hi) 2)))
@@ -1283,7 +1282,7 @@
((= i 20))
(oboish (/ (random 32) 8)
(/ (+ 3 (random 8)) 8)
- (* 16.351 16 (vector-ref rats (vector-ref mode (random 12))))
+ (* 16.351 16 (rats (mode (random 12))))
(+ .25 (random .25))
(let* ((pt1 (random 1.0))
(pt2 (+ pt1 (random 1.0)))
@@ -1632,7 +1631,7 @@
(set! (npos3cos-angle gen) (+ x fm (npos3cos-frequency gen)))
(if (< (abs den) nearly-zero)
- (exact->inexact n)
+ (* 1.0 n)
(/ (- 2 (cos (* n x)) (cos (* (+ n 1) x)))
den))))
@@ -3614,7 +3613,7 @@
:make-wrapper (lambda (g)
(set! (bess-frequency g) (hz->radians (bess-frequency g)))
(if (>= (bess-n g) (length bessel-peaks))
- (set! (bess-norm g) (/ 0.67 (expt (bess-n g) (exact->inexact 1/3))))
+ (set! (bess-norm g) (/ 0.67 (expt (bess-n g) 1/3)))
;; this formula comes from V P Krainov, "Selected Mathetical Methods in Theoretical Physics"
(set! (bess-norm g) (vct-ref bessel-peaks (bess-n g))))
g))
@@ -4750,20 +4749,20 @@ index 10 (so 10/2 is the bes-jn arg):
(index1 (hz->radians (* fm-index frq (/ 5.0 (log frq)))))
(index2 (hz->radians (* fm-index frq 3.0 (/ (- 8.5 (log frq)) (+ 3.0 (* frq .001))))))
(index3 (hz->radians (* fm-index frq (/ 4.0 (sqrt frq))))))
- (vector-set! carriers i (make-oscil frq))
- (vector-set! fmoscs i (make-polyshape :frequency frq
- :coeffs (partials->polynomial
- (list 1 index1
- 3 index2
- 4 index3))))))
+ (set! (carriers i) (make-oscil frq))
+ (set! (fmoscs i) (make-polyshape :frequency frq
+ :coeffs (partials->polynomial
+ (list 1 index1
+ 3 index2
+ 4 index3))))))
- (vector-set! ampfs 0 (make-env (or amp-env '(0 0 1 1 2 1 3 0)) :scaler amp :duration dur))
- (vector-set! ampfs 1 (make-env (list 0 0 .04 1 .075 0 dur 0) :scaler (* amp .0125) :duration dur))
- (vector-set! ampfs 2 (make-env (list 0 0 .02 1 .05 0 dur 0) :scaler (* amp .025) :duration dur))
+ (set! (ampfs 0) (make-env (or amp-env '(0 0 1 1 2 1 3 0)) :scaler amp :duration dur))
+ (set! (ampfs 1) (make-env (list 0 0 .04 1 .075 0 dur 0) :scaler (* amp .0125) :duration dur))
+ (set! (ampfs 2) (make-env (list 0 0 .02 1 .05 0 dur 0) :scaler (* amp .025) :duration dur))
;; also good:
- ;(vector-set! ampfs 1 (make-env (list 0 0 .02 1 .05 0 (- dur .1) 0 (- dur .05) 1 dur 0) :scaler (* amp .025) :duration dur))
- ;(vector-set! ampfs 2 (make-env (list 0 0 .01 1 .025 0 (- dur .15) 0 (- dur .1) 1 dur 0) :scaler (* amp .05) :duration dur))
+ ;(set! (ampfs 1) (make-env (list 0 0 .02 1 .05 0 (- dur .1) 0 (- dur .05) 1 dur 0) :scaler (* amp .025) :duration dur))
+ ;(set! (ampfs 2) (make-env (list 0 0 .01 1 .025 0 (- dur .15) 0 (- dur .1) 1 dur 0) :scaler (* amp .05) :duration dur))
(run
(do ((i start (+ i 1)))
@@ -4774,10 +4773,10 @@ index 10 (so 10/2 is the bes-jn arg):
(do ((k 0 (+ 1 k))
(n 1 (* n 2)))
((= k 3))
- (set! sum (+ sum (* (env (vector-ref ampfs k))
- (oscil (vector-ref carriers k)
+ (set! sum (+ sum (* (env (ampfs k))
+ (oscil (carriers k)
(+ (* n vib)
- (polyshape (vector-ref fmoscs k) 1.0 (* n vib))))))))
+ (polyshape (fmoscs k) 1.0 (* n vib))))))))
(outa i sum))))))
#|
@@ -5251,8 +5250,8 @@ index 10 (so 10/2 is the bes-jn arg):
(set! (pink-noise-rands g) (make-vector n))
(do ((i 0 (+ i 1)))
((= i n))
- (vector-set! (pink-noise-rands g) i (make-rand :frequency (/ (mus-srate) (expt 2 i))))
- (set! (mus-phase (vector-ref (pink-noise-rands g) i)) (random pi))))
+ (set! ((pink-noise-rands g) i) (make-rand :frequency (/ (mus-srate) (expt 2 i))))
+ (set! (mus-phase ((pink-noise-rands g) i)) (random pi))))
g))
(n 1) (rands #f :type clm-vector))
@@ -5266,7 +5265,7 @@ index 10 (so 10/2 is the bes-jn arg):
(n (pink-noise-n gen)))
(do ((i 0 (+ i 1)))
((= i n))
- (set! val (+ val (rand (vector-ref rands i)))))
+ (set! val (+ val (rand (rands i)))))
(/ val (* 2.5 (sqrt n))))) ; this normalization is not quite right
@@ -5744,9 +5743,9 @@ index 10 (so 10/2 is the bes-jn arg):
(j 0 (+ j 1)))
((or (= j amps-len)
(= i data-len)))
- (let* ((hn (inexact->exact (vct-ref original-data i)))
- (amp (env (vector-ref amps j)))
- (phase (env (vector-ref phases j))))
+ (let* ((hn (floor (vct-ref original-data i)))
+ (amp (env (amps j)))
+ (phase (env (phases j))))
(vct-set! tn hn (* amp (sin phase)))
(vct-set! un hn (* amp (cos phase)))))
(polyoid gen fm)))
@@ -5902,7 +5901,7 @@ index 10 (so 10/2 is the bes-jn arg):
(case choice
((all) (vct-set! amps j i))
((odd) (vct-set! amps j (- (* 2 i) 1)))
- ((prime) (vct-set! amps j (vector-ref some-primes (- i 1)))) ; defined below up to 1024th or so -- probably should use low-primes.scm
+ ((prime) (vct-set! amps j (some-primes (- i 1)))) ; defined below up to 1024th or so -- probably should use low-primes.scm
((even) (vct-set! amps j (max 1 (* 2 (- i 1))))))
(vct-set! amps (+ j 1) (/ 1.0 n))
@@ -5924,7 +5923,7 @@ index 10 (so 10/2 is the bes-jn arg):
((or (= i len)
result)
result)
- (set! result (func (vector-ref vect i))))))))
+ (set! result (func (vect i))))))))
(if (not (defined? 'noid-min-peak-phases))
(load "peak-phases.scm"))
@@ -5933,17 +5932,17 @@ index 10 (so 10/2 is the bes-jn arg):
(lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) n)
- (let* ((a-val (vector-ref val 1))
+ (= (val 0) n)
+ (let* ((a-val (val 1))
(a-len (length val))
- (a-data (list a-val (vector-ref val 2))))
+ (a-data (list a-val (val 2))))
(do ((k 2 (+ 1 k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
+ (if (and (number? (val k))
+ (< (val k) a-val))
(begin
- (set! a-val (vector-ref val k))
- (set! a-data (list a-val (vector-ref val (+ k 1)))))))
+ (set! a-val (val k))
+ (set! a-data (list a-val (val (+ k 1)))))))
a-data)))
(case choice
((all) noid-min-peak-phases)
@@ -5957,7 +5956,7 @@ index 10 (so 10/2 is the bes-jn arg):
(j 0 (+ j 3)))
((> i n))
(vct-set! amps (+ j 1) (/ 1.0 n)) ;(/ 0.999 norm)) -- can't decide about this -- I guess it should be consistent with the #f case
- (vct-set! amps (+ j 2) (* pi (vector-ref rats (- i 1))))))))))
+ (vct-set! amps (+ j 2) (* pi (rats (- i 1))))))))))
amps)))
@@ -6138,7 +6137,7 @@ index 10 (so 10/2 is the bes-jn arg):
((or (= i len)
result)
result)
- (set! result (func (vector-ref vect i))))))))
+ (set! result (func (vect i))))))))
(if (not (defined? 'roid-min-peak-phases))
(load "peak-phases.scm"))
@@ -6147,17 +6146,17 @@ index 10 (so 10/2 is the bes-jn arg):
(lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) n)
- (let* ((a-val (vector-ref val 1))
+ (= (val 0) n)
+ (let* ((a-val (val 1))
(a-len (length val))
- (a-data (list a-val (vector-ref val 2))))
+ (a-data (list a-val (val 2))))
(do ((k 2 (+ 1 k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
+ (if (and (number? (val k))
+ (< (val k) a-val))
(begin
- (set! a-val (vector-ref val k))
- (set! a-data (list a-val (vector-ref val (+ k 1)))))))
+ (set! a-val (val k))
+ (set! a-data (list a-val (val (+ k 1)))))))
a-data)))
roid-min-peak-phases)))
(if min-dat
@@ -6169,7 +6168,7 @@ index 10 (so 10/2 is the bes-jn arg):
((> i n))
(vct-set! amps (+ j 1) rn)
(set! rn (* rn r))
- (vct-set! amps (+ j 2) (* pi (vector-ref rats (- i 1))))))))))
+ (vct-set! amps (+ j 2) (* pi (rats (- i 1))))))))))
amps)))
@@ -6644,7 +6643,7 @@ taking input from the readin generator 'reader'. The output data is available v
(set! last-pitch pitch)
(set! pitch (moving-pitch scn))
(if (not (= last-pitch pitch))
- (format #t "~A: ~A~%" (exact->inexact (/ i cur-srate)) pitch))))
+ (format #t "~A: ~A~%" (* 1.0 (/ i cur-srate)) pitch))))
(set! (mus-srate) old-srate))
|#
diff --git a/grfsnd.html b/grfsnd.html
index f27bf39..b481803 100644
--- a/grfsnd.html
+++ b/grfsnd.html
@@ -1186,13 +1186,13 @@ these declarations in ~/.snd:
(define (run-gen func) ; func is a function of no arguments (a "thunk")
(do ((i 0 (+ 1 i)))
((= i data-size))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data i (func))) ; fill data vct with output of 'func'
+ (set! (data i) (func))) ; fill data vct with output of 'func'
(<a class=quiet href="extsnd.html#graph" onmouseout="UnTip()" onmouseover="Tip(extsnd_graph_tip)">graph</a> data)) ; display data as a graph
(define (run-fft func)
(do ((i 0 (+ 1 i)))
((= i data-size))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data i (func)))
+ (set! (data i) (func)))
(<a class=quiet href="extsnd.html#graph" onmouseout="UnTip()" onmouseover="Tip(extsnd_graph_tip)">graph</a> (<a class=quiet href="extsnd.html#sndspectrum" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndspectrum_tip)">snd-spectrum</a> data blackman2-window data-size #t)))
</pre></td></tr></table>
@@ -1382,7 +1382,7 @@ an oscil or a sawtooth-wave:
(lambda (dir)
(<a class=quiet href="sndclm.html#granulate" onmouseout="UnTip()" onmouseover="Tip(sndclm_granulate_tip)">granulate</a> gr
(lambda (dir)
- (let ((val (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> v inctr)))
+ (let ((val (v inctr)))
(set! inctr (+ inctr dir))
(if (&gt;= inctr vsize)
(begin
diff --git a/gtk-effects-utils.scm b/gtk-effects-utils.scm
index ecb55ae..1bf91d8 100644
--- a/gtk-effects-utils.scm
+++ b/gtk-effects-utils.scm
@@ -100,7 +100,7 @@
(log-lo (/ (log (max lo 1.0)) log2))
(log-hi (/ (log hi) log2))
(log-val (/ (log val) log2)))
- (inexact->exact (floor (* log-scale-ticks (/ (- log-val log-lo) (- log-hi log-lo)))))))
+ (floor (* log-scale-ticks (/ (- log-val log-lo) (- log-hi log-lo))))))
(define (scale-linear->log lo val hi)
;; given user-relative lo..hi and scale-relative val, return user-relative val
diff --git a/gtk-popup.scm b/gtk-popup.scm
index d0c3a9b..f55b5ec 100644
--- a/gtk-popup.scm
+++ b/gtk-popup.scm
@@ -76,9 +76,9 @@
(change-label w "Stop")
(set! stop-widget w)
(set! stopping #t)
- (play-selection #f (lambda (reason)
- (set! stopping #f)
- (change-label w "Play")))))))
+ (play (selection) :wait #f :stop (lambda (reason)
+ (set! stopping #f)
+ (change-label w "Play")))))))
(list "Loop play" every-menu
(lambda (w data)
(define (stop-playing-selection)
@@ -92,7 +92,7 @@
(if (and (not (c-g?))
(= reason 0)
stopping1)
- (play-selection #f play-selection-again)
+ (play (selection) :wait #f :stop play-selection-again)
(stop-playing-selection)))
(if stopping1
(begin
@@ -102,7 +102,7 @@
(change-label w "Stop!")
(set! stop-widget1 w) ; needs to be separate from Play case since we're stopping/restarting deliberately
(set! stopping1 #t)
- (play-selection #f play-selection-again)))))
+ (play (selection) :wait #f :stop play-selection-again)))))
(list "Delete" every-menu (lambda (w data) (delete-selection)))
(list "Zero" every-menu (lambda (w data) (scale-selection-by 0.0)))
(list "Crop" every-menu
@@ -306,7 +306,7 @@
(srate snd)
(mus-header-type-name (header-type snd))
(mus-data-format-name (data-format snd))
- (exact->inexact (/ (frames snd graph-popup-chn) (srate snd)))
+ (* 1.0 (/ (frames snd graph-popup-chn) (srate snd)))
(maxamp snd #t)
(if (comment snd)
(format #f " comment: \"~A\"~%" (comment snd))
diff --git a/index.html b/index.html
index d5dc605..8b95445 100644
--- a/index.html
+++ b/index.html
@@ -25,303 +25,307 @@
</td></tr></table>
<br>
-<!-- created 28-Feb-2010 at 4:05 -->
+<!-- created 3-Jun-2010 at 3:10 -->
<table cellspacing=0 cellpadding=1>
- <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td width=20></td><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td width=20></td><td><em class=tab><a href="sndclm.html#make-mixer!">make-mixer!</a></em></td><td width=20></td><td><em class=tab><a href="sndscm.html#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a></em></td><td width=20></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addcomment">add-comment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#evalbetweenmarks">eval-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#evaloverselection">eval-over-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd-&gt;sample</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd-&gt;sample?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td bgcolor="lightgreen"><center>O</center></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addwatcher">add-watcher</a></em></td><td></td><td><em class=tab><a href="extsnd.html#extractchannel">extract-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#extractchannels">extract-channels</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td bgcolor="lightgreen"><center>F</center></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="snd.html#fftsize">fft sizes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#optimization">optimization</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeregionframereader">make-region-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#optimizationhook">optimization-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound-&gt;amp-env</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoframe">sound-&gt;frame</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample-&gt;file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound-&gt;integer</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtosounddata">sound-&gt;sound-data</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#oscopedoc">oscilloscope dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndsounddata"><b>sound-data</b></a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-scalar-mixer">make-scalar-mixer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata*">sound-data*</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata+">sound-data+</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#appendsound">append-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselectionframereader">make-selection-frame-reader</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatofile">sound-data-&gt;file</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file-&gt;array</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd-&gt;sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatoframe">sound-data-&gt;frame</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframe">file-&gt;frame</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputnamehook">output-name-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatosound">sound-data-&gt;sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#arraytofile">array-&gt;file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframe?">file-&gt;frame?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesounddata">make-sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatatosounddata">sound-data-&gt;sound-data</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file-&gt;sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatatovct">sound-data-&gt;vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file-&gt;sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td bgcolor="lightgreen"><center>P</center></td><td></td><td><em class=tab><a href="extsnd.html#sounddataadd">sound-data-add!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filetosounddata">file-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatachans">sound-data-chans</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filetovct">file-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesyncframereader">make-sync-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatacopy">sound-data-copy</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatafill">sound-data-fill!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#audioinputdevice">audio-input-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatalength">sound-data-length</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#audiooutputdevice">audio-output-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatamaxamp">sound-data-maxamp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixvct">pan-mix-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatamultiply">sound-data-multiply!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials-&gt;polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataoffset">sound-data-offset!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials-&gt;wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatapeak">sound-data-peak</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevct">make-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataref">sound-data-ref</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatareverse">sound-data-reverse!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvhook">peak-env-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatascale">sound-data-scale!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsound">map-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataset">sound-data-set!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata?">sound-data?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials-&gt;wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark-&gt;integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>B</center></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sound-let">sound-let</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdragtrianglehook">mark-drag-triangle-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findchannel">find-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name-&gt;id</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#bomb">bomb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</A></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar-&gt;rectangular</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum-&gt;coeffs</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixerdoc"><b>Matrices</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>C</center></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cgx">c-g!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxvirtualptrees">max-virtual-ptrees</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#callin">call_in</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">fm-voice</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade-&gt;canonical</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position-&gt;x</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeltovct">channel-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position-&gt;y</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#minibufferhistorylength">minibuffer-history-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#previousframe">previous-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix-&gt;integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtovct">mix-&gt;vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printhook">print-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fouriertransform">fourier-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#profile">profile</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame1">frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame*">frame*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#promptinminibuffer">prompt-in-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame+">frame+</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ptreechannel">ptree-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametofile">frame-&gt;file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelstyleconstants">channels-separate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametofile?">frame-&gt;file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channels=">channels=?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametoframe">frame-&gt;frame</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixframe">mix-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pushedbuttoncolor">pushed-button-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#starthook">start-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametolist">frame-&gt;list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametosample">frame-&gt;sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td bgcolor="lightgreen"><center>Q</center></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#checkforunsavededits">check-for-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametosound">frame-&gt;sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametosounddata">frame-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixmovesound">mix-move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#quitbuttoncolor">quit-button-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametovct">frame-&gt;vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#startwaterfall">start-waterfall</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framecopy">frame-copy</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name-&gt;id</a></em></td><td></td><td bgcolor="lightgreen"><center>R</center></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo-&gt;mono</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#clear-array">clear-array</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderatendQ">frame-reader-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#stopdachook">stop-dac-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderchans">frame-reader-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians-&gt;degrees</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clearminibuffer">clear-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderhome">frame-reader-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians-&gt;hz</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#clearselection">clear-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderposition">frame-reader-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderQ">frame-reader?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame-ref">frame-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereverse">frame-reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#clmload">clm-load</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame-set!">frame-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clonesoundas">clone-sound-as</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame?">frame?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsounddata">mix-sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#framedoc"><b>frames</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="sndscm.html#readframe">read-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#frames">frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colortolist">color-&gt;list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframes"><b>frames (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-all">sync-all</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeframereader">free-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixvct">mix-vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td bgcolor="lightgreen"><center>T</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#recorderdialog">recorder-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mixer1">mixer</a></em></td><td></td><td><em class=tab><a href="snd.html#recordfile"><b>Recording</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td bgcolor="lightgreen"><center>G</center></td><td></td><td><em class=tab><a href="sndclm.html#mixermultiply">mixer*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular-&gt;magnitudes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap-&gt;integer</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#mixerdoc">mixer as matrix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular-&gt;polar</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixeradd">mixer+</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixercopy">mixer-copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redochannel">redo-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-determinant">mixer-determinant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redoedit">redo-edit</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphhook">time-graph-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-inverse">mixer-inverse</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regiontoframe">region-&gt;frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph-&gt;ps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-poly">mixer-poly</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region-&gt;integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer-ref">mixer-ref</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regiontosounddata">region-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer-set!">mixer-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontovct">region-&gt;vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-solve">mixer-solve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-transpose">mixer-transpose</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframes">region-frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#compandchannel">compand-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer?">mixer?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform-&gt;integer</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#compandsound">compand-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#framedoc"><b>mixers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtovct">transform-&gt;vct</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-frametofile">continue-frame-&gt;file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframes">transform-frames</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample-&gt;file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono-&gt;stereo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph-&gt;ps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphlines">graph-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr>
- <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls-&gt;channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trapsegfault">trap-segfault</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reportinminibuffer">report-in-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetbuttoncolor">reset-button-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td bgcolor="lightgreen"><center>H</center></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</A></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#copyframereader">copy-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</A></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td bgcolor="lightgreen"><center>U</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and Data formats</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpbuttoncolor">help-button-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#countmatches">count-matches</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#createssbdialog">create-ssb-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undochannel">undo-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoedit">undo-edit</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#currenteditposition">current-edit-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannels">reverse-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</A></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorfollowsplay">cursor-follows-play</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz-&gt;radians</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorchoices">cursor-in-view</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td bgcolor="lightgreen"><center>I</center></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#multiply-arrays">multiply-arrays</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td bgcolor="lightgreen"><center>V</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rotatechannel">rotate-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vct">vct</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>D</center></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttimes">vct*</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctplus">vct+</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioclose">mus-audio-close</a></em></td><td></td><td><em class=tab><a href="extsnd.html#run">run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttochannel">vct-&gt;channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dachook">dac-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudiodescribe">mus-audio-describe</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#vcttofile">vct-&gt;file</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioopeninput">mus-audio-open-input</a></em></td><td></td><td bgcolor="lightgreen"><center>S</center></td><td></td><td><em class=tab><a href="sndscm.html#vcttoframe">vct-&gt;frame</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioopenoutput">mus-audio-open-output</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#vcttolist">vct-&gt;list</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dataformat">data-format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioread">mus-audio-read</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttosounddata">vct-&gt;sound-data</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertframe">insert-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudiowrite">mus-audio-write</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttostring">vct-&gt;string</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample-&gt;file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttovector">vct-&gt;vector</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db-&gt;linear</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample-&gt;file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctadd">vct-add!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletoframe">sample-&gt;frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctcopy">vct-copy</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctfill">vct-fill!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctlength">vct-length</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#def-clm-struct">def-clm-struct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmap">vct-map!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertsounddata">insert-sound-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmove">vct-move!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputdataformat">default-output-data-format</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertvct">insert-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musdataformattostring">mus-data-format-&gt;string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmultiply">vct-multiply!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musdataformatname">mus-data-format-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctoffset">vct-offset!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#instruments">instruments</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples-&gt;seconds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctpeak">vct-peak</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer-&gt;colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vctpolynomial">vct-polynomial</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer-&gt;mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type-&gt;string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctref">vct-ref</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer-&gt;mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctreverse">vct-reverse!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#definstrument">definstrument</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer-&gt;region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctscale">vct-scale!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defvar">defvar</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer-&gt;sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctset">vct-set!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees-&gt;radians</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer-&gt;transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfft">mus-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubseq">vct-subseq</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubtract">vct-subtract!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemacros">save-macros</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctp">vct?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#Vcts"><b>Vcts</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td bgcolor="lightgreen"><center>J</center></td><td></td><td><em class=tab><a href="extsnd.html#musfileprescaler">mus-file-prescaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vectortovct">vector-&gt;vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#verbosecursor">verbose-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemixes">save-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type-&gt;string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td bgcolor="lightgreen"><center>K</center></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="snd.html#builtinkeys"><b>Key bindings</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletewatcher">delete-watcher</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td bgcolor="lightgreen"><center>L</center></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ptreechannel"><b>Virtual Edits</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musmix">mus-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced-&gt;unvoiced</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td><td bgcolor="lightgreen"><center>W</center></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displayscannedsynthesis">display-scanned-synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelevelmeter">level meters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear-&gt;db</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musoutformat">mus-out-format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dlocsig">dlocsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musprescaler">mus-prescaler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dop">do?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#doitagainbuttoncolor">doit-again-button-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtovct">list-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#doitbuttoncolor">doit-button-color</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scansound">scan-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-safety">mus-safety</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowproperty">window-property</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowpropertychangedhook">window-property-changed-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddataformat">mus-sound-data-format</a></em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds-&gt;samples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframes">mus-sound-frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>E</center></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#loopbetweenmarks">loop-between-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmarkedsound">with-marked-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection-&gt;mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmixedsound">with-mixed-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td bgcolor="lightgreen"><center>M</center></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectiontosounddata">selection-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmixedsoundtonotelist">with-mixed-sound-&gt;notelist</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list-&gt;function</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withreopenmenu">with-reopen-menu</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframes">selection-frames</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtempsound">with-temp-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframe">mus-sound-seek-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withthreadedchannels">with-threaded-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withthreadedsound">with-threaded-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#emacsstylesaveas">emacs-style-save-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td><td></td><td bgcolor="lightgreen"><center>X</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sendmozilla">send-mozilla</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="sndscm.html#setglobalsync">set-global-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x-&gt;position</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="sndscm.html#shepardtone">shepard-tone</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframe">make-file-&gt;frame</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file-&gt;sample</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td bgcolor="lightgreen"><center>N</center></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td><td></td><td bgcolor="lightgreen"><center>Y</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y-&gt;position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frame">make-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frame!">make-frame!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showselection">show-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frametofile">make-frame-&gt;file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeframereader">make-frame-reader</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nextframe">next-frame</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showsmptelabel">show-smpte-label</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td><td></td><td bgcolor="lightgreen"><center>Z</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehiddencontrolsdialog">make-hidden-controls-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-mixer">make-mixer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td><td></td>
+ <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td width=20></td><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td width=20></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td width=20></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td width=20></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr>
+ <tr><td bgcolor="lightgreen"><center>A</center></td><td></td><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-mixer">make-mixer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-mixer!">make-mixer!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="s7.html#errorhook">*error-hook*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addcomment">add-comment</a></em></td><td></td><td><em class=tab><a href="s7.html#errorinfo">*error-info*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd-&gt;sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#evalbetweenmarks">eval-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd-&gt;sample?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#evaloverselection">eval-over-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td bgcolor="lightgreen"><center>O</center></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addwatcher">add-watcher</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#extractchannel">extract-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#extractchannels">extract-channels</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td bgcolor="lightgreen"><center>F</center></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound-&gt;amp-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoframe">sound-&gt;frame</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#optimization">optimization</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound-&gt;integer</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="snd.html#fftsize">fft sizes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#optimizationhook">optimization-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtosounddata">sound-&gt;sound-data</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndsounddata"><b>sound-data</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata*">sound-data*</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeregionframereader">make-region-frame-reader</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata+">sound-data+</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#oscopedoc">oscilloscope dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatofile">sound-data-&gt;file</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample-&gt;file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatoframe">sound-data-&gt;frame</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatosound">sound-data-&gt;sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatatosounddata">sound-data-&gt;sound-data</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-scalar-mixer">make-scalar-mixer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatatovct">sound-data-&gt;vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#appendsound">append-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputnamehook">output-name-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataadd">sound-data-add!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselectionframereader">make-selection-frame-reader</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatachans">sound-data-chans</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd-&gt;sample</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatacopy">sound-data-copy</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#arraytofile">array-&gt;file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file-&gt;array</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td bgcolor="lightgreen"><center>P</center></td><td></td><td><em class=tab><a href="extsnd.html#sounddatafill">sound-data-fill!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframe">file-&gt;frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesounddata">make-sound-data</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatalength">sound-data-length</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframe?">file-&gt;frame?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatamaxamp">sound-data-maxamp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file-&gt;sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatamultiply">sound-data-multiply!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file-&gt;sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataoffset">sound-data-offset!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filetosounddata">file-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesyncframereader">make-sync-frame-reader</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatapeak">sound-data-peak</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#audioinputdevice">audio-input-device</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filetovct">file-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixvct">pan-mix-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataref">sound-data-ref</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#audiooutputdevice">audio-output-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials-&gt;polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatareverse">sound-data-reverse!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials-&gt;wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatascale">sound-data-scale!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataset">sound-data-set!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata?">sound-data?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvhook">peak-env-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevct">make-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials-&gt;wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsound">map-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sound-let">sound-let</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark-&gt;integer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr>
+ <tr><td bgcolor="lightgreen"><center>B</center></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdragtrianglehook">mark-drag-triangle-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findchannel">find-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name-&gt;id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum-&gt;coeffs</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar-&gt;rectangular</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#bomb">bomb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</A></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</A></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixerdoc"><b>Matrices</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
+ <tr><td bgcolor="lightgreen"><center>C</center></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxvirtualptrees">max-virtual-ptrees</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cgx">c-g!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position-&gt;x</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position-&gt;y</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#callin">call_in</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">fm-voice</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade-&gt;canonical</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeltovct">channel-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="sndscm.html#previousframe">previous-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#minibufferhistorylength">minibuffer-history-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printhook">print-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix-&gt;integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtovct">mix-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#profile">profile</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#promptinminibuffer">prompt-in-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fouriertransform">fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ptreechannel">ptree-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#starthook">start-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame1">frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame*">frame*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pushedbuttoncolor">pushed-button-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame+">frame+</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametofile">frame-&gt;file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td bgcolor="lightgreen"><center>Q</center></td><td></td><td><em class=tab><a href="sndscm.html#startwaterfall">start-waterfall</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelstyleconstants">channels-separate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametofile?">frame-&gt;file?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixframe">mix-frame</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo-&gt;mono</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channels=">channels=?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametoframe">frame-&gt;frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#quitbuttoncolor">quit-button-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopdachook">stop-dac-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametolist">frame-&gt;list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametosample">frame-&gt;sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td bgcolor="lightgreen"><center>R</center></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#checkforunsavededits">check-for-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametosound">frame-&gt;sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixmovesound">mix-move-sound</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametosounddata">frame-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians-&gt;degrees</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametovct">frame-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name-&gt;id</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians-&gt;hz</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framecopy">frame-copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#clear-array">clear-array</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderatendQ">frame-reader-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderchans">frame-reader-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clearminibuffer">clear-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderhome">frame-reader-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#clearselection">clear-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderposition">frame-reader-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderQ">frame-reader?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-all">sync-all</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame-ref">frame-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#readframe">read-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereverse">frame-reverse!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#clmload">clm-load</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame-set!">frame-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsounddata">mix-sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clonesoundas">clone-sound-as</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame?">frame?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td bgcolor="lightgreen"><center>T</center></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#framedoc"><b>frames</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#frames">frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colortolist">color-&gt;list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframes"><b>frames (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeframereader">free-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#recorderdialog">recorder-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixvct">mix-vct</a></em></td><td></td><td><em class=tab><a href="snd.html#recordfile"><b>Recording</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular-&gt;magnitudes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular-&gt;polar</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphhook">time-graph-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer1">mixer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mixermultiply">mixer*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redochannel">redo-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td bgcolor="lightgreen"><center>G</center></td><td></td><td><em class=tab><a href="sndscm.html#mixerdoc">mixer as matrix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redoedit">redo-edit</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap-&gt;integer</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mixeradd">mixer+</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regiontoframe">region-&gt;frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixercopy">mixer-copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region-&gt;integer</a></em></td><td></td><td><em class=tab><a href="s7.html#tracehook">*trace-hook*</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-determinant">mixer-determinant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regiontosounddata">region-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-inverse">mixer-inverse</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontovct">region-&gt;vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-poly">mixer-poly</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform-&gt;integer</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph-&gt;ps</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer-ref">mixer-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframes">region-frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtovct">transform-&gt;vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer-set!">mixer-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-solve">mixer-solve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframes">transform-frames</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-transpose">mixer-transpose</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer?">mixer?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#compandchannel">compand-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#framedoc"><b>mixers</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#compandsound">compand-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-frametofile">continue-frame-&gt;file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono-&gt;stereo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample-&gt;file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph-&gt;ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trapsegfault">trap-segfault</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphlines">graph-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reportinminibuffer">report-in-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr>
+ <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls-&gt;channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetbuttoncolor">reset-button-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td bgcolor="lightgreen"><center>U</center></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td bgcolor="lightgreen"><center>H</center></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#copyframereader">copy-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and Data formats</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undochannel">undo-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoedit">undo-edit</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpbuttoncolor">help-button-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#countmatches">count-matches</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#createssbdialog">create-ssb-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannels">reverse-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</A></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#currenteditposition">current-edit-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</A></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td bgcolor="lightgreen"><center>V</center></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorfollowsplay">cursor-follows-play</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz-&gt;radians</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorchoices">cursor-in-view</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td bgcolor="lightgreen"><center>I</center></td><td></td><td><em class=tab><a href="sndclm.html#multiply-arrays">multiply-arrays</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vct">vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rotatechannel">rotate-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttimes">vct*</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctplus">vct+</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttochannel">vct-&gt;channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#run">run</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vcttofile">vct-&gt;file</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#vcttoframe">vct-&gt;frame</a></em></td></tr>
+ <tr><td bgcolor="lightgreen"><center>D</center></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td bgcolor="lightgreen"><center>S</center></td><td></td><td><em class=tab><a href="extsnd.html#vcttolist">vct-&gt;list</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioclose">mus-audio-close</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#vcttosounddata">vct-&gt;sound-data</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudiodescribe">mus-audio-describe</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttostring">vct-&gt;string</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dachook">dac-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioopeninput">mus-audio-open-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttovector">vct-&gt;vector</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioopenoutput">mus-audio-open-output</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample-&gt;file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctadd">vct-add!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioread">mus-audio-read</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample-&gt;file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctcopy">vct-copy</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dataformat">data-format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudiowrite">mus-audio-write</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletoframe">sample-&gt;frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctfill">vct-fill!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertframe">insert-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctlength">vct-length</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmap">vct-map!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db-&gt;linear</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmove">vct-move!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmultiply">vct-multiply!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctoffset">vct-offset!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctpeak">vct-peak</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#def-clm-struct">def-clm-struct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples-&gt;seconds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vctpolynomial">vct-polynomial</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertsounddata">insert-sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musdataformattostring">mus-data-format-&gt;string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctref">vct-ref</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputdataformat">default-output-data-format</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertvct">insert-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musdataformatname">mus-data-format-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctreverse">vct-reverse!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctscale">vct-scale!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#instruments">instruments</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctset">vct-set!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer-&gt;colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type-&gt;string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubseq">vct-subseq</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer-&gt;mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubtract">vct-subtract!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer-&gt;mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctp">vct?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#definstrument">definstrument</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer-&gt;region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemacros">save-macros</a></em></td><td></td><td><em class=tab><a href="extsnd.html#Vcts"><b>Vcts</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defvar">defvar</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer-&gt;sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfft">mus-fft</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vectortovct">vector-&gt;vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees-&gt;radians</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer-&gt;transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab><a href="s7.html#vectorprintlength">*vector-print-length*</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#verbosecursor">verbose-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemixes">save-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musfileprescaler">mus-file-prescaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td bgcolor="lightgreen"><center>J</center></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type-&gt;string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td bgcolor="lightgreen"><center>K</center></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="snd.html#builtinkeys"><b>Key bindings</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ptreechannel"><b>Virtual Edits</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletewatcher">delete-watcher</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced-&gt;unvoiced</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td bgcolor="lightgreen"><center>L</center></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#musmix">mus-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td><td bgcolor="lightgreen"><center>W</center></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displayscannedsynthesis">display-scanned-synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelevelmeter">level meters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musoutformat">mus-out-format</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear-&gt;db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musprescaler">mus-prescaler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scansound">scan-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dlocsig">dlocsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dop">do?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#doitagainbuttoncolor">doit-again-button-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtovct">list-&gt;vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#doitbuttoncolor">doit-button-color</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-safety">mus-safety</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowproperty">window-property</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowpropertychangedhook">window-property-changed-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds-&gt;samples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddataformat">mus-sound-data-format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#loadhook">*load-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframes">mus-sound-frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmarkedsound">with-marked-sound</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr>
+ <tr><td bgcolor="lightgreen"><center>E</center></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection-&gt;mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmixedsound">with-mixed-sound</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectiontosounddata">selection-&gt;sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmixedsoundtonotelist">with-mixed-sound-&gt;notelist</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#loopbetweenmarks">loop-between-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withreopenmenu">with-reopen-menu</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframes">selection-frames</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list-&gt;function</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtempsound">with-temp-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td bgcolor="lightgreen"><center>M</center></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withthreadedchannels">with-threaded-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withthreadedsound">with-threaded-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframe">mus-sound-seek-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td><td></td><td bgcolor="lightgreen"><center>X</center></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sendmozilla">send-mozilla</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#emacsstylesaveas">emacs-style-save-as</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="sndscm.html#setglobalsync">set-global-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x-&gt;position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#shepardtone">shepard-tone</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td bgcolor="lightgreen"><center>N</center></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td><td></td><td bgcolor="lightgreen"><center>Y</center></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframe">make-file-&gt;frame</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file-&gt;sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y-&gt;position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showselection">show-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showsmptelabel">show-smpte-label</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td><td></td><td bgcolor="lightgreen"><center>Z</center></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frame">make-frame</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nextframe">next-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frame!">make-frame!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frametofile">make-frame-&gt;file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeframereader">make-frame-reader</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehiddencontrolsdialog">make-hidden-controls-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td><td></td>
+</tr>
+ <tr><td><em class=tab><a href="sndscm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td><td></td>
</tr>
</table>
diff --git a/jcrev.scm b/jcrev.scm
index 1a99a12..124a0cb 100644
--- a/jcrev.scm
+++ b/jcrev.scm
@@ -26,7 +26,7 @@
(file-dur (frames *reverb*))
(decay-dur (mus-srate))
(len (floor (+ decay-dur file-dur)))
- (envA (if amp-env (make-env :envelope amp-env :scaler volume :duration (exact->inexact (/ len (mus-srate)))) #f))
+ (envA (if amp-env (make-env :envelope amp-env :scaler volume :duration (/ len (mus-srate))) #f))
(scl volume))
(ws-interrupt?)
(if (or amp-env low-pass)
diff --git a/jcvoi.scm b/jcvoi.scm
index 8e13a9d..261b68b 100644
--- a/jcvoi.scm
+++ b/jcvoi.scm
@@ -13,7 +13,7 @@
(len (length data)))
(do ((i 0 (+ i 2)))
((>= i len))
- (let ((x (list-ref data (1+ i)))
+ (let ((x (list-ref data (+ 1 i)))
(y (list-ref data i)))
(set! unseg (cons x unseg))
(set! unseg (cons y unseg))))
@@ -32,10 +32,10 @@
100)))
(define (setf-aref vect a b c d val)
- (vector-set! vect (+ a (* 3 b) (* 3 6 c) (* 3 6 4 d)) val))
+ (set! (vect (+ a (* 3 b) (* 3 6 c) (* 3 6 4 d))) val))
(define (aref vect a b c d)
- (vector-ref vect (+ a (* 3 b) (* 3 6 c) (* 3 6 4 d))))
+ (vect (+ a (* 3 b) (* 3 6 c) (* 3 6 4 d))))
(define (fillfnc)
(if (not fnc)
@@ -141,16 +141,16 @@
;; these are vibrato frequencies functions (pitch dependent);
- (vector-set! vibfreqfun 1 (flipxy '(4.5 138.8 5 1568)))
- (vector-set! vibfreqfun 2 (flipxy '(4.5 16.5 5 130.8)))
+ (set! (vibfreqfun 1) (flipxy '(4.5 138.8 5 1568)))
+ (set! (vibfreqfun 2) (flipxy '(4.5 16.5 5 130.8)))
;; these are index functions for cascade modulater (pitch dependent);
- (vector-set! i3fun1 1 (flipxy '(4 138.8 4 784 1 1568)))
- (vector-set! i3fun1 2 (flipxy '(4 16.5 4 65.41 1 130.8)))
+ (set! (i3fun1 1) (flipxy '(4 138.8 4 784 1 1568)))
+ (set! (i3fun1 2) (flipxy '(4 16.5 4 65.41 1 130.8)))
- (vector-set! i3fun2 1 (flipxy '(.4 138.8 .1 1568)))
- (vector-set! i3fun2 2 (flipxy '(.4 16.5 .1 130.8)))
+ (set! (i3fun2 1) (flipxy '(.4 138.8 .1 1568)))
+ (set! (i3fun2 2) (flipxy '(.4 16.5 .1 130.8)))
)))
(define (fncval ptr pitch)
@@ -164,7 +164,7 @@
(sex (floor sex-1))
(ampref (expt amp .8))
(deg (- deg 45))
- (vibfreq (fncval (vector-ref vibfreqfun sex) pitch))
+ (vibfreq (fncval (vibfreqfun sex) pitch))
(vibpc (* .01 (/ (log pitch) (log 2)) (+ .15 (sqrt amp)) vibscl))
(ranfreq 20)
(ranpc (* .002 (/ (log pitch) (log 2)) (- 2 (expt amp .25)) pcran))
@@ -203,8 +203,8 @@
(indx0 (if (or (= vowel 3) (= vowel 4)) 0 1.5))
(indx1 1)
(i3 (if (< pitch (/ c 2))
- (fncval (vector-ref i3fun1 sex) pitch)
- (fncval (vector-ref i3fun2 sex) pitch)))
+ (fncval (i3fun1 sex) pitch)
+ (fncval (i3fun2 sex) pitch)))
(dev (hz->radians (* i3 mfq)))
(dev0 (hz->radians (* indx0 mfq)))
(dev1 (hz->radians (* (- indx1 indx0) mfq))))
diff --git a/maraca.scm b/maraca.scm
index 6d81ef4..fdf9d4a 100644
--- a/maraca.scm
+++ b/maraca.scm
@@ -23,7 +23,7 @@
(num-beans 64)
(j 0)
(sndamp (/ amp 16384.0))
- (srate4 (inexact->exact (floor (/ (mus-srate) 4))))
+ (srate4 (floor (/ (mus-srate) 4)))
(gain (/ (* (/ (log num-beans) (log 4.0)) 40) num-beans)))
(ws-interrupt?)
;; gourd resonance filter
diff --git a/misc.scm b/misc.scm
index 65bf7ac..c119188 100644
--- a/misc.scm
+++ b/misc.scm
@@ -369,7 +369,7 @@
(let ((time (* 1000 (car tone)))
(region (cadr tone)))
(if (region? region)
- (in time (lambda () (play-region region))))))
+ (in time (lambda () (play region))))))
data))
;;; (region-play-list (list (list 0.0 0) (list 0.5 1) (list 1.0 2) (list 1.0 0)))
diff --git a/mix.scm b/mix.scm
index ab8604d..087e5fe 100644
--- a/mix.scm
+++ b/mix.scm
@@ -175,9 +175,9 @@ All mixes sync'd to it are also moved the same number of samples. (remove-hook!
(format #f "~A" n))
(mix-sync n)
(mix-position n)
- (exact->inexact (/ (mix-position n) (srate (car (mix-home n)))))
+ (* 1.0 (/ (mix-position n) (srate (car (mix-home n)))))
(frames n)
- (exact->inexact (/ (frames n) (srate (car (mix-home n)))))
+ (* 1.0 (/ (frames n) (srate (car (mix-home n)))))
(short-file-name (car (mix-home n)))
(cadr (mix-home n))
(mix-amp n)
@@ -413,7 +413,10 @@ last end of the mixes in 'mix-list'"
(play (lambda ()
(while (and (not (null? sorted-mixes))
(= now (mix-position (car sorted-mixes))))
- (play-mix (car sorted-mixes))
+ (play (let ((mx (car sorted-mixes)))
+ (if (integer? mx)
+ (integer->mix mx)
+ mx)))
(set! sorted-mixes (cdr sorted-mixes)))
(set! now (+ 1 now))
(if (null? sorted-mixes)
diff --git a/mixer.scm b/mixer.scm
index b79ea10..7506d41 100644
--- a/mixer.scm
+++ b/mixer.scm
@@ -136,21 +136,21 @@
(row 0))
(do ((j 0 (+ 1 j)))
((= j n))
- (if (not (= (vector-ref pivots j) 1))
+ (if (not (= (pivots j) 1))
(begin
(do ((k 0 (+ 1 k)))
((= k n))
- (if (= (vector-ref pivots k) 0)
+ (if (= (pivots k) 0)
(let ((val (abs (mat matrix j k))))
(if (> val biggest)
(begin
(set! col k)
(set! row j)
(set! biggest val))))
- (if (> (vector-ref pivots k) 1)
+ (if (> (pivots k) 1)
(return #f)))))))
(if (< biggest zero) (return #f)) ; this can be fooled (floats...): (invert-matrix (make-mixer 3 1 2 3 3 2 1 4 5 6))
- (vector-set! pivots col (+ (vector-ref pivots col) 1))
+ (set! (pivots col) (+ (pivots col) 1))
(if (not (= row col))
(let ((temp (if b (frame-ref b row) 0.0)))
(if b
@@ -162,8 +162,8 @@
(set! temp (mat matrix row k))
(set! (mat matrix row k) (mat matrix col k))
(set! (mat matrix col k) temp))))
- (vector-set! cols i col)
- (vector-set! rows i row)
+ (set! (cols i) col)
+ (set! (rows i) row)
;; round-off troubles here
(if (< (abs (mat matrix col col)) zero)
(return #f))
@@ -184,12 +184,12 @@
(if b (frame-set! b k (- (frame-ref b k) (* scl (frame-ref b col))))))))))
(do ((i (- n 1) (- i 1)))
((< i 0))
- (if (not (= (vector-ref rows i) (vector-ref cols i)))
+ (if (not (= (rows i) (cols i)))
(do ((k 0 (+ 1 k)))
((= k n))
- (let ((temp (mat matrix k (vector-ref rows i))))
- (set! (mat matrix k (vector-ref rows i)) (mat matrix k (vector-ref cols i)))
- (set! (mat matrix k (vector-ref cols i)) temp)))))
+ (let ((temp (mat matrix k (rows i))))
+ (set! (mat matrix k (rows i)) (mat matrix k (cols i)))
+ (set! (mat matrix k (cols i)) temp)))))
(list matrix b)))))
;;; it would be faster to use invert-matrix to calculate the determinant, but that
diff --git a/mus-config.h.in b/mus-config.h.in
index 6a0b7cb..afe9791 100644
--- a/mus-config.h.in
+++ b/mus-config.h.in
@@ -218,6 +218,7 @@
#undef HAVE_GTK_STATUS_ICON_GET_TITLE
#undef HAVE_GTK_WIDGET_GET_VISIBLE
#undef HAVE_GTK_ENTRY_GET_TEXT_WINDOW
+#undef HAVE_GTK_SCALE_NEW
#undef HAVE_PANGO_MATRIX_ROTATE
#undef MUS_PANGO_VERSION
diff --git a/musglyphs.scm b/musglyphs.scm
index c34b8dd..3aa3ec5 100644
--- a/musglyphs.scm
+++ b/musglyphs.scm
@@ -25,11 +25,11 @@
(len (length vect)))
(do ((i 0 (+ 1 i)))
((= i len))
- (vector-set! vals (+ start i) (vector-ref vect i)))
+ (set! (vals (+ start i)) (vect i)))
(set-vals (cdr vects) (+ start len) vals))
(if (car vects)
(begin
- (vector-set! vals start (car vects))
+ (set! (vals start) (car vects))
(set-vals (cdr vects) (+ start 1) vals))
(set-vals (cdr vects) start vals)))))
(set-vals args 0 (make-vector (total-length args 0)))))
@@ -45,13 +45,13 @@
(ay (- y3 (+ y0 cy by)))
(incr (/ 1.0 n))
(pts (make-vector (* 2 (+ n 1)))))
- (vector-set! pts 0 x0)
- (vector-set! pts 1 y0)
+ (set! (pts 0) x0)
+ (set! (pts 1) y0)
(do ((i 0 (+ 1 i))
(val incr (+ val incr)))
((> i n) pts)
- (vector-set! pts (* i 2) (floor (+ x0 (* val (+ cx (* val (+ bx (* val ax))))))))
- (vector-set! pts (+ (* i 2) 1) (floor (+ y0 (* val (+ cy (* val (+ by (* val ay)))))))))))
+ (set! (pts (* i 2)) (floor (+ x0 (* val (+ cx (* val (+ bx (* val ax))))))))
+ (set! (pts (+ (* i 2) 1)) (floor (+ y0 (* val (+ cy (* val (+ by (* val ay)))))))))))
;; pass our Snd context into the graphics procedures (there's probably a cleaner way)
(define ps-snd 0)
@@ -95,8 +95,8 @@
(define (lineto score x y)
(let ((v (make-vector 2)))
- (vector-set! v 0 (->x x))
- (vector-set! v 1 (->y y))
+ (set! (v 0) (->x x))
+ (set! (v 1) (->y y))
(set! curx x)
(set! cury y)
(set! pathlist (cons v pathlist))
@@ -106,8 +106,8 @@
(let ((v (make-vector 2)))
(set! curx (+ curx x))
(set! cury (+ cury y))
- (vector-set! v 0 (->x curx))
- (vector-set! v 1 (->y cury))
+ (set! (v 0) (->x curx))
+ (set! (v 1) (->y cury))
(set! pathlist (cons v pathlist))
#f))
diff --git a/noise.scm b/noise.scm
index adde978..09709cc 100644
--- a/noise.scm
+++ b/noise.scm
@@ -137,7 +137,7 @@
(degree (random 90.0))
(distance 1.0)
(reverb-amount 0.005))
- (let* ((dur (/ len (inexact->exact (srate))))
+ (let* ((dur (/ len (floor (srate))))
(amp-attack (attack-point dur ampat ampdc))
(amp-decay (- 100.0 (attack-point dur ampdc ampat)))
(freq-attack (attack-point dur freqat freqdc))
diff --git a/nrev.scm b/nrev.scm
index 013b010..b3ee864 100644
--- a/nrev.scm
+++ b/nrev.scm
@@ -28,7 +28,7 @@
(dly-len (list 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19)))
(do ((i 0 (+ i 1)))
((= i 15))
- (let ((val (inexact->exact (floor (* srscale (list-ref dly-len i))))))
+ (let ((val (floor (* srscale (list-ref dly-len i)))))
(if (even? val) (set! val (+ 1 val)))
(list-set! dly-len i (next-prime val))))
diff --git a/numerics.scm b/numerics.scm
index 6343636..756523e 100644
--- a/numerics.scm
+++ b/numerics.scm
@@ -6,8 +6,8 @@
(define factorial
(let* ((num-factorials 128)
(factorials (let ((temp (make-vector num-factorials 0)))
- (vector-set! temp 0 1) ; is this correct?
- (vector-set! temp 1 1)
+ (set! (temp 0) 1) ; is this correct?
+ (set! (temp 1) 1)
temp)))
(lambda (n)
(if (> n num-factorials)
@@ -17,10 +17,10 @@
(set! factorials (make-vector num-factorials 0))
(do ((i 0 (+ 1 i)))
((= i old-num))
- (vector-set! factorials i (vector-ref old-facts i)))))
- (if (zero? (vector-ref factorials n))
- (vector-set! factorials n (* n (factorial (- n 1)))))
- (vector-ref factorials n))))
+ (set! (factorials i) (old-facts i)))))
+ (if (zero? (factorials n))
+ (set! (factorials n) (* n (factorial (- n 1)))))
+ (factorials n))))
(define (binomial-direct n m) ; "n-choose-m" might be a better name (there are much better ways to compute this -- see below)
(/ (factorial n)
@@ -81,22 +81,22 @@
(define (legendre-polynomial a x) ; sum of weighted polynomials (m=0)
(let ((n (- (length a) 1)))
(if (= n 0)
- (vector-ref a 0)
+ (a 0)
(let* ((r x)
(s 1.0)
(h 0.0)
- (sum (vector-ref a 0)))
+ (sum (a 0)))
(do ((k 1 (+ 1 k)))
((= k n))
(set! h r)
- (set! sum (+ sum (* r (vector-ref a k))))
+ (set! sum (+ sum (* r (a k))))
(set! r (/ (- (* r x (+ (* 2 k) 1)) (* s k)) (+ k 1)))
(set! s h))
- (+ sum (* r (vector-ref a n)))))))
+ (+ sum (* r (a n)))))))
(define (legendre n x)
(legendre-polynomial (let ((v (make-vector (+ 1 n) 0.0)))
- (vector-set! v n 1.0)
+ (set! (v n) 1.0)
v)
x))
@@ -164,69 +164,69 @@
(define* (chebyshev-polynomial a x (kind 1))
(let ((n (- (length a) 1)))
(if (= n 0)
- (vector-ref a 0)
+ (a 0)
(let* ((r (* kind x))
(s 1.0)
(h 0.0)
- (sum (vector-ref a 0)))
+ (sum (a 0)))
(do ((k 1 (+ 1 k)))
((= k n))
(set! h r)
- (set! sum (+ sum (* r (vector-ref a k))))
+ (set! sum (+ sum (* r (a k))))
(set! r (- (* 2 r x) s))
(set! s h))
- (+ sum (* r (vector-ref a n)))))))
+ (+ sum (* r (a n)))))))
(define* (chebyshev n x (kind 1))
(let ((a (make-vector (+ 1 n) 0.0)))
- (vector-set! a n 1.0)
+ (set! (a n) 1.0)
(chebyshev-polynomial a x kind)))
(define (hermite-polynomial a x)
(let ((n (- (length a) 1)))
(if (= n 0)
- (vector-ref a 0)
+ (a 0)
(let* ((r (* 2 x))
(s 1.0)
(h 0.0)
- (sum (vector-ref a 0)))
+ (sum (a 0)))
(do ((k 1 (+ 1 k))
(k2 2 (+ k2 2)))
((= k n))
(set! h r)
- (set! sum (+ sum (* r (vector-ref a k))))
+ (set! sum (+ sum (* r (a k))))
(set! r (- (* 2 r x) (* k2 s)))
(set! s h))
- (+ sum (* r (vector-ref a n)))))))
+ (+ sum (* r (a n)))))))
(define* (hermite n x)
(let ((a (make-vector (+ 1 n) 0.0)))
- (vector-set! a n 1.0)
+ (set! (a n) 1.0)
(hermite-polynomial a x)))
(define* (laguerre-polynomial a x (alpha 0.0))
(let ((n (- (length a) 1)))
(if (= n 0)
- (vector-ref a 0)
+ (a 0)
(let* ((r (- (+ alpha 1.0) x))
(s 1.0)
(h 0.0)
- (sum (vector-ref a 0)))
+ (sum (a 0)))
(do ((k 1 (+ 1 k)))
((= k n))
(set! h r)
- (set! sum (+ sum (* r (vector-ref a k))))
+ (set! sum (+ sum (* r (a k))))
(set! r (/ (- (* r (- (+ (* 2 k) 1 alpha) x))
(* s (+ k alpha)))
(+ k 1)))
(set! s h))
- (+ sum (* r (vector-ref a n)))))))
+ (+ sum (* r (a n)))))))
(define* (laguerre n x (alpha 0.0))
(let ((a (make-vector (+ 1 n) 0.0)))
- (vector-set! a n 1.0)
+ (set! (a n) 1.0)
(laguerre-polynomial a x alpha)))
@@ -243,7 +243,7 @@
(define* (automorph a b c d snd chn)
(let* ((len (frames snd chn))
(pow2 (ceiling (/ (log len) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(fftscale (/ 1.0 fftlen))
(rl (channel->vct 0 fftlen snd chn))
(im (make-vct fftlen)))
@@ -251,25 +251,25 @@
(vct-scale! rl fftscale)
(vct-scale! im fftscale)
;; handle 0 case by itself
- (let* ((c1 (make-rectangular (vct-ref rl 0) (vct-ref im 0)))
+ (let* ((c1 (make-rectangular (rl 0) (im 0)))
(val (/ (+ (* a c1) b)
(+ (* c c1) d)))
(rval (real-part val))
(ival (imag-part val)))
- (vct-set! rl 0 rval)
- (vct-set! im 0 ival))
+ (set! (rl 0) rval)
+ (set! (im 0) ival))
(do ((i 1 (+ i 1))
(k (- fftlen 1) (- k 1)))
((= i (/ fftlen 2)))
- (let* ((c1 (make-rectangular (vct-ref rl i) (vct-ref im i)))
+ (let* ((c1 (make-rectangular (rl i) (im i)))
(val (/ (+ (* a c1) b) ; (az + b) / (cz + d)
(+ (* c c1) d)))
(rval (real-part val))
(ival (imag-part val)))
- (vct-set! rl i rval)
- (vct-set! im i ival)
- (vct-set! rl k rval)
- (vct-set! im k (- ival))))
+ (set! (rl i) rval)
+ (set! (im i) ival)
+ (set! (rl k) rval)
+ (set! (im k) (- ival))))
(fft rl im -1)
(vct->channel rl 0 len snd chn #f (format #f "automorph ~A ~A ~A ~A" a b c d))))
|#
@@ -396,11 +396,11 @@
-23749461029/870 0 8615841276005/14322 0)))
(do ((i 0 (+ i 1)))
((= i 30))
- (vector-set! v i (vector-ref vals i)))
+ (set! (v i) (vals i)))
v)))
(lambda (n)
- (if (number? (vector-ref saved-values n))
- (vector-ref saved-values n)
+ (if (number? (saved-values n))
+ (saved-values n)
(let ((value (if (odd? n)
0.0
(let ((sum2 0.0)
@@ -417,7 +417,7 @@
(/ (* 2.0 sum2 (factorial n)
(if (= (modulo n 4) 0) -1 1))
(expt (* 2.0 pi) n))))))
- (vector-set! saved-values n value)
+ (set! (saved-values n) value)
value)))))
(define (bernoulli-poly n x)
@@ -689,10 +689,10 @@
(if (= tp1 0)
(begin
(set! tp1 1)
- (vector-set! tp 0 1.0)
+ (set! (tp 0) 1.0)
(do ((i 1 (+ i 1)))
((= i ntp))
- (vector-set! tp i (* 2.0 (vector-ref tp (- i 1)))))))
+ (set! (tp i) (* 2.0 (tp (- i 1)))))))
(if (= ak 1.0)
0.0
@@ -701,11 +701,11 @@
(do ((i 0 (+ i 1)))
((or (not (= pl -1))
(= i ntp)))
- (if (> (vector-ref tp i) p)
+ (if (> (tp i) p)
(set! pl i)))
(if (= pl -1) (set! pl ntp))
- (let ((pt (vector-ref tp (- pl 1)))
+ (let ((pt (tp (- pl 1)))
(p1 p)
(r 1.0))
;; Perform binary exponentiation algorithm modulo ak.
diff --git a/oscope.scm b/oscope.scm
index 19ae8b7..e1e9dbc 100644
--- a/oscope.scm
+++ b/oscope.scm
@@ -87,7 +87,7 @@
(set! cycle-length size)
(set! cycle-start 0)
(if (< cycle-length old-length)
- (do ((i cycle-length (1+ i)))
+ (do ((i cycle-length (+ 1 i)))
((>= i old-length))
(sound-data-set! oscope-graph-data 0 i 0.0)))
(set! oscope-frozen old-frozen)
@@ -222,7 +222,7 @@
(gtk_widget_show scale)
(gtk_box_pack_start (GTK_BOX mainform) label #f #f 0)
(gtk_widget_show label)
- (g_signal_connect adj "value_changed" (lambda (w d) (cycle-func (inexact->exact (gtk_adjustment_get_value (GTK_ADJUSTMENT adj)))) #f))
+ (g_signal_connect adj "value_changed" (lambda (w d) (cycle-func (floor (gtk_adjustment_get_value (GTK_ADJUSTMENT adj)))) #f))
(set! (right-sample oscope-graph 0) cycle-length)
(set! (max-transform-peaks oscope-graph 0) 10)
(g_signal_connect freeze-button "toggled" (lambda (w d) (freeze-func) #f))
diff --git a/peak-phases.scm b/peak-phases.scm
index 55647e5..4951675 100644
--- a/peak-phases.scm
+++ b/peak-phases.scm
@@ -471,8 +471,12 @@
7.3913831710815 #(0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 0 0 0)
6.346036 #(0.000000 1.818883 1.394935 0.090665 1.139537 1.165964 1.461640 1.551576 0.109199 0.483325 0.457022 1.430459 0.313081 0.193612 -0.212653 1.499702 -0.336679 -0.030396 0.079881 0.292504 0.027640 1.238186 0.695831 0.610958 0.187391 1.410399 0.320777 1.252473 1.494258 1.872292 1.369864 0.531768 1.529954 1.740607 0.843604 -0.279705 1.622680 0.757666 1.267011 0.542859)
- 6.336253 #(0.000000 -0.046049 1.595878 0.169924 0.957788 1.367294 1.550762 1.537681 -0.062765 0.279986 0.456789 1.218805 -0.085060 -0.067610 0.065702 1.458980 -0.512122 0.191375 0.334960 0.297794 -0.118032 0.897519 0.684504 0.984389 0.245029 1.447214 0.139278 1.283829 -0.051049 -0.246982 1.479684 0.442074 1.804042 1.505867 0.749155 -0.288520 1.520689 0.909275 1.198216 0.523439)
6.330560 #(0.000000 -0.055500 1.612353 0.161597 1.040781 1.375231 1.547588 1.626609 0.015834 0.328740 0.440549 1.222968 -0.049633 -0.052407 0.063037 1.418798 -0.435067 0.286083 0.324626 0.391438 -0.079529 0.954953 0.722271 1.043942 0.284220 1.511639 0.226824 1.387435 1.932227 -0.186417 1.474740 0.437652 1.803128 1.543918 0.780894 -0.187766 1.570949 0.924069 1.272265 0.609643)
+ 6.330286 #(0.000000 -0.045819 1.600127 0.155043 1.039652 1.376700 1.563111 1.661155 0.050057 0.323163 0.431924 1.241351 -0.044202 -0.066168 0.055611 1.410210 -0.445906 0.280566 0.332922 0.404118 -0.063322 0.965131 0.712707 1.048912 0.294430 1.513916 0.224477 1.395693 1.910012 -0.162538 1.449224 0.446580 1.781307 1.550872 0.770292 -0.175206 1.602409 0.911990 1.261579 0.611431)
+ 6.328818 #(0.000000 -0.185771 1.608833 0.118847 0.817687 1.353844 1.415394 1.577468 -0.167919 0.452879 0.750506 1.135243 -0.091923 0.422968 0.015288 1.927628 -0.209142 0.433543 0.464803 0.118398 0.065517 0.879942 0.906211 1.106392 0.447050 1.638584 0.371725 1.545148 0.220166 -0.139773 1.376317 0.506218 1.939479 1.290399 0.482924 -0.145636 -0.030130 1.377304 1.794185 0.858100)
+ 6.314770 #(0.000000 1.477318 1.335538 0.251846 1.014057 1.344577 1.644248 1.746079 -0.046981 0.427480 0.544395 1.279480 0.331812 0.073511 -0.019282 1.703045 -0.342343 -0.112266 0.023018 0.166081 -0.168901 1.203245 0.790101 0.845081 0.487304 1.481093 0.195721 1.092519 1.513429 1.816386 1.253020 0.583214 1.424097 1.687515 0.627946 -0.148951 1.535227 0.370840 1.233467 0.706089)
+ 6.301754 #(0.000000 1.476257 1.342265 0.249536 0.993496 1.359771 1.647689 1.742640 -0.043805 0.433316 0.547201 1.276571 0.329714 0.081651 -0.007008 1.723278 -0.348484 -0.105026 0.024999 0.161467 -0.165703 1.229751 0.808127 0.870069 0.517209 1.472566 0.175815 1.061432 1.507576 1.812612 1.247658 0.572949 1.415088 1.684510 0.618679 -0.115957 1.533439 0.354306 1.246699 0.710352)
+ 6.299043 #(0.000000 1.472809 1.342339 0.246263 0.991856 1.364904 1.647208 1.737556 -0.043009 0.433781 0.542673 1.274446 0.327101 0.080827 -0.005060 1.722843 -0.348703 -0.102392 0.020851 0.163683 -0.163807 1.232757 0.806939 0.869455 0.520612 1.473286 0.172075 1.061287 1.508730 1.814241 1.251176 0.573394 1.417654 1.686745 0.620310 -0.108344 1.534180 0.355574 1.249840 0.714009)
)
;;; 41 all -------------------------------------------------------------------------------- ; 6.4031
@@ -733,7 +737,8 @@
10.544771744298 #(0 0 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0)
10.495518383865 #(0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0)
- 8.362613 #(0.000000 0.468238 0.210993 -0.255076 0.536623 1.828813 0.810954 -0.147666 1.626282 0.787382 -0.299269 1.434983 0.710885 0.473690 1.279566 0.523361 0.208532 0.764349 0.320450 -0.101772 1.235404 1.399328 0.406601 0.085124 0.698175 0.068435 1.635974 0.146613 1.044048 1.209349 1.649887 1.054483 0.187601 0.556523 0.448975 -0.114593 1.727204 0.983333 0.308994 0.438038 1.413924 0.937988 1.580809 0.064620 0.402027 0.476577 0.299123 0.340495 1.276441 -0.027857 -0.719089 1.629412 0.361047 0.068512 1.429645 1.484335 0.487238 0.513554 1.403391 0.391007 1.082391 0.176040 0.984070 0.949921 1.090370 1.056275 1.278937 1.184858 1.312358)
+ 8.299080 #(0.000000 0.508857 0.174091 -0.180116 0.629036 1.747663 0.879808 -0.175981 1.593336 0.764649 -0.231941 1.439394 0.705700 0.507236 1.361142 0.555427 0.133651 0.697717 0.364984 -0.110592 1.321147 1.438738 0.435492 0.000792 0.635734 0.126449 1.615283 0.130189 1.020079 1.213203 1.688898 1.049803 0.271531 0.558077 0.310108 -0.123290 1.703486 1.022869 0.333346 0.490474 1.352428 1.046060 1.650816 0.043963 0.365200 0.516481 0.301589 0.265705 1.422839 0.039035 -0.744816 1.649414 0.349508 0.127869 1.391962 1.542995 0.363559 0.471804 1.439979 0.387347 1.070127 0.133602 1.007305 0.873734 0.968254 1.076970 1.251776 1.088230 1.275780)
+ 8.289844 #(0.000000 0.513585 0.177479 -0.176888 0.623783 1.745401 0.873250 -0.173141 1.596123 0.753018 -0.230814 1.441081 0.705435 0.505271 1.366748 0.558604 0.140712 0.699849 0.362073 -0.111867 1.322811 1.446154 0.437920 -0.004880 0.636812 0.132544 1.613260 0.126691 1.024863 1.218542 1.684056 1.053127 0.272250 0.553128 0.296391 -0.119714 1.708317 1.024886 0.325200 0.493314 1.349317 1.057246 1.659956 0.046289 0.374425 0.519480 0.314406 0.268202 1.430527 0.044485 -0.747002 1.651671 0.338001 0.130617 1.387118 1.539222 0.360122 0.465635 1.448451 0.389965 1.070962 0.131507 1.008142 0.867151 0.967360 1.085348 1.255863 1.090665 1.273123)
)
;;; 70 all -------------------------------------------------------------------------------- ; 8.3666
@@ -758,7 +763,7 @@
10.908146369485 #(0 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0)
10.800657366855 #(0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0)
- 8.514782 #(0.000000 -0.045540 0.887698 0.763926 -0.006514 1.217592 -0.162525 0.539995 0.585188 1.415662 1.716330 1.036001 1.108405 0.287662 0.436107 1.555037 0.104318 0.869742 0.332982 1.473369 0.948218 1.448345 0.029287 0.096296 0.000633 0.320934 0.339821 0.841210 0.566797 0.274560 0.101353 0.428417 0.756158 0.631409 0.815415 0.360917 1.755123 1.457038 0.056157 1.292116 1.193121 1.007204 0.364720 0.676599 -0.003192 0.565614 0.230532 0.590404 1.564790 -0.279644 0.282845 1.424037 1.419725 0.217234 0.268113 1.706881 1.054117 1.776134 1.047056 0.701086 1.636575 1.116196 1.667624 -0.031698 0.709359 1.336015 0.666148 1.487347 0.439735 1.082973 0.190469 -0.221764)
+ 8.509295 #(0.000000 -0.109482 0.850217 0.653010 0.050693 1.185668 -0.189008 0.592350 0.602513 1.378281 1.765296 1.052677 1.217338 0.256452 0.397169 1.560562 0.157322 0.864563 0.314629 1.495363 0.987451 1.347990 0.023710 0.069127 -0.046288 0.272003 0.317696 0.865722 0.645013 0.246417 0.101694 0.455991 0.762055 0.592234 0.859140 0.382549 1.784540 1.445197 0.137622 1.231953 1.159845 1.086835 0.416787 0.612377 0.000031 0.590764 0.187426 0.541490 1.701444 -0.349958 0.385149 1.457944 1.415258 0.195118 0.231137 1.667747 1.072145 1.733966 1.010881 0.631834 1.608455 1.085410 1.617413 -0.023438 0.665293 1.364662 0.709312 1.513048 0.424392 1.105246 0.130599 -0.150134)
)
;;; 73 all -------------------------------------------------------------------------------- ; 8.5440
@@ -785,7 +790,7 @@
#(75 11.477107048035 #(0 1 0 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 0)
10.935811368418 #(0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1)
- 8.700794 #(0.000000 1.799374 1.276825 1.353681 0.198420 0.946690 1.203667 0.157305 0.148135 1.336175 0.958858 1.218866 1.624608 0.358767 0.324008 1.691789 1.597669 0.951228 1.884600 1.053100 1.195530 1.223611 1.336671 1.164189 1.400930 1.512292 0.701325 0.661349 0.223795 1.025001 1.234659 0.535747 0.097348 1.273929 1.476207 0.359263 0.876275 1.915190 0.538682 0.620541 0.647165 1.135986 1.295831 0.274648 1.283765 0.381957 1.340553 1.464783 1.436808 1.571483 1.552925 0.105744 1.249495 0.105007 1.316386 0.603373 -0.074702 1.442841 0.145337 1.364775 0.831373 0.545687 0.369398 1.438174 1.750552 -0.084319 -0.051978 0.287248 1.630917 0.840490 1.351389 0.293169 0.768722 0.526907 1.747359)
+ 8.689894 #(0.000000 1.784755 1.275549 1.345815 0.168323 0.929043 1.212360 0.147903 0.174163 1.335540 0.941808 1.244917 1.614862 0.355710 0.348234 1.665251 1.614201 0.925603 1.863519 1.039766 1.211304 1.247839 1.324022 1.152460 1.375073 1.524827 0.700656 0.639020 0.208536 1.054505 1.240563 0.530250 0.088188 1.190609 1.447059 0.354711 0.859424 1.900706 0.534652 0.618361 0.629184 1.126026 1.288842 0.204936 1.279452 0.352995 1.327839 1.474719 1.459492 1.582495 1.612042 0.068056 1.172612 0.091968 1.266124 0.555051 -0.081134 1.442803 0.115099 1.371862 0.825542 0.508402 0.330636 1.426689 1.725441 -0.064859 -0.088049 0.242245 1.591582 0.789268 1.284803 0.335758 0.736989 0.522332 1.693743)
)
;;; 76 all -------------------------------------------------------------------------------- ; 8.7178
@@ -793,16 +798,19 @@
11.208243370056 #(0 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0)
10.689208030701 #(0 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0)
- 8.724730 #(0.000000 0.310615 -0.220870 1.517731 1.429780 0.399888 0.835754 1.713323 0.596558 1.293291 0.882430 -0.089907 1.221838 1.579037 0.292989 0.372115 1.613344 0.659138 1.302246 0.839327 1.608263 0.665882 1.571937 1.865896 1.254345 0.753969 0.737058 0.971956 0.655571 1.490305 -0.062436 0.660592 1.341204 -0.146647 0.890575 0.725682 0.972354 0.157141 0.393293 0.602370 0.816779 -0.226071 0.591611 0.186831 0.967028 0.711769 1.181215 0.094222 0.298979 0.010472 1.800229 1.211561 0.214664 1.958834 0.281591 0.096268 1.102425 0.732847 0.992198 1.032166 0.857703 0.989314 0.143655 0.778576 0.906468 0.342153 1.268622 1.007987 -0.038780 1.660006 0.928021 0.657057 1.373162 1.868260 1.596282 1.057849)
+ 8.715587 #(0.000000 0.281925 -0.253706 1.532477 1.353267 0.338241 0.825181 1.708101 0.623818 1.329772 0.892319 -0.110223 1.205848 1.576251 0.336892 0.382797 1.582123 0.636854 1.287935 0.814706 1.596528 0.626294 1.539351 1.838956 1.200895 0.756781 0.787851 0.936315 0.700555 1.574513 -0.109586 0.613352 1.382131 -0.134916 0.929434 0.697620 0.938363 0.098033 0.458882 0.611792 0.793501 -0.207505 0.608719 0.241124 0.976333 0.737280 1.296248 0.101449 0.306745 0.023850 1.813323 1.153489 0.222564 -0.060923 0.221057 0.154525 1.072947 0.791013 1.134055 1.063743 0.822576 0.987896 0.137559 0.802222 0.936968 0.332305 1.244704 0.917497 -0.070239 1.593690 0.884185 0.690296 1.409572 1.823248 1.581224 1.044184)
+ 8.693745 #(0.000000 0.389055 -0.214240 1.512820 1.305193 0.233839 0.760517 1.834769 0.712415 1.504071 0.890275 -0.141153 1.218947 1.552096 0.372320 0.406916 1.569773 0.657971 1.243672 0.810549 1.733556 0.546539 1.509186 1.872627 1.270706 0.607256 0.871413 0.881217 0.755034 1.498283 -0.227481 0.612205 1.401916 -0.093683 0.865714 0.664719 0.854258 0.240459 0.359294 0.388009 0.796602 -0.189413 0.546591 0.206229 1.111186 0.879066 1.342898 0.082541 0.297420 0.005262 1.801512 1.070219 0.315302 -0.099132 0.130613 0.172787 1.082438 0.782149 1.181223 1.069229 0.711531 1.120588 0.157034 0.806933 0.801228 0.244528 1.184034 0.894385 -0.126524 1.596304 0.934734 0.678447 1.493203 1.673326 1.658877 1.065092)
+ 8.675548 #(0.000000 0.395449 -0.221652 1.508912 1.295673 0.225142 0.745185 1.835132 0.696172 1.499982 0.898863 -0.141132 1.224041 1.571359 0.370821 0.413663 1.573949 0.668236 1.248394 0.813796 1.731666 0.540922 1.496927 1.867687 1.275577 0.612159 0.880593 0.878186 0.758700 1.493715 -0.225764 0.619891 1.417171 -0.090012 0.865382 0.650445 0.855134 0.245796 0.357615 0.380467 0.792165 -0.196281 0.536105 0.207395 1.118128 0.877987 1.338340 0.082944 0.308384 0.015781 1.798508 1.072546 0.315979 -0.093624 0.132136 0.181172 1.087870 0.781548 1.187502 1.065952 0.696709 1.124799 0.171193 0.800027 0.790065 0.238454 1.188888 0.881236 -0.120900 1.608859 0.934182 0.682489 1.491805 1.664595 1.660453 1.075790)
)
;;; 77 all -------------------------------------------------------------------------------- ; 8.7750
#(77 11.25105381012 #(0 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0)
11.114716461811 #(0 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0)
- 8.773496 #(0.000000 0.337282 0.486837 0.606945 1.374787 1.764158 0.115328 0.261134 0.926386 0.345406 0.596740 0.272278 1.052952 0.176387 0.254106 0.779734 1.426671 1.582191 0.552854 0.065531 -0.251553 0.334914 0.117108 -0.176248 0.728266 0.042007 -0.050180 0.808009 0.755224 1.668438 0.703162 1.252158 -0.078436 1.540282 0.662149 -0.032655 -0.069749 1.623593 1.432211 0.726273 -0.056331 1.267142 0.840543 0.479553 0.481034 0.321360 1.665967 0.559468 0.575426 0.971416 0.678346 1.129903 0.707285 -0.063998 0.339486 0.180615 0.695893 1.475350 0.732909 0.796101 1.525143 1.604326 1.525763 1.735024 0.936519 1.336761 0.613386 -0.634225 1.862384 0.948260 1.029241 0.298810 0.493428 0.093887 1.348477 -0.064924 1.291774)
8.746446 #(0.000000 0.343092 0.482442 0.607083 1.379080 1.765436 0.124327 0.263273 0.930952 0.363196 0.612436 0.275934 1.066423 0.184709 0.259380 0.787622 1.424087 1.584541 0.542414 0.075530 -0.252877 0.337922 0.125889 -0.165796 0.736013 0.047094 -0.044516 0.815052 0.747878 1.680227 0.716634 1.257338 -0.087740 1.561825 0.663932 -0.053039 -0.081458 1.622831 1.444388 0.728565 -0.055857 1.265919 0.842791 0.490176 0.483760 0.312928 1.658999 0.565781 0.561571 0.966556 0.687691 1.126222 0.723328 -0.056476 0.338984 0.174008 0.692400 1.471446 0.721571 0.800597 1.515975 1.616916 1.511349 1.737913 0.929460 1.339379 0.588014 -0.633630 1.862090 0.944159 1.012028 0.284587 0.489072 0.072198 1.328090 -0.066575 1.290861)
8.739984 #(0.000000 0.345625 0.482217 0.607256 1.383603 1.768327 0.124348 0.265120 0.937869 0.360204 0.615749 0.276403 1.070789 0.184863 0.257704 0.783170 1.417438 1.586623 0.545035 0.079404 -0.252713 0.339606 0.123187 -0.161837 0.739100 0.048801 -0.042808 0.821384 0.752707 1.678812 0.717844 1.254063 -0.088723 1.561591 0.668050 -0.052214 -0.078714 1.623211 1.440906 0.726355 -0.053126 1.270639 0.843198 0.487033 0.486824 0.316727 1.659991 0.563454 0.556411 0.974428 0.686270 1.128551 0.725616 -0.053730 0.339355 0.169760 0.684991 1.472647 0.721497 0.807985 1.513883 1.613764 1.510136 1.741662 0.931642 1.336116 0.587274 -0.636731 1.857791 0.940446 1.016500 0.290521 0.490249 0.067167 1.330074 -0.066867 1.292205)
+ 8.732482 #(0.000000 0.348602 0.477765 0.604071 1.391186 1.768872 0.127420 0.258268 0.939406 0.359461 0.622679 0.279852 1.076905 0.187605 0.253898 0.776811 1.412785 1.590214 0.547845 0.079872 -0.258445 0.337571 0.112062 -0.150679 0.750057 0.052500 -0.042874 0.822953 0.754438 1.681775 0.713488 1.250782 -0.089174 1.561891 0.670417 -0.056647 -0.078343 1.627957 1.445961 0.729974 -0.049985 1.270537 0.844387 0.485140 0.495347 0.314589 1.658989 0.557481 0.558533 0.976065 0.690945 1.127291 0.723698 -0.047046 0.344734 0.173346 0.679025 1.477843 0.719957 0.802240 1.508189 1.616867 1.507095 1.742524 0.924032 1.343640 0.581622 -0.632657 1.852719 0.944787 1.014241 0.291712 0.504130 0.056585 1.321487 -0.070558 1.294494)
+ 8.731162 #(0.000000 0.348676 0.476377 0.606944 1.387256 1.768549 0.128473 0.260518 0.936568 0.358886 0.618317 0.280418 1.076704 0.186339 0.253960 0.776508 1.415471 1.590913 0.546179 0.076687 -0.256531 0.340311 0.112669 -0.148999 0.753233 0.052743 -0.044103 0.824890 0.752198 1.684593 0.714352 1.250265 -0.090239 1.560152 0.669337 -0.059070 -0.080355 1.629461 1.446609 0.729659 -0.052531 1.270090 0.841483 0.483368 0.495715 0.314144 1.657576 0.557726 0.561425 0.975115 0.690361 1.125970 0.725027 -0.046759 0.347806 0.174137 0.676572 1.478198 0.720342 0.799677 1.510275 1.619276 1.506849 1.740348 0.921395 1.343963 0.582947 -0.631428 1.853084 0.942657 1.014466 0.289120 0.506940 0.058495 1.321113 -0.071385 1.294695)
)
;;; 78 all -------------------------------------------------------------------------------- ; 8.8318
@@ -810,7 +818,9 @@
11.541502084124 #(0 1 1 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1)
11.471938943963 #(0 1 1 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1)
- 8.859257 #(0.000000 1.165085 1.142263 -0.030240 0.257293 1.715027 0.489073 1.775599 1.456855 -0.166789 1.336884 1.807187 1.302422 0.954237 0.438896 0.988586 1.064753 1.606736 0.330980 0.436407 0.902511 1.670753 0.845876 1.547259 0.772378 0.513821 1.619304 0.238782 1.154687 1.553997 0.733242 1.781639 1.646666 1.241125 1.290591 0.585593 1.149317 1.442806 1.061691 0.355551 0.939633 1.163535 -0.089669 0.676026 0.664320 1.162907 1.768053 1.111044 1.444822 0.458176 0.843264 1.315468 0.909896 1.630629 0.840443 -0.029293 0.563805 -0.024665 -0.100859 1.553653 1.801549 1.504186 0.454783 0.086917 -0.033797 0.095051 0.215235 0.997103 0.922868 0.868884 1.469290 1.395430 0.304668 -0.218279 1.609243 0.083529 1.698920 0.866764)
+ 8.810051 #(0.000000 1.281797 1.248071 0.017881 0.219532 1.723330 0.535306 1.852152 1.539652 -0.097691 1.392570 1.862297 1.346899 0.842733 0.393848 1.100209 0.980199 1.569762 0.455029 0.511084 0.846957 1.879482 0.786125 1.522551 0.912634 0.588499 1.547880 0.309074 1.254908 1.549500 0.855883 1.793881 1.637177 1.338799 1.459693 0.617316 1.193509 1.518025 1.379856 0.489189 0.779894 1.402025 -0.116700 0.711399 0.555640 1.274571 1.673260 1.103728 1.548908 0.340613 0.859556 1.289654 0.897163 1.872663 0.984388 0.130889 0.570502 0.001998 -0.028041 1.550459 1.950822 1.592275 0.514806 0.326967 0.072988 0.038166 0.188035 1.021401 0.922653 0.863100 1.462188 1.557348 0.323733 -0.070049 1.714946 0.210174 1.871065 1.067555)
+ 8.795731 #(0.000000 1.282318 1.240645 0.018820 0.219553 1.725222 0.535292 1.853509 1.538597 -0.096831 1.391656 1.857011 1.353966 0.834555 0.387620 1.109417 0.982126 1.562399 0.452659 0.512667 0.841461 1.888671 0.781666 1.532561 0.910937 0.587818 1.543816 0.308176 1.253865 1.544715 0.852521 1.811133 1.652977 1.333001 1.464081 0.607812 1.200958 1.526308 1.365645 0.477229 0.769767 1.395193 -0.103176 0.702550 0.563945 1.281049 1.663465 1.094164 1.552060 0.346743 0.849897 1.297844 0.896641 1.861136 0.988631 0.126947 0.571843 0.002980 -0.034253 1.549375 1.962618 1.606029 0.511966 0.319012 0.062726 0.030396 0.178722 1.017658 0.911303 0.868079 1.472217 1.559508 0.317521 -0.060899 1.717949 0.205195 1.874515 1.066438)
+ 8.794117 #(0.000000 1.282102 1.240015 0.017847 0.220140 1.725512 0.535654 1.852526 1.539563 -0.097808 1.392291 1.857206 1.353378 0.834032 0.387900 1.109453 0.981795 1.560899 0.453225 0.511918 0.840637 1.888309 0.781021 1.533489 0.910642 0.589260 1.543961 0.308835 1.253077 1.545209 0.851990 1.811551 1.652706 1.332577 1.464031 0.607707 1.200927 1.525331 1.366128 0.477575 0.769976 1.396647 -0.102003 0.702279 0.563845 1.281107 1.662601 1.095721 1.552502 0.346884 0.849929 1.298623 0.896092 1.861554 0.989388 0.126963 0.572164 0.003751 -0.034407 1.549877 1.964346 1.606783 0.513154 0.319400 0.062595 0.030600 0.179109 1.017830 0.910238 0.867600 1.472571 1.560119 0.318146 -0.061019 1.718368 0.205299 1.874891 1.066065)
)
;;; 79 all -------------------------------------------------------------------------------- ; 8.8882
@@ -838,14 +848,15 @@
11.501712958685 #(0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 0 0)
11.22668050284 #(0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1)
- 9.023652 #(0.000000 0.637071 0.905537 0.360741 0.481563 1.279042 0.728410 1.722820 1.154673 1.426040 0.424177 0.238209 1.066494 0.054734 1.394939 1.766666 1.218097 0.809891 1.173405 0.008140 1.624164 0.086855 1.923640 -0.052006 0.892616 0.855522 1.313546 1.382934 1.049361 0.106403 0.991088 1.145394 0.381259 1.549987 1.839263 0.580913 1.463745 0.696400 0.743144 1.729409 1.034320 1.837006 -0.089312 1.961319 0.780840 1.685299 0.404592 0.541198 0.738034 0.746861 -0.191719 0.583930 0.381037 0.025217 -0.211078 0.941509 -0.500359 1.794794 1.815416 1.454991 1.089168 0.376629 1.912757 0.316959 1.133243 1.002430 0.452893 -0.074138 0.400559 0.084973 1.117036 1.901747 1.176121 0.408188 -0.032888 -0.086582 0.326540 1.641763 0.175865 0.229573 -0.094416)
+ 8.999386 #(0.000000 0.636704 0.919856 0.364855 0.482236 1.332751 0.670771 1.786492 1.132598 1.417907 0.440010 0.232061 1.126315 0.043418 1.334412 1.777180 1.272400 0.776184 1.127149 0.032976 1.580036 0.069827 1.913095 0.028111 0.879566 0.822704 1.299361 1.380039 1.029283 0.158043 0.976969 1.176080 0.254964 1.538453 1.829697 0.589440 1.385747 0.717737 0.653801 1.719225 1.010556 1.795028 -0.124781 -0.038353 0.781428 1.688962 0.392217 0.506997 0.708882 0.726628 -0.179121 0.487411 0.358661 0.029085 -0.184601 0.934967 -0.612037 1.678497 1.758492 1.376364 1.158652 0.351359 1.924829 0.229318 1.186140 0.941704 0.379187 -0.021711 0.337728 0.113318 1.055005 -0.041266 1.172383 0.355135 -0.084320 -0.230776 0.285280 1.605754 0.133969 0.155697 -0.140985)
+ 8.993998 #(0.000000 0.636751 0.920048 0.365669 0.477946 1.336017 0.669352 1.785557 1.130216 1.416644 0.440922 0.231515 1.127604 0.041463 1.332258 1.780894 1.274713 0.771704 1.126971 0.033094 1.582754 0.067812 1.914158 0.026056 0.878856 0.825850 1.296875 1.383602 1.029910 0.157395 0.976012 1.176464 0.253993 1.535453 1.831173 0.584953 1.391904 0.718067 0.654959 1.713218 1.009768 1.792700 -0.124016 -0.041074 0.778948 1.687788 0.400387 0.505095 0.708859 0.724321 -0.181066 0.483060 0.363237 0.028143 -0.187444 0.935593 -0.616832 1.674274 1.763223 1.371173 1.160874 0.352512 1.928192 0.230330 1.192677 0.944215 0.381375 -0.023299 0.342451 0.111811 1.055875 -0.041760 1.167875 0.356968 -0.077068 -0.226964 0.289050 1.605427 0.129811 0.151778 -0.130837)
)
;;; 82 all -------------------------------------------------------------------------------- ; 9.0554
#(82 11.697486877441 #(0 0 1 1 0 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0)
11.601468306037 #(0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0)
- 9.115775 #(0.000000 1.666560 0.122962 0.983690 0.634817 1.925464 0.590893 0.037776 1.116998 0.564168 0.391476 0.350969 -0.279448 1.620971 0.907715 0.448688 1.349368 -0.166366 1.114360 1.060755 0.600487 1.662085 0.424476 1.961078 0.321985 0.268606 1.039091 1.695667 0.405153 0.216349 0.849001 1.309251 1.890463 1.015956 0.199570 -0.073649 0.178319 1.570442 1.142737 0.622147 1.405667 1.709015 0.124592 0.353295 0.249188 1.051475 1.599281 0.643190 0.034391 -0.345624 1.088130 1.461239 1.624482 0.754279 1.616371 0.028656 0.361419 1.658078 1.813016 1.000981 0.295624 0.919254 0.861827 0.465971 0.105275 0.632607 0.793861 1.804445 0.662722 0.718015 0.352717 -1.854762 0.483685 0.333876 0.392327 1.362238 1.048404 0.920099 1.556699 1.153613 1.800656 0.442733)
+ 9.108691 #(0.000000 1.664074 0.120439 0.974519 0.656798 1.932908 0.612034 0.041043 1.110170 0.556893 0.379443 0.359746 -0.251371 1.621400 0.914613 0.459432 1.372532 -0.157514 1.110512 1.066157 0.612825 1.658235 0.425776 1.976703 0.353728 0.280241 1.032069 1.701860 0.394105 0.218873 0.867086 1.330782 1.854533 1.014953 0.214208 -0.071965 0.194780 1.561024 1.158727 0.615697 1.413107 1.725886 0.138523 0.377459 0.259413 1.054121 1.617942 0.649733 0.040448 -0.358426 1.110086 1.446356 1.625598 0.779893 1.603956 0.022722 0.353391 1.671051 1.828188 0.991340 0.308657 0.909383 0.859724 0.460147 0.120324 0.623171 0.810607 1.823200 0.684565 0.729743 0.366167 -1.857154 0.497073 0.345905 0.389496 1.371158 1.056787 0.924156 1.573982 1.158865 1.815669 0.445958)
)
;;; 83 all -------------------------------------------------------------------------------- ; 9.1104
@@ -853,7 +864,7 @@
11.868338980165 #(0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0)
11.429935034332 #(0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
- 9.203661 #(0.000000 0.588240 -0.054378 0.939973 0.133763 1.036230 0.411391 1.288972 1.910211 1.861461 1.586597 1.087988 1.339455 0.047206 1.215148 0.389119 1.771132 -0.007294 1.768433 -0.105122 1.580791 0.446116 0.758837 1.595623 -0.045818 -0.117428 1.746992 0.617194 0.809190 0.711890 0.795955 0.800601 0.695540 0.294096 0.201222 0.291293 0.943861 0.001586 0.244926 1.024865 0.638461 1.661798 1.707198 0.665910 0.292688 0.066209 1.535953 1.101931 0.168636 0.746141 0.584258 1.465574 0.718564 0.253953 0.466725 1.423948 1.902330 1.074392 0.335028 1.237310 0.054468 1.756991 1.251063 -0.019236 0.147931 0.129959 0.377182 -0.020540 0.290100 1.212657 1.295410 0.735980 1.483795 -0.214273 0.664838 1.517805 1.212363 0.479281 -0.052946 1.924418 0.252378 0.983590 1.319863)
+ 9.161778 #(0.000000 0.565844 0.017427 0.999853 0.090643 0.891500 0.228464 1.198563 -0.076140 1.762064 1.661510 1.098817 1.357624 -0.069489 1.276047 0.263820 1.726264 0.020351 1.713473 -0.032576 1.614725 0.509151 0.703442 1.594959 -0.078688 -0.032791 1.718025 0.538263 0.884353 0.649492 0.865299 0.797006 0.741504 0.410048 0.167948 0.299103 0.867977 0.015033 0.211127 1.063424 0.496664 1.726800 1.612783 0.660555 0.288319 0.094786 1.508106 1.115273 0.226816 0.743899 0.616744 1.364321 0.698351 0.217020 0.506185 1.571740 1.849538 0.937887 0.176739 1.217072 0.028008 1.798937 1.113530 -0.045155 0.269435 0.193442 0.418745 -0.120764 0.338159 1.168671 1.342196 0.683757 1.533710 -0.294433 0.580624 1.426343 1.083644 0.422662 -0.019956 0.009565 0.232384 0.892505 1.346317)
)
;;; 84 all -------------------------------------------------------------------------------- ; 9.1652
@@ -872,7 +883,9 @@
11.953980403239 #(0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1)
11.927130699158 #(0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 0 1)
- 9.268862 #(0.000000 0.397629 0.016627 1.522227 0.416101 1.301363 0.890067 -0.138521 -0.378921 0.682155 1.513519 1.753065 0.517186 1.353144 0.634441 1.757087 1.592905 0.333739 0.793055 0.341682 0.368279 1.015131 0.945203 1.805292 -0.062154 0.579382 0.983702 -0.120586 1.859729 1.849521 1.158127 0.046044 1.533020 0.478659 0.438798 0.778076 0.628755 1.660383 1.577013 0.493020 0.925842 1.379155 0.955139 0.523185 1.158511 0.292564 0.324460 0.358998 1.762733 0.140938 0.839918 1.616975 0.639317 0.964322 0.574825 1.630012 1.281697 1.372827 0.239948 0.910404 0.624430 0.676812 0.834680 1.229911 0.678687 1.372326 0.888707 1.153462 0.275425 1.675914 1.431108 0.675567 1.066152 0.557935 1.381473 -0.128388 0.773064 0.339579 0.126371 0.333842 -0.023343 1.771991 0.622592 0.532692 0.190267)
+ 9.219942 #(0.000000 0.455813 -0.011867 1.411465 0.433424 1.182466 0.733955 -0.167069 -0.410037 0.636163 1.397451 1.743029 0.579611 1.370362 0.708673 1.752489 1.500760 0.360345 0.749853 0.467762 0.265089 1.037236 0.870853 1.736757 0.008222 0.655695 0.967815 -0.057923 1.699543 1.844637 1.107509 0.051899 1.437840 0.404512 0.390788 0.752187 0.628906 1.497586 1.563689 0.404275 0.967716 1.258872 0.942287 0.665873 1.281212 0.332154 0.326249 0.316091 1.566785 0.068793 0.834439 1.705751 0.834980 0.931219 0.679155 1.595164 1.312632 1.314513 0.156668 0.839960 0.627986 0.806000 0.624517 1.293947 0.734541 1.365350 0.946060 1.189674 0.340653 1.547044 1.350826 0.681857 1.078876 0.606677 1.333414 -0.248274 0.732021 0.351338 0.084965 0.218392 -0.147332 1.747101 0.568674 0.487423 0.108240)
+ 9.212181 #(0.000000 0.455316 -0.010080 1.408851 0.435968 1.183393 0.730527 -0.169335 -0.414238 0.626773 1.399000 1.742036 0.581077 1.371815 0.707328 1.744224 1.505255 0.359516 0.754480 0.465178 0.269557 1.036769 0.873072 1.739996 0.005547 0.663270 0.969270 -0.056337 1.689218 1.840752 1.106477 0.046351 1.437612 0.408201 0.395005 0.750942 0.625242 1.486423 1.567538 0.401179 0.969926 1.260634 0.947695 0.667581 1.286081 0.327228 0.330617 0.317297 1.565397 0.068959 0.835613 1.699302 0.833698 0.936201 0.671377 1.596245 1.317273 1.317053 0.154308 0.839285 0.639068 0.817680 0.622620 1.293614 0.744576 1.359869 0.943260 1.195469 0.341000 1.553647 1.349309 0.685811 1.086387 0.609937 1.336960 -0.254513 0.735210 0.355646 0.085374 0.216898 -0.143342 1.754279 0.566227 0.488966 0.097590)
+ 9.206495 #(0.000000 0.454294 -0.006778 1.405024 0.435345 1.180265 0.729061 -0.167606 -0.414377 0.622801 1.397590 1.745859 0.580538 1.369588 0.708392 1.745766 1.501891 0.357658 0.749761 0.470769 0.266733 1.037590 0.874498 1.736222 0.004264 0.668144 0.970831 -0.055600 1.693281 1.843913 1.101654 0.045034 1.436150 0.408743 0.391619 0.757017 0.622827 1.480180 1.565855 0.400913 0.972856 1.254371 0.947327 0.668234 1.287300 0.329811 0.330070 0.314091 1.562459 0.066784 0.834398 1.696859 0.841687 0.935500 0.675823 1.598347 1.318536 1.314650 0.150970 0.836407 0.640954 0.819952 0.623171 1.294750 0.745024 1.356839 0.939237 1.198437 0.340920 1.557885 1.350507 0.684458 1.090164 0.608579 1.330718 -0.253728 0.735970 0.353223 0.089358 0.219355 -0.145713 1.750455 0.563666 0.486954 0.088866)
)
;;; 86 all -------------------------------------------------------------------------------- ; 9.2736
@@ -888,7 +901,7 @@
12.065419665482 #(0 0 1 1 1 0 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1)
11.76194265333 #(0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
- 9.399508 #(0.000000 0.888522 -0.307667 0.628043 -0.228249 0.615453 1.853288 0.048455 0.273150 0.262976 0.540097 1.342840 0.446606 1.162824 0.226920 0.873309 0.090709 0.611979 1.000327 1.426420 0.172761 1.500227 0.780898 0.143451 1.697714 1.335818 1.090809 0.284483 1.181881 -0.196573 0.017270 0.979487 -0.067903 0.582925 0.715402 -0.036334 0.720374 1.286096 0.885015 1.225090 0.568963 1.797423 1.255621 0.246627 0.132220 1.291861 1.573456 1.269669 1.175378 0.341239 0.298938 0.777910 0.774475 0.336556 1.046602 1.586182 1.567935 -0.041411 0.354277 -0.313571 1.753431 -0.231208 0.477870 -0.202396 1.154873 0.487273 1.413627 1.162541 0.405349 0.526222 0.742560 1.674209 0.557063 0.155914 0.590441 0.591012 0.677515 1.643528 0.168605 1.167599 0.657579 0.428395 0.267537 0.430541 0.319856 1.275371 1.746080)
+ 9.391027 #(0.000000 0.908024 -0.306506 0.673470 -0.205597 0.584518 1.887098 -0.003037 0.275437 0.284864 0.498502 1.390619 0.420836 1.130381 0.231886 0.847073 0.095615 0.607414 1.011081 1.447841 0.164573 1.502453 0.831139 0.132345 1.661157 1.312226 1.076357 0.243461 1.200184 -0.157359 0.043305 1.032359 -0.121583 0.546718 0.767293 -0.067637 0.694051 1.269141 0.893547 1.206075 0.570998 1.759030 1.248561 0.298055 0.146313 1.260654 1.554458 1.250667 1.256527 0.344868 0.276564 0.771847 0.802457 0.370262 0.976654 1.676537 1.624269 -0.036514 0.330146 -0.303271 1.905782 -0.218435 0.485886 -0.252420 1.030936 0.499169 1.467945 1.172102 0.363852 0.627021 0.755752 1.579484 0.464510 0.154753 0.560440 0.607319 0.638005 1.680124 0.083722 1.177794 0.736709 0.494518 0.286164 0.424904 0.321110 1.279219 1.729418)
)
;;; 88 all -------------------------------------------------------------------------------- ; 9.3808
@@ -903,7 +916,7 @@
#(89 12.644 #(0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 1)
12.148494905477 #(0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1)
- 9.552286 #(0.000000 0.119302 0.907367 0.992672 0.317127 0.192011 0.442698 0.339874 1.043812 0.516921 0.336110 0.693140 1.235627 0.624748 1.730543 0.377091 0.472035 1.462094 0.262954 0.379100 0.007054 -0.017270 0.272107 -0.177457 0.656035 0.674353 1.295950 0.908789 1.384729 0.497078 -0.297053 -0.207064 1.659235 1.067898 1.447152 1.505905 0.848258 0.745164 0.134919 0.850306 0.539871 1.436385 0.911002 0.787911 -0.117010 0.466708 1.274488 0.585895 0.469558 1.583009 1.284543 1.070181 -0.481937 1.200424 1.265237 1.067793 0.258135 0.035666 1.492390 0.834893 -0.054066 0.701490 0.052277 1.915133 1.749538 -0.250885 0.248617 1.204067 0.286129 0.689295 -0.275794 1.183948 0.143572 0.704846 1.247912 1.700944 -1.645761 0.229667 0.982642 0.554800 1.272942 1.061160 -0.525795 0.223308 0.633945 0.176923 1.033105 1.735657 0.843597)
+ 9.472615 #(0.000000 0.150083 0.891634 1.001254 0.117140 0.334827 0.513328 0.409924 0.971306 0.550414 0.454067 0.565463 1.465027 0.649243 1.843011 0.403693 0.574619 1.541968 0.271000 0.363088 0.098278 0.042912 0.284076 -0.218863 0.809814 0.647783 1.447012 0.889636 1.378793 0.534278 -0.334856 -0.186570 1.785150 1.085706 1.516663 1.568373 0.823136 0.765666 0.157943 0.795560 0.634023 1.410905 0.998401 0.634625 -0.048746 0.621077 1.240559 0.590505 0.559871 1.736873 1.447453 1.096197 -0.529446 1.197020 1.258901 1.174681 0.113743 0.131603 1.448674 0.781112 0.041421 0.704153 0.068860 1.919719 1.734535 -0.308648 0.240609 1.196557 0.399186 0.658712 -0.302315 1.187038 0.087947 0.451649 1.231493 1.586420 -1.622483 0.138236 0.980516 0.520557 1.245864 1.011113 -0.550327 0.212162 0.585507 0.099562 0.956382 1.774128 0.914152)
)
;;; 90 all -------------------------------------------------------------------------------- ; 9.4868
@@ -912,7 +925,8 @@
12.299262768523 #(0 0 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 0)
12.059710502625 #(0 0 1 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0)
- 9.571827 #(0.000000 0.774614 1.060957 0.258357 0.198721 1.336325 1.042354 0.084563 1.060581 0.035883 0.325577 1.464399 1.613183 1.307773 0.219555 1.966156 1.284457 1.550349 -0.044391 0.781239 0.629552 1.253012 -0.054307 0.353119 0.398495 1.194223 1.758259 0.382231 -0.353854 0.005691 1.279364 -0.205439 0.316377 1.143021 0.190410 0.226195 0.994821 0.065022 0.593226 0.309887 1.039854 1.156142 0.901216 1.043996 1.476581 1.010048 1.021222 0.769316 1.007643 0.084460 1.129675 0.325092 1.877786 0.726895 0.569601 1.780841 0.809974 0.896502 -0.045512 1.350967 0.002891 0.738755 0.431930 0.690105 1.780108 1.618360 0.514591 0.492343 0.521863 0.804702 0.519964 -0.290120 1.778509 1.828403 1.585895 0.788236 -0.310283 0.693070 0.265999 0.750689 0.174788 1.438951 1.349990 1.164335 0.273188 0.180395 0.513900 0.753309 0.671367 0.415233)
+ 9.487241 #(0.000000 0.821187 1.065882 0.245299 0.203813 1.336050 1.029192 0.060191 1.116904 0.099855 0.397107 1.567726 1.597774 1.290756 0.257293 0.044108 1.243795 1.542367 0.016757 0.761122 0.736892 1.274128 -0.021140 0.359952 0.382828 1.218339 1.795620 0.424928 -0.350980 -0.045109 1.264637 -0.246113 0.268799 1.163717 0.248773 0.227821 0.973862 0.046334 0.590622 0.249050 1.038956 1.308054 0.927178 1.123337 1.495757 1.079094 1.029002 0.844746 0.881979 0.068151 1.167550 0.339718 1.885933 0.711159 0.478834 1.733200 0.810480 0.944144 -0.078350 1.327983 0.060049 0.690812 0.266076 0.704239 1.824891 1.661000 0.523134 0.570089 0.480904 0.749266 0.577075 -0.345022 1.908572 1.812546 1.629032 0.727732 -0.248250 0.648783 0.210873 0.718072 0.154953 1.374916 1.337617 1.170048 0.324014 0.272274 0.525214 0.775291 0.726050 0.455735)
+ 9.479133 #(0.000000 0.822048 1.068030 0.245103 0.203813 1.337163 1.028331 0.059571 1.115220 0.098101 0.397397 1.570543 1.598034 1.289018 0.259921 0.045157 1.242626 1.542433 0.015545 0.760564 0.737915 1.271979 -0.019075 0.363900 0.382471 1.216250 1.794431 0.424508 -0.347932 -0.047968 1.264050 -0.245556 0.265542 1.169267 0.248290 0.226799 0.976877 0.046568 0.592976 0.245442 1.039617 1.304587 0.935439 1.123390 1.494419 1.082327 1.025358 0.842932 0.879477 0.065387 1.168085 0.338837 1.888400 0.716047 0.479689 1.733020 0.809078 0.946940 -0.078437 1.324866 0.061389 0.689578 0.267649 0.703261 1.824143 1.659706 0.524310 0.572907 0.479618 0.745116 0.577835 -0.344556 1.911060 1.814292 1.628569 0.729576 -0.246475 0.646149 0.216374 0.717722 0.156295 1.374775 1.335769 1.171186 0.323834 0.268945 0.525905 0.778827 0.723760 0.452553)
)
;;; 91 all -------------------------------------------------------------------------------- ; 9.5394
@@ -921,7 +935,7 @@
12.335505485535 #(0 1 1 0 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0 1 1 1 0)
12.130150794983 #(0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0)
- 9.566004 #(0.000000 0.508722 1.663202 1.491954 0.748688 1.401758 1.704100 1.185015 0.656593 1.079830 0.879314 1.722179 0.976749 1.144609 0.531920 1.270018 1.227969 0.241024 0.036212 1.756560 1.734807 0.161520 0.320748 1.499002 -0.061621 0.666540 0.539166 0.633227 1.496489 0.360912 1.824163 0.047339 1.585249 1.802154 -0.137749 -0.048508 1.492593 0.336359 0.367633 0.064380 0.519228 1.710513 1.495840 0.532025 1.099614 0.005786 0.826252 -0.091858 1.088022 0.407324 1.601474 0.614471 0.781061 1.636940 0.261887 0.423223 -0.191445 1.716597 -0.235283 0.878679 1.563955 0.272112 0.054276 0.248462 1.047153 1.129671 1.415525 1.521956 0.336704 1.728004 0.656963 0.976889 1.043677 0.493659 1.156626 1.157642 1.754941 -0.070778 0.161273 1.195037 0.483553 -0.075775 1.431201 0.040932 1.339377 1.102136 0.908605 0.072696 1.538073 1.858671 0.776932)
+ 9.528947 #(0.000000 0.481655 1.594439 1.568902 0.697073 1.408460 1.707303 1.224860 0.612341 1.080428 0.880549 1.734112 0.982775 1.127349 0.542673 1.278938 1.245839 0.259013 0.026700 1.730319 1.718641 0.127782 0.350321 1.499262 -0.045960 0.661905 0.491583 0.650691 1.529351 0.348327 1.850119 0.053248 1.564181 1.855067 -0.100690 -0.046751 1.512155 0.331287 0.375579 0.070846 0.530999 1.696360 1.469014 0.538915 1.146418 0.023700 0.842729 -0.119479 1.151201 0.438075 1.568174 0.639290 0.856401 1.661287 0.307628 0.426892 -0.123879 1.724105 -0.224579 0.942282 1.637726 0.293382 0.106322 0.270710 1.076945 1.053470 1.411125 1.497123 0.340993 1.799885 0.724628 1.007280 1.020833 0.419771 1.154723 1.181398 1.725955 -0.054491 0.131589 1.260162 0.429345 -0.095145 1.444416 0.053690 1.369364 1.065391 0.957845 0.105299 1.588168 1.926962 0.805879)
)
;;; 92 all -------------------------------------------------------------------------------- ; 9.5917
@@ -942,7 +956,7 @@
#(94 12.840441703796 #(0 1 0 1 1 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0)
12.510846178591 #(0 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0)
- 10.036698 #(0.000000 0.262507 0.927762 0.691765 -0.022528 0.948670 1.044464 -0.015912 1.254426 1.166017 -0.025359 0.573446 0.809346 0.904328 -0.112314 0.171289 1.482375 0.738024 0.928318 0.370521 0.935471 0.523015 0.397254 0.907754 0.840706 0.553700 0.985208 0.562651 1.843651 -0.075166 1.025659 0.388683 1.451036 1.083044 -0.062570 1.603926 0.821882 1.718727 0.462600 0.003258 1.761297 1.372576 1.725807 1.298659 1.470134 1.296691 1.316351 0.404379 1.586151 1.002498 0.941536 1.041567 -0.236309 0.005698 0.165302 0.426267 0.159084 1.629758 0.222308 1.142609 0.929200 1.297377 0.497412 1.470594 1.311979 -0.075434 0.149955 0.969083 1.525999 0.818305 0.622508 0.449059 0.888200 1.335928 1.223884 0.370550 1.142545 1.800074 1.443730 -0.097620 1.281325 0.908411 0.516689 0.825316 1.614830 0.244384 1.297300 0.081265 0.488987 1.076651 1.164354 1.011567 0.600061 -0.001949)
+ 9.994747 #(0.000000 0.282902 0.945972 0.724203 0.027615 0.953259 1.102656 -0.028654 1.298905 1.116381 -0.029515 0.630456 0.776527 0.953348 -0.104560 0.140764 1.457722 0.751991 0.852252 0.280293 0.911490 0.466508 0.496306 0.849571 0.748952 0.529781 1.080235 0.648396 1.876067 -0.126403 0.927072 0.395861 1.433843 1.073551 -0.243097 1.629522 0.853509 1.580983 0.379343 0.028738 1.793691 1.365035 1.769762 1.307882 1.579379 1.369855 1.201827 0.298233 1.492951 0.969322 1.037440 0.986911 -0.265307 0.160928 0.144083 0.447441 0.186548 1.469520 0.197964 1.216523 1.059884 1.273163 0.432301 1.469448 1.333041 -0.087527 0.126295 0.963711 1.540788 0.792066 0.479372 0.649972 0.855451 1.408971 1.155520 0.292298 0.971896 1.828610 1.433555 -0.131172 1.266750 0.994089 0.550615 0.739833 1.572707 0.069097 1.107277 0.105102 0.466611 1.117144 1.345031 0.969627 0.675127 0.053450)
)
;;; 95 all -------------------------------------------------------------------------------- ; 9.7468
@@ -951,7 +965,7 @@
12.448801040649 #(0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0)
12.431831359863 #(0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
- 10.003573 #(0.000000 1.454443 1.079180 1.309664 0.769785 0.620517 -0.014045 0.953473 0.679764 -0.289348 1.690422 0.136029 -0.117344 1.842923 1.214335 1.449226 1.044205 0.025475 0.571885 1.285922 0.496170 1.781943 1.016637 0.883364 0.305662 1.664884 1.125941 0.903056 1.490649 1.638320 1.367818 1.341050 1.001095 0.658320 1.647841 -0.005525 0.662875 0.843702 1.522677 1.276396 0.635758 0.481450 0.813547 0.591675 0.682886 1.452601 0.169855 0.595991 1.071763 -0.019224 0.826664 0.039464 0.089088 1.731249 0.977864 1.922336 1.059970 -0.116167 1.216611 0.678254 1.686716 1.655851 0.061642 0.763051 1.285269 0.430309 0.536591 1.275950 0.868974 1.403790 0.645360 0.515504 1.161466 -0.091744 1.507259 1.478290 1.633821 1.455564 0.140932 0.992249 0.572614 1.155813 1.387100 1.763058 1.325768 1.545854 -0.060166 1.557318 0.216519 1.462662 0.549524 0.854108 -0.150450 0.062302 1.722316)
+ 9.872220 #(0.000000 1.290021 1.094574 1.289254 0.777075 0.613943 -0.103411 0.953606 0.785437 -0.188455 1.633489 0.093148 0.028987 1.754107 1.308104 1.470491 0.912786 -0.058470 0.613367 1.209875 0.452270 1.600963 1.126752 0.835222 0.371664 1.564190 1.002192 0.873588 1.627648 1.673137 1.348794 1.318139 0.967996 0.790482 1.717003 0.056605 0.621705 0.808080 1.488458 1.280827 0.751371 0.344496 0.711284 0.584875 0.686536 1.550957 0.285460 0.551163 1.155702 -0.004317 0.766557 -0.046598 -0.148508 1.846033 0.937439 1.712194 1.047374 -0.098577 1.043878 0.911165 1.886020 1.782673 0.139943 0.832515 1.386418 0.334932 0.670828 1.181611 0.866170 1.335306 0.778145 0.374585 1.307072 0.030925 1.571911 1.278489 1.677033 1.327630 0.125408 1.117264 0.426978 1.079248 1.294939 1.596728 1.336207 1.528768 -0.069596 1.631456 0.184938 1.395648 0.665217 0.747477 -0.193461 0.117060 1.772423)
)
;;; 96 all -------------------------------------------------------------------------------- ; 9.7980
@@ -960,7 +974,7 @@
12.682573318481 #(0 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1)
12.586637130548 #(0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1)
- 9.956428 #(0.000000 1.675948 0.287209 0.233310 -0.079824 1.523542 1.399256 1.406750 1.935730 0.696672 0.776947 1.692980 0.052528 -0.381442 -0.039538 0.044914 -0.069553 0.919028 1.502378 1.371220 1.644355 0.996502 0.725953 0.523704 -0.049850 1.531859 -0.250600 0.598605 0.616260 1.115441 0.541721 0.658757 0.084092 0.894102 1.563465 1.000331 1.159567 0.505090 0.694196 -0.455290 0.585717 0.650149 1.707617 1.762636 0.467126 1.279163 0.867638 1.057351 0.185275 1.642674 1.261541 0.679914 1.215538 -0.409094 1.099267 -0.301955 0.890993 1.775338 1.489942 0.108918 0.526171 1.058424 0.017386 0.224591 0.700086 1.875075 0.823581 0.881656 -0.008544 1.052889 -0.000036 1.372655 1.239030 0.728069 1.769731 1.257473 1.169958 1.224521 1.037137 -0.251090 0.225039 0.773457 0.850235 1.641708 0.985338 0.223366 1.283683 -0.004076 -0.276133 0.133001 0.421688 0.830765 0.048497 1.273913 0.928539 1.501846)
+ 9.858639 #(0.000000 1.670983 0.285310 0.267391 -0.020713 1.527801 1.350806 1.468289 1.959307 0.745049 0.833269 1.695927 0.053448 -0.360648 -0.009685 0.057817 -0.029080 0.963022 1.476375 1.416655 1.644990 1.028547 0.727066 0.591745 -0.097819 1.512883 -0.300131 0.607260 0.624465 1.126166 0.545667 0.641102 0.097644 0.874108 1.620145 0.967134 1.190690 0.560799 0.740485 -0.461228 0.612887 0.640708 1.777573 1.712413 0.461031 1.253034 0.864791 1.041453 0.231399 1.619014 1.278225 0.742019 1.197758 -0.413662 1.153111 -0.258503 0.949095 1.725830 1.436307 0.016825 0.570128 1.054216 -0.002973 0.213207 0.701781 1.912432 0.823896 0.853074 0.015814 1.006434 0.026300 1.447387 1.204384 0.692934 1.771464 1.204723 1.215557 1.200801 1.060016 -0.217865 0.249753 0.789466 0.811931 1.612619 1.000393 0.232656 1.332554 0.067500 -0.262633 0.152330 0.360651 0.843314 0.019120 1.363355 0.954938 1.529730)
)
;;; 97 all -------------------------------------------------------------------------------- ; 9.8489
@@ -1220,7 +1234,7 @@
15.249417304993 #(0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1)
15.138 #(0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1)
- 11.609503 #(0.000000 1.385779 0.070925 1.496922 1.096632 1.284240 0.843817 1.025359 0.259538 0.708219 0.254515 0.652208 1.512380 0.890462 0.641585 1.506231 1.525569 0.059734 0.195758 0.287010 -0.116843 -0.232866 1.118815 0.537868 0.091408 1.495377 1.816696 -0.112783 1.162119 1.444329 0.495587 1.220847 1.307235 0.105294 0.591085 1.850342 0.080497 0.934256 0.322497 0.804748 0.261492 0.431829 1.265153 1.023741 0.795833 0.778440 0.549868 1.290344 0.046569 0.306780 -0.332313 1.403525 1.427302 0.431610 1.186464 1.326416 0.054461 0.590485 -0.137233 0.365851 0.091044 -0.123127 0.572543 0.608652 1.404450 0.961768 1.361797 1.091260 1.391389 0.458065 1.668735 -0.076306 1.449830 1.251556 0.876263 0.420897 1.305047 1.142384 0.053156 1.275863 1.310243 1.028562 0.214260 0.216332 0.921686 1.099795 0.698867 -0.116927 0.397582 0.127627 0.766052 0.798293 1.458560 1.079225 1.315103 0.253628 0.784746 0.616589 1.151511 0.761235 0.533750 0.559544 0.512023 0.356841 1.281582 0.880026 0.175606 1.130494 -0.126906 1.078820 0.266565 1.286713 0.806879 1.213467 1.566778 0.646791 1.790457 0.709685 1.046269 0.124577 0.380084 0.899328 1.165923 1.737719 -0.029121 1.392570 0.091574 1.102089)
+ 11.573528 #(0.000000 1.358622 0.052815 1.525342 1.078254 1.277467 0.851644 0.993773 0.270527 0.666892 0.214715 0.561881 1.486305 0.897301 0.663907 1.464915 1.458940 0.073985 0.227716 0.240977 -0.118121 -0.240614 1.129165 0.562949 0.104761 1.512942 1.850497 -0.150893 1.132547 1.479629 0.454176 1.177070 1.243333 0.052388 0.587923 1.838013 0.100181 0.948655 0.323787 0.826841 0.229639 0.441532 1.219126 0.983808 0.782016 0.761902 0.566556 1.268485 0.018509 0.263246 -0.384569 1.394812 1.372861 0.446364 1.200217 1.335900 0.036123 0.561092 -0.095607 0.396696 0.119690 -0.125962 0.586149 0.613171 1.411972 1.000998 1.395219 1.079869 1.383076 0.460730 1.650881 -0.061949 1.452576 1.251142 0.849189 0.416834 1.306581 1.183581 0.090160 1.263584 1.323055 1.014591 0.198802 0.170910 0.985123 1.132470 0.684690 -0.159944 0.394404 0.148159 0.775584 0.814835 1.415542 1.113548 1.363351 0.271326 0.750728 0.663523 1.188110 0.784207 0.491110 0.586774 0.532456 0.358822 1.296022 0.846135 0.234995 1.116767 -0.154526 1.037932 0.290091 1.320389 0.871439 1.212979 1.564010 0.656220 1.789912 0.666737 1.027019 0.134831 0.399150 0.881457 1.220367 1.794516 -0.015901 1.390136 0.114371 1.152434)
)
;;; 256 all --------------------------------------------------------------------------------
@@ -1703,7 +1717,10 @@
#(47 8.4595276184949 #(0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 0 1)
8.336971282959 #(0 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 0)
- 6.869846 #(0.000000 0.962936 0.748807 0.958751 0.275405 0.669334 0.092536 1.497374 1.630172 1.228945 -0.192324 1.791130 -0.024109 0.137976 0.044702 0.520016 0.098390 1.509943 1.287002 0.195293 -0.096188 1.667599 -0.106430 0.609206 1.248071 -0.185310 0.334303 1.813975 1.309446 0.857993 0.628347 0.649209 0.980643 1.660713 0.518704 -0.051308 0.579556 0.979282 1.869242 0.165757 1.616459 0.801284 1.473067 0.928753 1.712835 1.632964 0.626211)
+ 6.830684 #(0.000000 0.925613 0.731025 0.826587 0.337466 0.552586 -0.007756 1.553024 1.574187 1.261569 -0.195026 1.740012 -0.008571 0.116716 -0.038767 0.642461 0.120597 1.285158 1.379269 0.169504 0.014258 1.661969 -0.108759 0.555943 1.282464 -0.130334 0.346154 1.746316 1.242394 0.734793 0.636960 0.445502 0.999801 1.599522 0.463287 -0.003293 0.565885 1.073841 1.870809 0.138086 1.429672 0.722631 1.436033 0.766038 1.792260 1.484750 0.511596)
+ 6.813080 #(0.000000 0.905073 0.720857 0.809038 0.349935 0.537327 -0.000922 1.557978 1.558030 1.262358 -0.197354 1.752599 0.008794 0.124688 -0.046228 0.662516 0.096529 1.285846 1.345281 0.200201 0.052671 1.678541 -0.089455 0.531007 1.289353 -0.091483 0.360154 1.752654 1.281049 0.712465 0.676290 0.476665 1.008383 1.642560 0.426923 0.037457 0.580019 1.098416 1.911742 0.149095 1.445158 0.729070 1.437273 0.755012 1.791986 1.500943 0.493857)
+ 6.794799 #(0.000000 0.897163 0.698247 0.822409 0.375616 0.539014 0.014454 1.555415 1.549108 1.257725 -0.202933 1.765450 0.025614 0.114875 -0.043447 0.663807 0.097520 1.291742 1.359676 0.228655 0.060069 1.644723 -0.084038 0.524959 1.308818 -0.081506 0.352086 1.751467 1.301845 0.679219 0.700158 0.496101 1.009200 1.661339 0.434627 0.072114 0.589374 1.130793 1.939998 0.152364 1.467129 0.726907 1.427280 0.765815 1.803918 1.480200 0.488883)
+ 6.793437 #(0.000000 0.899395 0.699139 0.822602 0.369563 0.538099 0.016185 1.556790 1.551639 1.250469 -0.202952 1.763170 0.028017 0.112846 -0.039936 0.661519 0.095443 1.286970 1.353214 0.225122 0.058009 1.649322 -0.090812 0.524816 1.307299 -0.085913 0.352297 1.754603 1.303478 0.680448 0.691624 0.498042 1.007138 1.659354 0.432424 0.069410 0.584615 1.128677 1.938358 0.151391 1.459330 0.723424 1.430080 0.763673 1.799518 1.483215 0.487535)
)
;;; 48 odd -------------------------------------------------------------------------------- ; 6.9282
@@ -1749,20 +1766,28 @@
7.280061 #(0.000000 1.321647 0.124991 0.267301 -0.097572 -0.182250 -0.264318 0.305281 1.510023 0.690643 -0.083761 1.149156 1.615661 1.082902 0.053495 0.729805 0.372777 0.867953 1.622402 1.147465 1.254474 -0.097105 0.284065 0.155239 0.747118 0.191728 0.572524 0.648832 1.863557 -0.077024 0.661631 1.317858 0.017675 1.383827 1.176558 0.383061 0.407564 -0.057445 0.037863 1.268097 0.050462 -0.093915 1.305364 0.606032 1.418849 -0.216569 1.955628 -0.054434 1.046128 1.613160 -0.222178 0.527538 0.279199)
7.277941 #(0.000000 1.320608 0.123883 0.266260 -0.098726 -0.180951 -0.263113 0.307354 1.509795 0.692362 -0.084460 1.146543 1.613082 1.083223 0.052430 0.729954 0.371750 0.865216 1.624262 1.151576 1.254591 -0.097077 0.283807 0.157287 0.747426 0.191510 0.576525 0.650443 1.865135 -0.076524 0.659368 1.316048 0.013316 1.383629 1.179236 0.382065 0.409609 -0.059453 0.038301 1.267468 0.048020 -0.089572 1.305742 0.607804 1.419408 -0.216409 1.955990 -0.058582 1.049800 1.616185 -0.225681 0.530375 0.281400)
+ 7.273215 #(0.000000 1.343052 0.104313 0.292254 -0.099809 -0.115744 -0.303393 0.309762 1.568110 0.711662 -0.129520 1.100770 1.602083 1.083618 0.030557 0.757257 0.439398 0.786330 1.619827 1.211602 1.230947 -0.130689 0.250207 0.237032 0.708572 0.165884 0.610782 0.691233 1.953472 -0.061951 0.592191 1.344205 -0.076495 1.318636 1.179553 0.359772 0.385425 -0.145969 0.033263 1.236535 0.044816 -0.007354 1.322911 0.548895 1.412806 -0.236927 0.039279 -0.084552 1.051232 1.601387 -0.195420 0.519143 0.313332)
+ 7.271553 #(0.000000 1.343135 0.103283 0.287007 -0.102113 -0.119135 -0.299440 0.306934 1.564192 0.708532 -0.127587 1.101288 1.599644 1.082570 0.030040 0.754816 0.434230 0.785436 1.626496 1.210693 1.232434 -0.132579 0.255945 0.230787 0.708125 0.164488 0.610014 0.688544 1.945948 -0.058700 0.591940 1.336609 -0.071792 1.322368 1.176977 0.357916 0.384133 -0.143441 0.029700 1.235899 0.047215 -0.009258 1.321575 0.549885 1.411465 -0.234445 0.035711 -0.088922 1.047606 1.600927 -0.199308 0.525150 0.312914)
)
;;; 54 odd -------------------------------------------------------------------------------- ; 7.348
#(54 9.3444428264144 #(0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1)
9.025 #(0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0)
- 7.370716 #(0.000000 0.360609 1.429198 0.167181 1.607354 -0.034732 1.302957 1.318914 0.760088 1.060904 0.226236 1.104193 0.450695 -0.071985 0.180662 -0.045912 1.280928 -0.014208 0.213798 0.433381 1.776229 0.032369 0.118062 1.582732 1.225392 1.447993 0.361580 0.843630 1.822053 1.598806 0.575866 1.413697 0.439937 0.741012 1.866884 0.829137 0.687919 1.196856 0.696097 0.025026 1.368451 0.851959 0.888202 1.902482 1.402613 0.565657 0.918452 1.468295 1.346530 1.838528 0.042226 0.240426 0.740524 0.492428)
+ 7.343237 #(0.000000 0.356519 1.378098 0.100713 1.597092 -0.025702 1.221174 1.251558 0.690644 0.974868 0.161868 1.045405 0.521711 0.003817 0.306043 -0.096834 1.232150 -0.099464 0.224397 0.415571 1.740071 0.094513 0.078550 1.542437 1.225294 1.399009 0.336583 0.674783 1.840391 1.660692 0.517435 1.402550 0.393296 0.592199 1.897829 0.665758 0.536805 1.096961 0.623716 -0.026615 1.280422 0.608136 0.821814 1.798315 1.255450 0.438527 0.834992 1.356753 1.200356 1.790553 -0.115951 0.080012 0.586774 0.361501)
+ 7.341731 #(0.000000 0.356465 1.378320 0.098833 1.596818 -0.023654 1.218823 1.251692 0.691288 0.972560 0.161978 1.045118 0.521354 0.003562 0.307317 -0.097314 1.234937 -0.099161 0.226221 0.415364 1.740269 0.091970 0.079470 1.547113 1.226610 1.398885 0.336150 0.678460 1.841150 1.662881 0.519475 1.400656 0.391672 0.592116 1.898122 0.666766 0.533527 1.098876 0.624484 -0.028163 1.280801 0.610596 0.821449 1.798883 1.252672 0.438494 0.835603 1.353298 1.199447 1.791275 -0.116097 0.078485 0.587033 0.360167)
)
;;; 55 odd -------------------------------------------------------------------------------- ; 7.416
#(55 9.3425494397445 #(0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 1 0)
9.2039985656738 #(0 0 1 1 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
- 7.425931 #(0.000000 0.393337 -0.069929 1.425570 0.738893 1.162800 1.432830 -0.019845 1.589453 0.196206 1.575243 0.533119 0.008790 0.321878 -0.002480 0.481021 1.750913 0.992172 1.263593 1.347617 0.146216 -0.019950 0.181353 0.308820 1.645107 0.199414 0.327265 1.401040 1.647980 0.702071 0.686547 0.051854 0.294800 0.485490 1.192994 1.062902 1.709403 0.535969 -0.395899 1.102802 1.001143 -0.007019 1.266768 1.319411 0.695248 1.405083 0.233837 0.701019 0.316208 0.586047 0.096288 1.610925 0.480265 0.282364 -0.129724)
+ 7.418031 #(0.000000 0.371883 -0.102385 1.384110 0.788939 1.172597 1.460679 -0.051584 1.613915 0.238888 1.525865 0.549649 -0.043003 0.333004 0.044794 0.512744 1.722267 1.079306 1.246830 1.284907 0.207450 0.040677 0.202715 0.238687 1.612592 0.166071 0.400629 1.260632 1.623827 0.653615 0.626094 0.034784 0.350367 0.574431 1.183380 0.988854 1.735576 0.588499 -0.354395 1.140552 1.016796 0.000102 1.159353 1.267678 0.628601 1.407149 0.225892 0.684474 0.382309 0.514872 0.105129 1.589405 0.489089 0.324447 -0.112140)
+ 7.404942 #(0.000000 0.377657 -0.163749 1.307019 0.766445 1.174591 1.554696 -0.065054 1.596223 0.235021 1.487365 0.562129 -0.056753 0.320528 0.088709 0.493279 1.702053 1.159242 1.253441 1.121244 0.218681 -0.012837 0.194853 0.218523 1.612330 0.162538 0.477456 1.220509 1.626107 0.697021 0.606582 -0.002540 0.392884 0.556790 1.119006 0.941328 1.694649 0.609115 -0.343444 1.141359 1.128719 0.007663 1.054168 1.118833 0.641850 1.493868 0.180476 0.692227 0.423391 0.515456 0.123028 1.635448 0.507483 0.365848 -0.081100)
+ 7.393931 #(0.000000 0.378507 -0.167999 1.303367 0.765000 1.172284 1.557323 -0.069028 1.593115 0.235078 1.482530 0.561149 -0.058717 0.314387 0.094982 0.493767 1.694436 1.161228 1.256150 1.115168 0.221349 -0.016290 0.194457 0.217551 1.610384 0.165550 0.477403 1.224092 1.629992 0.696230 0.613196 0.002173 0.397633 0.549432 1.107815 0.948327 1.688439 0.607705 -0.336957 1.132758 1.135627 0.007272 1.054953 1.105488 0.644644 1.501879 0.180228 0.701215 0.425909 0.523464 0.116797 1.644929 0.498341 0.370645 -0.083698)
+ 7.388862 #(0.000000 0.380156 -0.171931 1.305953 0.766789 1.172901 1.559612 -0.075057 1.594209 0.233800 1.478965 0.563052 -0.064375 0.315917 0.092488 0.489599 1.684953 1.165576 1.262217 1.111692 0.227250 -0.025739 0.190013 0.217850 1.606986 0.164294 0.472832 1.227464 1.629452 0.697721 0.615520 0.002756 0.393787 0.546726 1.101414 0.952868 1.676931 0.600150 -0.336717 1.126210 1.136438 0.000608 1.053599 1.103228 0.649802 1.498716 0.172656 0.704531 0.425773 0.526132 0.114614 1.643561 0.494086 0.373521 -0.092896)
+ 7.384000 #(0.000000 0.377170 -0.171355 1.303977 0.765847 1.173036 1.564018 -0.072211 1.588223 0.235555 1.476689 0.559065 -0.064492 0.319345 0.095498 0.485382 1.686734 1.162129 1.270167 1.107241 0.234030 -0.027234 0.192277 0.220076 1.602606 0.164187 0.465725 1.231364 1.629068 0.697588 0.620787 0.005975 0.394481 0.549307 1.099799 0.964361 1.679269 0.595539 -0.332886 1.121604 1.140852 0.005330 1.057829 1.103141 0.657093 1.506149 0.171394 0.709315 0.427763 0.530110 0.119909 1.650065 0.491806 0.378320 -0.092271)
+ 7.380864 #(0.000000 0.378551 -0.175193 1.300624 0.762558 1.175276 1.564939 -0.074547 1.588074 0.235386 1.476865 0.556896 -0.066849 0.320111 0.097192 0.478953 1.683244 1.161925 1.270025 1.102513 0.235436 -0.031016 0.191299 0.221952 1.599370 0.162880 0.467467 1.233359 1.633245 0.699500 0.616427 0.003933 0.396463 0.543856 1.099953 0.961829 1.677585 0.593150 -0.332782 1.122442 1.143751 0.006167 1.059002 1.097752 0.656783 1.507140 0.168776 0.709153 0.425304 0.531258 0.118299 1.654258 0.491202 0.377929 -0.088468)
)
;;; 56 odd -------------------------------------------------------------------------------- ; 7.483
@@ -1800,7 +1825,9 @@
#(60 9.8824768066406 #(0 1 0 1 1 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 0)
9.6560277938843 #(0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0)
- 7.776767 #(0.000000 0.106293 0.624575 1.610685 1.046822 0.345054 0.896924 0.768673 0.382495 0.930136 0.216658 1.055646 -0.129210 1.618048 1.682407 -0.108877 1.570005 0.449695 1.121851 -0.333022 1.572576 0.324993 0.790891 1.288124 1.788293 0.097558 0.079357 1.630631 0.388545 1.287581 1.245285 0.345140 0.072592 1.828700 0.271195 0.278666 1.768361 1.596051 0.543356 0.198781 0.019788 1.084288 1.800177 0.718099 1.357412 1.506123 1.376340 0.637159 0.024591 0.956737 -0.024152 1.097002 1.426793 0.517035 0.057163 1.654042 0.219761 0.892937 0.743965 0.538643)
+ 7.739591 #(0.000000 -0.033501 0.619177 1.679261 0.721982 0.363648 0.878008 0.753620 0.225391 0.790557 0.189152 0.980066 -0.081610 1.728314 1.754207 -0.082883 1.638402 0.243777 1.229442 -0.466843 1.486892 0.262866 0.775574 1.130741 1.791308 0.031265 -0.171199 1.509590 0.224673 1.282758 1.212715 0.402030 0.299992 1.810442 0.424136 0.139270 1.799454 1.623755 0.488829 0.280451 0.137561 0.865648 1.810471 0.659298 1.194928 1.622255 1.425441 0.549726 0.110141 0.980860 -0.102558 1.102577 1.367909 0.445596 -0.086685 1.609098 0.043088 0.846296 0.673395 0.574626)
+ 7.717261 #(0.000000 -0.043543 0.600571 1.684561 0.722320 0.365276 0.898920 0.760440 0.237420 0.799852 0.177231 0.980091 -0.082164 1.722522 1.747076 -0.096968 1.637533 0.245814 1.222271 -0.463850 1.487297 0.275317 0.757190 1.138657 1.800100 0.004736 -0.174304 1.515674 0.231338 1.288318 1.221744 0.401221 0.323048 1.801172 0.413376 0.134236 1.802419 1.619328 0.485155 0.285264 0.130134 0.861710 1.813452 0.662559 1.223815 1.624613 1.430619 0.561330 0.100676 0.991556 -0.091888 1.106293 1.347663 0.435925 -0.077868 1.612575 0.063087 0.865799 0.679820 0.564508)
+ 7.715763 #(0.000000 -0.042788 0.602795 1.680148 0.721955 0.364027 0.894513 0.761479 0.236381 0.801451 0.176852 0.981725 -0.083622 1.720521 1.748351 -0.096212 1.639998 0.247099 1.225553 -0.461897 1.486616 0.276795 0.759617 1.138466 1.798696 0.004884 -0.171091 1.515113 0.231143 1.285422 1.222896 0.402531 0.319870 1.799104 0.412826 0.132684 1.801011 1.618575 0.483378 0.284155 0.129012 0.861247 1.811542 0.663827 1.221591 1.622984 1.428996 0.559001 0.101540 0.992031 -0.090308 1.103974 1.349687 0.436834 -0.074972 1.609682 0.062500 0.865222 0.678405 0.566972)
)
;;; 61 odd -------------------------------------------------------------------------------- ; 7.8102
@@ -1839,20 +1866,20 @@
10.022200584412 #(0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 1)
10.0 #(0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0)
- 8.076771 #(0.000000 1.082966 0.536005 0.830980 0.672103 0.948911 1.067391 0.102494 0.538255 0.057721 1.210526 1.163677 1.308751 -0.018261 0.671091 0.343620 1.035947 0.111126 1.505154 0.938236 0.670415 0.643270 0.928004 0.016262 0.587907 -0.637526 0.894706 0.430199 1.307032 0.621719 1.785706 0.986084 0.824267 0.285717 1.136965 1.265126 1.093070 0.443030 1.152479 1.676677 0.538360 -0.032005 -0.036686 0.647028 1.759523 0.333714 0.436654 0.573488 0.754357 1.691591 -0.222697 0.008779 -0.403679 1.643822 0.328010 0.505853 1.405011 1.581077 0.916570 1.052527 0.249935 1.554486 0.422102 0.838168)
+ 8.063789 #(0.000000 1.101099 0.602034 0.782491 0.697303 0.953568 1.029560 0.116167 0.534482 0.056839 1.177875 1.130699 1.283612 -0.059984 0.623810 0.344036 0.995635 0.096315 1.454462 0.914478 0.627848 0.663044 0.895985 0.021578 0.525686 -0.656147 0.794994 0.316795 1.350578 0.539610 1.703530 0.953234 0.770323 0.217282 1.058758 1.203159 1.048775 0.409086 1.090816 1.638682 0.456816 -0.128952 -0.103400 0.536416 1.625188 0.267460 0.387143 0.504877 0.640085 1.600063 -0.276082 -0.015244 -0.472943 1.570136 0.279373 0.427984 1.349728 1.459025 0.789425 1.021546 0.125635 1.434044 0.285470 0.750018)
)
;;; 65 odd -------------------------------------------------------------------------------- ; 8.0622
#(65 10.517309434908 #(0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1)
10.169842720032 #(0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1)
- 8.064838 #(0.000000 1.617303 1.387694 1.760698 1.521031 1.123027 -0.132198 1.153111 0.190205 1.472632 1.091575 0.399034 0.106976 0.421102 0.829299 1.667152 0.070561 0.058861 0.379491 0.549455 1.898721 0.043703 1.606003 1.058082 1.379504 1.583147 0.460760 1.571291 0.599466 1.174806 1.758595 0.263155 -0.362426 0.316101 1.755017 1.343528 1.570038 1.319933 1.399063 -0.025095 1.016516 0.001806 0.166804 0.175504 0.801433 1.168717 1.332325 0.904507 0.881984 1.718358 0.114882 0.907136 1.572342 1.403331 0.459614 -0.014027 1.807461 1.040251 0.576994 1.762376 0.200045 1.290860 0.536182 0.973419 0.736118)
+ 8.063423 #(0.000000 1.514017 1.477049 1.701599 1.477098 1.169313 -0.075329 1.286913 0.276989 1.468126 1.119589 0.404989 0.067303 0.491026 0.781791 1.701024 -0.020529 0.158627 0.277331 0.576195 1.931735 0.013487 1.631717 1.098265 1.396954 1.592476 0.527632 1.605742 0.711046 1.211603 1.716435 0.235070 -0.346987 0.362548 1.804862 1.235988 1.622218 1.297965 1.428305 0.007277 1.067887 0.026547 0.129971 0.135503 0.797012 1.235581 1.256506 0.828380 0.948896 1.703647 0.203535 0.911377 1.509825 1.310639 0.464424 -0.021037 1.773975 1.041112 0.489609 1.766338 0.167302 1.250383 0.535074 0.908499 0.837807)
)
;;; 66 odd -------------------------------------------------------------------------------- ; 8.1240
#(66 10.212840820553 #(0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0)
- 8.187044 #(0.000000 0.892304 -0.054641 0.984099 0.960662 1.134153 -0.120903 0.796166 1.331987 1.737716 0.131693 1.488555 0.058626 -0.044747 0.772642 -0.177677 1.527841 0.914620 0.512614 0.734289 -0.186508 0.834862 0.033457 1.167034 0.182321 1.515747 1.561452 0.397696 1.664592 1.347337 0.684886 0.786415 0.277357 0.077756 1.471579 1.444105 1.650524 0.242677 0.247548 0.070197 0.974037 -0.033537 1.207438 0.249783 0.617083 1.102129 0.594399 0.810354 1.910260 0.023382 1.478473 0.073912 0.702336 1.097883 1.147318 1.634314 1.810759 1.283831 1.307039 1.755834 1.640661 1.156939 0.875853 1.214567 1.508917 0.963139)
+ 8.157682 #(0.000000 0.864481 -0.087958 0.952979 0.990806 1.117378 -0.079822 0.799417 1.371802 1.727158 0.176395 1.489530 0.091710 -0.055244 0.768556 -0.182732 1.511445 0.919447 0.529018 0.741118 -0.207254 0.800079 0.010178 1.152014 0.183475 1.472872 1.571378 0.446209 1.663618 1.364506 0.715046 0.828731 0.313345 0.066095 1.516975 1.454528 1.677262 0.265348 0.285413 0.096996 0.990233 -0.034999 1.186591 0.321899 0.654849 1.135127 0.632072 0.949446 1.927164 0.016900 1.513154 0.066336 0.780091 1.101350 1.161809 1.669676 1.820897 1.282518 1.327582 1.730419 1.612974 1.135344 0.869848 1.264996 1.504778 0.959294)
)
;;; 67 odd -------------------------------------------------------------------------------- ; 8.1853
@@ -1860,14 +1887,14 @@
10.287303318203 #(0 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 0 1)
10.209677696228 #(0 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 1)
- 8.244924 #(0.000000 0.225241 0.672844 0.382270 1.550586 0.546246 0.858377 0.445858 -0.096073 1.363655 0.962814 0.257316 1.433531 0.171699 0.830977 1.005292 1.430407 1.274195 1.065177 0.817517 0.032134 0.528962 0.965582 1.320172 0.327246 1.649611 0.154261 0.588925 1.547512 -0.246005 -0.061320 -0.174666 1.812695 0.900162 0.560635 0.754952 0.008010 1.785514 1.011530 1.919878 0.805214 0.484166 1.258031 0.679556 0.855624 1.158995 1.516412 -0.062004 1.516283 0.858949 1.189612 0.073458 0.548333 0.508433 0.170312 0.943904 0.561891 -0.105858 0.872386 0.675673 1.307910 -0.045595 0.973024 0.144582 0.656206 0.187691 0.360507)
+ 8.189482 #(0.000000 0.223835 0.709563 0.361631 1.551719 0.569710 0.892711 0.412471 -0.122532 1.384928 0.920338 0.229931 1.448943 0.172890 0.823530 0.990828 1.509979 1.338332 1.208846 0.787460 0.061898 0.478875 0.981296 1.272732 0.373155 1.666130 0.172923 0.490908 1.701260 -0.223436 -0.153385 -0.210376 1.754388 0.900377 0.534928 0.735691 -0.024560 1.844372 0.982693 1.901761 0.736388 0.462828 1.348703 0.713521 0.867221 1.154715 1.565263 -0.077256 1.621203 0.799836 1.222303 0.052403 0.526227 0.481968 0.153640 0.955669 0.588080 -0.054516 0.786535 0.593333 1.327174 -0.007899 0.946668 0.129005 0.631564 0.210690 0.355805)
)
;;; 68 odd -------------------------------------------------------------------------------- ; 8.24621
#(68 10.698028101377 #(0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 1)
10.359804316765 #(0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0)
- 8.315119 #(0.000000 0.239272 1.644299 0.931268 0.624633 0.351602 0.333962 0.126372 0.857385 -0.114365 1.447465 0.954724 0.817853 0.900618 0.220428 1.689580 0.255756 0.734919 0.570791 0.776052 1.625190 1.151717 0.401574 0.671891 0.914103 0.605620 1.210980 0.032752 0.141608 0.373424 -0.081791 0.676337 0.380354 0.904472 0.290206 0.390656 1.359391 1.686949 0.716195 1.487851 -0.136679 0.551821 1.534954 0.888921 -0.083922 1.384200 1.428668 1.071303 1.340209 0.841005 1.659450 0.289601 0.274860 1.392303 -0.192788 0.548018 0.059043 1.396525 1.654720 1.915695 0.332774 1.710406 1.019818 0.399672 0.816073 1.298020 0.654106 0.216701)
+ 8.313178 #(0.000000 0.244343 1.642715 0.935745 0.628088 0.349339 0.336732 0.124857 0.857555 -0.116402 1.447310 0.953846 0.817972 0.894526 0.216338 1.688708 0.261371 0.735227 0.573014 0.775001 1.626527 1.148714 0.406863 0.670940 0.918299 0.604950 1.210229 0.031199 0.141725 0.375232 -0.081240 0.677485 0.378578 0.906117 0.294520 0.392067 1.355911 1.690390 0.718951 1.487329 -0.138179 0.553201 1.536097 0.881957 -0.082538 1.382961 1.427653 1.067926 1.340027 0.840907 1.660791 0.289066 0.274973 1.390968 -0.190181 0.543981 0.061245 1.393573 1.655279 1.916631 0.332779 1.712105 1.020206 0.398966 0.816453 1.294153 0.656319 0.218180)
)
;;; 69 odd -------------------------------------------------------------------------------- ; 8.3066
@@ -1876,7 +1903,9 @@
10.636575441359 #(0 0 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1)
10.452348709106 #(0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1)
- 8.350628 #(0.000000 1.827055 1.336867 -0.224040 0.157670 0.165342 0.604024 1.333297 0.841116 0.236318 1.457810 0.699804 1.043922 1.119175 1.068905 1.033855 0.162735 0.050648 0.456733 0.171865 1.700575 0.153883 0.597127 1.453703 1.125872 0.284285 1.520776 -0.119602 0.603061 0.226155 0.965795 -0.232995 0.328959 1.487254 0.002500 1.531168 0.985500 1.366452 1.274289 0.673075 1.623632 1.041976 0.192712 0.110777 0.935665 1.151876 1.041685 1.861048 0.425433 0.633398 -0.143934 0.249861 1.509358 0.548576 0.569792 0.699590 -0.240364 0.639529 1.031826 1.141805 0.611225 0.583454 -0.130148 0.897889 1.067017 0.896083 0.631691 1.343048 0.674979)
+ 8.299240 #(0.000000 1.809793 1.335116 -0.212710 0.158753 0.164651 0.603125 1.322153 0.831452 0.183363 1.448673 0.721080 1.066312 1.181872 1.076260 1.013268 0.191732 0.040800 0.486287 0.191971 1.710264 0.131293 0.621897 1.438011 1.135075 0.253412 1.507015 -0.159413 0.582721 0.193017 0.964253 -0.301532 0.293120 1.510278 0.034886 1.510459 0.975161 1.367320 1.238913 0.711944 1.636109 1.055624 0.191284 0.131365 0.923162 1.196510 1.037073 1.867255 0.433263 0.695116 -0.176328 0.235278 1.513915 0.550725 0.590587 0.684660 -0.200846 0.627019 0.987897 1.135787 0.574659 0.584443 -0.132204 0.924754 1.054659 0.926694 0.631260 1.327795 0.666286)
+ 8.287150 #(0.000000 1.788301 1.283865 -0.243377 0.143266 0.147064 0.583603 1.353517 0.822051 0.190027 1.414426 0.749816 1.060222 1.185192 1.093194 1.015512 0.161763 0.036963 0.497716 0.199845 1.710593 0.157923 0.616485 1.421608 1.168253 0.254166 1.519024 -0.174832 0.580521 0.195896 0.931932 -0.335581 0.290075 1.495789 0.039388 1.508198 0.993690 1.383338 1.230196 0.721038 1.621157 1.080787 0.186354 0.155199 0.911321 1.202612 1.049209 1.889955 0.428940 0.699100 -0.158825 0.279340 1.504069 0.569377 0.588039 0.685787 -0.246385 0.660960 0.985862 1.105698 0.572672 0.607429 -0.158430 0.926470 1.112443 0.938063 0.625090 1.346978 0.671578)
+ 8.286822 #(0.000000 1.788409 1.282257 -0.243275 0.144332 0.147372 0.582588 1.352720 0.820670 0.189941 1.414000 0.749482 1.059640 1.185143 1.094489 1.016383 0.161516 0.036696 0.497605 0.199194 1.710632 0.158778 0.616819 1.421634 1.168175 0.254077 1.519069 -0.175539 0.581179 0.194080 0.931559 -0.335790 0.288181 1.495548 0.038347 1.508309 0.993101 1.383618 1.230992 0.720738 1.621197 1.080692 0.185939 0.155063 0.909757 1.202469 1.049902 1.890071 0.429591 0.699293 -0.158546 0.279706 1.502937 0.567855 0.587581 0.684816 -0.246769 0.661087 0.986565 1.105766 0.572827 0.606959 -0.158508 0.926574 1.112685 0.938932 0.623827 1.346926 0.670541)
)
;;; 70 odd -------------------------------------------------------------------------------- ; 8.3666
@@ -1891,7 +1920,7 @@
11.002258540604 #(0 0 0 0 0 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 0 0)
10.642364501953 #(0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0)
- 8.548557 #(0.000000 1.159245 0.804326 1.818062 0.005394 0.097933 -0.138261 1.594586 0.297595 0.760631 1.031241 0.815952 0.866563 0.774938 -0.223575 0.279521 1.068782 0.377240 1.514609 1.075573 1.083234 1.370745 1.738157 1.768465 1.412446 1.545670 0.511503 1.461130 0.798315 0.347250 1.063200 1.662194 -0.167130 0.696591 -0.189179 1.082639 1.456846 1.772156 -0.021813 0.918942 0.867791 0.256756 0.910059 1.275113 1.690354 1.855607 1.011782 1.024418 1.033538 1.269188 0.626590 0.942262 1.196124 0.370318 1.378284 0.422412 1.021155 -0.262315 0.747897 0.088659 -0.217573 0.794506 1.071778 0.482608 1.808390 0.082121 1.722106 1.393830 1.277390 0.241523 1.675970)
+ 8.544504 #(0.000000 1.192383 0.795808 1.814023 0.056608 0.083907 -0.121050 1.626552 0.286630 0.766728 1.045352 0.813921 0.864758 0.794241 -0.252016 0.298119 1.064468 0.399420 1.532548 1.071264 1.065947 1.441145 1.758062 1.782588 1.457751 1.574983 0.499529 1.425562 0.810711 0.355236 1.084616 1.675909 -0.179044 0.717225 -0.165733 1.115628 1.485185 1.816919 0.012182 0.966936 0.903934 0.282770 0.928839 1.334934 1.757792 1.915789 1.073267 1.033220 1.131276 1.295678 0.674973 0.957907 1.155850 0.411091 1.358848 0.430934 1.032809 -0.242665 0.780401 0.116051 -0.143764 0.882115 1.167719 0.546914 1.849824 0.136356 1.758031 1.431559 1.298153 0.304816 1.714100)
)
;;; 72 odd -------------------------------------------------------------------------------- ; 8.4853
@@ -1899,14 +1928,14 @@
10.912703440154 #(0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1)
10.880306243896 #(0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1)
- 8.666354 #(0.000000 1.527577 0.368844 0.280099 0.745797 1.443412 1.076244 1.325593 0.209672 1.207426 0.385880 0.766837 1.756953 0.752137 1.461217 1.610143 1.009696 0.374199 1.734676 0.145089 0.511535 0.518250 0.491406 0.573663 0.883626 1.431657 0.900847 1.656822 1.137140 1.224741 0.607669 0.356780 1.730697 0.177763 0.378498 1.514810 0.617017 0.262463 1.157913 1.457396 0.221540 0.823022 0.746004 0.403692 0.562306 0.775541 0.134399 1.159497 1.804735 0.837034 0.959946 1.463438 0.416612 1.266440 0.711188 1.341387 1.179889 1.010997 0.603620 0.339860 0.932577 1.032590 0.087458 0.192776 0.041418 1.323630 0.973556 -0.216960 0.145851 0.268620 -0.003443 1.701817)
+ 8.605355 #(0.000000 1.538496 0.528188 0.224102 0.798611 1.667890 1.077695 1.251919 0.236481 1.248046 0.323237 0.802574 1.704665 0.718246 1.482106 1.728872 1.094605 0.405459 1.712545 0.074434 0.493266 0.643511 0.431980 0.576201 0.969406 1.300867 0.905210 1.837071 1.243165 1.100725 0.665435 0.215780 1.699240 0.155038 0.348205 1.558373 0.736396 0.445371 1.125432 1.537966 0.150096 0.661420 0.835098 0.410480 0.664983 0.762141 0.133680 1.168201 1.819381 0.989486 1.005334 1.375496 0.415260 1.297598 0.824824 1.270970 1.112196 0.988207 0.602187 0.364890 0.792911 1.213964 0.087899 0.306864 0.115764 1.421002 1.127294 -0.276309 0.279516 0.344478 0.039173 1.742464)
)
;;; 73 odd -------------------------------------------------------------------------------- ; 8.5440
#(73 11.087996391987 #(0 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1)
10.907942771912 #(0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1)
- 8.595833 #(0.000000 1.466671 0.418190 -0.006245 1.119293 1.557350 0.050570 -0.252893 1.020513 1.330101 1.696784 -0.021193 0.243993 1.618536 0.021448 0.445019 0.758051 1.128433 0.540322 1.625741 0.467320 0.404094 1.210572 0.582402 -0.147086 0.082703 0.103170 1.387015 1.519322 0.040173 1.416292 1.416189 0.056441 0.485986 0.097628 0.444462 0.929324 0.528673 1.003835 1.260541 0.631406 0.725787 0.243578 0.625655 -0.202347 0.432847 0.230684 1.396229 0.713809 1.137409 0.446245 0.131391 0.249881 1.158908 1.331723 0.568546 0.051571 -0.148726 -0.005463 0.271144 1.703682 0.388876 0.655869 -0.287166 1.423162 1.099889 0.224113 1.543437 0.286113 0.975156 0.277191 1.527998 0.013345)
+ 8.577606 #(0.000000 1.468120 0.399577 -0.018267 1.129749 1.540112 0.080443 -0.225521 0.984350 1.318256 1.725963 -0.015940 0.240457 1.585666 0.066646 0.456005 0.751053 1.114533 0.580701 1.657836 0.496435 0.433822 1.298768 0.600415 -0.190098 0.064658 0.103847 1.339139 1.507511 0.087123 1.469545 1.406973 0.042591 0.416789 0.070338 0.413098 0.972952 0.584179 1.008661 1.214009 0.655088 0.742369 0.248321 0.571683 -0.200036 0.424291 0.202007 1.422478 0.685909 1.132358 0.366535 0.103301 0.284148 1.188052 1.256745 0.599482 0.119285 -0.134695 -0.000187 0.303508 1.738552 0.317055 0.701322 -0.250651 1.419996 1.135309 0.264805 1.507796 0.275630 0.983246 0.282234 1.603893 0.010492)
)
;;; 74 odd -------------------------------------------------------------------------------- ; 8.6023
@@ -1922,7 +1951,7 @@
11.190553665161 #(0 0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 1)
10.942812919617 #(0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1)
- 8.726538 #(0.000000 1.071041 1.809816 0.059958 0.822097 0.020221 1.022061 0.267268 1.741927 0.823111 1.638047 0.234259 1.039944 1.939384 0.056641 1.512071 -0.446876 1.424554 1.395220 0.890315 0.150374 0.850506 1.740318 0.059864 0.284457 1.080394 -0.041575 -0.037683 0.246082 0.070045 0.556604 0.388223 0.907316 0.463106 0.901346 0.577387 0.428043 0.243019 1.797584 0.149750 1.587401 0.816348 1.650825 0.228184 0.984368 1.731206 1.472552 0.027902 0.172873 0.314194 0.827665 1.129630 1.192781 0.322381 1.817208 0.352452 1.708513 1.845590 0.806857 1.649527 0.120363 -0.087767 1.164645 0.852247 0.257218 1.588574 1.223106 0.870144 -0.282258 1.566337 1.495687 0.602027 0.686458 0.896987 0.048610)
+ 8.683698 #(0.000000 1.124940 1.810082 -0.048540 0.885185 0.101134 0.938946 0.189377 1.804564 0.801297 1.688153 0.224055 0.930401 -0.034817 0.076145 1.457725 -0.522454 1.353074 1.346269 0.916340 0.092845 0.958076 1.682504 0.027480 0.309688 1.061777 -0.013601 -0.050917 0.351752 -0.000108 0.484661 0.289700 0.926135 0.549821 0.935781 0.557659 0.449714 0.113690 1.820721 0.164733 1.593766 0.791524 1.700317 0.143258 0.971859 1.745798 1.477768 0.014993 0.086193 0.310990 0.869473 1.077134 1.225568 0.295373 1.810290 0.261102 1.605132 1.918757 0.779195 1.750321 0.094238 -0.024202 0.975187 0.766697 0.238490 1.630859 1.240419 0.857804 -0.286669 1.532284 1.412769 0.565085 0.735535 0.956985 0.019220)
)
;;; 76 odd -------------------------------------------------------------------------------- ; 8.7178
@@ -1972,8 +2001,8 @@
11.372210502625 #(0 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1)
8.994542 #(0.000000 0.154013 -0.316348 0.071738 1.106993 1.468229 0.131212 1.016340 0.347330 0.790110 0.582586 0.573996 1.621030 -0.055594 0.422842 1.432066 0.973798 0.924172 0.517788 0.808823 0.322273 0.477855 1.110729 0.828232 -0.135776 0.453821 0.977388 1.079080 0.813213 1.339889 0.985697 1.418288 1.872633 0.935702 0.560398 1.716219 0.625329 0.674462 -0.191195 1.017852 1.180580 1.259494 1.238203 1.074177 -0.246143 0.408570 1.154438 0.464503 0.237200 0.406748 0.428747 1.803989 0.602651 0.236975 0.696601 -0.007967 -0.109139 1.624732 1.107572 0.212492 1.019018 0.430487 1.302442 1.524648 1.430984 0.088883 0.131497 1.050853 1.025920 0.220497 0.271749 1.730206 1.423209 0.551947 1.919540 0.532335 0.723265 1.045572 -0.032108 1.423657 0.888376)
- 8.987279 #(0.000000 0.156944 -0.319459 0.072324 1.104721 1.467823 0.126980 1.023582 0.343810 0.792460 0.581799 0.582888 1.622258 -0.056238 0.416207 1.432094 0.972550 0.933447 0.514297 0.805196 0.319673 0.473007 1.116195 0.825577 -0.134145 0.460124 0.974451 1.075666 0.812037 1.339578 0.987012 1.419993 1.868380 0.927823 0.574271 1.715730 0.623958 0.670441 -0.191984 1.015705 1.182499 1.258988 1.239517 1.072788 -0.249344 0.413307 1.156258 0.465299 0.240010 0.408266 0.430155 1.807472 0.601305 0.227759 0.698162 -0.011086 -0.108166 1.621628 1.103908 0.220054 1.022971 0.436482 1.307860 1.523190 1.430286 0.089030 0.127133 1.052241 1.028409 0.223766 0.277009 1.729352 1.419545 0.550548 1.922867 0.526883 0.714025 1.040970 -0.032525 1.425838 0.883396)
- 8.984859 #(0.000000 0.155520 -0.316944 0.074556 1.100859 1.468955 0.123985 1.026117 0.344642 0.787968 0.580449 0.580762 1.623527 -0.053315 0.411429 1.431453 0.977816 0.930755 0.512135 0.804792 0.321683 0.474393 1.116236 0.827431 -0.134931 0.462890 0.970244 1.076428 0.811743 1.338275 0.983135 1.416970 1.870759 0.926936 0.574416 1.717843 0.625984 0.672133 -0.191605 1.014530 1.184980 1.256042 1.238003 1.073658 -0.246370 0.408840 1.152690 0.461112 0.241853 0.402947 0.430990 1.806193 0.602352 0.227109 0.696033 -0.012743 -0.109733 1.626393 1.107249 0.221550 1.025355 0.434908 1.308223 1.524465 1.430638 0.087189 0.127839 1.057102 1.028317 0.222556 0.275985 1.731909 1.415871 0.552268 1.920829 0.528266 0.714523 1.037633 -0.033204 1.425563 0.881356)
+ 8.979620 #(0.000000 0.133971 -0.325879 0.058128 1.116281 1.475033 0.088635 1.009750 0.356790 0.799299 0.624490 0.593664 1.616289 -0.067242 0.372934 1.431140 1.001806 0.880386 0.505977 0.815701 0.344281 0.468214 1.141868 0.829938 -0.170002 0.461248 0.936587 1.075431 0.837609 1.318066 0.963230 1.378111 1.858712 0.911927 0.588728 1.758887 0.624705 0.697629 -0.193269 1.006514 1.201616 1.263814 1.198019 1.079340 -0.267858 0.375758 1.151285 0.480731 0.258408 0.362257 0.458080 1.807940 0.623036 0.213144 0.719329 -0.053019 -0.116682 1.631840 1.109487 0.214661 1.030431 0.439182 1.277276 1.498167 1.406049 0.063731 0.100756 1.056934 1.016131 0.217283 0.289228 1.768181 1.383609 0.560872 1.955323 0.542811 0.720389 1.003976 -0.042309 1.458275 0.852285)
+ 8.978751 #(0.000000 0.133442 -0.323272 0.060725 1.114679 1.473804 0.089264 1.010184 0.354571 0.798241 0.627718 0.594956 1.616426 -0.067445 0.370170 1.433443 0.999941 0.878691 0.506811 0.816927 0.341781 0.470013 1.141387 0.832036 -0.171466 0.461911 0.937434 1.074597 0.837015 1.318765 0.967657 1.380005 1.862128 0.913359 0.586701 1.759303 0.626415 0.695822 -0.190484 1.006634 1.203431 1.266834 1.197949 1.077990 -0.267729 0.380595 1.150154 0.478725 0.254873 0.362966 0.458333 1.811543 0.623044 0.209843 0.719689 -0.056221 -0.112031 1.630512 1.109177 0.215435 1.027013 0.440511 1.281860 1.500481 1.406261 0.066775 0.100497 1.059738 1.020731 0.214321 0.289590 1.768407 1.382768 0.561941 1.958539 0.543300 0.720294 1.004120 -0.043334 1.455233 0.853445)
)
;;; 82 odd -------------------------------------------------------------------------------- ; 9.0554
@@ -1981,8 +2010,8 @@
11.662058134504 #(0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 0)
9.042421 #(0.000000 1.613429 0.890216 0.650247 0.418218 1.544981 1.351274 1.041821 0.736636 -0.052917 1.081786 0.682808 1.700282 0.443440 1.632352 1.476576 0.452722 1.365793 0.061696 0.416085 0.179035 1.612726 0.359782 0.147488 0.040516 0.024699 1.869944 -0.112635 1.097677 0.268033 0.556971 0.475782 1.772405 0.132338 -0.190930 1.845529 0.126807 0.920947 0.992215 -0.284266 -0.218677 0.284711 1.612935 0.566004 0.593993 1.112984 -0.131771 1.759380 0.896818 0.116126 0.882942 1.708811 0.774247 1.351876 0.743857 1.126350 0.329744 1.311156 1.741855 0.539284 0.734174 1.444281 0.266389 1.812979 0.182870 1.519402 1.556083 0.123915 0.153347 0.837477 0.626772 -0.362496 0.925116 0.876296 1.110977 1.503293 1.058612 -0.070260 0.265042 0.422215 0.314116 -0.020861)
- 9.003854 #(0.000000 1.607344 0.892265 0.658677 0.440184 1.548952 1.382460 1.054968 0.705954 -0.043646 1.083307 0.683663 1.693069 0.451943 1.636402 1.467412 0.462241 1.344346 0.064404 0.414208 0.166946 1.615183 0.382419 0.155434 0.042469 -0.002168 1.824986 -0.110040 1.103935 0.265094 0.532862 0.473766 1.770160 0.123094 -0.177669 1.845062 0.107709 0.921891 1.017796 -0.292281 -0.222922 0.287106 1.608775 0.561016 0.599846 1.105062 -0.130128 1.756711 0.900686 0.083470 0.890374 1.722592 0.777870 1.347208 0.731816 1.123753 0.337242 1.316821 1.739575 0.520359 0.720342 1.455696 0.238930 1.823965 0.178529 1.541756 1.552063 0.139634 0.163404 0.851490 0.618207 -0.343147 0.943811 0.877420 1.088040 1.514631 1.073488 -0.070807 0.252963 0.446042 0.320066 -0.036723)
- 8.991395 #(0.000000 1.606074 0.890427 0.664236 0.456617 1.553228 1.389226 1.054553 0.702312 -0.038861 1.081273 0.673084 1.695849 0.456458 1.633655 1.474714 0.459837 1.346377 0.054643 0.411012 0.179369 1.607511 0.371697 0.173120 0.031834 -0.008282 1.817860 -0.118531 1.112288 0.262167 0.525921 0.474600 1.766086 0.122614 -0.171400 1.838280 0.091899 0.908972 1.034003 -0.287228 -0.224122 0.269242 1.601891 0.579054 0.611390 1.087147 -0.132985 1.741500 0.912423 0.080303 0.891983 1.739869 0.794387 1.347677 0.736422 1.152064 0.352260 1.324353 1.740187 0.510087 0.720640 1.473055 0.234255 1.827317 0.175209 1.560509 1.524570 0.153564 0.192583 0.861676 0.625023 -0.354545 0.966452 0.867917 1.078067 1.531550 1.070608 -0.063745 0.251424 0.440039 0.331772 -0.039535)
+ 8.956328 #(0.000000 1.643417 0.930734 0.689653 0.459028 1.593622 1.395371 1.072996 0.631861 -0.043633 1.099666 0.636948 1.712104 0.476746 1.634771 1.484565 0.482834 1.313999 0.039060 0.427177 0.212554 1.582973 0.394395 0.162584 0.034735 -0.034150 1.846695 -0.114756 1.176241 0.261099 0.544044 0.481753 1.753535 0.147113 -0.077837 1.852751 0.089577 0.941708 1.042049 -0.248672 -0.246388 0.240284 1.601806 0.604079 0.624166 1.095407 -0.116063 1.788283 0.927447 0.114648 0.912323 1.773105 0.731730 1.312518 0.797511 1.130357 0.376900 1.293915 1.747093 0.588107 0.704443 1.456343 0.248930 1.811513 0.132706 1.579869 1.572933 0.088710 0.236497 0.885229 0.558925 -0.346604 0.954554 0.842875 1.065506 1.508473 1.080853 -0.118242 0.320826 0.502405 0.287435 -0.040363)
+ 8.948791 #(0.000000 1.646364 0.928529 0.693440 0.460887 1.595958 1.394805 1.076015 0.626935 -0.035751 1.099515 0.631936 1.715216 0.483859 1.634990 1.488401 0.486827 1.309023 0.037548 0.428335 0.214774 1.578527 0.387809 0.163045 0.041178 -0.034336 1.843570 -0.112925 1.175887 0.260055 0.544850 0.480701 1.747090 0.142986 -0.070411 1.857869 0.091286 0.937248 1.043072 -0.244613 -0.249110 0.236774 1.589347 0.603067 0.625259 1.093170 -0.117445 1.790187 0.921893 0.118787 0.918942 1.774733 0.728860 1.304744 0.805082 1.133332 0.377366 1.284792 1.748077 0.586947 0.701690 1.453035 0.246783 1.819209 0.129644 1.576061 1.568360 0.088126 0.240960 0.884392 0.556728 -0.346198 0.948937 0.841328 1.063756 1.503795 1.073970 -0.121108 0.318456 0.509518 0.288220 -0.040604)
)
;;; 83 odd -------------------------------------------------------------------------------- ; 9.1104
@@ -1990,7 +2019,9 @@
11.795211509729 #(0 0 1 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1)
11.732900669843 #(0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1)
- 9.160905 #(0.000000 0.862839 1.093350 0.288304 0.206192 1.581898 1.081183 0.613408 1.492034 0.182899 0.924989 0.894752 0.501219 0.418071 1.606965 0.997457 0.633424 1.290865 1.788114 1.434123 0.741270 -0.245668 0.841782 0.111312 0.034293 -0.064350 0.460600 0.383630 1.349164 0.596254 1.641279 0.108347 1.564074 1.416170 1.892762 0.487657 1.470252 0.190905 -0.036926 0.141804 -0.323860 1.824041 0.661005 1.268274 0.034205 0.678172 0.029648 0.958082 0.700546 0.743986 0.962774 0.705124 0.057430 1.285675 1.556465 0.848976 1.255155 0.860681 0.086088 0.641504 0.592890 0.704671 0.997963 -0.117153 1.706272 -0.016715 0.627402 0.676893 1.793930 0.504132 0.042861 1.315087 1.238597 0.072382 0.977091 0.573573 1.160652 0.710207 0.750327 0.853281 0.806604 1.775944 0.138603)
+ 9.107370 #(0.000000 0.835270 1.070766 0.324594 0.180708 1.521614 1.066314 0.570971 1.544859 0.209148 0.988385 0.858708 0.495870 0.425352 1.594189 1.008851 0.620310 1.317094 1.729720 1.466155 0.660122 -0.274303 0.854003 0.212032 0.062313 -0.122891 0.463347 0.374442 1.370005 0.619558 1.616310 0.054785 1.609815 1.386199 1.949023 0.509205 1.445269 0.239075 -0.011744 0.173754 -0.253878 1.826857 0.652062 1.228839 0.039399 0.642567 -0.003758 1.030309 0.749010 0.712883 1.005339 0.826674 0.072984 1.286902 1.640088 0.907258 1.203641 0.823959 0.062483 0.744552 0.606129 0.682347 0.915180 -0.148703 1.749999 0.015959 0.625552 0.690874 1.836891 0.542447 0.107816 1.289411 1.325541 0.025501 0.995863 0.569416 1.194610 0.751797 0.840909 0.832618 0.816495 1.720996 0.199928)
+ 9.105408 #(0.000000 0.837905 1.072904 0.324368 0.184295 1.517304 1.069122 0.570319 1.545392 0.210606 0.986292 0.862289 0.498149 0.423639 1.599582 1.011412 0.624482 1.318296 1.727190 1.469788 0.663108 -0.277095 0.851493 0.213180 0.063053 -0.121885 0.467512 0.374048 1.370758 0.615862 1.620039 0.051967 1.610885 1.386455 1.953047 0.509459 1.449382 0.234978 -0.008785 0.166382 -0.257114 1.831570 0.652824 1.226541 0.039884 0.644892 -0.008557 1.034498 0.743282 0.715743 1.003139 0.825556 0.067494 1.288519 1.643253 0.907913 1.202416 0.818474 0.059978 0.749557 0.604237 0.682081 0.917032 -0.156287 1.745699 0.021442 0.625191 0.686611 1.840109 0.544796 0.107766 1.290472 1.326859 0.030333 0.992087 0.566603 1.200687 0.753756 0.836194 0.836363 0.819465 1.721461 0.195247)
+ 9.098442 #(0.000000 0.839572 1.074098 0.324921 0.180873 1.518224 1.071608 0.572848 1.544103 0.208707 0.988181 0.862080 0.497301 0.425505 1.602983 1.012766 0.625086 1.316448 1.725429 1.471562 0.661237 -0.273288 0.850910 0.216989 0.065921 -0.124476 0.473030 0.376843 1.370353 0.617187 1.623533 0.049665 1.611932 1.386692 1.955490 0.505504 1.447189 0.240009 -0.006708 0.166903 -0.255242 1.834944 0.654286 1.229426 0.040813 0.641985 -0.009213 1.031854 0.749665 0.718158 1.006079 0.824983 0.065384 1.285071 1.646733 0.911415 1.196057 0.818339 0.060266 0.752603 0.606354 0.685039 0.915633 -0.158850 1.743393 0.020574 0.625319 0.683486 1.837454 0.549326 0.109589 1.286323 1.331894 0.025378 0.994511 0.565370 1.200207 0.756063 0.841852 0.838865 0.818311 1.724021 0.197827)
)
;;; 84 odd -------------------------------------------------------------------------------- ; 9.1652
@@ -1998,7 +2029,7 @@
11.724502770898 #(0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
11.626023292542 #(0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
- 9.329769 #(0.000000 0.003216 1.940737 1.198434 1.869818 0.859094 0.517383 1.902229 1.806972 0.189941 0.477781 0.994512 1.950100 0.973915 1.748246 1.298185 1.103883 0.821182 0.605011 0.486249 0.606930 1.263509 1.548079 -0.404358 0.788042 1.808670 1.511690 0.572711 0.437411 0.829455 1.551441 0.316899 1.812885 1.949577 0.865540 0.246311 1.142214 1.588980 0.967948 1.265924 1.068277 1.810259 1.434939 1.094592 0.756949 0.691984 -0.012469 0.599595 0.613733 0.872724 0.181503 1.094709 0.340491 0.619787 0.315753 0.066526 1.005841 0.361510 1.134495 1.087039 0.780257 0.976391 0.307304 0.390798 1.035240 0.008916 -0.417078 0.440980 0.588677 0.298342 1.282057 0.942865 1.441503 1.429268 0.216105 1.212463 1.255405 0.188095 1.541628 1.878798 0.372860 1.091641 1.361748 0.418839)
+ 9.263173 #(0.000000 -0.016320 1.973184 1.169374 1.849875 0.832567 0.608967 1.871553 1.827386 0.123062 0.496102 0.959622 -0.000539 1.001472 1.802268 1.208691 1.121411 0.814397 0.608465 0.455541 0.606534 1.302086 1.563147 -0.460730 0.799467 1.757879 1.552438 0.510707 0.442904 0.879144 1.604210 0.335665 1.828810 1.881566 0.873701 0.210316 1.116186 1.555052 0.943600 1.271988 1.011573 1.731869 1.527478 1.060290 0.804706 0.634384 0.033383 0.652087 0.523407 0.863108 0.107650 1.095047 0.312794 0.568246 0.242147 0.054946 0.928314 0.432300 1.132718 1.048968 0.736860 0.984114 0.324606 0.311659 0.975292 0.025172 -0.470048 0.478237 0.522809 0.276511 1.248570 0.889811 1.428301 1.433484 0.259033 1.109021 1.287522 0.162643 1.450125 1.888807 0.347945 1.132503 1.380355 0.438804)
)
;;; 85 odd -------------------------------------------------------------------------------- ; 9.2195
@@ -2006,7 +2037,7 @@
12.309050256429 #(0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
11.829360154975 #(0 0 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
- 9.456234 #(0.000000 0.930469 1.891194 0.702240 0.285217 0.410739 1.630468 1.950077 0.156932 0.789145 0.017711 1.672493 1.618979 1.234322 0.577913 1.431751 0.004761 1.385570 1.828763 0.926713 -0.347880 1.398364 0.833037 1.237110 1.771477 -0.464186 0.888201 0.379527 0.754847 1.741788 1.550741 0.706268 0.921767 1.397439 1.095063 0.413820 1.522948 1.072840 1.745558 0.458662 -0.230477 1.655833 1.513952 0.694462 1.361976 1.238554 0.731096 1.380873 0.646573 0.374106 0.746327 0.248207 0.934042 1.075618 -0.215698 -0.096824 1.374528 1.487638 0.073036 1.807028 0.569443 1.646708 -0.047130 1.060384 0.350790 0.607643 0.998088 0.383558 -0.027303 -0.043997 0.457511 0.773501 1.300967 1.032349 0.283096 0.443679 0.355235 -1.855437 1.014013 1.058522 1.202068 0.600978 1.312913 1.361618 0.124517)
+ 9.353589 #(0.000000 1.062584 1.974507 0.608443 0.359786 0.411786 1.661456 -0.028715 0.210937 0.873240 -0.059884 1.657858 1.581829 1.238215 0.536159 1.437517 -0.031102 1.293736 1.866925 0.834699 -0.375618 1.277667 0.903381 1.153848 1.876213 -0.444848 0.884017 0.277843 0.770722 1.710188 1.570201 0.627960 0.896388 1.326751 1.064012 0.342962 1.448176 0.981887 1.749804 0.392723 -0.401994 1.686496 1.545365 0.549190 1.373092 1.132788 0.680954 1.375558 0.681657 0.407214 0.845644 0.198826 1.051408 1.109983 -0.149865 0.022369 1.355476 1.413985 0.178634 1.766333 0.534910 1.614543 -0.059502 1.003867 0.316441 0.599270 1.040099 0.395452 0.092270 0.153942 0.548461 0.755956 1.371414 1.087311 0.323880 0.319537 0.299601 -1.847088 1.101468 1.070178 1.120305 0.670136 1.280313 1.530576 0.114287)
)
;;; 86 odd -------------------------------------------------------------------------------- ; 9.2736
@@ -2014,7 +2045,7 @@
12.274354058598 #(0 0 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
12.140432277993 #(0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
- 9.489021 #(0.000000 0.666000 0.434248 1.692671 0.072335 0.748078 0.569695 1.191443 0.555640 0.166979 -0.011898 0.201056 0.518971 0.412654 0.623620 0.020870 1.668734 -0.405937 0.330817 0.263651 1.384757 1.651626 1.454315 0.307276 0.667959 1.742210 0.675133 0.974997 0.910183 -0.028749 0.899226 0.976617 1.329167 -0.028836 1.571732 0.969036 0.352467 0.486544 0.239373 0.306606 1.804736 1.177937 1.775645 1.866512 -0.073488 1.206101 0.450480 0.967038 1.386002 0.696338 1.215838 -0.029130 1.060327 0.481961 -0.033811 1.571242 1.853636 0.963308 1.497667 1.170833 -0.068660 0.594697 1.293885 1.790470 1.628644 0.414903 -0.077193 0.347519 0.999039 0.063124 0.202141 0.842236 0.201500 0.463521 0.212201 1.761255 0.865282 1.256539 1.242152 0.571612 1.861087 0.757361 0.074392 1.987601 0.989447 0.559222)
+ 9.398907 #(0.000000 0.705469 0.427835 1.637982 0.061577 0.723983 0.775333 1.213958 0.673955 0.191237 -0.034643 0.369731 0.647523 0.480344 0.747244 -0.053932 1.740985 -0.425730 0.395850 0.272203 1.347231 1.653055 1.447653 0.338387 0.525490 1.701418 0.588177 0.945880 0.835314 -0.048045 0.835140 0.985577 1.412670 0.148280 1.484922 0.880897 0.366136 0.559943 0.254912 0.327286 1.856098 1.156292 1.693251 1.752343 -0.272463 1.243030 0.420624 0.931525 1.429965 0.611611 1.233825 -0.144495 1.068145 0.667757 -0.026517 1.562509 1.907152 0.911441 1.440415 1.183903 -0.108879 0.528208 1.251635 1.847758 1.600133 0.414245 0.059739 0.413562 0.879645 0.159609 0.371270 0.815080 0.281107 0.553620 0.148459 1.708116 0.886074 1.241416 1.194420 0.554734 1.849850 0.704675 0.063044 -0.036534 1.044823 0.566389)
)
;;; 87 odd -------------------------------------------------------------------------------- ; 9.3274
@@ -2022,7 +2053,7 @@
12.481803894043 #(0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 0 0 0 0 0 1 0 1)
11.937030388359 #(0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1)
- 9.465752 #(0.000000 1.330116 0.792124 1.376934 0.642800 1.395127 0.603695 1.032924 0.988345 0.868670 0.136131 0.140244 1.219293 0.753959 0.716996 -0.208369 0.302258 0.534955 0.730217 1.364422 1.812355 0.226067 1.129469 0.483354 0.891993 0.663260 1.580800 1.405361 0.780750 0.843914 0.971437 1.599589 0.005220 0.943497 0.513444 0.473200 0.231621 0.799383 1.529853 1.659436 1.183515 0.925693 0.694273 0.377330 0.628833 0.347180 -0.014242 0.187287 1.135916 0.132966 0.844210 1.264334 -0.411297 1.329964 0.316637 -0.317473 1.185889 0.560555 -0.067387 1.479722 0.447424 1.848958 0.238168 1.815520 0.824643 1.439895 0.646994 -0.256276 0.028382 -0.588781 1.609979 0.435810 0.508720 1.292038 0.424760 1.148421 0.088194 0.288660 0.879623 0.302062 0.372008 0.664926 0.949381 1.208397 0.639652 -0.245856 1.180139)
+ 9.401467 #(0.000000 1.284004 0.784369 1.387463 0.594585 1.403798 0.619627 1.084772 0.963852 0.814530 0.106339 0.227008 1.231747 0.842795 0.694052 -0.291296 0.405925 0.569187 0.767739 1.358815 1.825672 0.200551 1.132871 0.480291 0.800280 0.608803 1.553239 1.365053 0.722494 0.856576 0.946966 1.591187 -0.059040 1.033606 0.474244 0.412313 0.136109 0.759312 1.576754 1.677523 1.162569 0.892982 0.713765 0.359716 0.651517 0.358747 -0.064433 0.133454 1.080119 0.154469 0.831139 1.144518 -0.565948 1.287001 0.300469 -0.328174 1.225022 0.501021 -0.039512 1.576506 0.418970 1.984225 0.200258 1.748909 0.768382 1.405825 0.669027 -0.283931 -0.075376 -0.636660 1.585905 0.363904 0.579985 1.231522 0.359706 1.078442 0.091968 0.210537 0.891673 0.243248 0.318340 0.696129 0.838218 1.272772 0.628451 -0.269209 1.151461)
)
;;; 88 odd -------------------------------------------------------------------------------- ; 9.3808
@@ -2030,7 +2061,7 @@
12.592202186584 #(0 0 1 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0)
12.128922775356 #(0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1)
- 9.557926 #(0.000000 0.644581 1.238697 1.578217 1.093549 1.439572 1.671306 0.538382 1.158057 1.011726 0.619785 0.241647 0.592694 0.296743 1.370965 0.400003 1.107692 -0.062436 -0.241230 1.214487 0.147317 -0.000657 0.941949 1.539770 0.927180 0.379800 0.921122 1.204804 0.617236 1.858566 1.546865 0.409961 0.603958 0.511829 1.834298 1.342621 -0.053536 0.671135 0.337619 1.564560 0.864069 0.789094 1.790547 1.789733 0.141735 0.283304 1.391074 0.944822 1.687751 0.192970 0.185601 1.132732 -0.165920 1.566597 0.857656 0.957944 1.658908 1.199569 -0.220279 1.207866 0.367534 0.054740 0.371883 1.350518 0.074726 1.098013 0.792809 0.642130 1.473120 0.553039 1.416600 -0.046488 1.029314 1.310674 1.090583 1.819997 1.581131 1.661352 1.641638 -0.316411 0.053750 0.419443 -0.064115 1.061606 -0.117181 -0.123808 1.669838 1.702382)
+ 9.374166 #(0.000000 0.683143 1.184346 1.603088 0.932241 1.495288 1.667150 0.438774 1.206520 1.113628 0.640173 0.163748 0.681157 0.335294 1.298404 0.448249 1.029206 -0.036684 -0.240776 1.391343 0.201134 -0.056881 1.009737 1.516185 0.930881 0.483971 0.921785 1.240958 0.636868 1.834218 1.631346 0.596388 0.526080 0.594877 1.940642 1.315665 -0.042700 0.611697 0.305291 1.504152 0.784185 0.766276 1.802874 1.820106 0.043145 0.206121 1.398090 0.795809 1.759875 0.165211 0.225300 1.353262 -0.198378 1.618287 0.955837 0.943272 1.582833 1.189148 -0.462950 1.449064 0.416978 0.098372 0.381884 1.328909 0.077113 1.165026 0.925880 0.457446 1.327030 0.654601 1.331357 -0.042995 0.959468 1.203640 1.293054 1.843013 1.400333 1.489951 1.502059 -0.490348 0.120710 0.439928 -0.038327 1.002285 -0.127460 -0.108202 1.634599 1.683607)
)
;;; 89 odd -------------------------------------------------------------------------------- ; 9.4340
@@ -2039,7 +2070,7 @@
12.4725522995 #(0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0)
12.362 #(0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0)
- 9.550063 #(0.000000 0.093480 0.868847 0.194577 0.259096 0.792598 0.353270 1.245126 0.156659 0.755014 0.468091 -0.105729 0.495476 1.799533 0.940897 0.168334 0.146208 1.035118 1.512538 1.391107 1.074782 1.311976 -0.241315 1.634970 1.474167 1.208128 1.058980 0.425747 1.336591 1.415943 0.225696 1.415335 0.411934 0.592968 0.260340 1.820983 0.875224 -0.081726 0.305334 1.137434 0.640815 1.665136 0.972557 1.774263 0.817892 0.988473 1.417229 0.446759 0.018534 1.192229 1.168620 1.178959 1.368270 0.456334 0.293076 0.789189 1.089629 1.516403 1.758508 0.835089 1.413380 0.457523 0.643362 0.248065 1.221463 1.568304 -0.675084 1.426310 0.657060 1.297765 -0.334081 0.476095 0.552658 -0.122869 0.078723 1.006148 0.659075 1.777432 1.439789 0.942810 0.906717 0.941606 1.224464 1.635635 0.888388 -0.045794 0.267660 -0.182197 0.515826)
+ 9.377504 #(0.000000 0.054834 0.829530 0.145221 0.421266 0.764833 0.349149 1.212123 0.144398 0.742358 0.560343 -0.049216 0.476585 1.547515 1.010781 0.255859 0.279279 1.116407 1.468245 1.321424 1.212072 1.200524 -0.193772 1.629519 1.436179 1.186230 1.116370 0.535144 1.278945 1.437979 0.174974 1.401957 0.493331 0.557237 0.175215 1.884868 0.920494 -0.028641 0.379436 1.204356 0.686946 1.785681 1.065198 1.989751 0.879149 1.028614 1.434442 0.552236 -0.140257 1.285831 1.125671 1.255905 1.378880 0.310793 0.378475 0.763354 1.062858 1.712477 1.689018 0.917160 1.316803 0.357480 0.638064 0.318895 1.050348 1.477982 -0.707041 1.294279 0.603067 1.218237 -0.316345 0.400534 0.503430 -0.088968 0.161285 1.133055 0.760213 1.924600 1.332651 0.887901 0.901255 0.893994 1.101471 1.646197 0.864775 -0.068467 0.313848 -0.207240 0.470312)
)
;;; 90 odd -------------------------------------------------------------------------------- ; 9.4868
@@ -2047,7 +2078,7 @@
12.44910044225 #(0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 1)
12.309 #(0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 0 0 1)
- 9.625570 #(0.000000 0.681094 -0.043012 0.876711 0.732427 1.902904 0.019836 1.077425 1.129951 -0.065722 1.009699 1.962492 0.951458 -0.032409 0.495790 0.326233 1.071520 0.081659 0.718367 0.805347 1.315266 0.606180 -0.164554 1.659468 0.734005 0.282450 1.415897 0.656630 0.224131 0.551732 0.679949 1.467134 1.093288 1.071862 1.169112 0.878380 -0.266980 0.839671 1.404541 0.223187 0.713414 0.715606 0.647703 0.897648 1.731363 1.628138 1.549436 1.047040 1.852095 1.497509 1.051783 0.882482 1.144373 1.252366 1.456748 0.413572 0.680156 0.246909 0.771702 0.632835 0.131384 1.030117 1.289836 0.168094 0.427970 0.865222 0.866813 1.875226 1.000330 0.149729 0.130036 0.068101 1.324911 1.483993 1.788018 0.406140 0.246104 1.892877 0.788639 0.097166 0.541615 0.079124 1.521714 1.308269 0.550719 0.941534 1.185039 0.354568 0.559821 -0.322278)
+ 9.510523 #(0.000000 0.758042 -0.054694 0.811880 0.761526 1.962723 -0.083244 1.053429 1.104472 -0.109216 0.937640 1.934646 0.897694 -0.126299 0.506296 0.359410 1.053820 0.091346 0.762136 0.742704 1.389725 0.618145 -0.219023 1.630783 0.754322 0.266215 1.441909 0.620122 0.234893 0.616837 0.660831 1.498764 0.998798 1.035328 1.113532 0.821990 -0.270132 0.795919 1.445665 0.244993 0.731299 0.815056 0.735003 0.920760 1.770960 1.628052 1.555348 1.090727 1.750098 1.453904 1.038033 0.772409 1.025806 1.301509 1.506752 0.390104 0.632396 0.358268 0.682164 0.608589 0.147662 1.018801 1.379351 0.167187 0.413327 0.954108 0.835458 1.961105 1.093313 0.141085 0.089670 0.098091 1.305209 1.482012 1.810606 0.378853 0.174115 1.905916 0.832232 0.069140 0.579561 0.064074 1.474377 1.386413 0.673245 0.953543 1.240323 0.412327 0.521503 -0.323035)
)
;;; 91 odd -------------------------------------------------------------------------------- ; 9.5394
@@ -2055,14 +2086,14 @@
12.7095674403 #(0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
12.351367950439 #(0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0)
- 9.618196 #(0.000000 0.085276 0.908700 0.984518 1.595631 -0.119425 1.017027 0.115634 0.561726 0.254322 0.890041 0.143619 -0.009034 1.001813 1.032163 0.137795 1.314249 1.412543 0.089180 1.682826 0.712213 0.266045 -0.081596 0.211244 1.188030 0.508724 1.576638 1.396419 1.557241 1.426585 0.078032 0.546387 1.343095 1.853527 0.842320 0.333723 1.054686 1.510776 1.020082 0.557510 1.019841 0.963459 -0.039565 1.479292 0.883137 1.389496 1.582648 0.578573 0.260547 1.034640 1.224754 0.359382 0.358388 0.101197 0.390820 0.789301 0.864651 -0.066624 1.232521 1.148327 0.779529 0.735318 0.533073 0.953659 0.661855 1.599345 0.941292 1.333583 0.512566 0.903584 -0.080361 1.880389 1.029247 -0.151016 0.729144 0.901484 1.277984 1.731063 1.425061 0.916485 -0.071559 1.210918 1.728823 1.074875 1.252437 0.800574 1.526748 0.539443 0.314736 0.346429 0.177413)
+ 9.517071 #(0.000000 0.116931 0.970464 0.965784 1.786481 -0.104910 1.031285 0.179536 0.745209 0.251101 0.791489 0.042267 0.013101 0.973355 1.079119 0.142745 1.329378 1.291486 0.057536 1.710925 0.765837 0.120948 0.005924 0.244411 1.228533 0.572040 1.491525 1.466867 1.685676 1.529194 -0.014875 0.591882 1.207272 1.749940 0.671185 0.269410 1.026054 1.556473 0.986325 0.698807 1.002196 0.819681 -0.094679 1.575348 0.989949 1.356162 1.541673 0.638391 0.478663 1.062002 1.211443 0.321970 0.307459 0.083077 0.547336 0.849975 0.855714 -0.135740 1.397339 1.227185 0.874884 0.696862 0.523700 0.957928 0.774798 1.746360 1.000622 1.415682 0.490824 0.948885 -0.042497 1.842632 1.048212 -0.194279 0.706176 1.137567 1.172946 1.669103 1.348792 0.824941 -0.178877 1.188802 1.721503 1.038427 1.175879 0.619800 1.588361 0.422945 0.279855 0.380800 0.167005)
)
;;; 92 odd -------------------------------------------------------------------------------- ; 9.5917
#(92 12.42142723142 #(0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1)
12.280749613899 #(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1)
- 9.729486 #(0.000000 1.285540 1.198953 0.961460 0.542964 1.800103 0.216990 1.719975 0.679366 0.844056 0.671378 0.409515 -0.175258 0.962695 1.446354 1.019513 0.365008 1.899984 0.655768 1.420568 0.027232 1.682924 0.087949 -0.324716 0.683839 0.864210 0.961005 0.488576 0.994178 1.284115 0.492444 1.228113 1.199960 0.033325 0.248943 1.682303 0.684547 0.081988 1.504948 0.827236 0.430317 1.247614 0.242630 1.209360 0.989495 0.705128 1.713800 1.500765 1.012696 0.686711 0.163126 1.373507 0.638772 0.857698 1.103256 1.587532 0.047297 0.547702 1.513645 -0.047747 0.434687 1.144614 1.307747 0.828783 1.440530 1.032224 1.192681 0.693645 0.666597 1.110465 1.586897 0.939938 1.384239 0.879154 0.961144 -0.066034 0.925939 1.678905 1.733454 1.712482 0.259232 0.600794 0.740451 1.439813 0.501813 0.286845 0.122845 0.459503 0.132307 -0.104664 1.851387 0.656786)
+ 9.634525 #(0.000000 1.247446 1.319207 0.950587 0.452425 1.876206 0.264256 1.666127 0.609610 0.925207 0.662099 0.333582 -0.153680 0.881276 1.494863 0.970017 0.309421 1.936947 0.649117 1.350210 0.130162 1.705484 0.180095 -0.329571 0.688864 0.823313 0.836461 0.550355 1.015927 1.250913 0.470321 1.158648 1.136391 0.068808 0.276366 1.685759 0.747571 0.029705 1.438875 0.797500 0.408569 1.171600 0.281505 1.247889 1.007486 0.704625 1.577580 1.467729 1.032037 0.625462 0.048570 1.324714 0.603308 0.834711 1.050809 1.566897 0.024238 0.603450 1.645371 -0.014035 0.366682 1.130775 1.449842 0.781178 1.467666 1.076926 1.054439 0.698728 0.588754 1.190422 1.575009 0.895428 1.292113 0.793515 0.876154 -0.102684 0.885130 1.735654 1.667490 1.792386 0.304239 0.539130 0.807323 1.407339 0.523480 0.332608 0.151888 0.484842 0.086933 -0.044276 1.851457 0.611953)
)
;;; 93 odd -------------------------------------------------------------------------------- ; 9.6437
@@ -2071,14 +2102,14 @@
12.587555885315 #(0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 0 1 1 0 1 0 1 1 1 1)
12.403578299298 #(0 1 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1)
- 9.896614 #(0.000000 1.375564 1.279294 0.618864 -0.040637 -0.180841 0.980325 1.236542 0.935778 0.945995 0.404716 1.000170 0.850866 1.774839 1.626094 1.353662 0.533611 1.363613 1.668198 1.136375 1.717253 0.218224 -0.221531 1.639788 0.731888 1.166772 0.490048 0.539534 0.156876 1.456676 1.521818 -0.367150 -0.053045 0.379654 0.016213 0.878656 -0.023653 0.525472 0.242668 0.097238 -0.071879 0.963776 0.285267 1.787978 1.497344 -0.047182 -0.087494 0.749770 1.888401 -0.029868 1.745724 0.837491 -0.205558 0.642811 0.859763 1.479156 0.314222 1.344782 1.779829 0.420270 0.808221 1.182515 1.613408 1.854166 1.065281 1.372878 1.049661 1.763338 0.730628 1.389571 0.355818 0.046159 1.108831 0.381073 0.218581 0.676444 -0.194520 1.431384 0.094376 0.088379 0.963645 0.950189 1.558848 0.870495 1.429066 1.163170 1.528660 1.795523 0.732557 0.103504 1.315003 1.457191 1.081680)
+ 9.822547 #(0.000000 1.397907 1.230130 0.668638 -0.127925 -0.166071 1.012709 1.295178 0.909842 1.030492 0.368243 0.926136 0.788893 1.839950 1.499009 1.463814 0.506359 1.242952 1.719331 1.096963 1.614923 0.175641 -0.142982 1.551626 0.788085 1.193027 0.525508 0.486577 0.184534 1.406102 1.517136 -0.333528 -0.081708 0.236483 -0.114236 0.947467 -0.082448 0.522091 0.226532 0.132740 -0.032060 0.909086 0.249207 1.726365 1.576513 -0.072367 -0.201191 0.697267 1.891195 -0.005393 1.825586 0.797124 -0.173159 0.701413 0.955565 1.408674 0.345171 1.292886 1.681852 0.422694 0.732385 1.186514 1.749761 1.855408 1.239998 1.430283 0.943961 1.773486 0.757919 1.438537 0.320533 0.100790 1.069439 0.407057 0.215010 0.731047 -0.201736 1.410334 0.140587 0.117434 0.862483 0.934566 1.627772 0.884522 1.392359 1.156673 1.559646 1.771905 0.825475 0.161152 1.312555 1.398735 0.942213)
)
;;; 94 odd -------------------------------------------------------------------------------- ; 9.6954
#(94 12.792093608509 #(0 1 1 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1)
12.789479876738 #(0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1)
- 9.981215 #(0.000000 1.446775 0.852391 0.885349 0.619952 0.682733 1.117147 0.421420 0.837038 0.343684 0.789980 0.576493 1.472358 1.784598 0.625810 -0.325945 1.336142 0.741427 1.021414 0.042998 0.935510 -1.825758 0.494225 1.457995 0.176545 0.011408 0.577961 1.307908 0.019996 0.345202 1.549905 0.246641 -0.100440 0.495400 1.190386 0.157716 0.550178 0.465111 1.290009 1.092483 0.851143 0.839357 0.781613 0.818905 0.963675 0.805610 -1.913712 0.000307 1.160106 0.225606 0.788435 0.310311 -0.065879 0.474473 1.411518 1.922760 0.183203 0.762082 0.643243 0.288494 1.776261 1.338461 0.754453 1.468051 -0.008241 1.424508 0.563818 1.034118 1.091810 1.866418 0.074631 1.604710 -0.073837 1.528895 0.357169 0.443813 0.862544 1.501150 1.071485 -1.927086 1.712123 1.303318 -0.023481 1.323548 1.573185 0.020282 0.882700 0.716927 0.578943 1.052475 -0.069819 1.537088 1.438403 0.732174)
+ 9.926277 #(0.000000 1.408236 0.855509 0.882774 0.630503 0.642086 1.130310 0.416741 0.874497 0.356241 0.789438 0.547290 1.486176 1.720832 0.643867 -0.339645 1.373807 0.730889 0.939196 0.040518 1.036344 -1.802189 0.521604 1.556687 0.175360 0.074306 0.644538 1.308330 -0.002342 0.396875 1.519031 0.243990 -0.131487 0.582258 1.212364 0.129075 0.583055 0.463612 1.296247 1.060621 0.927032 0.844809 0.785386 0.841503 0.978899 0.874850 0.057548 -0.064850 1.155018 0.218260 0.773815 0.339885 -0.140192 0.434056 1.362180 -0.021382 0.214020 0.814343 0.611888 0.176243 1.669842 1.369627 0.692350 1.416748 -0.047682 1.437737 0.546148 1.050339 1.110134 1.887185 0.112070 1.656797 -0.097977 1.581545 0.369988 0.371235 0.861004 1.518383 1.089170 -1.913009 1.767710 1.280715 -0.090192 1.300752 1.568334 0.014890 0.875429 0.709139 0.559907 1.104174 -0.096583 1.584003 1.448777 0.763876)
)
;;; 95 odd -------------------------------------------------------------------------------- ; 9.7468
@@ -2087,7 +2118,7 @@
12.858592033386 #(0 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0)
12.575266058635 #(0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 0 0)
- 9.831615 #(0.000000 1.294313 0.030358 -0.462559 1.674909 1.489397 0.975537 1.110583 1.374932 0.365413 0.963868 1.300827 1.862824 1.127081 0.641565 0.982380 0.261862 0.317330 0.298200 1.211803 0.220399 1.575598 1.169579 0.387004 0.764569 0.233379 0.203236 0.834029 1.493899 1.269749 0.603221 0.196881 0.339078 1.755217 0.925503 1.105868 0.027348 0.644796 1.418753 1.150982 0.851163 1.877895 1.130655 0.861272 0.673341 0.394430 1.720410 1.277434 1.164733 1.431525 0.034784 0.629172 0.736096 1.113409 0.779268 1.490790 -0.044261 0.124778 -0.396202 1.743382 0.933864 -0.189661 0.967573 -0.185810 1.124329 -0.118876 0.870934 1.434447 0.080500 0.187777 1.170853 1.040326 0.245641 0.854448 0.658513 0.804378 0.764637 1.129514 1.366099 1.493594 -0.032492 1.358103 1.837426 1.128267 -0.240021 -0.267972 1.242063 0.460729 1.402849 1.143393 0.457080 0.051005 0.973855 1.064859 0.080585)
+ 9.766551 #(0.000000 1.305371 0.072105 -0.379317 1.644169 1.509707 0.879319 1.133990 1.484710 0.349362 1.012468 1.377372 1.792175 1.147321 0.643214 0.986769 0.284981 0.281992 0.352619 1.195819 0.156649 1.657724 1.090923 0.339412 0.735766 0.208052 0.110018 0.847498 1.401058 1.299427 0.616564 0.217961 0.327468 1.756609 0.862846 1.045424 0.106023 0.597053 1.438389 1.196689 0.828739 1.785055 1.131191 0.847919 0.771617 0.402166 1.698963 1.235833 1.051641 1.456541 0.145180 0.638130 0.742197 1.071565 0.853311 1.619762 -0.126568 0.081526 -0.366906 1.701624 1.001601 -0.194031 1.100553 -0.103693 1.147626 0.037573 0.875820 1.501720 0.078242 0.085548 1.195959 0.998398 0.261973 0.961143 0.661391 0.879954 0.745535 1.142076 1.364642 1.539562 0.066375 1.431239 1.915804 1.186098 -0.163350 -0.299812 1.287124 0.464752 1.359648 1.187932 0.548102 -0.071507 0.994302 1.030334 0.091644)
)
;;; 96 odd -------------------------------------------------------------------------------- ; 9.7980
@@ -2096,7 +2127,7 @@
12.956554412842 #(0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 0 0 1 1 0)
12.803173065186 #(0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 1 0)
- 9.904723 #(0.000000 0.580582 1.536449 0.358799 0.155852 0.229705 1.080879 0.270880 0.270509 -0.008917 0.500684 1.867755 0.664105 0.850106 1.368579 0.169196 0.384275 0.424741 0.737010 -0.006234 0.968053 -0.125586 0.576856 -0.138340 0.355537 1.256605 1.489923 0.372735 0.625488 0.207073 0.433945 1.368772 1.756154 1.513888 1.203659 0.586303 0.885127 0.048942 0.990985 -0.105860 1.701540 1.827646 0.220925 0.374747 0.502799 -0.065673 0.672046 0.896986 1.692246 0.769111 0.637789 0.622119 1.411200 1.143610 1.773433 0.871468 1.733562 1.312089 0.622892 0.746855 1.009704 1.094748 0.685255 -0.011357 0.220483 -0.376888 1.218153 0.420591 0.643204 0.619141 1.403560 0.932712 1.244874 0.129907 0.215436 1.160385 1.721524 -0.046065 0.605505 0.198594 1.532001 -0.252823 1.496256 1.427990 1.568057 1.209040 -0.010497 1.451584 0.821691 0.413553 1.636792 0.766417 0.323739 1.853538 0.134856 0.838140)
+ 9.848509 #(0.000000 0.532299 1.551561 0.277924 0.111472 0.262158 0.979774 0.169100 0.326655 -0.015235 0.573742 1.898393 0.651227 0.946335 1.346372 0.112448 0.303472 0.455385 0.745914 -0.004552 0.846126 -0.145122 0.609423 -0.144150 0.338604 1.304191 1.465712 0.375141 0.580068 0.185382 0.362862 1.357391 1.829181 1.535355 1.239897 0.654227 0.787708 0.062126 1.036184 -0.136954 1.656906 1.855309 0.148835 0.366962 0.473220 -0.089206 0.687423 0.836314 1.711478 0.770922 0.570067 0.591691 1.406196 1.131478 1.817338 0.824578 1.734648 1.268754 0.618486 0.695930 1.041795 0.985922 0.568895 0.054591 0.298505 -0.365288 1.210457 0.453510 0.692872 0.602675 1.441808 0.916229 1.250730 0.151859 0.275531 1.174411 1.750829 0.014065 0.707742 0.253193 1.489647 -0.383903 1.412445 1.456166 1.488345 1.274547 -0.062568 1.518447 0.802217 0.484473 1.652296 0.801542 0.288020 1.801701 0.185648 0.889189)
)
;;; 97 odd -------------------------------------------------------------------------------- ; 9.8489
@@ -2104,7 +2135,7 @@
12.954301727663 #(0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0)
12.837450993031 #(0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1)
- 9.986871 #(0.000000 0.399639 1.501185 0.024007 -0.098611 1.413884 0.270204 1.210848 1.609163 0.515705 1.657848 0.118322 0.728242 1.040335 1.920617 1.022855 0.748722 -0.324583 0.065629 0.743464 0.370954 0.965139 0.581582 0.771898 0.557355 0.672406 0.342074 0.648799 1.479220 0.118446 -0.081406 1.611547 1.810063 0.363602 1.372738 1.222246 0.221165 0.365965 0.660135 0.593395 1.390040 -0.162155 -0.328932 1.766586 0.231560 1.665506 0.540538 1.826768 -0.085426 -0.245202 1.609321 0.534871 1.498346 1.214192 0.694212 1.955516 1.614176 0.964024 -0.044633 0.124200 0.284448 0.644515 1.057763 -0.044514 0.189328 1.722397 0.672896 -0.045940 0.689812 0.532068 0.536333 0.797105 1.707042 1.597261 0.947371 0.788835 0.094942 -0.109313 1.262854 1.651047 0.628356 0.376129 1.272347 1.786773 1.674196 0.859937 0.339075 0.762496 1.965864 0.601698 0.544636 1.032373 1.524466 0.888139 1.083054 0.679584 -0.034267)
+ 9.908417 #(0.000000 0.431077 1.515482 0.054320 -0.083060 1.485605 0.284339 1.278973 1.578470 0.517197 1.647412 0.190782 0.762927 0.965430 1.916437 0.969768 0.720572 -0.331541 0.044205 0.743759 0.293286 0.923233 0.598354 0.782102 0.583413 0.678205 0.319384 0.637984 1.466597 0.130734 -0.141766 1.616943 1.791399 0.410783 1.370469 1.176646 0.197182 0.372771 0.580596 0.537403 1.359190 -0.196138 -0.323700 1.708294 0.219663 1.704787 0.532203 1.850438 -0.114427 -0.188949 1.638869 0.545226 1.457448 1.226960 0.724808 1.940971 1.667443 0.960042 -0.004518 0.107150 0.277340 0.648929 1.149626 -0.049493 0.215509 1.729136 0.662507 -0.010818 0.665784 0.560313 0.538803 0.867756 1.720020 1.653110 0.990133 0.727693 0.128193 -0.155102 1.199834 1.697761 0.636433 0.309768 1.364956 1.791368 1.621481 0.886892 0.411810 0.752734 -0.001318 0.587080 0.572992 1.025564 1.526296 0.844584 1.070604 0.597584 -0.110638)
)
;;; 98 odd -------------------------------------------------------------------------------- ; 9.8995
@@ -2113,7 +2144,7 @@
13.062 #(0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 1 1 0)
12.972 #(0 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0)
- 10.141147 #(0.000000 1.081352 0.793929 0.017152 -0.199315 1.099416 1.747207 0.902339 0.644825 -0.213075 0.002273 1.724173 -0.030043 1.431833 0.764299 1.522457 0.460738 0.701493 1.550089 -0.042712 1.110355 1.591491 1.163367 0.619215 0.137317 1.660430 1.591740 1.631728 1.588982 0.760026 0.223400 1.221651 1.207679 1.163545 1.322122 -0.140204 0.831524 -0.231013 0.777409 1.039914 0.367138 1.375441 1.189881 0.131341 1.210303 0.352275 0.727281 0.824286 0.394635 0.638461 0.962277 1.338782 1.522150 0.282614 -0.100347 0.191445 -0.243604 1.501958 0.352656 0.098374 0.114681 0.847553 1.120190 0.667561 0.970789 0.639129 1.646096 0.496233 0.435127 0.727483 1.387874 1.506532 0.682700 0.396598 1.055285 1.138241 0.690797 0.120185 -0.152070 1.128298 1.661767 0.623249 1.378656 1.105450 0.605387 0.730933 1.176192 0.090501 0.769514 0.224340 1.310566 1.701569 1.440735 1.822520 1.766927 0.295311 1.029522 1.572416)
+ 10.041603 #(0.000000 1.081951 0.822630 -0.045978 -0.256881 0.976452 1.712734 0.884845 0.581899 -0.176025 0.022020 1.701752 -0.036061 1.388371 0.731055 1.602331 0.458696 0.729181 1.545164 -0.123101 1.014594 1.556143 1.119676 0.549522 0.010363 1.665103 1.647772 1.564544 1.540723 0.671888 0.100539 1.209262 1.202402 1.198564 1.275535 -0.138844 0.834634 -0.087258 0.775755 1.032037 0.291503 1.394642 1.041705 0.132007 1.180888 0.351946 0.751443 0.900146 0.441935 0.637009 0.990149 1.283683 1.517584 0.345385 -0.231388 0.130309 -0.397039 1.542670 0.182385 -0.012664 0.118632 0.932819 1.073089 0.714960 0.910068 0.685325 1.708155 0.366179 0.367843 0.740304 1.342496 1.438555 0.680162 0.415164 1.030089 1.216253 0.752964 0.131560 -0.253153 1.122509 1.526881 0.614186 1.361597 1.180983 0.580253 0.708237 1.236459 0.044048 0.833144 0.243361 1.377357 1.611426 1.486604 1.791281 1.790226 0.227751 1.038879 1.572361)
)
;;; 99 odd -------------------------------------------------------------------------------- ; 9.9499
@@ -2122,7 +2153,7 @@
13.046126365662 #(0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 0 0 1)
13.000000000002 #(0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
- 10.200959 #(0.000000 0.478640 0.102211 1.505110 1.288582 1.028307 1.145791 0.170349 1.059707 0.675128 1.377147 1.669151 1.457992 1.492536 1.805954 0.438938 0.374847 1.218160 0.971057 0.101382 0.830370 -0.650005 1.070834 1.453620 1.361512 -0.047476 1.378134 1.246053 0.517983 1.424286 1.820952 0.078662 0.693681 -0.300898 0.739877 1.484313 0.160919 1.237921 1.054484 -0.127894 1.573348 0.484269 0.677100 1.391822 1.620503 0.481849 1.038408 0.568435 0.302625 0.116755 0.890158 -0.250473 0.427224 1.164698 0.028972 1.318267 0.299591 -0.264969 0.669839 0.453205 1.079239 0.883321 1.136876 0.837222 0.266952 0.925021 0.569236 0.259704 0.684251 0.572745 -0.131036 -0.199614 1.778959 1.244681 0.542499 -0.002422 1.834129 1.332519 0.450040 1.890318 0.459944 0.405663 1.427141 -0.293780 1.094192 1.710512 0.100009 0.633093 0.953511 1.057008 0.854046 0.718749 1.245654 0.561106 1.316644 0.123019 1.214232 1.346151 1.040734)
+ 10.117316 #(0.000000 0.480738 0.094999 1.487729 1.322270 1.025540 1.160121 0.131999 1.105208 0.706566 1.402344 1.658138 1.438662 1.520278 1.827075 0.425564 0.358262 1.212927 0.994260 0.119963 0.806067 -0.631582 1.089314 1.430212 1.341223 -0.046463 1.355553 1.211227 0.493326 1.452827 1.783695 0.133028 0.661082 -0.268151 0.685502 1.420668 0.102385 1.161665 1.006807 -0.115080 1.524930 0.527663 0.614478 1.370106 1.632264 0.479802 1.153895 0.605805 0.384979 0.155340 0.852045 -0.258582 0.435282 1.238019 0.070941 1.299425 0.271410 -0.239169 0.677967 0.427984 1.123482 0.969881 1.112348 0.874737 0.235582 0.886565 0.554918 0.235788 0.745853 0.642994 -0.160772 -0.168551 1.805419 1.273181 0.478336 -0.001441 1.904115 1.324684 0.518612 -0.035511 0.440382 0.292254 1.367185 -0.344900 1.092552 1.644593 0.151789 0.571107 0.991986 1.166765 0.940416 0.751498 1.158879 0.522421 1.326566 0.054784 1.195223 1.295297 1.072284)
)
;;; 100 odd -------------------------------------------------------------------------------- ; 10
@@ -2130,28 +2161,30 @@
13.24493912033 #(0 1 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0)
13.117680368039 #(0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0)
- 10.255455 #(0.000000 1.077883 0.826789 0.796069 0.466556 1.600384 0.562295 1.064577 1.682729 0.523018 1.383726 0.679107 -0.346278 0.487920 0.700851 1.054996 0.021813 0.023908 1.263695 -0.007061 0.703432 1.450961 0.013666 0.185905 0.399282 1.280776 0.614476 0.388936 1.779269 1.118732 1.004150 1.091928 0.313317 0.077879 1.492371 0.047685 1.485449 1.789904 -0.058961 1.698297 0.905745 1.543907 0.736797 1.617404 0.320467 0.748983 0.348507 0.119861 0.234828 -0.202293 0.629962 0.069516 0.853596 1.220718 0.380639 0.901832 0.252631 -0.409617 1.870987 0.503840 0.533509 0.370630 0.594000 -0.179844 0.742842 0.506435 1.631874 1.074927 0.523627 -0.360794 1.156847 1.613188 0.428407 0.505277 1.253676 1.434373 1.279515 0.175442 0.068266 0.346171 0.373336 0.216950 1.273905 1.736872 -0.218328 1.057827 1.795061 0.374228 -0.087678 1.345178 0.154957 1.466024 1.186215 1.037632 0.076107 -0.312447 0.729215 1.057263 0.941458 1.113962)
+ 10.230825 #(0.000000 1.024941 0.898750 0.722381 0.475307 1.535505 0.523315 1.113341 1.771270 0.523051 1.394219 0.680737 -0.280243 0.532731 0.796394 1.078708 0.170623 0.090284 1.307576 0.035015 0.750558 1.419655 0.047013 0.150595 0.289834 1.242517 0.606241 0.333290 1.832803 1.134900 1.005448 1.041529 0.426243 0.116098 1.482270 -0.007122 1.553676 1.766504 -0.121393 1.782972 0.875434 1.500324 0.686370 1.699664 0.369284 0.820049 0.316063 0.097620 0.332992 -0.144352 0.643975 0.144824 0.852860 1.173564 0.289978 0.956151 0.298542 -0.394363 1.908566 0.480701 0.463222 0.409345 0.662053 -0.056905 0.761239 0.594164 1.647334 1.140117 0.472329 -0.165645 1.195089 1.584012 0.391171 0.548044 1.260238 1.383102 1.316887 0.161189 0.186009 0.371309 0.383644 0.304180 1.262110 1.751683 -0.160225 1.046529 1.907404 0.520494 -0.138808 1.371784 0.211322 1.435242 1.256575 1.049378 0.249966 -0.425532 0.777676 1.056834 1.035417 1.130586)
)
;;; 101 odd -------------------------------------------------------------------------------- ; 10.0499
#(101 13.462674500314 #(0 1 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 0 1 1 1)
13.28250751675 #(0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1)
- 10.155997 #(0.000000 -0.077657 1.592490 -0.103377 0.954823 0.606200 1.369656 0.416637 1.410613 1.373958 0.635655 0.193995 0.227183 0.799393 0.984131 0.521308 1.532211 1.227788 0.484206 0.925669 0.486820 0.928775 1.156110 0.657649 1.828379 1.692056 1.708668 1.496193 0.318226 0.301224 0.224428 1.645147 0.870093 0.646998 0.365820 0.011112 0.971679 1.829550 1.619702 -0.382925 1.588972 0.111240 0.954459 -0.316474 1.841640 0.057334 -0.148360 0.563805 1.293568 0.272287 0.465042 1.859788 1.233586 1.747929 0.521942 0.888481 0.007405 0.221770 0.992416 1.708806 1.406046 0.879616 0.790649 1.285448 1.271779 0.333335 0.330584 -0.032003 -0.356972 0.479274 1.547916 1.760613 1.059578 -0.300137 1.510379 0.121752 -0.183884 1.240830 1.578668 1.349861 0.646054 0.996347 0.587200 1.447121 -0.096382 -0.110677 0.653835 0.258181 1.458149 0.563076 0.352097 1.354330 0.344652 0.746484 1.861182 1.214382 -0.141977 1.767246 -0.090070 0.510844 1.432903)
+ 10.046903 #(0.000000 -0.089763 1.523396 -0.106133 0.944573 0.620202 1.377647 0.439372 1.425613 1.356086 0.661032 0.135688 0.191846 0.890619 1.002619 0.445886 1.504230 1.207741 0.500700 0.903449 0.417390 0.884693 1.134860 0.560794 1.843279 1.731562 1.700889 1.523091 0.370999 0.245966 0.362748 1.563073 0.841907 0.694332 0.414231 -0.040376 0.893373 1.817813 1.672556 -0.431972 1.582816 0.030271 0.973669 -0.346984 1.831408 0.129311 -0.100660 0.613519 1.270960 0.324668 0.540290 1.876115 1.205386 1.778934 0.554608 0.939545 0.166026 0.268052 1.003884 1.657246 1.370522 0.967522 0.829124 1.322942 1.294043 0.335230 0.282187 -0.072124 -0.429651 0.473323 1.546141 1.779507 1.031407 -0.256904 1.489466 0.036539 -0.055417 1.246659 1.629869 1.393476 0.678594 1.087784 0.606406 1.490950 -0.059973 -0.098351 0.662146 0.348207 1.543479 0.641425 0.308024 1.412530 0.169371 0.720921 1.867977 1.297091 -0.212019 1.810737 -0.133402 0.444295 1.394429)
+ 9.997232 #(0.000000 -0.103212 1.550728 -0.110599 0.979368 0.639386 1.379969 0.410134 1.418129 1.383938 0.695047 0.166531 0.162436 0.866524 1.018737 0.426200 1.498479 1.196432 0.500174 0.916312 0.402881 0.920422 1.120259 0.573939 1.891738 1.738635 1.711957 1.549849 0.387975 0.225356 0.409585 1.535627 0.819706 0.732893 0.459626 -0.057073 0.872711 1.776059 1.695593 -0.439936 1.643523 -0.022818 0.929384 -0.404822 1.867331 0.106732 -0.070922 0.649782 1.236875 0.352861 0.541981 1.855009 1.192844 1.790359 0.545262 1.013566 0.213212 0.275280 0.979706 1.627273 1.366046 1.009915 0.809926 1.351043 1.267467 0.268879 0.305911 -0.110279 -0.464923 0.472048 1.529764 1.800241 1.015487 -0.280177 1.487234 -0.020377 0.004957 1.286004 1.644804 1.404665 0.699153 1.153573 0.597678 1.475982 -0.051817 -0.105043 0.674217 0.365450 1.531205 0.658106 0.279493 1.436280 0.096662 0.739081 1.888921 1.349760 -0.203939 1.841016 -0.163733 0.416219 1.379646)
+ 9.990273 #(0.000000 -0.103261 1.551689 -0.106365 0.982709 0.641488 1.374974 0.404901 1.419395 1.381273 0.692730 0.170389 0.163315 0.873466 1.021006 0.419164 1.505185 1.198052 0.500229 0.921687 0.402096 0.918041 1.123883 0.571960 1.893612 1.736056 1.719711 1.549107 0.391084 0.225297 0.411403 1.533444 0.820553 0.733262 0.456509 -0.060734 0.873892 1.777713 1.694072 -0.437061 1.636225 -0.024301 0.930406 -0.402962 1.873950 0.101804 -0.071018 0.651149 1.235664 0.344657 0.543747 1.848278 1.187686 1.784786 0.537188 1.010839 0.216202 0.270360 0.978834 1.621905 1.366680 1.012803 0.809752 1.350005 1.264731 0.274186 0.305176 -0.106456 -0.465317 0.469683 1.535517 1.800710 1.014885 -0.286733 1.486075 -0.015447 -0.000524 1.292544 1.638650 1.408795 0.692338 1.154279 0.593364 1.477675 -0.054927 -0.093958 0.675613 0.371872 1.539091 0.661045 0.277231 1.435201 0.092819 0.740928 1.890046 1.344568 -0.208154 1.843774 -0.156548 0.415849 1.386195)
)
;;; 102 odd -------------------------------------------------------------------------------- ; 10.0995
#(102 13.701085090637 #(0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0)
13.159336831147 #(0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0)
- 10.146906 #(0.000000 -0.206206 0.188280 0.174113 1.726740 1.498359 0.721964 0.512981 0.497527 1.156180 0.586910 1.631337 0.518233 0.528933 1.778111 0.926493 0.722410 1.297450 1.875334 0.255170 -0.229197 1.329815 0.685401 0.658202 1.034279 0.499316 1.797097 1.118280 0.017803 0.376453 1.045097 1.332084 1.299887 1.411728 0.578124 0.251904 0.166934 1.442332 1.736594 0.324707 0.220279 0.776703 0.278290 0.802923 1.096771 1.001517 1.575815 0.848350 1.345460 1.056988 0.122311 1.308867 0.505977 0.804254 -0.065840 1.297361 1.370248 -0.127941 1.118368 1.934489 1.612134 1.638788 0.861219 0.948403 0.542467 -0.128366 0.269546 0.424256 1.258206 -0.008164 0.946947 0.956644 0.563889 0.687743 -0.312271 0.122288 0.729798 0.543905 0.758584 -0.035745 0.454406 0.174859 0.489763 0.159120 0.591151 0.664707 0.140376 1.775134 -0.078695 1.034629 1.595817 0.038632 0.950072 0.966590 0.448509 1.579554 0.969180 0.536577 1.131153 1.892304 1.696526 0.650986)
+ 10.140793 #(0.000000 -0.229617 0.172026 0.112864 1.779965 1.514819 0.691339 0.534706 0.467893 1.143322 0.607869 1.640585 0.565378 0.496028 1.760060 0.913508 0.723881 1.276699 1.866275 0.295575 -0.254951 1.332486 0.684335 0.653959 1.047149 0.529057 1.799171 1.159538 0.067279 0.364036 1.044032 1.327131 1.318399 1.408496 0.574525 0.284252 0.179317 1.419136 1.670408 0.333457 0.195098 0.780697 0.255817 0.802170 1.078392 1.038637 1.589150 0.844458 1.354914 1.044204 0.136194 1.306618 0.550305 0.815017 -0.099393 1.275216 1.398323 -0.091960 1.086866 1.991480 1.524072 1.653941 0.907669 0.935918 0.540850 -0.182560 0.288266 0.443192 1.318796 0.005767 0.923023 0.920569 0.580737 0.730902 -0.310538 0.087187 0.713741 0.532155 0.771701 -0.048732 0.421255 0.202898 0.498034 0.164858 0.610957 0.624820 0.151230 1.763491 -0.103103 1.029934 1.596064 0.001427 0.924024 0.957896 0.485303 1.581631 0.965908 0.565355 1.131889 1.931709 1.633305 0.606986)
)
;;; 103 odd -------------------------------------------------------------------------------- ; 10.1489
#(103 13.551587266363 #(0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1)
13.142812158651 #(0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1)
- 10.346204 #(0.000000 1.522875 0.362346 1.600685 1.403370 1.134413 0.709882 1.111703 0.446510 1.474705 1.429235 1.938285 1.560852 0.329033 0.367270 -0.130012 1.521878 0.448344 1.257758 0.094928 -0.285821 0.903492 0.242932 1.079367 1.646219 1.158560 0.823878 0.117625 0.342480 0.431604 0.075524 0.841308 1.302343 1.026403 0.623957 0.238668 1.402263 0.423956 0.924319 1.827648 0.238064 1.079131 1.083282 -0.110412 1.051327 -0.055981 0.702443 0.516788 0.996315 0.536073 1.838825 0.434175 0.689394 0.494866 1.049886 1.909823 1.015131 1.108874 1.212748 -0.058358 1.029912 -0.102411 1.378321 0.902448 0.630177 0.484558 0.412760 0.770857 1.825062 1.590730 -0.014700 1.126867 1.388632 0.120837 -0.391534 1.407490 0.551261 0.679689 1.587896 1.287155 1.769026 0.969362 0.973872 0.185975 1.644331 0.867283 1.039748 0.122253 0.871370 0.765675 0.599175 1.375629 0.353869 0.750709 0.787303 0.938253 1.010020 0.474245 1.003481 1.108774 -0.031837 1.895244 1.742887)
+ 10.168531 #(0.000000 1.402262 0.390984 1.499485 1.313607 1.147732 0.692998 1.120347 0.496669 1.460754 1.449668 0.084461 1.588684 0.392787 0.213884 -0.062145 1.632734 0.377039 1.334216 0.206141 -0.197229 0.898931 0.228959 1.182027 1.762695 1.221298 0.896145 0.188843 0.416276 0.501312 0.054420 0.825865 1.279867 0.961295 0.656148 0.137858 1.568590 0.495997 0.831373 1.847500 0.251311 1.104471 1.198906 -0.050567 1.242664 -0.045544 0.683930 0.505964 1.089093 0.651840 1.811556 0.349401 0.738311 0.582424 1.004810 0.126191 1.055201 1.137010 1.337411 -0.026831 1.067466 -0.192191 1.371924 0.990625 0.493989 0.568246 0.383517 0.879501 1.848268 1.565590 -0.148568 1.223874 1.413067 0.258781 -0.457032 1.318003 0.593281 0.683947 1.541394 1.249979 1.839212 0.921716 0.877955 0.240218 1.522931 0.967608 1.071890 0.152969 0.910066 0.759704 0.550783 1.462973 0.246988 0.705636 0.812567 0.923483 1.112980 0.598411 0.974719 1.130685 0.061317 1.985387 1.825697)
)
;;; 104 odd -------------------------------------------------------------------------------- ; 10.1980
@@ -2160,21 +2193,25 @@
13.214084551284 #(0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
13.176067352295 #(0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
- 10.526710 #(0.000000 1.057676 -0.092446 1.263625 1.407775 1.336885 0.057415 1.800325 -0.082623 -0.247863 0.432664 1.259400 1.531607 0.210443 1.091470 0.192475 0.859204 1.518653 0.015687 1.295435 0.148847 0.782272 0.587578 1.016052 -0.272224 0.618711 1.597714 0.816245 0.697560 1.227125 0.629605 1.357616 0.814801 0.843162 0.976956 1.326142 0.882841 1.010425 0.708739 1.722159 0.067632 1.142627 0.821017 0.719124 0.341503 0.964449 1.174389 -0.079990 0.380272 1.070696 1.650329 0.380226 1.060583 1.616363 0.934883 0.183004 1.967638 0.237755 -0.035050 0.931522 1.956607 0.818087 0.851731 1.572882 1.399147 1.186558 1.455457 1.489734 1.308982 1.127013 0.918741 0.985119 1.859798 0.515594 -0.052622 1.189517 0.069470 0.649212 0.104544 -0.169221 1.353684 0.255587 0.087097 1.169735 1.064535 0.249946 1.572374 0.788524 0.782562 1.372519 0.897524 0.190154 1.557309 1.678681 1.517325 1.722172 0.755677 0.610350 0.741547 1.506658 1.679380 0.484745 0.518305 -0.224267)
+ 10.475946 #(0.000000 1.034264 -0.120029 1.262694 1.368873 1.300536 0.054042 1.817693 -0.056800 -0.180350 0.483603 1.303103 1.522845 0.299207 1.072152 0.191353 0.819941 1.591426 -0.005969 1.216579 0.132209 0.790814 0.634302 0.937402 -0.324582 0.537853 1.500007 0.747718 0.685856 1.183303 0.655624 1.325389 0.781541 0.870379 0.863653 1.283311 0.867947 1.048089 0.688819 1.790352 -0.011129 1.080550 0.759160 0.775928 0.383127 0.984140 1.193758 0.011420 0.248008 1.044386 1.716602 0.380584 0.981620 1.533101 1.033426 0.209011 -0.012617 0.260827 -0.037006 0.862634 1.945689 0.758958 0.913390 1.519516 1.373001 1.144957 1.412838 1.512255 1.343577 1.124987 0.831931 0.983327 1.911909 0.478600 -0.024278 1.141464 0.071413 0.672771 0.088945 -0.138390 1.383770 0.315274 0.171961 1.195759 1.119445 0.258603 1.574629 0.855465 0.791216 1.391318 0.787759 0.233799 1.583542 1.589038 1.534872 1.781760 0.761360 0.525572 0.693136 1.450937 1.681966 0.492576 0.574320 -0.210512)
)
;;; 105 odd -------------------------------------------------------------------------------- ; 10.2470
#(105 14.179738044739 #(0 1 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 0)
13.491228801467 #(0 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0)
- 10.430197 #(0.000000 0.023741 1.402656 1.035467 0.683403 0.961472 0.692769 0.660454 1.510696 1.527393 0.341716 1.558646 1.532378 0.636200 0.549626 0.924251 1.634255 -0.066787 0.333358 1.865394 1.549216 1.504436 0.469734 1.187982 -0.291722 1.827036 0.940552 1.412465 -0.128031 1.240597 1.310838 0.699895 0.900882 -0.312508 1.311927 1.325909 0.845901 0.270236 0.821436 1.679589 0.887436 1.025902 1.365259 1.193469 1.628473 0.080600 1.271976 -0.189973 -0.284548 0.132882 1.610413 1.473243 0.691506 0.060173 1.030900 0.003173 -0.239869 0.811010 -0.021215 0.713099 1.262421 1.065062 0.060748 0.626754 1.208629 1.207693 0.146832 1.502871 -0.075327 1.781431 1.053136 0.227515 0.736372 0.685736 1.193639 -0.008840 1.420270 0.818302 0.511115 1.251530 1.011428 0.757558 0.050681 0.556674 1.559871 0.173836 1.581035 0.274559 0.249861 1.055407 1.697503 1.713094 1.316901 0.464759 1.042563 0.169890 1.256344 -0.043034 0.251166 0.240366 0.380273 0.321895 0.441135 -0.256767 1.292792)
+ 10.221648 #(0.000000 0.068203 1.395718 1.083644 0.687861 0.942702 0.643586 0.723372 1.477722 1.611410 0.446862 1.451846 1.613897 0.733670 0.611803 0.898766 1.513768 1.867597 0.350883 1.956552 1.591570 1.515030 0.520177 1.118003 -0.453819 1.636422 0.814682 1.367228 -0.245478 1.332731 1.403304 0.581101 0.875430 -0.302259 1.199879 1.337193 0.947364 0.353909 0.673534 1.615034 0.841909 1.070209 1.455103 1.345994 1.633647 0.219709 1.341427 -0.191302 -0.206411 0.234408 1.670074 1.442518 0.679760 -0.082208 1.126311 0.030913 -0.299587 0.772723 0.070010 0.558118 1.211275 0.943280 -0.085959 0.706171 1.294850 1.186996 0.232086 1.425801 -0.096055 1.797146 1.023384 0.167586 0.635350 0.702860 1.145107 -0.239263 1.361830 0.817387 0.496423 1.186989 0.982737 0.727347 -0.042396 0.509686 1.460082 0.168462 1.551172 0.358655 0.206593 0.981103 1.652127 1.680727 1.454691 0.378918 1.142396 0.321625 1.273114 -0.091463 0.366808 0.185588 0.328641 0.273204 0.366357 -0.164352 1.250870)
+ 10.198964 #(0.000000 0.064247 1.385316 1.087164 0.688020 0.947488 0.640627 0.727728 1.485689 1.606885 0.446655 1.463230 1.609641 0.728469 0.610768 0.890953 1.511493 1.851404 0.351876 1.967073 1.592336 1.522885 0.516160 1.110256 -0.445962 1.639360 0.811583 1.357540 -0.252436 1.338788 1.396833 0.572722 0.877284 -0.303365 1.194008 1.335377 0.948123 0.349938 0.657086 1.611558 0.841043 1.065370 1.450795 1.348185 1.626223 0.226620 1.334513 -0.184931 -0.203549 0.232519 1.662350 1.459561 0.673021 -0.086246 1.123006 0.036049 -0.297185 0.766635 0.075537 0.555732 1.211198 0.936259 -0.088448 0.720358 1.284849 1.182400 0.239811 1.423376 -0.101828 1.798570 1.023366 0.165394 0.629886 0.703719 1.141718 -0.247919 1.357187 0.799814 0.498700 1.188319 0.975104 0.715660 -0.042929 0.505153 1.466161 0.162641 1.553625 0.358126 0.222062 0.981936 1.655089 1.692040 1.439102 0.382904 1.151260 0.315812 1.276971 -0.097067 0.365417 0.178585 0.330527 0.267621 0.366209 -0.168047 1.250199)
+ 10.192870 #(0.000000 0.063312 1.384372 1.086439 0.684302 0.945358 0.642095 0.724572 1.489181 1.605861 0.449210 1.461912 1.614328 0.722935 0.610542 0.890187 1.513085 1.844156 0.353463 1.966071 1.593301 1.526519 0.522510 1.113977 -0.439345 1.638405 0.797486 1.355105 -0.255746 1.339037 1.396457 0.571655 0.873681 -0.305117 1.200537 1.335227 0.949159 0.352487 0.654704 1.614195 0.841539 1.060210 1.455080 1.348910 1.627499 0.228142 1.329739 -0.188034 -0.200956 0.237959 1.661858 1.458479 0.671755 -0.084937 1.122471 0.025425 -0.291339 0.765119 0.080334 0.559106 1.206004 0.929365 -0.089206 0.719279 1.289436 1.187059 0.233841 1.424446 -0.096978 1.801004 1.014600 0.173925 0.630554 0.701096 1.141457 -0.244831 1.350965 0.801662 0.499860 1.187650 0.966455 0.716418 -0.042838 0.498374 1.473096 0.163606 1.550290 0.361961 0.223757 0.982662 1.653466 1.696386 1.443212 0.385979 1.155039 0.315577 1.275138 -0.097552 0.370438 0.172582 0.331487 0.265687 0.367633 -0.161193 1.254543)
)
;;; 106 odd -------------------------------------------------------------------------------- ; 10.2956
#(106 13.492804348903 #(0 1 1 1 1 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 0 1 0 0 1)
13.091135978699 #(0 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0)
- 10.445972 #(0.000000 0.828470 1.039139 0.550832 0.197907 1.314861 1.643107 1.152657 0.585667 1.179896 -0.083472 1.032118 0.668266 0.716400 1.548114 0.046439 0.177784 1.160766 1.640728 0.589776 0.426066 1.299802 -0.237963 1.754334 0.785933 0.151483 1.198774 1.077995 1.159292 0.348105 -0.294386 1.789440 -0.061990 0.962655 0.324884 1.098161 1.627805 1.448424 0.349667 1.281286 0.254616 0.252149 0.297766 1.044799 0.379324 0.903591 0.384614 0.676633 0.814741 0.775253 1.092887 0.133647 0.642883 0.694446 -0.005179 -0.030069 1.717248 -0.037390 1.314564 -0.038145 1.681855 0.063501 1.011401 1.101871 0.342127 1.244812 1.506921 1.728771 1.258567 1.548104 1.518588 0.093282 0.545244 0.600808 0.080019 1.703054 1.312181 0.371698 1.620653 1.353668 1.350185 0.239616 1.885292 1.161958 0.907648 1.613692 1.110494 -0.020132 0.133900 1.224414 -0.205319 1.102674 1.438443 -0.067396 1.771546 0.577887 -0.008031 1.400197 1.302116 0.254519 0.751012 0.036130 0.247517 1.381241 0.176095 1.659167)
+ 10.292134 #(0.000000 0.810475 1.033482 0.550694 0.184882 1.297239 1.661161 1.167427 0.653962 1.155880 -0.117293 1.007879 0.642013 0.700634 1.522209 0.093964 0.118360 1.189116 1.681308 0.560938 0.507175 1.259013 -0.294203 1.738922 0.876156 0.157191 1.264238 1.135688 1.199355 0.268997 -0.233823 1.797328 -0.057653 0.963253 0.370744 1.107202 1.708749 1.444814 0.351633 1.290274 0.324094 0.285112 0.301000 1.136974 0.387817 0.901660 0.343419 0.673908 0.864742 0.961904 1.054553 0.082074 0.677455 0.709940 -0.010277 -0.001559 1.717900 -0.032390 1.355783 -0.043158 1.719512 0.049870 1.037079 1.106304 0.325726 1.215582 1.524725 1.745123 1.252031 1.617458 1.551681 0.207463 0.541297 0.662701 0.057061 1.699055 1.353228 0.340712 1.668569 1.375789 1.332979 0.289056 1.855486 1.162714 0.926262 1.664853 1.144741 -0.058810 0.099760 1.361997 -0.241533 1.019775 1.429797 -0.022629 1.813910 0.625118 0.001802 1.374735 1.210000 0.203619 0.854706 0.077140 0.257839 1.375323 0.181331 1.652287)
+ 10.271435 #(0.000000 0.820273 1.066396 0.583402 0.192883 1.250319 1.682159 1.171181 0.681767 1.127098 -0.100470 1.006906 0.669311 0.718493 1.521670 0.106314 0.103259 1.176128 1.706630 0.519764 0.481287 1.315302 -0.310944 1.724029 0.908784 0.194295 1.230327 1.120031 1.153386 0.281420 -0.224812 1.795179 -0.079057 0.979449 0.420459 1.115413 1.731622 1.448892 0.339819 1.309962 0.311546 0.261757 0.334242 1.188917 0.360576 0.888348 0.366241 0.652850 0.875215 0.955773 1.049946 0.141514 0.680544 0.762852 -0.041218 -0.033690 1.712522 -0.055808 1.401464 -0.005650 1.762081 0.090872 1.010261 1.116637 0.320760 1.232171 1.581197 1.758825 1.295134 1.620603 1.544819 0.243649 0.577472 0.716783 0.031780 1.717275 1.373437 0.329551 1.665503 1.368029 1.300265 0.340533 1.907645 1.149096 0.926168 1.715792 1.153850 -0.066233 0.073290 1.388787 -0.227996 1.042181 1.453125 0.006688 1.819924 0.638807 0.026610 1.384624 1.227832 0.195921 0.852566 0.090208 0.259805 1.389529 0.206802 1.649577)
+ 10.270846 #(0.000000 0.819165 1.068752 0.583908 0.193268 1.246632 1.680630 1.168493 0.681515 1.119941 -0.103583 1.005783 0.671557 0.715469 1.521683 0.100050 0.103928 1.177788 1.706211 0.520642 0.487117 1.315232 -0.310270 1.727651 0.907859 0.195037 1.229054 1.119869 1.152686 0.282011 -0.224722 1.796458 -0.080301 0.980885 0.424151 1.117927 1.730879 1.450803 0.340809 1.313348 0.310943 0.257235 0.336745 1.188642 0.362171 0.886119 0.364003 0.651269 0.876388 0.956443 1.044360 0.139906 0.683371 0.764369 -0.035602 -0.032529 1.711134 -0.057775 1.401260 -0.006722 1.765680 0.094171 1.006063 1.119062 0.319911 1.233788 1.580745 1.758932 1.294949 1.619289 1.547561 0.246759 0.578580 0.715653 0.029566 1.719637 1.377564 0.331648 1.662851 1.367436 1.299842 0.341815 1.905510 1.149747 0.921856 1.715496 1.152941 -0.067907 0.075487 1.389444 -0.225447 1.044800 1.457795 0.003916 1.820320 0.642746 0.023596 1.383278 1.227376 0.196685 0.853371 0.087277 0.264363 1.394060 0.210839 1.646463)
)
;;; 107 odd -------------------------------------------------------------------------------- ; 10.3441
@@ -2183,7 +2220,7 @@
13.722554538648 #(0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1)
13.537808159641 #(0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 0 1)
- 10.757957 #(0.000000 1.466154 1.743157 -0.018226 0.679237 1.474407 0.253122 1.791098 0.219200 1.433677 1.444413 0.163961 1.415015 1.494009 0.121982 1.725530 0.074888 1.231869 -0.164077 0.092597 0.764002 0.080580 1.522701 0.682044 0.839574 0.255352 1.113609 0.535530 0.052761 -0.054726 0.233970 1.576633 0.669439 0.103688 0.008810 0.897638 0.800333 0.949543 0.274558 0.764359 -0.193404 0.810126 1.829865 1.776460 1.259286 1.492230 1.528504 1.818912 1.432957 0.511591 0.446380 1.012707 0.304293 0.019526 0.467836 0.334830 1.418396 -0.108114 0.388280 0.400008 1.954939 0.962150 0.796172 1.710162 0.920007 0.753024 1.484961 -0.164213 0.910855 1.211384 0.613769 -0.251056 0.391506 0.457843 1.903980 0.520265 0.890621 0.591025 1.712017 -0.093539 1.653226 0.502728 0.363967 0.294431 1.909376 0.723146 1.688029 1.134857 1.599714 -0.009095 -0.148695 0.593871 0.680364 0.094412 1.822483 -0.099150 1.414452 0.136406 0.954355 0.959928 1.804652 0.285646 1.844550 1.925212 1.433567 1.045441 1.443089)
+ 10.564685 #(0.000000 1.442175 1.714218 0.024813 0.730244 1.477796 0.212396 1.793928 0.270982 1.436933 1.425689 0.127181 1.470763 1.592296 0.109544 1.661733 0.129864 1.268207 -0.231060 0.165683 0.789503 0.120281 1.515600 0.722604 0.861210 0.284618 1.170853 0.497879 0.007694 -0.069463 0.250328 1.661666 0.683306 0.091404 0.005311 0.810871 0.896219 0.870627 0.327870 0.872352 -0.070917 0.900991 1.907068 1.702029 1.262354 1.452413 1.543830 1.851235 1.337845 0.441569 0.484224 1.105428 0.246771 0.075988 0.452082 0.385840 1.493622 -0.199899 0.401164 0.414604 0.037372 1.048729 0.770333 1.770540 0.995159 0.652450 1.523172 -0.206947 0.893680 1.207278 0.715401 -0.199037 0.413755 0.546151 1.910577 0.546285 0.904996 0.603409 1.774117 -0.116066 1.700700 0.450234 0.364439 0.346205 0.011096 0.765281 1.746558 1.167818 1.639313 0.009292 -0.266074 0.634907 0.776120 0.111310 1.816230 0.005991 1.426916 0.125735 1.051790 1.000327 1.771173 0.344467 1.897868 1.949971 1.448781 1.046428 1.450648)
)
;;; 108 odd -------------------------------------------------------------------------------- ; 10.3923
@@ -2192,14 +2229,14 @@
13.584542754139 #(0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
13.472808406168 #(0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
- 10.739724 #(0.000000 1.843910 0.218121 1.274435 0.526942 0.998275 -0.365012 1.082735 -1.386416 0.924155 0.004148 1.545935 1.118103 1.717617 0.611697 -0.259773 0.611997 0.950890 1.493797 -0.293778 1.692214 0.270833 0.199891 0.880414 -0.316547 0.694432 1.020511 1.665748 0.247167 1.453086 -0.072588 -1.814802 0.444119 0.294600 0.384503 1.877099 1.810757 1.318761 1.721135 0.607652 0.436876 0.218128 0.850707 1.944091 -0.283183 1.910946 0.945422 0.831071 0.755841 0.435584 0.959909 1.389874 0.824233 0.709571 -0.367902 0.428317 -0.380212 1.104148 1.248115 1.642849 0.290319 -0.470074 1.209473 0.866387 0.992563 0.661964 0.703050 1.140540 0.987337 0.343161 0.531233 1.046329 1.819576 0.086721 0.105676 0.500120 1.036281 0.610565 0.234880 1.332990 0.920208 0.059716 1.210648 1.070555 1.297339 0.208338 0.792497 1.590310 0.744150 1.891949 1.437762 1.411687 0.528595 1.264504 1.219015 0.264320 0.214765 0.476380 -1.348101 0.732992 0.106750 0.680225 0.379590 1.345331 1.040373 0.469645 1.464051 0.206800)
+ 10.406293 #(0.000000 1.853444 0.165967 1.339625 0.623535 0.993422 -0.435000 1.051705 -1.305298 0.768597 -0.150947 1.574742 0.993298 1.773003 0.618536 -0.219773 0.513372 1.070267 1.525944 -0.238250 1.509352 0.364276 0.166977 0.865200 -0.439411 0.580944 0.953531 1.625995 0.296526 1.448246 -0.095677 -1.858632 0.387882 0.276046 0.462832 1.980035 1.787199 1.271279 1.604171 0.357875 0.428413 0.246068 0.836949 1.911944 -0.348477 1.882220 0.968017 0.750913 0.759681 0.355108 0.873494 1.384603 0.872708 0.526108 -0.395009 0.418307 -0.500907 1.112269 1.115501 1.666087 0.358067 -0.483899 1.006133 0.571987 0.934614 0.645014 0.775909 1.191542 0.979462 0.418623 0.533518 1.056806 1.941330 0.123425 0.152561 0.462794 0.911592 0.532095 0.305539 1.441709 0.881869 -0.009356 1.118317 1.115001 1.219134 0.245858 0.674521 1.582140 0.663859 1.947600 1.503964 1.666919 0.435476 1.234883 1.372534 0.142103 0.262261 0.684596 -1.364882 0.562651 0.178530 0.577085 0.236834 1.409709 1.004758 0.345641 1.404775 0.087191)
)
;;; 109 odd -------------------------------------------------------------------------------- ; 10.4403
#(109 13.889015913621 #(0 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 0)
13.798 #(0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 0)
- 10.833859 #(0.000000 -0.058339 1.636410 0.523968 0.387332 1.764429 1.091739 1.267468 0.539622 1.433730 1.312112 1.341605 1.655084 0.067062 0.977927 1.527385 0.968046 0.715531 0.580218 0.684444 0.051598 1.565948 1.290692 0.268542 0.624110 1.301066 0.437753 0.254235 1.278687 0.903347 1.027781 0.580587 0.468212 1.467717 1.157130 1.239255 1.195238 0.313495 1.082570 -1.518818 1.326540 0.234917 0.080552 1.001259 1.063845 0.460208 1.387337 0.703758 0.493004 0.502009 1.248100 0.721319 1.735261 0.471762 0.872803 1.511547 1.558697 1.151049 1.405228 0.668179 1.410639 0.924316 -0.009073 1.283900 0.689866 0.108692 0.816700 1.700463 0.505616 0.405384 0.237740 0.344089 1.340738 -0.125167 1.574446 0.212276 1.614012 0.966648 0.658942 0.055546 0.262768 1.647409 -0.081661 0.673047 0.781594 1.001916 1.471458 0.982577 1.341711 1.024323 1.162188 1.939692 1.281339 0.674849 1.144487 -0.016496 0.514507 1.455919 1.273012 -0.128632 0.671837 1.064952 0.434507 0.990483 0.851317 1.692498 -0.135219 0.031170 0.216628)
+ 10.712744 #(0.000000 -0.122631 1.753336 0.436833 0.453704 1.829495 1.081663 1.255451 0.521091 1.303507 1.204398 1.414721 1.691490 0.140331 0.920105 1.619359 1.074023 0.825667 0.637596 0.773546 0.099787 1.594848 1.256565 0.304155 0.602824 1.316802 0.410428 0.296739 1.276171 0.969599 1.068681 0.560404 0.549078 1.465733 1.172204 1.152179 1.176213 0.312634 1.202143 -1.487915 1.328552 0.249897 0.003810 0.984289 1.096427 0.574688 1.366813 0.690499 0.496665 0.393870 1.320489 0.809599 1.748248 0.435771 0.796130 1.552224 1.489437 1.123537 1.285033 0.675041 1.449935 0.977039 0.038202 1.474324 0.668888 0.083984 0.814875 1.787747 0.548843 0.456033 0.123470 0.337210 1.370167 -0.235331 1.610983 0.172074 1.635245 0.944265 0.614020 0.051557 0.270858 1.472766 -0.123660 0.667610 0.800181 0.976585 1.491190 0.855510 1.303823 1.096929 1.145931 1.907986 1.217941 0.580133 1.028008 -0.076763 0.475882 1.390663 1.255236 -0.221159 0.631367 1.043835 0.420976 0.910816 0.797859 1.737982 -0.188767 0.011574 0.171562)
)
;;; 110 odd -------------------------------------------------------------------------------- ; 10.4881
@@ -2207,7 +2244,7 @@
13.75 #(0 1 0 0 1 0 0 0 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0)
13.576010454591 #(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0)
- 10.541538 #(0.000000 1.584097 1.139814 0.871278 0.416591 0.118688 0.672426 1.256258 1.664722 1.410639 -0.270823 -0.061943 1.601823 1.223255 1.291376 0.027131 0.117441 0.700306 1.621886 1.270558 1.429744 1.359367 1.090094 1.237746 1.410298 -0.338735 -0.132305 -0.251219 0.337733 0.262757 1.936668 1.195875 -0.464689 0.517768 1.208234 1.498743 1.518196 0.961925 -0.135858 0.706927 1.350509 1.523037 0.833912 0.424444 0.728562 1.804525 0.189564 0.702080 0.906083 0.139619 0.405107 -0.003809 1.412134 0.523131 0.557561 1.001710 0.064599 0.666366 1.458683 1.131027 1.460708 0.805723 0.824143 0.112092 1.125696 0.071455 1.174024 1.522359 1.668726 1.807105 0.600957 0.261846 1.745918 0.611469 1.437166 0.540773 1.086905 -0.672618 0.779134 0.330237 0.296427 0.186426 0.098209 1.150516 1.503300 0.736371 -0.062412 1.392634 0.234067 1.071602 -0.064449 1.000723 0.022822 1.736288 0.521393 0.008630 -0.612849 0.969483 1.646120 -0.187476 1.740190 0.884004 0.473359 1.235300 0.898487 0.778748 1.264076 0.161471 0.059166 0.670192)
+ 10.461826 #(0.000000 1.595493 1.136304 0.922027 0.386040 0.083768 0.665092 1.222882 1.644688 1.443081 -0.274470 -0.074757 1.665441 1.223501 1.365287 0.028045 0.059500 0.631391 1.593962 1.257425 1.427888 1.404926 1.082188 1.204899 1.409151 -0.317922 -0.204164 -0.263206 0.378480 0.176297 1.933898 1.164209 -0.414109 0.507337 1.227766 1.532342 1.519271 0.975238 -0.105706 0.766783 1.358601 1.531223 0.821349 0.478701 0.747612 1.821774 0.179361 0.724758 0.913540 0.186340 0.367727 0.022290 1.469492 0.515440 0.505152 0.909759 0.032270 0.600161 1.433900 1.126651 1.475620 0.795769 0.801024 0.167153 1.157008 0.049059 1.160907 1.515451 1.624651 1.744556 0.542862 0.268045 1.730002 0.525513 1.390582 0.517818 1.020301 -0.650183 0.848573 0.347117 0.386743 0.157248 0.084442 1.120038 1.509647 0.727803 -0.109245 1.359937 0.278567 1.060748 -0.088458 0.980213 0.066107 1.720969 0.442198 0.008038 -0.647051 0.971838 1.646129 -0.250533 1.753056 0.879333 0.412980 1.291610 0.858393 0.759239 1.227102 0.087704 0.052262 0.681925)
)
;;; 111 odd -------------------------------------------------------------------------------- ; 10.5357
@@ -2215,7 +2252,7 @@
14.114 #(0 0 0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0)
13.709900383304 #(0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0)
- 10.794043 #(0.000000 0.021380 0.387012 -0.197869 0.571472 -0.099743 1.129771 0.899997 -0.264438 0.066952 1.593139 0.042246 -0.030267 0.907027 0.914025 1.831969 1.438509 1.295656 1.478806 1.664128 0.050480 0.260969 1.920495 1.035329 -0.128163 1.580467 0.700690 1.765290 1.484919 -0.116726 0.829026 0.907218 0.513092 0.497912 0.064698 1.666015 0.944542 0.816568 1.198048 0.626277 0.329806 0.855505 0.263580 0.083653 0.528486 0.033792 0.901163 1.182832 0.220870 1.221046 1.256888 0.152054 0.872204 1.672674 1.558584 0.472832 1.465590 -0.224223 1.748028 0.613678 0.073724 0.149891 0.105144 0.967601 0.766915 0.378950 0.513152 0.406773 1.745623 1.268110 -0.129853 0.083652 1.478541 1.418247 -0.096794 0.467980 0.034697 0.697990 1.390342 1.897448 0.853786 -0.013507 -0.061050 1.637869 1.762546 0.423986 1.612987 0.731395 1.467358 0.461293 1.349422 0.326810 0.531040 0.894141 1.176570 -0.046699 -0.024180 0.139005 0.318499 1.700656 1.254640 1.208966 0.004502 -0.225029 0.568846 1.127900 0.212312 1.241309 1.511936 0.758112 0.463051)
+ 10.706926 #(0.000000 0.061875 0.397989 -0.144662 0.557681 -0.106239 1.114440 0.911387 -0.331115 0.078640 1.583233 0.014655 -0.047399 0.918827 0.888663 1.874354 1.474690 1.301488 1.511467 1.646293 0.136549 0.267571 1.957911 0.926052 -0.078395 1.638090 0.704843 1.825046 1.492976 -0.058997 0.913704 0.870986 0.557202 0.547575 0.070643 1.586480 0.829607 0.866682 1.222577 0.666205 0.334146 0.865159 0.333048 0.051439 0.568078 0.072509 0.940531 1.188601 0.165766 1.298967 1.313795 0.109766 0.909888 1.702862 1.590200 0.425391 1.437553 -0.182804 1.728746 0.603013 0.143642 0.161199 0.123802 0.988186 0.696595 0.468927 0.426097 0.363838 1.726729 1.379896 -0.235008 0.046851 1.425945 1.466027 -0.106864 0.421495 -0.009249 0.643024 1.392736 1.913771 0.775136 -0.034587 -0.065666 1.642139 1.767288 0.409867 1.544938 0.686857 1.544277 0.529076 1.255817 0.320781 0.508603 0.874253 1.206557 -0.097165 -0.067888 0.061964 0.329536 1.687111 1.247926 1.199691 0.065184 -0.176759 0.560442 1.091173 0.162705 1.258456 1.543257 0.792801 0.446572)
)
;;; 112 odd -------------------------------------------------------------------------------- ; 10.5830
@@ -2223,7 +2260,7 @@
14.383410482601 #(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 1 0 0)
13.92684841156 #(0 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1)
- 10.979221 #(0.000000 0.450684 0.025532 0.793063 0.423676 0.693558 1.460334 0.283377 1.502608 0.716405 1.184486 1.002913 -0.029597 1.687335 0.267999 0.834787 0.582888 1.552165 1.281501 1.246396 0.946486 0.000812 1.701047 1.556469 1.324922 0.645485 0.380022 0.378104 1.145342 0.955096 0.313810 0.018698 0.073003 1.455529 0.650422 1.621976 0.494787 0.968734 0.562727 0.347277 0.024850 0.519160 1.871723 1.740594 0.213586 1.154589 0.854308 0.538255 1.607769 0.769567 0.071547 1.199585 1.090924 -0.011020 0.728248 1.029738 -0.262376 1.558641 0.247104 0.490547 0.456045 0.848213 0.871467 1.161886 0.396763 0.812723 0.314632 -0.256648 0.370763 1.274956 0.369106 0.283404 0.242115 0.316742 0.557674 0.344345 0.661914 1.131649 -0.133029 0.509400 1.215828 -0.188413 1.140005 0.764987 1.304795 1.511354 1.183579 0.390512 0.307700 1.244506 0.035341 0.272181 1.552692 1.194233 0.107425 0.233174 1.586878 0.073087 -0.156339 0.977970 1.165172 1.226533 0.805752 1.580145 1.127655 1.331670 1.677301 0.726930 1.225803 0.462995 1.360761 -0.105526)
+ 10.820741 #(0.000000 0.414304 0.106262 0.809513 0.330582 0.804601 1.429044 0.280538 1.478466 0.682441 1.181995 0.988431 -0.004766 1.724597 0.259892 0.852900 0.709660 1.600976 1.255224 1.278691 0.949251 -0.092569 1.737118 1.621944 1.331150 0.643812 0.425780 0.362304 1.117314 0.989322 0.295332 0.013416 0.024744 1.574390 0.752305 1.637729 0.508835 0.959838 0.555045 0.377723 0.132450 0.510706 1.913852 1.736510 0.155154 1.162286 0.887832 0.580311 1.695573 0.896830 0.097438 1.107363 1.041407 -0.000165 0.618563 1.042217 -0.324037 1.501660 0.255596 0.437381 0.397068 0.895929 1.022816 1.269464 0.502766 0.823070 0.264708 -0.338497 0.364128 1.350822 0.474962 0.326256 0.176979 0.303814 0.511444 0.344425 0.607021 1.174789 -0.220907 0.579905 1.131238 -0.082150 1.168447 0.773891 1.460107 1.517829 1.173832 0.455714 0.303135 1.401693 0.114560 0.353025 1.544372 1.158476 0.229098 0.240915 1.541450 0.096978 -0.121740 1.044179 1.125378 1.394865 0.821585 1.561913 1.153476 1.425413 1.681310 0.813806 1.287380 0.661694 1.285159 -0.017547)
)
;;; 113 odd -------------------------------------------------------------------------------- ; 10.6301
@@ -2231,7 +2268,7 @@
14.00348588593 #(0 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 1 0 0)
13.825498858186 #(0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0)
- 10.763371 #(0.000000 0.788501 0.336107 1.171272 0.251259 1.313867 0.308239 -0.113193 0.842159 1.834692 1.075000 1.774336 1.323918 -0.355917 0.066119 1.573040 -0.223295 0.653027 0.706661 1.050699 0.820663 1.488604 1.695505 1.440458 1.750946 0.802128 1.712149 0.784957 1.114800 0.603597 0.751098 0.850001 1.854218 1.291507 1.493429 1.150422 0.454382 0.338585 1.104023 0.725177 0.502692 0.855373 0.442546 0.600824 0.516729 1.381780 0.449297 0.433470 1.280046 1.360061 1.334015 0.890340 0.400729 1.853916 0.480677 1.660841 -0.001327 1.677673 0.593240 0.694236 0.892571 1.580850 0.782380 0.818863 0.139221 1.502680 0.515988 1.098811 0.307075 1.848438 1.603240 0.724775 0.126619 0.665060 0.973381 1.711309 1.424164 0.204185 0.279321 1.436198 0.841986 0.551955 0.003459 -0.098241 0.032847 1.356601 1.666878 0.498841 1.030791 0.247428 0.966564 1.044951 0.276075 0.784772 0.859724 0.488754 0.352464 0.939988 0.793233 1.110254 1.826601 0.523682 1.413413 1.618738 1.468615 0.759261 1.267402 0.986750 1.970916 -0.132928 0.708330 0.587932 1.323416)
+ 10.714268 #(0.000000 0.826391 0.340897 1.231603 0.281185 1.360627 0.359989 -0.176419 0.849727 1.859846 1.073767 1.810540 1.353346 -0.366643 0.074464 1.641871 -0.182253 0.604179 0.675567 1.081491 0.861656 1.534240 1.684512 1.438158 1.736220 0.865729 1.737018 0.798208 1.154877 0.664851 0.717687 0.903291 1.780468 1.301662 1.449823 1.164801 0.441093 0.318331 1.127356 0.670499 0.426985 0.887536 0.417727 0.613767 0.501312 1.382563 0.421126 0.467025 1.342975 1.363476 1.372643 0.915281 0.403037 1.871616 0.476704 1.715045 -0.013559 1.647304 0.567680 0.680413 0.898771 1.538648 0.770538 0.813378 0.208644 1.545020 0.554732 1.057556 0.304802 1.844122 1.618833 0.732444 0.080115 0.673417 0.927917 1.754678 1.463688 0.171342 0.277180 1.437160 0.810315 0.539759 0.002191 -0.077850 0.051580 1.393488 1.697822 0.495907 1.033713 0.258546 0.964879 1.040002 0.352930 0.782125 0.840113 0.433318 0.412767 0.964654 0.753607 1.054496 1.885042 0.505525 1.427456 1.591678 1.570443 0.772436 1.213934 1.082669 1.930862 -0.132721 0.792514 0.580200 1.270484)
)
;;; 114 odd -------------------------------------------------------------------------------- ; 10.6771
@@ -2240,7 +2277,7 @@
13.974405288696 #(0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0)
13.920305720092 #(0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 0 0)
- 10.866267 #(0.000000 -0.187677 0.585356 0.306262 1.004783 1.584856 0.685458 0.706736 1.019916 1.569629 0.355755 0.214570 1.705392 0.081483 1.050274 -0.485634 1.543047 1.081169 0.760120 1.568883 0.309178 1.161069 0.507804 0.526033 0.660095 0.842155 0.901061 1.514999 0.447300 0.957115 0.527601 1.816729 0.619528 1.515506 0.881561 0.729995 1.271515 0.301892 1.762697 1.024222 0.318361 1.149478 -0.044161 0.573109 1.726397 1.421875 1.755853 1.412716 0.667039 1.658862 1.793966 1.639490 0.977346 -0.636800 1.727143 1.050980 -0.211257 0.151272 0.226434 1.775203 0.793631 0.030602 0.452246 0.710888 0.642807 1.729345 0.627316 1.772252 1.366968 1.028281 1.846771 1.864119 0.065596 -0.075533 1.110672 0.552510 0.735318 1.744620 1.131474 1.169473 0.649052 0.106355 0.355147 1.439693 0.145833 0.267149 1.445725 1.565054 1.520939 -0.077964 1.839663 0.768391 1.891614 1.272946 1.513748 0.175525 1.551881 0.263179 0.640585 1.222163 1.392879 1.822628 1.528546 1.355864 0.964743 0.522016 0.502008 1.290900 0.367070 1.669528 1.760014 0.689139 1.272193 1.637034)
+ 10.745561 #(0.000000 -0.210357 0.564676 0.359404 0.913773 1.626584 0.718679 0.687824 1.035981 1.565826 0.374126 0.188499 1.735183 0.100430 1.140883 -0.490323 1.481962 1.069450 0.720725 1.574153 0.361899 1.179454 0.510984 0.525476 0.801021 0.759170 0.912309 1.555884 0.437215 0.950259 0.487743 1.822344 0.674389 1.541322 0.883876 0.752883 1.321180 0.318249 1.743803 1.086956 0.267247 1.148302 0.002330 0.484939 1.759551 1.424349 1.747661 1.299089 0.624948 1.608514 1.762967 1.584380 0.998119 -0.687997 1.667925 1.080614 -0.217279 0.152777 0.193713 1.802880 0.769596 0.043067 0.453482 0.737948 0.642979 1.787105 0.652594 1.858944 1.393939 0.999191 1.953789 1.842134 0.069427 -0.055875 1.074162 0.462072 0.728017 1.625944 1.094125 1.140312 0.585763 -0.017057 0.374815 1.438164 0.165894 0.255645 1.419049 1.568101 1.490758 -0.099656 1.796795 0.732987 1.903514 1.357932 1.461532 0.249644 1.630673 0.208778 0.661031 1.242395 1.372645 1.898467 1.467145 1.337736 0.925703 0.504022 0.524923 1.289935 0.239605 1.706071 1.728121 0.764558 1.275663 1.683002)
)
;;; 115 odd -------------------------------------------------------------------------------- ; 10.7238
@@ -2248,7 +2285,7 @@
14.449532208006 #(0 0 0 0 1 0 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0)
14.20306968689 #(0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1)
- 11.059824 #(0.000000 1.062170 -0.142304 -0.023107 0.693447 0.736232 0.338652 0.901579 1.227692 0.483840 1.002544 0.487308 0.319179 1.007360 0.968277 0.103392 1.455902 1.377101 0.203597 0.343520 1.600016 1.011193 1.599550 0.067410 0.171805 0.127162 0.688447 1.110354 0.206954 1.392686 -0.338111 0.281358 1.734360 1.163092 1.240478 0.548056 1.271747 0.832537 1.129137 0.701612 0.115920 0.872001 1.366753 -0.017077 1.992490 1.838139 0.294370 1.674186 1.212130 0.285150 -0.135335 0.212598 0.249158 0.345782 0.026925 0.037812 0.434448 0.793923 0.467909 -0.023456 -0.256093 0.020407 1.329801 0.284733 -0.061807 1.268883 0.615997 0.165721 0.783428 0.331612 1.235540 1.150059 0.112594 1.855576 0.145249 1.413691 0.881467 0.771987 0.655474 0.087557 0.132627 1.495940 1.471669 1.237604 1.556746 0.400250 -0.542764 0.726362 1.421288 1.885026 0.539061 0.800872 1.669822 0.623750 0.874798 0.807731 1.772651 1.186665 1.661700 0.411316 0.009748 0.862677 0.151742 0.199673 0.537548 1.056241 1.462942 1.683993 0.887465 0.806518 0.952371 0.399212 0.779561 1.186301 0.384266)
+ 10.922902 #(0.000000 0.840984 -0.243031 0.063049 0.648859 0.632203 0.214491 0.829543 1.123258 0.473687 0.950036 0.445834 0.265200 1.163244 0.913847 0.135028 1.511865 1.369851 0.310831 0.155738 1.543602 0.956873 1.557325 0.022552 0.222716 0.161605 0.831637 1.017057 0.197264 1.300888 -0.316745 0.263788 1.599583 1.096538 1.093216 0.465839 1.239585 0.876232 1.200420 0.696233 0.268726 0.845096 1.401600 0.030217 0.100494 1.803292 0.229196 1.897150 1.168120 0.141148 -0.131717 0.276636 0.213398 0.322406 0.082188 0.022607 0.314060 0.775366 0.299651 -0.001089 -0.417549 0.032852 1.281165 0.246120 -0.327139 1.324789 0.596132 0.091979 0.972752 0.329168 1.140066 1.089367 0.014799 -0.005480 0.047563 1.576402 0.940191 0.775863 0.737318 -0.006716 0.321478 1.570426 1.576351 1.319919 1.440254 0.253068 -0.642478 0.730931 1.429291 1.991402 0.469861 0.613863 1.756256 0.499038 0.777771 0.839054 1.817310 1.194248 1.742070 0.373792 -0.000906 0.981181 0.019664 0.404965 0.463031 1.034022 1.437050 1.678633 1.097957 0.696506 1.002708 0.276197 0.826246 1.021240 0.315904)
)
;;; 116 odd -------------------------------------------------------------------------------- ; 10.7703
@@ -2256,14 +2293,14 @@
14.619069099426 #(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0)
13.887789451571 #(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0)
- 11.017229 #(0.000000 0.458606 1.879706 1.111660 0.845232 1.497842 0.943190 0.954997 1.221927 0.088797 0.768298 1.249847 0.205226 1.728114 -0.144753 0.828461 0.317924 1.619078 0.784135 1.585635 0.250649 0.118217 1.141246 0.100813 0.295121 0.760586 0.217154 0.541603 -0.035468 0.301620 1.742033 0.205247 1.600495 0.873981 1.544463 0.136086 0.982052 1.535216 1.567207 -0.205364 0.619537 1.442018 0.163453 0.664652 0.516319 0.965228 0.903981 1.534457 1.791553 0.041254 1.321067 1.148890 0.017288 0.934329 0.769231 1.216395 0.459208 0.963541 0.684566 1.503749 1.669076 1.616343 0.125831 0.846684 -0.022333 1.421841 1.075513 1.431479 0.261725 1.239321 1.041694 1.067662 1.518597 1.898744 1.266081 1.218438 0.438374 1.537891 0.365586 1.638596 -0.065273 0.738078 1.686335 0.065063 0.743933 0.688220 0.178363 -0.240062 1.683303 0.297053 -0.096937 1.296712 1.716977 1.431723 1.256712 0.493894 -0.135801 0.239360 0.269709 1.575835 0.919992 0.806425 0.505547 1.731225 1.405184 0.010769 1.313287 0.617742 0.850789 1.520570 1.637497 1.618215 -0.151362 0.001429 1.524416 1.143797)
+ 10.990832 #(0.000000 0.483308 1.870123 1.135804 0.881776 1.543776 0.925742 0.959800 1.206557 0.157522 0.765275 1.305527 0.179590 1.753652 -0.142120 0.825137 0.368838 1.576888 0.742503 1.655416 0.221411 0.173082 1.172117 0.090774 0.294153 0.772403 0.191147 0.548875 -0.120934 0.296752 1.776133 0.206215 1.630176 0.905938 1.526007 0.119822 0.974283 1.532681 1.684339 -0.206959 0.636301 1.456178 0.190032 0.704702 0.488949 0.923296 0.893836 1.578122 1.778414 0.044662 1.318758 1.179643 0.003013 0.985236 0.727650 1.230497 0.502470 0.957220 0.705947 1.540165 1.726261 1.640448 0.129576 0.851087 -0.046779 1.440963 1.097736 1.455777 0.291127 1.238446 1.034565 1.081555 1.456873 1.924640 1.261044 1.237561 0.479763 1.499119 0.343522 1.627329 -0.085516 0.727681 1.731229 0.043013 0.750403 0.701056 0.158874 -0.233570 1.702514 0.279862 -0.068752 1.247258 1.671759 1.508737 1.263823 0.481625 -0.144337 0.295030 0.306982 1.522546 0.906287 0.764511 0.463967 1.755991 1.403214 0.018778 1.300239 0.705304 0.843053 1.543715 1.630033 1.679997 -0.174261 0.000270 1.536367 1.152539)
)
;;; 117 odd -------------------------------------------------------------------------------- ; 10.8167
#(117 14.63381513714 #(0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1)
14.427604264985 #(0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1)
- 11.097974 #(0.000000 0.208566 0.807682 0.152793 1.152987 1.032881 0.721217 1.572343 1.663937 0.584035 1.230767 0.697357 1.736776 -0.281510 1.335104 0.969824 1.441330 0.434735 1.015568 0.057696 0.764967 0.656896 1.445638 1.385550 1.044177 0.927674 0.089030 0.946824 1.382231 0.066786 0.423790 1.583747 1.622645 1.148031 1.669622 0.509808 0.289629 0.040749 0.005550 1.358642 1.670480 0.106734 0.175873 1.156040 0.526875 1.543427 1.035499 1.127790 -0.335454 0.484395 1.176308 0.855912 0.793212 1.308409 1.618582 1.452509 0.220160 1.770382 1.005355 0.593613 1.301148 0.640396 1.523637 0.893463 0.867796 1.488883 0.778228 0.178972 0.039741 1.735106 1.906482 1.781816 1.578681 1.273807 0.381219 0.415472 0.209640 0.907347 0.016383 0.730921 0.739697 1.792221 0.025293 1.360314 0.218083 1.767812 0.488570 0.742663 0.345591 1.762618 1.364140 0.116572 1.609028 1.783398 1.532580 0.288555 0.550722 1.047799 1.657793 1.357186 0.380560 0.781851 0.264081 1.417935 -0.013314 0.059687 0.082561 0.895074 0.035410 0.189636 0.292807 1.214429 1.661235 0.498471 1.703367 1.284877 1.370124)
+ 11.037769 #(0.000000 0.137964 0.675480 0.160818 1.131517 1.092021 0.723771 1.569504 1.684353 0.598318 1.226316 0.680087 1.714373 -0.259627 1.399954 0.960558 1.372140 0.362544 0.944488 0.039937 0.667426 0.745932 1.453703 1.413876 1.134027 0.818729 0.080433 0.947502 1.351924 -0.058520 0.406758 1.607203 1.706730 1.147281 1.736244 0.502240 0.326382 0.055903 0.022030 1.370695 1.640995 0.134073 0.086849 1.076378 0.580534 1.628515 0.945665 1.124381 -0.362337 0.525801 1.209501 0.827087 0.775197 1.237011 1.584438 1.428350 0.134828 1.743865 1.046538 0.542581 1.246821 0.560342 1.489692 0.883846 0.807941 1.439275 0.824409 0.210415 0.053994 1.740471 1.942155 1.807424 1.511354 1.266302 0.338851 0.393535 0.263333 0.879408 -0.047411 0.705981 0.744599 1.801911 0.044930 1.419224 0.148072 1.720139 0.459947 0.694573 0.332017 1.847351 1.248398 0.061959 1.651879 1.776782 1.525557 0.318321 0.488890 1.052778 1.672246 1.251859 0.346986 0.757273 0.203793 1.413012 0.021139 0.069347 0.124428 0.833593 -0.018404 0.251948 0.269619 1.171170 1.647843 0.374480 1.797783 1.203842 1.317826)
)
;;; 118 odd -------------------------------------------------------------------------------- ; 10.8628
@@ -2271,7 +2308,7 @@
14.72793006897 #(0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1)
14.399567650824 #(0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1)
- 11.318385 #(0.000000 1.542974 1.737873 1.278019 0.672929 1.076378 0.322375 0.165231 0.289196 1.784704 0.520057 1.523592 -0.391711 0.874395 1.155201 0.564382 0.284415 0.461129 0.266639 0.769982 1.300285 0.373989 1.562028 0.788232 1.622824 0.080549 -0.310822 -0.211720 0.459558 0.942531 0.579515 -0.247270 -0.002775 1.744060 0.627683 0.362838 1.849553 0.859387 1.456518 1.272915 1.714281 1.820412 0.722186 1.659547 0.153367 0.239154 0.482585 0.977478 -0.177883 0.945110 1.225655 1.313574 1.711853 -0.291331 0.578522 1.468478 1.334318 -0.491638 1.499961 0.656755 0.484757 0.938590 1.366822 1.124702 1.957574 1.170085 1.690042 0.643053 1.505687 1.154111 0.537381 0.567092 1.048105 1.813378 -0.004236 0.241161 1.813084 0.808703 1.400465 0.287547 1.989990 1.527716 0.496590 1.438076 1.265510 1.153421 1.178796 1.214320 0.366077 1.407406 1.053866 0.620334 0.941293 0.125780 0.347301 -0.202370 1.056963 0.893267 0.052175 1.316033 0.971105 1.894067 1.186888 1.448759 0.715721 0.816354 1.516319 1.614173 1.092303 -0.211030 1.594495 0.481217 1.511682 -0.092735 0.153032 0.074185 1.199970 1.864924)
+ 11.012091 #(0.000000 1.480011 1.791206 1.317972 0.667823 1.060985 0.389171 0.160365 0.377486 1.797135 0.540329 1.478985 -0.410860 0.978816 1.085161 0.585052 0.350877 0.431572 0.268930 0.813766 1.376231 0.370006 1.529775 0.786981 1.538166 0.214135 -0.287817 -0.137665 0.332724 0.966408 0.577642 -0.344356 -0.004296 1.792405 0.621335 0.388650 1.949559 0.790385 1.445541 1.303857 1.783078 1.780124 0.718120 1.682682 0.080756 0.237137 0.451021 0.941003 -0.121972 0.883877 1.322149 1.410348 1.632154 -0.303599 0.556446 1.533535 1.343956 -0.506974 1.540406 0.695569 0.389200 0.951136 1.321144 1.025056 0.038567 1.122603 1.706936 0.621069 1.509223 1.045062 0.608019 0.571780 1.082745 1.795905 0.022436 0.262838 1.974441 0.732706 1.330304 0.327734 -0.017860 1.404263 0.566868 1.320404 1.430562 1.098734 1.170050 1.201259 0.226385 1.437925 1.014109 0.586779 0.951723 0.137834 0.252783 -0.364672 1.125355 0.926415 0.099283 1.319397 1.027191 1.796116 1.319273 1.460922 0.720907 0.863175 1.493185 1.620443 0.976030 -0.284737 1.549533 0.421205 1.520783 -0.201265 0.197766 -0.039088 1.184821 1.841056)
)
;;; 119 odd -------------------------------------------------------------------------------- ; 10.9087
@@ -2279,7 +2316,7 @@
14.647579104049 #(0 1 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1)
14.464 #(0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1)
- 11.280372 #(0.000000 1.379731 0.010861 0.479379 0.835196 0.697626 1.367768 1.676346 1.604167 -0.019328 1.610789 1.524055 0.786269 1.610577 0.287550 1.511396 0.896173 0.702880 0.221293 -0.258157 0.431389 0.558429 0.483464 -0.179194 1.539369 0.357572 1.661798 1.514185 -0.012363 0.765883 0.114890 0.065960 1.709051 0.166629 0.694771 1.179357 0.966546 0.189207 -0.082445 0.483616 -0.186838 1.023542 1.639569 0.576980 1.175733 0.149968 1.966061 0.139064 0.287827 1.478312 1.262287 1.428509 0.304235 0.811124 1.507996 0.510870 1.529294 1.733302 0.800376 1.394522 -0.054905 0.693060 1.022299 0.919754 0.710335 1.796209 0.886541 -0.084485 1.945782 0.857487 1.306437 1.408486 1.298006 1.221915 1.236043 1.730922 1.299449 1.890489 1.299948 0.186602 -0.164442 -0.031401 0.911590 1.468095 0.975347 0.232115 1.432445 1.430334 0.636172 0.405472 1.396424 0.320289 0.461392 0.510758 0.733298 0.909056 -0.063451 1.203365 0.840780 1.824102 0.136531 1.633472 -0.233947 0.111096 1.148789 0.810510 1.720520 1.713028 0.973449 0.008834 1.104457 0.746960 1.446836 1.801807 1.528063 1.011509 1.360612 0.729884 1.783167)
+ 11.206045 #(0.000000 1.419767 -0.012038 0.580925 0.872505 0.692523 1.371043 1.730743 1.572303 0.038471 1.639547 1.598556 0.735377 1.607372 0.242556 1.485546 0.920224 0.738712 0.287146 -0.266329 0.399140 0.565476 0.479707 -0.201439 1.570200 0.382674 1.626736 1.511277 0.018284 0.736849 0.092602 0.093643 1.695695 0.122981 0.682440 1.289197 1.006784 0.153299 -0.126135 0.452443 -0.193903 0.998972 1.640481 0.602162 1.122949 0.121712 0.000640 0.144050 0.261232 1.443214 1.298757 1.455139 0.296681 0.859360 1.500930 0.557455 1.467350 1.687349 0.785901 1.234823 -0.078128 0.693136 0.944604 1.005181 0.813814 1.808285 0.921052 -0.096434 1.939541 0.853915 1.297815 1.447043 1.283129 1.255134 1.221865 1.727207 1.258580 1.876334 1.220588 0.183087 -0.154260 0.012891 0.891644 1.429420 0.955077 0.192789 1.382834 1.354000 0.650147 0.442754 1.391625 0.251602 0.415076 0.550256 0.810998 0.899852 -0.062985 1.150152 0.755542 1.794270 0.213876 1.604646 -0.214661 0.108222 1.171838 0.745312 1.698636 1.703330 0.938312 0.051676 1.085729 0.740273 1.463535 1.737180 1.503266 1.007561 1.277970 0.643222 1.783385)
)
;;; 120 odd -------------------------------------------------------------------------------- ; 10.9545
@@ -2288,7 +2325,7 @@
14.578378677368 #(0 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1)
14.530112637252 #(0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0)
- 11.302183 #(0.000000 1.548536 1.367207 1.236270 0.280015 1.506583 0.155017 0.218717 1.020798 1.193439 0.976683 1.594335 1.585627 0.888430 1.172701 0.730021 0.654376 1.199328 1.054092 1.284074 0.170269 0.583042 1.413404 1.281166 1.860245 0.724027 0.919410 1.394810 1.882867 0.096591 0.513243 -0.200668 0.291966 -0.164809 0.316700 0.990672 0.602875 0.120615 0.952715 0.298494 1.438159 0.271724 0.487831 1.421812 0.392903 0.985827 1.942798 1.476921 0.619129 0.414610 1.325847 1.355425 0.815335 -0.078087 1.123953 1.494310 0.139357 0.029771 1.359661 0.664980 0.839520 1.327689 0.426052 1.151356 0.722563 0.129131 1.165016 1.703905 0.413530 -0.002896 0.505691 1.881884 0.134488 1.586566 0.710551 1.134469 0.541186 0.137510 1.948392 0.947262 1.439847 1.009520 1.623789 0.103004 0.050214 0.961785 1.663539 1.565115 1.061627 0.223169 0.266743 0.277703 1.670735 0.908249 0.170462 0.708102 0.447433 0.981338 0.695988 0.733618 -0.029332 1.895396 1.911980 0.278395 0.514534 1.756391 0.739920 0.545768 0.066996 1.673010 0.406908 1.312116 1.256987 0.282139 0.953759 0.960782 0.447692 0.823911 0.700629 0.059538)
+ 11.080256 #(0.000000 1.602530 1.359004 1.216921 0.319722 1.550366 0.109575 0.144151 0.969125 1.199184 0.920369 1.594663 1.656346 0.819801 1.242772 0.677183 0.644951 1.160759 1.051582 1.210705 0.235042 0.605796 1.428659 1.296079 1.904633 0.711499 0.904090 1.459446 1.862607 0.071023 0.472155 -0.164657 0.285848 -0.239760 0.282408 1.011413 0.605420 0.146094 0.940774 0.211799 1.487192 0.195858 0.520824 1.405869 0.418864 1.066989 1.966162 1.500298 0.608814 0.465602 1.261944 1.234802 0.791744 -0.053748 1.198734 1.480129 0.071408 0.013565 1.333027 0.664251 0.840791 1.323433 0.534236 1.162291 0.616102 0.175852 1.182198 1.711556 0.370380 -0.028137 0.479946 1.859519 0.208500 1.526814 0.739995 1.075897 0.551908 0.245447 1.923134 0.888156 1.428761 0.984225 1.687129 0.094709 -0.000665 0.973570 1.644389 1.605423 1.054161 0.214641 0.317574 0.246435 1.685207 0.983954 0.219164 0.707254 0.431278 0.976742 0.603242 0.694936 -0.072926 1.828922 1.870283 0.357365 0.497193 1.899340 0.681073 0.449050 -0.005727 1.748396 0.516348 1.306116 1.260654 0.311637 1.017677 0.987539 0.422854 0.874208 0.648925 0.015114)
)
;;; 121 odd -------------------------------------------------------------------------------- ; 11
@@ -2296,7 +2333,7 @@
14.673 #(0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0)
14.355115628334 #(0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0)
- 11.353001 #(0.000000 0.546936 1.111740 0.499462 1.766462 0.169303 1.586982 0.801681 0.334713 1.216864 1.256642 1.491354 0.494366 1.188721 1.276420 0.896397 0.831173 0.937932 1.118112 0.684225 1.898377 0.158758 1.346945 0.960398 1.274240 0.290650 0.119509 1.026186 1.806522 1.726799 0.384923 0.757976 0.356123 1.501209 0.153583 1.761742 0.560783 0.007600 0.393149 0.126156 1.324903 1.658458 1.330758 -0.017909 0.404922 0.129424 0.472875 0.089316 0.444681 -0.030068 0.606860 0.131438 0.675091 0.552180 1.737749 0.660524 0.870041 -0.022586 0.588384 -0.183408 -0.047090 1.500088 -0.088088 1.772391 1.133452 0.262471 0.825927 1.451969 1.092666 0.962574 0.123398 0.357871 0.481956 1.002567 1.706394 0.077444 0.136240 1.852553 0.824859 0.474477 1.693983 0.610178 0.360494 0.572513 1.087023 0.005222 0.894041 0.108812 0.959309 -0.126052 1.435178 1.220186 0.536664 -0.099745 0.254879 1.179534 1.207334 -0.137379 1.442617 1.083534 1.846851 1.540107 0.480643 0.293409 0.049224 1.302563 0.371937 0.871834 1.040573 1.603680 1.106026 0.967035 -0.156181 0.354045 0.707836 1.614636 0.797178 1.001811 0.269210 -0.014140 1.436582)
+ 11.251755 #(0.000000 0.616396 1.145651 0.448244 1.761234 0.192024 1.606262 0.862349 0.348055 1.176986 1.299320 1.556365 0.505344 1.218624 1.265898 0.933279 0.856541 0.916727 1.161758 0.614744 1.928067 0.111721 1.443155 0.955924 1.271842 0.264505 0.120298 1.090835 1.813127 1.689743 0.391028 0.745365 0.325537 1.569771 0.112161 1.759158 0.591817 0.031537 0.437154 0.155541 1.282148 1.603690 1.297436 -0.042911 0.360966 0.175879 0.480785 0.072954 0.498092 -0.012986 0.589839 0.064536 0.584865 0.623220 1.716464 0.688040 0.773709 -0.048689 0.583532 -0.225163 -0.041259 1.431336 -0.167221 1.810487 1.135295 0.244937 0.798260 1.440149 1.066054 0.903238 0.151253 0.363163 0.554300 1.154564 1.732657 0.106500 0.179440 1.889491 0.798931 0.383142 1.791086 0.608853 0.388150 0.613343 1.182517 -0.041143 0.882164 0.212484 1.013654 -0.164814 1.443794 1.315656 0.517417 -0.160450 0.216250 1.187339 1.211088 -0.153762 1.564433 1.130817 1.878274 1.429911 0.526793 0.338560 0.100965 1.331100 0.339220 0.942326 1.098782 1.625798 1.140704 0.884529 -0.134149 0.399116 0.699562 1.697921 0.765048 1.005095 0.261851 -0.025205 1.419104)
)
;;; 122 odd -------------------------------------------------------------------------------- ; 11.0454
@@ -2304,7 +2341,7 @@
14.561 #(0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1)
14.266534958875 #(0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1)
- 11.359253 #(0.000000 1.209083 1.146530 1.580972 1.071741 0.023909 1.325583 0.039418 -0.017860 0.324981 1.700953 0.205470 1.304331 0.057913 1.418401 1.882102 1.324034 1.352679 1.717944 1.089789 1.550501 0.026680 1.567806 0.229886 1.351801 0.337879 0.509444 1.260905 1.181310 0.068897 1.354790 1.505801 1.408504 0.392406 0.144563 -0.501200 0.630761 -0.022907 1.348545 0.658217 0.229000 1.604841 0.577398 0.510266 1.414235 0.497010 1.262368 0.006123 1.581375 1.652545 0.569160 1.482220 0.228493 1.180791 0.479933 -0.415334 -0.207826 -0.392744 0.898254 0.771222 0.040384 1.045504 0.865781 1.174861 0.348559 1.513382 0.820260 1.660098 -0.095177 0.452377 1.175722 0.707162 0.946006 0.776304 0.784272 0.530055 1.633782 0.353099 0.862715 0.121927 0.411999 1.415252 -0.109842 0.515195 0.708756 1.247593 0.618372 1.012059 -0.133464 0.128681 0.054187 1.494514 1.120097 0.938566 1.048292 1.282837 1.714288 -0.099674 0.376743 0.527954 1.486675 1.484174 0.070344 0.567047 0.326738 0.036219 0.023316 -0.228020 0.085903 1.573555 0.677463 0.461600 -0.088265 1.731067 1.181480 0.557859 0.951284 0.829723 1.576371 1.634761 0.686760 0.841373)
+ 11.246495 #(0.000000 1.245631 1.162837 1.527233 1.113641 0.011457 1.330436 -0.041764 -0.007967 0.382655 1.634043 0.160497 1.252079 0.109803 1.380072 1.832167 1.363414 1.381673 1.671982 1.142331 1.577349 0.065745 1.509838 0.223603 1.283341 0.366969 0.481818 1.266854 1.180148 -0.017504 1.311096 1.532121 1.496593 0.335825 0.202360 -0.482809 0.546887 0.010958 1.361750 0.679290 0.216769 1.604545 0.655670 0.581029 1.462756 0.569601 1.324264 -0.069937 1.680274 1.651840 0.522395 1.541310 0.220902 1.227011 0.532318 -0.353937 -0.238770 -0.488853 0.928347 0.827352 0.023419 1.061824 0.871101 1.270478 0.309881 1.490184 0.833985 1.734296 -0.125259 0.514623 1.167498 0.789180 0.928607 0.752371 0.747638 0.506290 1.671542 0.298542 0.934464 0.183999 0.461499 1.429797 -0.199387 0.557684 0.744948 1.232482 0.580417 1.060463 -0.096660 0.264088 0.045764 1.542472 1.063855 0.977500 1.023406 1.301820 1.681261 -0.056686 0.399820 0.503143 1.518676 1.441290 -0.056598 0.565211 0.352773 -0.012555 0.061340 -0.273158 -0.010289 1.711990 0.681576 0.474307 -0.067198 1.714449 1.240049 0.536606 0.963800 0.892794 1.549811 1.615110 0.777068 0.784197)
)
;;; 123 odd -------------------------------------------------------------------------------- ; 11.0905
@@ -2312,14 +2349,14 @@
15.019962594276 #(0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0)
14.795100232697 #(0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0)
- 11.538648 #(0.000000 1.185212 1.633056 1.208365 0.561478 0.846581 0.392779 0.583912 0.379322 0.010085 1.778299 1.054658 0.073180 1.881887 -0.048714 0.317254 0.518282 1.187644 1.512680 0.795665 1.423358 0.305433 0.759395 0.096128 0.123089 1.073505 0.471224 0.936923 1.087520 -0.383289 0.147046 0.035498 1.031138 1.015704 0.913516 0.324251 0.745469 0.964887 0.883403 1.497950 0.303223 0.228588 1.692940 0.358756 1.380036 0.022799 0.872177 -0.014429 0.576859 0.986542 0.337056 0.985992 0.241266 1.523793 1.346723 0.782408 1.276903 1.447990 1.715244 0.556778 0.380794 0.686227 0.803661 0.467625 1.366792 1.638017 0.261310 1.111552 1.167368 1.306920 -0.028201 0.928746 1.808991 1.488383 0.529717 0.421052 1.729314 1.503729 1.542277 0.330299 0.389478 0.208019 0.066249 -0.040611 0.951713 0.073631 1.180511 0.157086 0.636679 0.665112 1.641374 0.238941 1.387396 1.368702 0.539058 1.414393 1.019359 0.177535 0.962756 1.078990 -0.017778 0.003971 1.676490 -0.337164 -0.061921 0.577861 -0.445129 0.539431 -0.049473 1.356833 -0.476115 1.163694 0.692211 1.698947 1.261886 1.620752 1.213320 0.712859 1.381296 1.549394 0.907420 0.301571 1.236930)
+ 11.384759 #(0.000000 1.250375 1.638093 1.086966 0.658382 0.846843 0.405161 0.615402 0.386733 -0.026369 1.721995 1.026231 0.061451 1.882944 -0.005338 0.402508 0.515210 1.186359 1.545807 0.853467 1.488045 0.367485 0.714167 0.051067 0.100578 1.087377 0.496844 0.942943 1.185225 -0.331715 0.124691 0.014727 0.950346 0.956943 1.070854 0.316490 0.741272 0.896410 0.874612 1.578197 0.233741 0.304034 1.733987 0.347933 1.383002 -0.137449 0.832731 0.070192 0.448378 1.013829 0.339511 0.950333 0.291005 1.514992 1.299699 0.818996 1.241667 1.454117 1.752918 0.561735 0.387893 0.621071 0.813016 0.433006 1.548487 1.640182 0.410180 1.072599 1.236529 1.246118 -0.089532 0.986450 1.846205 1.519808 0.469451 0.479186 1.863532 1.521196 1.544448 0.280134 0.470877 0.336639 0.103598 -0.090484 0.814306 0.082853 1.086843 0.176162 0.755825 0.730478 1.554684 0.342884 1.398871 1.469353 0.439863 1.427253 0.989932 0.245396 0.941740 1.150852 0.002136 0.092133 1.736549 -0.389764 -0.108687 0.793881 -0.496038 0.499635 -0.113663 1.260419 -0.585550 1.184958 0.700767 1.656396 1.241261 1.545065 1.199595 0.651157 1.436004 1.574158 0.859605 0.387712 1.229129)
)
;;; 124 odd -------------------------------------------------------------------------------- ; 11.1355
#(124 15.930208950198 #(0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 0)
14.82254124518 #(0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0)
- 11.454792 #(0.000000 0.722232 0.186030 1.251986 0.451332 0.878407 -0.064283 1.043226 0.385522 -0.640071 0.042666 -0.096354 0.912059 0.731273 0.422875 1.737766 0.065884 0.236069 0.718314 1.478918 -0.342504 0.246104 1.124282 0.463201 1.407465 0.154873 0.262910 1.143620 1.796255 0.668890 0.585272 -0.009006 -0.199043 0.636698 0.383168 1.653052 0.591260 1.569511 1.386078 0.263725 1.437213 0.002072 -0.003540 0.867980 1.719970 0.531867 0.045015 0.032765 1.012858 -0.020313 -0.244803 0.775550 0.331764 0.673924 0.692473 1.078056 1.642603 0.043558 0.419893 0.342164 1.059701 0.542041 0.637144 0.172150 -0.370992 1.044040 0.537805 1.120228 1.101101 0.902976 1.120312 1.778487 0.755970 -0.499984 1.602776 1.254397 0.102917 1.348865 1.824025 0.637080 0.100800 0.667746 1.235192 1.357652 0.508645 0.461284 0.840135 0.603453 0.756108 0.130275 -0.152630 -0.355532 0.208979 -0.462166 -0.245509 0.733300 0.318548 0.920731 -0.062446 1.313484 1.586624 -0.127524 1.332912 0.224711 0.211971 1.316418 1.402904 0.650380 0.707762 0.538845 1.703362 1.473872 1.316255 -0.579271 1.445774 0.020749 1.346122 1.520814 0.535455 0.932334 0.988862 0.782113 0.538606 -0.226762)
+ 11.416926 #(0.000000 0.723460 0.166879 1.239074 0.427397 0.853546 -0.075003 1.057125 0.435319 -0.640591 0.045342 -0.079915 0.914526 0.741272 0.451741 1.736620 0.038110 0.271977 0.718888 1.459293 -0.368510 0.217107 1.151924 0.489479 1.399034 0.168148 0.233828 1.187929 1.783316 0.664789 0.609273 0.034294 -0.178285 0.653035 0.402717 1.669426 0.550203 1.528056 1.375306 0.286962 1.407903 -0.011825 0.009961 0.925318 1.690169 0.527957 0.021174 0.017170 1.019581 -0.013888 -0.295351 0.760782 0.309956 0.635375 0.685708 1.065410 1.657570 0.044175 0.408312 0.394344 1.062728 0.586544 0.581731 0.161170 -0.403342 1.018291 0.559335 1.106904 1.131061 0.912043 1.104409 1.783921 0.811553 -0.509711 1.673242 1.238184 0.092261 1.313953 1.841521 0.672446 0.100199 0.677194 1.207219 1.385792 0.496340 0.449547 0.863961 0.610006 0.775449 0.169326 -0.190403 -0.338723 0.185599 -0.459463 -0.275919 0.716070 0.272647 0.948934 -0.104097 1.352349 1.571514 -0.177207 1.335790 0.208072 0.250251 1.238009 1.362764 0.709775 0.746154 0.550918 1.709562 1.416034 1.285573 -0.534798 1.435270 0.007139 1.353559 1.510108 0.564476 0.953143 0.951187 0.806356 0.487335 -0.231079)
)
;;; 125 odd -------------------------------------------------------------------------------- ; 11.1803
@@ -2327,14 +2364,14 @@
14.833 #(0 0 1 1 0 1 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 0)
14.82163143158 #(0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 1 0 0 1 1 1 0 0)
- 11.700289 #(0.000000 0.948169 0.023390 0.582221 0.461197 1.667740 1.283779 0.502177 0.966231 0.349437 0.681051 1.716107 1.576126 1.163306 1.287474 -0.007297 0.427933 1.189971 0.398004 1.035449 0.309531 0.556120 0.778270 1.044647 0.020383 0.262027 0.742019 1.401278 0.395950 0.940867 0.733401 -0.176067 1.912120 0.575045 -0.437735 1.038304 1.864614 0.980310 -0.062801 0.247593 0.758388 1.670616 1.009787 1.672848 -0.037615 1.382638 1.348554 1.867303 1.104303 0.028410 -0.017302 0.180723 0.264154 -0.086762 0.134183 0.271192 0.161453 1.326320 0.825020 -0.115106 1.318570 1.341292 -0.118144 -0.227414 -0.060758 0.077699 0.399007 1.470045 1.405116 1.134994 0.955776 -0.047429 0.496754 0.297508 1.015361 1.757378 0.071944 1.658562 0.097246 0.453125 1.206492 0.227653 -0.191805 1.452292 1.216930 0.942641 0.660953 0.090777 0.542662 0.238275 0.563964 1.669475 1.328839 0.139910 1.174724 -0.241573 1.776160 1.085651 0.425702 1.953589 1.349597 1.175432 1.138202 1.660950 0.065807 1.052438 1.897528 0.886456 0.254672 0.366263 1.127094 1.016610 0.179302 1.502274 0.424689 1.175671 0.375027 -0.008295 0.242811 0.551985 0.085822 1.411695 0.814707 0.197492 0.353723)
+ 11.503401 #(0.000000 0.932730 0.020454 0.602478 0.445704 1.765781 1.303976 0.504734 1.010458 0.328786 0.683215 1.709178 1.612800 1.172004 1.315930 -0.034533 0.425707 1.213999 0.415559 1.003129 0.292226 0.499899 0.819166 1.069695 0.004133 0.235471 0.733217 1.438617 0.405088 0.941772 0.718005 -0.204201 1.917446 0.626017 -0.449527 0.955084 1.886234 0.932921 -0.094300 0.308763 0.670563 1.721060 1.028205 1.698074 -0.029921 1.389368 1.376606 1.882382 1.190830 -0.022031 -0.024884 0.081997 0.268694 -0.131962 0.122368 0.271079 0.214541 1.340622 0.846695 -0.047984 1.323879 1.276260 -0.189041 -0.188626 -0.007887 0.081372 0.378631 1.585740 1.402648 1.133031 1.009678 0.028533 0.442132 0.306251 0.924656 1.799292 0.096741 1.629028 0.058173 0.551119 1.222606 0.292777 -0.159025 1.496803 1.112726 1.080061 0.698329 0.082659 0.582344 0.271257 0.542795 1.688189 1.339524 0.162558 1.219458 -0.161464 1.834483 1.096260 0.470864 1.959908 1.409887 1.132229 1.217207 1.694429 0.047349 1.035647 1.979567 0.981595 0.291474 0.349901 1.083215 0.954099 0.244986 1.487293 0.393262 1.127344 0.460420 -0.059706 0.343980 0.513511 0.099425 1.387214 0.908243 0.187944 0.377584)
)
;;; 126 odd -------------------------------------------------------------------------------- ; 11.2250
#(126 15.556811374771 #(0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 1)
14.961482935205 #(0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1)
- 11.620743 #(0.000000 1.300898 1.917297 -0.293040 0.896833 -0.601682 1.140580 1.306153 1.122969 1.758083 0.942723 0.961308 1.044496 0.980783 1.127427 -0.251343 -0.427866 0.405328 1.419466 0.602380 -0.056536 0.263898 0.134139 1.428763 0.014795 0.725845 1.263021 1.668485 0.664324 -0.176065 0.041856 0.455017 1.977471 0.861764 -0.325499 -0.178179 -0.095371 1.151527 0.887722 1.226755 0.889766 1.666641 0.062134 1.410037 0.485851 0.846780 1.733412 1.516020 0.148866 0.091948 0.168328 1.801265 -0.136299 -0.062301 0.844118 0.830360 1.713581 1.410773 0.864031 1.901329 0.392767 0.448977 0.384927 -0.023102 -0.091621 0.730719 -0.110238 0.491946 1.070226 0.080261 0.423591 1.317268 1.106058 0.770109 0.059061 1.576992 0.427030 1.018242 1.137492 1.309620 1.478786 0.894337 1.387901 1.953868 0.379067 0.372209 0.016662 1.484576 0.314935 1.644997 1.297146 0.604450 0.954902 -0.290705 1.399859 1.357032 0.981574 0.876837 1.655285 1.630649 0.221057 0.266159 1.699132 1.478352 0.965351 0.417556 0.936882 0.387429 1.416858 -0.122239 0.665611 -0.126811 1.049911 0.067378 0.506853 1.082576 0.829527 1.044911 -1.803083 1.774678 1.169830 1.803033 0.625068 0.801197 -0.022098 1.141362)
+ 11.506033 #(0.000000 1.266121 1.908615 -0.366608 0.823384 -0.521945 1.115330 1.371954 1.172745 1.704962 0.897211 0.975854 1.053070 0.891245 1.122386 -0.188017 -0.396512 0.437547 1.484287 0.595893 -0.008735 0.234866 0.156480 1.510266 0.088044 0.727707 1.281599 1.666574 0.610950 -0.196122 0.082257 0.465263 0.001416 0.791317 -0.287253 -0.143747 -0.132604 1.194516 0.849203 1.249729 0.910290 1.844533 0.084167 1.467108 0.498020 0.858984 1.652790 1.518373 0.190904 0.079888 0.078302 1.903608 -0.147934 -0.046274 0.858075 0.875775 1.724292 1.423719 1.015240 1.953227 0.351650 0.383988 0.343356 -0.000835 -0.103335 0.750725 -0.101707 0.630361 1.069452 0.085379 0.409710 1.275717 1.169644 0.850489 -0.004781 1.603057 0.371773 1.077787 1.107195 1.235167 1.493176 0.863299 1.346491 1.884561 0.396369 0.360168 -0.006038 1.448186 0.399320 1.629697 1.338342 0.671621 0.917412 -0.311833 1.429459 1.280685 1.008590 0.861427 1.669294 1.575964 0.236148 0.245763 1.727782 1.489714 0.966605 0.383522 0.826262 0.429808 1.425319 -0.127594 0.671419 -0.224113 0.948785 -0.049150 0.479472 1.065639 0.749481 1.112281 -1.746268 1.740858 1.133709 1.885854 0.622258 0.730045 0.006577 1.165635)
)
;;; 127 odd -------------------------------------------------------------------------------- ; 11.2694
@@ -2342,7 +2379,7 @@
15.018874168396 #(0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 1)
14.695912364919 #(0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
- 11.631393 #(0.000000 0.605616 0.795684 0.382477 -0.107686 1.304676 0.923298 0.493842 1.304540 0.348226 -0.015464 1.373465 1.451489 0.390268 0.250185 -0.226479 0.279949 0.540140 1.240106 0.806476 0.240868 1.075216 1.299131 0.208989 0.868026 1.146809 0.127168 0.969611 0.891350 1.884594 0.663612 0.073390 1.598897 1.145572 0.163105 0.699228 -0.059192 1.920142 1.584665 -0.048569 1.352552 0.708712 0.915914 0.497230 1.264320 1.011473 1.208305 1.651779 1.174320 1.631794 -0.048319 0.400729 0.929387 1.255134 0.853395 0.333504 0.603015 0.896588 1.482481 1.771231 0.527072 1.106468 -0.291100 1.664954 1.230576 -0.183143 0.916627 1.505954 1.148168 1.127389 1.096161 1.200117 0.835410 1.646948 1.763151 1.465057 1.392826 0.633002 1.470033 1.206291 0.633029 -0.182384 -0.019284 -0.075964 0.036387 1.332848 0.357390 1.037421 0.761735 1.076326 0.396251 0.645543 0.556826 0.056725 1.162052 0.460302 0.673571 0.490677 -0.012617 1.227711 1.707603 0.795517 0.208354 1.586923 1.003236 1.818077 0.270993 -0.216225 0.745981 0.887395 0.927888 1.727523 1.744043 1.851860 0.411149 -0.108044 0.810351 1.307933 1.264427 1.334885 0.428501 0.808770 1.115735 0.185759 1.050808 -0.050587 1.133123)
+ 11.531653 #(0.000000 0.563286 0.849127 0.422032 -0.125775 1.300790 0.955761 0.509517 1.296381 0.317664 -0.080052 1.390132 1.467842 0.388221 0.233424 -0.274987 0.301923 0.546211 1.241123 0.836584 0.325866 1.134782 1.290904 0.216370 0.948111 1.102877 0.193082 0.975895 0.917134 1.861877 0.638104 0.124618 1.576442 1.159573 0.131442 0.684599 -0.059082 1.879811 1.597417 -0.031975 1.295807 0.674429 0.993280 0.575059 1.304510 0.972670 1.186933 1.609821 1.136712 1.624798 -0.143161 0.378790 0.870280 1.266235 0.895716 0.353514 0.648678 0.920766 1.505831 1.758151 0.587786 1.034640 -0.259911 1.644029 1.233026 -0.204073 0.920900 1.558313 1.130770 1.083242 1.126439 1.212624 0.857170 1.678815 1.790734 1.381193 1.385268 0.582973 1.421926 1.193587 0.638798 -0.135870 0.044868 0.021301 0.079377 1.433099 0.340228 0.983048 0.746590 1.117996 0.377123 0.681405 0.506217 0.086128 1.181701 0.460264 0.601461 0.475469 0.014581 1.305066 1.727692 0.788232 0.164313 1.595350 1.003271 1.824572 0.191308 -0.289767 0.788802 0.897077 0.932286 1.698471 1.704891 1.934381 0.379866 -0.051166 0.815438 1.337609 1.267631 1.367122 0.431119 0.864281 1.127105 0.244966 1.082387 -0.093369 1.079540)
)
;;; 128 odd -------------------------------------------------------------------------------- ; 11.3137
@@ -2350,7 +2387,7 @@
15.003612518311 #(0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1)
14.876242756695 #(0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1)
- 11.625352 #(0.000000 0.063214 0.727436 1.024405 0.469177 0.840730 0.837557 0.922465 1.634444 1.064649 0.677474 0.602485 0.911686 -0.048296 0.759635 0.025707 0.275107 -0.476673 0.851507 0.208615 0.389554 1.392561 0.671879 0.420218 1.155746 -0.287398 0.452125 0.157655 0.943775 1.286467 1.655189 -0.019065 0.198638 1.500409 0.876782 0.346693 1.009410 0.765036 0.801064 1.026710 0.192087 0.173196 1.085246 0.588277 1.432398 0.605723 0.967155 0.706150 1.287226 -0.112281 0.839438 1.936852 0.942692 -0.252220 0.770570 1.513828 0.862974 0.495283 1.242261 0.655321 0.607997 1.286144 1.343500 1.265079 0.126713 0.209030 0.999402 0.899335 1.490074 1.454836 0.738247 1.878905 0.533933 0.396509 1.870270 0.460316 0.123304 0.282232 0.571202 1.427509 0.159620 1.298318 0.270875 -0.095136 1.911240 0.249833 1.640499 1.288602 0.736209 0.963849 1.398431 0.013951 0.515098 0.519273 0.179541 0.072069 1.343540 1.709146 1.495859 0.402578 1.734570 0.289971 0.038521 1.156866 -0.105340 0.697324 0.797176 0.229746 0.484537 1.388748 1.171097 0.827896 0.298294 1.074475 1.022214 1.518989 0.290888 1.877515 1.542106 0.589723 1.062097 0.437068 0.243976 -0.212407 1.428256 1.040982 1.637928 1.462326)
+ 11.536342 #(0.000000 0.099460 0.679861 1.017305 0.457597 0.754826 0.907482 0.982807 1.665447 1.118787 0.658139 0.587830 0.885804 -0.007757 0.743706 -0.021259 0.225502 -0.455116 0.982149 0.232118 0.453686 1.403265 0.637269 0.499924 1.100407 -0.261963 0.396030 0.153827 0.866530 1.297508 1.570019 -0.077564 0.140754 1.527847 0.857455 0.324059 1.042013 0.740414 0.808730 0.995200 0.234176 0.116054 1.063554 0.680273 1.486116 0.566574 0.901660 0.701926 1.267260 -0.102702 0.846148 1.993686 1.001548 -0.300311 0.723125 1.488775 0.952124 0.604170 1.283554 0.697299 0.605975 1.334293 1.321676 1.260337 0.168502 0.178643 0.984507 0.877372 1.386577 1.462938 0.732017 1.966392 0.589665 0.412565 1.919130 0.426838 0.151191 0.262800 0.513221 1.468738 0.174501 1.345854 0.239976 -0.178660 1.943910 0.245842 1.668020 1.271993 0.762743 0.887384 1.441278 -0.054260 0.576819 0.570504 0.070665 0.032993 1.342717 1.654309 1.442610 0.362253 1.792056 0.336713 0.042709 1.086287 -0.136542 0.645214 0.878180 0.215453 0.476804 1.280053 1.230921 0.848777 0.297820 1.093385 0.890336 1.466071 0.315274 1.881593 1.514888 0.505520 1.051009 0.432769 0.321625 -0.146951 1.504860 1.055377 1.623794 1.507014)
)
;;; 256 odd --------------------------------------------------------------------------------
@@ -4168,6 +4205,7 @@
#(78 11.940728787203 #(0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0)
9.722686 #(0.000000 0.041250 0.229149 0.578291 0.646882 1.195423 1.748984 0.323224 0.223523 0.820584 0.594179 0.356713 0.333205 1.058700 0.290449 0.335164 0.734131 1.481300 1.443499 0.531017 1.858232 -0.087589 0.437928 0.245757 -0.114242 0.584232 0.176670 -0.119556 0.788980 0.989819 1.615347 0.884161 1.297188 -0.157894 1.488979 0.621304 1.865417 -0.094043 1.339426 1.219808 0.723368 1.862441 1.068487 0.856066 0.338384 0.512073 0.000987 1.836569 0.437243 0.562905 1.155474 0.517697 1.343789 0.729055 -0.139029 0.434784 0.378612 0.613892 1.274765 0.553170 0.992078 1.605782 1.455134 1.699970 1.789101 0.931741 1.250740 0.551294 -0.359418 1.855476 1.045881 1.165135 0.333953 0.469587 0.198724 1.503226 -0.020367 1.415823)
+ 9.7174727609649 #(0.0 1.3777043269231 1.1040846538462 0.60948998076923 0.11776130769231 0.27577763461539 0.034774961538462 1.7724032884615 1.2821526153846 1.3359069423077 0.13592926923077 1.7730645961538 0.81286992307692 0.98686025 1.4741995769231 0.91952490384615 0.81977723076923 0.83644455769231 0.38959088461538 0.72256121153846 1.6307735384615 0.67525986538462 0.64980619230769 1.7998685192308 0.91590484615385 1.1958411730769 1.8730555 1.1539138269231 1.4006111538462 0.70562348076923 1.0157228076923 1.4231861346154 1.3368034615385 1.3740037884615 0.40209911538462 0.8889884423077 1.5382857692308 0.89470509615385 1.9822254230769 1.17707775 1.8378320769231 0.43334640384616 1.1336717307692 0.082769057692303 1.1023583846154 0.49240971153846 1.6885430384615 0.40967936538461 0.6875336923077 0.068937019230766 1.8603313461538 0.95328167307693 0.766595 1.7433563269231 0.34927465384616 0.12154398076923 1.3255793076923 1.2057186346154 1.3850489615385 0.0048972884615353 1.4619366153846 1.5502389423077 1.0369442692308 0.30222159615384 1.9134249230769 0.47217625 0.27244857692308 0.88913690384616 1.0524662307692 0.9146825576923 1.3819598846154 0.83147321153847 1.4838315384615 1.0793558653846 0.008615192307694 0.64893751923077 0.63414384615384 1.3779281730769)
)
;;; 79 even --------------------------------------------------------------------------------
@@ -4192,6 +4230,7 @@
11.979215621948 #(0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0)
9.909988 #(0.000000 -0.027044 0.670925 0.672287 0.556422 0.959061 1.660404 1.827490 1.905204 1.572938 1.373745 0.831711 0.128112 0.570430 0.434295 0.195583 0.358256 1.146370 0.628086 1.483182 1.214550 -0.065975 0.458916 0.501501 0.929542 0.491767 1.503491 1.754954 0.111944 0.504737 0.092861 1.544656 0.164190 1.755634 1.221889 0.787583 -0.143678 0.905795 0.441179 0.584480 0.876410 0.663568 1.537778 -0.028267 1.158967 -0.048259 0.437283 1.306139 0.048632 0.836907 1.320011 0.768327 0.367308 0.809095 0.904707 1.604869 0.430890 0.663938 0.954948 0.951226 0.568565 0.312704 0.653386 1.519386 1.820067 1.378419 0.869714 0.026266 0.117129 1.358608 1.578943 0.853699 0.160601 1.528143 1.910946 0.431626 1.950106 1.853442 1.792735 0.765719 0.185923)
+ 9.8865253871568 #(0.0 0.4981674382716 1.6926788765432 0.25877431481481 0.66029275308642 1.527037191358 0.55834362962963 1.2068170679012 1.6499475061728 0.22075794444444 0.35487338271605 0.20917982098765 0.081467259259259 1.1896286975309 1.5328081358025 1.7123705740741 0.49349901234568 1.6781464506173 1.4552218888889 1.1841373271605 1.1504737654321 0.6274052037037 1.5028576419753 1.8736840802469 1.1618285185185 0.67017495679012 0.64406239506173 1.3401768333333 1.9451352716049 0.91003470987654 0.83908114814815 0.92792158641975 0.19960602469136 1.850665462963 0.23851990123457 0.14247333950618 1.6113487777778 1.3394012160494 1.352189654321 0.11547109259259 0.8338045308642 1.0490439691358 0.55128140740741 1.412857845679 0.50724228395062 0.19621072222222 1.5346021604938 0.81722659876543 1.901177037037 0.97268047530864 0.20352291358025 1.9454683518519 0.18649079012345 1.0346882283951 1.7065776666667 1.1611311049383 0.18421654320988 0.90468698148148 0.046087419753086 0.13269585802469 0.3284752962963 0.9755197345679 1.6046761728395 0.86870761111111 1.3940900493827 1.6022014876543 1.6057639259259 1.7082733641975 1.7795968024691 1.5490352407407 0.45499467901235 0.14810611728395 0.063276555555554 1.6367569938272 0.64297643209876 1.7555298703704 1.718774308642 0.24097674691358 0.53632618518518 0.19834562345679 1.7269090617284)
)
;;; 82 even --------------------------------------------------------------------------------
@@ -4224,7 +4263,7 @@
10.062737 #(0.000000 -0.053166 0.118817 -0.074368 0.188285 1.295311 0.521867 0.459224 1.246169 1.616232 -0.077420 0.347090 0.432939 1.661505 1.063938 1.416193 0.989215 1.425194 1.132974 0.603470 1.159207 0.101846 0.696956 0.427568 1.941017 0.267014 -0.129528 1.557595 1.817554 0.131593 0.956970 0.942471 1.261806 -0.086081 0.508562 -0.280398 -0.302917 1.163169 0.936668 1.359628 1.439682 0.115087 -0.097035 0.711525 1.672363 1.133281 0.328498 0.145548 0.965470 0.566986 0.834914 0.425989 1.113858 0.920544 0.820226 0.713008 1.573233 0.799527 0.810769 0.749089 1.124330 -0.116418 0.160945 1.454955 0.885413 0.605857 1.290508 1.462062 0.724327 1.041691 1.322778 0.230136 1.669614 -0.290838 1.200167 0.151272 0.788256 -0.180767 0.725771 0.595460 1.513509 1.100469 0.914540 1.420823 0.479684)
- 10.043571791235 #(0.0 0.58621323529412 1.3064794705882 1.5441807058824 0.53573994117647 0.11696217647059 0.036616411764705 0.29875464705882 0.11339888235294 0.85659811764706 1.9266483529412 1.0298155882353 1.5316548235294 1.4910200588235 1.4924392941176 0.20338052941177 0.39402776470588 1.479544 1.6364772352941 1.7157144705882 0.88756070588235 0.48591294117647 1.4999251764706 1.9199694117647 1.8487496470588 0.86575788235294 1.0529961176471 1.3307353529412 0.36357058823529 1.1394018235294 0.46114105882353 1.4048192941176 0.042003529411765 1.0419327647059 0.362384 0.25126623529412 0.72821747058823 0.87307070588235 1.2596099411765 0.49165617647059 0.89617741176471 0.26221464705883 0.44073088235294 1.9879911176471 1.4960493529412 1.3151625882353 1.3184008235294 1.6596680588235 1.2489652941176 1.1763575294118 0.20053376470588 0.490005 1.7937172352941 1.8090794705882 0.35004770588235 0.80079294117647 0.28053817647059 0.41263741176471 0.72178564705882 1.2735578823529 0.19454811764706 1.7486523529412 0.43598558823529 0.62285682352941 0.19098305882353 0.91631129411765 1.9533495294118 0.56688876470588 0.478643 1.4117642352941 0.51920347058823 1.6888587058824 1.6597109411765 0.72519017647058 0.27181841176471 0.20884864705883 1.3035388823529 0.90661611764706 0.41236435294118 1.0249035882353 0.43687482352941 0.53448405882353 1.2352122941176 0.27207552941177 1.7971807647059)
+ 10.039863832621 #(0.0 0.17040441176471 0.49966482352941 0.29846923529412 0.87530164705882 0.042905058823529 1.5354024705882 1.3893938823529 0.78678129411765 1.1305487058824 1.7796471176471 0.47034952941176 0.54722894117647 0.099286352941176 1.6870227647059 1.9478811764706 1.7379385882353 0.454465 0.15382141176471 1.8324908235294 0.58936623529412 1.7634206470588 0.37067805882353 0.36429247058823 1.8490578823529 0.47464229411765 0.25635270588235 0.10546011764706 0.73353952941176 1.0791899411765 1.9632213529412 0.53313576470588 0.74725917647059 1.3266225882353 0.243704 1.7402684117647 1.7709858235294 1.5194542352941 1.4731236470588 0.28874205882353 0.28936947058823 1.2263598823529 0.98748529411765 0.082040705882353 1.1957321176471 0.62857052941176 0.20243194117647 0.15145135294118 1.3138287647059 0.82268217647059 1.4765045882353 1.306259 0.19790141176471 1.8156928235294 1.9165752352941 1.9331166470588 0.99242605882353 0.75807747058824 0.63303188235294 0.74946429411765 1.2560457058824 0.39323811764706 0.65098752941176 0.46701594117647 1.6158483529412 1.9309827647059 0.51325417647059 0.74163858823529 0.203836 0.77028341176471 1.4339588235294 0.18967723529412 1.7488096470588 0.40058305882353 1.5350214705882 1.0576938823529 1.7219502941176 0.89513970588235 1.9988451176471 0.24684052941176 1.2115699411765 0.88165235294118 1.1694447647059 1.7399731764706 0.88864158823529)
)
;;; 86 even --------------------------------------------------------------------------------
@@ -4340,6 +4379,7 @@
13.341398779709 #(0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1)
10.935272 #(0.000000 -0.058056 -0.064525 0.720038 1.162189 -0.133475 1.672199 0.428406 0.679800 0.029717 0.592079 1.498265 0.113477 0.918147 0.555757 0.199928 1.773096 0.955248 0.645137 0.322272 1.589119 1.804055 0.188603 1.772538 1.261795 1.266287 1.275653 -0.019112 0.380657 1.179342 1.638873 -0.138611 0.205014 1.359633 1.646116 1.230614 0.847759 0.982841 1.503112 0.804577 0.629158 0.965822 -0.280134 1.766593 1.793859 -0.004894 0.622628 0.439199 0.606680 0.055302 0.182137 1.276570 1.972833 0.493276 0.174908 0.430413 0.484641 1.872625 1.301314 1.314572 0.039656 0.310656 0.045974 0.476798 0.586820 0.963277 0.059920 0.639178 1.129383 0.783886 1.258531 0.697627 1.726337 0.249306 1.711661 0.704658 0.165383 1.419227 0.291127 1.476152 0.283197 -0.032688 1.534693 1.197155 0.443916 1.523789 0.498040 0.211672 1.302069 0.633387 0.501526 0.836235 0.316967 1.689521 0.102971 1.394532 -0.037136 -0.014200 1.413808)
+ 10.800392237871 #(0.0 0.74692234848485 1.3453846969697 0.92074804545455 0.13019539393939 1.5867667424242 0.13792109090909 1.5736114393939 0.45441678787879 0.88932613636364 0.17498348484849 1.9127808333333 1.3194701818182 0.74233253030303 0.99528587878788 1.5462252272727 1.5181875757576 1.6420609242424 0.37127327272727 0.076130621212119 0.57284596969697 1.3277543181818 0.49769266666667 1.0616920151515 1.1200573636364 1.9634387121212 0.66372206060606 0.18222440909091 1.3216787575758 0.8616881060606 0.054347454545454 1.0141468030303 0.15859715151515 1.9158595 1.0685628484848 1.2769231969697 1.7982405454545 0.75676289393939 1.8467632424242 1.9673615909091 0.32184493939394 1.4081812878788 0.97655163636364 1.9904809848485 0.59098333333333 1.3735726818182 1.115679030303 1.6883943787879 0.46728072727273 0.80797407575758 1.3354244242424 1.6077477727273 0.79543312121212 0.18665546969697 0.34576881818182 1.5676491666667 0.35960651515152 0.51022186363636 0.60188621212121 1.3963275606061 0.85495790909091 1.8364722575758 0.11083460606061 1.6765439545455 0.28077130303031 1.3607856515152 1.308419 0.64302234848485 0.0019716969696972 0.37470404545455 1.5159343939394 1.7069537424242 1.4157910909091 0.84793243939394 1.1342467878788 0.74115713636363 0.84603048484848 1.0627848333333 0.45419418181819 0.46933453030303 0.066800878787888 0.64024422727273 0.79669457575758 1.2193219242424 1.2424532727273 0.90787862121212 1.098807969697 1.0204533181818 1.2091836666667 1.1015440151515 1.4835993636364 0.53172071212121 1.0190740606061 1.2622364090909 0.46784575757576 0.11028810606061 1.6134424545455 0.6156698030303 0.39357415151515)
)
;;; 100 even --------------------------------------------------------------------------------
@@ -4373,7 +4413,7 @@
11.361804 #(0.000000 0.012900 0.149112 0.580163 0.388185 0.737705 0.891940 0.030448 0.094621 0.222515 1.702261 1.549121 1.354059 0.574681 0.526041 0.749587 0.448856 1.668506 0.292586 0.509824 -0.462477 0.456429 1.446079 1.384067 0.486428 1.634295 1.567034 0.644925 0.225833 0.355474 1.712127 1.659107 0.589959 1.495951 1.238576 0.877099 -0.124515 0.001316 1.754342 0.552641 -0.127346 0.963601 0.671625 0.300078 0.532847 0.336947 0.451727 1.037892 1.831422 0.399204 -0.221917 0.661207 0.113435 1.690191 0.151019 0.672075 1.209504 1.631280 1.607400 0.989043 1.015167 0.566364 0.263106 -0.125432 1.472797 0.681898 -0.190956 0.861075 1.802553 0.124093 0.018827 0.282757 0.429782 0.805599 0.254524 0.271832 0.721652 1.745383 0.508043 0.236386 1.090605 1.777114 0.759912 -0.106845 0.910250 1.120643 0.643737 1.569578 1.545998 -0.343253 0.182117 0.828483 -0.087223 0.278642 1.086767 1.133859 1.174332 0.252639 1.115972 1.084180 0.967486 0.825005 1.728775)
- 11.294944921235 #(0.0 0.052563713592233 0.23939242718447 0.6823791407767 0.59862385436893 1.0678045679612 1.2580882815534 0.21166499514563 0.38669570873786 0.6394554223301 0.23075713592233 1.9946488495146 1.9713995631068 1.408600276699 1.4771729902913 1.5725917038835 1.2756704174757 0.48430613106796 1.3196748446602 1.4415175582524 0.52509127184466 1.8351599854369 0.53575769902913 0.68562841262136 1.7644611262136 1.1597448398058 1.1343185533981 0.31241426699029 1.7272069805825 0.050740694174757 1.026217407767 1.3570791213592 0.18685683495146 1.2752295485437 0.97513726213592 0.68877897572816 1.7261296893204 1.9532284029126 1.8937061165049 0.77271483009709 1.9758055436893 1.4019512572816 0.80235097087379 0.52098968446602 0.91168139805825 0.75235711165049 0.97040882524272 1.441812538835 0.26491825242718 1.0779289660194 0.63261067961165 1.2351523932039 1.0222591067961 0.51974182038835 0.98780153398058 1.7735852475728 1.970720961165 0.82788967475728 0.65138038834951 0.061528101941748 0.20155481553398 1.9249595291262 1.6056602427184 1.4107639563107 0.96924966990291 0.097134383495145 1.1957460970874 0.63552081067961 1.4684705242718 1.9082322378641 1.8407589514563 1.9575606650485 0.22122737864078 0.69527209223301 0.24363380582524 0.15978651941748 0.78898023300971 1.9392899466019 0.74680266019418 0.34728937378641 1.4523420873786 0.34139680097087 1.0635475145631 0.04827122815534 1.3233719417476 1.7659176553398 1.211170368932 0.27703308252427 0.2696847961165 0.38316050970874 0.97274622330097 1.6463639368932 0.55118865048544 1.1352113640777 0.038928077669903 0.099492791262136 0.22351650485437 1.5000242184466 0.29843993203884 0.49085664563107 0.2498463592233 0.17073407281553 1.2256907864078)
+ 11.247144958527 #(0.0 1.2578883495146 0.62877169902913 0.24980204854369 1.3742923980583 1.0905817475728 0.47523709708738 0.60753644660194 0.025893796116506 1.4057471456311 0.25196649514563 1.2222768446602 0.38926719417476 1.0902995436893 0.32255489320388 1.6538512427184 0.54996059223301 0.99653294174757 1.0357282912621 0.3510136407767 0.66106299029126 1.1458793398058 1.0379666893204 0.43294903883495 0.75064838834952 1.2818377378641 0.54467908737864 0.8405194368932 1.4381297864078 1.0246481359223 1.2140374854369 0.70689883495146 0.75692218446602 0.98217153398058 1.8906648834951 0.85554523300971 1.0645645825243 0.54681193203884 1.6988092815534 1.697727631068 0.24491298058253 0.82384033009708 1.4184646796116 0.33183502912622 1.9594043786408 1.0214267281553 0.40033507766991 0.20303142718446 0.19120677669903 0.13654012621359 0.88302947572815 0.71886482524272 1.6779711747573 0.34542552427185 0.022309873786412 0.05584822330097 1.3950975728155 1.5544889223301 0.55544827184467 1.2471166213592 0.48844797087378 1.4516543203884 0.34226666990291 1.3419500194175 0.19678636893204 0.4284787184466 0.75224206796117 1.3841074174757 1.4115917669903 1.0199841165049 0.18413046601941 1.522801815534 0.91152516504854 0.6680405145631 1.4901968640777 0.48147321359224 0.3424935631068 0.80526891262136 0.75699526213592 1.4930786116505 1.888185961165 1.9606983106796 1.8484736601942 0.047646009708728 0.6225673592233 0.23198970873787 0.84542305825244 1.117108407767 0.29267275728155 1.6561501067961 1.4627394563107 1.3299398058252 1.3430191553398 1.2152155048544 1.2362118543689 0.54941020388348 1.9442165533981 0.37037990291262 0.36524325242718 1.7988146019417 0.74072195145629 1.8866553009709 0.16336065048544)
)
;;; 104 even --------------------------------------------------------------------------------
@@ -4382,7 +4422,7 @@
11.414434 #(0.000000 0.026783 0.554871 0.694362 0.631118 0.139017 -0.030109 0.875949 1.442909 0.350004 0.915476 0.250663 0.759652 0.238278 0.140281 0.259804 1.794832 1.813032 1.076407 1.676140 1.930398 -0.193182 1.753611 0.727026 1.637880 1.331007 -0.115065 0.619492 1.193303 1.343360 1.540138 0.309420 0.727482 1.148883 0.879680 0.607466 0.223909 -0.282260 1.213178 1.044913 1.175194 0.242832 -0.272989 0.561895 0.840116 1.290391 0.829322 1.922689 1.264085 0.109576 1.542933 1.304995 1.397476 1.648033 1.160630 -0.025561 0.998231 1.512523 0.355440 0.881235 0.009456 1.657043 0.549110 1.269617 1.572247 1.398086 1.008398 1.733226 0.830436 0.013389 1.485520 0.936378 1.550445 -0.074007 1.460307 0.528006 0.036071 -0.049588 0.736162 0.063031 1.491402 0.692650 -0.177557 0.006671 0.181392 0.804548 0.572498 0.682893 0.721213 1.340507 1.532374 1.312598 1.304434 0.421951 1.592339 0.986297 1.206479 0.215756 0.134334 0.825164 0.212132 0.557322 1.290703 1.440032)
- 11.35930717665 #(0.0 0.81512920673077 0.36505641346154 1.1799626201923 1.8279318269231 0.36572103365385 0.80193224038462 0.54538844711538 0.050670653846154 1.7366818605769 1.0398340673077 1.2417832740385 0.35074548076923 0.8699936875 1.5363708942308 0.49575810096154 0.91891730769231 1.5173065144231 1.7658837211538 1.2382749278846 0.35978413461538 1.0353543413462 1.6185235480769 1.4126577548077 1.1594649615385 1.5946221682692 0.948671375 0.48035058173077 1.9507437884615 0.89054699519231 1.7737902019231 1.4043984086538 0.60187161538462 1.8746988221154 0.73216302884616 0.93557123557692 1.5782054423077 1.9600476490385 0.13958685576923 0.7679080625 1.8475892692308 1.6778124759615 1.9074706826923 1.5445938894231 0.76468509615384 1.9392603028846 0.13004650961538 0.31445071634615 0.20909492307693 0.12882712980769 0.32087833653846 0.98973854326923 1.76197675 0.72335295673077 1.2460241634615 0.94193937019231 0.54952857692307 1.7017997836538 1.7750129903846 1.1908901971154 1.1605064038461 1.2369376105769 1.0795278173077 0.55304802403846 1.7613732307692 0.3876314375 0.89663164423077 0.48237985096154 0.46040505769231 0.23646526442308 0.59876347115385 0.69598867788462 0.15379388461538 1.5237880913461 1.8420032980769 1.7319115048077 0.016793711538455 0.62690291826923 0.277918125 0.56665633173077 0.90442453846154 0.80135374519231 0.52183795192308 1.6699181586539 0.62543936538462 0.21128657211538 0.80966777884615 1.6239899855769 0.40966119230769 1.8954803990385 0.79772960576923 1.4842538125 0.58037801923077 0.29941522596154 0.41677043269231 0.33809463942308 1.4988078461539 1.3117830528846 0.10292125961538 1.8180764663461 1.7647256730769 0.50341787980769 0.34474208653846 1.2836332932692)
+ 11.350146934479 #(0.0 0.87868088942308 0.51837877884615 1.4107626682692 0.11562455769231 0.68227744711538 1.2010153365385 0.92480722596154 0.55418311538461 0.26180500480769 1.6499778942308 1.9606597836538 1.1632826730769 1.6635815625 0.45024945192308 1.4264753413462 1.9453532307692 0.61178112019231 0.88549100961539 0.43303189903846 1.6476017884615 0.37480467788462 0.98940156730769 0.87780845673077 0.65308734615384 1.2103962355769 0.635461125 0.20484301442308 1.7265039038462 0.66320179326923 1.5981836826923 1.4017965721154 0.61638046153846 1.9522823509615 0.91210924038462 1.1572991298077 1.8859100192308 0.30116990865385 0.60434279807692 1.2580166875 0.42023257692308 0.35073646634616 0.52106635576923 0.27620324519231 1.5614341346154 0.79040502403846 1.0430559134615 1.3233898028846 1.2235836923077 1.2857595817308 1.5025714711538 0.22706936057693 1.02109225 0.064622139423079 0.67789102884615 0.44037991826923 0.14616080769231 1.3001536971154 1.4809485865385 0.97508047596154 0.95250036538462 1.0953022548077 1.0411261442308 0.51426303365385 1.8238749230769 0.4943578125 1.0451807019231 0.79889659134615 0.73395548076923 0.60658537019231 1.0454162596154 1.2511611490385 0.75618903846154 0.13430792788462 0.56381581730769 0.48309270673077 0.88399659615385 1.5222254855769 1.232676375 1.6337512644231 1.9688281538461 0.012987043269234 1.7964169326923 0.97276182211538 0.00085071153846172 1.5817786009615 0.22398749038462 1.1937883798077 0.042066269230773 1.5540851586538 0.50437204807692 1.2025889375 0.37441682692308 0.15979671634615 0.39800260576923 0.36091249519231 1.6436013846154 1.4454552740385 0.38911216346154 0.06789905288462 0.1242009423077 0.92256483173077 0.83415972115385 1.7859056105769)
)
;;; 105 even --------------------------------------------------------------------------------
@@ -4462,7 +4502,7 @@
11.903493 #(0.000000 0.030871 0.888039 0.959311 0.070171 0.436603 0.757816 1.217508 1.619759 -0.129337 0.330925 1.334481 1.277796 0.176499 0.416610 0.405059 0.347102 1.797714 1.109814 1.786828 1.298739 0.024165 1.875529 0.396367 0.525690 0.085794 -0.853079 0.745254 0.470764 1.708415 0.454432 0.154292 1.462384 0.611113 1.516746 1.371688 0.703292 0.701390 0.544563 0.626810 1.837098 1.610825 -0.024228 1.358625 0.479292 0.329229 1.052435 0.463840 0.312830 1.141728 1.582086 0.765008 0.327578 -0.085831 1.025222 1.291122 -0.200144 0.034110 -0.142378 1.852735 0.417386 0.764887 -0.019552 1.031569 -0.134898 0.442984 1.851464 0.765045 0.390155 0.409642 1.494195 0.907120 1.218247 0.925510 1.218873 0.082822 1.269590 -0.113144 1.736202 0.789672 0.902667 1.309261 0.125219 1.015082 0.103562 0.966352 0.882833 0.512183 -0.206360 1.361027 0.879198 1.428818 0.481892 0.858788 0.830911 0.157959 0.596064 0.538693 0.094129 0.926733 1.570637 0.418544 0.228207 -0.036964 1.469787 1.423685 0.893617 1.433152 1.658379 0.825654 1.401066 0.922419 1.034588 0.704542)
- 11.852274865927 #(0.0 1.3396381578947 1.5141053157895 1.0596174736842 1.3775696315789 1.0144227894737 0.97558394736842 0.84338510526316 0.51587426315789 0.20564842105263 1.8757425789474 0.1296997368421 1.3820728947368 1.5737030526316 1.2890022105263 0.40582436842105 1.7981235263158 0.60319568421053 1.2357848421053 1.459955 1.9693281578947 0.11007031578947 1.4498624736842 1.4240856315789 0.82516778947369 1.4833729473684 0.15163910526316 0.7501992631579 1.9163414210526 0.69928957894737 0.5759697368421 1.6264378947368 0.27846305263158 0.89614121052631 1.0032093684211 0.4001965263158 0.78072068421053 0.068184842105268 1.416925 0.77515615789473 1.3158263157895 0.68007147368421 0.26005263157894 0.83754178947368 1.4163789473684 0.99928110526315 0.92052926315789 1.3338614210526 0.60760057894737 0.84915573684211 0.35108189473685 1.3123320526316 1.8834282105263 0.86206736842105 1.5352515263158 1.0564856842105 0.90066484210526 0.466676 1.6986391578947 0.83116831578947 0.97907447368421 0.53045763157894 1.0933637894737 1.3994029473684 1.5173721052631 1.6325612631579 0.41038242105263 0.54667057894737 1.5174607368421 0.88425489473684 1.0424270526316 0.16481221052632 1.6193943684211 0.69542352631578 0.30620268421052 0.47526884210525 1.118791 1.2213421578948 0.081729315789474 0.59135847368421 0.14031263157895 1.6890757894737 0.037147947368425 0.057790105263166 0.61730326315789 0.96595842105265 0.12006557894736 1.0562817368421 1.6149698947368 0.51522205263159 1.3750392105263 1.317418368421 1.6717875263158 1.4798766842105 0.56832384210526 1.527982 1.2948271578947 0.56427231578948 1.4007794736842 1.4577456315789 1.6950227894737 1.7377459473684 0.90868810526317 1.9790892631579 0.78902542105263 0.20112857894736 1.0722007368421 0.97300689473684 0.48697105263159 0.7127872105263 0.93851036842105 1.6893415263158 1.3540846842105 0.018221842105248)
+ 11.803769491638 #(0.0 0.99588815789474 0.82728031578947 0.03346047368421 0.039283631578947 1.3133017894737 0.93709294736842 0.45573910526316 1.7685282631579 1.1186944210526 0.44180657894737 0.33834473684211 1.2175528947368 1.1102750526316 0.50922021052632 1.2503193684211 0.35855852631579 0.71680768421053 1.0557138421053 0.910988 1.1412951578947 0.87617931578948 1.8676494736842 1.5482506315789 0.60117278947368 0.92469294736842 1.1933301052632 1.4769832631579 0.25778542105263 0.76405557894736 0.2696847368421 0.96656089473684 1.2877880526316 1.5290362105263 1.3403293684211 0.34387652631579 0.38790468421053 1.3630728421053 0.35674 1.3160451578947 1.5841333157895 0.60897147368421 1.8302256315789 1.9917527894737 0.27849294736842 1.5409951052632 1.1454202631579 1.1435374210526 0.067870578947364 0.028087736842103 1.1716218947368 1.7947190526316 0.0037352105263153 0.64602936842105 0.97844952631579 0.15825068421053 1.6898058421053 0.846813 1.7807891578947 0.50155731578948 0.3798744736842 1.5903156315789 1.7564017894737 1.7524969473684 1.5350501052632 1.2523892631579 1.7014414210526 1.5061515789474 0.20888573684211 1.1781838947368 0.95967705263158 1.7349862105263 0.81493536842105 1.6549925263158 0.88588168421052 0.66866584210527 1.021806 0.74024715789473 1.2966033157895 1.4138464736842 0.62610663157895 1.7856757894737 1.8707769473684 1.4895111052632 1.7188032631579 1.7521334210526 0.60334657894737 1.1726097368421 1.3484508947368 1.9267150526316 0.39880121052632 0.079105368421054 0.031622526315793 1.5431936842105 0.28033084210527 0.872149 0.35271515789474 1.2488533157895 1.6769884736842 1.484639631579 1.3643977894737 1.0369359473684 1.8999541052632 0.5448452631579 1.0952784210526 0.13675457894738 0.71095673684211 0.17321989473685 1.4099700526316 1.2621442105263 1.1108443684211 1.5349415263158 0.81628368421053 1.1855388421053)
)
;;; 115 even --------------------------------------------------------------------------------
@@ -4494,7 +4534,7 @@
12.124469 #(0.000000 -0.101844 1.526167 1.040742 1.526927 0.080488 1.602658 1.483052 -0.459908 -0.038895 0.795467 0.008851 -0.277377 0.337360 1.876286 0.292929 1.414530 1.605137 0.266403 0.268276 0.782042 -0.024236 1.384291 1.168997 1.869737 -0.228479 0.882177 1.618271 1.171696 0.872709 1.378093 -0.169864 0.191552 1.501933 0.888886 -0.091719 1.495681 0.219309 0.542807 0.550860 0.189947 0.140827 0.102895 1.721432 1.414137 1.813983 0.260362 1.287057 0.595302 0.196190 1.624744 1.146396 1.283547 1.587944 0.168946 0.974937 0.661164 0.586746 -0.044034 1.525222 0.833386 -0.207521 1.888113 0.102417 1.177923 0.014173 1.273258 0.509042 1.684444 1.029755 1.031756 0.630019 0.802522 1.733930 0.351432 1.630372 1.566092 1.268313 1.270650 1.787636 0.402989 1.700179 1.127993 1.663395 0.787482 0.005615 1.759743 0.303584 1.637027 1.533976 0.956211 0.881291 1.141253 1.291578 1.376154 -0.003898 0.940461 -0.032703 1.890197 0.697064 0.151305 0.844421 0.952321 0.845714 1.642460 0.490608 0.965392 0.810311 1.596525 0.148308 1.281598 0.543299 0.481803 0.130521 0.708019 1.395795 0.251578 0.984080)
- 11.965208612121 #(0.0 0.22662870762712 1.9087094152542 1.8827011228814 0.46747183050847 1.1054635381356 0.94984924576271 0.80308795338983 1.4600106610169 0.065578368644068 1.0716230762712 0.5981577838983 0.31393549152542 1.2922691991525 1.0267339067797 1.8074426144068 0.7879503220339 1.428818029661 0.44424773728814 0.74290544491525 1.5431971525424 0.78443386016949 0.25994356779661 0.65125727542373 1.2320939830508 1.445441690678 0.74391439830509 1.7284491059322 1.4951518135593 1.4608945211864 0.27938222881356 0.61948593644068 1.5110896440678 1.1059683516949 0.65170505932203 1.6251807669492 1.6297074745763 0.61919318220339 1.2299928898305 1.3583565974576 1.1983923050847 1.4024460127119 1.663350720339 1.8280404279661 1.8296401355932 0.080441843220338 0.69215955084746 0.17120925847458 1.4183239661017 1.2576466737288 1.0854123813559 0.96730808898305 1.0852077966102 1.6907925042373 0.49445621186441 1.3689629194915 1.4155756271186 1.5256773347458 0.99839104237288 0.98274275 0.36604445762712 1.5657631652542 1.9138658728814 0.38232458050847 1.6390822881356 0.99789699576271 0.27793570338983 1.7904324110169 0.84572711864407 0.69323882627119 0.82630553389831 0.79468024152543 1.1651359491525 0.20402765677966 1.2098033644068 0.6243630720339 0.85267777966102 0.65156748728814 0.88119519491525 1.5512579025424 0.61492661016949 0.13506331779661 1.7154980254237 0.40980973305085 1.896832440678 1.2920891483051 1.4616958559322 0.068077563559321 1.6158042711864 1.2785329788136 1.4886146864407 1.2582673940678 1.9486331016949 0.39827580932204 0.60293551694915 1.3495602245763 0.69208693220339 0.03120163983051 0.19901634745763 1.3663830550847 0.75847176271186 1.619281470339 0.4469281779661 1.9122288855932 1.1308755932203 0.18477530084746 0.79399200847458 0.93939671610169 0.32811242372881 0.53265013135593 0.29217083898305 1.7917475466102 1.6985662542373 1.5312979618644 0.65029466949153 1.4171983771186 0.53825308474576 1.4837717923729)
+ 11.94427607766 #(0.0 0.2862155720339 0.031014144067797 0.066667716101695 0.71146228813559 1.4118518601695 1.3074044322034 1.2173690042373 1.9333225762712 0.60597914830509 1.661075720339 1.2552312923729 1.0330598644068 0.069078436440678 1.8627970084746 0.69800158050847 1.7455761525424 0.43687372457627 1.5178582966102 1.8737408686441 0.74110144067797 0.031172012711864 1.5780305847458 0.022833156779661 0.66610072881356 0.93587830084746 0.29536687288136 1.3373614449153 1.1641610169492 1.1960735889831 0.06355916101695 0.47647673305085 1.4218203050847 1.0709248771186 0.66986244915254 1.7119380211864 1.7801945932203 0.83154816525424 1.4905247372881 1.684374309322 1.5768488813559 1.8536184533898 0.15894002542373 0.38876259745763 0.44623416949153 0.76623674152543 1.4315643135593 0.96516588559322 0.28112145762712 0.17125402966102 0.066268601694915 0.0088011737288127 0.18593874576271 0.85555731779661 1.7137178898305 0.64153046186441 0.75557503389831 0.9242886059322 0.4521921779661 0.49459575 1.9433983220339 1.1980518940678 1.6086654661017 0.12830103813559 1.4555566101695 0.86969418220339 0.20622175423729 1.7929073262712 0.89995389830508 0.80424147033898 0.99511704237288 1.0248746144068 1.4611621864407 0.55146675847458 1.6232653305085 1.0949939025424 1.3778234745763 1.2354400466102 1.5328496186441 0.26261419067797 1.3801947627119 0.95799533474576 0.59531290677966 1.3535734788136 0.89890205084746 0.36052262288136 0.58517419491525 1.2522007669492 0.85828933898305 0.58309291101695 0.85888448305085 0.68434505508475 1.4322006271186 1.9383391991525 0.20514677118644 1.0052513432203 0.41745991525424 1.8130894872881 0.044957059322037 1.2646376313559 0.71929720338983 1.6399997754237 0.52479034745762 0.041509919491524 1.3271574915254 0.45215606355932 1.1111766355932 1.3109842076271 0.76697877966102 1.0316963516949 0.84628692372882 0.40590049576271 0.37732606779661 0.26488163983051 1.4450492118644 0.26908078389831 1.4529053559322 0.45615992796611)
)
;;; 119 even --------------------------------------------------------------------------------
@@ -4503,7 +4543,7 @@
12.197901 #(0.000000 0.062772 -0.230894 -0.023186 0.137044 0.115669 0.747539 -0.016469 1.836034 0.429324 1.221476 0.835800 1.928046 0.714197 0.291508 1.145038 0.872468 0.303766 0.469804 1.742339 -0.401733 1.222324 0.207115 0.863223 0.526300 1.868195 1.624093 1.574289 1.281763 0.606577 1.673180 1.656332 -0.055371 0.713841 0.264359 0.194509 0.585495 0.993664 0.276942 0.412030 1.903785 1.344433 1.259395 1.623046 -0.551576 1.135833 -0.133608 1.057739 0.759391 1.259282 0.244461 1.664654 1.198154 1.166275 1.085676 1.322459 0.232410 0.969214 1.024215 0.320998 1.039121 0.704587 0.714973 1.008864 0.743958 -0.035347 1.357510 1.029688 0.074847 1.713622 0.991435 1.052979 0.888225 0.214659 0.721347 0.993389 0.695233 -0.304478 0.878306 1.422327 0.054718 0.884687 0.953296 1.712647 1.563591 1.738488 1.067875 1.686497 1.580518 1.184042 1.579698 0.702024 1.576476 -0.054125 0.360220 -0.197336 0.378704 1.159006 1.028114 1.193458 0.298060 1.374308 0.194132 0.612428 -0.064545 0.689271 0.387523 1.143695 -0.348251 1.965698 0.233743 0.762618 0.870385 0.341755 0.909464 1.482337 0.146037 1.171221 1.200280)
- 12.054239208962 #(0.0 0.76969537815126 1.2095587563025 0.20430713445378 1.258122512605 0.079104890756303 1.4723392689076 1.3063426470588 1.8421810252101 1.2957274033613 0.98684378151261 1.3646901596639 1.0890645378151 0.75667191596639 0.97089929411765 0.63210667226891 1.0528450504202 1.4408204285714 0.45321580672269 0.25678618487395 0.88684556302521 1.3353979411765 1.1643443193277 0.48129569747899 0.93415807563025 0.98384645378151 1.5708458319328 0.18113121008403 0.73622658823529 0.85760096638655 0.61831434453781 1.6330067226891 0.58339310084033 0.1406954789916 0.44447785714286 1.2720002352941 0.38050361344538 1.3534609915966 1.5238103697479 0.40453574789916 0.65590212605042 0.96376550420168 1.6676198823529 0.7240122605042 1.2735116386555 1.6830650168067 1.237214394958 1.2502837731092 1.7186301512605 1.1156485294118 0.74298590756302 0.89247928571429 1.1657706638655 1.9776030420168 0.65490042016807 1.7707607983193 1.1301331764706 0.99464755462185 1.6970729327731 1.5542883109244 1.3950356890756 1.8230580672269 0.23616244537816 1.5056578235294 1.8737562016807 1.8551005798319 0.24759895798319 0.75615833613445 0.47294971428572 0.66034609243697 0.83602347058824 1.6206268487395 0.20124722689076 0.37721960504201 1.8146499831933 0.83870236134453 1.1878977394958 1.1410371176471 1.0090874957983 0.048029873949574 1.7293782521008 1.1866346302521 0.13903700840336 1.6615823865546 0.29476576470588 1.2436111428571 1.1146595210084 0.61550889915966 1.3164632773109 1.7039646554622 0.89768103361344 0.68850641176471 0.29621278991596 1.4147381680672 0.68835954621849 0.85942392436975 0.24654830252101 1.7605186806723 0.35283705882353 1.4011784369748 1.0773708151261 1.1074291932773 0.67666657142857 1.9762029495798 1.9764763277311 1.5704127058823 1.7455550840336 1.3083924621849 0.89560584033613 1.7762012184874 0.89436759663865 0.07744197478992 0.96696335294118 1.2701827310924 0.69058910924369 0.15514648739496 1.3316698655462 0.93231424369748 1.9302096218487)
+ 12.036718462396 #(0.0 0.5140493697479 0.6959657394958 1.4395301092437 0.2308164789916 0.7982868487395 1.9402342184874 1.5069245882353 1.7952889579832 0.99684132773109 0.42579669747899 0.54615806722689 0.01582143697479 1.4242458067227 1.3954851764706 0.80337554621849 0.95883791596639 1.0975302857143 1.8487836554622 1.4019830252101 1.774056394958 1.9695887647059 1.5341841344538 0.59868450420168 0.79395687394958 0.58776624369748 0.91591061344538 1.2752619831933 1.5831673529412 1.4471057226891 0.95133209243697 1.7107154621849 0.40490883193277 1.7046322016807 1.7561355714286 0.32342394117647 1.1762593109244 1.8928326806723 1.8064920504202 0.44249742016807 0.43901178991597 0.49139715966387 0.93508452941176 1.7372568991597 0.032005268907564 0.18149763865546 1.4721420084034 1.2418153781513 1.4482337478992 0.60086211764706 1.959006487395 1.8544108571429 1.8761062268908 0.42405059663865 0.84724496638655 1.7083163361345 0.81332070588235 0.42810507563025 0.87764144537815 0.47811381512605 0.064951184873948 0.22733855462184 0.39175192436975 1.4011432941176 1.5122526638655 1.2383450336134 1.3775094033613 1.6310987731092 1.0887521428571 1.018322512605 0.94888988235294 1.4697032521008 1.7915326218487 1.7092649915966 0.89864836134454 1.6627677310924 1.7604681008403 1.4554264705882 1.0709898403361 1.850774210084 1.2772805798319 0.48556994957983 1.1813663193277 0.44475168907563 0.81377405882353 1.5196874285714 1.1272847983193 0.36318216806723 0.82321053781513 0.94425990756303 1.8846262773109 1.4239136470588 0.77757601680672 1.6451633865546 0.65292775630252 0.57115912605042 1.7011744957983 0.96828186554622 1.3110512352941 0.095690605042016 1.5156439747899 1.2862493445378 0.60600871428572 1.6428950840336 1.3936024537815 0.73920682352941 0.64259219327731 1.9673235630252 1.2906869327731 1.916465302521 0.77633767226891 1.7090180420168 0.32592141176471 0.3806247815126 1.5573021512605 0.7604375210084 1.6836528907563 1.0210852605042 1.7669256302521)
)
;;; 120 even --------------------------------------------------------------------------------
@@ -4523,7 +4563,7 @@
12.157683 #(0.000000 0.059763 1.666720 1.218256 0.672025 0.154875 0.916309 1.303918 0.495384 0.138934 1.916394 0.800511 0.257720 1.915678 1.822857 0.205238 0.682056 1.519945 0.147422 0.361404 1.219148 0.162136 0.398907 -0.153342 -0.288258 0.316684 1.491173 -0.205193 0.277440 -0.334620 1.749739 0.792253 0.915550 1.553009 1.203314 1.397799 0.324699 1.302033 0.145779 0.697510 0.063544 0.006244 1.223857 0.079204 1.671795 0.353459 -0.270794 1.519014 1.438884 1.316406 0.482605 1.827624 -0.154250 -0.019478 0.519099 1.560395 0.323778 1.294633 0.662858 1.227912 0.657667 0.297037 0.418416 0.048946 0.975766 0.288400 0.404737 0.972322 0.200980 -0.041432 1.205873 1.042617 1.100103 0.388073 0.739181 1.656298 -0.421720 -0.044708 0.783754 -0.072960 1.299760 0.296091 -0.368405 1.475799 1.772041 1.546627 1.244455 0.230731 0.383765 1.621325 0.728766 1.584175 0.587352 0.899458 1.331695 1.012643 1.046419 1.309046 0.103540 -0.001532 0.043263 1.562889 0.842747 1.633106 1.510290 0.150293 0.334205 0.734559 -0.045976 0.039961 0.115134 0.602101 1.044593 0.986087 -0.130790 1.387421 0.035534 0.059984 -0.080403 0.363073 1.777303)
- 11.998410221202 #(0.0 1.2387654958678 0.099563991735537 1.0438424876033 1.5791729834711 0.25197947933884 0.074228975206612 1.9913334710744 0.45317396694215 1.1973694628099 0.14335395867769 0.56602645454546 1.2118559504132 0.19003044628099 1.2212359421488 0.77805743801653 0.5380429338843 0.73635142975206 0.51446492561984 1.8344764214876 0.076976917355367 0.13522641322314 1.7972579090909 0.14798940495868 1.5459759008264 1.3791483966942 1.707784892562 1.2776733884298 0.97469788429752 1.5323913801653 0.81781787603306 1.2478793719008 0.62562686776859 0.52460336363636 1.4071828595041 0.7287793553719 0.92647185123968 1.1864233471074 1.2040228429752 1.022231338843 1.6045188347107 0.59073533057853 1.2987688264463 1.2414783223141 0.17373681818182 0.086543314049578 0.85781680991735 1.6644513057851 1.1620018016529 1.9701642975207 0.52933479338841 1.0386072892562 0.36580878512397 1.6550222809917 1.5957717768595 1.7132772727273 1.843024768595 1.7416832644628 0.47214076033057 0.38045725619834 1.0509357520661 1.9390582479339 1.2586657438017 0.14282023966943 0.067899735537182 0.90300923140497 0.049600727272718 1.9637852231405 0.13244471900828 1.314513214876 1.9053057107438 1.1453152066115 0.15137870247935 0.66395619834711 0.39763969421486 0.45340119008267 1.8301406859504 1.2536591818182 1.2832096776859 1.9888271735537 0.46958066942148 0.79165116528924 1.401541661157 0.16822015702479 1.7929666528925 0.88739914876035 1.7599316446281 1.9908221404959 1.2574856363636 1.8179551322314 0.16057562809917 0.25455012396696 0.5876626198347 0.13491611570248 1.8609276115703 0.72608510743802 1.8653126033058 1.4404980991735 1.4000055950413 0.44513309090908 0.017195586776836 0.54959508264466 1.4878895785124 1.3783330743802 0.52431757024794 0.3391540661157 1.6623865619835 1.1754560578512 1.641362553719 1.0567110495868 0.35504554545457 0.1674470413223 1.8009575371901 0.99324703305783 1.1025895289256 1.5629450247934 1.5694955206611 0.99870801652895 1.9735125123967 1.8867130082645 0.067146504132239)
+ 11.986011240286 #(0.0 0.085227272727273 1.7988725454545 1.5797318181818 0.96805309090909 0.47713036363636 1.1563886363636 1.9179659090909 1.2299791818182 0.81440945454545 0.60712072727273 1.874334 1.3643332727273 1.1958395454545 1.0631568181818 1.4693560909091 0.083772363636363 1.1249986363636 1.7496819090909 1.9138791818182 1.0010004545455 1.9056177272727 0.4152 1.6144342727273 1.8669515454545 0.53896081818182 1.7192270909091 0.12860836363636 0.66989263636364 0.081629909090909 0.21177718181818 1.4844184545455 1.7063767272727 0.461415 0.18122727272727 0.36114454545454 1.3971268181818 0.50666309090909 1.3702293636364 0.031292636363636 1.4632649090909 1.3053981818182 0.85533845454545 1.6422837272727 1.423958 0.17121627272727 1.8021895454545 1.4459498181818 1.7881880909091 1.4501273636364 0.85532263636364 0.20735590909091 0.38335218181818 0.51925945454545 1.3010787272727 0.27307 1.2497952727273 1.9919975454545 1.5648058181818 0.32314509090909 1.8389853636364 1.5725896363636 1.7345389090909 1.4668001818182 0.24186145454545 1.9229277272727 1.914405 0.67624127272727 1.6996815454545 1.7173498181818 1.1535200909091 1.2436383636364 1.1017536363636 0.46166690909091 1.0346751818182 1.9364814545455 0.16616272727273 0.438345 1.3085552727273 0.85772954545454 0.18766081818182 1.3515080909091 0.80514336363636 0.42036863636364 0.89480590909091 0.83728318181818 0.54369945454545 1.6241997272727 1.7442 1.1485762727273 0.34087654545455 1.2863068181818 0.47061809090909 0.85827636363636 1.4301886363636 1.1368359090909 1.1178671818182 1.5531844545455 0.35611472727273 0.246136 0.65727227272727 0.039933545454545 1.8188598181818 0.56597109090909 0.55109236363636 1.2233546363636 1.3873289090909 1.7422751818182 1.0646034545455 1.3270137272727 1.464733 0.12678127272727 0.59467054545454 0.64017881818182 1.5977000909091 0.90787036363636 1.7608156363636 0.035412909090908 1.8599061818182 0.62088745454546 1.6327527272727)
)
;;; 122 even --------------------------------------------------------------------------------
@@ -4570,7 +4610,7 @@
12.496996 #(0.000000 0.043702 1.208303 1.354701 1.420749 0.540685 -0.012542 0.620860 0.334785 0.647306 0.981098 1.023731 1.860482 1.434667 0.843218 1.553274 0.893912 1.566878 1.629090 1.531618 0.459282 -0.871897 0.850404 -0.122459 0.824325 0.173998 1.763771 0.141679 1.631798 0.015339 0.124197 0.337347 0.156508 0.448075 0.156007 0.131808 1.166853 -0.184664 1.435711 0.979083 1.561752 0.046495 0.760019 0.210722 1.816800 1.817598 0.259865 0.324996 1.361265 0.861626 1.210521 1.577801 1.419723 1.659738 1.058148 0.850366 0.818485 0.094797 0.620677 1.247684 0.485557 -0.340825 0.063081 0.174775 0.219721 1.129656 0.676973 0.760106 0.565893 0.894092 1.264752 1.388040 0.788329 0.299885 1.340501 0.778336 0.097679 1.273185 1.394099 1.514751 0.459616 0.784483 1.090003 0.014569 0.481415 -0.199532 0.997466 0.132132 1.516462 1.863074 1.054286 1.250663 1.812057 0.471105 0.707174 -0.613582 0.820175 0.779698 1.774273 0.278986 1.040204 1.049339 0.966633 0.163475 0.332859 0.408581 1.621383 0.023523 1.367312 1.749255 0.805369 1.571926 0.510583 -0.159182 1.420442 0.886683 -0.053010 0.563299 1.128697 1.048473 0.946568 1.646947 1.636124 1.279848 0.689700 0.608960)
- 12.44782008665 #(0.0 0.11755952380952 1.499634047619 1.6675925714286 1.9353100952381 1.0498696190476 0.77545714285714 1.4741996666667 1.2401821904762 1.4704087142857 0.26003123809524 0.43052676190476 1.4168982857143 0.95727180952381 0.63579833333333 1.4567038571429 0.83210638095238 1.7566889047619 1.7529874285714 1.900950952381 0.90495447619048 1.805215 1.2949505238095 0.53428404761905 1.6956555714286 1.0818590952381 0.80445661904762 1.3086371428571 0.96294866666667 1.4326101904762 1.4725897142857 1.9918872380952 1.9263027619048 1.9973072857143 0.25429480952381 0.12776933333333 1.4935328571429 0.18442738095238 1.8710189047619 1.5589044285714 0.42348795238095 0.67685347619048 1.764269 1.0838875238095 0.97783504761905 1.0136135714286 1.6441850952381 1.7900566190476 1.0766081428571 0.72056066666667 1.0756801904762 1.5286067142857 1.6054252380952 1.8334267619048 1.5131082857143 1.3072598095238 1.4721403333333 0.68776885714286 1.3279303809524 0.083368904761905 1.4783774285714 0.73117695238095 1.4005744761905 1.698731 1.6127655238095 0.84984204761905 0.53003757142857 0.7069720952381 0.46365561904762 1.0879851428571 1.4811296666667 1.6986331904762 1.1969097142857 0.96351423809524 0.067532761904762 1.6812562857143 0.86975180952381 0.26539333333333 0.57301285714286 0.88733038095238 1.8383509047619 0.33587642857143 0.68692995238095 1.7609514761905 0.346331 1.8545045238095 1.255957047619 0.26113457142857 1.6916150952381 0.33451361904762 1.6079471428571 0.002398666666668 0.67006719047619 1.3225267142857 1.5534622380952 0.61949376190476 0.21134728571429 0.22142980952381 1.2759623333333 1.8904128571429 0.80464038095238 0.9094329047619 0.87244642857143 0.14836295238095 0.52767147619048 0.803872 0.24986552380952 0.53918304761905 1.8633225714286 0.55681009523809 1.6238736190476 0.46201014285714 1.6482336666667 1.1668731904762 0.85004071428571 0.45969123809524 1.7066807619048 0.26831928571429 0.92831980952381 1.1981253333333 1.0318948571429 1.8091753809524 0.2469889047619 1.7650954285714 1.298992952381 1.4138494761905)
+ 12.401357608606 #(0.0 1.7734375 0.746467 0.6110195 0.580232 1.3741655 0.662093 1.0645335 0.481088 0.3356215 0.826735 0.6607695 1.331697 0.5441475 1.81337 0.2767245 1.331229 1.9415465 1.517627 1.3793725 0.008267 0.5899335 1.715001 0.6783905 1.452253 0.4623785 1.863351 0.077460500000001 1.358552 1.4385845 1.186282 1.3663085 0.89344800000001 0.7133675 0.60720500000001 0.1178745 1.107802 1.4105865 0.829128 0.1692165 0.623331 0.5621945 1.308932 0.26842449999999 1.902499 1.5459865 1.885131 1.6768275 0.549075 1.8677305 1.884977 1.9875895 1.699181 1.5980185 0.939417 0.32517250000001 0.221126 1.1135205 1.350971 1.7993505 0.82412000000001 1.7212375 0.097027999999995 0.029675499999996 1.564208 0.44961949999998 1.830507 1.6735905 1.120597 1.3883655 1.415592 1.2907895 0.46601799999999 1.8331815 0.628676 1.8921235 0.78510599999998 1.7849855 1.750164 1.6900285 0.33839499999999 0.5219725 0.51655300000002 1.1515915 1.407915 0.53246850000001 1.672219 0.37259449999999 1.450828 1.7318245 0.63243199999999 0.6720785 0.98700300000002 1.3408155 1.18298 1.9290315 1.186661 0.87072549999999 1.569671 1.8495435 0.39748799999998 0.21101349999999 1.83465 0.73826050000001 0.661706 0.6644225 1.722684 1.7371445 0.706734 1.0531465 1.798889 0.23331449999999 1.144698 0.25723550000001 1.663092 0.93512949999999 1.853311 0.04995550000001 0.315415 0.2804565 1.720787 0.13918649999999 0.29213999999999 1.4363025 0.64692300000002 0.48012749999998)
)
;;; 127 even --------------------------------------------------------------------------------
@@ -4580,7 +4620,7 @@
12.433433 #(0.000000 0.001039 0.794589 0.480502 1.208764 0.770971 1.073324 1.674362 1.759250 1.653246 0.687630 0.117389 1.757594 0.396153 0.742139 -0.145275 0.150278 0.989943 0.871445 1.284923 0.503406 1.468297 0.547288 0.717952 0.333519 0.467563 0.859810 0.710502 0.157439 -0.056125 1.830397 0.438027 1.628650 1.381862 1.053617 0.920360 0.822025 0.688382 0.334613 1.051817 1.027260 0.203568 0.917096 0.646127 1.008962 0.965638 0.659078 1.314658 1.103724 0.240444 1.161698 0.495615 0.015437 0.971561 0.222253 0.342979 1.441628 1.676417 1.250376 1.121554 0.560005 1.503617 0.874148 1.197806 0.599591 1.638135 1.294060 1.377340 1.250695 0.193947 0.461795 0.268431 0.454564 1.602492 -0.056376 0.853305 0.018596 0.077381 0.484563 0.721471 0.176812 0.446403 0.825071 0.310039 0.502119 1.338224 1.729751 0.207977 0.303827 1.102208 0.966639 -0.018319 1.909312 1.729043 0.150613 1.106267 1.608811 1.055529 1.617021 1.672950 -0.451767 0.290000 1.734544 0.181495 -0.125976 0.874095 0.964353 0.807511 -0.067029 0.794199 0.120181 1.440997 0.424676 1.073894 -0.135463 0.688492 1.074206 -0.267919 1.540866 0.725381 0.727642 1.052285 0.292076 -0.070293 0.145539 1.020900 0.791555)
- 12.330872369834 #(0.0 0.088767224409449 0.9829674488189 0.57564367322835 1.5799788976378 1.2664641220472 1.5115493464567 0.32209957086614 0.51237879527559 0.70114501968504 1.6938652440945 0.91971646850394 0.82652369291339 1.4888429173228 0.0075921417322835 1.1178093661417 1.5071745905512 0.46472781496063 0.58268503937008 0.91430926377953 0.25536148818898 1.3787257125984 0.56963393700787 0.80408416141732 0.28783238582677 0.75519361023622 1.2885028346457 1.2014960590551 0.57354428346457 0.58372850787402 0.67924473228346 1.2456379566929 0.54968318110236 0.20450440551181 0.09734662992126 0.060720854330709 0.11131307874016 1.9311653031496 1.8412725275591 0.7003747519685 0.58846197637795 1.7983702007874 0.42880142519685 0.3302346496063 1.0507228740157 0.9312810984252 0.81052832283465 1.5255105472441 1.3862127716535 0.49345599606299 1.6579342204724 1.0782794448819 0.91020366929134 1.6227838937008 0.91948511811024 1.2236503425197 0.46040156692913 0.57878679133858 0.32668301574803 0.24522024015748 1.9296464645669 0.68711468897638 0.55527591338583 0.81129013779528 0.34513636220472 1.5108825866142 1.0977448110236 1.2573540354331 1.4639012598425 0.35647148425197 0.65203670866142 0.71225693307087 0.94209115748031 0.28891138188976 0.66119760629921 1.5689328307087 0.84586205511811 0.75380227952756 1.272565503937 1.8585557283465 1.1768789527559 1.7019231771654 0.040551401574803 1.6042426259843 1.9918738503937 0.93065707480315 1.3283682992126 0.15835152362205 1.9473937480315 1.1010409724409 1.0874311968504 1.9841054212598 1.9557776456693 0.04513787007874 0.60330109448819 1.3938623188976 0.070970543307087 1.5582657677165 0.36025299212598 0.28467121653543 0.29675944094488 1.2781116653543 0.89158988976378 1.5830861141732 1.0465123385827 0.28045756299213 0.52763578740157 0.18083501181102 1.6782832362205 0.61802346062992 0.008813685039371 1.3507469094488 0.20480113385827 1.2875273582677 0.089223582677166 0.91653380708662 1.5024400314961 0.41594425590551 0.21732548031496 1.2780667047244 1.4206029291339 1.7693901535433 1.2852013779528 0.8270546023622 1.1174278267717 0.2568980511811 0.0063172755905523)
+ 12.30257214351 #(0.0 0.43922244094488 1.6862278818898 1.6317353228346 1.0025297637795 1.0126302047244 1.6208786456693 0.77186508661417 1.3087345275591 1.8495249685039 1.1866324094488 0.7781288503937 1.0293792913386 0.062711732283464 0.91089217322835 0.37337661417323 1.1092750551181 0.41124649606299 0.89401193700787 1.5787313779528 1.2721478188976 0.72214125984252 0.2927917007874 0.87523314173228 0.68998758267717 1.517879023622 0.41697146456693 0.65816390551181 0.38999134645669 0.73172778740157 1.2012362283465 0.09235566929134 1.7893961102362 1.7547475511811 0.029369992125982 0.31799643307087 0.73455287401575 0.89483231496063 1.1564337559055 0.37706719685039 0.61516063779527 0.17021207874016 1.139038519685 1.3897089606299 0.4611384015748 0.68391484251969 0.93484628346457 1.9879847244095 0.21046616535433 1.6567816062992 1.1726050472441 0.96375048818897 1.1437379291339 0.18946237007874 1.8571348110236 0.50164925196851 0.096263692913382 0.55087113385827 0.66872257480315 0.92129801574803 0.95791045669291 0.062725897637794 0.27791333858268 0.89190777952756 0.77772722047244 0.29649366141732 0.2255591023622 0.72630254330709 1.290245984252 0.53272042519685 1.1965308661417 1.5963443070866 0.18150274803149 1.8474701889764 0.57929962992126 1.8570880708661 1.480848511811 1.7392919527559 0.60281839370079 1.5481688346457 1.2012492755905 0.085552716535432 0.77950115748032 0.68407459842519 1.4269730393701 0.71659348031496 1.4686529212598 0.65883536220472 0.78537780314961 0.29193424409449 0.63450768503937 1.8786711259842 0.18769656692913 0.62802600787402 1.5486074488189 0.68529388976378 1.7207173307087 1.5596907716535 0.71106121259843 0.9597136535433 1.3413550944882 0.66247353543307 0.63821997637795 1.6894714173228 1.4648778582677 1.0901882992126 1.6647377401575 1.6846451811024 1.5246896220472 0.81916306299213 0.55831950393701 0.23436494488189 1.4621723858268 0.89565882677165 0.051744267716529 1.2246797086614 0.1663511496063 1.4105805905512 1.5693240314961 0.98731947244094 1.4703719133858 0.17406835433071 0.051964795275588 1.9339972362205 0.56767967716536 0.066256118110232 0.15666555905512)
)
;;; 128 even --------------------------------------------------------------------------------
@@ -4641,17 +4681,17 @@
(do ((i 0 (+ i 3))
(j 0 (+ j 1)))
((= i 72))
- (vct-set! cos-phases i (+ j 1))
- (vct-set! sin-phases i (+ j 1))
- (vct-set! cos-phases (+ i 1) 1.0)
- (vct-set! sin-phases (+ i 1) 1.0)
- (vct-set! cos-phases (+ i 2) (* pi (vct-ref c-phases j)))
- (vct-set! sin-phases (+ i 2) (* pi (vct-ref s-phases j))))
+ (set! (cos-phases i) (+ j 1))
+ (set! (sin-phases i) (+ j 1))
+ (set! (cos-phases (+ i 1)) 1.0)
+ (set! (sin-phases (+ i 1)) 1.0)
+ (set! (cos-phases (+ i 2)) (* pi (c-phases j)))
+ (set! (sin-phases (+ i 2)) (* pi (s-phases j))))
(let ((gen1 (make-polyoid 100.0 cos-phases))
(gen2 (make-polyoid 100.0 sin-phases)))
(run
- (do ((i 0 (1+ i)))
+ (do ((i 0 (+ 1 i)))
((= i 88200))
(outa i (polyoid gen1 0.0))
(outb i (polyoid gen2 0.0)))))))
@@ -4666,7 +4706,7 @@
((or (= i len)
result)
result)
- (set! result (func (vector-ref vect i))))))
+ (set! result (func (vect i))))))
(define low-primes (vector 1
2 3 5 7 11 13 17 19 23
@@ -4703,12 +4743,12 @@
(define (get-fft-size choice n1)
(let ((n (if (eq? choice :all) n1
(if (not (eq? choice :prime)) (* 2 n1)
- (vector-ref low-primes n1)))))
+ (low-primes n1)))))
(min (expt 2 16)
(expt 2 (ceiling (/ (log (* n 64)) (log 2)))))))
(define (random n)
- (if (exact? n)
+ (if (rational? n)
(mus-irandom n)
(mus-frandom n)))
@@ -4718,9 +4758,9 @@
(define (save-case n choice peak phases)
(let ((fd (open-output-file data-file "a")))
(format fd "~%;~A: ~A ~A #(" n choice peak)
- (do ((m 0 (1+ m)))
+ (do ((m 0 (+ 1 m)))
((= m n))
- (if (zero? (vct-ref phases m))
+ (if (zero? (phases m))
(format fd "0")
(format fd "1"))
(if (< m (- n 1))
@@ -4748,14 +4788,14 @@
(let ((min-val (vector-find-if (lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) n)
- (let ((a-val (vector-ref val 1))
+ (= (val 0) n)
+ (let ((a-val (val 1))
(a-len (vector-length val)))
- (do ((k 2 (1+ k)))
+ (do ((k 2 (+ 1 k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
- (set! a-val (vector-ref val k))))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
a-val)))
(if (eq? choice :all)
noid-min-peak-phases
@@ -4775,34 +4815,34 @@
(run
(lambda ()
- (do ((try 0 (1+ try)))
+ (do ((try 0 (+ 1 try)))
((= try tries))
- (do ((i 1 (1+ i)))
+ (do ((i 1 (+ 1 i)))
((= i n))
(if (> (random 1.0) 0.5)
- (vct-set! phases i pi)
- (vct-set! phases i 0.0)))
+ (set! (phases i) pi)
+ (set! (phases i) 0.0)))
(clear-array fft-rl)
(clear-array fft-im)
(do ((k 0 (+ k 1)))
((= k n))
- (let ((phi (+ (vct-ref phases k) pi2))
+ (let ((phi (+ (phases k) pi2))
(bin (if (= nc 0) (+ k 1)
(if (= nc 1) (+ 1 (* k 2))
(if (= nc 2) (max 1 (* k 2))
- (vector-ref low-primes k))))))
- (vct-set! fft-rl bin (cos phi))
- (vct-set! fft-im bin (sin phi))))
+ (low-primes k))))))
+ (set! (fft-rl bin) (cos phi))
+ (set! (fft-im bin) (sin phi))))
(let ((peak (vct-peak (mus-fft fft-rl fft-im size -1))))
(if (< peak cur-min)
(begin
(save-case n choice peak phases)
(format #t ";~A: ~A ~A #(" n choice peak)
- (do ((m 0 (1+ m)))
+ (do ((m 0 (+ 1 m)))
((= m n))
- (if (zero? (vct-ref phases m))
+ (if (zero? (phases m))
(format #t "0")
(format #t "1"))
(if (< m (- n 1))
@@ -4837,17 +4877,17 @@
(let* ((min-val (vector-find-if (lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) n)
- (let ((a-val (vector-ref val 1))
+ (= (val 0) n)
+ (let ((a-val (val 1))
(a-len (vector-length val))
- (a-data (vector-ref val 2)))
- (do ((k 3 (1+ k)))
+ (a-data (val 2)))
+ (do ((k 3 (+ 1 k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
+ (if (and (number? (val k))
+ (< (val k) a-val))
(begin
- (set! a-val (vector-ref val k))
- (set! a-data (vector-ref val (+ k 1))))))
+ (set! a-val (val k))
+ (set! a-data (val (+ k 1))))))
(list a-val a-data))))
(if (eq? choice :all)
noid-min-peak-phases
@@ -4872,35 +4912,35 @@
(do ((i 1 (+ i 1)))
((= i n))
- (let ((old-val (vector-ref cur-phases i)))
+ (let ((old-val (cur-phases i)))
(do ((k 0 (+ k 1)))
((> k inc))
(if (not (= old-val (/ k inc)))
(begin
- (vector-set! cur-phases i (/ k inc))
+ (set! (cur-phases i) (/ k inc))
(clear-array fft-rl)
(clear-array fft-im)
(do ((m 0 (+ m 1)))
((= m n))
- (let ((phi (+ (* pi (vector-ref cur-phases m)) pi2))
+ (let ((phi (+ (* pi (cur-phases m)) pi2))
(bin (if (= nc 0) (+ m 1)
(if (= nc 1) (+ 1 (* m 2))
(if (= nc 2) (max 1 (* m 2))
- (vector-ref low-primes m))))))
- (vct-set! fft-rl bin (cos phi))
- (vct-set! fft-im bin (sin phi))))
+ (low-primes m))))))
+ (set! (fft-rl bin) (cos phi))
+ (set! (fft-im bin) (sin phi))))
(let ((peak (vct-peak (mus-fft fft-rl fft-im size -1))))
(if (< peak min-phase)
(begin
- (do ((m 0 (1+ m)))
+ (do ((m 0 (+ 1 m)))
((= m n))
- (vector-set! min-phases m (vector-ref cur-phases m)))
+ (set! (min-phases m) (cur-phases m)))
(set! min-phase peak))))
- (vector-set! cur-phases i old-val))))))
+ (set! (cur-phases i) old-val))))))
;(format #t "~D: ~A~%" inc min-phase)
@@ -4908,7 +4948,7 @@
(begin
(do ((m 0 (+ m 1)))
((= m n))
- (vector-set! cur-phases m (vector-ref min-phases m)))
+ (set! (cur-phases m) (min-phases m)))
(set! cur-min min-phase)
(if (= inc 1)
(format #t ";~A: ~A ~A ~A~%" n choice cur-min cur-phases)))
@@ -5034,22 +5074,22 @@
((or (= i len)
result)
result)
- (set! result (func (vector-ref vect i))))))
+ (set! result (func (vect i))))))
(vector-find-if (lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) n)
- (let ((a-val (vector-ref val 1))
+ (= (val 0) n)
+ (let ((a-val (val 1))
(a-len (vector-length val))
- (a-data (vector-ref val 2)))
- (do ((k 3 (1+ k)))
+ (a-data (val 2)))
+ (do ((k 3 (+ 1 k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
+ (if (and (number? (val k))
+ (< (val k) a-val))
(begin
- (set! a-val (vector-ref val k))
- (set! a-data (vector-ref val (+ k 1))))))
+ (set! a-val (val k))
+ (set! a-data (val (+ k 1))))))
(list a-val a-data))))
(if (eq? choice :all)
noid-min-peak-phases
@@ -5074,14 +5114,14 @@
(set! last this)
(set! this next)
(set! next (car (get-best choice (+ i 1))))
- (vector-set! diffs (- i 12) (cons i (+ (- this last) (- this next))))
+ (set! (diffs (- i 12)) (cons i (+ (- this last) (- this next))))
(set! total (+ total (abs (- this last)))))
(sort! diffs (lambda (a b)
(> (cdr a) (cdr b))))
(do ((i (- choices 1) (- i 1)))
((< i 0))
- (let ((c (vector-ref diffs i)))
- (set! choice-list (cons (vector-ref diffs i) choice-list))))
+ (let ((c (diffs i)))
+ (set! choice-list (cons (diffs i) choice-list))))
(list choice-list (- (+ total first) this)))) ; first to this would be a straight line
@@ -5153,7 +5193,7 @@
(let ((phases (sort! (list pk1 pk2 pk3 pk4)
(lambda (a b)
- (< (vector-ref a 1) (vector-ref b 1))))))
+ (< (a 1) (b 1))))))
(format #t "~,8F~% ~A~% ~A~% ~A~% ~A~%"
(car data)
(list-ref phases 0)
@@ -5178,26 +5218,35 @@
;; 1 Feb 4292.451, 0.524
;; 1 Mar 4280.782, 0.524
;; 1 Apr 4272.964, 0.523
-;; 1 May
+;; 1 May 4267.719, 0.523
+;; 1 Jun 4261.356, 0.523
-; all 0.4861 (20) to 0.5086 (94), dist: 7.5434
-; odd 0.4821 (11) to 0.5098 (125), dist: 15.5869
+; all 0.4861 (20) to 0.5076 (94), dist: 6.3076
+; odd 0.4821 (11) to 0.5092 (125), dist: 12.0591
; even 0.5158 (64) to 0.5244 (22), dist: 86.9326
; prime 0.5449 (24) to 0.5712 (117), dist: 288.4718
+; all 0.4861 (20) to 0.5070 (94), dist: 5.6759
+; odd 0.4821 (11) to 0.5061 (119), dist: 7.2783
+; even 0.5158 (64) to 0.5244 (22), dist: 86.5343
+; prime 0.5449 (24) to 0.5712 (117), dist: 288.4718
+
+
+
;(test-all-phases #f) in test-phases.scm
-;all peaks... Fri 02-Apr-2010 02:56
+
+;all peaks... Mon 31-May-2010 04:17
;all 512: peak-phases value: 31.391244, current: 31.393507890848, diff: 0.0022638908477184
;all 1024: peak-phases value: 49.867216, current: 49.863543040531, diff: -0.0036729594690925
-
-;odd peaks... Fri 02-Apr-2010 03:42
+;odd peaks... Mon 31-May-2010 05:20
;odd 2048: peak-phases value: 78.937441, current: 78.931916185936, diff: -0.0055248140642448
-
-;even peaks... Fri 02-Apr-2010 04:23
+;even peaks... Mon 31-May-2010 06:17
;even 256: peak-phases value: 21.147051, current: 21.149844044205, diff: 0.0027930442051805
;even 512: peak-phases value: 31.628149, current: 31.625265493922, diff: -0.0028835060781311
;even 1024: peak-phases value: 51.627202, current: 51.61731817532, diff: -0.0098838246798678
;even 2048: peak-phases value: 78.079325, current: 78.055349684919, diff: -0.023975315080548
+;prime peaks... Mon 31-May-2010 07:15
+;prime 256: peak-phases value: 25.419292, current: 25.416395401039, diff: -0.0028965989614846
+;all done! Mon 31-May-2010 07:51
-;prime peaks... Fri 02-Apr-2010 05:14
-;primes.scm dropped the 1 somehow!
+;;; gad161: clean-up-evens
diff --git a/pix/8.png b/pix/8.png
new file mode 100644
index 0000000..938f891
--- /dev/null
+++ b/pix/8.png
Binary files differ
diff --git a/pix/88.png b/pix/88.png
new file mode 100644
index 0000000..446c8aa
--- /dev/null
+++ b/pix/88.png
Binary files differ
diff --git a/pix/sqrt.png b/pix/sqrt.png
index c9d035a..8a5df56 100644
--- a/pix/sqrt.png
+++ b/pix/sqrt.png
Binary files differ
diff --git a/pix/sqrt1.png b/pix/sqrt1.png
index 66d3358..9101d52 100644
--- a/pix/sqrt1.png
+++ b/pix/sqrt1.png
Binary files differ
diff --git a/play.scm b/play.scm
index b528a63..35a4a67 100644
--- a/play.scm
+++ b/play.scm
@@ -115,14 +115,17 @@
;;; -------- play region over and over until C-g typed
-(define (play-region-forever reg)
+(define (play-region-forever reg1)
"(play-region-forever reg) plays region 'reg' until you interrupt it via C-g"
- (define (play-region-again reason)
- (if (and (not (c-g?)) ; be extra careful (probably superfluous)
- (= reason 0)) ; 0=play completed normally
- (play-region reg #f play-region-again)))
- (play-region reg #f play-region-again))
+ (let ((reg (if (integer? reg1) (integer->region reg1) reg1)))
+
+ (define (play-region-again reason)
+ (if (and (not (c-g?)) ; be extra careful (probably superfluous)
+ (= reason 0)) ; 0=play completed normally
+ (play reg :wait #f :stop play-region-again)))
+
+ (play reg :wait #f :stop play-region-again)))
;(bind-key #\p 0 (lambda (n) "play region forever" (play-region-forever (list-ref (regions) (max 0 n)))))
@@ -201,7 +204,7 @@ read, even if not playing. 'files' is a list of files to be played."
(begin
(do ((i 0 (+ 1 i)))
((= i files-len))
- (vector-set! pframes i (frames (list-ref files i))))
+ (set! (pframes i) (frames (list-ref files i))))
(catch #t
(lambda ()
(while reading
@@ -210,9 +213,9 @@ read, even if not playing. 'files' is a list of files to be played."
(let* ((ramp-down 1.0)
(ramp (/ 1.0 bufsize))
(current (list-ref readers current-file))
- (current-loc (vector-ref locs current-file))
+ (current-loc (locs current-file))
(next (list-ref readers next-file))
- (next-loc (vector-ref locs next-file))
+ (next-loc (locs next-file))
(downs (channels current))
(ups (channels next))
(up (make-frame ups))
@@ -234,13 +237,13 @@ read, even if not playing. 'files' is a list of files to be played."
(if read-even-when-not-playing
(do ((i 0 (+ 1 i)))
((= i files-len))
- (vector-set! locs i (+ (vector-ref locs i) bufsize)))
+ (set! (locs i) (+ (locs i) bufsize)))
(begin
- (vector-set! locs current-file (+ (vector-ref locs current-file) bufsize))
- (vector-set! locs next-file (+ (vector-ref locs next-file) bufsize))))
+ (set! (locs current-file) (+ (locs current-file) bufsize))
+ (set! (locs next-file) (+ (locs next-file) bufsize))))
(set! current-file next-file))
(let* ((current (list-ref readers current-file))
- (current-loc (vector-ref locs current-file))
+ (current-loc (locs current-file))
(ons (channels current))
(on (make-frame ons)))
(do ((i 0 (+ 1 i)))
@@ -252,15 +255,15 @@ read, even if not playing. 'files' is a list of files to be played."
(if read-even-when-not-playing
(do ((i 0 (+ 1 i)))
((= i files-len))
- (vector-set! locs i (+ (vector-ref locs i) bufsize)))
- (vector-set! locs current-file (+ (vector-ref locs current-file) bufsize)))))
+ (set! (locs i) (+ (locs i) bufsize)))
+ (set! (locs current-file) (+ (locs current-file) bufsize)))))
(mus-audio-write out-port data bufsize)
(set! reading (and (not (c-g?))
(letrec ((any-data-left
(lambda (f)
(if (= f files-len)
#f
- (or (< (vector-ref locs f) (vector-ref pframes f))
+ (or (< (locs f) (pframes f))
(any-data-left (+ 1 f)))))))
(any-data-left 0)))))))
(lambda args (begin (snd-print (format #f "error ~A" args)) (car args))))
@@ -303,7 +306,7 @@ amp: (play-with-amps 0 1.0 0.5) plays channel 2 of stereo sound at half amplitud
(let* ((len 22050)
(osc (make-oscil freq)))
(play (lambda ()
- (set! len (1- len))
+ (set! len (- len 1))
(if (<= len 0)
#f
(* amp (oscil osc)))))))
@@ -317,16 +320,16 @@ amp: (play-with-amps 0 1.0 0.5) plays channel 2 of stereo sound at half amplitud
(amps (make-vector num-oscs)))
(do ((i 0 (+ 1 i)))
((= i num-oscs))
- (vector-set! oscs i (make-oscil (car (list-ref freqs-and-amps i))))
- (vector-set! amps i (cadr (list-ref freqs-and-amps i))))
+ (set! (oscs i) (make-oscil (car (list-ref freqs-and-amps i))))
+ (set! (amps i) (cadr (list-ref freqs-and-amps i))))
(play (lambda ()
- (set! len (1- len))
+ (set! len (- len 1))
(if (<= len 0)
#f
(let ((sum 0.0))
(do ((i 0 (+ 1 i)))
((= i num-oscs))
- (set! sum (+ sum (* (vector-ref amps i) (oscil (vector-ref oscs i))))))
+ (set! sum (+ sum (* (amps i) (oscil (oscs i))))))
sum))))))
;(play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
diff --git a/poly.scm b/poly.scm
index dd49af4..de4113f 100644
--- a/poly.scm
+++ b/poly.scm
@@ -14,7 +14,7 @@
(let ((len (min (length p1) (length p2))))
(do ((i 0 (+ i 1)))
((= i len))
- (vector-set! p1 i (+ (vector-ref p1 i) (vector-ref p2 i))))
+ (set! (p1 i) (+ (p1 i) (p2 i))))
p1))
(define (vector-scale! p1 scl)
@@ -22,7 +22,7 @@
(let ((len (length p1)))
(do ((i 0 (+ i 1)))
((= i len))
- (vector-set! p1 i (* scl (vector-ref p1 i))))
+ (set! (p1 i) (* scl (p1 i))))
p1))
(define (vector-copy p1)
@@ -31,15 +31,15 @@
(v (make-vector len)))
(do ((i 0 (+ i 1)))
((= i len))
- (vector-set! v i (vector-ref p1 i)))
+ (set! (v i) (p1 i)))
v))
(define (poly-as-vector-eval v x)
"(poly-as-vector-eval v x) treats 'v' as a vector of polynomial coefficients, returning the value of the polynomial at x"
- (let ((sum (vector-ref v (- (length v) 1))))
+ (let ((sum (v (- (length v) 1))))
(do ((i (- (length v) 2) (- i 1)))
((< i 0) sum)
- (set! sum (+ (* sum x) (vector-ref v i))))))
+ (set! sum (+ (* sum x) (v i))))))
(define (poly-as-vector-reduce p1)
@@ -47,18 +47,18 @@
;; always return at least a 0 coeff (rather than return #f=0 polynomial)
(let ((new-len (do ((i (- (length p1) 1) (- i 1)))
((or (= i 0)
- (not (= (vector-ref p1 i) 0.0)))
+ (not (= (p1 i) 0.0)))
(+ i 1)))))
(if (= new-len (length p1))
p1
(let ((np (make-vector new-len)))
(do ((i 0 (+ i 1)))
((= i new-len))
- (vector-set! np i (vector-ref p1 i)))
+ (set! (np i) (p1 i)))
np))))
(define (poly-reduce p1)
- "(poly-reduce p1) removes trailing (high-degree) zeros from the vector or vct p1"
+ "(poly-reduce p1) removes trailing (high-degree) zeros from the vct p1"
(if (= (vct-ref p1 (- (length p1) 1)) 0.0)
(vector->vct (poly-as-vector-reduce (vct->vector p1)))
p1))
@@ -76,10 +76,10 @@
(vector-add! (vector-copy p1) p2)
(vector-add! (vector-copy p2) p1))
(let ((v (vector-copy p1)))
- (vector-set! v 0 (+ (vector-ref v 0) p2))
+ (set! (v 0) (+ (v 0) p2))
v))
(let ((v (vector-copy p2)))
- (vector-set! v 0 (+ (vector-ref v 0) p1))
+ (set! (v 0) (+ (v 0) p1))
v)))
(define (poly+ p1 p2)
@@ -106,7 +106,7 @@
((= i p1len))
(do ((j 0 (+ 1 j)))
((= j p2len))
- (vector-set! m (+ i j) (+ (vector-ref m (+ i j)) (* (vector-ref p1 i) (vector-ref p2 j))))))
+ (set! (m (+ i j)) (+ (m (+ i j)) (* (p1 i) (p2 j))))))
m)
(vector-scale! (vector-copy p1) p2))
(vector-scale! (vector-copy p2) p1)))
@@ -139,18 +139,18 @@
(q (make-vector len 0)))
(do ((i 0 (+ i 1)))
((= i len))
- (vector-set! r i (vector-ref p1 i)))
+ (set! (r i) (p1 i)))
(let ((n (- p1len 1))
(nv (- p2len 1)))
(do ((k (- n nv) (- k 1)))
((< k 0))
- (vector-set! q k (/ (vector-ref r (+ nv k)) (vector-ref p2 nv)))
+ (set! (q k) (/ (r (+ nv k)) (p2 nv)))
(do ((j (+ nv k -1) (- j 1)))
((< j k))
- (vector-set! r j (- (vector-ref r j) (* (vector-ref q k) (vector-ref p2 (- j k)))))))
+ (set! (r j) (- (r j) (* (q k) (p2 (- j k)))))))
(do ((j nv (+ 1 j)))
((> j n))
- (vector-set! r j 0))
+ (set! (r j) 0))
(list q r)))))
(list (poly-as-vector* p1 (/ 1 p2)) (vector 0)))
(list (vector 0) p2)))
@@ -175,7 +175,7 @@
(do ((i (- len 1) (- i 1))
(j len (- j 1)))
((< i 0) v)
- (vector-set! v i (* j (vector-ref p1 j))))))
+ (set! (v i) (* j (p1 j))))))
(define (poly-derivative p1)
"(poly-derivative p1) returns the derivative of p1, either a vct or vector"
@@ -199,12 +199,12 @@
((= i (- n 1)))
(do ((j 0 (+ 1 j)))
((= j m))
- (mixer-set! mat i (+ i j) (vector-ref p1 (- m j 1)))))
+ (mixer-set! mat i (+ i j) (p1 (- m j 1)))))
(do ((i 0 (+ i 1)))
((= i (- m 1)))
(do ((j 0 (+ 1 j)))
((= j n))
- (mixer-set! mat (+ i n -1) (+ i j) (vector-ref p2 (- n j 1)))))
+ (mixer-set! mat (+ i n -1) (+ i j) (p2 (- n j 1)))))
(mixer-determinant mat)))
(define (poly-resultant p1 p2)
@@ -271,7 +271,7 @@
(let ((qr (map poly-as-vector-reduce (poly-as-vector/ p1 p2))))
;(display (format #f ";poly-as-vector-gcd ~A ~A ->~A ~%" p1 p2 qr))
(if (= (length (cadr qr)) 1)
- (if (= (vector-ref (cadr qr) 0) 0.0)
+ (if (= ((cadr qr) 0) 0.0)
p2
(vector 0))
(apply poly-as-vector-gcd qr)))))
@@ -379,65 +379,65 @@
(if (= deg 0) ; just constant
'()
- (if (= (vector-ref p1 0) 0.0) ; constant=0.0, divide through by x, recurse on new
+ (if (= (p1 0) 0.0) ; constant=0.0, divide through by x, recurse on new
(if (= deg 1)
(list 0.0)
(let ((pnew (make-vector deg)))
(do ((i 1 (+ i 1)))
((> i deg))
- (vector-set! pnew (- i 1) (vector-ref p1 i)))
+ (set! (pnew (- i 1)) (p1 i)))
(append (list 0.0) (poly-as-vector-roots pnew))))
(if (= deg 1) ; ax + b -> -b/a
- (linear-root (vector-ref p1 1) (vector-ref p1 0))
+ (linear-root (p1 1) (p1 0))
(if (= deg 2) ; ax^2 + bx + c -> -b +/- sqrt(b^2 - 4ac) / 2a
- (quadratic-roots (vector-ref p1 2) (vector-ref p1 1) (vector-ref p1 0))
+ (quadratic-roots (p1 2) (p1 1) (p1 0))
(or (and (= deg 3)
;; it may be better to fall into Newton's method here
- (cubic-roots (vector-ref p1 3) (vector-ref p1 2) (vector-ref p1 1) (vector-ref p1 0)))
+ (cubic-roots (p1 3) (p1 2) (p1 1) (p1 0)))
(and (= deg 4)
- (quartic-roots (vector-ref p1 4) (vector-ref p1 3) (vector-ref p1 2) (vector-ref p1 1) (vector-ref p1 0)))
+ (quartic-roots (p1 4) (p1 3) (p1 2) (p1 1) (p1 0)))
;; degree>4 (or trouble above), use Newton's method unless some simple case pops up
(let ((ones 0))
(do ((i 1 (+ i 1)))
((> i deg))
- (if (not (= (vector-ref p1 i) 0.0))
+ (if (not (= (p1 i) 0.0))
(set! ones (+ 1 ones))))
(if (= ones 1) ; x^n + b -- "linear" in x^n
- (nth-roots (vector-ref p1 deg) (vector-ref p1 0) deg)
+ (nth-roots (p1 deg) (p1 0) deg)
(if (and (= ones 2)
(even? deg)
- (not (= (vector-ref p1 (/ deg 2)) 0.0)))
+ (not (= (p1 (/ deg 2)) 0.0)))
(let ((roots '()) ; quadratic in x^(n/2)
(n (/ deg 2)))
(for-each
(lambda (r)
(set! roots (append roots (nth-roots 1.0 (- r) n))))
- (poly-as-vector-roots (vector (vector-ref p1 0)
- (vector-ref p1 (/ deg 2))
- (vector-ref p1 deg))))
+ (poly-as-vector-roots (vector (p1 0)
+ (p1 (/ deg 2))
+ (p1 deg))))
roots)
(if (and (> deg 3)
(= ones 3)
(= (modulo deg 3) 0)
- (not (= (vector-ref p1 (/ deg 3)) 0.0))
- (not (= (vector-ref p1 (/ (* 2 deg) 3)) 0.0)))
+ (not (= (p1 (/ deg 3)) 0.0))
+ (not (= (p1 (/ (* 2 deg) 3)) 0.0)))
(let ((roots '()) ; cubic in x^(n/3)
(n (/ deg 3)))
(for-each
(lambda (r)
(set! roots (append roots (nth-roots 1.0 (- r) n))))
- (poly-as-vector-roots (vector (vector-ref p1 0)
- (vector-ref p1 (/ deg 3))
- (vector-ref p1 (/ (* 2 deg) 3))
- (vector-ref p1 deg))))
+ (poly-as-vector-roots (vector (p1 0)
+ (p1 (/ deg 3))
+ (p1 (/ (* 2 deg) 3))
+ (p1 deg))))
roots)
;; perhaps get derivative roots, plug in main -- need to get nth derivative to be safe in this
diff --git a/popup.scm b/popup.scm
index 8438624..b7ffef4 100644
--- a/popup.scm
+++ b/popup.scm
@@ -89,7 +89,7 @@
(change-label w "Stop")
(set! stop-widget w)
(set! stopping #t)
- (play-selection)))))
+ (play (selection))))))
(list "Loop play" xmPushButtonWidgetClass every-menu ; play over and over
(lambda (w c i)
(define (stop-playing-selection)
@@ -103,7 +103,7 @@
(if (and (not (c-g?))
(= reason 0)
stopping1)
- (play-selection #f play-selection-again)
+ (play (selection) :wait #f :stop play-selection-again)
(stop-playing-selection)))
(if stopping1
(begin
@@ -113,7 +113,7 @@
(change-label w "Stop!")
(set! stop-widget1 w) ; needs to be separate from Play case since we're stopping/restarting deliberately
(set! stopping1 #t)
- (play-selection #f play-selection-again)))))
+ (play (selection) :wait #f :stop play-selection-again)))))
(list "Delete" xmPushButtonWidgetClass every-menu (lambda (w c i) (delete-selection)))
(list "Zero" xmPushButtonWidgetClass every-menu (lambda (w c i) (scale-selection-by 0.0)))
(list "Crop" xmPushButtonWidgetClass every-menu
@@ -168,9 +168,9 @@
(info-dialog
"Selection info"
(format #f "start ~A, ~,3F~%end: ~A, ~,3F~%duration: ~A, ~,3F~%chans: ~D~%maxamp: ~,3F"
- beg (exact->inexact (/ beg (srate)))
- (+ beg len) (exact->inexact (/ (+ beg len) (srate)))
- len (exact->inexact (/ len (srate)))
+ beg (* 1.0 (/ beg (srate)))
+ (+ beg len) (* 1.0 (/ (+ beg len) (srate)))
+ len (* 1.0 (/ len (srate)))
(selection-chans)
(selection-maxamp))))))
(list "Apply controls" xmPushButtonWidgetClass every-menu (lambda (w c i) (apply-controls (selected-sound) 2))) ; 2=selection
@@ -308,7 +308,7 @@
(srate snd)
(mus-header-type-name (header-type snd))
(mus-data-format-name (data-format snd))
- (exact->inexact (/ (frames snd graph-popup-chn) (srate snd)))
+ (* 1.0 (/ (frames snd graph-popup-chn) (srate snd)))
(maxamp snd #t)
(if (comment snd)
(format #f " comment: \"~A\"~%" (comment snd))
diff --git a/rtio.scm b/rtio.scm
index 29ecee0..88cede9 100644
--- a/rtio.scm
+++ b/rtio.scm
@@ -142,7 +142,7 @@
blackman2-window our-dac-buffer-size-in-shorts #t)
"spectrum"
0.0 x1)
- (let ((maxpt (inexact->exact (floor (* x1 our-dac-buffer-size-in-shorts)))))
+ (let ((maxpt (floor (* x1 our-dac-buffer-size-in-shorts))))
(graph
(snd-spectrum
(vct-subseq (sound-data->vct data our-chan vobj) 0 maxpt)
diff --git a/rubber.scm b/rubber.scm
index 423f74b..02c80a3 100644
--- a/rubber.scm
+++ b/rubber.scm
@@ -27,7 +27,7 @@
(define* (derumble-sound snd chn)
(let* ((old-length (frames snd chn))
(pow2 (ceiling (/ (log (min old-length (srate snd))) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(flt-env (list 0.0 0.0 (/ (* 2 16.0) (srate snd)) 0.0 (/ (* 2 20.0) (srate snd)) 1.0 1.0 1.0)))
(filter-sound flt-env fftlen snd chn)
(set! (frames snd chn) old-length)))
@@ -118,11 +118,11 @@
(run
(do ((i 0 (+ 1 i)))
((= i (- crosses 1)))
- (let* ((start (inexact->exact (vct-ref cross-samples i)))
+ (let* ((start (floor (vct-ref cross-samples i)))
(autolen 0))
(let* ((s0 start)
(pow2 (ceiling (/ (log (* extension (/ (srate snd) 40.0))) (log 2))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (fftlen (floor (expt 2 pow2)))
(len4 (/ fftlen 4))
(data (make-vct fftlen))
(reader (make-sampler (floor s0))))
@@ -142,10 +142,10 @@
(set! happy #t))))))
(let* ((next-start (+ start autolen))
(min-i (+ i 1))
- (min-samps (inexact->exact (abs (- (vct-ref cross-samples min-i) next-start)))))
+ (min-samps (floor (abs (- (vct-ref cross-samples min-i) next-start)))))
(do ((k (+ i 2) (+ 1 k)))
((= k (min crosses (+ i zeros-checked))))
- (let ((dist (inexact->exact (abs (- (vct-ref cross-samples k) next-start)))))
+ (let ((dist (floor (abs (- (vct-ref cross-samples k) next-start)))))
(if (< dist min-samps)
(begin
(set! min-samps dist)
@@ -153,7 +153,7 @@
(let* ((current-mark min-i)
(current-min 0.0))
(let* ((s0 start)
- (s1 (inexact->exact (vct-ref cross-samples current-mark)))
+ (s1 (floor (vct-ref cross-samples current-mark)))
(len autolen)
(sr0 (make-sampler (floor s0)))
(sr1 (make-sampler (floor s1)))
@@ -174,7 +174,7 @@
((= k top))
(let ((wgt 0.0))
(let* ((s0 start)
- (s1 (inexact->exact (vct-ref cross-samples k)))
+ (s1 (floor (vct-ref cross-samples k)))
(len autolen)
(sr0 (make-sampler (floor s0)))
(sr1 (make-sampler (floor s1)))
@@ -191,7 +191,7 @@
(set! wgt (/ diffsum ampsum))))
(if (< wgt min-samps)
(begin
- (set! min-samps (inexact->exact wgt))
+ (set! min-samps (floor wgt))
(set! min-i k))))))
(if (not (= current-mark min-i))
(begin
@@ -246,10 +246,10 @@
(weights (length cross-weights)))
(do ((i 0 (+ 1 i)))
((or (= i curs) (> changed-len samps)))
- (let* ((best-mark (inexact->exact (vct-ref edits i)))
- (beg (inexact->exact (vct-ref cross-samples best-mark)))
- (next-beg (inexact->exact (vct-ref cross-samples (inexact->exact (vct-ref cross-marks best-mark)))))
- (len (inexact->exact (vct-ref cross-periods best-mark))))
+ (let* ((best-mark (floor (vct-ref edits i)))
+ (beg (floor (vct-ref cross-samples best-mark)))
+ (next-beg (floor (vct-ref cross-samples (floor (vct-ref cross-marks best-mark)))))
+ (len (floor (vct-ref cross-periods best-mark))))
(if (> len 0)
(if adding
(let ((new-samps
@@ -264,7 +264,7 @@
(set! changed-len (+ changed-len (* mult len)))
(do ((j 0 (+ 1 j)))
((= j weights))
- (let ((curbeg (inexact->exact (vct-ref cross-samples j))))
+ (let ((curbeg (floor (vct-ref cross-samples j))))
(if (> curbeg beg)
(vct-set! cross-samples j (+ curbeg len))))))
(begin
@@ -277,13 +277,13 @@
(let ((end (+ beg len)))
(do ((j 0 (+ 1 j)))
((= j weights))
- (let ((curbeg (inexact->exact (vct-ref cross-samples j))))
+ (let ((curbeg (floor (vct-ref cross-samples j))))
(if (> curbeg beg)
(if (< curbeg end)
(vct-set! cross-periods j 0)
(vct-set! cross-samples j (- curbeg len))))))))))))
(if show-details
- (snd-print (format #f "wanted: ~D, got ~D~%" (inexact->exact samps) (inexact->exact changed-len)))))
+ (snd-print (format #f "wanted: ~D, got ~D~%" (floor samps) (floor changed-len)))))
))
;; and return to original srate
(unsample-sound snd chn)
diff --git a/run.c b/run.c
index ac93a51..bbea88c 100644
--- a/run.c
+++ b/run.c
@@ -95,6 +95,11 @@
* TODO: run doesn't always warn about a closure (explicit gen basically) -- if it's used directly,
* there's no warning, but it doesn't handle the closed-over variables correctly
* PERHAPS: named let/tail recursion
+ * SOMEDAY: generics like length
+ * PERHAPS: can we get rid of "declare" now?
+ * SOMEDAY: if return int and bool
+ *
+ * perhaps we can access s7 globals directly -- no need to copy each way for ints/dbls/strings
*/
@@ -2396,6 +2401,8 @@ static vect *read_vector(ptree *pt, s7_pointer vector, int type)
int mus_run_xen_to_run_type(s7_pointer val)
{
+ /* fprintf(stderr, "get type of %s\n", s7_object_to_c_string(s7, val)); */
+
if (s7_is_real(val))
{
if ((s7_is_exact(val)) && (s7_is_integer(val)))
@@ -2437,7 +2444,7 @@ int mus_run_xen_to_run_type(s7_pointer val)
return(R_FLOAT_VECTOR);
}
if (MUS_VCT_P(val0)) return(R_VCT_VECTOR);
- if ((mus_xen_p(val0)) || (val0 == scheme_false)) return(R_CLM_VECTOR);
+ if ((mus_xen_p(val0)) || (val0 == scheme_false)) return(R_CLM_VECTOR);
if (s7_is_list(s7, val0)) return(R_LIST_VECTOR);
}
@@ -4193,15 +4200,17 @@ static xen_value *if_form(ptree *prog, s7_pointer form, walk_result_t need_resul
#endif
false_result->type = true_result->type;
else
+ {
#if USE_SND
- if ((true_result->type == R_BOOL) &&
- ((false_result->type == R_CLM) ||
- (false_result->type == R_SAMPLER)))
+ if ((true_result->type == R_BOOL) &&
+ ((false_result->type == R_CLM) ||
+ (false_result->type == R_SAMPLER)))
#else
- if ((true_result->type == R_BOOL) &&
- (false_result->type == R_CLM))
+ if ((true_result->type == R_BOOL) &&
+ (false_result->type == R_CLM))
#endif
- true_result->type = false_result->type;
+ true_result->type = false_result->type;
+ }
}
if (false_result->type != true_result->type)
@@ -4676,7 +4685,7 @@ static opt_ops do_ops[NUM_DO_OPS] = {
{outa_multiply_f3, "outa_multiply_f3", outa_multiply_f3_inc_and_jump_maybe, "outa_multiply_f3_inc_and_jump_maybe", NULL, NULL},
{outa_multiply_f2, "outa_multiply_f2", outa_multiply_f2_inc_and_jump_maybe, "outa_multiply_f2_inc_and_jump_maybe", NULL, NULL},
{frame_set_0r, "frame_set_0r", frame_set_0r_inc_and_jump_maybe, "frame_set_0r_inc_and_jump_maybe", NULL, NULL},
- {vct_set_f, "vct_set_f", vct_set_f_inc_and_jump_maybe, "vct_set_f_inc_and_jump_maybe", NULL, NULL},
+ {vct_set_f, "vct_set_f(1)", vct_set_f_inc_and_jump_maybe, "vct_set_f_inc_and_jump_maybe", NULL, NULL},
{set_scaler_f, "set_scaler_f", set_scaler_f_inc_and_jump_maybe, "set_scaler_f_inc_and_jump_maybe", NULL, NULL},
{outa_polywave_1_mult, "outa_polywave_1_mult", outa_polywave_1_mult_inc_and_jump_maybe, "outa_polywave_1_mult_inc_and_jump_maybe", NULL, NULL},
{outa_oscil_1_mult, "outa_oscil_1_mult", outa_oscil_1_mult_inc_and_jump_maybe, "outa_oscil_1_mult_inc_and_jump_maybe", NULL, NULL},
@@ -10137,6 +10146,13 @@ static void vector_set_v(int *args, ptree *pt) {VECT_ARG_1->data.vcts[INT_ARG_2]
static void vector_set_c(int *args, ptree *pt) {VECT_ARG_1->data.gens[INT_ARG_2] = CLM_ARG_3;}
+static void int_vector_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
+{
+ xen_var *var;
+ var = find_var_in_ptree_via_addr(prog, in_v->type, in_v->addr);
+ if (var) var->unclean = true;
+ add_triple_to_ptree(prog, va_make_triple(vector_set_i, "vector_set_i", 4, NULL, in_v, in_v1, v));
+}
static xen_value *vector_set_1(ptree *prog, xen_value **args, int num_args)
{
@@ -10338,46 +10354,61 @@ static void vct_nf(int *args, ptree *pt) {if (VCT_ARG_1) FLOAT_RESULT = VCT_ARG_
static xen_value *vct_n(ptree *prog, xen_value **args, int num_args, xen_value *sf)
{
/* this is handling the vct-as-applicable-func stuff (v ind) = (vct-ref v ind) */
- /* (let ((v (make-vct 3 1.0))) (run (lambda () (v 0)))) */
+ /* (let ((v (make-vct 3 1.0))) (run (lambda () (v 0))))
+ * (run ((make-vct 3 1.0) 1))
+ */
+
if (args[0]) free(args[0]);
+ if (args[1]->type != R_INT)
+ return(run_warn("vct index should be an integer"));
+
args[0] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
add_triple_to_ptree(prog, va_make_triple(vct_nf, "vct_nf", 3, args[0], sf, args[1]));
return(args[0]);
}
-static void vct_constant_set_0(int *args, ptree *pt) {VCT_ARG_1->data[0] = FLOAT_ARG_3; FLOAT_RESULT = FLOAT_ARG_3;}
-static void vct_constant_set_1(int *args, ptree *pt) {VCT_ARG_1->data[1] = FLOAT_ARG_3; FLOAT_RESULT = FLOAT_ARG_3;}
-static void vct_constant_set_2(int *args, ptree *pt) {VCT_ARG_1->data[2] = FLOAT_ARG_3; FLOAT_RESULT = FLOAT_ARG_3;}
-static void vct_constant_set_3(int *args, ptree *pt) {VCT_ARG_1->data[3] = FLOAT_ARG_3; FLOAT_RESULT = FLOAT_ARG_3;}
+static void vct_constant_set_0(int *args, ptree *pt) {VCT_ARG_1->data[0] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
+static void vct_constant_set_1(int *args, ptree *pt) {VCT_ARG_1->data[1] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
+static void vct_constant_set_2(int *args, ptree *pt) {VCT_ARG_1->data[2] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
+static void vct_constant_set_3(int *args, ptree *pt) {VCT_ARG_1->data[3] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-static void vct_set_f(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] = FLOAT_ARG_3; FLOAT_RESULT = FLOAT_ARG_3;}
-static void vct_set_f_add(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] += FLOAT_ARG_3; FLOAT_RESULT = FLOAT_ARG_3;}
-static void vct_set_f_mult(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] *= FLOAT_ARG_3; FLOAT_RESULT = FLOAT_ARG_3;}
+static void vct_set_f(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
+static void vct_set_f_add(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] += FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
+static void vct_set_f_mult(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] *= FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-static void vct_set_i(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] = (mus_float_t)INT_ARG_3; FLOAT_RESULT = (Double)INT_ARG_3;}
+static void vct_set_i(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] = (mus_float_t)INT_ARG_3; /* FLOAT_RESULT = (Double)INT_ARG_3; */}
static void vct_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
{
/* set! vct-ref */
xen_var *var;
+ xen_value *arg0 = NULL;
+ arg0 = add_temporary_var_to_ptree(prog, R_FLOAT);
+
var = find_var_in_ptree_via_addr(prog, in_v->type, in_v->addr);
if (var) var->unclean = true;
- /* v->type is guaranteed float in this case (generalized set will insist on it) */
+
+ if (v->type == R_INT)
+ {
+ add_triple_to_ptree(prog, va_make_triple(vct_set_i, "vct_set_i(2)", 4, arg0, in_v, in_v1, v));
+ return;
+ }
+
if (in_v1->constant == R_CONSTANT)
{
if (prog->ints[in_v1->addr] == 0)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_0, "vct_constant_set_0", 4, NULL, in_v, in_v1, v));
+ add_triple_to_ptree(prog, va_make_triple(vct_constant_set_0, "vct_constant_set_0(1)", 4, arg0, in_v, in_v1, v));
else if (prog->ints[in_v1->addr] == 1)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_1, "vct_constant_set_1", 4, NULL, in_v, in_v1, v));
+ add_triple_to_ptree(prog, va_make_triple(vct_constant_set_1, "vct_constant_set_1(1)", 4, arg0, in_v, in_v1, v));
else if (prog->ints[in_v1->addr] == 2)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_2, "vct_constant_set_2", 4, NULL, in_v, in_v1, v));
+ add_triple_to_ptree(prog, va_make_triple(vct_constant_set_2, "vct_constant_set_2(1)", 4, arg0, in_v, in_v1, v));
else if (prog->ints[in_v1->addr] == 3)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_3, "vct_constant_set_3", 4, NULL, in_v, in_v1, v));
- else add_triple_to_ptree(prog, va_make_triple(vct_set_f, "vct_set_f", 4, NULL, in_v, in_v1, v));
+ add_triple_to_ptree(prog, va_make_triple(vct_constant_set_3, "vct_constant_set_3(1)", 4, arg0, in_v, in_v1, v));
+ else add_triple_to_ptree(prog, va_make_triple(vct_set_f, "vct_set_f(2)", 4, arg0, in_v, in_v1, v));
}
- else add_triple_to_ptree(prog, va_make_triple(vct_set_f, "vct_set_f", 4, NULL, in_v, in_v1, v));
+ else add_triple_to_ptree(prog, va_make_triple(vct_set_f, "vct_set_f(3)", 4, arg0, in_v, in_v1, v));
}
@@ -10392,13 +10423,13 @@ static xen_value *vct_set_2(ptree *prog, xen_value **args, int num_args)
if (args[2]->constant == R_CONSTANT)
{
if (prog->ints[args[2]->addr] == 0)
- return(package(prog, R_FLOAT, vct_constant_set_0, "vct_constant_set_0", args, 3));
+ return(package(prog, R_FLOAT, vct_constant_set_0, "vct_constant_set_0(0)", args, 3));
if (prog->ints[args[2]->addr] == 1)
- return(package(prog, R_FLOAT, vct_constant_set_1, "vct_constant_set_1", args, 3));
+ return(package(prog, R_FLOAT, vct_constant_set_1, "vct_constant_set_1(0)", args, 3));
if (prog->ints[args[2]->addr] == 2)
- return(package(prog, R_FLOAT, vct_constant_set_2, "vct_constant_set_2", args, 3));
+ return(package(prog, R_FLOAT, vct_constant_set_2, "vct_constant_set_2(0)", args, 3));
if (prog->ints[args[2]->addr] == 3)
- return(package(prog, R_FLOAT, vct_constant_set_3, "vct_constant_set_3", args, 3));
+ return(package(prog, R_FLOAT, vct_constant_set_3, "vct_constant_set_3(0)", args, 3));
}
if (prog->triple_ctr > 0)
@@ -10425,7 +10456,7 @@ static xen_value *vct_set_2(ptree *prog, xen_value **args, int num_args)
}
}
- return(package(prog, R_FLOAT, vct_set_f, "vct_set_f", args, 3));
+ return(package(prog, R_FLOAT, vct_set_f, "vct_set_f(4)", args, 3));
}
return(package(prog, R_FLOAT, vct_set_i, "vct_set_i", args, 3));
}
@@ -10827,13 +10858,13 @@ static xen_value *sound_data_n(ptree *prog, xen_value **args, int num_args, xen_
static void sound_data_set_f(int *args, ptree *pt)
{
SOUND_DATA_ARG_1->data[INT_ARG_2][INT_ARG_3] = FLOAT_ARG_4;
- FLOAT_RESULT = FLOAT_ARG_4;
+ /* FLOAT_RESULT = FLOAT_ARG_4; */
}
static void sound_data_set_i(int *args, ptree *pt)
{
SOUND_DATA_ARG_1->data[INT_ARG_2][INT_ARG_3] = (mus_float_t)INT_ARG_4;
- FLOAT_RESULT = (Double)INT_ARG_4;
+ /* FLOAT_RESULT = (Double)INT_ARG_4; */
}
@@ -13379,6 +13410,7 @@ static xen_value *out_any_function_body(ptree *prog, s7_pointer proc, xen_value
/* here if num_args == 2 *output* is used by default */
+
static xen_value *outn_1(ptree *prog, int chan, xen_value **args, int num_args, xen_value *(*out_func)(ptree *prog, xen_value **args, int num_args))
{
if (num_args == 2)
@@ -13411,11 +13443,13 @@ static xen_value *outn_1(ptree *prog, int chan, xen_value **args, int num_args,
true_args[3] = out_any_function_body(prog, output, func_args, 3, NULL);
protect_ptree = true;
free(func_args[3]);
+ if (true_args[3] == NULL) return(NULL);
}
else true_args[3] = make_xen_value(R_XEN, add_xen_to_ptree(prog, output), R_VARIABLE);
}
}
}
+
for (k = 0; k < 3; k++) true_args[k] = args[k];
rtn = out_func(prog, true_args, 3);
if (!protect_ptree) free(true_args[3]); /* otherwise the embedded ptree is gc'd twice */
@@ -13471,6 +13505,7 @@ static xen_value *out_any_1(ptree *prog, xen_value **args, int num_args)
{
for (k = 0; k < 4; k++) true_args[k] = args[k];
true_args[4] = out_any_function_body(prog, output, true_args, 3, NULL);
+ if (true_args[4] == NULL) return(NULL);
protect_ptree = true;
}
else true_args[4] = make_xen_value(R_XEN, add_xen_to_ptree(prog, output), R_VARIABLE);
@@ -13770,7 +13805,7 @@ static void clm_set_f(int *args, ptree *pt)
mus_mixer_set(CLM_ARG_1, INT_ARG_2, INT_ARG_3, FLOAT_ARG_4);
}
}
- FLOAT_RESULT = FLOAT_ARG_4;
+ /* FLOAT_RESULT = FLOAT_ARG_4; */
}
static void clm_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
@@ -15334,7 +15369,7 @@ static xen_value *quote_form(ptree *prog, s7_pointer form, walk_result_t ignore)
{
xen_value *rv;
char *temp = NULL;
- rv = run_warn("can't handle %s", temp = s7_object_to_c_string(s7, form));
+ rv = run_warn("quote can't handle %s", temp = s7_object_to_c_string(s7, form));
if (temp) free(temp);
return(rv);
}
@@ -15705,6 +15740,24 @@ static xen_value *walk(ptree *prog, s7_pointer form, walk_result_t walk_result)
res = vct_n(prog, args, num_args, v);
break;
+ case R_CLM_VECTOR:
+ args[0] = make_xen_value(R_CLM, add_clm_to_ptree(prog, NULL, scheme_false), R_VARIABLE);
+ add_triple_to_ptree(prog, va_make_triple(vector_ref_c, "clm_vector_ref", 3, args[0], v, args[1]));
+ res = args[0];
+ break;
+
+ case R_INT_VECTOR:
+ args[0] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
+ add_triple_to_ptree(prog, va_make_triple(vector_ref_i, "int_vector_ref", 3, args[0], v, args[1]));
+ res = args[0];
+ break;
+
+ case R_VCT_VECTOR:
+ args[0] = make_xen_value(R_VCT, add_vct_to_ptree(prog, NULL), R_VARIABLE);
+ add_triple_to_ptree(prog, va_make_triple(vector_ref_v, "vct_vector_ref", 3, args[0], v, args[1]));
+ res = args[0];
+ break;
+
case R_SOUND_DATA:
res = sound_data_n(prog, args, num_args, v);
break;
@@ -15862,6 +15915,8 @@ static xen_value *walk(ptree *prog, s7_pointer form, walk_result_t walk_result)
(!(s7_is_procedure_with_setter(rtnval)))
)
{
+ /* fprintf(stderr, "look for %s\n", s7_object_to_c_string(s7, rtnval)); */
+
v = splice_in_function_body(prog, rtnval, args, num_args, funcname);
if (v)
return(clean_up(v, args, num_args));
@@ -15885,7 +15940,7 @@ static xen_value *walk(ptree *prog, s7_pointer form, walk_result_t walk_result)
}
type = mus_run_xen_to_run_type(form);
- /* fprintf(stderr, "line 15765 %s %s\n", s7_object_to_c_string(s7, form), type_name(type)); */
+ /* fprintf(stderr, "line 15924 %s %s\n", s7_object_to_c_string(s7, form), type_name(type)); */
switch (type)
{
@@ -15916,7 +15971,7 @@ static xen_value *walk(ptree *prog, s7_pointer form, walk_result_t walk_result)
{
xen_value *rv;
char *temp1 = NULL, *temp2 = NULL;
- /* fprintf(stderr, "can't handle %s\n", s7_object_to_c_string(s7, form)); */
+ /* fprintf(stderr, "walker can't handle %s\n", s7_object_to_c_string(s7, form)); */
rv = run_warn("can't handle: %s (%s)", temp1 = s7_object_to_c_string(s7, form), temp2 = s7_object_to_c_string(s7, s7_procedure_source(s7, prog->code)));
if (temp1) free(temp1);
if (temp2) free(temp2);
@@ -15986,7 +16041,6 @@ static xen_value *lookup_generalized_set(ptree *prog, s7_pointer acc_form, xen_v
{
/* (let ((v (vct 1.0 2.0 3.0))) (run (lambda () (set! (v 1) 0.5)))) */
vct_set_1(prog, val, in_v, NULL, v);
- /* SOMEDAY: in_v1 here for multidim vect? but the latter aren't accepted because vcts are 1-dim */
happy = 1;
}
else
@@ -16006,6 +16060,15 @@ static xen_value *lookup_generalized_set(ptree *prog, s7_pointer acc_form, xen_v
clm_set_1(prog, val, in_v, in_v1, v);
happy = 1;
}
+ else
+ {
+ if (val->type == R_INT_VECTOR)
+ {
+ /* (let ((v (vector 1 2 3))) (run (set! (v 1) 32) (v 1))) */
+ int_vector_set_1(prog, val, in_v, NULL, v);
+ happy = 1;
+ }
+ }
}
}
free(val);
@@ -17128,8 +17191,6 @@ void mus_init_run(void)
s7_define_function(s7, "run-clear-counts", g_clear_counts_w, 0, 0, 0, "clear run stats");
#endif
- s7_provide(s7, "run");
-
XEN_DEFINE_PROCEDURE_WITH_SETTER(S_optimization, g_optimization_w, H_optimization, S_setB S_optimization, g_set_optimization_w, 0, 0, 1, 0);
s7_define_function(s7, S_snd_declare, g_snd_declare_w, 1, 0, 0, H_snd_declare);
diff --git a/s7.c b/s7.c
index e5b9f4a..1cb4df4 100644
--- a/s7.c
+++ b/s7.c
@@ -33,9 +33,9 @@
* no invidious distinction between built-in and "foreign"
* (this makes it easy to extend built-in operators like "+" -- see s7.html for a simple example)
* lists, strings, vectors, and hash-tables are (set-)applicable objects
- * true multiple-values, multiple-value-bind, multiple-value-set! (all optional: see WITH_MULTIPLE_VALUES)
+ * true multiple-values (optional)
* threads (optional)
- * multidimensional vectors (optional)
+ * multidimensional vectors
*
* many minor changes!
*
@@ -46,7 +46,6 @@
* (exact? has no obvious meaning in regard to complex numbers anyway -- are we referring to the polar or
* the rectangular form, and are both real and imaginary parts included? -- why can't they be separate?)
* In s7, exact? is a synonym for rational?, inexact->exact is a synonym for rationalize.
- * Also, why isn't 1e2 considered exact? The e2 business is 10^2 -- not a float!
* '#' does not stand for an unknown digit, and the '@' complex number notation is ignored
* I also choose not to include numbers such as +i (= 0+i) -- include the real part!
*
@@ -62,7 +61,7 @@
* random for any numeric type and any numeric argument, including 0 ferchrissake!
* sinh, cosh, tanh, asinh, acosh, atanh
* read-line, read-byte, write-byte
- * logior, logxor, logand, lognot, ash, integer-length
+ * logior, logxor, logand, lognot, ash, integer-length, integer-decode-float, nan?, infinite?
* procedure-source, procedure-arity, procedure-documentation, help
* if the initial expression in a function body is a string constant, it is assumed to be a documentation string
* symbol-table, symbol->value, global-environment, current-environment, stack
@@ -70,8 +69,8 @@
* port-line-number, port-filename
* object->string, eval-string
* reverse!, list-set!, sort!, make-list
- * gc, quit, *load-hook*, *error-hook*, *error-info*
- * *features*, *load-path*, *vector-print-length*
+ * gc, quit, *load-hook*, *error-hook*, *error-info*, *unbound-variable-hook*
+ * *features*, *load-path*, *vector-print-length*, *#readers*
* define-constant, pi, most-positive-fixnum, most-negative-fixnum, constant?
* a constant is really constant -- it can't be bound or set.
* symbol-calls if profiling is enabled
@@ -191,13 +190,6 @@
*/
#endif
-#ifndef WITH_MULTIDIMENSIONAL_VECTORS
- #define WITH_MULTIDIMENSIONAL_VECTORS 1
- /* this includes the multidimension vector support
- * added function: vector-dimensions returns a list of dimensions
- */
-#endif
-
#ifndef WITH_PROFILING
#define WITH_PROFILING 0
/* this includes a simple profiler -- see the profile function in Snd's extensions.scm
@@ -249,7 +241,7 @@
* multiprecision arithmetic
* s7 init
*
- * naming conventions: s7_* usually are C accessible (snd.h), g_* are scheme accessible (FFI), H_* are documentation strings,
+ * naming conventions: s7_* usually are C accessible (s7.h), g_* are scheme accessible (FFI), H_* are documentation strings,
* *_1 are auxilliary functions, big_* refer to gmp and friends, scheme "?" corresponds to C "_is_", scheme "->" to C "_to_".
*/
@@ -367,7 +359,7 @@ typedef struct s7_port_t {
char *value;
int size, point;
s7_pointer (*input_function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port);
- void (*output_function)(s7_scheme *sc, char c, s7_pointer port);
+ void (*output_function)(s7_scheme *sc, unsigned char c, s7_pointer port);
void *data;
/* a version of string ports using a pointer to the current location and a pointer to the end
* (rather than an integer for both, indexing from the base string) was not faster.
@@ -385,12 +377,10 @@ typedef struct s7_func_t {
} s7_func_t;
-#if WITH_MULTIDIMENSIONAL_VECTORS
typedef struct s7_vdims_t {
int ndims;
s7_Int *dims, *offsets;
} s7_vdims_t;
-#endif
/* cell structure */
@@ -423,9 +413,7 @@ typedef struct s7_cell {
struct {
s7_Int length;
s7_pointer *elements;
-#if WITH_MULTIDIMENSIONAL_VECTORS
s7_vdims_t *dim_info;
-#endif
} vector;
s7_func_t *ffptr;
@@ -546,6 +534,8 @@ struct s7_scheme {
s7_pointer output_port; /* current-output-port (nil = stderr) */
s7_pointer error_port; /* current-error-port (nil = stderr) */
s7_pointer error_info; /* the vector bound to *error-info* */
+ s7_pointer sharp_readers; /* the binding pair for the global *#readers* list */
+ s7_pointer vector_print_length; /* same for *vector-print-length* */
/* these 6 are pointers so that all thread refs are to the same thing */
bool *gc_off; /* if true, the GC won't run */
@@ -567,9 +557,6 @@ struct s7_scheme {
s7_pointer *temps; /* short-term gc protection */
int temps_ctr, temps_size;
- #define CIRCULAR_REFS_SIZE 8
- s7_pointer *circular_refs; /* printer circular list/vector checks */
-
jmp_buf goto_start, goto_qsort_end;
bool longjmp_ok;
void (*error_exiter)(void);
@@ -586,7 +573,7 @@ struct s7_scheme {
#define BLOCK_VECTOR_SIZE 100
s7_pointer *nil_vector, *unspecified_vector;
-
+
void *default_rng;
#if WITH_GMP
void *default_big_rng;
@@ -717,7 +704,13 @@ struct s7_scheme {
* it needs to be marked during GC -- this adds less .1% total time).
*/
-#define UNUSED_BITS 0xf8000000
+#define T_STRUCTURE (1 << (TYPE_BITS + 19))
+#define has_structure(p) ((typeflag(p) & T_STRUCTURE) != 0)
+/* for quick recognition of lists, vectors, hash-tables in print.
+ * This flag does not buy us much, so if a bit is ever needed, flush this first.
+ */
+
+#define UNUSED_BITS 0xf0000000
#if HAVE_PTHREADS
#define set_type(p, f) typeflag(p) = ((typeflag(p) & T_GC_MARK) | (f))
@@ -780,15 +773,10 @@ struct s7_scheme {
#define vector_element(p, i) ((p)->object.vector.elements[i])
#define vector_elements(p) (p)->object.vector.elements
-#if WITH_MULTIDIMENSIONAL_VECTORS
- #define vector_dimension(p, i) ((p)->object.vector.dim_info->dims[i])
- #define vector_ndims(p) ((p)->object.vector.dim_info->ndims)
- #define vector_offset(p, i) ((p)->object.vector.dim_info->offsets[i])
- #define vector_is_multidimensional(p) ((p)->object.vector.dim_info)
- #define VECTOR_REST_ARGS true
-#else
- #define VECTOR_REST_ARGS false
-#endif
+#define vector_dimension(p, i) ((p)->object.vector.dim_info->dims[i])
+#define vector_ndims(p) ((p)->object.vector.dim_info->ndims)
+#define vector_offset(p, i) ((p)->object.vector.dim_info->offsets[i])
+#define vector_is_multidimensional(p) ((p)->object.vector.dim_info)
#define small_int(Val) small_ints[Val]
#define opcode(Op) small_ints[(int)Op]
@@ -836,6 +824,7 @@ struct s7_scheme {
#define s7_stack_top(Sc) ((Sc)->stack_end - (Sc)->stack_start)
+#define is_continuation(p) (type(p) == T_CONTINUATION)
#define is_goto(p) (type(p) == T_GOTO)
#define is_macro(p) (type(p) == T_MACRO)
@@ -913,7 +902,9 @@ static char *copy_string_with_len(const char *str, int len)
{
char *newstr;
newstr = (char *)malloc((len + 1) * sizeof(char));
- memcpy((void *)newstr, (void *)str, len + 1);
+ if (len != 0)
+ memcpy((void *)newstr, (void *)str, len + 1);
+ else newstr[0] = 0;
return(newstr);
}
@@ -928,6 +919,28 @@ static char *copy_string(const char *str)
/* newlib code here was slower */
+static int safe_strcmp(const char *s1, const char *s2)
+{
+ int val;
+ if (s1 == NULL)
+ {
+ if (s2 == NULL)
+ return(0);
+ return(-1);
+ }
+ if (s2 == NULL)
+ return(1);
+
+ val = strcmp(s1, s2); /* strcmp can return stuff like -97, but we want -1, 0, or 1 */
+
+ if (val <= -1)
+ return(-1);
+ if (val >= 1)
+ return(1);
+ return(val);
+}
+
+
static bool is_proper_list(s7_scheme *sc, s7_pointer lst);
static void mark_embedded_objects(s7_pointer a); /* called by gc, calls fobj's mark func */
static s7_pointer eval(s7_scheme *sc, opcode_t first_op);
@@ -941,16 +954,19 @@ static s7_pointer make_atom(s7_scheme *sc, char *q, int radix, bool want_symbol)
static bool object_is_applicable(s7_pointer x);
static s7_pointer make_list_1(s7_scheme *sc, s7_pointer a);
static s7_pointer make_list_2(s7_scheme *sc, s7_pointer a, s7_pointer b);
+static s7_pointer make_list_3(s7_scheme *sc, s7_pointer a, s7_pointer b, s7_pointer c);
static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, int type);
static void write_string(s7_scheme *sc, const char *s, s7_pointer pt);
static s7_pointer eval_symbol(s7_scheme *sc, s7_pointer sym);
static s7_pointer eval_error(s7_scheme *sc, const char *errmsg, s7_pointer obj);
+static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args);
static bool is_thunk(s7_scheme *sc, s7_pointer x);
static int remember_file_name(const char *file);
static const char *type_name(s7_pointer arg);
static s7_pointer make_string_uncopied(s7_scheme *sc, char *str);
static s7_pointer make_protected_string(s7_scheme *sc, const char *str);
static s7_pointer call_symbol_bind(s7_scheme *sc, s7_pointer symbol, s7_pointer new_value);
+static s7_pointer s7_copy(s7_scheme *sc, s7_pointer obj);
#if HAVE_PTHREADS
static bool is_thread(s7_pointer obj);
@@ -1042,8 +1058,7 @@ static s7_pointer g_is_boolean(s7_scheme *sc, s7_pointer args)
bool s7_is_constant(s7_pointer p)
{
- /* this means "not settable": numbers, characters, strings, keywords, #f #t pi etc */
- /* so to be non-constant, it has to be a non-keyword symbol with the immutable bit not set, I think */
+ /* this means "always evaluates to the same thing" */
return((type(p) != T_SYMBOL) ||
(is_immutable(p)) ||
@@ -1217,14 +1232,12 @@ static void finalize_s7_cell(s7_scheme *sc, s7_pointer a)
if (vector_length(a) > 0)
{
free(vector_elements(a));
-#if WITH_MULTIDIMENSIONAL_VECTORS
if (vector_is_multidimensional(a))
{
free(a->object.vector.dim_info->dims);
free(a->object.vector.dim_info->offsets);
free(a->object.vector.dim_info);
}
-#endif
}
break;
@@ -1773,7 +1786,7 @@ static s7_pointer symbol_table_add_by_name_at_location(s7_scheme *sc, const char
#endif
vector_element(sc->symbol_table, location) = permanent_cons(x, vector_element(sc->symbol_table, location),
- T_PAIR | T_ATOM | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY);
+ T_PAIR | T_ATOM | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
#if HAVE_PTHREADS
pthread_mutex_unlock(&symtab_lock);
#endif
@@ -1867,7 +1880,7 @@ void s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_na
}
-static bool *number_inits;
+static bool *number_inits; /* bad symbol name error check */
s7_pointer s7_make_symbol(s7_scheme *sc, const char *name)
{
@@ -1883,7 +1896,7 @@ s7_pointer s7_make_symbol(s7_scheme *sc, const char *name)
(make_atom(sc, (char *)name, 10, false) != sc->F))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
make_list_2(sc,
- s7_make_string(sc, "identifier (symbol) name, ~A, can't be a number"),
+ make_protected_string(sc, "identifier (symbol) name, ~A, can't be a number"),
s7_make_string(sc, name))));
return(symbol_table_add_by_name_at_location(sc, name, location));
@@ -2013,7 +2026,7 @@ static s7_pointer g_symbol_calls(s7_scheme *sc, s7_pointer args)
NEW_CELL(Sc, x); \
car(x) = Sc->NIL; \
cdr(x) = Old_Env; \
- set_type(x, T_PAIR); \
+ set_type(x, T_PAIR | T_STRUCTURE); \
New_Env = x; \
} while (0)
@@ -2025,7 +2038,7 @@ static s7_pointer new_frame_in_env(s7_scheme *sc, s7_pointer old_env)
NEW_CELL(sc, x);
car(x) = sc->NIL;
cdr(x) = old_env;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
return(x);
}
@@ -2061,7 +2074,7 @@ static s7_pointer add_to_environment(s7_scheme *sc, s7_pointer env, s7_pointer v
car(x) = slot;
csr(x) = variable;
cdr(x) = e;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
car(env) = x;
set_local(variable);
@@ -2085,7 +2098,7 @@ static s7_pointer add_to_current_environment(s7_scheme *sc, s7_pointer variable,
{
if (is_immutable(variable)) /* (let ((pi 3)) pi) */
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "can't bind an immutable object: ~S"), variable)));
+ make_list_2(sc, make_protected_string(sc, "can't bind an immutable object: ~S"), variable)));
value = call_symbol_bind(sc, variable, value);
}
@@ -2102,20 +2115,20 @@ static s7_pointer add_to_local_environment(s7_scheme *sc, s7_pointer variable, s
{
if (is_immutable(variable))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "can't bind an immutable object: ~S"), variable)));
+ make_list_2(sc, make_protected_string(sc, "can't bind an immutable object: ~S"), variable)));
value = call_symbol_bind(sc, variable, value);
}
NEW_CELL(sc, y);
car(y) = variable;
cdr(y) = value;
- set_type(y, T_PAIR | T_IMMUTABLE | T_DONT_COPY);
+ set_type(y, T_PAIR | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
NEW_CELL(sc, x);
/* car(x) = immutable_cons(sc, variable, value); */
car(x) = y;
cdr(x) = car(sc->envir);
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
car(sc->envir) = x;
set_local(variable);
@@ -2135,7 +2148,7 @@ static s7_pointer g_augment_environment(s7_scheme *sc, s7_pointer args)
{
#define H_augment_environment "(augment-environment env ...) adds its \
arguments (each a cons: symbol . value) to the environment env, and returns the \
-new environment."
+new environment. "
s7_pointer x, e, new_e;
int gc_loc;
@@ -2569,7 +2582,10 @@ void *s7_c_pointer(s7_pointer p)
return(NULL); /* special case where the null pointer has been cons'd up by hand */
if (type(p) != T_C_POINTER)
- fprintf(stderr, "s7_c_pointer argument is not a c pointer?");
+ {
+ fprintf(stderr, "s7_c_pointer argument is not a c pointer?");
+ return(NULL);
+ }
return(p->object.c_pointer);
}
@@ -2591,15 +2607,14 @@ s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr)
bool s7_is_continuation(s7_pointer p)
{
- return(type(p) == T_CONTINUATION);
+ return(is_continuation(p));
}
static s7_pointer g_is_continuation(s7_scheme *sc, s7_pointer args)
{
#define H_is_continuation "(continuation? obj) returns #t if obj is a continuation"
- return(make_boolean(sc, (s7_is_continuation(car(args))) ||
- (is_goto(car(args)))));
+ return(make_boolean(sc, (is_continuation(car(args))) || (is_goto(car(args)))));
}
@@ -2831,7 +2846,7 @@ static s7_pointer g_call_cc(s7_scheme *sc, s7_pointer args)
(s7_integer(cadr(proc_args)) == 0) &&
(caddr(proc_args) == sc->F)))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "call/cc procedure, ~A, should take one argument"), car(args))));
+ make_list_2(sc, make_protected_string(sc, "call/cc procedure, ~A, should take one argument"), car(args))));
sc->code = car(args);
sc->args = make_list_1(sc, s7_make_continuation(sc));
@@ -2893,10 +2908,10 @@ static s7_pointer g_call_with_exit(s7_scheme *sc, s7_pointer args)
#endif
-#define s7_Int_abs(x) (x >= 0 ? x : -x)
+#define s7_Int_abs(x) ((x) >= 0 ? (x) : -(x))
/* can't use abs even in gcc -- it doesn't work with long long ints! */
#define s7_Double_abs(x) fabs(x)
-#define s7_fabsl(x) ((x < 0.0) ? -x : x)
+#define s7_fabsl(x) (((x) < 0.0) ? -(x) : (x))
/* fabsl doesn't exist in netBSD! */
@@ -2934,6 +2949,11 @@ double cbrt(double x)
return(pow(x, 1.0 / 3.0));
return(-pow(-x, 1.0 / 3.0));
}
+
+static bool isnan(s7_Double x) {return(x != x);}
+
+static bool isinf(s7_Double x) {return((x == x) && (isnan(x - x)));}
+
#endif
#if WITH_COMPLEX
@@ -3620,7 +3640,13 @@ static s7_pointer inexact_to_exact(s7_scheme *sc, s7_pointer x)
(!s7_is_rational(x)))
{
s7_Int numer = 0, denom = 1;
- if (c_rationalize(s7_real_part(x), default_rationalize_error, &numer, &denom))
+ s7_Double val;
+
+ val = s7_real_part(x);
+ if ((isinf(val)) || (isnan(val)))
+ return(s7_wrong_type_arg_error(sc, "inexact->exact", 1, x, "a normal real"));
+
+ if (c_rationalize(val, default_rationalize_error, &numer, &denom))
return(s7_make_ratio(sc, numer, denom));
}
return(x);
@@ -3862,7 +3888,7 @@ static bool s7_is_zero(s7_pointer x)
static bool s7_is_one(s7_pointer x)
-{
+ {
switch (number_type(x))
{
case NUM_INT: return(s7_integer(x) == 1);
@@ -3889,8 +3915,39 @@ static void s7_Int_to_string(char *p, s7_Int n, int radix, int width)
return;
}
+ if (n == LLONG_MIN)
+ {
+ /* a special case -- we can't use abs on this because it goes to 0, we won't get here if gmp.
+ * (number->string most-negative-fixnum 2) -> "-0" unless we do something special
+ */
+ int j;
+ p[0] = '-';
+ /* build it backwards (will reverse digits below) */
+ p[1] = dignum[-(n % (s7_Int)radix)];
+ n /= (s7_Int)radix;
+ n = -n;
+ for (i = 2; n >= (s7_Int)radix; i++)
+ {
+ p[i] = dignum[n % (s7_Int)radix];
+ n /= (s7_Int)radix;
+ }
+ p[i] = dignum[n];
+ len = i;
+ /* reverse digits (leave sign alone) */
+ for (i = 1, j = len; i < j; i++, j--)
+ {
+ char tmp;
+ tmp = p[i];
+ p[i] = p[j];
+ p[j] = tmp;
+ }
+ p[len + 1] = 0;
+ return;
+ /* there has to be a better way... */
+ }
+
sign = (n < 0);
- n = s7_Int_abs(n); /* most-negative-fixnum loses... */
+ n = s7_Int_abs(n);
/* the previous version that counted up to n, rather than dividing down below n, as here,
* could be confused by large ints on 64 bit machines
@@ -4099,7 +4156,8 @@ static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, int radi
char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, int radix)
{
- return(number_to_string_with_radix(sc, obj, radix, 0, 20, 'g')); /* (log top 10) so we get all the digits */
+ return(number_to_string_with_radix(sc, obj, radix, 0, 20, 'g'));
+ /* (log top 10) so we get all the digits in base 10 (??) */
}
@@ -4231,6 +4289,40 @@ static bool is_radix_prefix(char prefix)
}
+static s7_pointer check_sharp_readers(s7_scheme *sc, const char *name)
+{
+ s7_pointer reader, value, args;
+ int args_loc = -1;
+ value = sc->F;
+
+ /* *#reader* is assumed to be an alist of (char . proc)
+ * where each proc takes one argument, the string from the "#" to the next delimiter.
+ * The procedure can call read-char to read ahead in the current-input-port.
+ * If it returns anything other than #f, that is the value of the sharp expression.
+ * This search happens after #:, #|, #!, #t, and #f.
+ */
+
+ for (reader = symbol_value(sc->sharp_readers); reader != sc->NIL; reader = cdr(reader))
+ {
+ if (name[0] == s7_character(caar(reader)))
+ {
+ if (args_loc == -1)
+ {
+ args = s7_cons(sc, s7_make_string(sc, name), sc->NIL);
+ args_loc = s7_gc_protect(sc, args);
+ }
+ value = s7_call(sc, cdar(reader), args);
+ if (value != sc->F)
+ break;
+ }
+ }
+ if (args_loc != -1)
+ s7_gc_unprotect_at(sc, args_loc);
+
+ return(value);
+}
+
+
static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool at_top)
{
/* name is the stuff after the '#', return sc->NIL if not a recognized #... entity */
@@ -4242,16 +4334,33 @@ static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool at_top)
if (strings_are_equal(name, "f"))
return(sc->F);
+
+ if ((at_top) &&
+ (symbol_value(sc->sharp_readers) != sc->NIL))
+ {
+ x = check_sharp_readers(sc, name);
+ if (x != sc->F)
+ return(x);
+ }
len = safe_strlen(name);
if (len == 0)
return(sc->NIL);
- if (len < 2) /* #<any other char> (except ':', sigh) is an error in this scheme */
+ if (len < 2) /* #<any other char> (except ':', sigh -- #: is the same as : for compatibility with Guile) is an error in this scheme */
return(sc->NIL);
switch (name[0])
{
+ case '<':
+ if (strings_are_equal(name, "<unspecified>"))
+ return(sc->UNSPECIFIED);
+ if (strings_are_equal(name, "<undefined>"))
+ return(sc->UNDEFINED);
+ if (strings_are_equal(name, "<eof>"))
+ return(sc->EOF_OBJECT);
+ return(sc->NIL);
+
case 'o': /* #o (octal) */
case 'd': /* #d (decimal) */
case 'x': /* #x (hex) */
@@ -4350,15 +4459,24 @@ static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool at_top)
else
{
if ((name[1] == 'x') &&
- (name[2] != 0)) /* #\x is just x, but apparently #\x<num> is int->char? #\x65 -> #\e */
+ (name[2] != 0)) /* #\x is just x, but apparently #\x<num> is int->char? #\x65 -> #\e */
{
- int c1 = 0;
- if ((sscanf(name + 2, "%x", &c1) == 1) &&
- (c1 < 256))
- c = c1;
- else return(sc->NIL); /* #\xx -> "undefined sharp expression" */
+ /* sscanf here misses errors like #\x1.4, but even this check misses #\x6/3!
+ */
+ s7_pointer result;
+ result = make_atom(sc, (char *)(name + 2), 16, false);
+ if (s7_is_integer(result))
+ {
+ int c1 = 0;
+ c1 = s7_integer(result);
+ if ((c1 < 256) &&
+ (c1 >= 0)) /* not #\x-65 */
+ c = c1;
+ else return(sc->NIL); /* #\xx -> "undefined sharp expression" */
+ }
+ else return(sc->NIL);
}
- else
+ else /* #\<char> */
{
if (name[2] == 0)
c = name[1];
@@ -4954,15 +5072,26 @@ static s7_pointer s7_string_to_number(s7_scheme *sc, char *str, int radix)
}
+#ifndef INFINITY
+ #define INFINITY (-log(0.0))
+#endif
+
+#ifndef NAN
+ #define NAN (INFINITY / INFINITY)
+#endif
+
+
static s7_pointer g_string_to_number(s7_scheme *sc, s7_pointer args)
{
#define H_string_to_number "(string->number str :optional (radix 10)) converts str into a number"
s7_Int radix = 0;
+ char *str;
if (!s7_is_string(car(args)))
return(s7_wrong_type_arg_error(sc, "string->number", 1, car(args), "a string"));
- if (!(string_value(car(args))))
+ str = (char *)string_value(car(args));
+ if ((!str) || (!(*str)))
return(sc->F);
if (is_pair(cdr(args)))
@@ -4978,7 +5107,18 @@ static s7_pointer g_string_to_number(s7_scheme *sc, s7_pointer args)
}
else radix = 10;
- return(s7_string_to_number(sc, string_value(car(args)), radix));
+ if (safe_strcmp(str, "nan.0") == 0)
+ return(s7_make_real(sc, NAN));
+
+ if ((safe_strcmp(str, "inf.0") == 0) ||
+ (safe_strcmp((const char *)(str + 1), "inf.0") == 0))
+ {
+ if (str[0] == '-')
+ return(s7_make_real(sc, -INFINITY));
+ return(s7_make_real(sc, INFINITY));
+ }
+
+ return(s7_string_to_number(sc, str, radix));
}
@@ -5021,10 +5161,15 @@ static s7_pointer g_make_polar(s7_scheme *sc, s7_pointer args)
mag = num_to_real(number(car(args)));
ang = num_to_real(number(cadr(args)));
+
if (ang == 0.0)
return(s7_make_real(sc, mag));
if (ang == M_PI)
return(s7_make_real(sc, -mag));
+
+ if ((isnan(mag)) || (isnan(ang)) || (isinf(ang)))
+ return(s7_make_real(sc, NAN));
+
return(s7_make_complex(sc, mag * cos(ang), mag * sin(ang)));
}
@@ -5094,6 +5239,7 @@ static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
{
#define H_angle "(angle z) returns the angle of z"
s7_pointer x;
+ s7_Double f;
x = car(args);
if (!s7_is_number(x))
@@ -5101,10 +5247,15 @@ static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
if (!s7_is_real(x))
return(s7_make_real(sc, atan2(s7_imag_part(x), s7_real_part(x))));
- if (num_to_real(number(x)) < 0.0)
+
+ f = num_to_real(number(x));
+ if (isnan(f)) return(x);
+
+ if (f < 0.0)
return(s7_make_real(sc, M_PI));
if (number_type(x) <= NUM_RATIO)
return(small_int(0));
+
return(real_zero);
}
@@ -5112,7 +5263,7 @@ static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args)
{
#define H_rationalize "(rationalize x err) returns the ratio with lowest denominator within err of x"
- s7_Double err;
+ s7_Double err, rat;
s7_Int numer = 0, denom = 1;
s7_pointer x;
@@ -5133,7 +5284,18 @@ static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args)
(err > -1.0))
return(x);
- if (c_rationalize(s7_number_to_real(x), err, &numer, &denom))
+ rat = s7_number_to_real(x);
+
+ /* (rationalize (real-part (log 0))) */
+ if ((isnan(rat)) || (isinf(rat)))
+ return(s7_wrong_type_arg_error(sc, "rationalize", 1, x, "a normal real"));
+ if (isnan(err))
+ return(s7_wrong_type_arg_error(sc, "rationalize", 2, cadr(args), "a normal real"));
+
+ if (s7_Double_abs(rat) < s7_Double_abs(err))
+ return(small_int(0));
+
+ if (c_rationalize(rat, err, &numer, &denom))
return(s7_make_ratio(sc, numer, denom));
return(sc->F);
}
@@ -5147,7 +5309,7 @@ static s7_pointer g_exp(s7_scheme *sc, s7_pointer args)
x = car(args);
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "exp", 0, x, "a number"));
- if (x == small_int(0)) return(small_int(1));
+ if (x == small_int(0)) return(small_int(1)); /* (exp 0) -> 1 */
if (s7_is_real(x))
return(s7_make_real(sc, exp(num_to_real(number(x)))));
@@ -5168,12 +5330,14 @@ static s7_pointer g_log(s7_scheme *sc, s7_pointer args)
if ((is_pair(cdr(args))) &&
(!(s7_is_number(cadr(args)))))
return(s7_wrong_type_arg_error(sc, "log base,", 2, cadr(args), "a number"));
-
+
if (is_pair(cdr(args)))
{
s7_pointer y;
y = cadr(args);
+ if ((x == small_int(1)) && (y == small_int(1))) return(small_int(0));
+
if ((s7_is_zero(y)) || (s7_is_one(y)))
return(s7_out_of_range_error(sc, "log base,", 2, y, "can't be 0.0 or 1.0"));
@@ -5190,14 +5354,14 @@ static s7_pointer g_log(s7_scheme *sc, s7_pointer args)
res = log(num_to_real(number(x))) / log(num_to_real(number(y)));
ires = (s7_Int)res;
if (res - ires == 0.0)
- return(s7_make_integer(sc, ires));
+ return(s7_make_integer(sc, ires)); /* (log i i) -> 1 */
return(s7_make_real(sc, res));
}
return(s7_make_real(sc, log(num_to_real(number(x))) / log(num_to_real(number(y)))));
}
return(s7_from_c_complex(sc, clog(s7_complex(x)) / clog(s7_complex(y))));
}
-
+
if (s7_is_real(x))
{
if (s7_is_positive(x))
@@ -5217,10 +5381,22 @@ static s7_pointer g_sin(s7_scheme *sc, s7_pointer args)
x = car(args);
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "sin", 0, x, "a number"));
- if (x == small_int(0)) return(x);
+ if (x == small_int(0)) return(x); /* (sin 0) -> 0 */
if (s7_is_real(x))
return(s7_make_real(sc, sin(num_to_real(number(x)))));
+
+ /* sin is totally inaccurate over about 1e18. There's a way to get true results,
+ * but it involves fancy "range reduction" techniques.
+ * This mean lots of things are inaccurate:
+ * (sin (remainder 1e22 (* 2 pi)))
+ * -0.57876806033477
+ * but it should be -8.522008497671888065747423101326159661908E-1
+ * ---
+ * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 !!
+ * it should be 5.263007914620499494429139986095833592117E0
+ */
+
return(s7_from_c_complex(sc, csin(s7_complex(x))));
}
@@ -5233,7 +5409,7 @@ static s7_pointer g_cos(s7_scheme *sc, s7_pointer args)
x = car(args);
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "cos", 0, x, "a number"));
- if (x == small_int(0)) return(small_int(1));
+ if (x == small_int(0)) return(small_int(1)); /* (cos 0) -> 1 */
if (s7_is_real(x))
return(s7_make_real(sc, cos(num_to_real(number(x)))));
@@ -5249,7 +5425,7 @@ static s7_pointer g_tan(s7_scheme *sc, s7_pointer args)
x = car(args);
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "tan", 0, x, "a number"));
- if (x == small_int(0)) return(x);
+ if (x == small_int(0)) return(x); /* (tan 0) -> 0 */
if (s7_is_real(x))
return(s7_make_real(sc, tan(num_to_real(number(x)))));
@@ -5372,8 +5548,11 @@ static s7_pointer g_atan(s7_scheme *sc, s7_pointer args)
{
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "atan", 1, x, "a number"));
+
+ if (x == small_int(0)) return(x); /* (atan 0) -> 0 */
if (s7_is_real(x))
return(s7_make_real(sc, atan(num_to_real(number(x)))));
+
return(s7_from_c_complex(sc, catan(s7_complex(x))));
}
@@ -5396,7 +5575,7 @@ static s7_pointer g_sinh(s7_scheme *sc, s7_pointer args)
x = car(args);
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "sinh", 0, x, "a number"));
- if (x == small_int(0)) return(x);
+ if (x == small_int(0)) return(x); /* (sinh 0) -> 0 */
if (s7_is_real(x))
return(s7_make_real(sc, sinh(num_to_real(number(x)))));
@@ -5412,7 +5591,7 @@ static s7_pointer g_cosh(s7_scheme *sc, s7_pointer args)
x = car(args);
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "cosh", 0, x, "a number"));
- if (x == small_int(0)) return(small_int(1));
+ if (x == small_int(0)) return(small_int(1)); /* (cosh 0) -> 1 */
if (s7_is_real(x))
return(s7_make_real(sc, cosh(num_to_real(number(x)))));
@@ -5429,8 +5608,10 @@ static s7_pointer g_tanh(s7_scheme *sc, s7_pointer args)
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "tanh", 0, x, "a number"));
+ if (x == small_int(0)) return(x); /* (tanh 0) -> 0 */
if (s7_is_real(x))
return(s7_make_real(sc, tanh(num_to_real(number(x)))));
+
if (s7_real_part(x) > 350.0)
return(real_one); /* closer than 0.0 which is what ctanh is about to return! */
if (s7_real_part(x) < -350.0)
@@ -5482,9 +5663,11 @@ static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args)
if (!s7_is_number(x))
return(s7_wrong_type_arg_error(sc, "atanh", 0, x, "a number"));
+ if (x == small_int(0)) return(x); /* (atanh 0) -> 0 */
if ((s7_is_real(x)) &&
(s7_Double_abs(num_to_real(number(x))) < 1.0))
return(s7_make_real(sc, atanh(num_to_real(number(x)))));
+
return(s7_from_c_complex(sc, catanh(s7_complex(x))));
}
@@ -5590,9 +5773,15 @@ static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
return(real_zero); /* (expt 0.0 0) -> 0.0 */
}
- if ((s7_is_real(pw)) && (s7_is_negative(pw))) /* (expt 0 -1) */
- return(division_by_zero_error(sc, "expt", args)); /* what about (expt 0 -1+i)? */
+ if (s7_is_real(pw))
+ {
+ if (s7_is_negative(pw)) /* (expt 0 -1) */
+ return(division_by_zero_error(sc, "expt", args)); /* what about (expt 0 -1+i)? */
+ /* (Clisp gives divide-by-zero error here, Guile returns inf.0) */
+ if (isnan(s7_real(pw))) /* (expt 0 +nan.0) */
+ return(pw);
+ }
if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* pw != 0, (expt 0 2312) */
return(small_int(0));
return(real_zero); /* (expt 0.0 123123) */
@@ -5613,6 +5802,7 @@ static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
y = s7_integer(pw);
if (y == 0)
{
+ /* (expt +nan.0 0) ?? */
if ((number_type(n) == NUM_INT) || (number_type(n) == NUM_RATIO))
return(small_int(1));
return(real_one);
@@ -5695,8 +5885,11 @@ static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
x = num_to_real(number(n));
y = num_to_real(number(pw));
- if (y == 0.0)
- return(real_one);
+
+ if (isnan(x)) return(n);
+ if (isnan(y)) return(pw);
+ if (y == 0.0) return(real_one);
+
if ((x > 0.0) ||
((y - floor(y)) < 1.0e-16))
return(s7_make_real(sc, pow(x, y)));
@@ -5732,6 +5925,7 @@ static s7_pointer g_floor(s7_scheme *sc, s7_pointer args)
}
default:
+ if (isnan(real(number(x)))) return(x);
return(s7_make_integer(sc, (s7_Int)floor(real(number(x)))));
}
}
@@ -5761,6 +5955,7 @@ static s7_pointer g_ceiling(s7_scheme *sc, s7_pointer args)
}
default:
+ if (isnan(real(number(x)))) return(x);
return(s7_make_integer(sc, (s7_Int)ceil(real(number(x)))));
}
}
@@ -5784,6 +5979,7 @@ static s7_pointer g_truncate(s7_scheme *sc, s7_pointer args)
return(s7_make_integer(sc, (s7_Int)(numerator(number(x)) / denominator(number(x))))); /* C "/" already truncates */
default:
+ if (isnan(real(number(x)))) return(x);
return(s7_make_integer(sc, s7_truncate(real(number(x)))));
}
}
@@ -5824,7 +6020,8 @@ static s7_pointer g_round(s7_scheme *sc, s7_pointer args)
}
default:
- return(s7_make_integer(sc, (s7_Int)round_per_R5RS(num_to_real(number(x)))));
+ if (isnan(real(number(x)))) return(x);
+ return(s7_make_integer(sc, (s7_Int)round_per_R5RS(real(number(x)))));
}
}
@@ -6331,7 +6528,7 @@ static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
i2 = num_to_imag_part(b);
den = (r2 * r2 + i2 * i2);
- /* SOMEDAY: avoid the squaring (see Knuth II p613 16)
+ /* we could avoid the squaring (see Knuth II p613 16)
* not a big deal: (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) => nan
* (gmp case is ok here)
*/
@@ -6367,6 +6564,7 @@ static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
result = ap;
a = number(ap);
+ if ((a.type > NUM_RATIO) && (isnan(real(a)))) return(s7_make_real(sc, NAN));
i = 2;
while (true)
{
@@ -6409,6 +6607,7 @@ static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
break;
default:
+ if ((b.type > NUM_RATIO) && (isnan(real(b)))) return(s7_make_real(sc, NAN));
if (num_to_real(a) < num_to_real(b))
{
a = b;
@@ -6444,6 +6643,7 @@ static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
result = ap;
a = number(ap);
+ if ((a.type > NUM_RATIO) && (isnan(real(a)))) return(s7_make_real(sc, NAN));
i = 2;
while (true)
{
@@ -6486,6 +6686,7 @@ static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
break;
default:
+ if ((b.type > NUM_RATIO) && (isnan(real(b)))) return(s7_make_real(sc, NAN));
if (num_to_real(a) > num_to_real(b))
{
a = b;
@@ -6553,7 +6754,16 @@ static s7_pointer g_remainder(s7_scheme *sc, s7_pointer args)
num_to_denominator(a) * num_to_denominator(b)));
default:
+ /* if a < b we can just return a */
return(s7_make_real(sc, num_to_real(a) - num_to_real(b) * quotient(a, b)));
+
+ /* see under sin -- this calculation is completely bogus if "a" is large
+ * (quotient 1e22 (* 2 pi)) -> -9223372036854775808 -- should this return arithmetic-overflow?
+ * but it should be 1591549430918953357688,
+ * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22
+ * -- the "remainder" is greater than the original argument!
+ * Clisp gives 0.0 here, as does sbcl
+ */
}
}
@@ -6591,7 +6801,18 @@ static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args)
num_to_denominator(a) * num_to_denominator(b)));
default:
- return(s7_make_real(sc, num_to_real(a) - num_to_real(b) * (s7_Int)floor(num_to_real(a) / num_to_real(b))));
+ {
+ s7_Double ax, bx;
+ ax = num_to_real(a);
+ bx = num_to_real(b);
+
+ if (isnan(ax)) return(ap);
+ if (isnan(bx)) return(bp);
+ if ((isinf(ax)) || (isinf(bx)))
+ return(s7_make_real(sc, sqrt(-1))); /* this is supposed to be a NaN */
+
+ return(s7_make_real(sc, ax - bx * (s7_Int)floor(ax / bx)));
+ }
}
}
@@ -6763,6 +6984,8 @@ static s7_pointer g_less_1(s7_scheme *sc, bool reversed, s7_pointer args)
a = number(car(args));
type_a = num_type(a);
+ if ((type_a > NUM_RATIO) && (isnan(real(a))))
+ return(sc->F);
i = 2;
x = cdr(args);
@@ -6777,6 +7000,8 @@ static s7_pointer g_less_1(s7_scheme *sc, bool reversed, s7_pointer args)
b = number(tmp);
type_b = num_type(b);
+ if ((type_b > NUM_RATIO) && (isnan(real(b))))
+ return(sc->F);
switch (type_a)
{
@@ -6908,6 +7133,8 @@ static s7_pointer g_greater_1(s7_scheme *sc, bool reversed, s7_pointer args)
a = number(car(args));
type_a = num_type(a);
+ if ((type_a > NUM_RATIO) && (isnan(real(a))))
+ return(sc->F);
i = 2;
x = cdr(args);
@@ -6922,6 +7149,8 @@ static s7_pointer g_greater_1(s7_scheme *sc, bool reversed, s7_pointer args)
b = number(tmp);
type_b = num_type(b);
+ if ((type_b > NUM_RATIO) && (isnan(real(b))))
+ return(sc->F);
/* the ">" operator here is a problem.
* we get different results depending on the gcc optimization level for cases like (< 1234/11 1234/11)
@@ -7100,6 +7329,45 @@ static s7_pointer g_denominator(s7_scheme *sc, s7_pointer args)
}
+static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_nan "(nan? obj) returns #t if obj is a NaN"
+ s7_pointer x;
+
+ x = car(args);
+#if WITH_GMP
+ return(make_boolean(sc, (isnan(s7_real_part(x))) || (isnan(s7_imag_part(x)))));
+#else
+ if (s7_is_number(x))
+ {
+ switch (number_type(x))
+ {
+ case NUM_INT:
+ case NUM_RATIO:
+ return(sc->F);
+
+ case NUM_REAL:
+ case NUM_REAL2:
+ return(make_boolean(sc, isnan(real(number(x)))));
+
+ default:
+ return(make_boolean(sc, (isnan(s7_real_part(x))) || (isnan(s7_imag_part(x)))));
+ }
+ }
+#endif
+ return(sc->F);
+}
+
+
+static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real"
+ s7_pointer x;
+ x = car(args);
+ return(make_boolean(sc, (isinf(s7_real_part(x))) || (isinf(s7_imag_part(x)))));
+}
+
+
static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args)
{
#define H_is_number "(number? obj) returns #t if obj is a number"
@@ -7183,8 +7451,10 @@ static s7_pointer g_is_negative(s7_scheme *sc, s7_pointer args)
static s7_pointer g_inexact_to_exact(s7_scheme *sc, s7_pointer args)
{
#define H_inexact_to_exact "(inexact->exact num) converts num to an exact number; (inexact->exact 1.5) = 3/2"
+
if (!s7_is_number(car(args)))
return(s7_wrong_type_arg_error(sc, "inexact->exact", 0, car(args), "a number"));
+
return(inexact_to_exact(sc, car(args)));
}
@@ -7215,12 +7485,6 @@ static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args)
return(make_boolean(sc, s7_is_inexact(car(args))));
}
-/* if these two meant "are represented exactly in the computer", we'd have int/ratios exact
- * (up to most-positive-fixnum, if any); reals and complex exact if they can be exactly
- * handled in floats (1.0 is exact, as is 0.5, if the printout isn't misleading us). 0.1 is inexact.
- * And we'd have both exact and inexact complex (1+i is just as exact as 1).
- */
-
bool s7_is_ulong(s7_pointer arg)
{
@@ -7284,6 +7548,44 @@ static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args)
}
+static s7_pointer g_integer_decode_float(s7_scheme *sc, s7_pointer args)
+{
+ #define H_integer_decode_float "(integer-decode-float x) returns a list containing the significand, exponent, and sign of 'x'"
+
+ s7_Int ix;
+ s7_pointer arg;
+ arg = car(args);
+
+ /* frexp doesn't work in edge cases. Since the double and long long int fields are equivalenced
+ * in the s7_num struct, we can get the actual bits of the double from the int. The problem with doing this
+ * is that bignums don't use that struct. Assume IEEE 754 and double = s7_Double.
+ */
+
+ if ((!s7_is_real(arg)) ||
+ (s7_is_rational(arg)))
+ return(s7_wrong_type_arg_error(sc, "integer-decode-float", 0, arg, "a non-rational real"));
+
+ if (s7_real(arg) == 0.0)
+ return(make_list_3(sc, small_int(0), small_int(0), small_int(1)));
+
+#if WITH_GMP
+ if (is_c_object(arg))
+ {
+ s7_num_t num;
+ real(num) = s7_number_to_real(arg);
+ ix = integer(num);
+ }
+ else
+#endif
+
+ ix = integer(number(arg));
+ return(make_list_3(sc,
+ s7_make_integer(sc, (s7_Int)((ix & 0xfffffffffffffLL) | 0x10000000000000LL)),
+ s7_make_integer(sc, (s7_Int)(((ix & 0x7fffffffffffffffLL) >> 52) - 1023 - 52)),
+ s7_make_integer(sc, ((ix & 0x8000000000000000LL) != 0) ? -1 : 1)));
+}
+
+
static s7_pointer g_logior(s7_scheme *sc, s7_pointer args)
{
#define H_logior "(logior i1 ...) returns the bitwise OR of its integer arguments"
@@ -7816,7 +8118,9 @@ s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, int len)
NEW_CELL(sc, x);
set_type(x, T_STRING | T_ATOM | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY); /* should this follow the malloc? */
string_value(x) = (char *)malloc((len + 1) * sizeof(char));
- memcpy((void *)string_value(x), (void *)str, len + 1);
+ if (len != 0) /* memcpy can segfault if string_value(x) is NULL */
+ memcpy((void *)string_value(x), (void *)str, len + 1);
+ else string_value(x)[0] = 0;
string_length(x) = len;
return(x);
}
@@ -8116,28 +8420,6 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args)
}
-static int safe_strcmp(const char *s1, const char *s2)
-{
- int val;
- if (s1 == NULL)
- {
- if (s2 == NULL)
- return(0);
- return(-1);
- }
- if (s2 == NULL)
- return(1);
-
- val = strcmp(s1, s2); /* strcmp can return stuff like -97, but we want -1, 0, or 1 */
-
- if (val <= -1)
- return(-1);
- if (val >= 1)
- return(1);
- return(val);
-}
-
-
static s7_pointer g_string_cmp(s7_scheme *sc, s7_pointer args, int val, const char *name)
{
int i;
@@ -8406,7 +8688,7 @@ static s7_pointer g_string_to_list(s7_scheme *sc, s7_pointer args)
str = string_value(car(args));
if (str) len = safe_strlen(str);
- if (len == 0)
+ if (len == 0) /* (string->list (string #\null)) will return '() -- not sure that's correct */
return(sc->NIL);
sc->w = sc->NIL;
@@ -8439,21 +8721,24 @@ static s7_pointer g_port_line_number(s7_scheme *sc, s7_pointer args)
{
#define H_port_line_number "(port-line-number input-file-port) returns the current read line number of port"
s7_pointer x;
- x = car(args);
- if (!(is_input_port(x)))
- return(s7_wrong_type_arg_error(sc, "port-line-number", 1, x, "an input port"));
+ if (args == sc->NIL)
+ x = sc->input_port;
+ else x = car(args);
- if (is_file_port(x))
- return(s7_make_integer(sc, port_line_number(x)));
+ if ((!(is_input_port(x))) ||
+ (port_is_closed(x)))
+ return(s7_wrong_type_arg_error(sc, "port-line-number", 1, x, "an open input port"));
- return(sc->F); /* not an error! */
+ return(s7_make_integer(sc, port_line_number(x)));
}
const char *s7_port_filename(s7_pointer x)
{
- if ((is_input_port(x)) || (is_output_port(x))) /* make sure it's some kind of port */
+ if (((is_input_port(x)) ||
+ (is_output_port(x))) &&
+ (!port_is_closed(x)))
return(port_filename(x));
return(NULL);
}
@@ -8464,11 +8749,16 @@ static s7_pointer g_port_filename(s7_scheme *sc, s7_pointer args)
#define H_port_filename "(port-filename file-port) returns the filename associated with port"
s7_pointer x;
- x = car(args);
- if ((is_input_port(x)) || (is_output_port(x)))
+ if (args == sc->NIL)
+ x = sc->input_port;
+ else x = car(args);
+
+ if (((is_input_port(x)) ||
+ (is_output_port(x))) &&
+ (!port_is_closed(x)))
return(make_protected_string(sc, port_filename(x)));
- return(s7_wrong_type_arg_error(sc, "port-filename", 1, x, "a port"));
+ return(s7_wrong_type_arg_error(sc, "port-filename", 1, x, "an open port"));
}
@@ -8519,9 +8809,10 @@ static s7_pointer g_set_current_input_port(s7_scheme *sc, s7_pointer args)
s7_pointer old_port, port;
old_port = sc->input_port;
port = car(args);
- if (s7_is_input_port(sc, port))
+ if ((s7_is_input_port(sc, port)) &&
+ (!port_is_closed(port)))
sc->input_port = port;
- else return(s7_wrong_type_arg_error(sc, "set-current-input-port", 0, port, "an input port or nil"));
+ else return(s7_wrong_type_arg_error(sc, "set-current-input-port", 0, port, "an open input port or nil"));
return(old_port);
}
@@ -8563,9 +8854,10 @@ static s7_pointer g_set_current_output_port(s7_scheme *sc, s7_pointer args)
s7_pointer old_port, port;
old_port = sc->output_port;
port = car(args);
- if (s7_is_output_port(sc, port))
+ if ((s7_is_output_port(sc, port)) &&
+ (!port_is_closed(port)))
sc->output_port = port;
- else return(s7_wrong_type_arg_error(sc, "set-current-output-port", 0, port, "an output port or nil"));
+ else return(s7_wrong_type_arg_error(sc, "set-current-output-port", 0, port, "an open output port or nil"));
return(old_port);
}
@@ -8598,9 +8890,10 @@ static s7_pointer g_set_current_error_port(s7_scheme *sc, s7_pointer args)
s7_pointer old_port, port;
old_port = sc->error_port;
port = car(args);
- if (s7_is_output_port(sc, port))
+ if ((s7_is_output_port(sc, port)) &&
+ (!port_is_closed(port)))
sc->error_port = port;
- else return(s7_wrong_type_arg_error(sc, "set-current-error-port", 0, port, "an output port or nil"));
+ else return(s7_wrong_type_arg_error(sc, "set-current-error-port", 0, port, "an open output port or nil"));
return(old_port);
}
@@ -8613,6 +8906,8 @@ static s7_pointer g_is_char_ready(s7_scheme *sc, s7_pointer args)
s7_pointer pt = car(args);
if (!s7_is_input_port(sc, pt))
return(s7_wrong_type_arg_error(sc, "char-ready?", 0, pt, "an input port"));
+ if (port_is_closed(pt))
+ return(s7_wrong_type_arg_error(sc, "char-ready?", 0, pt, "an open input port"));
if (is_function_port(pt))
return((*(port_input_function(pt)))(sc, S7_IS_CHAR_READY, pt));
@@ -8709,10 +9004,12 @@ static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, long max_
{
s7_pointer port;
long size;
+ int port_loc;
char *content = NULL;
NEW_CELL(sc, port);
set_type(port, T_INPUT_PORT | T_ATOM | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
+ port_loc = s7_gc_protect(sc, port);
port->object.port = (s7_port_t *)calloc(1, sizeof(s7_port_t));
port_is_closed(port) = false;
port_filename(port) = make_permanent_string(name);
@@ -8752,6 +9049,8 @@ static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, long max_
port_type(port) = FILE_PORT;
port_needs_free(port) = false;
}
+
+ s7_gc_unprotect_at(sc, port_loc);
return(port);
}
@@ -8904,6 +9203,9 @@ static s7_pointer g_get_output_string(s7_scheme *sc, s7_pointer args)
if ((!is_output_port(p)) ||
(!is_string_port(p)))
return(s7_wrong_type_arg_error(sc, "get-output-string", 0, p, "an output string port"));
+ if (port_is_closed(p))
+ return(s7_wrong_type_arg_error(sc, "get-output-string", 0, p, "an active (open) string port"));
+
return(s7_make_string(sc, s7_get_output_string(sc, p)));
}
@@ -8922,7 +9224,7 @@ s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_schem
}
-s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, char c, s7_pointer port))
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, unsigned char c, s7_pointer port))
{
s7_pointer x;
NEW_CELL(sc, x);
@@ -8976,13 +9278,13 @@ static int inchar(s7_scheme *sc, s7_pointer pt)
if (pt == sc->NIL) return(EOF);
if (is_file_port(pt))
- c = fgetc(port_file(pt));
+ c = fgetc(port_file(pt)); /* not unsigned char! -- could be EOF */
else
{
if ((!(port_string(pt))) ||
(port_string_length(pt) <= port_string_point(pt)))
return(EOF);
- c = port_string(pt)[port_string_point(pt)++];
+ c = (unsigned char)port_string(pt)[port_string_point(pt)++];
}
if (c == '\n')
@@ -9009,10 +9311,10 @@ static void backchar(s7_scheme *sc, char c, s7_pointer pt)
}
-static char s7_read_char_1(s7_scheme *sc, s7_pointer port, s7_read_t read_choice)
+static int s7_read_char_1(s7_scheme *sc, s7_pointer port, s7_read_t read_choice)
{
/* port nil -> as if read-char with no arg -> use current input port */
- int c;
+ int c; /* needs to be an int so EOF=-1, but not 255 */
if (is_function_port(port))
return(character((*(port_input_function(port)))(sc, read_choice, port)));
@@ -9024,13 +9326,13 @@ static char s7_read_char_1(s7_scheme *sc, s7_pointer port, s7_read_t read_choice
}
-char s7_read_char(s7_scheme *sc, s7_pointer port)
+int s7_read_char(s7_scheme *sc, s7_pointer port)
{
return(s7_read_char_1(sc, port, S7_READ_CHAR));
}
-char s7_peek_char(s7_scheme *sc, s7_pointer port)
+int s7_peek_char(s7_scheme *sc, s7_pointer port)
{
return(s7_read_char_1(sc, port, S7_PEEK_CHAR));
}
@@ -9038,7 +9340,7 @@ char s7_peek_char(s7_scheme *sc, s7_pointer port)
static s7_pointer g_read_char_1(s7_scheme *sc, s7_pointer args, bool peek)
{
- char c;
+ int c;
s7_pointer port;
if (args != sc->NIL)
@@ -9046,6 +9348,8 @@ static s7_pointer g_read_char_1(s7_scheme *sc, s7_pointer args, bool peek)
else port = sc->input_port;
if (!s7_is_input_port(sc, port))
return(s7_wrong_type_arg_error(sc, (peek) ? "peek-char" : "read-char", 0, port, "an input port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, (peek) ? "peek-char" : "read-char", 0, port, "an open input port"));
c = s7_read_char_1(sc, port, (peek) ? S7_PEEK_CHAR : S7_READ_CHAR);
if (c == EOF)
@@ -9083,6 +9387,8 @@ If 'with-eol' is not #f, include the trailing end-of-line character."
port = car(args);
if (!s7_is_input_port(sc, port))
return(s7_wrong_type_arg_error(sc, "read-line", 0, port, "an input port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "read-line", 0, port, "an open input port"));
if ((cdr(sc->args) != sc->NIL) &&
(cadr(sc->args) != sc->F))
@@ -9172,11 +9478,18 @@ static s7_pointer g_read(s7_scheme *sc, s7_pointer args)
* should stdin work in that case?
*/
return(s7_wrong_type_arg_error(sc, "read", 0, port, "an input port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "read", 0, port, "an open input port"));
if (is_function_port(port))
return((*(port_input_function(port)))(sc, S7_READ, port));
+ if ((is_string_port(port)) &&
+ (port_string_length(port) <= port_string_point(port)))
+ return(sc->EOF_OBJECT);
+
push_input_port(sc, port);
+
push_stack(sc, opcode(OP_READ_POP_AND_RETURN_EXPRESSION), sc->NIL, sc->NIL); /* this stops the internal read process so we only get one form */
push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
return(port);
@@ -9390,6 +9703,20 @@ static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args)
sc->envir = cadr(args);
}
+ /* if we had an independent stack+evaluator here, we wouldn't have to worry
+ * about an error in eval-string screwing up everything else. But if we
+ * clone_s7 (with a reasonable stack size!), how do we make sure it is
+ * gc protected? Currently this does the right thing:
+
+ (define t1 (make-thread
+ (lambda ()
+ (eval-string "#2d((1 2) #2d((3 4) 5 6))"))))
+ (join-thread t1)
+
+ * so we'd need (with-evaluator ...)?
+ * and some way to set initial stack sizes -- the current 4000 seems excessive
+ */
+
return(eval_string_1(sc, s7_string(car(args))));
}
@@ -9466,6 +9793,8 @@ static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args)
return(s7_wrong_type_arg_error(sc, "call-with-input-string", 1, car(args), "a string"));
if (!is_procedure(cadr(args)))
return(s7_wrong_type_arg_error(sc, "call-with-input-string", 2, cadr(args), "a procedure"));
+ if ((is_continuation(cadr(args))) || is_goto(cadr(args)))
+ return(s7_wrong_type_arg_error(sc, "call-with-input-string", 2, cadr(args), "a normal procedure (not a continuation)"));
return(call_with_input(sc, s7_open_input_string(sc, s7_string(car(args))), args));
}
@@ -9479,6 +9808,8 @@ static s7_pointer g_call_with_input_file(s7_scheme *sc, s7_pointer args)
return(s7_wrong_type_arg_error(sc, "call-with-input-file", 1, car(args), "a string (a filename)"));
if (!is_procedure(cadr(args)))
return(s7_wrong_type_arg_error(sc, "call-with-input-file", 2, cadr(args), "a procedure"));
+ if ((is_continuation(cadr(args))) || is_goto(cadr(args)))
+ return(s7_wrong_type_arg_error(sc, "call-with-input-file", 2, cadr(args), "a normal procedure (not a continuation)"));
return(call_with_input(sc, s7_open_input_file(sc, s7_string(car(args)), "r"), args));
}
@@ -9517,6 +9848,12 @@ static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args)
if (!is_thunk(sc, cadr(args)))
return(s7_wrong_type_arg_error(sc, "with-input-from-string", 2, cadr(args), "a thunk"));
+ /* since the arguments are evaluated before we get here, we can get some confusing situations:
+ * (with-input-from-string "#x2.1" (read))
+ * (read) -> whatever it can get from the current input port!
+ * ";with-input-from-string argument 2, #<eof>, is untyped but should be a thunk"
+ */
+
return(with_input(sc, s7_open_input_string(sc, s7_string(car(args))), args));
}
@@ -9549,7 +9886,7 @@ static void char_to_string_port(char c, s7_pointer pt)
}
-static void write_char(s7_scheme *sc, char c, s7_pointer pt)
+static void write_char(s7_scheme *sc, int c, s7_pointer pt)
{
if (pt == sc->NIL)
fputc(c, stderr);
@@ -9805,7 +10142,7 @@ static char *atom_to_c_string(s7_scheme *sc, s7_pointer obj, bool use_write)
{
char *buf;
buf = (char *)calloc(512, sizeof(char));
- snprintf(buf, 512, "<unknown object! type: %d (%s), flags: %x%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s>",
+ snprintf(buf, 512, "<unknown object! type: %d (%s), flags: %x%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s>",
type(obj),
type_name(obj),
typeflag(obj),
@@ -9823,7 +10160,8 @@ static char *atom_to_c_string(s7_scheme *sc, s7_pointer obj, bool use_write)
is_expansion(obj) ? " (expansion)" : "",
(!is_not_local(obj)) ? " (local)" : "",
symbol_accessed(obj) ? " (accessed)" : "",
- symbol_has_accessor(obj) ? " (has accessor)" : "",
+ symbol_has_accessor(obj) ? " (accessor)" : "",
+ has_structure(obj) ? " (structure)" : "",
((typeflag(obj) & UNUSED_BITS) != 0) ? " bad bits!" : "");
return(buf);
}
@@ -9837,44 +10175,260 @@ bool s7_is_valid_pointer(s7_pointer arg)
}
-static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, int depth, bool to_file);
-static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, int depth);
+static int display_multivector(s7_scheme *sc, s7_pointer vec, int out_len, int flat_ref, int dimension, int dimensions, char *out_str, char **elements, char *last)
+{
+ int i;
+
+ if (*last == ')')
+ strcat(out_str, " ");
+
+ strcat(out_str, "(");
+ (*last) = '(';
+
+ for (i = 0; i < vector_dimension(vec, dimension); i++)
+ {
+ if (dimension == (dimensions - 1))
+ {
+ strcat(out_str, elements[flat_ref++]);
+ if (out_len < flat_ref)
+ {
+ strcat(out_str, "...");
+ return(flat_ref);
+ }
+ if (i < (vector_dimension(vec, dimension) - 1))
+ strcat(out_str, " ");
+ }
+ else
+ {
+ if (flat_ref < out_len)
+ flat_ref = display_multivector(sc, vec, out_len, flat_ref, dimension + 1, dimensions, out_str, elements, last);
+ }
+ }
+ strcat(out_str, ")");
+ (*last) = ')';
+ return(flat_ref);
+}
+
+
+typedef struct {
+ s7_pointer *objs;
+ int size, top, ref;
+ int *refs;
+} shared_info;
+
+#define INITIAL_SHARED_INFO_SIZE 8
-static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, bool use_write, int depth, bool to_file)
+static shared_info *free_shared_info(shared_info *ci)
{
- if ((s7_is_vector(obj)) ||
- (s7_is_hash_table(obj)))
- return(vector_to_c_string(sc, obj, depth, to_file));
+ if (ci)
+ {
+ if (ci->objs) free(ci->objs);
+ if (ci->refs) free(ci->refs);
+ ci->objs = NULL;
+ free(ci);
+ }
+ return(NULL);
+}
- if (is_pair(obj))
- return(list_to_c_string(sc, obj, depth));
- return(atom_to_c_string(sc, obj, use_write));
+static int shared_ref(shared_info *ci, s7_pointer p)
+{
+ int i;
+ for (i = 0; i < ci->top; i++)
+ if (ci->objs[i] == p)
+ {
+ int val;
+ val = ci->refs[i];
+ if (val > 0)
+ ci->refs[i] = -ci->refs[i];
+ return(val);
+ }
+ return(0);
+}
+
+
+static int peek_shared_ref(shared_info *ci, s7_pointer p)
+{
+ /* returns 0 if not found, otherwise the ref value for p */
+ int i;
+ for (i = 0; i < ci->top; i++)
+ if (ci->objs[i] == p)
+ return(ci->refs[i]);
+ return(0);
+}
+
+
+static void check_shared_info_size(shared_info *ci)
+{
+ if (ci->top == ci->size)
+ {
+ int i;
+ ci->size *= 2;
+ ci->objs = (s7_pointer *)realloc(ci->objs, ci->size * sizeof(s7_pointer));
+ ci->refs = (int *)realloc(ci->refs, ci->size * sizeof(int));
+ for (i = ci->top; i < ci->size; i++) ci->refs[i] = 0;
+ }
+}
+
+
+static void add_equal_ref(shared_info *ci, s7_pointer x, s7_pointer y)
+{
+ /* assume neither x nor y is in the table, and that they should share a ref value */
+ check_shared_info_size(ci);
+ ci->ref++;
+ ci->objs[ci->top] = x;
+ ci->refs[ci->top++] = ci->ref;
+ check_shared_info_size(ci);
+ ci->objs[ci->top] = y;
+ ci->refs[ci->top++] = ci->ref;
+}
+
+
+static void add_shared_ref(shared_info *ci, s7_pointer x, int ref_x)
+{
+ check_shared_info_size(ci);
+ ci->objs[ci->top] = x;
+ ci->refs[ci->top++] = ref_x;
}
-static char *object_to_c_string_with_circle_check(s7_scheme *sc, s7_pointer vr, int depth)
+static shared_info *collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top)
{
- int k, lim;
+ int i, ref = -1;
+
+ /* look for top in current list */
+ for (i = 0; i < ci->top; i++)
+ if (ci->objs[i] == top)
+ {
+ if (ci->refs[i] == 0)
+ ci->refs[i] = ++ci->ref; /* if found, set the ref number */
+ ref = ci->refs[i];
+ break;
+ }
+
+ if (ref == -1)
+ {
+ /* top not found -- add it to the list */
+ check_shared_info_size(ci);
+ ci->objs[ci->top++] = top;
+
+ /* now search the rest of this structure */
+ if (is_pair(top))
+ {
+ if (has_structure(car(top)))
+ collect_shared_info(sc, ci, car(top));
+ if (has_structure(cdr(top)))
+ collect_shared_info(sc, ci, cdr(top));
+ }
+ else
+ {
+ int i, plen;
+ plen = s7_integer(symbol_value(sc->vector_print_length));
+ if (plen > vector_length(top))
+ plen = vector_length(top);
+ for (i = 0; i < plen; i++)
+ if (has_structure(vector_element(top, i)))
+ collect_shared_info(sc, ci, vector_element(top, i));
+ }
+ }
+ return(ci);
+}
+
- lim = depth;
- if (lim >= CIRCULAR_REFS_SIZE) lim = CIRCULAR_REFS_SIZE - 1;
+static shared_info *new_shared_info(s7_scheme *sc)
+{
+ shared_info *ci;
+ ci = (shared_info *)calloc(1, sizeof(shared_info));
+ ci->top = 0;
+ ci->ref = 0;
+ ci->size = INITIAL_SHARED_INFO_SIZE;
+ ci->objs = (s7_pointer *)malloc(ci->size * sizeof(s7_pointer));
+ ci->refs = (int *)calloc(ci->size, sizeof(int)); /* finder expects 0 = unseen previously */
+ return(ci);
+}
- for (k = 0; k <= lim; k++)
- if (s7_is_eq(vr, sc->circular_refs[k]))
+
+static shared_info *make_shared_info(s7_scheme *sc, s7_pointer top)
+{
+ shared_info *ci;
+ int i, refs;
+
+ ci = new_shared_info(sc);
+
+ /* collect all pointers associated with top */
+ collect_shared_info(sc, ci, top);
+
+ /* find if any were referenced twice */
+ for (i = 0, refs = 0; i < ci->top; i++)
+ if (ci->refs[i] > 0)
{
- if (s7_is_vector(vr))
- return(copy_string("[circular vector]"));
- if (s7_is_hash_table(vr))
- return(copy_string("[circular hash-table]"));
- return(copy_string("[circular list]"));
+ if (i == refs)
+ refs++;
+ else
+ {
+ ci->objs[refs] = ci->objs[i];
+ ci->refs[refs++] = ci->refs[i];
+ }
}
+ ci->top = refs;
+
+ if (refs == 0)
+ {
+ free_shared_info(ci);
+ return(NULL);
+ }
+ return(ci);
+}
+
+
+
+static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, bool to_file, shared_info *ci);
+static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, shared_info *ci);
+
+static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, bool use_write, bool to_file, shared_info *ci)
+{
+ if ((s7_is_vector(obj)) ||
+ (s7_is_hash_table(obj)))
+ return(vector_to_c_string(sc, obj, to_file, ci));
+
+ if (is_pair(obj))
+ return(list_to_c_string(sc, obj, ci));
- return(s7_object_to_c_string_1(sc, vr, true, depth + 1, false));
+ return(atom_to_c_string(sc, obj, use_write));
+}
+
+
+static char *object_to_c_string_with_circle_check(s7_scheme *sc, s7_pointer vr, bool use_write, bool to_file, shared_info *ci)
+{
+ if (ci)
+ {
+ int ref;
+ ref = shared_ref(ci, vr);
+ if (ref != 0)
+ {
+ char *name;
+ if (ref > 0)
+ {
+ char *element;
+ element = s7_object_to_c_string_1(sc, vr, true, false, ci);
+ name = (char *)calloc(strlen(element) + 32, sizeof(char));
+ sprintf(name, "#%d=%s", ref, element);
+ free(element);
+ return(name);
+ }
+ else
+ {
+ name = (char *)calloc(32, sizeof(char));
+ snprintf(name, 32, "#%d#", -ref);
+ return(name);
+ }
+ }
+ }
+ return(s7_object_to_c_string_1(sc, vr, use_write, to_file, ci));
}
-static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, int depth, bool to_file)
+static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, bool to_file, shared_info *ci)
{
s7_Int i, len, bufsize = 0;
bool too_long = false;
@@ -9883,7 +10437,15 @@ static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, int depth, bool
len = vector_length(vect);
if (len == 0)
- return(copy_string("#()"));
+ {
+ if (vector_is_multidimensional(vect))
+ {
+ buf = (char *)calloc(16, sizeof(char));
+ snprintf(buf, 16, "#%dD()", vector_ndims(vect));
+ return(buf);
+ }
+ else return(copy_string("#()"));
+ }
if (!to_file)
{
@@ -9896,7 +10458,7 @@ static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, int depth, bool
* (write vect))))
*/
- plen = s7_integer(s7_symbol_value(sc, s7_make_symbol(sc, "*vector-print-length*")));
+ plen = s7_integer(symbol_value(sc->vector_print_length));
if (plen <= 0)
return(copy_string("#(...)"));
@@ -9907,20 +10469,29 @@ static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, int depth, bool
}
}
- if (depth < CIRCULAR_REFS_SIZE)
- sc->circular_refs[depth] = vect; /* (let ((v (vector 1 2))) (vector-set! v 0 v) v) */
-
elements = (char **)malloc(len * sizeof(char *));
for (i = 0; i < len; i++)
{
- elements[i] = object_to_c_string_with_circle_check(sc, vector_element(vect, i), depth);
+ elements[i] = object_to_c_string_with_circle_check(sc, vector_element(vect, i), true, false, ci);
bufsize += safe_strlen(elements[i]);
}
bufsize += (len * 2 + 256);
buf = (char *)malloc(bufsize * sizeof(char));
- sprintf(buf, "#(");
+ if (vector_is_multidimensional(vect))
+ {
+ char c;
+ c = '#';
+ snprintf(buf, bufsize, "#%dD", vector_ndims(vect));
+ display_multivector(sc, vect, len, 0, 0, vector_ndims(vect), buf, elements, &c);
+ for (i = 0; i < len; i++)
+ free(elements[i]);
+ free(elements);
+ return(buf);
+ }
+
+ sprintf(buf, "#(");
for (i = 0; i < len - 1; i++)
{
if (elements[i])
@@ -9930,11 +10501,13 @@ static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, int depth, bool
strcat(buf, " ");
}
}
+
if (elements[len - 1])
{
strcat(buf, elements[len - 1]);
free(elements[len - 1]);
}
+
free(elements);
if (too_long)
strcat(buf, " ...");
@@ -9945,13 +10518,32 @@ static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, int depth, bool
static s7_pointer vector_to_string(s7_scheme *sc, s7_pointer vect)
{
- return(make_string_uncopied(sc, vector_to_c_string(sc, vect, 0, false)));
+ s7_pointer result;
+ shared_info *ci = NULL;
+ ci = make_shared_info(sc, vect);
+ result = make_string_uncopied(sc, object_to_c_string_with_circle_check(sc, vect, true, false, ci));
+ if (ci) free_shared_info(ci);
+ return(result);
}
-static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, int depth)
+static int circular_list_entries(s7_scheme *sc, s7_pointer lst)
+{
+ int i;
+ s7_pointer x;
+ for (i = 1, x = cdr(lst); ; i++, x = cdr(x))
+ {
+ int j;
+ s7_pointer y;
+ for (y = lst, j = 0; j < i; y = cdr(y), j++)
+ if (x == y)
+ return(i + 1);
+ }
+}
+
+
+static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, shared_info *ci)
{
- bool dotted = false;
s7_pointer x;
int i, len, bufsize = 0;
char **elements = NULL;
@@ -9959,37 +10551,42 @@ static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, int depth)
len = s7_list_length(sc, lst);
if (len < 0) /* a dotted list -- handle cars, then final cdr */
+ len = (-len + 1);
+ else
{
- len = (-len + 1);
- dotted = true;
- }
-
- if (len == 0) /* either '() or a circular list */
- {
- if (lst != sc->NIL)
- return(copy_string("[circular list]"));
- return(copy_string("()"));
+ if (len == 0) /* either '() or a circular list */
+ {
+ if (lst != sc->NIL)
+ len = circular_list_entries(sc, lst);
+ else return(copy_string("()"));
+ }
}
-
- if (depth < CIRCULAR_REFS_SIZE)
- sc->circular_refs[depth] = lst; /* (let ((l (list 1 2))) (list-set! l 0 l) l) */
- elements = (char **)malloc(len * sizeof(char *));
- for (x = lst, i = 0; is_pair(x) && (i < len); i++, x = cdr(x))
- {
- elements[i] = object_to_c_string_with_circle_check(sc, car(x), depth);
- bufsize += safe_strlen(elements[i]);
- }
+ elements = (char **)calloc(len, sizeof(char *));
- if (dotted)
+ for (x = lst, i = 0; (x != sc->NIL) && (i < len); i++, x = cdr(x))
{
- if (s7_is_eq(x, lst))
- elements[i] = copy_string("[circular list]");
- elements[i] = object_to_c_string_with_circle_check(sc, x, depth);
+ if (is_pair(x))
+ {
+ if ((ci) && (i != 0) && (peek_shared_ref(ci, x) != 0))
+ {
+ elements[i] = object_to_c_string_with_circle_check(sc, x, true, false, ci);
+ len = i + 1;
+ break;
+ }
+ else elements[i] = object_to_c_string_with_circle_check(sc, car(x), true, false, ci);
+ }
+ else
+ {
+ elements[i] = object_to_c_string_with_circle_check(sc, x, true, false, ci);
+ len = i + 1;
+ break;
+ }
bufsize += safe_strlen(elements[i]);
}
bufsize += (256 + len * 2); /* len spaces */
+ if (ci) bufsize += (ci->top * 16);
buf = (char *)malloc(bufsize * sizeof(char));
sprintf(buf, "(");
@@ -10001,12 +10598,16 @@ static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, int depth)
strcat(buf, " ");
}
}
- if (dotted) strcat(buf, ". ");
+
+ if (x != sc->NIL)
+ strcat(buf, ". ");
+
if (elements[len - 1])
{
strcat(buf, elements[len - 1]);
strcat(buf, ")");
}
+
for (i = 0; i < len; i++)
if (elements[i])
free(elements[i]);
@@ -10015,15 +10616,26 @@ static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, int depth)
}
-static s7_pointer list_to_string(s7_scheme *sc, s7_pointer lst)
+static s7_pointer list_as_string(s7_scheme *sc, s7_pointer lst)
{
- return(make_string_uncopied(sc, list_to_c_string(sc, lst, 0)));
+ s7_pointer result;
+ shared_info *ci;
+ ci = make_shared_info(sc, lst);
+ result = make_string_uncopied(sc, object_to_c_string_with_circle_check(sc, lst, true, false, ci));
+ if (ci) free_shared_info(ci);
+ return(result);
}
char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj)
{
- return(s7_object_to_c_string_1(sc, obj, true, 0, false));
+ char *result;
+ shared_info *ci = NULL;
+ if (has_structure(obj))
+ ci = make_shared_info(sc, obj);
+ result = object_to_c_string_with_circle_check(sc, obj, true, false, ci);
+ if (ci) free_shared_info(ci);
+ return(result);
}
@@ -10034,7 +10646,7 @@ s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer obj)
return(vector_to_string(sc, obj));
if (is_pair(obj))
- return(list_to_string(sc, obj));
+ return(list_as_string(sc, obj));
return(make_string_uncopied(sc, atom_to_c_string(sc, obj, true)));
}
@@ -10056,6 +10668,8 @@ static s7_pointer g_newline(s7_scheme *sc, s7_pointer args)
port = car(args);
if (!s7_is_output_port(sc, port))
return(s7_wrong_type_arg_error(sc, "newline", 0, port, "an output port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "newline", 0, port, "an open output port"));
}
else port = sc->output_port;
@@ -10064,7 +10678,7 @@ static s7_pointer g_newline(s7_scheme *sc, s7_pointer args)
}
-void s7_write_char(s7_scheme *sc, char c, s7_pointer port)
+void s7_write_char(s7_scheme *sc, int c, s7_pointer port)
{
write_char(sc, c, port);
}
@@ -10083,6 +10697,8 @@ static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args)
port = cadr(args);
if (!s7_is_output_port(sc, port))
return(s7_wrong_type_arg_error(sc, "write-char port", 2, port, "an output port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "write-char port", 2, port, "an open output port"));
}
else port = sc->output_port;
s7_write_char(sc, s7_character(car(args)), port);
@@ -10093,8 +10709,12 @@ static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args)
static void write_or_display(s7_scheme *sc, s7_pointer obj, s7_pointer port, bool use_write)
{
char *val;
- val = s7_object_to_c_string_1(sc, obj, use_write, 0, is_file_port(port));
+ shared_info *ci = NULL;
+ if (has_structure(obj))
+ ci = make_shared_info(sc, obj);
+ val = object_to_c_string_with_circle_check(sc, obj, use_write, is_file_port(port), ci);
write_string(sc, val, port);
+ if (ci) free_shared_info(ci);
if (val) free(val);
}
@@ -10115,6 +10735,8 @@ static s7_pointer g_write(s7_scheme *sc, s7_pointer args)
port = cadr(args);
if (!s7_is_output_port(sc, port))
return(s7_wrong_type_arg_error(sc, "write port", 2, port, "an output port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "write port", 2, port, "an open output port"));
}
else port = sc->output_port;
write_or_display(sc, car(args), port, true);
@@ -10138,6 +10760,8 @@ static s7_pointer g_display(s7_scheme *sc, s7_pointer args)
port = cadr(args);
if (!s7_is_output_port(sc, port))
return(s7_wrong_type_arg_error(sc, "display port", 2, port, "an output port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "display port", 2, port, "an open output port"));
}
else port = sc->output_port;
write_or_display(sc, car(args), port, false);
@@ -10156,6 +10780,8 @@ static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args)
if (!is_input_port(port))
return(s7_wrong_type_arg_error(sc, "read-byte", 0, port, "an input port"));
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "read-byte", 0, port, "an open input port"));
if (is_string_port(port))
{
@@ -10192,7 +10818,9 @@ static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args)
if ((!is_output_port(port)) ||
(is_string_port(port)))
return(s7_wrong_type_arg_error(sc, "write-byte port", 2, port, "an output file or function port"));
-
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "write-byte port", 2, port, "an open output port"));
+
if (is_file_port(port))
fputc((unsigned char)s7_integer(car(args)), port_file(port));
else (*(port_output_function(port)))(sc, (char)s7_integer(car(args)), port);
@@ -10208,6 +10836,10 @@ static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args)
if (!is_procedure(car(args)))
return(s7_wrong_type_arg_error(sc, "call-with-output-string", 1, car(args), "a procedure"));
+ if ((is_continuation(car(args))) || is_goto(car(args)))
+ return(s7_wrong_type_arg_error(sc, "call-with-output-string", 2, car(args), "a normal procedure (not a continuation)"));
+ if (is_thunk(sc, car(args)))
+ return(s7_wrong_type_arg_error(sc, "call-with-output-string", 2, car(args), "a procedure of one argument (the port)"));
port = s7_open_output_string(sc);
push_stack(sc, opcode(OP_UNWIND_OUTPUT), sc->F, port);
@@ -10229,6 +10861,10 @@ static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args)
return(s7_wrong_type_arg_error(sc, "call-with-output-file filename,", 1, car(args), "a string"));
if (!is_procedure(cadr(args)))
return(s7_wrong_type_arg_error(sc, "call-with-output-file", 2, cadr(args), "a procedure"));
+ if ((is_continuation(cadr(args))) || is_goto(cadr(args)))
+ return(s7_wrong_type_arg_error(sc, "call-with-output-file", 2, cadr(args), "a normal procedure (not a continuation)"));
+ if (is_thunk(sc, car(args)))
+ return(s7_wrong_type_arg_error(sc, "call-with-output-file", 2, car(args), "a procedure of one argument (the port)"));
port = s7_open_output_file(sc, s7_string(car(args)), "w");
push_stack(sc, opcode(OP_UNWIND_OUTPUT), sc->F, port);
@@ -10308,7 +10944,7 @@ static s7_pointer immutable_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
NEW_CELL(sc, x); /* might trigger gc, expansion here does not help */
car(x) = a;
cdr(x) = b;
- set_type(x, T_PAIR | T_IMMUTABLE | T_DONT_COPY);
+ set_type(x, T_PAIR | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
return(x);
}
@@ -10319,7 +10955,7 @@ s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
NEW_CELL(sc, x);
car(x) = a;
cdr(x) = b;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
return(x);
}
@@ -10375,7 +11011,7 @@ static s7_pointer make_list_1(s7_scheme *sc, s7_pointer a)
NEW_CELL(sc, x);
car(x) = a;
cdr(x) = sc->NIL;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
return(x);
}
@@ -10386,11 +11022,11 @@ static s7_pointer make_list_2(s7_scheme *sc, s7_pointer a, s7_pointer b)
NEW_CELL(sc, y);
car(y) = b;
cdr(y) = sc->NIL;
- set_type(y, T_PAIR);
+ set_type(y, T_PAIR | T_STRUCTURE);
NEW_CELL(sc, x); /* order matters because the GC will see "y" and expect it to have legit car/cdr */
car(x) = a;
cdr(x) = y;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
return(x);
}
@@ -10401,15 +11037,15 @@ static s7_pointer make_list_3(s7_scheme *sc, s7_pointer a, s7_pointer b, s7_poin
NEW_CELL(sc, z);
car(z) = c;
cdr(z) = sc->NIL;
- set_type(z, T_PAIR);
+ set_type(z, T_PAIR | T_STRUCTURE);
NEW_CELL(sc, y);
car(y) = b;
cdr(y) = z;
- set_type(y, T_PAIR);
+ set_type(y, T_PAIR | T_STRUCTURE);
NEW_CELL(sc, x);
car(x) = a;
cdr(x) = y;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
return(x);
}
@@ -10453,6 +11089,27 @@ s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
}
+static bool symbol_is_in_list(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x;
+ for (x = lst; is_pair(x); x = cdr(x))
+ if (is_pair(car(x)))
+ {
+ if (sym == caar(x))
+ return(true);
+ }
+ else
+ {
+ if (sym == car(x))
+ return(true);
+ }
+ if (sym == x)
+ return(true);
+
+ return(false);
+}
+
+
s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
{
s7_pointer x;
@@ -10468,21 +11125,44 @@ s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a)
{
- /* reverse list -- produce new list */
- s7_pointer p;
+ /* reverse list -- produce new list (other code assumes this function does not return the original!) */
+ s7_pointer x, p;
- sc->w = sc->NIL;
- for ( ; is_pair(a); a = cdr(a))
- sc->w = s7_cons(sc, car(a), sc->w);
- p = sc->w;
- sc->w = sc->NIL;
+ if (a == sc->NIL) return(a);
- if (a == sc->NIL)
- return(p);
+ if (!is_pair(cdr(a)))
+ {
+ if (cdr(a) != sc->NIL)
+ return(s7_cons(sc, cdr(a), car(a)));
+ return(s7_cons(sc, car(a), sc->NIL)); /* don't return a itself */
+ }
- return(sc->NIL);
+ sc->w = s7_cons(sc, car(a), sc->NIL);
+
+ for (x = cdr(a), p = a; is_pair(x); x = cdr(x), p = cdr(p))
+ {
+ sc->w = s7_cons(sc, car(x), sc->w);
+ if (is_pair(cdr(x)))
+ {
+ x = cdr(x);
+ sc->w = s7_cons(sc, car(x), sc->w);
+ }
+ if (x == p) /* this can take awhile to notice there's a cycle, but what does the caller expect? */
+ break;
+ }
+
+ if (x != sc->NIL)
+ p = s7_cons(sc, x, sc->w); /* ?? this means that (reverse '(1 2 . 3)) returns '(3 2 1) -- we used to return '() here */
+ else p = sc->w;
+
+ sc->w = sc->NIL;
+ return(p);
}
+/* PERHAPS: s7_reverse sometimes tacks extra nodes on the end of a reversed circular list (it detects the cycle too late)
+ * (let ((lst (list 0))) (set! (cdr lst) lst) (reverse lst)) -> (#1=(0 . #1#) 0 0 0)
+ */
+
static s7_pointer reverse_in_place(s7_scheme *sc, s7_pointer term, s7_pointer list)
{
@@ -10552,9 +11232,10 @@ static int safe_list_length(s7_scheme *sc, s7_pointer a)
int s7_list_length(s7_scheme *sc, s7_pointer a)
{
+ /* returns -len if list is dotted, 0 if it's (directly) circular */
int i;
s7_pointer slow, fast;
-
+
slow = fast = a;
for (i = 0; ; i += 2)
{
@@ -10576,13 +11257,7 @@ int s7_list_length(s7_scheme *sc, s7_pointer a)
fast = cdr(fast);
slow = cdr(slow);
if (fast == slow)
- {
- /* the fast pointer has looped back around and caught up
- * with the slow pointer, hence the structure is circular,
- * not of finite length, and therefore not a list
- */
- return(0);
- }
+ return(0);
}
return(0);
}
@@ -10750,7 +11425,7 @@ static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args)
if (index < 0)
return(s7_out_of_range_error(sc, "list-tail index,", 2, cadr(args), "should be non-negative"));
- for (i = 0, p = car(args); (i < index) && is_pair(p); i++, p = cdr(p)) {}
+ for (i = 0, p = car(args); (i < index) && (is_pair(p)); i++, p = cdr(p)) {}
if (i < index)
return(s7_out_of_range_error(sc, "list-tail", 2, cadr(args), "index should be less than list length"));
@@ -10794,7 +11469,7 @@ static s7_pointer g_cons(s7_scheme *sc, s7_pointer args)
NEW_CELL(sc, x);
car(x) = car(args);
cdr(x) = cadr(args);
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
return(x);
}
@@ -10823,10 +11498,6 @@ static s7_pointer g_set_cdr(s7_scheme *sc, s7_pointer args)
}
-/* The rest are trivial: (define (set-cadr! a b) (set-car! (cdr a) b)) or (define-macro (set-cadr! a b) `(set-car! (cdr ,a) ,b)) -- use c?r
- */
-
-
static s7_pointer g_caar(s7_scheme *sc, s7_pointer args)
{
#define H_caar "(caar lst) returns (car (car lst)): (caar '((1 2))) -> 1"
@@ -11203,26 +11874,7 @@ static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer g_reverse(s7_scheme *sc, s7_pointer args)
-{
- #define H_reverse "(reverse lst) returns a list with the elements of lst in reverse order"
- s7_pointer p, np;
-
- p = car(args);
- if (p == sc->NIL)
- return(sc->NIL);
-
- if (!is_pair(p))
- return(s7_wrong_type_arg_error(sc, "reverse", 0, p, "a list"));
-
- np = s7_reverse(sc, p);
- if (np == sc->NIL)
- return(s7_wrong_type_arg_error(sc, "reverse", 0, p, "a proper list"));
-
- return(np);
-}
-
-
+/* reverse is in the generic function section */
static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args)
{
#define H_reverse_in_place "(reverse! lst) reverses lst in place"
@@ -11262,67 +11914,73 @@ s7_pointer s7_remv(s7_scheme *sc, s7_pointer a, s7_pointer obj)
static s7_pointer g_assq(s7_scheme *sc, s7_pointer args)
{
#define H_assq "(assq obj alist) returns the key-value pair associated (via eq?) with the key obj in the association list alist"
- s7_pointer x, y, result = sc->F;
+ /* this version accepts any kind of list
+ * my little essay: the scheme standard should not unnecessarily restrict the kinds of arguments
+ * a function can take (such as saying memq only accepts proper lists). It is
+ * trivial for the programmer to add such a check to a built-in function, but
+ * not trivial to re-invent the built-in function with that restriction removed.
+ * If some structure exists as a normal scheme object (a dotted or circular list),
+ * every built-in function should be able to deal with it, if it makes sense at all.
+ */
- if (!s7_is_list(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, "assq alist", 2, cadr(args), "a list"));
+ s7_pointer x, y, obj;
- if (cadr(args) == sc->NIL)
- return(sc->F);
-
- x = car(args);
- for (y = cadr(args); is_pair(y); y = cdr(y))
+ x = cadr(args);
+ if (x == sc->NIL) return(sc->F);
+
+ if (!is_pair(x))
+ return(s7_wrong_type_arg_error(sc, "assq", 2, x, "a list"));
+
+ y = x;
+ obj = car(args);
+
+ while (true)
{
- s7_pointer tmp;
- tmp = car(y);
- if ((is_pair(tmp)) &&
- (x == car(tmp)))
- {
- result = tmp;
- break;
- }
- }
+ if ((is_pair(car(x))) && (obj == caar(x))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- /* check for wrong-type-arg error */
- while (is_pair(y)) {y = cdr(y);}
- if (y != sc->NIL)
- return(s7_wrong_type_arg_error(sc, "assq alist", 2, cadr(args), "a proper list"));
-
- return(result);
-}
+ if ((is_pair(car(x))) && (obj == caar(x))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
static s7_pointer g_assq_1(s7_scheme *sc, s7_pointer args, const char *name, bool (*eq_func)(s7_scheme *sc, s7_pointer a, s7_pointer b))
{
#define H_assv "(assv obj alist) returns the key-value pair associated (via eqv?) with the key obj in the association list alist"
#define H_assoc "(assoc obj alist) returns the key-value pair associated (via equal?) with the key obj in the association list alist"
- s7_pointer x, y, result = sc->F;
+ s7_pointer x, y, obj;
- if (!s7_is_list(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, name, 2, cadr(args), "a list"));
+ x = cadr(args);
+ if (x == sc->NIL) return(sc->F);
- if (cadr(args) == sc->NIL)
- return(sc->F);
+ if (!is_pair(x))
+ return(s7_wrong_type_arg_error(sc, name, 2, x, "a list"));
- x = car(args);
- for (y = cadr(args); is_pair(y); y = cdr(y))
+ y = x;
+ obj = car(args);
+
+ while (true)
{
- s7_pointer tmp;
- tmp = car(y);
- if ((is_pair(tmp)) &&
- (eq_func(sc, x, car(tmp))))
- {
- result = tmp;
- break;
- }
- }
-
- while (is_pair(y)) {y = cdr(y);}
- if (y != sc->NIL)
- return(s7_wrong_type_arg_error(sc, name, 2, cadr(args), "a proper list"));
+ if ((is_pair(car(x))) && (eq_func(sc, obj, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- return(result);
-}
+ if ((is_pair(car(x))) && (eq_func(sc, obj, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
static bool s7_is_eqv_1(s7_scheme *sc, s7_pointer a, s7_pointer b) {return(s7_is_eqv(a, b));}
@@ -11334,55 +11992,71 @@ static s7_pointer g_assoc(s7_scheme *sc, s7_pointer args) {return(g_assq_1(sc, a
static s7_pointer g_memq(s7_scheme *sc, s7_pointer args)
{
#define H_memq "(memq obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memq uses eq?"
- s7_pointer x, result = sc->F;
- if (!s7_is_list(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, "memq", 2, cadr(args), "a list"));
+ /* this version accepts any kind of list (the previous one insisted on proper lists for some reason) */
+ s7_pointer x, y, obj;
- if (cadr(args) == sc->NIL)
- return(sc->F);
+ x = cadr(args);
+ if (x == sc->NIL) return(sc->F);
- for (x = cadr(args); is_pair(x); x = cdr(x))
- if (car(args) == car(x))
- {
- result = x;
- break;
- }
-
- while (is_pair(x)) {x = cdr(x);}
- if (x != sc->NIL)
- return(s7_wrong_type_arg_error(sc, "memq", 2, cadr(args), "a proper list"));
+ if (!is_pair(x))
+ return(s7_wrong_type_arg_error(sc, "memq", 2, x, "a list"));
- return(result);
-}
+ y = x;
+ obj = car(args);
+
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ /* I think (memq 'c '(a b . c)) should return #f because otherwise
+ * (memq '() ...) would return the '() at the end.
+ */
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
static s7_pointer g_memq_1(s7_scheme *sc, s7_pointer args, const char *name, bool (*eq_func)(s7_scheme *sc, s7_pointer a, s7_pointer b))
{
#define H_memv "(memv obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memv uses eqv?"
#define H_member "(member obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. member uses equal?"
- s7_pointer x, result = sc->F;
- if (!s7_is_list(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, name, 2, cadr(args), "a list"));
+ s7_pointer x, y, obj;
- if (cadr(args) == sc->NIL)
- return(sc->F);
+ x = cadr(args);
+ if (x == sc->NIL) return(sc->F);
- for (x = cadr(args); is_pair(x); x = cdr(x))
- if (eq_func(sc, car(args), car(x)))
- {
- result = x;
- break;
- }
-
- while (is_pair(x)) {x = cdr(x);}
- if (x != sc->NIL)
- return(s7_wrong_type_arg_error(sc, name, 2, cadr(args), "a proper list"));
+ if (!is_pair(x))
+ return(s7_wrong_type_arg_error(sc, name, 2, x, "a list"));
- return(result);
-}
+ y = x;
+ obj = car(args);
+ while (true)
+ {
+ if (eq_func(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (eq_func(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
static s7_pointer g_memv(s7_scheme *sc, s7_pointer args) {return(g_memq_1(sc, args, "memv", s7_is_eqv_1));}
static s7_pointer g_member(s7_scheme *sc, s7_pointer args) {return(g_memq_1(sc, args, "member", s7_is_equal));}
@@ -11455,7 +12129,7 @@ static s7_pointer g_append(s7_scheme *sc, s7_pointer args)
return(s7_append(sc, x, car(y)));
if (!is_proper_list(sc, car(y)))
- return(s7_wrong_type_arg_error(sc, "append", i, car(y), "a list"));
+ return(s7_wrong_type_arg_error(sc, "append", i, car(y), "a proper list"));
x = s7_append(sc, x, car(y));
}
@@ -11498,7 +12172,7 @@ static s7_pointer s7_make_vector_1(s7_scheme *sc, s7_Int len, bool filled)
NEW_CELL(sc, x);
vector_length(x) = 0;
vector_elements(x) = NULL;
- set_type(x, T_VECTOR | T_FINALIZABLE | T_DONT_COPY);
+ set_type(x, T_VECTOR | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
/* in the multithread case, we can be interrupted here, and a subsequent GC mark sweep can see
* this half-allocated vector. If length>0, and a non-null "elements" field is left over
@@ -11509,16 +12183,13 @@ static s7_pointer s7_make_vector_1(s7_scheme *sc, s7_Int len, bool filled)
{
vector_elements(x) = (s7_pointer *)malloc(len * sizeof(s7_pointer));
if (!(vector_elements(x)))
- return(s7_error(sc, s7_make_symbol(sc, "out-of-memory"), s7_make_string(sc, "make-vector allocation failed!")));
+ return(s7_error(sc, s7_make_symbol(sc, "out-of-memory"), make_protected_string(sc, "make-vector allocation failed!")));
vector_length(x) = len;
- if (filled) s7_vector_fill(sc, x, sc->NIL);
+ if (filled) s7_vector_fill(sc, x, sc->NIL); /* make_hash_table assumes nil as the default value */
}
-#if WITH_MULTIDIMENSIONAL_VECTORS
x->object.vector.dim_info = NULL;
-#endif
-
return(x);
}
@@ -11568,22 +12239,6 @@ static void vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
}
-static s7_pointer vector_copy(s7_scheme *sc, s7_pointer old_vect)
-{
- s7_Int len;
- s7_pointer new_vect;
-
- len = vector_length(old_vect);
- new_vect = s7_make_vector_1(sc, len, false);
- /*
- * here and in vector-fill! we have a problem with bignums -- should new bignums be allocated? (copy_list also)
- */
- memcpy((void *)(vector_elements(new_vect)), (void *)(vector_elements(old_vect)), len * sizeof(s7_pointer));
-
- return(new_vect);
-}
-
-
static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args)
{
#define H_vector_fill "(vector-fill! v val) sets all elements of the vector v to val"
@@ -11629,10 +12284,8 @@ s7_pointer *s7_vector_elements(s7_pointer vec)
s7_Int *s7_vector_dimensions(s7_pointer vec)
{
s7_Int *dims;
-#if WITH_MULTIDIMENSIONAL_VECTORS
if (vector_is_multidimensional(vec))
return(vec->object.vector.dim_info->dims);
-#endif
dims = (s7_Int *)malloc(sizeof(s7_Int));
dims[0] = vector_length(vec);
return(dims);
@@ -11642,10 +12295,8 @@ s7_Int *s7_vector_dimensions(s7_pointer vec)
s7_Int *s7_vector_offsets(s7_pointer vec)
{
s7_Int *offs;
-#if WITH_MULTIDIMENSIONAL_VECTORS
if (vector_is_multidimensional(vec))
return(vec->object.vector.dim_info->offsets);
-#endif
offs = (s7_Int *)malloc(sizeof(s7_Int));
offs[0] = 1;
return(offs);
@@ -11675,38 +12326,6 @@ static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args)
}
-static bool vectors_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- s7_Int i, len;
-
- len = vector_length(x);
- if (len != vector_length(y)) return(false);
-
-#if WITH_MULTIDIMENSIONAL_VECTORS
- if (vector_is_multidimensional(x))
- {
- if (!(vector_is_multidimensional(y)))
- return(false);
- if (vector_ndims(x) != vector_ndims(y))
- return(false);
- for (i = 0; i < vector_ndims(x); i++)
- if (vector_dimension(x, i) != vector_dimension(y, i))
- return(false);
- }
- else
- {
- if (vector_is_multidimensional(y))
- return(false);
- }
-#endif
-
- for (i = 0; i < len; i++)
- if (!(s7_is_equal(sc, vector_element(x, i), vector_element(y, i))))
- return(false);
- return(true);
-}
-
-
s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_Int len, s7_pointer fill)
{
s7_pointer vect;
@@ -11723,7 +12342,8 @@ static s7_pointer g_vector(s7_scheme *sc, s7_pointer args)
s7_pointer vec;
len = s7_list_length(sc, args);
- if (len < 0)
+ if ((len < 0) ||
+ ((len == 0) && (args != sc->NIL)))
return(s7_wrong_type_arg_error(sc, "vector", 1, car(args), "a proper list"));
vec = s7_make_vector_1(sc, len, false);
@@ -11761,7 +12381,9 @@ static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args)
static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices)
{
s7_Int index = 0;
-#if WITH_MULTIDIMENSIONAL_VECTORS
+ if (vector_length(vect) == 0)
+ return(s7_out_of_range_error(sc, "vector-ref", 1, vect, "this vector has no elements, so vector-ref is hopeless"));
+
if (vector_is_multidimensional(vect))
{
int i;
@@ -11771,24 +12393,28 @@ static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indice
s7_Int n;
if (!s7_is_integer(car(x)))
return(s7_wrong_type_arg_error(sc, "vector ref index,", i + 2, car(x), "an integer"));
+
n = s7_integer(car(x));
if ((n < 0) ||
(n >= vector_dimension(vect, i)))
return(s7_out_of_range_error(sc, "vector ref", i + 2, car(x), "index should be between 0 and the dimension size"));
+
index += n * vector_offset(vect, i);
}
- if ((x != sc->NIL) ||
- (i != vector_ndims(vect)))
- return(s7_wrong_number_of_args_error(sc, "vector ref: ~A", indices));
+ if (x != sc->NIL)
+ return(s7_wrong_number_of_args_error(sc, "too many indices for vector ref: ~A", indices));
+ if (i < vector_ndims(vect))
+ return(s7_wrong_number_of_args_error(sc, "not enough indices for vector ref: ~A", indices));
}
else
-#endif
{
/* (let ((hi (make-vector 3 0.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 3)) (set! sum (+ sum (hi i)))) sum) */
+
if (!s7_is_integer(car(indices)))
return(s7_wrong_type_arg_error(sc, "vector ref index,", 2, car(indices), "an integer"));
+
if (cdr(indices) != sc->NIL) /* (#(1 2) 1 2) */
- return(s7_wrong_number_of_args_error(sc, "vector ref: ~A", indices));
+ return(s7_wrong_number_of_args_error(sc, "too many args for vector ref: ~A", indices));
index = s7_integer(car(indices));
if ((index < 0) ||
@@ -11802,13 +12428,9 @@ static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indice
static s7_pointer g_vector_ref(s7_scheme *sc, s7_pointer args)
{
-#if WITH_MULTIDIMENSIONAL_VECTORS
#define H_vector_ref "(vector-ref v i) returns the i-th element of vector v. If v \
is a multidimensional vector, you can also use (vector-ref v ...) where the trailing args \
are the indices, or omit 'vector-ref': (v ...)."
-#else
- #define H_vector_ref "(vector-ref v i) returns the i-th element of vector v"
-#endif
s7_pointer vec;
vec = car(args);
@@ -11821,21 +12443,19 @@ are the indices, or omit 'vector-ref': (v ...)."
static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args)
{
-#if WITH_MULTIDIMENSIONAL_VECTORS
#define H_vector_set "(vector-set! v i value) sets the i-th element of vector v to value. If 'v' is \
multidimensional you can also use (vector-set! v ... val) where the ellipsis refers to the indices. You \
can also use 'set!' instead of 'vector-set!': (set! (v ...) val) -- I find this form much easier to read."
-#else
- #define H_vector_set "(vector-set! v i value) sets the i-th element of vector v to value"
-#endif
+
s7_pointer vec, val;
s7_Int index;
vec = car(args);
if (!s7_is_vector(vec))
return(s7_wrong_type_arg_error(sc, "vector-set!", 1, vec, "a vector"));
+ if (vector_length(vec) == 0)
+ return(s7_out_of_range_error(sc, "vector-set!", 1, vec, "this vector has no elements, so vector-set! is hopeless"));
-#if WITH_MULTIDIMENSIONAL_VECTORS
if (vector_is_multidimensional(vec))
{
int i;
@@ -11846,25 +12466,28 @@ can also use 'set!' instead of 'vector-set!': (set! (v ...) val) -- I find this
s7_Int n;
if (!s7_is_integer(car(x)))
return(s7_wrong_type_arg_error(sc, "vector-set! index,", i + 2, car(x), "an integer"));
+
n = s7_integer(car(x));
if ((n < 0) ||
(n >= vector_dimension(vec, i)))
return(s7_out_of_range_error(sc, "vector-set!", i, car(x), "index should be between 0 and the dimension size"));
+
index += n * vector_offset(vec, i);
}
- if ((cdr(x) != sc->NIL) ||
- ((i != vector_ndims(vec)) &&
- (i != 1)))
- return(s7_wrong_number_of_args_error(sc, "vector-set!: ~A", args));
+ if (cdr(x) != sc->NIL)
+ return(s7_wrong_number_of_args_error(sc, "too many args for vector-set!: ~A", args));
+ if (i != vector_ndims(vec))
+ return(s7_wrong_number_of_args_error(sc, "not enough args for vector-set!: ~A", args));
val = car(x);
}
else
-#endif
{
if (!s7_is_integer(cadr(args)))
return(s7_wrong_type_arg_error(sc, "vector-set! index,", 2, cadr(args), "an integer"));
+ if (cdddr(args) != sc->NIL) /* (vector-set! #(1 2) 1 2 3) */
+ return(s7_wrong_number_of_args_error(sc, "too many args for vector set: ~A", args));
index = s7_integer(cadr(args));
if ((index < 0) ||
@@ -11881,14 +12504,10 @@ can also use 'set!' instead of 'vector-set!': (set! (v ...) val) -- I find this
static s7_pointer g_make_vector(s7_scheme *sc, s7_pointer args)
{
-#if WITH_MULTIDIMENSIONAL_VECTORS
#define H_make_vector "(make-vector len :optional (value #f)) returns a vector of len elements initialized to value. \
To create a multidimensional vector, put the dimension bounds in a list (this is to avoid ambiguities such as \
(make-vector 1 2) where it's not clear whether the '2' is an initial value or a dimension size). (make-vector '(2 3) 1.0) \
returns a 2 dimensional vector of 6 total elements, all initialized to 1.0."
-#else
- #define H_make_vector "(make-vector len :optional (value #f)) returns a vector of len elements initialized to value"
-#endif
s7_Int len;
s7_pointer x, fill, vec;
@@ -11901,7 +12520,6 @@ returns a 2 dimensional vector of 6 total elements, all initialized to 1.0."
return(s7_wrong_type_arg_error(sc, "make-vector length,", 1, x, "a non-negative integer"));
len = s7_integer(x);
}
-#if WITH_MULTIDIMENSIONAL_VECTORS
else
{
s7_pointer y;
@@ -11928,15 +12546,13 @@ returns a 2 dimensional vector of 6 total elements, all initialized to 1.0."
}
}
}
-#endif
if (cdr(args) != sc->NIL)
fill = cadr(args);
vec = s7_make_vector_1(sc, len, false);
- s7_vector_fill(sc, vec, fill);
+ if (len > 0) s7_vector_fill(sc, vec, fill);
-#if WITH_MULTIDIMENSIONAL_VECTORS
if ((is_pair(x)) &&
(is_pair(cdr(x))))
{
@@ -11961,7 +12577,6 @@ returns a 2 dimensional vector of 6 total elements, all initialized to 1.0."
vec->object.vector.dim_info = v;
}
-#endif
return(vec);
}
@@ -11976,15 +12591,12 @@ static s7_pointer g_is_vector(s7_scheme *sc, s7_pointer args)
int s7_vector_rank(s7_pointer vect)
{
-#if WITH_MULTIDIMENSIONAL_VECTORS
if (vector_is_multidimensional(vect))
return(vector_ndims(vect));
-#endif
return(1);
}
-#if WITH_MULTIDIMENSIONAL_VECTORS
static s7_pointer g_vector_dimensions(s7_scheme *sc, s7_pointer args)
{
#define H_vector_dimensions "(vector-dimensions vect) returns a list of vect's dimensions. In srfi-63 terms:\n\
@@ -12010,7 +12622,121 @@ static s7_pointer g_vector_dimensions(s7_scheme *sc, s7_pointer args)
return(make_list_1(sc, s7_make_integer(sc, vector_length(x))));
}
-#endif
+
+
+#define MV_TOO_MANY_ELEMENTS -1
+#define MV_NOT_ENOUGH_ELEMENTS -2
+
+static int traverse_vector_data(s7_scheme *sc, s7_pointer vec, int flat_ref, int dimension, int dimensions, int *sizes, s7_pointer lst)
+{
+ /* we're filling vec, we're currently looking for element (flat-wise) flat_ref,
+ * we're at ref in dimension of dimensions, where sizes gives the bounds, and lst is our data
+ * #3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))
+ */
+ int i;
+ s7_pointer x;
+
+ for (i = 0, x = lst; i < sizes[dimension]; i++, x = cdr(x))
+ {
+ if (!is_pair(x))
+ return(MV_NOT_ENOUGH_ELEMENTS);
+
+ if (dimension == (dimensions - 1))
+ vector_element(vec, flat_ref++) = car(x);
+ else
+ {
+ flat_ref = traverse_vector_data(sc, vec, flat_ref, dimension + 1, dimensions, sizes, car(x));
+ if (flat_ref < 0) return(flat_ref);
+ }
+ }
+
+ if (x != sc->NIL)
+ return(MV_TOO_MANY_ELEMENTS);
+ return(flat_ref);
+}
+
+
+static s7_pointer s7_multivector_error(s7_scheme *sc, const char *message, s7_pointer data)
+{
+ return(s7_error(sc, s7_make_symbol(sc, "read-error"),
+ s7_cons(sc,
+ make_protected_string(sc, "reading constant vector, ~A: ~A"),
+ make_list_2(sc,
+ make_protected_string(sc, message),
+ data))));
+}
+
+
+static s7_pointer g_multivector(s7_scheme *sc, int dims, s7_pointer data)
+{
+ /* get the dimension bounds from data, make the new vector, fill it from data */
+ s7_pointer vec, x;
+ int i, total_size = 1, vec_loc, err;
+ int *sizes;
+
+ /* (#2d((1 2 3) (4 5 6)) 0 0) -> 1
+ * (#2d((1 2 3) (4 5 6)) 0 1) -> 2
+ * (#2d((1 2 3) (4 5 6)) 1 1) -> 5
+ * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) -> 1
+ * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) -> 7
+ * #3D(((1 2) (3 4)) ((5 6) (7))) -> error, #3D(((1 2) (3 4)) ((5 6) (7 8 9))), #3D(((1 2) (3 4)) (5 (7 8 9))) etc
+ *
+ * but a special case: #nD() is an n-dimensional empty vector
+ */
+
+ sc->w = sc->NIL;
+ sizes = (int *)calloc(dims, sizeof(int));
+ if (data == sc->NIL)
+ {
+ /* dims are already 0 (calloc above) */
+ return(g_make_vector(sc, s7_cons(sc, g_make_list(sc, make_list_2(sc, s7_make_integer(sc, dims), small_int(0))), sc->NIL)));
+ }
+
+ for (x = data, i = 0; i < dims; i++)
+ {
+ sizes[i] = safe_list_length(sc, x);
+ total_size *= sizes[i];
+ sc->w = s7_cons(sc, s7_make_integer(sc, sizes[i]), sc->w);
+ x = car(x);
+ if ((i < (dims - 1)) &&
+ (!is_pair(x)))
+ return(s7_multivector_error(sc, "a list that fully specifies the vector's elements", data));
+ }
+
+ vec = g_make_vector(sc, s7_cons(sc, safe_reverse_in_place(sc, sc->w), sc->NIL));
+ vec_loc = s7_gc_protect(sc, vec);
+ sc->w = sc->NIL;
+
+ /* now fill the vector checking that all the lists match */
+ err = traverse_vector_data(sc, vec, 0, 0, dims, sizes, data);
+
+ free(sizes);
+ s7_gc_unprotect_at(sc, vec_loc);
+ if (err < 0)
+ return(s7_multivector_error(sc, (err == MV_TOO_MANY_ELEMENTS) ? "too many elements" : "not enough elements", data));
+
+ return(vec);
+}
+
+
+static s7_pointer vector_copy(s7_scheme *sc, s7_pointer old_vect)
+{
+ s7_Int len;
+ s7_pointer new_vect;
+
+ len = vector_length(old_vect);
+
+ if (vector_is_multidimensional(old_vect))
+ new_vect = g_make_vector(sc, s7_cons(sc, g_vector_dimensions(sc, s7_cons(sc, old_vect, sc->NIL)), sc->NIL));
+ else new_vect = s7_make_vector_1(sc, len, false);
+
+ /* here and in vector-fill! we have a problem with bignums -- should new bignums be allocated? (copy_list also) */
+
+ memcpy((void *)(vector_elements(new_vect)), (void *)(vector_elements(old_vect)), len * sizeof(s7_pointer));
+ return(new_vect);
+}
+
+
@@ -12107,10 +12833,14 @@ If its first argument is a list, the list is copied (despite the '!')."
if (!s7_is_vector(vect))
return(s7_wrong_type_arg_error(sc, "sort!", 1, vect, "a vector or a list"));
- if (!s7_is_procedure(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "sort!", 2, cadr(args), "a procedure"));
compare_proc = cadr(args);
+ if (!s7_is_procedure(compare_proc))
+ return(s7_wrong_type_arg_error(sc, "sort!", 2, compare_proc, "a procedure"));
+
+ if ((is_continuation(compare_proc)) || is_goto(compare_proc))
+ return(s7_wrong_type_arg_error(sc, "sort!", 2, compare_proc, "a normal procedure (not a continuation)"));
+
#if (!HAVE_NESTED_FUNCTIONS)
compare_sc = sc;
#endif
@@ -12175,8 +12905,8 @@ static s7_pointer g_hash_table_size(s7_scheme *sc, s7_pointer args)
s7_pointer s7_make_hash_table(s7_scheme *sc, s7_Int size)
{
s7_pointer table;
- table = s7_make_vector(sc, size);
- set_type(table, T_HASH_TABLE | T_FINALIZABLE | T_DONT_COPY);
+ table = s7_make_vector(sc, size); /* nil is the default value */
+ set_type(table, T_HASH_TABLE | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
return(table);
}
@@ -12240,45 +12970,36 @@ s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, const char *name,
#define HASHED_INTEGER_BUFFER_SIZE 64
-static char *hashed_integer_name(s7_Int key, char *intbuf) /* not const here because snprintf is declared char* */
+static char *hashed_name(s7_scheme *sc, s7_pointer key, char *intbuf, const char *caller)
{
- snprintf(intbuf, HASHED_INTEGER_BUFFER_SIZE, "\b%lld\b", (long long int)key);
- return(intbuf);
-}
-
-
-static char *hashed_real_name(s7_Double key, char *intbuf)
-{
- /* this is actually not safe due to the challenges faced by %f */
- snprintf(intbuf, HASHED_INTEGER_BUFFER_SIZE, "\b%.20f\b", key); /* default precision is not enough */
- return(intbuf);
-}
-
-
-static s7_pointer hash_table_ref_1(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- const char *name;
- char intbuf[HASHED_INTEGER_BUFFER_SIZE];
-
if (s7_is_string(key))
- name = string_value(key);
- else
+ return(string_value(key));
+
+ if (s7_is_symbol(key))
+ snprintf(intbuf, HASHED_INTEGER_BUFFER_SIZE, "\b%s\b", symbol_name(key));
+ else
{
- if (s7_is_symbol(key))
- name = s7_symbol_name(key);
+ if (s7_is_integer(key))
+ snprintf(intbuf, HASHED_INTEGER_BUFFER_SIZE, "\b%lld\b", (long long int)s7_integer(key));
else
{
- if (s7_is_integer(key))
- name = hashed_integer_name(s7_integer(key), intbuf);
+ if ((s7_is_real(key)) && (!s7_is_ratio(key)))
+ snprintf(intbuf, HASHED_INTEGER_BUFFER_SIZE, "\b%.20f\b", s7_real(key)); /* default precision is not enough, but this still won't work in general */
else
{
- if ((s7_is_real(key)) && (!s7_is_ratio(key)))
- name = hashed_real_name(s7_real(key), intbuf);
- else return(s7_wrong_type_arg_error(sc, "hash-table-ref key,", 2, key, "a string, symbol, integer, or (non-ratio) real"));
+ s7_wrong_type_arg_error(sc, caller, 2, key, "a string, symbol, integer, or (non-ratio) real");
+ return(NULL);
}
}
}
- return(s7_hash_table_ref(sc, table, name));
+ return(intbuf);
+}
+
+
+static s7_pointer hash_table_ref_1(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ char intbuf[HASHED_INTEGER_BUFFER_SIZE];
+ return(s7_hash_table_ref(sc, table, hashed_name(sc, key, intbuf, "hash-table-ref")));
}
@@ -12300,7 +13021,7 @@ static s7_pointer g_hash_table_ref(s7_scheme *sc, s7_pointer args)
static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args)
{
#define H_hash_table_set "(hash-table-set! table key value) sets the value associated with key (a string or symbol) in the hash table to value"
- const char *name;
+
char intbuf[HASHED_INTEGER_BUFFER_SIZE];
s7_pointer table, key;
@@ -12310,29 +13031,75 @@ static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args)
if (!s7_is_hash_table(table))
return(s7_wrong_type_arg_error(sc, "hash-table-set!", 1, table, "a hash-table"));
- if (s7_is_string(key))
- name = string_value(key);
- else
+ return(s7_hash_table_set(sc, table, hashed_name(sc, key, intbuf, "hash-table-set!"), caddr(args)));
+}
+
+
+static s7_pointer g_hash_table(s7_scheme *sc, s7_pointer args)
+{
+ #define H_hash_table "(hash-table ...) returns a hash-table containing the cons's passed as its arguments. \
+That is, (hash-table '(\"hi\" . 3) (\"ho\" . 32)) returns a new hash-table with the two key/value pairs preinstalled."
+
+ s7_Int i, len;
+ s7_pointer ht;
+ char intbuf[HASHED_INTEGER_BUFFER_SIZE];
+
+ len = s7_list_length(sc, args);
+ if ((len < 0) ||
+ ((len == 0) && (args != sc->NIL)))
+ return(s7_wrong_type_arg_error(sc, "hash-table", 1, car(args), "a proper list"));
+
+ ht = s7_make_hash_table(sc, 461);
+ if (len > 0)
{
- if (s7_is_symbol(key))
- name = s7_symbol_name(key);
- else
- {
- if (s7_is_integer(key))
- name = hashed_integer_name(s7_integer(key), intbuf);
- else
- {
- if ((s7_is_real(key)) && (!s7_is_ratio(key)))
- name = hashed_real_name(s7_real(key), intbuf);
- else return(s7_wrong_type_arg_error(sc, "hash-table-set! key,", 2, key, "a string, symbol, integer, or (non-ratio) real"));
- }
- }
+ s7_pointer x;
+ for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
+ if (is_pair(car(x)))
+ s7_hash_table_set(sc, ht, hashed_name(sc, caar(x), intbuf, "hash-table"), cdar(x));
}
-
- return(s7_hash_table_set(sc, table, name, caddr(args)));
+ return(ht);
}
+static s7_pointer hash_list_copy(s7_scheme *sc, s7_pointer obj)
+{
+ if (is_pair(obj))
+ return(s7_cons(sc, s7_copy(sc, car(obj)), hash_list_copy(sc, cdr(obj))));
+ return(obj);
+}
+
+
+static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash)
+{
+ /* this has to copy not only the lists but the cons's in the lists! */
+ s7_Int i, len;
+ s7_pointer new_hash;
+ s7_pointer *old_lists, *new_lists;
+
+ len = vector_length(old_hash);
+ new_hash = s7_make_hash_table(sc, len);
+ old_lists = vector_elements(old_hash);
+ new_lists = vector_elements(new_hash);
+
+ for (i = 0; i < len; i++)
+ if (old_lists[i] != sc->NIL)
+ new_lists[i] = hash_list_copy(sc, old_lists[i]);
+
+ return(new_hash);
+}
+
+
+static s7_pointer hash_table_clear(s7_scheme *sc, s7_pointer table)
+{
+ int i, len;
+ len = vector_length(table);
+ for (i = 0; i < len; i++)
+ vector_element(table, i) = sc->NIL;
+ return(table);
+}
+
+
+
/* -------------------------------- objects and functions -------------------------------- */
@@ -12409,8 +13176,7 @@ static void s7_function_set_setter(s7_scheme *sc, const char *getter, const char
static char *pws_documentation(s7_pointer x);
static s7_pointer pws_source(s7_scheme *sc, s7_pointer x);
-static int pws_get_req_args(s7_pointer x);
-static int pws_get_opt_args(s7_pointer x);
+static s7_pointer pws_arity(s7_scheme *sc, s7_pointer obj);
s7_pointer s7_procedure_source(s7_scheme *sc, s7_pointer p)
@@ -12625,18 +13391,43 @@ s7_pointer s7_procedure_arity(s7_scheme *sc, s7_pointer x)
return(make_list_3(sc, small_int(0), small_int(0), sc->T));
len = s7_list_length(sc, closure_args(x));
}
-
+
if (is_closure_star(x))
- return(make_list_3(sc, small_int(0), s7_make_integer(sc, abs(len)), make_boolean(sc, len < 0)));
+ {
+ s7_pointer tmp; /* make sure we aren't counting :optional and friends as arguments */
+ int opts = 0;
+
+ if (is_pair(x))
+ tmp = car(x);
+ else tmp = closure_args(x);
+
+ for (; is_pair(tmp); tmp = cdr(tmp))
+ {
+ if ((car(tmp) == sc->KEY_KEY) ||
+ (car(tmp) == sc->KEY_OPTIONAL))
+ opts++;
+ if (car(tmp) == sc->KEY_REST)
+ {
+ opts += 2; /* both :rest and the arg name are not counted as optional args */
+ if (len > 0) len = -len;
+ }
+ }
+ return(make_list_3(sc, small_int(0), s7_make_integer(sc, abs(len) - opts), make_boolean(sc, len < 0)));
+ }
+
return(make_list_3(sc, s7_make_integer(sc, abs(len)), small_int(0), make_boolean(sc, len < 0)));
}
if (s7_is_procedure_with_setter(x))
- return(make_list_3(sc,
- s7_make_integer(sc, pws_get_req_args(x)),
- s7_make_integer(sc, pws_get_opt_args(x)),
- sc->F));
-
+ {
+ if (s7_procedure_with_setter_getter(x) != sc->NIL)
+ return(s7_append(sc,
+ s7_procedure_arity(sc, s7_procedure_with_setter_getter(x)),
+ s7_procedure_arity(sc, s7_procedure_with_setter_setter(x))));
+
+ return(pws_arity(sc, x));
+ }
+
if ((object_is_applicable(x)) ||
(s7_is_continuation(x)))
return(make_list_3(sc, small_int(0), small_int(0), sc->T));
@@ -12660,6 +13451,23 @@ static bool is_thunk(s7_scheme *sc, s7_pointer x)
}
+static bool args_match(s7_scheme *sc, s7_pointer x, int args)
+{
+ switch (type(x))
+ {
+ case T_C_FUNCTION:
+ return((c_function_required_args(x) <= args) &&
+ (c_function_all_args(x) >= args));
+
+ case T_CLOSURE:
+ case T_CLOSURE_STAR:
+ return((s7_is_symbol(closure_args(x))) ||
+ (safe_list_length(sc, closure_args(x)) >= args));
+ }
+ return(false);
+}
+
+
static s7_pointer g_procedure_arity(s7_scheme *sc, s7_pointer args)
{
#define H_procedure_arity "(procedure-arity func) returns a list '(required optional rest)"
@@ -12714,7 +13522,7 @@ typedef struct {
s7_pointer (*length)(s7_scheme *sc, s7_pointer obj);
s7_pointer (*copy)(s7_scheme *sc, s7_pointer obj);
s7_pointer (*fill)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
- s7_pointer print_func, equal_func, getter_func, setter_func, length_func;
+ s7_pointer print_func, equal_func, getter_func, setter_func, length_func, copy_func, fill_func;
} s7_c_object_t;
@@ -12839,7 +13647,7 @@ static s7_pointer apply_object(s7_scheme *sc, s7_pointer obj, s7_pointer args)
if (object_types[tag].apply)
return((*(object_types[tag].apply))(sc, obj, args));
- return(eval_error(sc, "attempt to apply ~A?", obj));
+ return(apply_error(sc, obj, args));
}
@@ -12946,9 +13754,6 @@ static char *call_s_object_print(s7_scheme *sc, void *value)
/* describe_object assumes the value returned here can be freed */
}
-/* PERHAPS: call_s_object_fill doesn't seem problematic, and call_s_object_copy could copy the object, then call copy for the value?
- * should these be the defaults (also for length and others)?
- */
static bool call_s_object_equal(s7_scheme *sc, s7_pointer a, s7_pointer b)
{
@@ -12991,6 +13796,33 @@ static s7_pointer call_s_object_length(s7_scheme *sc, s7_pointer a)
}
+static s7_pointer call_s_object_copy(s7_scheme *sc, s7_pointer a)
+{
+ s_type_t *obj, *new_obj;
+ s7_pointer result;
+
+ obj = (s_type_t *)s7_object_value(a);
+ car(sc->s_function_args) = obj->value;
+
+ new_obj = (s_type_t *)calloc(1, sizeof(s_type_t));
+ new_obj->type = obj->type;
+
+ new_obj->value = s7_call(sc, object_types[new_obj->type].copy_func, sc->s_function_args);
+ result = s7_make_object(sc, new_obj->type, (void *)new_obj);
+ typeflag(result) |= T_S_OBJECT;
+
+ return(result);
+}
+
+
+static s7_pointer call_s_object_fill(s7_scheme *sc, s7_pointer a, s7_pointer val)
+{
+ s_type_t *obj;
+ obj = (s_type_t *)s7_object_value(a);
+ return(s7_call(sc, object_types[obj->type].fill_func, make_list_2(sc, obj->value, val)));
+}
+
+
static char *s_type_print(s7_scheme *sc, void *val)
{
/* describe_object assumes the string is allocated here */
@@ -13078,7 +13910,7 @@ static s7_pointer s_type_ref(s7_scheme *sc, s7_pointer args)
static s7_pointer g_make_type(s7_scheme *sc, s7_pointer args)
{
- #define H_make_type "(make-type :optkey print equal getter setter length name) returns a new type object.\
+ #define H_make_type "(make-type :optkey print equal getter setter length name copy fill) returns a new type object.\
The optional arguments are functions that specify how objects of the new type display themselves (print, 1 argument), \
check for equality (equal, 2 args, both will be of the new type), apply themselves to arguments, (getter, any number \
of args, see vector for an example), respond to the generalized set! and length generic functions, and finally, \
@@ -13113,7 +13945,7 @@ In each case, the argument is the value of the object, not the object itself."
if (!s7_is_procedure(func))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
make_list_2(sc,
- s7_make_string(sc, "make-type arg, ~A, should be a function"),
+ make_protected_string(sc, "make-type arg, ~A, should be a function"),
func)));
proc_args = s7_procedure_arity(sc, func);
nargs = s7_integer(car(proc_args)) + s7_integer(cadr(proc_args));
@@ -13126,7 +13958,7 @@ In each case, the argument is the value of the object, not the object itself."
if ((s7_integer(car(proc_args)) > 1) ||
((nargs == 0) && (!rest_arg)))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "make-type :print procedure, ~A, should take one argument"), func)));
+ make_list_2(sc, make_protected_string(sc, "make-type :print procedure, ~A, should take one argument"), func)));
object_types[tag].print_func = func;
object_types[tag].print = call_s_object_print;
@@ -13137,7 +13969,7 @@ In each case, the argument is the value of the object, not the object itself."
if ((s7_integer(car(proc_args)) > 2) ||
((nargs < 2) && (!rest_arg)))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "make-type :equal procedure, ~A, should take two arguments"), func)));
+ make_list_2(sc, make_protected_string(sc, "make-type :equal procedure, ~A, should take two arguments"), func)));
object_types[tag].equal_func = func;
break;
@@ -13145,7 +13977,7 @@ In each case, the argument is the value of the object, not the object itself."
case 2: /* getter: (((cadr (make-type :getter (lambda (a b) (vector-ref a b)))) (vector 1 2 3)) 1) -> 2 */
if ((nargs == 0) && (!rest_arg))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "make-type :getter procedure, ~A, should take at least one argument"), func)));
+ make_list_2(sc, make_protected_string(sc, "make-type :getter procedure, ~A, should take at least one argument"), func)));
object_types[tag].getter_func = func;
object_types[tag].apply = call_s_object_getter;
@@ -13154,7 +13986,7 @@ In each case, the argument is the value of the object, not the object itself."
case 3: /* setter: (set! (((cadr (make-type :setter (lambda (a b c) (vector-set! a b c)))) (vector 1 2 3)) 1) 23) */
if ((nargs < 2) && (!rest_arg))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "make-type :setter procedure, ~A, should take at least two arguments"), func)));
+ make_list_2(sc, make_protected_string(sc, "make-type :setter procedure, ~A, should take at least two arguments"), func)));
object_types[tag].setter_func = func;
object_types[tag].set = call_s_object_setter;
@@ -13164,7 +13996,7 @@ In each case, the argument is the value of the object, not the object itself."
if ((s7_integer(car(proc_args)) > 1) ||
((nargs == 0) && (!rest_arg)))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "make-type :length procedure, ~A, should take at one argument"), func)));
+ make_list_2(sc, make_protected_string(sc, "make-type :length procedure, ~A, should take at one argument"), func)));
object_types[tag].length_func = func;
object_types[tag].length = call_s_object_length;
@@ -13173,10 +14005,30 @@ In each case, the argument is the value of the object, not the object itself."
case 5: /* name, ((cadr (make-type :name "hiho")) 123) -> #<hiho 123> */
if (!s7_is_string(func))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "make-type :name arg, ~S, should be a string"), func)));
+ make_list_2(sc, make_protected_string(sc, "make-type :name arg, ~S, should be a string"), func)));
object_types[tag].name = copy_string(s7_string(func));
break;
+
+ case 6: /* copy */
+ if ((s7_integer(car(proc_args)) > 1) ||
+ ((nargs == 0) && (!rest_arg)))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG,
+ make_list_2(sc, make_protected_string(sc, "make-type :copy procedure, ~A, should take at one argument"), func)));
+
+ object_types[tag].copy_func = func;
+ object_types[tag].copy = call_s_object_copy;
+ break;
+
+ case 7: /* fill */
+ if ((s7_integer(car(proc_args)) > 2) ||
+ ((nargs == 0) && (!rest_arg)))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG,
+ make_list_2(sc, make_protected_string(sc, "make-type :fill procedure, ~A, should take at two arguments"), func)));
+
+ object_types[tag].fill_func = func;
+ object_types[tag].fill = call_s_object_fill;
+ break;
}
}
}
@@ -13366,13 +14218,27 @@ static s7_pointer pws_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
}
+static s7_pointer pws_arity(s7_scheme *sc, s7_pointer obj)
+{
+ s7_pws_t *f;
+ f = (s7_pws_t *)s7_object_value(obj);
+
+ return(s7_cons(sc, s7_make_integer(sc, f->get_req_args),
+ s7_cons(sc, s7_make_integer(sc, f->get_opt_args),
+ s7_cons(sc, sc->F,
+ s7_cons (sc, s7_make_integer(sc, f->set_req_args),
+ s7_cons(sc, s7_make_integer(sc, f->set_opt_args),
+ s7_cons(sc, sc->F, sc->NIL)))))));
+}
+
+
static s7_pointer g_make_procedure_with_setter(s7_scheme *sc, s7_pointer args)
{
#define H_make_procedure_with_setter "(make-procedure-with-setter getter setter) combines its \
two function arguments as a procedure-with-setter. The 'getter' is called unless the procedure \
occurs as the object of set!."
- s7_pointer p, getter, setter;
+ s7_pointer p, getter, setter, arity;
s7_pws_t *f;
/* the two args should be functions, the setter taking one more arg than the getter */
@@ -13387,16 +14253,14 @@ occurs as the object of set!."
f = (s7_pws_t *)s7_object_value(p);
f->scheme_getter = getter;
- if ((is_closure(getter)) ||
- (is_closure_star(getter)))
- f->get_req_args = s7_list_length(sc, closure_args(getter));
- else f->get_req_args = s7_list_length(sc, caar(args));
+ arity = s7_procedure_arity(sc, getter);
+ if (is_pair(arity))
+ f->get_req_args = s7_integer(car(arity));
f->scheme_setter = setter;
- if ((is_closure(setter)) ||
- (is_closure_star(setter)))
- f->set_req_args = s7_list_length(sc, closure_args(setter));
- else f->set_req_args = s7_list_length(sc, caadr(args));
+ arity = s7_procedure_arity(sc, setter);
+ if (is_pair(arity))
+ f->set_req_args = s7_integer(car(arity));
return(p);
}
@@ -13439,34 +14303,6 @@ static char *pws_documentation(s7_pointer x)
}
-static int pws_get_req_args(s7_pointer x)
-{
- s7_pws_t *f = (s7_pws_t *)s7_object_value(x);
- return(f->get_req_args);
-}
-
-
-static int pws_get_opt_args(s7_pointer x)
-{
- s7_pws_t *f = (s7_pws_t *)s7_object_value(x);
- return(f->get_opt_args);
-}
-
-
-static s7_pointer g_procedure_with_setter_setter_arity(s7_scheme *sc, s7_pointer args)
-{
- s7_pws_t *f;
- if (!s7_is_procedure_with_setter(car(args)))
- return(s7_wrong_type_arg_error(sc, "procedure-with-setter-setter-arity", 0, car(args), "a procedure-with-setter"));
-
- f = (s7_pws_t *)s7_object_value(car(args));
- return(make_list_3(sc,
- s7_make_integer(sc, f->set_req_args),
- s7_make_integer(sc, f->set_opt_args),
- sc->F));
-}
-
-
static s7_pointer pws_source(s7_scheme *sc, s7_pointer x)
{
s7_pws_t *f;
@@ -13521,8 +14357,6 @@ void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function
* (define (notify-if-set var notifier) ; returns #t if it's ok to set
* (set! (symbol-access)
* (list #f (lambda (symbol new-value) (or (notifier symbol new-value) new-value)) #f)))
- *
- * PERHAPS: symbol-access get side implemented (is there any use for it?)
*/
@@ -13670,7 +14504,16 @@ bool s7_is_eqv(s7_pointer a, s7_pointer b)
}
-bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+/* -------- structure equality --------
+ *
+ * equal? examines the entire structure (possibly a tree etc), which might contain
+ * cycles (vector element is the vector etc), so list/vector/hash-table equality
+ * needs to carry along a list of pointers seen so far.
+ */
+
+static bool structures_are_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci);
+
+bool s7_is_equal_ci(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
if (x == y)
return(true);
@@ -13682,30 +14525,132 @@ bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
if (type(x) != type(y))
return(false);
- if (is_pair(x))
- return((s7_is_equal(sc, car(x), car(y))) &&
- (s7_is_equal(sc, cdr(x), cdr(y))));
-
- if (s7_is_string(x))
- return(strings_are_equal(string_value(x), string_value(y)));
-
- if (is_c_object(x))
+ switch (type(x))
{
+ case T_STRING:
+ return(strings_are_equal(string_value(x), string_value(y)));
+
+ case T_C_OBJECT:
if (is_s_object(x))
return(call_s_object_equal(sc, x, y));
return(objects_are_equal(x, y));
+
+ case T_CHARACTER:
+ return(s7_character(x) == s7_character(y));
+
+ case T_NUMBER:
+ return(numbers_are_eqv(x, y));
+
+ case T_VECTOR:
+ case T_HASH_TABLE:
+ case T_PAIR:
+ return(structures_are_equal(sc, x, y, ci));
+ }
+
+ return(false); /* we already checked that x != y (port etc) */
+}
+
+
+static bool structures_are_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ /* here we know x and y are pointers to the same type of structure */
+ int ref_x, ref_y;
+
+ ref_x = peek_shared_ref(ci, x);
+ ref_y = peek_shared_ref(ci, y);
+
+ if ((ref_x != 0) && (ref_y != 0))
+ return(ref_x == ref_y);
+
+ if ((ref_x != 0) || (ref_y != 0))
+ {
+ /* try to harmonize the new guy -- there can be more than one structure equal to the current one */
+ if (ref_x != 0)
+ add_shared_ref(ci, y, ref_x);
+ else add_shared_ref(ci, x, ref_y);
}
+ else add_equal_ref(ci, x, y);
- if ((s7_is_vector(x)) ||
- (s7_is_hash_table(x)))
- return(vectors_equal(sc, x, y));
+ /* now compare the elements of the structures. */
+ if (is_pair(x))
+ return((s7_is_equal_ci(sc, car(x), car(y), ci)) &&
+ (s7_is_equal_ci(sc, cdr(x), cdr(y), ci)));
+
+ /* vector or hash table */
+ {
+ s7_Int i, len;
+ len = vector_length(x);
+ if (len != vector_length(y)) return(false);
+
+ if (vector_is_multidimensional(x))
+ {
+ if (!(vector_is_multidimensional(y)))
+ return(false);
+ if (vector_ndims(x) != vector_ndims(y))
+ return(false);
+ for (i = 0; i < vector_ndims(x); i++)
+ if (vector_dimension(x, i) != vector_dimension(y, i))
+ return(false);
+ }
+ else
+ {
+ if (vector_is_multidimensional(y))
+ return(false);
+ }
+
+ for (i = 0; i < len; i++)
+ if (!(s7_is_equal_ci(sc, vector_element(x, i), vector_element(y, i), ci)))
+ return(false);
+ }
+ return(true);
+}
+
+
+bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (x == y)
+ return(true);
- if (s7_is_character(x))
- return(s7_character(x) == s7_character(y));
+#if WITH_GMP
+ if (big_numbers_are_eqv(x, y)) return(true); /* T_NUMBER != T_C_OBJECT but both can represent numbers */
+#endif
+
+ if (type(x) != type(y))
+ return(false);
- if (s7_is_number(x))
- return(numbers_are_eqv(x, y));
+ switch (type(x))
+ {
+ case T_STRING:
+ return(strings_are_equal(string_value(x), string_value(y)));
+
+ case T_C_OBJECT:
+ if (is_s_object(x))
+ return(call_s_object_equal(sc, x, y));
+ return(objects_are_equal(x, y));
+
+ case T_CHARACTER:
+ return(s7_character(x) == s7_character(y));
+ case T_NUMBER:
+ return(numbers_are_eqv(x, y));
+
+ case T_VECTOR:
+ case T_HASH_TABLE:
+ if (vector_length(x) != vector_length(y))
+ return(false);
+ /* fall through */
+
+ case T_PAIR:
+ {
+ shared_info *ci;
+ bool result;
+ ci = new_shared_info(sc);
+ result = structures_are_equal(sc, x, y, ci);
+ free_shared_info(ci);
+ return(result);
+ }
+ }
+
return(false); /* we already checked that x != y (port etc) */
}
@@ -13741,7 +14686,9 @@ static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args)
static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
{
- #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, or hash-table"
+ #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, or hash-table. \
+The length of a dotted list does not include the final cdr, and is returned as a negative number. A circular \
+list has infinite length."
s7_pointer lst = car(args);
@@ -13754,12 +14701,11 @@ static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
{
int len;
len = s7_list_length(sc, lst);
-
- if (len < 0)
- return(s7_wrong_type_arg_error(sc, "length:", 0, lst, "a proper (not a dotted) list"));
+ /* len < 0 -> dotted and (abs len) is length not counting the final cdr
+ * len == 0, circular so length is infinite
+ */
if (len == 0)
- return(s7_wrong_type_arg_error(sc, "length:", 0, lst, "a proper (not a circular) list"));
-
+ return(s7_make_real(sc, INFINITY));
return(s7_make_integer(sc, len));
}
@@ -13783,11 +14729,12 @@ static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer list_copy(s7_scheme *sc, s7_pointer obj)
+static s7_pointer list_copy(s7_scheme *sc, s7_pointer x, s7_pointer y, bool step)
{
- if (is_pair(obj))
- return(s7_cons(sc, car(obj), list_copy(sc, cdr(obj))));
- return(obj);
+ if ((!is_pair(x)) ||
+ (x == y))
+ return(x);
+ return(s7_cons(sc, car(x), list_copy(sc, cdr(x), (step) ? cdr(y) : y, !step)));
}
@@ -13801,12 +14748,14 @@ static s7_pointer s7_copy(s7_scheme *sc, s7_pointer obj)
case T_C_OBJECT:
return(object_copy(sc, obj));
- case T_HASH_TABLE:
+ case T_HASH_TABLE: /* this has to copy nearly everything */
+ return(hash_table_copy(sc, obj));
+
case T_VECTOR:
- return(vector_copy(sc, obj));
+ return(vector_copy(sc, obj)); /* "shallow" copy */
case T_PAIR:
- return(list_copy(sc, obj)); /* should vector/list copy the objects as well as the container? */
+ return(s7_cons(sc, car(obj), list_copy(sc, cdr(obj), obj, true))); /* this is the only use of list_copy */
}
return(obj);
}
@@ -13819,20 +14768,96 @@ static s7_pointer g_copy(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer list_fill(s7_scheme *sc, s7_pointer obj, s7_pointer val)
+static s7_pointer g_reverse(s7_scheme *sc, s7_pointer args)
{
- if (is_pair(obj))
+ #define H_reverse "(reverse lst) returns a list with the elements of lst in reverse order. reverse \
+also accepts a string or vector argument."
+ s7_pointer p, np;
+
+ p = car(args);
+ np = sc->NIL;
+
+ switch (type(p))
{
- if (is_pair(car(obj)))
- list_fill(sc, car(obj), val);
- else car(obj) = val;
+ case T_NIL:
+ return(sc->NIL);
+
+ case T_PAIR:
+ if (p == sc->NIL)
+ return(sc->NIL);
+ np = s7_reverse(sc, p);
+ if (np == sc->NIL)
+ return(s7_wrong_type_arg_error(sc, "reverse", 0, p, "a proper list"));
+ break;
+
+ case T_STRING:
+ {
+ int i, j, len;
+ len = string_length(p);
+ np = make_empty_string(sc, len, 0);
+ if (len > 0)
+ for (i = 0, j = len - 1; i < len; i++, j--)
+ string_value(np)[i] = string_value(p)[j];
+ }
+ break;
- if (is_pair(cdr(obj)))
- list_fill(sc, cdr(obj), val);
+ case T_VECTOR:
+ {
+ s7_Int i, j, len;
+ len = vector_length(p);
+ if (vector_is_multidimensional(p))
+ np = g_make_vector(sc, s7_cons(sc, g_vector_dimensions(sc, s7_cons(sc, p, sc->NIL)), sc->NIL));
+ else np = s7_make_vector_1(sc, len, false);
+ if (len > 0)
+ for (i = 0, j = len - 1; i < len; i++, j--)
+ vector_element(np, i) = vector_element(p, j);
+ }
+ break;
+
+ /* would (reverse hash) exchange keys and values? */
+
+ default:
+ return(s7_wrong_type_arg_error(sc, "reverse", 0, p, "a list, string, or vector"));
+ }
+
+ return(np);
+}
+
+
+static s7_pointer list_fill(s7_scheme *sc, s7_pointer obj, s7_pointer val)
+{
+ /* ambiguous ("tree-fill"?) but if it's like vector-fill, we just stomp on the top level */
+ s7_pointer x, y;
+
+ x = obj;
+ y = obj;
+
+ while (true)
+ {
+ if (!is_pair(x)) return(val);
+ car(x) = val;
+ if (is_pair(cdr(x)))
+ {
+ x = cdr(x);
+ car(x) = val;
+ if (is_pair(cdr(x)))
+ {
+ x = cdr(x);
+ y = cdr(y);
+ if (x == y) return(val);
+ }
+ else
+ {
+ if (cdr(x) != sc->NIL)
+ cdr(x) = val;
+ return(val);
+ }
+ }
else
{
- if (cdr(obj) != sc->NIL)
- cdr(obj) = val;
+ if (cdr(x) != sc->NIL)
+ cdr(x) = val;
+ return(val);
}
}
return(val);
@@ -13849,6 +14874,10 @@ static s7_pointer g_fill(s7_scheme *sc, s7_pointer args)
return(g_string_fill(sc, args));
case T_HASH_TABLE:
+ if (cadr(args) != sc->NIL)
+ return(s7_wrong_type_arg_error(sc, "copy hash-table value,", 2, cadr(args), "nil"));
+ return(hash_table_clear(sc, car(args)));
+
case T_VECTOR:
return(g_vector_fill(sc, args));
@@ -13857,7 +14886,9 @@ static s7_pointer g_fill(s7_scheme *sc, s7_pointer args)
case T_PAIR:
return(list_fill(sc, car(args), cadr(args)));
-
+
+ case T_NIL:
+ return(cadr(args)); /* this parallels the empty vector case */
}
return(s7_wrong_type_arg_error(sc, "fill!", 1, car(args), "a fillable object")); /* (fill! 1 0) */
@@ -13955,7 +14986,35 @@ static void format_number(s7_scheme *sc, format_data *fdat, int radix, int width
{
char *tmp;
if (width < 0) width = 0;
+
+ /* precision choice depends on float_choice if it's -1 */
+ if (precision < 0)
+ {
+ if ((float_choice == 'e') ||
+ (float_choice == 'f') ||
+ (float_choice == 'g'))
+ precision = 6;
+ else
+ {
+ /* in the "int" cases, precision depends on the arg type */
+ switch (number_type(car(fdat->args)))
+ {
+ case NUM_INT:
+ case NUM_RATIO:
+ precision = 0;
+ break;
+
+ default:
+ precision = 6;
+ break;
+ }
+ }
+ }
+
+ /* should (format #f "~F" 1/3) return "1/3"?? in CL it's "0.33333334" */
+
tmp = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice);
+
if (pad != ' ')
{
char *padtmp;
@@ -14037,25 +15096,55 @@ static char *format_to_c_string(s7_scheme *sc, const char *str, s7_pointer args,
}
i++;
break;
+
+ case '@': /* -------- plural, 'y' or 'ies' -------- */
+ i += 2;
+ if ((str[i] != 'P') && (str[i] != 'p'))
+ return(format_error(sc, "unknown '@' directive", str, args, fdat));
+
+ if (!s7_is_one(car(fdat->args)))
+ format_append_string(fdat, "ies");
+ else format_append_char(fdat, 'y');
+
+ fdat->args = cdr(fdat->args);
+ break;
+
+ case 'P': case 'p': /* -------- plural in 's' -------- */
+ if (!s7_is_one(car(fdat->args)))
+ format_append_char(fdat, 's');
+ i++;
+ fdat->args = cdr(fdat->args);
+ break;
case 'A': case 'a': /* -------- object->string -------- */
case 'C': case 'c':
case 'S': case 's':
+ {
+ shared_info *ci = NULL;
+ s7_pointer obj;
- /* slib suggests num arg to ~A and ~S to truncate: ~20A sends only (up to) 20 chars of object->string result,
- * but that could easily(?) be handled with substring and an embedded format arg.
- */
- if (fdat->args == sc->NIL)
- return(format_error(sc, "missing argument", str, args, fdat));
- i++;
- if (((str[i] == 'C') || (str[i] == 'c')) &&
- (!s7_is_character(car(fdat->args))))
- return(format_error(sc, "~C directive requires a character argument", str, args, fdat));
+ /* slib suggests num arg to ~A and ~S to truncate: ~20A sends only (up to) 20 chars of object->string result,
+ * but that could easily(?) be handled with substring and an embedded format arg.
+ */
- tmp = s7_object_to_c_string_1(sc, car(fdat->args), (str[i] == 'S') || (str[i] == 's'), 0, false);
- format_append_string(fdat, tmp);
- if (tmp) free(tmp);
- fdat->args = cdr(fdat->args);
+ if (fdat->args == sc->NIL)
+ return(format_error(sc, "missing argument", str, args, fdat));
+ i++;
+ obj = car(fdat->args);
+
+ if (((str[i] == 'C') || (str[i] == 'c')) &&
+ (!s7_is_character(obj)))
+ return(format_error(sc, "'C' directive requires a character argument", str, args, fdat));
+
+ if (has_structure(obj))
+ ci = make_shared_info(sc, obj);
+ tmp = object_to_c_string_with_circle_check(sc, obj, (str[i] == 'S') || (str[i] == 's'), false, ci);
+ if (ci) free_shared_info(ci);
+
+ format_append_string(fdat, tmp);
+ if (tmp) free(tmp);
+ fdat->args = cdr(fdat->args);
+ }
break;
case '{': /* -------- iteration -------- */
@@ -14088,7 +15177,7 @@ static char *format_to_c_string(s7_scheme *sc, const char *str, s7_pointer args,
return(format_error(sc, "'{' directive, but no matching '}'", str, args, fdat));
if (curly_len <= 1)
- return(format_error(sc, "~{...~} doesn't consume any arguments!", str, args, fdat));
+ return(format_error(sc, "'{...}' doesn't consume any arguments!", str, args, fdat));
curly_str = (char *)malloc(curly_len * sizeof(char));
for (k = 0; k < curly_len - 1; k++)
@@ -14105,7 +15194,7 @@ static char *format_to_c_string(s7_scheme *sc, const char *str, s7_pointer args,
if (curly_arg == new_arg)
{
if (curly_str) free(curly_str);
- return(format_error(sc, "~{...~} doesn't consume any arguments!", str, args, fdat));
+ return(format_error(sc, "'{...}' doesn't consume any arguments!", str, args, fdat));
}
curly_arg = new_arg;
}
@@ -14122,6 +15211,7 @@ static char *format_to_c_string(s7_scheme *sc, const char *str, s7_pointer args,
/* -------- numeric args -------- */
case '0': case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9': case ',':
+
case 'B': case 'b':
case 'D': case 'd':
case 'E': case 'e':
@@ -14134,8 +15224,10 @@ static char *format_to_c_string(s7_scheme *sc, const char *str, s7_pointer args,
int width = -1, precision = -1;
char pad = ' ';
i++;
+
if (isdigit(str[i]))
width = format_read_integer(sc, &i, str_len, str, args, fdat);
+
if (str[i] == ',')
{
i++;
@@ -14189,31 +15281,37 @@ static char *format_to_c_string(s7_scheme *sc, const char *str, s7_pointer args,
/* -------- numbers -------- */
case 'F': case 'f':
- format_number(sc, fdat, 10, width, (precision < 0) ? 6 : precision, 'f', pad);
+ format_number(sc, fdat, 10, width, precision, 'f', pad);
break;
case 'G': case 'g':
- format_number(sc, fdat, 10, width, (precision < 0) ? 6 : precision, 'g', pad);
+ format_number(sc, fdat, 10, width, precision, 'g', pad);
break;
case 'E': case 'e':
- format_number(sc, fdat, 10, width, (precision < 0) ? 6 : precision, 'e', pad);
+ format_number(sc, fdat, 10, width, precision, 'e', pad);
break;
+ /* how to handle non-integer arguments in the next 4 cases? clisp just returns
+ * the argument: (format nil "~X" 1.25) -> "1.25" which is perverse (ClTl2 p 581:
+ * "if arg is not an integer, it is printed in ~A format and decimal base")!!
+ * Guile raises an error ("argument is not an integer"). slib also raise an error.
+ * I think I'll use the type of the number to choose the output format.
+ */
case 'D': case 'd':
- format_number(sc, fdat, 10, width, (precision < 0) ? 0 : precision, 'd', pad);
+ format_number(sc, fdat, 10, width, precision, 'd', pad);
break;
case 'O': case 'o':
- format_number(sc, fdat, 8, width, (precision < 0) ? 0 : precision, 'o', pad);
+ format_number(sc, fdat, 8, width, precision, 'o', pad);
break;
case 'X': case 'x':
- format_number(sc, fdat, 16, width, (precision < 0) ? 0 : precision, 'x', pad);
+ format_number(sc, fdat, 16, width, precision, 'x', pad);
break;
case 'B': case 'b':
- format_number(sc, fdat, 2, width, (precision < 0) ? 0 : precision, 'b', pad);
+ format_number(sc, fdat, 2, width, precision, 'b', pad);
break;
default:
@@ -14256,7 +15354,7 @@ static s7_pointer format_to_output(s7_scheme *sc, s7_pointer out_loc, const char
if (args != sc->NIL)
return(s7_error(sc,
sc->FORMAT_ERROR,
- make_list_2(sc, s7_make_string(sc, "format control string is null, but there are other arguments: ~A"), args)));
+ make_list_2(sc, make_protected_string(sc, "format control string is null, but there are other arguments: ~A"), args)));
return(s7_make_string(sc, ""));
}
@@ -14292,8 +15390,9 @@ spacing (and spacing character) and precision. ~{ starts an embedded format dir
if (!((s7_is_boolean(pt)) || /* #f or #t */
(pt == sc->NIL) || /* default current-output-port = stdout -> nil */
- (s7_is_output_port(sc, pt)))) /* (current-output-port) or call-with-open-file arg, etc */
- return(s7_wrong_type_arg_error(sc, "format", 1, pt, "#f, #t, or an output port"));
+ ((s7_is_output_port(sc, pt)) && /* (current-output-port) or call-with-open-file arg, etc */
+ (!port_is_closed(pt)))))
+ return(s7_wrong_type_arg_error(sc, "format", 1, pt, "#f, #t, or an open output port"));
return(format_to_output(sc, (pt == sc->T) ? sc->output_port : pt, s7_string(cadr(args)), cddr(args)));
}
@@ -14661,6 +15760,21 @@ each a function of no arguments, guaranteeing that finish is called even if body
return(s7_wrong_type_arg_error(sc, "dynamic-wind", 2, cadr(args), "a thunk"));
if (!is_thunk(sc, caddr(args)))
return(s7_wrong_type_arg_error(sc, "dynamic-wind", 3, caddr(args), "a thunk"));
+
+ /* this won't work:
+
+ (let ((final (lambda (a b c) (list a b c))))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (set! final (lambda () (display "in final"))))
+ final))
+
+ * but why not? 'final' is a thunk by the time it is evaluated.
+ * catch (the error handler) is similar.
+ *
+ * It can't work here because we set up the dynamic_wind_out slot below and
+ * even if the thunk check was removed, we'd still be trying to apply the original function.
+ */
NEW_CELL(sc, p);
dynamic_wind_in(p) = car(args);
@@ -14779,6 +15893,21 @@ static int remember_file_name(const char *file)
(apply error continue ',args))))
;;; now ((vector-ref *error-info* 0)) will continue from the error
+
+(define (cerror . args)
+ (format #t "error: ~A" (car args))
+ (if (not (null? (cdr args)))
+ (if (and (string? (cadr args))
+ (not (null? (cddr args))))
+ (let ((str (apply format (cdr args))))
+ (format #t "~S~%" str))
+ (format #t "~S~%" (cadr args))))
+ (format #t "continue? (<cr>=yes) ")
+ (let ((val (read-line ())))
+ (if (not (char=? (val 0) #\newline))
+ (error (car args)))))
+
+;;; so perhaps wrap the caller-passed stuff in "continue?" etc?
*/
@@ -14802,6 +15931,10 @@ static s7_pointer s7_error_1(s7_scheme *sc, s7_pointer type, s7_pointer info, bo
vector_element(sc->error_info, ERROR_ENVIRONMENT) = sc->envir;
s7_gc_on(sc, true); /* this is in case we were triggered from the sort function -- clumsy! */
+ /* currently sc->error_info is shared by all threads, so if two get an error at the same
+ * time, could we get a confused error message?
+ */
+
/* (let ((x 32)) (define (h1 a) (* a "hi")) (define (h2 b) (+ b (h1 b))) (h2 1)) */
if (is_pair(sc->cur_code))
@@ -14895,6 +16028,16 @@ GOT_CATCH:
sc->code = catch_handler(catcher);
loc = catch_goto_loc(catcher);
sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+
+ /* if user (i.e. yers truly!) copies/pastes the preceding lambda () into the
+ * error handler portion of the catch, he gets the inexplicable message:
+ * ;(): too many arguments: (a1 ())
+ * when this apply tries to call the handler. So, we need a special case
+ * error check here!
+ */
+ if (!args_match(sc, sc->code, 2))
+ return(s7_wrong_number_of_args_error(sc, "catch error handler has wrong number of args: ~A", sc->args));
+
sc->op = OP_APPLY;
/* explicit eval needed if s7_call called into scheme where a caught error occurred (ex6 in exs7.c)
@@ -15047,6 +16190,12 @@ s7_pointer s7_error_and_exit(s7_scheme *sc, s7_pointer type, s7_pointer info)
}
+static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ return(s7_error(sc, sc->SYNTAX_ERROR, make_list_3(sc, make_protected_string(sc, "attempt to apply ~S to ~S?"), obj, args)));
+}
+
+
static s7_pointer eval_error(s7_scheme *sc, const char *errmsg, s7_pointer obj)
{
return(s7_error(sc, sc->SYNTAX_ERROR, make_list_2(sc, make_protected_string(sc, errmsg), obj)));
@@ -15164,13 +16313,13 @@ static s7_pointer missing_close_paren_error(s7_scheme *sc)
if (line > 0)
return(s7_error(sc, sc->READ_ERROR,
make_list_3(sc,
- s7_make_string(sc, "missing close paren, list started around line ~D of ~S"),
+ make_protected_string(sc, "missing close paren, list started around line ~D of ~S"),
s7_make_integer(sc, remembered_line_number(line)),
make_protected_string(sc, port_filename(sc->input_port)))));
/* we need a legit s7_error here, but we're lost... */
return(s7_error(sc, sc->READ_ERROR,
- make_list_1(sc, s7_make_string(sc, "missing close paren"))));
+ make_list_1(sc, make_protected_string(sc, "missing close paren"))));
}
@@ -15184,7 +16333,7 @@ static void improper_arglist_error(s7_scheme *sc)
s7_error(sc, sc->SYNTAX_ERROR,
make_list_2(sc,
- s7_make_string(sc, "improper list of arguments: ~A"),
+ make_protected_string(sc, "improper list of arguments: ~A"),
x));
}
@@ -15256,9 +16405,10 @@ output is sent to the current-output-port."
{
if (cdr(args) != sc->NIL)
{
- if (is_output_port(cadr(args)))
+ if ((is_output_port(cadr(args))) &&
+ (!port_is_closed(cadr(args))))
port = cadr(args);
- else return(s7_wrong_type_arg_error(sc, "stacktrace", 2, cadr(args), "an output port"));
+ else return(s7_wrong_type_arg_error(sc, "stacktrace", 2, cadr(args), "an open output port"));
}
}
obj = car(args);
@@ -15377,7 +16527,7 @@ static s7_pointer g_apply(s7_scheme *sc, s7_pointer args)
if (!is_proper_list(sc, sc->args)) /* (apply + #f) etc */
return(s7_error(sc, sc->WRONG_TYPE_ARG,
make_list_2(sc,
- s7_make_string(sc, "apply's last argument should be a list: ~A"),
+ make_protected_string(sc, "apply's last argument should be a proper list: ~A"),
args)));
}
push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
@@ -15464,12 +16614,20 @@ static s7_pointer g_s7_version(s7_scheme *sc, s7_pointer args)
/* ---------------------------------------- map and for-each ---------------------------------------- */
-static int applicable_length(s7_scheme *sc, s7_pointer obj)
+static long int applicable_length(s7_scheme *sc, s7_pointer obj)
{
switch (type(obj))
{
case T_PAIR:
- return(s7_list_length(sc, obj));
+ {
+ int len;
+ len = s7_list_length(sc, obj);
+ if (len < 0) /* dotted (does not include the final cdr) */
+ return(-len);
+ if (len == 0) /* circular */
+ return(LONG_MAX);
+ return(len);
+ }
case T_C_OBJECT:
return(s7_integer(object_length(sc, obj)));
@@ -15528,6 +16686,11 @@ static void next_for_each(s7_scheme *sc)
case T_HASH_TABLE:
car(x) = vector_element(car(y), loc);
break;
+ /* for hash tables to go by entries, we'd need to set the "length" to the number of entries,
+ * then find the next entry here. This would require independent "loc" and current element
+ * values. Or when we initially get the length, also set up a parallel vector pointing
+ * to them, and walk down it, freeing it at the end -- perhaps this is simpler.
+ */
case T_STRING:
car(x) = s7_make_character(sc, string_value(car(y))[loc]);
@@ -15549,7 +16712,7 @@ static s7_pointer g_for_each(s7_scheme *sc, s7_pointer args)
Each object can be a list (the normal case), string, vector, hash-table, or any applicable object."
/* (for-each (lambda (n) (format #t "~A " n)) (vct 1.0 2.0 3.0)) */
- int i, len;
+ long int i, len; /* the "long" matters on 64-bit machines */
s7_pointer obj, x;
sc->code = car(args);
@@ -15558,17 +16721,11 @@ Each object can be a list (the normal case), string, vector, hash-table, or any
sc->y = args;
obj = cadr(args);
+
len = applicable_length(sc, obj);
if (len < 0)
return(s7_wrong_type_arg_error(sc, "for-each", 2, obj, "a vector, list, string, or applicable object"));
- if (len == 0)
- {
- /* this for-each is a no-op, but we'll still check for unequal length args */
- for (i = 3, x = cddr(args); x != sc->NIL; x = cdr(x), i++)
- if (applicable_length(sc, car(x)) != 0)
- return(s7_wrong_type_arg_error(sc, "for-each", i, car(x), "an object whose length matches the other objects"));
- return(obj);
- }
+ if (len == 0) return(sc->UNSPECIFIED);
sc->x = s7_cons(sc, sc->NIL, sc->NIL);
sc->z = s7_cons(sc, obj, sc->NIL);
@@ -15580,12 +16737,14 @@ Each object can be a list (the normal case), string, vector, hash-table, or any
{
for (i = 3, x = cddr(args); x != sc->NIL; x = cdr(x), i++)
{
- int nlen;
+ long int nlen;
+
nlen = applicable_length(sc, car(x));
if (nlen < 0)
return(s7_wrong_type_arg_error(sc, "for-each", i, car(x), "a vector, list, string, or applicable object"));
- if (len != nlen)
- return(s7_wrong_type_arg_error(sc, "for-each", i, car(x), "an object whose length matches the other objects"));
+ if (nlen == 0) return(sc->UNSPECIFIED);
+ if (nlen < len) len = nlen;
+
sc->x = s7_cons(sc, sc->NIL, sc->x);
sc->z = s7_cons(sc, car(x), sc->z);
}
@@ -15649,6 +16808,7 @@ static void next_map(s7_scheme *sc)
break;
default: /* make the compiler happy */
+ /* fprintf(stderr, "vargs: %s, loc: %d, len: %lld\n", s7_object_to_c_string(sc, vargs), loc, s7_integer(cadr(sc->args))); */
x = sc->F;
break;
}
@@ -15671,7 +16831,7 @@ static s7_pointer g_map(s7_scheme *sc, s7_pointer args)
#define H_map "(map proc object . objectss) applies proc to a list made up of the next element of each of its arguments, returning \
a list of the results. Its arguments can be lists, vectors, strings, hash-tables, or any applicable objects."
- int i, len;
+ long int i, len;
s7_pointer obj, x;
sc->code = car(args);
@@ -15680,17 +16840,11 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table
sc->y = args; /* gc protect */
obj = cadr(args);
+
len = applicable_length(sc, obj);
if (len < 0)
return(s7_wrong_type_arg_error(sc, "map", 2, obj, "a vector, list, string, or applicable object"));
- if (len == 0)
- {
- /* this for-each is a no-op, but we'll still check for unequal length args */
- for (i = 3, x = cddr(args); x != sc->NIL; x = cdr(x), i++)
- if (applicable_length(sc, car(x)) != 0)
- return(s7_wrong_type_arg_error(sc, "map", i, car(x), "an object whose length matches the other objects"));
- return(sc->NIL);
- }
+ if (len == 0) return(sc->NIL);
sc->z = s7_cons(sc, obj, sc->NIL);
/* we have to copy the args if any of them is a list:
@@ -15701,12 +16855,14 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table
{
for (i = 3, x = cddr(args); x != sc->NIL; x = cdr(x), i++)
{
- int nlen;
+ long int nlen;
+
nlen = applicable_length(sc, car(x));
if (nlen < 0)
return(s7_wrong_type_arg_error(sc, "map", i, car(x), "a vector, list, string, or applicable object"));
- if (len != nlen)
- return(s7_wrong_type_arg_error(sc, "map", i, car(x), "an object whose length matches the other objects"));
+ if (nlen == 0) return(sc->NIL);
+ if (nlen < len) len = nlen;
+
sc->z = s7_cons(sc, car(x), sc->z);
}
}
@@ -15888,8 +17044,9 @@ static void back_up_stack(s7_scheme *sc)
if (top_op == OP_READ_QUOTE)
pop_stack(sc);
- if (top_op == OP_EVAL_STRING) /* ?? */
- pop_stack(sc);
+ /* we used to backup past OP_EVAL_STRING here, but that leads to segfaults if
+ * the input is (+ 1 . . ) or (list . ). Why were we backing past it?
+ */
}
@@ -15994,9 +17151,37 @@ static token_t token(s7_scheme *sc)
case '#':
c = inchar(sc, pt);
+ sc->w = small_int(1);
if (c == '(')
return(TOKEN_VECTOR);
+ if (isdigit(c)) /* #2D(...) */
+ {
+ int dims, dig, d, loc = 0;
+ sc->strbuf[loc++] = c;
+ dims = digits[c];
+ while ((dig = digits[d = inchar(sc, pt)]) < 10)
+ {
+ dims = dig + (dims * 10);
+ sc->strbuf[loc++] = d;
+ }
+ sc->strbuf[loc++] = d;
+ if ((d == 'D') || (d == 'd'))
+ {
+ d = inchar(sc, pt);
+ sc->strbuf[loc++] = d;
+ if (d == '(')
+ {
+ sc->w = s7_make_integer(sc, dims);
+ return(TOKEN_VECTOR);
+ }
+ }
+
+ /* try to back out */
+ for (d = loc - 1; d > 0; d--)
+ backchar(sc, sc->strbuf[d], pt);
+ }
+
if (c == ':') /* turn #: into : */
{
sc->strbuf[0] = ':';
@@ -16199,6 +17384,7 @@ static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt)
{
if (!isspace(c))
return(sc->T); /* #f here would give confusing error message "end of input", so return #t=bad backslash */
+ /* this in my opinion is not optimal. It's easy to forget that backslash needs to be backslashed. */
}
}
}
@@ -16222,8 +17408,8 @@ static s7_pointer read_expression(s7_scheme *sc)
return(sc->EOF_OBJECT);
case TOKEN_VECTOR: /* already read #( -- TOKEN_VECTOR is triggered by #( */
- push_stack(sc, opcode(OP_READ_VECTOR), sc->NIL, sc->NIL);
- /* fall through */
+ push_stack(sc, opcode(OP_READ_VECTOR), sc->w, sc->NIL); /* sc->w is the dimensions */
+ /* fall through */
case TOKEN_LEFT_PAREN:
sc->tok = token(sc);
@@ -16253,7 +17439,7 @@ static s7_pointer read_expression(s7_scheme *sc)
sc->tok = token(sc);
if (sc->tok == TOKEN_VECTOR)
{
- push_stack(sc, opcode(OP_READ_QUASIQUOTE_VECTOR), sc->NIL, sc->NIL);
+ push_stack(sc, opcode(OP_READ_QUASIQUOTE_VECTOR), sc->w, sc->NIL);
sc->tok= TOKEN_LEFT_PAREN;
}
else push_stack(sc, opcode(OP_READ_QUASIQUOTE), sc->NIL, sc->NIL);
@@ -16275,10 +17461,12 @@ static s7_pointer read_expression(s7_scheme *sc)
case TOKEN_DOUBLE_QUOTE:
sc->value = read_string_constant(sc, sc->input_port);
+
if (sc->value == sc->F) /* can happen if input code ends in the middle of a string */
return(read_error(sc, "end of input encountered while in a string"));
if (sc->value == sc->T)
- return(read_error(sc, "unknown backslash usage"));
+ return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
+
return(sc->value);
case TOKEN_SHARP_CONST:
@@ -16326,8 +17514,11 @@ static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym)
if ((unbound_variable_hook_binding != sc->NIL) &&
(is_procedure(symbol_value(unbound_variable_hook_binding))))
{
- int save_x, save_y, save_z;
- s7_pointer x;
+ int save_x, save_y, save_z, cur_code_loc;
+ s7_pointer x, cur_code;
+
+ cur_code = sc->cur_code;
+ cur_code_loc = s7_gc_protect(sc, cur_code); /* we need to save this because it has the file/line number of the unbound symbol */
SAVE_X_Y_Z(save_x, save_y, save_z);
x = s7_call(sc,
@@ -16335,6 +17526,9 @@ static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym)
make_list_1(sc, sym));
RESTORE_X_Y_Z(save_x, save_y, save_z);
+ sc->cur_code = cur_code;
+ s7_gc_unprotect_at(sc, cur_code_loc);
+
return(x);
}
return(sc->UNDEFINED);
@@ -16612,8 +17806,28 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
switch (sc->op)
{
- /* in gcc, this becomes a jump table, so we're not doing a linear search (gcc s7.c -S -I.) */
+ /* in gcc, this becomes a jump table, so we're not doing a linear search (gcc s7.c -S -I.)
+ */
+
case OP_READ_INTERNAL:
+ /* if we're loading a file, and in the file we evaluate something like:
+ *
+ * (let ()
+ * (set-current-input-port (open-input-file "tmp2.r5rs"))
+ * (close-input-port (current-input-port)))
+ * ... (with no reset of input port to its original value)
+ *
+ * the load process tries to read the loaded string, but the sc->input_port is now closed,
+ * and the original is inaccessible! So we get a segfault in token. We don't want to put
+ * a port_is_closed check there because token only rarely is in this danger. I think this
+ * is the only place where we can be about to call token, and someone has screwed up our port.
+ *
+ * We can't call read_error here because it assumes the input string is ok!
+ */
+
+ if (port_is_closed(sc->input_port))
+ return(s7_error(sc, sc->READ_ERROR, s7_cons(sc, make_protected_string(sc, "our input port got clobbered!"), sc->NIL)));
+
sc->tok = token(sc);
switch (sc->tok)
@@ -16957,10 +18171,23 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->x = car(sc->code);
if (is_syntax(sc->x))
{
+#if 0
+ /* (let () (define (if a) a) (if 1)) or (let let ((i 0)) (if (< i 3) (let (+ i 1)) i))
+ * but this slows us down by a huge amount (30%!) [I don't know why...]
+ */
+ if ((!(is_not_local(sc->x))) &&
+ (find_symbol(sc, sc->envir, sc->x) != sc->NIL))
+ {
+ push_stack(sc, opcode(OP_EVAL_ARGS), sc->NIL, sc->code);
+ sc->code = sc->x;
+ goto EVAL;
+ }
+#endif
sc->code = cdr(sc->code);
sc->op = (opcode_t)syntax_opcode(sc->x);
goto START;
}
+
push_stack(sc, opcode(OP_EVAL_ARGS), sc->NIL, sc->code);
sc->code = sc->x;
goto EVAL;
@@ -17066,7 +18293,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
NEW_CELL(sc, x);
car(x) = sc->value;
cdr(x) = sc->args;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
sc->args = x;
}
@@ -17256,19 +18483,19 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
if (is_immutable(z))
return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, s7_make_string(sc, "can't bind an immutable object: ~S"), z)));
+ make_list_2(sc, make_protected_string(sc, "can't bind an immutable object: ~S"), z)));
car(sc->y) = call_symbol_bind(sc, z, car(sc->y));
}
NEW_CELL(sc, y);
car(y) = z;
cdr(y) = car(sc->y);
- set_type(y, T_PAIR | T_IMMUTABLE | T_DONT_COPY);
+ set_type(y, T_PAIR | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
NEW_CELL(sc, x);
car(x) = y;
cdr(x) = car(sc->envir);
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
car(sc->envir) = x;
set_local(z);
@@ -17362,14 +18589,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case T_STRING: /* -------- string as applicable object -------- */
if (cdr(sc->args) != sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "string ref (via string as applicable object): ~A", sc->args));
+ return(s7_wrong_number_of_args_error(sc, "too many args for string ref (via string as applicable object): ~A", sc->args));
sc->value = string_ref_1(sc, sc->code, car(sc->args));
pop_stack(sc);
goto START;
case T_PAIR: /* -------- list as applicable object -------- */
if (cdr(sc->args) != sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "list ref (via list as applicable object): ~A", sc->args));
+ return(s7_wrong_number_of_args_error(sc, "too many args for list ref (via list as applicable object): ~A", sc->args));
/*
* I suppose we could take n args here = repeated list-refs
* ((list (list 1 2) 3) 0 0) -> 1 (caar)
@@ -17380,13 +18607,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case T_HASH_TABLE: /* -------- hash-table as applicable object -------- */
if (cdr(sc->args) != sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "hash-table ref (via hash-table as applicable object): ~A", sc->args));
+ return(s7_wrong_number_of_args_error(sc, "too many args for hash-table ref (via hash-table as applicable object): ~A", sc->args));
sc->value = hash_table_ref_1(sc, sc->code, car(sc->args));
pop_stack(sc);
goto START;
default:
- return(eval_error(sc, "attempt to apply ~S?", sc->code));
+ return(apply_error(sc, sc->code, sc->args));
}
/* ---------------- end OP_APPLY ---------------- */
@@ -17405,21 +18632,25 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!s7_is_list(sc, car(sc->code)))
{
- if (!s7_is_symbol(car(sc->code))) /* (lambda "hi" ...) */
- return(eval_error(sc, "lambda parameter ~S is not a symbol", car(sc->code)));
+ if (s7_is_constant(car(sc->code))) /* (lambda :a ...) */
+ return(eval_error(sc, "lambda parameter '~A is a constant", car(sc->code)));
- /* but we currently accept (lambda :hi 1) or (lambda (:hi) 1) or (lambda (:hi . :hi) 1)
- * (lambda i i . i) and (lambda (i i i i) (i)) and (lambda* ((i 1) i i) i)
- * (lambda quote i) (lambda (i . i) 1 . 2) (lambda : : . #()) (lambda : 1 . "")
+ /* we currently accept (lambda i i . i) (lambda quote i) (lambda : : . #()) (lambda : 1 . "")
+ * at this level, but when the lambda form is evaluated, it will trigger an error.
*/
}
else
{
- for (sc->x = car(sc->code); sc->x != sc->NIL; sc->x = cdr(sc->x))
- if ((!s7_is_symbol(sc->x)) && /* (lambda (a . b) 0) */
- ((!is_pair(sc->x)) || /* (lambda (a . 0.0) a) */
- (!s7_is_symbol(car(sc->x))))) /* (lambda ("a") a) or (lambda (a "a") a) */
- return(eval_error(sc, "lambda parameter ~S is not a symbol", sc->x));
+ for (sc->x = car(sc->code); is_pair(sc->x); sc->x = cdr(sc->x))
+ {
+ if (s7_is_constant(car(sc->x))) /* (lambda (pi) pi) */
+ return(eval_error(sc, "lambda parameter '~A is a constant", car(sc->x)));
+ if (symbol_is_in_list(sc, car(sc->x), cdr(sc->x))) /* (lambda (a a) ...) or (lambda (a . a) ...) */
+ return(eval_error(sc, "lambda parameter '~A is used twice in the lambda argument list", car(sc->x)));
+ }
+ if ((sc->x != sc->NIL) &&
+ (s7_is_constant(sc->x))) /* (lambda (a . 0.0) a) or (lambda (a . :b) a) */
+ return(eval_error(sc, "lambda :rest parameter '~A is a constant", sc->x));
}
sc->value = make_closure(sc, sc->code, sc->envir, T_CLOSURE);
pop_stack(sc);
@@ -17433,20 +18664,40 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!s7_is_list(sc, car(sc->code)))
{
- if (!s7_is_symbol(car(sc->code))) /* (lambda* "hi" ...) */
- return(eval_error(sc, "lambda* parameter ~S is not a symbol", car(sc->code)));
+ if (s7_is_constant(car(sc->code))) /* (lambda* :a ...) */
+ return(eval_error(sc, "lambda* parameter '~A is a constant", car(sc->code)));
}
else
{
- for (sc->x = car(sc->code); sc->x != sc->NIL; sc->x = cdr(sc->x))
- if ((!s7_is_symbol(sc->x)) &&
- ((!is_pair(sc->x)) ||
- ((!s7_is_symbol(car(sc->x))) &&
- ((!is_pair(car(sc->x))) || /* check for stuff like (lambda* (()) 1) (lambda* ((a . 0)) 1) etc */
- (!s7_is_symbol(caar(sc->x))) ||
- (cdar(sc->x) == sc->NIL) ||
- (cddar(sc->x) != sc->NIL)))))
- return(eval_error(sc, "lambda* parameter ~S is confused", sc->x));
+ for (sc->w = car(sc->code); is_pair(sc->w); sc->w = cdr(sc->w))
+ {
+ if (is_pair(car(sc->w)))
+ {
+ if (s7_is_constant(caar(sc->w))) /* (lambda* ((:a 1)) ...) */
+ return(eval_error(sc, "lambda* parameter '~A is a constant", caar(sc->w)));
+ if (symbol_is_in_list(sc, caar(sc->w), cdr(sc->w))) /* (lambda* ((a 1) a) ...) */
+ return(eval_error(sc, "lambda* parameter '~A is used twice in the argument list", caar(sc->w)));
+ if (!is_pair(cdar(sc->w))) /* (lambda* ((a . 0.0)) a) */
+ return(eval_error(sc, "lambda* parameter is a dotted pair? '~A", car(sc->w)));
+ if (cddar(sc->w) != sc->NIL) /* (lambda* ((a 0.0 "hi")) a) */
+ return(eval_error(sc, "lambda* parameter has multiple default values? '~A", car(sc->w)));
+ }
+ else
+ {
+ if (car(sc->w) != sc->KEY_REST)
+ {
+ if ((s7_is_constant(car(sc->w))) &&
+ (car(sc->w) != sc->KEY_KEY) &&
+ (car(sc->w) != sc->KEY_OPTIONAL)) /* (lambda* (pi) ...) */
+ return(eval_error(sc, "lambda* parameter '~A is a constant", car(sc->w)));
+ if (symbol_is_in_list(sc, car(sc->w), cdr(sc->w))) /* (lambda* (a a) ...) or (lambda* (a . a) ...) */
+ return(eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car(sc->w)));
+ }
+ }
+ }
+ if ((sc->w != sc->NIL) &&
+ (s7_is_constant(sc->w))) /* (lambda* (a . 0.0) a) or (lambda* (a . :b) a) */
+ return(eval_error(sc, "lambda* :rest parameter '~A is a constant", sc->w));
}
sc->value = make_closure(sc, sc->code, sc->envir, T_CLOSURE_STAR);
@@ -17496,6 +18747,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
(cddr(sc->code) != sc->NIL)) /* (define var 1 . 2) */
return(eval_error(sc, "define: more than 1 value? ~A", sc->code)); /* (define var 1 2) */
+ /* parameter error checks are handled by lambda/lambda* (see OP_LAMBDA above) */
if (is_pair(car(sc->code)))
{
sc->x = caar(sc->code);
@@ -17703,6 +18955,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
/* if unbound variable hook here, we need the binding, not the current value */
+ if (is_syntax(sc->code))
+ return(eval_error(sc, "set! ~A: this is not allowed for some reason", sc->code));
return(eval_error(sc, "set! ~A: unbound variable", sc->code));
@@ -17752,18 +19006,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
(!s7_is_symbol(car(sc->code))))
return(eval_error(sc, "let variable list is messed up or missing: ~A", sc->code));
- /* TODO: we're accepting these in let (should say "no exprs"):
- * (let () (define (hi) (+ 1 2)))
- * (let () (begin (define x 3)))
- * (let () 3 (begin (define x 3)))
- * (let () (define x 3))
- * (let () (if #t (define (x) 3)))
+ /* we accept these (other schemes complain, but I can't see why -- a no-op is the user's business!):
+ * (let () (define (hi) (+ 1 2)))
+ * (let () (begin (define x 3)))
+ * (let () 3 (begin (define x 3)))
+ * (let () (define x 3))
+ * (let () (if #t (define (x) 3)))
*
- * are these legal? (Guile sez "definition in expression context")
+ * similar cases:
* (case 0 ((0) (define (x) 3) (x)))
* (cond (0 (define (x) 3) (x)))
- *
- * and these look odd but we don't flag them as errors -- maybe they're ok
* (and (define (x) x) 1)
* (begin (define (x y) y) (x (define (x y) y)))
* (if (define (x) 1) 2 3)
@@ -18166,6 +19418,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
return(s7_error(sc, sc->SYNTAX_ERROR, /* (defmacro mac (1) ...) */
make_list_3(sc, make_protected_string(sc, "defmacro ~A argument name is not a symbol: ~S"), sc->x, sc->y)));
+ /* other parameter error checks are handled by lambda/lambda* (see OP_LAMBDA above) at macro expansion time */
+
if (cdr(sc->z) == sc->NIL) /* (defmacro hi ()) */
return(eval_error(sc, "defmacro ~A has no body?", sc->x));
@@ -18475,7 +19729,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
NEW_CELL(sc, x);
car(x) = sc->value;
cdr(x) = sc->args;
- set_type(x, T_PAIR);
+ set_type(x, T_PAIR | T_STRUCTURE);
sc->args = x;
}
sc->tok = token(sc);
@@ -18608,6 +19862,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* this works only if the backquote is right next to the #( of the read-time vector,
* and then only if the vector can be dealt with at read time. It doesn't seem
* very useful to me. To get a vector in a macro, use "vector", not "#()".
+ * It's also limited to 1-dimensional cases, since I think it's a bad idea to begin with.
*/
sc->value = make_list_3(sc, sc->APPLY, sc->VECTOR, g_quasiquote_2(sc, sc->value));
pop_stack(sc);
@@ -18627,7 +19882,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_READ_VECTOR:
- sc->value = g_vector(sc, sc->value);
+ if (sc->args == small_int(1))
+ sc->value = g_vector(sc, sc->value);
+ else sc->value = g_multivector(sc, (int)s7_integer(sc->args), sc->value);
+
+ if (sc->code != sc->NIL)
+ {
+ /* code = shared num to be assigned */
+ }
+
pop_stack(sc);
goto START;
@@ -18665,7 +19928,7 @@ static s7_scheme *clone_s7(s7_scheme *sc, s7_pointer vect)
new_sc->stack = vect;
new_sc->stack_start = vector_elements(vect);
new_sc->stack_end = new_sc->stack_start;
- new_sc->stack_size = INITIAL_STACK_SIZE;
+ new_sc->stack_size = vector_length(vect);
new_sc->stack_resize_trigger = (s7_pointer *)(new_sc->stack_start + new_sc->stack_size / 2);
new_sc->w = new_sc->NIL;
@@ -18677,13 +19940,17 @@ static s7_scheme *clone_s7(s7_scheme *sc, s7_pointer vect)
new_sc->value = new_sc->NIL;
new_sc->cur_code = ERROR_INFO_DEFAULT;
+ /* should threads share the current ports and associated stack?
+ * sc->input_port = sc->NIL;
+ * sc->input_port_stack = sc->NIL;
+ */
+
new_sc->temps_size = GC_TEMPS_SIZE;
new_sc->temps_ctr = 0;
new_sc->temps = (s7_pointer *)malloc(new_sc->temps_size * sizeof(s7_pointer));
for (i = 0; i < new_sc->temps_size; i++)
new_sc->temps[i] = new_sc->NIL;
- new_sc->circular_refs = (s7_pointer *)calloc(CIRCULAR_REFS_SIZE, sizeof(s7_pointer));
#if HAVE_PTHREADS
new_sc->key_values = sc->NIL;
@@ -18732,6 +19999,10 @@ static void mark_s7(s7_scheme *sc)
#if HAVE_PTHREADS
S7_MARK(sc->key_values);
#endif
+ S7_MARK(sc->input_port);
+ S7_MARK(sc->input_port_stack);
+ S7_MARK(sc->output_port);
+ S7_MARK(sc->error_port);
}
@@ -18802,17 +20073,24 @@ static void *run_thread_func(void *obj)
static s7_pointer g_make_thread(s7_scheme *sc, s7_pointer args)
{
- #define H_make_thread "(make-thread thunk) creates a new thread running thunk"
+ #define H_make_thread "(make-thread thunk (initial-stack-size 4000)) creates a new thread running thunk"
thred *f;
s7_pointer obj, vect, frame;
- int floc, vloc, oloc;
+ int floc, vloc, oloc, stack_size = INITIAL_STACK_SIZE;
if (!is_procedure(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-thread", 0, car(args), "a thunk"));
+ return(s7_wrong_type_arg_error(sc, "make-thread", 1, car(args), "a thunk"));
+
+ if (cdr(args) != sc->NIL)
+ {
+ if (!s7_is_integer(cadr(args)))
+ return(s7_wrong_type_arg_error(sc, "make-thread stack-size", 2, cadr(args), "an integer"));
+ stack_size = s7_integer(cadr(args));
+ }
frame = immutable_cons(sc, sc->NIL, sc->envir);
floc = s7_gc_protect(sc, frame);
- vect = s7_make_vector(sc, INITIAL_STACK_SIZE);
+ vect = s7_make_vector(sc, stack_size);
vloc = s7_gc_protect(sc, vect);
f = (thred *)calloc(1, sizeof(thred));
@@ -19030,7 +20308,7 @@ static s7_pointer g_make_thread_variable(s7_scheme *sc, s7_pointer args)
err = pthread_key_create(key, NULL);
if (err == 0)
return(s7_make_object(sc, key_tag, (void *)key));
- return(s7_error(sc, s7_make_symbol(sc, "thread-error"), make_list_1(sc, s7_make_string(sc, "make-thread-variable failed!?"))));
+ return(s7_error(sc, s7_make_symbol(sc, "thread-error"), make_list_1(sc, make_protected_string(sc, "make-thread-variable failed!?"))));
}
@@ -19038,7 +20316,7 @@ static s7_pointer get_key(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
if (args != sc->NIL)
return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, s7_make_string(sc, "thread variable is a function of no arguments: ~A ~A"), obj, args)));
+ make_list_3(sc, make_protected_string(sc, "thread variable is a function of no arguments: ~A ~A"), obj, args)));
return(s7_thread_variable_value(sc, obj));
}
@@ -20759,7 +22037,7 @@ static s7_pointer big_divide(s7_scheme *sc, s7_pointer args)
#if 0
-/* SOMEDAY: we need to catch gmp exceptions somehow: SIGFPE (exception=deliberate /0 -- see gmp/errno.c) */
+/* someday we need to catch gmp exceptions somehow: SIGFPE (exception=deliberate /0 -- see gmp/errno.c) */
#include <signal.h>
static void s7_sigfpe(int ignored)
@@ -22252,7 +23530,7 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
(mpfr_cmp(val, x1) <= 0)) ||
(mpfr_cmp_ui(e1, 0) == 0) ||
(mpfr_cmp_ui(e1p, 0) == 0))
- /* these last 2 are probably not needed -- they protect against running out of bits in the standard C case above */
+ /* these last 2 are probably not needed -- they protect against running out of bits in the non-gmp case above */
{
mpq_t *q;
q = (mpq_t *)malloc(sizeof(mpq_t));
@@ -23487,8 +24765,6 @@ s7_scheme *s7_init(void)
for (i = 0; i < sc->temps_size; i++)
sc->temps[i] = sc->NIL;
- sc->circular_refs = (s7_pointer *)calloc(CIRCULAR_REFS_SIZE, sizeof(s7_pointer));
-
sc->protected_objects_size = (int *)malloc(sizeof(int));
(*(sc->protected_objects_size)) = INITIAL_PROTECTED_OBJECTS_SIZE;
sc->protected_objects_loc = (int *)malloc(sizeof(int));
@@ -23505,7 +24781,7 @@ s7_scheme *s7_init(void)
/* keep the symbol table out of the heap */
sc->symbol_table = (s7_pointer)calloc(1, sizeof(s7_cell));
- set_type(sc->symbol_table, T_VECTOR | T_FINALIZABLE | T_DONT_COPY);
+ set_type(sc->symbol_table, T_VECTOR | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
vector_length(sc->symbol_table) = SYMBOL_TABLE_SIZE;
vector_elements(sc->symbol_table) = (s7_pointer *)malloc(SYMBOL_TABLE_SIZE * sizeof(s7_pointer));
s7_vector_fill(sc, sc->symbol_table, sc->NIL);
@@ -23671,7 +24947,7 @@ s7_scheme *s7_init(void)
sc->WRONG_TYPE_ARG_INFO = sc->NIL;
for (i = 0; i < 6; i++)
- sc->WRONG_TYPE_ARG_INFO = permanent_cons(sc->F, sc->WRONG_TYPE_ARG_INFO, T_PAIR);
+ sc->WRONG_TYPE_ARG_INFO = permanent_cons(sc->F, sc->WRONG_TYPE_ARG_INFO, T_PAIR | T_STRUCTURE);
s7_list_set(sc, sc->WRONG_TYPE_ARG_INFO, 0, s7_make_permanent_string("~A argument ~D, ~S, is ~A but should be ~A"));
sc->WRONG_NUMBER_OF_ARGS = s7_make_symbol(sc, "wrong-number-of-args");
@@ -23685,7 +24961,7 @@ s7_scheme *s7_init(void)
sc->OUT_OF_RANGE_INFO = sc->NIL;
for (i = 0; i < 5; i++)
- sc->OUT_OF_RANGE_INFO = permanent_cons(sc->F, sc->OUT_OF_RANGE_INFO, T_PAIR);
+ sc->OUT_OF_RANGE_INFO = permanent_cons(sc->F, sc->OUT_OF_RANGE_INFO, T_PAIR | T_STRUCTURE);
s7_list_set(sc, sc->OUT_OF_RANGE_INFO, 0, s7_make_permanent_string("~A argument ~D, ~S, is out of range (~A)"));
sc->KEY_KEY = s7_make_keyword(sc, "key");
@@ -23712,7 +24988,7 @@ s7_scheme *s7_init(void)
sc->SET = s7_make_symbol(sc, "set!");
typeflag(sc->SET) |= T_DONT_COPY;
- sc->s_function_args = permanent_cons(sc->F, sc->NIL, T_PAIR);
+ sc->s_function_args = permanent_cons(sc->F, sc->NIL, T_PAIR | T_STRUCTURE);
(*(sc->gc_off)) = false;
@@ -23720,7 +24996,6 @@ s7_scheme *s7_init(void)
/* pws first so that make-procedure-with-setter has a type tag */
s7_define_function(sc, "make-procedure-with-setter", g_make_procedure_with_setter, 2, 0, false, H_make_procedure_with_setter);
s7_define_function(sc, "procedure-with-setter?", g_is_procedure_with_setter, 1, 0, false, H_is_procedure_with_setter);
- s7_define_function(sc, "procedure-with-setter-setter-arity", g_procedure_with_setter_setter_arity, 1, 0, false, "kludge to get setter's arity");
pws_tag = s7_new_type("<procedure-with-setter>", pws_print, pws_free, pws_equal, pws_mark, pws_apply, pws_set);
@@ -23749,21 +25024,14 @@ s7_scheme *s7_init(void)
s7_define_function(sc, "symbol->keyword", g_symbol_to_keyword, 1, 0, false, H_symbol_to_keyword);
s7_define_function(sc, "keyword->symbol", g_keyword_to_symbol, 1, 0, false, H_keyword_to_symbol);
-
- s7_define_function(sc, "hash-table?", g_is_hash_table, 1, 0, false, H_is_hash_table);
- s7_define_function(sc, "make-hash-table", g_make_hash_table, 0, 1, false, H_make_hash_table);
- s7_define_function(sc, "hash-table-ref", g_hash_table_ref, 2, 0, false, H_hash_table_ref);
- s7_define_function(sc, "hash-table-set!", g_hash_table_set, 3, 0, false, H_hash_table_set);
- s7_define_function(sc, "hash-table-size", g_hash_table_size, 1, 0, false, H_hash_table_size);
-
- s7_define_function(sc, "port-line-number", g_port_line_number, 1, 0, false, H_port_line_number);
- s7_define_function(sc, "port-filename", g_port_filename, 1, 0, false, H_port_filename);
+ s7_define_function(sc, "port-line-number", g_port_line_number, 0, 1, false, H_port_line_number);
+ s7_define_function(sc, "port-filename", g_port_filename, 0, 1, false, H_port_filename);
s7_define_function(sc, "input-port?", g_is_input_port, 1, 0, false, H_is_input_port);
s7_define_function(sc, "output-port?", g_is_output_port, 1, 0, false, H_is_output_port);
s7_define_function(sc, "char-ready?", g_is_char_ready, 0, 1, false, H_is_char_ready);
s7_define_function(sc, "eof-object?", g_is_eof_object, 1, 0, false, H_is_eof_object);
- /* this should be named eof? (what isn't an object?) and we should also have (eof) -> #<eof> */
+ /* this should be named eof? (what isn't an object?) */
s7_define_function(sc, "current-input-port", g_current_input_port, 0, 0, false, H_current_input_port);
s7_define_function(sc, "set-current-input-port", g_set_current_input_port, 1, 0, false, H_set_current_input_port);
@@ -23854,17 +25122,21 @@ s7_scheme *s7_init(void)
s7_define_function(sc, "real?", g_is_real, 1, 0, false, H_is_real);
s7_define_function(sc, "complex?", g_is_complex, 1, 0, false, H_is_complex);
s7_define_function(sc, "rational?", g_is_rational, 1, 0, false, H_is_rational);
+ s7_define_function(sc, "nan?", g_is_nan, 1, 0, false, H_is_nan);
+ s7_define_function(sc, "infinite?", g_is_infinite, 1, 0, false, H_is_infinite);
s7_define_function(sc, "even?", g_is_even, 1, 0, false, H_is_even);
s7_define_function(sc, "odd?", g_is_odd, 1, 0, false, H_is_odd);
s7_define_function(sc, "zero?", g_is_zero, 1, 0, false, H_is_zero);
s7_define_function(sc, "positive?", g_is_positive, 1, 0, false, H_is_positive);
s7_define_function(sc, "negative?", g_is_negative, 1, 0, false, H_is_negative);
+
s7_define_function(sc, "inexact->exact", g_inexact_to_exact, 1, 0, false, H_inexact_to_exact);
s7_define_function(sc, "exact->inexact", g_exact_to_inexact, 1, 0, false, H_exact_to_inexact);
s7_define_function(sc, "exact?", g_is_exact, 1, 0, false, H_is_exact);
s7_define_function(sc, "inexact?", g_is_inexact, 1, 0, false, H_is_inexact);
s7_define_function(sc, "integer-length", g_integer_length, 1, 0, false, H_integer_length);
+ s7_define_function(sc, "integer-decode-float", g_integer_decode_float, 1, 0, false, H_integer_decode_float);
s7_define_function(sc, "logior", g_logior, 1, 0, true, H_logior);
s7_define_function(sc, "logxor", g_logxor, 1, 0, true, H_logxor);
s7_define_function(sc, "logand", g_logand, 1, 0, true, H_logand);
@@ -23930,8 +25202,6 @@ s7_scheme *s7_init(void)
s7_define_function(sc, "null?", g_is_null, 1, 0, false, H_is_null);
s7_define_function(sc, "list?", g_is_list, 1, 0, false, H_is_list);
s7_define_function(sc, "pair?", g_is_pair, 1, 0, false, H_is_pair);
- s7_define_function(sc, "reverse", g_reverse, 1, 0, false, H_reverse);
- s7_define_function(sc, "reverse!", g_reverse_in_place, 1, 0, false, H_reverse_in_place); /* used by Snd code */
s7_define_function(sc, "cons", g_cons, 2, 0, false, H_cons);
s7_define_function(sc, "car", g_car, 1, 0, false, H_car);
s7_define_function(sc, "cdr", g_cdr, 1, 0, false, H_cdr);
@@ -23981,6 +25251,8 @@ s7_scheme *s7_init(void)
s7_define_function(sc, "length", g_length, 1, 0, false, H_length);
s7_define_function(sc, "copy", g_copy, 1, 0, false, H_copy);
s7_define_function(sc, "fill!", g_fill, 2, 0, false, H_fill);
+ s7_define_function(sc, "reverse", g_reverse, 1, 0, false, H_reverse);
+ s7_define_function(sc, "reverse!", g_reverse_in_place, 1, 0, false, H_reverse_in_place); /* used by Snd code */
s7_define_function(sc, "vector?", g_is_vector, 1, 0, false, H_is_vector);
@@ -23989,15 +25261,21 @@ s7_scheme *s7_init(void)
s7_define_function(sc, "vector-fill!", g_vector_fill, 2, 0, false, H_vector_fill);
s7_define_function(sc, "vector", g_vector, 0, 0, true, H_vector);
s7_define_function(sc, "vector-length", g_vector_length, 1, 0, false, H_vector_length);
- s7_define_function(sc, "vector-ref", g_vector_ref, 2, 0, VECTOR_REST_ARGS, H_vector_ref);
- s7_define_function(sc, "vector-set!", g_vector_set, 3, 0, VECTOR_REST_ARGS, H_vector_set);
+ s7_define_function(sc, "vector-ref", g_vector_ref, 2, 0, true, H_vector_ref);
+ s7_define_function(sc, "vector-set!", g_vector_set, 3, 0, true, H_vector_set);
s7_define_function(sc, "make-vector", g_make_vector, 1, 1, false, H_make_vector);
-#if WITH_MULTIDIMENSIONAL_VECTORS
s7_define_function(sc, "vector-dimensions", g_vector_dimensions, 1, 0, false, H_vector_dimensions);
-#endif
s7_define_function(sc, "sort!", g_sort_in_place, 2, 0, false, H_sort_in_place);
+ s7_define_function(sc, "hash-table", g_hash_table, 0, 0, true, H_hash_table);
+ s7_define_function(sc, "hash-table?", g_is_hash_table, 1, 0, false, H_is_hash_table);
+ s7_define_function(sc, "make-hash-table", g_make_hash_table, 0, 1, false, H_make_hash_table);
+ s7_define_function(sc, "hash-table-ref", g_hash_table_ref, 2, 0, false, H_hash_table_ref);
+ s7_define_function(sc, "hash-table-set!", g_hash_table_set, 3, 0, false, H_hash_table_set);
+ s7_define_function(sc, "hash-table-size", g_hash_table_size, 1, 0, false, H_hash_table_size);
+
+
s7_define_function(sc, "call/cc", g_call_cc, 1, 0, false, H_call_cc);
s7_define_function(sc, "call-with-current-continuation", g_call_cc, 1, 0, false, H_call_cc);
s7_define_function(sc, "call-with-exit", g_call_with_exit, 1, 0, false, H_call_with_exit);
@@ -24022,6 +25300,9 @@ s7_scheme *s7_init(void)
s7_define_variable(sc, "*trace-hook*", sc->NIL);
s7_define_function(sc, "stacktrace", g_stacktrace, 0, 2, false, H_stacktrace);
+ s7_define_variable(sc, "*#readers*", sc->NIL);
+ sc->sharp_readers = symbol_global_slot(s7_make_symbol(sc, "*#readers*"));
+
s7_define_function(sc, "gc", g_gc, 0, 1, false, H_gc);
s7_define_function(sc, "quit", g_quit, 0, 0, false, H_quit);
@@ -24045,13 +25326,15 @@ s7_scheme *s7_init(void)
s7_define_function(sc, s_is_type_name, s_is_type, 2, 0, false, "internal object type check");
s7_define_function(sc, s_type_make_name, s_type_make, 2, 0, false, "internal object creation");
s7_define_function(sc, s_type_ref_name, s_type_ref, 2, 0, false, "internal object value");
- s7_define_function_star(sc, "make-type", g_make_type, "print equal getter setter length name", H_make_type);
+ s7_define_function_star(sc, "make-type", g_make_type, "print equal getter setter length name copy fill", H_make_type);
s7_define_variable(sc, "*features*", sc->NIL);
s7_define_variable(sc, "*load-path*", sc->NIL);
- s7_define_variable(sc, "*vector-print-length*", small_ints[8]);
s7_define_variable(sc, "*load-hook*", sc->NIL);
+ s7_define_variable(sc, "*vector-print-length*", small_ints[8]);
+ sc->vector_print_length = symbol_global_slot(s7_make_symbol(sc, "*vector-print-length*"));
+
s7_define_variable(sc, "*error-hook*", sc->NIL);
sc->error_info = s7_make_and_fill_vector(sc, ERROR_INFO_SIZE, ERROR_INFO_DEFAULT);
s7_define_constant(sc, "*error-info*", sc->error_info);
@@ -24064,7 +25347,7 @@ s7_scheme *s7_init(void)
lock_tag = s7_new_type("<lock>", lock_print, lock_free, lock_equal, NULL, NULL, NULL);
key_tag = s7_new_type("<thread-variable>", key_print, key_free, key_equal, NULL, get_key, set_key);
- s7_define_function(sc, "make-thread", g_make_thread, 1, 0, false, H_make_thread);
+ s7_define_function(sc, "make-thread", g_make_thread, 1, 1, false, H_make_thread);
s7_define_function(sc, "join-thread", g_join_thread, 1, 0, false, H_join_thread);
s7_define_function(sc, "thread?", g_is_thread, 1, 0, false, H_is_thread);
@@ -24079,9 +25362,7 @@ s7_scheme *s7_init(void)
g_provide(sc, make_list_1(sc, s7_make_symbol(sc, "threads")));
#endif
-#if WITH_MULTIDIMENSIONAL_VECTORS
- g_provide(sc, make_list_1(sc, s7_make_symbol(sc, "multidimensional-vectors")));
-#endif
+ g_provide(sc, make_list_1(sc, s7_make_symbol(sc, "multidimensional-vectors"))); /* backwards compatibility */
#if WITH_PROFILING
g_provide(sc, make_list_1(sc, s7_make_symbol(sc, "profiling")));
@@ -24106,7 +25387,6 @@ s7_scheme *s7_init(void)
s7_function_set_setter(sc, "list-ref", "list-set!");
s7_function_set_setter(sc, "string-ref", "string-set!");
-
{
int i, top;
#define LOG_LLONG_MAX 43.668274
@@ -24198,33 +25478,27 @@ s7_scheme *s7_init(void)
}
/* TODO: macroexpand and fully-expand are buggy
- * PERHAPS: method lists for c_objects
* TODO: function IO completed -- tie into scheme for tests?
+ * what is needed? -- scheme "soft-port"? C-side listener stuff? [snd-g|xlistener, and snd-xen -- 4 altogether]
+ * a guile sort port is a vector: write-char func, write-string, flush, read-char, close which seems completely random (why mix in/out?)
+ * function-port scheme side a port object with a callable function f(val choice)
+ * val = thing to write (or omitted on read side)
+ * choice = symbol of caller: 'read-byte or 'display for example
+ * this is then passed as the "port" arg to everything else
+ * what does this buy that string ports don't?
+ *
+ * s7 has input/output function ports with
+ * typedef enum {S7_READ, S7_READ_CHAR, S7_READ_LINE, S7_READ_BYTE, S7_PEEK_CHAR, S7_IS_CHAR_READY} s7_read_t;
+ * choosing the input function, but output is just the char-at-a-time case
*
- * TODO: how to connect from C to scheme-side make-type (defgenerator) [s7.html example]
- * :(let ((lst (make-type))) (procedure-source (car lst)))
- * (lambda ([arg]) ([?] 22 [arg]))
- * for C side to check/make/refer to these it needs the list returned by make-type and some identifying name?
- * s7_type_info(sc, var-of-that-type)?
- * does s7_object_type return the tag in this case? yes!
- * what else is needed -- access to the type table functions via the tag? or via the object?
+ * why not just tie in open-input|output-function on scheme side (distinguish read-char from read-line?)
+ * port_input_function would be a C->scheme wrapper and function held perhaps in port struct?
+ * then also open-input|output-string.
*
* SOMEDAY: eval-string (or eval?) with jump outside the eval (call/cc external) -> segfault or odd error
* (is this the case in dynamic-wind also?)
- * TODO: multidim vector constant input syntax
- *
- * SOMEDAY: there's a problem with very large vectors -- the GC does not notice how much RAM
- * they are taking up, and unless we call gc ourselves, we run out of memory. Since each
- * element has the vector pointer, the heap pointer, and the free-list pointer (worst case),
- * we're consuming 28 + 12 or 40 + 24 bytes per element!
- *
- * in CL: (make-array (list 2 3) :initial-element 0) -> #2A((0 0 0) (0 0 0))
- * in s7: (make-vector (list 2 3) 0) -> #(0 0 0 0 0 0)
*
- * so whatever constant vector syntax we choose should be used in the vector display code (vector_to_c_string)
- *
- * describe for vectors (dims), ports [describe_object for gdb, but also printout in vector case, vector_to_c_string]
- * also envs as debugging aids: how to show file/line tags as well
+ * envs as debugging aids: how to show file/line tags as well
* and perhaps store cur-code? __form__ ? make a cartoon of entire state? [need only the pointer, not a copy]
*
* this would be good in ws too -- a way to show which notes are active at a given point in the graph
@@ -24235,21 +25509,22 @@ s7_scheme *s7_init(void)
* and a way to jump into the error environment, cerror
* an error handling dialog (gui) in snd?
*
- * if *unbound-variable-hook* is set, and something actually unbound is encountered,
- * we seem to lose the file/line and so on?
+ * TODO: loading s7test simultaneously in several threads hangs after awhile in join_thread (call/cc?)
+ * why are list-ref tests getting 'wrong-type-arg?
+ * (qsort is not thread safe -- should we use guile's quicksort rewrite? libguile/quicksort.i.c)
+ * (ideally it would be wrapped inside the evaluator)
+ * perhaps use procedure-source?
*
- * inexact->exact: return closest exact float [or leave alone if not float]
- * exact->inexact: return closest float [or leave alone if float]
- * exact? #t if it was represented exactly and has not been touched by anything that might make it inexact (or is not a float)
- * inexact? == not exact?
- * in complex case, exact only if both real/imag are exact (ignore polar case I guess)
+ * :allow-other-keys in lambda*
+ * PERHAPS: pretty-printing in the REPL or in format (~W in CL I think)
+ * lint
+ * TODO: hash-table map and for-each should be entry-oriented, not alist-oriented
+ * TODO: clean up vct|list|vector-ref|set! throughout Snd (scm/html)
+ * generic append? slice? member? null?
+ * reverse for c|s_object
*
- * or perhaps inexact? either #f or the interval (as in interval arithmetic)
- * but then exact? is a problem -- we want to return the interval when not exact which scheme thinks is not false
- */
-
-/* OBJECTS...
- * perhaps: a method list in the object struct, (:methods to make-type, methods func to retrieve them -- an alist)
+ * PERHAPS: method lists for c_objects
+ * a method list in the object struct, (:methods to make-type, methods func to retrieve them -- an alist)
* catch 'wrong-type-arg-error in the evaluator,
* if 1st arg is v_object, look for method?
* this would not slow the rest of s7 down, but would let us handle anything
diff --git a/s7.h b/s7.h
index 65de2cc..6672e7e 100644
--- a/s7.h
+++ b/s7.h
@@ -1,8 +1,8 @@
#ifndef S7_H
#define S7_H
-#define S7_VERSION "1.54"
-#define S7_DATE "26-Apr-10"
+#define S7_VERSION "1.58"
+#define S7_DATE "2-June-10"
typedef long long int s7_Int;
@@ -29,7 +29,7 @@ typedef double s7_Double;
*
* s7 (scheme) variables:
*
- * *features* a list of symbols describing what is current available (initially '(s7)).
+ * *features* a list of symbols describing what is currently available (initially '(s7)).
* "provide" adds a symbol to the list,
* "provided?" returns #t if its symbol arg is in the list.
* *vector-print-length* how many elements of a vector are printed (initially 8)
@@ -41,6 +41,7 @@ typedef double s7_Double;
* *error-info* data describing last error (see below).
* *trace-hook* called upon trace (a function of two args)
* *unbound-variable-hook* called when an unbound symbol is accessed.
+ * *#readers* #... readers
*
* s7 constants:
*
@@ -112,7 +113,7 @@ s7_scheme *s7_init(void);
* s7_init creates the interpreter.
*/
-typedef s7_pointer (*s7_function)(s7_scheme *sc, s7_pointer args); /* obj = func(s7, args) -- args is a list of arguments */
+typedef s7_pointer (*s7_function)(s7_scheme *sc, s7_pointer args); /* that is, obj = func(s7, args) -- args is a list of arguments */
s7_pointer s7_f(s7_scheme *sc); /* #f */
@@ -321,8 +322,7 @@ int s7_vector_rank(s7_pointer vect);
s7_Int *s7_vector_dimensions(s7_pointer vec); /* dimensions */
s7_Int *s7_vector_offsets(s7_pointer vec); /* precalculated offsets to speed-up addressing */
- /* if s7 is built with multidimensional and applicable vectors,
- *
+ /*
* (vect i) is the same as (vector-ref vect i)
* (set! (vect i) x) is the same as (vector-set! vect i x)
* (vect i j k) accesses the 3-dimensional vect
@@ -372,16 +372,16 @@ const char *s7_get_output_string(s7_scheme *sc, s7_pointer out_port); /* (
/* don't free the string */
typedef enum {S7_READ, S7_READ_CHAR, S7_READ_LINE, S7_READ_BYTE, S7_PEEK_CHAR, S7_IS_CHAR_READY} s7_read_t;
-s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, char c, s7_pointer port));
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, unsigned char c, s7_pointer port));
s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port));
void *s7_port_data(s7_pointer port);
void *s7_port_set_data(s7_pointer port, void *stuff);
-char s7_read_char(s7_scheme *sc, s7_pointer port); /* (read-char port) */
-char s7_peek_char(s7_scheme *sc, s7_pointer port); /* (peek-char port) */
+int s7_read_char(s7_scheme *sc, s7_pointer port); /* (read-char port) */
+int s7_peek_char(s7_scheme *sc, s7_pointer port); /* (peek-char port) */
s7_pointer s7_read(s7_scheme *sc, s7_pointer port); /* (read port) */
void s7_newline(s7_scheme *sc, s7_pointer port); /* (newline port) */
-void s7_write_char(s7_scheme *sc, char c, s7_pointer port); /* (write-char c port) */
+void s7_write_char(s7_scheme *sc, int c, s7_pointer port); /* (write-char c port) */
void s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port); /* (write obj port) */
void s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port); /* (display obj port) */
const char *s7_format(s7_scheme *sc, s7_pointer args); /* (format ... */
@@ -758,6 +758,12 @@ void s7_mark_object(s7_pointer p);
*
* s7 changes
*
+ * 2-June: removed procedure-with-setter-setter-arity and folded that info into procedure-arity (use cdddr).
+ * 22-May: multidimensional vectors are no longer optional.
+ * 9-May: s7_read_char and s7_peek_char have to return an int, not a char (<eof>=-1, but 255 is a legit char).
+ * s7_write_char and s7_open_output_function have similar changes.
+ * 3-May: *#readers* to customize #... reading. Also nan? and infinite?.
+ * multidimensional vector constants using #nD(...): (#2D((1 2 3) (4 5 6)) 0 0) -> 1.
* 15-Apr: multiple-values support is now on the WITH_MULTIPLE_VALUES switch (default 1).
* 13-Apr: removed hash-table|vector|string-for-each -- these are handled by for-each.
* also removed vector-map -- map is generic, but always returns a list.
diff --git a/s7.html b/s7.html
index eb0b689..1452302 100644
--- a/s7.html
+++ b/s7.html
@@ -44,6 +44,7 @@ interpreter (see below). s7test.scm is a regression test for s7.
If you're running s7 in a context
that has getenv, file-exists?, and system (Snd for example), you can use s7-slib-init.scm
to gain easy access to slib (this init file is named "s7.init" in the slib distribution).
+A tarball is available: ftp://ccrma-ftp.stanford.edu/pub/Lisp/s7.tar.gz.
</p>
<p>
s7 is the default extension language of Snd and sndlib (http://ccrma.stanford.edu/software/snd/),
@@ -51,18 +52,19 @@ and Rick Taube's Common Music (commonmusic at sourceforge). There are X, Motif,
in libxm (in the Snd tarball, or at ftp://ccrma-ftp.stanford.edu/pub/Lisp/libxm.tar.gz).
</p>
-<p>s7 has full continuations, dynamic-wind, sort!,
+<p>Although it is a descendent of tinyScheme, s7 is closest as a Scheme dialect to Guile 1.8 (r5rs).
+It has full continuations, dynamic-wind, sort!,
error handling, ratios and complex numbers,
define-macro, keywords, hash-tables, block comments,
threads, multiprecision arithmetic for all numeric types,
-generalized set!, format, define*, and a host of other
-extensions of r5rs. It does not have syntax-rules or any of
+generalized set!, format, define*, and so on.
+It does not have syntax-rules or any of
its friends, and it does not think there is any such thing
-as an "inexact integer" (what were those guys smoking?).
+as an "inexact integer".
</p>
<p>This file assumes you know about Scheme and all its problems,
-and want a quick tour of where s7 is different.
+and want a quick tour of where s7 is different.
</p>
<ul>
@@ -142,6 +144,35 @@ Its argument is a string representing the desired number:
1.12312312312312312312312312300000000009E0
</pre>
+<small>
+<blockquote>
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>In the non-gmp case, if s7 is built using doubles (s7_Double in s7.h), the float "epsilon" is
+around (expt 2 -53), or about 1e-16. In the gmp case, it is around (expt 2 (- (bignum-precision))).
+So in the default case (precision = 128), using gmp:
+</p>
+<pre>
+&gt; (= 1.0 (+ 1.0 (expt 2.0 -128)))
+#t
+&gt; (= 1.0 (+ 1.0 (expt 2.0 -127)))
+#f
+</pre>
+<p>and in the non-gmp case:
+</p>
+<pre>
+&gt; (= 1.0 (+ 1.0 (expt 2 -53)))
+#t
+&gt; (= 1.0 (+ 1.0 (expt 2 -52)))
+#f
+</pre>
+
+</blockquote>
+</small>
+
+
</dd>
<br><br>
@@ -159,17 +190,17 @@ s7 includes:
</p>
<ul>
<li>sinh, cosh, tanh, asinh, acosh, atanh
-<li>logior, logxor, logand, lognot, ash, integer-length
+<li>logior, logxor, logand, lognot, ash, integer-length, integer-decode-float
<li>random
+<li>nan?, infinite?
</ul>
<p>
-The random function can take any numeric argument, including 0 (don't get me started...).
+The random function can take any numeric argument, including 0.
The following constants are predefined: pi, most-positive-fixnum, most-negative-fixnum.
Other math-related differences between s7 and r5rs:
</p>
<ul>
-<li>exact means integer or ratio, inexact means not exact.
-<li>rational? is a synonym for exact?.
+<li>rational? and exact mean integer or ratio (i.e. not floating point), inexact means not exact.
<li>floor, ceiling, truncate, and round return (exact) integer results.
<li>"#" does not stand for an unknown digit.
<li>the "@" complex number notation is not supported.
@@ -178,7 +209,6 @@ Other math-related differences between s7 and r5rs:
<li>lcm and gcd can take integer or ratio arguments.
<li>log takes an optional 2nd arg (the base).
<li>'.' and an exponent can occur in a number in any base.
-<li>NaN and inf handling is left up to the underlying C or C++.
<li>rationalize returns a ratio!
</ul>
<pre>
@@ -218,7 +248,7 @@ Other math-related differences between s7 and r5rs:
The exponent itself is always in base 10 (this follows gmp usage).
Since Scheme uses "@" for its useless polar notation, s7 doesn't use it for the exponent marker, but that
-means (string-&gt;number "1e1", 16) is ambiguous &mdash; is the "e" a digit or an exponent marker?
+means (string-&gt;number "1e1" 16) is ambiguous &mdash; is the "e" a digit or an exponent marker?
s7 could perhaps substitute "s" in this case, but instead it just prohibits exponents if the
radix is greater than 10.
<pre>
@@ -246,14 +276,88 @@ otherwise "rational?" is the same as "real?":
(not-s7-scheme)&gt; (rational? (sqrt 2))
#t
</pre>
-<p>I wonder if it might be more useful if
-"exact" meant "is represented exactly in the computer". We'd have integers and ratios exact;
+
+<p>Did "inexact" originally mean "floating point"? So 0.0 becomes an "inexact" integer (although it can be represented exactly in floating
+point).
++inf.0 is an integer &mdash;
+its fractional part is explicitly zero! But +nan.0...
+And then there's:
+</p>
+<pre>
+(not-s7-scheme)&gt; (integer? 9007199254740993.1)
+#t
+</pre>
+<p>
+When does this matter? I often need to index into a vector, but the index is inexact.
+In standard scheme:
+</p>
+<pre>
+(not-s7-scheme)&gt; (vector-ref #(0) (floor 0.1))
+ERROR: Wrong type (expecting exact integer): 0.0
+</pre>
+<p>Not to worry, I'll use inexact-&gt;exact!
+</p>
+<pre>
+(not-s7-scheme)&gt; (inexact-&gt;exact 0.1)
+3602879701896397/36028797018963968
+</pre>
+<p>So I end up using the verbose <code>(inexact-&gt;exact (floor ...))</code> everywhere, and even
+then I have no guarantee that I'll get a legal vector index.
+When I started work on s7, I thought perhaps
+"exact" could mean "is represented exactly in the computer". We'd have integers and ratios exact;
reals and complex exact if they are exactly
-represented in the current floating point implementation. So, 1+i is just as exact as 1;
+represented in the current floating point implementation.
0.0 and 0.5 might be exact if the printout isn't misleading, and 0.1 is inexact.
"integer?" and friends would refer instead to the programmer's point of view.
+That is, if the programmer uses 1 or if the thing prints as 1, it is the integer 1, whereas 1.0
+means floating point (not integer!).
+But then what would inexact-&gt;exact do?
+And to keep exactness in view, we'd have
+to monitor which operations introduce inexactness &mdash; a kind of interval arithmetic.
+I may remove the exact/inexact distinction from s7. The only useful part is
+exact-&gt;inexact, but perhaps it would be better named "-&gt;float"? Then if
+you have to run code that uses those guys:
+</p>
+<pre>
+ (define exact? rational?)
+ (define (inexact? x) (not (rational? x)))
+ (define inexact-&gt;exact rationalize) ; or floor
+ (define (exact-&gt;inexact x) (* x 1.0))
+</pre>
+<p>I'd also remove #i and #e &mdash; they're already useless because you can
+have any number after, for example, #b:
</p>
+<pre>
+ &gt; #b1.1
+ 1.5
+ &gt; #b1e2
+ 4.0
+ &gt; #o17.5+i
+ 15.625+1i
+</pre>
+
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<p>Should s7 predefine the numbers +inf.0, -inf.0, and nan.0? It doesn't currently, but you can
+get them via log:
+</p>
+<pre>
+(define -inf.0 (real-part (log 0.0)))
+(define +inf.0 (- (real-part (log 0.0))))
+(define nan.0 (/ +inf.0 +inf.0))
+</pre>
+<p>There are some situations involving NaNs and infinities that I believe the IEEE doesn't specify.
+I've made what I hope are reasonable choices:
+</p>
+<pre>
+&gt; (expt 1.0 +inf.0)
+1.0
+&gt; (sin nan.0)
+nan.0
+;; etc
+</pre>
</blockquote>
</small>
@@ -384,35 +488,10 @@ c
&gt; (a)
123
</pre>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>Another variant of define creates "curried" functions:
-</p>
-<pre>
-(define-macro (define-curried name-and-args . body)
- `(define ,@(let ((newlst `(begin ,@body)))
- (define (rewrap lst)
- (if (pair? (car lst))
- (begin
- (set! newlst (cons 'lambda (cons (cdr lst) (list newlst))))
- (rewrap (car lst)))
- (list (car lst) (list 'lambda (cdr lst) newlst))))
- (rewrap name-and-args))))
-&gt; (define-curried ((f a) b) (+ a b))
-f
-&gt; ((f 1) 2)
-3
-&gt; (define-curried (((((f a b) c) d e) f) g) (* a b c d e f g))
-f
-&gt; (((((f 1 2) 3) 4 5) 6) 7)
-5040
-</pre>
<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
<p>To try to catch what I believe are usually mistakes, I added two
error checks. One is triggered if you set the same parameter twice
in the same call, and the other if an unknown keyword is encountered
@@ -433,13 +512,43 @@ argument keyword: <code>(f :a :c)</code>, or make the default value a keyword:
<code>(define* (f (a :c) ...))</code>.
</p>
-<!--
-(define* (f a b . c) (list a b c))
-(f 1 2 :d 4)
-(1 2 (:d 4))
-(f :d 1)
-;f: unknown key: (:d 1) in (:d 1)
--->
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>s7's lambda* arglist handling is not the same as CL's lambda-list. First,
+you can have more than one :rest parameter:
+</p>
+<pre>
+&gt; ((lambda* ((a 1) :rest b :rest c) (list a b c)) 1 2 3 4 5)
+(1 (2 3 4 5) (3 4 5))
+</pre>
+<p>and second, the rest parameter, if any, takes up an argument slot just like any other
+argument:
+</p>
+<pre>
+&gt; ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32)
+(32 1 ())
+&gt; ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5)
+(1 3 (2 3 4 5))
+</pre>
+<p>CL would agree with the first case (if we used &amp;key for 'c'), but would give an error in the second.
+Of course, the major difference is that s7 keyword arguments don't insist that the key be present.
+The :rest argument is needed in cases like these because we can't use expression
+such as:
+</p>
+<pre>
+&gt; ((lambda* ((a 3) . b c) (list a b c)) 1 2 3 4 5)
+stray dot?
+</pre>
+<p>Yet another nit: the :rest argument is not considered a keyword argument, so
+</p>
+<pre>
+&gt; (define* (f :rest a) a)
+f
+&gt; (f :a 1)
+(:a 1)
+</pre>
</blockquote>
</small>
@@ -951,14 +1060,22 @@ when passed that object.
|#
</pre>
-<p>Currently make-type takes some optional arguments to specify other actions. I
-might change this to be an alist of (operation function) pairs, but for now,
-the optional (optkey) arguments are: print equal getter setter length name.
-The optional argument values are functions that specify how objects of the new type display themselves (print, 1 argument),
-check for equality (equal, 2 args, both will be of the new type), apply themselves to arguments, (getter, any number
-of arguments), respond to the generalized set! and length generic functions, and finally,
-one special case: name sets the type name (a string), which only matters if you're not specifying the print function.
-In each case, the argument is the value of the object, not the object itself.
+<p>Currently make-type takes some optional arguments to specify other actions.
+I might change this to be an alist of (operation function) pairs, but for now,
+the optional (optkey) arguments are: print equal getter setter length name copy fill.
+Except for the 'name' argument, these are functions.
+When these functions are called, the argument representing the object is
+the value of the object, not the object itself (see the examples below).
+If no print function is specified, the 'name' argument is used when the
+object is displayed.
+The 'equal' function checks two objects of the new type for equality.
+The 'getter' function applies the object to whatever arguments are
+passed, and the 'setter' function does the same in the context of set!.
+The 'length' function returns the length of the object's value.
+The 'copy function returns a new object of the same type with the copy
+function applied to the old object's value.
+The 'fill' function takes two arguments, the object and what to
+fill its value with.
So, remembering that (cadr type) is the make function:
</p>
<pre>
@@ -1086,8 +1203,8 @@ if you supply the length and getter functions to make-type.
&gt; (define-record point (x 0.0) (y 0.0))
point
&gt; (let ((pt (make-point 1.0)))
- (set! (point-y pt) 3.0)
- (list (point? pt) (point-x pt) (point-y pt)))
+ (set! (point-y pt) 3.0)
+ (list (point? pt) (point-x pt) (point-y pt)))
(#t 1.0 3.0)
</pre>
<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
@@ -1102,14 +1219,11 @@ point
(define float-vector #f)
(let* ((fv-type (<em class=red>make-type</em>
- :getter (lambda (obj index)
- (vector-ref obj index))
+ :getter vector-ref :length length :copy copy :fill fill!
:setter (lambda (obj index value)
(if (not (real? value))
(error 'wrong-type-arg-error "float-vector element must be real: ~S" value))
(vector-set! obj index (exact-&gt;inexact value)))
- :length (lambda (obj)
- (vector-length obj))
:name "float-vector"))
(fv? (car fv-type))
(make-fv (cadr fv-type))
@@ -1330,8 +1444,48 @@ it is set:
</td></tr></table>
</dt>
-<dd><p>Lists, strings, vectors, hash-tables, and any cooperating C or Scheme-defined objects
-are both applicable and settable. I think the syntax is pretty:
+<dd><p>procedure-with-setters can be viewed as one generalization of set!. Another
+treats objects as having predefined get and set functions. In s7
+lists, strings, vectors, hash-tables, and any cooperating C or Scheme-defined objects
+are both applicable and settable. I think the syntax is pretty (the less noise, the better!):
+</p>
+<pre>
+;; an example taken from R Cox's website
+
+(define dense (make-vector 128))
+(define sparse (make-vector 128))
+(define n 0)
+
+(define (add-member i)
+ (set! (dense n) i)
+ (set! (sparse i) n)
+ (set! n (+ n 1)))
+
+(define (is-member i)
+ (and (number? (sparse i))
+ (&lt; (sparse i) n)
+ (= (dense (sparse i)) i)))
+
+(define (clear-all) (set! n 0))
+
+(define (remove-member i)
+ (if (is-member i)
+ (begin
+ (let ((j (dense (- n 1))))
+ (set! (dense (sparse i)) j)
+ (set! (sparse j) (sparse i))
+ (set! n (- n 1))))))
+
+(add-member 32)
+1
+(add-member 12)
+2
+(is-member 14)
+#f
+(is-member 12)
+#t
+</pre>
+<p>Lists and hash-tables behave similarly:
</p>
<pre>
(let ((lst (list 1 2 3)))
@@ -1345,7 +1499,8 @@ are both applicable and settable. I think the syntax is pretty:
-&gt; 32
</pre>
<p>You can use list-ref and friends, of course, but just try to read any serious vector arithmetic code
-when it is buried in vector-refs and vector-set!s! set! can also apply to string-ref, list-ref, vector-ref,
+when it is buried in vector-refs and vector-set!s!
+set! can also apply to string-ref, list-ref, vector-ref,
hash-table-ref, car, and cdr. That is,
</p>
<pre>
@@ -1368,9 +1523,9 @@ so is <code>(cond (1 =&gt; "hi"))</code>!
<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>This syntax makes it easy to write generic functions.
+<p>The applicable object syntax makes it easy to write generic functions.
For example, s7test.scm has implementations of Common Lisp's sequence functions.
-length, copy, fill!, map and for-each are generic in this sense (map always returns a list).
+length, copy, reverse, fill!, map and for-each are generic in this sense (map always returns a list).
</p>
<pre>
&gt; (map (lambda (a b) (- a b)) (list 1 2) (vector 3 4))
@@ -1441,7 +1596,7 @@ We can write an FFT procedure that accepts lists or vectors:
</dt>
<dd><p>
-If s7 is built with WITH_MULTIDIMENSIONAL_VECTORS (the default), it supports
+s7 supports
vectors with any number of dimensions. It is here, in particular, that the generalized
set! stuff shines. make-vector's 2nd argument can be a list of dimensions, rather than
an integer (the one dimensional case):
@@ -1459,10 +1614,10 @@ vector-dimensions returns a list of the dimensions.
</p>
<pre>
&gt; (define v (make-vector '(2 3) 1.0))
- #(1.0 1.0 1.0 1.0 1.0 1.0) ; perhaps this should show the dimensional grouping
+ #2D((1.0 1.0 1.0) (1.0 1.0 1.0))
&gt; (set! (v 0 1) 2.0)
- #(1.0 2.0 1.0 1.0 1.0 1.0)
+ #2D((1.0 2.0 1.0) (1.0 1.0 1.0))
&gt; (v 0 1)
2.0
@@ -1482,12 +1637,12 @@ vector-dimensions returns a list of the dimensions.
(define (matrix-multiply A B)
;; assume square matrices and so on here for simplicity
(let* ((size (car (vector-dimensions A)))
- (C (make-vector (list size size) 0.0)))
+ (C (make-vector (list size size) 0)))
(do ((i 0 (+ i 1)))
((= i size) C)
(do ((j 0 (+ j 1)))
((= j size))
- (let ((sum 0.0))
+ (let ((sum 0))
(do ((k 0 (+ k 1)))
((= k size))
(set! sum (+ sum (* (A i k) (B k j)))))
@@ -1497,11 +1652,26 @@ vector-dimensions returns a list of the dimensions.
<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>I can't think of a nice syntax for a constant multidimensional vector. One idea is
-to mimic CL and use <code>#n(...)</code> where the n gives the number of dimensions, and the data is
-enclosed in n lists. But I tried this and it is too subtle. Perhaps #[...] would be better?
-Also, the vector printout should probably show the dimensions in some way.
+<p>Multidimensional vector constant syntax is modelled after CL: #nd(...) or #nD(...)
+signals that the lists specify the elements of an 'n' dimensional vector: <code>#2D((1 2 3) (4 5 6))</code>
+</p>
+<pre>
+ &gt; (vector-ref #2D((1 2 3) (4 5 6)) 1 2)
+ 6
+ &gt; (matrix-multiply #2d((-1 0) (0 -1)) #2d((2 0) (-2 2)))
+ #2D((-2 0) (2 -2))
+</pre>
+
+<p>If any dimension has 0 length, you get an n-dimensional empty vector. It is not
+equal to a 1-dimensional empty vector.
</p>
+<pre>
+ &gt; (make-vector '(10 0 3))
+ #3D()
+ &gt; (equal? #() #3D())
+ #f
+</pre>
+
</blockquote>
</small>
</dd>
@@ -1519,6 +1689,7 @@ Also, the vector printout should probably show the dimensions in some way.
<dd><br>
<ul>
<li>(make-hash-table (size 461))
+<li>(hash-table ...)
<li>(hash-table-ref ht obj)
<li>(hash-table-set! ht obj val)
<li>(hash-table? obj)
@@ -1533,6 +1704,51 @@ Also, the vector printout should probably show the dimensions in some way.
-&gt; 123
</pre>
+
+<p>hash-table parallels vector, list, and string. Its arguments are cons's containing the key/value pair.
+The result is a new hash-table with those values preinstalled: <code>(hash-table '("hi" . 32) '("ho" 1))</code>.
+</p>
+
+<small>
+<blockquote>
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>Since hash-tables accept the same applicable-object syntax that vectors use, we can
+treat a hash-table as, for example, a sparse array:
+</p>
+<pre>
+&gt; (define make-sparse-array make-hash-table)
+make-sparse-array
+&gt; (let ((arr (make-sparse-array)))
+ (set! (arr 1032) "1032")
+ (set! (arr -23) "-23")
+ (list (arr 1032) (arr -23)))
+("1032" "-23")
+</pre>
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>for-each and map accept hash-table arguments. Currently, the map or for-each function is passed the
+internal lists, rather than the key/value pairs (this is a bug; someday I'll fix it!).
+</p>
+<pre>
+(define (hash-table-&gt;alist table)
+ (let ((alist '()))
+ (for-each
+ (lambda (lst) ; this outer for-each should not be necessary
+ (for-each
+ (lambda (key.value)
+ (set! alist (cons key.value alist)))
+ lst))
+ table)
+ alist))
+</pre>
+
+</blockquote>
+</small>
+
</dd>
<br><br>
@@ -1685,6 +1901,13 @@ in Guile just returns 1! In Clisp, both cases return 1. This causes total conf
arg))))
(find-first-even-number (list 1 3 9 13 8 2 4)) -&gt; 8
+
+(define-macro (block . body)
+ `(<em class=red>call-with-exit</em>
+ (lambda (return)
+ ,@body)))
+
+(block (display "hi") (return 32) (display "oops")) -&gt; 32
</pre>
<p><b>continuation?</b> returns #t if its argument is a continuation,
as opposed to a normal procedure. I don't know why Scheme hasn't had this function from
@@ -1732,6 +1955,76 @@ it is continuing from the point of the error, but then fails to do so.
(format #f "~A ~D ~F" 'hi 123 3.14)
-&gt; "hi 123 3.140000"
</pre>
+
+
+<p>The format directives (tilde chars) are:</p>
+<pre>
+~% insert newline
+~&amp; insert newline if preceding char was not newline
+~~ insert tilde
+~\n (tilde followed by newline): trim white space
+~{ begin iteration (take arguments from a list)
+~} end iteration
+~^ jump out of iteration
+~* ignore the current argument
+~A object-&gt;string as in display
+~S object-&gt;string as in write
+~C print as character
+~P insert 's' if current argument is not 1 or 1.0 (use ~@P for "ies" or "y")
+~B number-&gt;string in base 2
+~O number-&gt;string in base 8
+~D number-&gt;string in base 10
+~X number-&gt;string in base 16
+~E float to string, (format #f "~E" 100.1) -&gt; "1.001000e+02", (%e in C)
+~F float to string, (format #f "~F" 100.1) -&gt; "100.100000", (%f in C)
+~G float to string, (format #f "~G" 100.1) -&gt; "100.1", (%g in C)
+~T insert spaces (padding)
+</pre>
+
+<p>The last eight take the usual numeric arguments to specify field width and precision.
+</p>
+
+<small>
+<blockquote>
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>Floats can occur in any base, so:
+</p>
+<pre>
+&gt; #xf.c
+15.75
+</pre>
+<p>This also affects format. In most schemes, <code>(format #f "~X" 1.25)</code> is
+an error (in CL, it is equivalent to using ~A which is perverse). But
+</p>
+<pre>
+&gt; (number-&gt;string 1.25 16)
+"1.4"
+</pre>
+<p>and there's no obvious way to get the same effect from format unless we accept
+floats in the "~X" case. So in s7,
+</p>
+<pre>
+&gt; (format #f "~X" 21)
+"15"
+&gt; (format #f "~X" 1.25)
+"1.4"
+&gt; (format #f "~X" 1.25+i)
+"1.4+1.0i"
+&gt; (format #f "~X" 21/4)
+"15/4"
+</pre>
+<p>That is, the output choice matches the argument.
+</p>
+
+</blockquote>
+</small>
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
<p>object-&gt;string returns the string representation of its argument, like format with ~S:
</p>
<pre>
@@ -1741,6 +2034,11 @@ it is continuing from the point of the error, but then fails to do so.
&gt; (format #f "~S" "hiho")
"\"hiho\""
</pre>
+
+<p>I added object-&gt;string before deciding to include format; it's no longer very useful. Similarly,
+string-&gt;list can be replaced by map, and list-&gt;string by string (using apply).
+</p>
+
</dd>
<br><br>
@@ -1764,7 +2062,14 @@ via the error function, and can be trapped and dealt with via catch.
(apply format (append (list #t) (cadr args)))))
-&gt; "abs: too many arguments: (1 2)"
+
+(<em class=red>catch</em> 'division-by-zero
+ (lambda () (/ 1.0 0.0))
+ (lambda args (string-&gt;number "inf.0")))
+
+-&gt; inf.0
</pre>
+
<p>
catch has 3 arguments: a tag indicating what error to catch (#t = anything),
the code (a thunk) that the catch is protecting, and the function to call
@@ -1776,7 +2081,7 @@ The default action (in the absence of any catch) is to treat the message as
a format control string, apply format to it and the other arguments, and
send that info to the current-error-port.
</p>
-<p>When an error is encountered, the variable *error-info* (a vector) contains
+<p>When an error is encountered, the variable <a name="errorinfo">*error-info*</a> (a vector) contains
additional info about that error:
</p>
<ul>
@@ -1799,7 +2104,7 @@ additional info about that error:
(stacktrace *error-info*)
</pre>
-<p>The variable *error-hook* provides a way to specialize error reporting.
+<p>The variable <a name="errorhook">*error-hook*</a> provides a way to specialize error reporting.
It is a function of 2 arguments, the values passed by the error function
(the error type and whatever other info accompanies it).
</p>
@@ -1830,19 +2135,44 @@ show the continuation stack.
<p>
See also trace below. There is a break macro defined in Snd (see snd-xen.c)
which allows you to stop at some point, then evaluate arbitrary expressions in that context.
-There's yet another hook, *unbound-variable-hook*, which is called when an unbound variable
+<!-- INDEX autoload:autoload -->
+<A NAME="autoload"></A>
+There's yet another hook, <a name="unboundvariablehook">*unbound-variable-hook*</a>, which is called when an unbound variable
is encountered (before the error is signalled). Its value is a function of one argument,
the unbound symbol. In Snd, this is used to implement autoloading:
</p>
<pre>
(set! <em class=red>*unbound-variable-hook*</em>
(lambda (sym)
+ ;; add your own symbol checks here
(let ((file (autoload-file (symbol-&gt;string sym))))
;; autoload-file is a Snd function that knows where a lot of Snd's scheme functions are
(if file (load file))
(symbol-&gt;value sym)))) ; this will return #&lt;undefined&gt; if we didn't find its source file
</pre>
+<!--
+<small>
+<blockquote>
+<p>Sly evil-doers can subvert this hook to provide something similar to Common Lisp's symbol-macros:
+</p>
+<pre>
+&gt; (set! *unbound-variable-hook*
+ (lambda (sym)
+ (if (eq? sym 'hiho)
+ (sin (random 1.0))
+ (symbol-&gt;value sym))))
+&lt;closure&gt;
+&gt; hiho
+0.46727567824396
+&gt; hiho
+0.64985453979392
+</pre>
+
+</blockquote>
+</small>
+-->
+
<p>The s7-built-in catch tags (error symbols) are 'wrong-type-arg, 'syntax-error, 'read-error, 'thread-error,
'out-of-memory, 'wrong-number-of-args, 'format-error, 'out-of-range, 'division-by-zero, 'io-error, and 'bignum-error.
</p>
@@ -1883,7 +2213,7 @@ the unbound symbol. In Snd, this is used to implement autoloading:
trace with no arguments causes everything to be traced, and untrace with no arguments
turns this off.
</p>
-<p>There is also a hook, *trace-hook*, a function of 2 arguments (the currently traced
+<p>There is also a hook, <a name="tracehook">*trace-hook*</a>, a function of 2 arguments (the currently traced
function and the list of current arguments). It is evaluated in the environment of the
function call (that is, global to the function, not the function's local environment).
</p>
@@ -1936,7 +2266,7 @@ are:
<li>read-byte and write-byte (binary IO) (named "read-u8" and "write-u8" in r6rs, I think)
<li>read-line (line-at-a-time reads)
</ul>
-<p>The variable *vector-print-length* sets
+<p>The variable <a name="vectorprintlength">*vector-print-length*</a> sets
the upper limit on how many vector elements are printed by object-&gt;string and format.
</p>
<p>When running s7 behind a GUI, you often want input to come from and output to go to
@@ -1945,6 +2275,22 @@ for an example.
</p>
<p>s7 also includes current-error-port and set-current-error-port.
</p>
+
+
+<small>
+<blockquote>
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>binary-io.scm in the Snd package has functions that read and write integers and floats in
+both endian choices in a variety of sizes. Besides read-byte and write-byte, it uses
+integer-decode-float, and the various bitwise operators.
+</p>
+
+</blockquote>
+</small>
+
</dd>
<br><br>
@@ -1960,7 +2306,7 @@ for an example.
<dd><p>procedure-source, procedure-arity, procedure-documentation, and help provide a look into a
scheme function.
procedure-documentation returns the documentation string associated with a procedure (the initial string in the
-function's body). procedure-arity returns a list describing the argument list of a function: '(required-args optional-args rest-arg).
+function's body). procedure-arity returns a list describing the argument list of a function: '(required-args optional-args rest-arg?).
procedure-source returns the source (as a list) of a procedure. procedure-environment returns
a procedure's environment.
</p>
@@ -1992,6 +2338,58 @@ write a function that tells us where the source is for a function:
"profile is at line 1048 of extensions.scm"
</pre>
+
+<small>
+<blockquote>
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>procedure-source returns the actual function source &mdash;
+more fun than a barrel of monkeys. Here is a circular function:
+</p>
+<pre>
+(define (cfunc)
+ (begin
+ (display "func! ")
+ #f))
+
+(let ((clst (<em class=red>procedure-source</em> cfunc)))
+ (set! (cdr (cdr (car (cdr (cdr clst))))) (cdr (car (cdr (cdr clst))))))
+
+(cfunc) ; displays "func! " until you kill it
+</pre>
+
+<p>Could you implement goto this way? Now we can write code that
+is not only unreadable, but unprintable!
+</p>
+
+<!--
+:(define q (list 1 2 3))
+q
+:(set! (cdr (cddr q)) q)
+#1#(1 2 3 #1#)
+:(set! (car q) 4)
+4
+:(set! q (cdr q))
+#1#(2 3 4 #1#)
+-->
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>Since define* accepts multiple rest arguments, perhaps procedure-arity should return that number,
+rather than a boolean. I haven't run into a case where it matters. If procedure-arity is passed
+a procedure-with-setter, it returns 6 values, rather than 3. The first 3 describe the "getter"
+and the following 3 describe the "setter". I wonder if it would be more consistent to use the
+name "procedure/setter" in place of "make-procedure-with-setter". (Its syntax is closer to
+vector than make-vector, for example).
+</p>
+
+</blockquote>
+</small>
+
+
</dd>
<br><br>
@@ -2295,8 +2693,8 @@ done!
</td></tr></table>
</dt>
-<dd><p><b>*load-path*</b> is a list of directories to search when loading a file.
-<b>*load-hook*</b> is a function called just before a file is loaded. Its argument is the filename.
+<dd><p><b><a name="loadpath">*load-path*</a></b> is a list of directories to search when loading a file.
+<b><a name="loadhook">*load-hook*</a></b> is a function called just before a file is loaded. Its argument is the filename.
While loading, port-filename and port-line-number (of the current-input-port) can tell you
where you are in the file.
</p>
@@ -2327,13 +2725,13 @@ the directory:
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>As in Common Lisp, <b>*features*</b> is a list describing what is currently loaded into s7. You can
+<p>As in Common Lisp, <b><a name="featureslist">*features*</a></b> is a list describing what is currently loaded into s7. You can
check it with the <b>provided?</b> function, or add something to it with <b>provide</b>. In my version of Snd,
at startup *features* is:
</p>
<pre>
&gt; *features*
-(snd10 snd snd-s7 snd-motif gsl alsa xm snd-ladspa run clm4 clm sndlib gmp multidimensional-vectors s7)
+(snd10 snd snd-s7 snd-motif gsl alsa xm snd-ladspa run clm4 clm sndlib gmp s7)
&gt; (provided? 'gmp)
#t
@@ -2349,6 +2747,44 @@ is for compatibility with Guile). These are also useful for in-line comments:
<code>(+ #| add |# 1 2)</code>.
</p>
+<p>Leaving aside these two cases, and the booleans, #f and #t, you can specify your own handlers for
+tokens that start with "#". <b><a name="sharpreaders">*#readers*</a></b> is a list of pairs: (char . func).
+"char" refers to the first character after the sharp sign (#). "func" is a function of
+one argument, the string that follows the #-sign up to the next delimiter. "func" is called
+when #&lt;char&gt; is encountered. If it returns something other than #f, the #-expression
+is replaced with that value. Scheme has several predefined #-readers for cases such
+as #b1, #\a, #i123, and so on, but you can override these if you like. If the string
+passed in is not the complete #-expression, the function can use read-char to get the
+rest. Say we'd like #t&lt;number&gt; to interpret the number in base 12:
+</p>
+
+<pre>
+(set! *#readers*
+ (cons (cons #\t (lambda (str)
+ (string-&gt;number (substring str 1) 12)))
+ *#readers*))
+
+&gt; #tb
+11
+&gt; #t11.3
+13.25
+</pre>
+<p>I use *#readers* primarily to implement a way to get the current line number and file name, along
+the lines of C's __LINE__ and __FILE__. port-line-number works if we're reading a file (during load
+for example), and *error-info* has the same information if an error happens. But during Snd's auto-test
+sequence, there are many cases that aren't errors, and the file is no longer being loaded, but
+I need to know where something unexpected happened. So:
+</p>
+<pre>
+(set! *#readers*
+ (cons (cons #\_ (lambda (str)
+ (if (string=? str "__line__")
+ (port-line-number)
+ (if (string=? str "__file__")
+ (port-filename)
+ #f))))
+ *#readers*))
+</pre>
<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
@@ -2406,9 +2842,9 @@ about stuff like <code>(let ((:hi 1)) :hi)</code>.
<p><b>help</b> tries to find information about its argument.</p>
<pre>
&gt; (help 'caadar)
-"(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
+"(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -&gt; 2"
</pre>
-<p>If the initial expression in a function body is a string constant, it is assumed to be a documentation string:
+<p>If the initial expression in a function body is a string constant, it is assumed to be a documentation string (accessible via help or procedure-documentation):
</p>
<pre>
(define (add1 a)
@@ -2453,6 +2889,8 @@ bind it to something else, which is asking for confusion).
<li>__func__ is the name (or name and location) of the function currently being defined or called (as in C).
<li>syntactic names can be values: <code>(define progn begin) (progn (display "progn!") (+ 3 4))</code> or <code>(define function lambda)</code>, etc
<li>begin returns the value of the last form (like progn); it can contain both definitions and other statements.
+<li>#&lt;unspecified&gt;, #&lt;eof&gt;, and #&lt;undefined&gt; are defined.
+<li>for-each and map accept different length arguments (operation stops when any argument reaches its end).
</ul>
<small>
@@ -2461,7 +2899,7 @@ bind it to something else, which is asking for confusion).
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
<p>Schemes vary in their treatment of (). s7 considers it a constant that evaluates to itself,
-so you rarely (never?) need to quote it. <code>(eq? () '())</code> is #t in s7.
+so you rarely (never?) need to quote it. <code>(eq? () '())</code> is #t.
</p>
<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
@@ -2471,6 +2909,7 @@ so you rarely (never?) need to quote it. <code>(eq? () '())</code> is #t in s7.
<code>(cond (1) (=&gt;))</code> is 1 in both, and
<code>(or 1 2 . 3)</code> is an
error in Guile, and 1 in s7!
+(Because it flushes trailing arguments, Guile returns 0 from <code>(* 0 +inf.0)</code>, but it should return NaN).
</p>
<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
<table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
@@ -2531,7 +2970,7 @@ ERROR: string is read-only: "symbol-&gt;string"
</pre>
<p>So both have a notion of immutable strings.
I wonder what other Scheme programmers (not implementors!) want in this situation.
-Currently in s7, there are no immutable list, string, or vector constants, and
+Currently, there are no immutable list, string, or vector constants, and
symbol-&gt;string
returns a copy of the string.
One simple way to ensure immutability is to use copy:
@@ -2541,6 +2980,29 @@ One simple way to ensure immutability is to use copy:
"hiho"
</pre>
+
+<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
+ <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<p>Another minor difference: s7 handles circular lists and vectors and dotted lists with its customary aplomb.
+You can pass them to memq, or print them, for example; you can even evaluate them.
+The print syntax is borrowed from CL:
+</p>
+<pre>
+&gt; (let ((lst (list 1 2 3)))
+ (set! (cdr (cdr (cdr lst))) lst)
+ lst)
+#1=(1 2 3 . #1#)
+</pre>
+<p>But should this syntax be readable as well? I'm inclined to say no because
+then it is part of the language, and it doesn't look like the rest of the language.
+(I think it's kind of ugly). Perhaps we could implement it via *#readers*.
+</p>
+<p>Length returns +inf.0 if passed a circular list, and returns a negative
+number if passed a dotted list (its absolute value is the list length not counting
+the final cdr). <code>(define (circular? lst) (infinite? (length lst)))</code>.
+</p>
+
</blockquote>
</small>
@@ -2563,7 +3025,7 @@ One simple way to ensure immutability is to use copy:
A CLM "instrument" is usually a do-loop running things like oscillators and envelopes
for zillions of sound samples. These calculations do not involve recursion, or
complex numbers, or fancy list processing, so it is not too hard to write an
-optimizer for them. In sndlib, that optimizer is called "run". It is a macro
+optimizer for them. In sndlib, that optimizer is called "run". It is a macro (in modern jargon, a JIT byte compiler)
that can be wrapped around any piece of Scheme code that you want to speed up.
If it can't optimize the code, it passes it to the s7 interpreter. If run is successful,
you will normally get a speed up by a factor of 10 to 30. For CLM instruments,
@@ -2662,7 +3124,6 @@ compile-time flags:
WITH_GMP 1 if you want multiprecision arithmetic (requires gmp, mpfr, and mpc, default is 0)
WITH_COMPLEX 1 if your compiler supports complex numbers
HAVE_COMPLEX_TRIG 1 if your math library has complex versions of the trig functions
- WITH_MULTIDIMENSIONAL_VECTORS 1 if you want multidimensional vectors (default is 1)
WITH_PROFILING 1 if you want profiling support (default is 0)
WITH_FORCE 1 if you want force and delay (default is 0)
WITH_MULTIPLE_VALUES 1 if you want multiple-values and its friends (default is 1)
@@ -3538,65 +3999,78 @@ int main(int argc, char **argv)
#include &lt;stdlib.h&gt;
#include &lt;stdio.h&gt;
#include &lt;string.h&gt;
+#include &lt;stdarg.h&gt;
#include "s7.h"
-static s7_pointer ref3(s7_scheme *sc, s7_pointer args)
+static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices, ...)
{
- /* (ref3 vec) prints out a multidimensional vector's contents, assuming a 3-D vector here */
- int x, y, z;
- s7_pointer *elements;
- s7_Int *offsets, *dimensions;
-
- elements = <em class=red>s7_vector_elements</em>(s7_car(args));
- dimensions = <em class=red>s7_vector_dimensions</em>(s7_car(args));
- offsets = <em class=red>s7_vector_offsets</em>(s7_car(args));
-
- for (z = 0; z &lt; dimensions[0]; z++)
- for (y = 0; y &lt; dimensions[1]; y++)
- for (x = 0; x &lt; dimensions[2]; x++)
- fprintf(stdout, "z: %d, y: %d, x: %d, (3dvec z y x): %s\n",
- z, y, x,
- s7_object_to_c_string(sc, elements[z * offsets[0] + y * offsets[1] + x * offsets[2]]));
-
- return(s7_car(args));
+ /* multivector_ref returns an element of a multidimensional vector */
+ int ndims;
+ ndims = <em class=red>s7_vector_rank</em>(vector);
+
+ if (ndims == indices)
+ {
+ va_list ap;
+ s7_Int index = 0;
+ va_start(ap, indices);
+
+ if (ndims == 1)
+ {
+ index = va_arg(ap, s7_Int);
+ va_end(ap);
+ return(s7_vector_ref(sc, vector, index));
+ }
+ else
+ {
+ int i;
+ s7_pointer *elements;
+ s7_Int *offsets, *dimensions;
+
+ elements = <em class=red>s7_vector_elements</em>(vector);
+ dimensions = <em class=red>s7_vector_dimensions</em>(vector);
+ offsets = <em class=red>s7_vector_offsets</em>(vector);
+
+ for (i = 0; i &lt; indices; i++)
+ {
+ int ind;
+ ind = va_arg(ap, int);
+ if ((ind &lt; 0) ||
+ (ind &gt;= dimensions[i]))
+ {
+ va_end(ap);
+ return(s7_out_of_range_error(sc,
+ "multivector_ref", i,
+ s7_make_integer(sc, ind),
+ "index should be between 0 and the dimension size"));
+ }
+ index += (ind * offsets[i]);
+ }
+ va_end(ap);
+ return(elements[index]);
+ }
+ }
+ return(s7_wrong_number_of_args_error(sc,
+ "multivector_ref: wrong number of indices: ~A",
+ s7_make_integer(sc, indices)));
}
int main(int argc, char **argv)
{
- s7_scheme *s7;
char buffer[512];
char response[1024];
+ s7_scheme *s7;
s7 = s7_init();
- s7_define_function(s7, "ref3", ref3, 1, 0, false, "(ref3 vect) prints the elements of the vector");
+ s7_eval_c_string(s7, "(define vect (make-vector '(2 3 4) 0))");
+ s7_eval_c_string(s7, "(set! (vect 1 1 1) 32)");
- while (1)
- {
- fprintf(stdout, "\n&gt; ");
- fgets(buffer, 512, stdin);
- if ((buffer[0] != '\n') ||
- (strlen(buffer) &gt; 1))
- {
- sprintf(response, "(write %s)", buffer);
- s7_eval_c_string(s7, response); /* evaluate input and write the result */
- }
- }
+ fprintf(stdout, "vect[0,0,0]: %s, vect[1,1,1]: %s\n",
+ s7_object_to_c_string(s7, <em class=red>multivector_ref</em>(s7, s7_name_to_value(s7, "vect"), 3, 0, 0, 0)),
+ s7_object_to_c_string(s7, <em class=red>multivector_ref</em>(s7, s7_name_to_value(s7, "vect"), 3, 1, 1, 1)));
}
-/*
- * &gt; (define vect (make-vector (list 1 2 3) 0))
- * vect
- * &gt; (set! (vect 0 1 1) 32)
- * 32
- * &gt; (ref3 vect)
- * z: 0, y: 0, x: 0, (3dvec z y x): 0
- * z: 0, y: 0, x: 1, (3dvec z y x): 0
- * z: 0, y: 0, x: 2, (3dvec z y x): 0
- * z: 0, y: 1, x: 0, (3dvec z y x): 0
- * z: 0, y: 1, x: 1, (3dvec z y x): 32
- * z: 0, y: 1, x: 2, (3dvec z y x): 0
- * #(0 0 0 0 32 0)
+/* vect[0,0,0]: 0, vect[1,1,1]: 32
*/
</pre>
</td></tr></table>
@@ -3899,6 +4373,5 @@ int main(int argc, char **argv)
<br><br>
-
</body>
</html>
diff --git a/s7test.scm b/s7test.scm
index b6b3cc1..5803aa7 100644
--- a/s7test.scm
+++ b/s7test.scm
@@ -11,13 +11,13 @@
;;; sacla test suite
;;; Kent Dybvig's "The Scheme Programming Language"
;;; Brad Lucier (who also pointed out many bugs)
-;;; numtst.c
;;; GSL tests
;;; Abramowitz and Stegun, "Handbook of Mathematical Functions"
;;; Weisstein, "Encyclopedia of Mathematics"
;;; the arprec package of David Bailey et al
;;; Maxima, William Schelter et al
;;; H Cohen, "A Course in Computational Algebraic Number Theory"
+;;; N Higham, "Accuracy and Stability of Numerical Algorithms"
;;; various mailing lists and websites (see individual cases below)
@@ -25,12 +25,9 @@
(define with-bigfloats (provided? 'gmp)) ; scheme real has any number of bits
(define with-bignum-function (defined? 'bignum)) ; this is a function that turns its string arg into a bignum
(define with-delay (provided? 'force)) ; delay and force
-(define with-error-data #f) ; collect numerical error info and report at end
-(define with-the-bug-finding-machine #t) ; run the machine (this variable can be set to the number of tries)
+(define with-the-bug-finding-machine #f) ; run the machine (this variable can be set to the number of tries)
; the default number of tries is 10000
(define with-test-at-random #f)
-(define with-immutable-constants #f) ; (string-set! "hiho" 1 #\X) etc
-
(define with-values (provided? 'values))
(define our-pi 3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930382)
@@ -45,7 +42,7 @@
(define (ok? tst result expected)
(if (not (equal? result expected))
- (format #t "~A got ~A but expected ~A~%~%" tst result expected)))
+ (format #t "~A: ~A got ~A but expected ~A~%~%" (port-line-number) tst result expected)))
(defmacro test (tst expected) ;(display tst) (newline)
`(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
@@ -55,14 +52,13 @@
`(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
(if (or (not result)
(eq? result 'error))
- (format #t "~A got ~A~%~%" ',tst result))))
-
+ (format #t "~A: ~A got ~A~%~%" (port-line-number) ',tst result))))
-;;; the error limits below are pretty expansive in some cases, so with-error-data
-;;; tries to keep a record of the worst case error for each operator. error-data
-;;; is a list: '(#(op worst-error worst-error-case) ...).
+(defmacro test-e (tst op arg) ;(display tst) (newline)
+ `(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
+ (if (not (eq? result 'error))
+ (format #t "~A: (~A ~A) got ~A but expected 'error~%~%" (port-line-number) ,op ,arg result))))
-(define error-data '())
(define (op-error op result expected)
@@ -102,27 +98,7 @@
(else (/ (magnitude (- result expected)) (max 0.001 (magnitude expected)))))))
-(define (check-error tst result expected)
- (if (and (number? result)
- (number? expected)
- (pair? tst))
- (let ((err (op-error (car tst) result expected)))
- (if (> err 0.0)
- (letrec ((find-if (lambda (pred l)
- (cond ((null? l) #f)
- ((pred (car l)) (car l))
- (else (find-if pred (cdr l)))))))
- (let* ((op (car tst))
- (err-op (find-if (lambda (n) (eq? op (vector-ref n 0))) error-data)))
- (if err-op
- (if (> err (vector-ref err-op 1))
- (begin
- (vector-set! err-op 1 err)
- (vector-set! err-op 2 tst)
- (vector-set! err-op 3 result)
- (vector-set! err-op 4 expected)))
- (set! error-data (cons (vector op err tst result expected) error-data)))))))))
-
+;;; relative error (/ (abs (- x res) (abs x)))
(define (types-consistent? n)
(not (or (and (integer? n)
@@ -156,10 +132,6 @@
(and (integer? x)
(not (= 1 (+ (if (even? x) 1 0)
(if (odd? x) 1 0)))))
- (not (= 1 (+ (if (zero? x) 1 0)
- (if (or (= x most-negative-fixnum)
- (> (magnitude x) 0))
- 1 0))))
(let ((type (+ (if (integer? x) 1 0)
(if (rational? x) 2 0)
(if (real? x) 4 0)
@@ -168,15 +140,10 @@
(not (= type 12))
(not (= type 14))
(not (= type 15))))
- (not (zero? (- x x))))) ; inf probably
+ (nan? x)))
(define (number-ok? tst result expected)
- (if (and with-error-data
- (number? result)
- (number? expected))
- (check-error tst result expected))
-
;; (number? +nan.0) returns #t in Guile and Gauche
(if (not (eq? result expected))
@@ -186,14 +153,10 @@
(or (not (number? result))
(our-nan? result)))
(and (rational? expected)
- (exact? expected)
(rational? result)
- (exact? result)
(not (= result expected)))
- (and (or (and (rational? expected)
- (exact? expected))
- (and (rational? result)
- (exact? result)))
+ (and (or (rational? expected)
+ (rational? result))
(real? expected)
(real? result)
(> (abs (- result expected)) 1.0e-12))
@@ -202,71 +165,65 @@
(and (number? result)
(not (types-consistent? result))))
(begin
- (format #t "~A got ~A~Abut expected ~A"
- tst result
+ (format #t "~A: ~A got ~A~Abut expected ~A"
+ (port-line-number) tst result
(if (and (rational? result) (not (rational? expected)))
- (format #f " (~A) " (exact->inexact result))
+ (format #f " (~A) " (* 1.0 result))
" ")
expected)
- (if (defined? 'format)
- (begin
- (if (and (not (number? expected))
- (not (eq? result expected)))
- (format #t ", (eq? ~A ~A) -> #f" result expected)
- (if (and (number? expected)
- (or (not (number? result))
- (our-nan? result)))
- (begin
- (if (not (number? result))
- (format #t ", (number? ~A) but not (number? ~A)" expected result)
- (format #t ", (number? ~A) but (nan? ~A)" expected result)))
- (if (and (rational? expected)
- (exact? expected)
- (rational? result)
- (exact? result)
- (not (= result expected)))
- (format #t ", exact results but not (= ~A ~A): ~A" expected result (= result expected))
- (if (and (or (and (rational? expected)
- (exact? expected))
- (and (rational? result)
- (exact? result)))
- (real? expected)
- (real? result)
- (> (abs (- result expected)) 1.0e-12))
- (format #t ", rational results but diff > 1e-12: ~A" (> (abs (- result expected)) 1.0e-12))
- (if (and (pair? tst)
- (< (op-error (car tst) result expected) 1.0e-6))
- (let ((n result))
- (format #t ", result not internally consistent")
- (if (and (integer? n)
- (or (not (= (denominator n) 1))
- (not (= n (numerator n)))
- (not (= (imag-part n) 0))
- (not (= (floor n) (ceiling n) (truncate n) (round n) n))
- (not (= n (real-part n)))))
- (format #t ", ~A integer but den: ~A, num: ~A, imag: ~A, real: ~A, floors: ~A ~A ~A ~A"
- n (denominator n) (numerator n) (imag-part n) (real-part n)
- (floor n) (ceiling n) (truncate n) (round n))
- (if (and (rational? n)
- (not (integer? n))
- (or (not (= (imag-part n) 0))
- (= (denominator n) 1)
- (= (denominator n) 0)
- (not (= n (real-part n)))
- (not (= n (/ (numerator n) (denominator n))))))
- (format #t ", ~A ratio but imag: ~A, den: ~A, real: ~A, ~A/~A=~A"
- n (imag-part n) (denominator n) (real-part n)
- (numerator n) (denominator n) (exact->inexact (/ (numerator n) (denominator n))))
- (if (and (real? n)
- (not (rational? n))
- (or (not (= (imag-part n) 0))
- (not (= n (real-part n)))))
- (format #t ", ~A real but rational: ~A, imag: ~A, real: ~A"
- n (rational? n) (imag-part n) (real-part n))
- (format #t ", ~A complex but real? ~A, imag: ~A, ~A+~A=~A"
- n (real? n) (imag-part n) (real-part n) (imag-part n)
- (+ (real-part n) (* 0+i (imag-part n)))))))))))))))
+ (if (and (not (number? expected))
+ (not (eq? result expected)))
+ (format #t ", (eq? ~A ~A) -> #f" result expected)
+ (if (and (number? expected)
+ (or (not (number? result))
+ (our-nan? result)))
+ (begin
+ (if (not (number? result))
+ (format #t ", (number? ~A) but not (number? ~A)" expected result)
+ (format #t ", (number? ~A) but (nan? ~A)" expected result)))
+ (if (and (rational? expected)
+ (rational? result)
+ (not (= result expected)))
+ (format #t ", exact results but not (= ~A ~A): ~A" expected result (= result expected))
+ (if (and (or (rational? expected)
+ (rational? result))
+ (real? expected)
+ (real? result)
+ (> (abs (- result expected)) 1.0e-12))
+ (format #t ", rational results but diff > 1e-12: ~A" (> (abs (- result expected)) 1.0e-12))
+ (if (and (pair? tst)
+ (< (op-error (car tst) result expected) 1.0e-6))
+ (let ((n result))
+ (format #t ", result not internally consistent")
+ (if (and (integer? n)
+ (or (not (= (denominator n) 1))
+ (not (= n (numerator n)))
+ (not (= (imag-part n) 0))
+ (not (= (floor n) (ceiling n) (truncate n) (round n) n))
+ (not (= n (real-part n)))))
+ (format #t ", ~A integer but den: ~A, num: ~A, imag: ~A, real: ~A, floors: ~A ~A ~A ~A"
+ n (denominator n) (numerator n) (imag-part n) (real-part n)
+ (floor n) (ceiling n) (truncate n) (round n))
+ (if (and (rational? n)
+ (not (integer? n))
+ (or (not (= (imag-part n) 0))
+ (= (denominator n) 1)
+ (= (denominator n) 0)
+ (not (= n (real-part n)))
+ (not (= n (/ (numerator n) (denominator n))))))
+ (format #t ", ~A ratio but imag: ~A, den: ~A, real: ~A, ~A/~A=~A"
+ n (imag-part n) (denominator n) (real-part n)
+ (numerator n) (denominator n) (* 1.0 (/ (numerator n) (denominator n))))
+ (if (and (real? n)
+ (not (rational? n))
+ (or (not (= (imag-part n) 0))
+ (not (= n (real-part n)))))
+ (format #t ", ~A real but rational: ~A, imag: ~A, real: ~A"
+ n (rational? n) (imag-part n) (real-part n))
+ (format #t ", ~A complex but real? ~A, imag: ~A, ~A+~A=~A"
+ n (real? n) (imag-part n) (real-part n) (imag-part n)
+ (+ (real-part n) (* 0+i (imag-part n)))))))))))))
(newline) (newline)))))
(defmacro num-test (tst expected) ;(display tst) (newline)
@@ -300,6 +257,19 @@
`(,op ,(recompose-1 (- n 1)))))
(recompose-1 n))
+(define-macro (with-evaluator . body)
+ (if (provided? 'threads)
+ `(join-thread (make-thread (lambda () ,@body) 200))
+ ''error)) ; yow! otherwise we get the error procedure, not the symbol 'error!
+
+(define-macro (test-w tst) ;(display "test-w: ") (display tst) (newline)
+ `(let* ((old-error-port (set-current-error-port (open-output-string)))
+ (result (with-evaluator (eval-string ,tst))))
+ (close-output-port (current-error-port))
+ (set-current-error-port old-error-port)
+ (if (or (not result)
+ (not (eq? result 'error)))
+ (format #t "~A: ~A got ~A~%~%" (port-line-number) ',tst result))))
@@ -362,6 +332,13 @@
;\;"#"#f
)#t)
+(test (+ #| this is a comment |# 2 #! and this is another !# 3) 5)
+(test (eq? (if #f #t) (if #f 3)) #t)
+
+(test (eq?) 'error)
+(test (eq? #t) 'error)
+(test (eq? #t #t #t) 'error)
+(test (eq? #f . 1) 'error)
(let ((things (vector #t #f #\space '() "" 0 1 3/4 1+i 1.5 '(1 .2) '#() (vector) (vector 1) (list 1) 'f 't #\t)))
(do ((i 0 (+ i 1)))
@@ -372,6 +349,13 @@
(format #t "(eq? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))
+;;; these are defined at user-level in s7 -- why are other schemes so coy about them?
+(test (eq? (if #f #f) #<unspecified>) #t)
+(test (eof-object? #<eof>) #t)
+(test (eq? (symbol->value '_?__undefined__?_) #<undefined>) #t)
+
+
+
(test (eqv? 'a 3) #f)
(test (eqv? #t 't) #f)
(test (eqv? "abs" 'abc) #f)
@@ -406,7 +390,7 @@
(test (eqv? (lambda () 1) (lambda () 1)) #f)
(test (let () (define (make-adder x) (lambda (y) (+ x y))) (eqv? (make-adder 1) (make-adder 1))) #f)
(test (eqv? 9/2 9/2) #t)
- ;(test (eqv? 3.4 (+ 3.0 0.4)) #t) ; can be fooled
+
(test (eqv? most-positive-fixnum most-positive-fixnum) #t)
(test (eqv? most-positive-fixnum most-negative-fixnum) #f)
(test (eqv? 9223372036854775807 9223372036854775806) #f)
@@ -429,7 +413,6 @@
(test (eqv? (cons 'a 'b) (cons 'a 'c)) #f)
(test (eqv? eqv? eqv?) #t)
- ;(test (let ((quote -)) (eqv? '1 1)) #f)
(test (eqv? '#(1) '#(1)) #f)
(test (eqv? '(1) '(1)) #f)
(test (eqv? '() '()) #t)
@@ -443,6 +426,10 @@
(if (eqv? (vector-ref things i) (vector-ref things j))
(format #t "(eqv? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))
+(test (eqv?) 'error)
+(test (eqv? #t) 'error)
+(test (eqv? #t #t #t) 'error)
+
(test (equal? 'a 3) #f)
(test (equal? #t 't) #f)
@@ -519,7 +506,6 @@
(test (let* ((x 1+i) (y x)) (equal? x y)) #t)
(test (let* ((x 3/4) (y x)) (equal? x y)) #t)
- ;(test (equal? 3.4 (+ 3.0 0.4)) #t)
(test (let ((x 3.141)) (equal? x x)) #t)
(test (equal? 3 3) #t)
(test (equal? 3 3.0) #f)
@@ -551,6 +537,9 @@
(if (equal? (vector-ref things i) (vector-ref things j))
(format #t "(equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))
+(test (equal?) 'error)
+(test (equal? #t) 'error)
+(test (equal? #t #t #t) 'error)
(test (boolean? #f) #t)
@@ -564,6 +553,7 @@
(test (boolean? 't) #f)
(test (boolean? (list)) #f)
(test ( boolean? #t) #t)
+(test (boolean? boolean?) #f)
(test ( ; a comment
boolean? ;;; and another
#t
@@ -578,6 +568,10 @@
(test (recompose 12 boolean? #f) #t)
+(test (boolean?) 'error)
+(test (boolean? #f #t) 'error)
+
+
(test (not #f) #t)
(test (not #t) #f)
@@ -599,6 +593,10 @@
(test (recompose 12 not #f) #f)
+(test (not) 'error)
+(test (not #f #t) 'error)
+
+
(test (symbol? 't) #t)
(test (symbol? "t") #f)
@@ -611,7 +609,13 @@
(test (symbol? '()) #f)
(test (symbol? #f) #f)
(test (symbol? 'car) #t)
+(test (symbol? car) #f)
(test (symbol? '#f) #f)
+(test (symbol? #()) #f)
+(test (symbol? :hi) #t)
+(test (symbol? hi:) #t)
+(test (symbol? :hi:) #t)
+(test (symbol? #b1) #f)
(test (symbol? 'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789) #t) ;M Gran
(test (symbol? (vector-ref '#(1 a 34) 1)) #t)
(test (if (symbol? '1+) (symbol? '0e) #t) #t)
@@ -622,6 +626,9 @@
(format #t "(symbol? ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1))))
+(test (symbol?) 'error)
+(test (symbol? 'hi 'ho) 'error)
+
(test (procedure? car) #t)
@@ -633,23 +640,18 @@
(test (let ((a (lambda (x) x))) (procedure? a)) #t)
(test (letrec ((a (lambda () (procedure? a)))) (a)) #t)
(test (let ((a 1)) (let ((a (lambda () (procedure? a)))) (a))) #f)
+(test (let () (define (hi) 1) (procedure? hi)) #t)
+(test (let () (define-macro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
(for-each
(lambda (arg)
(if (procedure? arg)
(format #t "(procedure? ~A) -> #t?~%" arg)))
- (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
+ (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f)))
+
+(test (procedure?) 'error)
+(test (procedure? abs car) 'error)
-(test (letrec* ((p (lambda (x)
- (+ 1 (q (- x 1)))))
- (q (lambda (y)
- (if (zero? y)
- 0
- (+ 1 (p (- y 1))))))
- (x (p 5))
- (y x))
- y)
- 5)
@@ -707,6 +709,32 @@
(if (not (char? (integer->char i)))
(format #t "(char? (integer->char ~A)) -> #f?~%" i)))
+(test (char?) 'error)
+(test (char? #\a #\b) 'error)
+(test (char? #\x65) #t)
+(test (char? #\x000000000065) #t)
+(test (char=? #\x+65 #\x0000000000065) #t)
+(test (char? #\x0) #t)
+(test (char? #\xff) #t)
+;; any larger number is a reader error
+
+(test-w "(char? #\\100)")
+(test-w "(char? #\\x-65)")
+(test-w "(char? #\\x6.5)")
+(test-w "(char? #\\x6/5)")
+(test-w "(char? #\\x6+i)")
+(test-w "(char? #\\x6asd)")
+(test-w "(char? #\\x6#)")
+
+(test (char=? #\x6a #\j) #t)
+
+(test (char? #\return) #t)
+(test (char? #\null) #t)
+(test (char? #\linefeed) #t)
+(test (char? #\tab) #t)
+(test (char? #\space) #t)
+
+
(num-test (let ((str (make-string 258 #\space)))
(do ((i 1 (+ i 1)))
((= i 256))
@@ -738,6 +766,12 @@
;; non-alpha chars are "unspecified" here
+ (test (char-upper-case? 1) 'error)
+ (test (char-upper-case?) 'error)
+ (test (char-upper-case? 1) 'error)
+ (test (char-upper-case?) 'error)
+ (test (char-upper-case? #\a #\b) 'error)
+
(test (char-lower-case? #\A) #f)
(test (char-lower-case? #\a) #t)
@@ -754,6 +788,12 @@
(format #t "(char-lower-case? ~A) -> #t?~%" arg)))
cap-a-to-z)
+ (test (char-lower-case? 1) 'error)
+ (test (char-lower-case?) 'error)
+ (test (char-lower-case? 1) 'error)
+ (test (char-lower-case?) 'error)
+ (test (char-lower-case? #\a #\b) 'error)
+
(test (char-upcase #\A) #\A)
(test (char-upcase #\a) #\A)
@@ -768,6 +808,7 @@
(test (char-upcase #\_) #\_)
(test (char-upcase #\space) #\space)
(test (char-upcase #\newline) #\newline)
+ (test (char-upcase #\null) #\null)
(for-each
(lambda (arg1 arg2)
@@ -785,6 +826,10 @@
(test (recompose 12 char-upcase #\a) #\A)
(test (reinvert 12 char-upcase char-downcase #\a) #\a)
+ (test (char-upcase) 'error)
+ (test (char-upcase #\a #\b) 'error)
+
+
(test (char-downcase #\A) #\a)
(test (char-downcase #\a) #\a)
@@ -807,7 +852,10 @@
a-to-z)
(test (recompose 12 char-downcase #\A) #\a)
-
+
+ (test (char-downcase) 'error)
+ (test (char-downcase #\a #\b) 'error)
+
(test (char-numeric? #\a) #f)
(test (char-numeric? #\5) #t)
@@ -832,7 +880,10 @@
(if (char-numeric? arg)
(format #t "(char-numeric? ~A) -> #t?~%" arg)))
a-to-z)
-
+
+ (test (char-numeric?) 'error)
+ (test (char-numeric? #\a #\b) 'error)
+
(test (char-whitespace? #\a) #f)
(test (char-whitespace? #\A) #f)
@@ -855,7 +906,10 @@
(if (char-whitespace? arg)
(format #t "(char-whitespace? ~A) -> #t?~%" arg)))
digits)
-
+
+ (test (char-whitespace?) 'error)
+ (test (char-whitespace? #\a #\b) 'error)
+
(test (char-alphabetic? #\a) #t)
(test (char-alphabetic? #\$) #f)
@@ -883,6 +937,19 @@
(if (not (char-alphabetic? arg))
(format #t "(char-alphabetic? ~A) -> #f?~%" arg)))
mixed-a-to-z)
+
+ (test (char-alphabetic?) 'error)
+ (test (char-alphabetic? #\a #\b) 'error)
+
+ (for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (test (op arg) 'error))
+ (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list char-upper-case? char-lower-case? char-upcase char-downcase char-numeric? char-whitespace? char-alphabetic?))
+
+
(test
(let ((unhappy '()))
@@ -920,7 +987,25 @@
unhappy)
'())
+
+ (for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (test (op #\a arg) 'error))
+ (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list char=? char<? char<=? char>? char>? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
+
+ (for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (test (op arg #\a) 'error))
+ (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list char=? char<? char<=? char>? char>? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
+
+
(test (char=? #\d #\d) #t)
(test (char=? #\A #\a) #f)
(test (char=? #\d #\x) #f)
@@ -934,6 +1019,7 @@
(let ((i (char->integer #\space)))
(test (char=? (integer->char i) #\space) #t))
(test (char=? (integer->char (char->integer #\")) #\") #t)
+ (test (char=? #\x65 #\e) #t)
(test (char=? #\d #\d #\d #\d) #t)
(test (char=? #\d #\d #\x #\d) #f)
@@ -942,6 +1028,10 @@
(test (apply char=? mixed-a-to-z) #f)
(test (apply char=? digits) #f)
(test (char=? #\d #\c #\d) #f)
+
+ (test (char=? #\a) 'error)
+ (test (char=?) 'error)
+ (test (char=? #\a 0) 'error)
(test (char<? #\z #\0) #f)
@@ -967,8 +1057,13 @@
(test (char<? #\b #\c #\a) #f)
(test (char<? #\B #\B #\A) #f)
(test (char<? #\b #\c #\e) #t)
+
+ (test (char<?) 'error)
+ (test (char<? #\b #\a "hi") 'error)
+ (test (char<? #\b #\a 0) 'error)
+
(test (char<=? #\d #\x) #t)
(test (char<=? #\d #\d) #t)
@@ -995,6 +1090,11 @@
(test (char<=? #\B #\B #\A) #f)
(test (char<=? #\b #\c #\e) #t)
+ (test (char<=? #\b #\a "hi") 'error)
+ (test (char<=? #\b #\a 0) 'error)
+ (test (char<=?) 'error)
+
+
(test (char>? #\e #\d) #t)
(test (char>? #\z #\a) #t)
@@ -1019,6 +1119,11 @@
(test (char>? #\d #\c #\c) #f)
(test (char>? #\B #\B #\C) #f)
(test (char>? #\b #\c #\e) #f)
+
+ (test (char>? #\a #\b "hi") 'error)
+ (test (char>? #\a #\b 0) 'error)
+ (test (char>?) 'error)
+
(test (char>=? #\e #\d) #t)
@@ -1043,6 +1148,11 @@
(test (char>=? #\d #\c #\c) #t)
(test (char>=? #\B #\B #\C) #f)
(test (char>=? #\b #\c #\e) #f)
+
+ (test (char>=? #\a #\b "hi") 'error)
+ (test (char>=? #\a #\b 0) 'error)
+ (test (char>=?) 'error)
+
(test (char-ci=? #\A #\B) #f)
@@ -1062,7 +1172,10 @@
(test (apply char-ci=? mixed-a-to-z) #f)
(test (apply char-ci=? digits) #f)
(test (char-ci=? #\d #\c #\d) #f)
+
+ (test (char-ci=?) 'error)
+
(test (char-ci<? #\A #\B) #t)
(test (char-ci<? #\a #\B) #t)
@@ -1079,6 +1192,8 @@
(test (char-ci<? #\a #\]) #t)
(test (char-ci<? #\z #\^) #t)
+ (test (char-ci<? #\b #\a "hi") 'error)
+ (test (char-ci<? #\b #\a 0) 'error)
;;; this tries them all:
;(do ((i 0 (+ i 1)))
@@ -1106,6 +1221,10 @@
(test (char-ci<? #\b #\C #\e) #t)
(test (char-ci<? #\3 #\? #\Z #\[) #t)
+ (test (char-ci>? #\a #\b "hi") 'error)
+ (test (char-ci>? #\a #\b 0) 'error)
+
+
(test (char-ci>? #\A #\B) #f)
(test (char-ci>? #\a #\B) #f)
@@ -1161,6 +1280,10 @@
(test (char-ci<=? #\b #\c #\C) #t)
(test (char-ci<=? #\b #\C #\e) #t)
+ (test (char-ci<=? #\b #\a "hi") 'error)
+ (test (char-ci<=? #\b #\a 0) 'error)
+
+
(test (char-ci>=? #\A #\B) #f)
(test (char-ci>=? #\a #\B) #f)
@@ -1188,10 +1311,14 @@
(test (char-ci>=? #\b #\c #\a) #f)
(test (char-ci>=? #\d #\D #\a) #t)
(test (char-ci>=? #\\ #\J #\+) #t)
-
+
+ (test (char-ci>=? #\a #\b "hi") 'error)
+ (test (char-ci>=? #\a #\b 0) 'error)
+
) ; end let with a-to-z
+
(test (integer->char (char->integer #\.)) #\.)
(test (integer->char (char->integer #\A)) #\A)
(test (integer->char (char->integer #\a)) #\a)
@@ -1199,6 +1326,27 @@
(test (reinvert 12 integer->char char->integer 60) 60)
+(test (char->integer 33) 'error)
+(test (char->integer) 'error)
+(test (integer->char) 'error)
+(test (integer->char (expt 2 31)) 'error)
+(test (integer->char (expt 2 32)) 'error)
+(test (integer->char 12 14) 'error)
+(test (char->integer #\a #\b) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (char->integer arg) 'error))
+ (list -1 1 0 123456789 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (integer->char arg) 'error))
+ (list -1 123456789 -123456789 #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+
;;; --------------------------------------------------------------------------------
@@ -1218,6 +1366,11 @@
(test (string? arg) #f))
(list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+(test (string?) 'error)
+(test (string? "hi" "ho") 'error)
+(test (string? #\null) #f)
+
+
(test (string=? "foo" "foo") #t)
(test (string=? "foo" "FOO") #f)
@@ -1237,6 +1390,7 @@
(test (string=? "foo" "foo" "") #f)
(test (string=? "foo" "foo" "fOo") #f)
+(test (string=? "foo" "FOO" 1.0) 'error)
(test (let ((str (string #\" #\1 #\\ #\2 #\"))) (string=? str "\"1\\2\"")) #t)
(test (let ((str (string #\\ #\\ #\\))) (string=? str "\\\\\\")) #t)
@@ -1244,7 +1398,31 @@
(test (let ((str (string #\\ #\"))) (string=? str "\\\"")) #t)
(test (let ((str (string #\space #\? #\)))) (string=? str " ?)")) #t)
(test (let ((str (string #\# #\\ #\t))) (string=? str "#\\t")) #t)
-(test (let ((str (string #\# #\\ #\t))) (string-length str)) 3)
+
+(test (string=? (string) "") #t)
+(test (string=? (string) (make-string 0)) #t)
+(test (string=? (string-copy (string)) (make-string 0)) #t)
+(test (string=? "" (make-string 0)) #t)
+(test (string=? "" (string-append)) #t)
+(test (string=? (string #\space #\newline) " \n") #t)
+
+(test (string=? "......" "...\ ...") #t)
+(test (string=? "......" "...\
+...") #t)
+(test (string=? "" "\ \ \ \ \ \ \ ") #t)
+(test (string=? "\n" (string #\newline)) #t)
+(test (string=? "\
+\
+\
+\
+" "") #t)
+(test (string=? "" (string #\null)) #t) ; ??
+(test (string=? (string #\null #\null) (string #\null)) #t) ; ?? their lengths are different!
+(test (string=? "" "asd") #f)
+(test (string=? "asd" "") #f)
+(test (string=? "xx" (make-string 2 #\x) (string #\x #\x) (list->string (list #\x #\x)) (substring "axxb" 1 3) (string-append "x" "x")) #t)
+
+
(test (string<? "aaaa" "aaab") #t)
@@ -1278,6 +1456,9 @@
(test (string<? "foo" "foo" "") #f)
(test (string<? "foo" "foo" "fOo") #f)
+(test (string<? "foo" "fo" 1.0) 'error)
+
+
(test (string>? "aaab" "aaaa") #t)
(test (string>? "aaaaa" "aaaa") #t)
(test (string>? "" "abcdefgh") #f)
@@ -1310,6 +1491,8 @@
(test (string>? "foo" "foo" "") #f)
(test (string>? "foo" "foo" "fOo") #f)
+(test (string>? "foo" "fooo" 1.0) 'error)
+
(test (string<=? "aaa" "aaaa") #t)
@@ -1343,6 +1526,9 @@
(test (string<=? "foo" "foo" "") #f)
(test (string<=? "foo" "foo" "fooo") #t)
+(test (string<=? "foo" "fo" 1.0) 'error)
+
+
(test (string>=? "aaaaa" "aaaa") #t)
(test (string>=? "aaaa" "aaaa") #t)
@@ -1378,6 +1564,9 @@
(test (string>=? "foo" "foo" "") #t)
(test (string>=? "foo" "foo" "fo") #t)
+(test (string>=? "fo" "foo" 1.0) 'error)
+
+
(test (string-ci=? "A" "B") #f)
(test (string-ci=? "a" "B") #f)
@@ -1397,6 +1586,9 @@
(test (string-ci=? "foo" "foo" "") #f)
(test (string-ci=? "foo" "Foo" "fOo") #t)
+(test (string-ci=? "foo" "GOO" 1.0) 'error)
+
+
(test (string-ci<? "a" "Aa") #t)
(test (string-ci<? "A" "B") #t)
@@ -1426,6 +1618,9 @@
(test (string-ci<? "NX7" "-;h>P" "DMhk3Bg") #f)
(test (string-ci<? "+\\mZl" "bE7\\e(HaW5CDXbPi@U_" "B_") #t)
+(test (string-ci<? "foo" "fo" 1.0) 'error)
+
+
(test (string-ci>? "Aaa" "AA") #t)
(test (string-ci>? "A" "B") #f)
@@ -1455,6 +1650,9 @@
(test (string-ci>? "ZNiuEa@/V" "KGbKliYMY" "9=69q3ica" ":]") #f)
(test (string-ci>? "^" "aN@di;iEO" "7*9q6uPmX9)PaY,6J" "15vH") #t)
+(test (string-ci>? "foo" "fooo" 1.0) 'error)
+
+
(test (string-ci<=? "A" "B") #t)
(test (string-ci<=? "a" "B") #t)
@@ -1482,6 +1680,9 @@
(test (string-ci<=? "78mdL82*" "EFaCrIdm@_D+" "eMu\\@dSSY") #t)
(test (string-ci<=? "`5pNuFc3PM<rNs" "e\\Su_raVNk6HD" "vXnuN7?S0?S(w+M?p") #f)
+(test (string-ci<=? "fOo" "fo" 1.0) 'error)
+
+
(test (string-ci>=? "A" "B") #f)
(test (string-ci>=? "a" "B") #f)
@@ -1511,6 +1712,61 @@
(test (string-ci>=? "tF?8`Sa" "NIkMd7" "f`" "1td-Z?teE" "-ik1SK)hh)Nq].>") #t)
(test (string-ci>=? "Z6a8P" "^/VpmWwt):?o[a9\\_N" "8[^h)<KX?[utsc") #f)
+(test (string-ci>=? "fo" "foo" 1.0) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (string=? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string<? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string>? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string<=? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string>=? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-ci=? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+(for-each
+ (lambda (arg)
+ (test (string-ci<? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-ci>? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-ci<=? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-ci>=? "hi" arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
(test (string-length "abc") 3)
(test (string-length "") 0)
@@ -1528,20 +1784,42 @@
(test (string-length "\\\\\\\"") 4)
(test (string-length "A ; comment") 11)
(test (string-length "#| comment |#") 13)
+(test (let ((str (string #\# #\\ #\t))) (string-length str)) 3)
+(test (string-length "#\\(") 3)
+(test (string-length ")()") 3)
+(test (string-length "(()") 3)
+(test (string-length "(string #\\( #\\+ #\\space #\\1 #\\space #\\3 #\\))") 44)
+(test (string-length) 'error)
+(test (string-length "hi" "ho") 'error)
+(test (string-length "..\ ..") 4)
+(test (string-length (string #\null)) 1) ; ??
+(test (string-length (string #\null #\null)) 2) ; ??
+(test (string-length (string #\null #\newline)) 2) ; ??
-(test (string=? (string) "") #t)
-(test (string=? (string) (make-string 0)) #t)
-(test (string=? (string-copy (string)) (make-string 0)) #t)
-(test (string=? "" (make-string 0)) #t)
-(test (string=? "" (string-append)) #t)
+(for-each
+ (lambda (arg)
+ (test (string-length arg) 'error))
+ (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+(for-each
+ (lambda (arg)
+ (test (string #\a arg) 'error))
+ (list '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
(test (string) "")
(test (string #\a #\b #\c) "abc")
(test (string #\a) "a")
-(test (string=? (string #\space #\newline) " \n") #t)
+(test (map string '(#\a #\b)) '("a" "b"))
+(test (map string '(#\a #\b) '(#\c #\d)) '("ac" "bd"))
+(test (map string '(#\a #\b #\c) '(#\d #\e #\f) '(#\g #\h #\i)) '("adg" "beh" "cfi"))
+(test (map string "abc" "def" "ghi") '("adg" "beh" "cfi"))
+(test (string #\" #\# #\") "\"#\"")
+(test (string #\\ #\\ #\# #\\ #\# #\#) "\\\\#\\##")
+(test (string #\' #\' #\` #\") '"''`\"")
+;;; some schemes accept \' and other such sequences in a string, but the spec only mentions \\ and \"
+(test (string '()) 'error)
(test (make-string 0) "")
@@ -1550,6 +1828,25 @@
(test (make-string 3 #\space) " ")
(test (let ((hi (make-string 3 #\newline))) (string-length hi)) 3)
+(test (make-string -1) 'error)
+(test (make-string 2 #\a #\b) 'error)
+(test (make-string) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (make-string 3 arg) 'error))
+ (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (make-string arg #\a) 'error))
+ (list #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (make-string arg) 'error))
+ (list #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
(test (string-ref "abcdef-dg1ndh" 0) #\a)
@@ -1557,15 +1854,67 @@
(test (string-ref "abcdef-dg1ndh" 6) #\-)
(test (string-ref "\"\\\"" 1) #\\)
(test (string-ref "\"\\\"" 2) #\")
+(test (string-ref "12\ 34" 2) #\3)
(test (let ((str (make-string 3 #\x))) (set! (string-ref str 1) #\a) str) "xax")
+(test (string-ref "abcdef-dg1ndh" 20) 'error)
+(test (string-ref "abcdef-dg1ndh") 'error)
+(test (string-ref "abcdef-dg1ndh" -3) 'error)
+(test (string-ref) 'error)
+(test (string-ref 2) 'error)
+(test (string-ref "\"\\\"" 3) 'error)
+(test (string-ref "" 0) 'error)
+(test (string-ref "" 1) 'error)
+(test (string-ref "hiho" (expt 2 32)) 'error)
+(test (char=? (string-ref (string #\null) 0) #\null) #t)
+(test (char=? (string-ref (string #\newline) 0) #\newline) #t)
+(test (char=? (string-ref (string #\space) 0) #\space) #t)
+
+(for-each
+ (lambda (arg)
+ (test (string-ref arg 0) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-ref "hiho" arg) 'error))
+ (list #\a -1 123 4 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(test ("hi" 1) #\i)
+(test (("hi" 1) 0) 'error)
+(test ("hi" 1 2) 'error)
+(test ("" 0) 'error)
+(test (set! ("" 0) #\a) 'error)
+(test (set! ("hi" 1 2) #\a) 'error)
+(test (set! ("hi" 1) #\a #\b) 'error)
+
+
(test (let ((hi (string-copy "hi"))) (string-set! hi 0 #\H) hi) "Hi")
(test (let ((hi (string-copy "hi"))) (string-set! hi 1 #\H) hi) "hH")
(test (let ((hi (string-copy "\"\\\""))) (string-set! hi 0 #\a) hi) "a\\\"")
(test (let ((hi (string-copy "\"\\\""))) (string-set! hi 1 #\a) hi) "\"a\"")
(test (let ((hi (string #\a #\newline #\b))) (string-set! hi 1 #\c) hi) "acb")
+(test (string-copy "ab") "ab")
+(test (string-copy "") "")
+(test (string-copy "\"\\\"") "\"\\\"")
+(test (let ((hi "abc")) (eq? hi (string-copy hi))) #f)
+(test (let ((hi (string-copy (make-string 8 (integer->char 0))))) (string-fill! hi #\a) hi) "aaaaaaaa") ; is this result widely accepted?
+(test (string-copy (string-copy (string-copy "a"))) "a")
+(test (string-copy (string-copy (string-copy ""))) "")
+
+(test (string-copy) 'error)
+(test (string-copy "hi" "ho") 'error)
+
+(for-each
+ (lambda (arg)
+ (test (string-copy arg) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(test (length (string-copy (string #\null))) 1)
+
+
(let ((str (make-string 10 #\x)))
(string-set! str 3 (integer->char 0))
@@ -1578,7 +1927,9 @@
(test (string=? str "xxxxaxxxxx") #t))
(test (string-set! "hiho" 1 #\c) #\c)
-(test (string-fill! "hiho" #\c) #\c)
+(test (set! ("hi" 1 2) #\i) 'error)
+(test (set! ("hi" 1) "ho") 'error)
+(test (set! ("hi") #\i) 'error)
(test (let ((hi (make-string 3 #\a)))
(string-set! hi 1 (let ((ho (make-string 4 #\x)))
@@ -1587,6 +1938,63 @@
hi)
"axa")
+(test (string-set! "hiho" (expt 2 32) #\a) 'error)
+
+(test (let ((hi (string-copy "hi"))) (string-set! hi 2 #\H) hi) 'error)
+(test (let ((hi (string-copy "hi"))) (string-set! hi -1 #\H) hi) 'error)
+(test (let ((g (lambda () "***"))) (string-set! (g) 0 #\?)) #\?)
+(test (string-set! "" 0 #\a) 'error)
+(test (string-set! "" 1 #\a) 'error)
+(test (string-set! (string) 0 #\a) 'error)
+(test (string-set! (symbol->string 'lambda) 0 #\a) #\a)
+(test (let ((ho (make-string 0 #\x))) (string-set! ho 0 #\a) ho) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (string-set! arg 0 #\a) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-set! "hiho" arg #\a) 'error))
+ (list #\a -1 123 4 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-set! "hiho" 0 arg) 'error))
+ (list 1 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+
+(test (string-fill! "hiho" #\c) #\c)
+(test (string-fill! "" #\a) #\a)
+(test (string-fill! "hiho" #\a) #\a)
+(test (let ((g (lambda () "***"))) (string-fill! (g) #\?)) #\?)
+(test (string-fill!) 'error)
+(test (string-fill! "hiho" #\a #\b) 'error)
+
+(test (let ((hi (string-copy "hi"))) (string-fill! hi #\s) hi) "ss")
+(test (let ((hi (string-copy ""))) (string-fill! hi #\x) hi) "")
+(test (let ((str (make-string 0))) (string-fill! str #\a) str) "")
+(test (let ((hi (make-string 8 (integer->char 0)))) (string-fill! hi #\a) hi) "aaaaaaaa") ; is this result widely accepted?
+(test (recompose 12 string-copy "xax") "xax")
+(test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! a #\a) a) hi)) "aaa")
+(test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! hi a)) #\a) hi) "aaa")
+(test (let ((str (string #\null #\null))) (fill! str #\x) str) "xx")
+
+(for-each
+ (lambda (arg)
+ (test (let ((hiho "hiho")) (string-fill! hiho arg) hiho) 'error))
+ (list 1 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string-fill! arg #\a) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
(test (substring "ab" 0 0) "")
(test (substring "ab" 1 1) "")
@@ -1602,10 +2010,50 @@
(string-set! str1 1 #\x))
(string=? str "012345"))
#t)
+(test (substring (substring "hiho" 0 2) 1) "i")
+(test (substring (substring "hiho" 0 2) 2) "")
+(test (substring (substring "hiho" 0 2) 0 1) "h")
+(test (substring "hi\nho" 3 5) "ho")
+(test (substring (substring "hi\nho" 1 4) 2) "h")
+(test (substring (substring "hi\nho" 3 5) 1 2) "o")
+(test (substring "hi\"ho" 3 5) "ho")
+(test (substring (substring "hi\"ho" 1 4) 2) "h")
+(test (substring (substring "hi\"ho" 3 5) 1 2) "o")
+(test (substring "01\ \ 34" 2) "34")
+
(test (recompose 12 (lambda (a) (substring a 0 3)) "12345") "123")
(test (reinvert 12 (lambda (a) (substring a 0 3)) (lambda (a) (string-append a "45")) "12345") "12345")
+(test (substring "ab" 0 3) 'error)
+(test (substring "ab" 3 3) 'error)
+(test (substring "ab" 2 3) 'error)
+(test (substring "" 0 1) 'error)
+(test (substring "" -1 0) 'error)
+(test (substring "abc" -1 0) 'error)
+(test (substring "hiho" (expt 2 32) (+ 2 (expt 2 32))) 'error)
+(test (substring) 'error)
+(test (substring "hiho" 0 1 2) 'error)
+(test (substring "1234" -1 -1) 'error)
+(test (substring "1234" 1 0) 'error)
+(test (substring "" most-positive-fixnum 1) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (substring "hiho" arg 0) 'error))
+ (list "hi" #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (substring "hiho" 1 arg) 'error))
+ (list "hi" #\a 0 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (substring arg 1 2) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
(test (string-append "hi" "ho") "hiho")
(test (string-append "hi") "hi")
@@ -1619,6 +2067,7 @@
(test (let ((hi "hi")) (let ((ho (string-append hi))) (eq? hi ho))) #f)
(test (let ((hi "hi")) (let ((ho (string-append hi))) (string-set! ho 0 #\a) hi)) "hi")
(test (let ((hi "hi")) (set! hi (string-append hi hi hi hi)) hi) "hihihihi")
+(test (string-append '()) 'error)
(num-test (letrec ((hi (lambda (str n)
(if (= n 0)
@@ -1650,16 +2099,11 @@
(test (recompose 12 (lambda (a) (string-append a "x")) "a") "axxxxxxxxxxxx")
(test (recompose 12 (lambda (a) (string-append "x" a)) "a") "xxxxxxxxxxxxa")
-
-
-(test (let ((hi (string-copy "hi"))) (string-fill! hi #\s) hi) "ss")
-(test (let ((hi (string-copy ""))) (string-fill! hi #\x) hi) "")
-(test (let ((str (make-string 0))) (string-fill! str #\a) str) "")
-(test (let ((hi (make-string 8 (integer->char 0)))) (string-fill! hi #\a) hi) "aaaaaaaa") ; is this result widely accepted?
-(test (recompose 12 string-copy "xax") "xax")
-(test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! a #\a) a) hi)) "aaa")
-(test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! hi a)) #\a) hi) "aaa")
-
+(test (string-append "hi" 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (string-append "hiho" arg) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
(test (let ((str (make-string 4 #\x))
@@ -1685,19 +2129,12 @@
"1h2i3h4o")
-(test (string-copy "ab") "ab")
-(test (string-copy "") "")
-(test (string-copy "\"\\\"") "\"\\\"")
-(test (let ((hi "abc")) (eq? hi (string-copy hi))) #f)
-(test (let ((hi (string-copy (make-string 8 (integer->char 0))))) (string-fill! hi #\a) hi) "aaaaaaaa") ; is this result widely accepted?
-(test (string-copy (string-copy (string-copy "a"))) "a")
-(test (string-copy (string-copy (string-copy ""))) "")
-
-
-
(test (string->list "abc") (list #\a #\b #\c))
(test (string->list "") '())
- ;(test (string->list (make-string 3 (integer->char 0))) '()) ; others return a list of #\nul or #\null
+(test (string->list (make-string 0)) '())
+(test (string->list (string #\null)) '()) ; should this be '(#\null) ? -- this is what Guile returns
+(test (string->list (string)) '())
+(test (string->list (substring "hi" 0 0)) '())
(test (string->list (list->string (list #\a #\b #\c))) (list #\a #\b #\c))
(test (string->list (list->string '())) '())
(test (list->string (string->list "abc")) "abc")
@@ -1717,13 +2154,94 @@
(test (list->string (list #\" #\# #\")) "\"#\"")
(test (list->string (list #\\ #\\ #\# #\\ #\# #\#)) "\\\\#\\##")
(test (list->string (list #\' #\' #\` #\")) '"''`\"")
-(test (string #\" #\# #\") "\"#\"")
-(test (string #\\ #\\ #\# #\\ #\# #\#) "\\\\#\\##")
-(test (string #\' #\' #\` #\") '"''`\"")
-;;; some schemes accept \' and other such sequences in a string, but the spec only mentions \\ and \"
(test (reinvert 12 string->list list->string "12345") "12345")
+(test (string->list) 'error)
+(test (list->string) 'error)
+(test (string->list "hi" "ho") 'error)
+(test (list->string '() '(1 2)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (string->list arg) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->string x)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (list->string arg) 'error))
+ (list "hi" #\a 1 ''foo '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+#|
+(define (all-strs len file)
+ (let* ((funny-chars (list #\` #\# #\, #\@ #\' #\" #\. #\( #\) #\\))
+ (num-chars (length funny-chars)))
+ (let ((ctrs (make-vector len 0)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i (expt num-chars len)))
+ (let ((carry #t))
+ (do ((k 0 (+ k 1)))
+ ((or (= k len)
+ (not carry)))
+ (vector-set! ctrs k (+ 1 (vector-ref ctrs k)))
+ (if (= (vector-ref ctrs k) num-chars)
+ (vector-set! ctrs k 0)
+ (set! carry #f)))
+
+ (let ((strlst '()))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (let ((c (list-ref funny-chars (vector-ref ctrs k))))
+ (set! strlst (cons c strlst))))
+
+ (let ((str (list->string strlst)))
+ (format file "(test (and (string=? ~S (string ~{#\\~C~^ ~})) (equal? '~A (string->list ~S))) #t)~%" str strlst strlst str))))))))
+
+(call-with-output-file "strtst.scm"
+ (lambda (p)
+ (do ((len 3 (+ len 1)))
+ ((= len 5))
+ (all-strs len p))))
+
+(load "strtst.scm")
+|#
+
+(test (and (string=? "\"" (string #\")) (equal? '(#\") (string->list "\""))) #t)
+(test (and (string=? "#\\" (string #\# #\\)) (equal? '(#\# #\\) (string->list "#\\"))) #t)
+(test (and (string=? "#(" (string #\# #\()) (equal? '(#\# #\() (string->list "#("))) #t)
+(test (and (string=? "\"@" (string #\" #\@)) (equal? '(#\" #\@) (string->list "\"@"))) #t)
+(test (and (string=? "\";" (string #\" #\;)) (equal? '(#\" #\;) (string->list "\";"))) #t)
+(test (and (string=? ")(" (string #\) #\()) (equal? '(#\) #\() (string->list ")("))) #t)
+(test (and (string=? "`)#" (string #\` #\) #\#)) (equal? '(#\` #\) #\#) (string->list "`)#"))) #t)
+(test (and (string=? "##\\" (string #\# #\# #\\)) (equal? '(#\# #\# #\\) (string->list "##\\"))) #t)
+(test (and (string=? "#\"(" (string #\# #\" #\()) (equal? '(#\# #\" #\() (string->list "#\"("))) #t)
+(test (and (string=? "#.@" (string #\# #\. #\@)) (equal? '(#\# #\. #\@) (string->list "#.@"))) #t)
+(test (and (string=? ",`@" (string #\, #\` #\@)) (equal? '(#\, #\` #\@) (string->list ",`@"))) #t)
+(test (and (string=? "',@" (string #\' #\, #\@)) (equal? '(#\' #\, #\@) (string->list "',@"))) #t)
+(test (and (string=? "\"#@" (string #\" #\# #\@)) (equal? '(#\" #\# #\@) (string->list "\"#@"))) #t)
+(test (and (string=? "\")\"" (string #\" #\) #\")) (equal? '(#\" #\) #\") (string->list "\")\""))) #t)
+(test (and (string=? ")#(" (string #\) #\# #\()) (equal? '(#\) #\# #\() (string->list ")#("))) #t)
+(test (and (string=? "`(,@" (string #\` #\( #\, #\@)) (equal? '(#\` #\( #\, #\@) (string->list "`(,@"))) #t)
+(test (and (string=? "`)#\"" (string #\` #\) #\# #\")) (equal? '(#\` #\) #\# #\") (string->list "`)#\""))) #t)
+(test (and (string=? "#\"'#" (string #\# #\" #\' #\#)) (equal? '(#\# #\" #\' #\#) (string->list "#\"'#"))) #t)
+(test (and (string=? "#(@\\" (string #\# #\( #\@ #\\)) (equal? '(#\# #\( #\@ #\\) (string->list "#(@\\"))) #t)
+(test (and (string=? "#(\\\\" (string #\# #\( #\\ #\\)) (equal? '(#\# #\( #\\ #\\) (string->list "#(\\\\"))) #t)
+(test (and (string=? ",,.@" (string #\, #\, #\. #\@)) (equal? '(#\, #\, #\. #\@) (string->list ",,.@"))) #t)
+(test (and (string=? ",@`\"" (string #\, #\@ #\` #\")) (equal? '(#\, #\@ #\` #\") (string->list ",@`\""))) #t)
+(test (and (string=? "\"'\")" (string #\" #\' #\" #\))) (equal? '(#\" #\' #\" #\)) (string->list "\"'\")"))) #t)
+(test (and (string=? "\")#\"" (string #\" #\) #\# #\")) (equal? '(#\" #\) #\# #\") (string->list "\")#\""))) #t)
+(test (and (string=? "(\\`)" (string #\( #\\ #\` #\))) (equal? '(#\( #\\ #\` #\)) (string->list "(\\`)"))) #t)
+(test (and (string=? "))\"'" (string #\) #\) #\" #\')) (equal? '(#\) #\) #\" #\') (string->list "))\"'"))) #t)
+(test (and (string=? "\\,\\\"" (string #\\ #\, #\\ #\")) (equal? '(#\\ #\, #\\ #\") (string->list "\\,\\\""))) #t)
+(test (and (string=? "\\\"`\"" (string #\\ #\" #\` #\")) (equal? '(#\\ #\" #\` #\") (string->list "\\\"`\""))) #t)
+(test (and (string=? "\\\\#\"" (string #\\ #\\ #\# #\")) (equal? '(#\\ #\\ #\# #\") (string->list "\\\\#\""))) #t)
+
+
(test (symbol->string 'hi) "hi")
(test (symbol->string (string->symbol "()")) "()")
@@ -1761,6 +2279,39 @@
(test (reinvert 12 string->symbol symbol->string "hiho") "hiho")
+(test (symbol->string) 'error)
+(test (string->symbol) 'error)
+(test (symbol->string 'hi 'ho) 'error)
+(test (string->symbol "hi" "ho") 'error)
+
+(for-each
+ (lambda (arg)
+ (test (symbol->string arg) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (string->symbol arg) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+(let ((sym 0))
+ (test (symbol->value 'sym) 0)
+ (for-each
+ (lambda (arg)
+ (set! sym arg)
+ (test (symbol->value 'sym) arg))
+ (list #\a 1 '() (list 1) '(1 . 2) #f (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1)))))
+
+(for-each
+ (lambda (arg)
+ (test (symbol->value arg) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (symbol->value) 'error)
+(test (symbol->value 'hi 'ho) 'error)
+
@@ -1791,6 +2342,9 @@
(test (let ((lst (list 1 2))) (list (apply cons lst) lst)) '((1 . 2) (1 2)))
(test (let ((lst (list 1 2))) (list lst (apply cons lst))) '((1 2) (1 . 2)))
(test (cdadr (let ((lst (list 1 2))) (list (apply cons lst) lst))) '(2))
+(test (cons 1 '()) '(
+ 1
+ ))
(test (car (list 1 2 3)) 1)
(test (car (cons 1 2)) 1)
@@ -1812,6 +2366,7 @@
(test (car '(1 .. 2)) 1)
(test (car ''foo) 'quote)
(test (car '(1 2 . 3)) 1)
+(test (car (cons 1 '())) 1)
(for-each
(lambda (arg)
@@ -2116,6 +2671,134 @@
(test (recompose 10 cdr '(1 2 3 4 5 6 7 8 9 10 11 12)) '(11 12))
(test (recompose 10 car '(((((((((((1 2 3)))))))))))) '(1 2 3))
+(test (cons 1 . 2) 'error)
+(test-w "(1 . 2 . 3)")
+(test (car (list)) 'error)
+(test (car '()) 'error)
+(test (cdr (list)) 'error)
+(test (cdr '()) 'error)
+(test (caddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
+(test (cdddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
+(test (caar '(a b c d e f g)) 'error)
+(test (cdar '(a b c d e f g)) 'error)
+(test (caaar '(a b c d e f g)) 'error)
+(test (caadr '(a b c d e f g)) 'error)
+(test (cadar '(a b c d e f g)) 'error)
+(test (cdaar '(a b c d e f g)) 'error)
+(test (cdadr '(a b c d e f g)) 'error)
+(test (cddar '(a b c d e f g)) 'error)
+(test (caaaar '(a b c d e f g)) 'error)
+(test (caaadr '(a b c d e f g)) 'error)
+(test (caadar '(a b c d e f g)) 'error)
+(test (caaddr '(a b c d e f g)) 'error)
+(test (cadaar '(a b c d e f g)) 'error)
+(test (cadadr '(a b c d e f g)) 'error)
+(test (caddar '(a b c d e f g)) 'error)
+(test (cdaaar '(a b c d e f g)) 'error)
+(test (cdaadr '(a b c d e f g)) 'error)
+(test (cdadar '(a b c d e f g)) 'error)
+(test (cdaddr '(a b c d e f g)) 'error)
+(test (cddaar '(a b c d e f g)) 'error)
+(test (cddadr '(a b c d e f g)) 'error)
+(test (cdddar '(a b c d e f g)) 'error)
+(test (caar 'a) 'error)
+(test (caar '(a)) 'error)
+(test (cadr 'a) 'error)
+(test (cadr '(a . b)) 'error)
+(test (cdar 'a) 'error)
+(test (cdar '(a . b)) 'error)
+(test (cddr 'a) 'error)
+(test (cddr '(a . b)) 'error)
+(test (caaar 'a) 'error)
+(test (caaar '(a)) 'error)
+(test (caaar '((a))) 'error)
+(test (caadr 'a) 'error)
+(test (caadr '(a . b)) 'error)
+(test (caadr '(a b)) 'error)
+(test (cadar 'a) 'error)
+(test (cadar '(a . b)) 'error)
+(test (cadar '((a . c) . b)) 'error)
+(test (caddr 'a) 'error)
+(test (caddr '(a . b)) 'error)
+(test (caddr '(a c . b)) 'error)
+(test (cdaar 'a) 'error)
+(test (cdaar '(a)) 'error)
+(test (cdaar '((a . b))) 'error)
+(test (cdadr 'a) 'error)
+(test (cdadr '(a . b)) 'error)
+(test (cdadr '(a b . c)) 'error)
+(test (cddar 'a) 'error)
+(test (cddar '(a . b)) 'error)
+(test (cddar '((a . b) . b)) 'error)
+(test (cdddr 'a) 'error)
+(test (cdddr '(a . b)) 'error)
+(test (cdddr '(a c . b)) 'error)
+(test (caaaar 'a) 'error)
+(test (caaaar '(a)) 'error)
+(test (caaaar '((a))) 'error)
+(test (caaaar '(((a)))) 'error)
+(test (caaadr 'a) 'error)
+(test (caaadr '(a . b)) 'error)
+(test (caaadr '(a b)) 'error)
+(test (caaadr '(a (b))) 'error)
+(test (caadar 'a) 'error)
+(test (caadar '(a . b)) 'error)
+(test (caadar '((a . c) . b)) 'error)
+(test (caadar '((a c) . b)) 'error)
+(test (caaddr 'a) 'error)
+(test (caaddr '(a . b)) 'error)
+(test (caaddr '(a c . b)) 'error)
+(test (caaddr '(a c b)) 'error)
+(test (cadaar 'a) 'error)
+(test (cadaar '(a)) 'error)
+(test (cadaar '((a . b))) 'error)
+(test (cadaar '((a b))) 'error)
+(test (cadadr 'a) 'error)
+(test (cadadr '(a . b)) 'error)
+(test (cadadr '(a b . c)) 'error)
+(test (cadadr '(a (b . e) . c)) 'error)
+(test (caddar 'a) 'error)
+(test (caddar '(a . b)) 'error)
+(test (caddar '((a . b) . b)) 'error)
+(test (caddar '((a b . c) . b)) 'error)
+(test (cadddr 'a) 'error)
+(test (cadddr '(a . b)) 'error)
+(test (cadddr '(a c . b)) 'error)
+(test (cadddr '(a c e . b)) 'error)
+(test (cdaaar 'a) 'error)
+(test (cdaaar '(a)) 'error)
+(test (cdaaar '((a))) 'error)
+(test (cdaaar '(((a . b)))) 'error)
+(test (cdaadr 'a) 'error)
+(test (cdaadr '(a . b)) 'error)
+(test (cdaadr '(a b)) 'error)
+(test (cdaadr '(a (b . c))) 'error)
+(test (cdadar 'a) 'error)
+(test (cdadar '(a . b)) 'error)
+(test (cdadar '((a . c) . b)) 'error)
+(test (cdadar '((a c . d) . b)) 'error)
+(test (cdaddr 'a) 'error)
+(test (cdaddr '(a . b)) 'error)
+(test (cdaddr '(a c . b)) 'error)
+(test (cdaddr '(a c b . d)) 'error)
+(test (cddaar 'a) 'error)
+(test (cddaar '(a)) 'error)
+(test (cddaar '((a . b))) 'error)
+(test (cddaar '((a b))) 'error)
+(test (cddadr 'a) 'error)
+(test (cddadr '(a . b)) 'error)
+(test (cddadr '(a b . c)) 'error)
+(test (cddadr '(a (b . e) . c)) 'error)
+(test (cdddar 'a) 'error)
+(test (cdddar '(a . b)) 'error)
+(test (cdddar '((a . b) . b)) 'error)
+(test (cdddar '((a b . c) . b)) 'error)
+(test (cddddr 'a) 'error)
+(test (cddddr '(a . b)) 'error)
+(test (cddddr '(a c . b)) 'error)
+(test (cddddr '(a c e . b)) 'error)
+
+
(test (length (list 'a 'b 'c 'd 'e 'f)) 6)
@@ -2130,6 +2813,21 @@
(test (length (list 1 (cons 1 2))) 2)
(test (length (list 1 (cons 1 '()))) 2)
+(for-each
+ (lambda (arg)
+ (test (length arg) 'error))
+ (list (integer->char 65) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(test (length 'x) 'error)
+(test (length (cons 1 2)) -1)
+(let ((x (list 1 2)))
+ (set-cdr! x x)
+ (test (infinite? (length x)) #t))
+(test (length '(1 2 . 3)) -2)
+(test (length) 'error)
+(test (length '(1 2 3) #(1 2 3)) 'error)
+
+
(test (reverse '(a b c d)) '(d c b a))
(test (reverse '(a b c)) '(c b a))
@@ -2163,6 +2861,9 @@
(test (let ((var '(1 (2 3)))) (reverse (cdr var)) var) '(1 (2 3)))
(test (let ((var (list (list 1 2) (list 3 4 5)))) (reverse (car var)) var) '((1 2) (3 4 5)))
(test (let ((x '(1 2 3))) (list (reverse x) x)) '((3 2 1) (1 2 3)))
+(test (reverse '(1 2)) '(2 1))
+(test (reverse '(1 2 3)) '(3 2 1))
+(test (reverse '(1 2 3 4)) '(4 3 2 1))
(for-each
(lambda (lst)
@@ -2181,6 +2882,50 @@
(test (let ((x (list 1 2 3))) (list (recompose 32 reverse x) x)) '((1 2 3) (1 2 3)))
(test (let ((x (list 1 2 3))) (list (recompose 31 reverse x) x)) '((3 2 1) (1 2 3)))
+(test (reverse (cons 1 2)) '(2 . 1))
+(test (reverse '(1 . 2)) '(2 . 1))
+(test (reverse '(1 2 . 3)) '(3 2 1))
+(test (reverse) 'error)
+(test (reverse '(1 2 3) '(3 2 1)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (reverse arg) 'error))
+ (list (integer->char 65) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+(test (reverse! '(1 . 2)) 'error)
+(test (reverse! (cons 1 2)) 'error)
+(test (reverse! (cons 1 (cons 2 3))) 'error)
+(test (reverse!) 'error)
+(test (reverse! '(1 2 3) '(3 2 1)) 'error)
+
+(test (reverse! '(a b c d)) '(d c b a))
+(test (reverse! '(a b c)) '(c b a))
+(test (reverse! '(a (b c) d (e (f)))) '((e (f)) d (b c) a))
+(test (reverse! '()) '())
+(test (reverse! (list 1 2 3)) '(3 2 1))
+(test (reverse! (list 1)) '(1))
+(test (reverse! (list)) (list))
+(test (reverse! '(1 2 3)) (list 3 2 1))
+(test (reverse! '(1)) '(1))
+(test (reverse! '((1 2) 3)) '(3 (1 2)))
+(test (reverse! '(((1 . 2) . 3) 4)) '(4 ((1 . 2) . 3)))
+(test (reverse! (list (list) (list 1 2))) '((1 2) ()))
+(test (reverse! '((a) b c d)) '(d c b (a)))
+(test (reverse! (reverse! (list 1 2 3 4))) (list 1 2 3 4))
+(test (reverse! ''foo) '(foo quote))
+(test (reverse (reverse! (list 1 2 3))) (list 1 2 3))
+(test (reverse (reverse! (reverse! (reverse (list 1 2 3))))) (list 1 2 3))
+
+(test (let ((x (list 1 2 3))) (recompose 31 reverse! x)) '(3 2 1))
+
+(for-each
+ (lambda (arg)
+ (test (reverse! arg) 'error))
+ (list (integer->char 65) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) #(1 2 3) "hiho" (lambda (a) (+ a 1))))
+
(test (pair? 'a) #f)
@@ -2210,6 +2955,7 @@
(test (pair? (list (list))) #t)
(test (pair? '(())) #t)
(test (pair? (cons 1 (cons 2 3))) #t)
+(test (pair?) 'error)
(for-each
(lambda (arg)
@@ -2249,6 +2995,8 @@
(test (list? (cons 1 (cons 2 3))) #f)
(test (list? '(1 . ())) #t)
+(test (list? '(1 2) '()) 'error)
+(test (list?) 'error)
(for-each
(lambda (arg)
(if (list? arg)
@@ -2284,6 +3032,10 @@
(test (null? (list (list))) #f)
(test (null? '(())) #f)
(test (null? '#()) #f)
+(test (null? "") #f)
+
+(test (null? () '()) 'error)
+(test (null?) 'error)
(for-each
(lambda (arg)
@@ -2292,27 +3044,6 @@
(list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
-(test (reverse! '(a b c d)) '(d c b a))
-(test (reverse! '(a b c)) '(c b a))
-(test (reverse! '(a (b c) d (e (f)))) '((e (f)) d (b c) a))
-(test (reverse! '()) '())
-(test (reverse! (list 1 2 3)) '(3 2 1))
-(test (reverse! (list 1)) '(1))
-(test (reverse! (list)) (list))
-(test (reverse! '(1 2 3)) (list 3 2 1))
-(test (reverse! '(1)) '(1))
-(test (reverse! '((1 2) 3)) '(3 (1 2)))
-(test (reverse! '(((1 . 2) . 3) 4)) '(4 ((1 . 2) . 3)))
-(test (reverse! (list (list) (list 1 2))) '((1 2) ()))
-(test (reverse! '((a) b c d)) '(d c b (a)))
-(test (reverse! (reverse! (list 1 2 3 4))) (list 1 2 3 4))
-(test (reverse! ''foo) '(foo quote))
-(test (reverse (reverse! (list 1 2 3))) (list 1 2 3))
-(test (reverse (reverse! (reverse! (reverse (list 1 2 3))))) (list 1 2 3))
-
-(test (let ((x (list 1 2 3))) (recompose 31 reverse! x)) '(3 2 1))
-
-
(test (let ((x (cons 1 2))) (set-car! x 3) x) (cons 3 2))
(test (let ((x (list 1 2))) (set-car! x 3) x) (list 3 2))
(test (let ((x (list (list 1 2) 3))) (set-car! x 22) x) (list 22 3))
@@ -2348,6 +3079,21 @@
(test (let ((x '(1 . (2 . (3 (4 5)))))) (set-cdr! x 4) x) '(1 . 4))
(test (let ((lst (cons 1 (cons 2 3)))) (set-cdr! (cdr lst) 4) lst) (cons 1 (cons 2 4)))
+(test (set-car! '() 32) 'error)
+(test (set-car! () 32) 'error)
+(test (set-car! (list) 32) 'error)
+(test (set-car! 'x 32) 'error)
+(test (set-car! #f 32) 'error)
+(test (set-cdr! '() 32) 'error)
+(test (set-cdr! () 32) 'error)
+(test (set-cdr! (list) 32) 'error)
+(test (set-cdr! 'x 32) 'error)
+(test (set-cdr! #f 32) 'error)
+(test (set-car!) 'error)
+(test (set-cdr!) 'error)
+(test (set-car! '(1 2) 1 2) 'error)
+(test (set-cdr! '(1 2) 1 2) 'error)
+
(test (list-ref (list 1 2) 1) 2)
(test (list-ref '(a b c d) 2) 'c)
@@ -2386,6 +3132,24 @@
(test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 1)) 1)
(test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 100)) 1)
+(test (list-ref '() 0) 'error)
+(test (list-ref (list 1 2) 2) 'error)
+(test (list-ref (list 1 2) -1) 'error)
+(test (list-ref (list 1 2) 1.3) 'error)
+(test (list-ref (list 1 2) 1/3) 'error)
+(test (list-ref (list 1 2) 1+2.0i) 'error)
+(test (list-ref (cons 1 2) 1) 'error)
+(test (list-ref (cons 1 2) 2) 'error)
+(test (list-ref (list 1 2 3) (expt 2 32)) 'error)
+(test (list-ref '(1 2 3) 1 2) 'error)
+(test (list-ref) 'error)
+(test (list-ref '(1 2)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (list-ref (list 1 2) arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+
(test (let ((x (list 1))) (list-set! x 0 2) x) (list 2))
@@ -2406,6 +3170,23 @@
(test (let ((x (list 1 2))) (list-set! x 0 arg) (list-ref x 0)) arg))
(list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+(test (list-set! '() 0 1) 'error)
+(test (list-set! '() -1 1) 'error)
+(test (list-set! '(1) 1 2) 'error)
+(test (list-set! '(1 2 3) -1 2) 'error)
+(test (list-set! '(1) 1.5 2) 'error)
+(test (list-set! '(1) 3/2 2) 'error)
+(test (list-set! '(1) 1+3i 2) 'error)
+(test (let ((x (cons 1 2))) (list-set! x 1 3) x) 'error)
+(test (list-set! '(1 2 3) 1 2 3) 'error)
+(test (list-set! (list 1 2 3) (expt 2 32) 0) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (list-set! (list 1 2) arg arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+
+
(test (let ((tree1 (list 1 (list 1 2) (list (list 1 2 3)) (list (list (list 1 2 3 4)))))) tree1) '(1 (1 2) ((1 2 3)) (((1 2 3 4)))))
@@ -2426,6 +3207,11 @@
(test (list) '())
(test (length (list quote do map call/cc lambda define if begin set! let let* cond and or for-each)) 15)
+(test (list 1 2 . 3) 'error)
+(test (list 1 2 , 3) 'error)
+(test (list 1 2 ,@ 3) 'error)
+
+
(test (list-tail '(1 2 3) 0) '(1 2 3))
(test (list-tail '(1 2 3) 2) '(3))
@@ -2434,6 +3220,8 @@
(test (list-tail '(1 2 3 . 4) 3) 4)
(test (let ((x (list 1 2 3))) (eq? (list-tail x 2) (cddr x))) #t)
(test (list-tail '() 0) '())
+(test (list-tail '() 1) 'error)
+(test (list-tail '() -1) 'error)
(test (list-tail (list 1 2) 2) '())
(test (list-tail (cons 1 2) 0) '(1 . 2))
(test (list-tail (cons 1 2) 1) 2)
@@ -2458,6 +3246,24 @@
(list (lambda (l) l) cdr cddr cdddr cddddr)
(list (lambda (l) (list-tail l 0)) (lambda (l) (list-tail l 1)) (lambda (l) (list-tail l 2)) (lambda (l) (list-tail l 3)) (lambda (l) (list-tail l 4))))
+(test (list-tail (list 1 2) 3) 'error)
+(test (list-tail (list 1 2) -1) 'error)
+(test (list-tail (list 1 2) 1.3) 'error)
+(test (list-tail (list 1 2) 1/3) 'error)
+(test (list-tail (list 1 2) 1+2.0i) 'error)
+(test (list-tail (cons 1 2) 2) 'error)
+(test (list-tail '(1 2 . 3)) 'error)
+(test (list-tail '(1 2 . 3) 1) '(2 . 3))
+(test (list-tail '(1 2 . 3) 0) '(1 2 . 3))
+(test (list-tail (list 1 2 3) (+ 1 (expt 2 32))) 'error)
+(test (list-tail) 'error)
+(test (list-tail '(1)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (list-tail (list 1 2) arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+
(let ((e '((a 1) (b 2) (c 3))))
@@ -2487,8 +3293,24 @@
(test (assq 'x (cdr (assq 'a '((b . 32) (a . ((a . 12) (b . 32) (x . 1))) (c . 1))))) '(x . 1))
+(test (assq #f '(#f 2 . 3)) #f)
+(test (assq #f '((#f 2) . 3)) '(#f 2))
+(test (assq '() '((() 1) (#f 2))) '(() 1))
+(test (assq '() '((1) (#f 2))) #f)
+(test (assq #() '((#f 1) (() 2) (#() 3))) #f) ; (eq? #() #()) -> #f
+
+(test (assq 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
+(test (assq 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
+(test (assq 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
+(test (assq 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
+(test (assq 'b (list '(a . 1) '(b . 2) '() '(c . 3) #f)) '(b . 2))
+(test (assq 'asdf (list '(a . 1) '(b . 2) '() '(c . 3) #f)) #f)
+(test (assq "" (list '("a" . 1) '("" . 2) '(#() . 3))) #f) ; since (eq? "" "") is #f
+(test (assv 1 '(1 2 . 3)) #f)
+(test (assv 1 '((1 2) . 3)) '(1 2))
+
(let ((e '((a 1) (b 2) (c 3))))
(test (assv 'a e) '(a 1))
(test (assv 'b e) '(b 2))
@@ -2525,6 +3347,17 @@
(set-cdr! (assv 3 lst) 'c)
(test lst '((2 . a) (3 . c))))
+(test (assv '() '((() 1) (#f 2))) '(() 1))
+(test (assv '() '((1) (#f 2))) #f)
+(test (assv #() '((#f 1) (() 2) (#() 3))) #f) ; (eqv? #() #()) -> #f ??
+
+(test (assv 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
+(test (assv 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
+(test (assv 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
+(test (assv 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
+(test (assv 'asdf '((a . 1) (b . 2) () (c . 3) . 4)) #f)
+(test (assv 'd '((a . 1) (b . 2) () (c . 3) (d . 5))) '(d . 5))
+
(let ((e '((a 1) (b 2) (c 3))))
(test (assoc 'a e) '(a 1))
@@ -2566,6 +3399,142 @@
(test (assoc 'key '(() ())) #f)
(test (assoc '() '()) #f)
+(test (assoc '() 1) 'error)
+(test (assoc (cons 1 2) 1) 'error)
+(test (assoc (let ((x (cons 1 2))) (set-cdr! x x)) 1) 'error)
+(test (assoc '((1 2) .3) 1) 'error)
+(test (assoc ''foo quote) 'error)
+(test (assoc 1 '(1 2 . 3)) #f)
+(test (assoc 1 '((1 2) . 3)) '(1 2))
+
+(test (assoc '() '((() 1) (#f 2))) '(() 1))
+(test (assoc '() '((1) (#f 2))) #f)
+(test (assoc #() '((#f 1) (() 2) (#() 3))) '(#() 3))
+
+(for-each
+ (lambda (arg)
+ (test (assoc arg (list (list 1 2) (list arg 3))) (list arg 3)))
+ (list "hi" (integer->char 65) #f 'a-symbol #() abs 3/4 #\f #t (if #f #f)))
+
+(test (assoc 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
+(test (assoc 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
+(test (assoc 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
+(test (assoc 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
+(test (assoc 'c '(() (a . 1) (b . 2) () (c . 3) (c . 4) . 4)) '(c . 3))
+(test (assoc 'asdf '(() (a . 1) (b . 2) () (c . 3) (c . 4) . 4)) #f)
+(test (assoc "" (list '("a" . 1) '("" . 2) '(#() . 3))) '("" . 2))
+
+
+
+(test (memq 'a '(a b c)) '(a b c))
+(test (memq 'b '(a b c)) '(b c))
+(test (memq 'a '(b c d)) #f)
+(test (memq (list 'a) '(b (a) c)) #f)
+(test (memq 'a '(b a c a d a)) '(a c a d a))
+(let ((v (vector 'a))) (test (memq v (list 'a 1.2 v "hi")) (list v "hi")))
+(test (memq #f '(1 a #t "hi" #f 2)) '(#f 2))
+(test (memq eq? (list 2 eqv? 1 eq?)) (list eq?))
+(test (memq eq? (list 2 eqv? 2)) #f)
+(test (memq 6 (memq 5 (memq 4 (memq 3 (memq 2 (memq 1 '(1 2 3 4 5 6))))))) '(6))
+(test (memq 'a (cons 'a 'b)) '(a . b))
+(test (memq 'a (list a b . c)) 'error)
+(test (memq) 'error)
+(test (memq 'a) 'error)
+(test (memq 'a 'b) 'error)
+(test (memq 'a '(a b . c)) '(a b . c))
+(test (memq 'b '(a b . c)) '(b . c))
+(test (memq 'c '(a b . c)) #f) ; or should it be 'c?
+(test (memq '() '(1 () 3)) '(() 3))
+(test (memq '() '(1 2)) #f)
+(test (memq 'a '(c d a b c)) '(a b c))
+(test (memq 'a '(c d f b c)) #f)
+(test (memq 'a '()) #f)
+(test (memq 'a '(c d a b . c)) '(a b . c))
+(test (memq 'a '(c d f b . c)) #f)
+
+
+
+(test (memv 101 '(100 101 102)) '(101 102))
+(test (memv 3.4 '(1.2 2.3 3.4 4.5)) '(3.4 4.5))
+(test (memv 3.4 '(1.3 2.5 3.7 4.9)) #f)
+(let ((ls (list 'a 'b 'c)))
+ (set-car! (memv 'b ls) 'z)
+ (test ls '(a z c)))
+(test (memv 1 (cons 1 2)) '(1 . 2))
+(test (memv 'a (list a b . c)) 'error)
+(test (memv 'a '(a b . c)) '(a b . c))
+(test (memv 'asdf '(a b . c)) #f)
+(test (memv) 'error)
+(test (memv 'a) 'error)
+(test (memv 'a 'b) 'error)
+(test (memv 'c '(a b c)) '(c))
+(test (memv 'c '(a b . c)) #f)
+
+
+
+(test (member (list 'a) '(b (a) c)) '((a) c))
+(test (member "b" '("a" "c" "b")) '("b"))
+(test (member 1 '(3 2 1 4)) '(1 4))
+(test (member car (list abs car modulo)) (list car modulo))
+(test (member do (list quote map do)) (list do))
+(test (member 5/2 (list 1/3 2/4 5/2)) '(5/2))
+(test (member 'a '(a b c d)) '(a b c d))
+(test (member 'b '(a b c d)) '(b c d))
+(test (member 'c '(a b c d)) '(c d))
+(test (member 'd '(a b c d)) '(d))
+(test (member 'e '(a b c d)) #f)
+(test (member 1 (cons 1 2)) '(1 . 2))
+(test (member 'a (list a b . c)) 'error)
+(test (member 1 '(1 2 . 3)) '(1 2 . 3))
+(test (member 4 '(1 2 . 3)) #f)
+(test (member) 'error)
+(test (member 'a) 'error)
+(test (member 'a 'b) 'error)
+(test (member '() '(1 2 3)) #f)
+(test (member '() '(1 2 ())) '(()))
+(test (member #() '(1 () 2 #() 3)) '(#() 3))
+(test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (1 2)))) #f)
+(test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (3 4)))) '(#2d((1 2) (3 4))))
+
+(for-each
+ (lambda (arg)
+ (test (member arg (list 1 2 arg 3)) (list arg 3)))
+ (list "hi" (integer->char 65) #f 'a-symbol abs 3/4 #\f #t (if #f #f) '(1 2 (3 (4))) most-positive-fixnum))
+
+
+(for-each
+ (lambda (op)
+ (test (op) 'error)
+ (for-each
+ (lambda (arg)
+ (let ((result (catch #t (lambda () (op arg)) (lambda args 'error))))
+ (if (not (eq? result 'error))
+ (format #t "(~A ~A) returned ~A?~%" op arg result))
+ (test (op arg '() arg) 'error)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar
+ caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar
+ assq assv assoc memq memv member list-ref list-tail))
+
+(for-each
+ (lambda (op)
+ (test (op '(1) '(2)) 'error))
+ (list reverse car cdr caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar
+ caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar
+ list-ref list-tail list-set!))
+
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (let ((result (catch #t (lambda () (op #f arg)) (lambda args 'error))))
+ (if (not (eq? result 'error))
+ (format #t "(~A #f ~A) returned ~A?~%" op arg result))))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list assq assv assoc memq memv member))
+
+
+
(test (append '(a b c) '()) '(a b c))
(test (append '() '(a b c)) '(a b c))
(test (append '(a b) '(c d)) '(a b c d))
@@ -2622,38 +3591,44 @@
(test (let ((xx (list 1 2))) (recompose 12 (lambda (x) (append (list (car x)) (cdr x))) xx)) '(1 2))
-
-(test (memq 'a '(a b c)) '(a b c))
-(test (memq 'b '(a b c)) '(b c))
-(test (memq 'a '(b c d)) #f)
-(test (memq (list 'a) '(b (a) c)) #f)
-(test (memq 'a '(b a c a d a)) '(a c a d a))
-(let ((v (vector 'a))) (test (memq v (list 'a 1.2 v "hi")) (list v "hi")))
-(test (memq #f '(1 a #t "hi" #f 2)) '(#f 2))
-(test (memq eq? (list 2 eqv? 1 eq?)) (list eq?))
-(test (memq eq? (list 2 eqv? 2)) #f)
-(test (memq 6 (memq 5 (memq 4 (memq 3 (memq 2 (memq 1 '(1 2 3 4 5 6))))))) '(6))
-
-
-(test (memv 101 '(100 101 102)) '(101 102))
-(test (memv 3.4 '(1.2 2.3 3.4 4.5)) '(3.4 4.5))
-(test (memv 3.4 '(1.3 2.5 3.7 4.9)) #f)
-(let ((ls (list 'a 'b 'c)))
- (set-car! (memv 'b ls) 'z)
- (test ls '(a z c)))
-
-
-(test (member (list 'a) '(b (a) c)) '((a) c))
-(test (member "b" '("a" "c" "b")) '("b"))
-(test (member 1 '(3 2 1 4)) '(1 4))
-(test (member car (list abs car modulo)) (list car modulo))
-(test (member do (list quote map do)) (list do))
-(test (member 5/2 (list 1/3 2/4 5/2)) '(5/2))
-(test (member 'a '(a b c d)) '(a b c d))
-(test (member 'b '(a b c d)) '(b c d))
-(test (member 'c '(a b c d)) '(c d))
-(test (member 'd '(a b c d)) '(d))
-(test (member 'e '(a b c d)) #f)
+(test (append 'a 'b) 'error)
+(test (append 'a '()) 'error)
+(test (append (cons 1 2) '()) 'error)
+(test (append '(1) 2 '(3)) 'error)
+(test (append '(1) 2 3) 'error)
+(test (let ((lst (list 1 2 3))) (append lst lst)) '(1 2 3 1 2 3))
+
+
+
+
+(test-w "(list #b)")
+(test-w "(char? #\\spaces)")
+(test-w "(car '( . 1))")
+(test-w "(car '(. ))")
+(test-w "(car '( . ))")
+(test-w "(car '(. . . ))")
+(test-w "'#( . 1)")
+(test-w "'(1 2 . )")
+(test-w "'#(1 2 . )")
+(test-w "(+ 1 . . )")
+(test-w "(car '(1 . ))")
+(test-w "(car '(1 . . 2))")
+(test-w "'#( . )")
+(test-w "'#(1 . )")
+(test-w "'#(. . . )")
+(test-w "'#(1 . . 2)")
+(test-w "'(. 1)")
+(test-w "'#(. 1)")
+(test-w "'(. )")
+(test-w "'#(. )")
+(test-w "(list 1 . 2)")
+(test-w "(+ 1 . 2)")
+(test-w "(car '@#`')")
+(test-w "(list . )")
+(test-w "'#( .)")
+(test-w "(car '( .))")
+(test-w "'#(1 . 2)")
+(test-w "(let ((. 3)) .)")
@@ -2677,6 +3652,10 @@
(test (vector? arg) #f))
(list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+(test (vector?) 'error)
+(test (vector? #() #(1)) 'error)
+
+
(test (let ((v (make-vector 3 #f))) (and (vector? v) (= (vector-length v) 3) (eq? (vector-ref v 1) #f))) #t)
(test (let ((v (make-vector 1 1))) (and (vector? v) (= (vector-length v) 1) (vector-ref v 0))) 1)
@@ -2698,6 +3677,17 @@
(test (vector-ref (make-vector 1 arg) 0) arg))
(list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (make-vector) 'error)
+(test (make-vector 1 #f #t) 'error)
+(test (make-vector 1 2 3) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (make-vector arg) 'error))
+ (list #\a '() -1 #f "hi" 'a-symbol abs 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+
+
+
(test (vector 1 2 3) '#(1 2 3))
(test (vector 1 '(2) 3) '#(1 (2) 3))
(test (vector) '#())
@@ -2741,6 +3731,7 @@
(if (list? arg)
(test (vector->list (list->vector arg)) arg)))
lists)
+(set! lists '())
(test (list->vector (vector->list (vector))) '#())
(test (list->vector (vector->list (vector 1))) '#(1))
@@ -2749,6 +3740,25 @@
(test (reinvert 12 vector->list list->vector #(1 2 3)) #(1 2 3))
+(test (vector->list) 'error)
+(test (list->vector) 'error)
+(test (vector->list #(1) #(2)) 'error)
+(test (list->vector '(1) '(2)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (vector->list arg) 'error))
+ (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol "hi" abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->vector x)) 'error)
+(test (list->vector (cons 1 2)) 'error)
+(test (list->vector '(1 2 . 3)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (list->vector arg) 'error))
+ (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
(test (vector-length (vector)) 0)
@@ -2762,6 +3772,15 @@
(test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) v)) 2)
(test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) (vector-ref v 1))) 2)
+(test (vector-length) 'error)
+(test (vector-length #(1) #(2)) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (vector-length arg) 'error))
+ (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
(test (vector-ref '#(1 1 2 3 5 8 13 21) 5) 8)
(test (vector-ref '#(1 1 2 3 5 8 13 21) (let ((i (round (* 2 (acos -1))))) (if (inexact? i) (inexact->exact i) i))) 13)
@@ -2775,6 +3794,36 @@
(test (vector-ref (vector-ref (vector-ref '#(1 (2) #(3 (4) #(5))) 2) 2) 0) 5)
(test (let ((v (vector 1 2))) (vector-set! v 1 v) (eq? (vector-ref v 1) v)) #t)
+(test (vector-ref) 'error)
+(test (vector-ref #(1)) 'error)
+(test (vector-ref #(1) 0 0) 'error)
+
+(test (let ((v (make-vector 1 0))) (vector-ref v 1)) 'error)
+(test (let ((v (make-vector 1 0))) (vector-ref v -1)) 'error)
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 3)) 'error)
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 3) 0)) 'error)
+(test (vector-ref (vector) 0) 'error)
+(test (vector-ref '#() 0) 'error)
+(test (vector-ref '#() -1) 'error)
+(test (vector-ref '#() 1) 'error)
+
+(test (#(1 2) 1) 2)
+(test (#(1 2) 1 2) 'error)
+(test ((#("hi" "ho") 0) 1) #\i)
+(test (((vector (list 1 2) (cons 3 4)) 0) 1) 2)
+(test ((#(#(1 2) #(3 4)) 0) 1) 2)
+(test ((((vector (vector (vector 1 2) 0) 0) 0) 0) 0) 1)
+(test ((((list (list (list 1 2) 0) 0) 0) 0) 0) 1)
+(test ((((list (list (list 1 2) 0) 0) 0) 0) ((((vector (vector (vector 1 2) 0) 0) 0) 0) 0)) 2)
+(test (#(1 2) -1) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (vector-ref arg 0) 'error))
+ (list "hi" #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table)))
+
+
+
(test (let ((vec (vector 0 '(2 2 2 2) "Anna"))) (vector-set! vec 1 '("Sue" "Sue")) vec) '#(0 ("Sue" "Sue") "Anna"))
(test (let ((v (vector 1 2 3))) (vector-set! v 1 32) v) '#(1 32 3))
@@ -2789,6 +3838,44 @@
(test (let ((v (vector 1 (list 2) (vector 1 2 3)))) (vector-set! (vector-ref v 2) 0 21) v) '#(1 (2) #(21 2 3)))
(test (vector-set! (vector 1 2) 0 4) 4)
+(test (vector-set!) 'error)
+(test (vector-set! #(1)) 'error)
+(test (vector-set! #(1) 0) 'error)
+(test (vector-set! #(1) 0 0 1) 'error)
+(test (vector-set! #(1) 0 0 1 2 3) 'error)
+(test (vector-set! #(1) #(0) 1) 'error)
+(test (vector-set! '#(1 2) 0 2) 2)
+
+(for-each
+ (lambda (arg)
+ (test (vector-set! arg 0 0) 'error))
+ (list "hi" #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table)))
+
+(let ((v (vector 1 2 3)))
+ (for-each
+ (lambda (arg)
+ (test (vector-set! v arg 0) 'error))
+ (list "hi" #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (make-vector 3) (lambda (a) (+ a 1)))))
+
+(for-each
+ (lambda (arg)
+ (test (vector-set! arg 0 0) 'error))
+ (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((v (vector)))
+ (test (vector-set! v 0 0) 'error)
+ (test (vector-set! v 1 0) 'error)
+ (test (vector-set! v -1 0) 'error))
+(test (vector-set! #() 0 123) 'error)
+(test (vector-set! #(1 2 3) 0 123) 123)
+
+(test (let ((g (lambda () '#(1 2 3)))) (vector-set! (g) 0 #\?) (g)) #(#\? 2 3))
+(test (let ((g (lambda () '(1 . 2)))) (set-car! (g) 123) (g)) '(123 . 2))
+(test (let ((g (lambda () '(1 2)))) (list-set! (g) 0 123) (g)) '(123 2))
+(test (let ((g (lambda () (symbol->string 'hi)))) (string-set! (g) 1 #\a) (symbol->string 'hi)) "hi")
+
+
+
(test (fill! (vector 1 2) 4) 4)
(test (let ((v (vector 1 2 3))) (vector-fill! v 0) v) '#(0 0 0))
@@ -2800,9 +3887,19 @@
(test (vector-ref v 1) arg))
(list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))))
- ;(let ((str "hi") (v (make-vector 3))) (vector-fill! v str) (string-set! (vector-ref v 0) 1 #\a) str) -> mutable string error
- ;(let ((lst (list 1 2)) (v (make-vector 3))) (vector-fill! v lst) (list-set! (vector-ref v 0) 1 #\a) lst) -> '(1 #\a)
+(test (let ((str "hi") (v (make-vector 3))) (vector-fill! v str) (string-set! (vector-ref v 0) 1 #\a) str) "ha")
+(test (let ((lst (list 1 2)) (v (make-vector 3))) (vector-fill! v lst) (list-set! (vector-ref v 0) 1 #\a) lst) '(1 #\a))
+
+(test (let ((v (vector 1 2 3))) (vector-set! v -1 0)) 'error)
+(test (let ((v (vector 1 2 3))) (vector-set! v 3 0)) 'error)
+(test (vector-fill! '#(1 2) 2) 2)
+(test (vector-fill! #() 0) 0)
+(test (vector-fill! (vector) 0) 0)
+(for-each
+ (lambda (arg)
+ (test (vector-fill! arg 0) 'error))
+ (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
(test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6)
@@ -2865,6 +3962,9 @@
(test (call/cc (lambda (return) (map (lambda (n) (return "oops")) (vector 1 2 3)))) "oops")
(test (call/cc (lambda (return) (map (lambda (n) (if (even? n) (return n))) (vector 1 3 8 7 9 10)))) 8)
+(test (vector? (symbol-table)) #t)
+(test (symbol? (((symbol-table) 0) 0)) #t)
+
(test (let ((val 0)
(ht (make-hash-table)))
(set! (ht "hi") 123)
@@ -2885,55 +3985,1205 @@
ht))))
123)
+(let ((v (make-vector 3 (vector 1 2))))
+ (test (equal? (v 0) (v 1)) #t)
+ (test (eq? (v 0) (v 1)) #t)
+ (test (eqv? (v 0) (v 1)) #t))
+
+(let ((v (vector (vector 1 2) (vector 1 2) (vector 1 2))))
+ (test (equal? (v 0) (v 1)) #t)
+ (test (eq? (v 0) (v 1)) #f)
+ (test (eqv? (v 0) (v 1)) #f))
+
+(let ((v (vector (vector (vector (vector 1 2) 3) 4) 5)))
+ (test (v 0) #(#(#(1 2) 3) 4))
+ (test (v 1) 5)
+ (test (((v 0) 0) 1) 3)
+ (test ((((v 0) 0) 0) 1) 2))
+
+(test (make-vector 1 (make-vector 1 (make-vector 1 0))) #(#(#(0))))
+
+(let ()
+ (let ((v1 (make-vector 3 1)))
+ (num-test (v1 1) 1)
+ (set! (v1 1) 2)
+ (num-test (v1 1) 2)
+ (let ((i0 0)
+ (i2 2))
+ (num-test (v1 i0) 1)
+ (num-test (vector-ref v1 i2) 1)
+ (set! (v1 i0) 0)
+ (num-test (v1 0) 0)
+ (set! (v1 i0) i2)
+ (num-test (v1 i0) i2))
+ (test (vector-dimensions v1) '(3))
+ (set! v1 (make-vector '(3 2)))
+ (test (vector-dimensions v1) '(3 2))
+ (vector-set! v1 1 1 0)
+ (num-test (vector-ref v1 1 1) 0)
+ (let ((i0 1)
+ (i1 1)
+ (i2 32))
+ (set! (v1 i0 i1) i2)
+ (num-test (vector-ref v1 1 1) 32)
+ (num-test (v1 i0 i1) i2)
+ (vector-set! v1 0 1 3)
+ (num-test (v1 0 1) 3)
+ (num-test (v1 1 1) 32))
+ (set! v1 (make-vector '(2 4 3) 1))
+ (test (vector-dimensions v1) '(2 4 3))
+ (num-test (vector-ref v1 1 1 1) 1)
+ (vector-set! v1 0 0 0 32)
+ (num-test (v1 0 0 0) 32)
+ (set! (v1 0 1 1) 3)
+ (num-test (v1 0 1 1) 3)
+
+ (let ((v (make-vector '(2 2))))
+ (set! (v 0 0) 1)
+ (set! (v 0 1) 2)
+ (set! (v 1 0) 3)
+ (set! (v 1 1) 4)
+ (set! (v 0 1) #2d((1 2) (3 4)))
+ v)
+
+ (let ((v #2d((1 2) (3 4))))
+ (set! (v 0 1) #2d((1 2) (3 4)))
+ v)
+
+ (test (let ((v1 (make-vector '(3 2) 1))
+ (v2 (make-vector '(3 2) 2))
+ (sum 0))
+ (for-each (lambda (n m) (set! sum (+ sum n m))) v1 v2)
+ sum)
+ 18)
+ (test (vector->list (make-vector '(2 3) 1)) '(1 1 1 1 1 1))
+ (test (vector->list #2d((1 2) (3 4))) '(1 2 3 4))
+ (test (list->vector '((1 2) (3 4))) #((1 2) (3 4)))
+
+ (test (#2d((1 2 3) (4 5 6)) 0 0) 1)
+ (test (#2d((1 2 3) (4 5 6)) 0 1) 2)
+ (test (#2d((1 2 3) (4 5 6)) 1 1) 5)
+ (test (#3D(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) 1)
+ (test (#3D(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) 7)
+ (test (#4d((((1) (2)) ((3) (4)) ((5) (6)))) 0 0 0 0) 1)
+ (test (vector? #2d((1 2) (3 4))) #t)
+ (test ((#2d((1 #2d((2 3) (4 5))) (6 7)) 0 1) 1 0) 4)
+
+ ;; these are read-time errors
+ ;(test #3D(((1 2) (3 4)) ((5 6) (7))) 'error)
+ ;(test #3D(((1 2) (3 4)) ((5 6) (7 8 9))) 'error)
+ ;(test #3D(((1 2) (3 4)) (5 (7 8 9))) 'error)
+
+ (test (vector-dimensions #3D(((1 2) (3 4)) ((5 6) (7 8)))) '(2 2 2))
+ (test (vector-dimensions #2d((1 2 3) (4 5 6))) '(2 3))
+ (test (vector-dimensions #4d((((1) (2)) ((3) (4)) ((5) (6))))) '(1 3 2 1))
+
+ (test (vector-length #3D(((1 2) (3 4)) ((5 6) (7 8)))) 8)
+ (test (length #2d((1 2 3) (4 5 6))) 6)
+
+ (test (#2d((1 (2) 3) (4 () 6)) 0 1) '(2))
+ (test (#2d((1 (2) 3) (4 () 6)) 1 1) '())
+ (test (#2d((1 (2) 3) (4 6 ())) 1 2) '())
+ (test (#2d((() (2) ()) (4 5 6)) 0 2) '())
+
+ (test (equal? (make-vector 0) (make-vector '(0))) #t)
+ (test (equal? #() (make-vector '(0))) #t)
+
+ (test (equal? #2d((1 2) (3 4)) #2D((1 2) (3 4))) #t)
+ (test (eq? #2d((1 2) (3 4)) #2D((1 2) (3 4))) #f)
+ (test (eqv? #2d((1 2) (3 4)) #2D((1 2) (3 4))) #f)
+ (test (make-vector (1 . 2) "hi") 'error)
+ (test (make-vector (cons 1 2) "hi") 'error)
+ (test (equal? (make-vector 0) (vector)) #t)
+ (test (equal? #() (vector)) #t)
+
+ (let ((v (make-vector '(2 3) 0)))
+ (num-test (vector-length v) 6)
+ (test (vector-dimensions v) '(2 3))
+ (num-test (v 0 0) 0)
+ (num-test (v 1 2) 0)
+ (test (v 2 2) 'error)
+ (test (v 2 -1) 'error)
+ (test (v 2 0) 'error)
+ (set! (v 0 1) 1)
+ (num-test (v 0 1) 1)
+ (num-test (v 1 0) 0)
+ (set! (v 1 2) 2)
+ (num-test (v 1 2) 2)
+ (test (set! (v 2 2) 32) 'error)
+ (test (set! (v 1 -1) 0) 'error)
+ (test (set! (v 2 0) 0) 'error)
+ (num-test (vector-ref v 0 1) 1)
+ (num-test (vector-ref v 1 2) 2)
+ (test (vector-ref v 2 2) 'error)
+ (test (vector-ref v 1 -1) 'error)
+ (vector-set! v 1 1 64)
+ (num-test (vector-ref v 1 1) 64)
+ (num-test (vector-ref v 0 0) 0)
+ (test (vector-ref v 1 2 3) 'error)
+ (test (vector-set! v 1 2 3 4) 'error)
+ (test (v 1 1 1) 'error)
+ (test (set! (v 1 1 1) 1) 'error))
+
+ (let ((v1 (make-vector '(3 2) 0))
+ (v2 (make-vector '(2 3) 0))
+ (v3 (make-vector '(2 3 4) 0))
+ (v4 (make-vector 6 0))
+ (v5 (make-vector '(2 3) 0)))
+ (test (equal? v1 v2) #f)
+ (test (equal? v1 v3) #f)
+ (test (equal? v1 v4) #f)
+ (test (equal? v2 v2) #t)
+ (test (equal? v3 v2) #f)
+ (test (equal? v4 v2) #f)
+ (test (equal? v5 v2) #t)
+ (test (equal? v4 v3) #f)
+ (test (vector-dimensions v3) '(2 3 4))
+ (test (vector-dimensions v4) '(6))
+ (num-test (v3 1 2 3) 0)
+ (set! (v3 1 2 3) 32)
+ (num-test (v3 1 2 3) 32)
+ (num-test (vector-length v3) 24)
+ (num-test (vector-ref v3 1 2 3) 32)
+ (vector-set! v3 1 2 3 -32)
+ (num-test (v3 1 2 3) -32)
+ (test (v3 1 2) 'error)
+ (test (set! (v3 1 2) 3) 'error)
+ (test (vector-ref v3 1 2) 'error)
+ (test (vector-set! v3 1 2 32) 'error))
+
+ (test (let ((v #2d((1 2) (3 4)))) (vector-fill! v #t) v) #2D((#t #t) (#t #t)))
+
+ (test-w "#2d((1 2) #2d((3 4) 5 6))")
+ (test (string=? (object->string #2d((1 2) (3 #2d((3 4) (5 6))))) "#2D((1 2) (3 #2D((3 4) (5 6))))") #t)
+ (test (string=? (object->string #3d(((#2d((1 2) (3 4)) #(1)) (#3d(((1))) 6)))) "#3D(((#2D((1 2) (3 4)) #(1)) (#3D(((1))) 6)))") #t)
+
+ (test (make-vector '(2 -2)) 'error)
+ (test (make-vector '(2 1/2)) 'error)
+ (test (make-vector '(2 1.2)) 'error)
+ (test (make-vector '(2 2+i)) 'error)
+ (test (make-vector '(2 "hi")) 'error)
+
+ (let ((v (make-vector '(1 1 1) 32)))
+ (test (vector? v) #t)
+ (test (equal? v #()) #f)
+ (test (vector->list v) '(32))
+ (test (vector-ref v 0) 'error)
+ (test (vector-set! v 0 0) 'error)
+ (test (vector-ref v 0 0) 'error)
+ (test (vector-set! v 0 0 0) 'error)
+ (test (vector-ref v 0 0 0) 32)
+ (test (let () (vector-set! v 0 0 0 31) (vector-ref v 0 0 0)) 31)
+ (test (vector-length v) 1)
+ (test (vector-dimensions v) '(1 1 1))
+ (test (object->string v) "#3D(((31)))")
+ )
+
+ (test (vector? #3D(((32)))) #t)
+ (test (equal? #3D(((32))) #()) #f)
+ (test (vector->list #3D(((32)))) '(32))
+ (test (#3D(((32))) 0) 'error)
+ (test (set! (#3D(((32))) 0) 0) 'error)
+ (test (#3D(((32))) 0 0) 'error)
+ (test (set! (#3D(((32))) 0 0) 0) 'error)
+ (test (#3D(((32))) 0 0 0) 32)
+ (test (vector-length #3D(((32)))) 1)
+ (test (vector-dimensions #3D(((32)))) '(1 1 1))
+ (test (object->string #3D(((32)))) "#3D(((32)))")
+
+
+ (let ((v1 (make-vector '(1 0))))
+ (test (vector? v1) #t)
+ (test (equal? v1 #()) #f)
+ (test (vector->list v1) '())
+ (test (vector-ref v1 0) 'error)
+ (test (vector-set! v1 0 0) 'error)
+ (test (vector-ref v1 0 0) 'error)
+ (test (vector-set! v1 0 0 0) 'error)
+ (test (vector-length v1) 0)
+ (test (vector-dimensions v1) '(1 0))
+ (test (object->string v1) "#2D()")
+ )
+
+ (let ((v2 (make-vector '(10 3 0))))
+ (test (vector? v2) #t)
+ (test (equal? v2 #()) #f)
+ (test (vector->list v2) '())
+ (test (vector-ref v2) 'error)
+ (test (vector-set! v2 0) 'error)
+ (test (vector-ref v2 0) 'error)
+ (test (vector-set! v2 0 0) 'error)
+ (test (vector-ref v2 0 0) 'error)
+ (test (vector-set! v2 0 0 0) 'error)
+ (test (vector-ref v2 1 2 0) 'error)
+ (test (vector-set! v2 1 2 0 0) 'error)
+ (test (vector-length v2) 0)
+ (test (vector-dimensions v2) '(10 3 0))
+ (test (object->string v2) "#3D()")
+ )
+
+ (let ((v3 (make-vector '(10 0 3))))
+ (test (vector? v3) #t)
+ (test (equal? v3 #()) #f)
+ (test (vector->list v3) '())
+ (test (vector-ref v3) 'error)
+ (test (vector-set! v3 0) 'error)
+ (test (vector-ref v3 0) 'error)
+ (test (vector-set! v3 0 0) 'error)
+ (test (vector-ref v3 0 0) 'error)
+ (test (vector-set! v3 0 0 0) 'error)
+ (test (vector-ref v3 1 0 2) 'error)
+ (test (vector-set! v3 1 0 2 0) 'error)
+ (test (vector-length v3) 0)
+ (test (vector-dimensions v3) '(10 0 3))
+ (test (object->string v3) "#3D()")
+ )
+
+ (test (((#(("hi") ("ho")) 0) 0) 1) #\i)
+ (test (string-ref (list-ref (vector-ref #(("hi") ("ho")) 0) 0) 1) #\i)
+
+ (test (equal? #2D() (make-vector '(0 0))) #t)
+ (test (equal? #2D() (make-vector '(1 0))) #f)
+ (test (equal? (make-vector '(2 2) 2) #2D((2 2) (2 2))) #t)
+ (test (equal? (make-vector '(2 2) 2) #2D((2 2) (1 2))) #f)
+ (test (equal? (make-vector '(1 2 3) 0) (make-vector '(1 2 3) 0)) #t)
+ (test (equal? (make-vector '(1 2 3) 0) (make-vector '(1 3 2) 0)) #f)
+ (test (make-vector '1 2 3) 'error)
+
+ (test (equal? (make-vector 10 '()) (make-hash-table 10)) #f)
+
+ (test (equal? #2d((1 2) (3 4)) (copy #2d((1 2) (3 4)))) #t)
+ (test (equal? #3d() #3d(((())))) #f)
+ (test (equal? #3d() #3d()) #t)
+ (test (equal? #3d() #2d()) #f)
+ (test (equal? #3d() (copy #3d())) #t)
+ (test (equal? #2d((1) (2)) #2d((1) (3))) #f)
+ (test (equal? #2d((1) (2)) (copy #2d((1) (2)))) #t)
+ (let ((v1 (make-vector '(3 2 1) #f))
+ (v2 (make-vector '(3 2 1) #f)))
+ (test (equal? v1 v2) #t)
+ (set! (v2 0 0 0) 1)
+ (test (equal? v1 v2) #f))
+ (test (equal? (make-vector '(3 2 1) #f) (make-vector '(1 2 3) #f)) #f)
+
+ (test (map (lambda (n) n) #2d((1 2) (3 4))) '(1 2 3 4))
+ (test (let ((vals '())) (for-each (lambda (n) (set! vals (cons n vals))) #2d((1 2) (3 4))) vals) '(4 3 2 1))
+ (test (map (lambda (x y) (+ x y)) #2d((1 2) (3 4)) #1d(4 3 2 1)) '(5 5 5 5))
+ (test (let ((vals '())) (for-each (lambda (x y) (set! vals (cons (+ x y) vals))) #2d((1 2) (3 4)) #1d(4 3 2 1)) vals) '(5 5 5 5))
+
+ (let ((v #2D((#(1 2) #(3 4)) (#2d((5 6) (7 8)) #2D((9 10 11) (12 13 14))))))
+ (test (v 0 0) #(1 2))
+ (test (v 0 1) #(3 4))
+ (test (v 1 0) #2d((5 6) (7 8)))
+ (test (v 1 1) #2D((9 10 11) (12 13 14)))
+ (test ((v 1 0) 0 1) 6)
+ (test ((v 0 1) 1) 4)
+ (test ((v 1 1) 1 2) 14))
+
+ (let ((v #2D((#((1) #(2)) #(#(3) (4))) (#2d(((5) #(6)) (#(7) #(8))) #2D((#2d((9 10) (11 12)) (13)) (14 15))))))
+ (test (v 0 0) #((1) #(2)))
+ (test (v 0 1) #(#(3) (4)))
+ (test (v 1 0) #2D(((5) #(6)) (#(7) #(8))))
+ (test (v 1 1) #2D((#2D((9 10) (11 12)) (13)) (14 15)))
+ (test ((v 1 0) 0 1) #(6))
+ (test (((v 1 0) 0 1) 0) 6)
+ (test ((v 0 1) 1) '(4))
+ (test (((v 1 1) 0 0) 1 0) 11))
+
+ ))
+
+
+;;; -------- circular structures --------
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (apply + lst) 'error))
+
+(let ((l1 (list 1)))
+ (test (object->string (list l1 1 l1)) "(#1=(1) 1 #1#)"))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (object->string (append '(1) lst)) "(1 . #1=(1 2 3 . #1#))"))
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (append lst '()) 'error))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (sort! lst <) 'error))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (object->string (list lst)) "(#1=(1 2 3 . #1#))"))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (object->string (make-list 4 lst)) "(#1=(1 2 3 . #1#) #1# #1# #1#)"))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (object->string (vector lst lst)) "#(#1=(1 2 3 . #1#) #1#)"))
+
+(let ((lst `(+ 1 2 3)))
+ (set! (cdr (cdddr lst)) (cddr lst))
+ (test (object->string lst) "(+ 1 . #1=(2 3 . #1#))"))
+
+
+(let ((x (list 1 2)))
+ (test (equal? x x) #t)
+ (test (equal? x (cdr x)) #f)
+ (test (equal? x '()) #f))
+(let ((x (list 1 (list 2 3) (list (list 4 (list 5)))))
+ (y (list 1 (list 2 3) (list (list 4 (list 5))))))
+ (test (equal? x y) #t))
+(let ((x (list 1 (list 2 3) (list (list 4 (list 5)))))
+ (y (list 1 (list 2 3) (list (list 4 (list 5) 6)))))
+ (test (equal? x y) #f))
+
+(test (length '()) 0)
+;;; (test (length (cons 1 2)) -1)
+(test (length '(1 2 3)) 3)
+
+(test (let ((lst (list))) (fill! lst 0) lst) '())
+(test (let ((lst (list 1))) (fill! lst 0) lst) '(0))
+(test (let ((lst (list 1 2))) (fill! lst 0) lst) '(0 0))
+(test (let ((lst (list 1 (list 2 3)))) (fill! lst 0) lst) '(0 0))
+(test (let ((lst (cons 1 2))) (fill! lst 0) lst) '(0 . 0))
+(test (let ((lst (cons 1 (cons 2 3)))) (fill! lst 0) lst) '(0 0 . 0))
+
+(let ((lst1 (list 1 2)))
+ (test (length lst1) 2)
+ (list-set! lst1 0 lst1)
+ (test (length lst1) 2) ; its car is a circular list, but it isn't
+ (test (list->string lst1) 'error)
+ (let ((lst2 (list 1 2)))
+ (set-car! lst2 lst2)
+ (test (equal? lst1 lst2) #t)
+ (test (eq? lst1 lst2) #f)
+ (test (eqv? lst1 lst2) #f)
+ (test (pair? lst1) #t)
+ (test (null? lst1) #f)
+ (test (car lst2) lst2)
+ (test (car lst1) lst1)
+ (test (let ()
+ (fill! lst1 32)
+ lst1)
+ '(32 32))))
+
+(let ((lst1 (list 1)))
+ (test (length lst1) 1)
+ (set-cdr! lst1 lst1)
+ (test (infinite? (length lst1)) #t)
+ (test (null? lst1) #f)
+ (test (pair? lst1) #t)
+ (let ((lst2 (cons 1 '())))
+ (set-cdr! lst2 lst2)
+ (test (equal? lst1 lst2) #t)
+ (set-car! lst2 0)
+ (test (equal? lst1 lst2) #f)
+ (test (infinite? (length lst2)) #t)))
+
+(let ((lst1 (list 1))
+ (lst2 (list 1)))
+ (set-car! lst1 lst2)
+ (set-car! lst2 lst1)
+ (test (equal? lst1 lst2) #t)
+ (test (length lst1) 1)
+ (let ((lst3 (list 1)))
+ (test (equal? lst1 lst3) #f)
+ (set-cdr! lst3 lst3)
+ (test (equal? lst1 lst3) #f)))
+
+(let ((lst1 (list 'a 'b 'c)))
+ (set! (cdr (cddr lst1)) lst1)
+ (test (infinite? (length lst1)) #t)
+ (test (memq 'd lst1) #f)
+ (test (memq 'a lst1) lst1)
+ (test (memq 'b lst1) (cdr lst1)))
+
+(let ((lst1 (list 1 2 3)))
+ (list-set! lst1 1 lst1)
+ (test (object->string lst1) "#1=(1 #1# 3)"))
+
+
+(test (copy (list 1 2 (list 3 4))) '(1 2 (3 4)))
+(test (copy (cons 1 2)) '(1 . 2))
+(test (copy '(1 2 (3 4) . 5)) '(1 2 (3 4) . 5))
+(test (copy '()) '())
+
+(test (object->string (let ((l1 (list 0 1))) (set! (l1 1) l1) (copy l1))) "(0 #1=(0 #1#))")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "(1 . #1=(1 . #1#))")
+(test (object->string (let ((l1 (list 1 2))) (copy (list l1 4 l1)))) "(#1=(1 2) 4 #1#)")
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 2 3 . #1=(2 3 . #1#))")
+
+(test (reverse '(1 2 (3 4))) '((3 4) 2 1))
+(test (reverse '(1 2 3)) '(3 2 1))
+(test (reverse '()) '())
+(test (let ((lst (list 1 2 3))) (set! (lst 2) lst) (object->string (reverse lst))) "(#1=(1 2 #1#) 2 1)")
+(test (let ((l1 (cons 1 '()))) (set-cdr! l1 l1) (object->string (reverse l1))) "(#1=(1 . #1#) 1 1 1)")
+
+
+(test (equal? (vector 0) (vector 0)) #t)
+(test (equal? (vector 0 #\a "hi" (list 1 2 3)) (vector 0 #\a "hi" (list 1 2 3))) #t)
+(test (let ((v (vector 0))) (equal? (vector v) (vector v))) #t)
+
+(let ((v1 (make-vector 1 0)))
+ (set! (v1 0) v1)
+ (test (vector? v1) #t)
+ (let ((v2 (vector 0)))
+ (vector-set! v2 0 v2)
+ (test (vector-length v1) 1)
+ (test (equal? v1 v2) #t)
+ (test (equal? (vector-ref v1 0) v1) #t)
+ (test (equal? (vector->list v1) (list v1)) #t)
+ (vector-fill! v1 0)
+ (test (equal? v1 (vector 0)) #t)
+ (let ((v3 (copy v2)))
+ (test (equal? v2 v3) #t)
+ (vector-set! v3 0 0)
+ (test (equal? v3 (vector 0)) #t))
+ ))
+
+(let ((v1 (make-vector 1 0))
+ (v2 (vector 0)))
+ (set! (v1 0) v2)
+ (set! (v2 0) v1)
+ (test (equal? v1 v2) #t))
+
+(let* ((l1 (list 1 2))
+ (v1 (vector 1 2))
+ (l2 (list 1 l1 2))
+ (v2 (vector l1 v1 l2)))
+ (vector-set! v1 0 v2)
+ (list-set! l1 1 l2)
+ (test (equal? v1 v2) #f))
+
+(let ((v1 (make-vector 1 0)))
+ (set! (v1 0) v1)
+ (let ((v2 (vector 0)))
+ (vector-set! v2 0 v2)
+ (test (equal? v1 v2) #t)))
+
+(let ((v1 (make-vector 1 0)))
+ (set! (v1 0) v1)
+ (test (object->string v1) "#1=#(#1#)"))
+
+(let ((l1 (cons 0 '())))
+ (set-cdr! l1 l1)
+ (test (list->vector l1) 'error))
+
+(let ((lst (list "nothing" "can" "go" "wrong")))
+ (let ((slst (cddr lst))
+ (result '()))
+ (set! (cdr (cdddr lst)) slst)
+ (test (do ((i 0 (+ i 1))
+ (l lst (cdr l)))
+ ((or (null? l) (= i 12))
+ (reverse result))
+ (set! result (cons (car l) result)))
+ '("nothing" "can" "go" "wrong" "go" "wrong" "go" "wrong" "go" "wrong" "go" "wrong"))))
+
+#|
+;;; here is a circular function!
+(let ()
+ (define (cfunc)
+ (begin
+ (display "cfunc! ")
+ #f))
+
+ (let ((clst (procedure-source cfunc)))
+ (set! (cdr (cdr (car (cdr (cdr clst)))))
+ (cdr (car (cdr (cdr clst))))))
+
+ (cfunc))
+|#
+
+(test (let ((l (list 1 2)))
+ (list-set! l 0 l)
+ (string=? (object->string l) "#1=(#1# 2)"))
+ #t)
+(test (let ((lst (cons 1 2)))
+ (set-cdr! lst lst)
+ (string=? (object->string lst) "#1=(1 . #1#)"))
+ #t)
+(test (let ((lst (cons 1 2)))
+ (set-car! lst lst)
+ (string=? (object->string lst) "#1=(#1# . 2)"))
+ #t)
+(test (let ((lst (cons (cons 1 2) 3)))
+ (set-car! (car lst) lst)
+ (string=? (object->string lst) "#1=((#1# . 2) . 3)"))
+ #t)
+(test (let ((v (vector 1 2)))
+ (vector-set! v 0 v)
+ (string=? (object->string v) "#1=#(#1# 2)"))
+ #t)
+(test (let* ((l1 (list 1 2)) (l2 (list l1)))
+ (list-set! l1 0 l1)
+ (string=? (object->string l2) "(#1=(#1# 2))"))
+ #t)
+
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (object->string lst)) "#1=(1 2 3 . #1#)")
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr lst)) (object->string lst)) "(1 . #1=(2 3 . #1#))")
+(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (object->string lst)) "(1 2 . #1=(3 . #1#))")
+(test (let ((lst (list 1 2 3))) (set! (car lst) (cdr lst)) (object->string lst)) "(#1=(2 3) . #1#)")
+(test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) (cdr lst)) (object->string lst)) "(1 . #1=(#1# 3))")
+(test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) lst) (object->string lst)) "#1=(1 #1# 3)")
+(test (let ((l1 (list 1))) (let ((l2 (list l1 l1))) (object->string l2))) "(#1=(1) #1#)")
+
+(test (let* ((v1 (vector 1 2)) (v2 (vector v1)))
+ (vector-set! v1 1 v1)
+ (string=? (object->string v2) "#(#1=#(1 #1#))"))
+ #t)
+(test (let ((v1 (make-vector 3 1)))
+ (vector-set! v1 0 (cons 3 v1))
+ (string=? (object->string v1) "#1=#((3 . #1#) 1 1)"))
+ #t)
+(test (let ((h1 (make-hash-table 11))
+ (old-print-length *vector-print-length*))
+ (set! *vector-print-length* 32)
+ (hash-table-set! h1 "hi" h1)
+ (let ((result (object->string h1)))
+ (set! *vector-print-length* old-print-length)
+ (let ((val (string=? result "#1=#(() () () () ((\"hi\" . #1#)) () () () () () ())")))
+ (if (not val)
+ (format #t ";hash display:~% ~A~%" (object->string h1)))
+ val)))
+ #t)
+
+(test (let* ((l1 (list 1 2))
+ (v1 (vector 1 2))
+ (l2 (list 1 l1 2))
+ (v2 (vector l1 v1 l2)))
+ (vector-set! v1 0 v2)
+ (list-set! l1 1 l2)
+ (string=? (object->string v2) "#2=#(#1=(1 #3=(1 #1# 2)) #(#2# 2) #3#)"))
+ #t)
+
+(test (let ((l1 (list 1 2))
+ (l2 (list 1 2)))
+ (set! (car l1) l2)
+ (set! (car l2) l1)
+ (object->string (list l1 l2)))
+ "(#1=(#2=(#1# 2) 2) #2#)")
+
+(test (let* ((l1 (list 1 2))
+ (l2 (list 3 4))
+ (l3 (list 5 l1 6 l2 7)))
+ (set! (cdr (cdr l1)) l1)
+ (set! (cdr (cdr l2)) l2)
+ (string=? (object->string l3) "(5 #1=(1 2 . #1#) 6 #2=(3 4 . #2#) 7)"))
+ #t)
+(test (let* ((lst1 (list 1 2))
+ (lst2 (list (list (list 1 (list (list (list 2 (list (list (list 3 (list (list (list 4 lst1 5))))))))))))))
+ (set! (cdr (cdr lst1)) lst1)
+ (string=? (object->string lst2) "(((1 (((2 (((3 (((4 #1=(1 2 . #1#) 5))))))))))))"))
+ #t)
+
+
+(test (equal? '(a) (list 'a)) #t)
+(test (equal? '(a b . c) '(a b . c)) #t)
+(test (equal? '(a b (c . d)) '(a b (c . d))) #t)
+(test (equal? (list "hi" "hi" "hi") '("hi" "hi" "hi")) #t)
+(let ((l1 (list "hi" "hi" "hi"))
+ (l2 (list "hi" "hi" "hi")))
+ (fill! l1 "ho")
+ (test (equal? l1 l2) #f)
+ (fill! l2 (car l1))
+ (test (equal? l1 l2) #t))
+(let ((lst (list 1 2 3 4)))
+ (fill! lst "hi")
+ (test (equal? lst '("hi" "hi" "hi" "hi")) #t))
+(let ((vect (vector 1 2 3 4)))
+ (fill! vect "hi")
+ (test (equal? vect #("hi" "hi" "hi" "hi")) #t))
+(let ((lst (list 1 2 (list 3 4) (list (list 5) 6))))
+ (test (equal? lst '(1 2 (3 4) ((5) 6))) #t)
+ (fill! lst #f)
+ (test (equal? lst '(#f #f #f #f)) #t))
+(let ((lst (list 1 2 3 4)))
+ (set! (cdr (cdddr lst)) lst)
+ (test (equal? lst lst) #t)
+ (test (eq? lst lst) #t)
+ (test (eqv? lst lst) #t)
+ (fill! lst #f)
+ (test (object->string lst) "#1=(#f #f #f #f . #1#)")
+ (let ((l1 (copy lst)))
+ (test (equal? lst l1) #t)
+ (test (eq? lst l1) #f)
+ (test (eqv? lst l1) #f)))
+
+(test (let ((lst (list "hi" "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi"))) #t)
+(test (let ((lst (list "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi"))) #t)
+(test (let ((lst (list 1 2 3 4))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi" "hi"))) #t)
+
+
+(let ((lst '(#\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ #\| #\} #\~)))
+ (let ((str (apply string lst)))
+ (let ((lstr (list->string lst)))
+ (let ((strl (string->list str)))
+ (test (eq? str str) #t)
+ (test (eq? str lstr) #f)
+ (test (eqv? str str) #t)
+ (test (eqv? str lstr) #f)
+ (test (equal? str lstr) #t)
+ (test (equal? str str) #t)
+ (test (eq? lst strl) #f)
+ (test (eqv? lst strl) #f)
+ (test (equal? lst strl) #t)
+ (let ((l2 (copy lst))
+ (s2 (copy str)))
+ (test (eq? l2 lst) #f)
+ (test (eq? s2 str) #f)
+ (test (eqv? l2 lst) #f)
+ (test (eqv? s2 str) #f)
+ (test (equal? l2 lst) #t)
+ (test (equal? s2 str) #t))))))
+
+
+(let ((vect #(#\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ #\| #\} #\~)))
+ (let ((lst (vector->list vect)))
+ (let ((vect1 (list->vector lst)))
+ (test (eq? lst lst) #t)
+ (test (eq? lst vect) #f)
+ (test (eqv? lst lst) #t)
+ (test (eqv? lst vect) #f)
+ (test (equal? vect1 vect) #t)
+ (test (equal? lst lst) #t)
+ (test (eq? vect vect1) #f)
+ (test (eqv? vect vect1) #f)
+ (test (equal? vect vect1) #t)
+ (let ((l2 (copy vect))
+ (s2 (copy lst)))
+ (test (eq? l2 vect) #f)
+ (test (eq? s2 lst) #f)
+ (test (eqv? l2 vect) #f)
+ (test (eqv? s2 lst) #f)
+ (test (equal? l2 vect) #t)
+ (test (equal? s2 lst) #t)))))
+
+(let* ((vals (list "hi" #\A 1 'a #(1) abs 3.14 3/4 1.0+1.0i #\f '(1 . 2)))
+ (vlen (length vals)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let* ((size (max 1 (random 20)))
+ (vect (make-vector size '())))
+ (do ((n 0 (+ n 1)))
+ ((= n size))
+ (let ((choice (random 4))
+ (len (random 4)))
+ (if (= choice 0)
+ (let ((v (make-vector len)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (vector-set! v k (list-ref vals (random vlen))))
+ (vector-set! vect n v))
+ (if (= choice 1)
+ (let ((lst (make-list len #f)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (list-set! lst k (list-ref vals (random vlen))))
+ (vector-set! vect n lst))
+ (vector-set! vect n (list-ref vals (random vlen)))))))
+ (test (eq? vect vect) #t)
+ (test (eqv? vect vect) #t)
+ (test (equal? vect vect) #t)
+ (let ((lst1 (vector->list vect)))
+ (let ((lst2 (copy lst1)))
+ (test (eq? lst1 lst2) #f)
+ (test (eqv? lst1 lst2) #f)
+ (test (equal? lst1 lst2) #t))))))
+
+(let* ((lst1 (list 1 2 3))
+ (vec1 (vector 1 2 lst1)))
+ (list-set! lst1 2 vec1)
+ (let* ((lst2 (list 1 2 3))
+ (vec2 (vector 1 2 lst2)))
+ (list-set! lst2 2 vec2)
+ (test (equal? lst1 lst2) #t)
+ (test (equal? vec1 vec2) #t)
+ (vector-set! vec1 1 vec1)
+ (test (equal? lst1 lst2) #f)
+ (test (equal? vec1 vec2) #f)
+ ))
+
+(let* ((base (list #f))
+ (lst1 (list 1 2 3))
+ (vec1 (vector 1 2 base)))
+ (list-set! lst1 2 vec1)
+ (let* ((lst2 (list 1 2 3))
+ (vec2 (vector 1 2 base)))
+ (list-set! lst2 2 vec2)
+ (set! (car lst1) lst1)
+ (set! (car lst2) lst2)
+ (set! (cdr (cddr lst1)) base)
+ (set! (cdr (cddr lst2)) base)
+ (test (equal? lst1 lst2) #t)
+ (test (equal? vec1 vec2) #t)
+ (test (object->string lst1) "#1=(#1# 2 #(1 2 #2=(#f)) . #2#)")))
+
+(let ((base (list 0 #f)))
+ (let ((lst1 (list 1 base 2))
+ (lst2 (list 1 base 2)))
+ (set! (cdr (cdr base)) base)
+ (test (equal? lst1 lst2) #t)))
+
+(let ((base1 (list 0 #f))
+ (base2 (list 0 #f)))
+ (let ((lst1 (list 1 base1 2))
+ (lst2 (list 1 base2 2)))
+ (set! (cdr (cdr base1)) lst2)
+ (set! (cdr (cdr base2)) lst1)
+ (test (equal? lst1 lst2) #t)
+ (test (object->string lst1) "#1=(1 (0 #f 1 (0 #f . #1#) 2) 2)")))
+
+(let ()
+ (define-macro (c?r path)
+
+ (define (X-marks-the-spot accessor tree)
+ (if (pair? tree)
+ (or (X-marks-the-spot (cons 'car accessor) (car tree))
+ (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+ (if (eq? tree 'X) accessor #f)))
+
+ (let ((body 'lst))
+ (for-each
+ (lambda (f)
+ (set! body (list f body)))
+ (reverse (X-marks-the-spot '() path)))
+
+ `(make-procedure-with-setter
+ (lambda (lst)
+ ,body)
+ (lambda (lst val)
+ (set! ,body val)))))
+
+ (define (copy-tree lis)
+ (if (pair? lis)
+ (cons (copy-tree (car lis))
+ (copy-tree (cdr lis)))
+ lis))
+
+ (let* ((l1 '(0 (1 (2 (3 (4 (5 (6 (7 (8))))))))))
+ (l2 (list 0 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7 (list 8))))))))))
+ (l3 (copy-tree l1))
+ (cxr (c?r (0 (1 (2 (3 (4 (5 (6 (7 (X))))))))))))
+ (set! (cxr l1) 3)
+ (set! (cxr l2) 4)
+ (test (equal? l1 l2) #f)
+ (test (equal? l1 l3) #f)
+ (set! (cxr l2) 3)
+ (test (cxr l2) 3)
+ (test (cxr l1) 3)
+ (test (cxr l3) 8)
+ (test (equal? l1 l2) #t)
+ (test (equal? l2 l3) #f))
+
+ (let* ((l1 '(0 (1 (2 (3 (4 (5 (6 (7 (8))))))))))
+ (l2 (list 0 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7 (list 8))))))))))
+ (l3 (copy-tree l1))
+ (cxr (c?r (0 (1 (2 (3 (4 (5 (6 (7 (8 . X))))))))))))
+ (set! (cxr l1) l1)
+ (set! (cxr l2) l2)
+ (test (equal? l1 l2) #t)
+ (test (equal? l1 l3) #f)
+ (test (object->string l2) "#1=(0 (1 (2 (3 (4 (5 (6 (7 (8 . #1#)))))))))"))
+
+ (let* ((l1 '(0 ((((((1))))))))
+ (l2 (copy-tree l1))
+ (cxr (c?r (0 ((((((1 . X))))))))))
+ (set! (cxr l1) l2)
+ (set! (cxr l2) l1)
+ (test (equal? l1 l2) #t))
+
+ (let* ((l1 '(0 1 (2 3) 4 5))
+ (cxr (c?r (0 1 (2 3 . X) 4 5))))
+ (set! (cxr l1) (cdr l1))
+ (test (object->string l1) "(0 . #1=(1 (2 3 . #1#) 4 5))"))
+
+ (let* ((l1 '(0 1 (2 3) 4 5))
+ (l2 '(6 (7 8 9) 10))
+ (cxr1 (c?r (0 1 (2 3 . X) 4 5)))
+ (cxr2 (c?r (6 . X)))
+ (cxr3 (c?r (6 (7 8 9) 10 . X)))
+ (cxr4 (c?r (0 . X))))
+ (set! (cxr1 l1) (cxr2 l2))
+ (set! (cxr3 l2) (cxr4 l1))
+ (test (object->string l1) "(0 . #1=(1 (2 3 (7 8 9) 10 . #1#) 4 5))")
+ (test (cadr l1) 1)
+ (test (cadddr l1) 4)
+ )
+
+ (let ((l1 '((a . 2) (b . 3) (c . 4)))
+ (cxr (c?r ((a . 2) (b . 3) (c . 4) . X))))
+ (set! (cxr l1) (cdr l1))
+ (test (assq 'a l1) '(a . 2))
+ (test (assv 'b l1) '(b . 3))
+ (test (assoc 'c l1) '(c . 4))
+ (test (object->string l1) "((a . 2) . #1=((b . 3) (c . 4) . #1#))")
+ (test (assq 'asdf l1) #f)
+ (test (assv 'asdf l1) #f)
+ (test (assoc 'asdf l1) #f)
+ )
+
+ (let ((l1 '(a b c d e))
+ (cxr (c?r (a b c d e . X))))
+ (set! (cxr l1) (cddr l1))
+ (test (memq 'b l1) (cdr l1))
+ (test (memv 'c l1) (cddr l1))
+ (test (member 'd l1) (cdddr l1))
+ (test (object->string l1) "(a b . #1=(c d e . #1#))")
+ (test (memq 'asdf l1) #f)
+ (test (memv 'asdf l1) #f)
+ (test (member 'asdf l1) #f)
+ (test (pair? (member 'd l1)) #t) ; #1=(d e c . #1#)
+ )
+ )
+
+(let ((v #2d((1 2) (3 4))))
+ (set! (v 1 0) v)
+ (test (object->string v) "#1=#2D((1 2) (#1# 4))")
+ (test (length v) 4)
+ (test ((((v 1 0) 1 0) 1 0) 0 0) 1))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (lst 100) 2)
+ (test ((cdddr (cdddr (cdddr lst))) 100) 2)
+ (set! (lst 100) 32)
+ (test (object->string lst) "#1=(1 32 3 . #1#)"))
+
+(let* ((l1 (list 1 2))
+ (l2 (list l1 l1)))
+ (set! (l1 0) 32)
+ (test (equal? l2 '((32 2) (32 2))) #t))
+
+(let ((q (list 1 2 3 4)))
+ (set! (cdr (cdddr q)) q)
+ (test (car q) 1)
+ (set! (car q) 5)
+ (set! q (cdr q))
+ (test (car q) 2)
+ (test (object->string q) "#1=(2 3 4 5 . #1#)"))
+
+(let ()
+ (define (make-node prev data next) (vector prev data next))
+ (define prev (make-procedure-with-setter (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+ (define next (make-procedure-with-setter (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+ (define data (make-procedure-with-setter (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+ (let* ((head (make-node () 0 ()))
+ (cur head))
+ (do ((i 1 (+ i 1)))
+ ((= i 8))
+ (let ((next-node (make-node cur i ())))
+ (set! (next cur) next-node)
+ (set! cur (next cur))))
+ (set! (next cur) head)
+ (set! (prev head) cur)
+ (test (object->string head) "#1=#(#7=#(#6=#(#5=#(#4=#(#3=#(#2=#(#8=#(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #1#) 0 #8#)")
+#|
+ ;; in CL:
+ (let* ((head (vector nil 0 nil))
+ (cur head))
+ (do ((i 1 (+ i 1)))
+ ((= i 8))
+ (let ((node (vector nil i nil)))
+ (setf (aref node 0) cur)
+ (setf (aref cur 2) node)
+ (setf cur node)))
+ (setf (aref head 0) cur)
+ (setf (aref cur 2) head)
+ (format t "~A~%" head)) -> "#1=#(#2=#(#3=#(#4=#(#5=#(#6=#(#7=#(#8=#(#1# 1 #7#) 2 #6#) 3 #5#) 4 #4#) 5 #3#) 6 #2#) 7 #1#) 0 #8#)"
+|#
+ (let ((ahead (do ((cur head (next cur))
+ (dat '() (cons (data cur) dat)))
+ ((member (data cur) dat)
+ (reverse dat)))))
+ (let ((behind (do ((cur (prev head) (prev cur))
+ (dat '() (cons (data cur) dat)))
+ ((member (data cur) dat)
+ dat))))
+ (test (equal? ahead behind) #t)))))
+
+(let ()
+ (define (make-node prev data next) (list prev data next))
+ (define prev (make-procedure-with-setter (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+ (define next (make-procedure-with-setter (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+ (define data (make-procedure-with-setter (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+ (let* ((head (make-node () 0 ()))
+ (cur head))
+ (do ((i 1 (+ i 1)))
+ ((= i 8))
+ (let ((next-node (make-node cur i ())))
+ (set! (next cur) next-node)
+ (set! cur (next cur))))
+ (set! (next cur) head)
+ (set! (prev head) cur)
+ (test (object->string head) "#1=(#7=(#6=(#5=(#4=(#3=(#2=(#8=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #1#) 0 #8#)")
+ (let ((ahead (do ((cur head (next cur))
+ (dat '() (cons (data cur) dat)))
+ ((member (data cur) dat)
+ (reverse dat)))))
+ (let ((behind (do ((cur (prev head) (prev cur))
+ (dat '() (cons (data cur) dat)))
+ ((member (data cur) dat)
+ dat))))
+ (test (equal? ahead behind) #t))))
+ (let* ((head (make-node () 0 ()))
+ (cur head))
+ (do ((i 1 (+ i 1)))
+ ((= i 32))
+ (let ((next-node (make-node cur i ())))
+ (set! (next cur) next-node)
+ (set! cur (next cur))))
+ (set! (next cur) head)
+ (set! (prev head) cur)
+ (test (object->string head) "#1=(#31=(#30=(#29=(#28=(#27=(#26=(#25=(#24=(#23=(#22=(#21=(#20=(#19=(#18=(#17=(#16=(#15=(#14=(#13=(#12=(#11=(#10=(#9=(#8=(#7=(#6=(#5=(#4=(#3=(#2=(#32=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #8#) 8 #9#) 9 #10#) 10 #11#) 11 #12#) 12 #13#) 13 #14#) 14 #15#) 15 #16#) 16 #17#) 17 #18#) 18 #19#) 19 #20#) 20 #21#) 21 #22#) 22 #23#) 23 #24#) 24 #25#) 25 #26#) 26 #27#) 27 #28#) 28 #29#) 29 #30#) 30 #31#) 31 #1#) 0 #32#)")))
+
+(test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (append lst lst ())) 'error)
+(test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (object->string (append (list lst) (list lst) ()))) "(#1=(1 2 3 . #1#) #1#)")
+
+(let ((ht (make-hash-table 3)))
+ (set! (ht "hi") ht)
+ (test (object->string ht) "#1=#(() () ((\"hi\" . #1#)))")
+ (test (equal? (ht "hi") ht) #t))
+
+(let ((l1 '(0)) (l2 '(0)))
+ (set! (car l1) l1) (set! (cdr l1) l1) (set! (car l2) l2) (set! (cdr l2) l2)
+ (test (object->string l1) "#1=(#1# . #1#)")
+ (test (equal? l1 l2) #t)
+ (set! (cdr l1) l2)
+ (test (object->string l1) "#1=(#1# . #2=(#2# . #2#))")
+ (test (equal? l1 l2) #t)
+ (set! (cdr l1) '())
+ (test (equal? l1 l2) #f))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (map (lambda (a b)
+ (+ a b))
+ (list 4 5 6)
+ lst)
+ '(5 7 9)))
+(test (let ((lst (list 1 2 3))
+ (result '()))
+ (set! (cdr (cddr lst)) lst)
+ (for-each (lambda (a b)
+ (set! result (cons (+ a b) result)))
+ (list 4 5 6)
+ lst)
+ result)
+ '(9 7 5))
+(test (let ((lst (list 1 2 3))
+ (ctr 0))
+ (set! (cdr (cddr lst)) lst)
+ (call-with-exit
+ (lambda (return)
+ (for-each (lambda (a)
+ (if (> ctr 12)
+ (return a))
+ (set! ctr (+ ctr a)))
+ lst))))
+ 2)
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (map (lambda (a b)
+ (+ a b))
+ (vector 4 5 6)
+ lst)
+ '(5 7 9)))
+(test (let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (map (lambda (a b)
+ (+ a b))
+ (vector 4 5 6 7 8 9 10)
+ lst))
+ '(5 7 9 8 10 12 11))
+(test (map (lambda (a) a) '(0 1 2 . 3)) '(0 1 2))
+(test (let ((ctr 0)) (for-each (lambda (a) (set! ctr (+ ctr a))) '(1 2 . 3)) ctr) 3)
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (map (lambda (a b)
+ (+ a b))
+ '()
+ lst)
+ '()))
+(test (let ((lst (list 1 2 3))
+ (ctr 0))
+ (set! (cdr (cddr lst)) lst)
+ (for-each (lambda (a b)
+ (set! ctr (+ ctr (+ a b))))
+ lst '())
+ ctr)
+ 0)
+
+(test (let ((lst (list 1))) (set! (cdr lst) (car lst)) (object->string lst)) "(1 . 1)")
+(test (let ((lst (list 1))) (set! (car lst) (cdr lst)) (object->string lst)) "(())")
+
+(test (let ((lst (list 1 2 3))) (fill! lst lst) (object->string lst)) "#1=(#1# #1# #1#)")
+(test (let ((lst (vector 1 2 3))) (fill! lst lst) (object->string lst)) "#1=#(#1# #1# #1#)")
+(test (let ((lst #2d((1) (1)))) (fill! lst lst) (object->string lst)) "#1=#2D((#1#) (#1#))")
+
+
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; HASH-TABLES
+;;; --------------------------------------------------------------------------------
+
+(let ((ht (make-hash-table)))
+ (test (hash-table? ht) #t)
+ (test (equal? ht ht) #t)
+ (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14)
+ (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14)
+ (test (let () (hash-table-set! ht 123 "hiho") (hash-table-ref ht 123)) "hiho")
+ (test (let () (hash-table-set! ht 3.14 "hi") (hash-table-ref ht 3.14)) "hi")
+ (test (let () (hash-table-set! ht our-pi "hiho") (hash-table-ref ht our-pi)) "hiho")
+ (test (hash-table-ref ht "123") #f)
+ (let ((ht1 (copy ht)))
+ (test (hash-table? ht1) #t)
+ (test (= (length ht) (length ht1)) #t)
+ (test (equal? ht ht1) #t)
+ (set! (ht 'key) 32)
+ (set! (ht1 'key) 123)
+ (test (and (= (ht 'key) 32) (= (ht1 'key) 123)) #t)
+ (set! (ht "key") 321)
+ (test (ht "key") 321)
+ (test (ht 'key) 32)
+ (set! (ht 123) 43)
+ (set! (ht "123") 45)
+ (test (ht 123) 43)
+ (test (ht "123") 45))
+ (test (let () (set! (hash-table-ref ht 'key) 32) (hash-table-ref ht 'key)) 32)
+
+ (for-each
+ (lambda (arg)
+ (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
+
+(for-each
+ (lambda (arg)
+ (test (hash-table-set! arg 'key 32) 'error))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+
+(let ((ht (make-hash-table 277)))
+ (test (hash-table? ht) #t)
+ (test (hash-table-size ht) 277)
+ (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14)
+ (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14)
+ (for-each
+ (lambda (arg)
+ (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
+
+(for-each
+ (lambda (arg)
+ (test (hash-table? arg) #f))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+
+(test (hash-table? (make-vector 3 '())) #f)
+
+(let ((ht (make-hash-table)))
+ (test (hash-table-ref ht 'not-a-key) #f)
+ (test (hash-table-ref ht "not-a-key") #f)
+ (hash-table-set! ht 'key 3/4)
+ (hash-table-set! ht "key" "hi")
+ (test (hash-table-ref ht "key") "hi")
+ (test (hash-table-ref ht 'key) 3/4)
+
+ (hash-table-set! ht 'asd 'hiho)
+ (test (hash-table-ref ht 'asd) 'hiho)
+ (hash-table-set! ht 'asd 1234)
+ (test (hash-table-ref ht 'asd) 1234))
+
+(for-each
+ (lambda (arg)
+ (test (hash-table-ref arg 'key) 'error))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((ht1 (make-hash-table 653))
+ (ht2 (make-hash-table 277)))
+ (test (equal? ht1 ht2) #f)
+ (hash-table-set! ht1 'key 'hiho)
+ (hash-table-set! ht2 (hash-table-ref ht1 'key) 3.14)
+ (test (hash-table-size ht1) 653)
+ (test (hash-table-ref ht2 'hiho) 3.14)
+ (test (hash-table-ref ht2 (hash-table-ref ht1 'key)) 3.14))
+
+(let ((ht1 (make-hash-table)))
+ (set! (ht1 1) 'hi)
+ (let ((ht2 (make-hash-table)))
+ (set! (ht2 1) ht1)
+ (test ((ht2 1) 1) 'hi)))
+
+(test (hash-table?) 'error)
+(test (hash-table? 1 2) 'error)
+
+(test (make-hash-table 10 1) 'error)
+
+(let ((ht (make-hash-table)))
+ (test (hash-table? ht ht) 'error)
+ (test (hash-table-ref ht #\a #\b) 'error)
+ (test (hash-table-ref ht) 'error)
+ (test (hash-table-ref) 'error)
+ (test (hash-table-set!) 'error)
+ (test (hash-table-set! ht) 'error)
+ (test (hash-table-set! ht #\a) 'error)
+ (test (hash-table-set! ht #\a #\b #\c) 'error)
+ (test (fill! ht 123) 'error)
+ (set! (ht 'key) 32)
+ (test (ht 'key) 32)
+ (set! (ht :key) 123)
+ (test (ht 'key) 32)
+ (test (ht :key) 123)
+ (fill! ht '())
+ (test (ht 'key) #f))
+
+(let ((ht (make-hash-table)))
+ (test (hash-table-set! ht #\a 'key) 'error)
+ (for-each
+ (lambda (arg)
+ (test (hash-table-set! ht arg 3.14) 'error))
+ (list #\a '#(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (for-each
+ (lambda (arg)
+ (test (hash-table-ref ht arg) 'error))
+ (list #\a '#(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
+
+(for-each
+ (lambda (arg)
+ (test (hash-table-size arg) 'error))
+ (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+ (test (make-hash-table arg) 'error))
+ (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((ht1 (make-hash-table))
+ (ht2 (make-hash-table)))
+ (test (equal? ht1 ht2) #t)
+ (test (equal? ht1 (make-vector (hash-table-size ht1) '())) #f)
+ (hash-table-set! ht1 'key 'hiho)
+ (test (equal? ht1 ht2) #f)
+ (hash-table-set! ht2 'key 'hiho)
+ (test (equal? ht1 ht2) #t)
+ )
+
+(let ((ht (hash-table '("hi" . 32) '("ho" . 1))))
+ (test (ht "hi") 32)
+ (test (ht "ho") 1))
+
+(let ((ht (hash-table)))
+ (test (hash-table? ht) #t))
+
-(if (provided? 'multidimensional-vectors)
- (let ((v1 (make-vector 3 1)))
- (num-test (v1 1) 1)
- (set! (v1 1) 2)
- (num-test (v1 1) 2)
- (let ((i0 0)
- (i2 2))
- (num-test (v1 i0) 1)
- (num-test (vector-ref v1 i2) 1)
- (set! (v1 i0) 0)
- (num-test (v1 0) 0)
- (set! (v1 i0) i2)
- (num-test (v1 i0) i2))
- (test (vector-dimensions v1) '(3))
- (set! v1 (make-vector '(3 2)))
- (test (vector-dimensions v1) '(3 2))
- (vector-set! v1 1 1 0)
- (num-test (vector-ref v1 1 1) 0)
- (let ((i0 1)
- (i1 1)
- (i2 32))
- (set! (v1 i0 i1) i2)
- (num-test (vector-ref v1 1 1) 32)
- (num-test (v1 i0 i1) i2)
- (vector-set! v1 0 1 3)
- (num-test (v1 0 1) 3)
- (num-test (v1 1 1) 32))
- (set! v1 (make-vector '(2 4 3) 1))
- (test (vector-dimensions v1) '(2 4 3))
- (num-test (vector-ref v1 1 1 1) 1)
- (vector-set! v1 0 0 0 32)
- (num-test (v1 0 0 0) 32)
- (set! (v1 0 1 1) 3)
- (num-test (v1 0 1 1) 3)
-
-
- (test (let ((v1 (make-vector '(3 2) 1))
- (v2 (make-vector '(3 2) 2))
- (sum 0))
- (for-each (lambda (n m) (set! sum (+ sum n m))) v1 v2)
- sum)
- 18)
-
- (test (equal? (make-vector 0) (make-vector '(0))) #t)
- (test (make-vector (1 . 2) "hi") 'error)))
-(set! lists '())
@@ -2983,6 +5233,43 @@
(- (+ (read p) (read q)) (read p) (read q))))))
-99990)
+(call-with-output-file "empty-file" (lambda (p) #f))
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-char p)))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read p)))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-byte p)))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-line p)))) #t)
+
+(call-with-output-file "empty-file" (lambda (p) (write-char #\a p)))
+(test (call-with-input-file "empty-file" (lambda (p) (and (char=? (read-char p) #\a) (eof-object? (read-char p))))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (and (string=? (symbol->string (read p)) "a") (eof-object? (read p))))) #t) ; Guile also returns a symbol here
+(test (call-with-input-file "empty-file" (lambda (p) (and (char=? (integer->char (read-byte p)) #\a) (eof-object? (read-byte p))))) #t)
+(test (call-with-input-file "empty-file" (lambda (p) (and (string=? (read-line p) "a") (eof-object? (read-line p))))) #t)
+
+(call-with-output-file "empty-file" (lambda (p) (for-each (lambda (c) (write-char c p)) "#b11")))
+(test (call-with-input-file "empty-file" (lambda (p)
+ (and (char=? (read-char p) #\#)
+ (char=? (read-char p) #\b)
+ (char=? (read-char p) #\1)
+ (char=? (read-char p) #\1)
+ (eof-object? (read-char p)))))
+ #t)
+(test (call-with-input-file "empty-file" (lambda (p)
+ (and (= (read p) 3)
+ (eof-object? (read p)))))
+ #t)
+(test (call-with-input-file "empty-file" (lambda (p)
+ (and (= (read-byte p) (char->integer #\#))
+ (= (read-byte p) (char->integer #\b))
+ (= (read-byte p) (char->integer #\1))
+ (= (read-byte p) (char->integer #\1))
+ (eof-object? (read-byte p)))))
+ #t)
+(test (call-with-input-file "empty-file" (lambda (p)
+ (and (string=? (read-line p) "#b11")
+ (eof-object? (read-line p)))))
+ #t)
+
+
(test (output-port? (current-output-port)) #t)
(write-char #\space (current-output-port))
(write " " (current-output-port))
@@ -3290,6 +5577,952 @@
(if with-values (test (+ 100 (with-input-from-string "123" (lambda () (values (read) 1)))) 224))
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg) ;(format #t "(~A ~A)~%" op arg)
+ (test (op arg) 'error))
+ (list (integer->char 65) 1 0 -1 (list 1) (cons 1 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list char-ready? set-current-output-port set-current-input-port set-current-error-port
+ close-input-port close-output-port open-input-file open-output-file
+ read-char peek-char read
+ (lambda (arg) (write-char #\a arg))
+ (lambda (arg) (write "hi" arg))
+ (lambda (arg) (display "hi" arg))
+ call-with-input-file with-input-from-file call-with-output-file with-output-to-file))
+
+(with-output-to-file "tmp1.r5rs"
+ (lambda ()
+ (display "this is a test")
+ (newline)))
+
+(test (call-with-input-file "tmp1.r5rs" (lambda (p) (integer->char (read-byte p)))) #\t)
+(test (with-input-from-string "123" (lambda () (read-byte))) 49)
+;(test (with-input-from-string "1/0" (lambda () (read))) 'error) ; this is a reader error in CL
+;;; this test causes trouble when s7test is called from snd-test -- I can't see why
+
+(let ((bytes (vector #o000 #o000 #o000 #o034 #o000 #o001 #o215 #o030 #o000 #o000 #o000 #o022 #o000
+ #o000 #o126 #o042 #o000 #o000 #o000 #o001 #o000 #o000 #o000 #o000 #o000 #o001)))
+ (with-output-to-file "tmp1.r5rs"
+ (lambda ()
+ (for-each
+ (lambda (b)
+ (write-byte b))
+ bytes)))
+
+ (let ((ctr 0))
+ (call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (if (not (string=? (port-filename p) "tmp1.r5rs")) (display (port-filename p)))
+ (let loop ((val (read-byte p)))
+ (if (eof-object? val)
+ (if (not (= ctr 26))
+ (format #t "read-byte done at ~A~%" ctr))
+ (begin
+ (if (not (= (bytes ctr) val))
+ (format #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val))
+ (set! ctr (+ 1 ctr))
+ (loop (read-byte p))))))))
+
+ (let ((ctr 0))
+ (call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (let loop ((val (read-char p)))
+ (if (eof-object? val)
+ (if (not (= ctr 26))
+ (format #t "read-char done at ~A~%" ctr))
+ (begin
+ (if (not (= (bytes ctr) (char->integer val)))
+ (format #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val)))
+ (set! ctr (+ 1 ctr))
+ (loop (read-char p))))))))
+ )
+
+(with-output-to-file "tmp1.r5rs"
+ (lambda ()
+ (if (not (string=? (port-filename (current-output-port)) "tmp1.r5rs")) (display (port-filename (current-output-port))))
+ (display "(+ 1 2) 32")
+ (newline)
+ (display "#\\a -1")))
+
+(with-input-from-file "tmp1.r5rs"
+ (lambda ()
+ (if (not (string=? (port-filename (current-input-port)) "tmp1.r5rs")) (display (port-filename (current-input-port))))
+ (let ((val (read)))
+ (if (not (equal? val (list '+ 1 2)))
+ (format #t "read: ~A~%" val)))
+ (let ((val (read)))
+ (if (not (equal? val 32))
+ (format #t "read: ~A~%" val)))
+ (let ((val (read)))
+ (if (not (equal? val #\a))
+ (format #t "read: ~A~%" val)))
+ (let ((val (read)))
+ (if (not (equal? val -1))
+ (format #t "read: ~A~%" val)))
+ (let ((val (read)))
+ (if (not (eof-object? val))
+ (format #t "read: ~A~%" val)))
+ (let ((val (read)))
+ (if (not (eof-object? val))
+ (format #t "read again: ~A~%" val)))))
+
+
+(for-each
+ (lambda (arg)
+ (test (char-ready? arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+;;; -------- format --------
+
+(test (format #f "hiho") "hiho")
+(test (format #f "") "")
+(test (format #f "a") "a")
+
+(test (format #f "~~") "~")
+(test (format #f "~~~~") "~~")
+(test (format #f "a~~") "a~")
+(test (format #f "~~a") "~a")
+
+(test (format #f "hiho~%ha") (string-append "hiho" (string #\newline) "ha"))
+(test (format #f "~%") (string #\newline))
+(test (format #f "~%ha") (string-append (string #\newline) "ha"))
+(test (format #f "hiho~%") (string-append "hiho" (string #\newline)))
+
+(for-each
+ (lambda (arg res)
+ (let ((val (catch #t (lambda () (format #f "~A" arg)) (lambda args 'error))))
+ (if (or (not (string? val))
+ (not (string=? val res)))
+ (begin (display "(format #f \"~A\" ") (display arg)
+ (display " returned \"") (display val)
+ (display "\" but expected \"") (display res) (display "\"")
+ (newline)))))
+ (list "hiho" -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.5+1.5i '() '#(()) (list 1 2 3) '(1 . 2) 'hi)
+ (list "hiho" "-1" "a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi"))
+
+(test (format #f "hi ~A ho" 1) "hi 1 ho")
+(test (format #f "hi ~a ho" 1) "hi 1 ho")
+(test (format #f "~a~A~a" 1 2 3) "123")
+(test (format #f "~a~~~a" 1 3) "1~3")
+(test (format #f "~a~%~a" 1 3) (string-append "1" (string #\newline) "3"))
+
+(for-each
+ (lambda (arg res)
+ (let ((val (catch #t (lambda () (format #f "~S" arg)) (lambda args 'error))))
+ (if (or (not (string? val))
+ (not (string=? val res)))
+ (begin (display "(format #f \"~S\" ") (display arg)
+ (display " returned \"") (display val)
+ (display "\" but expected \"") (display res) (display "\"")
+ (newline)))))
+ (list "hiho" -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.5+1.5i '() '#(()) (list 1 2 3) '(1 . 2) 'hi)
+ (list "\"hiho\"" "-1" "#\\a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi"))
+
+(test (format #f "hi ~S ho" 1) "hi 1 ho")
+(test (format #f "hi ~S ho" "abc") "hi \"abc\" ho")
+(test (format #f "~s~a" #\a #\b) "#\\ab")
+(test (format #f "~C~c~C" #\a #\b #\c) "abc")
+
+(test (format #f "~{~A~}" '(1 2 3)) "123")
+(test (format #f "asb~{~A ~}asb" '(1 2 3 4)) "asb1 2 3 4 asb")
+(test (format #f "asb~{~A ~A.~}asb" '(1 2 3 4)) "asb1 2.3 4.asb")
+(test (format #f ".~{~A~}." '()) "..")
+
+(test (format #f "~{~A ~A ~}" '(1 "hi" 2 "ho")) "1 hi 2 ho ")
+(test (format #f "~{.~{+~A+~}.~}" (list (list 1 2 3) (list 4 5 6))) ".+1++2++3+..+4++5++6+.")
+(test (format #f "~{~s ~}" '(fred jerry jill)) "fred jerry jill ")
+(test (format #f "~{~s~^ ~}" '(fred jerry jill)) "fred jerry jill")
+(test (format #f "~{~s~^~^ ~}" '(fred jerry jill)) "fred jerry jill")
+(test (format #f "~{.~{~A~}+~{~A~}~}" '((1 2) (3 4 5) (6 7 8) (9))) ".12+345.678+9")
+(test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)))) ".+-1-2+-3-4-5")
+(test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)) ((6) (7 8 9)))) ".+-1-2+-3-4-5.+-6+-7-8-9")
+
+(test (format #f "~A ~* ~A" 1 2 3) "1 3")
+(test (format #f "~*" 1) "")
+(test (format #f "~{~* ~}" '(1 2 3)) " ")
+
+(test (format #f "this is a ~
+ sentence") "this is a sentence")
+
+;; ~nT handling is a mess -- what are the defaults? which is column 1? do we space up to or up to and including?
+
+(test (format #f "asdh~20Thiho") "asdh hiho")
+(test (format #f "asdh~2Thiho") "asdhhiho")
+(test (format #f "a~Tb") "ab")
+(test (format #f "0123456~4,8Tb") "0123456 b")
+ ; (test (format #f "XXX~%0123456~4,8Tb") (string-append "XXX" (string #\newline) "0123456 b")) ; clearly wrong...
+(test (format #f "0123456~0,8Tb") "0123456 b")
+ ; (test (format #f "0123456~10,8Tb") "0123456 b")
+(test (format #f "0123456~1,0Tb") "0123456b")
+(test (format #f "0123456~1,Tb") "0123456b")
+(test (format #f "0123456~1,Tb") "0123456b")
+(test (format #f "0123456~,Tb") "0123456b")
+ ; (test (format #f "0123456~7,10Tb") "0123456 b")
+ ; (test (format #f "0123456~8,10tb") "0123456 b")
+(test (format #f "0123456~3,12tb") "0123456 b")
+
+ ; (test (format #f "~40TX") " X")
+ ; (test (format #f "X~,8TX~,8TX") "X X X")
+(test (format #f "X~8,TX~8,TX") "X XX")
+ ; (test (format #f "X~8,10TX~8,10TX") "X X X")
+(test (format #f "X~8,0TX~8,0TX") "X XX")
+(test (format #f "X~0,8TX~0,8TX") "X X X")
+ ; (test (format #f "X~1,8TX~1,8TX") "X X X")
+ ; (test (format #f "X~,8TX~,8TX") "X X X")
+(test (format #f "X~TX~TX") "XXX") ; clisp and sbcl say "X X X" here and similar differences elsewhere
+(test (format #f "X~0,0TX~0,0TX") "XXX")
+(test (format #f "X~0,TX~0,TX") "XXX")
+(test (format #f "X~,0TX~,0TX") "XXX")
+
+(test (string=? (format #f "~%~&" ) (string #\newline)) #t)
+(test (string=? (format #f "~%a~&" ) (string #\newline #\a #\newline)) #t)
+(test (string=? (format #f "~%~%") (string #\newline #\newline)) #t)
+
+(test (format #f "~2,1F" 0.5) "0.5")
+(test (format #f "~:2T") 'error)
+(test (format #f "~2,1,3F" 0.5) 'error)
+(test (format #f "~<~W~>" 'foo) 'error)
+(test (format #f "~{12") 'error)
+(test (format #f "~{}") 'error)
+(test (format #f "~{}" '(1 2)) 'error)
+(test (format #f "{~}" '(1 2)) 'error)
+(test (format #f "~{~{~}}" '(1 2)) 'error)
+(test (format #f "#|~|#|") 'error)
+(test (format #f "~1.5F" 1.5) 'error)
+(test (format #f "~1+iF" 1.5) 'error)
+(test (format #f "~1,1iF" 1.5) 'error)
+(test (format #f "~0" 1) 'error)
+(test (format #f "~1") 'error)
+(test (format #f "~^" 1) 'error)
+(test (format #f "~^") "")
+(test (format #f "~D~" 9) "9~")
+(test (format #f "~&" 9) 'error)
+(test (format #f "~D~100T~D" 1 1) "1 1")
+(test (format #f ".~P." 1) "..")
+(test (format #f ".~P." 1.0) "..")
+(test (format #f ".~P." 1.2) ".s.")
+(test (format #f ".~P." 2) ".s.")
+(test (format #f ".~p." 1) "..")
+(test (format #f ".~p." 1.0) "..")
+(test (format #f ".~p." 1.2) ".s.")
+(test (format #f ".~p." 2) ".s.")
+(test (format #f ".~@P." 1) ".y.")
+(test (format #f ".~@P." 1.0) ".y.")
+(test (format #f ".~@P." 1.2) ".ies.")
+(test (format #f ".~@P." 2) ".ies.")
+(test (format #f ".~@p." 1) ".y.")
+(test (format #f ".~@p." 1.0) ".y.")
+(test (format #f ".~@p." 1.2) ".ies.")
+(test (format #f ".~@p." 2) ".ies.")
+
+(test (format #f (string #\~ #\a) 1) "1")
+(test (format #f (format #f "~~a") 1) "1")
+(test (format #f (format #f "~~a") (format #f "~D" 1)) "1")
+
+(test (format #f "~f" (/ 1 3)) "1/3") ; hmmm -- should it call exact->inexact?
+(test (format #f "~f" 1) "1")
+
+
+
+
+(if with-bignums
+ (begin
+ (test (format #f "~A" -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601) "-7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601")
+ (test (format #f "~D" -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601) "-7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601")
+ ))
+(test (format #f "~@F" 1.23) 'error)
+(test (format #f "~{testing ~D ~C ~}" (list 0 #\( 1 #\) 2 #\* 3 #\+ 4 #\, 5 #\- 6 #\. 7 #\/ 8 #\0 9 #\1 10 #\2 11 #\3 12 #\4 13 #\5 14 #\6 15 #\7 16 #\8 17 #\9 18 #\: 19 #\; 20 #\< 21 #\= 22 #\> 23 #\? 24 #\@ 25 #\A 26 #\B 27 #\C 28 #\D 29 #\E 30 #\F 31 #\G 32 #\H 33 #\I 34 #\J 35 #\K 36 #\L 37 #\M 38 #\N 39 #\O 40 #\P 41 #\Q 42 #\R 43 #\S 44 #\T 45 #\U 46 #\V 47 #\W 48 #\X 49 #\Y 50 #\( 51 #\) 52 #\* 53 #\+ 54 #\, 55 #\- 56 #\. 57 #\/ 58 #\0 59 #\1 60 #\2 61 #\3 62 #\4 63 #\5 64 #\6 65 #\7 66 #\8 67 #\9 68 #\: 69 #\; 70 #\< 71 #\= 72 #\> 73 #\? 74 #\@ 75 #\A 76 #\B 77 #\C 78 #\D 79 #\E 80 #\F 81 #\G 82 #\H 83 #\I 84 #\J 85 #\K 86 #\L 87 #\M 88 #\N 89 #\O 90 #\P 91 #\Q 92 #\R 93 #\S 94 #\T 95 #\U 96 #\V 97 #\W 98 #\X 99 #\Y))
+ "testing 0 ( testing 1 ) testing 2 * testing 3 + testing 4 , testing 5 - testing 6 . testing 7 / testing 8 0 testing 9 1 testing 10 2 testing 11 3 testing 12 4 testing 13 5 testing 14 6 testing 15 7 testing 16 8 testing 17 9 testing 18 : testing 19 ; testing 20 < testing 21 = testing 22 > testing 23 ? testing 24 @ testing 25 A testing 26 B testing 27 C testing 28 D testing 29 E testing 30 F testing 31 G testing 32 H testing 33 I testing 34 J testing 35 K testing 36 L testing 37 M testing 38 N testing 39 O testing 40 P testing 41 Q testing 42 R testing 43 S testing 44 T testing 45 U testing 46 V testing 47 W testing 48 X testing 49 Y testing 50 ( testing 51 ) testing 52 * testing 53 + testing 54 , testing 55 - testing 56 . testing 57 / testing 58 0 testing 59 1 testing 60 2 testing 61 3 testing 62 4 testing 63 5 testing 64 6 testing 65 7 testing 66 8 testing 67 9 testing 68 : testing 69 ; testing 70 < testing 71 = testing 72 > testing 73 ? testing 74 @ testing 75 A testing 76 B testing 77 C testing 78 D testing 79 E testing 80 F testing 81 G testing 82 H testing 83 I testing 84 J testing 85 K testing 86 L testing 87 M testing 88 N testing 89 O testing 90 P testing 91 Q testing 92 R testing 93 S testing 94 T testing 95 U testing 96 V testing 97 W testing 98 X testing 99 Y ")
+
+
+(test (format #f "~D" 123) "123")
+(test (format #f "~X" 123) "7b")
+(test (format #f "~B" 123) "1111011")
+(test (format #f "~O" 123) "173")
+
+(test (format #f "~10D" 123) " 123")
+(test (format #f "~10X" 123) " 7b")
+(test (format #f "~10B" 123) " 1111011")
+(test (format #f "~10O" 123) " 173")
+
+(test (format #f "~D" -123) "-123")
+(test (format #f "~X" -123) "-7b")
+(test (format #f "~B" -123) "-1111011")
+(test (format #f "~O" -123) "-173")
+
+(test (format #f "~10D" -123) " -123")
+(test (format #f "~10X" -123) " -7b")
+(test (format #f "~10B" -123) " -1111011")
+(test (format #f "~10O" -123) " -173")
+
+(test (format #f "~d" 123) "123")
+(test (format #f "~x" 123) "7b")
+(test (format #f "~b" 123) "1111011")
+(test (format #f "~o" 123) "173")
+
+(test (format #f "~10d" 123) " 123")
+(test (format #f "~10x" 123) " 7b")
+(test (format #f "~10b" 123) " 1111011")
+(test (format #f "~10o" 123) " 173")
+
+(test (format #f "~d" -123) "-123")
+(test (format #f "~x" -123) "-7b")
+(test (format #f "~b" -123) "-1111011")
+(test (format #f "~o" -123) "-173")
+
+(test (format #f "~10d" -123) " -123")
+(test (format #f "~10x" -123) " -7b")
+(test (format #f "~10b" -123) " -1111011")
+(test (format #f "~10o" -123) " -173")
+
+(test (format #f "~D" most-positive-fixnum) "9223372036854775807")
+(test (format #f "~D" (+ 1 most-negative-fixnum)) "-9223372036854775807")
+
+(test (format #f "~X" most-positive-fixnum) "7fffffffffffffff")
+(test (format #f "~X" (+ 1 most-negative-fixnum)) "-7fffffffffffffff")
+
+(test (format #f "~O" most-positive-fixnum) "777777777777777777777")
+(test (format #f "~O" (+ 1 most-negative-fixnum)) "-777777777777777777777")
+
+(test (format #f "~B" most-positive-fixnum) "111111111111111111111111111111111111111111111111111111111111111")
+(test (format #f "~B" (+ 1 most-negative-fixnum)) "-111111111111111111111111111111111111111111111111111111111111111")
+
+(num-test (inexact->exact most-positive-fixnum) most-positive-fixnum)
+
+(test (format #f "~0D" 123) "123")
+(test (format #f "~0X" 123) "7b")
+(test (format #f "~0B" 123) "1111011")
+(test (format #f "~0O" 123) "173")
+
+(test (format #f "" 1) 'error)
+(test (format #f "hiho" 1) 'error)
+(test (format #f "a~%" 1) 'error) ; some just ignore extra args
+
+(for-each
+ (lambda (arg)
+ (let ((result (catch #t (lambda () (format arg "hiho")) (lambda args 'error))))
+ (if (not (eq? result 'error))
+ (begin (display "(format ") (display arg) (display " \"hiho\")")
+ (display " returned ") (display result)
+ (display " but expected 'error")
+ (newline)))))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+ (let ((result (catch #t (lambda () (format #f arg)) (lambda args 'error))))
+ (if (not (eq? result 'error))
+ (begin (display "(format #f ") (display arg) (display ")")
+ (display " returned ") (display result)
+ (display " but expected 'error")
+ (newline)))))
+ (list -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
+
+(test (format #f "hi ~A ho" 1 2) 'error)
+(test (format #f "hi ~A ho") 'error)
+(test (format #f "hi ~S ho") 'error)
+(test (format #f "hi ~S ho" 1 2) 'error)
+(test (format #f "~C" 1) 'error)
+(test (format #f "123 ~R 321" 1) 'error)
+(test (format #f "123 ~,3R 321" 1) 'error)
+(test (format #f "~,2,3,4D" 123) 'error)
+
+(test (format #f "hi ~Z ho") 'error)
+(test (format #f "hi ~+ ho") 'error)
+(test (format #f "hi ~# ho") 'error)
+
+(test (format #f "hi ~} ho") 'error)
+(test (format #f "hi {ho~}") 'error)
+
+(test (format #f "asb~{~A asd" '(1 2 3)) 'error)
+(test (format #f "~{~A~}" 1 2 3) 'error)
+(test (format #f "asb~{~}asd" '(1 2 3)) 'error) ; this apparently makes the format.scm in Guile hang? [fixed]
+(test (format #f "asb~{ ~}asd" '(1 2 3)) 'error)
+(test (format #f "asb~{ hiho~~~}asd" '(1 2 3)) 'error)
+
+(test (format #f "~{~A ~A ~}" '(1 "hi" 2)) 'error)
+(for-each
+ (lambda (arg)
+ (let ((result (catch #t (lambda () (format #f "~F" arg)) (lambda args 'error))))
+ (if (not (eq? result 'error))
+ (begin (display "(format #f \"~F\" ") (display arg)
+ (display ") returned ") (display result)
+ (display " but expected 'error")
+ (newline)))))
+ (list #\a '#(1 2 3) "hi" '() 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
+
+(test (format #f "~D") 'error)
+ ; (test (format () "hi") "hi") ; not sure this is a good idea
+(test (format #f "~F" "hi") 'error)
+(test (format #f "~D" #\x) 'error)
+(test (format #f "~C" (list 1 2 3)) 'error)
+(test (format #f "~1/4F" 1.4) 'error)
+(test (format #f "~1.4F" 1.4) 'error)
+(test (format #f "~F" (real-part (log 0.0))) "-inf.0")
+(test (format #f "~F" (/ (real-part (log 0.0)) (real-part (log 0.0)))) "nan.0")
+(test (format #f "~1/4T~A" 1) 'error)
+(test (format #f "~T") "")
+
+
+(call-with-output-file "tmp1.r5rs" (lambda (p) (format p "this ~A ~C test ~D" "is" #\a 3)))
+(let ((res (call-with-input-file "tmp1.r5rs" (lambda (p) (read-line p)))))
+ (if (not (string=? res "this is a test 3"))
+ (begin
+ (display "call-with-input-file + format to \"tmp1.r5rs\" ... expected \"this is a test 3\", but got \"")
+ (display res) (display "\"?") (newline))))
+
+(let ((val (format #f "line 1~%line 2~%line 3")))
+ (with-input-from-string val
+ (lambda ()
+ (let ((line1 (read-line)))
+ (test (string=? line1 "line 1") #t))
+ (let ((line2 (read-line)))
+ (test (string=? line2 "line 2") #t))
+ (let ((line3 (read-line)))
+ (test (string=? line3 "line 3") #t))
+ (let ((eof (read-line)))
+ (test (eof-object? eof) #t))
+ (let ((eof (read-line)))
+ (test (eof-object? eof) #t)))))
+
+
+(let ((val (format #f "line 1~%line 2~%line 3")))
+ (call-with-input-string val
+ (lambda (p)
+ (let ((line1 (read-line p #t)))
+ (test (string=? line1 (string-append "line 1" (string #\newline))) #t))
+ (let ((line2 (read-line p #t)))
+ (test (string=? line2 (string-append "line 2" (string #\newline))) #t))
+ (let ((line3 (read-line p #t)))
+ (test (string=? line3 "line 3") #t))
+ (let ((eof (read-line p #t)))
+ (test (eof-object? eof) #t))
+ (let ((eof (read-line p #t)))
+ (test (eof-object? eof) #t)))))
+
+(let ((res #f))
+ (let ((this-file (open-output-string)))
+ (format this-file "this ~A ~C test ~D" "is" #\a 3)
+ (set! res (get-output-string this-file))
+ (close-output-port this-file))
+ (if (not (string=? res "this is a test 3"))
+ (begin
+ (display "open-output-string + format ... expected \"this is a test 3\", but got \"")
+ (display res) (display "\"?") (newline))))
+
+(test (call/cc (lambda (return) (let ((val (format #f "line 1~%line 2~%line 3")))
+ (call-with-input-string val
+ (lambda (p) (return "oops"))))))
+ "oops")
+
+(format #t "format #t: ~D" 1)
+(format (current-output-port) " output-port: ~D! (this is testing output ports)~%" 2)
+;; for float formats, assume s7 for now -- use our-pi and most-positive-fixnum
+;; (format with 18 digits is enough to tell what s7_Double is via built-in pi)
+
+;; from slib/formatst.scm
+(test (string=? (format #f "abc") "abc") #t)
+(test (string=? (format #f "~a" 10) "10") #t)
+(test (string=? (format #f "~a" -1.2) "-1.2") #t)
+(test (string=? (format #f "~a" 'a) "a") #t)
+(test (string=? (format #f "~a" #t) "#t") #t)
+(test (string=? (format #f "~a" #f) "#f") #t)
+(test (string=? (format #f "~a" "abc") "abc") #t)
+(test (string=? (format #f "~a" '#(1 2 3)) "#(1 2 3)") #t)
+(test (string=? (format #f "~a" '()) "()") #t)
+(test (string=? (format #f "~a" '(a)) "(a)") #t)
+(test (string=? (format #f "~a" '(a b)) "(a b)") #t)
+(test (string=? (format #f "~a" '(a (b c) d)) "(a (b c) d)") #t)
+(test (string=? (format #f "~a" '(a . b)) "(a . b)") #t)
+(test (string=? (format #f "~a ~a" 10 20) "10 20") #t)
+(test (string=? (format #f "~a abc ~a def" 10 20) "10 abc 20 def") #t)
+(test (string=? (format #f "~d" 100) "100") #t)
+(test (string=? (format #f "~x" 100) "64") #t)
+(test (string=? (format #f "~o" 100) "144") #t)
+(test (string=? (format #f "~b" 100) "1100100") #t)
+(test (string=? (format #f "~10d" 100) " 100") #t)
+(test (string=? (format #f "~10,'*d" 100) "*******100") #t)
+(test (string=? (format #f "~c" #\a) "a") #t)
+(test (string=? (format #f "~~~~") "~~") #t)
+(test (string=? (format #f "~s" "abc") "\"abc\"") #t)
+(test (string=? (format #f "~s" "abc \\ abc") "\"abc \\\\ abc\"") #t)
+(test (string=? (format #f "~a" "abc \\ abc") "abc \\ abc") #t)
+(test (string=? (format #f "~s" "abc \" abc") "\"abc \\\" abc\"") #t)
+(test (string=? (format #f "~a" "abc \" abc") "abc \" abc") #t)
+(test (string=? (format #f "~s" #\space) "#\\space") #t)
+(test (string=? (format #f "~s" #\newline) "#\\newline") #t)
+(test (string=? (format #f "~s" #\a) "#\\a") #t)
+(test (string=? (format #f "~a" '(a "b" c)) "(a \"b\" c)") #t)
+(test (string=? (format #f "abc~
+ 123") "abc123") #t)
+(test (string=? (format #f "abc~
+123") "abc123") #t)
+(test (string=? (format #f "abc~
+") "abc") #t)
+(test (string=? (format #f "~{ ~a ~}" '(a b c)) " a b c ") #t)
+(test (string=? (format #f "~{ ~a ~}" '()) "") #t)
+(test (string=? (format #f "~{ ~a,~a ~}" '(a 1 b 2 c 3)) " a,1 b,2 c,3 ") #t)
+(test (string=? (format #f "abc ~^ xyz") "abc ") #t)
+(test (format (values #f "~A ~D" 1 2)) "1 2")
+
+(test (string=? (format #f "~B" 123) "1111011") #t)
+(test (string=? (format #f "~B" 123/25) "1111011/11001") #t)
+(test (string=? (format #f "~B" 123.25) "1111011.01") #t)
+(test (string=? (format #f "~B" 123+i) "1111011.0+1.0i") #t)
+
+(test (string=? (format #f "~D" 123) "123") #t)
+(test (string=? (format #f "~D" 123/25) "123/25") #t)
+
+(test (string=? (format #f "~O" 123) "173") #t)
+(test (string=? (format #f "~O" 123/25) "173/31") #t)
+(test (string=? (format #f "~O" 123.25) "173.2") #t)
+(test (string=? (format #f "~O" 123+i) "173.0+1.0i") #t)
+
+(test (string=? (format #f "~X" 123) "7b") #t)
+(test (string=? (format #f "~X" 123/25) "7b/19") #t)
+(test (string=? (format #f "~X" 123.25) "7b.4") #t)
+(test (string=? (format #f "~X" 123+i) "7b.0+1.0i") #t)
+
+(for-each
+ (lambda (arg)
+ (test (format #f "~F" arg) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (format #f "~D" arg) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (format #f "~X" arg) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (format #f "~C" arg) 'error))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (test (format #f arg 123) 'error))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(call-with-output-file "tmp1.r5rs"
+ (lambda (p)
+ (display 1 p)
+ (write 2 p)
+ (write-char #\3 p)
+ (format p "~D" 4)
+ (write-byte (char->integer #\5) p)
+ (call-with-output-file "tmp2.r5rs"
+ (lambda (p)
+ (display 6 p)
+ (write 7 p)
+ (write-char #\8 p)
+ (format p "~D" 9)
+ (write-byte (char->integer #\0) p)
+ (newline p)))
+ (call-with-input-file "tmp2.r5rs"
+ (lambda (pin)
+ (display (read-line pin) p)))
+ (newline p)))
+
+(test (call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (read-line p)))
+ "1234567890")
+
+(call-with-output-file "tmp1.r5rs"
+ (lambda (p)
+ (format p "12345~%")
+ (format p "67890~%")))
+
+(call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (test (read-char p) #\1)
+ (test (read-byte p) (char->integer #\2))
+ (test (peek-char p) #\3)
+ (test (char-ready? p) #t)
+ (test (read-line p) "345")
+ (test (read-line p) "67890")))
+
+(let ((op1 (set-current-output-port (open-output-file "tmp1.r5rs"))))
+ (display 1)
+ (write 2)
+ (write-char #\3)
+ (format #t "~D" 4) ; #t -> output port
+ (write-byte (char->integer #\5))
+ (let ((op2 (set-current-output-port (open-output-file "tmp2.r5rs"))))
+ (display 6)
+ (write 7)
+ (write-char #\8)
+ (format #t "~D" 9)
+ (write-byte (char->integer #\0))
+ (newline)
+ (close-output-port (current-output-port))
+ (set-current-output-port op2)
+ (let ((ip1 (set-current-input-port (open-input-file "tmp2.r5rs"))))
+ (display (read-line))
+ (close-input-port (current-input-port))
+ (set-current-input-port ip1))
+ (newline)
+ (close-output-port (current-output-port))
+ (set-current-output-port op1)))
+
+(test (call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (read-line p)))
+ "1234567890")
+
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (test (op arg display) 'error))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list call-with-output-file call-with-input-file
+ call-with-output-string call-with-input-string
+ with-input-from-string with-input-from-file
+ with-output-to-file))
+
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (test (op arg) 'error))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list open-output-file open-input-file
+ open-input-string))
+
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (test (op "hi" arg) 'error))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list write display write-byte newline write-char
+ read read-char read-byte peek-char char-ready? read-line))
+
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (test (op arg) 'error))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs (if #f #f) (lambda (a) (+ a 1)))))
+ (list set-current-input-port set-current-error-port set-current-output-port close-input-port close-output-port))
+
+(let ((hi (open-output-string)))
+ (close-output-port hi)
+ (test (get-output-string hi) 'error))
+
+;; since read of closed port will generate garbage, it needs to be an error,
+;; so I guess write of closed port should also be an error
+
+(let ((hi (open-output-string)))
+ (close-output-port hi)
+ (for-each
+ (lambda (op)
+ (test-e (op hi) (object->string op) 'closed-port))
+ (list (lambda (p) (display 1 p))
+ (lambda (p) (write 1 p))
+ (lambda (p) (write-char #\a p))
+ (lambda (p) (write-byte 0 p))
+ (lambda (p) (format p "hiho"))
+ set-current-output-port
+ set-current-input-port
+ set-current-error-port
+ newline)))
+
+(let ((hi (open-input-string "hiho")))
+ (close-input-port hi)
+ (for-each
+ (lambda (op)
+ (test-e (op hi) (object->string op) 'closed-port))
+ (list read read-char read-byte peek-char char-ready? read-line
+ port-filename port-line-number
+ set-current-output-port
+ set-current-input-port
+ set-current-error-port
+ )))
+
+(test (close-output-port (open-input-string "hiho")) 'error)
+(test (close-input-port (open-output-string)) 'error)
+
+(let* ((new-error-port (open-output-string))
+ (old-error-port (set-current-error-port new-error-port)))
+ (catch #t
+ (lambda ()
+ (format #f "~R" 123))
+ (lambda args
+ (format (current-error-port) "oops")))
+ (let ((str (get-output-string new-error-port)))
+ (set-current-error-port old-error-port)
+ (test str "oops")))
+
+
+(let ((hi (open-input-string "hiho")))
+ (for-each
+ (lambda (op)
+ (test-e (op hi) (object->string op) 'input-port))
+ (list (lambda (p) (display 1 p))
+ (lambda (p) (write 1 p))
+ (lambda (p) (write-char #\a p))
+ (lambda (p) (write-byte 0 p))
+ (lambda (p) (format p "hiho"))
+ newline))
+ (close-input-port hi))
+
+(let ((hi (open-output-string)))
+ (for-each
+ (lambda (op)
+ (test-e (op hi) (object->string op) 'output-port))
+ (list read read-char read-byte peek-char char-ready? read-line))
+ (close-output-port hi))
+
+(test (output-port? (current-error-port)) #t)
+(test (and (not (null? (current-error-port))) (input-port? (current-error-port))) #f)
+
+(call-with-output-file "tmp1.r5rs"
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (write-byte i p))))
+
+(call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (let ((b (read-byte p)))
+ (if (not (= b i))
+ (format #t "read-byte got ~A, expected ~A~%" b i))))
+ (let ((eof (read-byte p)))
+ (if (not (eof-object? eof))
+ (format #t "read-byte at end: ~A~%" eof)))
+ (let ((eof (read-byte p)))
+ (if (not (eof-object? eof))
+ (format #t "read-byte at end: ~A~%" eof)))))
+
+(call-with-output-file "tmp1.r5rs"
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (write-char (integer->char i) p))))
+
+(define our-eof #f)
+
+(call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (let ((b (read-char p)))
+ (if (or (not (char? b))
+ (not (char=? b (integer->char i))))
+ (format #t "read-char got ~A, expected ~A (~D: char? ~A)~%" b (integer->char i) i (char? (integer->char i))))))
+ (let ((eof (read-char p)))
+ (if (not (eof-object? eof))
+ (format #t "read-char at end: ~A~%" eof))
+ (set! our-eof eof))
+ (let ((eof (read-char p)))
+ (if (not (eof-object? eof))
+ (format #t "read-char again at end: ~A~%" eof)))))
+
+(test (eof-object? (integer->char 255)) #f)
+(test (eof-object? our-eof) #t)
+(test (char->integer our-eof) 'error)
+(test (char? our-eof) #f)
+(test (eof-object? ((lambda () our-eof))) #t)
+
+(test (open-input-file "[*not-a-file!*]-") 'error)
+(test (call-with-input-file "[*not-a-file!*]-" (lambda (p) p)) 'error)
+(test (with-input-from-file "[*not-a-file!*]-" (lambda () #f)) 'error)
+
+(test (open-input-file "") 'error)
+(test (call-with-input-file "" (lambda (p) p)) 'error)
+(test (with-input-from-file "" (lambda () #f)) 'error)
+
+;(test (open-output-file "/bad-dir/badness/[*not-a-file!*]-") 'error)
+;(test (call-with-output-file "/bad-dir/badness/[*not-a-file!*]-" (lambda (p) p)) 'error)
+;(test (with-output-to-file "/bad-dir/badness/[*not-a-file!*]-" (lambda () #f)) 'error)
+
+(with-output-to-file "tmp.r5rs"
+ (lambda ()
+ (write-char #\a)
+ (with-output-to-file "tmp1.r5rs"
+ (lambda ()
+ (format #t "~C" #\b)
+ (with-output-to-file "tmp2.r5rs"
+ (lambda ()
+ (display #\c)))
+ (display (with-input-from-file "tmp2.r5rs"
+ (lambda ()
+ (read-char))))))
+ (with-input-from-file "tmp1.r5rs"
+ (lambda ()
+ (write-byte (read-byte))
+ (write-char (read-char))))))
+
+(with-input-from-file "tmp.r5rs"
+ (lambda ()
+ (test (read-line) "abc")))
+
+(with-input-from-file "tmp.r5rs" ; this assumes tmp.r5rs has "abc" as above
+ (lambda ()
+ (test (read-char) #\a)
+ (test (eval-string "(+ 1 2)") 3)
+ (test (read-char) #\b)
+ (with-input-from-string "(+ 3 4)"
+ (lambda ()
+ (test (read) '(+ 3 4))))
+ (test (read-char) #\c)))
+
+(test (eval-string (object->string (with-input-from-string "(+ 1 2)" (lambda () (read))))) 3)
+(test (eval (eval-string "(with-input-from-string \"(+ 1 2)\" (lambda () (read)))")) 3)
+(test (eval-string "(eval (with-input-from-string \"(+ 1 2)\" (lambda () (read))))") 3)
+(test (eval-string (object->string (eval-string (format #f "(+ 1 2)")))) 3)
+
+;; (eval-string "(eval-string ...)") is not what it appears to be -- the outer call
+;; still sees the full string when it evaluates, not the string that results from
+;; the inner call.
+
+(test (let ((name '+))
+ (let ((+ *))
+ (eval (list name 2 3))))
+ 6)
+(test (let ((name +))
+ (let ((+ *))
+ (eval (list name 2 3))))
+ 5)
+;; why is this considered confusing? It has nothing to do with eval!
+
+(test (let ((call/cc (lambda (x)
+ (let ((c (call/cc x))) c))))
+ (call/cc (lambda (r) (r 1))))
+ 1)
+
+(for-each
+ (lambda (arg)
+ (test
+ (with-input-from-string (format #f "~A" arg)
+ (lambda ()
+ (read)))
+ arg))
+ (list 1 3/4 '(1 2) #(1 2) :hi #f #t))
+
+(num-test (with-input-from-string "3.14" (lambda () (read))) 3.14)
+(num-test (with-input-from-string "3.14+2i" (lambda () (read))) 3.14+2i)
+(num-test (with-input-from-string "#x2.1" (lambda () (read))) 2.0625)
+(test (with-input-from-string "'hi" (lambda () (read))) ''hi)
+(test (with-input-from-string "'(1 . 2)" (lambda () (read))) ''(1 . 2))
+
+
+(test
+ (let ((cin #f)
+ (cerr #f))
+ (catch #t
+ (lambda ()
+ (with-input-from-string "123"
+ (lambda ()
+ (set! cin (current-input-port))
+ (error 'testing "jump out"))))
+ (lambda args
+ (set! cerr #t)))
+ (format #f "~A ~A" cin cerr))
+ "<port string input (closed)> #t")
+
+(test
+ (let ((cout #f)
+ (cerr #f))
+ (catch #t
+ (lambda ()
+ (with-output-to-string
+ (lambda ()
+ (set! cout (current-output-port))
+ (error 'testing "jump out"))))
+ (lambda args
+ (set! cerr #t)))
+ (format #f "~A ~A" cout cerr))
+ "<port string output (closed)> #t")
+
+(call-with-output-file "tmp1.r5rs"
+ (lambda (p)
+ (display "1" p)
+ (newline p)
+ (newline p)
+ (display "2345" p)
+ (newline p)))
+
+(call-with-input-file "tmp1.r5rs"
+ (lambda (p)
+ (test (read-line p) "1")
+ (test (read-line p) "")
+ (test (read-line p) "2345")
+ (test (eof-object? (read-line p)) #t)))
+
+(for-each
+ (lambda (arg)
+ (test (port-filename arg) 'error))
+ (list "hi" -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+ (test (port-line-number arg) 'error))
+ (list "hi" -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (op)
+ (let ((tag (catch #t (lambda () (op)) (lambda args 'error))))
+ (if (not (eq? tag 'error))
+ (format #t "(~A) -> ~A (expected 'error)~%" op tag))))
+ (list set-current-input-port set-current-error-port set-current-output-port
+ close-input-port close-output-port
+ write display write-byte write-char format ; newline
+ ;read read-char read-byte peek-char char-ready? read-line ; these can default to current input
+ call-with-output-file call-with-input-file
+ call-with-output-string call-with-input-string
+ with-input-from-string with-input-from-file
+ with-output-to-file
+ open-output-file open-input-file
+ open-input-string))
+
+(for-each
+ (lambda (op)
+ (let ((tag (catch #t (lambda () (op 1 2 3 4 5)) (lambda args 'error))))
+ (if (not (eq? tag 'error))
+ (format #t "(~A 1 2 3 4 5) -> ~A (expected 'error)~%" op tag))))
+ (list set-current-input-port set-current-error-port set-current-output-port
+ close-input-port close-output-port
+ write display write-byte write-char format newline
+ read read-char read-byte peek-char char-ready? read-line
+ call-with-output-file call-with-input-file
+ call-with-output-string call-with-input-string
+ with-input-from-string with-input-from-file
+ with-output-to-file
+ open-output-file open-input-file
+ open-input-string))
+
+
+(test (string=? (object->string 32) "32") #t)
+(test (string=? (object->string 32.5) "32.5") #t)
+(test (string=? (object->string 32/5) "32/5") #t)
+(test (string=? (object->string "hiho") "\"hiho\"") #t)
+(test (string=? (object->string 'symb) "symb") #t)
+(test (string=? (object->string (list 1 2 3)) "(1 2 3)") #t)
+(test (string=? (object->string (cons 1 2)) "(1 . 2)") #t)
+(test (string=? (object->string '#(1 2 3)) "#(1 2 3)") #t)
+(test (string=? (object->string +) "+") #t)
+(test (object->string (object->string (object->string "123"))) "\"\\\"\\\\\\\"123\\\\\\\"\\\"\"")
+(test (object->string) 'error)
+(test (object->string 1 2) 'error)
+(test (object->string abs) "abs")
+
+
+;;; (string-set! (with-input-from-string "\"1234\"" (lambda () (read))) 1 #\a)
+
+
+
;;; --------------------------------------------------------------------------------
@@ -3316,7 +6549,7 @@
(format #t "~A not equal? to itself?~%" op)))
control-ops)
-(define question-ops (list boolean? eof-object? string?
+(define question-ops (list boolean? eof-object? string?
number? integer? real? rational? complex? char?
list? vector? pair? null?))
@@ -3360,8 +6593,7 @@
(test (if (list) 2 3) 2)
(test (if "" 2 3) 2)
(test (eq? (if #f #f) (if #f #f)) #t) ; I assume there's only one #<unspecified>!
-
- ;(test (if () () ()) 'error) ; ?? s7 thinks it's ok
+(test (if . (1 2)) 2)
(test (let ((a #t) (b #f) (c #t) (d #f)) (if (if (if (if d d c) d b) d a) 'a 'd)) 'a)
(test (let ((a #t) (b #f) (c #t) (d #f)) (if a (if b (if c (if d d c) c) 'b) 'a)) 'b)
@@ -3383,14 +6615,15 @@
(test (let ((ctr 0) (a #t)) (if a (let ((b ctr)) (set! ctr (+ ctr 1)) (list b ctr)) (let ((c ctr)) (set! ctr (+ ctr 100)) (list c ctr)))) (list 0 1))
(test (if if if if) if)
- ;(test (((if if if) if if) if if 'gad) if)
+(test (((if if if) if if) if if 'gad) if)
(test (if if (if if if) if) if)
- ;(test (let ((car if)) (car #t 0 1)) 0)
- ;(test ((car (list if)) #t 0 1) 0)
+(test (let ((car if)) (car #t 0 1)) 0)
+(test ((car (list if)) #t 0 1) 0)
(test (symbol->string 'if) "if")
(test (if (and if (if if if)) if 'gad) if)
- ;(test (let ((if #t)) (or if)) #t)
- ;(test (let ((if +)) (if 1 2 3)) 6)
+(test (let ((if #t)) (or if)) #t)
+;(test (let ((if +)) (if 1 2 3)) 6)
+; this is another of the "syntax" as car choices
(test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (= ctr 1)) 0 1)) 0)
(test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (if (= ctr 1) (> 3 2) (< 3 2))) 0 1)) 0)
(test ( if (> 3 2) 1 2) 1)
@@ -3400,11 +6633,11 @@
(test (let ((alist (list map car if do))) (member if alist)) (list if do))
(test (let ((alist (list map car if do))) (memv if alist)) (list if do))
(test (let ((alist (list map car if do))) (memq if alist)) (list if do))
- ;(test ((vector-ref (vector if) 0) #t 1 2) 1)
- ;(test ((vector-ref (make-vector 1 if) 0) #t 1 2) 1)
+(test ((vector-ref (vector if) 0) #t 1 2) 1)
+(test ((vector-ref (make-vector 1 if) 0) #t 1 2) 1)
(test ((if #t + -) 3 4) 7)
(test (list (if 0 1 2)) (list 1))
- ;(test ((car (list if map)) #f 1 2) 2)
+(test ((car (list if map)) #f 1 2) 2)
(test (let ((ctr 0)) (if (= ctr 0) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 2 3)) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 4 5)))) 2)
(test (let ((x (cons 1 2))) (set-cdr! x x) (if x 1 2)) 1)
(test (let ((ctr 0)) (if (let ((ctr 123)) (set! ctr (+ ctr 1)) (= ctr 124)) (let () (set! ctr (+ ctr 100)) ctr) (let () (set! ctr (+ ctr 1000)) ctr)) ctr) 100)
@@ -3468,6 +6701,19 @@
ctr)
969)
+(test (if #f) 'error)
+(test (if (< 2 3)) 'error)
+(test (if #f 1 2 3) 'error)
+(test (if 1 2 3 4) 'error)
+(test (if #f 1 else 2) 'error)
+(test (if) 'error)
+(test ('+ '1 '2) 'error)
+(test (if 1 . 2) 'error)
+(test (if 1 2 . 3) 'error)
+(test (if . 1) 'error)
+(test (if _no_var_ 1) 'error)
+
+
@@ -3517,6 +6763,13 @@
(test ((lambda (quote) (+ quote 1)) 2) 3)
(test ((lambda (quote . args) (list quote args)) 1 2 3) '(1 (2 3)))
+(test (quote . -1) 'error)
+(test (quote 1 1) 'error)
+(test (quote . 1) 'error)
+(test (quote . (1 2)) 'error)
+(test (quote 1 . 2) 'error)
+
+
;;; -------- for-each --------
@@ -3535,7 +6788,7 @@
(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2) '(2 1 0)) sum) 6)
(test (let () (for-each + '(0 1 2) '(2 1 0)) 0) 0)
(test (let () () ()) '())
-(test (for-each + ()) '())
+(test (for-each + ()) #<unspecified>)
(test (let ((d 0))
(for-each (let ((a 0))
(for-each (lambda (b) (set! a (+ a b))) (list 1 2))
@@ -3635,6 +6888,46 @@
(test (let* ((x (list (list 1 2 3))) (y (apply for-each abs x))) x) '((1 2 3)))
+(test (for-each (lambda (x) (display "for-each should not have called this"))) 'error)
+;(test (for-each (lambda () 1) '()) 'error)
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) '()) ctr) 0)
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6)) ctr) 15)
+(test (for-each (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1) (list)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1) (list 1 2)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (cons 1 2) (list 1 2)) #<unspecified>)
+(test (for-each (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
+(test (for-each (lambda (a) (+ a 1)) #\a) 'error)
+(test (for-each (lambda (a) (+ a 1)) (cons 1 2)) #<unspecified>)
+(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2)) sum) 'error)
+(test (for-each (lambda (a) a) '(1 2 . 3)) #<unspecified>)
+(for-each
+ (lambda (arg)
+ (test (for-each arg (list 1)) 'error))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+(for-each
+ (lambda (arg)
+ (test (for-each (lambda (n m) n) (list 1) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+
+(for-each
+ (lambda (arg)
+ (test (for-each (lambda (a) a) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+
+(test (for-each abs '() abs) #<unspecified>)
+(test (for-each abs '(1) '#(1)) 'error)
+(test (let ((vals '())) (for-each for-each (list (lambda (a) (set! vals (cons (abs a) vals)))) (list (list -1 -2))) vals) '(2 1))
+
+
;;; -------- map --------
@@ -3734,6 +7027,67 @@
(test (map char-upcase "hi") '(#\H #\I))
(test (map append #(#() #())) '(#() #()))
+(test (map abs '() abs) '())
+(test (map (lambda (x) (display "map should not have called this"))) 'error)
+;(test (map (lambda () 1) '()) 'error)
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) '())) '())
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6))) '(6 15))
+
+(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1) (list)) '())
+(test (map (lambda (a b) (+ a b)) (list 1) (list 2)) (list 3))
+(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1) (list 1 2)) '(2))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) '(2 4))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2))
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) '())
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
+(test (map (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) '(2))
+
+(test (map (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
+(test (map (lambda (a) (+ a 1)) #\a) 'error)
+(test (map (lambda (a) (+ a 1)) (cons 1 2)) '(2))
+(test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2)) 'error)
+(test (map (lambda (a) a) '(1 2 . 3)) '(1 2))
+(for-each
+ (lambda (arg)
+ (test (map arg (list 1)) 'error))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+(for-each
+ (lambda (arg)
+ (test (map (lambda (n m) n) (list 1) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+
+(for-each
+ (lambda (arg)
+ (test (map (lambda (a) a) arg) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+
+(test (map (lambda (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
+ (max a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
+ (list 6 7 8 9 10)
+ (list 21 22 23 24 25)
+ (list 16 17 18 19 20)
+ (list 11 12 13 14 15)
+ (list 26 27 28 29 30)
+ (list 1 2 3 4 5)
+ (list 36 37 38 39 40)
+ (list 41 42 43 44 45)
+ (list 46 47 48 49 50)
+ (list 31 32 33 34 35))
+ (list 46 47 48 49 50))
+
+(test (map map (list abs) (list (list -1))) '((1)))
+(test (map map (list map) (list (list abs)) (list (list (list -1)))) '(((1))))
+(test (map map (list map) (list (list map)) (list (list (list abs))) (list (list (list (list -1 -3))))) '((((1 3)))))
+(test (let () (define (mrec a b) (if (<= b 0) (list a) (map mrec (list a) (list (- b 1))))) (mrec (list 1 2) 5)) '(((((((1 2))))))))
+
+
+
+
+
;;; --------- do --------
@@ -3829,6 +7183,24 @@
(test (do ((i 0 (+ i 1))) ((or (= i 12) (not (number? i)) (> (expt 2 i) 32)) (expt 2 i))) 64)
(test (let ((k 0)) (do ((i 0 (+ i 1))) ((let () (set! k (+ k 1)) (set! i (+ i 1)) (> k 3)) i))) 7)
+(test (let ((lst '(1 2 3))
+ (v (vector 0 0 0)))
+ (do ((l lst (map (lambda (a) (+ a 1)) (cdr l))))
+ ((null? l))
+ (set! (v (- (length l) 1)) (apply + l)))
+ v)
+ #(5 7 6))
+
+(test (let ((lst '(1 2 3)))
+ (map (lambda (a)
+ (let ((! 1))
+ (do ((i 0 (+ i 1))
+ (sum 0))
+ ((= i a) sum)
+ (set! sum (+ sum a)))))
+ lst))
+ '(1 4 9))
+
(test (let ((sum 0)) (do ((i_0 0 (+ i_0 0))(i_1 1 (+ i_1 1))(i_2 2 (+ i_2 2))(i_3 3 (+ i_3 3))(i_4 4 (+ i_4 4))(i_5 5 (+ i_5 5))(i_6 6 (+ i_6 6))(i_7 7 (+ i_7 7))(i_8 8 (+ i_8 8))(i_9 9 (+ i_9 9))(i_10 10 (+ i_10 10))(i_11 11 (+ i_11 11))(i_12 12 (+ i_12 12))(i_13 13 (+ i_13 13))(i_14 14 (+ i_14 14))(i_15 15 (+ i_15 15))(i_16 16 (+ i_16 16))(i_17 17 (+ i_17 17))(i_18 18 (+ i_18 18))(i_19 19 (+ i_19 19))(i_20 20 (+ i_20 20))(i_21 21 (+ i_21 21))(i_22 22 (+ i_22 22))(i_23 23 (+ i_23 23))(i_24 24 (+ i_24 24))(i_25 25 (+ i_25 25))(i_26 26 (+ i_26 26))(i_27 27 (+ i_27 27))(i_28 28 (+ i_28 28))(i_29 29 (+ i_29 29))(i_30 30 (+ i_30 30))(i_31 31 (+ i_31 31))(i_32 32 (+ i_32 32))(i_33 33 (+ i_33 33))(i_34 34 (+ i_34 34))(i_35 35 (+ i_35 35))(i_36 36 (+ i_36 36))(i_37 37 (+ i_37 37))(i_38 38 (+ i_38 38))(i_39 39 (+ i_39 39)))
((= i_1 10) sum)
(set! sum (+ sum i_0 i_1 i_2 i_3 i_4 i_5 i_6 i_7 i_8 i_9 i_10 i_11 i_12 i_13 i_14 i_15 i_16 i_17 i_18 i_19 i_20 i_21 i_22 i_23 i_24 i_25 i_26 i_27 i_28 i_29 i_30 i_31 i_32 i_33 i_34 i_35 i_36 i_37 i_38 i_39))))
@@ -3958,6 +7330,53 @@
(vector-set! vec j n))
'#(9 8 7 6 5 4 3 2 1 0)))
+(test (do '() (#t 1)) 'error)
+(test (do . 1) 'error)
+(test (do ((i i i)) (i i)) 'error)
+(test (do ((i 0 i (+ i 1))) (i i)) 'error)
+(test (do ((i)) (#t i)) 'error)
+(test (do ((i 0 (+ i 1))) #t) 'error)
+(test (do 123 (#t 1)) 'error)
+(test (do ((i 1)) (#t . 1) 1) 'error)
+(test (do ((i 1) . 1) (#t 1) 1) 'error)
+(test (do ((i 1) ()) (= i 1)) 'error)
+(test (do ((i 0 . 1)) ((= i 1)) i) 'error)
+(test (do ((i 0 (+ i 1))) ((= i 3)) (set! i "hiho")) 'error)
+(test (let ((do+ +)) (do ((i 0 (do+ i 1))) ((= i 3)) (set! do+ abs))) 'error)
+(test (do () . 1) 'error)
+(test (do ((i)) (1 2)) 'error)
+(test (do (((i))) (1 2)) 'error)
+(test (do ((i 1) ((j))) (1 2)) 'error)
+(test (do (((1))) (1 2)) 'error)
+
+(test (let ((j #f))
+ (do ((i 0 (let ((x 0))
+ (dynamic-wind
+ (lambda ()
+ (set! x i))
+ (lambda ()
+ (+ x 1))
+ (lambda ()
+ (if (> x 3)
+ (set! j #t)))))))
+ (j i)))
+ 5)
+(test (let ((j 0)) (do ((i 0 (eval-string "(+ j 1)"))) ((= i 4) j) (set! j i))) 3)
+(test (do ((i (do ((i (do ((i 0 (+ i 1)))
+ ((= i 3) (+ i 1)))
+ (do ((j 0 (+ j 1)))
+ ((= j 3)) (+ j i))))
+ ((> (do ((k 0 (+ k 1)))
+ ((= k 2) (* k 4)))
+ (do ((n 0 (+ n 1)))
+ ((= n 3) n)))
+ (do ((m 0 (+ m 1)))
+ ((= m 3) (+ m i)))))
+ i))
+ ((> i 6) i))
+ 7)
+
+
@@ -3985,7 +7404,47 @@
(set! (((z)) 1) 32)
x)
#(1 32 3))
-;; is it assumed in Scheme that a vector returned from a function is not a copy?
+
+(test (let ((a 1)) (set! a)) 'error)
+(test (let ((a 1)) (set! a 2 3)) 'error)
+(test (let ((a 1)) (set! a . 2)) 'error)
+(test (let ((a 1)) (set! a 1 . 2)) 'error)
+(test (set! "hi" 1) 'error)
+(test (set! 'a 1) 'error)
+(test (set! 1 1) 'error)
+(test (set! (list 1 2) 1) 'error)
+(test (set! (let () 'a) 1) 'error)
+(test (set!) 'error)
+(test (set! #t #f) 'error)
+(test (set! '() #f) 'error)
+(test (set! #(1 2 3) 1) 'error)
+(test (set! (call/cc (lambda (a) a)) #f) 'error)
+(test (set! 3 1) 'error)
+(test (set! 3/4 1) 'error)
+(test (set! 3.14 1) 'error)
+(test (set! #\a 12) 'error)
+(test (set! (1 2) #t) 'error)
+(test (set! _not_a_var_ 1) 'error)
+(test (set! (_not_a_pws_) 1) 'error)
+
+(test (let ((a (lambda (x) (set! a 3) x))) (list (a 1) a)) 'error)
+(test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error)
+(test (let ((a (lambda () "hi"))) (set! (a) "ho")) 'error)
+(test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error)
+
+(test (set! . -1) 'error)
+(test (set!) 'error)
+(test (let ((x 1)) (set! x x x)) 'error)
+(test (let ((x 1)) (set! x x) x) 1)
+(test (set! set! 123) 'error)
+(test (set! (cons 1 2) 3) 'error)
+(test (let ((var 1) (val 2)) (set! var set!) (var val 3) val) 3)
+(test (let ((var 1) (val 2)) (set! var +) (var val 3)) 5)
+(test (let ((sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 1))
+ (set! sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 2)
+ sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789)
+ 2)
+
@@ -4030,6 +7489,10 @@
(test (or 0) 0)
(test (if (or) 1 2) 2)
+(test (or . 1) 'error)
+(test (or #f . 1) 'error)
+(test (or . (1 2)) 1)
+
;;; -------- and --------
@@ -4076,6 +7539,9 @@
(test (call/cc (lambda (r) (and #t (< 3 2) (r 123) 321))) #f)
(test (+ (and (null? '()) 3) (and (zero? 0) 2)) 5)
+(test (and . #t) 'error)
+(test (and 1 . 2) 'error)
+(test (and . (1 2)) 2)
@@ -4111,6 +7577,8 @@
;;; (cond (1 1) (asdf 3)) -- should this be an error?
(test (cond (+ 0)) 0)
+(test (cond . ((1 2) ((3 4)))) 2)
+
(for-each
(lambda (arg)
(test (cond ((or arg) => (lambda (x) x))) arg))
@@ -4119,7 +7587,8 @@
(test (cond ((+ 1 2) => (lambda (x) (+ 1 x)))) 4)
(test (cond ((cons 1 2) => car)) 1)
- ; (cond ((values 1 2) => +)) -- seems like it ought to work
+;(test (cond ((values 1 2) => +)) 'error)
+;(cond (1 2 => +))
(if with-values (test (cond ((values -1) => abs)) 1))
(test (cond (else 1)) 1)
@@ -4151,6 +7620,31 @@
;(test (and (defined? 'else) (boolean? else)) #f)
+(test (cond) 'error)
+ ;(test (cond ((= 1 2) 3) (else 4) (4 5)) 'error)
+(test (cond ((+ 1 2) => (lambda (a b) (+ a b)))) 'error)
+ ;(test (cond (else)) 'error) ; value of else might be #t -- perhaps (equal? (cond (else)) else)
+(test (cond (#t => 'ok)) 'error)
+(test (cond (else =>)) 'error)
+(if with-values (test (cond ((values -1) => => abs)) 'error))
+(if with-values (test (cond ((values -1) =>)) 'error))
+(test (cond (cond (#t 1))) 'error)
+(test (cond 1) 'error)
+(test (cond (1 . 2) (else 3)) 'error)
+(test (cond (#f 2) (else . 4)) 'error)
+(if with-values (test (cond ((values 1 2) => (lambda (x y) #t))) 'error))
+(test (cond #t) 'error)
+(test (cond 1 2) 'error)
+(test (cond 1 2 3) 'error)
+(test (cond 1 2 3 4) 'error)
+(test (cond (1 => (lambda (x y) #t))) 'error)
+(test (cond . 1) 'error)
+(test (cond ((1 2)) . 3) 'error)
+(test (cond (1 => + abs)) 'error)
+(test (cond (1 =>)) 'error)
+(if with-values (test (cond ((values 1 2) => + abs)) 'error))
+
+
;;; -------- case --------
@@ -4205,6 +7699,30 @@
(test (case (list) ((1) 1) ((()) 2)) 2)
+(test (case 1) 'error)
+(test (case 1 . "hi") 'error)
+(test (case 1 ("hi")) 'error)
+(test (case 1 ("a" "b")) 'error)
+(test (case 1 (else #f) ((1) #t)) 'error)
+(test (case "hi" (("hi" "ho") 123) ("ha" 321)) 'error)
+(test (case) 'error)
+(test (case . 1) 'error)
+(test (case 1 . 1) 'error)
+(test (case 1 (#t #f) ((1) #t)) 'error)
+(test (case 1 (#t #f)) 'error)
+(test (case -1 ((-1) => abs)) 'error)
+(test (case #t ((1 2) (3 4)) -1) 'error)
+(test (case 1 1) 'error)
+(test (case 1 ((2) 1) . 1) 'error)
+(test (case 1 (2 1) (1 1)) 'error)
+(test (case 1 (else)) 'error)
+(test (case () ((1 . 2) . 1) . 1) 'error)
+(test (case case ((case) 1) ((cond) 3)) 1)
+(test (case 101 ((0 1 2) 200) ((3 4 5 6) 600) ((7) 700) ((8) 800) ((9 10 11 12 13) 1300) ((14 15 16) 1600) ((17 18 19 20) 2000) ((21 22 23 24 25) 2500) ((26 27 28 29) 2900) ((30 31 32) 3200) ((33 34 35) 3500) ((36 37 38 39) 3900) ((40) 4000) ((41 42) 4200) ((43) 4300) ((44 45 46) 4600) ((47 48 49 50 51) 5100) ((52 53 54) 5400) ((55) 5500) ((56 57) 5700) ((58 59 60) 6000) ((61 62) 6200) ((63 64 65) 6500) ((66 67 68 69) 6900) ((70 71 72 73) 7300) ((74 75 76 77) 7700) ((78 79 80) 8000) ((81) 8100) ((82 83) 8300) ((84 85 86 87) 8700) ((88 89 90 91 92) 9200) ((93 94 95) 9500) ((96 97 98) 9800) ((99) 9900) ((100 101 102) 10200) ((103 104 105 106 107) 10700) ((108 109) 10900) ((110 111) 11100) ((112 113 114 115) 11500) ((116) 11600) ((117) 11700) ((118) 11800) ((119 120) 12000) ((121 122 123 124 125) 12500) ((126 127) 12700) ((128) 12800) ((129 130) 13000) ((131 132) 13200) ((133 134 135 136) 13600) ((137 138) 13800)) 10200)
+
+
+
+
;;; -------- lambda --------
@@ -4289,7 +7807,7 @@
(test (let ((g (lambda () '3))) (= (g) 3)) #t)
(test ((lambda lambda lambda) 'x) '(x))
- ;(test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) '(1 2 3))
+ ;(test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) 3)
(test (let () ; PLP Scott p168
(define A
@@ -4441,6 +7959,37 @@
(+ (f1 1) (f2 1)))
2)
+(test ((lambda () => abs)) 'error)
+(test ((lambda () => => 3)) 'error)
+;; actually, both Guile and Gauche accept
+;; ((lambda () + 3)) and (begin + 3)
+;; but surely => is an undefined variable in this context?
+
+(test (lambda) 'error)
+(test (lambda (a) ) 'error)
+;; should this be an error: (lambda (a) (define x 1)) ?
+(test (lambda . 1) 'error)
+(test (lambda 1) 'error)
+(test (lambda (x 1) x) 'error)
+(test (lambda "hi" 1) 'error)
+(test (lambda (x x) x) 'error)
+(test ((lambda (x x) x) 1 2) 'error)
+(test (lambda (x "a")) 'error)
+(test ((lambda (x y) (+ x y a)) 1 2) 'error)
+(test ((lambda ())) 'error)
+(test (lambda (x (y)) x) 'error)
+(test ((lambda (x) x . 5) 2) 'error)
+(test (lambda (1) #f) 'error)
+;(test (lambda (x . y z) x) 'error)
+(test ((lambda () 1) 1) 'error)
+(test ((lambda (()) 1) 1) 'error)
+(test ((lambda (x) x) 1 2) 'error)
+(test ((lambda (x) x)) 'error)
+(test ((lambda ("x") x)) 'error)
+(test ((lambda "x" x)) 'error)
+(test ((lambda (x . "hi") x)) 'error)
+(test (let ((hi (lambda (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
+
@@ -4454,6 +8003,7 @@
(test (let () (begin (define x 3)) (begin (set! x 4) (+ x x))) 8)
(test (let ((x 3)) (begin x)) 3)
(test (begin 3) 3)
+(test (begin . (1 2)) 2)
(if (equal? (begin 1) 1)
(begin
@@ -4483,9 +8033,9 @@
(test (let ((begin 3)) (+ begin 1)) 4)
(test ((lambda (x) (begin (set! x 1) (let ((a x)) (+ a 1)))) 2) 2)
;;; apparently these can be considered errors or not (guile says error, stklos and gauche do not)
- ;(test (begin (define x 0) (+ x 1)) 1)
- ;(test ((lambda () (begin (define x 0) (+ x 1)))) 1)
- ;(test (let ((f (lambda () (begin (define x 0) (+ x 1))))) (f)) 1)
+(test (begin (define x 0) (+ x 1)) 1)
+(test ((lambda () (begin (define x 0) (+ x 1)))) 1)
+(test (let ((f (lambda () (begin (define x 0) (+ x 1))))) (f)) 1)
(test ((lambda () (begin (define x 0)) (+ x 1))) 1)
(test (let ((f (lambda () (begin (define x 0)) (+ x 1)))) (f)) 1)
@@ -4503,8 +8053,10 @@
(test (let () (begin (begin (define (a3) 1)) (begin (define (a3) b3) (define b3 3)) (a3))) 3) ; yow
(test (let () (begin (begin (define (a) 1)) (a))) 1)
(test (let ((a 1)) (begin (define a 2)) a) 2)
+(if with-values (test (+ 1 (begin (values 2 3)) 4) 10))
+(if with-values (test (+ 1 (begin (values 5 6) (values 2 3)) 4) 10))
+
-;;; begin is a mess...
@@ -4527,7 +8079,8 @@
(test (apply apply (list list 1 2 '(3))) (list 1 2 3))
(test (vector? (apply make-vector '(1))) #t)
(test (apply make-vector '(1 1)) '#(1))
- ;(test (let* ((x '(1 2 3)) (y (apply list x))) (not (eq? x y))) #t) ; is this standard?
+(test (let ((f +)) (apply f '(1 2))) 3)
+ ;(test (let* ((x '(1 2 3)) (y (apply list x))) (not (eq? x y))) #f) ; is this standard?
(test (apply min '(1 2 3 5 4 0 9)) 0)
(test (apply min 1 2 4 3 '(4 0 9)) 0)
(test (apply vector 1 2 '(3)) '#(1 2 3))
@@ -4547,6 +8100,28 @@
(test (apply apply apply apply (list (list (list + '(3 2))))) 5)
(test (apply + 1 2 (list 3 4)) 10)
+(test (apply + #f) 'error)
+(test (apply #f '(2 3)) 'error)
+(test (apply make-vector '(1 2 3)) 'error)
+(test (apply + 1) 'error)
+(test (apply) 'error)
+(test (apply 1) 'error)
+(test (apply . 1) 'error)
+(test (apply car ''foo) 'error)
+(test (apply + '(1 . 2)) 'error)
+(test (apply '() '()) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (apply arg '(1)) 'error))
+ (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t)) ; "hi" and (list 1 2 3) work here because they are applicable in s7
+
+(test (let ((x (list 1 2))) (set-cdr! x x) (apply + x)) 'error)
+(test (apply + '(1 2 . 3)) 'error)
+(test (apply + '(1 2) (list 3 4)) 'error)
+(test (let () (define (mrec a b) (if (<= b 0) (list a) (apply mrec (list a) (list (- b 1))))) (mrec (list 1 2) 5)) '(((((((1 2))))))))
+
+
;;; -------- define --------
@@ -4613,6 +8188,20 @@
(test (procedure? (let () (define (a) a) (a))) #t)
+(test (define) 'error)
+(test (define x) 'error)
+(test (define . x) 'error)
+(test (define x 1 2) 'error)
+(test (define (x 1)) 'error)
+(test (define (x)) 'error)
+(test (define 1 2) 'error)
+(test (define "hi" 2) 'error)
+(test (define x 1 2) 'error)
+(test (define x 1 . 2) 'error)
+(test (define x . 1) 'error)
+(test (define x (lambda ())) 'error)
+ ;(test (define 'hi 1) 'error) ; this redefines quote, which maybe isn't an error
+(test (let () (define . 1) 1) 'error)
@@ -4713,7 +8302,27 @@
(+ (* a (call-with-values (lambda () (values 1 2 3)) +))
(* b (call-with-values (lambda () (values 1 2 3 4)) *)))))
612)
+
+ (test (call-with-values (lambda (x) (+ x 1)) (lambda (y) y)) 'error)
+ (test (+ (values . 1)) 'error)
+ (for-each
+ (lambda (arg)
+ (test (call-with-values arg arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (test (call-with-values (lambda () (values -1 2)) abs) 'error)
+
+ (test (multiple-value-bind (a b) (values 1 2) (+ a b)) 3)
+ (test (multiple-value-bind (a) 1 a) 1)
+ (test (multiple-value-bind (a . rest) (values 1 2 3) (+ a (apply + rest))) 6)
+ (test (multiple-value-bind a (values 1 2 3) a) '(1 2 3))
+
+ (test (let ((a 1)
+ (b 2))
+ (multiple-value-set! (a b) (values 32 64))
+ (+ a b))
+ 96)
))
+(test (let ((add (lambda (a b) (values (+ a 1) (+ b 1))))) (+ 1 (add 2 3))) 8)
@@ -4990,31 +8599,31 @@
;(let ((initial-chars "aA!$%&*/:<=>?^_~")
; (subsequent-chars "9aA!$%&*+-./:<=>?@^_~")
; (ctr 0))
- ; (display (format #f "(let ("))
+ ; (format #t "(let (")
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
- ; (display (format #f "(~A ~D) " (string (string-ref initial-chars i)) ctr))
+ ; (format #t "(~A ~D) " (string (string-ref initial-chars i)) ctr)
; (set! ctr (+ ctr 1)))
;
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (display (format #f "(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr))
+ ; (format #t "(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr)
; (set! ctr (+ ctr 1))))
;
- ; (display (format #f ")~% (+ "))
+ ; (format #t ")~% (+ ")
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
- ; (display (format #f "~A " (string (string-ref initial-chars i)))))
+ ; (format #t "~A " (string (string-ref initial-chars i))))
;
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (display (format #f "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))))
+ ; (format #t "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))
;
- ; (display (format #f "))~%")))
+ ; (format #t "))~%"))
(num-test (let ((a 0) (A 1) (! 2) ($ 3) (% 4) (& 5) (* 6) (/ 7) (: 8) (< 9) (= 10) (> 11) (? 12) (^ 13) (_ 14) (~ 15) (a9 16) (aa 17) (aA 18) (a! 19) (a$ 20) (a% 21) (a& 22) (a* 23) (a+ 24) (a- 25) (a. 26) (a/ 27) (a: 28) (a< 29) (a= 30) (a> 31) (a? 32) (a@ 33) (a^ 34) (a_ 35) (a~ 36) (A9 37) (Aa 38) (AA 39) (A! 40) (A$ 41) (A% 42) (A& 43) (A* 44) (A+ 45) (A- 46) (A. 47) (A/ 48) (A: 49) (A< 50) (A= 51) (A> 52) (A? 53) (A@ 54) (A^ 55) (A_ 56) (A~ 57) (!9 58) (!a 59) (!A 60) (!! 61) (!$ 62) (!% 63) (!& 64) (!* 65) (!+ 66) (!- 67) (!. 68) (!/ 69) (!: 70) (!< 71) (!= 72) (!> 73) (!? 74) (!@ 75) (!^ 76) (!_ 77) (!~ 78) ($9 79) ($a 80) ($A 81) ($! 82) ($$ 83) ($% 84) ($& 85) ($* 86) ($+ 87) ($- 88) ($. 89) ($/ 90) ($: 91) ($< 92) ($= 93) ($> 94) ($? 95) ($@ 96) ($^ 97) ($_ 98) ($~ 99) (%9 100) (%a 101) (%A 102) (%! 103) (%$ 104) (%% 105) (%& 106) (%* 107) (%+ 108) (%- 109) (%. 110) (%/ 111) (%: 112) (%< 113) (%= 114) (%> 115) (%? 116) (%@ 117) (%^ 118) (%_ 119) (%~ 120) (&9 121) (&a 122) (&A 123) (&! 124) (&$ 125) (&% 126) (&& 127) (&* 128) (&+ 129) (&- 130) (&. 131) (&/ 132) (&: 133) (&< 134) (&= 135) (&> 136) (&? 137) (&@ 138) (&^ 139) (&_ 140) (&~ 141) (*9 142) (*a 143) (*A 144) (*! 145) (*$ 146) (*% 147) (*& 148) (** 149) (*+ 150) (*- 151) (*. 152) (*/ 153) (*: 154) (*< 155) (*= 156) (*> 157) (*? 158) (*@ 159) (*^ 160) (*_ 161) (*~ 162) (/9 163) (/a 164) (/A 165) (/! 166) (/$ 167) (/% 168) (/& 169) (/* 170) (/+ 171) (/- 172) (/. 173) (// 174) (/: 175) (/< 176) (/= 177) (/> 178) (/? 179) (/@ 180) (/^ 181) (/_ 182) (/~ 183) (:9 184) (ca 185) (CA 186) (:! 187) (:$ 188) (:% 189) (:& 190) (:* 191) (:+ 192) (:- 193) (:. 194) (:/ 195) (cc 196) (:< 197) (:= 198) (:> 199) (:? 200) (:@ 201) (:^ 202) (:_ 203) (:~ 204) (<9 205) (<a 206) (<A 207) (<! 208) (<$ 209) (<% 210) (<& 211) (<* 212) (<+ 213) (<- 214) (<. 215) (</ 216) (<: 217) (<< 218) (<= 219) (<> 220) (<? 221) (<@ 222) (<^ 223) (<_ 224) (<~ 225) (=9 226) (=a 227) (=A 228) (=! 229) (=$ 230) (=% 231) (=& 232) (=* 233) (=+ 234) (=- 235) (=. 236) (=/ 237) (=: 238) (=< 239) (== 240) (=> 241) (=? 242) (=@ 243) (=^ 244) (=_ 245) (=~ 246) (>9 247) (>a 248) (>A 249) (>! 250) (>$ 251) (>% 252) (>& 253) (>* 254) (>+ 255) (>- 256) (>. 257) (>/ 258) (>: 259) (>< 260) (>= 261) (>> 262) (>? 263) (>@ 264) (>^ 265) (>_ 266) (>~ 267) (?9 268) (?a 269) (?A 270) (?! 271) (?$ 272) (?% 273) (?& 274) (?* 275) (?+ 276) (?- 277) (?. 278) (?/ 279) (?: 280) (?< 281) (?= 282) (?> 283) (?? 284) (?@ 285) (?^ 286) (?_ 287) (?~ 288) (^9 289) (^a 290) (^A 291) (^! 292) (^$ 293) (^% 294) (^& 295) (^* 296) (^+ 297) (^- 298) (^. 299) (^/ 300) (^: 301) (^< 302) (^= 303) (^> 304) (^? 305) (^@ 306) (^^ 307) (^_ 308) (^~ 309) (_9 310) (_a 311) (_A 312) (_! 313) (_$ 314) (_% 315) (_& 316) (_* 317) (_+ 318) (_- 319) (_. 320) (_/ 321) (_: 322) (_< 323) (_= 324) (_> 325) (_? 326) (_@ 327) (_^ 328) (__ 329) (_~ 330) (~9 331) (~a 332) (~A 333) (~! 334) (~$ 335) (~% 336) (~& 337) (~* 338) (~+ 339) (~- 340) (~. 341) (~/ 342) (~: 343) (~< 344) (~= 345) (~> 346) (~? 347) (~@ 348) (~^ 349) (~_ 350) (~~ 351) )
(+ a A ! $ % & * / : < = > ? ^ _ ~ a9 aa aA a! a$ a% a& a* a+ a- a. a/ a: a< a= a> a? a@ a^ a_ a~ A9 Aa AA A! A$ A% A& A* A+ A- A. A/ A: A< A= A> A? A@ A^ A_ A~ !9 !a !A !! !$ !% !& !* !+ !- !. !/ !: !< != !> !? !@ !^ !_ !~ $9 $a $A $! $$ $% $& $* $+ $- $. $/ $: $< $= $> $? $@ $^ $_ $~ %9 %a %A %! %$ %% %& %* %+ %- %. %/ %: %< %= %> %? %@ %^ %_ %~ &9 &a &A &! &$ &% && &* &+ &- &. &/ &: &< &= &> &? &@ &^ &_ &~ *9 *a *A *! *$ *% *& ** *+ *- *. */ *: *< *= *> *? *@ *^ *_ *~ /9 /a /A /! /$ /% /& /* /+ /- /. // /: /< /= /> /? /@ /^ /_ /~ :9 ca CA :! :$ :% :& :* :+ :- :. :/ cc :< := :> :? :@ :^ :_ :~ <9 <a <A <! <$ <% <& <* <+ <- <. </ <: << <= <> <? <@ <^ <_ <~ =9 =a =A =! =$ =% =& =* =+ =- =. =/ =: =< == => =? =@ =^ =_ =~ >9 >a >A >! >$ >% >& >* >+ >- >. >/ >: >< >= >> >? >@ >^ >_ >~ ?9 ?a ?A ?! ?$ ?% ?& ?* ?+ ?- ?. ?/ ?: ?< ?= ?> ?? ?@ ?^ ?_ ?~ ^9 ^a ^A ^! ^$ ^% ^& ^* ^+ ^- ^. ^/ ^: ^< ^= ^> ^? ^@ ^^ ^_ ^~ _9 _a _A _! _$ _% _& _* _+ _- _. _/ _: _< _= _> _? _@ _^ __ _~ ~9 ~a ~A ~! ~$ ~% ~& ~* ~+ ~- ~. ~/ ~: ~< ~= ~> ~? ~@ ~^ ~_ ~~ ))
@@ -5034,6 +8643,8 @@
(+ x (let* ((x 8) (y x) )(+ x y (let* ((x 9) (y x) (z y) )(+ x ))))))))))))))))))))
49)
+(test (let ((!@$%^&*~|}{?><.,/`_-+=:! 1)) (+ !@$%^&*~|}{?><.,/`_-+=:! 1)) 2)
+
(test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b)) b) 1)
(test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b) b)) 0)
(test (let loop ((numbers '(3 -2 1 6 -5))
@@ -5082,6 +8693,191 @@
(test (let ((hi''' 3) (a'''b 2)) (+ hi''' a'''b)) 5)
+(let ((enter 0)
+ (exit 0)
+ (inner 0))
+ (define (j1)
+ (set! enter (+ enter 1))
+ (let ((result
+ (let hiho
+ ((i 0))
+ (set! inner (+ inner 1))
+ (if (< i 3)
+ hiho
+ i))))
+ (set! exit (+ exit 1))
+ result))
+
+ (let ((j2 (j1)))
+ (test (and (procedure? j2) (= enter 1) (= exit 1) (= inner 1)) #t)
+ (let ((result (j2 1)))
+ (test (and (procedure? result) (= enter 1) (= exit 1) (= inner 2)) #t)
+ (set! result (j2 3))
+ (test (and (= result 3) (= enter 1) (= exit 1) (= inner 3)) #t))))
+
+
+(let ()
+ (define (block-comment-test a b c)
+ (+ a b c))
+
+ (let ((val (block-comment-test
+#|
+ a comment
+|#
+ 1 #| this is a |#
+#!
+ another comment
+!#
+ 2 #! this is b !# 3)))
+
+ (test val 6)))
+
+
+(test (letrec* ((p (lambda (x)
+ (+ 1 (q (- x 1)))))
+ (q (lambda (y)
+ (if (zero? y)
+ 0
+ (+ 1 (p (- y 1))))))
+ (x (p 5))
+ (y x))
+ y)
+ 5)
+
+(test (let ((x 1) ((y 2))) x) 'error)
+(test (let ((x 1 2 3)) x) 'error)
+(test (let ((+ 1 2)) 2) 'error)
+(test (let* ((x 1 2)) x) 'error)
+(test (letrec ((x 1 2)) x) 'error)
+(test (let ((x 1 . 2)) x) 'error)
+(test (let ((x 1 , 2)) x) 'error)
+(test (let ((x . 1)) x) 'error)
+(test (let* ((x . 1)) x) 'error)
+(test (letrec ((x . 1)) x) 'error)
+(test (let hi ()) 'error)
+
+(test (let . 1) 'error)
+(test (let* (x)) 'error)
+(test (let (x) 1) 'error)
+(test (let ((x)) 3) 'error)
+(test (let ((x 1) y) x) 'error)
+(test (let* x ()) 'error)
+(test (let* ((1 2)) 3) 'error)
+(test (let () ) 'error)
+(test (let '() 3) 'error)
+(test (let* ((x 1))) 'error)
+(test (let ((x 1)) (letrec ((x 32) (y x)) (+ 1 y))) 'error) ; #<unspecified> seems reasonable if not the 1+
+(test (let ((x 1)) (letrec ((y x) (x 32)) (+ 1 y))) 'error)
+ ;(test (let ((x 1)) (letrec ((y x) (x 32)) 1)) 'error) ; Guile is perverse... s7 returns 1 here
+(test (let ((x 1)) (letrec ((y (let () (+ x 1))) (x 32)) (+ 1 y))) 'error)
+(test (let ((x 1)) (letrec ((y (let ((xx (+ x 1))) xx)) (x 32)) (+ 1 y))) 'error)
+ ;(test (let ((x 32)) (letrec ((y (apply list `(* ,x 2))) (x 1)) y)) 'error)
+(test (letrec) 'error)
+(test (let ((x . 1)) x) 'error)
+
+(test (let (((x 1)) 2) 3) 'error)
+(test (let ((#f 1)) #f) 'error)
+(test (let (()) #f) 'error)
+(test (let (lambda () ) #f) 'error)
+(test (let ((f1 3) (f1 4)) f1) 'error) ; not sure about this
+;; (let () (define (f1) 3) (define (f1) 4) (f1))
+(test (let ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error)
+(test (let* ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error)
+(test (let (('a 3)) 1) 'error)
+(test (let ((#\a 3)) #\a) 'error)
+;; (test (let ((#z1 2)) 1) 'error)
+(test (let ('a 3) 1) 'error)
+(test (let 'a 1) 'error)
+;; what about: (let ('1 ) quote) -> 1
+(test (let* func ((a 1)) a) 'error)
+(test (letrec func ((a 1)) a) 'error)
+
+(test (let ((1 3)) 3) 'error)
+(test (let ((#t 3)) 3) 'error)
+(test (let ((() 3)) 3) 'error)
+(test (let ((#\c 3)) 3) 'error)
+(test (let (("hi" 3)) 3) 'error)
+;(test (let ((:hi 3)) 3) 'error)
+
+(test (let 1 ((i 0)) i) 'error)
+(test (let #f ((i 0)) i) 'error)
+(test (let "hi" ((i 0)) i) 'error)
+(test (let #\c ((i 0)) i) 'error)
+;(test (let :hi ((i 0)) i) 'error)
+
+(test (let func ((a 1) . b) a) 'error)
+(test (let func ((a 1) . b) (if (> a 0) (func (- a 1) 2 3) b)) 'error)
+(test (let func ((a . 1)) a) 'error)
+(test (let func (a . 1) a) 'error)
+(test (let ((a 1) . b) a) 'error)
+(test (let* ((a 1) . b) a) 'error)
+(test (let func ((a func) (i 1)) i) 'error)
+(test (let func ((i 0)) (if (< i 1) (func))) 'error)
+(test (let func (let ((i 0)) (if (< i 1) (begin (set! i (+ i 1)) (func))))) 'error)
+(test (let ((x 0)) (set! x (+ x 1)) (begin (define y 1)) (+ x y)) 2)
+(test (let loop loop) 'error)
+(test (let loop (loop)) 'error)
+(test (let loop ((i 0) (loop 1)) i) 'error)
+
+(test (letrec ((cons 1 (quote ())) . #(1)) 1) 'error)
+(test (letrec ((a 1) . 2) 1) 'error)
+(test (let* ((a 1) (b . 2) . 1) (())) 'error)
+(test (let "" 1) 'error)
+(test (let "hi" 1) 'error)
+(test (let #(1) 1) 'error)
+(test (let __hi__ #t) 'error)
+(test (let* hi () 1) 'error)
+(test (letrec (1 2) #t) 'error)
+
+;;; these ought to work, but see s7.c under EVAL: (it's a speed issue)
+;(test (let let ((i 0)) (if (< i 3) (let (+ i 1)) i)) 3)
+;(test (let () (define (if a) a) (if 1)) 1)
+;(test (let begin ((i 0)) (if (< i 3) (begin (+ i 1)) i)) 3)
+
+
+;;; from the scheme wiki
+;;; http://community.schemewiki.org/?sieve-of-eratosthenes
+
+(let ((results '(2)))
+ (define (primes n)
+ (let ((pvector (make-vector (+ 1 n) #t))) ; if slot k then 2k+1 is a prime
+ (let loop ((p 3) ; Maintains invariant p = 2j + 1
+ (q 4) ; Maintains invariant q = 2j + 2jj
+ (j 1)
+ (k '())
+ (vec pvector))
+ (letrec ((lp (lambda (p q j k vec)
+ (loop (+ 2 p)
+ (+ q (- (* 2 (+ 2 p)) 2))
+ (+ 1 j)
+ k
+ vec)))
+ (eradicate (lambda (q p vec)
+ (if (<= q n)
+ (begin (vector-set! vec q #f)
+ (eradicate (+ q p) p vec))
+ vec))))
+ (if (<= j n)
+ (if (eq? #t (vector-ref vec j))
+ (begin (set! results (cons p results))
+ (lp p q j q (eradicate q p vec)))
+ (lp p q j k vec))
+ (reverse results))))))
+ (test (primes 10) '(2 3 5 7 11 13 17 19)))
+
+(test (let ((gvar 32)) (define (hi1 a) (+ a gvar)) (let ((gvar 0)) (hi1 2))) 34)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (hi2 a) gvar)) (let ((gvar 0)) (hi1 2))) 96)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ a gvar)) (let ((gvar 0)) (hi1 (hi2 2)))) 32)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let ((gvar 0)) (define (hi2 a) (* a 2)) (hi1 hi2))) 36)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let ((gvar 0) (hi2 (lambda (a) (hi2 a)))) (hi1 hi2))) 96)
+(test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let* ((gvar 0) (hi2 (lambda (a) (hi2 a)))) (hi1 hi2))) 32)
+(test (let () ((let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (hi2 2) gvar)) hi1) 2)) 96)
+(test (let ((gvar 0)) ((let ((gvar 1)) (define-macro (hi2 b) `(+ gvar ,b)) (define (hi1 a) (let ((gvar 2)) (hi2 a))) hi1) 2)) 4)
+(test (let ((gvar 0)) (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (let ((gvar 2)) (a 2))) hi1) hi2)) 4)
+(test (let ((gvar 0)) (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (a 2)) hi1) hi2)) 3)
+(test (let () (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (a 2)) hi1) hi2)) 3)
+
+
;;; -------- call/cc --------
@@ -5552,7 +9348,8 @@
'(2 4 3 4 3))
(test (let ((call/cc 2)) (+ call/cc 1)) 3)
-
+(test (+ 1 (call/cc (lambda (r) (r 2 3 4))) 5) 15)
+(test (string-ref (call/cc (lambda (s) (s "hiho" 1)))) #\i)
(let ((r5rs-ratify (lambda (ux err)
(if (= ux 0.0)
@@ -5572,14 +9369,14 @@
(#f)
(set! a (+ (* a1 tt) a2))
(set! b (+ (* tt b1) b2))
- ;(display (format #f "~A ~A~%" a (- b a)))
+ ;(format #t "~A ~A~%" a (- b a))
(if (or (<= (abs (- ux (/ a b))) err)
(> ctr 1000))
(return (/ a b)))
(set! ctr (+ 1 ctr))
(if (= x tt) (return))
(set! x (/ 1 (- x tt)))
- (set! tt (inexact->exact (floor x)))
+ (set! tt (floor x))
(set! a2 a1)
(set! b2 b1)
(set! a1 a)
@@ -5703,6 +9500,84 @@
(product-list '(1 2 (3 4) ((5)))))
120)
+(test (call/cc (lambda () 0)) 'error)
+(test (call/cc (lambda (a) 0) 123) 'error)
+(test (call/cc) 'error)
+(test (call/cc abs) 'error)
+(for-each
+ (lambda (arg)
+ (test (call/cc arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(test (call/cc . 1) 'error)
+(test (call/cc abs) 'error)
+
+
+
+;;; from scheme wiki
+;;; http://community.schemewiki.org/?quines
+;;; Tanaka Tomoyuki
+;;; Moshe Zadka
+
+(test (object->string (call/cc
+ (lambda (c)
+ (call/cc
+ (lambda (cc)
+ (c ((lambda (c)
+ `(call/cc
+ (lambda (c) (call/cc (lambda (cc) (c (,c ',c)))))))
+ '(lambda (c)
+ `(call/cc
+ (lambda (c) (call/cc (lambda (cc) (c (,c ',c))))))))))))))
+ "(call/cc (lambda (c) (call/cc (lambda (cc) (c (#1=(lambda (c) (cons (quote call/cc) (cons (cons (quote lambda) (cons (quote (c)) (cons (cons (quote call/cc) (cons (cons (quote lambda) (cons (quote (cc)) (cons (cons (quote c) (cons (cons c (cons (cons (quote quote) (cons c (quote ()))) (quote ()))) (quote ()))) (quote ())))) (quote ()))) (quote ())))) (quote ())))) (quote #1#)))))))")
+
+(test (object->string ((lambda (x)
+ (list x (list (quote quote) x)))
+ (quote
+ (lambda (x)
+ (list x (list (quote quote) x))))))
+ "(#1=(lambda (x) (list x (list (quote quote) x))) (quote #1#))")
+
+(test (object->string ((lambda (q qq) ((lambda (x) `((lambda (q qq) ,(q x)) . ,(q qq)))
+ '(lambda (x) `((lambda (q qq) ,(q x)) . ,(q qq)))))
+ (lambda (q) `(,q ',q))
+ '(lambda (q) `(,q ',q))))
+ "((lambda (q qq) (#1=(lambda (x) (cons (cons (quote lambda) (cons (quote (q qq)) (cons (q x) (quote ())))) (q qq))) (quote #1#))) #2=(lambda (q) (cons q (cons (cons (quote quote) (cons q (quote ()))) (quote ())))) (quote #2#))")
+
+(test (object->string ((lambda (c)
+ (if (procedure? c) (c 0)
+ ((lambda (c) `((lambda (c) (if (procedure? c) (c 0) (,c ',c)))
+ (call/cc call/cc)))
+ '(lambda (c) `((lambda (c) (if (procedure? c) (c 0) (,c ',c)))
+ (call/cc call/cc))))))
+ (call/cc call/cc)))
+ "((lambda (c) (if (procedure? c) (c 0) (#1=(lambda (c) (cons (cons (quote lambda) (cons (quote (c)) (cons (cons (quote if) (cons (quote (procedure? c)) (cons (cons (quote c) (cons 0 (quote ()))) (cons (cons c (cons (cons (quote quote) (cons c (quote ()))) (quote ()))) (quote ()))))) (quote ())))) (quote ((call/cc call/cc))))) (quote #1#)))) (call/cc call/cc))")
+
+(test (object->string ((lambda (c)
+ (if (procedure? c)
+ (c '`((lambda (c) (if (procedure? c) (c ',c) ,c)) (call/cc call/cc)))
+ `((lambda (c) (if (procedure? c) (c ',c) ,c)) (call/cc call/cc))))
+ (call/cc call/cc)))
+ "((lambda (c) (if (procedure? c) (c (quote #1=(cons (cons (quote lambda) (cons (quote (c)) (cons (cons (quote if) (cons (quote (procedure? c)) (cons (cons (quote c) (cons (cons (quote quote) (cons c (quote ()))) (quote ()))) (cons c (quote ()))))) (quote ())))) (quote ((call/cc call/cc)))))) #1#)) (call/cc call/cc))")
+
+
+(test (object->string ((lambda (x) `((lambda (x) ,x) ',x)) '`((lambda (x) ,x) ',x)))
+ "((lambda (x) #1=(cons (cons (quote lambda) (cons (quote (x)) (cons x (quote ())))) (cons (cons (quote quote) (cons x (quote ()))) (quote ())))) (quote #1#))")
+
+
+(test (object->string ((lambda (q) ((lambda (x) `((lambda (q) ,((eval q) x)) ',q))
+ '(lambda (x) `((lambda (q) ,((eval q) x)) ',q))))
+ '(lambda (x) `(,x ',x))))
+ "((lambda (q) (#1=(lambda (x) (cons (cons (quote lambda) (cons (quote (q)) (cons ((eval q) x) (quote ())))) (cons (cons (quote quote) (cons q (quote ()))) (quote ())))) (quote #1#))) (quote (lambda (x) (cons x (cons (cons (quote quote) (cons x (quote ()))) (quote ()))))))")
+
+(test (with-output-to-string (lambda ()
+ ((lambda (p) (write (list p (list (quote quote) p))))
+ (quote (lambda (p) (write (list p (list (quote quote) p))))))))
+ "(#1=(lambda (p) (write (list p (list (quote quote) p)))) (quote #1#))")
+
+(test (object->string ((lambda (x) `(,(reverse x) ',x)) '(`(,(reverse x) ',x) (x) lambda)))
+ "((lambda #2=(x) #1=(cons (reverse x) (cons (cons (quote quote) (cons x (quote ()))) (quote ())))) (quote (#1# #2# lambda)))")
+
@@ -5799,12 +9674,12 @@
'(a b c d e f g b c d e f g h))
(if with-values
-(test (list (dynamic-wind
- (lambda () #f)
- (lambda () (values 'a 'b 'c))
- (lambda () #f)))
- (list 'a 'b 'c))
-)
+ (test (list (dynamic-wind
+ (lambda () #f)
+ (lambda () (values 'a 'b 'c))
+ (lambda () #f)))
+ (list 'a 'b 'c))
+ )
(test (let ((dynamic-wind 1)) (+ dynamic-wind 2)) 3)
@@ -5916,6 +9791,165 @@
n)
15)
+(test (dynamic-wind) 'error)
+(test (dynamic-wind (lambda () #f)) 'error)
+(test (dynamic-wind (lambda () #f) (lambda () #f)) 'error)
+(test (dynamic-wind (lambda (a) #f) (lambda () #f) (lambda () #f)) 'error)
+(test (dynamic-wind (lambda () #f) (lambda (a b) #f) (lambda () #f)) 'error)
+(test (dynamic-wind (lambda () #f) (lambda () #f) (lambda (a) #f)) 'error)
+(test (dynamic-wind (lambda () 1) #f (lambda () 2)) 'error)
+(test (dynamic-wind . 1) 'error)
+
+;;; from scheme wiki
+;;; http://community.schemewiki.org/?hose-the-repl
+;;; jorgen-schafer
+
+(test (let loop ()
+ (call-with-exit
+ (lambda (k)
+ (dynamic-wind
+ (lambda () #t)
+ (lambda () (let loop () (loop)))
+ k)))
+ (loop))
+ 'error)
+;; that example calls to mind a bunch like it:
+(test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) (lambda () (let loop () (loop))) k))) 'error)
+(test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) k (lambda () #t)))) 'error)
+(test (call-with-exit (lambda (k) (dynamic-wind k (lambda () #f) (lambda () #t)))) 'error)
+
+(test (call-with-exit (lambda (k) (procedure-documentation k))) "")
+(test (call-with-exit (lambda (k) (procedure-arity k))) '())
+(test (call-with-exit (lambda (k) (procedure-source k))) '())
+(test (procedure-arity (call-with-exit (lambda (k) (make-procedure-with-setter k k)))) '())
+(test (procedure-arity (make-procedure-with-setter vector-ref vector-set!)) '(2 0 #t 3 0 #t))
+(test (let ((pws (make-procedure-with-setter vector-ref vector-set!)))
+ (let ((pws1 (make-procedure-with-setter pws vector-set!)))
+ (let ((v (vector 1 2)))
+ (set! (pws1 v 1) 32)
+ (pws1 v 1))))
+ 32)
+(test (call-with-exit (lambda (k) (map k '(1 2 3)))) 1)
+(test (call-with-exit (lambda (k) (for-each k '(1 2 3)))) 1)
+(test (call-with-exit (lambda (k) (catch #t k k))) 'error)
+(test (call-with-exit (lambda (k) (catch #t (lambda () #f) k))) #f)
+(test (call-with-exit (lambda (k) (catch #t (lambda () (error 'an-error)) k))) 'error)
+(test (call-with-exit (lambda (k) (sort! '(1 2 3) k))) 'error)
+(test (sort! '(1 2 3) (lambda () #f)) 'error)
+(test (sort! '(1 2 3) (lambda (a) #f)) 'error)
+(test (sort! '(1 2 3) (lambda (a b c) #f)) 'error)
+(test (let () (define-macro (asdf a b) `(< ,a ,b)) (sort! '(1 2 3) asdf)) 'error)
+(test (let () (let asdf () (sort! '(1 2 3) asdf))) 'error)
+(test (let () (let asdf () (map asdf '(1 2 3)))) 'error)
+(test (let () (let asdf () (for-each asdf '(1 2 3)))) 'error)
+
+(test (let ((ctr 0))
+ (call-with-exit
+ (lambda (exit)
+ (let asdf
+ ()
+ (set! ctr (+ ctr 1))
+ (if (> ctr 2)
+ (exit ctr))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () #f)
+ asdf)))))
+ 3)
+
+(test (let ((ctr 0))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (call-with-exit
+ (lambda (exit)
+ (catch #t
+ (lambda ()
+ (error 'error))
+ (lambda args
+ (exit 'error)))
+ (set! ctr 1))))
+ (lambda ()
+ (set! ctr (+ ctr 2))))
+ ctr)
+ 2)
+(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r1 12) (r2 1))) (r1 2))) 3)) 12)
+(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r2 12) (r2 1))) (r1 2))) 3)) 3)
+(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r3 12) (r2 1))) (r1 2))) 3)) 2)
+
+(let ((pws (make-procedure-with-setter < >))) (test (sort! '(2 3 1 4) pws) '(1 2 3 4)))
+(test (call-with-exit (lambda (k) (call-with-input-string "123" k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-input-file "tmp1.r5rs" k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-output-file "tmp1.r5rs" k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-output-string k))) 'error)
+(let ((pws (make-procedure-with-setter (lambda (a) (+ a 1)) (lambda (a b) b))))
+ (test (map pws '(1 2 3)) '(2 3 4))
+ (test (apply pws '(1)) 2))
+(test (let ((ctr 0)) (call-with-exit (lambda (top-exit) (set! ctr (+ ctr 1)) (call-with-exit top-exit) (set! ctr (+ ctr 16)))) ctr) 1)
+(test (apply dynamic-wind (list (lambda () #f) (lambda () 1) (lambda () #f))) 1)
+(test (apply call-with-exit (list (lambda (exit) 1))) 1)
+(test (apply call-with-exit (list (lambda (exit) (exit 1) 32))) 1)
+(test (apply catch (list #t (lambda () 1) (lambda args 'error))) 1)
+
+(test (let ((cur '()))
+ (define (step pos)
+ (dynamic-wind
+ (lambda ()
+ (set! cur (cons pos cur)))
+ (lambda ()
+ (set! cur (cons (+ pos 1) cur))
+ (if (< pos 40)
+ (step (+ pos 10)))
+ (set! cur (cons (+ pos 2) cur))
+ cur)
+ (lambda ()
+ (set! cur (cons (+ pos 3) cur)))))
+ (reverse (step 0)))
+ '(0 1 10 11 20 21 30 31 40 41 42 43 32 33 22 23 12 13 2))
+
+
+(test (let ((cur '()))
+ (define (step pos)
+ (dynamic-wind
+ (lambda ()
+ (set! cur (cons pos cur)))
+ (lambda ()
+ (set! cur (cons (+ pos 1) cur))
+ (if (< pos 40)
+ (step (+ pos 10))
+ (error 'all-done))
+ (set! cur (cons (+ pos 2) cur))
+ cur)
+ (lambda ()
+ (set! cur (cons (+ pos 3) cur)))))
+ (catch 'all-done
+ (lambda ()
+ (reverse (step 0)))
+ (lambda args (reverse cur))))
+ '(0 1 10 11 20 21 30 31 40 41 43 33 23 13 3))
+
+(test (let ((cur '()))
+ (define (step pos ret)
+ (dynamic-wind
+ (lambda ()
+ (set! cur (cons pos cur)))
+ (lambda ()
+ (set! cur (cons (+ pos 1) cur))
+ (if (< pos 40)
+ (step (+ pos 10) ret)
+ (ret (reverse cur)))
+ (set! cur (cons (+ pos 2) cur))
+ cur)
+ (lambda ()
+ (set! cur (cons (+ pos 3) cur)))))
+ (list (call-with-exit
+ (lambda (ret)
+ (step 0 ret)))
+ (reverse cur)))
+ '((0 1 10 11 20 21 30 31 40 41) (0 1 10 11 20 21 30 31 40 41 43 33 23 13 3)))
+
+
+
;;; -------- delay and force --------
@@ -6114,7 +10148,9 @@
(set! newlst (cons (car p) newlst)))))
(list 1 2 3 4 5))
-
+ (test (force) 'error)
+ (test (delay) 'error)
+ (test (delay 1 2) 'error)
))
@@ -6260,58 +10296,11 @@
(test (let () (define-macro (tryqv . lst) `(map abs '(,@lst))) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5))
(test (let () (define-macro (tryqv . lst) `(map abs (vector ,@lst))) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5))
+(test (quasiquote) 'error)
+(let ((d 1))
+ (test (quasiquote (a b c ,d)) '(a b c 1)))
-(let ((ht (make-hash-table)))
- (test (hash-table? ht) #t)
- (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14)
- (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14)
- (test (let () (hash-table-set! ht 123 "hiho") (hash-table-ref ht 123)) "hiho")
- (test (let () (hash-table-set! ht 3.14 "hi") (hash-table-ref ht 3.14)) "hi")
- (test (let () (hash-table-set! ht our-pi "hiho") (hash-table-ref ht our-pi)) "hiho")
- (test (hash-table-ref ht "123") #f)
-
- (test (let () (set! (hash-table-ref ht 'key) 32) (hash-table-ref ht 'key)) 32)
-
- (for-each
- (lambda (arg)
- (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
-
-(let ((ht (make-hash-table 277)))
- (test (hash-table? ht) #t)
- (test (hash-table-size ht) 277)
- (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14)
- (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14)
- (for-each
- (lambda (arg)
- (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
-
-(for-each
- (lambda (arg)
- (test (hash-table? arg) #f))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
-
-(test (hash-table? (make-vector 3 '())) #f)
-(let ((ht (make-hash-table)))
- (test (hash-table-ref ht 'not-a-key) #f)
- (test (hash-table-ref ht "not-a-key") #f)
- (hash-table-set! ht 'key 3/4)
- (hash-table-set! ht "key" "hi")
- (test (hash-table-ref ht "key") "hi")
- (test (hash-table-ref ht 'key) "hi")
-
- (hash-table-set! ht 'asd 'hiho)
- (test (hash-table-ref ht 'asd) 'hiho))
-
-(let ((ht1 (make-hash-table 653))
- (ht2 (make-hash-table 277)))
- (hash-table-set! ht1 'key 'hiho)
- (hash-table-set! ht2 (hash-table-ref ht1 'key) 3.14)
- (test (hash-table-size ht1) 653)
- (test (hash-table-ref ht2 'hiho) 3.14)
- (test (hash-table-ref ht2 (hash-table-ref ht1 'key)) 3.14))
@@ -6347,6 +10336,93 @@
(test (symbol->string (keyword->symbol :hi)) "hi")
(test (make-keyword ":") ::))
+(let ()
+ (define* (hi a b) (+ a b))
+ (test (hi 1 2) 3)
+ (test (hi :b 3 :a 1) 4)
+ (test (hi b: 3 a: 1) 4))
+
+(for-each
+ (lambda (arg)
+ (test (make-keyword arg) 'error))
+ (list -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+ (test (keyword->symbol arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+ (test (symbol->keyword arg) 'error))
+ (list "hi" -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+
+(test (keyword?) 'error)
+(test (keyword? 1 2) 'error)
+(test (make-keyword) 'error)
+(test (make-keyword 'hi 'ho) 'error)
+(test (keyword->symbol) 'error)
+(test (keyword->symbol :hi :ho) 'error)
+(test (symbol->keyword) 'error)
+(test (symbol->keyword 'hi 'ho) 'error)
+
+
+
+(for-each
+ (lambda (arg)
+ (test (gensym arg) 'error))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+
+(test (gensym "hi" "ho") 'error)
+
+(test (symbol? (gensym)) #t)
+(test (symbol? (gensym "temp")) #t)
+(test (eq? (gensym) (gensym)) #f)
+(test (eqv? (gensym) (gensym)) #f)
+(test (equal? (gensym) (gensym)) #f)
+(test (keyword? (gensym)) #f)
+(test (let* ((a (gensym)) (b a)) (eq? a b)) #t)
+(test (let* ((a (gensym)) (b a)) (eqv? a b)) #t)
+
+(let ((sym (gensym)))
+ (test (eval `(let ((,sym 32)) (+ ,sym 1))) 33))
+
+(let ((sym1 (gensym))
+ (sym2 (gensym)))
+ (test (eval `(let ((,sym1 32) (,sym2 1)) (+ ,sym1 ,sym2))) 33))
+
+(test (let ((hi (gensym))) (eq? hi (string->symbol (symbol->string hi)))) #t)
+
+
+(test (provided?) 'error)
+(test (provide) 'error)
+(test (or (null? *features*) (pair? *features*)) #t)
+(test (provided? 1 2 3) 'error)
+(test (provide 1 2 3) 'error)
+(provide 's7test)
+(test (provided? 's7test) #t)
+(test (provided? 'not-provided!) #f)
+
+(for-each
+ (lambda (arg)
+ (test (provide arg) 'error))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+ (test (provided? arg) 'error))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+
+
+(test (integer? *vector-print-length*) #t)
+(test (or (null? *trace-hook*) (procedure? *trace-hook*)) #t)
+(test (or (null? *#readers*) (pair? *#readers*)) #t)
+(test (or (null? *load-hook*) (procedure? *load-hook*)) #t)
+(test (or (null? *load-path*) (pair? *load-path*)) #t)
+(test (or (null? *error-hook*) (procedure? *error-hook*)) #t)
+(test (or (null? *unbound-variable-hook*) (procedure? *unbound-variable-hook*)) #t)
+(test (vector? *error-info*) #t)
+
(test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) <) (list 0 1 2 3 4 5 6 7 8 9)) #t)
@@ -6408,25 +10484,107 @@
(apply < vals)))
#t)
+(test (sort!) 'error)
+(test (sort! '(1 2 3)) 'error)
+(test (sort! '(1 2 3) 1) 'error)
+(test (sort! '(1 2 3) < <) 'error)
+(for-each
+ (lambda (arg)
+ (test (sort! arg <) 'error))
+ (list -1 #\a 1 0 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
-(test (symbol? (gensym)) #t)
-(test (symbol? (gensym "temp")) #t)
-(test (eq? (gensym) (gensym)) #f)
-(test (eqv? (gensym) (gensym)) #f)
-(test (equal? (gensym) (gensym)) #f)
-(test (keyword? (gensym)) #f)
-(test (let* ((a (gensym)) (b a)) (eq? a b)) #t)
-(test (let* ((a (gensym)) (b a)) (eqv? a b)) #t)
+(for-each
+ (lambda (arg)
+ (test (sort! '(1 2 3) arg) 'error))
+ (list -1 #\a 1 0 'a-symbol 3.14 3/4 1.0+1.0i #f #t #(1) '(1) "hi" :hi))
+
+(test (sort! '(1 2 "hi" 3) <) 'error)
+(test (sort! '(1 -2 "hi" 3) (lambda (a b)
+ (let ((a1 (if (number? a) a (length a)))
+ (b1 (if (number? b) b (length b))))
+ (< a1 b1))))
+ '(-2 1 "hi" 3))
+
+(let ((ok #f))
+ (catch #t
+ (lambda ()
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (sort! '(1 2 "hi" 3) <))
+ (lambda () (set! ok #t))))
+ (lambda args 'error))
+ (if (not ok) (format #t "dynamic-wind out of sort! skipped cleanup?~%")))
+
+
+
+;;; -------- catch --------
+
+(define (catch-test sym)
+ (let ((errs '()))
+ (catch 'a1
+ (lambda ()
+ (catch 'a2
+ (lambda ()
+ (catch 'a3
+ (lambda ()
+ (catch 'a4
+ (lambda ()
+ (error sym "hit error!"))
+ (lambda args
+ (set! errs (cons 'a4 errs))
+ 'a4)))
+ (lambda args
+ (set! errs (cons 'a3 errs))
+ 'a3)))
+ (lambda args
+ (set! errs (cons 'a2 errs))
+ 'a2)))
+ (lambda args
+ (set! errs (cons 'a1 errs))
+ 'a1))
+ errs))
+
+(test (catch-test 'a1) '(a1))
+(test (catch-test 'a2) '(a2))
+(test (catch-test 'a3) '(a3))
+(test (catch-test 'a4) '(a4))
+
+(define (catch-test-1 sym)
+ (let ((errs '()))
+ (catch 'a1
+ (lambda ()
+ (catch 'a2
+ (lambda ()
+ (catch 'a3
+ (lambda ()
+ (catch 'a4
+ (lambda ()
+ (error sym "hit error!"))
+ (lambda args
+ (set! errs (cons 'a4 errs))
+ (error 'a3)
+ 'a4)))
+ (lambda args
+ (set! errs (cons 'a3 errs))
+ (error 'a2)
+ 'a3)))
+ (lambda args
+ (set! errs (cons 'a2 errs))
+ (error 'a1)
+ 'a2)))
+ (lambda args
+ (set! errs (cons 'a1 errs))
+ 'a1))
+ errs))
+
+(test (catch-test-1 'a1) '(a1))
+(test (catch-test-1 'a2) '(a1 a2))
+(test (catch-test-1 'a3) '(a1 a2 a3))
+(test (catch-test-1 'a4) '(a1 a2 a3 a4))
-(let ((sym (gensym)))
- (test (eval `(let ((,sym 32)) (+ ,sym 1))) 33))
-(let ((sym1 (gensym))
- (sym2 (gensym)))
- (test (eval `(let ((,sym1 32) (,sym2 1)) (+ ,sym1 ,sym2))) 33))
-(test (let ((hi (gensym))) (eq? hi (string->symbol (symbol->string hi)))) #t)
(define (last-pair l) ; needed also by loop below
(if (pair? (cdr l))
@@ -6518,285 +10676,6 @@
- (test (format #f "hiho") "hiho")
- (test (format #f "") "")
- (test (format #f "a") "a")
-
- (test (format #f "~~") "~")
- (test (format #f "~~~~") "~~")
- (test (format #f "a~~") "a~")
- (test (format #f "~~a") "~a")
-
- (test (format #f "hiho~%ha") (string-append "hiho" (string #\newline) "ha"))
- (test (format #f "~%") (string #\newline))
- (test (format #f "~%ha") (string-append (string #\newline) "ha"))
- (test (format #f "hiho~%") (string-append "hiho" (string #\newline)))
-
- (for-each
- (lambda (arg res)
- (let ((val (catch #t (lambda () (format #f "~A" arg)) (lambda args 'error))))
- (if (or (not (string? val))
- (not (string=? val res)))
- (begin (display "(format #f \"~A\" ") (display arg)
- (display " returned \"") (display val)
- (display "\" but expected \"") (display res) (display "\"")
- (newline)))))
- (list "hiho" -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.5+1.5i '() '#(()) (list 1 2 3) '(1 . 2) 'hi)
- (list "hiho" "-1" "a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi"))
-
- (test (format #f "hi ~A ho" 1) "hi 1 ho")
- (test (format #f "hi ~a ho" 1) "hi 1 ho")
- (test (format #f "~a~A~a" 1 2 3) "123")
- (test (format #f "~a~~~a" 1 3) "1~3")
- (test (format #f "~a~%~a" 1 3) (string-append "1" (string #\newline) "3"))
-
- (for-each
- (lambda (arg res)
- (let ((val (catch #t (lambda () (format #f "~S" arg)) (lambda args 'error))))
- (if (or (not (string? val))
- (not (string=? val res)))
- (begin (display "(format #f \"~S\" ") (display arg)
- (display " returned \"") (display val)
- (display "\" but expected \"") (display res) (display "\"")
- (newline)))))
- (list "hiho" -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.5+1.5i '() '#(()) (list 1 2 3) '(1 . 2) 'hi)
- (list "\"hiho\"" "-1" "#\\a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi"))
-
- (test (format #f "hi ~S ho" 1) "hi 1 ho")
- (test (format #f "hi ~S ho" "abc") "hi \"abc\" ho")
- (test (format #f "~s~a" #\a #\b) "#\\ab")
- (test (format #f "~C~c~C" #\a #\b #\c) "abc")
-
- (test (format #f "~{~A~}" '(1 2 3)) "123")
- (test (format #f "asb~{~A ~}asb" '(1 2 3 4)) "asb1 2 3 4 asb")
- (test (format #f "asb~{~A ~A.~}asb" '(1 2 3 4)) "asb1 2.3 4.asb")
- (test (format #f ".~{~A~}." '()) "..")
-
- (test (format #f "~{~A ~A ~}" '(1 "hi" 2 "ho")) "1 hi 2 ho ")
- (test (format #f "~{.~{+~A+~}.~}" (list (list 1 2 3) (list 4 5 6))) ".+1++2++3+..+4++5++6+.")
- (test (format #f "~{~s ~}" '(fred jerry jill)) "fred jerry jill ")
- (test (format #f "~{~s~^ ~}" '(fred jerry jill)) "fred jerry jill")
- (test (format #f "~{~s~^~^ ~}" '(fred jerry jill)) "fred jerry jill")
- (test (format #f "~{.~{~A~}+~{~A~}~}" '((1 2) (3 4 5) (6 7 8) (9))) ".12+345.678+9")
- (test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)))) ".+-1-2+-3-4-5")
- (test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)) ((6) (7 8 9)))) ".+-1-2+-3-4-5.+-6+-7-8-9")
-
- (test (format #f "~A ~* ~A" 1 2 3) "1 3")
- (test (format #f "~*" 1) "")
- (test (format #f "~{~* ~}" '(1 2 3)) " ")
-
- (test (format #f "this is a ~
- sentence") "this is a sentence")
-
- ;; ~nT handling is a mess -- what are the defaults? which is column 1? do we space up to or up to and including?
-
- (test (format #f "asdh~20Thiho") "asdh hiho")
- (test (format #f "asdh~2Thiho") "asdhhiho")
- (test (format #f "a~Tb") "ab")
- (test (format #f "0123456~4,8Tb") "0123456 b")
- ; (test (format #f "XXX~%0123456~4,8Tb") (string-append "XXX" (string #\newline) "0123456 b")) ; clearly wrong...
- (test (format #f "0123456~0,8Tb") "0123456 b")
- ; (test (format #f "0123456~10,8Tb") "0123456 b")
- (test (format #f "0123456~1,0Tb") "0123456b")
- (test (format #f "0123456~1,Tb") "0123456b")
- (test (format #f "0123456~1,Tb") "0123456b")
- (test (format #f "0123456~,Tb") "0123456b")
- ; (test (format #f "0123456~7,10Tb") "0123456 b")
- ; (test (format #f "0123456~8,10tb") "0123456 b")
- (test (format #f "0123456~3,12tb") "0123456 b")
-
- ; (test (format #f "~40TX") " X")
- ; (test (format #f "X~,8TX~,8TX") "X X X")
- (test (format #f "X~8,TX~8,TX") "X XX")
- ; (test (format #f "X~8,10TX~8,10TX") "X X X")
- (test (format #f "X~8,0TX~8,0TX") "X XX")
- (test (format #f "X~0,8TX~0,8TX") "X X X")
- ; (test (format #f "X~1,8TX~1,8TX") "X X X")
- ; (test (format #f "X~,8TX~,8TX") "X X X")
- (test (format #f "X~TX~TX") "XXX") ; clisp and sbcl say "X X X" here and similar differences elsewhere
- (test (format #f "X~0,0TX~0,0TX") "XXX")
- (test (format #f "X~0,TX~0,TX") "XXX")
- (test (format #f "X~,0TX~,0TX") "XXX")
-
- (test (format #f "~D" 123) "123")
- (test (format #f "~X" 123) "7b")
- (test (format #f "~B" 123) "1111011")
- (test (format #f "~O" 123) "173")
-
- (test (format #f "~10D" 123) " 123")
- (test (format #f "~10X" 123) " 7b")
- (test (format #f "~10B" 123) " 1111011")
- (test (format #f "~10O" 123) " 173")
-
- (test (format #f "~D" -123) "-123")
- (test (format #f "~X" -123) "-7b")
- (test (format #f "~B" -123) "-1111011")
- (test (format #f "~O" -123) "-173")
-
- (test (format #f "~10D" -123) " -123")
- (test (format #f "~10X" -123) " -7b")
- (test (format #f "~10B" -123) " -1111011")
- (test (format #f "~10O" -123) " -173")
-
- (test (format #f "~d" 123) "123")
- (test (format #f "~x" 123) "7b")
- (test (format #f "~b" 123) "1111011")
- (test (format #f "~o" 123) "173")
-
- (test (format #f "~10d" 123) " 123")
- (test (format #f "~10x" 123) " 7b")
- (test (format #f "~10b" 123) " 1111011")
- (test (format #f "~10o" 123) " 173")
-
- (test (format #f "~d" -123) "-123")
- (test (format #f "~x" -123) "-7b")
- (test (format #f "~b" -123) "-1111011")
- (test (format #f "~o" -123) "-173")
-
- (test (format #f "~10d" -123) " -123")
- (test (format #f "~10x" -123) " -7b")
- (test (format #f "~10b" -123) " -1111011")
- (test (format #f "~10o" -123) " -173")
-
- (if (and (defined? 'most-positive-fixnum)
- (= most-positive-fixnum 9223372036854775807))
- (begin
-
- (test (format #f "~D" most-positive-fixnum) "9223372036854775807")
- (test (format #f "~D" (+ 1 most-negative-fixnum)) "-9223372036854775807")
-
- (test (format #f "~X" most-positive-fixnum) "7fffffffffffffff")
- (test (format #f "~X" (+ 1 most-negative-fixnum)) "-7fffffffffffffff")
-
- (test (format #f "~O" most-positive-fixnum) "777777777777777777777")
- (test (format #f "~O" (+ 1 most-negative-fixnum)) "-777777777777777777777")
-
- (test (format #f "~B" most-positive-fixnum) "111111111111111111111111111111111111111111111111111111111111111")
- (test (format #f "~B" (+ 1 most-negative-fixnum)) "-111111111111111111111111111111111111111111111111111111111111111")
-
- (num-test (inexact->exact most-positive-fixnum) most-positive-fixnum)
-
- ))
-
- (if (and (defined? 'most-positive-fixnum)
- (= most-positive-fixnum 2147483647))
- (begin
-
- (test (format #f "~D" most-positive-fixnum) "2147483647")
- (test (format #f "~D" (+ 1 most-negative-fixnum)) "-2147483647")
-
- (test (format #f "~X" most-positive-fixnum) "7fffffff")
- (test (format #f "~X" (+ 1 most-negative-fixnum)) "-7fffffff")
-
- (test (format #f "~O" most-positive-fixnum) "17777777777")
- (test (format #f "~O" (+ 1 most-negative-fixnum)) "-17777777777")
-
- (test (format #f "~B" most-positive-fixnum) "1111111111111111111111111111111")
- (test (format #f "~B" (+ 1 most-negative-fixnum)) "-1111111111111111111111111111111")
-
- (num-test (inexact->exact most-positive-fixnum) most-positive-fixnum)
-
- ))
-
- (test (format #f "~0D" 123) "123")
- (test (format #f "~0X" 123) "7b")
- (test (format #f "~0B" 123) "1111011")
- (test (format #f "~0O" 123) "173")
-
- (call-with-output-file "tmp1.r5rs" (lambda (p) (format p "this ~A ~C test ~D" "is" #\a 3)))
- (let ((res (call-with-input-file "tmp1.r5rs" (lambda (p) (read-line p)))))
- (if (not (string=? res "this is a test 3"))
- (begin
- (display "call-with-input-file + format to \"tmp1.r5rs\" ... expected \"this is a test 3\", but got \"")
- (display res) (display "\"?") (newline))))
-
- (let ((val (format #f "line 1~%line 2~%line 3")))
- (with-input-from-string val
- (lambda ()
- (let ((line1 (read-line)))
- (test (string=? line1 "line 1") #t))
- (let ((line2 (read-line)))
- (test (string=? line2 "line 2") #t))
- (let ((line3 (read-line)))
- (test (string=? line3 "line 3") #t))
- (let ((eof (read-line)))
- (test (eof-object? eof) #t)))))
-
- (let ((val (format #f "line 1~%line 2~%line 3")))
- (call-with-input-string val
- (lambda (p)
- (let ((line1 (read-line p #t)))
- (test (string=? line1 (string-append "line 1" (string #\newline))) #t))
- (let ((line2 (read-line p #t)))
- (test (string=? line2 (string-append "line 2" (string #\newline))) #t))
- (let ((line3 (read-line p #t)))
- (test (string=? line3 "line 3") #t))
- (let ((eof (read-line p #t)))
- (test (eof-object? eof) #t)))))
-
- (let ((res #f))
- (let ((this-file (open-output-string)))
- (format this-file "this ~A ~C test ~D" "is" #\a 3)
- (set! res (get-output-string this-file))
- (close-output-port this-file))
- (if (not (string=? res "this is a test 3"))
- (begin
- (display "open-output-string + format ... expected \"this is a test 3\", but got \"")
- (display res) (display "\"?") (newline))))
-
- (test (call/cc (lambda (return) (let ((val (format #f "line 1~%line 2~%line 3")))
- (call-with-input-string val
- (lambda (p) (return "oops"))))))
- "oops")
-
- (format #t "format #t: ~D" 1)
- (format (current-output-port) " output-port: ~D! (this is testing output ports)~%" 2)
- ;; for float formats, assume s7 for now -- use our-pi and most-positive-fixnum
- ;; (format with 18 digits is enough to tell what s7_Double is via built-in pi)
-
- ;; from slib/formatst.scm
- (test (string=? (format #f "abc") "abc") #t)
- (test (string=? (format #f "~a" 10) "10") #t)
- (test (string=? (format #f "~a" -1.2) "-1.2") #t)
- (test (string=? (format #f "~a" 'a) "a") #t)
- (test (string=? (format #f "~a" #t) "#t") #t)
- (test (string=? (format #f "~a" #f) "#f") #t)
- (test (string=? (format #f "~a" "abc") "abc") #t)
- (test (string=? (format #f "~a" '#(1 2 3)) "#(1 2 3)") #t)
- (test (string=? (format #f "~a" '()) "()") #t)
- (test (string=? (format #f "~a" '(a)) "(a)") #t)
- (test (string=? (format #f "~a" '(a b)) "(a b)") #t)
- (test (string=? (format #f "~a" '(a (b c) d)) "(a (b c) d)") #t)
- (test (string=? (format #f "~a" '(a . b)) "(a . b)") #t)
- (test (string=? (format #f "~a ~a" 10 20) "10 20") #t)
- (test (string=? (format #f "~a abc ~a def" 10 20) "10 abc 20 def") #t)
- (test (string=? (format #f "~d" 100) "100") #t)
- (test (string=? (format #f "~x" 100) "64") #t)
- (test (string=? (format #f "~o" 100) "144") #t)
- (test (string=? (format #f "~b" 100) "1100100") #t)
- (test (string=? (format #f "~10d" 100) " 100") #t)
- (test (string=? (format #f "~10,'*d" 100) "*******100") #t)
- (test (string=? (format #f "~c" #\a) "a") #t)
- (test (string=? (format #f "~~~~") "~~") #t)
- (test (string=? (format #f "~s" "abc") "\"abc\"") #t)
- (test (string=? (format #f "~s" "abc \\ abc") "\"abc \\\\ abc\"") #t)
- (test (string=? (format #f "~a" "abc \\ abc") "abc \\ abc") #t)
- (test (string=? (format #f "~s" "abc \" abc") "\"abc \\\" abc\"") #t)
- (test (string=? (format #f "~a" "abc \" abc") "abc \" abc") #t)
- (test (string=? (format #f "~s" #\space) "#\\space") #t)
- (test (string=? (format #f "~s" #\newline) "#\\newline") #t)
- (test (string=? (format #f "~s" #\a) "#\\a") #t)
- (test (string=? (format #f "~a" '(a "b" c)) "(a \"b\" c)") #t)
- (test (string=? (format #f "abc~
- 123") "abc123") #t)
- (test (string=? (format #f "abc~
-123") "abc123") #t)
- (test (string=? (format #f "abc~
-") "abc") #t)
- (test (string=? (format #f "~{ ~a ~}" '(a b c)) " a b c ") #t)
- (test (string=? (format #f "~{ ~a ~}" '()) "") #t)
- (test (string=? (format #f "~{ ~a,~a ~}" '(a 1 b 2 c 3)) " a,1 b,2 c,3 ") #t)
- (test (string=? (format #f "abc ~^ xyz") "abc ") #t)
(let ((hi (lambda* (a) a)))
(test (hi 1) 1)
@@ -6968,13 +10847,53 @@
(lambda args (car args)))))
(eq? tag 'wrong-number-of-args)))
#t)
-
+
+ (test (let () (define (hi :a) :a) (hi 1)) 'error)
+ (test (let () (define* (hi :a) :a) (hi 1)) 'error)
+ (test (let () (define* (hi (:a 2)) a) (hi 1)) 'error)
+ (test (let () (define* (hi (a 1) (:a 2)) a) (hi 1)) 'error)
+ (test (let () (define* (hi (pi 1)) pi) (hi 2)) 'error)
+ (test (let () (define* (hi (:b 1) (:a 2)) a) (hi)) 'error)
+
+ (test (let () (define* (hi (a 1) (a 2)) a) (hi 2)) 'error)
+ (test (let () (define (hi a a) a) (hi 1 2)) 'error)
+ (test (let () (define hi (lambda (a a) a)) (hi 1 1)) 'error)
+ (test (let () (define hi (lambda* ((a 1) (a 2)) a)) (hi 1 2)) 'error)
+ (test (let () (define (hi (a 1)) a) (hi 1)) 'error)
+
+ (let ()
+ (define* (hi (a #2d((1 2) (3 4)))) (a 1 0))
+ (test (hi) 3)
+ (test (hi #2d((7 8) (9 10))) 9))
+
+ (let () (define* (f :rest a) a) (test (f :a 1) '(:a 1)))
+ (let () (define* (f :rest a :rest b) (list a b)) (test (f :a 1 :b 2) '((:a 1 :b 2) (1 :b 2))))
+
+ (test (lambda :hi 1) 'error)
+ (test (lambda (:hi) 1) 'error)
+ (test (lambda (:hi . :hi) 1) 'error)
+ (test (lambda (i . i) 1 . 2) 'error)
+ (test (lambda (i i i i) (i)) 'error)
+ (test (lambda "hi" 1) 'error)
+ (test (lambda* ((i 1) i i) i) 'error)
+ (test (lambda* ((a 1 2)) a) 'error)
+ (test (lambda* ((a . 1)) a) 'error)
+ (test (lambda* ((0.0 1)) 0.0) 'error)
+
+ (test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32) '(32 1 ()))
+ (test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5) '(1 3 (2 3 4 5)))
+ (test ((lambda* ((a 1) :rest b :rest c) (list a b c)) 1 2 3 4 5) '(1 (2 3 4 5) (3 4 5)))
+
+ (test (let () (define-macro (hi a a) `(+ ,a 1)) (hi 1 2)) 'error)
+
(test (procedure-arity car) '(1 0 #f))
(test (procedure-arity 'car) '(1 0 #f))
(test (procedure-arity +) '(0 0 #t))
(test (procedure-arity '+) '(0 0 #t))
(test (procedure-arity log) '(1 1 #f))
(test (procedure-arity '/) '(1 0 #t))
+ (test (procedure-arity) 'error)
+ (test (procedure-arity abs abs) 'error)
;(test (procedure-arity vector-set!) '(3 0 #f)) ; can be '(3 0 #t)
(test (let ((hi (lambda () 1))) (procedure-arity hi)) '(0 0 #f))
(test (let ((hi (lambda (a) 1))) (procedure-arity hi)) '(1 0 #f))
@@ -6989,7 +10908,22 @@
(test (let () (define* (hi (a 1) (b 2)) a) (procedure-arity hi)) '(0 2 #f))
(test (let ((hi (lambda* (a) 1))) (procedure-arity hi)) '(0 1 #f))
(test (call/cc (lambda (func) (procedure-arity func))) '(0 0 #t))
-
+
+ (test (procedure-arity (lambda* (a :rest b) a)) '(0 1 #t))
+ (test (procedure-arity (lambda* (:optional a :rest b) a)) '(0 1 #t))
+ (test (procedure-arity (lambda* (:optional a :key b :rest c) a)) '(0 2 #t))
+ (test (procedure-arity (lambda* (:optional a b) a)) '(0 2 #f))
+ (test (procedure-arity (lambda* (:rest args) args)) '(0 0 #t))
+ (test (procedure-arity (lambda* (a :optional b . c) a)) '(0 2 #t))
+ (test (procedure-arity (lambda* (:rest a . b) a)) '(0 0 #t))
+ (test (procedure-arity (lambda* (:key :optional a) a)) '(0 1 #f))
+ (test (procedure-arity (lambda* a a)) '(0 0 #t))
+ (test (let () (define-macro (hi a) `(+ ,a 1)) (procedure-arity hi)) 'error)
+ (test (procedure-arity (make-procedure-with-setter (lambda (a) a) (lambda (a b) a))) '(1 0 #f 2 0 #f))
+ (test (procedure-arity (make-procedure-with-setter (lambda (a . b) a) (lambda (a b) a))) '(1 0 #t 2 0 #f))
+ (test (procedure-arity (make-procedure-with-setter (lambda* (a :optional b) a) (lambda (a b) a))) '(0 2 #f 2 0 #f))
+
+
(test (let ((c 1))
(define* (a #:optional (b c)) b)
(set! c 2)
@@ -7025,6 +10959,14 @@
(lambda (arg)
(test (procedure-arity arg) 'error))
(list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+
+ (for-each
+ (lambda (arg)
+ (eval-string (format #f "(define (func) ~S)" arg))
+ (let ((source (procedure-source func)))
+ (let ((val (func)))
+ (test val arg))))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) ':hi "hi"))
(test (string=? (let () (define (hi) "this is a string" 1) (procedure-documentation hi)) "this is a string") #t)
@@ -7113,6 +11055,7 @@
notes))
2)
+
(for-each
(lambda (arg)
(test (continuation? arg) #f))
@@ -7122,6 +11065,9 @@
(and (call/cc (lambda (x) (set! cont x) (continuation? x)))
(continuation? cont)))
#t)
+ (test (continuation?) 'error)
+ (test (continuation? 1 2) 'error)
+
(test (string? (s7-version)) #t)
(test (eval-string "(+ 1 2)") 3)
@@ -7136,6 +11082,8 @@
(test (eq? (eval (quote (quote ()))) ()) #t)
(test (apply (cons (quote cons) (cons 1 (quote ((quote ()))))) 1 ()) 1) ; essentially ((list 'cons 1 ...) 1) => 1
(test (eval ((cons (quote cons) (cons 1 (quote ((quote ()))))) 1)) 1)
+ (test (eval (eval (list '+ 1 2))) 3)
+
(test (apply + (+ 1) ()) 1)
(test (apply #(1) (+) ()) 1)
@@ -7143,6 +11091,7 @@
(test (eval #()) #())
(test (apply (lambda () #f)) #f)
(test (eval '(if #f #f)) (if #f #f))
+ (test (let ((ho 32)) (symbol? (eval (eval (eval (eval '''''ho)))))) #t)
(test (eval-string (string-append "(list 1 2 3)" (string #\newline) (string #\newline))) (list 1 2 3))
(eval-string (string-append "(define evalstr_1 32)" (string #\newline) "(define evalstr_2 2)"))
@@ -7153,12 +11102,27 @@
(if with-values (test (+ (eval `(values 1 2 3)) 4) 10))
(if with-values (test (+ (eval-string "(values 1 2 3)") 4) 10))
(test (+ 1 (eval-string "(+ 2 3)") 4) 10)
+ (test ((eval-string "(lambda (a) (+ a 1))") 2) 3)
+ (test (eval ((eval-string "(lambda (a) (list '+ a 1))") 2)) 3)
+ (test (eval-string "(+ 1 (eval (list '+ 1 2)))") 4)
+
+ (for-each
+ (lambda (arg)
+ (test (eval-string arg) 'error))
+ (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (for-each
+ (lambda (arg)
+ (test (eval-string "(+ 1 2)" arg) 'error))
+ (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i 'hi abs "hi" '#(()) (lambda () 1)))
+
+
(test (string=? (procedure-documentation abs) "(abs x) returns the absolute value of the real number x") #t)
(test (string=? (procedure-documentation 'abs) "(abs x) returns the absolute value of the real number x") #t)
(test (let ((hi (lambda (x) "this is a test" (+ x 1))))
(list (hi 1) (procedure-documentation hi)))
(list 2 "this is a test"))
+ (test (procedure-documentation (lambda* (a b) "docs" a)) "docs")
(for-each
(lambda (arg)
@@ -7171,6 +11135,14 @@
(lambda (arg)
(test (procedure-source arg) 'error))
(list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+
+ (test (procedure-documentation) 'error)
+ (test (procedure-documentation abs abs) 'error)
+ (test (procedure-arity) 'error)
+ (test (procedure-arity abs abs) 'error)
+ (test (procedure-source) 'error)
+ (test (procedure-source abs abs) 'error)
+
(test (make-list 0) '())
(test (make-list 0 123) '())
@@ -7179,12 +11151,22 @@
(test (make-list 1 '()) '(()))
(test (make-list 2) '(#f #f))
(test (make-list 2 1) '(1 1))
+ (test (make-list 2 (make-list 1 1)) '((1) (1)))
(test (make-list -1) 'error)
(for-each
(lambda (arg)
(test (make-list arg) 'error))
- (list #\a '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+ (list #\a '#(1 2 3) 3.14 3/4 1.0+1.0i '() #t 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+
+ (for-each
+ (lambda (arg)
+ (test ((make-list 1 arg) 0) arg))
+ (list #\a '#(1 2 3) 3.14 3/4 1.0+1.0i '() #f 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+
+ (test (make-list) 'error)
+ (test (make-list 1 2 3) 'error)
+
(test (let () (defmacro hiho (a) `(+ ,a 1)) (hiho 3)) 4)
(test (let () (defmacro hiho () `(+ 3 1)) (hiho)) 4)
@@ -7218,6 +11200,31 @@
(test (let () (define-macro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4)
+ (test (defmacro) 'error)
+ (test (define-macro) 'error)
+ (test (defmacro 1 2 3) 'error)
+ (test (define-macro (1 2) 3) 'error)
+ (test (defmacro a) 'error)
+ (test (define-macro (a)) 'error)
+ (test (defmacro a (1) 2) 'error)
+ (test (define-macro (a 1) 2) 'error)
+ (test (defmacro . a) 'error)
+ (test (define-macro . a) 'error)
+ (test (define :hi 1) 'error)
+ (test (define hi: 1) 'error)
+ (test (define-macro (:hi a) `(+ ,a 1)) 'error)
+ (test (defmacro :hi (a) `(+ ,a 1)) 'error)
+ (test (defmacro hi (1 . 2) 1) 'error)
+ (test (defmacro hi 1 . 2) 'error)
+ (test (defmacro : "" . #(1)) 'error)
+ (test (defmacro : #(1) . :) 'error)
+ (test (defmacro hi ()) 'error)
+ (test (define-macro (mac . 1) 1) 'error)
+ (test (define-macro (mac 1) 1) 'error)
+ (test (define-macro (a #()) 1) 'error)
+ (test (define-macro (i 1) => (j 2)) 'error)
+ (test (define hi 1 . 2) 'error)
+
(let ()
;; inspired by Doug Hoyte, "Let Over Lambda"
(define (mcxr path lst)
@@ -7392,6 +11399,7 @@
(lambda (arg)
(test (macro? arg) #f))
(list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+ (test (macro?) 'error)
(define-macro (fully-expand form)
(define (expand form)
@@ -7618,6 +11626,12 @@
(test (_mac14_ 2 :b 3) 5)
(test (_mac14_ :b 10 :a 12) 22)
(test (_mac14_ :a 4) 6)
+
+ (let ()
+ (set! *#readers* (list (cons #\s (lambda (str) 123))))
+ (let ((val (eval-string "(+ 1 #s1)"))) ; force this into the current reader
+ (test val 124))
+ (set! *#readers* '()))
(begin
(define-macro (hi a) `(+ ,a 1))
@@ -7816,15 +11830,11 @@
(define float-vector #f)
(let* ((fv-type (make-type
- :getter (lambda (obj index)
- ;(format #t "obj: ~A, index: ~A ~A -> ~A~%" obj index (vector? obj) (vector-ref obj index))
- (vector-ref obj index))
+ :getter vector-ref :length length :copy copy :fill fill!
:setter (lambda (obj index value)
(if (not (real? value))
(error 'wrong-type-arg-error "float-vector element must be real: ~S" value))
- (vector-set! obj index (exact->inexact value)))
- :length (lambda (obj)
- (vector-length obj))
+ (vector-set! obj index (* 1.0 value)))
:name "float-vector"))
(fv? (car fv-type))
(make-fv (cadr fv-type))
@@ -7834,7 +11844,7 @@
(lambda* (len (initial-element 0.0))
(if (not (real? initial-element))
(error 'wrong-type-arg-error "make-float-vector initial element must be real: ~S" initial-element))
- (make-fv (make-vector len (exact->inexact initial-element)))))
+ (make-fv (make-vector len (* 1.0 initial-element)))))
(set! float-vector? fv?)
@@ -7849,7 +11859,7 @@
(let ((arg (car lst)))
(if (not (real? arg))
(error 'wrong-type-arg-error "float-vector element must be real: ~S in ~S" arg args))
- (set! (v i) (exact->inexact arg))))))))
+ (set! (v i) (* 1.0 arg))))))))
(let ((v (make-float-vector 3 0.0)))
(test (length v) 3)
@@ -7900,7 +11910,54 @@
(set! (v 1) 32.0)
(adjust-vector v 10 #f)
(test (length v) 10)
- (test (v 1) 32.0)))
+ (test (v 1) 32.0))
+
+ (blet* (rec-a rec? rec-b make-rec)
+
+ ((rec-type (make-type :name "rec" :length length :copy copy :fill fill!))
+ (? (car rec-type))
+ (make (cadr rec-type))
+ (ref (caddr rec-type)))
+
+ (set! make-rec (lambda* ((a 1) (b 2))
+ (make (vector a b))))
+
+ (set! rec? ?)
+
+ (set! rec-a (make-procedure-with-setter
+ (lambda (obj)
+ (and (rec? obj)
+ (vector-ref (ref obj) 0)))
+ (lambda (obj val)
+ (if (rec? obj)
+ (vector-set! (ref obj) 0 val)))))
+
+ (set! rec-b (make-procedure-with-setter
+ (lambda (obj)
+ (and (rec? obj)
+ (vector-ref (ref obj) 1)))
+ (lambda (obj val)
+ (if (rec? obj)
+ (vector-set! (ref obj) 1 val))))))
+
+ (let ((r1 (make-rec)))
+ (let ((r2 (copy r1)))
+ (test (eq? r1 r2) #f)
+ (test (rec? r2) #t)
+ (test (rec-a r1) 1)
+ (test (rec-b r1) 2)
+ (test (rec-a r2) 1)
+ (test (rec-b r2) 2)
+ (set! (rec-b r2) 32)
+ (test (rec-b r2) 32)
+ (test (rec-b r1) 2)
+ (fill! r2 123)
+ (test (rec-a r1) 1)
+ (test (rec-b r1) 2)
+ (test (rec-a r2) 123)
+ (test (rec-b r2) 123)
+ )
+ ))
(define (notify-if-set var notifier)
@@ -7975,6 +12032,533 @@
(test '(_expansion_ 3) (quote (_expansion_ 3)))
(test (_expansion_ (+ (_expansion_ 1) 2)) 5)
+(test (let () (define-constant __c1__ 32) __c1__) 32)
+(test (let () __c1__) 'error)
+(test (let ((__c1__ 3)) __c1__) 'error)
+(test (let* ((__c1__ 3)) __c1__) 'error)
+(test (letrec ((__c1__ 3)) __c1__) 'error)
+(test (let () (define (__c1__ a) a) (__c1__ 3)) 'error)
+(test (let () (set! __c1__ 3)) 'error)
+
+(test (constant? '__c1__) #t)
+(test (constant? pi) #t)
+(test (constant? 'pi) #t) ; take that, Clisp!
+(test (constant? 12345) #t)
+(test (constant? 3.14) #t)
+(test (constant? :asdf) #t)
+(test (constant? 'asdf) #f)
+(test (constant? "hi") #t)
+(test (constant? #\a) #t)
+(test (constant? #f) #t)
+(test (constant? #t) #t)
+(test (constant? '()) #t)
+(test (constant? ()) #t)
+(test (constant? '(a)) #t)
+(test (constant? '*features*) #f)
+(test (let ((a 3)) (constant? 'a)) #f)
+(test (constant? 'abs) #f)
+(test (constant? abs) #t)
+(test (constant? most-positive-fixnum) #t)
+(test (constant? (/ (log 0))) #t) ; nan.0 is a constant as a number I guess
+(test (constant? (log 0)) #t)
+
+;; and some I wonder about -- in CL's terms, these always evaluate to the same thing, so they're constantp
+;; but Clisp:
+;; (constantp (cons 1 2)) ->NIL
+;; (constantp #(1 2)) -> T
+;; (constantp '(1 . 2)) -> NIL
+;; etc -- what a mess!
+
+(test (constant? (cons 1 2)) #t)
+(test (constant? #(1 2)) #t)
+(test (constant? (list 1 2)) #t)
+(test (constant? (vector 1 2)) #t)
+(test (let ((v (vector 1 2))) (constant? v)) #t) ;!!
+;; it's returning #t unless the arg is a symbol that is not a keyword or a defined constant
+;; (it's seeing the value of v, not v):
+(test (let ((v (vector 1 2))) (constant? 'v)) #f)
+
+;; not sure this is the right thing...
+;; but CL makes no sense:
+;; [3]> (constantp (vector 1))
+;; T
+;; [4]> (constantp (cons 1 2))
+;; NIL
+;; [5]> (constantp (list 1))
+;; NIL
+;; [7]> (constantp "hi")
+;; T
+;; (setf (elt "hi" 1) #\a)
+;; #\a
+;; at least they finally agree that pi is a constant!
+
+
+(test (defined? 'pi) #t)
+(test (defined? 'pi (global-environment)) #t)
+(test (defined? 'abs (global-environment)) #t)
+(test (defined? 'abs (current-environment)) #t)
+(test (let ((__c2__ 32)) (defined? '__c2__)) #t)
+(test (let ((__c2__ 32)) (defined? '__c2__ (current-environment))) #t)
+(test (let ((__c2__ 32)) (defined? '__c3__ (current-environment))) #f)
+(test (let ((__c2__ 32)) (defined? '__c2__ (global-environment))) #f)
+(test (let ((__c2__ 32)) (defined? '__c3__ (global-environment))) #f)
+
+(test (current-environment 1) 'error)
+(test (global-environment 1) 'error)
+
+
+(test (let ((a 1)) (eval '(+ a b) (augment-environment (current-environment) (cons 'b 32)))) 33)
+(test (let ((a 1)) (+ (eval '(+ a b) (augment-environment (current-environment) (cons 'b 32))) a)) 34)
+(test (let ((a 1)) (+ (eval '(+ a b) (augment-environment (current-environment) (cons 'b 32) (cons 'a 12))) a)) 45)
+
+(test (augment-environment) 'error)
+(for-each
+ (lambda (arg)
+ (test (augment-environment arg '(a . 32)) 'error))
+ (list -1 #\a 1 3.14 3/4 1.0+1.0i "hi"))
+(let ((e (augment-environment (current-environment)
+ (cons 'a 32)
+ (cons 'b 12))))
+ (test (eval '(+ a b) e) 44)
+ (test (eval '(+ a b c) (augment-environment e (cons 'c 3))) 47)
+ (test (eval '(+ a b) (augment-environment e (cons 'b 3))) 35))
+
+(test (with-environment (current-environment) (let ((x 1)) x)) 1)
+
+(test (let ((x 12))
+ (let ((e (current-environment)))
+ (let ((x 32))
+ (with-environment e (* x 2)))))
+ 24)
+
+(test (let ((*features* 123))
+ (let ((e (global-environment)))
+ (with-environment e (list? *features*))))
+ #t)
+
+(test (with-environment) 'error)
+(test (with-environment 1) 'error)
+(test (with-environment () 1) 'error)
+(test (with-environment (current-environment) 1) 1)
+(test (let ((a 1))
+ (+ (with-environment
+ (augment-environment (current-environment) (cons 'a 10))
+ a)
+ a))
+ 11)
+
+
+
+(test (call-with-exit (lambda (c) (0 (c 1)))) 1)
+(test (call-with-exit (lambda (k) (k "foo"))) "foo")
+(test (call-with-exit (lambda (k) "foo")) "foo")
+(test (call-with-exit (lambda (k) (k "foo") "oops")) "foo")
+(test (let ((memb (lambda (x ls)
+ (call-with-exit
+ (lambda (break)
+ (do ((ls ls (cdr ls)))
+ ((null? ls) #f)
+ (if (equal? x (car ls))
+ (break ls))))))))
+ (list (memb 'd '(a b c))
+ (memb 'b '(a b c))))
+ '(#f (b c)))
+
+(let ((x 1))
+ (define y (call-with-exit (lambda (return) (set! x (return 32)))))
+ (test (and (= x 1) (= y 32)) #t)
+ (set! y (call-with-exit (lambda (return) ((lambda (a b c) (set! x a)) 1 2 (return 33)))))
+ (test (and (= x 1) (= y 33)) #t)
+ (set! y (call-with-exit (lambda (return) ((lambda (a b) (return a) (set! x b)) 2 3))))
+ (test (and (= x 1) (= y 2)) #t))
+
+(if (and (defined? 'provided?)
+ (provided? 'threads))
+ (begin
+
+ (test (let ((ctr 0))
+ (let ((t1 (make-thread (lambda () (set! ctr (+ ctr 1))))))
+ (join-thread t1))
+ ctr)
+ 1)
+
+ (test (let ((ctr 0))
+ (let ((t1 (make-thread (lambda () (set! ctr (+ ctr 1))))))
+ (join-thread t1)
+ (thread? t1)))
+ #t)
+
+ (test (let ((ctr 0)
+ (loc (make-thread-variable)))
+ (let ((t1 (make-thread (lambda () (set! (loc) (+ ctr 1)) (set! ctr (loc))))))
+ (join-thread t1)
+ ctr))
+ 1)
+
+ (test (let ((ctr 0)
+ (loc (make-thread-variable)))
+ (let ((t1 (make-thread (lambda () (set! (loc) (+ ctr 1)) (set! ctr (thread-variable? loc))))))
+ (join-thread t1)
+ ctr))
+ #t)
+
+ (test (let ((ctr 0)
+ (lock (make-lock)))
+ (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
+ (join-thread t1))
+ ctr)
+ 1)
+
+ (test (let ((ctr 0)
+ (lock (make-lock)))
+ (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (lock? lock)) (release-lock lock)))))
+ (join-thread t1))
+ ctr)
+ #t)
+
+ (test (let ((ctr 0)
+ (lock (make-lock)))
+ (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock))))
+ (t2 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
+ (join-thread t1)
+ (join-thread t2))
+ ctr)
+ 2)
+
+ (test (let ((ctr 0)
+ (lock (make-lock)))
+ (let ((threads '()))
+ (do ((i 0 (+ 1 i)))
+ ((= i 8))
+ (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
+ (set! threads (cons t1 threads))))
+ (for-each
+ (lambda (tn)
+ (join-thread tn))
+ threads))
+ ctr)
+ 8)
+
+ (test (let ((ctr 0)
+ (ctr1 0)
+ (ctr2 0)
+ (lock (make-lock))
+ (var (make-thread-variable)))
+ (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (set! (var) ctr) (release-lock lock) (set! ctr1 (var)))))
+ (t2 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (set! (var) ctr) (release-lock lock) (set! ctr2 (var))))))
+ (join-thread t1)
+ (join-thread t2))
+ (and (= ctr 2)
+ (= (+ ctr1 ctr2) 3)))
+ #t)
+
+ (let ((v1 (make-vector 4096))
+ (v2 (make-vector 4096))
+ (dsum 0.0)
+ (dlock (make-lock)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 4096))
+ (set! (v1 i) (- (random 2.0) 1.0))
+ (set! (v2 i) (- (random 2.0) 1.0)))
+
+ (let ((threads '()))
+ (let loop
+ ((i 0))
+ (set! threads (cons (make-thread
+ (lambda ()
+ (let ((sum 0.0)
+ (end (+ i 1024)))
+ (do ((k i (+ k 1)))
+ ((= k end))
+ (set! sum (+ sum (* (v1 k) (v2 k)))))
+ (grab-lock dlock)
+ (set! dsum (+ dsum sum))
+ (release-lock dlock))))
+ threads))
+ (if (< i 3072)
+ (loop (+ i 1024))))
+
+ (for-each
+ (lambda (thread)
+ (join-thread thread))
+ threads))
+
+ (let ((xsum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4096))
+ (set! xsum (+ xsum (* (v1 i) (v2 i)))))
+
+ (test (< (abs (- xsum dsum)) .001) #t)))
+
+ (for-each
+ (lambda (arg)
+ (test (thread? arg) #f))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+ (for-each
+ (lambda (arg)
+ (test (lock? arg) #f))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+ (for-each
+ (lambda (arg)
+ (test (thread-variable? arg) #f))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+ (for-each
+ (lambda (arg)
+ (test (make-thread arg) 'error))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))
+
+ (for-each
+ (lambda (arg)
+ (test (grab-lock arg) 'error))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))
+
+ (for-each
+ (lambda (arg)
+ (test (release-lock arg) 'error))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))))
+
+(test (apply "hi" '(1 2)) 'error)
+(test ("hi" 1 2) 'error)
+(test (apply '(1 2) '(1 2)) 'error)
+(test ((list 1 2 3) 1 2) 'error)
+
+(test (apply "hi" '(1)) #\i)
+(test ("hi" 1) #\i)
+(test (apply '(1 2) '(1)) 2)
+(test ((list 1 2 3) 1) 2)
+
+(test (let ((pi 3)) pi) 'error)
+;; or ... (let ((:asdf 3)) :asdf) and worse (let ((:key 1)) :key) or even worse (let ((:3 1)) 1)
+(test (let ((x_x_x 32)) (let () (define-constant x_x_x 3) x_x_x) (set! x_x_x 31) x_x_x) 'error)
+
+
+(test (let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda () local)
+ (lambda (val) (set! local val))))
+ (pws-test))
+ 123)
+
+(test (let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda () local)
+ (lambda (val) (set! local val))))
+ (pws-test 32))
+ 'error)
+
+(test (let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda () local)
+ (lambda (val) (set! local val))))
+ (set! (pws-test 32) 123))
+ 'error)
+
+(test (call-with-exit
+ (lambda (return)
+ (let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda () (return "oops"))
+ (lambda (val) (set! local val))))
+ (pws-test))))
+ "oops")
+(test (call-with-exit
+ (lambda (return)
+ (let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda () 123)
+ (lambda (val) (return "oops"))))
+ (set! (pws-test) 1))))
+ "oops")
+
+(test (let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda () local)
+ (lambda (val) (set! local val))))
+ (set! (pws-test) 321)
+ (pws-test))
+ 321)
+
+(test (let ((v (vector 1 2 3)))
+ (define vset (make-procedure-with-setter
+ (lambda (loc)
+ (vector-ref v loc))
+ (lambda (loc val)
+ (vector-set! v loc val))))
+ (let ((lst (list vset)))
+ (let ((val (vset 1)))
+ (set! (vset 1) 32)
+ (let ((val1 (vset 1)))
+ (set! ((car lst) 1) 3)
+ (list val val1 (vset 1))))))
+ (list 2 32 3))
+
+(let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda () local)
+ (lambda (val) (set! local val))))
+ (test (pws-test) 123)
+ (set! (pws-test) 32)
+ (test (pws-test) 32)
+ (set! (pws-test) 0)
+ (test (pws-test) 0))
+
+(let ((local 123))
+ (define pws-test (make-procedure-with-setter
+ (lambda (val) (+ local val))
+ (lambda (val new-val) (set! local new-val) (+ local val))))
+ (test (pws-test 1) 124)
+ (set! (pws-test 1) 32)
+ (test (pws-test 2) 34)
+ (set! (pws-test 3) 0)
+ (test (pws-test 3) 3))
+
+
+(test (make-procedure-with-setter) 'error)
+(test (make-procedure-with-setter abs) 'error)
+(test (make-procedure-with-setter 1 2) 'error)
+(test (make-procedure-with-setter (lambda () 1) (lambda (a) a) (lambda () 2)) 'error)
+(test (make-procedure-with-setter (lambda () 1) 2) 'error)
+
+(let ((pws (make-procedure-with-setter vector-ref vector-set!)))
+ (let ((v (vector 1 2 3)))
+ (test (pws v 1) 2)
+ (set! (pws v 1) 32)
+ (test (pws v 1) 32)
+ (test (procedure-arity pws) '(2 0 #t 3 0 #t))))
+
+
+(define (procedure-with-setter-setter-arity proc) (cdddr (procedure-arity proc)))
+(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda (a) a)))) (procedure-with-setter-setter-arity pws)) '(1 0 #f))
+(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda (a b c) a)))) (procedure-with-setter-setter-arity pws)) '(3 0 #f))
+(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda (a . b) a)))) (procedure-with-setter-setter-arity pws)) '(1 0 #t))
+(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda* (a (b 1)) a)))) (procedure-with-setter-setter-arity pws)) '(0 2 #f))
+(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda* (a :rest b) a)))) (procedure-with-setter-setter-arity pws)) '(0 1 #t))
+(test (procedure-with-setter-setter-arity symbol-access) '(2 0 #f))
+
+
+
+;; generic length/reverse/copy/fill!
+(test (length (list 1 2)) 2)
+(test (length "hiho") 4)
+(test (length (vector 1 2)) 2)
+(test (length (make-hash-table 7)) 7)
+(test (length '()) 0)
+(test (length (#(#() #()) 1)) 0)
+
+(test (copy 3) 3)
+(test (copy 3/4) 3/4)
+(test (copy "hi") "hi")
+(test (copy (list 1 2 3)) (list 1 2 3))
+(test (copy (vector 0.0)) (vector 0.0))
+(test (copy #\f) #\f)
+(test (copy (list 1 (list 2 3))) (list 1 (list 2 3)))
+(test (copy (cons 1 2)) (cons 1 2))
+(test (copy '(1 2 . 3)) '(1 2 . 3))
+(test (copy (+)) 0)
+(test (copy +) +)
+(test (copy (#(#() #()) 1)) #())
+(test (copy #f) #f)
+(test (copy '()) '())
+
+(test (reverse "hi") "ih")
+(test (reverse "") "")
+(test (reverse "123") "321")
+(test (reverse "1234") "4321")
+(test (reverse #()) #())
+(test (reverse #(1 2 3)) #(3 2 1))
+(test (reverse #(1 2 3 4)) #(4 3 2 1))
+(test (reverse #2D((1 2) (3 4))) #2D((4 3) (2 1)))
+
+(if (not (provided? 'gmp))
+ (let ((r1 (make-random-state 1234)))
+ (random 1.0 r1)
+ (let ((r2 (copy r1)))
+ (let ((v1 (random 1.0 r1))
+ (v2 (random 1.0 r2)))
+ (test (= v1 v2) #t)
+ (let ((v3 (random 1.0 r1)))
+ (random 1.0 r1)
+ (random 1.0 r1)
+ (let ((v4 (random 1.0 r2)))
+ (test (= v3 v4) #t)))))))
+
+(if (provided? 'gmp)
+ (let ((i (copy (bignum "1")))
+ (r (copy (bignum "3/4")))
+ (f (copy (bignum "1.5")))
+ (c (copy (bignum "1.0+1.0i"))))
+ (test (= i (bignum "1")) #t)
+ (test (= r (bignum "3/4")) #t)
+ (test (= f (bignum "1.5")) #t)
+ (test (= c (bignum "1.0+1.0i")) #t)))
+
+(let ((str (string #\1 #\2 #\3)))
+ (fill! str #\x)
+ (test str "xxx"))
+(let ((v (vector 1 2 3)))
+ (fill! v 0.0)
+ (test v (vector 0.0 0.0 0.0)))
+(let ((lst (list 1 2 (list (list 3) 4))))
+ (fill! lst 100)
+ (test lst '(100 100 100)))
+(let ((cn (cons 1 2)))
+ (fill! cn 100)
+ (test cn (cons 100 100)))
+(test (fill! 1 0) 'error)
+(test (fill! 'hi 0) 'error)
+
+(test (fill!) 'error)
+(test (copy) 'error)
+(test (fill! '"hi") 'error)
+
+(for-each
+ (lambda (arg)
+ (test (fill! arg 1) 'error))
+ (list (integer->char 65) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (let ((str (string #\a #\b)))
+ (test (fill! str arg) 'error)))
+ (list "hi" '(1 2 3) #() #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+;; generic for-each/map
+(test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6)
+(test (map (lambda (n) (+ n 1)) (vector 1 2 3)) '(2 3 4))
+(test (map (lambda (a b) (/ a b)) (list 1 2 3) (list 4 5 6)) '(1/4 2/5 1/2))
+
+;; try some applicable stuff
+(test (let ((lst (list 1 2 3)))
+ (set! (lst 1) 32)
+ (list (lst 0) (lst 1)))
+ (list 1 32))
+
+(test (let ((hash (make-hash-table)))
+ (set! (hash 'hi) 32)
+ (hash 'hi))
+ 32)
+
+(test (let ((str (string #\1 #\2 #\3)))
+ (set! (str 1) #\a)
+ (str 1))
+ #\a)
+
+(test (let ((v (vector 1 2 3)))
+ (set! (v 1) 0)
+ (v 1))
+ 0)
+
+(let ()
+ (define (hiho a) __func__)
+ (test (or (equal? (hiho 1) 'hiho)
+ (equal? (car (hiho 1)) 'hiho))
+ #t))
+
#|
;; these 2 tests don't work in this context because the file/line are included
@@ -9340,12 +13924,10 @@
(define list-length length)
(define* (cl-make-list size (initial-element '())) (make-list size initial-element))
- (define (copy-list lis) ; need to handle dotted lists too
- (if (null? list)
- '()
- (if (not (pair? lis))
- lis
- (cons (car lis) (copy-list (cdr lis))))))
+ (define (copy-list lis)
+ (if (not (pair? lis))
+ lis
+ (cons (car lis) (copy-list (cdr lis)))))
(define (rplaca x y) (set-car! x y) x)
(define (rplacd x y) (set-cdr! x y) x)
@@ -9642,7 +14224,7 @@
(define minusp negative?)
(define realpart real-part)
(define imagpart imag-part)
- (define* (float x ignore) (exact->inexact x))
+ (define* (float x ignore) (* 1.0 x))
(define rational rationalize)
(define mod modulo)
(define rem remainder)
@@ -9731,8 +14313,6 @@
(define (ldb-test byte int) (not (zero? (ldb byte int))))
(define (mask-field byte int) (logand int (dpb -1 byte 0)))
(define (deposit-field byte spec int) (logior (logand byte (byte-mask spec)) (logand int (lognot (byte-mask spec)))))
-
- ;; decode-float strikes me as a bad idea, as do all the others in this section!
(define (scale-float x k) (* x (expt 2.0 k)))
;; from clisp -- can't see any point to most of these
@@ -9801,10 +14381,10 @@
(define* (cl-ceiling x (divisor 1)) (ceiling (/ x divisor)))
(define* (cl-truncate x (divisor 1)) (truncate (/ x divisor)))
(define* (cl-round x (divisor 1)) (round (/ x divisor)))
- (define* (ffloor x divisor) (exact->inexact (cl-floor x divisor)))
- (define* (fceling x divisor) (exact->inexact (cl-ceiling x divisor)))
- (define* (ftruncate x divisor) (exact->inexact (cl-truncate x divisor)))
- (define* (fround x divisor) (exact->inexact (cl-round x divisor)))
+ (define* (ffloor x divisor) (* 1.0 (cl-floor x divisor)))
+ (define* (fceling x divisor) (* 1.0 (cl-ceiling x divisor)))
+ (define* (ftruncate x divisor) (* 1.0 (cl-truncate x divisor)))
+ (define* (fround x divisor) (* 1.0 (cl-round x divisor)))
(define (/= . args)
(if (null? (cdr args))
@@ -10615,9 +15195,9 @@
(define svref vector-ref)
(define aref vector-ref)
- (define array-dimensions vector-dimensions)
+ (define array-dimensions vector-dimensions)
(define array-total-size vector-length)
- (define (array-dimension array num) (list-ref (vector-dimensions array) num))
+ (define (array-dimension array num) (list-ref (vector-dimensions array) num))
(define-constant array-dimension-limit 16777215)
(define-constant array-rank-limit 4096)
@@ -11534,13 +16114,13 @@
(test-t (eql (do ((temp-one 1 (1+ temp-one)) (temp-two 0 (1+ temp-one))) ((= 3 temp-two) temp-one)) 3))
(test-t (eql (do* ((temp-one 1 (1+ temp-one)) (temp-two 0 (1+ temp-one))) ((= 3 temp-two) temp-one)) 2))
- (test-t (let ((a-vector (vector 1 nil 3 nil)))
- (and (null (do ((i 0 (+ i 1))
- (n (array-dimension a-vector 0)))
- ((= i n))
- (when (null (aref a-vector i))
- (setf (aref a-vector i) 0))))
- (equalp a-vector #(1 0 3 0)))))
+ (test-t (let ((a-vector (vector 1 nil 3 nil)))
+ (do ((i 0 (+ i 1))
+ (n (array-dimension a-vector 0)))
+ ((= i n))
+ (when (null (aref a-vector i))
+ (setf (aref a-vector i) 0)))
+ (equalp a-vector #(1 0 3 0))))
(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
(equalp (do ((i 0 (1+ i))
@@ -15929,12 +20509,13 @@
(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 7 val)) 8)
(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 17 val)) '())
- (if with-values (begin
- (test (let*-values (((x) (values 1))) x) 1)
- (test (let*-values ((x (values 1))) x) '(1))
- (test (let*-values (((x) (values 1)) ((y) (values 2))) (list x y)) '(1 2))
- (test (let*-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)) '(1 2))
- ))
+ (if with-values
+ (begin
+ (test (let*-values (((x) (values 1))) x) 1)
+ (test (let*-values ((x (values 1))) x) '(1))
+ (test (let*-values (((x) (values 1)) ((y) (values 2))) (list x y)) '(1 2))
+ (test (let*-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)) '(1 2))
+ ))
(test (let () (enum one two three) (list one two three)) '(0 1 2))
@@ -17014,7 +21595,7 @@
;***
;
- ; Another way of writing that class definition, that achives better
+ ; Another way of writing that class definition, that achieves better
; `encapsulation' by using slot names that are unique keys, rather
; than symbols.
;
@@ -17114,7 +21695,7 @@
; subclass that allocates all its slots dynamically.
;
;
-;;; these tests take too long for what why return
+;;; these tests take too long for what they return
#|
(define <dynamic-class>
(make-class (list <class>)
@@ -17290,607 +21871,6 @@
-(test (let () (define-constant __c1__ 32) __c1__) 32)
-(test (let () __c1__) 'error)
-(test (let ((__c1__ 3)) __c1__) 'error)
-(test (let* ((__c1__ 3)) __c1__) 'error)
-(test (letrec ((__c1__ 3)) __c1__) 'error)
-(test (let () (define (__c1__ a) a) (__c1__ 3)) 'error)
-(test (let () (set! __c1__ 3)) 'error)
-(test (constant? '__c1__) #t)
-(test (constant? 'abs) #f)
-(test (constant? '*features*) #f)
-
-(test (defined? 'pi) #t)
-(test (defined? 'pi (global-environment)) #t)
-(test (defined? 'abs (global-environment)) #t)
-(test (defined? 'abs (current-environment)) #t)
-(test (let ((__c2__ 32)) (defined? '__c2__)) #t)
-(test (let ((__c2__ 32)) (defined? '__c2__ (current-environment))) #t)
-(test (let ((__c2__ 32)) (defined? '__c3__ (current-environment))) #f)
-(test (let ((__c2__ 32)) (defined? '__c2__ (global-environment))) #f)
-(test (let ((__c2__ 32)) (defined? '__c3__ (global-environment))) #f)
-
-(test (let ((a 1)) (eval '(+ a b) (augment-environment (current-environment) (cons 'b 32)))) 33)
-
-(test (call-with-exit (lambda (c) (0 (c 1)))) 1)
-(test (call-with-exit (lambda (k) (k "foo"))) "foo")
-(test (call-with-exit (lambda (k) "foo")) "foo")
-(test (call-with-exit (lambda (k) (k "foo") "oops")) "foo")
-(test (let ((memb (lambda (x ls)
- (call-with-exit
- (lambda (break)
- (do ((ls ls (cdr ls)))
- ((null? ls) #f)
- (if (equal? x (car ls))
- (break ls))))))))
- (list (memb 'd '(a b c))
- (memb 'b '(a b c))))
- '(#f (b c)))
-(let ((x 1))
- (define y (call-with-exit (lambda (return) (set! x (return 32)))))
- (test (and (= x 1) (= y 32)) #t)
- (set! y (call-with-exit (lambda (return) ((lambda (a b c) (set! x a)) 1 2 (return 33)))))
- (test (and (= x 1) (= y 33)) #t)
- (set! y (call-with-exit (lambda (return) ((lambda (a b) (return a) (set! x b)) 2 3))))
- (test (and (= x 1) (= y 2)) #t))
-
-;(test (string=? (let ((hi (lambda (b) (+ b 1)))) (object->string hi)) "hi") #t) -- this has changed
-(test (string=? (object->string 32) "32") #t)
-(test (string=? (object->string 32.5) "32.5") #t)
-(test (string=? (object->string 32/5) "32/5") #t)
-(test (string=? (object->string "hiho") "\"hiho\"") #t)
-(test (string=? (object->string 'symb) "symb") #t)
-(test (string=? (object->string (list 1 2 3)) "(1 2 3)") #t)
-(test (string=? (object->string (cons 1 2)) "(1 . 2)") #t)
-(test (string=? (object->string '#(1 2 3)) "#(1 2 3)") #t)
-(test (string=? (object->string +) "+") #t)
-
-(test (let ((l (list 1 2)))
- (list-set! l 0 l)
- (string=? (object->string l) "([circular list] 2)"))
- #t)
-(test (let ((lst (cons 1 2)))
- (set-cdr! lst lst)
- (string=? (object->string lst) "[circular list]"))
- #t)
-(test (let ((lst (cons 1 2)))
- (set-car! lst lst)
- (string=? (object->string lst) "([circular list] . 2)"))
- #t)
-(test (let ((lst (cons (cons 1 2) 3)))
- (set-car! (car lst) lst)
- (string=? (object->string lst) "(([circular list] . 2) . 3)"))
- #t)
-(test (let ((v (vector 1 2)))
- (vector-set! v 0 v)
- (string=? (object->string v) "#([circular vector] 2)"))
- #t)
-(test (let* ((l1 (list 1 2)) (l2 (list l1)))
- (list-set! l1 0 l1)
- (string=? (object->string l2) "(([circular list] 2))"))
- #t)
-(test (let* ((v1 (vector 1 2)) (v2 (vector v1)))
- (vector-set! v1 1 v1)
- (string=? (object->string v2) "#(#(1 [circular vector]))"))
- #t)
-(test (let ((v1 (make-vector 3 1)))
- (vector-set! v1 0 (cons 3 v1))
- (string=? (object->string v1) "#((3 . [circular vector]) 1 1)"))
- #t)
-(test (let ((h1 (make-hash-table 11))
- (old-print-length *vector-print-length*))
- (set! *vector-print-length* 32)
- (hash-table-set! h1 'hi h1)
- (let ((result (object->string h1)))
- (set! *vector-print-length* old-print-length)
- (let ((val (string=? result "#(() () () () ((\"hi\" . [circular hash-table])) () () () () () ())")))
- (if (not val)
- (format #t ";hash display:~% ~A~% ~A~%" (object->string h1) "#(() () () () ((\"hi\" . [circular hash-table])) () () () () () ())"))
- val)))
- #t)
-
-(test (let* ((l1 (list 1 2))
- (v1 (vector 1 2))
- (l2 (list 1 l1 2))
- (v2 (vector l1 v1 l2)))
- (vector-set! v1 0 v2)
- (list-set! l1 1 l2)
- (string=? (object->string v2) "#((1 (1 [circular list] 2)) #([circular vector] 2) (1 (1 [circular list]) 2))"))
- #t)
-
-(if with-values (begin
-(test (multiple-value-bind (a b) (values 1 2) (+ a b)) 3)
-(test (multiple-value-bind (a) 1 a) 1)
-(test (multiple-value-bind (a . rest) (values 1 2 3) (+ a (apply + rest))) 6)
-(test (multiple-value-bind a (values 1 2 3) a) '(1 2 3))
-
-(test (let ((a 1)
- (b 2))
- (multiple-value-set! (a b) (values 32 64))
- (+ a b))
- 96)
-))
-
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (integer->char (read-byte p)))) #\t)
-
-(let ((bytes (vector #o000 #o000 #o000 #o034 #o000 #o001 #o215 #o030 #o000 #o000 #o000 #o022 #o000
- #o000 #o126 #o042 #o000 #o000 #o000 #o001 #o000 #o000 #o000 #o000 #o000 #o001)))
- (with-output-to-file "tmp1.r5rs"
- (lambda ()
- (for-each
- (lambda (b)
- (write-byte b))
- bytes)))
-
- (let ((ctr 0))
- (call-with-input-file "tmp1.r5rs"
- (lambda (p)
-
- (if (not (string=? (port-filename p) "tmp1.r5rs")) (display (port-filename p)))
-
- (let loop ((val (read-byte p)))
- (if (eof-object? val)
- (if (not (= ctr 26))
- (format #t "read-byte done at ~A~%" ctr))
- (begin
- (if (not (= (bytes ctr) val))
- (format #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val))
- (set! ctr (+ 1 ctr))
- (loop (read-byte p))))))))
-
- (let ((ctr 0))
- (call-with-input-file "tmp1.r5rs"
- (lambda (p)
- (let loop ((val (read-char p)))
- (if (eof-object? val)
- (if (not (= ctr 26))
- (format #t "read-char done at ~A~%" ctr))
- (begin
- (if (not (= (bytes ctr) (char->integer val)))
- (format #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val)))
- (set! ctr (+ 1 ctr))
- (loop (read-char p))))))))
- )
-
-(with-output-to-file "tmp1.r5rs"
- (lambda ()
- (display "(+ 1 2) 32")
- (newline)
- (display "#\\a -1")))
-
-(with-input-from-file "tmp1.r5rs"
- (lambda ()
- (let ((val (read)))
- (if (not (equal? val (list '+ 1 2)))
- (format #t "read: ~A~%" val)))
- (let ((val (read)))
- (if (not (equal? val 32))
- (format #t "read: ~A~%" val)))
- (let ((val (read)))
- (if (not (equal? val #\a))
- (format #t "read: ~A~%" val)))
- (let ((val (read)))
- (if (not (equal? val -1))
- (format #t "read: ~A~%" val)))
- (let ((val (read)))
- (if (not (eof-object? val))
- (format #t "read: ~A~%" val)))))
-
-(if (and (defined? 'provided?)
- (provided? 'threads))
- (begin
-
- (test (let ((ctr 0))
- (let ((t1 (make-thread (lambda () (set! ctr (+ ctr 1))))))
- (join-thread t1))
- ctr)
- 1)
-
- (test (let ((ctr 0))
- (let ((t1 (make-thread (lambda () (set! ctr (+ ctr 1))))))
- (join-thread t1)
- (thread? t1)))
- #t)
-
- (test (let ((ctr 0)
- (loc (make-thread-variable)))
- (let ((t1 (make-thread (lambda () (set! (loc) (+ ctr 1)) (set! ctr (loc))))))
- (join-thread t1)
- ctr))
- 1)
-
- (test (let ((ctr 0)
- (loc (make-thread-variable)))
- (let ((t1 (make-thread (lambda () (set! (loc) (+ ctr 1)) (set! ctr (thread-variable? loc))))))
- (join-thread t1)
- ctr))
- #t)
-
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
- (join-thread t1))
- ctr)
- 1)
-
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (lock? lock)) (release-lock lock)))))
- (join-thread t1))
- ctr)
- #t)
-
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock))))
- (t2 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
- (join-thread t1)
- (join-thread t2))
- ctr)
- 2)
-
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((threads '()))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
- (set! threads (cons t1 threads))))
- (for-each
- (lambda (tn)
- (join-thread tn))
- threads))
- ctr)
- 8)
-
- (test (let ((ctr 0)
- (ctr1 0)
- (ctr2 0)
- (lock (make-lock))
- (var (make-thread-variable)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (set! (var) ctr) (release-lock lock) (set! ctr1 (var)))))
- (t2 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (set! (var) ctr) (release-lock lock) (set! ctr2 (var))))))
- (join-thread t1)
- (join-thread t2))
- (and (= ctr 2)
- (= (+ ctr1 ctr2) 3)))
- #t)
-
- (let ((v1 (make-vector 4096))
- (v2 (make-vector 4096))
- (dsum 0.0)
- (dlock (make-lock)))
-
- (do ((i 0 (+ i 1)))
- ((= i 4096))
- (set! (v1 i) (- (random 2.0) 1.0))
- (set! (v2 i) (- (random 2.0) 1.0)))
-
- (let ((threads '()))
- (let loop
- ((i 0))
- (set! threads (cons (make-thread
- (lambda ()
- (let ((sum 0.0)
- (end (+ i 1024)))
- (do ((k i (+ k 1)))
- ((= k end))
- (set! sum (+ sum (* (v1 k) (v2 k)))))
- (grab-lock dlock)
- (set! dsum (+ dsum sum))
- (release-lock dlock))))
- threads))
- (if (< i 3072)
- (loop (+ i 1024))))
-
- (for-each
- (lambda (thread)
- (join-thread thread))
- threads))
-
- (let ((xsum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 4096))
- (set! xsum (+ xsum (* (v1 i) (v2 i)))))
-
- (test (< (abs (- xsum dsum)) .001) #t)))
-
- (for-each
- (lambda (arg)
- (test (thread? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
- (for-each
- (lambda (arg)
- (test (lock? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
- (for-each
- (lambda (arg)
- (test (thread-variable? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
- (for-each
- (lambda (arg)
- (test (make-thread arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))
-
- (for-each
- (lambda (arg)
- (test (grab-lock arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))
-
- (for-each
- (lambda (arg)
- (test (release-lock arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))))
-
-(let ((v (make-vector '(2 3) 0)))
- (num-test (vector-length v) 6)
- (test (vector-dimensions v) '(2 3))
- (num-test (v 0 0) 0)
- (num-test (v 1 2) 0)
- (test (v 2 2) 'error)
- (test (v 2 -1) 'error)
- (test (v 2 0) 'error)
- (set! (v 0 1) 1)
- (num-test (v 0 1) 1)
- (num-test (v 1 0) 0)
- (set! (v 1 2) 2)
- (num-test (v 1 2) 2)
- (test (set! (v 2 2) 32) 'error)
- (test (set! (v 1 -1) 0) 'error)
- (test (set! (v 2 0) 0) 'error)
- (num-test (vector-ref v 0 1) 1)
- (num-test (vector-ref v 1 2) 2)
- (test (vector-ref v 2 2) 'error)
- (test (vector-ref v 1 -1) 'error)
- (vector-set! v 1 1 64)
- (num-test (vector-ref v 1 1) 64)
- (num-test (vector-ref v 0 0) 0)
- (test (vector-ref v 1 2 3) 'error)
- (test (vector-set! v 1 2 3 4) 'error)
- (test (v 1 1 1) 'error)
- (test (set! (v 1 1 1) 1) 'error))
-
-(let ((v1 (make-vector '(3 2) 0))
- (v2 (make-vector '(2 3) 0))
- (v3 (make-vector '(2 3 4) 0))
- (v4 (make-vector 6 0))
- (v5 (make-vector '(2 3) 0)))
- (test (equal? v1 v2) #f)
- (test (equal? v1 v3) #f)
- (test (equal? v1 v4) #f)
- (test (equal? v2 v2) #t)
- (test (equal? v3 v2) #f)
- (test (equal? v4 v2) #f)
- (test (equal? v5 v2) #t)
- (test (equal? v4 v3) #f)
- (test (vector-dimensions v3) '(2 3 4))
- (test (vector-dimensions v4) '(6))
- (num-test (v3 1 2 3) 0)
- (set! (v3 1 2 3) 32)
- (num-test (v3 1 2 3) 32)
- (num-test (vector-length v3) 24)
- (num-test (vector-ref v3 1 2 3) 32)
- (vector-set! v3 1 2 3 -32)
- (num-test (v3 1 2 3) -32)
- (test (v3 1 2) 'error)
- (test (set! (v3 1 2) 3) 'error)
- (test (vector-ref v3 1 2) 'error)
- (test (vector-set! v3 1 2 32) 'error))
-
-(test (#(1 2) 1) 2)
-(test (#(1 2) 1 2) 'error)
-
-(test (constant? pi) #t)
-(test (constant? 'pi) #t) ; take that, Clisp!
-(test (constant? 12345) #t)
-(test (constant? 3.14) #t)
-(test (constant? :asdf) #t)
-(test (constant? "hi") #t)
-(test (constant? #\a) #t)
-(test (constant? #f) #t)
-(test (constant? #t) #t)
-(test (constant? '()) #t)
-(test (constant? ()) #t)
-(test (constant? '(a)) #t)
-(test (constant? '*features*) #f)
-(test (let ((a 3)) (constant? 'a)) #f)
-(test (constant? 'abs) #f)
-(test (constant? abs) #t)
-
-(test (apply "hi" '(1 2)) 'error)
-(test ("hi" 1 2) 'error)
-(test (apply '(1 2) '(1 2)) 'error)
-(test ((list 1 2 3) 1 2) 'error)
-
-(test (apply "hi" '(1)) #\i)
-(test ("hi" 1) #\i)
-(test (apply '(1 2) '(1)) 2)
-(test ((list 1 2 3) 1) 2)
-
-(test (let ((pi 3)) pi) 'error)
-;; or ... (let ((:asdf 3)) :asdf) and worse (let ((:key 1)) :key) or even worse (let ((:3 1)) 1)
-(test (let ((x_x_x 32)) (let () (define-constant x_x_x 3) x_x_x) (set! x_x_x 31) x_x_x) 'error)
-
-
-(test (with-environment (current-environment) (let ((x 1)) x)) 1)
-
-(test (let ((x 12))
- (let ((e (current-environment)))
- (let ((x 32))
- (with-environment e (* x 2)))))
- 24)
-
-(test (let ((*features* 123))
- (let ((e (global-environment)))
- (with-environment e (list? *features*))))
- #t)
-
-(test (with-environment) 'error)
-(test (with-environment 1) 'error)
-(test (with-environment () 1) 'error)
-(test (with-environment (current-environment) 1) 1)
-
-(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
- (lambda () local)
- (lambda (val) (set! local val))))
- (pws-test))
- 123)
-
-(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
- (lambda () local)
- (lambda (val) (set! local val))))
- (pws-test 32))
- 'error)
-
-(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
- (lambda () local)
- (lambda (val) (set! local val))))
- (set! (pws-test 32) 123))
- 'error)
-
-(test (call-with-exit (lambda (return) (let ((local 123))
- (define pws-test (make-procedure-with-setter
- (lambda () (return "oops"))
- (lambda (val) (set! local val))))
- (pws-test))))
- "oops")
-(test (call-with-exit (lambda (return) (let ((local 123))
- (define pws-test (make-procedure-with-setter
- (lambda () 123)
- (lambda (val) (return "oops"))))
- (set! (pws-test) 1))))
- "oops")
-
-(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
- (lambda () local)
- (lambda (val) (set! local val))))
- (set! (pws-test) 321)
- (pws-test))
- 321)
-
-(test (let ((v (vector 1 2 3)))
- (define vset (make-procedure-with-setter
- (lambda (loc)
- (vector-ref v loc))
- (lambda (loc val)
- (vector-set! v loc val))))
- (let ((lst (list vset)))
- (let ((val (vset 1)))
- (set! (vset 1) 32)
- (let ((val1 (vset 1)))
- (set! ((car lst) 1) 3)
- (list val val1 (vset 1))))))
- (list 2 32 3))
-
-(for-each
- (lambda (arg)
- (test (port-filename arg) 'error))
- (list "hi" -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
-
-(for-each
- (lambda (arg)
- (test (port-line-number arg) 'error))
- (list "hi" -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
-
-;; generic length/copy/fill!
-(test (length (list 1 2)) 2)
-(test (length "hiho") 4)
-(test (length (vector 1 2)) 2)
-(test (length (make-hash-table 7)) 7)
-(test (length '()) 0)
-(test (length (#(#() #()) 1)) 0)
-
-(test (copy 3) 3)
-(test (copy 3/4) 3/4)
-(test (copy "hi") "hi")
-(test (copy (list 1 2 3)) (list 1 2 3))
-(test (copy (vector 0.0)) (vector 0.0))
-(test (copy #\f) #\f)
-(test (copy (list 1 (list 2 3))) (list 1 (list 2 3)))
-(test (copy (cons 1 2)) (cons 1 2))
-(test (copy '(1 2 . 3)) '(1 2 . 3))
-(test (copy (+)) 0)
-(test (copy +) +)
-(test (copy (#(#() #()) 1)) #())
-
-(if (not (provided? 'gmp))
- (let ((r1 (make-random-state 1234)))
- (random 1.0 r1)
- (let ((r2 (copy r1)))
- (let ((v1 (random 1.0 r1))
- (v2 (random 1.0 r2)))
- (test (= v1 v2) #t)
- (let ((v3 (random 1.0 r1)))
- (random 1.0 r1)
- (random 1.0 r1)
- (let ((v4 (random 1.0 r2)))
- (test (= v3 v4) #t)))))))
-
-(if (provided? 'gmp)
- (let ((i (copy (bignum "1")))
- (r (copy (bignum "3/4")))
- (f (copy (bignum "1.5")))
- (c (copy (bignum "1.0+1.0i"))))
- (test (= i (bignum "1")) #t)
- (test (= r (bignum "3/4")) #t)
- (test (= f (bignum "1.5")) #t)
- (test (= c (bignum "1.0+1.0i")) #t)))
-
-(let ((str (string #\1 #\2 #\3)))
- (fill! str #\x)
- (test str "xxx"))
-(let ((v (vector 1 2 3)))
- (fill! v 0.0)
- (test v (vector 0.0 0.0 0.0)))
-(let ((lst (list 1 2 (list (list 3) 4))))
- (fill! lst 100)
- (test lst '(100 100 ((100) 100))))
-(let ((cn (cons 1 2)))
- (fill! cn 100)
- (test cn (cons 100 100)))
-(test (fill! 1 0) 'error)
-(test (fill! 'hi 0) 'error)
-
-;; generic for-each/map
-(test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6)
-(test (map (lambda (n) (+ n 1)) (vector 1 2 3)) '(2 3 4))
-(test (map (lambda (a b) (/ a b)) (list 1 2 3) (list 4 5 6)) '(1/4 2/5 1/2))
-
-;; try some applicable stuff
-(test (let ((lst (list 1 2 3)))
- (set! (lst 1) 32)
- (list (lst 0) (lst 1)))
- (list 1 32))
-
-(test (let ((hash (make-hash-table)))
- (set! (hash 'hi) 32)
- (hash 'hi))
- 32)
-
-(test (let ((str (string #\1 #\2 #\3)))
- (set! (str 1) #\a)
- (str 1))
- #\a)
-
-(test (let ((v (vector 1 2 3)))
- (set! (v 1) 0)
- (v 1))
- 0)
-
-(let ()
- (define (hiho a) __func__)
- (test (or (equal? (hiho 1) 'hiho)
- (equal? (car (hiho 1)) 'hiho))
- #t))
-
@@ -18294,6 +22274,30 @@
(val2 (* 1/8 (+ (sqrt (+ 10 (* 2 (sqrt 5)))) (sqrt 15) (- (sqrt 3))))))
(num-test (- val1 val2) 0.0))
+(num-test (sin 22) -8.851309290403875921690256815772332463307E-3)
+(if with-bigfloats
+ (num-test (sin 1e22) -8.522008497671888017727058937530293682616E-1))
+;; not even close if not bignums: 0.4626130407646
+;; we start to lose around 1e18 -- running out of bits of fraction?
+
+(test (>= 0.0000001 (sin 0.0000001)) #t)
+(test (>= 0.000000001 (sin 0.000000001)) #t)
+;(test (>= 0.0000001 (sin (+ (* 2 our-pi) 0.0000001))) #t)
+; this fails because "pi" is inaccurate?
+(num-test (sin 31415926.0) -0.5106132968486)
+(num-test (sin (+ (* 200 our-pi) 0.001)) 9.999998333333416874831395573527051109993E-4)
+(test (< (abs (- (sin (+ (* 200 our-pi) 0.001)) (- (sin (- (* 200 our-pi) 0.001))))) 1e-14) #t)
+
+(num-test (sin 32767.) 1.8750655394138942394239E-1)
+(num-test (sin 8388607.) 9.9234509376961249835628E-1)
+(num-test (sin 2147483647.) -7.2491655514455639054829E-1)
+
+(test (sin) 'error)
+(test (sin "hi") 'error)
+(test (sin 1.0+23.0i 1.0+23.0i) 'error)
+(test (sin 0 1) 'error)
+
+
;; -------- cos
(num-test (cos 0) 1.0)
@@ -18684,6 +22688,17 @@
(num-test (cos -9.42512322775237976202e+00-2.0e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i)
(num-test (cos 0) 1.0)
+(num-test (cos 22) -9.999608263946371264541747392126937741354E-1)
+(num-test (cos 32767.) 9.8226335176928229845654E-1)
+(num-test (cos 8388607.) -1.2349580912475928183718E-1)
+(num-test (cos 2147483647.) -6.8883669187794383467976E-1)
+
+(test (cos) 'error)
+(test (cos "hi") 'error)
+(test (cos 1.0+23.0i 1.0+23.0i) 'error)
+(test (cos 0 1) 'error)
+
+
;; -------- tan
(num-test (tan 0) 0.0)
@@ -19074,6 +23089,14 @@
(num-test (tan 9.42512322775237976202e+00-2.0e+00i) 2.439339541035071690e-5-9.6402758819508310550e-1i)
(num-test (tan -9.42512322775237976202e+00+2.0e+00i) -2.439339541035071690e-5+9.6402758819508310550e-1i)
(num-test (tan -9.42512322775237976202e+00-2.0e+00i) -2.439339541035071690e-5-9.6402758819508310550e-1i)
+(num-test (tan 32767.) 1.9089234430221485740826E-1)
+(num-test (tan 8388607.) -8.0354556223613614748329E0)
+(num-test (tan 2147483647.) 1.0523779637351339136698E0)
+
+(test (tan) 'error)
+(test (tan "hi") 'error)
+(test (tan 1.0+23.0i 1.0+23.0i) 'error)
+(test (tan 0 1) 'error)
;; -------- asin
@@ -19562,6 +23585,11 @@
(if (> err 1e-9)
(format #t "(sin (asin ~A)) error: ~A~%" mx err)))
+(test (asin) 'error)
+(test (asin "hi") 'error)
+(test (asin 1.0+23.0i 1.0+23.0i) 'error)
+(test (asin 0 1) 'error)
+
;; -------- acos
@@ -20049,6 +24077,12 @@
(if (> err 1e-10)
(format #t "(cos (acos ~A)) error: ~A~%" mx err)))
+(test (acos) 'error)
+(test (acos "hi") 'error)
+(test (acos 1.0+23.0i 1.0+23.0i) 'error)
+(test (acos 0 1) 'error)
+
+
;; -------- atan
(num-test (atan 0) 0.0)
@@ -20519,6 +24553,11 @@
(num-test (atan -8.3886080e+06+8.3886080e+06i) -1.5707962671902518438e0+5.9604644775390483828e-8i)
(num-test (atan -8.3886080e+06-8.3886080e+06i) -1.5707962671902518438e0-5.9604644775390483828e-8i)
+(test (atan) 'error)
+(test (atan "hi") 'error)
+(test (atan 1.0+23.0i 1.0+23.0i) 'error)
+(test (atan 0 1 2) 'error)
+
;; -------- sinh
@@ -20912,6 +24951,12 @@
(num-test (sinh -2.0e+00-9.42512322775237976202e+00i) 3.6268601916692946571e0+1.2989619299081657245e-3i)
(num-test (sinh 0) 0.0)
+(test (sinh) 'error)
+(test (sinh "hi") 'error)
+(test (sinh 1.0+23.0i 1.0+23.0i) 'error)
+(test (sinh 0 1) 'error)
+
+
;; -------- cosh
(num-test (cosh 0) 1.0)
@@ -21299,6 +25344,12 @@
(num-test (cosh (log (/ (+ 1 (sqrt 5)) 2))) (/ (sqrt 5) 2))
(num-test (cosh 0) 1.0)
+(test (cosh) 'error)
+(test (cosh "hi") 'error)
+(test (cosh 1.0+23.0i 1.0+23.0i) 'error)
+(test (cosh 0 1) 'error)
+
+
;; -------- tanh
(num-test (tanh 0) 0.0)
@@ -21719,6 +25770,12 @@
(num-test (tanh 1L-17) 1L-17)
(num-test (tanh 1L-47) 1L-47)
+(test (tanh) 'error)
+(test (tanh "hi") 'error)
+(test (tanh 1.0+23.0i 1.0+23.0i) 'error)
+(test (tanh 0 1) 'error)
+
+
;; -------- asinh
(num-test (asinh 0) 0.0)
@@ -22175,6 +26232,12 @@
(num-test (asinh -8.3886080e+06+8.3886080e+06i) -1.6982105923718660081e1+7.8539816339744653326e-1i)
(num-test (asinh -8.3886080e+06-8.3886080e+06i) -1.6982105923718660081e1-7.8539816339744653326e-1i)
+(test (asinh) 'error)
+(test (asinh "hi") 'error)
+(test (asinh 1.0+23.0i 1.0+23.0i) 'error)
+(test (asinh 0 1) 'error)
+
+
;; -------- acosh
(num-test (acosh 0) 0.0+1.57079632679490i)
@@ -22680,6 +26743,12 @@
(num-test (acosh -8.3886080e+06+8.3886080e+06i) 1.6982105923718660081e1+2.3561944901923431525e0i)
(num-test (acosh -8.3886080e+06-8.3886080e+06i) 1.6982105923718660081e1-2.3561944901923431525e0i)
+(test (acosh) 'error)
+(test (acosh "hi") 'error)
+(test (acosh 1.0+23.0i 1.0+23.0i) 'error)
+(test (acosh 0 1) 'error)
+
+
;; -------- atanh
(num-test (atanh 0) 0.0)
@@ -23092,6 +27161,23 @@
(num-test (atanh -8.3886080e+06+8.3886080e+06i) -5.9604644775390483828e-8+1.5707962671902518438e0i)
(num-test (atanh -8.3886080e+06-8.3886080e+06i) -5.9604644775390483828e-8-1.5707962671902518438e0i)
+(test (atanh) 'error)
+(test (atanh "hi") 'error)
+(test (atanh 1.0+23.0i 1.0+23.0i) 'error)
+(test (atanh 0 1) 'error)
+
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
+ (if (not (eq? val 'error))
+ (begin
+ (display "(") (display op) (display " ") (display arg) (display ") returned ")
+ (display val) (display " but expected 'error") (newline)))))
+ (list "hi" '() #\a (list 1) '(1 . 2) '#(0) #f 'a-symbol (make-vector 3) abs #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list cosh sinh tanh acosh asinh atanh))
+
(let ((err 0.0)
(mx 0.0))
(do ((i 0 (+ i 1))
@@ -23652,8 +27738,7 @@
(num-test (sqrt (sqrt (sqrt 256))) 2)
(num-test (sqrt (sqrt (sqrt 1/256))) 1/2)
-(if (and (integer? (sqrt 4))
- (exact? (sqrt 4)))
+(if (integer? (sqrt 4))
(begin
(for-each
(lambda (n sqn)
@@ -23671,7 +27756,7 @@
(let ((val (sqrt n)))
(if (or (integer? val)
(> (abs (- (* val val) n)) .001))
- (format #t "(sqrt ~A) expected ~A but got ~A~%" n (sqrt (exact->inexact n)) val)))))
+ (format #t "(sqrt ~A) expected ~A but got ~A~%" n (sqrt (* 1.0 n)) val)))))
(list 10 491400 19439282 1248844920 235565593200))
(test (eqv? (expt 2 3) 8) #t)
@@ -23702,6 +27787,10 @@
(if (> err 1e-12)
(format #t "(sqr (sqrt ~A)) error: ~A~%" mx err)))
+(test (sqrt) 'error)
+(test (sqrt "hi") 'error)
+(test (sqrt 1.0+23.0i 1.0+23.0i) 'error)
+
;; -------- exp
@@ -24154,6 +28243,10 @@
(num-test (exp 5e-10) 1.000000000500000000125000031161629077797E0)
(num-test (- (expt (exp 5e-8) 2e7) (exp 1)) 0.0)
+(test (exp) 'error)
+(test (exp "hi") 'error)
+(test (exp 1.0+23.0i 1.0+23.0i) 'error)
+
;; -------- log
@@ -24771,6 +28864,74 @@
(if (> err 1e-14)
(format #t "(exp (log ~A)) error: ~A~%" mx err)))
+(do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((val (+ .001 (random 100.0)))
+ (base (+ 2 (random 20))))
+ (num-test (log val base) (/ (log val) (log base)))))
+
+(do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((val (+ .001 (random 10000.0)))
+ (base (+ 1.0 (random 20.0))))
+ (num-test (log val base) (/ (log val) (log base)))))
+
+(num-test (log (sqrt (- (expt 10 9) 1))) 1.036163291797320557783096154591297226743E1)
+(num-test (log (sqrt (- (expt 10 17) 1))) 1.957197329044938830915292736481709573957E1)
+(num-test (log (sqrt (- (expt 10 20) 1))) 2.302585092994045684017491454684364207599E1)
+(if with-bigfloats (num-test (log (expt 2 16382)) 1.135513711193302405887309661372784853823E4))
+(num-test (log (expt 2 1022)) 7.083964185322641062244112281302564525734E2)
+(num-test (log (expt 2 125)) 8.664339756999316367715401518227207100938E1)
+
+(test (log) 'error)
+(test (log "hi") 'error)
+(test (log 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
+(test (log "hi" (expt 2 30)) 'error)
+(test (log (expt 2 30) #t) 'error)
+(num-test (log 3 0) 'error)
+(num-test (log 2 2) 1)
+(num-test (log (sqrt 2) 2) 0.5)
+(num-test (log -2 -2) 1)
+(num-test (log (sqrt -2) -2) 0.5)
+(num-test (log (sqrt 1+i) 1+i) 0.5)
+
+(for-each
+ (lambda (arg)
+ (test (log 10.0 arg) 'error))
+ (list "hi" #\a 0 '#(1 2 3) #t #f '() abs 'hi (list 1 2 3) '(1 . 2)))
+
+(do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((val (+ .001 (random 100.0)))
+ (base (+ 2 (random 20))))
+ (if (> (random 1.0) 0.5) (set! val (- val)))
+ (if (> (random 1.0) 0.5) (set! base (- base)))
+ (num-test (log val base) (/ (log val) (log base)))))
+
+(do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((val (+ .001 (random 10000.0)))
+ (base (+ 1.0 (random 20.0))))
+ (if (> (random 1.0) 0.5) (set! val (- val)))
+ (if (> (random 1.0) 0.5) (set! base (- base)))
+ (num-test (log val base) (/ (log val) (log base)))))
+
+(do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((val1 (+ .001 (random 10000.0)))
+ (val2 (+ .001 (random 10000.0)))
+ (base1 (+ 1.0 (random 20.0)))
+ (base2 (+ 1.0 (random 20.0))))
+ (if (> (random 1.0) 0.5) (set! val1 (- val1)))
+ (if (> (random 1.0) 0.5) (set! val2 (- val2)))
+ (if (> (random 1.0) 0.5) (set! base1 (- base1)))
+ (if (> (random 1.0) 0.5) (set! base2 (- base2)))
+ (let ((val (make-rectangular val1 val2))
+ (base (make-rectangular base1 base2)))
+ (num-test (log val base) (/ (log val) (log base))))))
+
+
+
;; -------- expt
(num-test (expt 0 0) 1)
@@ -24986,6 +29147,31 @@
(num-test (expt (expt -1 1/123) 123) -1)
(num-test (expt -1/8 -3) -512)
+(num-test (+ 1 (expt 2 54)) 18014398509481985)
+(num-test (- (expt 2 54) 18014398509481984) 0)
+(num-test (- (expt 2 54) 18014398509481983) 1)
+(num-test (+ 10000000000000000 1) 10000000000000001)
+(num-test (- 10000000000000000 9999999999999999) 1)
+(num-test (/ (expt 2 -53) 2) (expt 2 -54))
+(num-test (* 1/18014398509481984 1/2) (expt 2 -55))
+(num-test (/ (expt 2.3 50) (expt 2.3 49)) 2.3)
+
+(test (expt) 'error)
+(test (expt 1) 'error)
+(test (expt 1.0+23.0i) 'error)
+(test (expt "hi" "hi") 'error)
+(test (expt 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
+(test (expt #t 0) 'error)
+(test (expt 0 -1) 'error)
+(test (expt 0.0 -1.0) 'error)
+(test (expt 0 -1.0) 'error)
+ ; (test (expt 0 -1.0+i) 'error)
+ ; (test (expt 0 0-i) 0.0) ; sbcl and clisp say division by 0 here
+(test (expt 0 -255) 'error)
+(test (expt 0 (- (expt 2 32))) 'error)
+
+
+
(test (= (make-rectangular 1.0 0.0) (make-polar 1.0 0.0) 1.0+0i (* -1.0 -1.0) (/ 1.0)
(exp 0.0) (abs -1.0) (cos 0.0) (log (exp 1)) (magnitude 1.0+0i) (max 0.0 1.0) (min 1.0 2.0) )
#t)
@@ -25003,6 +29189,12 @@
ys))
xs))
+(num-test (expt 2 1/3) 1.25992104989487316476721060727822835057E0)
+(num-test (expt 4 1/3) 1.587401051968199474751705639272308260393E0)
+(num-test (expt 1/2 1/3) 7.937005259840997373758528196361541301963E-1)
+(num-test (expt 1/4 1/3) 6.299605249474365823836053036391141752849E-1)
+
+
(if with-bignums
(begin
(num-test (expt 4722366482869645213696 1/2) 68719476736)
@@ -26113,6 +30305,10 @@
(set! (bignum-precision) old-prec)))
)
+(test (rationalize) 'error)
+(test (rationalize 1.23+1.0i 1.23+1.0i) 'error)
+(test (rationalize 1.23 1.23 1.23) 'error)
+
@@ -26928,6 +31124,37 @@
(num-test (gcd 2 0) 2)
(num-test (lcm 2 0) 0)
+(num-test (lcm 1/2 2) 2)
+(num-test (lcm 1/3 3/4) 3)
+(num-test (lcm 2 3/4) 6)
+(num-test (lcm 3/4 2) 6)
+(num-test (lcm 1/3 3/4 5/8) 15)
+(num-test (lcm 1/3 2/3) 2/3)
+(num-test (lcm 1/3 1/6 5/12) 5/3)
+(num-test (lcm 1/3 1/6 5/12 2) 10)
+
+(num-test (gcd 1/2 1/3) 1/6)
+(num-test (gcd 1/2 2) 1/2)
+(num-test (gcd 1/3 3/4) 1/12)
+(num-test (gcd 2 3/4) 1/4)
+(num-test (gcd 3/4 2) 1/4)
+(num-test (gcd 1/3 3/4 5/8) 1/24)
+(num-test (gcd 1/3 2/3) 1/3)
+(num-test (gcd 1/3 1/6 5/12) 1/12)
+(num-test (gcd 1/3 1/6 5/12 2) 1/12)
+(num-test (gcd 77874422 32223899) 1)
+
+(num-test (gcd 1.4 2.3) 'error)
+(num-test (lcm 1.4 2.3) 'error)
+(num-test (gcd 2 1.0+0.5i) 'error)
+(num-test (lcm 2 1.0+0.5i) 'error)
+(test (gcd 1 "hi") 'error)
+(test (lcm 0 "hi") 'error)
+(num-test (gcd 0 "hi") 'error)
+(num-test (lcm 0 "hi") 'error)
+
+
+
;; -------- real-part and imag-part
(num-test (real-part 1) 1)
@@ -27042,6 +31269,14 @@
(num-test (imag-part 5) 0.0)
(num-test (imag-part 1.4+0.0i) 0.0)
+(test (imag-part) 'error)
+(test (imag-part "hi") 'error)
+(test (imag-part 1.0+23.0i 1.0+23.0i) 'error)
+(test (real-part) 'error)
+(test (real-part "hi") 'error)
+(test (real-part 1.0+23.0i 1.0+23.0i) 'error)
+
+
;; -------- numerator and denominator
(num-test (numerator 12/6000996) 1)
@@ -27205,6 +31440,16 @@
(num-test (denominator 5/2) 2)
(num-test (denominator (/ 8 -6)) 3)
+(test (numerator) 'error)
+(test (numerator 1.23+1.0i) 'error)
+(test (numerator 1.23 1.23) 'error)
+(test (denominator) 'error)
+(test (denominator 1.23+1.0i) 'error)
+(test (denominator 1.23 1.23) 'error)
+(num-test (numerator 2.3+0.5i) 'error)
+(num-test (denominator 2.3+0.5i) 'error)
+
+
;; -------- modulo, remainder, quotient
;;; (modulo x 0) -> x? I seem to be getting errors instead; maxima returns x and refers to Section 3.4, of "Concrete Mathematics," by Graham, Knuth, and Patashnik
@@ -28159,27 +32404,6 @@
(num-test (quotient -3/2 -2) 0)
(num-test (quotient -1.5 -2) 0)
-(num-test (lcm 1/2 2) 2)
-(num-test (lcm 1/3 3/4) 3)
-(num-test (lcm 2 3/4) 6)
-(num-test (lcm 3/4 2) 6)
-(num-test (lcm 1/3 3/4 5/8) 15)
-(num-test (lcm 1/3 2/3) 2/3)
-(num-test (lcm 1/3 1/6 5/12) 5/3)
-(num-test (lcm 1/3 1/6 5/12 2) 10)
-
-(num-test (gcd 1/2 1/3) 1/6)
-(num-test (gcd 1/2 2) 1/2)
-(num-test (gcd 1/3 3/4) 1/12)
-(num-test (gcd 2 3/4) 1/4)
-(num-test (gcd 3/4 2) 1/4)
-(num-test (gcd 1/3 3/4 5/8) 1/24)
-(num-test (gcd 1/3 2/3) 1/3)
-(num-test (gcd 1/3 1/6 5/12) 1/12)
-(num-test (gcd 1/3 1/6 5/12 2) 1/12)
-(num-test (gcd 77874422 32223899) 1)
-
-
(num-test (modulo 13 4) 1)
(num-test (modulo -13 4) 3)
(num-test (quotient 35 7) 5 )
@@ -28230,6 +32454,25 @@
(begin (set! happy #f) (display "(remainder ") (display val2) (display " 2) = ") (display rv) (display "?") (newline))))))
)
+(test (quotient) 'error)
+(test (quotient 123) 'error)
+(test (quotient 123 123 123) 'error)
+(test (remainder) 'error)
+(test (remainder 123) 'error)
+(test (remainder 123 123 123) 'error)
+(test (modulo) 'error)
+(test (modulo 123) 'error)
+(test (modulo 123 123 123) 'error)
+(num-test (modulo 2.3 1.0+0.1i) 'error)
+(num-test (modulo 3.0+2.3i 3) 'error)
+(num-test (mod 2 0) 'error)
+(num-test (remainder 2.3 1.0+0.1i) 'error)
+(num-test (remainder 3.0+2.3i 3) 'error)
+(test (quotient 3 0) 'error)
+(test (remainder 3 0) 'error)
+
+
+
;; -------- abs and magnitude
@@ -28921,6 +33164,16 @@
(if with-bigfloats (num-test (magnitude most-negative-fixnum) 9223372036854775808))
(if with-bigfloats (num-test (abs most-negative-fixnum) 9223372036854775808))
+(test (abs) 'error)
+(test (abs 1.23+1.0i) 'error)
+(test (abs 1.23 1.23) 'error)
+(test (magnitude) 'error)
+(test (magnitude "hi") 'error)
+(test (magnitude 1.0+23.0i 1.0+23.0i) 'error)
+(num-test (abs 1.0+0.1i) 'error)
+
+
+
;; -------- make-polar and make-rectangular
@@ -29841,6 +34094,24 @@
(num-test (make-rectangular 0 0) 0)
(num-test (make-rectangular 0.0 0.0) 0.0)
+(test (make-polar) 'error)
+(test (make-polar 1.23) 'error)
+(test (make-polar 1.23+1.0i 1.23+1.0i) 'error)
+(test (make-polar 1.23 1.23 1.23) 'error)
+(test (make-rectangular) 'error)
+(test (make-rectangular 1.23) 'error)
+(test (make-rectangular 1.23+1.0i 1.23+1.0i) 'error)
+(test (make-rectangular 1.23 1.23 1.23) 'error)
+(num-test (make-polar 1.0 1.0+0.1i) 'error)
+(num-test (make-polar 1.0+0.1i 0.0) 'error)
+(num-test (make-rectangular 1.0 1.0+0.1i) 'error)
+(num-test (make-rectangular 1.0+0.1i 1.0) 'error)
+
+(num-test (make-polar 1.0 (* 200 pi)) 1.0)
+(num-test (make-polar 1.0 (* 2000000 pi)) 1.0)
+(num-test (make-polar 1.0 (* 2000000000 pi)) 1.0)
+
+
;; -------- angle
(num-test (angle 1) 0)
@@ -30292,28 +34563,10 @@
(num-test (angle 0) 0)
(num-test (angle 0.0) 0.0)
-;; from libm tests
-(num-test (sin 32767.) 1.8750655394138942394239E-1)
-(num-test (cos 32767.) 9.8226335176928229845654E-1)
-(num-test (tan 32767.) 1.9089234430221485740826E-1)
-(num-test (sin 8388607.) 9.9234509376961249835628E-1)
-(num-test (cos 8388607.) -1.2349580912475928183718E-1)
-(num-test (tan 8388607.) -8.0354556223613614748329E0)
-(num-test (sin 2147483647.) -7.2491655514455639054829E-1)
-(num-test (cos 2147483647.) -6.8883669187794383467976E-1)
-(num-test (tan 2147483647.) 1.0523779637351339136698E0)
+(test (angle) 'error)
+(test (angle "hi") 'error)
+(test (angle 1.0+23.0i 1.0+23.0i) 'error)
-;; ieetst
-(num-test (log (sqrt (- (expt 10 9) 1))) 1.036163291797320557783096154591297226743E1)
-(num-test (log (sqrt (- (expt 10 17) 1))) 1.957197329044938830915292736481709573957E1)
-(num-test (log (sqrt (- (expt 10 20) 1))) 2.302585092994045684017491454684364207599E1)
-(if with-bigfloats (num-test (log (expt 2 16382)) 1.135513711193302405887309661372784853823E4))
-(num-test (log (expt 2 1022)) 7.083964185322641062244112281302564525734E2)
-(num-test (log (expt 2 125)) 8.664339756999316367715401518227207100938E1)
-(num-test (expt 2 1/3) 1.25992104989487316476721060727822835057E0)
-(num-test (expt 4 1/3) 1.587401051968199474751705639272308260393E0)
-(num-test (expt 1/2 1/3) 7.937005259840997373758528196361541301963E-1)
-(num-test (expt 1/4 1/3) 6.299605249474365823836053036391141752849E-1)
;; -------- floor, ceiling, truncate, round
@@ -30348,6 +34601,24 @@
(num-test (truncate (exact->inexact most-negative-fixnum)) most-negative-fixnum)
(if with-bigfloats (test (truncate (exact->inexact most-positive-fixnum)) most-positive-fixnum))
+(num-test (truncate 0) 0)
+(num-test (truncate -0) 0)
+(num-test (truncate 0.0) 0)
+(num-test (truncate -0.0) 0)
+(num-test (truncate -1) -1)
+(num-test (truncate 1) 1)
+(num-test (truncate 1/123400000) 0)
+(num-test (truncate -1/123400000) 0)
+(num-test (truncate (- 1 1/123400000)) 0)
+(num-test (truncate (- (+ 1 -1/123400000))) 0)
+(num-test (truncate 2.6) 2)
+(num-test (truncate 2.5) 2)
+(num-test (truncate 2.4) 2)
+
+(test (truncate) 'error)
+(test (truncate 1.23+1.0i) 'error)
+
+
(num-test (floor (+ 1 (expt 2 30))) 1073741825)
(num-test (floor 19) 19)
(num-test (floor 2/3) 0)
@@ -30379,6 +34650,30 @@
(num-test (floor (exact->inexact most-negative-fixnum)) most-negative-fixnum)
(if with-bigfloats (test (floor (exact->inexact most-positive-fixnum)) most-positive-fixnum))
+(num-test (floor 9007199254740992.95) 9007199254740992)
+;; but unfortunately (floor 9007199254740993.95) is also 9007199254740992...
+;; and (floor (bignum "9007199254740993.95")) is as well! Isn't this a bug?
+;; I'm going through mpfr_get_z, so the bug must be in mpfr?
+
+(num-test (floor 0) 0)
+(num-test (floor -0) 0)
+(num-test (floor 0.0) 0)
+(num-test (floor -0.0) 0)
+(num-test (floor -1) -1)
+(num-test (floor 1) 1)
+(num-test (floor 1/123400000) 0)
+(num-test (floor (- 1 1/123400000)) 0)
+(num-test (floor (- (+ 1 -1/123400000))) -1)
+(num-test (floor 2.6) 2)
+(num-test (floor 2.5) 2)
+(num-test (floor -1/123400000) -1)
+
+(test (floor) 'error)
+(test (floor 1.23+1.0i) 'error)
+(test (floor 1.23 1.23) 'error)
+
+
+
(num-test (ceiling 19) 19)
(num-test (ceiling 2/3) 1)
(num-test (ceiling -2/3) 0)
@@ -30425,6 +34720,26 @@
(num-test (ceiling -123456789012345678901234567890.1) -123456789012345678901234567890)
))
+(num-test (ceiling 0) 0)
+(num-test (ceiling -0) 0)
+(num-test (ceiling 0.0) 0)
+(num-test (ceiling -0.0) 0)
+(num-test (ceiling -1) -1)
+(num-test (ceiling 1) 1)
+(num-test (ceiling 2.6) 3)
+(num-test (ceiling 2.5) 3)
+(num-test (ceiling 2.4) 3)
+(num-test (ceiling 1/123400000) 1)
+(num-test (ceiling -1/123400000) 0)
+(num-test (ceiling (- 1 1/123400000)) 1)
+(num-test (ceiling (- (+ 1 -1/123400000))) 0)
+
+(test (ceiling) 'error)
+(test (ceiling 1.23+1.0i) 'error)
+(test (ceiling 1.23 1.23) 'error)
+
+
+
(num-test (round 19) 19)
(num-test (round 2/3) 1)
(num-test (round -2/3) -1)
@@ -30478,61 +34793,26 @@
(list 0 -1 -2 -2 -2 -3))
#t)
-(num-test (floor 0) 0)
(num-test (round 0) 0)
-(num-test (ceiling 0) 0)
-(num-test (truncate 0) 0)
-(num-test (floor -0) 0)
(num-test (round -0) 0)
-(num-test (ceiling -0) 0)
-(num-test (truncate -0) 0)
-(num-test (floor 0.0) 0)
(num-test (round 0.0) 0)
-(num-test (ceiling 0.0) 0)
-(num-test (truncate 0.0) 0)
-(num-test (floor -0.0) 0)
(num-test (round -0.0) 0)
-(num-test (ceiling -0.0) 0)
-(num-test (truncate -0.0) 0)
-(num-test (floor -1) -1)
(num-test (round -1) -1)
-(num-test (ceiling -1) -1)
-(num-test (truncate -1) -1)
-(num-test (floor 1) 1)
(num-test (round 1) 1)
-(num-test (ceiling 1) 1)
-(num-test (truncate 1) 1)
-
-(num-test (floor 1/123400000) 0)
(num-test (round 1/123400000) 0)
-(num-test (ceiling 1/123400000) 1)
-(num-test (truncate 1/123400000) 0)
-(num-test (floor -1/123400000) -1)
(num-test (round -1/123400000) 0)
-(num-test (ceiling -1/123400000) 0)
-(num-test (truncate -1/123400000) 0)
-
-(num-test (floor (- 1 1/123400000)) 0)
(num-test (round (- 1 1/123400000)) 1)
-(num-test (ceiling (- 1 1/123400000)) 1)
-(num-test (truncate (- 1 1/123400000)) 0)
-(num-test (floor (- (+ 1 -1/123400000))) -1)
(num-test (round (- (+ 1 -1/123400000))) -1)
-(num-test (ceiling (- (+ 1 -1/123400000))) 0)
-(num-test (truncate (- (+ 1 -1/123400000))) 0)
-
-(num-test (floor 2.6) 2)
-(num-test (floor 2.5) 2)
-(num-test (ceiling 2.6) 3)
-(num-test (ceiling 2.5) 3)
-(num-test (ceiling 2.4) 3)
-(num-test (truncate 2.6) 2)
-(num-test (truncate 2.5) 2)
-(num-test (truncate 2.4) 2)
(num-test (round 2.6) 3)
(num-test (round 2.5) 2)
(num-test (round 2.4) 2)
+(test (round) 'error)
+(test (round 1.23+1.0i) 'error)
+(test (round 1.23 1.23) 'error)
+
+
+
(let ((top-exp 60))
(if with-bignums
(set! top-exp 150))
@@ -30776,6 +35056,18 @@
(format #t "(zero? ~A) -> #t?~%" n)))
(list 1 1/100 -0.001 0.0+1.0i))
+(test (positive?) 'error)
+(test (positive? 1.23+1.0i) 'error)
+(test (positive? 1.23 1.23) 'error)
+(test (negative?) 'error)
+(test (negative? 1.23+1.0i) 'error)
+(test (negative? 1.23 1.23) 'error)
+(test (zero?) 'error)
+(test (zero? "hi") 'error)
+(test (zero? 1.0+23.0i 1.0+23.0i) 'error)
+
+
+
;; -------- even?, odd?
@@ -30834,6 +35126,14 @@
(if (not ov2)
(begin (set! happy #f) (display "not (odd? ") (display val2) (display ")?") (newline)))))))
+(test (even?) 'error)
+(test (even? 1.23) 'error)
+(test (even? 123 123) 'error)
+(test (odd?) 'error)
+(test (odd? 1.23) 'error)
+(test (odd? 123 123) 'error)
+
+
;; -------- real?, complex?, number?, integer?, rational?
@@ -30845,6 +35145,12 @@
(test (number? #f) #f)
(test (number? (cons 1 2)) #f)
(test (number? 2.5-.5i) #t)
+(test (number? most-negative-fixnum) #t)
+(test (number? 1e-308) #t)
+(test (number? 1e308) #t)
+(test (number? 0+0i) #t)
+(test (number? (log 0)) #t)
+(test (number? (real-part (log 0))) #t)
(test (real? (+ 1+i 1-i)) #t)
(test (real? (- 1+i 1+i)) #t)
@@ -30861,6 +35167,440 @@
(test (real? (real-part 1+i)) #t)
(test (real? (imag-part 1+i)) #t)
(test (real? (expt 0+i 0+i)) #t)
+(test (real? (log 0)) #f)
+(test (real? (real-part (log 0))) #t)
+
+
+;;; (real-part (log 0)) -> -inf.0
+;;; (- (real-part (log 0))) -> inf.0
+;;; (real-part (/ (log 0))) -> nan.0
+;;; but (- (real-part (/ (log 0)))) is not -nan.0
+
+(let* ((inf+ (- (real-part (log 0))))
+ (inf- (real-part (log 0)))
+ (nan (real-part (/ (log 0)))) ;; perhaps this should be 0.0 -- 1/inf
+ (nan.0 nan)
+ (inf.0 inf+)
+ (-inf.0 inf-)
+ (complex-nan (make-rectangular nan.0 nan.0))
+ (complex-inf++ (make-rectangular inf+ inf+))
+ (complex-inf+- (make-rectangular inf+ inf-))
+ (complex-inf-- (make-rectangular inf- inf-))
+ (complex-inf-+ (make-rectangular inf- inf+))
+ (complex-inf+-nan (+ complex-inf++ complex-inf+-))
+ (complex-inf--nan (+ complex-inf-- complex-inf-+))
+ ;; and so on!!
+ )
+
+ ;; (define (nan? x) (and (number? x) (not (= x x))))
+ ;; (define (infinite? x) (and (number? x) (= x x) (or (= x inf+) (= x inf-))))
+
+ (if (zero? nan)
+ (set! nan (/ (real-part (log 0)) (real-part (log 0))))) ; inf/inf
+
+ (test (equal? inf+ inf+) #t)
+ (test (equal? inf+ inf-) #f)
+
+ ;; these are from r6rs.html
+ (test (number? nan) #t)
+ (test (complex? nan) #t)
+ (test (real? nan) #t)
+ (test (rational? nan) #f)
+ (test (complex? inf+) #t)
+ (test (real? inf-) #t)
+ (test (rational? inf-) #f)
+ (test (integer? inf-) #f)
+ (test (inexact? inf+) #t)
+ (test (zero? nan) #f)
+ (test (positive? inf+) #t)
+ (test (negative? inf-) #t)
+ (test (positive? nan) #f)
+ (test (negative? nan) #f)
+ (test (infinite? inf+) #t)
+ (test (nan? (imag-part complex-nan)) #t)
+ (test (number? complex-nan) #t)
+ (test (complex? complex-nan) #t)
+ (test (real? complex-nan) #f)
+ (test (number? complex-inf--) #t)
+ (test (complex? complex-inf++) #t)
+ (test (real? complex-inf-+) #f)
+
+ (test (< inf+ inf-) #f)
+ (test (< inf- inf+) #t)
+ (test (< inf- 0.0) #t)
+ (test (> inf+ 0.0) #t)
+ (test (= inf+ inf+) #t)
+ (test (= inf- inf+) #f)
+ (test (= inf- inf-) #t)
+ (test (= inf+ 0.0) #f)
+ (test (= inf+ nan) #f)
+ (test (= 0.0 nan) #f)
+ (test (= nan nan) #f)
+ (test (nan? (* 0 inf+)) #t)
+ (test (= inf+ most-positive-fixnum) #f)
+ (test (> inf+ most-positive-fixnum) #t)
+ (test (> inf+ 1.0e308) #t)
+ (test (nan? (- inf+ inf+)) #t)
+ (test (= (+ inf+ inf+) inf+) #t)
+ (test (= (* inf+ inf+) inf+) #t)
+ (test (nan? (/ inf+ inf+)) #t)
+ (test (= (+ 1 inf+) inf+) #t)
+ (test (nan? (- inf- inf-)) #t)
+ (test (nan? (- nan nan)) #t)
+ (test (nan? (/ inf+ inf-)) #t)
+ (test (nan? (/ inf- inf-)) #t)
+ (test (nan? (/ nan nan)) #t)
+ (test (nan? (/ nan inf+)) #t)
+ (test (nan? (/ inf+ nan)) #t)
+ (test (= (/ 0.0 inf+) 0.0) #t)
+ (test (= (- 0.0 inf+) inf-) #t)
+ (test (= (- inf+) inf-) #t)
+ (test (= (- inf-) inf+) #t)
+ (test (nan? (- nan)) #t)
+ (test (= (* inf+ inf-) inf-) #t)
+ (test (= (* inf- inf-) inf+) #t)
+ (test (<= inf- 0.0 inf+ inf+) #t)
+ (test (>= inf+ inf- 0.0) #f)
+ (test (= (* (+ inf+ inf+) inf-) inf-) #t)
+ (test (= nan complex-nan) #f)
+ (test (= complex-nan complex-nan) #f)
+ (test (= nan (real-part complex-nan)) #f)
+ (test (nan? (real-part complex-nan)) #t)
+ (test (nan? (imag-part complex-nan)) #t)
+
+ (test (nan? (imag-part (+ complex-inf-- complex-inf++))) #t)
+
+ ;; the following are not specified by IEEE 754
+ (test (= (expt 1 inf+) 1.0) #t)
+ (test (= (expt 1 inf-) 1.0) #t)
+ (test (= (expt 0.0 inf+) 0.0) #t)
+ ;(test (= (expt 2 inf+) inf+) #t)
+ (test (= (expt 2 inf-) 0.0) #t)
+ (test (= (exp inf-) 0.0) #t)
+ (test (= (exp inf+) inf+) #t)
+ (test (nan? (exp nan)) #t)
+ ;(test (= (expt nan 0) 1.0) #t) ;hmmm
+ ;(test (= (expt nan nan) 0) #t)
+ ;(test (= (expt inf+ inf-) 0.0) #t)
+ ;(test (= (expt inf+ inf+) inf+) #t)
+ ;(test (= (expt 1 nan) 1) #t)
+ ;(test (= (expt 1 complex-nan) 1) #t) ; or maybe NaN?
+ (test (= (expt inf+ 0) 1.0) #t)
+ (test (= (expt inf- 0) 1.0) #t)
+ (test (= (log inf+) inf+) #t)
+ (test (nan? (real-part (log nan))) #t)
+ (test (nan? (real-part (log complex-nan))) #t)
+ (test (nan? (real-part (exp complex-nan))) #t)
+ (test (nan? (real-part (sqrt nan))) #t)
+ (test (= (sqrt inf+) inf+) #t)
+
+ (test (= (abs inf+) inf+) #t)
+ (test (= (abs inf-) inf+) #t)
+ (test (nan? (abs nan)) #t)
+ (test (= (magnitude inf+) inf+) #t)
+ (test (= (magnitude inf-) inf+) #t)
+ (test (nan? (magnitude nan)) #t)
+ (test (nan? (magnitude complex-nan)) #t)
+
+ (test (= (make-polar inf+ 0) inf+) #t)
+ (test (nan? (real-part (make-polar 0 inf-))) #t)
+ (test (nan? (make-polar nan 0)) #t)
+ (test (nan? (real-part (make-polar 0 nan))) #t)
+ (test (= (make-rectangular inf+ 0) inf+) #t)
+ (test (= (make-rectangular 0 inf+) (sqrt inf-)) #t) ; (sqrt inf-) -> 0+infi !
+ (test (nan? (make-rectangular nan 0)) #t)
+ (test (nan? (imag-part (make-rectangular 0 nan))) #t)
+
+ (test (nan? (sin nan)) #t)
+ (test (nan? (sin inf+)) #t)
+ (test (nan? (sin inf-)) #t)
+ (test (nan? (/ 0 nan)) #t)
+ (test (nan? (* 0 nan)) #t)
+ (test (nan? (/ nan)) #t)
+
+ (test (= (exp most-positive-fixnum) inf+) #t)
+ (test (= (exp most-negative-fixnum) 0.0) #t)
+ (test (= (* -3.4 inf-) inf+) #t)
+
+ (test (= (exact->inexact inf+) inf+) #t)
+ (test (exact? inf+) #f)
+ (test (exact? nan) #f)
+ (test (inexact? inf+) #t)
+ (test (inexact? nan) #t)
+ (test (= (max inf- inf+) inf+) #t)
+ (test (= (min inf- inf+) inf-) #t)
+
+ (if with-values (test (nan? (+ (values inf+ inf-) inf+)) #t))
+ (test (/ nan 0) 'error)
+
+ (test (rationalize inf+) 'error)
+ (test (rationalize inf-) 'error)
+ (test (rationalize nan) 'error)
+
+ (test (rationalize 198797.5 inf+) 0)
+ (test (rationalize 178978.5 inf-) 0)
+ (test (rationalize 178978.5 complex-inf-) 'error)
+ (test (rationalize 178987.5 nan) 'error)
+
+ (for-each
+ (lambda (op)
+ (test (number? (op inf+)) #t)
+ (test (number? (op inf-)) #t)
+ (test (number? (op nan)) #t))
+ (list floor ceiling truncate round exact->inexact
+ magnitude abs exp angle sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin
+ real-part imag-part))
+
+ (num-test (tanh inf-) -1.0)
+ (num-test (tanh inf+) 1.0)
+ (num-test (angle inf+) 0.0)
+ (num-test (angle inf-) our-pi)
+ ;; (test (nan? (angle nan)) #t)
+ ;; this could also be (angle complex-inf) etc -- need to check both sides
+
+ ; (atanh inf-) 0+1.5707963267949i
+
+ (for-each
+ (lambda (op)
+ (test (number? (op inf+ inf+)) #t)
+ (test (number? (op nan inf-)) #t))
+ (list + - * / expt make-rectangular make-polar))
+
+ (for-each
+ (lambda (op)
+ (test (boolean? (op inf+)) #t)
+ (test (boolean? (op nan)) #t)
+ (test (op) 'error))
+ (list number? integer? real? complex? rational? zero? positive? negative? inexact? exact?))
+
+ (for-each
+ (lambda (op)
+ (test (boolean? (op inf+ inf-)) #t)
+ (test (boolean? (op nan inf-)) #t))
+ (list = < > <= >=))
+
+ (for-each
+ (lambda (op)
+ (test (op inf+) 'error)
+ (test (op nan) 'error))
+ (list even? odd? numerator denominator lcm gcd inexact->exact
+ logior logxor logand lognot ash integer-length))
+
+ (let ((d1 1e-312)
+ (d2 1e-316)
+ (d3 1e-320))
+ (if (not (zero? d3))
+ (begin
+ (test (= d1 d2 d3) #f)
+ (test (< d1 d2 d3) #f)
+ (test (> d1 d2 d3) #t)
+ (test (rationalize d1) 0)
+ (test (rationalize d3) 0)
+ (test (rationalize (- d1)) 0)
+ (test (not (= d2 (* 2 d1))) #t)
+ (num-test (string->number (number->string d1)) d1)
+ (test (infinite? (log d1)) #f)
+
+ (test (< (sin d3) (sin d2) (sin d1)) #t)
+ (test (< (log d3) (log d2) (log d1)) #t)
+ (test (< (abs d3) (abs d2) (abs d1)) #t)
+ (test (< (sqrt d3) (sqrt d2) (sqrt d1)) #t)
+ (test (<= (exp d3) (exp d2) (exp d3)) #t) ; all might be 1.0
+ )))
+
+ (test (nan? (modulo nan 1)) #t)
+ (test (nan? (modulo inf+ 1)) #t)
+ (test (nan? (modulo 1 nan)) #t)
+ (test (nan? (modulo 1 inf+)) #t)
+
+ (test (nan? (string->number "nan.0")) #t)
+ (test (infinite? (string->number "inf.0")) #t)
+ (test (infinite? (string->number "+inf.0")) #t)
+ (test (infinite? (string->number "-inf.0")) #t)
+ (test (positive? (string->number "+inf.0")) #t)
+ (test (negative? (string->number "-inf.0")) #t)
+
+ (if (not (provided? 'gmp)) (test (* 1e12000 1e12000) inf+))
+
+ (test (zero? nan.0) #f)
+ (test (positive? nan.0) #f)
+ (test (negative? nan.0) #f)
+ (test (exact? nan.0) #f)
+ (test (inexact? nan.0) #t)
+ (test (imag-part nan.0) 0.0)
+ (test (nan? (asin nan.0)) #t)
+ (test (nan? (make-polar nan.0 nan.0)) #t)
+ (test (nan? (make-rectangular nan.0 nan.0)) #t)
+ (test (nan? (log nan.0 nan.0)) #t)
+ (test (= nan.0 nan.0) #f)
+ (test (< nan.0 nan.0) #f)
+ (test (> nan.0 nan.0) #f)
+ (test (magnitude inf.0) inf.0)
+ (test (angle inf.0) 0.0)
+ (test (abs inf.0) inf.0)
+ (test (exp inf.0) inf.0)
+ (test (log inf.0) inf.0)
+ ;; so (log inf.0 inf.0) should be a nan? inf/inf
+ (test (log 8.0 inf.0) 0.0)
+ (test (nan? (log 8.0 nan.0)) #t)
+ (test (nan? (asin inf.0)) #t)
+ (test (nan? (acos inf.0)) #t)
+ (num-test (atan inf.0) 1.5707963267949)
+ (test (sinh inf.0) inf.0)
+ (test (cosh inf.0) inf.0)
+ (test (tanh inf.0) 1.0)
+ (test (asinh inf.0) inf.0)
+ (test (acosh inf.0) inf.0)
+ (num-test (atanh inf.0) 0+1.5707963267949i)
+ (test (sqrt inf.0) inf.0)
+ (test (+ inf.0) inf.0)
+ (test (- inf.0) -inf.0)
+ (test (* inf.0) inf.0)
+ (test (/ inf.0) 0.0)
+ (test (max inf.0) inf.0)
+ (test (min inf.0) inf.0)
+ (test (number? inf.0) #t)
+ (test (integer? inf.0) #f)
+ (test (real? inf.0) #t)
+ (test (complex? inf.0) #t)
+ (test (rational? inf.0) #f)
+ (test (even? inf.0) 'error)
+ (test (odd? inf.0) 'error)
+ (test (zero? inf.0) #f)
+ (test (positive? inf.0) #t)
+ (test (negative? inf.0) #f)
+ (test (real-part inf.0) inf.0)
+ (test (imag-part inf.0) 0.0)
+ (test (numerator inf.0) 'error)
+ (test (denominator inf.0) 'error)
+ (test (inexact->exact inf.0) 'error)
+ (test (inexact->exact nan.0) 'error)
+ (test (exact->inexact inf.0) inf.0)
+ (test (exact? inf.0) #f)
+ (test (inexact? inf.0) #t)
+ (test (infinite? (make-rectangular -inf.0 inf.0)) #t)
+ (test (* -inf.0 inf.0) -inf.0)
+ (test (max -inf.0 inf.0) inf.0)
+ (test (min -inf.0 inf.0) -inf.0)
+ (test (= -inf.0 inf.0) #f)
+ (test (< -inf.0 inf.0) #t)
+ (test (> -inf.0 inf.0) #f)
+ (test (<= -inf.0 inf.0) #t)
+ (test (>= -inf.0 inf.0) #f)
+ (test (- -inf.0 inf.0) -inf.0)
+ (test (nan? (make-rectangular nan.0 inf.0)) #t)
+ (test (= nan.0 inf.0) #f)
+ (test (< nan.0 inf.0) #f)
+ (test (> nan.0 inf.0) #f)
+ (test (+ 0 inf.0) inf.0)
+ (test (- 0 inf.0) -inf.0)
+ (test (/ 0 inf.0) 0.0)
+ (test (max 0 inf.0) inf.0)
+ (test (min 0 inf.0) 0)
+ (test (= 0 inf.0) #f)
+ (test (< 0 inf.0) #t)
+ (test (> 0 inf.0) #f)
+ (test (<= 0 inf.0) #t)
+ (test (>= 0 inf.0) #f)
+ (test (= 0 inf.0 -inf.0) #f)
+ (test (< 0 inf.0 -inf.0) #f)
+ (test (> 0 inf.0 -inf.0) #f)
+ (test (<= 0 inf.0 -inf.0) #f)
+ (test (max 0 inf.0 -inf.0) inf.0)
+ (test (min 0 inf.0 -inf.0) -inf.0)
+ (test (real-part (make-rectangular 1 inf.0)) 1.0)
+ (test (imag-part (make-rectangular 1 inf.0)) inf.0)
+ (test (exact? (make-rectangular 1 inf.0)) #f)
+ (test (inexact? (make-rectangular 1 inf.0)) #t)
+ (test (zero? (make-rectangular 1 inf.0)) #f)
+ (test (nan? (max 0 inf.0 nan.0)) #t)
+ (test (nan? (min 0 inf.0 nan.0)) #t)
+ (test (nan? (max 1 nan.0)) #t)
+ (test (nan? (min 1 nan.0)) #t)
+ (test (infinite? (+ (make-rectangular 1 inf.0))) #t)
+ (test (expt nan.0) 'error)
+ (test (nan? (random nan.0)) #t)
+ (test (random nan.0 inf.0) 'error)
+
+ ;; these are errors because the arg is a real
+ (test (lcm nan.0) 'error)
+ (test (lcm nan.0 nan.0) 'error)
+ (test (gcd nan.0 nan.0) 'error)
+ (test (lcm nan.0 inf.0) 'error)
+ (test (gcd nan.0 inf.0) 'error)
+ (test (lcm -inf.0 inf.0) 'error)
+ (test (gcd -inf.0 inf.0) 'error)
+ (test (logior nan.0 nan.0) 'error)
+ (test (logxor nan.0 nan.0) 'error)
+ (test (logand nan.0 nan.0) 'error)
+ (test (lognot nan.0 nan.0) 'error)
+ (test (logior nan.0 inf.0) 'error)
+ (test (logxor nan.0 inf.0) 'error)
+ (test (logand nan.0 inf.0) 'error)
+ (test (lognot nan.0 inf.0) 'error)
+ (test (logior -inf.0 inf.0) 'error)
+ (test (logxor -inf.0 inf.0) 'error)
+ (test (logand -inf.0 inf.0) 'error)
+ (test (lognot -inf.0 inf.0) 'error)
+ (test (ash nan.0 inf.0) 'error)
+ (test (ash -inf.0 inf.0) 'error)
+ (test (ash nan.0 nan.0) 'error)
+
+ (test (nan? (make-polar -inf.0 inf.0)) #t)
+ (test (nan? (floor nan.0)) #t)
+ (test (nan? (ceiling nan.0)) #t)
+ (test (nan? (truncate nan.0)) #t)
+ (test (nan? (round nan.0)) #t)
+ (test (nan? (angle nan.0)) #t)
+ (test (rationalize nan.0) 'error)
+ (test (rationalize inf.0) 'error)
+ (test (rationalize nan.0 nan.0) 'error)
+
+(if (not (provided? 'gmp))
+ (begin
+ (test (nan? (expt 1 nan.0)) #t)
+ (test (nan? (expt nan.0 inf.0)) #t)
+ (test (nan? (expt nan.0 nan.0)) #t)
+ (test (nan? (expt 0 nan.0)) #t)
+ (test (<= 1 nan.0) #f)
+ (test (>= 1 nan.0) #f)
+ (test (<= 0 inf.0 nan.0) #f)
+ (test (<= nan.0 inf.0) #f)
+ (test (>= nan.0 inf.0) #f)
+ (test (<= nan.0 1) #f)
+ (test (>= nan.0 1) #f)
+ (test (<= nan.0 nan.0) #f)
+ (test (>= nan.0 nan.0) #f)))
+
+#|
+;; bad?
+ (test (>= 0 inf.0 -inf.0) #t)
+ (test (/ 0 inf.0 -inf.0) 0.0)
+ (test (nan? (expt 0 inf.0)) #t)
+ (test (nan? (quotient nan.0 nan.0)) #t)
+ (test (nan? (quotient nan.0 1)) #t)
+ (test (nan? (quotient 1 nan.0)) #t)
+ (test (nan? (quotient nan.0 inf.0)) #t)
+ (test (nan? (quotient -inf.0 inf.0)) #t)
+ (test (nan? (atan -inf.0 inf.0)) #t) ; ??
+|#
+
+#|
+ ;; what are these?
+
+ (test (nan? (floor inf.0)) #t)
+ (test (nan? (ceiling inf.0)) #t)
+ (test (nan? (truncate inf.0)) #t)
+ (test (nan? (round inf.0)) #t)
+ (test (inexact->exact (make-rectangular 1 inf.0)) 1+infi) ; error or nan?
+ (test (angle (make-rectangular 1 inf.0)) 1.5707963267949)
+ (test (tan (make-rectangular 1 inf.0)) 0+1i)
+ (test (atanh (make-rectangular 1 inf.0)) -0+1.5707963267949i)
+|#
+
+
+ )
+
(test (number? 3) #t )
(test (complex? 3) #t )
@@ -30898,11 +35638,45 @@
(format #t "(real? ~A) -> #f?~%" arg)))
(list 1 1.0 1/2))
-(if (not (rational? 1/2))
- (format #t "(rational? 1/2) is #f?~%"))
+(test (rational? 1/2) #t)
+(test (rational? 2) #t)
+(test (rational? (sqrt 2)) #f)
+(test (rational? 1.0) #f)
+(test (rational? 1+i) #f)
+(test (rational? most-negative-fixnum) #t)
+
+(test (integer? 1/2) #f)
+(test (integer? 2) #t)
+(test (integer? (sqrt 2)) #f)
+(test (integer? 1.0) #f)
+(test (integer? 1+i) #f)
+(test (integer? most-negative-fixnum) #t)
+
+(test (real? 1/2) #t)
+(test (real? 2) #t)
+(test (real? (sqrt 2)) #t)
+(test (real? 1.0) #t)
+(test (real? 1+i) #f)
+(test (real? most-negative-fixnum) #t)
+
+(test (complex? 1/2) #t)
+(test (complex? 2) #t)
+(test (complex? (sqrt 2)) #t)
+(test (complex? 1.0) #t)
+(test (complex? 1+i) #t)
+(test (complex? most-negative-fixnum) #t)
+
+(test (integer?) 'error)
+(test (rational?) 'error)
+(test (real?) 'error)
+(test (complex?) 'error)
+
+(test (integer? 1 2) 'error)
+(test (rational? 1 2) 'error)
+(test (real? 1 2) 'error)
+(test (complex? 1 2) 'error)
+
-(if (not (rational? 2))
- (format #t "(rational? 2) is #f?~%"))
@@ -30918,13 +35692,35 @@
(test (inexact? 1/2) #f)
(test (exact? 1.5+0.123i) #f)
(test (inexact? 1.5+0.123i) #t)
+(test (exact? 1.0) #f)
+(test (inexact? 1.0) #t)
+(test (exact? most-positive-fixnum) #t)
+(test (exact? our-pi) #f)
+
+(test (exact?) 'error)
+(test (exact? "hi") 'error)
+(test (exact? 1.0+23.0i 1.0+23.0i) 'error)
+(test (inexact?) 'error)
+(test (inexact? "hi") 'error)
+(test (inexact? 1.0+23.0i 1.0+23.0i) 'error)
+
(num-test (inexact->exact 1.5) 3/2)
(num-test (exact->inexact 3/2) 1.5)
(num-test (inexact->exact 1) 1)
+(num-test (inexact->exact 1.0) 1)
(num-test (exact->inexact 1) 1.0)
(num-test (exact->inexact 1.0) 1.0)
+(test (exact->inexact) 'error)
+(test (exact->inexact "hi") 'error)
+(test (exact->inexact 1.0+23.0i 1.0+23.0i) 'error)
+(test (inexact->exact) 'error)
+(test (inexact->exact "hi") 'error)
+(test (inexact->exact 1.0+23.0i 1.0+23.0i) 'error)
+
+
+
;; -------- min, max
@@ -31733,6 +36529,29 @@
(num-test (max 1 3 2 -7) 3)
(num-test (max 34 5 7 38 6) 38 )
+(test (max) 'error)
+(test (max 1.23+1.0i) 'error)
+(test (min) 'error)
+(test (min 1.23+1.0i) 'error)
+(num-test (min 0.0+0.00000001i) 'error)
+(num-test (max 0.0+0.00000001i) 'error)
+(num-test (min -0.0+0.00000001i) 'error)
+(num-test (max -0.0+0.00000001i) 'error)
+(num-test (min 1.0+1.0i) 'error)
+(num-test (max 1.0+1.0i) 'error)
+(num-test (min -1.0+1.0i) 'error)
+(num-test (max -1.0+1.0i) 'error)
+(num-test (min 2.71828182845905+3.14159265358979i) 'error)
+(num-test (max 2.71828182845905+3.14159265358979i) 'error)
+(num-test (min -2.71828182845905+3.14159265358979i) 'error)
+(num-test (max -2.71828182845905+3.14159265358979i) 'error)
+(num-test (min 1234000000.0+2.71828182845905i) 'error)
+(num-test (max 1234000000.0+2.71828182845905i) 'error)
+(num-test (min -1234000000.0+2.71828182845905i) 'error)
+(num-test (max -1234000000.0+2.71828182845905i) 'error)
+
+
+
;; -------- = < > <= >= + - / *
@@ -36620,7 +41439,8 @@
(num-test (log 8 2) 3)
(num-test (log -1 -1) 1.0)
-(num-test (log 1 1) 'error)
+;(num-test (log 1 1) 'error) -- could also be 0
+(num-test (log 2 1) 'error)
(num-test (log 1 -1) 0.0)
(num-test (log 1.5 -1) 0-0.12906355241341i)
@@ -38499,6 +43319,103 @@
(num-test (- 100000000000000.0 100000000000001.0) -1.0)
(num-test (- 1000000000000000000/3 1000000000000000001/3) -1/3)
+(num-test (+ 3 4) 7 )
+(num-test (+ 3) '3 )
+(num-test (+) 0 )
+(num-test (* 4) 4 )
+(num-test (*) 1 )
+(num-test (- 3 4) -1 )
+(num-test (- 3) -3 )
+
+(num-test (/ 0/3) 'error)
+(num-test (/ 2/3 0) 'error)
+(num-test (/ 0 2/3) 0)
+(num-test (/ 1e-10 1e10) 1e-20)
+ ;(num-test (/ 1e-20 1e300) 1e-321)
+
+(test (/) 'error)
+(test (/ "hi") 'error)
+(test (+ 1 2 . 3) 'error)
+(test (>=- 1 2) 'error)
+(test (>= - 1 2) 'error)
+(num-test (< 0) 'error)
+(num-test (<= 0) 'error)
+(num-test (= 0) 'error)
+(num-test (> 0) 'error)
+(num-test (>= 0) 'error)
+(num-test (< 2) 'error)
+(num-test (<= 2) 'error)
+(num-test (= 2) 'error)
+(num-test (> 2) 'error)
+(num-test (>= 2) 'error)
+(num-test (< 0/1) 'error)
+(num-test (<= 0/1) 'error)
+(num-test (= 0/1) 'error)
+(num-test (> 0/1) 'error)
+(num-test (>= 0/1) 'error)
+(num-test (< 10/3) 'error)
+(num-test (<= 10/3) 'error)
+(num-test (= 10/3) 'error)
+(num-test (> 10/3) 'error)
+(num-test (>= 10/3) 'error)
+(num-test (< 0.0) 'error)
+(num-test (<= 0.0) 'error)
+(num-test (= 0.0) 'error)
+(num-test (> 0.0) 'error)
+(num-test (>= 0.0) 'error)
+(num-test (< 1.0) 'error)
+(num-test (<= 1.0) 'error)
+(num-test (= 1.0) 'error)
+(num-test (> 1.0) 'error)
+(num-test (>= 1.0) 'error)
+(num-test (< 0.0+0.00000001i) 'error)
+(num-test (<= 0.0+0.00000001i) 'error)
+(num-test (= 0.0+0.00000001i) 'error)
+(num-test (> 0.0+0.00000001i) 'error)
+(num-test (>= 0.0+0.00000001i) 'error)
+(num-test (< 1.0+1.0i) 'error)
+(num-test (<= 1.0+1.0i) 'error)
+(num-test (= 1.0+1.0i) 'error)
+(num-test (> 1.0+1.0i) 'error)
+(num-test (>= 1.0+1.0i) 'error)
+(num-test (< 2.71828182845905+3.14159265358979i) 'error)
+(num-test (<= 2.71828182845905+3.14159265358979i) 'error)
+(num-test (= 2.71828182845905+3.14159265358979i) 'error)
+(num-test (> 2.71828182845905+3.14159265358979i) 'error)
+(num-test (>= 2.71828182845905+3.14159265358979i) 'error)
+(num-test (< 1234000000.0+2.71828182845905i) 'error)
+(num-test (<= 1234000000.0+2.71828182845905i) 'error)
+(num-test (= 1234000000.0+2.71828182845905i) 'error)
+(num-test (> 1234000000.0+2.71828182845905i) 'error)
+(num-test (>= 1234000000.0+2.71828182845905i) 'error)
+(num-test (< 2 1 1.0+1.0i) 'error)
+(num-test (<= 2 1 1.0+1.0i) 'error)
+(num-test (> 1 2 1.0+1.0i) 'error)
+(num-test (>= 1 2 1.0+1.0i) 'error)
+(num-test (< 2 1 #\a) 'error)
+(num-test (<= 2 1 #\a) 'error)
+(num-test (> 1 2 #\a) 'error)
+(num-test (>= 1 2 #\a) 'error)
+(num-test (= 0 1 "hi") 'error)
+(num-test (= 0.0 1.0 "hi") 'error)
+(num-test (* 0 1 "hi") 'error)
+(num-test (* 0.0 "hi") 'error)
+(num-test (* 0.0+0.0i "hi") 'error)
+(num-test (* 0/1 "hi") 'error)
+(num-test (/ 0 1 "hi") 'error)
+(num-test (* 1 0.0 #\a) 'error)
+(num-test (< 3 3.0 3 3.0+1.0i) 'error)
+(num-test (> 3 3.0 3 3.0+1.0i) 'error)
+(test (+ 1 + 2) 'error)
+(test (+ 1 - 2) 'error)
+(test (+ 1 #t) 'error)
+(test (+ 1 #f) 'error)
+(test (/ 0) 'error)
+(test (/ -0) 'error)
+(test (/ 0.0) 'error)
+(test (/ 1.0 0) 'error)
+
+
;; --------------------------------------------------------------------------------
;; miscellaneous numeric tests
@@ -39523,32 +44440,11 @@
(if with-bignums (num-test (/ -9223372036854775808 -9223372036854775808 -9223372036854775808) -1/9223372036854775808))
-(num-test (ash -1 -3) -1)
-(num-test (ash -31 -20) -1)
-(num-test (ash -31 -60) -1)
-(num-test (ash -31 -70) -1)
-(num-test (ash -31 -100) -1)
-(num-test (ash -31 most-negative-fixnum) -1)
-
-(num-test (/ 0/3) 'error)
-(num-test (/ 2/3 0) 'error)
-(num-test (/ 0 2/3) 0)
-
-
(test (integer? (expt 2.3 54)) #f)
(test (zero? (- (expt 2.3 54) (floor (expt 2.3 54)))) #f)
(test (integer? 10000000000000000.5) #f)
(test (integer? (expt 2 54)) #t)
-(num-test (+ 1 (expt 2 54)) 18014398509481985)
-(num-test (- (expt 2 54) 18014398509481984) 0)
-(num-test (- (expt 2 54) 18014398509481983) 1)
-(num-test (+ 10000000000000000 1) 10000000000000001)
-(num-test (- 10000000000000000 9999999999999999) 1)
-(num-test (/ (expt 2 -53) 2) (expt 2 -54))
-(num-test (* 1/18014398509481984 1/2) (expt 2 -55))
-(num-test (/ (expt 2.3 50) (expt 2.3 49)) 2.3)
-(num-test (/ 1e-10 1e10) 1e-20)
- ;(num-test (/ 1e-20 1e300) 1e-321)
+
;;; why: (- 1e-2 (expt 10 -2)) = 2.081668171172168513294235909273361692968E-19? in guile it's 0.0 -- this is mpfr's fault
(num-test (/ (expt 10 -20) (expt 10 -20)) 1)
(num-test (/ (expt 10 -200) (expt 10 -200)) 1)
@@ -39761,6 +44657,20 @@
(num-test (/ 123412341234) 1/123412341234)
(num-test (/ 1/123412341234) 123412341234)
+(test (< (abs (- (do ((x0 11/2)
+ (x1 61/11)
+ (i 0 (+ i 1)))
+ ((= i 100) x1)
+ (let ((tmp x1))
+ (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1)))
+ (set! x0 tmp)))
+ 6)) ; (6 - 1/(1+(6/5)^k))
+ 0.00001)
+ #t)
+
+;; in floats this heads for 100:
+;; (do ((x0 (exact->inexact 11/2)) (x1 (exact->inexact 61/11)) (i 0 (+ i 1))) ((= i 100) x1) (let ((tmp x1)) (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1))) (set! x0 tmp)))
+
(let ((tag (catch #t (lambda () (log 10.0 10.0)) (lambda args 'error))))
(if (and (number? tag)
@@ -39821,18 +44731,10 @@
(if (> mx 1e-6)
(format #t "dht error: ~A~%" mx))))
-(num-test (+ 3 4) 7 )
-(num-test (+ 3) '3 )
-(num-test (+) 0 )
-(num-test (* 4) 4 )
-(num-test (*) 1 )
-(num-test (- 3 4) -1 )
-(num-test (- 3) -3 )
;; -------- random
-
(let ((v (lambda (n range chker) ; chi^2 or mus-random
(let ((hits (make-vector 100 0)))
(do ((i 0 (+ 1 i )))
@@ -39840,7 +44742,7 @@
(let ((y (random range)))
(if (not (chker y))
(format #t "(random ~A) -> ~A?~%" range y))
- (let ((iy (min 99 (inexact->exact (floor (* 100 (/ y range)))))))
+ (let ((iy (min 99 (floor (* 100 (/ y range))))))
(vector-set! hits iy (+ 1 (vector-ref hits iy))))))
(let ((sum 0.0)
(p (/ n 100.0)))
@@ -40828,7 +45730,7 @@
(lambda (lo hi)
(if (= lo hi)
hi
- (let ((mid (inexact->exact (floor (/ (+ hi lo) 2)))))
+ (let ((mid (floor (/ (+ hi lo) 2))))
(if (or (>= mid hi)
(<= mid lo))
mid
@@ -40839,8 +45741,7 @@
(return (search last-good (- (* 2 last-good) 1)))))))))))
(set! number-to-string-top first-bad)
(if (and (integer? first-bad)
- (or (not (defined? 'most-positive-fixnum))
- (< first-bad most-positive-fixnum)))
+ (< first-bad most-positive-fixnum))
(format #t "string->number ints fail around ~A (2^~A)~%" first-bad (log first-bad 2))))
(let* ((last-good 0)
@@ -40855,7 +45756,7 @@
(set! last-good k)
(letrec ((search
(lambda (lo hi)
- (if (= (inexact->exact (floor lo)) (inexact->exact (floor hi)))
+ (if (= (floor lo) (floor hi))
hi
(let ((mid (/ (+ hi lo) 2)))
(if (or (>= mid hi)
@@ -40883,7 +45784,7 @@
(set! last-good k)
(letrec ((search
(lambda (lo hi)
- (if (= (inexact->exact (floor (/ 1.0 lo))) (inexact->exact (floor (/ 1.0 hi))))
+ (if (= (floor (/ 1.0 lo)) (floor (/ 1.0 hi)))
hi
(let ((mid (/ (+ hi lo) 2)))
(if (or (>= mid hi)
@@ -40909,7 +45810,7 @@
(set! last-good k)
(letrec ((search
(lambda (lo hi)
- (if (= (inexact->exact (floor lo)) (inexact->exact (floor hi)))
+ (if (= (floor lo) (floor hi))
hi
(let ((mid (/ (+ hi lo) 2)))
(if (or (>= mid hi)
@@ -40962,7 +45863,7 @@
(lambda (lo hi)
(if (= lo hi)
hi
- (let ((mid (inexact->exact (floor (/ (+ hi lo) 2)))))
+ (let ((mid (floor (/ (+ hi lo) 2))))
(if (and (eqv? mid (string->number (number->string mid radix) radix))
(eqv? (- mid) (string->number (number->string (- mid) radix) radix)))
(search mid hi)
@@ -41150,6 +46051,123 @@
(num-test (string->number "1.1e4" 3) 108.0)
(num-test (string->number "1.1e4" 2) 24.0)
+(num-test #b111111111111111111111111111111111111111111111111111111111111111 most-positive-fixnum)
+(num-test #o777777777777777777777 most-positive-fixnum)
+(num-test #x7fffffffffffffff most-positive-fixnum)
+(num-test #d9223372036854775807 most-positive-fixnum)
+
+(num-test #d-9223372036854775808 most-negative-fixnum)
+(num-test #o-1000000000000000000000 most-negative-fixnum)
+(num-test #x-8000000000000000 most-negative-fixnum)
+(num-test #b-1000000000000000000000000000000000000000000000000000000000000000 most-negative-fixnum)
+
+
+(test (number->string most-positive-fixnum 2) "111111111111111111111111111111111111111111111111111111111111111")
+(test (number->string most-positive-fixnum 8) "777777777777777777777")
+(test (number->string most-positive-fixnum 16) "7fffffffffffffff")
+(test (number->string most-positive-fixnum 10) "9223372036854775807")
+(test (number->string most-negative-fixnum 10) "-9223372036854775808")
+(test (number->string most-negative-fixnum 8) "-1000000000000000000000")
+(test (number->string most-negative-fixnum 16) "-8000000000000000")
+(test (number->string most-negative-fixnum 2) "-1000000000000000000000000000000000000000000000000000000000000000")
+
+(test (string->number "111111111111111111111111111111111111111111111111111111111111111" 2) most-positive-fixnum)
+(test (string->number "777777777777777777777" 8) most-positive-fixnum)
+(test (string->number "7fffffffffffffff" 16) most-positive-fixnum)
+(test (string->number "9223372036854775807" 10) most-positive-fixnum)
+(test (string->number "-9223372036854775808" 10) most-negative-fixnum)
+(test (string->number "-1000000000000000000000" 8) most-negative-fixnum)
+(test (string->number "-8000000000000000" 16) most-negative-fixnum)
+(test (string->number "-1000000000000000000000000000000000000000000000000000000000000000" 2) most-negative-fixnum)
+
+
+(num-test #b1.0e8 256.0)
+(num-test #o1.0e8 16777216.0)
+(num-test #d1.0e8 100000000.0)
+
+;;; no #x here because e is a digit
+;;; #b1.1111111111111111111111111111111111111111111111111110011101010100100100011001011011111011000011001110110101010011110011000100111E1023 1.7976931348623156E308
+;;; currently (number->string 1/9 2) returns "1/1001" -- is this expected?
+
+(num-test #b1.0e-8 0.00390625)
+(num-test #o1.0e-8 5.9604644775391e-08)
+(num-test #d1.0e-8 1.0e-8)
+
+(num-test #b-.1 -0.5)
+(num-test #o-.1 -0.125)
+(num-test #d-.1 -0.1)
+(num-test #x-.1 -0.0625)
+
+(num-test #b+.1 +0.5)
+(num-test #o+.1 +0.125)
+(num-test #d+.1 +0.1)
+(num-test #x+.1 +0.0625)
+
+(num-test #b+.1e+1 1.0)
+(num-test #d+.1e+1 1.0)
+(num-test #o+.1e+1 1.0)
+
+(num-test #b000000001 1)
+(num-test #b1e1 2.0)
+(num-test #b1.e1 2.0)
+
+(num-test #b#e-.1 -1/2)
+(num-test #o#e-.1 -1/8)
+(num-test #d#e-.1 -1/10)
+(num-test #x#e-.1 -1/16)
+
+(num-test #b#e1.1e2 6)
+(num-test #o#e1.1e2 72)
+(num-test #d#e1.1e2 110)
+
+(num-test #b#i-1.1e-2 -0.375)
+(num-test #o#i-1.1e-2 -0.017578125)
+(num-test #d#i-1.1e-2 -0.011)
+
+(num-test #e#b+1.1 3/2)
+(num-test #e#o+1.1 9/8)
+(num-test #e#d+1.1 11/10)
+(num-test #e#x+1.1 17/16)
+
+(num-test #e#b+1.1e+2 6)
+(num-test #e#o+1.1e+2 72)
+(num-test #e#d+1.1e+2 110)
+
+(num-test #i#b.001 0.125)
+(num-test #i#b000000000011 3.0)
+(num-test #i#b-000000000011e1 -6.0)
+(num-test #i#b-000000000011e+11 -6144.0)
+
+(num-test #x-AAF -2735)
+(num-test #x-aAf -2735)
+
+(num-test #b1+1.1i 1+1.5i) ; yow...
+(num-test #b#e0+i 0+1i)
+(num-test #b#e0+1.1i 0+1.5i) ; oh well
+
+(num-test #xf/c 5/4)
+(num-test #x+f/c 5/4)
+(num-test #x-f/c -5/4)
+(num-test #i#xf/c 1.25)
+(num-test #e#x1.4 5/4)
+
+;; nutty: #e+inf.0 #e+nan.0
+;; these don't arise in s7 because we don't define inf.0 and nan.0
+
+(num-test #b0/1 0)
+(num-test #d3/4 3/4)
+(num-test #o7/6 7/6)
+(num-test #o11/2 9/2)
+(num-test #d11/2 11/2)
+(num-test #x11/2 17/2)
+(num-test #b111/11 7/3)
+(num-test #b111111111111111111111111111111111111111111111111111111111111111/111 1317624576693539401)
+(num-test #d9223372036854775807/7 1317624576693539401)
+(num-test (* 1317624576693539401 7) most-positive-fixnum)
+(num-test #o777777777777777777777/7 1317624576693539401)
+(num-test #x7fffffffffffffff/7 1317624576693539401)
+
+
(do ((i 2 (+ i 1)))
((= i 17))
(num-test (string->number (number->string 12345.67890987654321 i) i) 12345.67890987654321))
@@ -41849,12 +46867,173 @@
"0d-+i" "1f-+i" "0f-+i" "1e++i" "0e++i" "1d++i" ".10-10." "-1.e++i" "0e--01i" "1-00." "0-00." "#xf+b"
"#x1+d" "0f++1i" "1+0d-i" ".0f--i" "1-0d-i" "#xe-ff" "0-" "0-e0"
+ "-#b1" "#b.i" "#b+i" "#b1e.1" "#b1+1" "#b#e#e1" "#b#ee1" "#b#e0e" "#d#d1" "#d#1d1"
+ "#b+1ei" "#b-1ei" "#b+0ei" "#b-0ei" "#b+1di" "#b-1di" "#b+0di" "#b-0di" "#b+1fi" "#b-1fi" "#b+0fi" "#b-0fi" "#b0e-+i" "#b1d-+i"
))
(num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427") 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427)
+;; from testbase-report.ps Vern Paxson (with some changes)
+;; resultant strings are thanks to clisp
+(let ((cases
+ (list
+ (list '(* 49517601571415211 (expt 2 -94)) "2.5e-12")
+ (list '(* 49517601571415211 (expt 2 -95)) "1.25e-12")
+ (list '(* 54390733528642804 (expt 2 -133)) "4.995e-24")
+ (list '(* 71805402319113924 (expt 2 -157)) "3.9305e-31")
+ (list '(* 40435277969631694 (expt 2 -179)) "5.27705e-38")
+ (list '(* 57241991568619049 (expt 2 -165)) "1.223955e-33")
+ (list '(* 65224162876242886 (expt 2.0 58)) "1.8799585e+34")
+ (list '(* 70173376848895368 (expt 2 -138)) "2.01387715e-25")
+ (list '(* 37072848117383207 (expt 2 -99)) "5.849064105e-14")
+ (list '(* 56845051585389697 (expt 2 -176)) "5.9349003055e-37")
+ (list '(* 54791673366936431 (expt 2 -145)) "1.22847180395e-27")
+ (list '(* 66800318669106231 (expt 2 -169)) "8.927076718085e-35")
+ (list '(* 66800318669106231 (expt 2 -170)) "4.4635383590425e-35")
+ (list '(* 66574323440112438 (expt 2 -119)) "1.00169908625495e-19")
+ (list '(* 65645179969330963 (expt 2 -173)) "5.482941262802465e-36")
+ (list '(* 61847254334681076 (expt 2 -109)) "9.529078328103644e-17")
+ (list '(* 39990712921393606 (expt 2 -145)) "8.966227936640557e-28")
+ (list '(* 59292318184400283 (expt 2 -149)) "8.308623441805854e-29")
+ (list '(* 69116558615326153 (expt 2 -143)) "6.1985873566126555e-27")
+ (list '(* 69116558615326153 (expt 2 -144)) "3.0992936783063277e-27")
+ (list '(* 39462549494468513 (expt 2 -152)) "6.912351250617602e-30")
+ (list '(* 39462549494468513 (expt 2 -153)) "3.456175625308801e-30")
+ (list '(* 50883641005312716 (expt 2 -172)) "8.5e-36")
+ (list '(* 38162730753984537 (expt 2 -170)) "2.55e-35")
+ (list '(* 50832789069151999 (expt 2 -101)) "2.005e-14")
+ (list '(* 51822367833714164 (expt 2 -109)) "7.984499999999999e-17")
+ (list '(* 66840152193508133 (expt 2 -172)) "1.11655e-35")
+ (list '(* 55111239245584393 (expt 2 -138)) "1.581615e-25")
+ (list '(* 71704866733321482 (expt 2 -112)) "1.3809855e-17")
+ (list '(* 67160949328233173 (expt 2 -142)) "1.20464045e-26")
+ (list '(* 53237141308040189 (expt 2 -152)) "9.325140545e-30")
+ (list '(* 62785329394975786 (expt 2 -112)) "1.2092014595e-17")
+ (list '(* 48367680154689523 (expt 2 -77)) "3.20070458385e-07")
+ (list '(* 42552223180606797 (expt 2 -102)) "8.391946324355e-15")
+ (list '(* 63626356173011241 (expt 2 -112)) "1.2253990460585e-17")
+ (list '(* 43566388595783643 (expt 2 -99)) "6.87356414897605e-14")
+ (list '(* 54512669636675272 (expt 2 -159)) "7.459816430480385e-32")
+ (list '(* 52306490527514614 (expt 2 -167)) "2.7960588398142556e-34")
+ (list '(* 52306490527514614 (expt 2 -168)) "1.3980294199071278e-34")
+ (list '(* 41024721590449423 (expt 2 -89)) "6.627901237305737e-11")
+ (list '(* 37664020415894738 (expt 2 -132)) "6.917788004396807e-24")
+ (list '(* 37549883692866294 (expt 2 -93)) "3.791569310834971e-12")
+ (list '(* 69124110374399839 (expt 2 -104)) "3.408081767659137e-15")
+ (list '(* 69124110374399839 (expt 2 -105)) "1.7040408838295685e-15")
+ (list '(* 9 (expt 10 26)) "9e+26")
+ (list '(* 79 (expt 10 -8)) "7.9e-07")
+ (list '(* 393 (expt 10.0 26)) "3.93e+28")
+ (list '(* 9171 (expt 10 -40)) "9.171e-37")
+ (list '(* 56257 (expt 10 -16)) "5.6257e-12")
+ (list '(* 281285 (expt 10 -17)) "2.81285e-12")
+ (list '(* 4691113 (expt 10 -43)) "4.691113e-37")
+ (list '(* 29994057 (expt 10 -15)) "2.9994057e-08")
+ (list '(* 834548641 (expt 10 -46)) "8.34548641e-38")
+ (list '(* 1058695771 (expt 10 -47)) "1.058695771e-38")
+ (list '(* 87365670181 (expt 10 -18)) "8.7365670181e-08")
+ (list '(* 872580695561 (expt 10 -36)) "8.72580695561e-25")
+ (list '(* 6638060417081 (expt 10 -51)) "6.638060417081e-39")
+ (list '(* 88473759402752 (expt 10 -52)) "8.8473759402752e-39")
+ (list '(* 412413848938563 (expt 10 -27)) "4.12413848938563e-13")
+ (list '(* 5592117679628511 (expt 10 -48)) "5.592117679628511e-33")
+ (list '(* 83881765194427665 (expt 10 -50)) "8.388176519442766e-34")
+ ;(list '(* 638632866154697279 (expt 10 -35)) "6.3863286615469725e-18")
+ ;(list '(* 3624461315401357483 (expt 10 -53)) "3.6244613154013574e-35")
+ ;(list '(* 75831386216699428651 (expt 10 -30)) "7.583138621669942e-11")
+ ;(list '(* 356645068918103229683 (expt 10 -42)) "3.566450689181032e-22")
+ ;(list '(* 7022835002724438581513 (expt 10 -33)) "7.022835002724439e-12")
+ (list '(* 7 (expt 10 -27)) "7e-27")
+ (list '(* 37 (expt 10 -29)) "3.7e-28")
+ (list '(* 743 (expt 10 -18)) "7.43e-16")
+ (list '(* 7861 (expt 10 -33)) "7.861e-30")
+ (list '(* 46073 (expt 10 -30)) "4.6073e-26")
+ (list '(* 774497 (expt 10 -34)) "7.74497e-29")
+ (list '(* 8184513 (expt 10 -33)) "8.184513e-27")
+ (list '(* 89842219 (expt 10 -28)) "8.9842219e-21")
+ (list '(* 449211095 (expt 10 -29)) "4.49211095e-21")
+ (list '(* 8128913627 (expt 10 -40)) "8.128913627e-31")
+ (list '(* 87365670181 (expt 10 -18)) "8.7365670181e-08")
+ (list '(* 436828350905 (expt 10 -19)) "4.36828350905e-08")
+ (list '(* 5569902441849 (expt 10 -49)) "5.569902441849e-37")
+ (list '(* 60101945175297 (expt 10 -32)) "6.0101945175297e-19")
+ (list '(* 754205928904091 (expt 10 -51)) "7.54205928904091e-37")
+ (list '(* 5930988018823113 (expt 10 -37)) "5.930988018823113e-22")
+ (list '(* 51417459976130695 (expt 10 -27)) "5.14174599761307e-11")
+ (list '(* 826224659167966417 (expt 10 -41)) "8.262246591679665e-24")
+ ;(list '(* 9612793100620708287 (expt 10 -57)) "9.612793100620708e-39")
+ ;(list '(* 93219542812847969081 (expt 10 -39)) "9.321954281284797e-20")
+ ;(list '(* 544579064588249633923 (expt 10 -48)) "5.445790645882496e-28")
+ ;(list '(* 4985301935905831716201 (expt 10 -48)) "4.9853019359058315e-27")
+ (list '(* 12676506 (expt 2 -102)) "2.499999999549897e-24")
+ (list '(* 12676506 (expt 2 -103)) "1.2499999997749484e-24")
+ (list '(* 15445013 (expt 2.0 86)) "1.1949999999989506e+33")
+ (list '(* 13734123 (expt 2 -138)) "3.941499999999621e-35")
+ (list '(* 12428269 (expt 2 -130)) "9.13084999999985e-33")
+ (list '(* 15334037 (expt 2 -146)) "1.719004999999994e-37")
+ (list '(* 11518287 (expt 2 -41)) "5.237910499999998e-06")
+ (list '(* 12584953 (expt 2 -145)) "2.82164405e-37")
+ (list '(* 15961084 (expt 2 -125)) "3.752432815e-31")
+ (list '(* 14915817 (expt 2 -146)) "1.6721209165e-37")
+ (list '(* 10845484 (expt 2 -102)) "2.13889458145e-24")
+ (list '(* 16431059 (expt 2 -61)) "7.125835945615e-12")
+ (list '(* 16093626 (expt 2.0 69)) "9.500000001279935e+27")
+ (list '(* 9983778 (expt 2.0 25)) "335000000004096.0")
+ (list '(* 12745034 (expt 2.0 104)) "2.5850000000046706e+38")
+ (list '(* 12706553 (expt 2.0 72)) "6.000500000000674e+28")
+ (list '(* 11005028 (expt 2.0 45)) "3.8720500000001465e+20")
+ (list '(* 15059547 (expt 2.0 71)) "3.555835000000006e+28")
+ (list '(* 16015691 (expt 2 -99)) "2.5268305000000024e-23")
+ (list '(* 8667859 (expt 2.0 56)) "6.24585065e+23")
+ (list '(* 14855922 (expt 2 -82)) "3.072132665e-18")
+ (list '(* 14855922 (expt 2 -83)) "1.5360663325e-18")
+ (list '(* 10144164 (expt 2 -110)) "7.81477968335e-27")
+ (list '(* 13248074 (expt 2.0 95)) "5.248102799365e+35")
+ (list '(* 5 (expt 10 -20)) "5e-20")
+ (list '(* 67 (expt 10.0 14)) "6.7e+15")
+ (list '(* 985 (expt 10.0 15)) "9.85e+17")
+ (list '(* 7693 (expt 10 -42)) "7.693e-39")
+ (list '(* 55895 (expt 10 -16)) "5.5895e-12")
+ (list '(* 996622 (expt 10 -44)) "9.96622e-39")
+ (list '(* 7038531 (expt 10 -32)) "7.038531e-26")
+ (list '(* 60419369 (expt 10 -46)) "6.0419369e-39")
+ (list '(* 702990899 (expt 10 -20)) "7.02990899e-12")
+ (list '(* 6930161142 (expt 10 -48)) "6.930161142e-39")
+ (list '(* 25933168707 (expt 10.0 13)) "2.5933168707e+23")
+ (list '(* 596428896559 (expt 10.0 20)) "5.96428896559e+31")
+ (list '(* 3 (expt 10 -23)) "3e-23")
+ (list '(* 57 (expt 10.0 18)) "5.7e+19")
+ (list '(* 789 (expt 10 -35)) "7.89e-33")
+ (list '(* 2539 (expt 10 -18)) "2.539e-15")
+ (list '(* 76173 (expt 10.0 28)) "7.6173e+32")
+ (list '(* 887745 (expt 10 -11)) "8.87745e-06")
+ (list '(* 5382571 (expt 10 -37)) "5.382571e-31")
+ (list '(* 82381273 (expt 10 -35)) "8.2381273e-28")
+ (list '(* 750486563 (expt 10 -38)) "7.50486563e-30")
+ (list '(* 3752432815 (expt 10 -39)) "3.752432815e-30")
+ (list '(* 75224575729 (expt 10 -45)) "7.5224575729e-35")
+ (list '(* 459926601011 (expt 10.0 15)) "4.59926601011e+26") ; 10.0 (and 2.0 above) because we aren't interested here in numeric overflows
+ )))
+ (let ((maxdiff 0.0)
+ (maxdiff-case '()))
+ (do ((lst cases (cdr lst)))
+ ((null? lst))
+ (let* ((form (caar lst))
+ (str (cadar lst))
+ (num (eval form))
+ (fnum (* 1.0 num))
+ (n2s (number->string fnum))
+ (s2n (string->number n2s))
+ (mnum (string->number str))
+ (diff (/ (abs (- mnum s2n)) (abs fnum))))
+ (if (> diff maxdiff)
+ (begin
+ (set! maxdiff diff)
+ (set! maxdiff-case (car lst))))))
+ (if (> maxdiff 1e-15) ; we're only interested in real problems
+ (format #t ";number->string rounding checks worst case relative error ~A ~A ~S~%" maxdiff (car maxdiff-case) (cadr maxdiff-case)))
+ ))
-;;; every scheme disagrees about stuff like #b.1 or #b+i etc -- I'll just omit them
(for-each
(lambda (p)
@@ -41902,13 +47081,13 @@
; ((= k len))
; (string-set! sym k (list-ref chars (vector-ref ctrs k)))))
;
- ; ;(display (format #f "~S " sym))
+ ; ;(format #t "~S " sym)
;
; (let ((tag (catch #t (lambda () (string->number sym)) (lambda args (car args)))))
; (if (not with-file)
; (if (and (number? tag)
; (= tag 1))
- ; (display (format #f "~S " sym)))
+ ; (format #t "~S " sym))
; (begin
; (if (number? tag)
; (display (format file "(if (not (number? (string->number ~S))) (begin (display ~S) (display #\space)))"))
@@ -41925,8 +47104,7 @@
(for-each
(lambda (n name)
(if (number? n)
- (begin
- (display "(number? ") (display name) (display ") returned #t?") (newline))))
+ (format #t "(number? ~A) returned #t?~%" name)))
(list
'a9 'aa 'aA 'a! 'a$ 'a% 'a& 'a* 'a+ 'a- 'a. 'a/ 'a: 'a< 'a= 'a> 'a? 'a@ 'a^ 'a_ 'a~ 'A9 'Aa 'AA 'A! 'A$ 'A% 'A& 'A* 'A+ 'A- 'A. 'A/ 'A: 'A< 'A= 'A> 'A? 'A@ 'A^ 'A_ 'A~ '!9 '!a '!A '!! '!$ '!% '!& '!* '!+ '!- '!. '!/ '!: '!< '!= '!> '!? '!@ '!^ '!_ '!~ '$9 '$a '$A '$! '$$ '$% '$& '$* '$+ '$- '$. '$/ '$: '$< '$= '$> '$? '$@ '$^ '$_ '$~ '%9 '%a '%A '%! '%$ '%% '%& '%* '%+ '%- '%. '%/ '%: '%< '%= '%> '%? '%@ '%^ '%_ '%~ '&9 '&a '&A '&! '&$ '&% '&& '&* '&+ '&- '&. '&/ '&: '&< '&= '&> '&? '&@ '&^ '&_ '&~ '*9 '*a '*A '*! '*$ '*% '*& '** '*+ '*- '*. '*/ '*: '*< '*= '*> '*? '*@ '*^ '*_ '*~ '/9 '/a '/A '/! '/$ '/% '/& '/* '/+ '/- '/. '// '/: '/< '/= '/> '/? '/@ '/^ '/_ '/~ ':9 ':a ':A ':! ':$ ':% ':& ':* ':+ ':- ':. ':/ ':: ':< ':= ':> ':? ':@ ':^ ':_ ':~ '<9 '<a '<A '<! '<$ '<% '<& '<* '<+ '<- '<. '</ '<: '<< '<= '<> '<? '<@ '<^ '<_ '<~ '=9 '=a '=A '=! '=$ '=% '=& '=* '=+ '=- '=. '=/ '=: '=< '== '=> '=? '=@ '=^ '=_ '=~ '>9 '>a '>A '>! '>$ '>% '>& '>* '>+ '>- '>. '>/ '>: '>< '>= '>> '>? '>@ '>^ '>_ '>~ '?9 '?a '?A '?! '?$ '?% '?& '?* '?+ '?- '?. '?/ '?: '?< '?= '?> '?? '?@ '?^ '?_ '?~ '^9 '^a '^A '^! '^$ '^% '^& '^* '^+ '^- '^. '^/ '^: '^< '^= '^> '^? '^@ '^^ '^_ '^~ '_9 '_a '_A '_! '_$ '_% '_& '_* '_+ '_- '_. '_/ '_: '_< '_= '_> '_? '_@ '_^ '__ '_~ '~9 '~a '~A '~! '~$ '~% '~& '~* '~+ '~- '~. '~/ '~: '~< '~= '~> '~? '~@ '~^ '~_ '~~)
@@ -41939,25 +47117,24 @@
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (display (format #f "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))))
+ ; (format #t "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))))
(for-each
(lambda (z)
(if (not (zero? z))
- (begin (display z) (display " is not zero?") (newline)))
+ (format #t "~A is not zero?~%" z))
(if (and (real? z) (positive? z))
- (begin (display z) (display " is positive?") (newline)))
+ (format #t "~A is positive?~%" z))
(if (and (real? z) (negative? z))
- (begin (display z) (display " is negative?") (newline))))
+ (format #t "~A is negative?~%" z)))
'(0 -0 +0 0.0 -0.0 +0.0 0/1 -0/1 +0/24 0+0i 0-0i -0-0i +0-0i 0.0-0.0i -0.0+0i #b0 #o-0 #x000 #e0 #e0.0 #e#b0 #b#e0 #e0/1 #b+0))
(for-each
(lambda (x)
(if (string->number x)
- (begin
- (display "(string->number ") (display x) (display ") returned ") (display (string->number x)) (newline))))
+ (format #t "(string->number ~A) returned ~A~%" x (string->number x))))
'("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@"
"+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
"3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2" "#b12" "#b-12"
@@ -41975,11 +47152,10 @@
(lambda (x y)
(let ((xx (string->number x)))
(if (or (eq? xx #f)
- (and (exact? y)
+ (and (rational? y)
(not (eqv? xx y)))
(> (abs (- xx y)) 1e-12))
- (begin
- (display "(string->number ") (display x) (display ") returned ") (display (string->number x)) (display " but expected ") (display y) (newline)))))
+ (format #t "(string->number ~A) returned ~A but expected ~A~%" x (string->number x) y))))
couple))
`(;; Radix:
("#b0" 0) ("#b1" 1) ("#o0" 0) ("#b-1" -1) ("#b+1" 1)
@@ -42036,6 +47212,45 @@
("#e1e1" 10) ("#i1e1+i" 10.0+1.0i)
))
+(for-each
+ (lambda (arg)
+ (test (string->number arg) 'error))
+ (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(for-each
+ (lambda (arg)
+ (test (string->number "123" arg) 'error)
+ (test (string->number "1" arg) 'error))
+ (list -1 0 1 #\a '#(1 2 3) 3.14 3/4 1.5+0.3i 1+i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+;; (string->number "0" 1) ?? why not?
+
+(for-each
+ (lambda (arg)
+ (test (number->string arg) 'error))
+ (list #\a '#(1 2 3) '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(for-each
+ (lambda (arg)
+ (test (number->string 123 arg) 'error))
+ (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(test (string->number "34.1" (+ 5 (expt 2 32))) 'error)
+(test (number->string 34.1 (+ 5 (expt 2 32))) 'error)
+(test (string->number) 'error)
+(test (string->number 'symbol) 'error)
+(test (string->number "1.0" "1.0") 'error)
+(test (number->string) 'error)
+(test (number->string "hi") 'error)
+(test (number->string 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
+(test (string->number "") #f)
+(test (string->number (make-string 0)) #f)
+(test (string->number (string #\null)) #f)
+(test (string->number (string)) #f)
+(test (string->number (substring "hi" 0 0)) #f)
+
+
+
;;; --------------------------------------------------------------------------------
@@ -42052,6 +47267,7 @@
(test (logior -1) -1)
(test (logior 12341234 10001111) 12378103)
(test (logior 1 2 4 8) 15)
+(test (logior) 'error)
(test (logand 0 1) 0)
@@ -42071,6 +47287,7 @@
(test (logand 1 -1) 1)
(test (logand 1 1) 1)
(test (logand 16 31) 16)
+(test (logand) 'error)
(test (logxor 0 1) 1)
@@ -42081,6 +47298,7 @@
(test (logxor #b1 #b11 #b111 #b1111) #b1010)
(test (logxor 12341234 10001111) 2413861)
(test (logxor 1 3 7 15) 10)
+(test (logxor) 'error)
(test (lognot 0) -1)
@@ -42091,6 +47309,8 @@
(test (lognot 12341234) -12341235)
(test (lognot #b-101) 4)
(test (lognot (+ 1 (lognot 1000))) 999)
+(test (lognot) 'error)
+
;; from CL spec
(test (let ((str ""))
@@ -42106,6 +47326,29 @@
(show m x y)))) str)
"[m = #o007750, x = #o452576, y = #o317407] [m = #o007750, x = #o457426, y = #o312557] ")
+(test (logior -1 "hi") 'error)
+(test (logand 0 "hi") 'error)
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
+ (if (not (equal? val 'error))
+ (format #t "(~A ~A) -> ~A?~%" op arg val))))
+ (list "hi" (integer->char 65) 'a-symbol (make-vector 3) 3.14 3/4 3.1+i abs #\f (lambda (a) (+ a 1)))))
+ (list logior logand lognot logxor ash integer-length))
+
+(for-each
+ (lambda (op)
+ (for-each
+ (lambda (arg)
+ (let ((val (catch #t (lambda () (op 1 arg)) (lambda args 'error))))
+ (if (not (equal? val 'error))
+ (format #t "(~A ~A) -> ~A?~%" op arg val))))
+ (list "hi" (integer->char 65) 'a-symbol (make-vector 3) 3.14 -1/2 1+i abs #\f (lambda (a) (+ a 1)))))
+ (list logior logand logxor lognot))
+
+
(num-test (ash 0 1) 0)
@@ -42135,6 +47378,9 @@
(num-test (ash 1 (- (expt 2 31))) 0)
(num-test (ash (expt 2 31) (- (expt 2 31))) 0)
(num-test (ash -129876 -1026) -1)
+(num-test (ash -2 -3) -1)
+(num-test (ash -3 -3) -1)
+(num-test (ash (ash 1 31) -31) 1)
(do ((i 0 (+ i 1)))
((= i 15))
@@ -42148,6 +47394,24 @@
(num-test (ash 1 32) 4294967296)
(num-test (ash 1 (- (expt 2 32))) 0)
(test (> (ash 1 62) 1) #t)
+(num-test (ash -1 -3) -1)
+(num-test (ash -31 -20) -1)
+(num-test (ash -31 -60) -1)
+(num-test (ash -31 -70) -1)
+(num-test (ash -31 -100) -1)
+(num-test (ash -31 most-negative-fixnum) -1)
+
+(test (ash 1 (expt 2 32)) 'error)
+(test (ash) 'error)
+(test (ash 1) 'error)
+(test (ash 1 2 3) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (ash 1 arg) 'error)
+ (test (ash arg 1) 'error))
+ (list #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
(num-test (integer-length 0) 0)
(num-test (integer-length 1) 1)
@@ -42178,6 +47442,88 @@
(num-test (integer-length -128) 7)
(num-test (integer-length -129) 8)
+(test (integer-length) 'error)
+(test (integer-length 1 2) 'error)
+
+
+(test (integer-decode-float) 'error)
+(test (integer-decode-float 0.0) '(0 0 1))
+(test (integer-decode-float -0.0) '(0 0 1))
+(test (integer-decode-float 1.0) '(4503599627370496 -52 1))
+(test (integer-decode-float -1.0) '(4503599627370496 -52 -1))
+(test (integer-decode-float 0.2) '(7205759403792794 -55 1))
+(test (integer-decode-float -0.2) '(7205759403792794 -55 -1))
+(test (integer-decode-float 3.0) '(6755399441055744 -51 1))
+(test (integer-decode-float -3.0) '(6755399441055744 -51 -1))
+(test (integer-decode-float 0.04) '(5764607523034235 -57 1))
+(test (integer-decode-float -0.04) '(5764607523034235 -57 -1))
+(test (integer-decode-float 50.0) '(7036874417766400 -47 1))
+(test (integer-decode-float -50.0) '(7036874417766400 -47 -1))
+(test (integer-decode-float 0.006) '(6917529027641082 -60 1))
+(test (integer-decode-float -0.006) '(6917529027641082 -60 -1))
+(test (integer-decode-float 7000.0) '(7696581394432000 -40 1))
+(test (integer-decode-float -7000.0) '(7696581394432000 -40 -1))
+(test (integer-decode-float 0.0008) '(7378697629483821 -63 1))
+(test (integer-decode-float -0.0008) '(7378697629483821 -63 -1))
+(test (integer-decode-float 90000.0) '(6184752906240000 -36 1))
+(test (integer-decode-float -90000.0) '(6184752906240000 -36 -1))
+(test (integer-decode-float 0.00001) '(5902958103587057 -69 1))
+(test (integer-decode-float 1.0d-6) '(4722366482869645 -72 1))
+(test (integer-decode-float 1.0d-8) '(6044629098073146 -79 1))
+(test (integer-decode-float 1.0d-12) '(4951760157141521 -92 1))
+(test (integer-decode-float 1.0d-16) '(8112963841460668 -106 1))
+(test (integer-decode-float 1.0d-17) '(6490371073168535 -109 1))
+(test (integer-decode-float 1.0d-18) '(5192296858534828 -112 1))
+(test (integer-decode-float 1.0d-19) '(8307674973655724 -116 1))
+(test (integer-decode-float 1.0d-25) '(8711228593176025 -136 1))
+(test (integer-decode-float 1.0d6) '(8589934592000000 -33 1))
+(test (integer-decode-float 1.0d12) '(8192000000000000 -13 1))
+(test (integer-decode-float 1.0d17) '(6250000000000000 4 1))
+(test (integer-decode-float 1.0d18) '(7812500000000000 7 1))
+(test (integer-decode-float 1.0d19) '(4882812500000000 11 1))
+(test (integer-decode-float 1.0d20) '(6103515625000000 14 1))
+(test (integer-decode-float 1.0d-100) '(7880401239278896 -385 1))
+(test (integer-decode-float 1.0d100) '(5147557589468029 280 1))
+(test (integer-decode-float 1.0d200) '(5883593420661338 612 1))
+(test (integer-decode-float 1.0d-200) '(6894565328877484 -717 1))
+(test (integer-decode-float 1.0d307) '(8016673440035891 967 1))
+
+(let ((val (integer-decode-float 1.0d-307)))
+ (if (and (not (equal? val '(5060056332682765 -1072 1)))
+ (not (equal? val '(5060056332682766 -1072 1))))
+ (format #t "(integer-decode-float 1.0d-307) got ~A?~%" val)))
+
+(test (integer-decode-float (/ 1.0d-307 100.0d0)) '(4706001880677807 -1075 1)) ; denormal
+(test (integer-decode-float (/ (log 0.0))) '(6755399441055744 972 -1)) ; nan
+(test (integer-decode-float (- (real-part (log 0.0)))) '(4503599627370496 972 1)) ; +inf
+(test (integer-decode-float (real-part (log 0.0))) '(4503599627370496 972 -1)) ; -inf
+(if (provided? 'gmp)
+ (test (integer-decode-float 2.225e-308) '(9007049763458157 -1075 1))
+ (test (integer-decode-float 2.225e-308) '(9007049763458133 -1075 1)))
+(test (integer-decode-float 1.797e308) '(9003726357340310 971 1))
+(test (integer-decode-float 1.0e-322) '(4503599627370516 -1075 1))
+(test (integer-decode-float (expt 2.0 31)) (list #x10000000000000 -21 1))
+(test (integer-decode-float (expt 2.0 52)) (list #x10000000000000 0 1))
+(test (integer-decode-float 1d23) '(5960464477539062 24 1))
+
+(for-each
+ (lambda (arg)
+ (test (integer-decode-float arg) 'error))
+ (list -1 0 #\a '#(1 2 3) 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+(test (integer-decode-float 1.0 1.0) 'error)
+
+(do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((val (- 1.0e6 (random 2.0e6))))
+ (let* ((data (integer-decode-float val))
+ (signif (car data))
+ (expon (cadr data))
+ (sign (caddr data)))
+ (num-test (* sign signif (expt 2.0 expon)) val))))
+
+
+
+
(if with-bignums
(begin
(num-test (logand (+ (expt 2 48) (expt 2 46)) (expt 2 48)) 281474976710656)
@@ -42200,40 +47546,44 @@
(num-test (ash 1267650600228229401496703205376 -100) 1)
))
-(if (defined? 'most-positive-fixnum)
- (begin
- (test (> 0 most-negative-fixnum) #t)
- (test (> most-negative-fixnum 0) #f)
- (test (> most-positive-fixnum 0) #t)
- (test (> 0 most-positive-fixnum) #f)
- (test (> most-positive-fixnum most-negative-fixnum) #t)
- (test (> most-negative-fixnum most-positive-fixnum) #f)
- (test (< 0 most-negative-fixnum) #f)
- (test (< most-negative-fixnum 0) #t)
- (test (< most-positive-fixnum 0) #f)
- (test (< 0 most-positive-fixnum) #t)
- (test (< most-positive-fixnum most-negative-fixnum) #f)
- (test (< most-negative-fixnum most-positive-fixnum) #t)
- (test (negative? most-negative-fixnum) #t)
- (test (positive? most-negative-fixnum) #f)
- (test (zero? most-negative-fixnum) #f)
- (test (zero? most-positive-fixnum) #f)
- (test (negative? most-positive-fixnum) #f)
- (test (positive? most-positive-fixnum) #t)
- (test (= (+ most-negative-fixnum 1) (- most-positive-fixnum)) #t)
- (test (= (abs (+ most-negative-fixnum 1)) most-positive-fixnum) #t)
- (test (= (+ most-negative-fixnum most-positive-fixnum) -1) #t)
- (test (= (- most-negative-fixnum (- most-positive-fixnum)) -1) #t)
- (test (even? most-positive-fixnum) #f)
- (test (odd? most-positive-fixnum) #t)
- (test (even? most-negative-fixnum) #t)
- (test (odd? most-negative-fixnum) #f)
- (test (integer? most-negative-fixnum) #t)
- (test (= (* most-positive-fixnum -1) (+ most-negative-fixnum 1)) #t)
- (test (= (* most-negative-fixnum 1) (- (* -1 most-positive-fixnum) 1)) #t)
- (if with-bignums
- (test (= most-positive-fixnum (- (/ most-negative-fixnum -1) 1)) #t))
- ))
+(test (> 0 most-negative-fixnum) #t)
+(test (> most-negative-fixnum 0) #f)
+(test (> most-positive-fixnum 0) #t)
+(test (> 0 most-positive-fixnum) #f)
+(test (> most-positive-fixnum most-negative-fixnum) #t)
+(test (> most-negative-fixnum most-positive-fixnum) #f)
+(test (< 0 most-negative-fixnum) #f)
+(test (< most-negative-fixnum 0) #t)
+(test (< most-positive-fixnum 0) #f)
+(test (< 0 most-positive-fixnum) #t)
+(test (< most-positive-fixnum most-negative-fixnum) #f)
+(test (< most-negative-fixnum most-positive-fixnum) #t)
+(test (negative? most-negative-fixnum) #t)
+(test (positive? most-negative-fixnum) #f)
+(test (zero? most-negative-fixnum) #f)
+(test (zero? most-positive-fixnum) #f)
+(test (negative? most-positive-fixnum) #f)
+(test (positive? most-positive-fixnum) #t)
+(test (= (+ most-negative-fixnum 1) (- most-positive-fixnum)) #t)
+(test (= (abs (+ most-negative-fixnum 1)) most-positive-fixnum) #t)
+(test (= (+ most-negative-fixnum most-positive-fixnum) -1) #t)
+(test (= (- most-negative-fixnum (- most-positive-fixnum)) -1) #t)
+(test (even? most-positive-fixnum) #f)
+(test (odd? most-positive-fixnum) #t)
+(test (even? most-negative-fixnum) #t)
+(test (odd? most-negative-fixnum) #f)
+(test (integer? most-negative-fixnum) #t)
+(test (= (* most-positive-fixnum -1) (+ most-negative-fixnum 1)) #t)
+(test (= (* most-negative-fixnum 1) (- (* -1 most-positive-fixnum) 1)) #t)
+(if with-bignums
+ (test (= most-positive-fixnum (- (/ most-negative-fixnum -1) 1)) #t))
+(test (/ most-positive-fixnum most-positive-fixnum) 1)
+(test (/ -9223372036854775808 -9223372036854775808) 1)
+(test (+ -9223372036854775808 9223372036854775807) -1)
+(test (/ -9223372036854775808 9223372036854775807) -9223372036854775808/9223372036854775807)
+(test (abs most-positive-fixnum) most-positive-fixnum)
+(test (floor most-positive-fixnum) most-positive-fixnum)
+(test (floor most-negative-fixnum) most-negative-fixnum)
(let ()
(define (2^n? x) (zero? (logand x (- x 1))))
@@ -42246,10 +47596,14 @@
(define-macro (<=> x y) `(begin (set! ,x (logxor ,x ,y)) (set! ,y (logxor ,y ,x)) (set! ,x (logxor ,x ,y))))
(test (2^n? 32) #t)
+ (test (2^n? 2305843009213693952) #t)
+ (test (2^n? 2305843009213693950) #f)
(test (2^n? 17) #f)
(test (2^n? 1) #t)
(test (2^n-1? 31) #t)
(test (2^n-1? 32) #f)
+ (test (2^n-1? 18014398509481985) #f)
+ (test (2^n-1? 18014398509481983) #t)
(test (x+y 41 3) 44)
(test (0? 0) #t)
(test (0? 123) #f)
@@ -42262,804 +47616,6 @@
)
-
-
-;;; -------------------------------- errors ------------------------------------------------
-
-
-(test (+ #| this is a comment |# 2 #! and this is another !# 3) 5)
-
-(test (eq?) 'error)
-(test (eq? #t) 'error)
-(test (eq? #t #t #t) 'error)
-(test (eq? #f . 1) 'error)
-(test (eqv?) 'error)
-(test (eqv? #t) 'error)
-(test (eqv? #t #t #t) 'error)
-(test (equal?) 'error)
-(test (equal? #t) 'error)
-(test (equal? #t #t #t) 'error)
-(test (boolean?) 'error)
-(test (boolean? #f #t) 'error)
-(test (not) 'error)
-(test (not #f #t) 'error)
-(test (symbol?) 'error)
-(test (procedure?) 'error)
-(test (char?) 'error)
- ;(test (char? '#\xxx) 'error) ; or possibly #f??
-(test (char-upper-case? 1) 'error)
-(test (char-upper-case?) 'error)
-(test (char-upper-case? 1) 'error)
-(test (char-upper-case?) 'error)
-(test (char-upcase) 'error)
-(test (char-downcase) 'error)
-(test (char-numeric?) 'error)
-(test (char-whitespace?) 'error)
-(test (char-alphabetic?) 'error)
-
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (test (op arg) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
- (list char-upper-case? char-lower-case? char-upcase char-downcase char-numeric? char-whitespace? char-alphabetic?))
-
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (test (op #\a arg) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
- (list char=? char<? char<=? char>? char>? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
-
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (test (op arg #\a) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
- (list char=? char<? char<=? char>? char>? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
-
-(test (char=? #\a) 'error)
-(test (char=?) 'error)
-(test (char<?) 'error)
-
-(test (char<? #\b #\a "hi") 'error)
-(test (char<? #\b #\a 0) 'error)
-(test (char<=? #\b #\a "hi") 'error)
-(test (char<=? #\b #\a 0) 'error)
-(test (char>? #\a #\b "hi") 'error)
-(test (char>? #\a #\b 0) 'error)
-(test (char>=? #\a #\b "hi") 'error)
-(test (char>=? #\a #\b 0) 'error)
-(test (char-ci<? #\b #\a "hi") 'error)
-(test (char-ci<? #\b #\a 0) 'error)
-(test (char-ci>? #\a #\b "hi") 'error)
-(test (char-ci>? #\a #\b 0) 'error)
-(test (char-ci<=? #\b #\a "hi") 'error)
-(test (char-ci<=? #\b #\a 0) 'error)
-(test (char-ci>=? #\a #\b "hi") 'error)
-(test (char-ci>=? #\a #\b 0) 'error)
-
-(test (char<=?) 'error)
-(test (char>?) 'error)
-(test (char>=?) 'error)
-(test (char-ci=?) 'error)
-(test (char->integer 33) 'error)
-(test (char->integer) 'error)
-(test (integer->char) 'error)
-(test (integer->char (expt 2 31)) 'error)
-(test (integer->char (expt 2 32)) 'error)
-
-(for-each
- (lambda (arg)
- (test (char->integer arg) 'error))
- (list -1 1 0 123456789 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (integer->char arg) 'error))
- (list -1 123456789 -123456789 #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-
- ;(test (string? "das ist die eine haelfte" "und das die andere") 'error)
-(test (string?) 'error)
-
-(test (string=? "foo" "FOO" 1.0) 'error)
-(test (string<? "foo" "fo" 1.0) 'error)
-(test (string>? "foo" "fooo" 1.0) 'error)
-(test (string<=? "foo" "fo" 1.0) 'error)
-(test (string>=? "fo" "foo" 1.0) 'error)
-(test (string-ci=? "foo" "GOO" 1.0) 'error)
-(test (string-ci<? "foo" "fo" 1.0) 'error)
-(test (string-ci>? "foo" "fooo" 1.0) 'error)
-(test (string-ci<=? "fOo" "fo" 1.0) 'error)
-(test (string-ci>=? "fo" "foo" 1.0) 'error)
-
-(for-each
- (lambda (arg)
- (test (string=? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string<? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string>? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string<=? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string>=? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-ci=? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-
-(for-each
- (lambda (arg)
- (test (string-ci<? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-ci>? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-ci<=? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-ci>=? "hi" arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-length arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string #\a arg) 'error))
- (list '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (make-string -1) 'error)
-
-(for-each
- (lambda (arg)
- (test (make-string 3 arg) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (make-string arg #\a) 'error))
- (list #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (make-string arg) 'error))
- (list #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (string-ref "abcdef-dg1ndh" 20) 'error)
-(test (string-ref "abcdef-dg1ndh") 'error)
-(test (string-ref "abcdef-dg1ndh" -3) 'error)
-(test (string-ref) 'error)
-(test (string-ref 2) 'error)
-(test (string-ref "\"\\\"" 3) 'error)
-(test (string-ref "" 0) 'error)
-(test (string-ref "" 1) 'error)
-(test (string-ref "hiho" (expt 2 32)) 'error)
-(test (string-set! "hiho" (expt 2 32) #\a) 'error)
-
-(for-each
- (lambda (arg)
- (test (string-ref arg 0) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-ref "hiho" arg) 'error))
- (list #\a -1 123 4 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (let ((hi (string-copy "hi"))) (string-set! hi 2 #\H) hi) 'error)
-(test (let ((hi (string-copy "hi"))) (string-set! hi -1 #\H) hi) 'error)
-(if with-immutable-constants (test (let ((g (lambda () "***"))) (string-set! (g) 0 #\?)) 'error))
-(test (string-set! "" 0 #\a) 'error)
-(test (string-set! "" 1 #\a) 'error)
-(test (string-set! (string) 0 #\a) 'error)
-(if with-immutable-constants (test (string-set! (symbol->string 'lambda) 0 #\a) 'error))
-(test (let ((ho (make-string 0 #\x))) (string-set! ho 0 #\a) ho) 'error)
-
-(for-each
- (lambda (arg)
- (test (string-set! arg 0 #\a) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-set! "hiho" arg #\a) 'error))
- (list #\a -1 123 4 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-set! "hiho" 0 arg) 'error))
- (list 1 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(if with-immutable-constants (begin
-(test (string-fill! "" #\a) 'error)
-(test (string-fill! "hiho" #\a) 'error)
-(test (let ((g (lambda () "***"))) (string-fill! (g) #\?)) 'error)
-))
-
-(test (substring "ab" 0 3) 'error)
-(test (substring "ab" 3 3) 'error)
-(test (substring "ab" 2 3) 'error)
-(test (substring "" 0 1) 'error)
-(test (substring "" -1 0) 'error)
-(test (substring "abc" -1 0) 'error)
-(test (substring "hiho" (expt 2 32) (+ 2 (expt 2 32))) 'error)
-
-(for-each
- (lambda (arg)
- (test (substring "hiho" arg 0) 'error))
- (list "hi" #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (substring "hiho" 1 arg) 'error))
- (list "hi" #\a 0 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (substring arg 1 2) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-append "hiho" arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (string-append '()) 'error)
-(test (string '()) 'error)
-
-(for-each
- (lambda (arg)
- (test (let ((hiho "hiho")) (string-fill! hiho arg) hiho) 'error))
- (list 1 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-fill! arg #\a) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string-copy arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string->list arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->string x)) 'error)
-
-(for-each
- (lambda (arg)
- (test (list->string arg) 'error))
- (list "hi" #\a 1 ''foo '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (symbol->string arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (string->symbol arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-
-
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (let ((result (catch #t (lambda () (op arg)) (lambda args 'error))))
- (if (not (eq? result 'error))
- (begin
- (display "(") (display op) (display " ") (display arg) (display ") returned ") (display result) (display "?") (newline)))))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
-
- (list reverse cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar
- caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar
- assq assv assoc memq memv member list-ref list-tail))
-
-(for-each
- (lambda (arg)
- (test (length arg) 'error))
- (list (integer->char 65) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (cons 1 . 2) 'error)
- ; (test '(1 . 2 . 3) 'error) ; gets reader error which is inconvenient
-(test (car (list)) 'error)
-(test (car '()) 'error)
-(test (cdr (list)) 'error)
-(test (cdr '()) 'error)
-(test (caddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
-(test (cdddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
-(test (caar '(a b c d e f g)) 'error)
-(test (cdar '(a b c d e f g)) 'error)
-(test (caaar '(a b c d e f g)) 'error)
-(test (caadr '(a b c d e f g)) 'error)
-(test (cadar '(a b c d e f g)) 'error)
-(test (cdaar '(a b c d e f g)) 'error)
-(test (cdadr '(a b c d e f g)) 'error)
-(test (cddar '(a b c d e f g)) 'error)
-(test (caaaar '(a b c d e f g)) 'error)
-(test (caaadr '(a b c d e f g)) 'error)
-(test (caadar '(a b c d e f g)) 'error)
-(test (caaddr '(a b c d e f g)) 'error)
-(test (cadaar '(a b c d e f g)) 'error)
-(test (cadadr '(a b c d e f g)) 'error)
-(test (caddar '(a b c d e f g)) 'error)
-(test (cdaaar '(a b c d e f g)) 'error)
-(test (cdaadr '(a b c d e f g)) 'error)
-(test (cdadar '(a b c d e f g)) 'error)
-(test (cdaddr '(a b c d e f g)) 'error)
-(test (cddaar '(a b c d e f g)) 'error)
-(test (cddadr '(a b c d e f g)) 'error)
-(test (cdddar '(a b c d e f g)) 'error)
-(test (caar 'a) 'error)
-(test (caar '(a)) 'error)
-(test (cadr 'a) 'error)
-(test (cadr '(a . b)) 'error)
-(test (cdar 'a) 'error)
-(test (cdar '(a . b)) 'error)
-(test (cddr 'a) 'error)
-(test (cddr '(a . b)) 'error)
-(test (caaar 'a) 'error)
-(test (caaar '(a)) 'error)
-(test (caaar '((a))) 'error)
-(test (caadr 'a) 'error)
-(test (caadr '(a . b)) 'error)
-(test (caadr '(a b)) 'error)
-(test (cadar 'a) 'error)
-(test (cadar '(a . b)) 'error)
-(test (cadar '((a . c) . b)) 'error)
-(test (caddr 'a) 'error)
-(test (caddr '(a . b)) 'error)
-(test (caddr '(a c . b)) 'error)
-(test (cdaar 'a) 'error)
-(test (cdaar '(a)) 'error)
-(test (cdaar '((a . b))) 'error)
-(test (cdadr 'a) 'error)
-(test (cdadr '(a . b)) 'error)
-(test (cdadr '(a b . c)) 'error)
-(test (cddar 'a) 'error)
-(test (cddar '(a . b)) 'error)
-(test (cddar '((a . b) . b)) 'error)
-(test (cdddr 'a) 'error)
-(test (cdddr '(a . b)) 'error)
-(test (cdddr '(a c . b)) 'error)
-(test (caaaar 'a) 'error)
-(test (caaaar '(a)) 'error)
-(test (caaaar '((a))) 'error)
-(test (caaaar '(((a)))) 'error)
-(test (caaadr 'a) 'error)
-(test (caaadr '(a . b)) 'error)
-(test (caaadr '(a b)) 'error)
-(test (caaadr '(a (b))) 'error)
-(test (caadar 'a) 'error)
-(test (caadar '(a . b)) 'error)
-(test (caadar '((a . c) . b)) 'error)
-(test (caadar '((a c) . b)) 'error)
-(test (caaddr 'a) 'error)
-(test (caaddr '(a . b)) 'error)
-(test (caaddr '(a c . b)) 'error)
-(test (caaddr '(a c b)) 'error)
-(test (cadaar 'a) 'error)
-(test (cadaar '(a)) 'error)
-(test (cadaar '((a . b))) 'error)
-(test (cadaar '((a b))) 'error)
-(test (cadadr 'a) 'error)
-(test (cadadr '(a . b)) 'error)
-(test (cadadr '(a b . c)) 'error)
-(test (cadadr '(a (b . e) . c)) 'error)
-(test (caddar 'a) 'error)
-(test (caddar '(a . b)) 'error)
-(test (caddar '((a . b) . b)) 'error)
-(test (caddar '((a b . c) . b)) 'error)
-(test (cadddr 'a) 'error)
-(test (cadddr '(a . b)) 'error)
-(test (cadddr '(a c . b)) 'error)
-(test (cadddr '(a c e . b)) 'error)
-(test (cdaaar 'a) 'error)
-(test (cdaaar '(a)) 'error)
-(test (cdaaar '((a))) 'error)
-(test (cdaaar '(((a . b)))) 'error)
-(test (cdaadr 'a) 'error)
-(test (cdaadr '(a . b)) 'error)
-(test (cdaadr '(a b)) 'error)
-(test (cdaadr '(a (b . c))) 'error)
-(test (cdadar 'a) 'error)
-(test (cdadar '(a . b)) 'error)
-(test (cdadar '((a . c) . b)) 'error)
-(test (cdadar '((a c . d) . b)) 'error)
-(test (cdaddr 'a) 'error)
-(test (cdaddr '(a . b)) 'error)
-(test (cdaddr '(a c . b)) 'error)
-(test (cdaddr '(a c b . d)) 'error)
-(test (cddaar 'a) 'error)
-(test (cddaar '(a)) 'error)
-(test (cddaar '((a . b))) 'error)
-(test (cddaar '((a b))) 'error)
-(test (cddadr 'a) 'error)
-(test (cddadr '(a . b)) 'error)
-(test (cddadr '(a b . c)) 'error)
-(test (cddadr '(a (b . e) . c)) 'error)
-(test (cdddar 'a) 'error)
-(test (cdddar '(a . b)) 'error)
-(test (cdddar '((a . b) . b)) 'error)
-(test (cdddar '((a b . c) . b)) 'error)
-(test (cddddr 'a) 'error)
-(test (cddddr '(a . b)) 'error)
-(test (cddddr '(a c . b)) 'error)
-(test (cddddr '(a c e . b)) 'error)
-
-(test (length 'x) 'error)
-(test (length (cons 1 2)) 'error)
-(let ((x (list 1 2)))
- (set-cdr! x x)
- (test (length x) 'error))
-(test (length '(1 2 . 3)) 'error)
-
-(test (reverse (cons 1 2)) 'error)
-(test (reverse '(1 . 2)) 'error)
-(test (reverse '(1 2 . 3)) 'error)
-
-(test (reverse! '(1 . 2)) 'error)
-(test (reverse! (cons 1 2)) 'error)
-(test (reverse! (cons 1 (cons 2 3))) 'error)
-
-(test (set-car! '() 32) 'error)
-(test (set-car! () 32) 'error)
-(test (set-car! (list) 32) 'error)
-(test (set-car! 'x 32) 'error)
-(test (set-car! #f 32) 'error)
-(test (set-cdr! '() 32) 'error)
-(test (set-cdr! () 32) 'error)
-(test (set-cdr! (list) 32) 'error)
-(test (set-cdr! 'x 32) 'error)
-(test (set-cdr! #f 32) 'error)
-
-(test (list-ref '() 0) 'error)
-(test (list-ref (list 1 2) 2) 'error)
-(test (list-ref (list 1 2) -1) 'error)
-(test (list-ref (list 1 2) 1.3) 'error)
-(test (list-ref (list 1 2) 1/3) 'error)
-(test (list-ref (list 1 2) 1+2.0i) 'error)
-(test (list-ref (cons 1 2) 1) 'error)
-(test (list-ref (cons 1 2) 2) 'error)
-(test (list-ref (list 1 2 3) (expt 2 32)) 'error)
-(test (list-set! (list 1 2 3) (expt 2 32) 0) 'error)
-
-(for-each
- (lambda (arg)
- (test (list-ref (list 1 2) arg) 'error))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (list-set! '() 0 1) 'error)
-(test (list-set! '(1) 1 2) 'error)
-(test (list-set! '(1 2 3) -1 2) 'error)
-(test (list-set! '(1) 1.5 2) 'error)
-(test (list-set! '(1) 3/2 2) 'error)
-(test (list-set! '(1) 1+3i 2) 'error)
-(test (let ((x (cons 1 2))) (list-set! x 1 3) x) 'error)
-
-(for-each
- (lambda (arg)
- (test (list-set! (list 1 2) arg arg) 'error))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (list 1 2 . 3) 'error)
-(test (list 1 2 , 3) 'error)
-(test (list 1 2 ,@ 3) 'error)
-
-(test (list-tail (list 1 2) 3) 'error)
-(test (list-tail (list 1 2) -1) 'error)
-(test (list-tail (list 1 2) 1.3) 'error)
-(test (list-tail (list 1 2) 1/3) 'error)
-(test (list-tail (list 1 2) 1+2.0i) 'error)
-(test (list-tail (cons 1 2) 2) 'error)
-(test (list-tail '(1 2 . 3)) 'error)
-(test (list-tail (list 1 2 3) (+ 1 (expt 2 32))) 'error)
-
-(for-each
- (lambda (arg)
- (test (list-tail (list 1 2) arg) 'error))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
-
-
-(test (assq #f '(#f 2 . 3)) 'error)
-(test (assq #f '((#f 2) . 3)) 'error) ; an a-list is a proper list sez kd
-(test (assv 1 '(1 2 . 3)) 'error)
-(test (assv 1 '((1 2) . 3)) 'error) ; an a-list is a proper list sez kd
-
-(test (assoc '() 1) 'error)
-(test (assoc (cons 1 2) 1) 'error)
-(test (assoc (let ((x (cons 1 2))) (set-cdr! x x)) 1) 'error)
-(test (assoc '((1 2) .3) 1) 'error)
-(test (assoc ''foo quote) 'error)
-(test (assoc 1 '(1 2 . 3)) 'error)
-(test (assoc 1 '((1 2) . 3)) 'error) ; an a-list is a proper list sez kd
-
- ;(test (let ((lst '((1 2)))) (assq #t (reverse! lst lst))) #f)
-
-
-(test (append 'a 'b) 'error)
-(test (append 'a '()) 'error)
-(test (append (cons 1 2) '()) 'error)
-(test (append '(1) 2 '(3)) 'error)
-(test (append '(1) 2 3) 'error)
-
- ;(test (memq 'a (cons a b)) 'error) ; there is disagreement about this
-(test (memq 'a (list a b . c)) 'error)
- ;(test (memv 1 (cons 1 2)) 'error) ; there is disagreement about this
-(test (memv 'a (list a b . c)) 'error)
- ;(test (member 1 (cons 1 2)) 'error) ; there is disagreement about this
-(test (member 'a (list a b . c)) 'error)
-(test (member 1 '(1 2 . 3)) 'error)
-
-(test (make-vector) 'error)
-
-(for-each
- (lambda (arg)
- (test (make-vector arg) 'error))
- (list #\a '() -1 #f "hi" 'a-symbol abs 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (vector->list arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol "hi" abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->vector x)) 'error)
-(test (list->vector (cons 1 2)) 'error)
-(test (list->vector '(1 2 . 3)) 'error)
-
-(for-each
- (lambda (arg)
- (test (list->vector arg) 'error))
- (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(for-each
- (lambda (arg)
- (test (vector-length arg) 'error))
- (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (let ((v (make-vector 1 0))) (vector-ref v 1)) 'error)
-(test (let ((v (make-vector 1 0))) (vector-ref v -1)) 'error)
-(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 3)) 'error)
-(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 3) 0)) 'error)
-(test (vector-ref (vector) 0) 'error)
-(test (vector-ref '#() 0) 'error)
-(test (vector-ref '#() -1) 'error)
-(test (vector-ref '#() 1) 'error)
-
- ;(test (vector-set! '#(0 1 2) 1 "doe") 'error)
-(test (let ((v (vector 1 2 3))) (vector-set! v -1 0)) 'error)
-(test (let ((v (vector 1 2 3))) (vector-set! v 3 0)) 'error)
-(if with-immutable-constants (test (vector-set! '#(1 2) 0 2) 'error))
-(if with-immutable-constants (test (vector-fill! '#(1 2) 2) 'error))
-
-(let ((v (vector 1 2 3)))
- (for-each
- (lambda (arg)
- (test (vector-set! v arg 0) 'error))
- (list "hi" #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (make-vector 3) (lambda (a) (+ a 1)))))
-
-(for-each
- (lambda (arg)
- (test (vector-set! arg 0 0) 'error))
- (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-(let ((v (vector)))
- (test (vector-set! v 0 0) 'error)
- (test (vector-set! v 1 0) 'error)
- (test (vector-set! v -1 0) 'error))
-(test (vector-set! #() 0 123) 'error)
-(if with-immutable-constants (test (vector-set! #(1 2 3) 0 123) 'error))
-
-(if with-immutable-constants (begin
-(test (let ((g (lambda () '#(1 2 3)))) (vector-set! (g) 0 #\?) (g)) 'error) ; not an error in Guile
- ;(test (let ((g (lambda () '(1 . 2)))) (set-car! (g) 123) (g)) 'error) ; should this also be an error?
- ;(test (let ((g (lambda () '(1 2)))) (list-set! (g) 0 123) (g)) 'error)
-(test (let ((g (lambda () (symbol->string 'hi)))) (string-set! (g) 1 #\a) (symbol->string 'hi)) 'error)
-))
-
-(for-each
- (lambda (arg)
- (test (vector-fill! arg 0) 'error))
- (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
-
-
-
-(for-each
- (lambda (arg)
- (test (string->number arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
-(for-each
- (lambda (arg)
- (test (string->number "123" arg) 'error)
- (test (string->number "1" arg) 'error))
- (list -1 0 1 #\a '#(1 2 3) 3.14 3/4 1.5+0.3i 1+i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
-;; (string->number "0" 1) ?? why not?
-
-(for-each
- (lambda (arg)
- (test (number->string arg) 'error))
- (list #\a '#(1 2 3) '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
-(for-each
- (lambda (arg)
- (test (number->string 123 arg) 'error))
- (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
-(test (exact?) 'error)
-(test (exact? "hi") 'error)
-(test (exact? 1.0+23.0i 1.0+23.0i) 'error)
-(test (inexact?) 'error)
-(test (inexact? "hi") 'error)
-(test (inexact? 1.0+23.0i 1.0+23.0i) 'error)
-(test (/) 'error)
-(test (/ "hi") 'error)
-(test (zero?) 'error)
-(test (zero? "hi") 'error)
-(test (zero? 1.0+23.0i 1.0+23.0i) 'error)
-(test (positive?) 'error)
-(test (positive? 1.23+1.0i) 'error)
-(test (positive? 1.23 1.23) 'error)
-(test (negative?) 'error)
-(test (negative? 1.23+1.0i) 'error)
-(test (negative? 1.23 1.23) 'error)
-(test (even?) 'error)
-(test (even? 1.23) 'error)
-(test (even? 123 123) 'error)
-(test (odd?) 'error)
-(test (odd? 1.23) 'error)
-(test (odd? 123 123) 'error)
-(test (quotient) 'error)
-(test (quotient 123) 'error)
-(test (quotient 123 123 123) 'error)
-(test (remainder) 'error)
-(test (remainder 123) 'error)
-(test (remainder 123 123 123) 'error)
-(test (modulo) 'error)
-(test (modulo 123) 'error)
-(test (modulo 123 123 123) 'error)
-(test (truncate) 'error)
-(test (truncate 1.23+1.0i) 'error)
-(test (floor) 'error)
-(test (floor 1.23+1.0i) 'error)
-(test (floor 1.23 1.23) 'error)
-(test (ceiling) 'error)
-(test (ceiling 1.23+1.0i) 'error)
-(test (ceiling 1.23 1.23) 'error)
-(test (round) 'error)
-(test (round 1.23+1.0i) 'error)
-(test (round 1.23 1.23) 'error)
-(test (abs) 'error)
-(test (abs 1.23+1.0i) 'error)
-(test (abs 1.23 1.23) 'error)
-(test (max) 'error)
-(test (max 1.23+1.0i) 'error)
-(test (min) 'error)
-(test (min 1.23+1.0i) 'error)
-(test (expt) 'error)
-(test (expt 1.0+23.0i) 'error)
-(test (expt "hi" "hi") 'error)
-(test (expt 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
-
-(test (expt 0 -1) 'error)
-(test (expt 0.0 -1.0) 'error)
-
-(test (expt 0 -1.0) 'error)
- ; (test (expt 0 -1.0+i) 'error)
- ; (test (expt 0 0-i) 0.0) ; sbcl and clisp say division by 0 here
-(test (expt 0 -255) 'error)
-(test (expt 0 (- (expt 2 32))) 'error)
-
-(test (exact->inexact) 'error)
-(test (exact->inexact "hi") 'error)
-(test (exact->inexact 1.0+23.0i 1.0+23.0i) 'error)
-(test (inexact->exact) 'error)
-(test (inexact->exact "hi") 'error)
-(test (inexact->exact 1.0+23.0i 1.0+23.0i) 'error)
-
-(test (rationalize) 'error)
-(test (rationalize 1.23+1.0i 1.23+1.0i) 'error)
-(test (rationalize 1.23 1.23 1.23) 'error)
-
-(test (numerator) 'error)
-(test (numerator 1.23+1.0i) 'error)
-(test (numerator 1.23 1.23) 'error)
-(test (denominator) 'error)
-(test (denominator 1.23+1.0i) 'error)
-(test (denominator 1.23 1.23) 'error)
-(test (imag-part) 'error)
-(test (imag-part "hi") 'error)
-(test (imag-part 1.0+23.0i 1.0+23.0i) 'error)
-(test (real-part) 'error)
-(test (real-part "hi") 'error)
-(test (real-part 1.0+23.0i 1.0+23.0i) 'error)
-(test (magnitude) 'error)
-(test (magnitude "hi") 'error)
-(test (magnitude 1.0+23.0i 1.0+23.0i) 'error)
-(test (angle) 'error)
-(test (angle "hi") 'error)
-(test (angle 1.0+23.0i 1.0+23.0i) 'error)
-(test (make-polar) 'error)
-(test (make-polar 1.23) 'error)
-(test (make-polar 1.23+1.0i 1.23+1.0i) 'error)
-(test (make-polar 1.23 1.23 1.23) 'error)
-(test (make-rectangular) 'error)
-(test (make-rectangular 1.23) 'error)
-(test (make-rectangular 1.23+1.0i 1.23+1.0i) 'error)
-(test (make-rectangular 1.23 1.23 1.23) 'error)
-(test (sqrt) 'error)
-(test (sqrt "hi") 'error)
-(test (sqrt 1.0+23.0i 1.0+23.0i) 'error)
-(test (exp) 'error)
-(test (exp "hi") 'error)
-(test (exp 1.0+23.0i 1.0+23.0i) 'error)
-(test (log) 'error)
-(test (log "hi") 'error)
-(test (log 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
-(test (log "hi" (expt 2 30)) 'error)
-(test (log (expt 2 30) #t) 'error)
-(test (expt #t 0) 'error)
-(test (sin) 'error)
-(test (sin "hi") 'error)
-(test (sin 1.0+23.0i 1.0+23.0i) 'error)
-(test (cos) 'error)
-(test (cos "hi") 'error)
-(test (cos 1.0+23.0i 1.0+23.0i) 'error)
-(test (tan) 'error)
-(test (tan "hi") 'error)
-(test (tan 1.0+23.0i 1.0+23.0i) 'error)
-(test (asin) 'error)
-(test (asin "hi") 'error)
-(test (asin 1.0+23.0i 1.0+23.0i) 'error)
-(test (acos) 'error)
-(test (acos "hi") 'error)
-(test (acos 1.0+23.0i 1.0+23.0i) 'error)
-(test (atan) 'error)
-(test (atan "hi") 'error)
-(test (atan 1.0+23.0i 1.0+23.0i) 'error)
-
-(test (ash 1 (expt 2 32)) 'error)
-
-(test (string->number "34.1" (+ 5 (expt 2 32))) 'error)
-(test (number->string 34.1 (+ 5 (expt 2 32))) 'error)
-
(for-each
(lambda (op)
(for-each
@@ -43077,770 +47633,7 @@
abs max min gcd lcm expt exact->inexact inexact->exact rationalize numerator denominator imag-part real-part
magnitude angle make-polar make-rectangular sqrt exp log sin cos tan asin acos atan number->string))
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg) ;(format #t "(~A ~A)~%" op arg)
- (test (op arg) 'error))
- (list (integer->char 65) 1 0 -1 (list 1) (cons 1 2) #f 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
- (list char-ready? set-current-output-port set-current-input-port set-current-error-port
- close-input-port close-output-port open-input-file open-output-file
- read-char peek-char read
- (lambda (arg) (write-char #\a arg))
- (lambda (arg) (write "hi" arg))
- (lambda (arg) (display "hi" arg))
- call-with-input-file with-input-from-file call-with-output-file with-output-to-file))
-
-
-(test (sinh) 'error)
-(test (sinh "hi") 'error)
-(test (sinh 1.0+23.0i 1.0+23.0i) 'error)
-(test (cosh) 'error)
-(test (cosh "hi") 'error)
-(test (cosh 1.0+23.0i 1.0+23.0i) 'error)
-(test (tanh) 'error)
-(test (tanh "hi") 'error)
-(test (tanh 1.0+23.0i 1.0+23.0i) 'error)
-(test (asinh) 'error)
-(test (asinh "hi") 'error)
-(test (asinh 1.0+23.0i 1.0+23.0i) 'error)
-(test (acosh) 'error)
-(test (acosh "hi") 'error)
-(test (acosh 1.0+23.0i 1.0+23.0i) 'error)
-(test (atanh) 'error)
-(test (atanh "hi") 'error)
-(test (atanh 1.0+23.0i 1.0+23.0i) 'error)
-
-
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
- (if (not (eq? val 'error))
- (begin
- (display "(") (display op) (display " ") (display arg) (display ") returned ")
- (display val) (display " but expected 'error") (newline)))))
- (list "hi" '() #\a (list 1) '(1 . 2) '#(0) #f 'a-symbol (make-vector 3) abs #t (if #f #f) (lambda (a) (+ a 1)))))
- (list cosh sinh tanh acosh asinh atanh))
-
-(for-each
- (lambda (arg)
- (test (eval-string arg) 'error))
- (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-(for-each
- (lambda (arg)
- (test (eval-string "(+ 1 2)" arg) 'error))
- (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i 'hi abs "hi" '#(()) (lambda () 1)))
-
-
-(test (string->number) 'error)
-(test (string->number 'symbol) 'error)
-(test (string->number "1.0" "1.0") 'error)
-(test (number->string) 'error)
-(test (number->string "hi") 'error)
-(test (number->string 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error)
-(test (+ 1 2 . 3) 'error)
-
-
-
-(num-test (gcd 1.4 2.3) 'error)
-(num-test (lcm 1.4 2.3) 'error)
- ;(num-test (gcd 2/3 1) 'error) ; these are ok in s7
- ;(num-test (lcm 2/3 1) 'error)
-(num-test (gcd 2 1.0+0.5i) 'error)
-(num-test (lcm 2 1.0+0.5i) 'error)
-(test (gcd 1 "hi") 'error)
-(test (lcm 0 "hi") 'error)
-(num-test (numerator 2.3+0.5i) 'error)
-(num-test (denominator 2.3+0.5i) 'error)
-
-(num-test (modulo 2.3 1.0+0.1i) 'error)
-(num-test (modulo 3.0+2.3i 3) 'error)
-(num-test (mod 2 0) 'error)
-
-(num-test (remainder 2.3 1.0+0.1i) 'error)
-(num-test (remainder 3.0+2.3i 3) 'error)
-(num-test (abs 1.0+0.1i) 'error)
-(num-test (make-polar 1.0 1.0+0.1i) 'error)
-(num-test (make-polar 1.0+0.1i 0.0) 'error)
-(num-test (make-rectangular 1.0 1.0+0.1i) 'error)
-(num-test (make-rectangular 1.0+0.1i 1.0) 'error)
-(test (>=- 1 2) 'error)
-(test (>= - 1 2) 'error)
-
-(num-test (< 0) 'error)
-(num-test (<= 0) 'error)
-(num-test (= 0) 'error)
-(num-test (> 0) 'error)
-(num-test (>= 0) 'error)
-(num-test (< 2) 'error)
-(num-test (<= 2) 'error)
-(num-test (= 2) 'error)
-(num-test (> 2) 'error)
-(num-test (>= 2) 'error)
-(num-test (< 0/1) 'error)
-(num-test (<= 0/1) 'error)
-(num-test (= 0/1) 'error)
-(num-test (> 0/1) 'error)
-(num-test (>= 0/1) 'error)
-(num-test (< 10/3) 'error)
-(num-test (<= 10/3) 'error)
-(num-test (= 10/3) 'error)
-(num-test (> 10/3) 'error)
-(num-test (>= 10/3) 'error)
-(num-test (< 0.0) 'error)
-(num-test (<= 0.0) 'error)
-(num-test (= 0.0) 'error)
-(num-test (> 0.0) 'error)
-(num-test (>= 0.0) 'error)
-(num-test (< 1.0) 'error)
-(num-test (<= 1.0) 'error)
-(num-test (= 1.0) 'error)
-(num-test (> 1.0) 'error)
-(num-test (>= 1.0) 'error)
-
-(num-test (min 0.0+0.00000001i) 'error)
-(num-test (max 0.0+0.00000001i) 'error)
-(num-test (< 0.0+0.00000001i) 'error)
-(num-test (<= 0.0+0.00000001i) 'error)
-(num-test (= 0.0+0.00000001i) 'error)
-(num-test (> 0.0+0.00000001i) 'error)
-(num-test (>= 0.0+0.00000001i) 'error)
-(num-test (min -0.0+0.00000001i) 'error)
-(num-test (max -0.0+0.00000001i) 'error)
-(num-test (min 1.0+1.0i) 'error)
-(num-test (max 1.0+1.0i) 'error)
-(num-test (< 1.0+1.0i) 'error)
-(num-test (<= 1.0+1.0i) 'error)
-(num-test (= 1.0+1.0i) 'error)
-(num-test (> 1.0+1.0i) 'error)
-(num-test (>= 1.0+1.0i) 'error)
-(num-test (min -1.0+1.0i) 'error)
-(num-test (max -1.0+1.0i) 'error)
-(num-test (min 2.71828182845905+3.14159265358979i) 'error)
-(num-test (max 2.71828182845905+3.14159265358979i) 'error)
-(num-test (< 2.71828182845905+3.14159265358979i) 'error)
-(num-test (<= 2.71828182845905+3.14159265358979i) 'error)
-(num-test (= 2.71828182845905+3.14159265358979i) 'error)
-(num-test (> 2.71828182845905+3.14159265358979i) 'error)
-(num-test (>= 2.71828182845905+3.14159265358979i) 'error)
-(num-test (min -2.71828182845905+3.14159265358979i) 'error)
-(num-test (max -2.71828182845905+3.14159265358979i) 'error)
-(num-test (min 1234000000.0+2.71828182845905i) 'error)
-(num-test (max 1234000000.0+2.71828182845905i) 'error)
-(num-test (< 1234000000.0+2.71828182845905i) 'error)
-(num-test (<= 1234000000.0+2.71828182845905i) 'error)
-(num-test (= 1234000000.0+2.71828182845905i) 'error)
-(num-test (> 1234000000.0+2.71828182845905i) 'error)
-(num-test (>= 1234000000.0+2.71828182845905i) 'error)
-(num-test (min -1234000000.0+2.71828182845905i) 'error)
-(num-test (max -1234000000.0+2.71828182845905i) 'error)
-(num-test (< 2 1 1.0+1.0i) 'error)
-(num-test (<= 2 1 1.0+1.0i) 'error)
-(num-test (> 1 2 1.0+1.0i) 'error)
-(num-test (>= 1 2 1.0+1.0i) 'error)
-
-(num-test (< 2 1 #\a) 'error)
-(num-test (<= 2 1 #\a) 'error)
-(num-test (> 1 2 #\a) 'error)
-(num-test (>= 1 2 #\a) 'error)
-
-(num-test (= 0 1 "hi") 'error)
-(num-test (= 0.0 1.0 "hi") 'error)
-(num-test (* 0 1 "hi") 'error)
-(num-test (* 0.0 "hi") 'error)
-(num-test (* 0.0+0.0i "hi") 'error)
-(num-test (* 0/1 "hi") 'error)
-(num-test (/ 0 1 "hi") 'error)
-(num-test (gcd 0 "hi") 'error)
-(num-test (lcm 0 "hi") 'error)
-(num-test (* 1 0.0 #\a) 'error)
-
-(num-test (< 3 3.0 3 3.0+1.0i) 'error)
-(num-test (> 3 3.0 3 3.0+1.0i) 'error)
-(num-test (log 3 0) 'error)
-
-(for-each
- (lambda (arg)
- (test (log 10.0 arg) 'error))
- (list "hi" #\a 0 '#(1 2 3) #t #f '() abs 'hi (list 1 2 3) '(1 . 2)))
-
-(test (quotient 3 0) 'error)
-(test (remainder 3 0) 'error)
-(test (+ 1 + 2) 'error)
-(test (+ 1 - 2) 'error)
-
-(test (+ 1 #t) 'error)
-(test (+ 1 #f) 'error)
-
-(test (/ 0) 'error)
-(test (/ -0) 'error)
-(test (/ 0.0) 'error)
-(test (/ 1.0 0) 'error)
-
-(test (logior -1 "hi") 'error)
-(test (logand 0 "hi") 'error)
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
- (if (not (equal? val 'error))
- (format #t "(~A ~A) -> ~A?~%" op arg val))))
- (list "hi" (integer->char 65) 'a-symbol (make-vector 3) 3.14 3/4 3.1+i abs #\f (lambda (a) (+ a 1)))))
- (list logior logand lognot logxor ash integer-length))
-
-(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (let ((val (catch #t (lambda () (op 1 arg)) (lambda args 'error))))
- (if (not (equal? val 'error))
- (format #t "(~A ~A) -> ~A?~%" op arg val))))
- (list "hi" (integer->char 65) 'a-symbol (make-vector 3) 3.14 -1/2 1+i abs #\f (lambda (a) (+ a 1)))))
- (list logior logand logxor lognot))
-
-(for-each
- (lambda (arg)
- (test (char-ready? arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol (make-vector 3) abs 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1))))
-
-(test (if #f) 'error)
-(test (if (< 2 3)) 'error)
-(test (if #f 1 2 3) 'error)
-(test (if 1 2 3 4) 'error)
-(test (if #f 1 else 2) 'error)
-(test (if) 'error)
-(test ('+ '1 '2) 'error)
-(test (if 1 . 2) 'error)
-(test (if 1 2 . 3) 'error)
-(test (if . 1) 'error)
-(test (if _no_var_ 1) 'error)
-
-(test (for-each (lambda (x) (display "for-each should not have called this"))) 'error)
-;(test (for-each (lambda () 1) '()) 'error)
-(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) '()) ctr) 'error)
-(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6)) ctr) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1) (list)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1) (list 1 2)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) 'error)
-(test (for-each (lambda (a b) (+ a b)) (cons 1 2) (list 1 2)) 'error)
-(test (for-each (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
-(test (for-each (lambda (a) (+ a 1)) #\a) 'error)
-(test (for-each (lambda (a) (+ a 1)) (cons 1 2)) 'error)
-(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2)) sum) 'error)
-(test (for-each (lambda (a) a) '(1 2 . 3)) 'error)
-(for-each
- (lambda (arg)
- (test (for-each arg (list 1)) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
-(for-each
- (lambda (arg)
- (test (for-each (lambda (n m) n) (list 1) arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
-
-(for-each
- (lambda (arg)
- (test (for-each (lambda (a) a) arg) 'error))
- (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t '(1 . 2)))
-
-(test (for-each abs '() abs) 'error)
-(test (for-each abs '() '#(1)) 'error)
-(test (map abs '() abs) 'error)
-
-
-(test (map (lambda (x) (display "map should not have called this"))) 'error)
-;(test (map (lambda () 1) '()) 'error)
-(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) '())) 'error)
-(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(0 1) '(2 3) '(4 5 6))) 'error)
-
-(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1) (list)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1) (list 2)) (list 3))
-(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1) (list 1 2)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) 'error)
-
-(test (map (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
-(test (map (lambda (a) (+ a 1)) #\a) 'error)
-(test (map (lambda (a) (+ a 1)) (cons 1 2)) 'error)
-(test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2)) 'error)
-(test (map (lambda (a) a) '(1 2 . 3)) 'error)
-(for-each
- (lambda (arg)
- (test (map arg (list 1)) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
-(for-each
- (lambda (arg)
- (test (map (lambda (n m) n) (list 1) arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
-
-(for-each
- (lambda (arg)
- (test (map (lambda (a) a) arg) 'error))
- (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t '(1 . 2)))
-
- ;(test (do '() ('() '())) 'error) ; ?? -- isn't this the same as before?
-(test (do '() (#t 1)) 'error)
-(test (do . 1) 'error)
-(test (do ((i i i)) (i i)) 'error)
-(test (do ((i 0 i (+ i 1))) (i i)) 'error)
-(test (do ((i)) (#t i)) 'error)
-(test (do ((i 0 (+ i 1))) #t) 'error)
-(test (do 123 (#t 1)) 'error)
-(test (do ((i 1)) (#t . 1) 1) 'error)
-(test (do ((i 1) . 1) (#t 1) 1) 'error)
-(test (do ((i 1) ()) (= i 1)) 'error)
-(test (do ((i 0 . 1)) ((= i 1)) i) 'error)
-(test (do ((i 0 (+ i 1))) ((= i 3)) (set! i "hiho")) 'error)
-(test (let ((do+ +)) (do ((i 0 (do+ i 1))) ((= i 3)) (set! do+ abs))) 'error)
-(test (do () . 1) 'error)
-(test (do ((i)) (1 2)) 'error)
-(test (do (((i))) (1 2)) 'error)
-(test (do ((i 1) ((j))) (1 2)) 'error)
-(test (do (((1))) (1 2)) 'error)
-
-
-(test (let ((a 1)) (set! a)) 'error)
-(test (let ((a 1)) (set! a 2 3)) 'error)
-(test (let ((a 1)) (set! a . 2)) 'error)
-(test (let ((a 1)) (set! a 1 . 2)) 'error)
-(test (set! "hi" 1) 'error)
-(test (set! 'a 1) 'error)
-(test (set! 1 1) 'error)
-(test (set! (list 1 2) 1) 'error)
-(test (set! (let () 'a) 1) 'error)
-(test (set!) 'error)
-(test (set! #t #f) 'error)
-(test (set! '() #f) 'error)
-(test (set! #(1 2 3) 1) 'error)
-(test (set! (call/cc (lambda (a) a)) #f) 'error)
-(test (set! 3 1) 'error)
-(test (set! 3/4 1) 'error)
-(test (set! 3.14 1) 'error)
-(test (set! #\a 12) 'error)
-(test (set! (1 2) #t) 'error)
-(test (set! _not_a_var_ 1) 'error)
-(test (set! (_not_a_pws_) 1) 'error)
-
-(test (let ((a (lambda (x) (set! a 3) x))) (list (a 1) a)) 'error)
-(test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error)
-(test (let ((a (lambda () "hi"))) (set! (a) "ho")) 'error)
-(test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error)
-(test (let ((x 1) ((y 2))) x) 'error)
-
-(test (cond) 'error)
- ;(test (cond ((= 1 2) 3) (else 4) (4 5)) 'error)
-(test (cond ((+ 1 2) => (lambda (a b) (+ a b)))) 'error)
- ;(test (cond (else)) 'error) ; value of else might be #t -- perhaps (equal? (cond (else)) else)
-(test (cond (#t => 'ok)) 'error)
-(test (cond (else =>)) 'error)
-(if with-values (test (cond ((values -1) => => abs)) 'error))
-(if with-values (test (cond ((values -1) =>)) 'error))
-(test (cond (cond (#t 1))) 'error)
-(test (cond 1) 'error)
-(test (cond (1 . 2) (else 3)) 'error)
-(test (cond (#f 2) (else . 4)) 'error)
-(if with-values (test (cond ((values 1 2) => (lambda (x y) #t))) 'error))
-(test (cond #t) 'error)
-(test (cond 1 2) 'error)
-(test (cond 1 2 3) 'error)
-(test (cond 1 2 3 4) 'error)
-(test (cond (1 => (lambda (x y) #t))) 'error)
-(test (cond . 1) 'error)
-(test (cond ((1 2)) . 3) 'error)
-(test (cond (1 => + abs)) 'error)
-(test (cond (1 =>)) 'error)
-(if with-values (test (cond ((values 1 2) => + abs)) 'error))
-
-
-(test (case 1) 'error)
-(test (case 1 . "hi") 'error)
-(test (case 1 ("hi")) 'error)
-(test (case 1 ("a" "b")) 'error)
-(test (case 1 (else #f) ((1) #t)) 'error)
-(test (case "hi" (("hi" "ho") 123) ("ha" 321)) 'error)
-(test (case) 'error)
-(test (case . 1) 'error)
-(test (case 1 . 1) 'error)
-(test (case 1 (#t #f) ((1) #t)) 'error)
-(test (case 1 (#t #f)) 'error)
-(test (case -1 ((-1) => abs)) 'error)
-(test (case #t ((1 2) (3 4)) -1) 'error)
-(test (case 1 1) 'error)
-(test (case 1 ((2) 1) . 1) 'error)
-(test (case 1 (2 1) (1 1)) 'error)
-(test (case 1 (else)) 'error)
-(test (case () ((1 . 2) . 1) . 1) 'error)
-
-(test ((lambda () => abs)) 'error)
-(test ((lambda () => => 3)) 'error)
-;; actually, both Guile and Gauche accept
-;; ((lambda () + 3)) and (begin + 3)
-;; but surely => is an undefined variable in this context?
-
-(test (lambda) 'error)
-(test (lambda (a) ) 'error)
-;; should this be an error: (lambda (a) (define x 1)) ?
-(test (lambda . 1) 'error)
-(test (lambda 1) 'error)
-(test (lambda (x 1) x) 'error)
-(test (lambda "hi" 1) 'error)
- ;(test (lambda (x x) x) 'error)
- ;(test ((lambda (x x) x) 1 2) 'error) returns 2 in s7
-(test (lambda (x "a")) 'error)
-(test ((lambda (x y) (+ x y a)) 1 2) 'error)
-(test ((lambda ())) 'error)
-(test (lambda (x (y)) x) 'error)
-(test ((lambda (x) x . 5) 2) 'error)
-(test (lambda (1) #f) 'error)
-;(test (lambda (x . y z) x) 'error) ; this is apparently uncatchable in Guile, in s7 it triggers a reader error
-(test ((lambda () 1) 1) 'error)
-(test ((lambda (()) 1) 1) 'error)
-(test ((lambda (x) x) 1 2) 'error)
-(test ((lambda (x) x)) 'error)
-(test ((lambda ("x") x)) 'error)
-(test ((lambda "x" x)) 'error)
-(test ((lambda (x . "hi") x)) 'error)
-
- ;(test (begin . 1) 'error)
- ;(test (let () (begin . 1)) 'error)
-
-(test (apply + #f) 'error)
-(test (apply #f '(2 3)) 'error)
-(test (apply make-vector '(1 2 3)) 'error)
-(test (apply + 1) 'error)
-(test (apply) 'error)
-(test (apply 1) 'error)
-(test (apply . 1) 'error)
-(test (apply car ''foo) 'error)
-(test (apply + '(1 . 2)) 'error)
-(test (apply '() '()) 'error)
-
-(for-each
- (lambda (arg)
- (test (apply arg '(1)) 'error))
- (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t)) ; "hi" and (list 1 2 3) work here because they are applicable in s7
-
-(test (let ((x (list 1 2))) (set-cdr! x x) (apply + x)) 'error)
-(test (apply + '(1 2 . 3)) 'error)
-(test (apply + '(1 2) (list 3 4)) 'error)
-
-(test (define) 'error)
-(test (define x) 'error)
-(test (define . x) 'error)
-(test (define x 1 2) 'error)
-(test (define (x 1)) 'error)
-(test (define 1 2) 'error)
-(test (define "hi" 2) 'error)
-(test (define x 1 2) 'error)
-(test (define x 1 . 2) 'error)
-(test (define x . 1) 'error)
- ;(test (define 'hi 1) 'error) ; this redefines quote, which maybe isn't an error
-(test (let () (define . 1) 1) 'error)
-(test (let ((hi (lambda (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
-
-(if with-values (begin
-(test (call-with-values (lambda (x) (+ x 1)) (lambda (y) y)) 'error)
-(test (+ (values . 1)) 'error)
-(for-each
- (lambda (arg)
- (test (call-with-values arg arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
-(test (call-with-values (lambda () (values -1 2)) abs) 'error)
-))
-
-(test (let ((x 1 2 3)) x) 'error)
-(test (let ((+ 1 2)) 2) 'error)
-(test (let* ((x 1 2)) x) 'error)
-(test (letrec ((x 1 2)) x) 'error)
-(test (let ((x 1 . 2)) x) 'error)
-(test (let ((x 1 , 2)) x) 'error)
-(test (let ((x . 1)) x) 'error)
-(test (let* ((x . 1)) x) 'error)
-(test (letrec ((x . 1)) x) 'error)
-(test (let hi ()) 'error)
-
-(test (let . 1) 'error)
-(test (let* (x)) 'error)
-(test (let (x) 1) 'error)
-(test (let ((x)) 3) 'error)
-(test (let ((x 1) y) x) 'error)
-(test (let* x ()) 'error)
-(test (let* ((1 2)) 3) 'error)
-(test (let () ) 'error)
-(test (let '() 3) 'error)
-(test (let* ((x 1))) 'error)
-(test (let ((x 1)) (letrec ((x 32) (y x)) (+ 1 y))) 'error) ; #<unspecified> seems reasonable if not the 1+
-(test (let ((x 1)) (letrec ((y x) (x 32)) (+ 1 y))) 'error)
- ;(test (let ((x 1)) (letrec ((y x) (x 32)) 1)) 'error) ; Guile is perverse... s7 returns 1 here
-(test (let ((x 1)) (letrec ((y (let () (+ x 1))) (x 32)) (+ 1 y))) 'error)
-(test (let ((x 1)) (letrec ((y (let ((xx (+ x 1))) xx)) (x 32)) (+ 1 y))) 'error)
- ;(test (let ((x 32)) (letrec ((y (apply list `(* ,x 2))) (x 1)) y)) 'error)
-(test (letrec) 'error)
-(test (let ((x . 1)) x) 'error)
-
-(test (let (((x 1)) 2) 3) 'error)
-(test (let ((#f 1)) #f) 'error)
-(test (let (()) #f) 'error)
-(test (let (lambda () ) #f) 'error)
-(test (let ((f1 3) (f1 4)) f1) 'error) ; not sure about this
-;; (let () (define (f1) 3) (define (f1) 4) (f1))
-(test (let ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error)
-(test (let* ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error)
-(test (let (('a 3)) 1) 'error)
-(test (let ((#\a 3)) #\a) 'error)
-;; (test (let ((#z1 2)) 1) 'error)
-(test (let ('a 3) 1) 'error)
-(test (let 'a 1) 'error)
-;; what about: (let ('1 ) quote) -> 1
-(test (let* func ((a 1)) a) 'error)
-(test (letrec func ((a 1)) a) 'error)
-
-(test (let ((1 3)) 3) 'error)
-(test (let ((#t 3)) 3) 'error)
-(test (let ((() 3)) 3) 'error)
-(test (let ((#\c 3)) 3) 'error)
-(test (let (("hi" 3)) 3) 'error)
-(test (let ((:hi 3)) 3) 'error)
-
-(test (let 1 ((i 0)) i) 'error)
-(test (let #f ((i 0)) i) 'error)
-(test (let "hi" ((i 0)) i) 'error)
-(test (let #\c ((i 0)) i) 'error)
-(test (let :hi ((i 0)) i) 'error)
-
-(test (let func ((a 1) . b) a) 'error)
-(test (let func ((a 1) . b) (if (> a 0) (func (- a 1) 2 3) b)) 'error)
-(test (let func ((a . 1)) a) 'error)
-(test (let func (a . 1) a) 'error)
-(test (let ((a 1) . b) a) 'error)
-(test (let* ((a 1) . b) a) 'error)
-(test (let func ((a func) (i 1)) i) 'error)
-(test (let func ((i 0)) (if (< i 1) (func))) 'error)
-(test (let func (let ((i 0)) (if (< i 1) (begin (set! i (+ i 1)) (func))))) 'error)
-(test (let ((x 0)) (set! x (+ x 1)) (begin (define y 1)) (+ x y)) 2)
-(test (let loop loop) 'error)
-(test (let loop (loop)) 'error)
-(test (let loop ((i 0) (loop 1)) i) 'error)
-
-(test (letrec ((cons 1 (quote ())) . #(1)) 1) 'error)
-(test (letrec ((a 1) . 2) 1) 'error)
-(test (let* ((a 1) (b . 2) . 1) (())) 'error)
-
-
-(test (call/cc (lambda () 0)) 'error)
-(test (call/cc (lambda (a) 0) 123) 'error)
-(test (call/cc) 'error)
-(test (call/cc abs) 'error)
-(for-each
- (lambda (arg)
- (test (call/cc arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
-
-(test (call/cc . 1) 'error)
-
-
-(test (dynamic-wind) 'error)
-(test (dynamic-wind (lambda () #f)) 'error)
-(test (dynamic-wind (lambda () #f) (lambda () #f)) 'error)
-(test (dynamic-wind (lambda (a) #f) (lambda () #f) (lambda () #f)) 'error)
-(test (dynamic-wind (lambda () #f) (lambda (a b) #f) (lambda () #f)) 'error)
-(test (dynamic-wind (lambda () #f) (lambda () #f) (lambda (a) #f)) 'error)
-(test (dynamic-wind (lambda () 1) #f (lambda () 2)) 'error)
-(test (dynamic-wind . 1) 'error)
-
-
-(if with-delay
- (begin
- (test (force) 'error)
- (test (delay) 'error)
- (test (delay 1 2) 'error)
- ))
-
-
-(test (hash-table?) 'error)
-(test (hash-table? 1 2) 'error)
-
-(let ((ht (make-hash-table)))
- (test (hash-table-set! ht #\a 'key) 'error)
- (for-each
- (lambda (arg)
- (test (hash-table-set! ht arg 3.14) 'error))
- (list #\a '#(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
- (for-each
- (lambda (arg)
- (test (hash-table-ref ht arg) 'error))
- (list #\a '#(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
-
-(for-each
- (lambda (arg)
- (test (hash-table-size arg) 'error))
- (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
-
-(for-each
- (lambda (arg)
- (test (make-hash-table arg) 'error))
- (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
-
-
-(for-each
- (lambda (arg)
- (test (make-keyword arg) 'error))
- (list -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
-
-(for-each
- (lambda (arg)
- (test (keyword->symbol arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
-
-(for-each
- (lambda (arg)
- (test (symbol->keyword arg) 'error))
- (list "hi" -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
-
-
-(for-each
- (lambda (arg)
- (test (gensym arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
-
-
-(test (defmacro) 'error)
-(test (define-macro) 'error)
-(test (defmacro 1 2 3) 'error)
-(test (define-macro (1 2) 3) 'error)
-(test (defmacro a) 'error)
-(test (define-macro (a)) 'error)
-;(test (defmacro a (1) 2) 'error)
-;(test (define-macro (a 1) 2) 'error)
-(test (defmacro . a) 'error)
-(test (define-macro . a) 'error)
-(test (define :hi 1) 'error)
-(test (define hi: 1) 'error)
-(test (define-macro (:hi a) `(+ ,a 1)) 'error)
-(test (defmacro :hi (a) `(+ ,a 1)) 'error)
-(test (defmacro hi (1 . 2) 1) 'error)
-(test (defmacro hi 1 . 2) 'error)
-(test (defmacro : "" . #(1)) 'error)
-(test (defmacro : #(1) . :) 'error)
-(test (defmacro hi ()) 'error)
-(test (define-macro (mac . 1) 1) 'error)
-(test (define-macro (mac 1) 1) 'error)
-(test (define-macro (a #()) 1) 'error)
-(test (define-macro (i 1) => (j 2)) 'error)
-(test (define hi 1 . 2) 'error)
-
-
-(test (format #f "" 1) 'error)
-(test (format #f "hiho" 1) 'error)
-(test (format #f "a~%" 1) 'error) ; some just ignore extra args
-
-(for-each
- (lambda (arg)
- (let ((result (catch #t (lambda () (format arg "hiho")) (lambda args 'error))))
- (if (not (eq? result 'error))
- (begin (display "(format ") (display arg) (display " \"hiho\")")
- (display " returned ") (display result)
- (display " but expected 'error")
- (newline)))))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
-
-(for-each
- (lambda (arg)
- (let ((result (catch #t (lambda () (format #f arg)) (lambda args 'error))))
- (if (not (eq? result 'error))
- (begin (display "(format #f ") (display arg) (display ")")
- (display " returned ") (display result)
- (display " but expected 'error")
- (newline)))))
- (list -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
-
-(test (format #f "hi ~A ho" 1 2) 'error)
-(test (format #f "hi ~A ho") 'error)
-(test (format #f "hi ~S ho") 'error)
-(test (format #f "hi ~S ho" 1 2) 'error)
-(test (format #f "~C" 1) 'error)
-(test (format #f "123 ~R 321" 1) 'error)
-(test (format #f "123 ~,3R 321" 1) 'error)
-(test (format #f "~,2,3,4D" 123) 'error)
-
-(test (format #f "hi ~Z ho") 'error)
-(test (format #f "hi ~+ ho") 'error)
-(test (format #f "hi ~# ho") 'error)
-
-(test (format #f "hi ~} ho") 'error)
-(test (format #f "hi {ho~}") 'error)
-
-(test (format #f "asb~{~A asd" '(1 2 3)) 'error)
-(test (format #f "~{~A~}" 1 2 3) 'error)
-(test (format #f "asb~{~}asd" '(1 2 3)) 'error) ; this apparently makes the format.scm in Guile hang? [fixed]
-(test (format #f "asb~{ ~}asd" '(1 2 3)) 'error)
-(test (format #f "asb~{ hiho~~~}asd" '(1 2 3)) 'error)
-
-(test (format #f "~{~A ~A ~}" '(1 "hi" 2)) 'error)
-(for-each
- (lambda (arg)
- (let ((result (catch #t (lambda () (format #f "~F" arg)) (lambda args 'error))))
- (if (not (eq? result 'error))
- (begin (display "(format #f \"~F\" ") (display arg)
- (display ") returned ") (display result)
- (display " but expected 'error")
- (newline)))))
- (list #\a '#(1 2 3) "hi" '() 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
-
-(test (format #f "~D") 'error)
- ; (test (format () "hi") "hi") ; not sure this is a good idea
-
-
-(test (let "" 1) 'error)
-(test (let "hi" 1) 'error)
-(test (let #(1) 1) 'error)
-(test (let __hi__ #t) 'error)
-(test (let* hi () 1) 'error)
-(test (letrec (1 2) #t) 'error)
-(test (call/cc abs) 'error)
-(test (quote . -1) 'error)
-(test (set! . -1) 'error)
-(test (and . #t) 'error)
-(test (and 1 . 2) 'error)
-(test (or . 1) 'error)
-(test (or #f . 1) 'error)
-(test (quote 1 1) 'error)
-(test (quote . 1) 'error)
-(test (quote . (1 2)) 'error)
-(test (quote 1 . 2) 'error)
-
-;; I think these are correct, but they look odd
-(test (eq? (if #f #t) (if #f 3)) #t)
-(test (if . (1 2)) 2)
-(test (begin . (1 2)) 2)
-(test (cond . ((1 2) ((3 4)))) 2)
-(test (and . (1 2)) 2)
-(test (or . (1 2)) 1)
-
-;; --------
-
-
-(test (let ((!@$%^&*~|}{?><.,/`_-+=:! 1)) (+ !@$%^&*~|}{?><.,/`_-+=:! 1)) 2)
-
-
(let ((d 3.14)
(i 32)
(r 2/3)
@@ -43938,13 +47731,7 @@
logior logxor logand lognot ash integer-length
+ - * / quotient remainder
expt = max min modulo < > <= >= lcm gcd
- ))))
-
-
- ))
-
-
-;;; ----------------
+ ))))))
(test (char? '1e311) #f)
(for-each
@@ -43953,610 +47740,372 @@
(if (not nb) (format #t "(number? ~A) -> #f?~%" n))))
(list '1e311 '1e-311 '0e311 '2.1e40000))
-#|
-(test (list #b) 'error)
-(test (char? #\spaces) 'error)
-(test (car '( . 1)) 'error)
-(test (car '(. )) 'error)
-(test (car '( . )) 'error)
-(test (car '(. . . )) 'error)
-(test '#( . 1) 'error)
-(test '(1 2 . ) 'error)
-(test '#(1 2 . ) 'error)
-(test (+ 1 . . ) 'error)
-(test (car '(1 . )) 'error)
-(test (car '(1 . . 2)) 'error)
-(test '#( . ) 'error)
-(test '#(1 . ) 'error)
-(test '#(. . . ) 'error)
-(test '#(1 . . 2) 'error)
-(test '(. 1) 'error)
-(test '#(. 1) 'error)
-(test '(. ) 'error)
-(test '#(. ) 'error)
-(test (list 1 . 2) 'error)
-(test (+ 1 . 2) 'error)
-(test (car '@#`') 'error)
-(test (list . ) 'error)
-(test '#( .) 'error)
-(test (car '( .)) 'error)
-(test '#(1 . 2) 'error)
-(test (let ((. 3)) .) 'error)
-|#
-
-
-;;; ----------------
-
-;;; due primarily to stupidities on my part, the "expected" values are sometimes not more
-;;; accurate than say 1e-7 or so
-
-(if (and (not (null? error-data))
- with-error-data)
- (begin
- (format #t "op~16Terror~44Ttest~76Tresult~115Texpected~%")
- (for-each
- (lambda (op)
- (format #t "~A: ~16T~A ~40T~A ~70T~A ~110T~A~%"
- (vector-ref op 0) (vector-ref op 1) (vector-ref op 2) (vector-ref op 3) (vector-ref op 4)))
- error-data)
-
- (let ((data '((3.0 0.14159265358979323846 0.1411200080598672)
- (31.0 0.41592653589793238462 0.404037645323065)
- (314.0 0.15926535897932384626 0.1585929060285728)
- (3141.0 0.59265358979323846264 0.5585640372121817)
- (31415.0 0.92653589793238462643 0.7995441773754675)
- (314159.0 0.26535897932384626433 0.262255699519879)
- (3141592.0 0.65358979323846264338 0.6080402764374114)
- (31415926.0 0.53589793238462643383 0.5106132968486387)
- (314159265.0 0.35897932384626433832 0.3513188023745885)
- (3141592653.0 0.58979323846264338327 0.5561892044494355)
- (31415926535.0 0.89793238462643383279 0.7820399858427447)
- (314159265358.0 0.97932384626433832795 0.8301205477998297)
- (3141592653589.0 0.79323846264338327950 0.7126289202333107)
- (31415926535897.0 0.93238462643383279502 0.8030432710678118)
- (314159265358979.0 0.32384626433832795028 0.3182152351447919)
- (3141592653589793.0 0.23846264338327950288 0.2362090532517409)
- (31415926535897932.0 0.38462643383279502884 0.3752128900123344)
- (314159265358979323.0 0.84626433832795028841 0.7488096950162713)
- (3141592653589793238.0 0.46264338327950288419 0.4463151633593201)
- (31415926535897932384.0 0.62643383279502884197 0.5862594566145847)
- (314159265358979323846.0 0.26433832795028841971 0.2612706361296674)
- (3141592653589793238462.0 0.64338327950288419716 0.5999057324027754)
- (31415926535897932384626.0 0.43383279502884197169 0.4203516113275538)
- (314159265358979323846264.0 0.33832795028841971693 0.3319102940355321)
- (3141592653589793238462643.0 0.38327950288419716939 .3739640276557301)))
- (vals '())
- (mx-sin-err 0.0))
-
- (for-each
- (lambda (p)
- (let ((arg1 (car p))
- (arg2 (cadr p))
- (mxerr 0.0))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x .1)))
- ((= i 10))
- (let ((err (abs (- (abs (sin (- arg1 x))) (abs (sin (+ arg2 x)))))))
- (if (> err mxerr)
- (set! mxerr err))))
- (set! vals (cons mxerr vals))
- (set! mx-sin-err (max mx-sin-err (abs (- (sin arg2) (caddr p)))))))
- data)
-
- (if (> mx-sin-err 1e-8)
- (begin
- (display "base sine seems inaccurate! error: ")
- (display mx-sin-err)
- (newline)))
-
- (set! vals (reverse vals))
-
- (let ((stop #f))
- (do ((i 0 (+ i 1)))
- ((or (number? stop)
- (= i (length vals))))
- (if (> (list-ref vals i) 1e-6)
- (set! stop i)))
- (if (number? stop)
- (begin
- (display "sin error > 1e-6 after 2^")
- (display (/ (log (car (list-ref data stop))) (log 2.0)))
- (display " or thereabouts")
- (newline)))))
-
- (let ((data (list
- 2.71828182845904523536028747135266249775724709369995957
- 27.1828182845904523536028747135266249775724709369995957
- 271.828182845904523536028747135266249775724709369995957
- 2718.28182845904523536028747135266249775724709369995957
- 27182.8182845904523536028747135266249775724709369995957
- 271828.182845904523536028747135266249775724709369995957
- 2718281.82845904523536028747135266249775724709369995957
- 27182818.2845904523536028747135266249775724709369995957
- 271828182.845904523536028747135266249775724709369995957
- 2718281828.45904523536028747135266249775724709369995957
- 27182818284.5904523536028747135266249775724709369995957
- 271828182845.904523536028747135266249775724709369995957
- 2718281828459.04523536028747135266249775724709369995957
- 27182818284590.4523536028747135266249775724709369995957
- 271828182845904.523536028747135266249775724709369995957
- 2718281828459045.23536028747135266249775724709369995957
- 27182818284590452.3536028747135266249775724709369995957
- 271828182845904523.536028747135266249775724709369995957
- 2718281828459045235.36028747135266249775724709369995957
- 27182818284590452353.6028747135266249775724709369995957
- 271828182845904523536.028747135266249775724709369995957
- 2718281828459045235360.28747135266249775724709369995957
- 27182818284590452353602.8747135266249775724709369995957
- 271828182845904523536028.747135266249775724709369995957
- 2718281828459045235360287.47135266249775724709369995957
- 27182818284590452353602874.7135266249775724709369995957
- 271828182845904523536028747.135266249775724709369995957
- 2718281828459045235360287471.35266249775724709369995957
- 27182818284590452353602874713.5266249775724709369995957)))
- (let ((happy #t))
- (do ((i 0 (+ i 1))
- (dec 1.0 (* dec 10.0)))
- ((or (not happy)
- (= i (length data))))
- (let ((val (exp (+ 1.0 (log dec)))))
- (let ((err (abs (- (list-ref data i) val))))
- (if (> err 1e-6)
- (begin
- (set! happy #f)
- (display "exp+log error > 1e-6 around 2^") (display (/ (log val) (log 2))) (newline))))))))
-
- (let ((data (list ; table[Tan[10^k], {k, 0, 30}]
- 1.55740772465490223050697480745836017308725077238152003838394660569886
- 0.64836082745908667125912493300980867681687434298372497563362796739585
- -0.58721391515692907667780963564458789425876598687291954412663968360989
- 1.47032415570271844598020880490391856915748389146711182025455665358979
- 0.32097113462381472460896162480876337966088525010731594977977206336933
- -0.03577166295289877341133054456893096203777589491986804979647879769616
- -0.37362445398759902917349708857538141978530379801059302641978134928241
- -0.46353082785018908581469758918080168755473695345937070670149218665289
- -2.56377890672837725789840319603083470729708859667680805828679070820622
- 0.65145220214514128858645272422054798185112543058289784681820964602226
- -0.55834963781124184656189340731863681858164809933060716499623295934358
- 2.50424481449822111118237373761381771825510968075886393173926375110559
- -0.77230596813187614161063494471423746038444882506077057787558499031077
- -0.30175082856983471199636858701688775346296430492149675721730025846251
- 0.21415652428250396225222102422385566728114779011753338339645623774420
- -1.67241478212758304295552142696079055033040910554091189243737002950172
- -1.24517343571840642168009129451609763781317676741030141327973693611564
- 0.52456243090255001593041672482494038697466467439258592602675334853162
- -8.38854968059368800013526842602194492647448392917034135131083409265520
- 2.47279376584652736033818679563656602249667799226358809957010483326311
- -0.84460246301988425418409323400055358116535547279258431245425813826798
- -0.89552329255426546888442598272446987755918451773757800611680045521648
- -1.62877822560689887854937593693954851354515116817021717086346127966844
- -0.98333523138083649717001389546802280189805226009031609173028377317771
- -11.87362630545544227571094967408372098364257316309876130680769667747893
- 1.11612596981774655887307362253927728556627435787456734029790793087502
- -1.63758698713112186463163321344320618241852069893975176926240178134592
- -1.03173363516910726343237554775898936974208941138122693037794681869065
- 6.35083773135836351463817396716338533781524290151157250457191403689220
- -110.81342510911236031336859049236316125148742351166700266651506403034426
- 0.09048506806330217256622313805004127372738954023205417991033965089185)))
- (let ((happy #t))
- (do ((i 0 (+ i 1))
- (dec 1.0 (* dec 10.0)))
- ((or (not happy)
- (= i (length data))))
- (let ((val (tan dec)))
- (let ((err (abs (- (list-ref data i) val)))
- (err1 (- (tan (+ 0.1 (* our-pi dec))) (tan 0.1)))
- (err2 (- (tan (+ 1.0 (* our-pi dec))) (tan 1.0))))
- (if (or (> err 1e-6)
- (> err1 1e-6)
- (> err2 1e-6))
- (begin
- (set! happy #f)
- (display "tan error > 1e-6 around 2^") (display (/ (log dec) (log 2))) (newline))))))))
-
- ;; table[(1/10^k)/(((1/10^k)^(1/10^k)) - 1), {k, 1, 30}]
- ;; the test came from calc_errors.txt from the web by "dave"
- (let ((expts (list
- -0.48621160938616180680870317336747983548142173621715706851490974881717
- -0.22218561601345857583044966876729715619642038672598556073380084629504
- -0.14526540294689938889864991134840220307566223888497162784858064408875
- -0.10862362815109649171007844591526444220973735508130191198062253212652
- -0.08686389647659141105044978528770239308857034812798554177686261943193
- -0.07238291365169326382168151357331039782973682143307349669152489742891
- -0.06204211884333512141082278643490234288550259196615819050849846987015
- -0.05428681523790663196206398113420109019962541643547760927657854324749
- -0.04825494293369464924373092184737925979664303236414611590980578553450
- -0.04342944824032518278430110099994422226122739720915846151097610557365
- -0.03948131654165925705940460838351885560840418164027583205682137097699
- -0.03619120682577098563759637916147675090355043511246085981138602579761
- -0.03340726783876167905008686486133377017608955166698061593202699553920
- -0.03102103442166584483222349447696386196557178259759899539894506586562
- -0.02895296546021728851007526126398523685253569082526692705926181546848
- -0.02714340511895328922819555743231851877797306680518273360154914602559
- -0.02554673422960305368536052464215356633451937057629542604571806752914
- -0.02412747121684732425839605105092250802578858425793889081112350331353
- -0.02285760431069746466321731152192658331511007129540571803806313398860
- -0.02171472409516259138755644594583025411510361447234900258639235440074
- -0.02068068961444056322198232947221928963307055360980162368063530687389
- -0.01974065826832962852964676904166386737701808793240851850210059107980
- -0.01888236877840225337614103995289587314323465286757518193028428290776
- -0.01809560341263549281879753828819187842893320857975794377409033233328
- -0.01737177927613007310604520675666420329177588023219463316734886061171
- -0.01670363391935583952504342495833096470363065406937228989783888395986
- -0.01608498081123154917226403453394833638127396317791358170357400676126
- -0.01551051721083042241611174715416446722479989306441666312924319204483
- -0.01497567178976730440176306617453810628601368985529884710795141610434
- -0.01447648273010839425503763063105350274314656686012221887048754923492)))
- (let ((happy #t))
- (do ((i 1 (+ i 1)))
- ((or (= i (length expts))
- (not happy)))
- (catch #t
- (lambda ()
- (let ((val (/ (expt .1 i)
- (- (expt (expt .1 i) (expt .1 i)) 1))))
- (if (> (abs (- val (list-ref expts (- i 1)))) 1e-6)
- (begin
- (set! happy #f)
- (display "expt error > 1e-6 around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline)))))
- (lambda args
- (display "expt no accurate below around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline))))))
-
- (let ((sin-err 0.0)
- (cos-err 0.0)
- (log-err 0.0)
- (asin-err 0.0)
- (atan-err 0.0)
- (sqrt-err 0.0))
- ;; data generated by mathtool in the arprec package
-
- ;; another baddy: (tan 314159265358979323) should be -1.129792652308908544253650171110
-
- (let ((sins (list
- 0.00000000000000000000000000000000000000000000000000000000000000000000
- 0.09983341664682815230681419841062202698991538801798225999276686156165
- 0.19866933079506121545941262711838975037020672954020540398639599139797
- 0.29552020666133957510532074568502737367783211174261844850153103617326
- 0.38941834230865049166631175679570526459306018344395889511584896585734
- 0.47942553860420300027328793521557138808180336794060067518861661312553
- 0.56464247339503535720094544565865790710988808499415177102426589426735
- 0.64421768723769105367261435139872018306581384457368964474396308809382
- 0.71735609089952276162717461058138536619278523779142282098968252068287
- 0.78332690962748338846138231571354862314014792572030960356048515256195
- 0.84147098480789650665250232163029899962256306079837106567275170999191
- 0.89120736006143533995180257787170353831890931945282652766035329176720
- 0.93203908596722634967013443549482599541507058820873073536659789445024
- 0.96355818541719296470134863003955481534204849131773911795564922309212
- 0.98544972998846018065947457880609751735626167234736563194021894560084
- 0.99749498660405443094172337114148732270665142592211582194997482405934
- 0.99957360304150516434211382554623417197949791475491995534260751586102
- 0.99166481045246861534613339864787565240681957116712372532710249102330
- 0.97384763087819518653237317884335760670293947136523395566725825917196
- 0.94630008768741448848970961163495776211399866559491176443047155279581
- 0.90929742682568169539601986591174484270225497144789026837897301153096
- 0.86320936664887377068075931326902458492047242489508107697183045949721
- 0.80849640381959018430403691041611906515855960597557707903336060873485
- 0.74570521217672017738540621164349953894264877802047425750762828050000
- 0.67546318055115092656577152534128337425336495789352584226890212866520
- 0.59847214410395649405185470218616227170359717157722357330262703263874
- 0.51550137182146423525772693520936824389387858775426312126259173008382
- 0.42737988023382993455605308585788064749647642266670256499017776070511
- 0.33498815015590491954385375271242210603030652888358671068410107309479
- 0.23924932921398232818425691873957537221555293029961877411621026588071
- 0.14112000805986722210074480280811027984693326425226558415188264123242
- 0.04158066243329057919469827159667310055461342296380675064800900076588
- -0.05837414342757990913721741461909518512512509908292656970935025422273)))
- (let ((mxerr 0.0))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.1)))
- ((= i 32))
- (let ((err (abs (- (sin x) (list-ref sins i)))))
- (if (> err mxerr)
- (set! mxerr err))))
- (set! sin-err mxerr)))
-
- (let ((coss (list
- 1.00000000000000000000000000000000000000000000000000000000000000000000
- 0.99500416527802576609556198780387029483857622541508403595935274468526
- 0.98006657784124163112419651674816887739352436080656799405254829012618
- 0.95533648912560601964231022756804989824421408263203767451761361222758
- 0.92106099400288508279852673205180161402585956931985044561508926713514
- 0.87758256189037271611628158260382965199164519710974405299761086831595
- 0.82533561490967829724095249895537603887809103918847038136974977367156
- 0.76484218728448842625585999019186490926821055037370335607293245825206
- 0.69670670934716542092074998164232492610178601370806078363714489414924
- 0.62160996827066445648471615140713350872176136659123900757638348453897
- 0.54030230586813971740093660744297660373231042061792222767009725538110
- 0.45359612142557738777137005178471612212146729566259504745593805541880
- 0.36235775447667357763837335562307602033994778557664862648774972093613
- 0.26749882862458740699798410929287135927592992167912966191725336742182
- 0.16996714290024093861674803520364980292818392102853430898236521149464
- 0.07073720166770291008818985143426870908509102756334686942264541719092
- -0.02919952230128872620577046294649852444486472109384694500313007908245
- -0.12884449429552468408764285733487351410164007964520297633178213994289
- -0.22720209469308705531667430653058073247695158653826107158496911100681
- -0.32328956686350342227883369508031017459419076544223959990115436505106
- -0.41614683654714238699756822950076218976600077107554489075514997378196
- -0.50484610459985745162093852371916747040702337674136205964819622353659
- -0.58850111725534570852414261265492841629376036669872798974753517400616
- -0.66627602127982419331788057116601723016327537100376988865266957182167
- -0.73739371554124549960882222733478290843301289199228479878436568873073
- -0.80114361554693371483350279046735166442856784876782013507459799166202
- -0.85688875336894723379770215164520111235392263823324404910501242714241
- -0.90407214201706114798252728194333012633184973516362471104126694868604
- -0.94222234066865815258678811736615401246341423446824662018098201995710
- -0.97095816514959052178110666934553217911761475942423954213867099245327
- -0.98999249660044545727157279473126130239367909661558832881408593292832
- -0.99913515027327946449237605454146626283664166994794274354471598254947
- -0.99829477579475308466166072228358269144701258595166016759508002045139)))
- (let ((mxerr 0.0))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.1)))
- ((= i 32))
- (let ((err (abs (- (cos x) (list-ref coss i)))))
- (if (> err mxerr)
- (set! mxerr err))))
- (set! cos-err mxerr)))
-
- (let ((logs-1 (list
- -4.60517018598809136803598290936872841520220297725754595206665580193514
- -3.91202300542814605861875078791055184712670284289729069794597579244175
- -3.50655789731998167664073767244620271055471241943479650033196146829765
- -3.21887582486820074920151866645237527905120270853703544382529578294835
- -2.99573227355399099343522357614254077567660162298902823015400791046096
- -2.81341071676003636722350555098802614247921228507454124621128145880425
- -2.65926003693277806293063016592554868556511824767568476360726565199756
- -2.52572864430825543978428654499419871097570257417678018970461577345496
- -2.40794560865187198524549243552367700590722186161204704859726713466015
- -2.30258509299404568401799145468436420760110148862877297603332790096757
- -2.20727491318972082397403933140359911538049612332012877684808809280457
- -2.12026353620009105780627342952984957440371215071428599209060144931086
- -2.04022082852655463198249546780340981039693503249733883564761029127168
- -1.96611285637283275351339804446737211748961811331542950948658564250417
- -1.89711998488588130203997833922001507102911106516627877841931357682347
- -1.83258146374831013036705442353602214290020243981652493558393576396157
- -1.77195684193187528778644829149560187961399996467180116476941806405285
- -1.71479842809192667582826031406550043783172172725179179447658712516676
- -1.66073120682165090802695547748087487796482371595841713352869556552585
- -1.60943791243410037460075933322618763952560135426851772191264789147417))
- (logs-2 (list
- 2.30258509299404568401799145468436420760110148862877297603332790096757
- 2.99573227355399099343522357614254077567660162298902823015400791046096
- 3.40119738166215537541323669160688991224859204645152242776802223460506
- 3.68887945411393630285245569760071734375210175734928348427468791995435
- 3.91202300542814605861875078791055184712670284289729069794597579244175
- 4.09434456222210068483046881306506648032409218081177768188870224409846
- 4.24849524204935898912334419812754393723818621821063416449271805090515
- 4.38202663467388161226968781905889391182760189170953873839536792944775
- 4.49980967033026506680848192852941561689608260427427187950271656824256
- 4.60517018598809136803598290936872841520220297725754595206665580193514
- 4.70048036579241622807993503264949350742280834256619015125189561009814
- 4.78749174278204599424770093452324304839959231517203293600938225359185
- 4.86753445045558242007147889624968281240636943338898009245237341163103
- 4.94164242260930429854057631958572050531368635257088941861339806039854
- 5.01063529409625575001399602483307755177419340072004014968067012607924
- 5.07517381523382692168691994051707047990310202606979399251604793894114
- 5.13579843705026176426752607255749074318930450121451776333056563884986
- 5.19295685089021037622571404998759218497158273863452713362339657773595
- 5.24702407216048614402701888657221774483848074992790179457128813737686
- 5.29831736654803667745321503082690498327770311161780120618733581142853)))
- (let ((mxerr 0.0))
- (do ((i 0 (+ i 1))
- (x 0.01 (+ x 0.01))
- (y 10.0 (+ y 10.0)))
- ((= i 20))
- (let ((err (max (abs (- (log x) (list-ref logs-1 i)))
- (abs (- (log y) (list-ref logs-2 i))))))
- (if (> err mxerr)
- (set! mxerr err))))
- (set! log-err mxerr)))
-
- (let ((asins (list
- 0.00000000000000000000000000000000000000000000000000000000000000000000
- 0.02500260489936113599406838915349107150195748368840710160729904233944
- 0.05002085680577001466274438682046411497780608049468789272874398055703
- 0.07507049107671654265775143572317089898194705496817785120910161299955
- 0.10016742116155979634552317945269331856867597222962954139102385503640
- 0.12532783116806539687456698635708471804814772683867237523396403098649
- 0.15056827277668602642326030146739539047425784470580485344319902595849
- 0.17590576816371628737774199743846051972730948209298253171964068749984
- 0.20135792079033079145512555221762341024003808140222838625725124345560
- 0.22694303617851994909359260763689579636930963064761339672521677581090
- 0.25268025514207865348565743699371097225219373309683819363392377874057
- 0.27858970239165058217050815183568882129133935843106227203280647300877
- 0.30469265401539750797200296122752916695456003170677638739297794874647
- 0.33101172808929452771961639961139035858195303667932389628972377319123
- 0.35757110364551028671483849232064256784674132498948776325141270863037
- 0.38439677449563908303819487296704697375277948430656504155058375479079
- 0.41151684606748801938473789761733560485570113512702585178394678070009
- 0.43896188560976067483321619602147236009843505358239561712817387552271
- 0.46676533904729636185033976030413712126156503909241369925276357159851
- 0.49496403171689461363027991615293072605447706550005723007748628111125
- 0.52359877559829887307710723054658381403286156656251763682915743205130
- 0.55271511309678317285035596261806027710654731438452549350875265730232
- 0.58236423786874344183204729090997636797897358751436418853659347126034
- 0.61260414804862246566851988030718610964520075565860642564808142300476
- 0.64350110879328438680280922871732263804151059111531238286560611871351
- 0.67513153293703164720905626529438801420418535124967921737841984904557
- 0.70758443672535557545286474430459468476197717933193633785448106190261
- 0.74096470220302000164595109317351452207440076171206748884906746063949
- 0.77539749661075306374035335271498711355578873864116199359771996373272
- 0.81103439428758154765966499519016990220446846078107874166646027112837
- 0.84806207898148100805294433899841808007336621326311264286071816357020
- 0.88671509499956738294114522105877020358977872696702934222169938478807
- 0.92729521800161223242851246292242880405707410857224052762186617744039
- 0.97020219992884564627294507144637975649395034794671876838355202607208
- 1.01598529381482513116231792163105149400316379682053508778250056579494
- 1.06543581651073931226000681765232949759419723349387652321962473867275
- 1.11976951499863418668667705584539961589516218640330288237568186391443
- 1.18103559399742179696187441797151603545275866323114802494551011137296
- 1.25323589750337525873710391866600599574114067342736145636046515573871
- 1.34672104149307735953151290762049740983950868154764854526693662237423
- 1.57079632679489661923132169163975144209858469968755291048747229615390)))
- (let ((mxerr 0.0))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x (/ 1.0 40.0))))
- ((= i 40))
- (let ((err (abs (- (asin x) (list-ref asins i)))))
- (if (> err mxerr)
- (set! mxerr err))))
- (set! asin-err mxerr)))
-
- (let ((atans (list
- 0.00000000000000000000000000000000000000000000000000000000000000000000
- 0.04995839572194276141000628703484488149127708042350717441085345482998
- 0.09966865249116202737844611987802059024327832250431464801550877681002
- 0.14888994760949725058653039165586728099052584656913639751654183508627
- 0.19739555984988075837004976519479029344758510378785210151768894024103
- 0.24497866312686415417208248121127581091414409838118406712737591466735
- 0.29145679447786709199560462143289119350316759901206541927220608308729
- 0.33667481938672718139669863134176645842796861176681965716976593102220
- 0.38050637711236488630358791681043310449740571365810083757630562232420
- 0.42285392613294071296648279098114197360332058559089653470801277782477
- 0.46364760900080611621425623146121440202853705428612026381093308872019
- 0.50284321092786082733088202924527755577645581499776483101147435179592
- 0.54041950027058415544357836460859991013514825146259238811636023340959
- 0.57637522059118368022757047839377004593402018294846332167674413471879
- 0.61072596438920861654375887649023609381850306612882761584286773000023
- 0.64350110879328438680280922871732263804151059111531238286560611871351
- 0.67474094222355266305652097360981361507400625484071242312092170496930
- 0.70449406424221771665748034078199625698360683805607748632242138272858
- 0.73281510178650659164079207273428025198575567935825608631050693192821
- 0.75976275487577082892296119539998182400552294838843900175686400378812
- 0.78539816339744830961566084581987572104929234984377645524373614807695
- 0.80978357257016684662414585801888523310377327237135123533486105150550
- 0.83298126667443170541769356183636123851585134443710842085342312250327
- 0.85505273712601651097815432807058769283799489703232752323972864020297
- 0.87605805059819342311404752112834133907534524616033200346065614838499
- 0.89605538457134395617480071802993782702457844484684048736655059118459
- 0.91510070055336041656680197245527296654755880944161873770852665151657
- 0.93324752865620386989366255071265925262560793377140310475404520234906
- 0.95054684081207514789478913546381917504767901030880427426177057808809
- 0.96704699339746024466331914650201513140746494542545306371969751473184
- 0.98279372324732906798571061101466601449687745363162855676142508831798
- 0.99783018390619045494496187944270463542510496590550026609871776901127
- 1.01219701145133418325981347523809017175213711715353810435383625801215
- 1.02593241134335292660599590143869494280346122674543977431139573494988
- 1.03907225953609102762125033790727884531233378855364699989530509706554
- 1.05165021254837366745986731208629982963024430034204461753698029655611
- 1.06369782240255966094389111605254547856256296541932752568273985366635
- 1.07524465330906808242086208732184320752064516718532174460312177009311
- 1.08631839775787341806397958192567762897580047046812780208748680606431
- 1.09694499030013626798639002132512259906130967805041989207206852796014
- 1.10714871779409050301706546017853704007004764540143264667653920743371)))
- (let ((mxerr 0.0))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x 0.05)))
- ((= i 40))
- (let ((err (abs (- (atan x) (list-ref atans i)))))
- (if (> err mxerr)
- (set! mxerr err))))
- (set! atan-err mxerr)))
-
- (let ((sqrts (list
- 1.00000000000000000000000000000000000000000000000000000000000000000000
- 1.41421356237309504880168872420969807856967187537694807317667973799073
- 1.73205080756887729352744634150587236694280525381038062805580697945193
- 2.00000000000000000000000000000000000000000000000000000000000000000000
- 2.23606797749978969640917366873127623544061835961152572427089724541052
- 2.44948974278317809819728407470589139196594748065667012843269256725096
- 2.64575131106459059050161575363926042571025918308245018036833445920106
- 2.82842712474619009760337744841939615713934375075389614635335947598146
- 3.00000000000000000000000000000000000000000000000000000000000000000000
- 3.16227766016837933199889354443271853371955513932521682685750485279259
- 3.31662479035539984911493273667068668392708854558935359705868214611648
- 3.46410161513775458705489268301174473388561050762076125611161395890386
- 3.60555127546398929311922126747049594625129657384524621271045305622716
- 3.74165738677394138558374873231654930175601980777872694630374546732003
- 3.87298334620741688517926539978239961083292170529159082658757376611348
- 4.00000000000000000000000000000000000000000000000000000000000000000000
- 4.12310562561766054982140985597407702514719922537362043439863357309495
- 4.24264068711928514640506617262909423570901562613084421953003921397219
- 4.35889894354067355223698198385961565913700392523244493689034413815955
- 4.47213595499957939281834733746255247088123671922305144854179449082104
- 4.58257569495584000658804719372800848898445657676797190260724212390686
- 4.69041575982342955456563011354446628058822835341173715360570189101702
- 4.79583152331271954159743806416269391999670704190412934648530911444825
- 4.89897948556635619639456814941178278393189496131334025686538513450192
- 5.00000000000000000000000000000000000000000000000000000000000000000000
- 5.09901951359278483002822410902278198956377094609959640758497080442593
- 5.19615242270663188058233902451761710082841576143114188416742093835579
- 5.29150262212918118100323150727852085142051836616490036073666891840213
- 5.38516480713450403125071049154032955629512016164478883768038867001664
- 5.47722557505166113456969782800802133952744694997983254226894449732493
- 5.56776436283002192211947129891854952047639337757041430396843258560358
- 5.65685424949238019520675489683879231427868750150779229270671895196292
- 5.74456264653802865985061146821892931822026445798279236769987747056590
- 5.83095189484530047087415287754558307652139833488597195445000674486781
- 5.91607978309961604256732829156161704841550123079434032287971966914282
- 6.00000000000000000000000000000000000000000000000000000000000000000000
- 6.08276253029821968899968424520206706208497009478641118641915304648633
- 6.16441400296897645025019238145424422523562402344457454487457207245839
- 6.24499799839839820584689312093979446107295997799165630845297193060961
- 6.32455532033675866399778708886543706743911027865043365371500970558518)))
- (let ((mxerr 0.0))
- (do ((i 1 (+ i 1)))
- ((> i 40))
- (let ((err (abs (- (sqrt i) (list-ref sqrts (- i 1))))))
- (if (> err mxerr)
- (set! mxerr err))))
- (set! sqrt-err mxerr)))
-
- (if (> sin-err 1e-12) (format #t "sin err: ~A~%" sin-err))
- (if (> cos-err 1e-12) (format #t "cos err: ~A~%" cos-err))
- (if (> log-err 1e-12) (format #t "log err: ~A~%" log-err))
- (if (> asin-err 1e-12) (format #t "asin err: ~A~%" asin-err))
- (if (> atan-err 1e-12) (format #t "atan err: ~A~%" atan-err))
- (if (> sqrt-err 1e-12) (format #t "sqrt err: ~A~%" sqrt-err))
- )
-
- ))
-'(
-;;; this is the current s7 output from loading this file:
-
- " "
- (let ((funcs (make-vector 3 #f))) (do ((i 0 (+ i 1))) ((= i 3)) (vector-set! funcs i (lambda () (+ i 1)))) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) got 12 but expected 6
-
- (let* ((x (quote (1 2 3))) (y (apply list x))) (not (eq? x y))) got #f but expected #t
-
- format #t 1 output-port: 2! (this is testing output ports)
-
- op error test result expected
- bes-i0: 4.728274528735e-07 (bes-i0 100.0) 1.0737511994318e+42 1.0737517071311e+42
- *: 1.4453905801655e-16 (* 1234/11 1234/11 1+1i) 12584.760330579+12584.760330579i 12584.760330579+12584.760330579i
- +: 1.2356560980092e-17 (+ 1.234+1.234i -1+1i) 0.234+2.234i 0.234+2.234i
- -: 7.065416064077e-15 (- 1234/11 1234/11 -1+1i) 1-1i 1-1i
- /: 6.7706212385519e-12 (/ 1+1i 123.4 123.4) 6.5670402874788e-05+6.5670402874788e-05i 6.567040287e-05+6.567040287e-05i
- magnitude: 4.3762690498963e-15 (magnitude 1e-08+1e-08i) 1.4142135623731e-08 1.414214e-08
- angle: 5.2180482157382e-15 (angle 3.1415926535898+1i) 0.30816907111599 0.30816907111598
- make-polar: 5.1075947370453e-12 (make-polar 1e-08 1234.0) -7.9855062358758e-09+6.019276547625e-09i -7.98551e-09+6.01928e-09i
- remainder: 1.1102230246252e-16 (remainder -3.1 2.5) -0.6 -0.6
- modulo: 1.1102230246252e-16 (modulo -3.1 2.0) 0.9 0.9
- expt: 5.3037918931232e-12 (expt -1234-2.718281828459i -1-1e-08i) -0.00081036881365486+1.7851555921329e-06i -0.00081036881365+1.78515559e-06i
- log: 1.9801079834368e-14 (log 8.0 1+1i) 0.97790391649038-2.2161063668189i 0.97790391649038-2.2161063668189i
- exp: 6.2082941131998e-11 (exp 2.718281828459+1234000000i) 2.4081506430049-14.961700256459i 2.4081506420759-14.961700256608i
- sqrt: 4.9628289840723e-12 (sqrt 1e-08+1e-08i) 0.00010986841134678+4.5508986056223e-05i 0.00010986841135+4.550898606e-05i
- atanh: 3.3019134302818e-14 (atanh 1e-08+1e-08i) 9.9999999669809e-09+1e-08i 1e-08+1e-08i
- acosh: 3.0063814632876e-11 (acosh 0-1234i) 7.8111635492012-1.5707963267949i 7.8111635489617-1.5707963267949i
- asinh: 1.8798350372034e-07 (asinh -181440) -12.801827480089 -12.801829886622
- tanh: 3.9570983863574e-10 (tanh 1e-08+1234000000i) 3.9600648213873e-07-6.2129419934418i 3.9600648244422e-07-6.2129419959003i
- cosh: 3.8571780349279e-10 (cosh 1e-08+1234000000i) 0.15890913095152-9.8729321283003e-09i 0.15890913089022-9.8729321283989e-09i
- sinh: 6.1863103554352e-11 (sinh 3.1415926535898+1234000000i) 1.8352001348474-11.444656792365i 1.8352001341396-11.44465679248i
- atan: 1.6781042865365e-14 (atan 0+1e-08i) 0+1.0000000016781e-08i 0+1e-08i
- acos: 1.8259451651704e-08 (acos 181440) -0+12.801827480074i 0+12.80182724632i
- asin: 6.2060307610322e-09 (asin 1e-08+1234000000i) 8.1037277147488e-18+21.62667394299i 8.1037250521496e-18+21.626673808774i
- tan: 4.2096697956986e-07 (tan 1234000000/3) -18.780955178921 -18.780947272762
- cos: 2.2319583216357e-08 (cos 1234000000/3) -0.053170110875237 -0.05317013319482
- sin: 1.1884160322495e-09 (sin 1234000000/3) 0.99858546920607 0.99858546801766
- string->number: 3.514766724748e-14 (string->number "1234567890123456789012345678901234567890.123456789e-30") 1234567890.1235 1234567890.1235
- sin error > 1e-6 after 2^38.192705173229 or thereabouts
- exp+log error > 1e-6 around 2^31.340047894875
- tan error > 1e-6 around 2^46.506993328423
- expt error > 1e-6 around 2^-46.506993328423
+
+(let ()
+
+ ;; table[(1/10^k)/(((1/10^k)^(1/10^k)) - 1), {k, 1, 30}]
+ ;; the test came from calc_errors.txt from the web by "dave"
+ (let ((expts (list
+ -0.48621160938616180680870317336747983548142173621715706851490974881717
+ -0.22218561601345857583044966876729715619642038672598556073380084629504
+ -0.14526540294689938889864991134840220307566223888497162784858064408875
+ -0.10862362815109649171007844591526444220973735508130191198062253212652
+ -0.08686389647659141105044978528770239308857034812798554177686261943193
+ -0.07238291365169326382168151357331039782973682143307349669152489742891
+ -0.06204211884333512141082278643490234288550259196615819050849846987015
+ -0.05428681523790663196206398113420109019962541643547760927657854324749
+ -0.04825494293369464924373092184737925979664303236414611590980578553450
+ -0.04342944824032518278430110099994422226122739720915846151097610557365
+ -0.03948131654165925705940460838351885560840418164027583205682137097699
+ -0.03619120682577098563759637916147675090355043511246085981138602579761
+ -0.03340726783876167905008686486133377017608955166698061593202699553920
+ -0.03102103442166584483222349447696386196557178259759899539894506586562
+ -0.02895296546021728851007526126398523685253569082526692705926181546848
+ -0.02714340511895328922819555743231851877797306680518273360154914602559
+ -0.02554673422960305368536052464215356633451937057629542604571806752914
+ -0.02412747121684732425839605105092250802578858425793889081112350331353
+ -0.02285760431069746466321731152192658331511007129540571803806313398860
+ -0.02171472409516259138755644594583025411510361447234900258639235440074
+ -0.02068068961444056322198232947221928963307055360980162368063530687389
+ -0.01974065826832962852964676904166386737701808793240851850210059107980
+ -0.01888236877840225337614103995289587314323465286757518193028428290776
+ -0.01809560341263549281879753828819187842893320857975794377409033233328
+ -0.01737177927613007310604520675666420329177588023219463316734886061171
+ -0.01670363391935583952504342495833096470363065406937228989783888395986
+ -0.01608498081123154917226403453394833638127396317791358170357400676126
+ -0.01551051721083042241611174715416446722479989306441666312924319204483
+ -0.01497567178976730440176306617453810628601368985529884710795141610434
+ -0.01447648273010839425503763063105350274314656686012221887048754923492)))
+ (let ((happy #t))
+ (do ((i 1 (+ i 1)))
+ ((or (= i (length expts))
+ (not happy)))
+ (catch #t
+ (lambda ()
+ (let ((val (/ (expt .1 i)
+ (- (expt (expt .1 i) (expt .1 i)) 1))))
+ (if (> (abs (- val (list-ref expts (- i 1)))) 1e-6)
+ (begin
+ (set! happy #f)
+ (display "expt error > 1e-6 around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline)))))
+ (lambda args
+ (display "expt no accurate below around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline))))))
+
+ (let ((sin-err 0.0)
+ (cos-err 0.0)
+ (log-err 0.0)
+ (asin-err 0.0)
+ (atan-err 0.0)
+ (sqrt-err 0.0))
+ ;; data generated by mathtool in the arprec package
+
+ ;; another baddy: (tan 314159265358979323) should be -1.129792652308908544253650171110
+
+ (let ((sins (list
+ 0.00000000000000000000000000000000000000000000000000000000000000000000
+ 0.09983341664682815230681419841062202698991538801798225999276686156165
+ 0.19866933079506121545941262711838975037020672954020540398639599139797
+ 0.29552020666133957510532074568502737367783211174261844850153103617326
+ 0.38941834230865049166631175679570526459306018344395889511584896585734
+ 0.47942553860420300027328793521557138808180336794060067518861661312553
+ 0.56464247339503535720094544565865790710988808499415177102426589426735
+ 0.64421768723769105367261435139872018306581384457368964474396308809382
+ 0.71735609089952276162717461058138536619278523779142282098968252068287
+ 0.78332690962748338846138231571354862314014792572030960356048515256195
+ 0.84147098480789650665250232163029899962256306079837106567275170999191
+ 0.89120736006143533995180257787170353831890931945282652766035329176720
+ 0.93203908596722634967013443549482599541507058820873073536659789445024
+ 0.96355818541719296470134863003955481534204849131773911795564922309212
+ 0.98544972998846018065947457880609751735626167234736563194021894560084
+ 0.99749498660405443094172337114148732270665142592211582194997482405934
+ 0.99957360304150516434211382554623417197949791475491995534260751586102
+ 0.99166481045246861534613339864787565240681957116712372532710249102330
+ 0.97384763087819518653237317884335760670293947136523395566725825917196
+ 0.94630008768741448848970961163495776211399866559491176443047155279581
+ 0.90929742682568169539601986591174484270225497144789026837897301153096
+ 0.86320936664887377068075931326902458492047242489508107697183045949721
+ 0.80849640381959018430403691041611906515855960597557707903336060873485
+ 0.74570521217672017738540621164349953894264877802047425750762828050000
+ 0.67546318055115092656577152534128337425336495789352584226890212866520
+ 0.59847214410395649405185470218616227170359717157722357330262703263874
+ 0.51550137182146423525772693520936824389387858775426312126259173008382
+ 0.42737988023382993455605308585788064749647642266670256499017776070511
+ 0.33498815015590491954385375271242210603030652888358671068410107309479
+ 0.23924932921398232818425691873957537221555293029961877411621026588071
+ 0.14112000805986722210074480280811027984693326425226558415188264123242
+ 0.04158066243329057919469827159667310055461342296380675064800900076588
+ -0.05837414342757990913721741461909518512512509908292656970935025422273)))
+ (let ((mxerr 0.0))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 32))
+ (let ((err (abs (- (sin x) (list-ref sins i)))))
+ (if (> err mxerr)
+ (set! mxerr err))))
+ (set! sin-err mxerr)))
+
+ (let ((coss (list
+ 1.00000000000000000000000000000000000000000000000000000000000000000000
+ 0.99500416527802576609556198780387029483857622541508403595935274468526
+ 0.98006657784124163112419651674816887739352436080656799405254829012618
+ 0.95533648912560601964231022756804989824421408263203767451761361222758
+ 0.92106099400288508279852673205180161402585956931985044561508926713514
+ 0.87758256189037271611628158260382965199164519710974405299761086831595
+ 0.82533561490967829724095249895537603887809103918847038136974977367156
+ 0.76484218728448842625585999019186490926821055037370335607293245825206
+ 0.69670670934716542092074998164232492610178601370806078363714489414924
+ 0.62160996827066445648471615140713350872176136659123900757638348453897
+ 0.54030230586813971740093660744297660373231042061792222767009725538110
+ 0.45359612142557738777137005178471612212146729566259504745593805541880
+ 0.36235775447667357763837335562307602033994778557664862648774972093613
+ 0.26749882862458740699798410929287135927592992167912966191725336742182
+ 0.16996714290024093861674803520364980292818392102853430898236521149464
+ 0.07073720166770291008818985143426870908509102756334686942264541719092
+ -0.02919952230128872620577046294649852444486472109384694500313007908245
+ -0.12884449429552468408764285733487351410164007964520297633178213994289
+ -0.22720209469308705531667430653058073247695158653826107158496911100681
+ -0.32328956686350342227883369508031017459419076544223959990115436505106
+ -0.41614683654714238699756822950076218976600077107554489075514997378196
+ -0.50484610459985745162093852371916747040702337674136205964819622353659
+ -0.58850111725534570852414261265492841629376036669872798974753517400616
+ -0.66627602127982419331788057116601723016327537100376988865266957182167
+ -0.73739371554124549960882222733478290843301289199228479878436568873073
+ -0.80114361554693371483350279046735166442856784876782013507459799166202
+ -0.85688875336894723379770215164520111235392263823324404910501242714241
+ -0.90407214201706114798252728194333012633184973516362471104126694868604
+ -0.94222234066865815258678811736615401246341423446824662018098201995710
+ -0.97095816514959052178110666934553217911761475942423954213867099245327
+ -0.98999249660044545727157279473126130239367909661558832881408593292832
+ -0.99913515027327946449237605454146626283664166994794274354471598254947
+ -0.99829477579475308466166072228358269144701258595166016759508002045139)))
+ (let ((mxerr 0.0))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 32))
+ (let ((err (abs (- (cos x) (list-ref coss i)))))
+ (if (> err mxerr)
+ (set! mxerr err))))
+ (set! cos-err mxerr)))
+
+ (let ((logs-1 (list
+ -4.60517018598809136803598290936872841520220297725754595206665580193514
+ -3.91202300542814605861875078791055184712670284289729069794597579244175
+ -3.50655789731998167664073767244620271055471241943479650033196146829765
+ -3.21887582486820074920151866645237527905120270853703544382529578294835
+ -2.99573227355399099343522357614254077567660162298902823015400791046096
+ -2.81341071676003636722350555098802614247921228507454124621128145880425
+ -2.65926003693277806293063016592554868556511824767568476360726565199756
+ -2.52572864430825543978428654499419871097570257417678018970461577345496
+ -2.40794560865187198524549243552367700590722186161204704859726713466015
+ -2.30258509299404568401799145468436420760110148862877297603332790096757
+ -2.20727491318972082397403933140359911538049612332012877684808809280457
+ -2.12026353620009105780627342952984957440371215071428599209060144931086
+ -2.04022082852655463198249546780340981039693503249733883564761029127168
+ -1.96611285637283275351339804446737211748961811331542950948658564250417
+ -1.89711998488588130203997833922001507102911106516627877841931357682347
+ -1.83258146374831013036705442353602214290020243981652493558393576396157
+ -1.77195684193187528778644829149560187961399996467180116476941806405285
+ -1.71479842809192667582826031406550043783172172725179179447658712516676
+ -1.66073120682165090802695547748087487796482371595841713352869556552585
+ -1.60943791243410037460075933322618763952560135426851772191264789147417))
+ (logs-2 (list
+ 2.30258509299404568401799145468436420760110148862877297603332790096757
+ 2.99573227355399099343522357614254077567660162298902823015400791046096
+ 3.40119738166215537541323669160688991224859204645152242776802223460506
+ 3.68887945411393630285245569760071734375210175734928348427468791995435
+ 3.91202300542814605861875078791055184712670284289729069794597579244175
+ 4.09434456222210068483046881306506648032409218081177768188870224409846
+ 4.24849524204935898912334419812754393723818621821063416449271805090515
+ 4.38202663467388161226968781905889391182760189170953873839536792944775
+ 4.49980967033026506680848192852941561689608260427427187950271656824256
+ 4.60517018598809136803598290936872841520220297725754595206665580193514
+ 4.70048036579241622807993503264949350742280834256619015125189561009814
+ 4.78749174278204599424770093452324304839959231517203293600938225359185
+ 4.86753445045558242007147889624968281240636943338898009245237341163103
+ 4.94164242260930429854057631958572050531368635257088941861339806039854
+ 5.01063529409625575001399602483307755177419340072004014968067012607924
+ 5.07517381523382692168691994051707047990310202606979399251604793894114
+ 5.13579843705026176426752607255749074318930450121451776333056563884986
+ 5.19295685089021037622571404998759218497158273863452713362339657773595
+ 5.24702407216048614402701888657221774483848074992790179457128813737686
+ 5.29831736654803667745321503082690498327770311161780120618733581142853)))
+ (let ((mxerr 0.0))
+ (do ((i 0 (+ i 1))
+ (x 0.01 (+ x 0.01))
+ (y 10.0 (+ y 10.0)))
+ ((= i 20))
+ (let ((err (max (abs (- (log x) (list-ref logs-1 i)))
+ (abs (- (log y) (list-ref logs-2 i))))))
+ (if (> err mxerr)
+ (set! mxerr err))))
+ (set! log-err mxerr)))
+
+ (let ((asins (list
+ 0.00000000000000000000000000000000000000000000000000000000000000000000
+ 0.02500260489936113599406838915349107150195748368840710160729904233944
+ 0.05002085680577001466274438682046411497780608049468789272874398055703
+ 0.07507049107671654265775143572317089898194705496817785120910161299955
+ 0.10016742116155979634552317945269331856867597222962954139102385503640
+ 0.12532783116806539687456698635708471804814772683867237523396403098649
+ 0.15056827277668602642326030146739539047425784470580485344319902595849
+ 0.17590576816371628737774199743846051972730948209298253171964068749984
+ 0.20135792079033079145512555221762341024003808140222838625725124345560
+ 0.22694303617851994909359260763689579636930963064761339672521677581090
+ 0.25268025514207865348565743699371097225219373309683819363392377874057
+ 0.27858970239165058217050815183568882129133935843106227203280647300877
+ 0.30469265401539750797200296122752916695456003170677638739297794874647
+ 0.33101172808929452771961639961139035858195303667932389628972377319123
+ 0.35757110364551028671483849232064256784674132498948776325141270863037
+ 0.38439677449563908303819487296704697375277948430656504155058375479079
+ 0.41151684606748801938473789761733560485570113512702585178394678070009
+ 0.43896188560976067483321619602147236009843505358239561712817387552271
+ 0.46676533904729636185033976030413712126156503909241369925276357159851
+ 0.49496403171689461363027991615293072605447706550005723007748628111125
+ 0.52359877559829887307710723054658381403286156656251763682915743205130
+ 0.55271511309678317285035596261806027710654731438452549350875265730232
+ 0.58236423786874344183204729090997636797897358751436418853659347126034
+ 0.61260414804862246566851988030718610964520075565860642564808142300476
+ 0.64350110879328438680280922871732263804151059111531238286560611871351
+ 0.67513153293703164720905626529438801420418535124967921737841984904557
+ 0.70758443672535557545286474430459468476197717933193633785448106190261
+ 0.74096470220302000164595109317351452207440076171206748884906746063949
+ 0.77539749661075306374035335271498711355578873864116199359771996373272
+ 0.81103439428758154765966499519016990220446846078107874166646027112837
+ 0.84806207898148100805294433899841808007336621326311264286071816357020
+ 0.88671509499956738294114522105877020358977872696702934222169938478807
+ 0.92729521800161223242851246292242880405707410857224052762186617744039
+ 0.97020219992884564627294507144637975649395034794671876838355202607208
+ 1.01598529381482513116231792163105149400316379682053508778250056579494
+ 1.06543581651073931226000681765232949759419723349387652321962473867275
+ 1.11976951499863418668667705584539961589516218640330288237568186391443
+ 1.18103559399742179696187441797151603545275866323114802494551011137296
+ 1.25323589750337525873710391866600599574114067342736145636046515573871
+ 1.34672104149307735953151290762049740983950868154764854526693662237423
+ 1.57079632679489661923132169163975144209858469968755291048747229615390)))
+ (let ((mxerr 0.0))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x (/ 1.0 40.0))))
+ ((= i 40))
+ (let ((err (abs (- (asin x) (list-ref asins i)))))
+ (if (> err mxerr)
+ (set! mxerr err))))
+ (set! asin-err mxerr)))
+
+ (let ((atans (list
+ 0.00000000000000000000000000000000000000000000000000000000000000000000
+ 0.04995839572194276141000628703484488149127708042350717441085345482998
+ 0.09966865249116202737844611987802059024327832250431464801550877681002
+ 0.14888994760949725058653039165586728099052584656913639751654183508627
+ 0.19739555984988075837004976519479029344758510378785210151768894024103
+ 0.24497866312686415417208248121127581091414409838118406712737591466735
+ 0.29145679447786709199560462143289119350316759901206541927220608308729
+ 0.33667481938672718139669863134176645842796861176681965716976593102220
+ 0.38050637711236488630358791681043310449740571365810083757630562232420
+ 0.42285392613294071296648279098114197360332058559089653470801277782477
+ 0.46364760900080611621425623146121440202853705428612026381093308872019
+ 0.50284321092786082733088202924527755577645581499776483101147435179592
+ 0.54041950027058415544357836460859991013514825146259238811636023340959
+ 0.57637522059118368022757047839377004593402018294846332167674413471879
+ 0.61072596438920861654375887649023609381850306612882761584286773000023
+ 0.64350110879328438680280922871732263804151059111531238286560611871351
+ 0.67474094222355266305652097360981361507400625484071242312092170496930
+ 0.70449406424221771665748034078199625698360683805607748632242138272858
+ 0.73281510178650659164079207273428025198575567935825608631050693192821
+ 0.75976275487577082892296119539998182400552294838843900175686400378812
+ 0.78539816339744830961566084581987572104929234984377645524373614807695
+ 0.80978357257016684662414585801888523310377327237135123533486105150550
+ 0.83298126667443170541769356183636123851585134443710842085342312250327
+ 0.85505273712601651097815432807058769283799489703232752323972864020297
+ 0.87605805059819342311404752112834133907534524616033200346065614838499
+ 0.89605538457134395617480071802993782702457844484684048736655059118459
+ 0.91510070055336041656680197245527296654755880944161873770852665151657
+ 0.93324752865620386989366255071265925262560793377140310475404520234906
+ 0.95054684081207514789478913546381917504767901030880427426177057808809
+ 0.96704699339746024466331914650201513140746494542545306371969751473184
+ 0.98279372324732906798571061101466601449687745363162855676142508831798
+ 0.99783018390619045494496187944270463542510496590550026609871776901127
+ 1.01219701145133418325981347523809017175213711715353810435383625801215
+ 1.02593241134335292660599590143869494280346122674543977431139573494988
+ 1.03907225953609102762125033790727884531233378855364699989530509706554
+ 1.05165021254837366745986731208629982963024430034204461753698029655611
+ 1.06369782240255966094389111605254547856256296541932752568273985366635
+ 1.07524465330906808242086208732184320752064516718532174460312177009311
+ 1.08631839775787341806397958192567762897580047046812780208748680606431
+ 1.09694499030013626798639002132512259906130967805041989207206852796014
+ 1.10714871779409050301706546017853704007004764540143264667653920743371)))
+ (let ((mxerr 0.0))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.05)))
+ ((= i 40))
+ (let ((err (abs (- (atan x) (list-ref atans i)))))
+ (if (> err mxerr)
+ (set! mxerr err))))
+ (set! atan-err mxerr)))
+
+ (let ((sqrts (list
+ 1.00000000000000000000000000000000000000000000000000000000000000000000
+ 1.41421356237309504880168872420969807856967187537694807317667973799073
+ 1.73205080756887729352744634150587236694280525381038062805580697945193
+ 2.00000000000000000000000000000000000000000000000000000000000000000000
+ 2.23606797749978969640917366873127623544061835961152572427089724541052
+ 2.44948974278317809819728407470589139196594748065667012843269256725096
+ 2.64575131106459059050161575363926042571025918308245018036833445920106
+ 2.82842712474619009760337744841939615713934375075389614635335947598146
+ 3.00000000000000000000000000000000000000000000000000000000000000000000
+ 3.16227766016837933199889354443271853371955513932521682685750485279259
+ 3.31662479035539984911493273667068668392708854558935359705868214611648
+ 3.46410161513775458705489268301174473388561050762076125611161395890386
+ 3.60555127546398929311922126747049594625129657384524621271045305622716
+ 3.74165738677394138558374873231654930175601980777872694630374546732003
+ 3.87298334620741688517926539978239961083292170529159082658757376611348
+ 4.00000000000000000000000000000000000000000000000000000000000000000000
+ 4.12310562561766054982140985597407702514719922537362043439863357309495
+ 4.24264068711928514640506617262909423570901562613084421953003921397219
+ 4.35889894354067355223698198385961565913700392523244493689034413815955
+ 4.47213595499957939281834733746255247088123671922305144854179449082104
+ 4.58257569495584000658804719372800848898445657676797190260724212390686
+ 4.69041575982342955456563011354446628058822835341173715360570189101702
+ 4.79583152331271954159743806416269391999670704190412934648530911444825
+ 4.89897948556635619639456814941178278393189496131334025686538513450192
+ 5.00000000000000000000000000000000000000000000000000000000000000000000
+ 5.09901951359278483002822410902278198956377094609959640758497080442593
+ 5.19615242270663188058233902451761710082841576143114188416742093835579
+ 5.29150262212918118100323150727852085142051836616490036073666891840213
+ 5.38516480713450403125071049154032955629512016164478883768038867001664
+ 5.47722557505166113456969782800802133952744694997983254226894449732493
+ 5.56776436283002192211947129891854952047639337757041430396843258560358
+ 5.65685424949238019520675489683879231427868750150779229270671895196292
+ 5.74456264653802865985061146821892931822026445798279236769987747056590
+ 5.83095189484530047087415287754558307652139833488597195445000674486781
+ 5.91607978309961604256732829156161704841550123079434032287971966914282
+ 6.00000000000000000000000000000000000000000000000000000000000000000000
+ 6.08276253029821968899968424520206706208497009478641118641915304648633
+ 6.16441400296897645025019238145424422523562402344457454487457207245839
+ 6.24499799839839820584689312093979446107295997799165630845297193060961
+ 6.32455532033675866399778708886543706743911027865043365371500970558518)))
+ (let ((mxerr 0.0))
+ (do ((i 1 (+ i 1)))
+ ((> i 40))
+ (let ((err (abs (- (sqrt i) (list-ref sqrts (- i 1))))))
+ (if (> err mxerr)
+ (set! mxerr err))))
+ (set! sqrt-err mxerr)))
+
+ (if (> sin-err 1e-12) (format #t "sin err: ~A~%" sin-err))
+ (if (> cos-err 1e-12) (format #t "cos err: ~A~%" cos-err))
+ (if (> log-err 1e-12) (format #t "log err: ~A~%" log-err))
+ (if (> asin-err 1e-12) (format #t "asin err: ~A~%" asin-err))
+ (if (> atan-err 1e-12) (format #t "atan err: ~A~%" atan-err))
+ (if (> sqrt-err 1e-12) (format #t "sqrt err: ~A~%" sqrt-err))
+ )
)
+
+
+;;; --------------------------------------------------------------------------------
+
(if with-the-bug-finding-machine
(let ((tries (if (integer? with-the-bug-finding-machine) with-the-bug-finding-machine 10000))
(err-max 1e-12)
@@ -44717,7 +48266,7 @@
;; --------------------------------------------------------------------------------
- (if (and (provided? 's7) (defined? 'current-time) (defined? 'mus-rand-seed)) (set! (mus-rand-seed) (current-time)))
+ (if (and (defined? 'current-time) (defined? 'mus-rand-seed)) (set! (mus-rand-seed) (current-time)))
(format #t "the bug machine is running...")
@@ -44728,8 +48277,8 @@
(choose-number (lambda ()
(let ((choice (random 4))
- (num1 (random (inexact->exact (floor (expt 2 expt-max)))))
- (num2 (random (inexact->exact (floor (expt 2 expt-max))))))
+ (num1 (random (floor (expt 2 expt-max))))
+ (num2 (random (floor (expt 2 expt-max)))))
(if (> (random 1.0) 0.5) (set! num1 (- num1)))
(if (> (random 1.0) 0.5) (set! num2 (- num2)))
(list
@@ -44753,8 +48302,8 @@
(choose-rational (lambda ()
(let ((choice (random 2))
- (num1 (random (inexact->exact (floor (expt 2 expt-max)))))
- (num2 (inexact->exact (floor (random (expt 2 expt-max))))))
+ (num1 (random (floor (expt 2 expt-max))))
+ (num2 (floor (random (expt 2 expt-max)))))
(if (> (random 1.0) 0.5) (set! num1 (- num1)))
(if (> (random 1.0) 0.5) (set! num2 (- num2)))
(list
@@ -44762,12 +48311,12 @@
((0) num1)
((1) (/ num1 (if (= num2 0) 1 num2))))))))
- (choose-integer (lambda () (list (random (inexact->exact (floor (expt 2 31)))))))
+ (choose-integer (lambda () (list (random (floor (expt 2 31))))))
(choose-number-small-imag (lambda ()
(let ((choice (random 4))
- (num1 (random (inexact->exact (floor (expt 2 31)))))
- (num2 (random (inexact->exact (floor (expt 2 31))))))
+ (num1 (random (floor (expt 2 31))))
+ (num2 (random (floor (expt 2 31)))))
(if (> (random 1.0) 0.5) (set! num1 (- num1)))
(if (> (random 1.0) 0.5) (set! num2 (- num2)))
(list
@@ -44951,7 +48500,7 @@
(choose-vector (lambda (ctr)
(if (> ctr 3)
(list 1)
- (let* ((len (+ 1 (random (inexact->exact (floor (/ 10 (+ ctr 1)))))))
+ (let* ((len (+ 1 (random (floor (/ 10 (+ ctr 1))))))
(v (make-vector len)))
(do ((i 0 (+ i 1)))
((= i len))
@@ -44961,7 +48510,7 @@
(choose-list (lambda (ctr)
(if (> ctr 6)
(list (list 1))
- (let ((len (random (inexact->exact (floor (/ 20 (+ ctr 1))))))
+ (let ((len (random (floor (/ 20 (+ ctr 1)))))
(lst '()))
(do ((i 0 (+ i 1)))
((= i len))
@@ -45153,10 +48702,8 @@
(do ((i 0 (+ i 1)))
((or dotted (= i len)))
(set! dotted (char=? #\. (string-ref str i))))
- (if (not (provided? 's7))
- (eq? v (not dotted))
- (eq? v (and (real? n)
- (not dotted))))))))
+ (eq? v (and (real? n)
+ (not dotted)))))))
choose-number)
(list inexact?
@@ -45169,10 +48716,8 @@
(do ((i 0 (+ i 1)))
((or dotted (= i len)))
(set! dotted (char=? #\. (string-ref str i))))
- (if (not (provided? 's7))
- (eq? v dotted)
- (eq? v (or (not (real? n))
- dotted)))))))
+ (eq? v (or (not (real? n))
+ dotted))))))
choose-number)
(list sin
@@ -45270,7 +48815,7 @@
(lambda (nlst v)
(ok-number-to-bool 'rational? nlst v
(lambda (n v)
- (eq? v (exact? n)))))
+ (eq? v (rational? n)))))
choose-number)
(list real?
@@ -45478,8 +49023,8 @@
(lambda (n1 n2 v)
(let ((a (- n1 (* n2 (floor (/ n1 n2))))))
(= a v)))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (let ((val (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (let ((val (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))))
(if (zero? val) 1 val)))))
(list remainder
@@ -45488,8 +49033,8 @@
(lambda (n1 n2 v)
(let ((a (- n1 (* n2 (quotient n1 n2)))))
(= a v)))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (let ((val (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (let ((val (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))))
(if (zero? val) 1 val)))))
(list quotient
@@ -45498,8 +49043,8 @@
(lambda (n1 n2 v)
(let ((a (truncate (/ n1 n2))))
(= a v)))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (let ((val (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (let ((val (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))))
(if (zero? val) 1 val)))))
(list rationalize
@@ -45511,20 +49056,20 @@
(let ((rat (lambda (ux err)
(let ((x0 (- ux err))
(x1 (+ ux err)))
- (let ((i (inexact->exact (ceiling x0)))
- (i0 (inexact->exact (floor x0)))
- (i1 (inexact->exact (ceiling x1)))
+ (let ((i (ceiling x0))
+ (i0 (floor x0))
+ (i1 (ceiling x1))
(r 0))
(if (>= err 1.0)
(if (< x0 0.0)
(if (< x1 0.0)
- (inexact->exact (floor x1))
+ (floor x1)
0)
i)
(if (>= x1 i)
(if (>= i 0)
i
- (inexact->exact (floor x1)))
+ (floor x1))
(do ((p0 i0 (+ p1 (* r p0)))
(q0 1 (+ q1 (* r q0)))
(p1 i1 p0)
@@ -45535,8 +49080,8 @@
(e1p (- x1 i0) (- e0 (* r e1))))
((<= x0 (/ p0 q0) x1)
(/ p0 q0))
- (set! r (min (inexact->exact (floor (/ e0 e1)))
- (inexact->exact (ceiling (/ e0p e1p)))))))))))))
+ (set! r (min (floor (/ e0 e1))
+ (ceiling (/ e0p e1p))))))))))))
(let ((v1 (rat n1 n2)))
(= v1 v)))))))
(lambda () (list (car (choose-real)) (max 0.000001 (random .1)))))
@@ -45553,7 +49098,7 @@
(ok-number 'exact->inexact nlst v
(lambda (n v)
(and (< (abs (- n v)) 1e-11)
- (inexact? v)))))
+ (not (rational? v))))))
choose-rational)
(list inexact->exact
@@ -45561,7 +49106,7 @@
(ok-number 'inexact->exact nlst v
(lambda (n v)
(and (< (abs (- n v)) 1e-11)
- (exact? v)))))
+ (rational? v)))))
choose-real)
(list gcd
@@ -45572,8 +49117,8 @@
(integer? (/ n2 v))
(positive? v)
(= (abs (lcm n1 n2)) (abs (/ (* n1 n2) v)))))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1)))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1)))))
(list lcm
@@ -45586,8 +49131,8 @@
(and (integer? (/ v n1))
(integer? (/ v n2))
(= (abs (/ (* n1 n2) v)) (gcd n1 n2)))))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1)))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1)))))
(list expt
(lambda (nlst v)
@@ -45811,16 +49356,16 @@
(lambda (n1 n2 v)
(let ((a (logical:logand n1 n2)))
(= a v)))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1)))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1)))))
(list logior
(lambda (nlst v)
(ok-two-numbers 'logior nlst v
(lambda (n1 n2 v)
(let ((a (logical:logior n1 n2)))
(= a v)))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1)))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1)))))
(list logxor
(lambda (nlst v)
@@ -45828,8 +49373,8 @@
(lambda (n1 n2 v)
(let ((a (logical:logxor n1 n2)))
(= a v)))))
- (lambda () (list (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1))
- (* (random (inexact->exact (floor (expt 2 30)))) (if (> (random 1.0) 0.5) 1 -1)))))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
+ (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1)))))
(list lognot
(lambda (nlst v)
@@ -45845,7 +49390,7 @@
(lambda (n1 n2 v)
(let ((a (logical:ash n1 n2)))
(= a v)))))
- (lambda () (list (* (random (inexact->exact (floor (inexact->exact (floor (expt 2 30)))))) (if (> (random 1.0) 0.5) 1 -1))
+ (lambda () (list (* (random (floor (expt 2 30))) (if (> (random 1.0) 0.5) 1 -1))
(* (random (if with-bignums 100 30)) (if (> (random 1.0) 0.5) 1 -1)))))
(list integer-length
@@ -46586,9 +50131,9 @@
((eq? x y))
((number? x)
(and (number? y)
- (if (exact? x)
- (and (exact? y) (= x y))
- (and (inexact? y) (= x y)))))
+ (if (rational? x)
+ (and (rational? y) (= x y))
+ (and (not (rational? y)) (= x y)))))
((char? x) (and (char? y) (char=? x y)))
(else #f)))
(if (or (not (boolean? v))
@@ -47326,7 +50871,7 @@
;;; --------------------------------------------------------------------------------
-
+
(define (s7-test-at-random)
(let ((group-1 #t)
(group-2 #t))
@@ -47389,7 +50934,7 @@
;quit gc
procedure? procedure-documentation procedure-environment
help procedure-arity procedure-source make-procedure-with-setter procedure-with-setter?
- procedure-with-setter-setter-arity not boolean? eq? eqv? equal? s7-version
+ not boolean? eq? eqv? equal? s7-version
symbol-access make-type macro?
)))
@@ -47696,7 +51241,7 @@
(let ((form (cons op arg))
(result 'error)) ;(display form) (newline)
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args)
@@ -47711,7 +51256,7 @@
(let ((form (cons op (cons arg1 arg2)))
(result 'error)) ;(display form) (newline)
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47729,7 +51274,7 @@
(let ((form (cons op (cons arg1 (cons arg2 arg3))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47748,7 +51293,7 @@
(let ((form (cons op (cons (cons arg1 arg2) arg3)))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47769,7 +51314,7 @@
(let ((form (cons op (cons arg1 (cons arg2 (cons arg3 arg4)))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47791,7 +51336,7 @@
(let ((form (cons op (cons arg1 (cons (cons arg2 arg3) arg4))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47813,7 +51358,7 @@
(let ((form (cons op (cons (cons arg1 (cons arg2 arg3)) arg4)))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47835,7 +51380,7 @@
(let ((form (cons op (cons (cons (cons arg1 arg2) arg3) arg4)))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47857,7 +51402,7 @@
(let ((form (cons op (cons (cons arg1 arg2) (cons arg3 arg4))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47882,7 +51427,7 @@
(let ((form (cons op (cons arg1 (cons arg2 (cons arg3 (cons arg4 arg5))))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47907,7 +51452,7 @@
(let ((form (cons op (cons (cons arg1 (cons arg2 (cons arg3 arg4))) arg5)))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47933,7 +51478,7 @@
(let ((form (cons op (cons (cons arg1 (cons arg2 arg3)) (cons arg4 arg5))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47959,7 +51504,7 @@
(let ((form (cons op (cons (cons arg1 arg2) (cons arg3 (cons arg4 arg5)))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -47984,7 +51529,7 @@
(let ((form (cons op (cons arg1 (cons (cons arg2 (cons arg3 arg4)) arg5))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -48009,7 +51554,7 @@
(let ((form (cons op (cons arg1 (cons (cons arg2 arg3) (cons arg4 arg5)))))
(result 'error))
(let ((tag (catch #t (lambda () (set! result (eval form))) (lambda args 'error))))
- (if (and printing (not (eq? tag 'error))) (display (format #f " ~A -> ~A~%" form result)))
+ (if (and printing (not (eq? tag 'error))) (format #t " ~A -> ~A~%" form result))
)))
ops))
args))
@@ -48026,7 +51571,11 @@
(s7-test-at-random))
-(newline) (display ";all done!") (newline)
+(format #t "~%;all done!~%")
+
+
+
+#|
;;; guile/s7 accept: (call/cc (lambda (a . b) (a 1))) -> 1
;;; same: (call/cc (lambda (a b c) (a 1))) -> too many args
@@ -48035,9 +51584,6 @@
;;; (call/cc (lambda () 1)) -> error?
-
-
-#|
:(+ 11111111111111113.0 (+ -11111111111111111.0 7.5111111111111))
8.0
:(+ (+ 11111111111111113.0 -11111111111111111.0) 7.5111111111111)
@@ -48045,10 +51591,35 @@
:(/ 1.0e308+1.0e308i 2.0e308+2.0e308i)
nannani
-;; with gmp 0.5:
+;; with gmp 0.5
:(/ 1.0e307+1.0e307i 2.0e307+2.0e307i)
0.5
-
+:(+ (+ 1.0e-30 1.0e30) -1.0e30)
+0.0
+:(+ 1.0e-30 (+ 1.0e30 -1.0e30))
+9.999999999999999999999999999999999999995E-31
+
+(define (mu)
+ (let* ((x 1)
+ (xp (+ x 1)))
+ (do ()
+ ((<= xp 1) (list (* 2 x) (* 2.0 x)))
+ (set! x (/ x 2))
+ (set! xp (+ x 1)))))
+
+; (1/1152921504606846976 8.673617379884e-19)
+
+smallest positive normalized fp 2-1022 = 2.225 10-308
+largest normalized fp 2+1023 (2 - 2-52) 2+1024 - 2+971 = 1.798 10+308
+smallest positive denormal 2-1023 2-52 2-1075 = 2.470 10-324
+largest denormal 2-1023 (1 - 2-52) 2-1023 - 2-1075 = 1.113 10-308
+largest fp integer 2+1024 - 2+971 = 1.798 10+308
+gap from largest fp integer to previous fp integer 2+971 = 1.996 10+292
+largest fp integer with a predecessor 2+53 - 1 = 9,007,199,254,740,991
+
+#x7ff0000000000000 +inf
+#xfff0000000000000 -inf
+#xfff8000000000000 nan
|#
diff --git a/singer.scm b/singer.scm
index 8ff1640..844a082 100644
--- a/singer.scm
+++ b/singer.scm
@@ -72,7 +72,7 @@
(v (make-vct len)))
(do ((i 0 (+ 1 i)))
((= i len))
- (vct-set! v i (exact->inexact (list-ref (list-ref data i) 5))))
+ (set! (v i) (exact->inexact (list-ref (list-ref data i) 5))))
v))
(frq-env (make-env pfun :duration dur))
(vib-env (make-env vfun :duration dur))
@@ -97,16 +97,16 @@
(do ((j i (+ 1 j))
(m 0 (+ 1 m)))
((= m (length shp)))
- (vct-set! shape-data j (list-ref shp m)))))
+ (set! (shape-data j) (list-ref shp m)))))
(do ((k 0 (+ 1 k))
(i 0 (+ i 2)))
((= k (length glts)))
(let ((glt (list-ref glts k)))
- (vct-set! glot-datai i 0.0)
- (vct-set! glot-datai (+ 1 i) (car glt))
- (vct-set! glot-datar i (cadr glt))
- (vct-set! glot-datar (+ 1 i) (caddr glt))))
+ (set! (glot-datai i) 0.0)
+ (set! (glot-datai (+ 1 i)) (car glt))
+ (set! (glot-datar i) (cadr glt))
+ (set! (glot-datar (+ 1 i)) (caddr glt))))
(let* ((table-size 1000) ; size of glottis wave-table
(noseposition 3)
(noselength 6)
@@ -196,36 +196,36 @@
(first-tract 1)
(offset -1)
(bg (seconds->samples beg))
- (nd (inexact->exact (vct-ref change-times (- (length change-times) 1))))
+ (nd (floor (change-times (- (length change-times) 1))))
(next-offset bg)
(last-sfd -1)
(last-gfd -1))
- (vct-set! nose-coeffs 0 0.0)
- (vct-set! nose-coeffs 1 -0.29)
- (vct-set! nose-coeffs 2 -0.22)
- (vct-set! nose-coeffs 3 0.0)
- (vct-set! nose-coeffs 4 0.24)
- (vct-set! nose-coeffs 5 0.3571)
+ (set! (nose-coeffs 0) 0.0)
+ (set! (nose-coeffs 1) -0.29)
+ (set! (nose-coeffs 2) -0.22)
+ (set! (nose-coeffs 3) 0.0)
+ (set! (nose-coeffs 4) 0.24)
+ (set! (nose-coeffs 5) 0.3571)
- (do ((i 0 (+ 1 i))) ((= i 8)) (vct-set! radii i 1.0))
- (vct-set! radii 8 0.7)
- (vct-set! radii 9 -0.5)
- (do ((i 0 (+ 1 i))) ((= i 8)) (vct-set! target-radii i 1.0))
- (vct-set! target-radii 8 0.7)
- (vct-set! target-radii 9 -0.5)
+ (do ((i 0 (+ 1 i))) ((= i 8)) (set! (radii i) 1.0))
+ (set! (radii 8) 0.7)
+ (set! (radii 9) -0.5)
+ (do ((i 0 (+ 1 i))) ((= i 8)) (set! (target-radii i) 1.0))
+ (set! (target-radii 8) 0.7)
+ (set! (target-radii 9) -0.5)
- (do ((i 0 (+ 1 i))) ((= i tractlength+8)) (vct-set! radii-poles i dpole))
- (vct-set! radii-poles 2 tong-hump-pole)
- (vct-set! radii-poles 3 tong-hump-pole)
- (vct-set! radii-poles 4 tong-hump-pole)
- (vct-set! radii-poles 5 tong-tip-pole)
+ (do ((i 0 (+ 1 i))) ((= i tractlength+8)) (set! (radii-poles i) dpole))
+ (set! (radii-poles 2) tong-hump-pole)
+ (set! (radii-poles 3) tong-hump-pole)
+ (set! (radii-poles 4) tong-hump-pole)
+ (set! (radii-poles 5) tong-tip-pole)
- (do ((i 0 (+ 1 i))) ((= i tractlength+8)) (vct-set! radii-pole-gains i dgain))
- (vct-set! radii-pole-gains 2 tong-hump-gain)
- (vct-set! radii-pole-gains 3 tong-hump-gain)
- (vct-set! radii-pole-gains 4 tong-hump-gain)
- (vct-set! radii-pole-gains 5 tong-tip-gain)
+ (do ((i 0 (+ 1 i))) ((= i tractlength+8)) (set! (radii-pole-gains i) dgain))
+ (set! (radii-pole-gains 2) tong-hump-gain)
+ (set! (radii-pole-gains 3) tong-hump-gain)
+ (set! (radii-pole-gains 4) tong-hump-gain)
+ (set! (radii-pole-gains 5) tong-tip-gain)
(ws-interrupt?)
(run
@@ -235,38 +235,38 @@
(begin
;; time to check for new tract shapes, glottal pulse shapes etc.
(set! offset (+ 1 offset))
- (set! fnoiseamp (vct-ref noiseamps offset))
+ (set! fnoiseamp (noiseamps offset))
(if (= last-sfd -1)
(set! last-sfd 0)
(let ((new-sfd (+ last-sfd 8 tractlength)))
(do ((j last-sfd (+ 1 j))
(k new-sfd (+ 1 k)))
((= j new-sfd))
- (if (> (abs (- (vct-ref shape-data j) (vct-ref shape-data k))) .001)
+ (if (> (abs (- (shape-data j) (shape-data k))) .001)
(set! new-tract 1)))
(set! last-sfd new-sfd)))
(if (= last-gfd -1)
(set! last-gfd 0)
(let ((new-gfd (+ last-gfd 2)))
(set! last-gfd new-gfd)))
- (set! next-offset (inexact->exact (vct-ref change-times (+ offset 1))))))
+ (set! next-offset (floor (change-times (+ offset 1))))))
(if (not (= new-tract 0))
(begin
(do ((j last-sfd (+ 1 j))
(k 0 (+ 1 k)))
((= k tractlength+8))
- (vct-set! target-radii k (vct-ref shape-data j)))
+ (set! (target-radii k) (shape-data j)))
(if (= first-tract 1)
(begin
(do ((k 0 (+ 1 k)))
((= k tractlength+8))
- (vct-set! radii k (vct-ref target-radii k)))))
+ (set! (radii k) (target-radii k)))))
(set! change-radii 0)
- (set! initial-noise-position (vct-ref radii tractlength+1))
+ (set! initial-noise-position (radii tractlength+1))
(do ((j 0 (+ 1 j)))
((= j tractlength+8))
- (if (> (abs (- (vct-ref target-radii j) (vct-ref radii j))) 0.001)
+ (if (> (abs (- (target-radii j) (radii j))) 0.001)
(set! change-radii 1)))))
(if (or (= first-tract 1) (not (= change-radii 0)))
@@ -275,27 +275,27 @@
(begin
(do ((j 0 (+ 1 j)))
((= j tractlength+8))
- (vct-set! radii j (+ (* (vct-ref radii j) (vct-ref radii-poles j))
- (* (vct-ref target-radii j) (vct-ref radii-pole-gains j)))))))
+ (set! (radii j) (+ (* (radii j) (radii-poles j))
+ (* (target-radii j) (radii-pole-gains j)))))))
;; set tract shape
- (vct-set! temp-arr 0 1.0)
+ (set! (temp-arr 0) 1.0)
(do ((j 1 (+ 1 j)))
((= j tractlength))
- (vct-set! temp-arr j (* (vct-ref radii (- j 1)) (vct-ref radii (- j 1))))
- (if (= (vct-ref temp-arr j) 0.0)
- (vct-set! temp-arr j 1e-10)))
+ (set! (temp-arr j) (* (radii (- j 1)) (radii (- j 1))))
+ (if (= (temp-arr j) 0.0)
+ (set! (temp-arr j) 1e-10)))
(do ((j 1 (+ 1 j)))
((= j tractlength))
- (vct-set! coeffs j (/ (- (vct-ref temp-arr (- j 1)) (vct-ref temp-arr j))
- (+ (vct-ref temp-arr (- j 1)) (vct-ref temp-arr j)))))
- (set! glot-refl-gain (vct-ref radii tractlength-1))
- (set! lip-refl-gain (vct-ref radii tractlength))
- (set! noise-pos (inexact->exact (vct-ref radii tractlength+1)))
- (set! noise-gain (vct-ref radii (+ tractlength 2)))
- (let* ((temp1 (vct-ref radii (+ tractlength 3)))
- (r (vct-ref radii (+ tractlength 4)))
- (t2 (vct-ref radii (+ tractlength 5)))
- (r2 (vct-ref radii (+ tractlength 6)))
+ (set! (coeffs j) (/ (- (temp-arr (- j 1)) (temp-arr j))
+ (+ (temp-arr (- j 1)) (temp-arr j)))))
+ (set! glot-refl-gain (radii tractlength-1))
+ (set! lip-refl-gain (radii tractlength))
+ (set! noise-pos (floor (radii tractlength+1)))
+ (set! noise-gain (radii (+ tractlength 2)))
+ (let* ((temp1 (radii (+ tractlength 3)))
+ (r (radii (+ tractlength 4)))
+ (t2 (radii (+ tractlength 5)))
+ (r2 (radii (+ tractlength 6)))
;; fricative noise generator (set noise angle and radius)
(noise-angle (hz->radians temp1))
(noise-radius r)
@@ -305,93 +305,93 @@
(noise-radius2 r2)
(noise-a2 (* -2.0 (cos (/ noise-angle2 formant-shift)) noise-radius2))
(noise-b2 (* noise-radius2 noise-radius2)))
- (vct-set! noise-c 0 (+ noise-a noise-a2))
- (vct-set! noise-c 1 (+ noise-b noise-b2 (* noise-a noise-a2)))
- (vct-set! noise-c 2 (+ (* noise-a2 noise-b) (* noise-b2 noise-a)))
- (vct-set! noise-c 3 (* noise-b2 noise-b)))
- (set! lip-radius (vct-ref radii tractlength-2))
- (set! velum-pos (vct-ref radii (+ tractlength 7)))
- (let ((leftradius (vct-ref radii (- noseposition 2)))
+ (set! (noise-c 0) (+ noise-a noise-a2))
+ (set! (noise-c 1) (+ noise-b noise-b2 (* noise-a noise-a2)))
+ (set! (noise-c 2) (+ (* noise-a2 noise-b) (* noise-b2 noise-a)))
+ (set! (noise-c 3) (* noise-b2 noise-b)))
+ (set! lip-radius (radii tractlength-2))
+ (set! velum-pos (radii (+ tractlength 7)))
+ (let ((leftradius (radii (- noseposition 2)))
(velumradius velum-pos)
- (rightradius (vct-ref radii (- noseposition 1))))
+ (rightradius (radii (- noseposition 1))))
(let ((temp1 0.0)
(temp 0.0))
;; nasal tract (set nasal shape)
(set! temp (- rightradius velumradius))
(if (< temp 0.0) (set! temp 0.0))
- (vct-set! alpha 1 (* leftradius leftradius))
- (vct-set! alpha 2 (* temp temp))
- (vct-set! alpha 3 (* velumradius velumradius))
- (set! temp1 (/ 2.0 (+ (vct-ref alpha 1) (vct-ref alpha 2) (vct-ref alpha 3))))
- (vct-set! alpha 1 (* (vct-ref alpha 1) temp1))
- (vct-set! alpha 2 (* (vct-ref alpha 2) temp1))
- (vct-set! alpha 3 (* (vct-ref alpha 3) temp1))))))
+ (set! (alpha 1) (* leftradius leftradius))
+ (set! (alpha 2) (* temp temp))
+ (set! (alpha 3) (* velumradius velumradius))
+ (set! temp1 (/ 2.0 (+ (alpha 1) (alpha 2) (alpha 3))))
+ (set! (alpha 1) (* (alpha 1) temp1))
+ (set! (alpha 2) (* (alpha 2) temp1))
+ (set! (alpha 3) (* (alpha 3) temp1))))))
(if (not (= new-tract 0))
(begin
(set! new-tract 0)
(set! first-tract 0)
(if (or (< s-noise 1.0) (< fnoiseamp 0.0001))
- (vct-set! target-radii tractlength+1 initial-noise-position))))
+ (set! (target-radii tractlength+1) initial-noise-position))))
(if (not (= new-glot 0))
(begin
(if (= first-glot 0)
(begin
(do ((i 0 (+ 1 i)))
((> i table-size))
- (vct-set! glot-table2 i (vct-ref glot-table i)))))
- (let* ((harms (inexact->exact (vct-ref glot-datai (+ last-gfd 1))))
+ (set! (glot-table2 i) (glot-table i)))))
+ (let* ((harms (floor (glot-datai (+ last-gfd 1))))
(temp1 0.0)
(temp 0.0)
- (a (vct-ref glot-datar last-gfd))
- (b (vct-ref glot-datar (+ last-gfd 1)))
+ (a (glot-datar last-gfd))
+ (b (glot-datar (+ last-gfd 1)))
(a2 (* two-pi a))
(b2 (* two-pi b)))
(vct-fill! sines 0.0)
(vct-fill! cosines 0.0)
- ;(vct-set! sines 1 0.0)
- ;(vct-set! cosines 1 0.0)
+ ;(set! (sines 1) 0.0)
+ ;(set! (cosines 1) 0.0)
(if (not (= b a))
(begin
(set! temp (/ one-over-two-pi (- b a)))
(set! temp1 (- 1.0 (cos a2)))
- (vct-set! sines 1 (* (+ (cos a2) (* (- (sin a2) (sin b2)) temp)) temp1 one-over-two-pi))
- (vct-set! cosines 1 (* (+ (- (sin a2)) (* (- (cos a2) (cos b2)) temp)) temp1 one-over-two-pi))))
- (vct-set! sines 1 (+ (vct-ref sines 1) (* (+ 0.75 (- (cos a2)) (* (cos (* 2 a2)) 0.25)) one-over-two-pi)))
- (vct-set! cosines 1 (+ (vct-ref cosines 1) (- (* (- (sin a2) (* (sin (* 2 a2)) 0.25)) one-over-two-pi) (* a 0.5))))
+ (set! (sines 1) (* (+ (cos a2) (* (- (sin a2) (sin b2)) temp)) temp1 one-over-two-pi))
+ (set! (cosines 1) (* (+ (- (sin a2)) (* (- (cos a2) (cos b2)) temp)) temp1 one-over-two-pi))))
+ (set! (sines 1) (+ (sines 1) (* (+ 0.75 (- (cos a2)) (* (cos (* 2 a2)) 0.25)) one-over-two-pi)))
+ (set! (cosines 1) (+ (cosines 1) (- (* (- (sin a2) (* (sin (* 2 a2)) 0.25)) one-over-two-pi) (* a 0.5))))
(do ((k 2 (+ 1 k))
(ka2 (* 2 a2) (+ ka2 a2))
(ka1 a2 (+ ka1 a2))
(ka3 (* 3 a2) (+ ka3 a2)))
((> k harms))
- ;(vct-set! sines k 0.0)
- ;(vct-set! cosines k 0.0)
+ ;(set! (sines k) 0.0)
+ ;(set! (cosines k) 0.0)
(if (not (= b a))
(begin
(set! temp (/ one-over-two-pi (* (- b a) k)))
- (vct-set! sines k (* (+ (cos ka2) (* (- (sin ka2) (sin (* k b2))) temp)) (/ temp1 k)))
- (vct-set! cosines k (* (+ (- (sin ka2)) (* (- (cos ka2) (cos (* k b2))) temp)) (/ temp1 k)))))
- (vct-set! sines k (+ (vct-ref sines k) (+ (/ (- 1.0 (cos ka2)) k) (/ (* (- (cos ka1) 1.0) 0.5) (- k 1))
- (/ (* (- (cos ka3) 1.0) 0.5) (+ k 1)))))
- (vct-set! sines k (* (vct-ref sines k) one-over-two-pi))
- (vct-set! cosines k (+ (vct-ref cosines k) (- (/ (sin ka2) k) (/ (* (sin ka1) 0.5) (- k 1)) (/ (* (sin ka3) 0.5) (+ k 1)))))
- (vct-set! cosines k (* (vct-ref cosines k) one-over-two-pi)))
+ (set! (sines k) (* (+ (cos ka2) (* (- (sin ka2) (sin (* k b2))) temp)) (/ temp1 k)))
+ (set! (cosines k) (* (+ (- (sin ka2)) (* (- (cos ka2) (cos (* k b2))) temp)) (/ temp1 k)))))
+ (set! (sines k) (+ (sines k) (+ (/ (- 1.0 (cos ka2)) k) (/ (* (- (cos ka1) 1.0) 0.5) (- k 1))
+ (/ (* (- (cos ka3) 1.0) 0.5) (+ k 1)))))
+ (set! (sines k) (* (sines k) one-over-two-pi))
+ (set! (cosines k) (+ (cosines k) (- (/ (sin ka2) k) (/ (* (sin ka1) 0.5) (- k 1)) (/ (* (sin ka3) 0.5) (+ k 1)))))
+ (set! (cosines k) (* (cosines k) one-over-two-pi)))
(vct-fill! glot-table 0.0)
(do ((j 0 (+ 1 j))
(x 0.0 (+ x two-pi-over-table-size)))
((> j table-size))
- ;(vct-set! glot-table j 0.0)
+ ;(set! (glot-table j) 0.0)
(do ((k 1 (+ 1 k)))
((> k harms))
- (vct-set! glot-table j (+ (vct-ref glot-table j) (+ (* (vct-ref cosines k) (cos (* k x)))
- (* (vct-ref sines k) (sin (* k x)))))))))
+ (set! (glot-table j) (+ (glot-table j) (+ (* (cosines k) (cos (* k x)))
+ (* (sines k) (sin (* k x)))))))))
(set! s-glot-mix 1.0)
(set! delta (/ 1.0 (- next-offset i)))
(if (not (= first-glot 0))
(begin
(do ((i 0 (+ 1 i)))
((> i table-size))
- (vct-set! glot-table2 i (vct-ref glot-table i)))
+ (set! (glot-table2 i) (glot-table i)))
(set! first-glot 0)))
(set! new-glot 0)))
@@ -408,54 +408,54 @@
(let ((table1 0.0)
(table2 0.0)
(int-loc 0))
- (set! glotsamp (* (vct-ref dline2 1) glot-refl-gain))
+ (set! glotsamp (* (dline2 1) glot-refl-gain))
(if (not (= table-increment 0.0))
(begin
(set! table-location (+ table-location table-increment))
(if (>= table-location table-size)
(set! table-location (- table-location table-size)))
- (set! int-loc (inexact->exact (floor table-location)))
- (set! table1 (vct-ref glot-table int-loc))
- (set! table2 (vct-ref glot-table2 int-loc))
+ (set! int-loc (floor table-location))
+ (set! table1 (glot-table int-loc))
+ (set! table2 (glot-table2 int-loc))
(set! glotsamp (+ glotsamp (* s-glot (+ table1 (* s-glot-mix (- table2 table1))))))
;; glot noise tick
- (if (and (not (= (vct-ref gn-table int-loc) 0.0))
+ (if (and (not (= (gn-table int-loc) 0.0))
(not (= gn-gain 0.0)))
(begin
(set! gn-out (- (* gn-gain s-glot (- 1.0 (random 2.0))) ;guessing here about random()
- (* (vct-ref gn-coeffs 3) (vct-ref gn-del 3))
- (* (vct-ref gn-coeffs 2) (vct-ref gn-del 2))
- (* (vct-ref gn-coeffs 1) (vct-ref gn-del 1))
- (* (vct-ref gn-coeffs 0) (vct-ref gn-del 0))))
+ (* (gn-coeffs 3) (gn-del 3))
+ (* (gn-coeffs 2) (gn-del 2))
+ (* (gn-coeffs 1) (gn-del 1))
+ (* (gn-coeffs 0) (gn-del 0))))
(do ((j 3 (- j 1))
(k 2 (- k 1)))
((< j 1))
- (vct-set! gn-del j (vct-ref gn-del k)))
- (vct-set! gn-del 0 gn-out)))
- (set! glotsamp (+ glotsamp (* gn-out (vct-ref gn-table int-loc)))))))
+ (set! (gn-del j) (gn-del k)))
+ (set! (gn-del 0) gn-out)))
+ (set! glotsamp (+ glotsamp (* gn-out (gn-table int-loc)))))))
;; next tract tick
(let ((j 0)
(temp1 0.0)
(temp 0.0))
- (vct-set! lt 0 (+ (vct-ref dline1 2) (vct-ref dline2 2)))
- (vct-set! dline2 1 (+ (vct-ref dline2 2) (* (vct-ref coeffs 1) (- glotsamp (vct-ref dline2 2)))))
- (set! temp (+ glotsamp (- (vct-ref dline2 1) (vct-ref dline2 2))))
+ (set! (lt 0) (+ (dline1 2) (dline2 2)))
+ (set! (dline2 1) (+ (dline2 2) (* (coeffs 1) (- glotsamp (dline2 2)))))
+ (set! temp (+ glotsamp (- (dline2 1) (dline2 2))))
(do ((j 2 (+ 1 j)))
((= j noseposition))
- (vct-set! dline2 j (+ (vct-ref dline2 (+ j 1)) (* (vct-ref coeffs j) (- (vct-ref dline1 (- j 1)) (vct-ref dline2 (+ j 1))))))
+ (set! (dline2 j) (+ (dline2 (+ j 1)) (* (coeffs j) (- (dline1 (- j 1)) (dline2 (+ j 1))))))
(set! temp1 temp)
- (set! temp (+ (vct-ref dline1 (- j 1)) (- (vct-ref dline2 j) (vct-ref dline2 (+ j 1)))))
- (vct-set! dline1 (- j 1) temp1))
+ (set! temp (+ (dline1 (- j 1)) (- (dline2 j) (dline2 (+ j 1)))))
+ (set! (dline1 (- j 1)) temp1))
(set! j noseposition) ;added
;;next nasal tick
- (let ((plussamp (vct-ref dline1 (- j 1)))
- (minussamp (vct-ref dline2 (+ j 1)))
+ (let ((plussamp (dline1 (- j 1)))
+ (minussamp (dline2 (+ j 1)))
(nose-reftemp 0.0))
(if (and (= velum-pos 0.0)
(>= time-nose-closed nose-ring-time))
(begin
- (set! nose-reftemp (+ (* (vct-ref alpha 1) plussamp) (* (vct-ref alpha 2) minussamp) (* (vct-ref alpha 3) (vct-ref nose2 1))))
+ (set! nose-reftemp (+ (* (alpha 1) plussamp) (* (alpha 2) minussamp) (* (alpha 3) (nose2 1))))
(set! nose-last-minus-refl (- nose-reftemp plussamp))
(set! nose-last-plus-refl (- nose-reftemp minussamp)))
(begin
@@ -465,62 +465,62 @@
;; nasal tick
(let* ((nose-t1 0.0)
(nose-temp 0.0)
- (nose-reftemp (+ (* (vct-ref alpha 1) plussamp) (* (vct-ref alpha 2) minussamp) (* (vct-ref alpha 3) (vct-ref nose2 1))))
- (plus-in (* velum-pos (- nose-reftemp (vct-ref nose2 1)))))
+ (nose-reftemp (+ (* (alpha 1) plussamp) (* (alpha 2) minussamp) (* (alpha 3) (nose2 1))))
+ (plus-in (* velum-pos (- nose-reftemp (nose2 1)))))
(set! nose-last-minus-refl (- nose-reftemp plussamp))
(set! nose-last-plus-refl (- nose-reftemp minussamp))
- (set! nose-reftemp (* (vct-ref nose-coeffs 1) (- plus-in (vct-ref nose2 2))))
- (vct-set! nose2 1 (+ (vct-ref nose2 2) nose-reftemp))
+ (set! nose-reftemp (* (nose-coeffs 1) (- plus-in (nose2 2))))
+ (set! (nose2 1) (+ (nose2 2) nose-reftemp))
(set! nose-temp (+ plus-in nose-reftemp))
(do ((j 2 (+ 1 j)))
((= j noselength-1))
- (set! nose-reftemp (* (vct-ref nose-coeffs j) (- (vct-ref nose1 (- j 1)) (vct-ref nose2 (+ j 1)))))
- (vct-set! nose2 j (+ (vct-ref nose2 (+ j 1)) nose-reftemp))
+ (set! nose-reftemp (* (nose-coeffs j) (- (nose1 (- j 1)) (nose2 (+ j 1)))))
+ (set! (nose2 j) (+ (nose2 (+ j 1)) nose-reftemp))
(set! nose-t1 nose-temp)
- (set! nose-temp (+ (vct-ref nose1 (- j 1)) nose-reftemp))
- (vct-set! nose1 (- j 1) nose-t1))
- (set! nose-reftemp (* (vct-ref nose-coeffs noselength-1)
- (- (vct-ref nose1 noselength-2) (* nose-last-output 0.25))))
- (vct-set! nose2 noselength-1 (+ (* nose-last-output 0.25) nose-reftemp))
- (vct-set! nose1 noselength-1 (+ (vct-ref nose1 noselength-2) nose-reftemp))
- (vct-set! nose1 noselength-2 nose-temp)
+ (set! nose-temp (+ (nose1 (- j 1)) nose-reftemp))
+ (set! (nose1 (- j 1)) nose-t1))
+ (set! nose-reftemp (* (nose-coeffs noselength-1)
+ (- (nose1 noselength-2) (* nose-last-output 0.25))))
+ (set! (nose2 noselength-1) (+ (* nose-last-output 0.25) nose-reftemp))
+ (set! (nose1 noselength-1) (+ (nose1 noselength-2) nose-reftemp))
+ (set! (nose1 noselength-2) nose-temp)
(set! nose-filt1 nose-filt)
- (set! nose-filt (vct-ref nose1 noselength-1))
+ (set! nose-filt (nose1 noselength-1))
(set! nose-last-output (* (+ nose-filt nose-filt1) 0.5)))))
- (vct-set! dline2 j nose-last-minus-refl))
+ (set! (dline2 j) nose-last-minus-refl))
(set! temp1 temp)
(set! temp nose-last-plus-refl)
- (vct-set! dline1 (- j 1) temp1)
+ (set! (dline1 (- j 1)) temp1)
(do ((j (+ noseposition 1) (+ 1 j)))
((= j tractlength-1))
- (vct-set! dline2 j (+ (vct-ref dline2 (+ j 1)) (* (vct-ref coeffs j) (- (vct-ref dline1 (- j 1)) (vct-ref dline2 (+ j 1))))))
+ (set! (dline2 j) (+ (dline2 (+ j 1)) (* (coeffs j) (- (dline1 (- j 1)) (dline2 (+ j 1))))))
(set! temp1 temp)
- (set! temp (+ (vct-ref dline1 (- j 1)) (- (vct-ref dline2 j) (vct-ref dline2 (+ j 1)))))
- (vct-set! dline1 (- j 1) temp1))
- (vct-set! dline2 tractlength-1 (+ last-lip-refl (* (vct-ref coeffs tractlength-1)
- (- (vct-ref dline1 tractlength-2) last-lip-refl))))
- (vct-set! dline1 tractlength-1 (+ (vct-ref dline1 tractlength-2)
- (- (vct-ref dline2 tractlength-1) last-lip-refl)))
- (vct-set! dline1 tractlength-2 temp)
+ (set! temp (+ (dline1 (- j 1)) (- (dline2 j) (dline2 (+ j 1)))))
+ (set! (dline1 (- j 1)) temp1))
+ (set! (dline2 tractlength-1) (+ last-lip-refl (* (coeffs tractlength-1)
+ (- (dline1 tractlength-2) last-lip-refl))))
+ (set! (dline1 tractlength-1) (+ (dline1 tractlength-2)
+ (- (dline2 tractlength-1) last-lip-refl)))
+ (set! (dline1 tractlength-2) temp)
(if (not (= noise-gain 0.0))
(begin
(set! noise-input (- 1.0 (random 2.0))) ;a guess
(do ((j 3 (- j 1))
(k 2 (- k 1)))
((< j 1))
- (vct-set! outz j (vct-ref outz k)))
- (vct-set! outz 0 noise-output)
+ (set! (outz j) (outz k)))
+ (set! (outz 0) noise-output)
(set! noise-output (- noise-input inz2))
(do ((i 0 (+ 1 i)))
((= i 4))
- (set! noise-output (- noise-output (* (vct-ref noise-c i) (vct-ref outz i)))))
+ (set! noise-output (- noise-output (* (noise-c i) (outz i)))))
(set! inz2 inz1)
(set! inz1 noise-input)
- (vct-set! dline1 noise-pos (+ (vct-ref dline1 noise-pos) (* noise-output noise-gain s-noise)))))
- (set! last-tract-plus (* (vct-ref dline1 tractlength-1) lip-radius)))
- (vct-set! lt 1 (* ltgain (+ (vct-ref lt 0) (* ltcoeff (vct-ref lt 1)))))
- (outa i (* amp (+ last-lip-out nose-last-output (vct-ref lt 1))) *output*)
+ (set! (dline1 noise-pos) (+ (dline1 noise-pos) (* noise-output noise-gain s-noise)))))
+ (set! last-tract-plus (* (dline1 tractlength-1) lip-radius)))
+ (set! (lt 1) (* ltgain (+ (lt 0) (* ltcoeff (lt 1)))))
+ (outa i (* amp (+ last-lip-out nose-last-output (lt 1))) *output*)
)))))
#|
diff --git a/snd-axis.c b/snd-axis.c
index fec97ba..2d9fc03 100644
--- a/snd-axis.c
+++ b/snd-axis.c
@@ -1328,7 +1328,7 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
int y0, majy, miny, i;
const char *label = NULL;
mus_float_t freq = 0.0, freq10 = 0.0;
- /* get min (log-freq or spectro-start), max, add major ticks and brief labels, then if room add log-style minor ticks (100's, 1000's) */
+ /* get min (log-freq or spectrum-start), max, add major ticks and brief labels, then if room add log-style minor ticks (100's, 1000's) */
y0 = ap->x_axis_y0;
majy = y0 + major_tick_length;
miny = y0 + minor_tick_length;
@@ -1390,7 +1390,7 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
int x0, majx, minx, i;
const char *label = NULL;
mus_float_t freq = 0.0, freq10 = 0.0;
- /* get min (log-freq or spectro-start), max, add major ticks and brief labels, then if room add log-style minor ticks (100's, 1000's) */
+ /* get min (log-freq or spectrum-start), max, add major ticks and brief labels, then if room add log-style minor ticks (100's, 1000's) */
x0 = ap->y_axis_x0;
majx = x0 - major_tick_length;
minx = x0 - minor_tick_length;
diff --git a/snd-chn.c b/snd-chn.c
index 0d7038f..0134f7c 100644
--- a/snd-chn.c
+++ b/snd-chn.c
@@ -4463,8 +4463,9 @@ void show_cursor_info(chan_info *cp)
samp = CURSOR(cp);
y = chn_sample(samp, cp, cp->edit_ctr);
absy = fabs(y);
- if (absy < .0001) digits = 4;
- else if (absy<.001) digits = 3;
+ if (absy < .0001) digits = 5;
+ else if (absy<.01) digits = 4;
+ else if (absy<1.0) digits = 3;
else digits = 2;
len = PRINT_BUFFER_SIZE;
expr_str = (char *)calloc(len, sizeof(char));
@@ -4672,7 +4673,7 @@ void check_cursor_shape(chan_info *cp, int x, int y)
click_loc_t where;
chan_info *ncp;
- if ((!cp) || (!cp->sound) || (cp->active == CHANNEL_INACTIVE)) return;
+ if ((!cp) || (!cp->sound) || (cp->active == CHANNEL_INACTIVE) || (cp->squelch_update)) return;
if (cp->sound->channel_style == CHANNELS_COMBINED)
ncp = which_channel(cp->sound, y);
@@ -9580,14 +9581,6 @@ void g_init_chn(void)
XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectrum_start, g_spectrum_start_w, H_spectrum_start,
S_setB S_spectrum_start, g_set_spectrum_start_w, g_set_spectrum_start_reversed, 0, 2, 1, 2);
- /* for backwards compatibility */
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER("spectro-cutoff", g_spectrum_end_w, H_spectrum_end,
- S_setB "spectro-cutoff", g_set_spectrum_end_w, g_set_spectrum_end_reversed, 0, 2, 1, 2);
- /* for backwards compatibility */
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER("spectro-start", g_spectrum_start_w, H_spectrum_start,
- S_setB "spectro-start", g_set_spectrum_start_w, g_set_spectrum_start_reversed, 0, 2, 1, 2);
-
-
XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_x_angle, g_spectro_x_angle_w, H_spectro_x_angle,
S_setB S_spectro_x_angle, g_set_spectro_x_angle_w, g_set_spectro_x_angle_reversed, 0, 2, 1, 2);
diff --git a/snd-completion.c b/snd-completion.c
index a04aa9a..bf8e89c 100644
--- a/snd-completion.c
+++ b/snd-completion.c
@@ -169,6 +169,7 @@ bool separator_char_p(char c)
(c != '+') &&
(c != '%') &&
(c != ':') &&
+ (c != '/') &&
#endif
(c != '$'));
}
diff --git a/snd-contents.html b/snd-contents.html
index fb17b93..d622d04 100644
--- a/snd-contents.html
+++ b/snd-contents.html
@@ -168,6 +168,7 @@ var olData = {childNodes:
{item:new outlineInnerItem("animals: a bunch of animals", "sndscm.html#animalsdoc")},
{item:new outlineInnerItem("autosave: auto-save (edit backup) support", "sndscm.html#autosavedoc")},
{item:new outlineInnerItem("bess and bess1: FM demo", "sndscm.html#bessdoc")},
+ {item:new outlineInnerItem("binary-io: binary files", "sndscm.html#binaryiodoc")},
{item:new outlineInnerItem("bird: North-American birds", "sndscm.html#birddoc")},
{item:new outlineInnerItem("clean: noise reduction", "sndscm.html#cleandoc")},
{item:new outlineInnerItem("clm-ins: more CLM instruments", "sndscm.html#clminsdoc")},
@@ -452,6 +453,7 @@ function initExpMenu() {
<small><a href="sndscm.html#animalsdoc" target="snd1">animals: a bunch of animals</a></small>
<small><a href="sndscm.html#autosavedoc" target="snd1">autosave: auto-save (edit backup) support</a></small>
<small><a href="sndscm.html#bessdoc" target="snd1">bess and bess1: FM demo</a></small>
+ <small><a href="sndscm.html#binaryiodoc" target="snd1">binary-io: binary files</a></small>
<small><a href="sndscm.html#birddoc" target="snd1">bird: North-American birds</a></small>
<small><a href="sndscm.html#cleandoc" target="snd1">clean: noise reduction</a></small>
<small><a href="sndscm.html#clminsdoc" target="snd1">clm-ins: more CLM instruments</a></small>
diff --git a/snd-dac.c b/snd-dac.c
index a93a6a9..d95fade 100644
--- a/snd-dac.c
+++ b/snd-dac.c
@@ -7,6 +7,18 @@
* channels can come and go as a play is in progress
*/
+/* TODO: how to use (play func) on a multichannel file?
+ * there is a slot for each chan
+ * add_xen_to_play_list needs a channel number [play has chan and out-chan]
+ * but would it be better to have multiple functions (how to specify chans?) or one function returning a frame?
+ * in the latter case, we'd need a :channels arg to play [this exists, currently only used for zero case?]
+ * but how to parcel out the frame? (does the 0-case actually work if chans>1?)
+ *
+ * use the :channel arg, :wait, and add a separate func for each chan
+ */
+
+
+
/* -------------------------------- per-channel control-panel state -------------------------------- */
typedef struct {
@@ -1209,6 +1221,7 @@ static bool add_xen_to_play_list(XEN func)
if (dp)
{
start_dac((int)mus_srate(), 1, IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY);
+ /* ^ output channels */
return(true);
}
}
@@ -3384,125 +3397,5 @@ If it returns " PROC_TRUE ", the sound is not played."
sdobj = XEN_FALSE;
sdobj_loc = NOT_A_GC_LOC;
-
-#ifndef SND_DISABLE_DEPRECATED
-#if HAVE_SCHEME
- XEN_EVAL_C_STRING("(define* (play-region reg wait stop-func)\
- (play (if (integer? reg) (integer->region reg) reg) :wait wait :stop stop-func))");
-
- XEN_EVAL_C_STRING("(define* (play-selection wait stop-func)\
- (play (selection) :wait wait :stop stop-func))");
-
- XEN_EVAL_C_STRING("(define* (play-mix id (beg 0))\
- (play (if (integer? id) (integer->mix id) id) beg))");
-
- XEN_EVAL_C_STRING("(define* (play-and-wait (start 0) snd chn syncd end (pos -1) stop-proc)\
- (if (string? start)\
- (play start (or snd 0) :end (or chn -1) :wait #t) \
- (play (if (integer? snd) (integer->sound snd)\
- (if (sound? snd) snd\
- (or (selected-sound) (car (sounds)))))\
- :channel (or chn -1) :wait #t :with-sync syncd :start start :end (or end -1) \
- :stop stop-proc :edit-position pos)))");
-
- XEN_EVAL_C_STRING("(define* (old-play (start 0) snd chn syncd end (pos -1) stop-proc (out-chan -1))\
- (play (if (integer? snd) (integer->sound snd)\
- (if (sound? snd) snd\
- (or (selected-sound) (car (sounds)))))\
- :channel (or chn -1) :with-sync syncd :start start :end (or end -1) \
- :stop stop-proc :out-channel out-chan :edit-position pos))");
-
- XEN_EVAL_C_STRING("(define* (play-channel (beg 0) dur snd chn (pos -1) stop-proc (out-chan -1))\
- (play (if (integer? snd) (integer->sound snd)\
- (if (sound? snd) snd\
- (or (selected-sound) (car (sounds)))))\
- :channel (or chn -1) :with-sync #f :start beg :end (if dur (+ beg dur) -1) \
- :stop stop-proc :out-channel out-chan :edit-position pos))");
-#endif
-
-#if HAVE_RUBY
- XEN_EVAL_C_STRING("def play_region(reg, wait = false, stop_proc = false)\n\
- play(reg.kind_of?(Fixnum) ? integer2region(reg) : reg, :wait, wait, :stop, stop_proc)\n\
- end");
-
- XEN_EVAL_C_STRING("def play_selection(wait = false, stop_proc = false)\n\
- play(selection(), :wait, wait, :stop, stop_proc)\n\
- end");
-
- XEN_EVAL_C_STRING("def play_mix(id, beg = 0)\n\
- play(id.kind_of?(Fixnum) ? integer2mix(id) : id, :start, beg)\n\
- end");
-
- /* "end" is a reserved word in Ruby, so we'll use "samps" instead */
- XEN_EVAL_C_STRING("def play_and_wait(start, snd, chn = -1, syncd = false, samps = -1, pos = -1, stop_proc = false, out_chan = -1)\n\
- play(snd.kind_of?(Fixnum) ? integer2sound(snd) : snd, :channel, chn, :with_sync, syncd, :wait, true, \n\
- :start, start, :end, samps, :stop, stop_proc, :out_channel, out_chan, :edit_position, pos)\n\
- end");
-
- XEN_EVAL_C_STRING("def old_play(start, snd, chn = -1, syncd = false, samps = -1, pos = -1, stop_proc = false, out_chan = -1)\n\
- play(snd.kind_of?(Fixnum) ? integer2sound(snd) : snd, :channel, chn, :with_sync, syncd, \n\
- :start, start, :end, samps, :stop, stop_proc, :out_channel, out_chan, :edit_position, pos)\n\
- end");
-
- XEN_EVAL_C_STRING("def play_channel(start, dur, snd, chn = 0, pos = -1, stop_proc = false, out_chan = -1)\n\
- play(snd.kind_of?(Fixnum) ? integer2sound(snd) : snd, :channel, chn, \n\
- :start, start, :end, dur.kind_of?(Fixnum) ? (start + dur) : -1, \n\
- :stop, stop_proc, :out_channel, out_chan, :edit_position, pos)\n\
- end");
-#endif
-
-#if HAVE_FORTH
- XEN_EVAL_C_STRING(": play-region <{ reg :optional wait #f stop-proc #f -- val }>\n\
- reg fixnum? if reg integer->region else reg then :wait wait :stop stop-proc play ;");
-
- XEN_EVAL_C_STRING(": play-selection <{ :optional wait #f stop-proc #f -- val }>\n\
- selection :wait wait :stop stop-proc play ;");
-
- XEN_EVAL_C_STRING(": play-mix <{ id :optional beg 0 -- }>\n\
- id fixnum? if id integer->mix else id then :start beg play ;");
-
- XEN_EVAL_C_STRING(": play-and-wait <{ start\n\
- :optional snd #f chn -1 syncd #f end -1 pos 0 stop-proc #f -- val }>\n\
- start string? if\n\
- start snd :channel chn :end end :wait #t play\n\
- else\n\
- snd fixnum? if\n\
- snd integer->sound\n\
- else\n\
- snd sound? if\n\
- snd\n\
- else\n\
- selected-sound sounds car ||\n\
- then\n\
- then :channel chn :wait #t :with-sync syncd\n\
- :start start :end end :stop stop-proc :edit-position pos play\n\
- then ;");
-
- XEN_EVAL_C_STRING(": old-play <{ :optional start 0 snd #f chn -1 syncd #f end -1 pos 0 stop-proc #f out-chan -1 -- val }>\n\
- snd fixnum? if\n\
- snd integer->sound\n\
- else\n\
- snd sound? if\n\
- snd\n\
- else\n\
- selected-sound sounds car ||\n\
- then\n\
- then :channel chn :with-sync syncd :start start :end end :stop stop-proc\n\
- :out-channel out-chan :edit-position pos play ;");
-
- XEN_EVAL_C_STRING(": play-channel <{ :optional beg 0 dur #f snd #f chn -1 pos 0 stop-proc #f out-chan -1 -- val }>\n\
- snd fixnum? if\n\
- snd integer->sound\n\
- else\n\
- snd sound? if\n\
- snd\n\
- else\n\
- selected-sound sounds car ||\n\
- then\n\
- then :channel chn :with-sync #f :start beg :end dur fixnum? if beg dur d+ else -1 then\n\
- :stop stop-proc :out-channel out-chan :edit-position pos play ;");
-#endif
-#endif
-
/* SOMEDAY: extend rest of play args to other cases like play-region */
}
diff --git a/snd-fft.c b/snd-fft.c
index e153b18..9b8c970 100644
--- a/snd-fft.c
+++ b/snd-fft.c
@@ -1938,7 +1938,7 @@ static XEN g_transform_frames(XEN snd, XEN chn)
#define H_transform_frames "(" S_transform_frames " :optional snd chn): \
return a description of transform graph data in snd's channel chn, based on " S_transform_graph_type ".\
If there is no transform graph, return 0; if " S_graph_once ", return " S_transform_size ",\
-and otherwise return a list (spectro-cutoff time-slices fft-bins)"
+and otherwise return a list (spectrum-cutoff time-slices fft-bins)"
chan_info *cp;
sono_info *si;
diff --git a/snd-file.c b/snd-file.c
index b24bcdc..a593950 100644
--- a/snd-file.c
+++ b/snd-file.c
@@ -1576,8 +1576,12 @@ void snd_close_file(snd_info *sp)
remember_filename(sp->filename, preloaded_files); /* for open dialog(s) previous files list in case dialog doesn't yet exist */
- /* an experiment -- event queue seems to be glomming up when lots of fast open/close */
- /* but squelch updates just in case a redisplay event is in the queue */
+ /* an experiment -- event queue seems to be glomming up when lots of fast open/close,
+ * but squelch updates just in case a redisplay event is in the queue. But check_for_event
+ * here is dangerous because a channel might be closed and deallocated already, then
+ * this check lets a mouse event through, cp->axis is NULL, cp->active has been stomped on,
+ * segfault!
+ */
for (i = 0; i < sp->nchans; i++)
sp->chans[i]->squelch_update = true;
@@ -5879,8 +5883,4 @@ files list of the View Files dialog. If it returns " PROC_TRUE ", the default a
XEN_DEFINE_PROCEDURE_WITH_SETTER(S_clipping, g_clipping_w, H_clipping,
S_setB S_clipping, g_set_clipping_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER("data-clipped", g_clipping_w, H_clipping,
- S_setB "data-clipped", g_set_clipping_w, 0, 0, 1, 0);
-
}
diff --git a/snd-g0.h b/snd-g0.h
index 805049c..fcbdac1 100644
--- a/snd-g0.h
+++ b/snd-g0.h
@@ -82,22 +82,18 @@ typedef enum {WITH_DEFAULT_BACKGROUND, WITH_WHITE_BACKGROUND} snd_entry_bg_t;
#define TOGGLE_BUTTON_ACTIVE(Button) gtk_toggle_button_get_active((GTK_TOGGLE_BUTTON(Button)))
#define BIN_CHILD(Bin) gtk_bin_get_child(GTK_BIN(Bin))
-#define EVENT_STATE(Ev) (Ev)->state
-/* perhaps #define EVENT_STATE(Ev) ({ GdkModifierType type; gdk_event_get_state(Ev, &Type); Type; })
- do we need GDK_EVENT_ANY(Ev)?
-*/
-
-#define EVENT_TIME(Ev) (Ev)->time
-/* perhaps #define EVENT_TIME(Ev) gdk_event_get_time(Ev)
- */
-
-#define EVENT_X(Ev) (Ev)->x
-/* perhaps #define EVENT_X(Ev) ({ gdouble x, y; gdk_event_get_coords(Ev, &x, &y); x; })
- */
-
-#define EVENT_Y(Ev) (Ev)->y
-/* perhaps #define EVENT_Y(Ev) ({ gdouble x, y; gdk_event_get_coords(Ev, &x, &y); y; })
- */
+#if (HAVE_GTK_SCALE_NEW) && defined(__GNUC__) && (!(defined(__cplusplus)))
+ #define EVENT_STATE(Ev) ({ GdkModifierType Type; gdk_event_get_state((GdkEvent *)Ev, &Type); Type; })
+ #define EVENT_TIME(Ev) gdk_event_get_time((GdkEvent *)Ev)
+ #define EVENT_X(Ev) ({ gdouble x, y; gdk_event_get_coords((GdkEvent *)Ev, &x, &y); x; })
+ #define EVENT_Y(Ev) ({ gdouble x, y; gdk_event_get_coords((GdkEvent *)Ev, &x, &y); y; })
+ /* there's also gtk_get_event_widget */
+#else
+ #define EVENT_STATE(Ev) (Ev)->state
+ #define EVENT_TIME(Ev) (Ev)->time
+ #define EVENT_X(Ev) (Ev)->x
+ #define EVENT_Y(Ev) (Ev)->y
+#endif
/* no accessors: */
#define EVENT_WINDOW(Ev) (Ev)->window
diff --git a/snd-gl.scm b/snd-gl.scm
index e4b9053..c505de7 100644
--- a/snd-gl.scm
+++ b/snd-gl.scm
@@ -110,7 +110,7 @@
(define (tick-audio id)
;; background process reads incoming audio data, creates spectrum, displays next trace
(mus-audio-read input-port input-data (* bins 2))
- (let ((rl-data (sound-data->vct input-data 0 (vector-ref data slice))))
+ (let ((rl-data (sound-data->vct input-data 0 (data slice))))
(snd-spectrum rl-data blackman2-window bins #t 0.0 #t #f)
(redraw-graph))
(set! slice (+ 1 slice))
@@ -130,7 +130,7 @@
(set! input-proc 0)))
(do ((i 0 (+ 1 i)))
((= i slices))
- (vct-scale! (vector-ref data i) 0.0)))
+ (vct-scale! (data i) 0.0)))
(define (start-it)
(define (add-main-pane name type args)
@@ -168,7 +168,7 @@
(set! input-data (make-sound-data 1 (* bins 2)))
(do ((i 0 (+ 1 i)))
((= i slices))
- (vector-set! data i (make-vct bins)))
+ (set! (data i) (make-vct bins)))
(start-it))
(stop-it)))))
@@ -453,7 +453,7 @@
(do ((i 0 (+ 1 i)))
((= i 256))
(glVertex3f (/ i 256.0) 0.0 0.0)
- (glVertex3f (/ i 256.0) (vct-ref rl i) (vct-ref im i)))
+ (glVertex3f (/ i 256.0) (rl i) (im i)))
(glEnd)
(glEndList))
(let ((vals (XtVaGetValues drawer (list XmNwidth 0 XmNheight 0))))
diff --git a/snd-gtk.scm b/snd-gtk.scm
index 59e373c..9d6cd9d 100644
--- a/snd-gtk.scm
+++ b/snd-gtk.scm
@@ -100,10 +100,10 @@
(define circle-vct-ref
(lambda (v i)
(if (< i 0)
- (vct-ref v (+ size i))
+ (v (+ size i))
(if (>= i size)
- (vct-ref v (- i size))
- (vct-ref v i)))))
+ (v (- i size))
+ (v i)))))
(let* ((dm (/ damp mass))
(km (/ xspring mass))
(denom (+ 1.0 dm))
@@ -112,10 +112,10 @@
(p3 (/ -1.0 denom)))
(do ((i 0 (+ 1 i)))
((= i size))
- (vct-set! x0 i (min (+ (* p1 (vct-ref x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
- (* p3 (vct-ref x2 i)))
- 1000.0)))
+ (set! (x0 i) (min (+ (* p1 (x1 i))
+ (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
+ (* p3 (x2 i)))
+ 1000.0)))
(vct-fill! x2 0.0)
(vct-add! x2 x1)
(vct-fill! x1 0.0)
@@ -182,11 +182,11 @@
(define (cairo-draw-lines cr data size)
(cairo_set_line_width cr 4.0)
- (cairo_move_to cr (vector-ref data 0) (vector-ref data 1))
+ (cairo_move_to cr (data 0) (data 1))
(do ((i 1 (+ 1 i))
(j 2 (+ j 2)))
((= i size))
- (cairo_line_to cr (vector-ref data j) (vector-ref data (+ j 1))))
+ (cairo_line_to cr (data j) (data (+ j 1))))
(cairo_stroke cr))
(define (draw-graph)
@@ -207,18 +207,18 @@
(cairo_set_source_rgb cr 0.0 0.0 0.0)
(cairo_set_line_width cr 1.0)
(let ((x (floor ax0))
- (y (y->grfy (vct-ref gx0 0) diff)))
+ (y (y->grfy (gx0 0) diff)))
(cairo_move_to cr x y)
- (vector-set! vect 0 x)
- (vector-set! vect 1 y))
+ (set! (vect 0) x)
+ (set! (vect 1) y))
(do ((i 1 (+ 1 i))
(j 2 (+ j 2))
(xi (+ ax0 xincr) (+ xi xincr)))
((= i size))
(let ((x (floor xi))
- (y (y->grfy (vct-ref gx0 i) diff)))
- (vector-set! vect j x)
- (vector-set! vect (+ j 1) y)
+ (y (y->grfy (gx0 i) diff)))
+ (set! (vect j) x)
+ (set! (vect (+ j 1)) y)
(cairo_line_to cr x y)))
(cairo_stroke cr)
(set! pts1 vect)
@@ -235,8 +235,8 @@
(j 0 (+ j 2))
(xi ax0 (+ xi xincr)))
((= i size))
- (vector-set! vect j (floor xi))
- (vector-set! vect (+ j 1) (y->grfy (vct-ref gx0 i) diff)))
+ (set! (vect j) (floor xi))
+ (set! (vect (+ j 1)) (y->grfy (gx0 i) diff)))
(if pts1 (freeGdkPoints pts1))
(set! pts0 (vector->GdkPoints vect))
(set! pts1 pts0)
@@ -270,7 +270,7 @@
(do ((i 0 (+ 1 i)))
((= i 12))
(let ((val (sin (/ (* 2 pi i) 12.0))))
- (vct-set! gx1 (+ i (- (/ size 4) 6)) val)))
+ (set! (gx1 (+ i (- (/ size 4) 6))) val)))
(set! work-proc (g_idle_add tick-synthesis #f)))
(define (continue-synthesis)
@@ -796,7 +796,7 @@ Reverb-feedback sets the scaler on the feedback.
((= i 12))
(let* ((pix (gdk_pixmap_new (GDK_DRAWABLE win) 16 16 -1))
(pixwin (GDK_DRAWABLE pix)))
- (vector-set! clock-pixmaps i pix)
+ (set! (clock-pixmaps i) pix)
(gdk_gc_set_foreground dgc (basic-color))
(gdk_draw_rectangle pixwin dgc #t 0 0 16 16)
(gdk_gc_set_foreground dgc white-pixel)
@@ -809,7 +809,7 @@ Reverb-feedback sets the scaler on the feedback.
(gdk_gc_set_foreground dgc (data-color))
(lambda (snd hour)
(gdk_draw_drawable (GDK_DRAWABLE (gtk_widget_get_window (list-ref (sound-widgets snd) 8))) dgc
- (GDK_DRAWABLE (vector-ref clock-pixmaps hour)) 0 0 0 4 16 16)
+ (GDK_DRAWABLE (clock-pixmaps hour)) 0 0 0 4 16 16)
#f)))))
@@ -1050,7 +1050,7 @@ Reverb-feedback sets the scaler on the feedback.
(gdk_draw_rectangle win gc #t 0 0 width height)
(gdk_gc_set_foreground gc black-pixel)
(gdk_draw_arc win gc #f 0 top width width ang0 ang1)
- (gdk_draw_arc win gc #f 0 (1- top) width width ang0 ang1)
+ (gdk_draw_arc win gc #f 0 (- top 1) width width ang0 ang1)
(if (> width 100)
(gdk_draw_arc win gc #f 0 (- top 2) width width ang0 ang1))
(gdk_draw_arc win gc #f 4 (+ top 4) (- width 8) (- width 8) ang0 ang1)
diff --git a/snd-help.c b/snd-help.c
index 54bb0b0..93bf353 100644
--- a/snd-help.c
+++ b/snd-help.c
@@ -493,15 +493,12 @@ void about_snd_help(void)
info,
"\nRecent changes include:\n\
\n\
+7-June: Snd 11.6.\n\
+27-May: removed snd6.scm. added binary-io.scm.\n\
+29-Apr: Snd 11.5.\n\
7-Apr: autoload support via s7's *unbound-variable-hook*.\n\
20-Mar: Snd 11.4.\n\
27-Feb: the run macro's argument no longer has to be a thunk.\n\
-11-Feb: Snd 11.3.\n\
-9-Feb: removed NLS support (the po directory and so on).\n\
-8-Feb: moved sound|channel|mix|mark|edit-property to C.\n\
-23-Jan: The rest of the Guile-dependent files have been removed.\n\
- This includes pd-*, rt-*, and the --with-snd-as-pd-external\n\
- --with-hobbit, and --with-rt configuration switches.\n\
",
#if HAVE_RUBY
"\n $LOADED_FEATURES: \n", features, "\n\n",
diff --git a/snd-listener.c b/snd-listener.c
index 1d5d6db..caf4224 100644
--- a/snd-listener.c
+++ b/snd-listener.c
@@ -175,9 +175,34 @@ int check_balance(const char *expr, int start, int end, bool in_listener)
return(i);
else
{
- if ((prev_separator) && (i + 1 < end) && (expr[i + 1] =='('))
- i++;
- else
+ bool found_it = false;
+ if (prev_separator)
+ {
+ int k, incr = 0;
+ for (k = i + 1; k < end; k++)
+ {
+ if (expr[k] == '(')
+ {
+ incr = k - i;
+ break;
+ }
+ else
+ {
+ if ((!isdigit(expr[k])) &&
+ (expr[k] != 'D') &&
+ (expr[k] != 'd') &&
+ (expr[k] != '=') &&
+ (expr[k] != '#'))
+ break;
+ }
+ }
+ if (incr > 0)
+ {
+ i += incr;
+ found_it = true;
+ }
+ }
+ if (!found_it)
{
if ((i + 2 < end) && (expr[i + 1] == '\\') &&
((expr[i + 2] == ')') || (expr[i + 2] == ';') || (expr[i + 2] == '\"') || (expr[i + 2] == '(')))
diff --git a/snd-motif.scm b/snd-motif.scm
index 0a6ca48..e8c7673 100644
--- a/snd-motif.scm
+++ b/snd-motif.scm
@@ -709,7 +709,7 @@ Reverb-feedback sets the scaler on the feedback.
(list XmNorientation XmHORIZONTAL
XmNshowValue #t
XmNbackground (basic-color)
- XmNvalue (inexact->exact frequency)
+ XmNvalue (floor frequency)
XmNmaximum 1000
XmNtitleString freqstr
XmNdecimalPoints 0)))
@@ -719,7 +719,7 @@ Reverb-feedback sets the scaler on the feedback.
(list XmNorientation XmHORIZONTAL
XmNshowValue #t
XmNbackground (basic-color)
- XmNvalue (inexact->exact (* 10 fm-index))
+ XmNvalue (floor (* 10 fm-index))
XmNmaximum 100
XmNtitleString indexstr
XmNdecimalPoints 1)))
@@ -729,7 +729,7 @@ Reverb-feedback sets the scaler on the feedback.
(list XmNorientation XmHORIZONTAL
XmNshowValue #t
XmNbackground (basic-color)
- XmNvalue (inexact->exact (* 100 noise-amount))
+ XmNvalue (floor (* 100 noise-amount))
XmNmaximum 100
XmNtitleString noisestr
XmNdecimalPoints 3))))
@@ -869,10 +869,10 @@ Reverb-feedback sets the scaler on the feedback.
(define circle-vct-ref
(lambda (v i)
(if (< i 0)
- (vct-ref v (+ size i))
+ (v (+ size i))
(if (>= i size)
- (vct-ref v (- i size))
- (vct-ref v i)))))
+ (v (- i size))
+ (v i)))))
(let* ((dm (/ damp mass))
(km (/ xspring mass))
(denom (+ 1.0 dm))
@@ -881,10 +881,10 @@ Reverb-feedback sets the scaler on the feedback.
(p3 (/ -1.0 denom)))
(do ((i 0 (+ i 1)))
((= i size))
- (vct-set! x0 i (min (+ (* p1 (vct-ref x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
- (* p3 (vct-ref x2 i)))
- 1000.0)))
+ (set! (x0 i) (min (+ (* p1 (x1 i))
+ (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
+ (* p3 (x2 i)))
+ 1000.0)))
(vct-fill! x2 0.0)
(vct-add! x2 x1)
(vct-fill! x1 0.0)
@@ -972,8 +972,8 @@ Reverb-feedback sets the scaler on the feedback.
(j 0 (+ j 2))
(xi ax0 (+ xi xincr)))
((= i size))
- (vector-set! vect j (floor xi))
- (vector-set! vect (+ j 1) (y->grfy (vct-ref gx0 i) diff)))
+ (set! (vect j) (floor xi))
+ (set! (vect (+ j 1)) (y->grfy (gx0 i) diff)))
(if pts1 (freeXPoints pts1))
(set! pts0 (vector->XPoints vect))
(set! pts1 pts0)
@@ -1007,7 +1007,7 @@ Reverb-feedback sets the scaler on the feedback.
(do ((i 0 (+ i 1)))
((= i 12))
(let ((val (sin (/ (* 2 pi i) 12.0))))
- (vct-set! gx1 (+ i (- (/ size 4) 6)) val)))
+ (set! (gx1 (+ i (- (/ size 4) 6))) val)))
(set! work-proc (XtAppAddWorkProc app tick-synthesis)))
(define (continue-synthesis)
@@ -1422,7 +1422,7 @@ Reverb-feedback sets the scaler on the feedback.
;; it's actually possible to simply redraw on one pixmap, but updates are unpredictable
(let* ((pix (XCreatePixmap dpy win 16 16 (screen-depth)))
(pixwin (list 'Window (cadr pix)))) ; C-style cast to Window for X graphics procedures
- (vector-set! clock-pixmaps i pix)
+ (set! (clock-pixmaps i) pix)
(XSetForeground dpy dgc (basic-color))
(XFillRectangle dpy pixwin dgc 0 0 16 16)
(XSetForeground dpy dgc (white-pixel))
@@ -1437,7 +1437,7 @@ Reverb-feedback sets the scaler on the feedback.
(lambda (snd hour)
(if hour
(XtSetValues (list-ref (sound-widgets snd) 8)
- (list XmNlabelPixmap (vector-ref clock-pixmaps hour)))
+ (list XmNlabelPixmap (clock-pixmaps hour)))
(bomb snd #f))))) ; using bomb to clear the icon
@@ -1467,7 +1467,7 @@ Reverb-feedback sets the scaler on the feedback.
(max ay1
(round (+ ay1
(* height (- 1.0 y)))))))
- (let* ((ly (y->grfy (vct-ref pts 0) range))
+ (let* ((ly (y->grfy (pts 0) range))
(lx left-margin)
(len (length pts))
(xinc (/ (- width left-margin right-margin) len))
@@ -1475,7 +1475,7 @@ Reverb-feedback sets the scaler on the feedback.
(do ((i 1 (+ i 1))
(x lx (+ x xinc)))
((= i len))
- (set! y (y->grfy (vct-ref pts i) range))
+ (set! y (y->grfy (pts i) range))
(XDrawLine dpy wn gc lx ly (round x) y)
(set! lx (round x))
(set! ly y)))))
@@ -2004,8 +2004,8 @@ Reverb-feedback sets the scaler on the feedback.
(if (<= val minval) 0
(if (>= val maxval) 9000
(if (>= val 1.0)
- (inexact->exact (* 4500 (+ 1.0 (/ (- val 1.0) (- maxval 1.0)))))
- (inexact->exact (* 4500 (/ (- val minval) (- 1.0 minval))))))))
+ (floor (* 4500 (+ 1.0 (/ (- val 1.0) (- maxval 1.0)))))
+ (floor (* 4500 (/ (- val minval) (- 1.0 minval))))))))
(define (scroll->amp snd val)
(if (<= val 0)
@@ -2738,7 +2738,7 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
((spectrum)
(let* ((form (XtCreateManagedWidget var-label xmFormWidgetClass pane
(list XmNpaneMinimum 100)))
- (snd (make-variable-graph form variable-name 2048 (inexact->exact (mus-srate)))))
+ (snd (make-variable-graph form variable-name 2048 (floor (mus-srate)))))
(set! (time-graph? snd 0) #f)
(set! (transform-graph? snd 0) #t)
(set! (x-axis-label snd 0 transform-graph) (string-append variable-name ": frequency"))
@@ -2942,7 +2942,7 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
(if running
(do ((i 0 (+ i 1)))
((= i ssb-pairs))
- (set! (mus-frequency (vector-ref ssbs i)) (* (+ i 1) ratio old-freq))))))
+ (set! (mus-frequency (ssbs i)) (* (+ i 1) ratio old-freq))))))
(set-ratio
(lambda (nfreq)
(set! new-freq nfreq)
@@ -2950,7 +2950,7 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
(if running
(do ((i 0 (+ i 1)))
((= i ssb-pairs))
- (set! (mus-frequency (vector-ref ssbs i)) (* (+ i 1) ratio old-freq))))))
+ (set! (mus-frequency (ssbs i)) (* (+ i 1) ratio old-freq))))))
(set-pairs
(lambda (pairs)
(set! ssb-pairs pairs)))
@@ -2975,7 +2975,7 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
(list XmNorientation XmHORIZONTAL
XmNshowValue #t
XmNbackground (basic-color)
- XmNvalue (inexact->exact old-freq)
+ XmNvalue (floor old-freq)
XmNmaximum 1000
XmNtitleString freqstr
XmNdecimalPoints 0)))
@@ -2985,7 +2985,7 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
(list XmNorientation XmHORIZONTAL
XmNshowValue #t
XmNbackground (basic-color)
- XmNvalue (inexact->exact new-freq)
+ XmNvalue (floor new-freq)
XmNmaximum 1000
XmNtitleString ratiostr
XmNdecimalPoints 0)))
@@ -3036,8 +3036,8 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
((> i ssb-pairs))
(let* ((aff (* i old-freq))
(bwf (* bw (+ 1.0 (/ i (* 2 ssb-pairs))))))
- (vector-set! ssbs (- i 1) (make-ssb-am (* i ratio old-freq)))
- (vector-set! bands (- i 1) (make-bandpass (hz->2pi (- aff bwf))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i ratio old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
(hz->2pi (+ aff bwf))
hilbert-order))))
(set! reader (make-sampler 0))
@@ -3126,7 +3126,7 @@ display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
(list XmNorientation XmHORIZONTAL
XmNshowValue #t
XmNbackground (basic-color)
- XmNvalue (inexact->exact frequency)
+ XmNvalue (floor frequency)
XmNmaximum 20000
XmNtitleString freqstr
XmNdecimalPoints 0))))
diff --git a/snd-sig.c b/snd-sig.c
index 114370c..dfa0fae 100644
--- a/snd-sig.c
+++ b/snd-sig.c
@@ -5747,13 +5747,13 @@ that give a minimum peak amplitude when the signals are added together."
17827, 17837, 17839, 17851, 17863};
#endif
- static mus_float_t all_mins[128] = {1.0000, 1.7600, 1.9797, 2.0390, 2.3435, 2.5493, 2.6394, 2.7947, 2.9618, 3.1027, 3.2184, 3.3891, 3.5249, 3.6131, 3.7690, 3.8751, 3.9815, 4.1454, 4.2237, 4.2901, 4.4844, 4.5881, 4.6077, 4.7308, 4.8556, 5.0083, 5.0665, 5.1610, 5.2447, 5.3667, 5.4835, 5.5298, 5.6351, 5.7213, 5.7695, 5.9314, 5.9340, 6.1411, 6.1310, 6.3306, 6.3364, 6.4658, 6.4824, 6.5525, 6.7031, 6.6997, 6.8394, 6.8711, 6.9216, 7.0407, 7.1289, 7.1497, 7.2114, 7.3372, 7.3621, 7.3719, 7.5207, 7.6146, 7.6748, 7.6195, 7.7868, 7.8677, 7.9218, 7.9862, 8.0570, 8.1118, 8.1712, 8.1976, 8.3626, 8.3468, 8.4245, 8.5148, 8.5279, 8.5725, 8.7008, 8.7247, 8.7400, 8.8593, 8.8770, 8.8986, 9.0237, 9.1158, 9.2037, 9.0496, 9.2689, 9.2397, 9.3995, 9.3913, 9.5523, 9.5718, 9.5660, 9.6547, 9.7038, 10.0367, 10.0036, 9.9564, 9.8937, 9.8164, 9.9063, 10.2353, 10.2223, 10.2586, 10.3631, 10.1881, 10.2269, 10.3949, 10.5097, 10.5434, 10.7085, 10.7391, 10.6273, 10.6695, 10.8235, 10.8344, 10.9368, 10.8960, 10.9612, 11.0541, 11.1182, 11.0013, 11.2427, 11.1853, 11.2551, 11.3159, 11.4204, 11.3113, 11.4579, 11.6095};
+ static mus_float_t all_mins[128] = {1.0000, 1.7600, 1.9797, 2.0390, 2.3435, 2.5493, 2.6394, 2.7947, 2.9618, 3.1027, 3.2184, 3.3891, 3.5249, 3.6131, 3.7690, 3.8751, 3.9815, 4.1454, 4.2237, 4.2901, 4.4844, 4.5881, 4.6077, 4.7308, 4.8556, 5.0083, 5.0665, 5.1610, 5.2447, 5.3667, 5.4835, 5.5298, 5.6351, 5.7213, 5.7695, 5.9314, 5.9340, 6.1411, 6.1310, 6.2990, 6.3364, 6.4658, 6.4824, 6.5525, 6.7031, 6.6997, 6.8394, 6.8711, 6.9216, 7.0407, 7.1289, 7.1497, 7.2114, 7.3372, 7.3621, 7.3719, 7.5207, 7.6146, 7.6748, 7.6195, 7.7868, 7.8677, 7.9218, 7.9862, 8.0570, 8.1118, 8.1712, 8.1976, 8.2898, 8.3468, 8.4245, 8.5093, 8.5279, 8.5725, 8.6899, 8.6755, 8.7312, 8.7941, 8.8770, 8.8986, 8.9940, 9.1087, 9.1618, 9.0496, 9.2065, 9.2397, 9.3910, 9.3913, 9.4726, 9.4791, 9.5289, 9.6547, 9.7038, 9.9947, 9.8722, 9.8586, 9.8937, 9.8164, 9.9063, 10.2353, 10.2223, 10.2586, 10.3631, 10.1881, 10.2269, 10.3949, 10.5097, 10.5434, 10.7085, 10.7391, 10.6273, 10.6695, 10.8235, 10.8344, 10.9368, 10.8960, 10.9612, 11.0541, 11.1182, 11.0013, 11.2427, 11.1853, 11.2551, 11.3159, 11.4204, 11.3113, 11.4579, 11.5735};
- static mus_float_t odd_mins[128] = {1.0000, 1.5390, 1.7387, 2.0452, 2.3073, 2.5227, 2.6184, 2.7908, 2.8865, 3.0538, 3.1771, 3.3627, 3.4755, 3.5994, 3.7398, 3.8582, 3.9278, 4.0712, 4.1739, 4.3601, 4.4504, 4.5828, 4.6639, 4.7891, 4.8892, 5.0085, 5.0916, 5.0926, 5.2674, 5.3569, 5.4235, 5.5676, 5.6070, 5.7451, 5.8382, 5.9961, 6.0249, 6.1502, 6.1875, 6.2779, 6.3276, 6.4085, 6.4809, 6.6048, 6.6310, 6.7167, 6.8698, 6.9153, 6.9979, 6.9553, 7.1024, 7.0875, 7.2779, 7.3707, 7.4259, 7.4388, 7.4982, 7.6006, 7.6434, 7.7768, 7.7859, 7.8935, 7.9226, 8.0768, 8.0648, 8.1870, 8.2449, 8.3151, 8.3506, 8.3994, 8.5486, 8.6664, 8.5958, 8.5058, 8.7265, 8.6919, 8.7389, 8.8023, 9.0193, 8.9753, 8.9849, 8.9914, 9.1609, 9.3298, 9.4562, 9.4890, 9.4658, 9.5579, 9.5501, 9.6256, 9.6182, 9.7295, 9.8966, 9.9812, 9.8316, 9.9047, 9.9869, 10.1411, 10.2010, 10.2555, 10.1560, 10.1469, 10.3462, 10.5267, 10.4302, 10.4460, 10.7580, 10.7397, 10.8339, 10.5415, 10.7940, 10.9792, 10.7634, 10.8663, 11.0598, 11.0172, 11.0980, 11.3184, 11.2804, 11.3022, 11.3530, 11.3593, 11.5386, 11.4548, 11.7003, 11.6207, 11.6314, 11.6254};
+ static mus_float_t odd_mins[128] = {1.0000, 1.5390, 1.7387, 2.0452, 2.3073, 2.5227, 2.6184, 2.7908, 2.8865, 3.0538, 3.1771, 3.3627, 3.4755, 3.5994, 3.7398, 3.8582, 3.9278, 4.0712, 4.1739, 4.3601, 4.4504, 4.5828, 4.6639, 4.7891, 4.8892, 5.0085, 5.0916, 5.0926, 5.2674, 5.3569, 5.4235, 5.5676, 5.6070, 5.7451, 5.8382, 5.9961, 6.0249, 6.1502, 6.1875, 6.2779, 6.3276, 6.4085, 6.4809, 6.6048, 6.6310, 6.7167, 6.7934, 6.9153, 6.9979, 6.9553, 7.1024, 7.0875, 7.2716, 7.3417, 7.3809, 7.4388, 7.4982, 7.6006, 7.6434, 7.7158, 7.7859, 7.8935, 7.9226, 8.0638, 8.0634, 8.1577, 8.1895, 8.3132, 8.2868, 8.3994, 8.5445, 8.6054, 8.5776, 8.5058, 8.6837, 8.6919, 8.7389, 8.8023, 9.0193, 8.9753, 8.9788, 8.9488, 9.0984, 9.2632, 9.3536, 9.3989, 9.4015, 9.3742, 9.3775, 9.5105, 9.5171, 9.6345, 9.8225, 9.9263, 9.7666, 9.8485, 9.9084, 10.0416, 10.1173, 10.2308, 9.9903, 10.1408, 10.1685, 10.4759, 10.1929, 10.2708, 10.5647, 10.4063, 10.7127, 10.4618, 10.7069, 10.8207, 10.7143, 10.7456, 10.9229, 10.9908, 11.0378, 11.0121, 11.2060, 11.0803, 11.2518, 11.2465, 11.3848, 11.4169, 11.5034, 11.5060, 11.5317, 11.5363};
static mus_float_t prime_mins[128] = {1.0000, 1.7600, 1.9798, 2.1921, 2.4768, 2.8055, 3.0619, 3.2630, 3.3824, 3.6023, 3.7790, 3.9366, 4.1551, 4.3254, 4.4680, 4.6025, 4.7203, 4.8567, 5.0167, 5.1901, 5.3299, 5.4469, 5.5674, 5.6505, 5.8178, 6.0653, 6.2081, 6.1965, 6.3721, 6.4568, 6.7151, 6.8684, 6.9144, 7.0538, 7.2291, 7.4042, 7.3551, 7.5736, 7.6340, 7.8117, 7.8967, 8.0162, 8.1174, 8.2153, 8.3261, 8.3882, 8.4967, 8.6045, 8.7217, 8.6988, 8.8050, 9.0379, 9.2928, 9.2154, 9.4256, 9.5635, 9.6958, 9.8552, 9.5883, 9.7591, 10.0939, 10.1512, 9.9367, 10.2679, 10.4742, 10.5562, 10.5489, 10.6922, 10.7636, 10.6987, 10.8841, 11.0362, 11.1187, 11.1436, 11.2561, 11.2994, 11.2399, 11.6393, 11.8223, 11.8510, 11.6859, 11.7939, 11.7819, 12.0045, 12.0393, 11.8403, 12.2786, 12.2679, 12.6520, 12.5783, 12.6296, 12.5320, 12.7409, 12.7509, 13.1423, 13.2047, 13.1303, 13.2481, 13.4171, 13.3503, 13.3679, 13.7348, 13.7727, 13.9934, 13.7340, 14.0443, 14.1183, 14.2221, 14.4192, 14.4269, 14.3588, 14.5122, 14.7860, 14.9489, 15.0036, 15.0120, 15.1811, 15.1379, 15.0064, 15.0844, 15.3211, 15.2519, 15.2207, 15.5409, 15.3624, 15.5629, 15.4239, 15.6868};
- static mus_float_t even_mins[128] = {1.0000, 1.7602, 2.0215, 2.4306, 2.6048, 2.8370, 3.0470, 3.1976, 3.4541, 3.5589, 3.6567, 3.7876, 3.9730, 4.0977, 4.1935, 4.3263, 4.4641, 4.5708, 4.7435, 4.8413, 4.9220, 5.0576, 5.1502, 5.2557, 5.4056, 5.4549, 5.6237, 5.7353, 5.7702, 5.9106, 5.9916, 6.0655, 6.1677, 6.2295, 6.4106, 6.4373, 6.5928, 6.5424, 6.7059, 6.7612, 6.8935, 7.0027, 7.0857, 7.1093, 7.1927, 7.2979, 7.3019, 7.4741, 7.6083, 7.6769, 7.6935, 7.8595, 7.7909, 7.8551, 8.1266, 8.1272, 8.1679, 8.2030, 8.2668, 8.3491, 8.4989, 8.5178, 8.5214, 8.5428, 8.7498, 8.8361, 8.9449, 8.9162, 8.9507, 9.0589, 9.2257, 9.1672, 9.3022, 9.3442, 9.3153, 9.4911, 9.5493, 9.7227, 9.7698, 9.7945, 9.9100, 9.9160, 9.9643, 9.9899, 10.0436, 10.0417, 10.2341, 10.2605, 10.2827, 10.4233, 10.3655, 10.5118, 10.5293, 10.6077, 10.8473, 10.8592, 10.8360, 10.8787, 10.9353, 10.8423, 11.0427, 11.0249, 11.2949, 11.3593, 11.1536, 11.2098, 11.3802, 11.4609, 11.4679, 11.5772, 11.6903, 11.5359, 11.6486, 11.8523, 11.6766, 11.8266, 11.8565, 11.9652, 12.0542, 12.1077, 11.9984, 12.2357, 12.1634, 12.1932, 12.3046, 12.4478, 12.3309, 12.4465};
+ static mus_float_t even_mins[128] = {1.0000, 1.7602, 2.0215, 2.4306, 2.6048, 2.8370, 3.0470, 3.1976, 3.4541, 3.5589, 3.6567, 3.7876, 3.9730, 4.0977, 4.1935, 4.3263, 4.4641, 4.5708, 4.7435, 4.8413, 4.9220, 5.0576, 5.1502, 5.2557, 5.4056, 5.4549, 5.6237, 5.7353, 5.7702, 5.9106, 5.9916, 6.0655, 6.1677, 6.2295, 6.4106, 6.4373, 6.5928, 6.5424, 6.7059, 6.7612, 6.8935, 7.0027, 7.0857, 7.1093, 7.1927, 7.2979, 7.3019, 7.4741, 7.6083, 7.6769, 7.6935, 7.8595, 7.7909, 7.8551, 8.1266, 8.1272, 8.1679, 8.2030, 8.2668, 8.3491, 8.4989, 8.5178, 8.5214, 8.5428, 8.7498, 8.8361, 8.9449, 8.9162, 8.9507, 9.0589, 9.2257, 9.1672, 9.3022, 9.3442, 9.3153, 9.4911, 9.5493, 9.7175, 9.7698, 9.7945, 9.8865, 9.9160, 9.9643, 9.9899, 10.0399, 10.0417, 10.2341, 10.2605, 10.2827, 10.4233, 10.3655, 10.5118, 10.5293, 10.6077, 10.8473, 10.8592, 10.8360, 10.8787, 10.8004, 10.8423, 11.0427, 11.0249, 11.2471, 11.3501, 11.1536, 11.2098, 11.3802, 11.4609, 11.4679, 11.5772, 11.6903, 11.5359, 11.6486, 11.8038, 11.6766, 11.8266, 11.8565, 11.9443, 12.0367, 12.1077, 11.9860, 12.2357, 12.1634, 12.1932, 12.3046, 12.4014, 12.3026, 12.4465};
static mus_float_t min_8[4] = {19.4199, 19.7800, 21.1471, 25.4193};
static mus_float_t min_9[4] = {31.3912, 31.6276, 31.6281, 40.2509};
@@ -5782,14 +5782,16 @@ static mus_float_t local_frandom(mus_float_t val)
}
-#define S_fpsa "fpsa"
-
typedef struct {
mus_float_t pk;
mus_float_t *phases;
} pk_data;
+#if 0
+
+#define S_fpsa "fpsa"
+
static XEN g_fpsa(XEN x_choice, XEN x_n, XEN x_size, XEN x_increment, XEN x_counts, XEN x_file, XEN x_just_best)
{
#define H_fpsa "(" S_fpsa " choice n (size 2000) (increment 1.0) (counts 50) (output-file \"test.data\") (report-best #t)) searches \
@@ -6608,6 +6610,7 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
return(xen_make_vct(n, min_phases));
}
+#endif
@@ -6718,8 +6721,6 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
mx_cos = mxtemp;
}
- return(mx_sin); /* ignore cos case since we're trying to follow a path */
-
if (mx_sin <= mx_cos)
return(mx_sin);
@@ -6893,7 +6894,7 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
increment = XEN_TO_C_DOUBLE(x_increment);
else increment = 0.06; /* was .03 */
- counts = 100;
+ counts = 50; /* was 100 */
orig_incr = increment;
incr_mult = INCR_DOWN;
file = "test.data";
@@ -6936,67 +6937,63 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
choices[start]->phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
}
-
+ free_top = 0;
+ day_counter = 0;
+ local_best = (mus_float_t)n;
+ increment = orig_incr;
+
+ for (start = 0; start < size; start++)
{
- free_top = 0;
- day_counter = 0;
- local_best = (mus_float_t)n;
- increment = orig_incr;
-
- for (start = 0; start < size; start++)
+ mus_float_t pk, local_pk = 100000.0;
+ int k, init_try;
+
+ for (init_try = 0; init_try < INIT_TRIES; init_try++)
{
- mus_float_t pk, local_pk = 100000.0;
- int k, init_try;
-
- for (init_try = 0; init_try < INIT_TRIES; init_try++)
+ if (initial_phases)
{
- if (initial_phases)
- {
- for (k = 1; k < n; k++)
- temp_phases[k] = initial_phases[k] + local_random(increment);
- }
- else
- {
- for (k = 1; k < n; k++)
- temp_phases[k] = local_frandom(2.0);
- }
- pk = get_peak(temp_phases);
-
- if (pk < local_best)
+ for (k = 1; k < n; k++)
+ temp_phases[k] = initial_phases[k] + local_random(increment);
+ }
+ else
+ {
+ for (k = 1; k < n; k++)
+ temp_phases[k] = local_frandom(2.0);
+ }
+ pk = get_peak(temp_phases);
+
+ if (pk < local_best)
+ {
+ local_best = pk;
+ if ((!just_best) ||
+ (pk < overall_min))
{
- local_best = pk;
- if ((!just_best) ||
- (pk < overall_min))
+ FILE *ofile;
+ for (k = 1; k < n; k++) min_phases[k] = temp_phases[k];
+ if (pk < overall_min)
{
- FILE *ofile;
- for (k = 1; k < n; k++) min_phases[k] = temp_phases[k];
- if (pk < overall_min)
- {
- if (file)
- ofile = fopen(file, "a");
- else ofile = stderr;
- fprintf(ofile, "[%d, %f, %f]: %s, %d %f #(", size, orig_incr, increment, choice_name[choice], n, pk);
- for (k = 0; k < n - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
- fprintf(ofile, "%f)\n\n", min_phases[n - 1]);
- if (file) fclose(ofile);
- overall_min = pk;
- }
+ if (file)
+ ofile = fopen(file, "a");
+ else ofile = stderr;
+ fprintf(ofile, "[%d, %f, %f]: %s, %d %f #(", size, orig_incr, increment, choice_name[choice], n, pk);
+ for (k = 0; k < n - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
+ fprintf(ofile, "%f)\n\n", min_phases[n - 1]);
+ if (file) fclose(ofile);
+ overall_min = pk;
}
}
-
- if (pk < local_pk)
- {
- for (k = 1; k < n; k++) choices[start]->phases[k] = temp_phases[k];
- choices[start]->pk = pk;
- local_pk = pk;
- }
+ }
+
+ if (pk < local_pk)
+ {
+ for (k = 1; k < n; k++) choices[start]->phases[k] = temp_phases[k];
+ choices[start]->pk = pk;
+ local_pk = pk;
}
}
-
- while (day()) {}
}
+ while (day()) {}
}
-
+
free(temp_phases);
free(diff_phases);
free(rl);
@@ -7017,11 +7014,11 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
return(XEN_LIST_2(C_TO_XEN_DOUBLE(local_best),
xen_make_vct(n, min_phases)));
}
-
#endif
+
#ifdef XEN_ARGIFY_1
XEN_ARGIFY_6(g_scan_chan_w, g_scan_chan)
XEN_ARGIFY_7(g_map_chan_w, g_map_chan)
@@ -7064,8 +7061,10 @@ XEN_NARGIFY_1(g_set_sinc_width_w, g_set_sinc_width)
XEN_ARGIFY_9(g_ptree_channel_w, g_ptree_channel)
#if HAVE_NESTED_FUNCTIONS
XEN_VARGIFY(g_find_min_peak_phases_w, g_find_min_peak_phases)
+#if 0
XEN_ARGIFY_7(g_fpsa_w, g_fpsa)
XEN_ARGIFY_9(g_fpsaf_w, g_fpsaf)
+#endif
XEN_ARGIFY_5(g_fpsap_w, g_fpsap)
#endif
#else
@@ -7110,8 +7109,10 @@ XEN_ARGIFY_5(g_fpsap_w, g_fpsap)
#define g_ptree_channel_w g_ptree_channel
#if HAVE_NESTED_FUNCTIONS
#define g_find_min_peak_phases_w g_find_min_peak_phases
+#if 0
#define g_fpsa_w g_fpsa
#define g_fpsaf_w g_fpsaf
+#endif
#define g_fpsap_w g_fpsap
#endif
#endif
@@ -7163,8 +7164,10 @@ void g_init_sig(void)
S_setB S_sinc_width, g_set_sinc_width_w, 0, 0, 1, 0);
#if HAVE_NESTED_FUNCTIONS
XEN_DEFINE_PROCEDURE(S_find_min_peak_phases, g_find_min_peak_phases_w, 0, 0, 1, H_find_min_peak_phases);
+#if 0
XEN_DEFINE_PROCEDURE(S_fpsa, g_fpsa_w, 2, 5, 0, H_fpsa);
XEN_DEFINE_PROCEDURE(S_fpsaf, g_fpsaf_w, 3, 6, 0, H_fpsaf);
+#endif
XEN_DEFINE_PROCEDURE(S_fpsap, g_fpsap_w, 3, 2, 0, H_fpsap);
#endif
}
diff --git a/snd-snd.c b/snd-snd.c
index 750de0e..3e6194e 100644
--- a/snd-snd.c
+++ b/snd-snd.c
@@ -2372,10 +2372,7 @@ void call_sp_watchers(snd_info *sp, sp_watcher_t type, sp_watcher_reason_t reaso
* ref needed: mix? region selection sound
* set needed: selection? sound
*
- * possible new objects: menu-item, file-filter|sorter, fft-window?, color? widget? variable-graph?
- * PERHAPS: make widgets and colors (at least) scheme-level object via make-type, look for other car=type name cases
- * this affects xm.c: new-types has the (very long) list.
- * But how to deal with C-side issues (clm.c methods that call defgenerator methods for example).
+ * possible new objects: menu-item, file-filter|sorter, fft-window?, variable-graph?
*
* (scan-channel -> channel-for-each)
* and channel-map rather than map-channel
diff --git a/snd-test.scm b/snd-test.scm
index 3a0586e..d6a8cba 100644
--- a/snd-test.scm
+++ b/snd-test.scm
@@ -33,142 +33,146 @@
(define tests 1)
(define keep-going #f)
-(define all-args #f)
+(define all-args #t)
(define test-at-random 0)
-;(show-ptree 1)
+ ;(show-ptree 1)
(define profiling #f)
-;(set! *load-hook* (lambda (name) (format #t "load ~S~%" name)))
+ ;(set! *load-hook* (lambda (name) (format #t "load ~S~%" name)))
(if (<= tests 0) (set! tests 1))
-(if (defined? 'run-clear-counts) (run-clear-counts))
+(set! *#readers*
+ (cons (cons #\_ (lambda (str)
+ (if (string=? str "__line__")
+ (port-line-number)
+ #f)))
+ *#readers*))
- (define O_RDWR 2)
- (define O_APPEND 1024)
- (define O_RDONLY 0)
+(if (defined? 'run-clear-counts) (run-clear-counts))
- (define (copy-file src dest) (system (string-append "cp " src " " dest)))
+(define O_RDWR 2)
+(define O_APPEND 1024)
+(define O_RDONLY 0)
- (define (procedure-property func prop)
- (if (eq? prop 'arity)
- (procedure-arity func)
- (procedure-documentation func)))
+(define (copy-file src dest) (system (string-append "cp " src " " dest)))
- (define (string-downcase str)
- (let* ((len (string-length str))
- (newstr (make-string len)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (string-set! newstr i (char-downcase (string-ref str i))))
- newstr))
+(define (procedure-property func prop)
+ (if (eq? prop 'arity)
+ (procedure-arity func)
+ (procedure-documentation func)))
- (define (sort lst . opt) (sort! lst (if (null? opt) < (car opt))))
+(define (string-downcase str)
+ (let* ((len (string-length str))
+ (newstr (make-string len)))
+ (do ((i 0 (+ 1 i)))
+ ((= i len))
+ (string-set! newstr i (char-downcase (string-ref str i))))
+ newstr))
+
+(define (sort lst . opt) (sort! lst (if (null? opt) < (car opt))))
+
+(define* (cfft! data n (dir 1))
+ (if (not n) (set! n (length data)))
+ (do ((i 0 (+ i 1))
+ (j 0))
+ ((= i n))
+ (if (> j i)
+ (let ((temp (data j)))
+ (set! (data j) (data i))
+ (set! (data i) temp)))
+ (let ((m (/ n 2)))
+ (do ()
+ ((or (< m 2) (< j m)))
+ (set! j (- j m))
+ (set! m (/ m 2)))
+ (set! j (+ j m))))
+ (let ((ipow (floor (log n 2)))
+ (prev 1))
+ (do ((lg 0 (+ lg 1))
+ (mmax 2 (* mmax 2))
+ (pow (/ n 2) (/ pow 2))
+ (theta (make-rectangular 0.0 (* pi dir)) (* theta 0.5)))
+ ((= lg ipow))
+ (let ((wpc (exp theta))
+ (wc 1.0))
+ (do ((ii 0 (+ ii 1)))
+ ((= ii prev))
+ (do ((jj 0 (+ jj 1))
+ (i ii (+ i mmax))
+ (j (+ ii prev) (+ j mmax)))
+ ((>= jj pow))
+ (let ((tc (* wc (data j))))
+ (set! (data j) (- (data i) tc))
+ (set! (data i) (+ (data i) tc))))
+ (set! wc (* wc wpc)))
+ (set! prev mmax))))
+ data)
+
+(define* (fft! rl im n (dir 1))
+ (if (not im)
+ (let ((clear (copy rl)))
+ (fill! clear 0.0)
+ (set! im clear)))
+ (if (not n)
+ (set! n (length rl)))
+ (do ((i 0 (+ i 1))
+ (j 0))
+ ((= i n))
+ (if (> j i)
+ (let ((tempr (rl j))
+ (tempi (im j)))
+ (set! (rl j) (rl i))
+ (set! (im j) (im i))
+ (set! (rl i) tempr)
+ (set! (im i) tempi)))
+ (let ((m (/ n 2)))
+ (do ()
+ ((or (< m 2) (< j m)))
+ (set! j (- j m))
+ (set! m (/ m 2)))
+ (set! j (+ j m))))
+ (let ((ipow (floor (log n 2)))
+ (prev 1))
+ (do ((lg 0 (+ lg 1))
+ (mmax 2 (* mmax 2))
+ (pow (/ n 2) (/ pow 2))
+ (theta (* pi dir) (* theta 0.5)))
+ ((= lg ipow))
+ (let ((wpr (cos theta))
+ (wpi (sin theta))
+ (wr 1.0)
+ (wi 0.0))
+ (do ((ii 0 (+ ii 1)))
+ ((= ii prev))
+ (do ((jj 0 (+ jj 1))
+ (i ii (+ i mmax))
+ (j (+ ii prev) (+ j mmax)))
+ ((>= jj pow))
+ (let ((tempr (- (* wr (rl j)) (* wi (im j))))
+ (tempi (+ (* wr (im j)) (* wi (rl j)))))
+ (set! (rl j) (- (rl i) tempr))
+ (set! (im j) (- (im i) tempi))
+ (set! (rl i) (+ (rl i) tempr))
+ (set! (im i) (+ (im i) tempi))))
+ (let ((wtemp wr))
+ (set! wr (- (* wr wpr) (* wi wpi)))
+ (set! wi (+ (* wi wpr) (* wtemp wpi)))))
+ (set! prev mmax))))
+ rl)
- (define* (cfft! data n (dir 1))
- (if (not n) (set! n (length data)))
- (do ((i 0 (+ i 1))
- (j 0))
- ((= i n))
- (if (> j i)
- (let ((temp (data j)))
- (set! (data j) (data i))
- (set! (data i) temp)))
- (let ((m (/ n 2)))
- (do ()
- ((or (< m 2) (< j m)))
- (set! j (- j m))
- (set! m (/ m 2)))
- (set! j (+ j m))))
- (let ((ipow (floor (log n 2)))
- (prev 1))
- (do ((lg 0 (+ lg 1))
- (mmax 2 (* mmax 2))
- (pow (/ n 2) (/ pow 2))
- (theta (make-rectangular 0.0 (* pi dir)) (* theta 0.5)))
- ((= lg ipow))
- (let ((wpc (exp theta))
- (wc 1.0))
- (do ((ii 0 (+ ii 1)))
- ((= ii prev))
- (do ((jj 0 (+ jj 1))
- (i ii (+ i mmax))
- (j (+ ii prev) (+ j mmax)))
- ((>= jj pow))
- (let ((tc (* wc (data j))))
- (set! (data j) (- (data i) tc))
- (set! (data i) (+ (data i) tc))))
- (set! wc (* wc wpc)))
- (set! prev mmax))))
- data)
-
- (define* (fft! rl im n (dir 1))
- (if (not im)
- (let ((clear (copy rl)))
- (fill! clear 0.0)
- (set! im clear)))
- (if (not n)
- (set! n (length rl)))
- (do ((i 0 (+ i 1))
- (j 0))
- ((= i n))
- (if (> j i)
- (let ((tempr (rl j))
- (tempi (im j)))
- (set! (rl j) (rl i))
- (set! (im j) (im i))
- (set! (rl i) tempr)
- (set! (im i) tempi)))
- (let ((m (/ n 2)))
- (do ()
- ((or (< m 2) (< j m)))
- (set! j (- j m))
- (set! m (/ m 2)))
- (set! j (+ j m))))
- (let ((ipow (floor (log n 2)))
- (prev 1))
- (do ((lg 0 (+ lg 1))
- (mmax 2 (* mmax 2))
- (pow (/ n 2) (/ pow 2))
- (theta (* pi dir) (* theta 0.5)))
- ((= lg ipow))
- (let ((wpr (cos theta))
- (wpi (sin theta))
- (wr 1.0)
- (wi 0.0))
- (do ((ii 0 (+ ii 1)))
- ((= ii prev))
- (do ((jj 0 (+ jj 1))
- (i ii (+ i mmax))
- (j (+ ii prev) (+ j mmax)))
- ((>= jj pow))
- (let ((tempr (- (* wr (rl j)) (* wi (im j))))
- (tempi (+ (* wr (im j)) (* wi (rl j)))))
- (set! (rl j) (- (rl i) tempr))
- (set! (im j) (- (im i) tempi))
- (set! (rl i) (+ (rl i) tempr))
- (set! (im i) (+ (im i) tempi))))
- (let ((wtemp wr))
- (set! wr (- (* wr wpr) (* wi wpi)))
- (set! wi (+ (* wi wpr) (* wtemp wpi)))))
- (set! prev mmax))))
- rl)
-
(if (not (defined? 'snd-test)) (define snd-test -1))
(define full-test (< snd-test 0))
(define total-tests 28)
(if (not (defined? 'with-exit)) (define with-exit (< snd-test 0)))
(define test-number -1)
-(define (snd-display . args)
+(define (snd-display line . args)
(let ((str (if (null? (cdr args))
(car args)
(apply format #f args))))
- (newline)
- (display str)
+ (format #t "~%~A: ~8T~A" line str)
(if (not (provided? 'snd-nogui))
- (begin
- (snd-print #\newline)
- (snd-print str)))))
+ (snd-print (format #f "~%~A: ~A" line str)))))
(define with-big-file #f)
(define big-file-name "/home/bil/zap/sounds/bigger.snd")
@@ -176,7 +180,7 @@
(not (string=? (version) "1.8.0")))
(begin
(set! with-big-file (file-exists? big-file-name))
- (if (not with-big-file) (snd-display ";no big file"))))
+ (if (not with-big-file) (snd-display #__line__ ";no big file"))))
(define big-file-frames 0)
(define original-save-dir (or (save-dir) "~/zap/snd"))
@@ -218,7 +222,7 @@
(set! sf-dir1 (string-append home-dir sf-dir "/"))
(if (not (file-exists? (string-append sf-dir1 "alaw.wav")))
(begin
- (snd-display ";;;can't find sf directory!")
+ (snd-display #__line__ ";;;can't find sf directory!")
(set! sf-dir1 #f)))))
(set! sf-dir sf-dir1)
@@ -447,7 +451,7 @@
"display-edits but catch all errors"
(catch #t
(lambda () (display-edits snd chn edpos with-source))
- (lambda args (snd-display ";display-edits error: ~A" args))))
+ (lambda args (snd-display #__line__ ";display-edits error: ~A" args))))
(define (safe-divide a b)
"divide but check for 0 denom"
@@ -458,7 +462,7 @@
(define timings (make-vector (+ total-tests 1) 0))
(define default-srate (mus-srate))
-(snd-display ";;~A" (snd-version))
+(snd-display #__line__ ";;~A" (snd-version))
(if (not (defined? 'before-test-hook)) (define before-test-hook (make-hook 1)))
(if (not (defined? 'after-test-hook)) (define after-test-hook (make-hook 1)))
(reset-hook! before-test-hook)
@@ -469,7 +473,7 @@
(set! (mus-clipping) #f) ; this cost me a morning of confusion!
(set! test-number n)
(vector-set! timings n (real-time))
- (snd-display ";test ~D" n)
+ (snd-display #__line__ ";test ~D" n)
))
@@ -481,7 +485,7 @@
(lambda (n)
(forget-region n))
regs))
-
+
(system (format #f "rm -f ~A/snd_*" (or (save-dir) original-save-dir)))
(if (file-exists? "/var/tmp")
(system (format #f "rm -f /var/tmp/snd_save_*")))
@@ -497,16 +501,16 @@
(if (not (null? (sounds)))
(begin
- (snd-display ";end test ~D: open sounds: ~A" n (map short-file-name (sounds)))
+ (snd-display #__line__ ";end test ~D: open sounds: ~A" n (map short-file-name (sounds)))
(for-each close-sound (sounds))))
(if (number? (vector-ref timings n))
(vector-set! timings n (hundred (- (real-time) (vector-ref timings n)))))))
(define overall-start-time (real-time))
-(snd-display ";~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+(snd-display #__line__ ";~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
(define (log-mem tst)
- (if (> tests 1) (begin (snd-display ";test ~D:~D " test-number (+ 1 tst)) )))
+ (if (> tests 1) (begin (snd-display #__line__ ";test ~D:~D " test-number (+ 1 tst)) )))
(defmacro without-errors (func)
`(catch #t
@@ -539,7 +543,7 @@
(define (set-arity-ok func args)
"set proc accepts args"
(let ((arity (if (procedure-with-setter? func)
- (procedure-with-setter-setter-arity func)
+ (cdddr (procedure-arity func))
(procedure-arity func))))
(and (list-p arity)
(>= args (car arity))
@@ -552,9 +556,9 @@
(let ((arg (script-arg))
(args (script-args)))
(if (not (string=? (list-ref args (- arg 1)) "-l"))
- (snd-display ";script-args[~A]: ~A (~A)?" (- arg 1) (list-ref args (- arg 1)) args))
+ (snd-display #__line__ ";script-args[~A]: ~A (~A)?" (- arg 1) (list-ref args (- arg 1)) args))
(if (not (string=? (list-ref args arg) "snd-test"))
- (snd-display ";script-args[~A]: ~A (~A)?" arg (list-ref args arg) args))
+ (snd-display #__line__ ";script-args[~A]: ~A (~A)?" arg (list-ref args arg) args))
(if (> (length args) (+ 1 arg))
(begin
;; test-number tests
@@ -591,9 +595,9 @@
(set! (mus-file-buffer-size) default-file-buffer-size)
(if (not (defined? 'pi))
- (snd-display ";pi is not defined!")
+ (snd-display #__line__ ";pi is not defined!")
(if (fneq pi 3.14159)
- (snd-display ";pi is ~A" pi)))
+ (snd-display #__line__ ";pi is ~A" pi)))
;;; ---------------- test 0: constants ----------------
@@ -604,7 +608,7 @@
(if (not (null? lst))
(begin
(if (not (= (cadr lst) (caddr lst)))
- (snd-display ";~A /= ~A (~A)~%"
+ (snd-display #__line__ ";~A /= ~A (~A)~%"
(car lst) (cadr lst) (caddr lst)))
(test-constants (cdddr lst)))))))
@@ -612,7 +616,7 @@
(not (null? (mixes)))
(not (null? (marks)))
(not (null? (regions))))
- (snd-display ";start up: ~A ~A ~A ~A" (sounds) (mixes) (marks) (regions)))
+ (snd-display #__line__ ";start up: ~A ~A ~A ~A" (sounds) (mixes) (marks) (regions)))
(test-constants
(list
'enved-amplitude enved-amplitude 0
@@ -765,366 +769,366 @@
(set! (region-graph-style) (region-graph-style))
(if (not (equal? (region-graph-style) graph-lines))
- (snd-display ";region-graph-style set def: ~A" (region-graph-style)))
+ (snd-display #__line__ ";region-graph-style set def: ~A" (region-graph-style)))
(set! (ask-before-overwrite) (ask-before-overwrite))
(if (not (equal? (ask-before-overwrite) #f))
- (snd-display ";ask-before-overwrite set def: ~A" (ask-before-overwrite)))
+ (snd-display #__line__ ";ask-before-overwrite set def: ~A" (ask-before-overwrite)))
(set! (audio-output-device) (audio-output-device))
(if (not (equal? (audio-output-device) 0))
- (snd-display ";audio-output-device set def: ~A" (audio-output-device)))
+ (snd-display #__line__ ";audio-output-device set def: ~A" (audio-output-device)))
(set! (auto-resize) (auto-resize))
(if (not (equal? (auto-resize) #t ))
- (snd-display ";auto-resize set def: ~A" (auto-resize)))
+ (snd-display #__line__ ";auto-resize set def: ~A" (auto-resize)))
(set! (auto-update) (auto-update))
(if (not (equal? (auto-update) #f))
- (snd-display ";auto-update set def: ~A" (auto-update)))
+ (snd-display #__line__ ";auto-update set def: ~A" (auto-update)))
(set! (channel-style) (channel-style))
(if (not (equal? (channel-style) 1 ))
- (snd-display ";channel-style set def: ~A" (channel-style)))
+ (snd-display #__line__ ";channel-style set def: ~A" (channel-style)))
(set! (color-cutoff) (color-cutoff))
(if (fneq (color-cutoff) 0.003 )
- (snd-display ";color-cutoff set def: ~A" (color-cutoff)))
+ (snd-display #__line__ ";color-cutoff set def: ~A" (color-cutoff)))
(set! (color-inverted) (color-inverted))
(if (not (equal? (color-inverted) #t))
- (snd-display ";color-inverted set def: ~A" (color-inverted)))
+ (snd-display #__line__ ";color-inverted set def: ~A" (color-inverted)))
(set! (color-scale) (color-scale))
(if (fneq (color-scale) 1.0 )
- (snd-display ";color-scale set def: ~A" (color-scale)))
+ (snd-display #__line__ ";color-scale set def: ~A" (color-scale)))
(set! (auto-update-interval) (auto-update-interval))
(if (fneq (auto-update-interval) 60.0 )
- (snd-display ";auto-update-interval set def: ~A" (auto-update-interval)))
+ (snd-display #__line__ ";auto-update-interval set def: ~A" (auto-update-interval)))
(set! (cursor-update-interval) (cursor-update-interval))
(if (fneq (cursor-update-interval) 0.05 )
- (snd-display ";cursor-update-interval set def: ~A" (cursor-update-interval)))
+ (snd-display #__line__ ";cursor-update-interval set def: ~A" (cursor-update-interval)))
(set! (cursor-location-offset) (cursor-location-offset))
(if (not (= (cursor-location-offset) 0))
- (snd-display ";cursor-location-offset set def: ~A" (cursor-location-offset)))
+ (snd-display #__line__ ";cursor-location-offset set def: ~A" (cursor-location-offset)))
(set! (dac-combines-channels) (dac-combines-channels))
(if (not (equal? (dac-combines-channels) #t))
- (snd-display ";dac-combines-channels set def: ~A" (dac-combines-channels)))
+ (snd-display #__line__ ";dac-combines-channels set def: ~A" (dac-combines-channels)))
(set! (dac-size) (dac-size))
(if (not (equal? (dac-size) 256 ))
- (snd-display ";dac-size set def: ~A" (dac-size)))
+ (snd-display #__line__ ";dac-size set def: ~A" (dac-size)))
(set! (minibuffer-history-length) (minibuffer-history-length))
(if (not (equal? (minibuffer-history-length) 8))
- (snd-display ";minibuffer-history-length set def: ~A" (minibuffer-history-length)))
+ (snd-display #__line__ ";minibuffer-history-length set def: ~A" (minibuffer-history-length)))
(set! (clipping) (clipping))
(if (not (equal? (clipping) #f ))
- (snd-display ";clipping set def: ~A" (clipping)))
+ (snd-display #__line__ ";clipping set def: ~A" (clipping)))
(set! (default-output-chans) (default-output-chans))
(if (not (equal? (default-output-chans) 1 ))
- (snd-display ";default-output-chans set def: ~A" (default-output-chans)))
+ (snd-display #__line__ ";default-output-chans set def: ~A" (default-output-chans)))
(set! (default-output-data-format) (default-output-data-format))
(if (and (not (equal? (default-output-data-format) mus-bfloat))
(not (equal? (default-output-data-format) mus-lfloat)))
- (snd-display ";default-output-data-format set def: ~A" (default-output-data-format)))
+ (snd-display #__line__ ";default-output-data-format set def: ~A" (default-output-data-format)))
(set! (default-output-srate) (default-output-srate))
(if (not (equal? (default-output-srate) 44100 ))
- (snd-display ";default-output-srate set def: ~A" (default-output-srate)))
+ (snd-display #__line__ ";default-output-srate set def: ~A" (default-output-srate)))
(set! (default-output-header-type) (default-output-header-type))
(if (not (equal? (default-output-header-type) mus-next))
- (snd-display ";default-output-header-type set def: ~A" (default-output-header-type)))
+ (snd-display #__line__ ";default-output-header-type set def: ~A" (default-output-header-type)))
(set! (dot-size) (dot-size))
(if (not (equal? (dot-size) 1 ))
- (snd-display ";dot-size set def: ~A" (dot-size)))
+ (snd-display #__line__ ";dot-size set def: ~A" (dot-size)))
(set! (cursor-size) (cursor-size))
(if (not (equal? (cursor-size) 15 ))
- (snd-display ";cursor-size set def: ~A" (cursor-size)))
+ (snd-display #__line__ ";cursor-size set def: ~A" (cursor-size)))
(set! (cursor-style) (cursor-style))
(if (not (equal? (cursor-style) cursor-cross ))
- (snd-display ";cursor-style set def: ~A" (cursor-style)))
+ (snd-display #__line__ ";cursor-style set def: ~A" (cursor-style)))
(set! (tracking-cursor-style) (tracking-cursor-style))
(if (not (equal? (tracking-cursor-style) cursor-cross ))
- (snd-display ";tracking-cursor-style set def: ~A" (tracking-cursor-style)))
+ (snd-display #__line__ ";tracking-cursor-style set def: ~A" (tracking-cursor-style)))
(set! (enved-base) (enved-base))
(if (fneq (enved-base) 1.0 )
- (snd-display ";enved-base set def: ~A" (enved-base)))
+ (snd-display #__line__ ";enved-base set def: ~A" (enved-base)))
(set! (enved-clip?) (enved-clip?))
(if (not (equal? (enved-clip?) #t ))
- (snd-display ";enved-clip? set def: ~A" (enved-clip?)))
+ (snd-display #__line__ ";enved-clip? set def: ~A" (enved-clip?)))
(set! (enved-filter) (enved-filter))
(if (not (equal? (enved-filter) #t))
- (snd-display ";enved-filter set def: ~A" (enved-filter)))
+ (snd-display #__line__ ";enved-filter set def: ~A" (enved-filter)))
(set! (enved-filter-order) (enved-filter-order))
(if (not (equal? (enved-filter-order) 40))
- (snd-display ";enved-filter-order set def: ~A" (enved-filter-order)))
+ (snd-display #__line__ ";enved-filter-order set def: ~A" (enved-filter-order)))
(set! (enved-in-dB) (enved-in-dB))
(if (not (equal? (enved-in-dB) #f ))
- (snd-display ";enved-in-dB set def: ~A" (enved-in-dB)))
+ (snd-display #__line__ ";enved-in-dB set def: ~A" (enved-in-dB)))
(set! (enved-style) (enved-style))
(if (not (equal? (enved-style) envelope-linear ))
- (snd-display ";enved-style set def: ~A" (enved-style)))
+ (snd-display #__line__ ";enved-style set def: ~A" (enved-style)))
(set! (enved-power) (enved-power))
(if (fneq (enved-power) 3.0)
- (snd-display ";enved-power set def: ~A" (enved-power)))
+ (snd-display #__line__ ";enved-power set def: ~A" (enved-power)))
(set! (enved-target) (enved-target))
(if (not (equal? (enved-target) 0 ))
- (snd-display ";enved-target set def: ~A" (enved-target)))
+ (snd-display #__line__ ";enved-target set def: ~A" (enved-target)))
(set! (enved-wave?) (enved-wave?))
(if (not (equal? (enved-wave?) #f ))
- (snd-display ";enved-wave? set def: ~A" (enved-wave?)))
+ (snd-display #__line__ ";enved-wave? set def: ~A" (enved-wave?)))
(if with-gui
(begin
(set! (enved-envelope) (enved-envelope))
(if (not (equal? (enved-envelope) '()))
- (snd-display ";enved-envelope set def: ~A" (enved-envelope)))))
+ (snd-display #__line__ ";enved-envelope set def: ~A" (enved-envelope)))))
(set! (eps-file) (eps-file))
(if (not (equal? (eps-file) "snd.eps" ))
- (snd-display ";eps-file set def: ~A" (eps-file)))
+ (snd-display #__line__ ";eps-file set def: ~A" (eps-file)))
(set! (eps-bottom-margin) (eps-bottom-margin))
(if (fneq (eps-bottom-margin) 0.0)
- (snd-display ";eps-bottom-margin set def: ~A" (eps-bottom-margin)))
+ (snd-display #__line__ ";eps-bottom-margin set def: ~A" (eps-bottom-margin)))
(set! (eps-left-margin) (eps-left-margin))
(if (fneq (eps-left-margin) 0.0)
- (snd-display ";eps-left-margin set def: ~A" (eps-left-margin)))
+ (snd-display #__line__ ";eps-left-margin set def: ~A" (eps-left-margin)))
(set! (eps-size) (eps-size))
(if (fneq (eps-size) 1.0)
- (snd-display ";eps-size set def: ~A" (eps-size)))
+ (snd-display #__line__ ";eps-size set def: ~A" (eps-size)))
(set! (fft-window-alpha) (fft-window-alpha))
(if (fneq (fft-window-alpha) 0.0 )
- (snd-display ";fft-window-alpha set def: ~A" (fft-window-alpha)))
+ (snd-display #__line__ ";fft-window-alpha set def: ~A" (fft-window-alpha)))
(set! (fft-window-beta) (fft-window-beta))
(if (fneq (fft-window-beta) 0.0 )
- (snd-display ";fft-window-beta set def: ~A" (fft-window-beta)))
+ (snd-display #__line__ ";fft-window-beta set def: ~A" (fft-window-beta)))
(set! (fft-log-frequency) (fft-log-frequency))
(if (not (equal? (fft-log-frequency) #f ))
- (snd-display ";fft-log-frequency set def: ~A" (fft-log-frequency)))
+ (snd-display #__line__ ";fft-log-frequency set def: ~A" (fft-log-frequency)))
(set! (fft-log-magnitude) (fft-log-magnitude))
(if (not (equal? (fft-log-magnitude) #f ))
- (snd-display ";fft-log-magnitude set def: ~A" (fft-log-magnitude)))
+ (snd-display #__line__ ";fft-log-magnitude set def: ~A" (fft-log-magnitude)))
(set! (fft-with-phases) (fft-with-phases))
(if (not (equal? (fft-with-phases) #f ))
- (snd-display ";fft-with-phases set def: ~A" (fft-with-phases)))
+ (snd-display #__line__ ";fft-with-phases set def: ~A" (fft-with-phases)))
(set! (transform-size) (transform-size))
(if (not (equal? (transform-size) 512 ))
- (snd-display ";transform-size set def: ~A" (transform-size)))
+ (snd-display #__line__ ";transform-size set def: ~A" (transform-size)))
(set! (transform-graph-type) (transform-graph-type))
(if (not (equal? (transform-graph-type) graph-once))
- (snd-display ";transform-graph-type set def: ~A" (transform-graph-type)))
+ (snd-display #__line__ ";transform-graph-type set def: ~A" (transform-graph-type)))
(set! (fft-window) (fft-window))
(if (not (equal? (fft-window) 6 ))
- (snd-display ";fft-window set def: ~A" (fft-window)))
+ (snd-display #__line__ ";fft-window set def: ~A" (fft-window)))
(set! (graph-cursor) (graph-cursor))
(if (not (equal? (graph-cursor) 34))
- (snd-display ";graph-cursor set def: ~A" (graph-cursor)))
+ (snd-display #__line__ ";graph-cursor set def: ~A" (graph-cursor)))
(set! (graph-style) (graph-style))
(if (not (equal? (graph-style) graph-lines ))
- (snd-display ";graph-style set def: ~A" (graph-style)))
+ (snd-display #__line__ ";graph-style set def: ~A" (graph-style)))
(set! (graphs-horizontal) (graphs-horizontal))
(if (not (equal? (graphs-horizontal) #t))
- (snd-display ";graphs-horizontal set def: ~A" (graphs-horizontal)))
+ (snd-display #__line__ ";graphs-horizontal set def: ~A" (graphs-horizontal)))
(set! (html-dir) (html-dir))
(if (not (equal? (html-dir) "."))
- (snd-display ";html-dir set def: ~A" (html-dir)))
+ (snd-display #__line__ ";html-dir set def: ~A" (html-dir)))
(set! (html-program) (html-program))
(if (not (equal? (html-program) "firefox"))
- (snd-display ";html-program set def: ~A" (html-program)))
+ (snd-display #__line__ ";html-program set def: ~A" (html-program)))
(set! (just-sounds) (just-sounds))
(if (not (equal? (just-sounds) #f))
- (snd-display ";just-sounds set def: ~A" (just-sounds)))
+ (snd-display #__line__ ";just-sounds set def: ~A" (just-sounds)))
(set! (listener-prompt) (listener-prompt))
(if (not (equal? (listener-prompt) ">" ))
- (snd-display ";listener-prompt set def: ~A" (listener-prompt)))
+ (snd-display #__line__ ";listener-prompt set def: ~A" (listener-prompt)))
(set! (max-transform-peaks) (max-transform-peaks))
(if (not (equal? (max-transform-peaks) 100))
- (snd-display ";max-transform-peaks set def: ~A" (max-transform-peaks)))
+ (snd-display #__line__ ";max-transform-peaks set def: ~A" (max-transform-peaks)))
(set! (max-transform-peaks) -123)
(if (not (equal? (max-transform-peaks) 100))
- (snd-display ";max-transform-peaks set -123: ~A" (max-transform-peaks)))
+ (snd-display #__line__ ";max-transform-peaks set -123: ~A" (max-transform-peaks)))
(set! (max-regions) (max-regions))
(if (not (equal? (max-regions) 16 ))
- (snd-display ";max-regions set def: ~A" (max-regions)))
+ (snd-display #__line__ ";max-regions set def: ~A" (max-regions)))
(set! (max-virtual-ptrees) (max-virtual-ptrees))
(if (not (equal? (max-virtual-ptrees) 32 ))
- (snd-display ";max-virtual-ptrees set def: ~A" (max-virtual-ptrees)))
+ (snd-display #__line__ ";max-virtual-ptrees set def: ~A" (max-virtual-ptrees)))
(set! (min-dB) (min-dB))
(if (fneq (min-dB) -60.0 )
- (snd-display ";min-dB set def: ~A" (min-dB)))
+ (snd-display #__line__ ";min-dB set def: ~A" (min-dB)))
(set! (log-freq-start) (log-freq-start))
(if (fneq (log-freq-start) 32.0 )
- (snd-display ";log-freq-start set def: ~A" (log-freq-start)))
+ (snd-display #__line__ ";log-freq-start set def: ~A" (log-freq-start)))
(set! (selection-creates-region) (selection-creates-region))
(if (not (equal? (selection-creates-region) #t ))
- (snd-display ";selection-creates-region set def: ~A" (selection-creates-region)))
+ (snd-display #__line__ ";selection-creates-region set def: ~A" (selection-creates-region)))
(set! (transform-normalization) (transform-normalization))
(if (not (equal? (transform-normalization) normalize-by-channel))
- (snd-display ";transform-normalization set def: ~A" (transform-normalization)))
+ (snd-display #__line__ ";transform-normalization set def: ~A" (transform-normalization)))
(set! (view-files-sort) (view-files-sort))
(if (not (equal? (view-files-sort) 0 ))
- (snd-display ";view-files-sort set def: ~A" (view-files-sort)))
+ (snd-display #__line__ ";view-files-sort set def: ~A" (view-files-sort)))
(set! (print-length) (print-length))
(if (not (equal? (print-length) 12 ))
- (snd-display ";print-length set def: ~A" (print-length)))
+ (snd-display #__line__ ";print-length set def: ~A" (print-length)))
(set! (save-state-file) (save-state-file))
(if (not (equal? (save-state-file) "saved-snd.scm" ))
- (snd-display ";save-state-file set def: ~A" (save-state-file)))
+ (snd-display #__line__ ";save-state-file set def: ~A" (save-state-file)))
(set! (show-axes) (show-axes))
(if (not (equal? (show-axes) 1))
- (snd-display ";show-axes set def: ~A" (show-axes)))
+ (snd-display #__line__ ";show-axes set def: ~A" (show-axes)))
(set! (show-transform-peaks) (show-transform-peaks))
(if (not (equal? (show-transform-peaks) #f ))
- (snd-display ";show-transform-peaks set def: ~A" (show-transform-peaks)))
+ (snd-display #__line__ ";show-transform-peaks set def: ~A" (show-transform-peaks)))
(set! (show-indices) (show-indices))
(if (not (equal? (show-indices) #f))
- (snd-display ";show-indices set def: ~A" (show-indices)))
+ (snd-display #__line__ ";show-indices set def: ~A" (show-indices)))
(set! (show-marks) (show-marks))
(if (not (equal? (show-marks) #t ))
- (snd-display ";show-marks set def: ~A" (show-marks)))
+ (snd-display #__line__ ";show-marks set def: ~A" (show-marks)))
(set! (show-mix-waveforms) (show-mix-waveforms))
(if (not (equal? (show-mix-waveforms) #t))
- (snd-display ";show-mix-waveforms set def: ~A" (show-mix-waveforms)))
+ (snd-display #__line__ ";show-mix-waveforms set def: ~A" (show-mix-waveforms)))
(set! (show-selection-transform) (show-selection-transform))
(if (not (equal? (show-selection-transform) #f ))
- (snd-display ";show-selection-transform set def: ~A" (show-selection-transform)))
+ (snd-display #__line__ ";show-selection-transform set def: ~A" (show-selection-transform)))
(set! (show-y-zero) (show-y-zero))
(if (not (equal? (show-y-zero) #f ))
- (snd-display ";show-y-zero set def: ~A" (show-y-zero)))
+ (snd-display #__line__ ";show-y-zero set def: ~A" (show-y-zero)))
(set! (show-grid) (show-grid))
(if (not (equal? (show-grid) #f ))
- (snd-display ";show-grid set def: ~A" (show-grid)))
+ (snd-display #__line__ ";show-grid set def: ~A" (show-grid)))
(set! (grid-density) (grid-density))
(if (fneq (grid-density) 1.0)
- (snd-display ";grid-density set def: ~A" (grid-density)))
+ (snd-display #__line__ ";grid-density set def: ~A" (grid-density)))
(set! (show-sonogram-cursor) (show-sonogram-cursor))
(if (not (equal? (show-sonogram-cursor) #f ))
- (snd-display ";show-sonogram-cursor set def: ~A" (show-sonogram-cursor)))
+ (snd-display #__line__ ";show-sonogram-cursor set def: ~A" (show-sonogram-cursor)))
(set! (sinc-width) (sinc-width))
(if (not (equal? (sinc-width) 10 ))
- (snd-display ";sinc-width set def: ~A" (sinc-width)))
+ (snd-display #__line__ ";sinc-width set def: ~A" (sinc-width)))
(set! (spectrum-end) (spectrum-end))
(if (fneq (spectrum-end) 1.0)
- (snd-display ";spectrum-end set def: ~A" (spectrum-end)))
+ (snd-display #__line__ ";spectrum-end set def: ~A" (spectrum-end)))
(set! (spectro-hop) (spectro-hop))
(if (not (equal? (spectro-hop) 4 ))
- (snd-display ";spectro-hop set def: ~A" (spectro-hop)))
+ (snd-display #__line__ ";spectro-hop set def: ~A" (spectro-hop)))
(set! (spectrum-start) (spectrum-start))
(if (fneq (spectrum-start) 0.0 )
- (snd-display ";spectrum-start set def: ~A" (spectrum-start)))
+ (snd-display #__line__ ";spectrum-start set def: ~A" (spectrum-start)))
(set! (spectro-x-angle) (spectro-x-angle))
(if (fneq (spectro-x-angle) (if (provided? 'gl) 300.0 90.0))
- (snd-display ";spectro-x-angle set def: ~A" (spectro-x-angle)))
+ (snd-display #__line__ ";spectro-x-angle set def: ~A" (spectro-x-angle)))
(set! (spectro-x-scale) (spectro-x-scale))
(if (fneq (spectro-x-scale) (if (provided? 'gl) 1.5 1.0))
- (snd-display ";spectro-x-scale set def: ~A" (spectro-x-scale)))
+ (snd-display #__line__ ";spectro-x-scale set def: ~A" (spectro-x-scale)))
(set! (spectro-y-angle) (spectro-y-angle))
(if (fneq (spectro-y-angle) (if (provided? 'gl) 320.0 0.0))
- (snd-display ";spectro-y-angle set def: ~A" (spectro-y-angle)))
+ (snd-display #__line__ ";spectro-y-angle set def: ~A" (spectro-y-angle)))
(set! (spectro-y-scale) (spectro-y-scale))
(if (fneq (spectro-y-scale) 1.0 )
- (snd-display ";spectro-y-scale set def: ~A" (spectro-y-scale)))
+ (snd-display #__line__ ";spectro-y-scale set def: ~A" (spectro-y-scale)))
(set! (spectro-z-angle) (spectro-z-angle))
(if (fneq (spectro-z-angle) (if (provided? 'gl) 0.0 358.0))
- (snd-display ";spectro-z-angle set def: ~A" (spectro-z-angle)))
+ (snd-display #__line__ ";spectro-z-angle set def: ~A" (spectro-z-angle)))
(set! (spectro-z-scale) (spectro-z-scale))
(if (fneq (spectro-z-scale) (if (provided? 'gl) 1.0 0.1))
- (snd-display ";spectro-z-scale set def: ~A" (spectro-z-scale)))
+ (snd-display #__line__ ";spectro-z-scale set def: ~A" (spectro-z-scale)))
(set! (temp-dir) (temp-dir))
(if (not (equal? (temp-dir) #f ))
- (snd-display ";temp-dir set def: ~A" (temp-dir)))
+ (snd-display #__line__ ";temp-dir set def: ~A" (temp-dir)))
(set! (ladspa-dir) (ladspa-dir))
(if (not (equal? (ladspa-dir) #f ))
- (snd-display ";ladspa-dir set def: ~A" (ladspa-dir)))
+ (snd-display #__line__ ";ladspa-dir set def: ~A" (ladspa-dir)))
(set! (peak-env-dir) (peak-env-dir))
(if (not (equal? (peak-env-dir) #f ))
- (snd-display ";peak-env-dir set def: ~A" (peak-env-dir)))
+ (snd-display #__line__ ";peak-env-dir set def: ~A" (peak-env-dir)))
(set! (tiny-font) (tiny-font))
(if (and (not (equal? (tiny-font) "6x12"))
(not (equal? (tiny-font) "Sans 8")))
- (snd-display ";tiny-font set def: ~A" (tiny-font)))
+ (snd-display #__line__ ";tiny-font set def: ~A" (tiny-font)))
(set! (transform-type) (transform-type))
(if (not (equal? (transform-type) fourier-transform ))
- (snd-display ";transform-type set def: ~A" (transform-type)))
+ (snd-display #__line__ ";transform-type set def: ~A" (transform-type)))
(set! (trap-segfault) (trap-segfault))
(if (not (equal? (trap-segfault) #t))
- (snd-display ";trap-segfault set def: ~A" (trap-segfault)))
+ (snd-display #__line__ ";trap-segfault set def: ~A" (trap-segfault)))
(set! (with-file-monitor) (with-file-monitor))
(if (not (equal? (with-file-monitor) #t))
- (snd-display ";with-file-monitor set def: ~A" (with-file-monitor)))
+ (snd-display #__line__ ";with-file-monitor set def: ~A" (with-file-monitor)))
(set! (optimization) (optimization))
(if (not (equal? (optimization) 6))
- (snd-display ";optimization set def: ~A" (optimization)))
+ (snd-display #__line__ ";optimization set def: ~A" (optimization)))
(set! (clm-table-size) (clm-table-size))
(if (not (equal? (clm-table-size) 512))
- (snd-display ";clm-table-size set def: ~A" (clm-table-size)))
+ (snd-display #__line__ ";clm-table-size set def: ~A" (clm-table-size)))
(set! (clm-default-frequency) (clm-default-frequency))
(if (fneq (clm-default-frequency) 0.0)
- (snd-display ";clm-default-frequency set def: ~A" (clm-default-frequency)))
+ (snd-display #__line__ ";clm-default-frequency set def: ~A" (clm-default-frequency)))
(set! (with-verbose-cursor) (with-verbose-cursor))
(if (not (equal? (with-verbose-cursor) #f))
- (snd-display ";with-verbose-cursor set def: ~A" (with-verbose-cursor)))
+ (snd-display #__line__ ";with-verbose-cursor set def: ~A" (with-verbose-cursor)))
(set! (with-inset-graph) (with-inset-graph))
(if (not (equal? (with-inset-graph) #f))
- (snd-display ";with-inset-graph set def: ~A" (with-inset-graph)))
+ (snd-display #__line__ ";with-inset-graph set def: ~A" (with-inset-graph)))
(set! (with-pointer-focus) (with-pointer-focus))
(if (not (equal? (with-pointer-focus) #f))
- (snd-display ";with-pointer-focus set def: ~A" (with-pointer-focus)))
+ (snd-display #__line__ ";with-pointer-focus set def: ~A" (with-pointer-focus)))
(set! (wavelet-type) (wavelet-type))
(if (not (equal? (wavelet-type) 0 ))
- (snd-display ";wavelet-type set def: ~A" (wavelet-type)))
+ (snd-display #__line__ ";wavelet-type set def: ~A" (wavelet-type)))
(set! (time-graph-type) (time-graph-type))
(if (not (equal? (time-graph-type) graph-once))
- (snd-display ";time-graph-type set def: ~A" (time-graph-type)))
+ (snd-display #__line__ ";time-graph-type set def: ~A" (time-graph-type)))
(set! (wavo-hop) (wavo-hop))
(if (not (equal? (wavo-hop) 3 ))
- (snd-display ";wavo-hop set def: ~A" (wavo-hop)))
+ (snd-display #__line__ ";wavo-hop set def: ~A" (wavo-hop)))
(set! (wavo-trace) (wavo-trace))
(if (not (equal? (wavo-trace) 64 ))
- (snd-display ";wavo-trace set def: ~A" (wavo-trace)))
+ (snd-display #__line__ ";wavo-trace set def: ~A" (wavo-trace)))
(set! (x-axis-style) (x-axis-style))
(if (not (equal? (x-axis-style) 0 ))
- (snd-display ";x-axis-style set def: ~A" (x-axis-style)))
+ (snd-display #__line__ ";x-axis-style set def: ~A" (x-axis-style)))
(set! (beats-per-minute) (beats-per-minute))
(if (fneq (beats-per-minute) 60.0 )
- (snd-display ";beats-per-minute set def: ~A" (beats-per-minute)))
+ (snd-display #__line__ ";beats-per-minute set def: ~A" (beats-per-minute)))
(set! (beats-per-measure) (beats-per-measure))
(if (not (= (beats-per-measure) 4))
- (snd-display ";beats-per-measure set def: ~A" (beats-per-measure)))
+ (snd-display #__line__ ";beats-per-measure set def: ~A" (beats-per-measure)))
(set! (zero-pad) (zero-pad))
(if (not (equal? (zero-pad) 0))
- (snd-display ";zero-pad set def: ~A" (zero-pad)))
+ (snd-display #__line__ ";zero-pad set def: ~A" (zero-pad)))
(set! (zero-pad) -123)
(if (not (equal? (zero-pad) 0))
- (snd-display ";zero-pad set -123: ~A" (zero-pad)))
+ (snd-display #__line__ ";zero-pad set -123: ~A" (zero-pad)))
(if (not (equal? (zero-pad #t #t) '()))
- (snd-display ";zero-pad #t: ~A" (zero-pad #t #t)))
+ (snd-display #__line__ ";zero-pad #t: ~A" (zero-pad #t #t)))
(set! (zoom-focus-style) (zoom-focus-style))
(if (not (equal? (zoom-focus-style) 2 ))
- (snd-display ";zoom-focus-style set def: ~A" (zoom-focus-style)))
+ (snd-display #__line__ ";zoom-focus-style set def: ~A" (zoom-focus-style)))
(set! (mix-waveform-height) (mix-waveform-height))
(if (not (equal? (mix-waveform-height) 20 ))
- (snd-display ";mix-waveform-height set def: ~A" (mix-waveform-height)))
+ (snd-display #__line__ ";mix-waveform-height set def: ~A" (mix-waveform-height)))
(set! (mix-tag-width) (mix-tag-width))
(if (not (equal? (mix-tag-width) 6))
- (snd-display ";mix-tag-width set def: ~A" (mix-tag-width)))
+ (snd-display #__line__ ";mix-tag-width set def: ~A" (mix-tag-width)))
(set! (mix-tag-height) (mix-tag-height))
(if (not (equal? (mix-tag-height) 14))
- (snd-display ";mix-tag-height set def: ~A" (mix-tag-height)))
+ (snd-display #__line__ ";mix-tag-height set def: ~A" (mix-tag-height)))
(set! (mark-tag-width) (mark-tag-width))
(if (not (equal? (mark-tag-width) 10))
- (snd-display ";mark-tag-width set def: ~A" (mark-tag-width)))
+ (snd-display #__line__ ";mark-tag-width set def: ~A" (mark-tag-width)))
(set! (mark-tag-height) (mark-tag-height))
(if (not (equal? (mark-tag-height) 4))
- (snd-display ";mark-tag-height set def: ~A" (mark-tag-height)))
+ (snd-display #__line__ ";mark-tag-height set def: ~A" (mark-tag-height)))
(set! (audio-output-device) (audio-output-device))
(if (not (equal? (audio-output-device) 0 ))
- (snd-display ";audio-output-device set def: ~A" (audio-output-device)))
+ (snd-display #__line__ ";audio-output-device set def: ~A" (audio-output-device)))
(set! (view-files-sort) (view-files-sort))
(if (not (= (view-files-sort) 0))
- (snd-display ";view-files-sort def: ~A" (view-files-sort)))
-
+ (snd-display #__line__ ";view-files-sort def: ~A" (view-files-sort)))
+
(if (and (defined? 'most-positive-fixnum)
(> most-positive-fixnum (expt 2 36)))
(begin
(let ((old-max-malloc (mus-max-malloc)))
(set! (mus-max-malloc) (expt 2 36))
(if (not (= (mus-max-malloc) (expt 2 36)))
- (snd-display ";mus-max-malloc as bignum: ~A" (mus-max-malloc)))
+ (snd-display #__line__ ";mus-max-malloc as bignum: ~A" (mus-max-malloc)))
(set! (mus-max-malloc) old-max-malloc))
-
+
(let ((old-max-table-size (mus-max-table-size)))
(set! (mus-max-table-size) (expt 2 36))
(if (not (= (mus-max-table-size) (expt 2 36)))
- (snd-display ";mus-max-table-size as bignum: ~A" (mus-max-table-size)))
+ (snd-display #__line__ ";mus-max-table-size as bignum: ~A" (mus-max-table-size)))
(set! (mus-max-table-size) old-max-table-size))))
(if (not (provided? 'snd-gtk))
@@ -1134,7 +1138,7 @@
(set! (func) "8x123")
(if (or (not (string? (func)))
(not (string=? val (func))))
- (snd-display ";set ~A to bogus value: ~A ~A" name val (func)))))
+ (snd-display #__line__ ";set ~A to bogus value: ~A ~A" name val (func)))))
(list axis-label-font axis-numbers-font tiny-font peaks-font bold-peaks-font)
(list 'axis-label-font 'axis-numbers-font 'tiny-font 'peaks-font 'bold-peaks-font)))
))
@@ -1171,10 +1175,10 @@
(begin
(if (not (equal? (cadr lst) (caddr lst)))
(if (and (number? (caddr lst))
- (inexact? (caddr lst)))
+ (not (rational? (caddr lst))))
(if (fneq (cadr lst) (caddr lst))
- (snd-display ";~A /= ~A (~A)" (car lst) (caddr lst) (cadr lst)))
- (snd-display ";~A /= ~A (~A)" (car lst) (caddr lst) (cadr lst))))
+ (snd-display #__line__ ";~A /= ~A (~A)" (car lst) (caddr lst) (cadr lst)))
+ (snd-display #__line__ ";~A /= ~A (~A)" (car lst) (caddr lst) (cadr lst))))
(test-defaults (cdddr lst)))))))
(for-each close-sound (sounds)) ; in case others opened elsewhere
@@ -1334,7 +1338,7 @@
'zero-pad (zero-pad) 0
'zoom-focus-style (zoom-focus-style) 2
))
- (if *snd-opened-sound* (snd-display ";*snd-opened-sound*: ~A" *snd-opened-sound*))
+ (if *snd-opened-sound* (snd-display #__line__ ";*snd-opened-sound*: ~A" *snd-opened-sound*))
))
@@ -1354,17 +1358,17 @@
(if (file-exists? file)
(begin
(if (not (equal? (mus-sound-chans file) (list-ref testf 1)))
- (snd-display ";~A: chans ~A /= ~A"
+ (snd-display #__line__ ";~A: chans ~A /= ~A"
(list-ref testf 0)
(mus-sound-chans file)
(list-ref testf 1)))
(if (not (equal? (mus-sound-srate file) (list-ref testf 2)))
- (snd-display ";~A: srate ~A /= ~A"
+ (snd-display #__line__ ";~A: srate ~A /= ~A"
(list-ref testf 0)
(mus-sound-srate file)
(list-ref testf 2)))
(if (fneq (mus-sound-duration file) (list-ref testf 3))
- (snd-display ";~A: duration ~A /= ~A"
+ (snd-display #__line__ ";~A: duration ~A /= ~A"
(list-ref testf 0)
(mus-sound-duration file)
(list-ref testf 3)))
@@ -1373,26 +1377,26 @@
(< (+ (mus-sound-length file) 1)
(* (mus-sound-datum-size file) (mus-sound-duration file)
(mus-sound-srate file) (mus-sound-chans file))))
- (snd-display ";mus-sound-length ~A: ~A (~A)" file
+ (snd-display #__line__ ";mus-sound-length ~A: ~A (~A)" file
(mus-sound-length file)
(* (mus-sound-duration file) (mus-sound-srate file)
(mus-sound-chans file) (mus-sound-datum-size file))))
(if (fneq (/ (mus-sound-frames file) (mus-sound-srate file)) (mus-sound-duration file))
- (snd-display ";mus-sound-frames ~A: ~A (~A ~A)" file
+ (snd-display #__line__ ";mus-sound-frames ~A: ~A (~A ~A)" file
(mus-sound-frames file)
(mus-sound-duration file)
(/ (mus-sound-frames file) (mus-sound-srate file))))
(if (> (abs (- (mus-sound-frames file) (/ (mus-sound-samples file) (mus-sound-chans file)))) 1)
- (snd-display ";mus-sound-samples ~A: ~A ~A" file
+ (snd-display #__line__ ";mus-sound-samples ~A: ~A ~A" file
(mus-sound-samples file)
(* (mus-sound-frames file) (mus-sound-chans file))))
(if (not (equal? (mus-header-type-name (mus-sound-header-type file)) (list-ref testf 4)))
- (snd-display ";~A: type ~A /= ~A"
+ (snd-display #__line__ ";~A: type ~A /= ~A"
(list-ref testf 0)
(mus-header-type-name (mus-sound-header-type file))
(list-ref testf 4)))
(if (not (equal? (mus-data-format-name (mus-sound-data-format file)) (list-ref testf 5)))
- (snd-display ";~A: type ~A /= ~A"
+ (snd-display #__line__ ";~A: type ~A /= ~A"
(list-ref testf 0)
(mus-data-format-name (mus-sound-data-format file))
(list-ref testf 5)))
@@ -1400,13 +1404,13 @@
(if (> (length testf) 6)
(begin
(if (not (equal? (car lst) (list-ref testf 6)))
- (snd-display ";~A: loop start: ~A" (car lst) (list-ref testf 6)))
+ (snd-display #__line__ ";~A: loop start: ~A" (car lst) (list-ref testf 6)))
(if (not (equal? (cadr lst) (list-ref testf 7)))
- (snd-display ";~A: loop end: ~A" (cadr lst) (list-ref testf 7))))
+ (snd-display #__line__ ";~A: loop end: ~A" (cadr lst) (list-ref testf 7))))
(if (not (null? lst))
- (snd-display ";~A thinks it has loop info: ~A" file lst))))
+ (snd-display #__line__ ";~A thinks it has loop info: ~A" file lst))))
(mus-sound-forget file))
- (snd-display ";~A missing?" file))
+ (snd-display #__line__ ";~A missing?" file))
(test-headers (cdr base-files))))))))
;; need to make sure raw defaults are consistent with following tests
@@ -1414,7 +1418,7 @@
(if (sound? ind) (close-sound ind)))
(catch #t
(lambda ()
- (if (not (= (mus-sound-header-type (string-append sf-dir "midi60.mid")) -1)) (snd-display ";midi60?")))
+ (if (not (= (mus-sound-header-type (string-append sf-dir "midi60.mid")) -1)) (snd-display #__line__ ";midi60?")))
(lambda args args))
(test-headers
(list
@@ -1636,30 +1640,28 @@
(for-each (lambda (in-name real-name)
(if (not (string=? (mus-expand-filename in-name) real-name))
- (snd-display ";mus-expand-filename ~A -> ~A" in-name (mus-expand-filename in-name)))
+ (snd-display #__line__ ";mus-expand-filename ~A -> ~A" in-name (mus-expand-filename in-name)))
(if (file-exists? "/home/bil/./sf1/o2.voc")
(let ((ind (open-sound in-name)))
(if (not (sound? ind))
- (snd-display ";can't open ~A" in-name)
+ (snd-display #__line__ ";can't open ~A" in-name)
(begin
(if (not (string=? (file-name ind) real-name))
- (snd-display ";expand file name ~A: ~A" in-name (file-name ind)))
+ (snd-display #__line__ ";expand file name ~A: ~A" in-name (file-name ind)))
(close-sound ind))))))
(list "/home/bil/./sf1/o2.voc" "~/./sf1/o2.voc" "~/cl/../sf1/o2.voc" "/home/bil/cl/../sf1/o2.voc")
(list "/home/bil/sf1/o2.voc" "/home/bil/sf1/o2.voc" "/home/bil/sf1/o2.voc" "/home/bil/sf1/o2.voc"))
-
+
(let ((lst (mus-sound-mark-info (string-append sf-dir "forest.aiff"))))
- (if (not (equal? lst '((4 1) (3 0) (2 144332) (1 24981))))
- (snd-display ";mus-sound-mark-info forest: ~A" lst)))
+ (if (not (equal? lst '((4 0) (3 0) (2 144332) (1 24981))))
+ (snd-display #__line__ ";mus-sound-mark-info forest: ~A" lst)))
(let ((lst (mus-sound-mark-info (string-append sf-dir "traffic.aiff"))))
(if (not (equal? lst '((4 1) (3 0) (2 171931) (1 99461))))
- (snd-display ";mus-sound-mark-info traffic: ~A" lst)))
+ (snd-display #__line__ ";mus-sound-mark-info traffic: ~A" lst)))
)))
-(if (not (provided? 'snd-snd6.scm)) (load "snd6.scm"))
-
;;; ---------------- test 3: variables ----------------
(define (snd_test_3)
@@ -1674,84 +1676,84 @@
(lambda ()
(set! (temp-dir) (string-append home-dir "/test"))
(if (not (string=? (temp-dir) (string-append home-dir "/test")))
- (snd-display ";set temp-dir: ~A?" (temp-dir))))
+ (snd-display #__line__ ";set temp-dir: ~A?" (temp-dir))))
(lambda args args))
(if td
(set! (temp-dir) td)
(set! (temp-dir) "")))
- (if (fneq (sample 1000) 0.0328) (snd-display ";sample: ~A?" (sample 1000)))
+ (if (fneq (sample 1000) 0.0328) (snd-display #__line__ ";sample: ~A?" (sample 1000)))
(if (or (not (hook? output-name-hook)) (not (hook-empty? output-name-hook)))
- (snd-display ";output-name-hook: ~A?" output-name-hook))
+ (snd-display #__line__ ";output-name-hook: ~A?" output-name-hook))
(if (or (not (hook? output-comment-hook)) (not (hook-empty? output-comment-hook)))
- (snd-display ";output-comment-hook: ~A?" output-comment-hook))
+ (snd-display #__line__ ";output-comment-hook: ~A?" output-comment-hook))
(if (or (not (hook? peak-env-hook)) (not (hook-empty? peak-env-hook)))
- (snd-display ";peak-env-hook: ~A?" peak-env-hook))
+ (snd-display #__line__ ";peak-env-hook: ~A?" peak-env-hook))
(if (or (not (hook? help-hook)) (not (hook-empty? help-hook)))
- (snd-display ";help-hook: ~A?" help-hook))
+ (snd-display #__line__ ";help-hook: ~A?" help-hook))
(if (or (not (hook? mark-drag-hook)) (not (hook-empty? mark-drag-hook)))
- (snd-display ";mark-drag-hook: ~A?" mark-drag-hook))
+ (snd-display #__line__ ";mark-drag-hook: ~A?" mark-drag-hook))
(if (or (not (hook? mark-drag-triangle-hook)) (not (hook-empty? mark-drag-triangle-hook)))
- (snd-display ";mark-drag-triangle-hook: ~A?" mark-drag-triangle-hook))
+ (snd-display #__line__ ";mark-drag-triangle-hook: ~A?" mark-drag-triangle-hook))
(if (or (not (hook? mix-drag-hook)) (not (hook-empty? mix-drag-hook)))
- (snd-display ";mix-drag-hook: ~A?" mix-drag-hook))
+ (snd-display #__line__ ";mix-drag-hook: ~A?" mix-drag-hook))
(if (or (not (hook? mouse-drag-hook)) (not (hook-empty? mouse-drag-hook)))
- (snd-display ";mouse-drag-hook: ~A?" mouse-drag-hook))
+ (snd-display #__line__ ";mouse-drag-hook: ~A?" mouse-drag-hook))
(if (or (not (hook? mouse-click-hook)) (not (hook-empty? mouse-click-hook)))
- (snd-display ";mouse-click-hook: ~A?" mouse-click-hook))
+ (snd-display #__line__ ";mouse-click-hook: ~A?" mouse-click-hook))
(if (or (not (hook? mouse-press-hook)) (not (hook-empty? mouse-press-hook)))
- (snd-display ";mouse-press-hook: ~A?" mouse-press-hook))
+ (snd-display #__line__ ";mouse-press-hook: ~A?" mouse-press-hook))
(if (or (not (hook? start-playing-hook)) (not (hook-empty? start-playing-hook)))
- (snd-display ";start-playing-hook: ~A?" start-playing-hook))
+ (snd-display #__line__ ";start-playing-hook: ~A?" start-playing-hook))
(if (or (not (hook? start-playing-selection-hook)) (not (hook-empty? start-playing-selection-hook)))
- (snd-display ";start-playing-selection-hook: ~A?" start-playing-selection-hook))
+ (snd-display #__line__ ";start-playing-selection-hook: ~A?" start-playing-selection-hook))
(if (not (hook? stop-playing-hook))
- (snd-display ";stop-playing-hook: ~A?" stop-playing-hook))
+ (snd-display #__line__ ";stop-playing-hook: ~A?" stop-playing-hook))
(if (or (not (hook? key-press-hook)) (not (hook-empty? key-press-hook)))
- (snd-display ";key-press-hook: ~A?" key-press-hook))
+ (snd-display #__line__ ";key-press-hook: ~A?" key-press-hook))
(if (or (not (hook? snd-error-hook)) (not (hook-empty? snd-error-hook)))
- (snd-display ";snd-error-hook: ~A?" snd-error-hook))
+ (snd-display #__line__ ";snd-error-hook: ~A?" snd-error-hook))
(if (or (not (hook? snd-warning-hook)) (not (hook-empty? snd-warning-hook)))
- (snd-display ";snd-warning-hook: ~A?" snd-warning-hook))
+ (snd-display #__line__ ";snd-warning-hook: ~A?" snd-warning-hook))
(if (or (not (hook? name-click-hook)) (not (hook-empty? name-click-hook)))
- (snd-display ";name-click-hook: ~A?" name-click-hook))
+ (snd-display #__line__ ";name-click-hook: ~A?" name-click-hook))
(if (or (not (hook? after-apply-controls-hook)) (not (hook-empty? after-apply-controls-hook)))
- (snd-display ";after-apply-controls-hook: ~A?" after-apply-controls-hook))
+ (snd-display #__line__ ";after-apply-controls-hook: ~A?" after-apply-controls-hook))
(if (or (not (hook? enved-hook)) (not (hook-empty? enved-hook)))
- (snd-display ";enved-hook: ~A?" enved-hook))
+ (snd-display #__line__ ";enved-hook: ~A?" enved-hook))
(if (or (not (hook? mouse-enter-label-hook)) (not (hook-empty? mouse-enter-label-hook)))
- (snd-display ";mouse-enter-label-hook: ~A?" mouse-enter-label-hook))
+ (snd-display #__line__ ";mouse-enter-label-hook: ~A?" mouse-enter-label-hook))
(if (or (not (hook? mouse-enter-graph-hook)) (not (hook-empty? mouse-enter-graph-hook)))
- (snd-display ";mouse-enter-graph-hook: ~A?" mouse-enter-graph-hook))
+ (snd-display #__line__ ";mouse-enter-graph-hook: ~A?" mouse-enter-graph-hook))
(if (or (not (hook? mouse-enter-listener-hook)) (not (hook-empty? mouse-enter-listener-hook)))
- (snd-display ";mouse-enter-listener-hook: ~A?" mouse-enter-listener-hook))
+ (snd-display #__line__ ";mouse-enter-listener-hook: ~A?" mouse-enter-listener-hook))
(if (or (not (hook? mouse-leave-label-hook)) (not (hook-empty? mouse-leave-label-hook)))
- (snd-display ";mouse-leave-label-hook: ~A?" mouse-leave-label-hook))
+ (snd-display #__line__ ";mouse-leave-label-hook: ~A?" mouse-leave-label-hook))
(if (or (not (hook? mouse-leave-graph-hook)) (not (hook-empty? mouse-leave-graph-hook)))
- (snd-display ";mouse-leave-graph-hook: ~A?" mouse-leave-graph-hook))
+ (snd-display #__line__ ";mouse-leave-graph-hook: ~A?" mouse-leave-graph-hook))
(if (or (not (hook? mouse-leave-listener-hook)) (not (hook-empty? mouse-leave-listener-hook)))
- (snd-display ";mouse-leave-listener-hook: ~A?" mouse-leave-listener-hook))
+ (snd-display #__line__ ";mouse-leave-listener-hook: ~A?" mouse-leave-listener-hook))
(if (or (not (hook? window-property-changed-hook)) (not (hook-empty? window-property-changed-hook)))
- (snd-display ";window-property-changed-hook: ~A?" window-property-changed-hook))
+ (snd-display #__line__ ";window-property-changed-hook: ~A?" window-property-changed-hook))
(if (or (not (hook? initial-graph-hook)) (not (hook-empty? initial-graph-hook)))
- (snd-display ";initial-graph-hook: ~A?" initial-graph-hook))
+ (snd-display #__line__ ";initial-graph-hook: ~A?" initial-graph-hook))
(if (or (not (hook? after-graph-hook)) (not (hook-empty? after-graph-hook)))
- (snd-display ";after-graph-hook: ~A?" after-graph-hook))
+ (snd-display #__line__ ";after-graph-hook: ~A?" after-graph-hook))
(if (or (not (hook? graph-hook)) (not (hook-empty? graph-hook)))
- (snd-display ";graph-hook: ~A?" graph-hook))
+ (snd-display #__line__ ";graph-hook: ~A?" graph-hook))
(set! (show-controls) #t)
(if with-gui
(begin
(let ((wid (enved-dialog) ))
(if (not (equal? wid (list-ref (dialog-widgets) 2)))
- (snd-display ";enved-dialog -> ~A ~A" wid (list-ref (dialog-widgets) 2))))
- (if (not (list-ref (dialog-widgets) 2)) (snd-display ";enved-dialog?"))
+ (snd-display #__line__ ";enved-dialog -> ~A ~A" wid (list-ref (dialog-widgets) 2))))
+ ;(if (not (list-ref (dialog-widgets) 2)) (snd-display #__line__ ";enved-dialog?"))
(set! (enved-envelope) '(0.0 0.0 1.0 1.0 2.0 0.0))
(if (not (equal? (enved-envelope) (list 0.0 0.0 1.0 1.0 2.0 0.0)))
- (snd-display ";set enved-envelope: ~A?" (enved-envelope)))
+ (snd-display #__line__ ";set enved-envelope: ~A?" (enved-envelope)))
(set! (enved-envelope) (enved-envelope))
(if (not (equal? (enved-envelope) (list 0.0 0.0 1.0 1.0 2.0 0.0)))
- (snd-display ";set enved-envelope to self: ~A?" (enved-envelope)))))
+ (snd-display #__line__ ";set enved-envelope to self: ~A?" (enved-envelope)))))
(letrec ((test-vars
(lambda (lst)
@@ -1767,20 +1769,20 @@
(if (and (not (equal? newval nowval))
(or (not (list? newval))
(not (feql newval nowval))))
- (if (and (number? newval) (inexact? newval))
+ (if (and (number? newval) (not (rational? newval)))
(if (> (abs (- newval nowval)) .01)
- (snd-display ";~A /= ~A (~A)" name newval nowval))
- (snd-display ";~A /= ~A (~A)" name newval nowval)))
+ (snd-display #__line__ ";~A /= ~A (~A)" name newval nowval))
+ (snd-display #__line__ ";~A /= ~A (~A)" name newval nowval)))
(setfnc initval)
(set! (getfnc) newval)
(let ((nowval (getfnc)))
(if (and (not (equal? newval nowval))
(or (not (list? newval))
(not (feql newval nowval))))
- (if (and (number? newval) (inexact? newval))
+ (if (and (number? newval) (not (rational? newval)))
(if (> (abs (- newval nowval)) .01)
- (snd-display ";set! ~A /= ~A (~A)" name newval nowval))
- (snd-display ";set! ~A /= ~A (~A)" name newval nowval)))
+ (snd-display #__line__ ";set! ~A /= ~A (~A)" name newval nowval))
+ (snd-display #__line__ ";set! ~A /= ~A (~A)" name newval nowval)))
(setfnc initval))
(test-vars (cdr lst))))))))
(test-vars
@@ -1937,7 +1939,7 @@
(lambda args (car args)))
(let ((nowval (getfnc)))
(if (equal? n nowval)
- (snd-display ";(bad set) ~A = ~A (~A)" name n initval))
+ (snd-display #__line__ ";(bad set) ~A = ~A (~A)" name n initval))
(setfnc initval)))
newvals)
(test-bad-args (cdr lst)))))))
@@ -1994,46 +1996,46 @@
(set! (window-width) 300)
(set! (window-height) 300)
(if (not (equal? (window-width) 300))
- (snd-display ";window width: ~A /= 300?" (window-width)))
+ (snd-display #__line__ ";window width: ~A /= 300?" (window-width)))
(if (not (equal? (window-height) 300))
- (snd-display ";window height: ~A /= 300?" (window-height)))
+ (snd-display #__line__ ";window height: ~A /= 300?" (window-height)))
(set! (window-x) 123)
(set! (window-y) 321)
(if (not (equal? (window-x) 123))
- (snd-display ";window x: ~A /= 123?" (window-x)))
+ (snd-display #__line__ ";window x: ~A /= 123?" (window-x)))
(if (not (equal? (window-y) 321))
- (snd-display ";window y: ~A /= 321?" (window-y)))
+ (snd-display #__line__ ";window y: ~A /= 321?" (window-y)))
(set! (window-y) 10) ; get it back out of harm's way
(set! (color-scale) 100.0)
- (if (fneq (color-scale) 100.0) (snd-display ";color-scale to 100: ~A" (color-scale)))
+ (if (fneq (color-scale) 100.0) (snd-display #__line__ ";color-scale to 100: ~A" (color-scale)))
(if (procedure? (search-procedure))
- (snd-display ";global search procedure: ~A?" (search-procedure)))
+ (snd-display #__line__ ";global search procedure: ~A?" (search-procedure)))
(set! (search-procedure) (lambda (y) (> y .1)))
(if (not (procedure? (search-procedure)))
- (snd-display ";set global search procedure: ~A?" (search-procedure)))
+ (snd-display #__line__ ";set global search procedure: ~A?" (search-procedure)))
(if (not ((search-procedure) .2))
- (snd-display ";search > .1 .2"))
+ (snd-display #__line__ ";search > .1 .2"))
(if ((search-procedure) .02)
- (snd-display ";search > .1 .02"))
+ (snd-display #__line__ ";search > .1 .02"))
(set! (search-procedure) (lambda (y) (< y 0.0)))
(if ((search-procedure) .02)
- (snd-display ";search < 0.0 .02"))
+ (snd-display #__line__ ";search < 0.0 .02"))
(set! (search-procedure) #f)
(if (procedure? (search-procedure))
- (snd-display ";global search procedure after reset: ~A?" (search-procedure)))
+ (snd-display #__line__ ";global search procedure after reset: ~A?" (search-procedure)))
(set! (search-procedure) (lambda (y) (> y .1)))
(if (not (procedure? (search-procedure)))
- (snd-display ";set global search procedure: ~A?" (search-procedure)))
+ (snd-display #__line__ ";set global search procedure: ~A?" (search-procedure)))
(set! (enved-filter-order) 5)
- (if (not (= (enved-filter-order) 6)) (snd-display ";set enved-filter-order 5: ~A" (enved-filter-order)))
+ (if (not (= (enved-filter-order) 6)) (snd-display #__line__ ";set enved-filter-order 5: ~A" (enved-filter-order)))
(if with-gui
(begin
(set! (enved-envelope) 'zero_to_one) ; funcs.cl above
- (if (not (feql (enved-envelope) zero_to_one)) (snd-display ";set symbol enved-envelope: ~A ~A" (enved-envelope) zero_to_one))
+ (if (not (feql (enved-envelope) zero_to_one)) (snd-display #__line__ ";set symbol enved-envelope: ~A ~A" (enved-envelope) zero_to_one))
(set! (enved-envelope) "mod_down")
- (if (not (feql (enved-envelope) mod_down)) (snd-display ";set string enved-envelope: ~A ~A" (enved-envelope) mod_down))))
+ (if (not (feql (enved-envelope) mod_down)) (snd-display #__line__ ";set string enved-envelope: ~A ~A" (enved-envelope) mod_down))))
(close-sound ind)
(dismiss-all-dialogs)
@@ -2152,7 +2154,7 @@
'mus-aifc 'mus-aiff 'mus-alaw 'mus-alsa-buffer-size 'mus-alsa-buffers
'mus-alsa-capture-device 'mus-alsa-device 'mus-alsa-playback-device 'mus-alsa-squelch-warning 'mus-apply
'mus-array-print-length 'mus-float-equal-fudge-factor
-
+
'mus-b24int 'mus-bdouble 'mus-bdouble-unscaled
'mus-bfloat 'mus-bfloat-unscaled 'mus-bicsf 'mus-bint 'mus-bintn
'mus-bshort 'mus-byte 'mus-bytes-per-sample 'mus-caff 'mus-channel 'mus-channels
@@ -2190,8 +2192,7 @@
'parzen-window 'pausing 'peak-env-hook 'peaks 'peaks-font
'phase-partials->wave 'phase-vocoder 'phase-vocoder-amp-increments 'phase-vocoder-amps 'phase-vocoder-freqs
'phase-vocoder-phase-increments 'phase-vocoder-phases 'phase-vocoder? 'play
- 'play-and-wait 'play-channel 'play-hook 'play-mix 'play-region
- 'play-selection 'player-home 'player? 'players
+ 'play-hook 'player-home 'player? 'players
'playing 'poisson-window 'polar->rectangular 'polynomial 'polyshape 'polywave
'polyshape? 'polywave? 'position->x 'position->y 'position-color 'preferences-dialog
'previous-sample 'print-dialog 'print-hook 'print-length 'progress-report
@@ -2281,7 +2282,7 @@
(set! undef (cons n undef))))
names)
(if (not (null? undef))
- (snd-display ";undefined: ~A" undef)))
+ (snd-display #__line__ ";undefined: ~A" undef)))
))
@@ -2312,7 +2313,7 @@
(if (= audio-fd -1)
(set! audio-fd (mus-audio-open-output 0 (mus-sound-srate file) chans mus-bshort bytes)))
(if (= audio-fd -1)
- (snd-display ";can't play ~A" file)
+ (snd-display #__line__ ";can't play ~A" file)
(begin
(catch #t
(lambda ()
@@ -2320,9 +2321,9 @@
((>= i frames))
(mus-audio-write audio-fd data bufsize)
(mus-sound-read sound-fd 0 (- bufsize 1) chans data)))
- (lambda args (snd-display ";play-sound-1: can play audio: ~A" args)))
+ (lambda args (snd-display #__line__ ";play-sound-1: can play audio: ~A" args)))
(mus-audio-close audio-fd)))))
- (lambda args (snd-display ";play-sound-1: can't open audio: ~A" args)))
+ (lambda args (snd-display #__line__ ";play-sound-1: can't open audio: ~A" args)))
(mus-sound-close-input sound-fd)))
(definstrument (out-samps beg chan data)
@@ -2370,7 +2371,7 @@
(data (make-sound-data our-chans our-dac-buffer-size-in-shorts))
(vobj (make-vct our-dac-buffer-size-in-shorts)))
(if (= in-port -1)
- (snd-display ";can't open audio input port!")
+ (snd-display #__line__ ";can't open audio input port!")
(begin
(do ((i 0 (+ 1 i)))
((= i 10))
@@ -2397,7 +2398,7 @@
(bytes (mus-bytes-per-sample (mus-sound-data-format "oboe.snd"))))
(if (or (not (= (car mz) 0))
(fneq (cadr mz) 0.0))
- (snd-display ";mus-sound-maxamp z.snd: ~A (~A ~A)" mz (not (= (car mz) 0)) (fneq (cadr mz) 0.0)))
+ (snd-display #__line__ ";mus-sound-maxamp z.snd: ~A (~A ~A)" mz (not (= (car mz) 0)) (fneq (cadr mz) 0.0)))
(let ((formats (list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat mus-lfloat
mus-bint mus-lint mus-bintn mus-lintn mus-b24int mus-l24int mus-bdouble mus-ldouble
mus-ubshort mus-ulshort mus-bdouble-unscaled mus-ldouble-unscaled mus-bfloat-unscaled
@@ -2409,69 +2410,69 @@
(for-each
(lambda (frm siz)
(if (not (= (mus-bytes-per-sample frm) siz))
- (snd-display ";mus-bytes-per-sample ~A: ~A" (mus-data-format-name frm) siz)))
+ (snd-display #__line__ ";mus-bytes-per-sample ~A: ~A" (mus-data-format-name frm) siz)))
formats
sizes))
(if (not (string=? (mus-data-format->string mus-bshort) "mus-bshort"))
- (snd-display ";mus-data-format->string: ~A" (mus-data-format->string mus-bshort)))
+ (snd-display #__line__ ";mus-data-format->string: ~A" (mus-data-format->string mus-bshort)))
(if (not (string=? (mus-header-type->string mus-aifc) "mus-aifc"))
- (snd-display ";mus-header-type->string: ~A" (mus-header-type->string mus-aifc)))
+ (snd-display #__line__ ";mus-header-type->string: ~A" (mus-header-type->string mus-aifc)))
(mus-sound-report-cache "hiho.tmp")
(if (defined? 'read-line)
(let ((p (open-input-file "hiho.tmp")))
(if (not p)
- (snd-display ";mus-sound-report-cache->hiho.tmp failed?")
+ (snd-display #__line__ ";mus-sound-report-cache->hiho.tmp failed?")
(let ((line (read-line p)))
(if (or (not (string? line))
(and (not (string=? line "sound table:"))
(not (string=? line (string-append "sound table:" (string #\newline))))))
- (snd-display ";print-cache 1: ~A?" line))
+ (snd-display #__line__ ";print-cache 1: ~A?" line))
(close-input-port p)
(delete-file "hiho.tmp")))))
(if (< (string-length (mus-audio-describe)) 10)
- (snd-display ";mus-audio-describe: ~A" (mus-audio-describe)))
- (if (not (= chns 1)) (snd-display ";oboe: mus-sound-chans ~D?" chns))
- (if (not (= dl 28)) (snd-display ";oboe: mus-sound-data-location ~D (~A)?" dl (= dl 28)))
- (if (not (= fr 50828)) (snd-display ";oboe: mus-sound-frames ~D?" fr))
- (if (not (= smps 50828)) (snd-display ";oboe: mus-sound-samples ~D?" smps))
- (if (not (= len (+ 28 (* 2 50828)))) (snd-display ";oboe: mus-sound-length ~D?" len))
- (if (not (= size 2)) (snd-display ";oboe: mus-sound-datum-size ~D?" size))
- (if (not (= bytes 2)) (snd-display ";oboe: sound-bytes ~D?" bytes))
- (if (not (= sr 22050)) (snd-display ";oboe: mus-sound-srate ~D?" sr))
- (if (and m1 (= clmtest 0)) (snd-display ";oboe: mus-sound-maxamp-exists before maxamp: ~A" m1))
+ (snd-display #__line__ ";mus-audio-describe: ~A" (mus-audio-describe)))
+ (if (not (= chns 1)) (snd-display #__line__ ";oboe: mus-sound-chans ~D?" chns))
+ (if (not (= dl 28)) (snd-display #__line__ ";oboe: mus-sound-data-location ~D (~A)?" dl (= dl 28)))
+ (if (not (= fr 50828)) (snd-display #__line__ ";oboe: mus-sound-frames ~D?" fr))
+ (if (not (= smps 50828)) (snd-display #__line__ ";oboe: mus-sound-samples ~D?" smps))
+ (if (not (= len (+ 28 (* 2 50828)))) (snd-display #__line__ ";oboe: mus-sound-length ~D?" len))
+ (if (not (= size 2)) (snd-display #__line__ ";oboe: mus-sound-datum-size ~D?" size))
+ (if (not (= bytes 2)) (snd-display #__line__ ";oboe: sound-bytes ~D?" bytes))
+ (if (not (= sr 22050)) (snd-display #__line__ ";oboe: mus-sound-srate ~D?" sr))
+ (if (and m1 (= clmtest 0)) (snd-display #__line__ ";oboe: mus-sound-maxamp-exists before maxamp: ~A" m1))
(if (not (mus-sound-maxamp-exists? "oboe.snd"))
- (snd-display ";oboe: not mus-sound-maxamp-exists after maxamp: ~A" (mus-sound-maxamp-exists? "oboe.snd")))
+ (snd-display #__line__ ";oboe: not mus-sound-maxamp-exists after maxamp: ~A" (mus-sound-maxamp-exists? "oboe.snd")))
(if (= clmtest 0)
(let ((vals (mus-header-raw-defaults)))
(if (or (not (list? vals))
(not (= (length vals) 3)))
- (snd-display ";mus-header-raw-defaults: ~A" vals)
+ (snd-display #__line__ ";mus-header-raw-defaults: ~A" vals)
(let ((sr (car vals))
(chns (cadr vals))
(frm (caddr vals)))
- (if (not (= sr 44100)) (snd-display ";mus-header-raw-defaults srate: ~A" sr))
- (if (not (= chns 2)) (snd-display ";mus-header-raw-defaults chns: ~A" chns))
- (if (not (= frm mus-bshort)) (snd-display ";mus-header-raw-defaults format: ~A: ~A" frm (mus-data-format-name frm)))))))
+ (if (not (= sr 44100)) (snd-display #__line__ ";mus-header-raw-defaults srate: ~A" sr))
+ (if (not (= chns 2)) (snd-display #__line__ ";mus-header-raw-defaults chns: ~A" chns))
+ (if (not (= frm mus-bshort)) (snd-display #__line__ ";mus-header-raw-defaults format: ~A: ~A" frm (mus-data-format-name frm)))))))
(set! (mus-header-raw-defaults) (list 12345 3 mus-bdouble-unscaled))
(let ((vals (mus-header-raw-defaults)))
(if (or (not (list? vals))
(not (= (length vals) 3)))
- (snd-display ";set mus-header-raw-defaults: ~A" vals)
+ (snd-display #__line__ ";set mus-header-raw-defaults: ~A" vals)
(let ((sr (car vals))
(chns (cadr vals))
(frm (caddr vals)))
- (if (not (= sr 12345)) (snd-display ";set mus-header-raw-defaults srate: ~A" sr))
- (if (not (= chns 3)) (snd-display ";set mus-header-raw-defaults chns: ~A" chns))
- (if (not (= frm mus-bdouble-unscaled)) (snd-display ";set mus-header-raw-defaults format: ~A: ~A" frm (mus-data-format-name frm))))))
+ (if (not (= sr 12345)) (snd-display #__line__ ";set mus-header-raw-defaults srate: ~A" sr))
+ (if (not (= chns 3)) (snd-display #__line__ ";set mus-header-raw-defaults chns: ~A" chns))
+ (if (not (= frm mus-bdouble-unscaled)) (snd-display #__line__ ";set mus-header-raw-defaults format: ~A: ~A" frm (mus-data-format-name frm))))))
(set! (mus-header-raw-defaults) (list 44100 2 mus-bshort))
(let ((str (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "oboe.snd")))))
(if (not (string=? str "15-Oct 04:34 PDT"))
- (snd-display ";mus-sound-write-date oboe.snd: ~A?" str)))
+ (snd-display #__line__ ";mus-sound-write-date oboe.snd: ~A?" str)))
(let ((str (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "pistol.snd")))))
(if (not (string-=? str "01-Jul 13:06 PDT"))
- (snd-display ";mus-sound-write-date pistol.snd: ~A?" str)))
+ (snd-display #__line__ ";mus-sound-write-date pistol.snd: ~A?" str)))
(let ((index (open-sound "oboe.snd"))
(long-file-name (let ((name "test"))
@@ -2479,62 +2480,62 @@
((= i 10)) ; 40 is about the limit in Linux (256 char limit here from OS, not Snd)
(set! name (string-append name "-test")))
(string-append name ".snd"))))
- (if (variable-graph? index) (snd-display ";variable-graph thinks anything is a graph..."))
- (if (player? index) (snd-display ";player? thinks anything is a player..."))
- (if (not (sound? index)) (snd-display ";~A is not a sound?" index))
- (if (sound? #f) (snd-display ";sound? #f -> #t?"))
- (if (sound? #t) (snd-display ";sound? #t -> #t?"))
+ (if (variable-graph? index) (snd-display #__line__ ";variable-graph thinks anything is a graph..."))
+ (if (player? index) (snd-display #__line__ ";player? thinks anything is a player..."))
+ (if (not (sound? index)) (snd-display #__line__ ";~A is not a sound?" index))
+ (if (sound? #f) (snd-display #__line__ ";sound? #f -> #t?"))
+ (if (sound? #t) (snd-display #__line__ ";sound? #t -> #t?"))
(save-sound-as long-file-name index)
(close-sound index)
(set! index (open-sound long-file-name))
- (if (not (sound? index)) (snd-display ";can't find test...snd"))
+ (if (not (sound? index)) (snd-display #__line__ ";can't find test...snd"))
(if (or (not (>= (string-length (file-name index)) (string-length long-file-name)))
(not (>= (string-length (short-file-name index)) (string-length long-file-name))))
- (snd-display ";file-name lengths: ~A ~A ~A"
+ (snd-display #__line__ ";file-name lengths: ~A ~A ~A"
(string-length (file-name index))
(string-length (short-file-name index))
(string-length long-file-name)))
(close-sound index)
(mus-sound-forget long-file-name)
(delete-file long-file-name))
-
+
(let* ((fsnd (string-append sf-dir "forest.aiff")))
(if (file-exists? fsnd)
(begin
(system (format #f "cp ~A fmv.snd" fsnd))
(let ((index (open-sound "fmv.snd")))
(if (not (equal? (sound-loop-info index) (mus-sound-loop-info fsnd)))
- (snd-display ";loop-info: ~A ~A" (sound-loop-info index) (mus-sound-loop-info fsnd)))
+ (snd-display #__line__ ";loop-info: ~A ~A" (sound-loop-info index) (mus-sound-loop-info fsnd)))
(set! (sound-loop-info index) (list 12000 14000 1 2 3 4))
(if (not (equal? (sound-loop-info index) (list 12000 14000 1 2 3 4 1 1)))
- (snd-display ";set loop-info: ~A" (sound-loop-info index)))
+ (snd-display #__line__ ";set loop-info: ~A" (sound-loop-info index)))
(save-sound-as "fmv1.snd" index mus-aifc)
(close-sound index)
(if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 12000 14000 1 2 3 4 1 1)))
- (snd-display ";saved loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))))
+ (snd-display #__line__ ";saved loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))))
(let ((index (open-sound "oboe.snd")))
(save-sound-as "fmv.snd" index mus-aifc)
(close-sound index))
(let ((index (open-sound "fmv.snd")))
(if (not (equal? (sound-loop-info index) '()))
- (snd-display ";null loop-info: ~A" (sound-loop-info index)))
+ (snd-display #__line__ ";null loop-info: ~A" (sound-loop-info index)))
(set! (sound-loop-info index) (list 1200 1400 4 3 2 1))
(if (not (equal? (sound-loop-info index) (list 1200 1400 4 3 2 1 1 1)))
- (snd-display ";set null loop-info: ~A" (sound-loop-info index)))
+ (snd-display #__line__ ";set null loop-info: ~A" (sound-loop-info index)))
(save-sound-as "fmv1.snd" :sound index :header-type mus-aifc)
(close-sound index)
(if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 1200 1400 4 3 2 1 1 1)))
- (snd-display ";saved null loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))
+ (snd-display #__line__ ";saved null loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))
(let ((index (open-sound "fmv.snd")))
(set! (sound-loop-info) (list 1200 1400 4 3 2 1 1 0))
(if (not (equal? (sound-loop-info index) (list 1200 1400 0 0 2 1 1 0)))
- (snd-display ";set null loop-info (no mode1): ~A" (sound-loop-info index)))
+ (snd-display #__line__ ";set null loop-info (no mode1): ~A" (sound-loop-info index)))
(save-sound-as "fmv1.snd" index mus-aifc)
(close-sound index)
(if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 1200 1400 0 0 2 1 1 0)))
- (snd-display ";saved null loop-info (no mode1): ~A" (mus-sound-loop-info "fmv1.snd")))))
+ (snd-display #__line__ ";saved null loop-info (no mode1): ~A" (mus-sound-loop-info "fmv1.snd")))))
- (if com (snd-display ";oboe: mus-sound-comment ~A?" com))
+ (if com (snd-display #__line__ ";oboe: mus-sound-comment ~A?" com))
(let ((fsnd (string-append sf-dir "nasahal8.wav")))
(if (file-exists? fsnd)
(begin
@@ -2546,87 +2547,87 @@
(string #\newline)
"ISFT: Sound Forge 4.0"
(string #\newline)))))
- (snd-display ";mus-sound-comment \"nasahal8.wav\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"nasahal8.wav\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "8svx-8.snd")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "File created by Sound Exchange ")))
- (snd-display ";mus-sound-comment \"8svx-8.snd\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"8svx-8.snd\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "sun-16-afsp.snd")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "AFspdate:1981/02/11 23:03:34 UTC")))
- (snd-display ";mus-sound-comment \"sun-16-afsp.snd\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"sun-16-afsp.snd\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "smp-16.snd")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "Converted using Sox. ")))
- (snd-display ";mus-sound-comment \"smp-16.snd\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"smp-16.snd\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "d40130.au")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "1994 Jesus Villena")))
- (snd-display ";mus-sound-comment \"d40130.au\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"d40130.au\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "wood.maud")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "file written by SOX MAUD-export ")))
- (snd-display ";mus-sound-comment \"wood.maud\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"wood.maud\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "addf8.sf_mipseb")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com))
(not (string-=? com "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" ")))
- (snd-display ";mus-sound-comment \"addf8.sf_mipseb\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"addf8.sf_mipseb\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "mary-sun4.sig")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com (string-append "MARY HAD A LITTLE LAMB" (string #\newline)))))
- (snd-display ";mus-sound-comment \"mary-sun4.sig\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"mary-sun4.sig\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "nasahal.pat")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "This patch saved with Sound Forge 3.0.")))
- (snd-display ";mus-sound-comment \"nasahal.pat\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"nasahal.pat\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "next-16.snd")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com))
(not (string-=? com ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91")))
- (snd-display ";mus-sound-comment \"next-16.snd\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"next-16.snd\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "wood16.nsp")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "Created by Snack ")))
- (snd-display ";mus-sound-comment \"wood16.nsp\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"wood16.nsp\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "wood.sdx")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "1994 Jesus Villena")))
- (snd-display ";mus-sound-comment \"wood.sdx\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"wood.sdx\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "clmcom.aif")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com "this is a comment")))
- (snd-display ";mus-sound-comment \"clmcom.aif\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"clmcom.aif\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "anno.aif")))
(if (file-exists? fsnd)
(begin
(set! com (mus-sound-comment fsnd))
(if (or (not (string? com)) (not (string-=? com (string-append "1994 Jesus Villena" (string #\newline)))))
- (snd-display ";mus-sound-comment \"anno.aif\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"anno.aif\") -> ~A?" com)))))
(let ((fsnd (string-append sf-dir "telephone.wav")))
(if (file-exists? fsnd)
(begin
@@ -2644,95 +2645,95 @@
(string #\newline)
"sample_sig_bits -i 16"
(string #\newline)))))
- (snd-display ";mus-sound-comment \"telephone.wav\") -> ~A?" com)))))
+ (snd-display #__line__ ";mus-sound-comment \"telephone.wav\") -> ~A?" com)))))
(if (not (string? (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
- (snd-display ";mus-sound-comment traffic: ~A" (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
+ (snd-display #__line__ ";mus-sound-comment traffic: ~A" (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
(if (= clmtest 0)
(begin
- (if (fneq (cadr mal) .14724) (snd-display ";oboe: mus-sound-maxamp ~F?" (cadr mal)))
- (if (not (= (car mal) 24971)) (snd-display ";oboe: mus-sound-maxamp at ~D?" (car mal)))))
+ (if (fneq (cadr mal) .14724) (snd-display #__line__ ";oboe: mus-sound-maxamp ~F?" (cadr mal)))
+ (if (not (= (car mal) 24971)) (snd-display #__line__ ";oboe: mus-sound-maxamp at ~D?" (car mal)))))
(set! (mus-sound-maxamp "oboe.snd") (list 1234 .5))
(set! mal (mus-sound-maxamp "oboe.snd"))
- (if (fneq (cadr mal) .5) (snd-display ";oboe: set! mus-sound-maxamp ~F?" (cadr mal)))
- (if (not (= (car mal) 1234)) (snd-display ";oboe: set! mus-sound-maxamp at ~D?" (car mal)))
+ (if (fneq (cadr mal) .5) (snd-display #__line__ ";oboe: set! mus-sound-maxamp ~F?" (cadr mal)))
+ (if (not (= (car mal) 1234)) (snd-display #__line__ ";oboe: set! mus-sound-maxamp at ~D?" (car mal)))
(set! mal (mus-sound-maxamp "4.aiff"))
(if (= clmtest 0)
(if (not (feql mal (list 810071 0.245 810071 0.490 810071 0.735 810071 0.980)))
- (snd-display ";mus-sound-maxamp 4.aiff: ~A?" mal)))
+ (snd-display #__line__ ";mus-sound-maxamp 4.aiff: ~A?" mal)))
(set! (mus-sound-maxamp "4.aiff") (list 12345 .5 54321 .2 0 .1 9999 .01))
(set! mal (mus-sound-maxamp "4.aiff"))
(if (not (feql mal (list 12345 .5 54321 .2 0 .1 9999 .01)))
- (snd-display ";set! mus-sound-maxamp 4.aiff: ~A?" mal))
+ (snd-display #__line__ ";set! mus-sound-maxamp 4.aiff: ~A?" mal))
(let ((var (catch #t (lambda () (set! (mus-sound-maxamp "oboe.snd") (list 1234))) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";set! mus-sound-maxamp bad arg: ~A" var)))
+ (snd-display #__line__ ";set! mus-sound-maxamp bad arg: ~A" var)))
(if (and (not (= (mus-sound-type-specifier "oboe.snd") #x646e732e)) ;little endian reader
(not (= (mus-sound-type-specifier "oboe.snd") #x2e736e64))) ;big endian reader
- (snd-display ";oboe: mus-sound-type-specifier: ~X?" (mus-sound-type-specifier "oboe.snd")))
+ (snd-display #__line__ ";oboe: mus-sound-type-specifier: ~X?" (mus-sound-type-specifier "oboe.snd")))
(if (not (string-=? (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd"))) "15-Oct-2006 04:34"))
- (snd-display ";oboe: file-write-date: ~A?" (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd")))))
+ (snd-display #__line__ ";oboe: file-write-date: ~A?" (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd")))))
(play-sound-1 "oboe.snd")
(mus-sound-forget "oboe.snd")
(let ((lasth (do ((i 1 (+ 1 i)))
((string-=? (mus-header-type-name i) "unsupported") i))))
- (if (< lasth 50) (snd-display ";header-type[~A] = ~A" lasth (mus-header-type-name lasth))))
+ (if (< lasth 50) (snd-display #__line__ ";header-type[~A] = ~A" lasth (mus-header-type-name lasth))))
(let ((lasth (do ((i 1 (+ 1 i)))
((string-=? (mus-data-format-name i) "unknown") i))))
- (if (< lasth 10) (snd-display ";data-format[~A] = ~A" lasth (mus-data-format-name lasth))))
+ (if (< lasth 10) (snd-display #__line__ ";data-format[~A] = ~A" lasth (mus-data-format-name lasth))))
(set! (transform-normalization) dont-normalize)
(if (not (= (transform-normalization) dont-normalize))
- (snd-display ";set-transform-normalization none -> ~A" (transform-normalization)))
+ (snd-display #__line__ ";set-transform-normalization none -> ~A" (transform-normalization)))
(set! (transform-normalization) normalize-globally)
(if (not (= (transform-normalization) normalize-globally))
- (snd-display ";set-transform-normalization globally -> ~A" (transform-normalization)))
+ (snd-display #__line__ ";set-transform-normalization globally -> ~A" (transform-normalization)))
(set! (transform-normalization) normalize-by-channel)
(if (not (= (transform-normalization) normalize-by-channel))
- (snd-display ";set-transform-normalization channel -> ~A" (transform-normalization)))
+ (snd-display #__line__ ";set-transform-normalization channel -> ~A" (transform-normalization)))
(let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "set-samples test" 100)))
(set! (samples 10 3) (make-vct 3 .1))
(if (not (vequal (channel->vct 0 20 ind 0) (vct 0 0 0 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display ";1 set samples 0 for .1: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";1 set samples 0 for .1: ~A" (channel->vct 0 20 ind 0)))
(set! (samples 20 3 ind 0) (make-vct 3 .1))
(if (not (vequal (channel->vct 10 20 ind 0) (vct .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display ";2 set samples 10 for .1: ~A" (channel->vct 10 20 ind 0)))
+ (snd-display #__line__ ";2 set samples 10 for .1: ~A" (channel->vct 10 20 ind 0)))
(set! (samples 30 3 ind 0 #f "a name") (make-vct 3 .1))
(if (not (vequal (channel->vct 20 20 ind 0) (vct .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display ";3 set samples 20 for .1: ~A" (channel->vct 20 20 ind 0)))
+ (snd-display #__line__ ";3 set samples 20 for .1: ~A" (channel->vct 20 20 ind 0)))
(set! (samples 0 3 ind 0 #f "a name" 0 1) (make-vct 3 .2))
(if (not (vequal (channel->vct 0 20 ind 0) (vct .2 .2 .2 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display ";4 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";4 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
(if (not (vequal (channel->vct 20 20 ind 0) (make-vct 20 0.0)))
- (snd-display ";5 set samples 20 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";5 set samples 20 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
(let ((nd (new-sound "fmv1.snd" :channels 2)))
(vct->channel (make-vct 10 .5) 0 10 nd 0)
(vct->channel (make-vct 10 .3) 0 10 nd 1)
(save-sound-as "fmv1.snd" nd)
(close-sound nd))
- (if (not (file-exists? "fmv1.snd")) (snd-display ";fmv1 not saved??"))
+ (if (not (file-exists? "fmv1.snd")) (snd-display #__line__ ";fmv1 not saved??"))
(set! (samples 0 10 ind 0 #f "another name" 1) "fmv1.snd")
(if (not (vequal (channel->vct 0 20 ind 0) (vct .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display ";6 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";6 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
(set! (samples 5 6 ind 0 #f "another name 7" 0) "fmv1.snd")
(if (not (vequal (channel->vct 0 20 ind 0) (vct .3 .3 .3 .3 .3 .5 .5 .5 .5 .5 .5 .1 .1 0 0 0 0 0 0 0)))
- (snd-display ";7 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";7 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
(revert-sound ind)
(set! (samples 0 10 ind 0 #f "another name 8" 1 0 #f) "fmv1.snd")
(if (not (vequal (channel->vct 0 20 ind 0) (vct .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 0 0 0 0 0 0 0 0 0 0)))
- (snd-display ";8 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";8 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
(set! (samples 10 10 ind 0 #f "another name 9" 0 0) "fmv1.snd")
(if (not (vequal (channel->vct 0 20 ind 0) (vct 0 0 0 0 0 0 0 0 0 0 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5)))
- (snd-display ";9 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";9 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
(set! (samples 20 10) "fmv1.snd")
(if (not (vequal (channel->vct 10 20 ind 0) (make-vct 20 .5)))
- (snd-display ";10 set samples 0 at 1 for .1: ~A" (channel->vct 10 20 ind 0)))
+ (snd-display #__line__ ";10 set samples 0 at 1 for .1: ~A" (channel->vct 10 20 ind 0)))
(revert-sound ind)
(set! (samples 0 10 ind 0 #t "another name" 1 0 #f) "fmv1.snd")
- (if (not (= (frames ind 0) 10)) (snd-display ";11 set-samples truncate to ~A" (frames ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";11 set-samples truncate to ~A" (frames ind 0)))
(revert-sound ind)
(delete-file "fmv1.snd")
@@ -2740,7 +2741,7 @@
(let ((tag (catch #t
(lambda () (set! (samples 0 10 ind 0) "fmv1.snd"))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-file)) (snd-display ";set-samples, no such file: ~A" tag)))
+ (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";set-samples, no such file: ~A" tag)))
(let ((nd (new-sound "fmv1.snd" :channels 1)))
(vct->channel (make-vct 10 .5) 0 10 nd 0)
(save-sound-as "fmv1.snd" nd)
@@ -2748,19 +2749,19 @@
(let ((tag (catch #t
(lambda () (set! (samples 0 10 ind 0 #f "another name" 1) "fmv1.snd")) ; chan 1 does not exist
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display ";set-samples no such channel: ~A" tag)))
+ (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";set-samples no such channel: ~A" tag)))
(let ((tag (catch #t
(lambda () (set! (samples 0 10 ind 0 #f "another name" -1) "fmv1.snd"))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display ";set-samples no such channel (-1): ~A" tag)))
+ (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";set-samples no such channel (-1): ~A" tag)))
(let ((tag (catch #t
(lambda () (set! (samples 0 -10) "fmv1.snd"))
(lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";set-samples (-10): ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-samples (-10): ~A" tag)))
(let ((tag (catch #t
(lambda () (set! (samples -10 10) "fmv1.snd"))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample)) (snd-display ";set-samples (beg -10): ~A" tag)))
+ (if (not (eq? tag 'no-such-sample)) (snd-display #__line__ ";set-samples (beg -10): ~A" tag)))
(close-sound ind))
(let ((len 100))
@@ -2784,7 +2785,7 @@
(let ((val (random 1.9999)))
(if (or (> val 2.0)
(< val 0.0))
- (snd-display ";random 2.0 -> ~A?" val))
+ (snd-display #__line__ ";random 2.0 -> ~A?" val))
(vct-set! v i (- 1.0 val))))
(vct->channel v 0 len ind 0)
(save-sound-as "test1.snd" ind mus-next :data-format type)
@@ -2799,7 +2800,7 @@
(set! maxdiff diff)
(set! maxpos i)))))
(if (> maxdiff allowed-diff)
- (snd-display ";[line 2841] ~A: ~A at ~A (~A ~A)"
+ (snd-display #__line__ ";[line 2841] ~A: ~A at ~A (~A ~A)"
(mus-data-format-name type)
maxdiff maxpos
(vct-ref v maxpos) (vct-ref v1 maxpos)))
@@ -2824,53 +2825,51 @@
(lambda ()
(save-sound-as "test.snd" ob mus-aifc mus-bdouble))
(lambda args (car args)))))
- (if (eq? tag 'cannot-save) (snd-display ";save-sound-as test.snd write trouble")))
+ (if (eq? tag 'cannot-save) (snd-display #__line__ ";save-sound-as test.snd write trouble")))
(set! (filter-control-in-hz) #t)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (provided? 'snd-debug)
- (begin
- (if (snd-sound-pointer 12345) (snd-display ";snd-sound-pointer #f: ~A" (snd-sound-pointer 12345)))
- (if (not (number? (snd-sound-pointer ab))) (snd-display ";snd-sound-pointer ~A: ~A" ab (snd-sound-pointer ab)))))
+ (if (snd-sound-pointer 12345) (snd-display #__line__ ";snd-sound-pointer #f: ~A" (snd-sound-pointer 12345))))
(if (not (= (header-type ab) mus-aifc))
- (snd-display ";save-as aifc -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as aifc -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-aifc))
- (snd-display ";saved-as aifc -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";aifc[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as aifc -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";aifc[1000] = ~A?" (sample 1000 ab)))
(if (or (not (string? (mus-sound-comment "test.snd")))
(not (string-=? (mus-sound-comment "test.snd") str)))
- (snd-display ";output-comment: ~A ~A" (mus-sound-comment "test.snd") str))
+ (snd-display #__line__ ";output-comment: ~A ~A" (mus-sound-comment "test.snd") str))
(if (or (not (string? (comment ab)))
(not (string-=? (comment ab) str)))
- (snd-display ";output-comment (comment): ~A ~A" (comment ab) str))
+ (snd-display #__line__ ";output-comment (comment): ~A ~A" (comment ab) str))
(close-sound ab))
(if (not (equal? old-comment (mus-sound-comment "oboe.snd")))
- (snd-display ";set-comment overwrote current ~A ~A" old-comment (mus-sound-comment "oboe.snd")))
+ (snd-display #__line__ ";set-comment overwrote current ~A ~A" old-comment (mus-sound-comment "oboe.snd")))
(set! (filter-control-in-hz) #f)
(save-sound-as "test.snd" ob mus-raw)
(let ((ab (open-raw-sound "test.snd" 1 22050 mus-bshort)))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-raw))
- (snd-display ";save-as raw -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as raw -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-raw))
- (snd-display ";saved-as raw -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";raw[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as raw -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";raw[1000] = ~A?" (sample 1000 ab)))
(close-sound ab))
(save-sound-as "test.snd" ob mus-nist mus-bint)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-nist))
- (snd-display ";save-as nist -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as nist -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-nist))
- (snd-display ";saved-as nist -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (snd-display #__line__ ";saved-as nist -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
(if (not (= (data-format ab) mus-bint))
- (snd-display ";save-as int -> ~A?" (mus-data-format-name (data-format ab))))
+ (snd-display #__line__ ";save-as int -> ~A?" (mus-data-format-name (data-format ab))))
(if (not (= (mus-sound-data-format "test.snd") mus-bint))
- (snd-display ";saved-as int -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";nist[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as int -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";nist[1000] = ~A?" (sample 1000 ab)))
(close-sound ab))
(reset-hook! output-comment-hook)
(add-hook! output-comment-hook
@@ -2882,127 +2881,127 @@
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-riff))
- (snd-display ";save-as riff -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as riff -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-riff))
- (snd-display ";saved-as riff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (snd-display #__line__ ";saved-as riff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
(if (not (= (data-format ab) mus-lfloat))
- (snd-display ";save-as float -> ~A?" (mus-data-format-name (data-format ab))))
+ (snd-display #__line__ ";save-as float -> ~A?" (mus-data-format-name (data-format ab))))
(if (not (= (mus-sound-data-format "test.snd") mus-lfloat))
- (snd-display ";saved-as float -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";riff[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as float -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";riff[1000] = ~A?" (sample 1000 ab)))
(if (or (not (string? (comment ab)))
(not (string-=? (comment ab)
(string-append "written "
(strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))
" [written by me]"))))
- (snd-display ";output-comment-hook: ~A~%(~A)" (comment ab) (mus-sound-comment "test.snd")))
+ (snd-display #__line__ ";output-comment-hook: ~A~%(~A)" (comment ab) (mus-sound-comment "test.snd")))
(close-sound ab))
(save-sound-as "test.snd" ob mus-aiff mus-b24int)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-aiff))
- (snd-display ";save-as aiff -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as aiff -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-aiff))
- (snd-display ";saved-as aiff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (snd-display #__line__ ";saved-as aiff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
(if (not (= (data-format ab) mus-b24int))
- (snd-display ";save-as 24-bit -> ~A?" (mus-data-format-name (data-format ab))))
+ (snd-display #__line__ ";save-as 24-bit -> ~A?" (mus-data-format-name (data-format ab))))
(if (not (= (mus-sound-data-format "test.snd") mus-b24int))
- (snd-display ";saved-as 24-bit -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";aiff[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as 24-bit -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";aiff[1000] = ~A?" (sample 1000 ab)))
(close-sound ab))
(save-sound-as "test.snd" ob mus-ircam mus-mulaw)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-ircam))
- (snd-display ";save-as ircam -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as ircam -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-ircam))
- (snd-display ";saved-as ircam -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (snd-display #__line__ ";saved-as ircam -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
(if (not (= (data-format ab) mus-mulaw))
- (snd-display ";save-as mulaw -> ~A?" (mus-data-format-name (data-format ab))))
+ (snd-display #__line__ ";save-as mulaw -> ~A?" (mus-data-format-name (data-format ab))))
(if (not (= (mus-sound-data-format "test.snd") mus-mulaw))
- (snd-display ";saved-as mulaw -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";ircam[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as mulaw -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";ircam[1000] = ~A?" (sample 1000 ab)))
(close-sound ab))
(save-sound-as "test.snd" ob mus-next mus-alaw)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-next))
- (snd-display ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-next))
- (snd-display ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
(if (not (= (data-format ab) mus-alaw))
- (snd-display ";save-as alaw -> ~A?" (mus-data-format-name (data-format ab))))
+ (snd-display #__line__ ";save-as alaw -> ~A?" (mus-data-format-name (data-format ab))))
(if (not (= (mus-sound-data-format "test.snd") mus-alaw))
- (snd-display ";saved-as alaw -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";next (alaw)[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as alaw -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (alaw)[1000] = ~A?" (sample 1000 ab)))
(close-sound ab))
(save-sound-as "test.snd" ob mus-next mus-bdouble)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-next))
- (snd-display ";save-as dbl next -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as dbl next -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (data-format ab) mus-bdouble))
- (snd-display ";save-as dbl -> ~A?" (mus-data-format-name (data-format ab))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";next (dbl)[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";save-as dbl -> ~A?" (mus-data-format-name (data-format ab))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (dbl)[1000] = ~A?" (sample 1000 ab)))
(close-sound ab))
(save-sound-as "test.snd" ob mus-next mus-bshort)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-next))
- (snd-display ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-next))
- (snd-display ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
(if (not (= (data-format ab) mus-bshort))
- (snd-display ";save-as short -> ~A?" (mus-data-format-name (data-format ab))))
+ (snd-display #__line__ ";save-as short -> ~A?" (mus-data-format-name (data-format ab))))
(if (not (= (mus-sound-data-format "test.snd") mus-bshort))
- (snd-display ";saved-as short -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";next (short)[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as short -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (short)[1000] = ~A?" (sample 1000 ab)))
(reset-hook! update-hook)
(set! (y-bounds ab 0) (list -3.0 3.0))
(set! (data-format ab) mus-lshort)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd"))) ; these set!'s can change the index via update-sound
- (if (not (= (data-format ab) mus-lshort)) (snd-display ";set data-format: ~A?" (mus-data-format-name (data-format ab))))
- (if (not (equal? (y-bounds ab 0) (list -3.0 3.0))) (snd-display ";set data format y-bounds: ~A?" (y-bounds ab 0)))
+ (if (not (= (data-format ab) mus-lshort)) (snd-display #__line__ ";set data-format: ~A?" (mus-data-format-name (data-format ab))))
+ (if (not (equal? (y-bounds ab 0) (list -3.0 3.0))) (snd-display #__line__ ";set data format y-bounds: ~A?" (y-bounds ab 0)))
(set! (y-bounds ab 0) (list 2.0))
- (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display ";set data format y-bounds 1: ~A?" (y-bounds ab 0)))
+ (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display #__line__ ";set data format y-bounds 1: ~A?" (y-bounds ab 0)))
(set! (y-bounds ab 0) (list -2.0))
- (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display ";set data format y-bounds -2: ~A?" (y-bounds ab 0)))
+ (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display #__line__ ";set data format y-bounds -2: ~A?" (y-bounds ab 0)))
(set! (header-type ab) mus-aifc)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (header-type ab) mus-aifc)) (snd-display ";set header-type: ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (header-type ab) mus-aifc)) (snd-display #__line__ ";set header-type: ~A?" (mus-header-type-name (header-type ab))))
(set! (channels ab) 3)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (channels ab) 3)) (snd-display ";set chans: ~A?" (channels ab)))
+ (if (not (= (channels ab) 3)) (snd-display #__line__ ";set chans: ~A?" (channels ab)))
(set! (data-location ab) 1234)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-location ab) 1234)) (snd-display ";set data-location: ~A?" (data-location ab)))
+ (if (not (= (data-location ab) 1234)) (snd-display #__line__ ";set data-location: ~A?" (data-location ab)))
(let ((old-size (data-size ab)))
(set! (data-size ab) 1234)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-size ab) 1234)) (snd-display ";set data-size: ~A?" (data-size ab)))
+ (if (not (= (data-size ab) 1234)) (snd-display #__line__ ";set data-size: ~A?" (data-size ab)))
(set! (data-size ab) old-size))
(set! (srate ab) 12345)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (srate ab) 12345)) (snd-display ";set srate: ~A?" (srate ab)))
+ (if (not (= (srate ab) 12345)) (snd-display #__line__ ";set srate: ~A?" (srate ab)))
(close-sound ab))
(save-sound-as "test.snd" ob mus-next mus-bfloat)
(let ((ab (open-sound "test.snd")))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(if (not (= (header-type ab) mus-next))
- (snd-display ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
+ (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
(if (not (= (mus-sound-header-type "test.snd") mus-next))
- (snd-display ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
(if (not (= (data-format ab) mus-bfloat))
- (snd-display ";save-as float -> ~A?" (mus-data-format-name (data-format ab))))
+ (snd-display #__line__ ";save-as float -> ~A?" (mus-data-format-name (data-format ab))))
(if (not (= (mus-sound-data-format "test.snd") mus-bfloat))
- (snd-display ";saved-as float -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display ";next (float)[1000] = ~A?" (sample 1000 ab)))
+ (snd-display #__line__ ";saved-as float -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (float)[1000] = ~A?" (sample 1000 ab)))
(close-sound ab))
(save-sound-as "test.snd" ob mus-next mus-bshort)
(close-sound ob)
@@ -3011,84 +3010,84 @@
(XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
(set! (data-format) mus-lshort)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-format) mus-lshort)) (snd-display ";set data-format: ~A?" (mus-data-format-name (data-format))))
+ (if (not (= (data-format) mus-lshort)) (snd-display #__line__ ";set data-format: ~A?" (mus-data-format-name (data-format))))
(set! (header-type) mus-aifc)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (header-type) mus-aifc)) (snd-display ";set header-type: ~A?" (mus-header-type-name (header-type))))
+ (if (not (= (header-type) mus-aifc)) (snd-display #__line__ ";set header-type: ~A?" (mus-header-type-name (header-type))))
(set! (channels) 3)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (channels) 3)) (snd-display ";set chans: ~A?" (channels)))
+ (if (not (= (channels) 3)) (snd-display #__line__ ";set chans: ~A?" (channels)))
(set! (data-location) 1234)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-location) 1234)) (snd-display ";set data-location: ~A?" (data-location)))
+ (if (not (= (data-location) 1234)) (snd-display #__line__ ";set data-location: ~A?" (data-location)))
(set! (srate) 12345)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (srate) 12345)) (snd-display ";set srate: ~A?" (srate)))
+ (if (not (= (srate) 12345)) (snd-display #__line__ ";set srate: ~A?" (srate)))
(close-sound ab)))
-
+
(let ((ind (open-sound "2a.snd")))
(save-sound-as "test.snd" :data-format mus-l24int :header-type mus-riff :channel 0)
(let ((ind0 (open-sound "test.snd")))
(if (not (= (channels ind0) 1))
- (snd-display ";save-sound-as :channel 0 chans: ~A" (channels ind0)))
+ (snd-display #__line__ ";save-sound-as :channel 0 chans: ~A" (channels ind0)))
(if (not (= (data-format ind0) mus-l24int))
- (snd-display ";save-sound-as :channel 0 data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
+ (snd-display #__line__ ";save-sound-as :channel 0 data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
(if (not (= (header-type ind0) mus-riff))
- (snd-display ";save-sound-as :channel 0 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (snd-display #__line__ ";save-sound-as :channel 0 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
(if (not (= (srate ind0) (srate ind)))
- (snd-display ";save-sound-as :channel 0 srates: ~A ~A" (srate ind0) (srate ind)))
+ (snd-display #__line__ ";save-sound-as :channel 0 srates: ~A ~A" (srate ind0) (srate ind)))
(if (not (= (frames ind0) (frames ind 0)))
- (snd-display ";save-sound-as :channel 0 frames: ~A ~A" (frames ind0) (frames ind 0)))
+ (snd-display #__line__ ";save-sound-as :channel 0 frames: ~A ~A" (frames ind0) (frames ind 0)))
(if (fneq (maxamp ind0 0) (maxamp ind 0))
- (snd-display ";save-sound-as :channel 0 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 0)))
+ (snd-display #__line__ ";save-sound-as :channel 0 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 0)))
(close-sound ind0))
(save-sound-as "test.snd" :data-format mus-bfloat :header-type mus-aifc :channel 1 :srate 12345)
(let ((ind0 (open-sound "test.snd")))
(if (not (= (channels ind0) 1))
- (snd-display ";save-sound-as :channel 1 chans: ~A" (channels ind0)))
+ (snd-display #__line__ ";save-sound-as :channel 1 chans: ~A" (channels ind0)))
(if (not (= (data-format ind0) mus-bfloat))
- (snd-display ";save-sound-as :channel 1 data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
+ (snd-display #__line__ ";save-sound-as :channel 1 data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
(if (not (= (header-type ind0) mus-aifc))
- (snd-display ";save-sound-as :channel 1 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (snd-display #__line__ ";save-sound-as :channel 1 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
(if (not (= (srate ind0) 12345))
- (snd-display ";save-sound-as :channel 1 srates: ~A ~A" (srate ind0) (srate ind)))
+ (snd-display #__line__ ";save-sound-as :channel 1 srates: ~A ~A" (srate ind0) (srate ind)))
(if (not (= (frames ind0) (frames ind 1)))
- (snd-display ";save-sound-as :channel 1 frames: ~A ~A" (frames ind0) (frames ind 1)))
+ (snd-display #__line__ ";save-sound-as :channel 1 frames: ~A ~A" (frames ind0) (frames ind 1)))
(if (fneq (maxamp ind0 0) (maxamp ind 1))
- (snd-display ";save-sound-as :channel 1 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
+ (snd-display #__line__ ";save-sound-as :channel 1 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
(close-sound ind0))
(save-sound-as "test.snd" :channel 1 :comment "this is a test")
(let ((ind0 (open-sound "test.snd")))
(if (not (= (channels ind0) 1))
- (snd-display ";save-sound-as :channel 1 (1) chans: ~A" (channels ind0)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) chans: ~A" (channels ind0)))
(if (not (= (data-format ind0) (data-format ind)))
- (snd-display ";save-sound-as :channel 1 (1) data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
(if (not (= (header-type ind0) (header-type ind)))
- (snd-display ";save-sound-as :channel 1 (1) header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
(if (not (= (srate ind0) (srate ind)))
- (snd-display ";save-sound-as :channel 1 (1) srates: ~A ~A" (srate ind0) (srate ind)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) srates: ~A ~A" (srate ind0) (srate ind)))
(if (not (= (frames ind0) (frames ind 1)))
- (snd-display ";save-sound-as :channel 1 (1) frames: ~A ~A" (frames ind0) (frames ind 1)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) frames: ~A ~A" (frames ind0) (frames ind 1)))
(if (fneq (maxamp ind0 0) (maxamp ind 1))
- (snd-display ";save-sound-as :channel 1 (1) maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
(if (not (string=? (comment ind0) "this is a test"))
- (snd-display ";save-sound-as :channel 0 (1) comment: ~A" (comment ind0)))
+ (snd-display #__line__ ";save-sound-as :channel 0 (1) comment: ~A" (comment ind0)))
(close-sound ind0))
(close-sound ind))
-
+
(let ((fsnd (string-append sf-dir "t15.aiff")))
(if (file-exists? fsnd)
(let ((ind (open-sound fsnd)))
(if (or (fneq (sample 132300 ind 0) .148)
(fneq (sample 132300 ind 1) .126))
- (snd-display ";aifc sowt trouble: ~A ~A" (sample 132300 ind 0) (sample 132300 ind 1)))
+ (snd-display #__line__ ";aifc sowt trouble: ~A ~A" (sample 132300 ind 0) (sample 132300 ind 1)))
(close-sound ind))))
(let ((fsnd (string-append sf-dir "M1F1-float64C-AFsp.aif")))
(if (file-exists? fsnd)
(let ((ind (open-sound fsnd)))
(if (or (fneq (sample 8000 ind 0) -0.024)
(fneq (sample 8000 ind 1) 0.021))
- (snd-display ";aifc fl64 trouble: ~A ~A" (sample 8000 ind 0) (sample 8000 ind 1)))
+ (snd-display #__line__ ";aifc fl64 trouble: ~A ~A" (sample 8000 ind 0) (sample 8000 ind 1)))
(close-sound ind))))
(for-each (lambda (n vals)
@@ -3099,7 +3098,7 @@
(lambda args (car args)))))
(if (and (not (equal? val vals))
(not (eq? val 'mus-error)))
- (snd-display ";~A: ~A ~A" n val vals))))
+ (snd-display #__line__ ";~A: ~A ~A" n val vals))))
(list (string-append sf-dir "bad_chans.snd")
(string-append sf-dir "bad_srate.snd")
(string-append sf-dir "bad_data_format.snd")
@@ -3126,7 +3125,7 @@
(let ((ind (open-sound (string-append "/usr/include/sys/" home-dir "/cl/oboe.snd"))))
(if (or (not (sound? ind))
(not (string=? (short-file-name ind) "oboe.snd")))
- (snd-display ";open-sound with slashes: ~A ~A" ind (and (sound? ind) (short-file-name ind))))
+ (snd-display #__line__ ";open-sound with slashes: ~A ~A" ind (and (sound? ind) (short-file-name ind))))
(add-hook! bad-header-hook (lambda (n) #t))
(for-each (lambda (n)
(begin
@@ -3158,49 +3157,49 @@
(string-append sf-dir "bad_srate.nist")
(string-append sf-dir "bad_length.nist")))
(close-sound ind))
-
+
(map close-sound (sounds))
(let* ((ob (open-sound (string-append "~/baddy/" home-dir "/cl/oboe.snd")))
(sd (samples->sound-data))
(mx (sound-data-maxamp sd)))
- (if (not (= (sound-data-length sd) 50828)) (snd-display ";oboe->sd: len ~A?" (sound-data-length sd)))
- (if (fneq (sound-data-ref sd 0 1000) .0328369) (snd-display ";oboe->sd[1000]: ~A?" (sound-data-ref sd 0 1000)))
- (if (not (= (length mx) 1)) (snd-display ";sound-data-maxamp oboe.snd: ~A?" mx))
- (if (not (= (maxamp ob 0) (car mx))) (snd-display ";sound-data-maxamp oboe.snd: ~A ~A?" mx (maxamp ob 0)))
- (if (fneq (sound-data-peak sd) (car mx)) (snd-display ";sound-data-peak oboe.snd: ~A ~A" (sound-data-peak sd) mx))
+ (if (not (= (sound-data-length sd) 50828)) (snd-display #__line__ ";oboe->sd: len ~A?" (sound-data-length sd)))
+ (if (fneq (sound-data-ref sd 0 1000) .0328369) (snd-display #__line__ ";oboe->sd[1000]: ~A?" (sound-data-ref sd 0 1000)))
+ (if (not (= (length mx) 1)) (snd-display #__line__ ";sound-data-maxamp oboe.snd: ~A?" mx))
+ (if (not (= (maxamp ob 0) (car mx))) (snd-display #__line__ ";sound-data-maxamp oboe.snd: ~A ~A?" mx (maxamp ob 0)))
+ (if (fneq (sound-data-peak sd) (car mx)) (snd-display #__line__ ";sound-data-peak oboe.snd: ~A ~A" (sound-data-peak sd) mx))
(let ((var (catch #t (lambda () (set! (selected-channel) 1)) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";set selected-channel bad chan: ~A" var)))
+ (snd-display #__line__ ";set selected-channel bad chan: ~A" var)))
(let ((var (catch #t (lambda () (set! (selected-channel 123456) 1)) (lambda args args))))
(if (not (eq? (car var) 'no-such-sound))
- (snd-display ";set selected-channel bad snd: ~A" var)))
+ (snd-display #__line__ ";set selected-channel bad snd: ~A" var)))
(let ((var (catch #t (lambda () (sound-data-ref sd 2 1000)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";sound-data-ref bad chan: ~A" var)))
+ (snd-display #__line__ ";sound-data-ref bad chan: ~A" var)))
(let ((var (catch #t (lambda () (sound-data-ref sd -1 1000)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";sound-data-ref bad chan -1: ~A" var)))
+ (snd-display #__line__ ";sound-data-ref bad chan -1: ~A" var)))
(let ((var (catch #t (lambda () (sound-data-ref sd 0 -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";sound-data-ref bad frame: ~A" var)))
+ (snd-display #__line__ ";sound-data-ref bad frame: ~A" var)))
(let ((var (catch #t (lambda () (sound-data-ref sd 0 10000000)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";sound-data-ref bad frame high: ~A" var)))
+ (snd-display #__line__ ";sound-data-ref bad frame high: ~A" var)))
(let ((var (catch #t (lambda () (sound-data-set! sd 2 1000 1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";sound-data-set! bad chan: ~A" var)))
+ (snd-display #__line__ ";sound-data-set! bad chan: ~A" var)))
(let ((var (catch #t (lambda () (sound-data-set! sd 0 10000000 1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";sound-data-set! bad frame: ~A" var)))
+ (snd-display #__line__ ";sound-data-set! bad frame: ~A" var)))
(let* ((v (make-vct 3))
(var (catch #t (lambda () (vct->sound-data v sd 2)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct->sound-data-set! bad chan: ~A" var)))
+ (snd-display #__line__ ";vct->sound-data-set! bad chan: ~A" var)))
(close-sound ob))
(if (selected-sound)
- (snd-display ";selected-sound ~A ~A" (selected-sound) (sounds)))
+ (snd-display #__line__ ";selected-sound ~A ~A" (selected-sound) (sounds)))
(if (file-exists? (string-append (or sf-dir "") "a.sf2"))
(let ((fil (open-sound (string-append (or sf-dir "") "a.sf2"))))
@@ -3209,7 +3208,7 @@
(if (or (null? loops)
(not (= (caddar loops) 65390))
(not (= (cadadr loops) 65490)))
- (snd-display ";soundfont-info: ~A?" loops))
+ (snd-display #__line__ ";soundfont-info: ~A?" loops))
(close-sound fil)))))
(if (file-exists? "fmv5.snd") (delete-file "fmv5.snd"))
@@ -3221,33 +3220,33 @@
(sound-data-set! sdata 0 i (* i .01)))
(if (not (string-=? "#<sound-data[chans=1, length=100]:\n (0.000 0.010 0.020 0.030 0.040 0.050 0.060 0.070 0.080 0.090 0.100 0.110 ...)>"
(format #f "~A" sdata)))
- (snd-display ";print sound-data: ~A?" (format #f "~A" sdata)))
+ (snd-display #__line__ ";print sound-data: ~A?" (format #f "~A" sdata)))
(let ((edat sdata)
(edat1 (make-sound-data 1 100))
(edat2 (make-sound-data 2 100)))
- (if (not (eq? sdata edat)) (snd-display ";sound-data not eq? ~A ~A" sdata edat))
- (if (not (equal? sdata edat)) (snd-display ";sound-data not equal? ~A ~A" sdata edat))
- (if (equal? sdata edat1) (snd-display ";sound-data 1 equal? ~A ~A" sdata edat1))
- (if (equal? edat2 edat1) (snd-display ";sound-data 2 equal? ~A ~A" edat2 edat1))
+ (if (not (eq? sdata edat)) (snd-display #__line__ ";sound-data not eq? ~A ~A" sdata edat))
+ (if (not (equal? sdata edat)) (snd-display #__line__ ";sound-data not equal? ~A ~A" sdata edat))
+ (if (equal? sdata edat1) (snd-display #__line__ ";sound-data 1 equal? ~A ~A" sdata edat1))
+ (if (equal? edat2 edat1) (snd-display #__line__ ";sound-data 2 equal? ~A ~A" edat2 edat1))
(do ((i 0 (+ 1 i)))
((= i 100))
(set! (sound-data-ref edat1 0 i) (sound-data-ref sdata 0 i)))
- (if (not (equal? sdata edat1)) (snd-display ";sound-data 3 not equal? ~A ~A" sdata edat1)))
+ (if (not (equal? sdata edat1)) (snd-display #__line__ ";sound-data 3 not equal? ~A ~A" sdata edat1)))
(let ((v0 (make-vct 100))
(v1 (make-vct 3)))
(sound-data->vct sdata 0 v0)
- (if (fneq (vct-ref v0 10) .1) (snd-display ";sound-data->vct: ~A?" v0))
+ (if (fneq (vct-ref v0 10) .1) (snd-display #__line__ ";sound-data->vct: ~A?" v0))
(sound-data->vct sdata 0 v1)
- (if (fneq (vct-ref v1 1) .01) (snd-display ";sound-data->(small)vct: ~A?" v1))
+ (if (fneq (vct-ref v1 1) .01) (snd-display #__line__ ";sound-data->(small)vct: ~A?" v1))
(vct->sound-data v0 sdata 0)
- (if (fneq (sound-data-ref sdata 0 10) .1) (snd-display ";vct->sound-data: ~A?" (sound-data-ref sdata 0 10)))
- (if (fneq (sdata 0 10) .1) (snd-display ";vct->sound-data applied: ~A?" (sdata 0 10)))
+ (if (fneq (sound-data-ref sdata 0 10) .1) (snd-display #__line__ ";vct->sound-data: ~A?" (sound-data-ref sdata 0 10)))
+ (if (fneq (sdata 0 10) .1) (snd-display #__line__ ";vct->sound-data applied: ~A?" (sdata 0 10)))
(let ((var (catch #t (lambda () (sound-data->vct sdata 2 v0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";sound-data->vct bad chan: ~A" var)))
+ (snd-display #__line__ ";sound-data->vct bad chan: ~A" var)))
(let ((var (catch #t (lambda () (mus-audio-write 1 (make-sound-data 3 3) 123)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-audio-write bad frames: ~A" var))))
+ (snd-display #__line__ ";mus-audio-write bad frames: ~A" var))))
(let ((v0 (make-vct 10))
(vx (make-vct 3))
@@ -3258,16 +3257,16 @@
(sound-data-set! sdata2 1 i 0.2))
(sound-data->vct sdata2 0 v0)
(sound-data->vct sdata2 0 vx)
- (if (fneq (vct-ref v0 1) .1) (snd-display ";sound-data->vct[1]: ~A?" v0))
+ (if (fneq (vct-ref v0 1) .1) (snd-display #__line__ ";sound-data->vct[1]: ~A?" v0))
(sound-data->vct sdata2 1 v0)
- (if (fneq (vct-ref v0 1) .2) (snd-display ";sound-data->vct[2]: ~A?" v0))
+ (if (fneq (vct-ref v0 1) .2) (snd-display #__line__ ";sound-data->vct[2]: ~A?" v0))
(vct->sound-data v0 sdata2 0)
(if (fneq (sound-data-ref sdata2 0 1) .2)
- (snd-display ";vct->sound-data[2]: ~A?" (sound-data-ref sdata2 0 1)))
+ (snd-display #__line__ ";vct->sound-data[2]: ~A?" (sound-data-ref sdata2 0 1)))
(vct-fill! v0 .3)
(vct->sound-data v0 sdata2 1)
(if (fneq (sound-data-ref sdata2 1 1) .3)
- (snd-display ";vct->sound-data[3]: ~A?" (sound-data-ref sdata2 1 1)))
+ (snd-display #__line__ ";vct->sound-data[3]: ~A?" (sound-data-ref sdata2 1 1)))
(vct->sound-data vx sdata2 0))
(mus-sound-write fd 0 99 1 sdata)
(mus-sound-close-output fd (* 100 (mus-bytes-per-sample mus-bshort))) ; bshort chosen at open
@@ -3275,14 +3274,14 @@
(mus-sound-close-output fd (* 100 (mus-bytes-per-sample mus-bshort)))
(set! fd (mus-sound-open-input "fmv5.snd"))
(mus-sound-read fd 0 99 1 sdata)
- (if (fneq (sound-data-ref sdata 0 10) .1) (snd-display ";mus-sound-write: ~A?" (sound-data-ref sdata 0 10)))
+ (if (fneq (sound-data-ref sdata 0 10) .1) (snd-display #__line__ ";mus-sound-write: ~A?" (sound-data-ref sdata 0 10)))
(let ((pos (mus-sound-seek-frame fd 20)))
(if (not (= pos (ftell fd)))
- (snd-display ";1 mus-sound-seek-frame: ~A ~A?" pos (ftell fd)))
+ (snd-display #__line__ ";1 mus-sound-seek-frame: ~A ~A?" pos (ftell fd)))
(if (not (= pos (frame->byte "fmv5.snd" 20)))
- (snd-display ";2 mus-sound-seek-frame(2): ~A ~A?" pos (frame->byte "fmv5.snd" 20))))
+ (snd-display #__line__ ";2 mus-sound-seek-frame(2): ~A ~A?" pos (frame->byte "fmv5.snd" 20))))
(mus-sound-read fd 0 10 1 sdata)
- (if (fneq (sound-data-ref sdata 0 0) .2) (snd-display ";2 mus-sound-seek: ~A?" (sound-data-ref sdata 0 0)))
+ (if (fneq (sound-data-ref sdata 0 0) .2) (snd-display #__line__ ";2 mus-sound-seek: ~A?" (sound-data-ref sdata 0 0)))
(mus-sound-close-input fd))
(let ((sd (make-sound-data 2 10)))
@@ -3290,45 +3289,45 @@
(vct->sound-data (make-vct 10 .5) sd 1)
(sound-data-scale! sd 2.0)
(if (not (vequal (sound-data->vct sd 0) (make-vct 10 .5)))
- (snd-display ";sound-data-scale! chan 0: ~A" (sound-data->vct sd 0)))
+ (snd-display #__line__ ";sound-data-scale! chan 0: ~A" (sound-data->vct sd 0)))
(if (not (vequal (sound-data->vct sd 1) (make-vct 10 1.0)))
- (snd-display ";sound-data-scale! chan 1: ~A" (sound-data->vct sd 1))))
+ (snd-display #__line__ ";sound-data-scale! chan 1: ~A" (sound-data->vct sd 1))))
(let ((sd (make-sound-data 2 10)))
(sound-data-fill! sd 2.0)
(if (not (vequal (sound-data->vct sd 0) (make-vct 10 2.0)))
- (snd-display ";sound-data-fill! chan 0: ~A" (sound-data->vct sd 0)))
+ (snd-display #__line__ ";sound-data-fill! chan 0: ~A" (sound-data->vct sd 0)))
(if (not (vequal (sound-data->vct sd 1) (make-vct 10 2.0)))
- (snd-display ";sound-data-fill! chan 1: ~A" (sound-data->vct sd 1))))
+ (snd-display #__line__ ";sound-data-fill! chan 1: ~A" (sound-data->vct sd 1))))
(let ((var (catch #t (lambda () (mus-sound-open-output "fmv.snd" 22050 -1 mus-bshort mus-aiff "no comment")) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-sound-open-output bad chans: ~A" var)))
+ (snd-display #__line__ ";mus-sound-open-output bad chans: ~A" var)))
(let ((var (catch #t (lambda () (mus-sound-open-output "fmv.snd" 22050 1 -1 mus-aiff "no comment")) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-sound-open-output bad format: ~A" var)))
+ (snd-display #__line__ ";mus-sound-open-output bad format: ~A" var)))
(let ((var (catch #t (lambda () (mus-sound-open-output "fmv.snd" 22050 1 mus-bshort -1 "no comment")) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-sound-open-output bad type: ~A" var)))
+ (snd-display #__line__ ";mus-sound-open-output bad type: ~A" var)))
(let ((var (catch #t (lambda () (mus-sound-reopen-output "fmv.snd" -1 mus-bshort mus-aiff #f)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-sound-reopen-output bad chans: ~A" var)))
+ (snd-display #__line__ ";mus-sound-reopen-output bad chans: ~A" var)))
(let ((var (catch #t (lambda () (mus-sound-reopen-output "fmv.snd" 1 -1 mus-aiff #f)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-sound-reopen-output bad format: ~A" var)))
+ (snd-display #__line__ ";mus-sound-reopen-output bad format: ~A" var)))
(let ((var (catch #t (lambda () (mus-sound-reopen-output "fmv.snd" 1 mus-bshort -1 #f)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-sound-reopen-output bad type: ~A" var)))
-
+ (snd-display #__line__ ";mus-sound-reopen-output bad type: ~A" var)))
+
(let ((sd (make-sound-data 2 10)))
(fill! sd 1.0)
(if (not (vequal (sound-data->vct sd 0) (make-vct 10 1.0)))
- (snd-display ";fill! sd chan 0: ~A" (sound-data->vct sd 0)))
+ (snd-display #__line__ ";fill! sd chan 0: ~A" (sound-data->vct sd 0)))
(if (not (vequal (sound-data->vct sd 1) (make-vct 10 1.0)))
- (snd-display ";fill! sd chan 1: ~A" (sound-data->vct sd 1)))
+ (snd-display #__line__ ";fill! sd chan 1: ~A" (sound-data->vct sd 1)))
(let ((sd1 (copy sd)))
- (if (not (equal? sd sd1)) (snd-display ";copy sd: ~A ~A"))))
+ (if (not (equal? sd sd1)) (snd-display #__line__ ";copy sd: ~A ~A"))))
(for-each
(lambda (file)
@@ -3336,7 +3335,7 @@
(lambda () (open-sound (string-append sf-dir file)))
(lambda args args))))
(if (not (eq? (car tag) 'mus-error))
- (snd-display ";open-sound ~A: ~A" file tag))))
+ (snd-display #__line__ ";open-sound ~A: ~A" file tag))))
(list "trunc.snd" "trunc.aiff" "trunc.wav" "trunc.sf" "trunc.voc" "trunc.nist" "bad.wav"
"trunc1.aiff" "badform.aiff"))
(add-hook! open-raw-sound-hook (lambda (file choice) (list 1 22050 mus-bshort)))
@@ -3346,7 +3345,7 @@
(not (= (srate ind) 22050))
(not (= (data-location ind) 0))
(not (= (frames ind) 0)))
- (snd-display ";open raw: ~A ~A ~A ~A ~A" (data-format ind) (chans ind) (srate ind) (data-location ind) (frames ind)))
+ (snd-display #__line__ ";open raw: ~A ~A ~A ~A ~A" (data-format ind) (chans ind) (srate ind) (data-location ind) (frames ind)))
(reset-hook! open-raw-sound-hook)
(close-sound ind))
@@ -3355,28 +3354,28 @@
(vc1 (sound-data->vct sd1))
(vc2 (samples->vct 12000 10 ind 0))
(sd2 (vct->sound-data vc2)))
- (if (not (equal? vc1 vc2)) (snd-display ";samples->sound-data->vct: ~A ~A" vc1 vc2))
- (if (not (equal? sd1 sd2)) (snd-display ";sound-data->vct->sound-data: ~A ~A" sd1 sd2))
+ (if (not (equal? vc1 vc2)) (snd-display #__line__ ";samples->sound-data->vct: ~A ~A" vc1 vc2))
+ (if (not (equal? sd1 sd2)) (snd-display #__line__ ";sound-data->vct->sound-data: ~A ~A" sd1 sd2))
(scale-by 2.0 ind 0)
(set! sd1 (samples->sound-data 12000 10 ind 0 #f 0))
(set! vc1 (sound-data->vct sd1))
(set! vc2 (samples->vct 12000 10 ind 0 #f 0))
(set! sd2 (vct->sound-data vc2))
- (if (not (equal? vc1 vc2)) (snd-display ";edpos samples->sound-data->vct: ~A ~A" vc1 vc2))
- (if (not (equal? sd1 sd2)) (snd-display ";edpos sound-data->vct->sound-data: ~A ~A" sd1 sd2))
+ (if (not (equal? vc1 vc2)) (snd-display #__line__ ";edpos samples->sound-data->vct: ~A ~A" vc1 vc2))
+ (if (not (equal? sd1 sd2)) (snd-display #__line__ ";edpos sound-data->vct->sound-data: ~A ~A" sd1 sd2))
(set! sd1 (samples->sound-data 12000 10 ind 1))
(set! vc1 (sound-data->vct sd1))
(set! vc2 (samples->vct 12000 10 ind 1))
(set! sd2 (vct->sound-data vc2))
- (if (not (equal? vc1 vc2)) (snd-display ";1 samples->sound-data->vct: ~A ~A" vc1 vc2))
- (if (not (equal? sd1 sd2)) (snd-display ";1 sound-data->vct->sound-data: ~A ~A" sd1 sd2))
+ (if (not (equal? vc1 vc2)) (snd-display #__line__ ";1 samples->sound-data->vct: ~A ~A" vc1 vc2))
+ (if (not (equal? sd1 sd2)) (snd-display #__line__ ";1 sound-data->vct->sound-data: ~A ~A" sd1 sd2))
(scale-by 2.0 ind 1)
(set! sd1 (samples->sound-data 12000 10 ind 1))
(set! vc1 (sound-data->vct sd1))
(set! vc2 (samples->vct 12000 10 ind 1))
(set! sd2 (vct->sound-data vc2))
- (if (not (equal? vc1 vc2)) (snd-display ";1 scaled samples->sound-data->vct: ~A ~A" vc1 vc2))
- (if (not (equal? sd1 sd2)) (snd-display ";1 scaled sound-data->vct->sound-data: ~A ~A" sd1 sd2))
+ (if (not (equal? vc1 vc2)) (snd-display #__line__ ";1 scaled samples->sound-data->vct: ~A ~A" vc1 vc2))
+ (if (not (equal? sd1 sd2)) (snd-display #__line__ ";1 scaled sound-data->vct->sound-data: ~A ~A" sd1 sd2))
(close-sound ind))
(let ((sd1 (make-sound-data 1 32))
@@ -3389,56 +3388,56 @@
(sound-data-set! sd2 0 i (* .1 i))
(sound-data-set! sd2 1 i (* .2 i)))
(sound-data->sound-data sd2 sd1 3 6 32)
- (if (fneq (sound-data-ref sd1 0 0) 0.0) (snd-display ";sound-data->sound-data 0: ~A" (sound-data-ref sd1 0 0)))
- (if (fneq (sound-data-ref sd1 0 2) 0.02) (snd-display ";sound-data->sound-data 2: ~A" (sound-data-ref sd1 0 2)))
- (if (fneq (sound-data-ref sd1 0 3) 0.0) (snd-display ";sound-data->sound-data 3: ~A" (sound-data-ref sd1 0 3)))
- (if (fneq (sound-data-ref sd1 0 6) 0.3) (snd-display ";sound-data->sound-data 6: ~A" (sound-data-ref sd1 0 6)))
- (if (fneq (sound-data-ref sd1 0 10) 0.1) (snd-display ";sound-data->sound-data 10: ~A" (sound-data-ref sd1 0 10)))
+ (if (fneq (sound-data-ref sd1 0 0) 0.0) (snd-display #__line__ ";sound-data->sound-data 0: ~A" (sound-data-ref sd1 0 0)))
+ (if (fneq (sound-data-ref sd1 0 2) 0.02) (snd-display #__line__ ";sound-data->sound-data 2: ~A" (sound-data-ref sd1 0 2)))
+ (if (fneq (sound-data-ref sd1 0 3) 0.0) (snd-display #__line__ ";sound-data->sound-data 3: ~A" (sound-data-ref sd1 0 3)))
+ (if (fneq (sound-data-ref sd1 0 6) 0.3) (snd-display #__line__ ";sound-data->sound-data 6: ~A" (sound-data-ref sd1 0 6)))
+ (if (fneq (sound-data-ref sd1 0 10) 0.1) (snd-display #__line__ ";sound-data->sound-data 10: ~A" (sound-data-ref sd1 0 10)))
(sound-data->sound-data sd1 sd2 0 10 32)
- (if (fneq (sound-data-ref sd2 0 5) 0.2) (snd-display ";sound-data->sound-data 2 5: ~A" (sound-data-ref sd2 0 5))))
+ (if (fneq (sound-data-ref sd2 0 5) 0.2) (snd-display #__line__ ";sound-data->sound-data 2 5: ~A" (sound-data-ref sd2 0 5))))
(let ((sdi (make-sound-data 1 32))
(sdo (make-sound-data 1 32)))
(let ((j (sound-data->sound-data sdi sdo 10 32 10)))
- (if (not (= j 2)) (snd-display ";sound-data->sound-data wrap around 2: ~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";sound-data->sound-data wrap around 2: ~A" j)))
(let ((j (sound-data->sound-data sdi sdo 10 32 32)))
- (if (not (= j 10)) (snd-display ";sound-data->sound-data wrap around 10: ~A" j)))
+ (if (not (= j 10)) (snd-display #__line__ ";sound-data->sound-data wrap around 10: ~A" j)))
(let ((tag (catch #t
(lambda () (sound-data->sound-data sdi sdo -1 10 10))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";sound-data->sound-data start: ~A" tag)))
+ (snd-display #__line__ ";sound-data->sound-data start: ~A" tag)))
(let ((tag (catch #t
(lambda () (sound-data->sound-data sdi sdo 0 -1 10))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";sound-data->sound-data frames: ~A" tag)))
+ (snd-display #__line__ ";sound-data->sound-data frames: ~A" tag)))
(let ((tag (catch #t
(lambda () (sound-data->sound-data sdi sdo 0 128 10))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";sound-data->sound-data frames: ~A" tag))))
+ (snd-display #__line__ ";sound-data->sound-data frames: ~A" tag))))
+
+
+ (let ((sd (make-sound-data 1 1)))
+ (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";sound-data ref: ~A" (sd 0 0)))
+ (set! (sd 0 0) 1.0)
+ (if (fneq (sd 0 0) 1.0) (snd-display #__line__ ";sound-data set: ~A" (sd 0 0)))
+ (if (not (equal? sd (let ((sd1 (make-sound-data 1 1))) (sound-data-set! sd1 0 0 1.0) sd1)))
+ (snd-display #__line__ ";sound-data set not equal: ~A" sd)))
+
+ (let ((sd (make-sound-data 2 3)))
+ (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";sound-data ref (1): ~A" (sd 0 0)))
+ (set! (sd 1 0) 1.0)
+ (if (fneq (sd 1 0) 1.0) (snd-display #__line__ ";sound-data set (1 0): ~A" (sd 1 0)))
+ (set! (sd 1 2) 2.0)
+ (if (fneq (sd 1 2) 2.0) (snd-display #__line__ ";sound-data set (1 2): ~A" (sd 1 2)))
+ (if (not (equal? sd (let ((sd1 (make-sound-data 2 3)))
+ (sound-data-set! sd1 1 0 1.0)
+ (sound-data-set! sd1 1 2 2.0)
+ sd1)))
+ (snd-display #__line__ ";sound-data set (3) not equal: ~A" sd)))
+
-
- (let ((sd (make-sound-data 1 1)))
- (if (fneq (sd 0 0) 0.0) (snd-display ";sound-data ref: ~A" (sd 0 0)))
- (set! (sd 0 0) 1.0)
- (if (fneq (sd 0 0) 1.0) (snd-display ";sound-data set: ~A" (sd 0 0)))
- (if (not (equal? sd (let ((sd1 (make-sound-data 1 1))) (sound-data-set! sd1 0 0 1.0) sd1)))
- (snd-display ";sound-data set not equal: ~A" sd)))
-
- (let ((sd (make-sound-data 2 3)))
- (if (fneq (sd 0 0) 0.0) (snd-display ";sound-data ref (1): ~A" (sd 0 0)))
- (set! (sd 1 0) 1.0)
- (if (fneq (sd 1 0) 1.0) (snd-display ";sound-data set (1 0): ~A" (sd 1 0)))
- (set! (sd 1 2) 2.0)
- (if (fneq (sd 1 2) 2.0) (snd-display ";sound-data set (1 2): ~A" (sd 1 2)))
- (if (not (equal? sd (let ((sd1 (make-sound-data 2 3)))
- (sound-data-set! sd1 1 0 1.0)
- (sound-data-set! sd1 1 2 2.0)
- sd1)))
- (snd-display ";sound-data set (3) not equal: ~A" sd)))
-
-
(for-each
(lambda (chans)
(for-each
@@ -3462,10 +3461,10 @@
(mus-sound-read fd 0 (- samps 1) chans ndata)
(let ((pos (mus-sound-seek-frame fd 100)))
(if (not (= pos (ftell fd)))
- (snd-display ";mus-sound-seek-frame[~A]: chans ~A ~A (~A ~A)?"
+ (snd-display #__line__ ";mus-sound-seek-frame[~A]: chans ~A ~A (~A ~A)?"
pos chans (ftell fd) (mus-header-type-name (cadr df-ht)) (mus-data-format-name (car df-ht))))
(if (not (= pos (frame->byte "fmv5.snd" 100)))
- (snd-display ";mus-sound-seek-frame(100): ~A ~A (~A ~A ~A)?"
+ (snd-display #__line__ ";mus-sound-seek-frame(100): ~A ~A (~A ~A ~A)?"
pos (frame->byte "fmv5.snd" 100) chans (mus-header-type-name (cadr df-ht)) (mus-data-format-name (car df-ht)))))
(mus-sound-close-input fd)
(let ((v0 0.0)
@@ -3481,11 +3480,11 @@
(begin
(set! v0 (sound-data-ref sdata k i))
(set! v1 (sound-data-ref ndata k i))
- ;(snd-display ";v0: ~A, v1: ~A, diff: ~A, k: ~A, i: ~A" v0 v1 (- v1 v0) k i)
- (throw 'read-write-error)))))))
+ ;(snd-display #__line__ ";v0: ~A, v1: ~A, diff: ~A, k: ~A, i: ~A" v0 v1 (- v1 v0) k i)
+ (throw 'read-write-error)))))))
(lambda args
(begin
- (snd-display ";read-write trouble: ~A ~A (~A != ~A): ~A"
+ (snd-display #__line__ ";read-write trouble: ~A ~A (~A != ~A): ~A"
(mus-data-format-name (car df-ht))
(mus-header-type-name (cadr df-ht))
v0 v1 args)
@@ -3512,57 +3511,59 @@
(list mus-ubshort mus-next))))
(list 1 2 4 8))
+#|
;; big sound-data objects (needs 32 Gbytes):
(if (and (string? (getenv "HOSTNAME"))
(string=? (getenv "HOSTNAME") "fatty8"))
(let ((size (+ 2 (expt 2 31))))
(if (not (= size 2147483650))
- (snd-display ";big sd, size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
+ (snd-display #__line__ ";big sd, size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
(set! (mus-max-malloc) (expt 2 40))
(if (not (= (mus-max-malloc) 1099511627776))
- (snd-display ";big sd, mus-max-malloc: ~A" (mus-max-malloc)))
+ (snd-display #__line__ ";big sd, mus-max-malloc: ~A" (mus-max-malloc)))
(let ((hi (make-sound-data 1 size)))
(if (not (sound-data? hi))
- (snd-display ";big sd, not a sound-data?? ~A" hi))
+ (snd-display #__line__ ";big sd, not a sound-data?? ~A" hi))
(if (fneq (sound-data-ref hi 0 (expt 2 31)) 0.0)
- (snd-display ";big sd, created at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
+ (snd-display #__line__ ";big sd, created at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
(if (not (= (sound-data-chans hi) 1))
- (snd-display ";big sd, sound-data-chans: ~A" (sound-data-chans hi)))
+ (snd-display #__line__ ";big sd, sound-data-chans: ~A" (sound-data-chans hi)))
(sound-data+ hi .1)
(if (fneq (sound-data-ref hi 0 (expt 2 31)) 0.1)
- (snd-display ";big sd, add .1 at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
+ (snd-display #__line__ ";big sd, add .1 at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
(let ((pk (sound-data-peak hi)))
(if (fneq pk .1)
- (snd-display ";big sd, sound-data-peak: ~A" pk)))
+ (snd-display #__line__ ";big sd, sound-data-peak: ~A" pk)))
(let ((len (sound-data-length hi)))
(if (not (= len size))
- (snd-display ";big sd, len: ~A" len)))
+ (snd-display #__line__ ";big sd, len: ~A" len)))
(sound-data-scale! hi 2.0)
(if (fneq (sound-data-ref hi 0 (+ 1 (expt 2 31))) .2)
- (snd-display ";big sd, scale: ~A ~A" (sound-data-ref hi 0 (+ 1 (expt 2 31))) hi))
+ (snd-display #__line__ ";big sd, scale: ~A ~A" (sound-data-ref hi 0 (+ 1 (expt 2 31))) hi))
(sound-data-set! hi 0 (expt 2 31) 1.0)
(if (fneq (sound-data-ref hi 0 (expt 2 31)) 1.0)
- (snd-display ";big sd, set at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
+ (snd-display #__line__ ";big sd, set at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
(sound-data-offset! hi .2)
(if (fneq (sound-data-ref hi 0 (expt 2 31)) 1.2)
- (snd-display ";big sd, offset: ~A" (sound-data-ref hi 0 (expt 2 31))))
+ (snd-display #__line__ ";big sd, offset: ~A" (sound-data-ref hi 0 (expt 2 31))))
(let ((pk (sound-data-maxamp hi)))
(if (fneq (car pk) 1.2)
- (snd-display ";big sd, subtract sound-data-maxamp: ~A ~A" pk hi)))
+ (snd-display #__line__ ";big sd, subtract sound-data-maxamp: ~A ~A" pk hi)))
(let ((pk (sound-data-peak hi)))
(if (fneq pk 1.2)
- (snd-display ";big sd, sound-data-peak: ~A ~A" pk hi)))
+ (snd-display #__line__ ";big sd, sound-data-peak: ~A ~A" pk hi)))
(sound-data-fill! hi 1.0)
(if (fneq (sound-data-ref hi 0 (expt 2 31)) 1.0)
- (snd-display ";big sd, fill: ~A ~A" (sound-data-ref hi 0 (expt 2 31)) hi))
+ (snd-display #__line__ ";big sd, fill: ~A ~A" (sound-data-ref hi 0 (expt 2 31)) hi))
(sound-data-reverse! hi)
(let ((v (sound-data->vct hi 0)))
(if (not (= (vct-length v) size))
- (snd-display ";big sd, sound-data->vct length: ~A" (vct-length v)))
+ (snd-display #__line__ ";big sd, sound-data->vct length: ~A" (vct-length v)))
(if (fneq (vct-ref v (expt 2 31)) 1.0)
- (snd-display ";big sd, sd->v ref: ~A" (vct-ref v (expt 2 31)))))
+ (snd-display #__line__ ";big sd, sd->v ref: ~A" (vct-ref v (expt 2 31)))))
)))
-
+|#
+
(let ((ind (open-sound (string-append "/usr//usr/include/" home-dir "/cl/oboe.snd"))))
(show-input-1)
(close-sound ind))
@@ -3588,7 +3589,7 @@
(fneq (sound-data-ref sdata 0 1) 0.1)
(fneq (sound-data-ref sdata 0 2) 0.0)
(fneq (sound-data-ref sdata 0 6) 0.0))
- (snd-display ";read/write: ~A?" (sound-data->list sdata)))
+ (snd-display #__line__ ";read/write: ~A?" (sound-data->list sdata)))
(mus-sound-close-input fd)
(set! fd (mus-sound-reopen-output "fmv.snd" 1 mus-bshort mus-next (mus-sound-data-location "fmv.snd")))
(mus-sound-seek-frame fd 0)
@@ -3604,7 +3605,7 @@
(fneq (sound-data-ref sdata1 0 2) 0.1)
(fneq (sound-data-ref sdata1 0 3) 0.1)
(fneq (sound-data-ref sdata1 0 6) 0.0))
- (snd-display ";re-read/write: ~A ~A?" (sound-data->list sdata1) (sound-data->lisp sdata))))
+ (snd-display #__line__ ";re-read/write: ~A ~A?" (sound-data->list sdata1) (sound-data->lisp sdata))))
(mus-sound-close-input fd)
;; check clipping choices
@@ -3615,7 +3616,7 @@
(undo 1 ind 0)
(let ((ind1 (open-sound "test.snd")))
(if (fneq (maxamp ind1 0) (* 10 (maxamp ind 0)))
- (snd-display ";clipping 0: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
+ (snd-display #__line__ ";clipping 0: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
(close-sound ind1))
(delete-file "test.snd")
(set! (clipping) #t)
@@ -3624,7 +3625,7 @@
(undo 1 ind 0)
(let ((ind1 (open-sound "test.snd")))
(if (fneq (maxamp ind1 0) 1.0)
- (snd-display ";clipping 1: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
+ (snd-display #__line__ ";clipping 1: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
(close-sound ind1))
(delete-file "test.snd")
(set! (clipping) #f)
@@ -3634,7 +3635,7 @@
(let* ((ind1 (open-sound "test.snd"))
(baddy (scan-channel (lambda (y) (< y 0.0)))))
(if (not (list-p baddy))
- (snd-display ";clipping 2: ~A" baddy))
+ (snd-display #__line__ ";clipping 2: ~A" baddy))
(close-sound ind1))
(delete-file "test.snd")
(set! (clipping) #t)
@@ -3642,7 +3643,7 @@
(let* ((ind1 (open-sound "test.snd"))
(baddy (scan-channel (lambda (y) (< y 0.0)))))
(if (list-p baddy)
- (snd-display ";clipping 3: ~A" baddy))
+ (snd-display #__line__ ";clipping 3: ~A" baddy))
(close-sound ind1))
(delete-file "test.snd")
(set! (clipping) #f))
@@ -3666,7 +3667,7 @@
(let ((snd (open-sound "test.snd")))
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000)))
- (snd-display ";unclipped 1: ~A" data)))
+ (snd-display #__line__ ";unclipped 1: ~A" data)))
(close-sound snd))
(mus-sound-forget "test.snd")
@@ -3687,7 +3688,7 @@
(let ((snd (open-sound "test.snd")))
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
- (snd-display ";clipped: ~A" data)))
+ (snd-display #__line__ ";clipped: ~A" data)))
(close-sound snd))
(let* ((data (vct 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8))
@@ -3700,7 +3701,7 @@
(let ((snd (open-sound "test.snd")))
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 -1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000)))
- (snd-display ";unclipped 2: ~A" data)))
+ (snd-display #__line__ ";unclipped 2: ~A" data)))
(close-sound snd))
(mus-sound-forget "test.snd")
@@ -3715,7 +3716,7 @@
(let ((snd (open-sound "test.snd")))
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
- (snd-display ";clipped 1: ~A" data)))
+ (snd-display #__line__ ";clipped 1: ~A" data)))
(close-sound snd))
(set! (mus-clipping) #f)
@@ -3728,7 +3729,7 @@
(let ((snd (open-sound "test.snd")))
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 -1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000)))
- (snd-display ";unclipped 3: ~A" data)))
+ (snd-display #__line__ ";unclipped 3: ~A" data)))
(close-sound snd))
(mus-sound-forget "test.snd")
@@ -3742,7 +3743,7 @@
(let ((snd (open-sound "test.snd")))
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
- (snd-display ";clipped 2: ~A" data)))
+ (snd-display #__line__ ";clipped 2: ~A" data)))
(close-sound snd))
(set! (mus-clipping) #t)
@@ -3752,15 +3753,15 @@
(let ((tag (catch #t
(lambda () (mus-sound-write snd 0 10 1 sdata))
(lambda args args))))
- (if (or (not (list? tag)) (not (eq? (car tag) 'out-of-range))) (snd-display ";mus-sound-write too many bytes: ~A" tag)))
+ (if (or (not (list? tag)) (not (eq? (car tag) 'out-of-range))) (snd-display #__line__ ";mus-sound-write too many bytes: ~A" tag)))
(let ((tag (catch #t
(lambda () (mus-sound-read snd 0 10 1 sdata))
(lambda args args))))
- (if (or (not (list? tag)) (not (eq? (car tag) 'out-of-range))) (snd-display ";mus-sound-read too many bytes: ~A" tag)))
+ (if (or (not (list? tag)) (not (eq? (car tag) 'out-of-range))) (snd-display #__line__ ";mus-sound-read too many bytes: ~A" tag)))
(mus-sound-close-output snd 0))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
-
+
(set! (mus-clipping) #f) ; this is the default
(set! (clipping) #f)
@@ -3783,7 +3784,7 @@
(fneq (sound-data-ref sdata i 1) 0.1)
(fneq (sound-data-ref sdata i 2) 0.0)
(fneq (sound-data-ref sdata i 6) 0.0))
- (snd-display ";1 read/write[~A]: ~A?" i (sound-data-channel->list sdata i))))
+ (snd-display #__line__ ";1 read/write[~A]: ~A?" i (sound-data-channel->list sdata i))))
(mus-sound-close-input fd)
(set! fd (mus-sound-reopen-output "fmv.snd" 4 mus-lshort mus-riff (mus-sound-data-location "fmv.snd")))
(mus-sound-seek-frame fd 0)
@@ -3803,12 +3804,12 @@
(fneq (sound-data-ref sdata1 i 2) 0.1)
(fneq (sound-data-ref sdata1 i 3) 0.1)
(fneq (sound-data-ref sdata1 i 6) 0.0))
- (snd-display ";2 re-read/write[~A]: ~A ~A?" i (sound-data-channel->list sdata1 i) (sound-data-channel->list sdata i)))))
+ (snd-display #__line__ ";2 re-read/write[~A]: ~A ~A?" i (sound-data-channel->list sdata1 i) (sound-data-channel->list sdata i)))))
(mus-sound-close-input fd))
(if (file-exists? (string-append sf-dir "32bit.sf"))
(let ((ind (open-sound (string-append sf-dir "32bit.sf"))))
- (if (fneq (maxamp ind 0) .228) (snd-display ";32bit max: ~A" (maxamp ind 0)))
+ (if (fneq (maxamp ind 0) .228) (snd-display #__line__ ";32bit max: ~A" (maxamp ind 0)))
(close-sound ind)))
(let ((test-data (lambda (file beg dur data)
@@ -3817,7 +3818,7 @@
(let* ((ind (open-sound file))
(ndata (samples->vct beg dur ind 0)))
(if (not (vequal data ndata))
- (snd-display ";~A: ~A != ~A" file data ndata))
+ (snd-display #__line__ ";~A: ~A != ~A" file data ndata))
(close-sound ind)))
(lambda args args)))))
(test-data (string-append sf-dir "next-dbl.snd") 10 10 (vct 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
@@ -3887,12 +3888,12 @@
((or (not happy) (= i len)))
(if (not (string-=? (list-ref errs i) (mus-error-type->string i)))
(begin
- (snd-display ";mus-error-type->string ~D: ~A ~A" i (list-ref errs i) (mus-error-type->string i))
+ (snd-display #__line__ ";mus-error-type->string ~D: ~A ~A" i (list-ref errs i) (mus-error-type->string i))
(set! happy #f))))))
; (let ((new-id (mus-make-error "hiho all messed up")))
; (if (not (string=? (mus-error-type->string new-id) "hiho all messed up"))
- ; (snd-display ";mus-make-error :~A ~A" new-id (mus-error-type->string new-id))))
+ ; (snd-display #__line__ ";mus-make-error :~A ~A" new-id (mus-error-type->string new-id))))
(let ((cur-srate (mus-sound-srate "oboe.snd"))
(cur-chans (mus-sound-chans "oboe.snd"))
@@ -3902,22 +3903,22 @@
(cur-samps (mus-sound-samples "oboe.snd")))
(set! (mus-sound-srate "oboe.snd") (* cur-srate 2))
(if (not (= (* cur-srate 2) (mus-sound-srate "oboe.snd")))
- (snd-display ";set mus-sound-srate: ~A -> ~A" cur-srate (mus-sound-srate "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-srate: ~A -> ~A" cur-srate (mus-sound-srate "oboe.snd")))
(set! (mus-sound-samples "oboe.snd") (* cur-samps 2))
(if (not (= (* cur-samps 2) (mus-sound-samples "oboe.snd")))
- (snd-display ";set mus-sound-samples: ~A -> ~A" cur-samps (mus-sound-samples "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-samples: ~A -> ~A" cur-samps (mus-sound-samples "oboe.snd")))
(set! (mus-sound-chans "oboe.snd") (* cur-chans 2))
(if (not (= (* cur-chans 2) (mus-sound-chans "oboe.snd")))
- (snd-display ";set mus-sound-chans: ~A -> ~A" cur-chans (mus-sound-chans "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-chans: ~A -> ~A" cur-chans (mus-sound-chans "oboe.snd")))
(set! (mus-sound-data-location "oboe.snd") (* cur-loc 2))
(if (not (= (* cur-loc 2) (mus-sound-data-location "oboe.snd")))
- (snd-display ";set mus-sound-data-location: ~A -> ~A" cur-loc (mus-sound-data-location "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-data-location: ~A -> ~A" cur-loc (mus-sound-data-location "oboe.snd")))
(set! (mus-sound-header-type "oboe.snd") mus-nist)
(if (not (= mus-nist (mus-sound-header-type "oboe.snd")))
- (snd-display ";set mus-sound-header-type: ~A -> ~A" cur-type (mus-sound-header-type "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-header-type: ~A -> ~A" cur-type (mus-sound-header-type "oboe.snd")))
(set! (mus-sound-data-format "oboe.snd") mus-lintn)
(if (not (= mus-lintn (mus-sound-data-format "oboe.snd")))
- (snd-display ";set mus-sound-data-format: ~A -> ~A" cur-format (mus-sound-data-format "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-data-format: ~A -> ~A" cur-format (mus-sound-data-format "oboe.snd")))
(set! (mus-sound-srate "oboe.snd") cur-srate)
(set! (mus-sound-samples "oboe.snd") cur-samps)
(set! (mus-sound-chans "oboe.snd") cur-chans)
@@ -3941,22 +3942,22 @@
(cur-samps (mus-sound-samples file)))
(set! (mus-sound-srate file) (* cur-srate 2))
(if (not (= (* cur-srate 2) (mus-sound-srate file)))
- (snd-display ";~A: set mus-sound-srate: ~A -> ~A" file cur-srate (mus-sound-srate file)))
+ (snd-display #__line__ ";~A: set mus-sound-srate: ~A -> ~A" file cur-srate (mus-sound-srate file)))
(set! (mus-sound-samples file) (* cur-samps 2))
(if (not (= (* cur-samps 2) (mus-sound-samples file)))
- (snd-display ";~A: set mus-sound-samples: ~A -> ~A" file cur-samps (mus-sound-samples file)))
+ (snd-display #__line__ ";~A: set mus-sound-samples: ~A -> ~A" file cur-samps (mus-sound-samples file)))
(set! (mus-sound-chans file) (* cur-chans 2))
(if (not (= (* cur-chans 2) (mus-sound-chans file)))
- (snd-display ";~A: set mus-sound-chans: ~A -> ~A" file cur-chans (mus-sound-chans file)))
+ (snd-display #__line__ ";~A: set mus-sound-chans: ~A -> ~A" file cur-chans (mus-sound-chans file)))
(set! (mus-sound-data-location file) (* cur-loc 2))
(if (not (= (* cur-loc 2) (mus-sound-data-location file)))
- (snd-display ";~A: set mus-sound-data-location: ~A -> ~A" file cur-loc (mus-sound-data-location file)))
+ (snd-display #__line__ ";~A: set mus-sound-data-location: ~A -> ~A" file cur-loc (mus-sound-data-location file)))
(set! (mus-sound-header-type file) mus-nist)
(if (not (= mus-nist (mus-sound-header-type file)))
- (snd-display ";~A: set mus-sound-header-type: ~A -> ~A" file cur-type (mus-sound-header-type file)))
+ (snd-display #__line__ ";~A: set mus-sound-header-type: ~A -> ~A" file cur-type (mus-sound-header-type file)))
(set! (mus-sound-data-format file) mus-lintn)
(if (not (= mus-lintn (mus-sound-data-format file)))
- (snd-display ";~A: set mus-sound-data-format: ~A -> ~A" file cur-format (mus-sound-data-format file)))
+ (snd-display #__line__ ";~A: set mus-sound-data-format: ~A -> ~A" file cur-format (mus-sound-data-format file)))
(set! (mus-sound-srate file) cur-srate)
(set! (mus-sound-samples file) cur-samps)
(set! (mus-sound-chans file) cur-chans)
@@ -3976,25 +3977,25 @@
(cur-samps (frames ind)))
(set! (srate ind) (* cur-srate 2))
(if (not (= (* cur-srate 2) (srate ind)))
- (snd-display ";~A: set srate: ~A -> ~A" file cur-srate (srate ind)))
+ (snd-display #__line__ ";~A: set srate: ~A -> ~A" file cur-srate (srate ind)))
(set! (frames ind) (* cur-samps 2))
(if (not (= (* cur-samps 2) (frames ind)))
- (snd-display ";~A: set frames: ~A -> ~A" file cur-samps (frames ind)))
+ (snd-display #__line__ ";~A: set frames: ~A -> ~A" file cur-samps (frames ind)))
(set! (chans ind) (* cur-chans 2)) ; this can change the index
(let ((xind (find-sound file)))
(if (not (equal? ind xind))
(set! ind xind)))
(if (not (= (* cur-chans 2) (chans ind)))
- (snd-display ";~A: set chans: ~A -> ~A" file cur-chans (chans ind)))
+ (snd-display #__line__ ";~A: set chans: ~A -> ~A" file cur-chans (chans ind)))
(set! (data-location ind) (* cur-loc 2))
(if (not (= (* cur-loc 2) (data-location ind)))
- (snd-display ";~A: set data-location: ~A -> ~A" file cur-loc (data-location ind)))
+ (snd-display #__line__ ";~A: set data-location: ~A -> ~A" file cur-loc (data-location ind)))
(set! (header-type ind) mus-nist)
(if (not (= mus-nist (header-type ind)))
- (snd-display ";~A: set header-type: ~A -> ~A" file cur-type (header-type ind)))
+ (snd-display #__line__ ";~A: set header-type: ~A -> ~A" file cur-type (header-type ind)))
(set! (data-format ind) mus-lintn)
(if (not (= mus-lintn (data-format ind)))
- (snd-display ";~A: set data-format: ~A -> ~A" file cur-format (data-format ind)))
+ (snd-display #__line__ ";~A: set data-format: ~A -> ~A" file cur-format (data-format ind)))
(set! (srate ind) cur-srate)
(set! (frames ind) cur-samps)
(set! (chans ind) cur-chans)
@@ -4011,59 +4012,59 @@
;; (fm-violin i .1 440 (+ .01 (* (/ i 72000.0) .9)))))
(if with-big-file
- (let ((probable-frames (inexact->exact (floor (* 44100 71999.1))))) ; silence as last .9 secs, so it probably wasn't written
+ (let ((probable-frames (floor (* 44100 71999.1)))) ; silence as last .9 secs, so it probably wasn't written
(if (not (= (mus-sound-samples big-file-name) 3175160310))
- (snd-display ";bigger samples: ~A" (mus-sound-samples big-file-name)))
+ (snd-display #__line__ ";bigger samples: ~A" (mus-sound-samples big-file-name)))
(if (not (= (mus-sound-frames big-file-name) 3175160310))
- (snd-display ";bigger frames: ~A" (mus-sound-frames big-file-name)))
+ (snd-display #__line__ ";bigger frames: ~A" (mus-sound-frames big-file-name)))
(if (not (= (mus-sound-frames big-file-name) probable-frames))
- (snd-display ";bigger frames: ~A (probable: ~A)" (mus-sound-frames big-file-name) probable-frames))
+ (snd-display #__line__ ";bigger frames: ~A (probable: ~A)" (mus-sound-frames big-file-name) probable-frames))
(if (not (= (mus-sound-length big-file-name) 6350320648))
- (snd-display ";bigger bytes: ~A" (mus-sound-length big-file-name)))
+ (snd-display #__line__ ";bigger bytes: ~A" (mus-sound-length big-file-name)))
(if (fneq (mus-sound-duration big-file-name) 71999.1015)
- (snd-display ";bigger dur: ~A" (mus-sound-duration big-file-name)))
+ (snd-display #__line__ ";bigger dur: ~A" (mus-sound-duration big-file-name)))
(let ((ind (open-sound big-file-name)))
- (if (not (= (frames ind) 3175160310)) (snd-display ";bigger frames: ~A" (frames ind)))
+ (if (not (= (frames ind) 3175160310)) (snd-display #__line__ ";bigger frames: ~A" (frames ind)))
(set! big-file-frames (frames ind))
- (if (not (= (frames ind) probable-frames)) (snd-display ";bigger frames: ~A (probable: ~A)" (frames ind) probable-frames))
- (if (not (= (frames ind 0 0) big-file-frames)) (snd-display ";bigger edpos-frames: ~A" (frames ind)))
+ (if (not (= (frames ind) probable-frames)) (snd-display #__line__ ";bigger frames: ~A (probable: ~A)" (frames ind) probable-frames))
+ (if (not (= (frames ind 0 0) big-file-frames)) (snd-display #__line__ ";bigger edpos-frames: ~A" (frames ind)))
(let ((m1 (add-mark (* 44100 50000) ind)))
- (if (not (= (mark-sample m1) (* 44100 50000))) (snd-display ";bigger mark at: ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m1) (* 44100 50000))) (snd-display #__line__ ";bigger mark at: ~A" (mark-sample m1)))
(set! (mark-sample m1) (* 44100 66000))
- (if (not (= (mark-sample m1) (* 44100 66000))) (snd-display ";bigger mark to: ~A" (mark-sample m1))))
+ (if (not (= (mark-sample m1) (* 44100 66000))) (snd-display #__line__ ";bigger mark to: ~A" (mark-sample m1))))
(let ((mx (mix-sound "oboe.snd" (* 44100 60000))))
(if (mix? mx)
(begin
- (if (not (= (mix-position mx) (* 44100 60000))) (snd-display ";bigger mix at: ~A" (mix-position mx)))
+ (if (not (= (mix-position mx) (* 44100 60000))) (snd-display #__line__ ";bigger mix at: ~A" (mix-position mx)))
(set! (mix-position mx) (* 44100 61000))
- (if (not (= (mix-position mx) (* 44100 61000))) (snd-display ";bigger mix to: ~A" (mix-position mx))))
- (snd-display ";no mix tag from mix-sound"))
+ (if (not (= (mix-position mx) (* 44100 61000))) (snd-display #__line__ ";bigger mix to: ~A" (mix-position mx))))
+ (snd-display #__line__ ";no mix tag from mix-sound"))
(undo 2))
(let ((res (find-channel (lambda (y) (not (= y 0.0))))))
(if (or (not res)
(> (cadr res) 100))
- (snd-display ";bigger find not 0.0: ~A" res)))
+ (snd-display #__line__ ";bigger find not 0.0: ~A" res)))
(let ((old-select (selection-creates-region)))
(set! (selection-creates-region) #f)
(select-all ind)
- (if (not (= (selection-frames) (frames ind))) (snd-display ";bigger select all: ~A ~A" (selection-frames) (frames)))
+ (if (not (= (selection-frames) (frames ind))) (snd-display #__line__ ";bigger select all: ~A ~A" (selection-frames) (frames)))
(set! (selection-position) (* 44100 50000))
- (if (not (= (selection-position) (* 44100 50000))) (snd-display ";bigger select pos: ~A" (selection-position)))
+ (if (not (= (selection-position) (* 44100 50000))) (snd-display #__line__ ";bigger select pos: ~A" (selection-position)))
(set! (selection-position) 0)
(set! (selection-frames) (* 44100 65000))
- (if (not (= (selection-frames) (* 44100 65000))) (snd-display ";bigger select len: ~A" (selection-frames)))
+ (if (not (= (selection-frames) (* 44100 65000))) (snd-display #__line__ ";bigger select len: ~A" (selection-frames)))
(set! (selection-creates-region) old-select))
(set! (cursor ind) (* 44100 50000))
- (if (not (= (cursor ind) (* 44100 50000))) (snd-display ";bigger cursor: ~A" (cursor ind)))
+ (if (not (= (cursor ind) (* 44100 50000))) (snd-display #__line__ ";bigger cursor: ~A" (cursor ind)))
(let ((m1 (add-mark (* 44123 51234) ind)))
- (if (not (= (mark-sample m1) (* 44123 51234))) (snd-display ";bigger mark at: ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m1) (* 44123 51234))) (snd-display #__line__ ";bigger mark at: ~A" (mark-sample m1)))
(let ((mid (find-mark (* 44123 51234))))
- (if (or (not (number? mid)) (not (= mid m1))) (snd-display ";bigger mark seach: ~A ~A" mid m1))))
+ (if (or (not (number? mid)) (not (= mid m1))) (snd-display #__line__ ";bigger mark seach: ~A ~A" mid m1))))
(let ((mx (mix-sound "oboe.snd" (* 44123 61234))))
(let ((mxd (find-mix (* 44123 61234))))
- (if (or (not (number? mxd)) (not (= mxd mx))) (snd-display ";bigger find-mix ~A ~A" mxd mx))))
+ (if (or (not (number? mxd)) (not (= mxd mx))) (snd-display #__line__ ";bigger find-mix ~A ~A" mxd mx))))
(set! (cursor ind) (* 44123 51234))
- (if (not (= (cursor ind) (* 44123 51234))) (snd-display ";bigger cursor 123: ~A" (cursor ind)))
+ (if (not (= (cursor ind) (* 44123 51234))) (snd-display #__line__ ";bigger cursor 123: ~A" (cursor ind)))
(close-sound ind))))
(let ((ind (new-sound "tmp.snd" mus-riff mus-l24int 22050 1 :size 100000))
@@ -4089,7 +4090,7 @@
(set! x (+ x incr))
(fneq val n)))
0 100000 ind1)))
- (if err (snd-display ";l24 (next) selection not saved correctly? ~A" err)))
+ (if err (snd-display #__line__ ";l24 (next) selection not saved correctly? ~A" err)))
(close-sound ind1))
(save-selection "tmp1.snd" mus-aifc mus-l24int)
(let ((ind1 (open-sound "tmp1.snd")))
@@ -4101,7 +4102,7 @@
(set! x (+ x incr))
(fneq val n)))
0 100000 ind1)))
- (if err (snd-display ";l24 (aifc) selection not saved correctly? ~A" err)))
+ (if err (snd-display #__line__ ";l24 (aifc) selection not saved correctly? ~A" err)))
(close-sound ind1))
(save-region reg "tmp1.snd" mus-next mus-l24int)
(let ((ind1 (open-sound "tmp1.snd")))
@@ -4113,18 +4114,18 @@
(set! x (+ x incr))
(fneq val n)))
0 100000 ind1)))
- (if err (snd-display ";l24 (next) region not saved correctly? ~A" err)))
+ (if err (snd-display #__line__ ";l24 (next) region not saved correctly? ~A" err)))
(close-sound ind1))
(delete-file "tmp1.snd")
(close-sound ind)
(delete-file "tmp.snd"))
(set! (selection-creates-region) old-selection-creates-region))
-
+
(let ((ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1 :size 10 :comment #f)))
(map-channel (lambda (y) 1.0))
(env-channel '(0 0 .1 .1 .2 .2 .3 .3 .4 .4 .5 .5 .6 .6 .7 .7 .8 .8 .9 .9))
(if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";ramp env by .1: ~A" (channel->vct)))
+ (snd-display #__line__ ";ramp env by .1: ~A" (channel->vct)))
(close-sound ind))
))
@@ -4132,8 +4133,8 @@
(add-hook! open-raw-sound-hook (lambda (a b) #t))
(reset-hook! bad-header-hook)
(add-hook! bad-header-hook (lambda (n) #t))
- (if (hook-empty? open-raw-sound-hook) (snd-display ";add-hook open-raw-sound-hook failed??"))
- (if (hook-empty? bad-header-hook) (snd-display ";add-hook bad-header-hook failed??"))
+ (if (hook-empty? open-raw-sound-hook) (snd-display #__line__ ";add-hook open-raw-sound-hook failed??"))
+ (if (hook-empty? bad-header-hook) (snd-display #__line__ ";add-hook bad-header-hook failed??"))
(let* ((magic-words (list ".snd" "FORM" "AIFF" "AIFC" "COMM" "COMT" "INFO" "INST" "inst" "MARK" "SSND"
"FVER" "NONE" "ULAW" "ulaw" "ima4" "raw " "sowt" "in32" "in24" "ni23" "fl32"
"FL32" "fl64" "twos" "ALAW" "alaw" "APPL" "CLM " "RIFF" "RIFX" "WAVE" "fmt "
@@ -4149,8 +4150,8 @@
(ctr 0))
(for-each
(lambda (magic)
- (if (hook-empty? open-raw-sound-hook) (snd-display ";open-raw-sound-hook cleared??"))
- (if (hook-empty? bad-header-hook) (snd-display ";bad-header-hook cleared??"))
+ (if (hook-empty? open-raw-sound-hook) (snd-display #__line__ ";open-raw-sound-hook cleared??"))
+ (if (hook-empty? bad-header-hook) (snd-display #__line__ ";bad-header-hook cleared??"))
(if (file-exists? "test.snd")
(delete-file "test.snd"))
(mus-sound-forget "test.snd")
@@ -4168,7 +4169,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound garbage ~A: ~A -> ~A?" magic tag (file->string "test.snd"))
+ (snd-display #__line__ ";open-sound garbage ~A: ~A -> ~A?" magic tag (file->string "test.snd"))
(if (sound? tag) (close-sound tag)))))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
@@ -4186,7 +4187,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound plausible garbage ~A: ~A?" magic tag)
+ (snd-display #__line__ ";open-sound plausible garbage ~A: ~A?" magic tag)
(if (sound? tag) (close-sound tag)))))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
@@ -4206,7 +4207,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound very plausible garbage ~A: ~A?" magic tag)
+ (snd-display #__line__ ";open-sound very plausible garbage ~A: ~A?" magic tag)
(if (sound? tag) (close-sound tag)))))
(set! ctr (+ 1 ctr)))
magic-words))
@@ -4225,7 +4226,7 @@
(write-byte #o000) (write-byte #o001) ; samp 1
))
(if (not (= (mus-sound-data-format "test.snd") mus-bshort))
- (snd-display ";next 18: ~A" (mus-sound-data-format "test.snd")))
+ (snd-display #__line__ ";next 18: ~A" (mus-sound-data-format "test.snd")))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
(with-output-to-file "test.snd"
@@ -4246,7 +4247,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound next bad location ~A: ~A?" (data-location tag) tag)
+ (snd-display #__line__ ";open-sound next bad location ~A: ~A?" (data-location tag) tag)
(close-sound tag))))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
@@ -4269,7 +4270,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound next bad format ~A: ~A?" (data-format tag) tag)
+ (snd-display #__line__ ";open-sound next bad format ~A: ~A?" (data-format tag) tag)
(close-sound tag))))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
@@ -4312,9 +4313,9 @@
(catch #t
(lambda ()
(let ((ind (open-sound "test.aif")))
- (if (not (= (frames ind) 2)) (snd-display ";bad frames in header: ~A" (frames ind)))
+ (if (not (= (frames ind) 2)) (snd-display #__line__ ";bad frames in header: ~A" (frames ind)))
(close-sound ind)))
- (lambda args (snd-display args)))
+ (lambda args (snd-display #__line__ args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(make-aifc-file #o002 #o150 #o020)
@@ -4325,7 +4326,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound aifc no ssnd chunk ~A: ~A?" (data-location tag) tag)
+ (snd-display #__line__ ";open-sound aifc no ssnd chunk ~A: ~A?" (data-location tag) tag)
(close-sound tag))))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -4337,7 +4338,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound aifc 0-len auth chunk ~A: ~A?" (data-location tag) tag)
+ (snd-display #__line__ ";open-sound aifc 0-len auth chunk ~A: ~A?" (data-location tag) tag)
(close-sound tag))))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -4349,7 +4350,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound bits 80 ~A: ~A?" (data-format tag) tag)
+ (snd-display #__line__ ";open-sound bits 80 ~A: ~A?" (data-format tag) tag)
(close-sound tag))))
(delete-file "test.aif")
(mus-sound-forget "test.aif"))
@@ -4392,8 +4393,8 @@
(catch #t
(lambda ()
(if (not (= (string-length (mus-sound-comment "test.aif")) 15))
- (snd-display ";aifc 3 aux comments: ~A?" (mus-sound-comment "test.aif"))))
- (lambda args (snd-display args)))
+ (snd-display #__line__ ";aifc 3 aux comments: ~A?" (mus-sound-comment "test.aif"))))
+ (lambda args (snd-display #__line__ args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(with-output-to-file "test.aif"
@@ -4427,10 +4428,10 @@
(catch #t
(lambda ()
(if (not (string=? (substring (mus-sound-comment "test.aif") 0 3) "bil"))
- (snd-display ";aifc trailing comt comment: ~A?" (mus-sound-comment "test.aif"))))
- (lambda args (snd-display args)))
+ (snd-display #__line__ ";aifc trailing comt comment: ~A?" (mus-sound-comment "test.aif"))))
+ (lambda args (snd-display #__line__ args)))
(if (not (= (mus-sound-frames "test.aif") 2))
- (snd-display ";aifc trailing comt frames: ~A?" (mus-sound-frames "test.aif")))
+ (snd-display #__line__ ";aifc trailing comt frames: ~A?" (mus-sound-frames "test.aif")))
(catch #t
(lambda ()
(let ((ind (open-sound "test.aif")))
@@ -4438,9 +4439,9 @@
(fneq (sample 1) 0.00195)
(fneq (sample 2) 0.0)
(fneq (sample 3) 0.0))
- (snd-display ";aifc trailing comt samps: ~A ~A ~A ~A" (sample 0) (sample 1) (sample 2) (sample 3)))
+ (snd-display #__line__ ";aifc trailing comt samps: ~A ~A ~A ~A" (sample 0) (sample 1) (sample 2) (sample 3)))
(close-sound ind)))
- (lambda args (snd-display args)))
+ (lambda args (snd-display #__line__ args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(with-output-to-file "test.aif"
@@ -4473,9 +4474,9 @@
))
(if (or (not (string? (mus-sound-comment "test.aif")))
(not (string=? (substring (mus-sound-comment "test.aif") 0 3) "bil")))
- (snd-display ";aifc trailing comt comment: ~A?" (mus-sound-comment "test.aif")))
+ (snd-display #__line__ ";aifc trailing comt comment: ~A?" (mus-sound-comment "test.aif")))
(if (not (= (mus-sound-frames "test.aif") 2))
- (snd-display ";aifc trailing comt (bogus) frames: ~A?" (mus-sound-frames "test.aif")))
+ (snd-display #__line__ ";aifc trailing comt (bogus) frames: ~A?" (mus-sound-frames "test.aif")))
(catch #t
(lambda ()
(let ((ind (open-sound "test.aif")))
@@ -4483,9 +4484,9 @@
(fneq (sample 1) 0.00195)
(fneq (sample 2) 0.0)
(fneq (sample 3) 0.0))
- (snd-display ";aifc trailing comt samps (bogus frame setting): ~A ~A ~A ~A" (sample 0) (sample 1) (sample 2) (sample 3)))
+ (snd-display #__line__ ";aifc trailing comt samps (bogus frame setting): ~A ~A ~A ~A" (sample 0) (sample 1) (sample 2) (sample 3)))
(close-sound ind)))
- (lambda args (snd-display args)))
+ (lambda args (snd-display #__line__ args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(with-output-to-file "test.aif"
@@ -4522,7 +4523,7 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display ";open-sound aifc 2 ssnd chunks ~A: ~A?" (data-location tag) tag)
+ (snd-display #__line__ ";open-sound aifc 2 ssnd chunks ~A: ~A?" (data-location tag) tag)
(close-sound tag))))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -4544,7 +4545,7 @@
(lambda args (car args)))))
(if (not (eq? tag 'mus-error))
(begin
- (snd-display ";open-sound aifc no comm chunk ~A?" tag)
+ (snd-display #__line__ ";open-sound aifc no comm chunk ~A?" tag)
(if (and (number? tag)
(sound? tag))
(close-sound tag)))))
@@ -4591,22 +4592,22 @@
(catch #t
(lambda ()
(let ((gen (make-file->sample "test.aif")))
- (if (fneq (gen 0) 0.93948) (snd-display ";file->sample chunked 0: ~A" (gen 0)))
- (if (fneq (gen 1) 0.50195) (snd-display ";file->sample chunked 1: ~A" (gen 1)))
- (if (fneq (gen 2) 0.0) (snd-display ";file->sample chunked eof: ~A" (gen 2)))
- (if (fneq (gen 3) 0.0) (snd-display ";file->sample chunked eof+1: ~A" (gen 3))))
+ (if (fneq (gen 0) 0.93948) (snd-display #__line__ ";file->sample chunked 0: ~A" (gen 0)))
+ (if (fneq (gen 1) 0.50195) (snd-display #__line__ ";file->sample chunked 1: ~A" (gen 1)))
+ (if (fneq (gen 2) 0.0) (snd-display #__line__ ";file->sample chunked eof: ~A" (gen 2)))
+ (if (fneq (gen 3) 0.0) (snd-display #__line__ ";file->sample chunked eof+1: ~A" (gen 3))))
(let ((file (open-sound "test.aif")))
- (if (not (= (frames file) 2)) (snd-display ";chunked frames: ~A" (frames file)))
- (if (fneq (sample 0) 0.93948) (snd-display ";file chunked 0: ~A" (sample 0)))
- (if (fneq (sample 1) 0.50195) (snd-display ";file chunked 1: ~A" (sample 1)))
- (if (fneq (sample 2) 0.0) (snd-display ";file chunked eof: ~A" (sample 2)))
- (if (fneq (sample 3) 0.0) (snd-display ";file chunked eof+1: ~A" (sample 3)))
+ (if (not (= (frames file) 2)) (snd-display #__line__ ";chunked frames: ~A" (frames file)))
+ (if (fneq (sample 0) 0.93948) (snd-display #__line__ ";file chunked 0: ~A" (sample 0)))
+ (if (fneq (sample 1) 0.50195) (snd-display #__line__ ";file chunked 1: ~A" (sample 1)))
+ (if (fneq (sample 2) 0.0) (snd-display #__line__ ";file chunked eof: ~A" (sample 2)))
+ (if (fneq (sample 3) 0.0) (snd-display #__line__ ";file chunked eof+1: ~A" (sample 3)))
(close-sound file)))
- (lambda args (snd-display args)))
+ (lambda args (snd-display #__line__ args)))
(catch #t
(lambda ()
- (if (not (= (mus-sound-frames "test.aif") 2)) (snd-display ";chunked mus-sound-frames: ~A" (mus-sound-frames "test.aif"))))
- (lambda args (snd-display args)))
+ (if (not (= (mus-sound-frames "test.aif") 2)) (snd-display #__line__ ";chunked mus-sound-frames: ~A" (mus-sound-frames "test.aif"))))
+ (lambda args (snd-display #__line__ args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -4642,21 +4643,21 @@
(catch #t
(lambda ()
(let ((gen (make-file->sample "test.aif")))
- (if (fneq (gen 0) 0.93948) (snd-display ";file->sample chunked 0: ~A" (gen 0)))
- (if (fneq (gen 1) 0.50195) (snd-display ";file->sample chunked 1: ~A" (gen 1)))
- (if (fneq (gen 2) 0.0) (snd-display ";file->sample chunked eof: ~A" (gen 2)))
- (if (fneq (gen 3) 0.0) (snd-display ";file->sample chunked eof+1: ~A" (gen 3))))
+ (if (fneq (gen 0) 0.93948) (snd-display #__line__ ";file->sample chunked 0: ~A" (gen 0)))
+ (if (fneq (gen 1) 0.50195) (snd-display #__line__ ";file->sample chunked 1: ~A" (gen 1)))
+ (if (fneq (gen 2) 0.0) (snd-display #__line__ ";file->sample chunked eof: ~A" (gen 2)))
+ (if (fneq (gen 3) 0.0) (snd-display #__line__ ";file->sample chunked eof+1: ~A" (gen 3))))
(let ((file (open-sound "test.aif")))
- (if (not (= (frames file) 2)) (snd-display ";chunked frames: ~A" (frames file)))
- (if (fneq (sample 0) 0.93948) (snd-display ";file chunked 0: ~A" (sample 0)))
- (if (fneq (sample 1) 0.50195) (snd-display ";file chunked 1: ~A" (sample 1)))
- (if (fneq (sample 2) 0.0) (snd-display ";file chunked eof: ~A" (sample 2)))
- (if (fneq (sample 3) 0.0) (snd-display ";file chunked eof+1: ~A" (sample 3)))
+ (if (not (= (frames file) 2)) (snd-display #__line__ ";chunked frames: ~A" (frames file)))
+ (if (fneq (sample 0) 0.93948) (snd-display #__line__ ";file chunked 0: ~A" (sample 0)))
+ (if (fneq (sample 1) 0.50195) (snd-display #__line__ ";file chunked 1: ~A" (sample 1)))
+ (if (fneq (sample 2) 0.0) (snd-display #__line__ ";file chunked eof: ~A" (sample 2)))
+ (if (fneq (sample 3) 0.0) (snd-display #__line__ ";file chunked eof+1: ~A" (sample 3)))
(if (or (not (string? (comment)))
(not (string=? (comment) ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98")))
- (snd-display ";chunked appl comment: ~A" (comment)))
+ (snd-display #__line__ ";chunked appl comment: ~A" (comment)))
(close-sound file)))
- (lambda args (snd-display args)))
+ (lambda args (snd-display #__line__ args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -4692,46 +4693,46 @@
(catch #t
(lambda ()
(let ((gen (make-file->sample "test.aif")))
- (if (fneq (gen 0 0) 0.93948) (snd-display ";file->sample chunked 0 0: ~A" (gen 0 0)))
- (if (fneq (gen 0 1) 0.50195) (snd-display ";file->sample chunked 0 1: ~A" (gen 0 1)))
- (if (fneq (gen 1 0) 0.0) (snd-display ";file->sample chunked eof(stereo): ~A" (gen 1 0)))
- (if (fneq (gen 1 1) 0.0) (snd-display ";file->sample chunked eof+1 (stereo): ~A" (gen 1 1))))
+ (if (fneq (gen 0 0) 0.93948) (snd-display #__line__ ";file->sample chunked 0 0: ~A" (gen 0 0)))
+ (if (fneq (gen 0 1) 0.50195) (snd-display #__line__ ";file->sample chunked 0 1: ~A" (gen 0 1)))
+ (if (fneq (gen 1 0) 0.0) (snd-display #__line__ ";file->sample chunked eof(stereo): ~A" (gen 1 0)))
+ (if (fneq (gen 1 1) 0.0) (snd-display #__line__ ";file->sample chunked eof+1 (stereo): ~A" (gen 1 1))))
(let ((file (open-sound "test.aif")))
- (if (not (= (frames file) 1)) (snd-display ";chunked frames (1): ~A" (frames file)))
- (if (fneq (sample 0 file 0) 0.93948) (snd-display ";file chunked 0 0: ~A" (sample 0 file 0)))
- (if (fneq (sample 0 file 1) 0.50195) (snd-display ";file chunked 0 1: ~A" (sample 0 file 1)))
- (if (fneq (sample 1 file 0) 0.0) (snd-display ";file chunked eof (stereo): ~A" (sample 1 file 0)))
- (if (fneq (sample 1 file 1) 0.0) (snd-display ";file chunked eof+1 (stereo): ~A" (sample 1 file 1)))
+ (if (not (= (frames file) 1)) (snd-display #__line__ ";chunked frames (1): ~A" (frames file)))
+ (if (fneq (sample 0 file 0) 0.93948) (snd-display #__line__ ";file chunked 0 0: ~A" (sample 0 file 0)))
+ (if (fneq (sample 0 file 1) 0.50195) (snd-display #__line__ ";file chunked 0 1: ~A" (sample 0 file 1)))
+ (if (fneq (sample 1 file 0) 0.0) (snd-display #__line__ ";file chunked eof (stereo): ~A" (sample 1 file 0)))
+ (if (fneq (sample 1 file 1) 0.0) (snd-display #__line__ ";file chunked eof+1 (stereo): ~A" (sample 1 file 1)))
(if (or (not (string? (comment)))
(not (string=? (comment) ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98")))
- (snd-display ";chunked appl comment (stereo): ~A" (comment)))
+ (snd-display #__line__ ";chunked appl comment (stereo): ~A" (comment)))
(close-sound file)))
- (lambda args (snd-display args)))
+ (lambda args (snd-display #__line__ args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(let ((files (sound-files-in-directory cwd)))
- (if (null? files) (snd-display ";no sound files in ~A?" cwd))
+ (if (null? files) (snd-display #__line__ ";no sound files in ~A?" cwd))
(let ((files1 (sound-files-in-directory)))
- (if (not (equal? files files1)) (snd-display ";different sound files in ~A and default?" cwd))
+ (if (not (equal? files files1)) (snd-display #__line__ ";different sound files in ~A and default?" cwd))
(let ((files2 (sound-files-in-directory ".")))
(if (or (not (equal? files1 files2))
(not (equal? files files2)))
- (snd-display ";sound-files-in-directory dot: ~A but ~A" files2 files)))))
+ (snd-display #__line__ ";sound-files-in-directory dot: ~A but ~A" files2 files)))))
(reset-hook! bad-header-hook)
(reset-hook! open-raw-sound-hook)
(if (not (null? (sounds))) (for-each close-sound (sounds)))
(let ((ind (new-sound :size 0)))
- (if (not (= (frames ind) 0)) (snd-display ";new-sound :size 0 -> ~A frames" (frames ind)))
- (if (fneq (sample 0) 0.0) (snd-display ";new-sound :size 0 sample 0: ~A" (sample 0)))
+ (if (not (= (frames ind) 0)) (snd-display #__line__ ";new-sound :size 0 -> ~A frames" (frames ind)))
+ (if (fneq (sample 0) 0.0) (snd-display #__line__ ";new-sound :size 0 sample 0: ~A" (sample 0)))
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let ((ind (new-sound :size 1)))
- (if (not (= (frames ind) 1)) (snd-display ";new-sound :size 1 -> ~A frames" (frames ind)))
- (if (fneq (sample 0) 0.0) (snd-display ";new-sound :size 1 sample 0: ~A" (sample 0)))
+ (if (not (= (frames ind) 1)) (snd-display #__line__ ";new-sound :size 1 -> ~A frames" (frames ind)))
+ (if (fneq (sample 0) 0.0) (snd-display #__line__ ";new-sound :size 1 sample 0: ~A" (sample 0)))
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
@@ -4740,20 +4741,20 @@
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
(begin
- (snd-display ";new-sound :size -1: ~A" tag)
+ (snd-display #__line__ ";new-sound :size -1: ~A" tag)
(if (not (null? (sounds))) (for-each close-sound (sounds))))))
(let ((ind (read-ascii (string-append sf-dir "caruso.asc"))))
(if (not (sound? ind))
- (snd-display ";read-ascii can't find ~A (~A)" (string-append sf-dir "caruso.asc") (map file-name (sounds)))
+ (snd-display #__line__ ";read-ascii can't find ~A (~A)" (string-append sf-dir "caruso.asc") (map file-name (sounds)))
(begin
- (if (fneq (maxamp ind 0) 0.723) (snd-display ";read-ascii maxamp: ~A" (maxamp ind 0)))
- (if (not (= (frames ind 0) 50000)) (snd-display ";read-ascii frames: ~A" (frames ind 0)))
- (if (not (= (srate ind) 44100)) (snd-display ";read-ascii srate: ~A" (srate ind)))
+ (if (fneq (maxamp ind 0) 0.723) (snd-display #__line__ ";read-ascii maxamp: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 50000)) (snd-display #__line__ ";read-ascii frames: ~A" (frames ind 0)))
+ (if (not (= (srate ind) 44100)) (snd-display #__line__ ";read-ascii srate: ~A" (srate ind)))
(set! (srate ind) 8000)
(if (or (not (= (frames ind 0) 50000))
(fneq (maxamp ind 0) .723))
- (snd-display ";set srate clobbered new sound: ~A ~A (~A)" (frames ind 0) (maxamp ind 0) (srate ind)))
+ (snd-display #__line__ ";set srate clobbered new sound: ~A ~A (~A)" (frames ind 0) (maxamp ind 0) (srate ind)))
(close-sound ind))))
@@ -4762,26 +4763,26 @@
(close-sound ind)
(set! ind (open-sound "test space.snd"))
(if (not (string=? (short-file-name ind) "test space.snd"))
- (snd-display ";file name with space: ~A" (short-file-name ind)))
+ (snd-display #__line__ ";file name with space: ~A" (short-file-name ind)))
(let ((len (frames ind))
(slen (mus-sound-frames "test space.snd")))
- (if (not (= len slen)) (snd-display ";spaced filename frames: ~A ~A" len slen)))
+ (if (not (= len slen)) (snd-display #__line__ ";spaced filename frames: ~A ~A" len slen)))
(add-mark 1234 ind 0)
(save-marks ind) ; should write "test space.marks"
(close-sound ind)
(set! ind (open-sound "test space.snd"))
(load (string-append cwd "test space.marks"))
(if (not (find-mark 1234 ind))
- (snd-display ";space file name save marks: ~A" (marks ind)))
+ (snd-display #__line__ ";space file name save marks: ~A" (marks ind)))
(let ((rd (make-readin :file "test space.snd")))
(if (not (string=? (mus-file-name rd) "test space.snd"))
- (snd-display ";file name with space readin: ~A" (mus-file-name rd))))
+ (snd-display #__line__ ";file name with space readin: ~A" (mus-file-name rd))))
(close-sound ind)
(if (file-exists? "test space.snd")
(delete-file "test space.snd"))
(if (file-exists? "test space.marks")
- (delete-file "test space.marks")))
-
+ (delete-file "test space.marks")))
+
(if (provided? 'snd-threads)
(let ((old-file-buffer-size *clm-file-buffer-size*))
@@ -4792,10 +4793,10 @@
(outa 3 -0.5)))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 0 no output: ~A ~A" result snd)
+ (snd-display #__line__ ";with-threaded-sound 0 no output: ~A ~A" result snd)
(let ((samps (channel->vct 0 (frames snd) snd 0)))
(if (not (vequal samps (vct 0.5 0.25 0.125 -0.5)))
- (snd-display ";with-threaded-sound 0 output: ~A" samps)))))
+ (snd-display #__line__ ";with-threaded-sound 0 output: ~A" samps)))))
(let* ((result (with-threaded-sound ()
(outa 0 0.5)
@@ -4806,10 +4807,10 @@
(outa 5 -0.125)))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 0a no output: ~A ~A" result snd)
+ (snd-display #__line__ ";with-threaded-sound 0a no output: ~A ~A" result snd)
(let ((samps (channel->vct 0 (frames snd) snd 0)))
(if (not (vequal samps (vct 0.5 0.25 0.125 -0.5 -0.25 -0.125)))
- (snd-display ";with-threaded-sound 0a output: ~A" samps)))))
+ (snd-display #__line__ ";with-threaded-sound 0a output: ~A" samps)))))
(let* ((result (with-threaded-sound ()
(outa 0 0.5)
@@ -4817,10 +4818,10 @@
(outa 1 -0.5)))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 0b no output: ~A ~A" result snd)
+ (snd-display #__line__ ";with-threaded-sound 0b no output: ~A ~A" result snd)
(let ((samps (channel->vct 0 (frames snd) snd 0)))
(if (not (vequal samps (vct 0.5 -0.25)))
- (snd-display ";with-threaded-sound 0b output: ~A" samps)))))
+ (snd-display #__line__ ";with-threaded-sound 0b output: ~A" samps)))))
(let ((samps (make-vct 512)))
(run
@@ -4832,13 +4833,13 @@
(out-samps 0 1 samps)))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 1 no output: ~A ~A" result snd)
+ (snd-display #__line__ ";with-threaded-sound 1 no output: ~A ~A" result snd)
(let ((new-samps-0 (channel->vct 0 (frames snd) snd 0))
(new-samps-1 (channel->vct 0 (frames snd) snd 1)))
(if (not (vequal samps new-samps-0))
- (snd-display ";with-threaded-sound 1 chan 0 output differs"))
+ (snd-display #__line__ ";with-threaded-sound 1 chan 0 output differs"))
(if (not (vequal samps new-samps-1))
- (snd-display ";with-threaded-sound 1 chan 1 output differs"))))))
+ (snd-display #__line__ ";with-threaded-sound 1 chan 1 output differs"))))))
(for-each
(lambda (buflen)
@@ -4854,13 +4855,13 @@
(out-samps 0 1 samps)))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 2 (~D) no output: ~A ~A" buflen result snd)
+ (snd-display #__line__ ";with-threaded-sound 2 (~D) no output: ~A ~A" buflen result snd)
(let ((new-samps-0 (channel->vct 0 (frames snd) snd 0))
(new-samps-1 (channel->vct 0 (frames snd) snd 1)))
(if (not (vequal samps new-samps-0))
- (snd-display ";with-threaded-sound 2 (~D) chan 0 output differs" buflen))
+ (snd-display #__line__ ";with-threaded-sound 2 (~D) chan 0 output differs" buflen))
(if (not (vequal samps new-samps-1))
- (snd-display ";with-threaded-sound 2 (~D) chan 1 output differs" buflen)))))))
+ (snd-display #__line__ ";with-threaded-sound 2 (~D) chan 1 output differs" buflen)))))))
(list 65536 8192 1024 256 1234))
(set! *clm-file-buffer-size* old-file-buffer-size)
(set! (mus-file-buffer-size) old-file-buffer-size)
@@ -4882,12 +4883,12 @@
(outa i val)))))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 3 no output: ~A ~A" result snd)
+ (snd-display #__line__ ";with-threaded-sound 3 no output: ~A ~A" result snd)
(let ((new-samps-0 (channel->vct 0 (frames snd) snd 0)))
(if (not (vequal samps new-samps-0))
- (snd-display ";with-threaded-sound 3 output differs"))
+ (snd-display #__line__ ";with-threaded-sound 3 output differs"))
(if (not (vequal samps inres))
- (snd-display ";with-threaded-sound 3 input differs"))))
+ (snd-display #__line__ ";with-threaded-sound 3 input differs"))))
(close-sound snd)
(set! snd (find-sound "thread-test.snd"))
(if (sound? snd) (close-sound snd))
@@ -4903,10 +4904,10 @@
(out-samps-invert 0 0 samps)))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 4 no output: ~A ~A" result snd)
+ (snd-display #__line__ ";with-threaded-sound 4 no output: ~A ~A" result snd)
(let ((new-samps-0 (channel->vct 0 (frames snd) snd 0)))
(if (fneq (vct-peak new-samps-0) 0.0)
- (snd-display ";with-threaded-sound 4 chan 1 output differs"))))))
+ (snd-display #__line__ ";with-threaded-sound 4 chan 1 output differs"))))))
(for-each
(lambda (buflen)
@@ -4922,38 +4923,122 @@
(out-samps-invert 0 0 samps)))
(snd (find-sound result)))
(if (not (sound? snd))
- (snd-display ";with-threaded-sound 5 (~D) no output: ~A ~A" buflen result snd)
+ (snd-display #__line__ ";with-threaded-sound 5 (~D) no output: ~A ~A" buflen result snd)
(let ((new-samps-0 (channel->vct 0 (frames snd) snd 0)))
(if (fneq (vct-peak new-samps-0) 0.0)
- (snd-display ";with-threaded-sound 5 chan 1 output differs")))))))
+ (snd-display #__line__ ";with-threaded-sound 5 chan 1 output differs")))))))
(list 65536 8192 1024 256 1234))
(set! *clm-file-buffer-size* old-file-buffer-size)
(set! (mus-file-buffer-size) old-file-buffer-size)
(for-each (lambda (snd) (close-sound snd)) (sounds))
))
-
- (if (file-is-directory? "oboe.snd") (snd-display ";file-is-directory? oboe.snd!"))
- (if (not (file-is-directory? ".")) (snd-display ";file-is-directory? . #f!"))
- (if (not (getenv "PATH")) (snd-display ";getenv: no PATH?"))
- (if (not (number? (getpid))) (snd-display ";getpid: ~A" (getpid)))
-
- (if (not (list? (global-environment))) (snd-display ";global-environment not a list?: ~A" (global-environment)))
-
- (let ((ip (current-input-port)))
- (let ((tag (catch #t (lambda () (set-current-input-port "hiho!")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";set-current-input-port tag: ~A" tag))
- (if (not (equal? ip (current-input-port))) (snd-display ";set-current-input-port clobbered port? ~A ~A" ip (current-input-port)))))
-
- (let ((ip (current-output-port)))
- (let ((tag (catch #t (lambda () (set-current-output-port "hiho!")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";set-current-output-port tag: ~A" tag))
- (if (not (equal? ip (current-output-port))) (snd-display ";set-current-output-port clobbered port? ~A ~A" ip (current-output-port)))))
-
- (let ((ip (current-error-port)))
- (let ((tag (catch #t (lambda () (set-current-error-port "hiho!")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";set-current-error-port tag: ~A" tag))
- (if (not (equal? ip (current-error-port))) (snd-display ";set-current-error-port clobbered port? ~A ~A" ip (current-error-port)))))
+ (if (file-is-directory? "oboe.snd") (snd-display #__line__ ";file-is-directory? oboe.snd!"))
+ (if (not (file-is-directory? ".")) (snd-display #__line__ ";file-is-directory? . #f!"))
+ (if (not (getenv "PATH")) (snd-display #__line__ ";getenv: no PATH?"))
+ (if (not (number? (getpid))) (snd-display #__line__ ";getpid: ~A" (getpid)))
+
+ (if (not (list? (global-environment))) (snd-display #__line__ ";global-environment not a list?: ~A" (global-environment)))
+
+ (let ((ip (current-input-port)))
+ (let ((tag (catch #t (lambda () (set-current-input-port "hiho!")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-input-port tag: ~A" tag))
+ (if (not (equal? ip (current-input-port))) (snd-display #__line__ ";set-current-input-port clobbered port? ~A ~A" ip (current-input-port)))))
+
+ (let ((ip (current-output-port)))
+ (let ((tag (catch #t (lambda () (set-current-output-port "hiho!")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-output-port tag: ~A" tag))
+ (if (not (equal? ip (current-output-port))) (snd-display #__line__ ";set-current-output-port clobbered port? ~A ~A" ip (current-output-port)))))
+
+ (let ((ip (current-error-port)))
+ (let ((tag (catch #t (lambda () (set-current-error-port "hiho!")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-error-port tag: ~A" tag))
+ (if (not (equal? ip (current-error-port))) (snd-display #__line__ ";set-current-error-port clobbered port? ~A ~A" ip (current-error-port)))))
+
+ (if (not (provided? 'gmp))
+ (let* ((LONG_MAX 2147483647)
+ (LONG_MIN -2147483648)
+ (LLONG_MAX most-positive-fixnum)
+ (LLONG_MIN most-negative-fixnum)
+ (ints (list 0 1 -1 10 -10 1234 -1234 LONG_MAX LONG_MIN 65536 -65536))
+ (shorts (list 0 1 -1 10 -10 1234 -1234 32767 -32768 8191 -8191))
+ (longs (list 0 1 -1 11 -11 LONG_MAX LONG_MIN LLONG_MAX LLONG_MIN 1000 -1000))
+ (floats (list 0.0 1.0 -1.0 0.1 -0.1 10.0 -10.0 1234.0 65536.0 -1234.0 -0.003))
+ (doubles (list 0.0 1.0 -1.0 0.1 -0.1 10.0 -10.0 1234.0 65536.0 -1234.0 -0.003)))
+ (load "binary-io.scm")
+
+ (with-output-to-file "idf1.data"
+ (lambda ()
+
+ (write-lint32 123)
+ (write-bint32 321)
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (write-lint32 (list-ref ints i))
+ (write-bint32 (list-ref ints i)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (write-lint16 (list-ref shorts i))
+ (write-bint16 (list-ref shorts i)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (write-lint64 (list-ref longs i))
+ (write-bint64 (list-ref longs i)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (write-lfloat32 (list-ref floats i))
+ (write-bfloat32 (list-ref floats i)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (write-lfloat64 (list-ref doubles i))
+ (write-bfloat64 (list-ref doubles i)))
+ ))
+
+ (with-input-from-file "idf1.data"
+ (lambda ()
+
+ (define (testf val1 val2 name)
+ (if (not (= val1 val2))
+ (if (and (not (eq? name 'lfloat32))
+ (not (eq? name 'bfloat32)))
+ (format #t ";~A: ~A != ~A~%" name val1 val2)
+ (if (> (abs (- val1 val2)) 1.0e-6)
+ (format #t ";~A: ~A != ~A (~A)~%" name val1 val2 (abs (- val1 val2)))))))
+
+ (testf (read-lint32) 123 'lint32)
+ (testf (read-bint32) 321 'bint32)
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (testf (read-lint32) (list-ref ints i) 'lint32)
+ (testf (read-bint32) (list-ref ints i) 'bint32))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (testf (read-lint16) (list-ref shorts i) 'lint16)
+ (testf (read-bint16) (list-ref shorts i) 'bint16))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (testf (read-lint64) (list-ref longs i) 'lint64)
+ (testf (read-bint64) (list-ref longs i) 'bint64))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (testf (read-lfloat32) (list-ref floats i) 'lfloat32)
+ (testf (read-bfloat32) (list-ref floats i) 'bfloat32))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 11))
+ (testf (read-lfloat64) (list-ref doubles i) 'lfloat64)
+ (testf (read-bfloat64) (list-ref doubles i) 'bfloat64))
+ ))
+ ))
))
@@ -5001,7 +5086,7 @@
(if (not (and (= fr1 fr2)
(= fr1 fr3)
(= fr1 fr4)))
- (snd-display ";initial ~A: ~A ~A ~A ~A?" func-name fr1 fr2 fr3 fr4))
+ (snd-display #__line__ ";initial ~A: ~A ~A ~A ~A?" func-name fr1 fr2 fr3 fr4))
(change-thunk)
(let ((fr5 (test-func ind1 0))
(fr6 (test-func ind1 0 1))
@@ -5010,12 +5095,12 @@
(if (not (and (= fr5 fr6)
(= fr5 fr7)
(= fr5 fr8)))
- (snd-display ";~A (edpos 1): ~A ~A ~A ~A?" func-name fr5 fr6 fr7 fr8))
+ (snd-display #__line__ ";~A (edpos 1): ~A ~A ~A ~A?" func-name fr5 fr6 fr7 fr8))
(set! fr5 (test-func ind1 0 0))
(set! fr6 (test-func ind1 0 (lambda (snd chn) 0)))
(if (not (and (= fr1 fr5)
(= fr1 fr6)))
- (snd-display ";~A (edpos -1): ~A ~A ~A?" func-name fr1 fr5 fr6))))
+ (snd-display #__line__ ";~A (edpos -1): ~A ~A ~A?" func-name fr1 fr5 fr6))))
(revert-sound ind1))
(define (test-edpos-1 test-func func-name ind1)
@@ -5023,15 +5108,15 @@
(test-func ind1 0)
(let ((v1 (samples->vct 12000 10 ind1 0)))
(if (vequal v0 v1)
- (snd-display ";~A (0) no change! ~A ~A" func-name v0 v1))
+ (snd-display #__line__ ";~A (0) no change! ~A ~A" func-name v0 v1))
(test-func ind1 0)
(let ((v2 (samples->vct 12000 10 ind1 0)))
(if (not (vequal v1 v2))
- (snd-display ";~A (1) ~A ~A" func-name v1 v2))
+ (snd-display #__line__ ";~A (1) ~A ~A" func-name v1 v2))
(test-func ind1 (lambda (snd chn) 0))
(set! v2 (samples->vct 12000 10 ind1 0))
(if (not (vequal v1 v2))
- (snd-display ";~A (2) ~A ~A" func-name v1 v2)))))
+ (snd-display #__line__ ";~A (2) ~A ~A" func-name v1 v2)))))
(revert-sound ind1))
(define (vfequal v0 v1)
@@ -5049,11 +5134,11 @@
(func0 ind1)
(let ((v1 (samples->vct 12000 10 ind1 0)))
(if (vfequal v0 v1)
- (snd-display ";~A (orig: 0) no change! ~A ~A" func-name v0 v1))
+ (snd-display #__line__ ";~A (orig: 0) no change! ~A ~A" func-name v0 v1))
(func1 ind1)
(let ((v2 (samples->vct 12000 10 ind1 0)))
(if (not (vfequal v0 v2))
- (snd-display ";~A (orig: 1) ~A ~A" func-name v0 v2))))
+ (snd-display #__line__ ";~A (orig: 1) ~A ~A" func-name v0 v2))))
(revert-sound ind1)))
(define* (make-bandpass-2 flo1 fhi1 flo2 fhi2 (len 30))
@@ -5077,13 +5162,13 @@
(set! (optimization) old-opt)))
(define (check-maxamp ind val name)
- (if (fneq (maxamp ind 0) val) (snd-display ";maxamp amp-env ~A: ~A should be ~A" name (maxamp ind) val))
+ (if (fneq (maxamp ind 0) val) (snd-display #__line__ ";maxamp amp-env ~A: ~A should be ~A" name (maxamp ind) val))
(let ((pos (find-channel (lambda (y) (>= (abs y) (- val .0001)))))
(maxpos (maxamp-position ind 0)))
(if (not pos)
- (snd-display ";actual maxamp ~A vals not right" name)
+ (snd-display #__line__ ";actual maxamp ~A vals not right" name)
(if (not (= maxpos (cadr pos)))
- (snd-display ";~A: find and maxamp-position disagree: ~A (~A) ~A (~A)"
+ (snd-display #__line__ ";~A: find and maxamp-position disagree: ~A (~A) ~A (~A)"
name pos (sample (cadr pos) ind 0) maxpos (sample maxpos ind 0))))
(let ((mx 0.0)
(ctr 0)
@@ -5096,8 +5181,8 @@
(set! ctr (+ 1 ctr))
#f))
(if (not (= mpos maxpos))
- (snd-display ";scan-chan and maxamp-position disagree: ~A ~A" mpos maxpos))
- (if (fneq mx val) (snd-display ";actual ~A max: ~A (correct: ~A)" name mx val)))))
+ (snd-display #__line__ ";scan-chan and maxamp-position disagree: ~A ~A" mpos maxpos))
+ (if (fneq mx val) (snd-display #__line__ ";actual ~A max: ~A (correct: ~A)" name mx val)))))
(define (check-env-vals name gen)
(let ((ctr -1))
@@ -5136,8 +5221,8 @@
(edit-position snd chn)
edpos)))
(ptree-channel (lambda (y data dir)
- (let* ((pos (inexact->exact (floor (vct-ref data 0))))
- (len (inexact->exact (floor (vct-ref data 1))))
+ (let* ((pos (floor (vct-ref data 0)))
+ (len (floor (vct-ref data 1)))
(val (vct-ref data (+ pos 2))))
(vct-set! data (+ pos 2) y)
(set! pos (+ 1 pos))
@@ -5160,10 +5245,10 @@
(set! (optimization) max-optimization) ; these trees assume optimization is on
- (if (playing) (snd-display ";dac is running??"))
+ (if (playing) (snd-display #__line__ ";dac is running??"))
(do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
(log-mem clmtest)
-
+
(let ((ind (open-sound "oboe.snd")))
(set! (transform-graph? ind 0) #t)
(set! (transform-graph-type ind 0) graph-as-sonogram)
@@ -5171,27 +5256,27 @@
(lambda ()
(set! (y-axis-label ind 0 1) "hiho"))
(lambda args
- (snd-display ";no fft axis: ~A" args)))
+ (snd-display #__line__ ";no fft axis: ~A" args)))
(set! (fft-log-frequency ind 0) #t) ; segfault here originally
(update-transform-graph ind 0)
(close-sound ind))
-
+
(let ((ind (new-sound "test.snd" :size 10)))
(vct->channel (make-vct 10 1.0))
(env-channel '(0 0 1 1 2 0))
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";pyr 10: ~A" data)))
+ (snd-display #__line__ ";pyr 10: ~A" data)))
(undo)
(env-channel '((0 0) (1 1) (2 0)))
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";pyr 10: ~A" data)))
+ (snd-display #__line__ ";pyr 10: ~A" data)))
(undo)
(env-channel (make-env '(0 0 1 1 2 0) :length 10))
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";pyr 10: ~A" data)))
+ (snd-display #__line__ ";pyr 10: ~A" data)))
(undo)
(close-sound ind))
@@ -5206,62 +5291,62 @@
(let ((data (channel->vct)))
(if (or (fneq (vct-ref data 0) 0.0)
(fneq (vct-ref data (- size 1)) 1.0))
- (snd-display ";ramp-channel ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
+ (snd-display #__line__ ";ramp-channel ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
(do ((i 0 (+ 1 i)))
((= i size))
(let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0)))
(segval (env e)))
(if (or (fneq segval val)
(fneq (vct-ref data i) val))
- (snd-display ";ramp-channel ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval)))))
+ (snd-display #__line__ ";ramp-channel ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval)))))
(undo)
(xramp-channel 0.0 1.0 32.0)
(let ((e (make-env '(0 0 1 1) :length size :base 32.0)))
(let ((data (channel->vct)))
(if (or (fneq (vct-ref data 0) 0.0)
(fneq (vct-ref data (- size 1)) 1.0))
- (snd-display ";xramp-channel 32 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
+ (snd-display #__line__ ";xramp-channel 32 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
(do ((i 0 (+ 1 i)))
((= i size))
(let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0) 32.0))
(segval (env e)))
(if (or (fneq segval val)
(fneq (vct-ref data i) val))
- (snd-display ";xramp-channel 32 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval))))))
+ (snd-display #__line__ ";xramp-channel 32 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval))))))
(undo)
(xramp-channel 0.0 1.0 0.4)
(let ((e (make-env '(0 0 1 1) :length size :base 0.4)))
(let ((data (channel->vct)))
(if (or (fneq (vct-ref data 0) 0.0)
(fneq (vct-ref data (- size 1)) 1.0))
- (snd-display ";xramp-channel .4 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
+ (snd-display #__line__ ";xramp-channel .4 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
(do ((i 0 (+ 1 i)))
((= i size))
(let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0) 0.4))
(segval (env e)))
(if (or (fneq segval val)
(fneq (vct-ref data i) val))
- (snd-display ";xramp-channel .4 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval))))))
+ (snd-display #__line__ ";xramp-channel .4 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval))))))
(undo)
(xramp-channel 1.0 -1.0 8.0)
(let ((e (make-env '(0 1 1 -1) :length size :base 8.0)))
(let ((data (channel->vct)))
(if (or (fneq (vct-ref data 0) 1.0)
(fneq (vct-ref data (- size 1)) -1.0))
- (snd-display ";xramp-channel 1 -1 8 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
+ (snd-display #__line__ ";xramp-channel 1 -1 8 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
(do ((i 0 (+ 1 i)))
((= i size))
(let ((segval (env e)))
(if (fneq segval (vct-ref data i))
- (snd-display ";xramp-channel 1 -1 8 ~A of ~A: ramp: ~A, env: ~A" i size (vct-ref data i) segval))))))
+ (snd-display #__line__ ";xramp-channel 1 -1 8 ~A of ~A: ramp: ~A, env: ~A" i size (vct-ref data i) segval))))))
(undo)
(close-sound ind)))
(list 10 100 1000))
;; basic edit tree cases
(let ((ind (new-sound "test.snd")))
- (if (not (= (redo) 0)) (snd-display ";redo with no ops: ~A" (redo)))
- (if (not (= (undo) 0)) (snd-display ";undo with no ops: ~A" (undo)))
+ (if (not (= (redo) 0)) (snd-display #__line__ ";redo with no ops: ~A" (redo)))
+ (if (not (= (undo) 0)) (snd-display #__line__ ";undo with no ops: ~A" (undo)))
(if (not (string-=? (display-edits) (string-append "
EDITS: 0
@@ -5270,9 +5355,9 @@ EDITS: 0
(at 0, cp->sounds[0][0:0, 0.000]) [file: " cwd "test.snd[0]]
(at 1, end_mark)
")))
- (snd-display ";new 0: ~A" (display-edits)))
+ (snd-display #__line__ ";new 0: ~A" (display-edits)))
(insert-samples 10 10 (make-vct 10))
- (if (not (= (frames) 20)) (snd-display ";new 1 frames: ~A" (frames)))
+ (if (not (= (frames) 20)) (snd-display #__line__ ";new 1 frames: ~A" (frames)))
(if (not (string-=? (display-edits) (string-append "
EDITS: 1
@@ -5286,10 +5371,10 @@ EDITS: 1
(at 10, cp->sounds[1][0:9, 1.000]) [buf: 10]
(at 20, end_mark)
")))
- (snd-display ";new 1: ~A" (display-edits)))
+ (snd-display #__line__ ";new 1: ~A" (display-edits)))
(undo)
(insert-samples 0 10 (make-vct 10))
- (if (not (= (frames) 11)) (snd-display ";new 2 frames: ~A" (frames))) ; 11 because there was 1 sample when new-sound created
+ (if (not (= (frames) 11)) (snd-display #__line__ ";new 2 frames: ~A" (frames))) ; 11 because there was 1 sample when new-sound created
(if (not (string-=? (display-edits) (string-append "
EDITS: 1
@@ -5302,11 +5387,11 @@ EDITS: 1
(at 10, cp->sounds[0][0:0, 0.000]) [file: " cwd "test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";new 2: ~A" (display-edits)))
+ (snd-display #__line__ ";new 2: ~A" (display-edits)))
(let ((eds (undo 2)))
- (if (not (= eds 2)) (snd-display ";new 3 undo: ~A" eds)))
+ (if (not (= eds 2)) (snd-display #__line__ ";new 3 undo: ~A" eds)))
(insert-samples 0 10 (make-vct 10))
- (if (not (= (frames) 11)) (snd-display ";new 3 frames: ~A" (frames)))
+ (if (not (= (frames) 11)) (snd-display #__line__ ";new 3 frames: ~A" (frames)))
(if (not (string-=? (display-edits) (string-append "
EDITS: 1
@@ -5319,10 +5404,10 @@ EDITS: 1
(at 10, cp->sounds[0][0:0, 0.000]) [file: " cwd "test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";new 3: ~A" (display-edits)))
+ (snd-display #__line__ ";new 3: ~A" (display-edits)))
(undo)
(set! (sample 0) .5)
- (if (not (= (frames) 1)) (snd-display ";new 4 frames: ~A" (frames)))
+ (if (not (= (frames) 1)) (snd-display #__line__ ";new 4 frames: ~A" (frames)))
(if (not (string-=? (display-edits) (string-append "
EDITS: 1
@@ -5334,11 +5419,11 @@ EDITS: 1
(at 0, cp->sounds[1][0:0, 1.000]) [buf: 1]
(at 1, end_mark)
")))
- (snd-display ";new 4: ~A" (display-edits)))
+ (snd-display #__line__ ";new 4: ~A" (display-edits)))
(undo)
-
+
(set! (samples 0 10) (make-vct 10))
- (if (not (= (frames) 10)) (snd-display ";new 5 frames: ~A" (frames)))
+ (if (not (= (frames) 10)) (snd-display #__line__ ";new 5 frames: ~A" (frames)))
(if (not (string-=? (display-edits) (string-append "
EDITS: 1
@@ -5350,20 +5435,20 @@ EDITS: 1
(at 0, cp->sounds[1][0:9, 1.000]) [buf: 10]
(at 10, end_mark)
")))
- (snd-display ";new 5: ~A" (display-edits)))
-
+ (snd-display #__line__ ";new 5: ~A" (display-edits)))
+
(delete-samples 3 4)
- (if (not (= (frames) 6)) (snd-display ";new 6 frames: ~A" (frames)))
+ (if (not (= (frames) 6)) (snd-display #__line__ ";new 6 frames: ~A" (frames)))
(if (not (string-=? (safe-display-edits ind 0 2) "
(delete 3 4) ; delete-samples 3 4 [2:3]:
(at 0, cp->sounds[1][0:2, 1.000]) [buf: 10]
(at 3, cp->sounds[1][7:9, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display ";new 6: ~A" (safe-display-edits ind 0 2)))
-
+ (snd-display #__line__ ";new 6: ~A" (safe-display-edits ind 0 2)))
+
(set! (samples 1 4) (make-vct 4))
- (if (not (= (frames) 6)) (snd-display ";new 7 frames: ~A" (frames)))
+ (if (not (= (frames) 6)) (snd-display #__line__ ";new 7 frames: ~A" (frames)))
(if (not (string-=? (safe-display-edits ind 0 3) "
(set 1 4) ; set-samples [3:4]:
(at 0, cp->sounds[1][0:0, 1.000]) [buf: 10]
@@ -5371,13 +5456,13 @@ EDITS: 1
(at 5, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display ";new 7: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";new 7: ~A" (safe-display-edits ind 0 3)))
(undo 2)
(insert-samples 2 3 (make-vct 3))
(insert-samples 2 1 (make-vct 1))
(insert-samples 4 1 (make-vct 1))
(insert-samples 15 1 (make-vct 1))
- (if (not (= (frames) 16)) (snd-display ";new 8 frames: ~A" (frames)))
+ (if (not (= (frames) 16)) (snd-display #__line__ ";new 8 frames: ~A" (frames)))
(if (not (string-=? (display-edits) (string-append "
EDITS: 5
@@ -5421,7 +5506,7 @@ EDITS: 5
(at 15, cp->sounds[5][0:0, 1.000]) [buf: 1]
(at 16, end_mark)
")))
- (snd-display ";new 8: ~A" (display-edits)))
+ (snd-display #__line__ ";new 8: ~A" (display-edits)))
(delete-samples 2 1)
(if (not (string-=? (safe-display-edits ind 0 6) "
(delete 2 1) ; delete-samples 2 1 [6:7]:
@@ -5433,7 +5518,7 @@ EDITS: 5
(at 14, cp->sounds[5][0:0, 1.000]) [buf: 1]
(at 15, end_mark)
"))
- (snd-display ";new 9: ~A" (safe-display-edits ind 0 6)))
+ (snd-display #__line__ ";new 9: ~A" (safe-display-edits ind 0 6)))
(delete-samples 0 5)
(if (not (string-=? (safe-display-edits ind 0 7) "
(delete 0 5) ; delete-samples 0 5 [7:4]:
@@ -5442,7 +5527,7 @@ EDITS: 5
(at 9, cp->sounds[5][0:0, 1.000]) [buf: 1]
(at 10, end_mark)
"))
- (snd-display ";new 10: ~A" (safe-display-edits ind 0 7)))
+ (snd-display #__line__ ";new 10: ~A" (safe-display-edits ind 0 7)))
(delete-samples 6 4)
(if (not (string-=? (safe-display-edits ind 0 8) "
(delete 6 4) ; delete-samples 6 4 [8:3]:
@@ -5450,38 +5535,38 @@ EDITS: 5
(at 1, cp->sounds[1][2:6, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display ";new 11: ~A" (safe-display-edits ind 0 8)))
+ (snd-display #__line__ ";new 11: ~A" (safe-display-edits ind 0 8)))
(delete-samples 0 1)
(if (not (string-=? (safe-display-edits ind 0 9) "
(delete 0 1) ; delete-samples 0 1 [9:2]:
(at 0, cp->sounds[1][2:6, 1.000]) [buf: 10]
(at 5, end_mark)
"))
- (snd-display ";new 12: ~A" (safe-display-edits ind 0 9)))
+ (snd-display #__line__ ";new 12: ~A" (safe-display-edits ind 0 9)))
(delete-samples 0 5)
(if (not (string-=? (safe-display-edits ind 0 10) "
(delete 0 5) ; delete-samples 0 5 [10:1]:
(at 0, end_mark)
"))
- (snd-display ";new 13: ~A" (safe-display-edits ind 0 10)))
+ (snd-display #__line__ ";new 13: ~A" (safe-display-edits ind 0 10)))
(delete-samples 0 10)
(if (not (= (edit-position) 10))
- (snd-display ";no-op delete deleted something! ~A" (display-edits)))
+ (snd-display #__line__ ";no-op delete deleted something! ~A" (display-edits)))
(insert-samples 0 3 (make-vct 3))
(if (not (string-=? (safe-display-edits ind 0 11) "
(insert 0 3) ; insert-samples [11:2]:
(at 0, cp->sounds[6][0:2, 1.000]) [buf: 3]
(at 3, end_mark)
"))
- (snd-display ";new 14: ~A" (safe-display-edits ind 0 11)))
+ (snd-display #__line__ ";new 14: ~A" (safe-display-edits ind 0 11)))
(delete-samples 2 1)
(if (not (string-=? (safe-display-edits ind 0 12) "
(delete 2 1) ; delete-samples 2 1 [12:2]:
(at 0, cp->sounds[6][0:1, 1.000]) [buf: 3]
(at 2, end_mark)
"))
- (snd-display ";new 15: ~A" (safe-display-edits ind 0 12)))
+ (snd-display #__line__ ";new 15: ~A" (safe-display-edits ind 0 12)))
(set! (sample 0) .5)
(if (not (string-=? (safe-display-edits ind 0 13) "
(set 0 1) ; set-sample 0 0.5000 [13:3]:
@@ -5489,7 +5574,7 @@ EDITS: 5
(at 1, cp->sounds[6][1:1, 1.000]) [buf: 3]
(at 2, end_mark)
"))
- (snd-display ";new 16: ~A" (safe-display-edits ind 0 13)))
+ (snd-display #__line__ ";new 16: ~A" (safe-display-edits ind 0 13)))
(set! (sample 1) .5)
(if (not (string-=? (safe-display-edits ind 0 14) "
(set 1 1) ; set-sample 1 0.5000 [14:3]:
@@ -5497,14 +5582,14 @@ EDITS: 5
(at 1, cp->sounds[8][0:0, 1.000]) [buf: 1]
(at 2, end_mark)
"))
- (snd-display ";new 17: ~A" (safe-display-edits ind 0 14)))
+ (snd-display #__line__ ";new 17: ~A" (safe-display-edits ind 0 14)))
(map-channel (lambda (y) 1.0) 0 10)
(if (not (string-=? (safe-display-edits ind 0 15) "
(set 0 10) ; map-channel [15:2]:
(at 0, cp->sounds[9][0:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";new 18: ~A" (safe-display-edits ind 0 15)))
+ (snd-display #__line__ ";new 18: ~A" (safe-display-edits ind 0 15)))
(insert-samples 0 10 (make-vct 10))
(if (not (string-=? (safe-display-edits ind 0 16) "
(insert 0 10) ; insert-samples [16:3]:
@@ -5512,7 +5597,7 @@ EDITS: 5
(at 10, cp->sounds[9][0:9, 1.000]) [buf: 10]
(at 20, end_mark)
"))
- (snd-display ";new 19: ~A" (safe-display-edits ind 0 16)))
+ (snd-display #__line__ ";new 19: ~A" (safe-display-edits ind 0 16)))
(set! (samples 2 3) (make-vct 3))
(if (not (string-=? (safe-display-edits ind 0 17) "
(set 2 3) ; set-samples [17:5]:
@@ -5522,7 +5607,7 @@ EDITS: 5
(at 10, cp->sounds[9][0:9, 1.000]) [buf: 10]
(at 20, end_mark)
"))
- (snd-display ";new 20: ~A" (safe-display-edits ind 0 17)))
+ (snd-display #__line__ ";new 20: ~A" (safe-display-edits ind 0 17)))
(set! (samples 0 12) (make-vct 12))
(if (not (string-=? (safe-display-edits ind 0 18) "
(set 0 12) ; set-samples [18:3]:
@@ -5530,7 +5615,7 @@ EDITS: 5
(at 12, cp->sounds[9][2:9, 1.000]) [buf: 10]
(at 20, end_mark)
"))
- (snd-display ";new 21: ~A" (safe-display-edits ind 0 18)))
+ (snd-display #__line__ ";new 21: ~A" (safe-display-edits ind 0 18)))
(set! (samples 30 10) (make-vct 10))
(if (not (string-=? (safe-display-edits ind 0 19) "
(set 20 21) ; set-samples [19:5]:
@@ -5540,7 +5625,7 @@ EDITS: 5
(at 30, cp->sounds[13][0:9, 1.000]) [buf: 10]
(at 40, end_mark)
"))
- (snd-display ";new 21: ~A" (safe-display-edits ind 0 19)))
+ (snd-display #__line__ ";new 21: ~A" (safe-display-edits ind 0 19)))
(close-sound ind))
;; scale/ramp
@@ -5552,7 +5637,7 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 0.500]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 0: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";scl 0: ~A" (safe-display-edits ind 0 2)))
(undo)
(scale-channel 0.5 0 3)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5561,7 +5646,7 @@ EDITS: 5
(at 3, cp->sounds[1][3:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 1: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";scl 1: ~A" (safe-display-edits ind 0 2)))
(undo)
(scale-channel 0.5 5 5)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5570,7 +5655,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 0.500]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 2: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";scl 2: ~A" (safe-display-edits ind 0 2)))
(undo)
(scale-channel 0.5 2 4)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5580,14 +5665,14 @@ EDITS: 5
(at 6, cp->sounds[1][6:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 2a: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";scl 2a: ~A" (safe-display-edits ind 0 2)))
(undo)
(scale-channel 0.5 10 10)
(if (not (= (edit-position) 1))
- (snd-display ";scale beyond end edited? ~A" (display-edits)))
+ (snd-display #__line__ ";scale beyond end edited? ~A" (display-edits)))
(scale-channel 0.5 100 10)
(if (not (= (edit-position) 1))
- (snd-display ";scale way beyond end edited? ~A" (display-edits)))
+ (snd-display #__line__ ";scale way beyond end edited? ~A" (display-edits)))
(scale-channel 0.5 5 10)
(if (not (string-=? (safe-display-edits ind 0 2) "
(scale 5 5) ; scale-channel 0.500 5 5 [2:3]:
@@ -5595,7 +5680,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 0.500]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 3: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";scl 3: ~A" (safe-display-edits ind 0 2)))
(undo)
(set! (sample 4) .5)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5605,7 +5690,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 4: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";scl 4: ~A" (safe-display-edits ind 0 2)))
(scale-channel 0.5 0 4)
(if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 4) ; scale-channel 0.500 0 4 [3:4]:
@@ -5614,7 +5699,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 5: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";scl 5: ~A" (safe-display-edits ind 0 3)))
(scale-channel 0.5 4 1)
(if (not (string-=? (safe-display-edits ind 0 4) "
(scale 4 1) ; scale-channel 0.500 4 1 [4:4]:
@@ -5623,7 +5708,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 6: ~A" (safe-display-edits ind 0 4)))
+ (snd-display #__line__ ";scl 6: ~A" (safe-display-edits ind 0 4)))
(scale-channel 0.5 0 7)
(if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 7) ; scale-channel 0.500 0 7 [5:5]:
@@ -5633,7 +5718,7 @@ EDITS: 5
(at 7, cp->sounds[1][7:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 7: ~A" (safe-display-edits ind 0 5)))
+ (snd-display #__line__ ";scl 7: ~A" (safe-display-edits ind 0 5)))
(scale-channel 0.5 1 4)
(if (not (string-=? (safe-display-edits ind 0 6) "
(scale 1 4) ; scale-channel 0.500 1 4 [6:6]:
@@ -5644,7 +5729,7 @@ EDITS: 5
(at 7, cp->sounds[1][7:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 8: ~A" (safe-display-edits ind 0 6)))
+ (snd-display #__line__ ";scl 8: ~A" (safe-display-edits ind 0 6)))
(undo 4)
(scale-channel 0.5 1 8)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5656,7 +5741,7 @@ EDITS: 5
(at 9, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";scl 9: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";scl 9: ~A" (safe-display-edits ind 0 3)))
(undo 2)
(ramp-channel 0.0 1.0)
@@ -5665,14 +5750,14 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 1.000, [1]-0.000 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 0: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";ramp 0: ~A" (safe-display-edits ind 0 2)))
(scale-channel 0.5)
(if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 10) ; scale-channel 0.500 0 #f [3:2]:
(at 0, cp->sounds[1][0:9, 0.500, [1]-0.000 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 1: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 1: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 0 5)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5681,7 +5766,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 1.000, [1]0.556 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 2: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 2: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 2 4)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5691,7 +5776,7 @@ EDITS: 5
(at 6, cp->sounds[1][6:9, 1.000, [1]0.667 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 3: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 3: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 5 5)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5700,7 +5785,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 0.500, [1]0.556 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 4: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 4: ~A" (safe-display-edits ind 0 3)))
(undo 2)
(ramp-channel .2 .6 2 6)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5710,7 +5795,7 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 5: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";ramp 5: ~A" (safe-display-edits ind 0 2)))
(scale-channel 0.5 0 5)
(if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 5) ; scale-channel 0.500 0 5 [3:5]:
@@ -5720,7 +5805,7 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 6: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 6: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 2 6)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5730,7 +5815,7 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 7: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 7: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 5 4)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5742,7 +5827,7 @@ EDITS: 5
(at 9, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 8: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 8: ~A" (safe-display-edits ind 0 3)))
(undo)
(set! (sample 4) .5)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5754,7 +5839,7 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 9: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 9: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 4 1)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5766,7 +5851,7 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 10: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 10: ~A" (safe-display-edits ind 0 3)))
(undo)
(delete-sample 4)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5777,7 +5862,7 @@ EDITS: 5
(at 7, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 9, end_mark)
"))
- (snd-display ";ramp 11: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 11: ~A" (safe-display-edits ind 0 3)))
(undo)
(delete-samples 4 2)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5788,7 +5873,7 @@ EDITS: 5
(at 6, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display ";ramp 12: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 12: ~A" (safe-display-edits ind 0 3)))
(undo)
(delete-samples 4 3)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5799,7 +5884,7 @@ EDITS: 5
(at 5, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 7, end_mark)
"))
- (snd-display ";ramp 13: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 13: ~A" (safe-display-edits ind 0 3)))
(undo)
(delete-samples 4 4)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5809,7 +5894,7 @@ EDITS: 5
(at 4, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display ";ramp 14: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 14: ~A" (safe-display-edits ind 0 3)))
(undo)
(delete-samples 4 5)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5819,7 +5904,7 @@ EDITS: 5
(at 4, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 5, end_mark)
"))
- (snd-display ";ramp 15: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 15: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 4 2)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5831,7 +5916,7 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";ramp 16: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 16: ~A" (safe-display-edits ind 0 3)))
(undo)
(pad-channel 4 1)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5843,7 +5928,7 @@ EDITS: 5
(at 9, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 11, end_mark)
"))
- (snd-display ";ramp 17: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";ramp 17: ~A" (safe-display-edits ind 0 3)))
(close-sound ind))
;; xramp
@@ -5855,7 +5940,7 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 1: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";xramp 1: ~A" (safe-display-edits ind 0 2)))
(undo)
(xramp-channel 0.0 1.0 0.325)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5863,7 +5948,7 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 1.000, off: 1.481, scl: -1.481]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 2: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";xramp 2: ~A" (safe-display-edits ind 0 2)))
(undo)
(xramp-channel 0.0 1.0 0.0)
(if (not (string-=? (safe-display-edits ind 0 2) (string-append "
@@ -5871,7 +5956,7 @@ EDITS: 5
(at 0, cp->sounds[0][0:9, 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 10, end_mark)
")))
- (snd-display ";xramp 3: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";xramp 3: ~A" (safe-display-edits ind 0 2)))
(undo)
(xramp-channel 0.0 1.0 1.0)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5879,7 +5964,7 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 1.000, [1]-0.000 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 4: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";xramp 4: ~A" (safe-display-edits ind 0 2)))
(undo)
(xramp-channel 0.5 1.5 32.0)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5887,9 +5972,9 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 1.000, [1]0.500 -> 1.500, off: 0.468, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 5: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";xramp 5: ~A" (safe-display-edits ind 0 2)))
(if (or (fneq (maxamp) 1.5) (fneq (sample 0) 0.5))
- (snd-display ";xramp 5 vals: ~A ~A" (maxamp) (sample 0)))
+ (snd-display #__line__ ";xramp 5 vals: ~A ~A" (maxamp) (sample 0)))
(undo)
(xramp-channel -0.5 1.5 32.0)
(if (not (string-=? (safe-display-edits ind 0 2) "
@@ -5897,9 +5982,9 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 1.000, [1]-0.500 -> 1.500, off: -0.565, scl: 0.065]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 6: ~A" (safe-display-edits ind 0 2)))
+ (snd-display #__line__ ";xramp 6: ~A" (safe-display-edits ind 0 2)))
(if (or (fneq (maxamp) 1.5) (fneq (sample 0) -0.5))
- (snd-display ";xramp 6 vals: ~A ~A" (maxamp) (sample 0)))
+ (snd-display #__line__ ";xramp 6 vals: ~A ~A" (maxamp) (sample 0)))
(undo)
(xramp-channel 0.0 1.0 32.0)
(let ((vals (channel->vct))
@@ -5910,10 +5995,10 @@ EDITS: 5
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 7: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 7: ~A" (safe-display-edits ind 0 3)))
(set! ctr 0)
(let ((baddy (scan-chan (lambda (y) (if (fneq y (* 0.5 (vct-ref vals ctr))) #t (begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display ";trouble in xramp 7: ~A" baddy)))
+ (if baddy (snd-display #__line__ ";trouble in xramp 7: ~A" baddy)))
(undo)
(delete-sample 0)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5921,10 +6006,10 @@ EDITS: 5
(at 0, cp->sounds[1][1:9, 1.000, [1]0.015 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 9, end_mark)
"))
- (snd-display ";xramp 8: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 8: ~A" (safe-display-edits ind 0 3)))
(set! ctr 1)
(let ((baddy (scan-chan (lambda (y) (if (fneq y (vct-ref vals ctr)) #t (begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display ";trouble in xramp 8: ~A" baddy)))
+ (if baddy (snd-display #__line__ ";trouble in xramp 8: ~A" baddy)))
(undo)
(delete-samples 0 2)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5932,10 +6017,10 @@ EDITS: 5
(at 0, cp->sounds[1][2:9, 1.000, [1]0.037 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display ";xramp 9: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 9: ~A" (safe-display-edits ind 0 3)))
(set! ctr 2)
(let ((baddy (scan-chan (lambda (y) (if (fneq y (vct-ref vals ctr)) #t (begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display ";trouble in xramp 9: ~A" baddy)))
+ (if baddy (snd-display #__line__ ";trouble in xramp 9: ~A" baddy)))
(undo)
(delete-sample 0)
(delete-sample 0)
@@ -5944,7 +6029,7 @@ EDITS: 5
(at 0, cp->sounds[1][2:9, 1.000, [1]0.037 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display ";xramp 10: ~A" (safe-display-edits ind 0 4)))
+ (snd-display #__line__ ";xramp 10: ~A" (safe-display-edits ind 0 4)))
(undo 2)
(delete-sample 4)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5953,7 +6038,7 @@ EDITS: 5
(at 4, cp->sounds[1][5:9, 1.000, [1]0.189 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 9, end_mark)
"))
- (snd-display ";xramp 11: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 11: ~A" (safe-display-edits ind 0 3)))
(undo)
(delete-samples 4 2)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5962,7 +6047,7 @@ EDITS: 5
(at 4, cp->sounds[1][6:9, 1.000, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display ";xramp 12: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 12: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5 4 2)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5972,7 +6057,7 @@ EDITS: 5
(at 6, cp->sounds[1][6:9, 1.000, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 13: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 13: ~A" (safe-display-edits ind 0 3)))
(set! ctr 0)
(let ((baddy (scan-chan (lambda (y)
(if (or (and (> ctr 5) (fneq y (vct-ref vals ctr)))
@@ -5980,7 +6065,7 @@ EDITS: 5
(and (or (= ctr 4) (= ctr 5)) (fneq y (* 0.5 (vct-ref vals ctr)))))
#t
(begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display ";trouble in xramp 8: ~A" baddy)))
+ (if baddy (snd-display #__line__ ";trouble in xramp 8: ~A" baddy)))
(undo)
(scale-channel 0.5 0 2)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5989,7 +6074,7 @@ EDITS: 5
(at 2, cp->sounds[1][2:9, 1.000, [1]0.037 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 14: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 14: ~A" (safe-display-edits ind 0 3)))
(undo)
(pad-channel 4 2)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -5999,7 +6084,7 @@ EDITS: 5
(at 6, cp->sounds[1][4:9, 1.000, [1]0.118 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 12, end_mark)
"))
- (snd-display ";xramp 15: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 15: ~A" (safe-display-edits ind 0 3)))
(undo)
(set! (sample 4) 1.0)
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -6009,7 +6094,7 @@ EDITS: 5
(at 5, cp->sounds[1][5:9, 1.000, [1]0.189 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 16: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 16: ~A" (safe-display-edits ind 0 3)))
(undo)
(set! (samples 4 2) (make-vct 2))
(if (not (string-=? (safe-display-edits ind 0 3) "
@@ -6019,7 +6104,7 @@ EDITS: 5
(at 6, cp->sounds[1][6:9, 1.000, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 17: ~A" (safe-display-edits ind 0 3)))
+ (snd-display #__line__ ";xramp 17: ~A" (safe-display-edits ind 0 3)))
(undo)
(scale-channel 0.5)
(set! (samples 4 2) (make-vct 2))
@@ -6030,7 +6115,7 @@ EDITS: 5
(at 6, cp->sounds[1][6:9, 0.500, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display ";xramp 18: ~A" (safe-display-edits ind 0 4)))
+ (snd-display #__line__ ";xramp 18: ~A" (safe-display-edits ind 0 4)))
)
(close-sound ind))
@@ -6054,8 +6139,8 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp 1: ~A" (safe-display-edits ind 0 12)))
- (if (fneq (maxamp) 0.5) (snd-display ";multi ramp 1 maxamp: ~A" (maxamp)))
+ (snd-display #__line__ ";multi-ramp 1: ~A" (safe-display-edits ind 0 12)))
+ (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 1 maxamp: ~A" (maxamp)))
(undo)
(ramp-channel 0.1 1.0 10 90)
(if (not (string=? (safe-display-edits ind 0 12) "
@@ -6072,8 +6157,8 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp 2: ~A" (safe-display-edits ind 0 12)))
- (if (fneq (maxamp) 0.5) (snd-display ";multi ramp 2 maxamp: ~A" (maxamp)))
+ (snd-display #__line__ ";multi-ramp 2: ~A" (safe-display-edits ind 0 12)))
+ (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 2 maxamp: ~A" (maxamp)))
(undo)
(ramp-channel 0.0 0.9 0 90)
(if (not (string=? (safe-display-edits ind 0 12) "
@@ -6090,10 +6175,10 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp 3: ~A" (safe-display-edits ind 0 12)))
- (if (fneq (maxamp) 0.5) (snd-display ";multi ramp 3 maxamp: ~A" (maxamp)))
- (if (fneq (sample 89) 0.45) (snd-display ";multi ramp 3 sample 89: ~A" (sample 89)))
- (if (fneq (sample 90) 0.5) (snd-display ";multi ramp 3 sample 90: ~A" (sample 90)))
+ (snd-display #__line__ ";multi-ramp 3: ~A" (safe-display-edits ind 0 12)))
+ (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 3 maxamp: ~A" (maxamp)))
+ (if (fneq (sample 89) 0.45) (snd-display #__line__ ";multi ramp 3 sample 89: ~A" (sample 89)))
+ (if (fneq (sample 90) 0.5) (snd-display #__line__ ";multi ramp 3 sample 90: ~A" (sample 90)))
(undo)
(ramp-channel 0.1 0.9 10 80)
(if (not (string=? (safe-display-edits ind 0 12) "
@@ -6110,7 +6195,7 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp 4: ~A" (safe-display-edits ind 0 12)))
+ (snd-display #__line__ ";multi-ramp 4: ~A" (safe-display-edits ind 0 12)))
(revert-sound)
(map-channel (lambda (y) 1.0) 0 100)
(ramp-channel 0.0 1.0)
@@ -6131,28 +6216,25 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp 5: ~A" (safe-display-edits ind 0 12)))
+ (snd-display #__line__ ";multi-ramp 5: ~A" (safe-display-edits ind 0 12)))
(close-sound ind))
-
- (if (provided? 'run)
- (begin
-
- (let ((ind (new-sound "test.snd")))
-
- ;; ptree+scale
- (map-channel (lambda (y) 1.0) 0 100)
- (cosine-channel 0 100)
- (let ((map-data (channel->vct)))
- (undo)
- (cosine-channel-via-ptree 0 100)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display ";map and ptree cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string=? (safe-display-edits ind 0 12 #f) "
+
+ (let ((ind (new-sound "test.snd")))
+
+ ;; ptree+scale
+ (map-channel (lambda (y) 1.0) 0 100)
+ (cosine-channel 0 100)
+ (let ((map-data (channel->vct)))
+ (undo)
+ (cosine-channel-via-ptree 0 100)
+ (let ((tree-data (channel->vct)))
+ (if (not (vequal map-data tree-data))
+ (snd-display #__line__ ";map and ptree cosine disagree: ~A ~A" map-data tree-data)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (if (not (string=? (safe-display-edits ind 0 12 #f) "
(scale 90 10) ; scale-channel 0.500 90 10 [12:11]:
(at 0, cp->sounds[1][0:9, 0.500, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, loc: 0, pos: 10, scl: 1.000]) [buf: 100]
@@ -6166,18 +6248,18 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, loc: 0, pos: 90, scl: 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 0: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and ptree->scl cosine disagree: ~% ~A~% ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 0 100)
- (if (not (string=? (safe-display-edits ind 0 12 #f) "
+ (snd-display #__line__ ";multi-tree 0: ~A" (safe-display-edits ind 0 12 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and ptree->scl cosine disagree: ~% ~A~% ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (cosine-channel-via-ptree 0 100)
+ (if (not (string=? (safe-display-edits ind 0 12 #f) "
(ptree[0] 0 100) ; ptree-channel [12:11]:
(at 0, cp->sounds[1][0:9, 1.000, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
@@ -6191,25 +6273,25 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 1.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 1: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and scl->ptree cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (cosine-channel 10 90)
- (set! map-data (channel->vct))
-
- (undo)
- (cosine-channel-via-ptree 10 90)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display ";map and ptree 10:90 cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 12 #f) "
+ (snd-display #__line__ ";multi-tree 1: ~A" (safe-display-edits ind 0 12 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and scl->ptree cosine disagree: ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (cosine-channel 10 90)
+ (set! map-data (channel->vct))
+
+ (undo)
+ (cosine-channel-via-ptree 10 90)
+ (let ((tree-data (channel->vct)))
+ (if (not (vequal map-data tree-data))
+ (snd-display #__line__ ";map and ptree 10:90 cosine disagree: ~A ~A" map-data tree-data)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (if (not (string-=? (safe-display-edits ind 0 12 #f) "
(scale 90 10) ; scale-channel 0.500 90 10 [12:11]:
(at 0, cp->sounds[1][0:9, 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
@@ -6223,24 +6305,24 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, loc: 0, pos: 80, scl: 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 2: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and scl->ptree 10:90 cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (cosine-channel 10 80)
- (set! map-data (channel->vct))
- (undo)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 10 80)
- (let ((tree-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data tree-data))
- (snd-display ";map and ptree 10:80 cosine disagree: ~A ~A" map-data tree-data)))
- (if (not (string-=? (safe-display-edits ind 0 12 #f) "
+ (snd-display #__line__ ";multi-tree 2: ~A" (safe-display-edits ind 0 12 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and scl->ptree 10:90 cosine disagree: ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (cosine-channel 10 80)
+ (set! map-data (channel->vct))
+ (undo)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (cosine-channel-via-ptree 10 80)
+ (let ((tree-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data tree-data))
+ (snd-display #__line__ ";map and ptree 10:80 cosine disagree: ~A ~A" map-data tree-data)))
+ (if (not (string-=? (safe-display-edits ind 0 12 #f) "
(ptree[0] 10 80) ; ptree-channel [12:11]:
(at 0, cp->sounds[1][0:9, 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
@@ -6254,26 +6336,26 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 3: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and scl->ptree 10:80 cosine disagree: ~A ~A" map-data scl-data)))
-
- ;; ptree + ramp
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (cosine-channel 0 100)
- (set! map-data (channel->vct))
- (undo)
- (cosine-channel-via-ptree 0 100)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display ";ptree->ramp cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 3: ~A" (safe-display-edits ind 0 12 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and scl->ptree 10:80 cosine disagree: ~A ~A" map-data scl-data)))
+
+ ;; ptree + ramp
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-channel '(0 0 1 1))
+ (cosine-channel 0 100)
+ (set! map-data (channel->vct))
+ (undo)
+ (cosine-channel-via-ptree 0 100)
+ (let ((tree-data (channel->vct)))
+ (if (not (vequal map-data tree-data))
+ (snd-display #__line__ ";ptree->ramp cosine disagree: ~A ~A" map-data tree-data)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(scale 90 10) ; scale-channel 0.500 90 10 [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, loc: 0, pos: 10, scl: 1.000]) [buf: 100]
@@ -6287,19 +6369,19 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, loc: 0, pos: 90, scl: 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 4: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and (scl) ptree->ramp cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '((0 0) (1 1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 0 100)
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 4: ~A" (safe-display-edits ind 0 13 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and (scl) ptree->ramp cosine disagree: ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-channel '((0 0) (1 1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (cosine-channel-via-ptree 0 100)
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(ptree[0] 0 100) ; ptree-channel [13:11]:
(at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 0.091, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, [1]0.101 -> 0.192, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
@@ -6313,13 +6395,13 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 1.000, [1]0.909 -> 1.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 5: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and ptree->ramp (scl) cosine disagree: ~A ~A" map-data scl-data)))
-
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 14 #f) "
+ (snd-display #__line__ ";multi-tree 5: ~A" (safe-display-edits ind 0 13 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and ptree->ramp (scl) cosine disagree: ~A ~A" map-data scl-data)))
+
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 14 #f) "
(scale 0 100) ; scale-channel 0.500 0 #f [14:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
@@ -6333,20 +6415,20 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 5 + scl: ~A" (safe-display-edits ind 0 14 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 4.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and ptree->ramp (scl twice) cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 10 80)
- (set! map-data (channel->vct))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 5 + scl: ~A" (safe-display-edits ind 0 14 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 4.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and ptree->ramp (scl twice) cosine disagree: ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-channel '(0 0 1 1))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (cosine-channel-via-ptree 10 80)
+ (set! map-data (channel->vct))
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(ptree[0] 10 80) ; ptree-channel [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, [1]0.101 -> 0.192, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
@@ -6360,27 +6442,27 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 6: ~A" (safe-display-edits ind 0 13 #f)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (cosine-channel-via-ptree 10 80)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (let ((scl-data (channel->vct)))
- (if (not (vequal map-data scl-data))
- (snd-display ";ptree+ramp order matters? ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (cosine-channel-via-ptree 15 70)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 6: ~A" (safe-display-edits ind 0 13 #f)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-channel '(0 0 1 1))
+ (cosine-channel-via-ptree 10 80)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (let ((scl-data (channel->vct)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";ptree+ramp order matters? ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-channel '(0 0 1 1))
+ (cosine-channel-via-ptree 15 70)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(scale 90 10) ; scale-channel 0.500 90 10 [13:13]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091]) [buf: 100]
(at 10, cp->sounds[1][10:14, 0.500, [1]0.101 -> 0.141]) [buf: 100]
@@ -6396,34 +6478,34 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 7: ~A" (safe-display-edits ind 0 13 #f)))
- (close-sound ind)))
-
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.75 (* i 10) 10))
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5)))
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 20 45 ind 0 #f #f
- (lambda (pos dur)
- (vct 0.25)))
- (let ((data (channel->vct))
- (orig (make-vct 100 1.0)))
- (vct-scale! orig 0.75) ; scale-channel
- (vct-scale! orig 0.5) ; ptree-channel
- (do ((i 20 (+ 1 i)))
- ((= i 65))
- (vct-set! orig i (* (vct-ref orig i) .25)))
- (if (not (vvequal orig data))
- (snd-display ";p2 pos test data: ~A" data))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 7: ~A" (safe-display-edits ind 0 13 #f)))
+ (close-sound ind)))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) 1.0) 0 100)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.75 (* i 10) 10))
+ (ptree-channel (lambda (y data forward)
+ (* y (vct-ref data 0)))
+ 0 (frames) ind 0 #f #f
+ (lambda (pos dur)
+ (vct 0.5)))
+ (ptree-channel (lambda (y data forward)
+ (* y (vct-ref data 0)))
+ 20 45 ind 0 #f #f
+ (lambda (pos dur)
+ (vct 0.25)))
+ (let ((data (channel->vct))
+ (orig (make-vct 100 1.0)))
+ (vct-scale! orig 0.75) ; scale-channel
+ (vct-scale! orig 0.5) ; ptree-channel
+ (do ((i 20 (+ 1 i)))
+ ((= i 65))
+ (vct-set! orig i (* (vct-ref orig i) .25)))
+ (if (not (vvequal orig data))
+ (snd-display #__line__ ";p2 pos test data: ~A" data))
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(ptree[1] 20 45) ; ptree-channel [13:12]:
(at 0, cp->sounds[1][0:9, 1.000, loc: 0, pos: 0, scl: 0.750]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, loc: 0, pos: 10, scl: 0.750]) [buf: 100]
@@ -6438,27 +6520,27 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 1.000, loc: 0, pos: 90, scl: 0.750]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";p2 pos multi: ~A" (safe-display-edits ind 0 13 #f)))
- (close-sound ind)))
-
- (let ((ind (new-sound "test.snd"))
- (map-data #f))
-
- ;; ptree + xramp
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (cosine-channel 0 100)
- (set! map-data (channel->vct))
- (undo)
- (cosine-channel-via-ptree 0 100)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display ";ptree->xramp cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";p2 pos multi: ~A" (safe-display-edits ind 0 13 #f)))
+ (close-sound ind)))
+
+ (let ((ind (new-sound "test.snd"))
+ (map-data #f))
+
+ ;; ptree + xramp
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-sound '(0 0 1 1) 0 100 32.0)
+ (cosine-channel 0 100)
+ (set! map-data (channel->vct))
+ (undo)
+ (cosine-channel-via-ptree 0 100)
+ (let ((tree-data (channel->vct)))
+ (if (not (vequal map-data tree-data))
+ (snd-display #__line__ ";ptree->xramp cosine disagree: ~A ~A" map-data tree-data)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(scale 90 10) ; scale-channel 0.500 90 10 [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.012, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.014 -> 0.030, off: -0.032, scl: 0.032, loc: 0, pos: 10, scl: 1.000]) [buf: 100]
@@ -6472,19 +6554,19 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.721 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 90, scl: 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 9: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and (scl) ptree->xramp cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 0 100)
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 9: ~A" (safe-display-edits ind 0 13 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and (scl) ptree->xramp cosine disagree: ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-sound '(0 0 1 1) 0 100 32.0)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (cosine-channel-via-ptree 0 100)
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(ptree[0] 0 100) ; ptree-channel [13:11]:
(at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 0.012, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, [1]0.014 -> 0.030, off: -0.032, scl: 0.032, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
@@ -6498,20 +6580,20 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 1.000, [1]0.721 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 10: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display ";map and ptree->xramp (scl) cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 10 80)
- (set! map-data (channel->vct))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 10: ~A" (safe-display-edits ind 0 13 #f)))
+ (let ((scl-data (vct-scale! (channel->vct) 2.0)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";map and ptree->xramp (scl) cosine disagree: ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-sound '(0 0 1 1) 0 100 32.0)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (cosine-channel-via-ptree 10 80)
+ (set! map-data (channel->vct))
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(ptree[0] 10 80) ; ptree-channel [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.012, off: -0.032, scl: 0.032]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, [1]0.014 -> 0.030, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
@@ -6525,27 +6607,27 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.721 -> 1.000, off: -0.032, scl: 0.032]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 11: ~A" (safe-display-edits ind 0 13 #f)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (cosine-channel-via-ptree 10 80)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (let ((scl-data (channel->vct)))
- (if (not (vequal map-data scl-data))
- (snd-display ";ptree+xramp order matters? ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (cosine-channel-via-ptree 15 70)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
+ (snd-display #__line__ ";multi-tree 11: ~A" (safe-display-edits ind 0 13 #f)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-sound '(0 0 1 1) 0 100 32.0)
+ (cosine-channel-via-ptree 10 80)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (let ((scl-data (channel->vct)))
+ (if (not (vequal map-data scl-data))
+ (snd-display #__line__ ";ptree+xramp order matters? ~A ~A" map-data scl-data)))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (env-sound '(0 0 1 1) 0 100 32.0)
+ (cosine-channel-via-ptree 15 70)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (if (not (string-=? (safe-display-edits ind 0 13 #f) "
(scale 90 10) ; scale-channel 0.500 90 10 [13:13]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.012, off: -0.032, scl: 0.032]) [buf: 100]
(at 10, cp->sounds[1][10:14, 0.500, [1]0.014 -> 0.020, off: -0.032, scl: 0.032]) [buf: 100]
@@ -6561,228 +6643,228 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.721 -> 1.000, off: -0.032, scl: 0.032]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-tree 12: ~A" (safe-display-edits ind 0 13 #f)))
- (close-sound ind))
-
- ;; ptree2
- (let ((ind (new-sound "test.snd")) ;4th
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (if (not (vequal (channel->vct) (make-vct 11 0.5)))
- (snd-display ";ptree2 0: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";multi-tree 12: ~A" (safe-display-edits ind 0 13 #f)))
+ (close-sound ind))
+
+ ;; ptree2
+ (let ((ind (new-sound "test.snd")) ;4th
+ (case1 #f)
+ (case2 #f))
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (if (not (vequal (channel->vct) (make-vct 11 0.5)))
+ (snd-display #__line__ ";ptree2 0: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ptree[0] 0 11) ; ptree-channel [2:2]:
(at 0, cp->sounds[1][0:10, 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2 3: ~A" (safe-display-edits ind 0 2)))
- (ptree-channel (lambda (y) (* y 1.5)))
- (if (not (vequal (channel->vct) (make-vct 11 0.75)))
- (snd-display ";ptree2 1: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ptree2 3: ~A" (safe-display-edits ind 0 2)))
+ (ptree-channel (lambda (y) (* y 1.5)))
+ (if (not (vequal (channel->vct) (make-vct 11 0.75)))
+ (snd-display #__line__ ";ptree2 1: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ptree[1] 0 11) ; ptree-channel [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-by (vct 1.5))
- (if (not (vequal (channel->vct) (make-vct 11 0.75)))
- (snd-display ";ptree2 5: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ptree2 4: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-by (vct 1.5))
+ (if (not (vequal (channel->vct) (make-vct 11 0.75)))
+ (snd-display #__line__ ";ptree2 5: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 11) ; scale-channel 1.500 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.500, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2 6: ~A" (safe-display-edits ind 0 3)))
- (ptree-channel (lambda (y) (* y 0.1)))
- (if (not (vequal (channel->vct) (make-vct 11 0.075)))
- (snd-display ";ptree2 7: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ptree2 6: ~A" (safe-display-edits ind 0 3)))
+ (ptree-channel (lambda (y) (* y 0.1)))
+ (if (not (vequal (channel->vct) (make-vct 11 0.075)))
+ (snd-display #__line__ ";ptree2 7: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ptree[1] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.500, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2 8: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
- (scale-by '(0.5))
- (ptree-channel (lambda (y) (* y 1.5)))
- (scale-by 2.0)
- (ptree-channel (lambda (y) (* y 0.1)))
- (scale-by 3.0)
- (if (not (vequal (channel->vct) (make-vct 11 0.45)))
- (snd-display ";ptree2 9: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 6) "
+ (snd-display #__line__ ";ptree2 8: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+ (scale-by '(0.5))
+ (ptree-channel (lambda (y) (* y 1.5)))
+ (scale-by 2.0)
+ (ptree-channel (lambda (y) (* y 0.1)))
+ (scale-by 3.0)
+ (if (not (vequal (channel->vct) (make-vct 11 0.45)))
+ (snd-display #__line__ ";ptree2 9: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 6) "
(scale 0 11) ; scale-channel 3.000 0 #f [6:2]:
(at 0, cp->sounds[1][0:10, 3.000, loc2: 1, pos2: 0, scl2: 2.000, loc: 0, pos: 0, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2 10: ~A" (safe-display-edits ind 0 6)))
- (undo 2)
- (ptree-channel (lambda (y) (* y 0.1)) 2 4)
- (scale-by 3.0)
- (if (not (vequal (channel->vct) (vct 4.500 4.500 0.450 0.450 0.450 0.450 4.500 4.500 4.500 4.500 4.500)))
- (snd-display ";ptree2 11: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 6) "
+ (snd-display #__line__ ";ptree2 10: ~A" (safe-display-edits ind 0 6)))
+ (undo 2)
+ (ptree-channel (lambda (y) (* y 0.1)) 2 4)
+ (scale-by 3.0)
+ (if (not (vequal (channel->vct) (vct 4.500 4.500 0.450 0.450 0.450 0.450 4.500 4.500 4.500 4.500 4.500)))
+ (snd-display #__line__ ";ptree2 11: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 6) "
(scale 0 11) ; scale-channel 3.000 0 #f [6:4]:
(at 0, cp->sounds[1][0:1, 6.000, loc: 0, pos: 0, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
(at 2, cp->sounds[1][2:5, 3.000, loc2: 1, pos2: 0, scl2: 2.000, loc: 0, pos: 2, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
(at 6, cp->sounds[1][6:10, 6.000, loc: 0, pos: 6, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2 12: ~A" (safe-display-edits ind 0 6)))
- (close-sound ind))
-
- ;; ptree2-zero
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-by 0.0)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (if (not (vequal (channel->vct) (make-vct 11 0.5)))
- (snd-display ";ptree2-zero 0: ~A" (channel->vct)))
- (ptree-channel (lambda (y) (+ y 0.25)))
- (if (not (vequal (channel->vct) (make-vct 11 0.75)))
- (snd-display ";ptree2-zero 1: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 4) (string-append "
+ (snd-display #__line__ ";ptree2 12: ~A" (safe-display-edits ind 0 6)))
+ (close-sound ind))
+
+ ;; ptree2-zero
+ (let ((ind (new-sound "test.snd"))
+ (case1 #f)
+ (case2 #f))
+ (map-chan (lambda (y) 1.0) 0 10)
+ (scale-by 0.0)
+ (ptree-channel (lambda (y) (+ y 0.5)))
+ (if (not (vequal (channel->vct) (make-vct 11 0.5)))
+ (snd-display #__line__ ";ptree2-zero 0: ~A" (channel->vct)))
+ (ptree-channel (lambda (y) (+ y 0.25)))
+ (if (not (vequal (channel->vct) (make-vct 11 0.75)))
+ (snd-display #__line__ ";ptree2-zero 1: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 4) (string-append "
(ptree[1] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[0][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000, code: (lambda (y) (+ y 0.5))]) [file: " (getcwd) "/test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";ptree2-zero 2: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
- (scale-channel 0.0 2 4)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (+ y 0.25)))
- (if (not (vequal (channel->vct) (vct 1.750 1.750 0.750 0.750 0.750 0.750 1.750 1.750 1.750 1.750 1.750)))
- (snd-display ";ptree2-zero 3: ~A" (channel->vct)))
-
- ;; ptree2-ramp
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y .5)))
- (ptree-channel (lambda (y) (+ y .25)))
- (if (not (vequal (channel->vct) (vct 0.250 0.300 0.350 0.400 0.450 0.500 0.550 0.600 0.650 0.700 0.750)))
- (snd-display ";ptree2-ramp 1: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ptree2-zero 2: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+ (scale-channel 0.0 2 4)
+ (ptree-channel (lambda (y) (+ y 0.5)))
+ (ptree-channel (lambda (y) (+ y 0.25)))
+ (if (not (vequal (channel->vct) (vct 1.750 1.750 0.750 0.750 0.750 0.750 1.750 1.750 1.750 1.750 1.750)))
+ (snd-display #__line__ ";ptree2-zero 3: ~A" (channel->vct)))
+
+ ;; ptree2-ramp
+ (revert-sound)
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (* y .5)))
+ (ptree-channel (lambda (y) (+ y .25)))
+ (if (not (vequal (channel->vct) (vct 0.250 0.300 0.350 0.400 0.450 0.500 0.550 0.600 0.650 0.700 0.750)))
+ (snd-display #__line__ ";ptree2-ramp 1: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ptree[1] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2-ramp 2: ~A" (safe-display-edits ind 0 4)))
- (scale-by 0.5)
- (if (not (vequal (channel->vct) (vct 0.125 0.150 0.175 0.200 0.225 0.250 0.275 0.300 0.325 0.350 0.375)))
- (snd-display ";ptree2-ramp 3: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ptree2-ramp 2: ~A" (safe-display-edits ind 0 4)))
+ (scale-by 0.5)
+ (if (not (vequal (channel->vct) (vct 0.125 0.150 0.175 0.200 0.225 0.250 0.275 0.300 0.325 0.350 0.375)))
+ (snd-display #__line__ ";ptree2-ramp 3: ~A" (channel->vct)))
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree2-ramp 4: ~A" (safe-display-edits ind 0 5)))
-
- ;; ptree+ramp3
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y .5)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ptree2-ramp 4: ~A" (safe-display-edits ind 0 5)))
+
+ ;; ptree+ramp3
+ (revert-sound)
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (* y .5)))
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(ptree[0] 0 11) ; ptree-channel [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp3: ~A" (safe-display-edits ind 0 5 #f)))
- (undo 1)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ptree-ramp3: ~A" (safe-display-edits ind 0 5 #f)))
+ (undo 1)
+ (ptree-channel (lambda (y data forward)
+ (* y (vct-ref data 0)))
+ 0 (frames) ind 0 #f #t
+ (lambda (pos dur)
+ (vct 0.5)))
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(ptree[0] 0 11) ; ptree-channel [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptreec-ramp3: ~A" (safe-display-edits ind 0 5 #f)))
- (undo 4)
- (xramp-channel 0.0 1.0 32.0)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ptreec-ramp3: ~A" (safe-display-edits ind 0 5 #f)))
+ (undo 4)
+ (xramp-channel 0.0 1.0 32.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp2: ~A" (safe-display-edits ind 0 4)))
- (close-sound ind))
-
- ;; ramp2
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp-xramp2: ~A" (safe-display-edits ind 0 4)))
+ (close-sound ind))
+
+ ;; ramp2
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 0: ~A" (safe-display-edits ind 0 3)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ramp2 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2 0: ~A" (safe-display-edits ind 0 3)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ramp2 (1): ~A" (channel->vct)))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2 1: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]-0.000 -> 0.400, [2]-0.000 -> 0.400]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 2: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ramp2 (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2 2: ~A" (safe-display-edits ind 0 4)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ramp2 (2): ~A" (channel->vct)))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.200 -> 0.500]) [buf: 11]
(at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.600 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 3: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp2 3: ~A" (safe-display-edits ind 0 4)))
+ (undo 2)
+ (ramp-channel 0.75 0.25)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]0.750 -> 0.250]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp2 4: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (ramp-channel .2 .6 2 6)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.600]) [buf: 11]
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2 5: ~A" (safe-display-edits ind 0 3)))
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
(at 0, cp->sounds[1][0:1, 0.500, [1]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.360]) [buf: 11]
@@ -6790,10 +6872,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 6: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2 6: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(set 4 1) ; set-sample 4 0.5000 [4:6]:
(at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.280]) [buf: 11]
@@ -6802,20 +6884,20 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 7: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
-
- ;; multi-ramp2
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (if (not (string-=? (safe-display-edits ind 0 13) "
+ (snd-display #__line__ ";ramp2 7: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) 1.0) 0 100)
+
+ ;; multi-ramp2
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 1.0 0.0)
+ (if (not (string-=? (safe-display-edits ind 0 13) "
(ramp 0 100) ; ramp-channel 1.000 0.000 0 #f [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.909]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.899 -> 0.808]) [buf: 100]
@@ -6829,12 +6911,12 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.091 -> -0.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp2 1: ~A" (safe-display-edits ind 0 13)))
- (undo 12)
- (ramp-channel 0.0 1.0 10 20)
- (ramp-channel 0.0 1.0 50 10)
- (ramp-channel 0.0 1.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";multi-ramp2 1: ~A" (safe-display-edits ind 0 13)))
+ (undo 12)
+ (ramp-channel 0.0 1.0 10 20)
+ (ramp-channel 0.0 1.0 50 10)
+ (ramp-channel 0.0 1.0 25 10)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 25 10) ; ramp-channel 0.000 1.000 25 10 [4:8]:
(at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
(at 10, cp->sounds[1][10:24, 1.000, [1]-0.000 -> 0.737]) [buf: 100]
@@ -6845,204 +6927,204 @@ EDITS: 5
(at 60, cp->sounds[1][60:99, 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp2 2: ~A" (safe-display-edits ind 0 4)))
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- ;; ramp ptree cases
- (for-each
- (lambda (func func-zero name)
- (func)
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 3 #f) "
+ (snd-display #__line__ ";multi-ramp2 2: ~A" (safe-display-edits ind 0 4)))
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ ;; ramp ptree cases
+ (for-each
+ (lambda (func func-zero name)
+ (func)
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 3 #f) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";~A 1: ~A" name (safe-display-edits ind 0 3 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500)))
- (snd-display ";~A 1: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
+ (snd-display #__line__ ";~A 1: ~A" name (safe-display-edits ind 0 3 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500)))
+ (snd-display #__line__ ";~A 1: ~A" name (channel->vct)))
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 4 #f) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";~A 2: ~A" name (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
- (snd-display ";~A 2: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";~A 2: ~A" name (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
+ (snd-display #__line__ ";~A 2: ~A" name (channel->vct)))
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";~A 3: ~A" name (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.004 0.013 0.032 0.062 0.108 0.171 0.256 0.364 0.500)))
- (snd-display ";~A 3: ~A" name (channel->vct)))
-
- (undo 4)
- (scale-by 0.0)
- (func-zero)
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 4 #f) (string-append "
+ (snd-display #__line__ ";~A 3: ~A" name (safe-display-edits ind 0 5 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.004 0.013 0.032 0.062 0.108 0.171 0.256 0.364 0.500)))
+ (snd-display #__line__ ";~A 3: ~A" name (channel->vct)))
+
+ (undo 4)
+ (scale-by 0.0)
+ (func-zero)
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 4 #f) (string-append "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
(at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";~A-zero 1: ~A" name (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500)))
- (snd-display ";~A-zero 1: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) (string-append "
+ (snd-display #__line__ ";~A-zero 1: ~A" name (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500)))
+ (snd-display #__line__ ";~A-zero 1: ~A" name (channel->vct)))
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) (string-append "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
(at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";~A-zero 2: ~A" name (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
- (snd-display ";~A-zero 2: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 6 #f) (string-append "
+ (snd-display #__line__ ";~A-zero 2: ~A" name (safe-display-edits ind 0 5 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
+ (snd-display #__line__ ";~A-zero 2: ~A" name (channel->vct)))
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 6 #f) (string-append "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [6:2]:
(at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";~A-zero 3: ~A" name (safe-display-edits ind 0 6 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.004 0.013 0.032 0.062 0.108 0.171 0.256 0.364 0.500)))
- (snd-display ";~A-zero 3: ~A" name (channel->vct)))
- (undo 5)
- )
- (list
- (lambda () (ptree-channel (lambda (y) (* y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list
- (lambda () (ptree-channel (lambda (y) (+ y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (+ y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list "ramp-ptree" "ramp-ptreec"))
-
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- ;; xramp ptree cases
- (for-each
- (lambda (func func-zero name twice)
- (func)
+ (snd-display #__line__ ";~A-zero 3: ~A" name (safe-display-edits ind 0 6 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.004 0.013 0.032 0.062 0.108 0.171 0.256 0.364 0.500)))
+ (snd-display #__line__ ";~A-zero 3: ~A" name (channel->vct)))
+ (undo 5)
+ )
+ (list
+ (lambda () (ptree-channel (lambda (y) (* y 0.5))))
+ (lambda () (ptree-channel
+ (lambda (y data forward)
+ (* y (vct-ref data 0)))
+ 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
+ (list
+ (lambda () (ptree-channel (lambda (y) (+ y 0.5))))
+ (lambda () (ptree-channel
+ (lambda (y data forward)
+ (+ y (vct-ref data 0)))
+ 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
+ (list "ramp-ptree" "ramp-ptreec"))
+
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ ;; xramp ptree cases
+ (for-each
+ (lambda (func func-zero name twice)
+ (func)
+ (xramp-channel 0 1 32)
+ (if (not (vequal (channel->vct) (vct 0.000 0.007 0.016 0.029 0.048 0.075 0.113 0.166 0.242 0.349 0.500)))
+ (snd-display #__line__ ";~A 1: ~A" name (channel->vct)))
+ (if twice
+ (begin
(xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.007 0.016 0.029 0.048 0.075 0.113 0.166 0.242 0.349 0.500)))
- (snd-display ";~A 1: ~A" name (channel->vct)))
- (if twice
- (begin
- (xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.001 0.002 0.005 0.011 0.025 0.055 0.117 0.243 0.500)))
- (snd-display ";~A 2: ~A" name (channel->vct)))
- (undo 1)))
- (undo 2)
- (scale-by 0.0)
- (func-zero)
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.001 0.002 0.005 0.011 0.025 0.055 0.117 0.243 0.500)))
+ (snd-display #__line__ ";~A 2: ~A" name (channel->vct)))
+ (undo 1)))
+ (undo 2)
+ (scale-by 0.0)
+ (func-zero)
+ (xramp-channel 0 1 32)
+ (if (not (vequal (channel->vct) (vct 0.000 0.007 0.016 0.029 0.048 0.075 0.113 0.166 0.242 0.349 0.500)))
+ (snd-display #__line__ ";~A-zero 1: ~A" name (channel->vct)))
+ (if twice
+ (begin
(xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.007 0.016 0.029 0.048 0.075 0.113 0.166 0.242 0.349 0.500)))
- (snd-display ";~A-zero 1: ~A" name (channel->vct)))
- (if twice
- (begin
- (xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.001 0.002 0.005 0.011 0.025 0.055 0.117 0.243 0.500)))
- (snd-display ";~A-zero 2: ~A" name (channel->vct)))
- (undo 1)))
- (undo 3))
- (list
- (lambda () (ptree-channel (lambda (y) (* y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list
- (lambda () (ptree-channel (lambda (y) (+ y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (+ y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list "xramp-ptree" "xramp-ptreec")
- (list #t #t))
-
- (close-sound ind))
-
- ;; ramp-xramp, xramp-ramp
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.001 0.002 0.005 0.011 0.025 0.055 0.117 0.243 0.500)))
+ (snd-display #__line__ ";~A-zero 2: ~A" name (channel->vct)))
+ (undo 1)))
+ (undo 3))
+ (list
+ (lambda () (ptree-channel (lambda (y) (* y 0.5))))
+ (lambda () (ptree-channel
+ (lambda (y data forward)
+ (* y (vct-ref data 0)))
+ 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
+ (list
+ (lambda () (ptree-channel (lambda (y) (+ y 0.5))))
+ (lambda () (ptree-channel
+ (lambda (y data forward)
+ (+ y (vct-ref data 0)))
+ 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
+ (list "xramp-ptree" "xramp-ptreec")
+ (list #t #t))
+
+ (close-sound ind))
+
+ ;; ramp-xramp, xramp-ramp
+ (let ((ind (new-sound "test.snd"))
+ (case1 #f)
+ (case2 #f))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 0: ~A" (safe-display-edits ind 0 3)))
- (set! case1 (channel->vct))
- (if (not (vequal case1 (vct 0.000 0.001 0.006 0.018 0.039 0.075 0.135 0.233 0.387 0.628 1.000)))
- (snd-display ";ramp-xramp (1): ~A" case1))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp-xramp 0: ~A" (safe-display-edits ind 0 3)))
+ (set! case1 (channel->vct))
+ (if (not (vequal case1 (vct 0.000 0.001 0.006 0.018 0.039 0.075 0.135 0.233 0.387 0.628 1.000)))
+ (snd-display #__line__ ";ramp-xramp (1): ~A" case1))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp-xramp 1: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.400, [2]0.000 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.150 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 2: ~A" (safe-display-edits ind 0 4)))
- (set! case2 (channel->vct))
- (if (not (vequal case2 (vct 0.000 0.001 0.003 0.009 0.019 0.075 0.135 0.233 0.387 0.628 1.000)))
- (snd-display ";ramp-xramp (2): ~A" case2))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp-xramp 2: ~A" (safe-display-edits ind 0 4)))
+ (set! case2 (channel->vct))
+ (if (not (vequal case2 (vct 0.000 0.001 0.003 0.009 0.019 0.075 0.135 0.233 0.387 0.628 1.000)))
+ (snd-display #__line__ ";ramp-xramp (2): ~A" case2))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.032 -> 0.150, off: -0.032, scl: 0.032]) [buf: 11]
(at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.226 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 3: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (xramp-channel 0.75 0.25 32.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp-xramp 3: ~A" (safe-display-edits ind 0 4)))
+ (undo 2)
+ (xramp-channel 0.75 0.25 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; xramp-channel 0.750 0.250 32.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.750 -> 0.250, off: 0.234, scl: 0.016]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (xramp-channel .2 .6 3.0 2 6)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp-xramp 4: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (xramp-channel .2 .6 3.0 2 6)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 2 6) ; xramp-channel 0.200 0.600 3.000 2 6 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.600, off: -0.000, scl: 0.200]) [buf: 11]
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp-xramp 5: ~A" (safe-display-edits ind 0 3)))
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
(at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.310, off: -0.000, scl: 0.200]) [buf: 11]
@@ -7050,10 +7132,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 6: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp-xramp 6: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(set 4 1) ; set-sample 4 0.5000 [4:6]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.249, off: -0.000, scl: 0.200]) [buf: 11]
@@ -7062,68 +7144,68 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp-xramp 7: ~A" (safe-display-edits ind 0 4)))
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
-
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp-xramp 7: ~A" (safe-display-edits ind 0 4)))
+ (revert-sound)
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ (xramp-channel 0.0 1.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 0: ~A" (safe-display-edits ind 0 3)))
- (if (not (vequal case1 (channel->vct)))
- (snd-display ";xramp-ramp (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp-ramp 0: ~A" (safe-display-edits ind 0 3)))
+ (if (not (vequal case1 (channel->vct)))
+ (snd-display #__line__ ";xramp-ramp (1): ~A" (channel->vct)))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp-ramp 1: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.400, [2]0.000 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.150 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 2: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal case2 (channel->vct)))
- (snd-display ";xramp-ramp (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp-ramp 2: ~A" (safe-display-edits ind 0 4)))
+ (if (not (vequal case2 (channel->vct)))
+ (snd-display #__line__ ";xramp-ramp (2): ~A" (channel->vct)))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.032 -> 0.150, off: -0.032, scl: 0.032]) [buf: 11]
(at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.226 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 3: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp-ramp 3: ~A" (safe-display-edits ind 0 4)))
+ (undo 2)
+ (ramp-channel 0.75 0.25)
+ (if (not (string=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.750 -> 0.250, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp-ramp 4: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (ramp-channel .2 .6 2 6)
+ (if (not (string=? (safe-display-edits ind 0 3) "
(ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.600, [2]0.032 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
(at 8, cp->sounds[1][8:10, 1.000, [1]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp-ramp 5: ~A" (safe-display-edits ind 0 3)))
+ (scale-channel 0.5 0 5)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
(at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.360, [2]0.032 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
@@ -7131,10 +7213,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 6: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp-ramp 6: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(set 4 1) ; set-sample 4 0.5000 [4:6]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280, [2]0.032 -> 0.059, off: -0.032, scl: 0.032]) [buf: 11]
@@ -7143,75 +7225,75 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp-ramp 7: ~A" (safe-display-edits ind 0 4)))
- (close-sound ind))
-
- ;; ramp2+xramp
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp-ramp 7: ~A" (safe-display-edits ind 0 4)))
+ (close-sound ind))
+
+ ;; ramp2+xramp
+ (let ((ind (new-sound "test.snd"))
+ (case1 #f)
+ (case2 #f))
+ (map-chan (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 0: ~A" (safe-display-edits ind 0 4)))
- (set! case1 (channel->vct))
- (if (not (vequal case1 (vct 0.000 0.000 0.001 0.005 0.015 0.038 0.081 0.163 0.310 0.565 1.000)))
- (snd-display ";ramp2+xramp (1): ~A" case1))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp2+xramp 0: ~A" (safe-display-edits ind 0 4)))
+ (set! case1 (channel->vct))
+ (if (not (vequal case1 (vct 0.000 0.000 0.001 0.005 0.015 0.038 0.081 0.163 0.310 0.565 1.000)))
+ (snd-display #__line__ ";ramp2+xramp (1): ~A" case1))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 1: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp2+xramp 1: ~A" (safe-display-edits ind 0 5)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 5) ; scale-channel 0.500 0 5 [5:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.400, [2]0.000 -> 0.400, [3]0.000 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000, [3]0.150 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 2: ~A" (safe-display-edits ind 0 5)))
- (set! case2 (channel->vct))
- (if (not (vequal case2 (vct 0.000 0.000 0.001 0.003 0.008 0.038 0.081 0.163 0.310 0.565 1.000)))
- (snd-display ";ramp2+xramp (2): ~A" case2))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp2+xramp 2: ~A" (safe-display-edits ind 0 5)))
+ (set! case2 (channel->vct))
+ (if (not (vequal case2 (vct 0.000 0.000 0.001 0.003 0.008 0.038 0.081 0.163 0.310 0.565 1.000)))
+ (snd-display #__line__ ";ramp2+xramp (2): ~A" case2))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 2 4) ; scale-channel 0.500 2 4 [5:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.100, [3]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.200 -> 0.500, [3]0.032 -> 0.150, off: -0.032, scl: 0.032]) [buf: 11]
(at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.600 -> 1.000, [3]0.226 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 3: ~A" (safe-display-edits ind 0 5)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2+xramp 3: ~A" (safe-display-edits ind 0 5)))
+ (undo 2)
+ (ramp-channel 0.75 0.25)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.750 -> 0.250, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 4: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2+xramp 4: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (ramp-channel .2 .6 2 6)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [4:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.600, [3]0.032 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 5: ~A" (safe-display-edits ind 0 4)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp2+xramp 5: ~A" (safe-display-edits ind 0 4)))
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 5) ; scale-channel 0.500 0 5 [5:5]:
(at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.360, [3]0.032 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
@@ -7219,10 +7301,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 6: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp2+xramp 6: ~A" (safe-display-edits ind 0 5)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(set 4 1) ; set-sample 4 0.5000 [5:6]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.280, [3]0.032 -> 0.059, off: -0.032, scl: 0.032]) [buf: 11]
@@ -7231,54 +7313,54 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2+xramp 7: ~A" (safe-display-edits ind 0 5)))
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp2+xramp 7: ~A" (safe-display-edits ind 0 5)))
+ (revert-sound)
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp+ramp2 0: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal case1 (channel->vct)))
- (snd-display ";xramp+ramp2 (1): ~A" (channel->vct)))
-
- (revert-sound ind)
- (map-channel (lambda (y) 1.0) 0 100)
- (scale-channel 0.75)
- (ramp-channel .5 1)
- (ptree-channel (lambda (y) (* y (/ 1.0 0.75))))
- (scale-channel 2.0)
- (ramp-channel 1 .5)
- (ptree-channel (lambda (y) (* y .25)))
- (scale-channel 4.0)
- (ramp-channel 0 1)
- (if (fneq (maxamp) 1.0)
- (snd-display ";rprpr max: ~A" (maxamp)))
-
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd"))
- (case3 #f))
- (map-channel (lambda (y) 1.0) 0 100)
- (scale-channel 0.5)
- (xramp-channel 1.0 0.0 32.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (set! case3 (channel->vct))
- (undo 4)
-
- ;; multi-ramp2+xramp
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (xramp-channel 1.0 0.0 32.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 14) "
+ (snd-display #__line__ ";xramp+ramp2 0: ~A" (safe-display-edits ind 0 4)))
+ (if (not (vequal case1 (channel->vct)))
+ (snd-display #__line__ ";xramp+ramp2 (1): ~A" (channel->vct)))
+
+ (revert-sound ind)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (scale-channel 0.75)
+ (ramp-channel .5 1)
+ (ptree-channel (lambda (y) (* y (/ 1.0 0.75))))
+ (scale-channel 2.0)
+ (ramp-channel 1 .5)
+ (ptree-channel (lambda (y) (* y .25)))
+ (scale-channel 4.0)
+ (ramp-channel 0 1)
+ (if (fneq (maxamp) 1.0)
+ (snd-display #__line__ ";rprpr max: ~A" (maxamp)))
+
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd"))
+ (case3 #f))
+ (map-channel (lambda (y) 1.0) 0 100)
+ (scale-channel 0.5)
+ (xramp-channel 1.0 0.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (set! case3 (channel->vct))
+ (undo 4)
+
+ ;; multi-ramp2+xramp
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (xramp-channel 1.0 0.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 14) "
(ramp 0 100) ; ramp-channel 0.000 1.000 0 #f [14:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]0.000 -> 0.091, [3]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.101 -> 0.192, [3]0.695 -> 0.499, off: -0.032, scl: 0.032]) [buf: 100]
@@ -7292,18 +7374,18 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.909 -> 1.000, [3]0.012 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp2+xramp 1: ~A" (safe-display-edits ind 0 14)))
- (if (not (vequal case3 (channel->vct)))
- (snd-display ";multi-ramp2+xramp:~%; ~A~%; ~A"
- case3 (channel->vct)))
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (xramp-channel 1.0 0.0 32.0)
-
- (ramp-channel 0.0 1.0 10 20)
- (ramp-channel 0.0 1.0 50 10)
- (ramp-channel 0.0 1.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";multi-ramp2+xramp 1: ~A" (safe-display-edits ind 0 14)))
+ (if (not (vequal case3 (channel->vct)))
+ (snd-display #__line__ ";multi-ramp2+xramp:~%; ~A~%; ~A"
+ case3 (channel->vct)))
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (xramp-channel 1.0 0.0 32.0)
+
+ (ramp-channel 0.0 1.0 10 20)
+ (ramp-channel 0.0 1.0 50 10)
+ (ramp-channel 0.0 1.0 25 10)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(ramp 25 10) ; ramp-channel 0.000 1.000 25 10 [5:8]:
(at 0, cp->sounds[1][0:9, 1.000, [1]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
(at 10, cp->sounds[1][10:24, 1.000, [1]0.000 -> 0.737, [2]0.695 -> 0.413, off: -0.032, scl: 0.032]) [buf: 100]
@@ -7314,25 +7396,25 @@ EDITS: 5
(at 60, cp->sounds[1][60:99, 1.000, [1]0.094 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp2+xramp 2: ~A" (safe-display-edits ind 0 5)))
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd"))
- (case3 #f))
- (map-channel (lambda (y) 1.0) 0 100)
- (scale-channel 0.5)
- (ramp-channel 0.0 1.0)
- (xramp-channel 1.0 0.0 32.0)
- (set! case3 (channel->vct))
- (undo 3)
-
- ;; multi-ramp-xramp
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (xramp-channel 1.0 0.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 13) "
+ (snd-display #__line__ ";multi-ramp2+xramp 2: ~A" (safe-display-edits ind 0 5)))
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd"))
+ (case3 #f))
+ (map-channel (lambda (y) 1.0) 0 100)
+ (scale-channel 0.5)
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 1.0 0.0 32.0)
+ (set! case3 (channel->vct))
+ (undo 3)
+
+ ;; multi-ramp-xramp
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 1.0 0.0 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 13) "
(ramp 0 100) ; xramp-channel 1.000 0.000 32.000 0 #f [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.695 -> 0.499, off: -0.032, scl: 0.032]) [buf: 100]
@@ -7346,14 +7428,14 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.012 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp-xramp 1: ~A" (safe-display-edits ind 0 13)))
- (if (not (vequal case3 (channel->vct)))
- (snd-display ";multi-ramp-xramp: ~A" (channel->vct)))
- (undo 12)
- (xramp-channel 0.0 1.0 3.0 10 20)
- (xramp-channel 0.0 1.0 3.0 50 10)
- (xramp-channel 0.0 1.0 3.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";multi-ramp-xramp 1: ~A" (safe-display-edits ind 0 13)))
+ (if (not (vequal case3 (channel->vct)))
+ (snd-display #__line__ ";multi-ramp-xramp: ~A" (channel->vct)))
+ (undo 12)
+ (xramp-channel 0.0 1.0 3.0 10 20)
+ (xramp-channel 0.0 1.0 3.0 50 10)
+ (xramp-channel 0.0 1.0 3.0 25 10)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 25 10) ; xramp-channel 0.000 1.000 3.000 25 10 [4:8]:
(at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
(at 10, cp->sounds[1][10:24, 1.000, [1]0.000 -> 0.623, off: -0.500, scl: 0.500]) [buf: 100]
@@ -7364,17 +7446,17 @@ EDITS: 5
(at 60, cp->sounds[1][60:99, 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp-xramp 2: ~A" (safe-display-edits ind 0 4)))
- (revert-sound)
-
- (map-channel (lambda (y) 1.0) 0 100)
- ;; multi-xramp-ramp
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (xramp-channel 1.0 0.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 13) "
+ (snd-display #__line__ ";multi-ramp-xramp 2: ~A" (safe-display-edits ind 0 4)))
+ (revert-sound)
+
+ (map-channel (lambda (y) 1.0) 0 100)
+ ;; multi-xramp-ramp
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (xramp-channel 1.0 0.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 13) "
(ramp 0 100) ; ramp-channel 0.000 1.000 0 #f [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.695 -> 0.499, off: -0.032, scl: 0.032]) [buf: 100]
@@ -7388,14 +7470,14 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.012 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-xramp-ramp 3: ~A" (safe-display-edits ind 0 13)))
- (if (not (vequal case3 (channel->vct)))
- (snd-display ";case3 xramp-ramp 3: ~A" (channel->vct)))
- (undo 12)
- (ramp-channel 0.0 1.0 10 20)
- (ramp-channel 0.0 1.0 50 10)
- (ramp-channel 0.0 1.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";multi-xramp-ramp 3: ~A" (safe-display-edits ind 0 13)))
+ (if (not (vequal case3 (channel->vct)))
+ (snd-display #__line__ ";case3 xramp-ramp 3: ~A" (channel->vct)))
+ (undo 12)
+ (ramp-channel 0.0 1.0 10 20)
+ (ramp-channel 0.0 1.0 50 10)
+ (ramp-channel 0.0 1.0 25 10)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 25 10) ; ramp-channel 0.000 1.000 25 10 [4:8]:
(at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
(at 10, cp->sounds[1][10:24, 1.000, [1]-0.000 -> 0.737]) [buf: 100]
@@ -7406,71 +7488,71 @@ EDITS: 5
(at 60, cp->sounds[1][60:99, 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-xramp-ramp 2: ~A" (safe-display-edits ind 0 4)))
- (close-sound ind))
-
- ;; xramp2
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (xramp-channel 0.0 1.0 2.0)
- (xramp-channel 0.0 1.0 2.0)
- (if (not (string=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";multi-xramp-ramp 2: ~A" (safe-display-edits ind 0 4)))
+ (close-sound ind))
+
+ ;; xramp2
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ (xramp-channel 0.0 1.0 2.0)
+ (xramp-channel 0.0 1.0 2.0)
+ (if (not (string=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; xramp-channel 0.000 1.000 2.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: -1.000, scl: 1.000, [2]0.000 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 0: ~A" (safe-display-edits ind 0 3)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.022 0.053 0.102 0.172 0.266 0.390 0.549 0.750 1.000)))
- (snd-display ";xramp2 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp2 0: ~A" (safe-display-edits ind 0 3)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.005 0.022 0.053 0.102 0.172 0.266 0.390 0.549 0.750 1.000)))
+ (snd-display #__line__ ";xramp2 (1): ~A" (channel->vct)))
+ (scale-channel 0.5)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, off: -1.000, scl: 1.000, [2]0.000 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp2 1: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.320, off: -1.000, scl: 1.000, [2]0.000 -> 0.320, off: -1.000, scl: 1.000]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]0.414 -> 1.000, off: -1.000, scl: 1.000, [2]0.414 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 2: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.011 0.027 0.051 0.172 0.266 0.390 0.549 0.750 1.000)))
- (snd-display ";xramp2 (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp2 2: ~A" (safe-display-edits ind 0 4)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.003 0.011 0.027 0.051 0.172 0.266 0.390 0.549 0.750 1.000)))
+ (snd-display #__line__ ";xramp2 (2): ~A" (channel->vct)))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.072, off: -1.000, scl: 1.000, [2]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
(at 2, cp->sounds[1][2:5, 0.500, [1]0.149 -> 0.414, off: -1.000, scl: 1.000, [2]0.149 -> 0.414, off: -1.000, scl: 1.000]) [buf: 11]
(at 6, cp->sounds[1][6:10, 1.000, [1]0.516 -> 1.000, off: -1.000, scl: 1.000, [2]0.516 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 3: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (xramp-channel 0.75 0.25 0.3)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp2 3: ~A" (safe-display-edits ind 0 4)))
+ (undo 2)
+ (xramp-channel 0.75 0.25 0.3)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; xramp-channel 0.750 0.250 0.300 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: -1.000, scl: 1.000, [2]0.750 -> 0.250, off: 0.964, scl: -0.714]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (xramp-channel .2 .6 32.0 2 6)
- (if (not (string=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp2 4: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (xramp-channel .2 .6 32.0 2 6)
+ (if (not (string=? (safe-display-edits ind 0 3) "
(ramp 2 6) ; xramp-channel 0.200 0.600 32.000 2 6 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
(at 2, cp->sounds[1][2:7, 1.000, [1]0.149 -> 0.625, off: -1.000, scl: 1.000, [2]0.200 -> 0.600, off: 0.187, scl: 0.013]) [buf: 11]
(at 8, cp->sounds[1][8:10, 1.000, [1]0.741 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp2 5: ~A" (safe-display-edits ind 0 3)))
+ (scale-channel 0.5 0 5)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
(at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
(at 2, cp->sounds[1][2:4, 0.500, [1]0.149 -> 0.320, off: -1.000, scl: 1.000, [2]0.200 -> 0.239, off: 0.187, scl: 0.013]) [buf: 11]
@@ -7478,10 +7560,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.741 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 6: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp2 6: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(set 4 1) ; set-sample 4 0.5000 [4:6]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.149 -> 0.231, off: -1.000, scl: 1.000, [2]0.200 -> 0.213, off: 0.187, scl: 0.013]) [buf: 11]
@@ -7490,20 +7572,20 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.741 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp2 7: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
-
- ;; multi-xramp2
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (xramp-channel 0.0 1.0 3.0)
- (xramp-channel 1.0 0.0 0.3)
- (if (not (string-=? (safe-display-edits ind 0 13) "
+ (snd-display #__line__ ";xramp2 7: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) 1.0) 0 100)
+
+ ;; multi-xramp2
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (xramp-channel 0.0 1.0 3.0)
+ (xramp-channel 1.0 0.0 0.3)
+ (if (not (string-=? (safe-display-edits ind 0 13) "
(ramp 0 100) ; xramp-channel 1.000 0.000 0.300 0 #f [13:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.053, off: -0.500, scl: 0.500, [2]1.000 -> 0.950, off: 1.429, scl: -1.429]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.059 -> 0.117, off: -0.500, scl: 0.500, [2]0.945 -> 0.889, off: 1.429, scl: -1.429]) [buf: 100]
@@ -7517,87 +7599,87 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.857 -> 1.000, off: -0.500, scl: 0.500, [2]0.148 -> 0.000, off: 1.429, scl: -1.429]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-xramp2 1: ~A" (safe-display-edits ind 0 13)))
- (close-sound ind))
-
- ;; ptree+ramp2
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
+ (snd-display #__line__ ";multi-xramp2 1: ~A" (safe-display-edits ind 0 13)))
+ (close-sound ind))
+
+ ;; ptree+ramp2
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) y))
+ (if (not (string-=? (safe-display-edits ind 0 4 #f) "
(ptree[0] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp2 0: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ptree-ramp2 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ptree-ramp2 0: ~A" (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ptree-ramp2 (1): ~A" (channel->vct)))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp2 1: ~A" (safe-display-edits ind 0 5 #f)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ptree-ramp2 1: ~A" (safe-display-edits ind 0 5 #f)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(scale 0 5) ; scale-channel 0.500 0 5 [5:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]-0.000 -> 0.400, [2]-0.000 -> 0.400, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000, loc: 0, pos: 5, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp2 2: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ptree-ramp2 (2): ~A" (channel->vct)))
- (undo 4)
-
- (scale-channel .5)
- (env-channel '(0 0 1 1 2 0))
- (ramp-channel 0 1 2 3)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ptree-ramp2 2: ~A" (safe-display-edits ind 0 5 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ptree-ramp2 (2): ~A" (channel->vct)))
+ (undo 4)
+
+ (scale-channel .5)
+ (env-channel '(0 0 1 1 2 0))
+ (ramp-channel 0 1 2 3)
+ (ptree-channel (lambda (y) y))
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(ptree[0] 0 11) ; ptree-channel [5:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.200, loc: 0, pos: 0, scl: 0.500]) [buf: 11]
(at 2, cp->sounds[1][2:4, 1.000, [1]0.400 -> 0.800, [2]0.000 -> 1.000, loc: 0, pos: 2, scl: 0.500]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]1.000 -> -0.000, loc: 0, pos: 5, scl: 0.500]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp2 4: ~A" (safe-display-edits ind 0 5 #f)))
-
- (undo 4)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
+ (snd-display #__line__ ";ptree-ramp2 4: ~A" (safe-display-edits ind 0 5 #f)))
+
+ (undo 4)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y data forward)
+ (* y (vct-ref data 0)))
+ 0 (frames) ind 0 #f #t
+ (lambda (pos dur)
+ (vct 0.5)))
+ (if (not (string-=? (safe-display-edits ind 0 4 #f) "
(ptree[0] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp2 5: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
- (snd-display ";ptree+closure+ramp2: ~A" (channel->vct)))
-
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
-
- ;; multi-ramp2
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 14 #f) "
+ (snd-display #__line__ ";ptree-ramp2 5: ~A" (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
+ (snd-display #__line__ ";ptree+closure+ramp2: ~A" (channel->vct)))
+
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) 1.0) 0 100)
+
+ ;; multi-ramp2
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 1.0 0.0)
+ (ptree-channel (lambda (y) y))
+ (if (not (string-=? (safe-display-edits ind 0 14 #f) "
(ptree[0] 0 100) ; ptree-channel [14:11]:
(at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 0.091, [2]1.000 -> 0.909, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, [1]0.101 -> 0.192, [2]0.899 -> 0.808, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
@@ -7611,39 +7693,39 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 1.000, [1]0.909 -> 1.000, [2]0.091 -> -0.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";ptree multi-ramp2 1: ~A" (safe-display-edits ind 0 14 #f)))
- (undo 12)
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (+ y .1)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ptree multi-ramp2 1: ~A" (safe-display-edits ind 0 14 #f)))
+ (undo 12)
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (+ y .1)))
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(ptree[0] 0 11) ; ptree-channel [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp3 0: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.100 0.101 0.108 0.127 0.164 0.225 0.316 0.443 0.612 0.829 1.100)))
- (snd-display ";ptree-ramp3 1: ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 6 #f) "
+ (snd-display #__line__ ";ptree-ramp3 0: ~A" (safe-display-edits ind 0 5 #f)))
+ (if (not (vequal (channel->vct) (vct 0.100 0.101 0.108 0.127 0.164 0.225 0.316 0.443 0.612 0.829 1.100)))
+ (snd-display #__line__ ";ptree-ramp3 1: ~A" (channel->vct)))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 6 #f) "
(scale 0 11) ; scale-channel 0.500 0 #f [6:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp3 2: ~A" (safe-display-edits ind 0 6 #f)))
-
- (undo 5)
- (ramp-channel 0 1)
- (ramp-channel 0 1 5 5)
- (ramp-channel 0 1 7 3)
- (ptree-channel (lambda (y) (+ y .1)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ptree-ramp3 2: ~A" (safe-display-edits ind 0 6 #f)))
+
+ (undo 5)
+ (ramp-channel 0 1)
+ (ramp-channel 0 1 5 5)
+ (ramp-channel 0 1 7 3)
+ (ptree-channel (lambda (y) (+ y .1)))
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(ptree[0] 0 11) ; ptree-channel [5:5]:
(at 0, cp->sounds[1][0:4, 1.000, [1]-0.000 -> 0.400, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 5, cp->sounds[1][5:6, 1.000, [1]0.500 -> 0.600, [2]0.000 -> 0.250, loc: 0, pos: 5, scl: 1.000]) [buf: 11]
@@ -7651,74 +7733,74 @@ EDITS: 5
(at 10, cp->sounds[1][10:10, 1.000, [1]1.000 -> 1.000, loc: 0, pos: 10, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree-ramp3 3: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.100 0.200 0.300 0.400 0.500 0.100 0.250 0.100 0.400 1.000 1.100)))
- (snd-display ";ptree-ramp3 4: ~A" (channel->vct)))
- (close-sound ind))
-
- ;; ramp3
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ptree-ramp3 3: ~A" (safe-display-edits ind 0 5 #f)))
+ (if (not (vequal (channel->vct) (vct 0.100 0.200 0.300 0.400 0.500 0.100 0.250 0.100 0.400 1.000 1.100)))
+ (snd-display #__line__ ";ptree-ramp3 4: ~A" (channel->vct)))
+ (close-sound ind))
+
+ ;; ramp3
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 0: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display ";ramp3 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp3 0: ~A" (safe-display-edits ind 0 4)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
+ (snd-display #__line__ ";ramp3 (1): ~A" (channel->vct)))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 1: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp3 1: ~A" (safe-display-edits ind 0 5)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 5) ; scale-channel 0.500 0 5 [5:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]-0.000 -> 0.400, [2]-0.000 -> 0.400, [3]-0.000 -> 0.400]) [buf: 11]
(at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000, [3]0.500 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 2: ~A" (safe-display-edits ind 0 5)))
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.004 0.014 0.032 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display ";ramp3 (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp3 2: ~A" (safe-display-edits ind 0 5)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.001 0.004 0.014 0.032 0.125 0.216 0.343 0.512 0.729 1.000)))
+ (snd-display #__line__ ";ramp3 (2): ~A" (channel->vct)))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 2 4) ; scale-channel 0.500 2 4 [5:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100, [3]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.200 -> 0.500, [3]0.200 -> 0.500]) [buf: 11]
(at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.600 -> 1.000, [3]0.600 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 3: ~A" (safe-display-edits ind 0 5)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp3 3: ~A" (safe-display-edits ind 0 5)))
+ (undo 2)
+ (ramp-channel 0.75 0.25)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]0.750 -> 0.250]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 4: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp3 4: ~A" (safe-display-edits ind 0 4)))
+ (undo)
+ (ramp-channel .2 .6 2 6)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [4:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.700, [3]0.200 -> 0.600]) [buf: 11]
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 5: ~A" (safe-display-edits ind 0 4)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp3 5: ~A" (safe-display-edits ind 0 4)))
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 5) ; scale-channel 0.500 0 5 [5:5]:
(at 0, cp->sounds[1][0:1, 0.500, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.400, [3]0.200 -> 0.360]) [buf: 11]
@@ -7726,10 +7808,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 6: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp3 6: ~A" (safe-display-edits ind 0 5)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(set 4 1) ; set-sample 4 0.5000 [5:6]:
(at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.300, [3]0.200 -> 0.280]) [buf: 11]
@@ -7738,21 +7820,21 @@ EDITS: 5
(at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.800 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3 7: ~A" (safe-display-edits ind 0 5)))
- (undo 3)
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
-
- ;; multi-ramp3
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 -0.5)
- (ramp-channel -0.5 1.5)
- (if (not (string=? (safe-display-edits ind 0 14) "
+ (snd-display #__line__ ";ramp3 7: ~A" (safe-display-edits ind 0 5)))
+ (undo 3)
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) 1.0) 0 100)
+
+ ;; multi-ramp3
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 1.0 -0.5)
+ (ramp-channel -0.5 1.5)
+ (if (not (string=? (safe-display-edits ind 0 14) "
(ramp 0 100) ; ramp-channel -0.500 1.500 0 #f [14:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.864, [3]-0.500 -> -0.318]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.848 -> 0.712, [3]-0.298 -> -0.116]) [buf: 100]
@@ -7766,13 +7848,13 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]-0.364 -> -0.500, [3]1.318 -> 1.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp3 1: ~A" (safe-display-edits ind 0 14)))
- (undo 13)
- (ramp-channel 0.0 1.0 10 30)
- (ramp-channel 0.0 1.0 50 20)
- (ramp-channel 0.0 1.0 20 15)
- (ramp-channel 0.0 1.0 30 30)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";multi-ramp3 1: ~A" (safe-display-edits ind 0 14)))
+ (undo 13)
+ (ramp-channel 0.0 1.0 10 30)
+ (ramp-channel 0.0 1.0 50 20)
+ (ramp-channel 0.0 1.0 20 15)
+ (ramp-channel 0.0 1.0 30 30)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(ramp 30 30) ; ramp-channel 0.000 1.000 30 30 [5:10]:
(at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
(at 10, cp->sounds[1][10:19, 1.000, [1]0.000 -> 0.310]) [buf: 100]
@@ -7785,579 +7867,577 @@ EDITS: 5
(at 70, cp->sounds[1][70:99, 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display ";multi-ramp3 2: ~A" (safe-display-edits ind 0 5)))
-
- (let ((vals (channel->vct)))
- (undo 4)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 10 30)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 50 20)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 20 15)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 30 30)
- (if (not (vequal vals (channel->vct)))
- (snd-display ";ramp3 opt vs unopt: ~A ~A" vals (channel->vct))))
-
- (close-sound ind))
-
- ;; various cases not optimized, presumably
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- ;; ramp+xramp (now optimized)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";multi-ramp3 2: ~A" (safe-display-edits ind 0 5)))
+
+ (let ((vals (channel->vct)))
+ (undo 4)
+ (ptree-channel (lambda (y) y))
+ (ramp-channel 0.0 1.0 10 30)
+ (ptree-channel (lambda (y) y))
+ (ramp-channel 0.0 1.0 50 20)
+ (ptree-channel (lambda (y) y))
+ (ramp-channel 0.0 1.0 20 15)
+ (ptree-channel (lambda (y) y))
+ (ramp-channel 0.0 1.0 30 30)
+ (if (not (vequal vals (channel->vct)))
+ (snd-display #__line__ ";ramp3 opt vs unopt: ~A ~A" vals (channel->vct))))
+
+ (close-sound ind))
+
+ ;; various cases not optimized, presumably
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ ;; ramp+xramp (now optimized)
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp+xramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; xramp+xramp -- this one now optimized
- (xramp-channel 0.0 1.0 0.32)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp+xramp: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+
+ ;; xramp+xramp -- this one now optimized
+ (xramp-channel 0.0 1.0 0.32)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: 1.471, scl: -1.471, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp+xramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; xramp+xramp+xramp
- (xramp-channel 0.0 1.0 0.32)
- (xramp-channel 0.0 1.0 32.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp+xramp: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+
+ ;; xramp+xramp+xramp
+ (xramp-channel 0.0 1.0 0.32)
+ (xramp-channel 0.0 1.0 32.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: 1.471, scl: -1.471, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp+xramp+xramp (maxed): ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; xramp+xramp+ramp (now optimized)
- (xramp-channel 0.0 1.0 0.32)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp+xramp+xramp (maxed): ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+
+ ;; xramp+xramp+ramp (now optimized)
+ (xramp-channel 0.0 1.0 0.32)
+ (xramp-channel 0.0 1.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: 1.471, scl: -1.471, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp+xramp+ramp: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; xramp+ramp (now optimized)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp+xramp+ramp: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+
+ ;; xramp+ramp (now optimized)
+ (xramp-channel 0.0 1.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp+ramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; ramp+ramp+xramp
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp+ramp: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+
+ ;; ramp+ramp+xramp
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp+ramp+xramp: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; ramp+ramp+ramp+ramp
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp+ramp+xramp: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+
+ ;; ramp+ramp+ramp+ramp
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, [4]-0.000 -> 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp+ramp+ramp+ramp: ~A" (safe-display-edits ind 0 5)))
- (undo 4)
-
- ;; ramp+ramp+ramp+xramp
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";ramp+ramp+ramp+ramp: ~A" (safe-display-edits ind 0 5)))
+ (undo 4)
+
+ ;; ramp+ramp+ramp+xramp
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, [4]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp+ramp+ramp+xramp: ~A" (safe-display-edits ind 0 5)))
- (undo 4)
-
- ;; ptree+ramp (now optimized)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp+ramp+ramp+xramp: ~A" (safe-display-edits ind 0 5)))
+ (undo 4)
+
+ ;; ptree+ramp (now optimized)
+ (ptree-channel (lambda (y) y))
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree+ramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; ramp+xramp+ptree (now optimized)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ptree+ramp: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+
+ ;; ramp+xramp+ptree (now optimized)
+ (ramp-channel 0.0 1.0)
+ (xramp-channel 0.0 1.0 32.0)
+ (ptree-channel (lambda (y) y))
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ptree[0] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp+xramp+ptree: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; xramp+ramp+ptree (now optimized)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";ramp+xramp+ptree: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+
+ ;; xramp+ramp+ptree (now optimized)
+ (xramp-channel 0.0 1.0 32.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) y))
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(ptree[0] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp+ramp+ptree: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; ramp3+ptree (now optimized)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";xramp+ramp+ptree: ~A" (safe-display-edits ind 0 4)))
+ (undo 3)
+
+ ;; ramp3+ptree (now optimized)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) y))
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(ptree[0] 0 11) ; ptree-channel [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp3+ptree: ~A" (safe-display-edits ind 0 5)))
- (undo 4)
-
- ;; ptree+ptree (now optimized)
- (ptree-channel (lambda (y) y))
- (ptree-channel (lambda (y) y))
- (if (not (string=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp3+ptree: ~A" (safe-display-edits ind 0 5)))
+ (undo 4)
+
+ ;; ptree+ptree (now optimized)
+ (ptree-channel (lambda (y) y))
+ (ptree-channel (lambda (y) y))
+ (if (not (string=? (safe-display-edits ind 0 3) "
(ptree[1] 0 11) ; ptree-channel [3:2]:
(at 0, cp->sounds[1][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ptree+ptree: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- ;; ramp ptree2 cases
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
+ (snd-display #__line__ ";ptree+ptree: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-chan (lambda (y) 1.0) 0 10)
+
+ ;; ramp ptree2 cases
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 4 #f) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp ptree2: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0)))
- (snd-display ";ramp ptree2: ~A" (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
+ (snd-display #__line__ ";ramp ptree2: ~A" (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0)))
+ (snd-display #__line__ ";ramp ptree2: ~A" (channel->vct)))
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";ramp2 ptree2: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ramp2 ptree2: ~A" (channel->vct)))
- (undo 2)
- (xramp-channel 0 1 32)
- (if (not (string=? (safe-display-edits ind 0 4 #f) "
+ (snd-display #__line__ ";ramp2 ptree2: ~A" (safe-display-edits ind 0 5 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ramp2 ptree2: ~A" (channel->vct)))
+ (undo 2)
+ (xramp-channel 0 1 32)
+ (if (not (string=? (safe-display-edits ind 0 4 #f) "
(ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
(at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: -0.032, scl: 0.032, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
(at 11, end_mark)
"))
- (snd-display ";xramp ptree2: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.000)))
- (snd-display ";xramp ptree2: ~A" (channel->vct)))
-
- (undo 3)
- (scale-channel 0.0)
-
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0 1)
- (if (not (string=? (safe-display-edits ind 0 4 #f) (string-append "
+ (snd-display #__line__ ";xramp ptree2: ~A" (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.000)))
+ (snd-display #__line__ ";xramp ptree2: ~A" (channel->vct)))
+
+ (undo 3)
+ (scale-channel 0.0)
+
+ (ptree-channel (lambda (y) (+ y 0.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (ramp-channel 0 1)
+ (if (not (string=? (safe-display-edits ind 0 4 #f) (string-append "
(ptree[1] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[0][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";ramp ptree2 zero: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0)))
- (snd-display ";ramp ptree2 zero: ~A" (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) (string-append "
+ (snd-display #__line__ ";ramp ptree2 zero: ~A" (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0)))
+ (snd-display #__line__ ";ramp ptree2 zero: ~A" (channel->vct)))
+ (ramp-channel 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 5 #f) (string-append "
(ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
(at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";ramp2 ptree2 zero: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ramp2 ptree2 zero: ~A" (channel->vct)))
- (undo 2)
- (xramp-channel 0 1 32)
- (if (not (string=? (safe-display-edits ind 0 4 #f) (string-append "
+ (snd-display #__line__ ";ramp2 ptree2 zero: ~A" (safe-display-edits ind 0 5 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ramp2 ptree2 zero: ~A" (channel->vct)))
+ (undo 2)
+ (xramp-channel 0 1 32)
+ (if (not (string=? (safe-display-edits ind 0 4 #f) (string-append "
(ptree[1] 0 11) ; ptree-channel [4:2]:
(at 0, cp->sounds[0][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 11, end_mark)
")))
- (snd-display ";xramp ptree2 zero: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.000)))
- (snd-display ";xramp ptree2 zero: ~A" (channel->vct)))
-
- (close-sound ind))
-
- ;; ptree3 + ramps
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (make-vct 11 4.0)))
- (snd-display ";ptree3 1: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 16)))
- (snd-display ";ptree3 2: ~A" (edit-tree)))
-
- (scale-channel 0.25)
- (if (not (vequal (channel->vct) (make-vct 11 1.0)))
- (snd-display ";ptree3 3: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.250 0.0 0.0 16)))
- (snd-display ";ptree3 4: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000)))
- (snd-display ";ptree3 5: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display ";ptree3 6: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ptree3 7: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display ";ptree3 8: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display ";ptree3 9: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display ";ptree3 10: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.008 0.026 0.062 0.130 0.240 0.410 0.656 1.000)))
- (snd-display ";ptree3 11: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display ";ptree3 12: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display ";ptree3 13: ~A" (edit-tree)))
-
- ;; ptree3-zero + ramps
- (revert-sound ind)
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-by 0.0)
-
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (make-vct 11 4.0)))
- (snd-display ";ptree3 14: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 18)))
- (snd-display ";ptree3 15: ~A" (edit-tree)))
-
- (scale-channel 0.25)
- (if (not (vequal (channel->vct) (make-vct 11 1.0)))
- (snd-display ";ptree3 16: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.250 0.0 0.0 18)))
- (snd-display ";ptree3 17: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000)))
- (snd-display ";ptree3 18: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display ";ptree3 19: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display ";ptree3 20: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display ";ptree3 21: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display ";ptree3 22: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display ";ptree3 23: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.008 0.026 0.062 0.130 0.240 0.410 0.656 1.000)))
- (snd-display ";ptree3 24: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display ";ptree3 25: ~A" (edit-tree)))
-
- (revert-sound ind)
-
- ;; ptree3 + various scalers
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-channel 0.5)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (scale-channel 2.0)
- (ptree-channel (lambda (y) (+ y 1.5)))
- (scale-channel 0.25)
- (ptree-channel (lambda (y) (+ y 1.0)))
- (scale-channel 0.1)
- (if (not (vequal (channel->vct) (vct 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188)))
- (snd-display ";ptree3 26: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.100000001490116 0.0 0.0 16)))
- (snd-display ";ptree3 27: ~A" (edit-tree)))
- (revert-sound ind)
-
- ;; ramps + ptree3
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.100 3.200 3.300 3.400 3.500 3.600 3.700 3.800 3.900 4.000)))
- (snd-display ";ptree3 28: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display ";ptree3 29: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.010 3.040 3.090 3.160 3.250 3.360 3.490 3.640 3.810 4.000)))
- (snd-display ";ptree3 30: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display ";ptree3 31: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.001 3.008 3.027 3.064 3.125 3.216 3.343 3.512 3.729 4.000)))
- (snd-display ";ptree3 32: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display ";ptree3 33: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.000 3.002 3.008 3.026 3.062 3.130 3.240 3.410 3.656 4.000)))
- (snd-display ";ptree3 34: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display ";ptree3 35: ~A" (edit-tree)))
- (revert-sound ind)
-
-
- ;; xramps+ptree3 and vice-versa
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.115 0.260 0.442 0.672 0.961 1.325 1.783 2.360 3.086 4.000)))
- (snd-display ";ptree3 36: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 30)))
- (snd-display ";ptree3 37: ~A" (edit-tree)))
-
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.017 0.049 0.113 0.231 0.439 0.795 1.392 2.381 4.000)))
- (snd-display ";ptree3 38: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 30)))
- (snd-display ";ptree3 39: ~A" (edit-tree)))
-
- (undo)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.012 0.052 0.133 0.269 0.481 0.795 1.248 1.888 2.777 4.000)))
- (snd-display ";ptree3 40: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
- (snd-display ";ptree3 41: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.010 0.040 0.108 0.240 0.477 0.874 1.510 2.500 4.000)))
- (snd-display ";ptree3 42: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
- (snd-display ";ptree3 43: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.012 0.043 0.120 0.286 0.612 1.208 2.250 4.000)))
- (snd-display ";ptree3 44: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
- (snd-display ";ptree3 45: ~A" (edit-tree)))
-
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-channel 0.0)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.115 0.260 0.442 0.672 0.961 1.325 1.783 2.360 3.086 4.000)))
- (snd-display ";ptree3 46: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 32)))
- (snd-display ";ptree3 47: ~A" (edit-tree)))
-
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.017 0.049 0.113 0.231 0.439 0.795 1.392 2.381 4.000)))
- (snd-display ";ptree3 48: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 32)))
- (snd-display ";ptree3 49: ~A" (edit-tree)))
-
- (undo)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.012 0.052 0.133 0.269 0.481 0.795 1.248 1.888 2.777 4.000)))
- (snd-display ";ptree3 50: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
- (snd-display ";ptree3 51: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.010 0.040 0.108 0.240 0.477 0.874 1.510 2.500 4.000)))
- (snd-display ";ptree3 52: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
- (snd-display ";ptree3 53: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.012 0.043 0.120 0.286 0.612 1.208 2.250 4.000)))
- (snd-display ";ptree3 54: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
- (snd-display ";ptree3 55: ~A" (edit-tree)))
-
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.029 3.065 3.111 3.168 3.240 3.331 3.446 3.590 3.771 4.000)))
- (snd-display ";ptree3 56: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 22)))
- (snd-display ";ptree3 57: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.003 3.013 3.033 3.067 3.120 3.199 3.312 3.472 3.694 4.000)))
- (snd-display ";ptree3 58: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 24)))
- (snd-display ";ptree3 59: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.001 3.004 3.012 3.028 3.058 3.110 3.199 3.348 3.595 4.000)))
- (snd-display ";ptree3 60: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 22)))
- (snd-display ";ptree3 61: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.303 0.613 0.933 1.267 1.620 1.999 2.412 2.872 3.394 4.000)))
- (snd-display ";ptree3 62: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
- (snd-display ";ptree3 63: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.030 0.123 0.280 0.507 0.810 1.199 1.688 2.298 3.055 4.000)))
- (snd-display ";ptree3 64: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
- (snd-display ";ptree3 65: ~A" (edit-tree)))
- (revert-sound ind)
-
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.025 0.084 0.203 0.405 0.720 1.182 1.838 2.749 4.000)))
- (snd-display ";ptree3 66: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
- (snd-display ";ptree3 67: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ptree-channel (lambda (y) (* y 0.1)))
- (if (not (vequal (channel->vct) (make-vct 11 0.4)))
- (snd-display ";ptree4: ~A" (channel->vct)))
- (if (< (max-virtual-ptrees) 4)
- (if (not (feql (car (edit-tree)) (list 0 2 0 10 1.0 0.0 0.0 0)))
- (snd-display ";ptree4: ~A" (edit-tree)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 16)))
- (snd-display ";ptree4 (maxed): ~A" (edit-tree))))
-
- (close-sound ind))
- ) (snd-display ";skipping ptree cases")) ; end 'run cases?
+ (snd-display #__line__ ";xramp ptree2 zero: ~A" (safe-display-edits ind 0 4 #f)))
+ (if (not (vequal (channel->vct) (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.000)))
+ (snd-display #__line__ ";xramp ptree2 zero: ~A" (channel->vct)))
+
+ (close-sound ind))
+ ;; ptree3 + ramps
+ (let ((ind (new-sound "test.snd"))
+ (case1 #f)
+ (case2 #f))
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (make-vct 11 4.0)))
+ (snd-display #__line__ ";ptree3 1: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 16)))
+ (snd-display #__line__ ";ptree3 2: ~A" (edit-tree)))
+
+ (scale-channel 0.25)
+ (if (not (vequal (channel->vct) (make-vct 11 1.0)))
+ (snd-display #__line__ ";ptree3 3: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.250 0.0 0.0 16)))
+ (snd-display #__line__ ";ptree3 4: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000)))
+ (snd-display #__line__ ";ptree3 5: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
+ (snd-display #__line__ ";ptree3 6: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ptree3 7: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
+ (snd-display #__line__ ";ptree3 8: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
+ (snd-display #__line__ ";ptree3 9: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
+ (snd-display #__line__ ";ptree3 10: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.008 0.026 0.062 0.130 0.240 0.410 0.656 1.000)))
+ (snd-display #__line__ ";ptree3 11: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
+ (snd-display #__line__ ";ptree3 12: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
+ (snd-display #__line__ ";ptree3 13: ~A" (edit-tree)))
+
+ ;; ptree3-zero + ramps
+ (revert-sound ind)
+ (map-chan (lambda (y) 1.0) 0 10)
+ (scale-by 0.0)
+
+ (ptree-channel (lambda (y) (+ y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (make-vct 11 4.0)))
+ (snd-display #__line__ ";ptree3 14: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 18)))
+ (snd-display #__line__ ";ptree3 15: ~A" (edit-tree)))
+
+ (scale-channel 0.25)
+ (if (not (vequal (channel->vct) (make-vct 11 1.0)))
+ (snd-display #__line__ ";ptree3 16: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.250 0.0 0.0 18)))
+ (snd-display #__line__ ";ptree3 17: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000)))
+ (snd-display #__line__ ";ptree3 18: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
+ (snd-display #__line__ ";ptree3 19: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
+ (snd-display #__line__ ";ptree3 20: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
+ (snd-display #__line__ ";ptree3 21: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
+ (snd-display #__line__ ";ptree3 22: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
+ (snd-display #__line__ ";ptree3 23: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.008 0.026 0.062 0.130 0.240 0.410 0.656 1.000)))
+ (snd-display #__line__ ";ptree3 24: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
+ (snd-display #__line__ ";ptree3 25: ~A" (edit-tree)))
+
+ (revert-sound ind)
+
+ ;; ptree3 + various scalers
+ (map-chan (lambda (y) 1.0) 0 10)
+ (scale-channel 0.5)
+ (ptree-channel (lambda (y) (+ y 0.5)))
+ (scale-channel 2.0)
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (scale-channel 0.25)
+ (ptree-channel (lambda (y) (+ y 1.0)))
+ (scale-channel 0.1)
+ (if (not (vequal (channel->vct) (vct 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188)))
+ (snd-display #__line__ ";ptree3 26: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.100000001490116 0.0 0.0 16)))
+ (snd-display #__line__ ";ptree3 27: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ ;; ramps + ptree3
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (vct 3.000 3.100 3.200 3.300 3.400 3.500 3.600 3.700 3.800 3.900 4.000)))
+ (snd-display #__line__ ";ptree3 28: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
+ (snd-display #__line__ ";ptree3 29: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (vct 3.000 3.010 3.040 3.090 3.160 3.250 3.360 3.490 3.640 3.810 4.000)))
+ (snd-display #__line__ ";ptree3 30: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
+ (snd-display #__line__ ";ptree3 31: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (vct 3.000 3.001 3.008 3.027 3.064 3.125 3.216 3.343 3.512 3.729 4.000)))
+ (snd-display #__line__ ";ptree3 32: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
+ (snd-display #__line__ ";ptree3 33: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (vct 3.000 3.000 3.002 3.008 3.026 3.062 3.130 3.240 3.410 3.656 4.000)))
+ (snd-display #__line__ ";ptree3 34: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
+ (snd-display #__line__ ";ptree3 35: ~A" (edit-tree)))
+ (revert-sound ind)
+
+
+ ;; xramps+ptree3 and vice-versa
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (xramp-channel 0.0 1.0 10.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.115 0.260 0.442 0.672 0.961 1.325 1.783 2.360 3.086 4.000)))
+ (snd-display #__line__ ";ptree3 36: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 30)))
+ (snd-display #__line__ ";ptree3 37: ~A" (edit-tree)))
+
+ (xramp-channel 0.0 1.0 10.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.003 0.017 0.049 0.113 0.231 0.439 0.795 1.392 2.381 4.000)))
+ (snd-display #__line__ ";ptree3 38: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 30)))
+ (snd-display #__line__ ";ptree3 39: ~A" (edit-tree)))
+
+ (undo)
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.012 0.052 0.133 0.269 0.481 0.795 1.248 1.888 2.777 4.000)))
+ (snd-display #__line__ ";ptree3 40: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
+ (snd-display #__line__ ";ptree3 41: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.001 0.010 0.040 0.108 0.240 0.477 0.874 1.510 2.500 4.000)))
+ (snd-display #__line__ ";ptree3 42: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
+ (snd-display #__line__ ";ptree3 43: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.012 0.043 0.120 0.286 0.612 1.208 2.250 4.000)))
+ (snd-display #__line__ ";ptree3 44: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
+ (snd-display #__line__ ";ptree3 45: ~A" (edit-tree)))
+
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (scale-channel 0.0)
+ (ptree-channel (lambda (y) (+ y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (xramp-channel 0.0 1.0 10.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.115 0.260 0.442 0.672 0.961 1.325 1.783 2.360 3.086 4.000)))
+ (snd-display #__line__ ";ptree3 46: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 32)))
+ (snd-display #__line__ ";ptree3 47: ~A" (edit-tree)))
+
+ (xramp-channel 0.0 1.0 10.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.003 0.017 0.049 0.113 0.231 0.439 0.795 1.392 2.381 4.000)))
+ (snd-display #__line__ ";ptree3 48: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 32)))
+ (snd-display #__line__ ";ptree3 49: ~A" (edit-tree)))
+
+ (undo)
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.012 0.052 0.133 0.269 0.481 0.795 1.248 1.888 2.777 4.000)))
+ (snd-display #__line__ ";ptree3 50: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
+ (snd-display #__line__ ";ptree3 51: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.001 0.010 0.040 0.108 0.240 0.477 0.874 1.510 2.500 4.000)))
+ (snd-display #__line__ ";ptree3 52: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
+ (snd-display #__line__ ";ptree3 53: ~A" (edit-tree)))
+
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.012 0.043 0.120 0.286 0.612 1.208 2.250 4.000)))
+ (snd-display #__line__ ";ptree3 54: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
+ (snd-display #__line__ ";ptree3 55: ~A" (edit-tree)))
+
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 10.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (vct 3.000 3.029 3.065 3.111 3.168 3.240 3.331 3.446 3.590 3.771 4.000)))
+ (snd-display #__line__ ";ptree3 56: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 22)))
+ (snd-display #__line__ ";ptree3 57: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 10.0)
+ (ramp-channel 0.0 1.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (vct 3.000 3.003 3.013 3.033 3.067 3.120 3.199 3.312 3.472 3.694 4.000)))
+ (snd-display #__line__ ";ptree3 58: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 24)))
+ (snd-display #__line__ ";ptree3 59: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 10.0)
+ (xramp-channel 0.0 1.0 10.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (if (not (vequal (channel->vct) (vct 3.000 3.001 3.004 3.012 3.028 3.058 3.110 3.199 3.348 3.595 4.000)))
+ (snd-display #__line__ ";ptree3 60: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 22)))
+ (snd-display #__line__ ";ptree3 61: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 10.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.303 0.613 0.933 1.267 1.620 1.999 2.412 2.872 3.394 4.000)))
+ (snd-display #__line__ ";ptree3 62: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
+ (snd-display #__line__ ";ptree3 63: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 10.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.030 0.123 0.280 0.507 0.810 1.199 1.688 2.298 3.055 4.000)))
+ (snd-display #__line__ ";ptree3 64: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
+ (snd-display #__line__ ";ptree3 65: ~A" (edit-tree)))
+ (revert-sound ind)
+
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 10.0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (if (not (vequal (channel->vct) (vct 0.000 0.003 0.025 0.084 0.203 0.405 0.720 1.182 1.838 2.749 4.000)))
+ (snd-display #__line__ ";ptree3 66: ~A" (channel->vct)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
+ (snd-display #__line__ ";ptree3 67: ~A" (edit-tree)))
+ (revert-sound ind)
+
+ (map-chan (lambda (y) 1.0) 0 10)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ptree-channel (lambda (y) (+ y 1.5)))
+ (ptree-channel (lambda (y) (* y 2.0)))
+ (ptree-channel (lambda (y) (* y 0.1)))
+ (if (not (vequal (channel->vct) (make-vct 11 0.4)))
+ (snd-display #__line__ ";ptree4: ~A" (channel->vct)))
+ (if (< (max-virtual-ptrees) 4)
+ (if (not (feql (car (edit-tree)) (list 0 2 0 10 1.0 0.0 0.0 0)))
+ (snd-display #__line__ ";ptree4: ~A" (edit-tree)))
+ (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 16)))
+ (snd-display #__line__ ";ptree4 (maxed): ~A" (edit-tree))))
+
+ (close-sound ind))
(let ((old-pmax (max-virtual-ptrees)))
@@ -8389,7 +8469,7 @@ EDITS: 5
pdata)
ramp-to-1)))
(if (not (vequal rpr nrpr))
- (snd-display ";simple rpr:~%; ~A~%; ~A" rpr nrpr))))
+ (snd-display #__line__ ";simple rpr:~%; ~A~%; ~A" rpr nrpr))))
(set! (edit-position) 1)
(scale-by 3.0)
@@ -8412,7 +8492,7 @@ EDITS: 5
ramp-to-1)
-1.234)))
(if (not (vequal rpr nrpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * rpr:~%; ~A~%; ~A" rpr nrpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * rpr:~%; ~A~%; ~A" rpr nrpr))))
;; -------- ramp-ptree-xramp --------
@@ -8428,7 +8508,7 @@ EDITS: 5
pdata)
ramp-to-1)))
(if (not (vequal rpr nrpr))
- (snd-display ";simple rpx:~%; ~A~%; ~A" rpr nrpr))))
+ (snd-display #__line__ ";simple rpx:~%; ~A~%; ~A" rpr nrpr))))
(set! (edit-position) 1)
(scale-by 3.0)
@@ -8451,7 +8531,7 @@ EDITS: 5
ramp-to-1)
-1.234)))
(if (not (vequal rpr nrpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * rpx:~%; ~A~%; ~A" rpr nrpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * rpx:~%; ~A~%; ~A" rpr nrpr))))
;; -------- ramp-ptree-xramp-ramp --------
@@ -8470,7 +8550,7 @@ EDITS: 5
pdata)
ramp-to-1)))
(if (not (vequal rpr nrpr))
- (snd-display ";simple rpxr:~%; ~A~%; ~A" rpr nrpr))))
+ (snd-display #__line__ ";simple rpxr:~%; ~A~%; ~A" rpr nrpr))))
(set! (edit-position) 1)
(env-channel '(0 0 1 1 2 1 3 0))
@@ -8496,7 +8576,7 @@ EDITS: 5
ramp-to-1)
-1.0)))
(if (not (vequal rpr nrpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * rpxr:~%; ~A~%; ~A" rpr nrpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * rpxr:~%; ~A~%; ~A" rpr nrpr))))
;; -------- xramp-ptree-ramp --------
@@ -8512,7 +8592,7 @@ EDITS: 5
pdata)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";simple xpr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";simple xpr:~%; ~A~%; ~A" xpr nxpr))))
(set! (edit-position) 1)
(scale-by 3.0)
@@ -8535,7 +8615,7 @@ EDITS: 5
xramp-to-1)
-1.234)))
(if (not (vequal xpr nxpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * xpr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xpr:~%; ~A~%; ~A" xpr nxpr))))
;; -------- xramp-ptree-xramp --------
@@ -8551,7 +8631,7 @@ EDITS: 5
pdata)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";simple xpx:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";simple xpx:~%; ~A~%; ~A" xpr nxpr))))
(set! (edit-position) 1)
(scale-by 3.0)
@@ -8574,7 +8654,7 @@ EDITS: 5
xramp-to-1)
-1.234)))
(if (not (vequal xpr nxpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * xpx:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xpx:~%; ~A~%; ~A" xpr nxpr))))
;; -------- xramp-ptree-xramp-ramp --------
@@ -8593,7 +8673,7 @@ EDITS: 5
pdata)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";simple xpxr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";simple xpxr:~%; ~A~%; ~A" xpr nxpr))))
(set! (edit-position) 1)
(env-channel '(0 0 1 1 2 1 3 0))
@@ -8619,7 +8699,7 @@ EDITS: 5
xramp-to-1)
-1.234)))
(if (not (vequal xpr nxpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * xpxr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xpxr:~%; ~A~%; ~A" xpr nxpr))))
;; -------- xramp-ramp-ptree-ramp --------
@@ -8638,7 +8718,7 @@ EDITS: 5
ramp-to-1)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";simple xrpr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";simple xrpr:~%; ~A~%; ~A" xpr nxpr))))
(set! (edit-position) 1)
(scale-by 3.0)
@@ -8664,7 +8744,7 @@ EDITS: 5
-1.234)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * xrpr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xrpr:~%; ~A~%; ~A" xpr nxpr))))
;; -------- xramp-ramp-ptree-xramp --------
@@ -8682,7 +8762,7 @@ EDITS: 5
ramp-to-1)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";simple xrpx:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";simple xrpx:~%; ~A~%; ~A" xpr nxpr))))
(set! (edit-position) 1)
(scale-by 3.0)
@@ -8708,7 +8788,7 @@ EDITS: 5
-1.234)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * xrpx:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xrpx:~%; ~A~%; ~A" xpr nxpr))))
@@ -8729,7 +8809,7 @@ EDITS: 5
ramp-to-1)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";simple xrpxr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";simple xrpxr:~%; ~A~%; ~A" xpr nxpr))))
(set! (edit-position) 1)
(scale-by 3.0)
@@ -8756,7 +8836,7 @@ EDITS: 5
-1.234)
xramp-to-1)))
(if (not (vequal xpr nxpr))
- (snd-display ";3.0 1.25 -0.8 -1.234 * xrpxr:~%; ~A~%; ~A" xpr nxpr))))
+ (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xrpxr:~%; ~A~%; ~A" xpr nxpr))))
(close-sound ind)))))
(set! (max-virtual-ptrees) old-pmax))
@@ -8819,9 +8899,9 @@ EDITS: 5
;; 0 case
(set-to-1)
(if (not (vvequal data (channel->vct)))
- (snd-display ";0 case! ~A" (channel->vct)))
+ (snd-display #__line__ ";0 case! ~A" (channel->vct)))
(if (not (vvequal data (rev-channel->vct)))
- (snd-display ";0 case rev! ~A" (rev-channel->vct)))
+ (snd-display #__line__ ";0 case rev! ~A" (rev-channel->vct)))
;; 1 case
(for-each
@@ -8832,9 +8912,9 @@ EDITS: 5
(func)
(check data)
(if (not (vvequal data (channel->vct)))
- (snd-display ";1 case: ~A ~A" (procedure-name func) (channel->vct)))
+ (snd-display #__line__ ";1 case: ~A ~A" (procedure-name func) (channel->vct)))
(if (not (vvequal data (rev-channel->vct)))
- (snd-display ";1 rev case: ~A ~A" (procedure-name func) (rev-channel->vct))))
+ (snd-display #__line__ ";1 rev case: ~A ~A" (procedure-name func) (rev-channel->vct))))
(list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
(list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen))
@@ -8851,9 +8931,9 @@ EDITS: 5
(func1)
(check1 data)
(if (not (vvequal data (channel->vct)))
- (snd-display ";2 case: ~A(~A): ~A" (procedure-name func1) (procedure-name func) (channel->vct)))
+ (snd-display #__line__ ";2 case: ~A(~A): ~A" (procedure-name func1) (procedure-name func) (channel->vct)))
(if (not (vvequal data (rev-channel->vct)))
- (snd-display ";2 rev case: ~A(~A): ~A" (procedure-name func1) (procedure-name func) (rev-channel->vct))))
+ (snd-display #__line__ ";2 rev case: ~A(~A): ~A" (procedure-name func1) (procedure-name func) (rev-channel->vct))))
(list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
(list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
(list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
@@ -8878,11 +8958,11 @@ EDITS: 5
(func2)
(check2 data)
(if (not (vvequal data (channel->vct)))
- (snd-display ";3 case: ~A(~A(~A)): off by ~A~%; calc: ~A~%; chan: ~A"
+ (snd-display #__line__ ";3 case: ~A(~A(~A)): off by ~A~%; calc: ~A~%; chan: ~A"
(procedure-name func2) (procedure-name func1) (procedure-name func)
(vmaxdiff data (channel->vct)) data (channel->vct)))
(if (not (vvequal data (rev-channel->vct)))
- (snd-display ";3 rev case: ~A(~A(~A)) off by ~A:~%; calc: ~A~%; chan: ~A"
+ (snd-display #__line__ ";3 rev case: ~A(~A(~A)) off by ~A:~%; calc: ~A~%; chan: ~A"
(procedure-name func2) (procedure-name func1) (procedure-name func)
(vmaxdiff data (rev-channel->vct)) data (rev-channel->vct))))
(list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
@@ -8915,11 +8995,11 @@ EDITS: 5
(func3)
(check3 data)
(if (not (vvequal data (channel->vct)))
- (snd-display ";4 case: ~A(~A(~A(~A))): ~A"
+ (snd-display #__line__ ";4 case: ~A(~A(~A(~A))): ~A"
(procedure-name func3) (procedure-name func2) (procedure-name func1) (procedure-name func)
(channel->vct)))
(if (not (vvequal data (rev-channel->vct)))
- (snd-display ";4 rev case: ~A(~A(~A(~A))): ~A"
+ (snd-display #__line__ ";4 rev case: ~A(~A(~A(~A))): ~A"
(procedure-name func3) (procedure-name func2) (procedure-name func1) (procedure-name func)
(rev-channel->vct))))
(list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
@@ -8956,7 +9036,7 @@ EDITS: 5
(func4)
(check4 data)
(if (not (vvequal data (channel->vct)))
- (snd-display ";5 case: ~A(~A(~A(~A(~A)))): ~A"
+ (snd-display #__line__ ";5 case: ~A(~A(~A(~A(~A)))): ~A"
(procedure-name func4) (procedure-name func3) (procedure-name func2)
(procedure-name func1) (procedure-name func)
(channel->vct))))
@@ -9000,7 +9080,7 @@ EDITS: 5
(func5)
(check5 data)
(if (not (vvequal data (channel->vct)))
- (snd-display ";6 case: ~A(~A(~A(~A(~A(~A))))): ~A"
+ (snd-display #__line__ ";6 case: ~A(~A(~A(~A(~A(~A))))): ~A"
(procedure-name func5) (procedure-name func4) (procedure-name func3)
(procedure-name func2) (procedure-name func1) (procedure-name func)
(channel->vct))))
@@ -9022,34 +9102,34 @@ EDITS: 5
(set! (optimization) old-opt-val)
(let ((ind (open-sound "oboe.snd")))
- (if (not (= (redo 1 ind 0) 0)) (snd-display ";open redo with no ops: ~A" (redo)))
- (if (not (= (undo 1 ind 0) 0)) (snd-display ";open undo with no ops: ~A" (undo)))
+ (if (not (= (redo 1 ind 0) 0)) (snd-display #__line__ ";open redo with no ops: ~A" (redo)))
+ (if (not (= (undo 1 ind 0) 0)) (snd-display #__line__ ";open undo with no ops: ~A" (undo)))
(set! (cursor) 1000)
(delete-sample 321)
- (if (not (= (cursor) 999)) (snd-display ";delete-sample before cursor: ~A" (cursor)))
- (if (not (= (cursor ind 0 0) 1000)) (snd-display ";delete-sample before cursor (0): ~A" (cursor ind 0 0)))
+ (if (not (= (cursor) 999)) (snd-display #__line__ ";delete-sample before cursor: ~A" (cursor)))
+ (if (not (= (cursor ind 0 0) 1000)) (snd-display #__line__ ";delete-sample before cursor (0): ~A" (cursor ind 0 0)))
(undo)
- (if (not (= (cursor) 1000)) (snd-display ";delete-sample after cursor undo: ~A" (cursor)))
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-sample after cursor undo: ~A" (cursor)))
(undo -1)
- (if (not (= (cursor) 999)) (snd-display ";delete-sample before cursor redo: ~A" (cursor)))
+ (if (not (= (cursor) 999)) (snd-display #__line__ ";delete-sample before cursor redo: ~A" (cursor)))
(redo -1)
(delete-sample 1321)
- (if (not (= (cursor) 1000)) (snd-display ";delete-sample after cursor: ~A" (cursor)))
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-sample after cursor: ~A" (cursor)))
(undo)
(delete-samples 0 100)
- (if (not (= (cursor) 900)) (snd-display ";delete-samples before cursor: ~A" (cursor)))
+ (if (not (= (cursor) 900)) (snd-display #__line__ ";delete-samples before cursor: ~A" (cursor)))
(undo)
(delete-samples 1100 100)
- (if (not (= (cursor) 1000)) (snd-display ";delete-samples after cursor: ~A" (cursor)))
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-samples after cursor: ~A" (cursor)))
(undo)
(insert-samples 100 100 (make-vct 100))
- (if (not (= (cursor) 1100)) (snd-display ";insert-samples before cursor: ~A" (cursor)))
+ (if (not (= (cursor) 1100)) (snd-display #__line__ ";insert-samples before cursor: ~A" (cursor)))
(undo)
(insert-samples 1100 100 (make-vct 100))
- (if (not (= (cursor) 1000)) (snd-display ";insert-samples after cursor: ~A" (cursor)))
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";insert-samples after cursor: ~A" (cursor)))
(undo)
(set! (samples 0 100) (make-vct 100))
- (if (not (= (cursor) 1000)) (snd-display ";set-samples cursor: ~A" (cursor)))
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";set-samples cursor: ~A" (cursor)))
(set! (show-axes ind 0) show-x-axis-unlabelled)
(update-time-graph)
(set! (show-axes ind 0) show-all-axes-unlabelled)
@@ -9059,24 +9139,24 @@ EDITS: 5
(let ((ind (new-sound "test.snd" :size 100)))
(vct->channel (make-vct 3 1.0) 10 8)
(if (fneq (maxamp ind 0) 1.0)
- (snd-display ";vct->channel size mismatch maxamp: ~A" (maxamp ind 0)))
+ (snd-display #__line__ ";vct->channel size mismatch maxamp: ~A" (maxamp ind 0)))
(if (not (vequal (channel->vct 0 20 ind 0)
(vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (snd-display ";vct->channel size mismatch: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";vct->channel size mismatch: ~A" (channel->vct 0 20 ind 0)))
(revert-sound ind)
(set! (samples 10 5) (make-vct 3 1.0))
(if (fneq (maxamp ind 0) 1.0)
- (snd-display ";set samples size mismatch maxamp: ~A" (maxamp ind 0)))
+ (snd-display #__line__ ";set samples size mismatch maxamp: ~A" (maxamp ind 0)))
(if (not (vequal (channel->vct 0 20 ind 0)
(vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (snd-display ";set samples size mismatch: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";set samples size mismatch: ~A" (channel->vct 0 20 ind 0)))
(revert-sound ind)
(insert-samples 10 8 (make-vct 3 1.0) ind 0)
(if (fneq (maxamp ind 0) 1.0)
- (snd-display ";insert samples size mismatch maxamp: ~A" (maxamp ind 0)))
+ (snd-display #__line__ ";insert samples size mismatch maxamp: ~A" (maxamp ind 0)))
(if (not (vequal (channel->vct 0 20 ind 0)
(vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (snd-display ";insert samples size mismatch: ~A" (channel->vct 0 20 ind 0)))
+ (snd-display #__line__ ";insert samples size mismatch: ~A" (channel->vct 0 20 ind 0)))
(close-sound ind))
(let* ((index (open-sound "oboe.snd"))
@@ -9086,21 +9166,21 @@ EDITS: 5
(xz (x-zoom-slider))
(yz (y-zoom-slider)))
(if (not (string=? (snd-completion " open-so") " open-sound"))
- (snd-display ";completion: ~A" (snd-completion " open-so")))
-; (if (not (string=? (snd-completion " open-sound") " open-sound"))
-; (snd-display ";completion: ~A" (snd-completion " open-so")))
+ (snd-display #__line__ ";completion: ~A" (snd-completion " open-so")))
+ ; (if (not (string=? (snd-completion " open-sound") " open-sound"))
+ ; (snd-display #__line__ ";completion: ~A" (snd-completion " open-so")))
(if (not (string=? (snd-completion " zoom-focus-r") " zoom-focus-right"))
- (snd-display ";completion: ~A" (snd-completion " zoom-focus-r")))
- (play-and-wait "oboe.snd")
- (play-and-wait "oboe.snd" 12000)
- (play-and-wait "oboe.snd" 12000 15000)
- (play-and-wait 0 #f #f #f #f (- (edit-position) 1))
+ (snd-display #__line__ ";completion: ~A" (snd-completion " zoom-focus-r")))
+ (play "oboe.snd" :wait #t)
+ (play "oboe.snd" :start 12000 :wait #t)
+ (play "oboe.snd" :start 12000 :end 15000 :wait #t)
+ (play :edit-position (- (edit-position) 1) :wait #t)
(let ((old-speed (speed-control index))
(old-style (speed-control-style))
(old-open (show-controls index)))
(set! (show-controls index) #t)
(set! (speed-control index) -2.0)
- (play-and-wait 12345 index)
+ (play index :start 12345 :wait #t)
(set! (speed-control-style) speed-control-as-semitone)
(set! (speed-control index) 0.5)
(set! (speed-control-style) speed-control-as-ratio)
@@ -9112,47 +9192,47 @@ EDITS: 5
(let ((k (disk-kspace "oboe.snd")))
(if (or (not (number? k))
(<= k 0))
- (snd-display ";disk-kspace = ~A" (disk-kspace "oboe.snd")))
+ (snd-display #__line__ ";disk-kspace = ~A" (disk-kspace "oboe.snd")))
(set! k (disk-kspace "/baddy/hiho"))
(if (not (= k -1))
- (snd-display ";disk-kspace of bogus file = ~A" (disk-kspace "/baddy/hiho"))))
- (if (not (= (transform-frames) 0)) (snd-display ";transform-frames ~A?" (transform-frames)))
+ (snd-display #__line__ ";disk-kspace of bogus file = ~A" (disk-kspace "/baddy/hiho"))))
+ (if (not (= (transform-frames) 0)) (snd-display #__line__ ";transform-frames ~A?" (transform-frames)))
(set! (transform-size) 512)
(set! (transform-graph?) #t)
(let ((pk (fft-peak index 0 1.0)))
- (if (not pk) (snd-display ";fft-peak? ")))
+ (if (not pk) (snd-display #__line__ ";fft-peak? ")))
(set! (time-graph?) #t)
-
+
(catch #t
(lambda ()
- (if (not (string=? (x-axis-label) "time")) (snd-display ";def time x-axis-label: ~A" (x-axis-label)))
+ (if (not (string=? (x-axis-label) "time")) (snd-display #__line__ ";def time x-axis-label: ~A" (x-axis-label)))
(set! (x-axis-label index 0 time-graph) "no time")
- (if (not (string=? (x-axis-label) "no time")) (snd-display ";time x-axis-label: ~A" (x-axis-label index 0 time-graph)))
+ (if (not (string=? (x-axis-label) "no time")) (snd-display #__line__ ";time x-axis-label: ~A" (x-axis-label index 0 time-graph)))
(update-transform-graph)
- (if (not (string=? (x-axis-label index 0 transform-graph) "frequency")) (snd-display ";get fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (if (not (string=? (x-axis-label index 0 transform-graph) "frequency")) (snd-display #__line__ ";get fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
(set! (x-axis-label index 0 transform-graph) "hiho")
(update-transform-graph)
- (if (not (string=? (x-axis-label index 0 transform-graph) "hiho")) (snd-display ";set set fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (if (not (string=? (x-axis-label index 0 transform-graph) "hiho")) (snd-display #__line__ ";set set fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
(set! (x-axis-label index 0 transform-graph) "frequency") ; for later test
(graph '(0 0 1 1 2 0) "lisp")
(update-lisp-graph)
- (if (not (string=? (x-axis-label index 0 lisp-graph) "lisp")) (snd-display ";def lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
+ (if (not (string=? (x-axis-label index 0 lisp-graph) "lisp")) (snd-display #__line__ ";def lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
(set! (x-axis-label index 0 lisp-graph) "no lisp")
- (if (not (string=? (x-axis-label index 0 lisp-graph) "no lisp")) (snd-display ";lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
+ (if (not (string=? (x-axis-label index 0 lisp-graph) "no lisp")) (snd-display #__line__ ";lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
(set! (y-axis-label index 0 time-graph) "no amp")
- (if (not (string=? (y-axis-label) "no amp")) (snd-display ";time y-axis-label: ~A" (y-axis-label index 0 time-graph)))
+ (if (not (string=? (y-axis-label) "no amp")) (snd-display #__line__ ";time y-axis-label: ~A" (y-axis-label index 0 time-graph)))
(set! (y-axis-label index 0 lisp-graph) "no lamp")
- (if (not (string=? (y-axis-label index 0 lisp-graph) "no lamp")) (snd-display ";lisp y-axis-label: ~A" (y-axis-label index 0 lisp-graph)))
+ (if (not (string=? (y-axis-label index 0 lisp-graph) "no lamp")) (snd-display #__line__ ";lisp y-axis-label: ~A" (y-axis-label index 0 lisp-graph)))
(set! (y-axis-label) #f)
(set! (y-axis-label index 0) "no amp")
- (if (not (string=? (y-axis-label) "no amp")) (snd-display ";time y-axis-label (time): ~A" (y-axis-label index 0 time-graph)))
+ (if (not (string=? (y-axis-label) "no amp")) (snd-display #__line__ ";time y-axis-label (time): ~A" (y-axis-label index 0 time-graph)))
(set! (y-axis-label index) #f))
- (lambda args (snd-display ";axis label error: ~A" args)))
-
+ (lambda args (snd-display #__line__ ";axis label error: ~A" args)))
+
(graph-data (make-vct 4))
(update-lisp-graph)
(graph (vct 0 0 1 1 2 0))
@@ -9164,59 +9244,59 @@ EDITS: 5
(set! (x-bounds) (list 0.0 0.01))
(let ((data (make-graph-data)))
(if (vct? data)
- (let ((mid (inexact->exact (round (* .5 (vct-length data))))))
+ (let ((mid (round (* .5 (vct-length data)))))
(if (not (= (vct-length data) (+ 1 (- (right-sample) (left-sample)))))
- (snd-display ";make-graph-data bounds: ~A ~A -> ~A" (left-sample) (right-sample) (vct-length data)))
+ (snd-display #__line__ ";make-graph-data bounds: ~A ~A -> ~A" (left-sample) (right-sample) (vct-length data)))
(if (fneq (vct-ref data mid)
(sample (+ (left-sample) mid)))
- (snd-display ";make-graph-data[~D]: ~A ~A" mid (vct-ref data mid) (sample (+ (left-sample) mid)))))))
+ (snd-display #__line__ ";make-graph-data[~D]: ~A ~A" mid (vct-ref data mid) (sample (+ (left-sample) mid)))))))
(let ((data (make-graph-data index 0 0 100 199)))
(if (vct? data)
(begin
(if (not (= (vct-length data) 100))
- (snd-display ";make-graph-data 100:199: ~A" (vct-length data)))
+ (snd-display #__line__ ";make-graph-data 100:199: ~A" (vct-length data)))
(if (fneq (vct-ref data 50) (sample 50))
- (snd-display ";make-graph-data 50: ~A ~A" (vct-ref data 50) (sample 50))))))
+ (snd-display #__line__ ";make-graph-data 50: ~A ~A" (vct-ref data 50) (sample 50))))))
(set! (x-bounds) (list 0.0 0.1))
(update-transform-graph)
(catch 'no-such-axis
(lambda ()
(if (not (string=? (x-axis-label index 0 transform-graph) "frequency"))
- (snd-display ";def fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (snd-display #__line__ ";def fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
(set! (x-axis-label index 0 transform-graph) "fourier")
(if (not (string=? (x-axis-label index 0 transform-graph) "fourier"))
- (snd-display ";fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (snd-display #__line__ ";fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
(set! (x-axis-label) "hiho")
(set! (y-axis-label index 0 transform-graph) "spectra")
(let ((val (y-axis-label index 0 transform-graph)))
(if (or (not (string? val))
(not (string=? val "spectra")))
- (snd-display ";fft y-axis-label: ~A" val)))
+ (snd-display #__line__ ";fft y-axis-label: ~A" val)))
(set! (y-axis-label) "hiho"))
- (lambda args (snd-display ";transform axis not displayed?")))
+ (lambda args (snd-display #__line__ ";transform axis not displayed?")))
(if (and (number? (transform-frames))
(= (transform-frames) 0))
- (snd-display ";transform-graph? transform-frames ~A?" (transform-frames)))
+ (snd-display #__line__ ";transform-graph? transform-frames ~A?" (transform-frames)))
(update-transform-graph)
(let ((tag (catch #t (lambda () (peaks "/baddy/hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'cant-open-file)) (snd-display ";peaks bad file: ~A" tag)))
+ (if (not (eq? tag 'cant-open-file)) (snd-display #__line__ ";peaks bad file: ~A" tag)))
(peaks "tmp.peaks")
(if (defined? 'read-line)
(let ((p (open-input-file "tmp.peaks")))
(if (not p)
- (snd-display ";peaks->tmp.peaks failed?")
+ (snd-display #__line__ ";peaks->tmp.peaks failed?")
(let ((line (read-line p)))
(if (or (not (string? line))
(not (string=? "Snd: fft peaks" (substring line 0 14))))
- (snd-display ";peaks 1: ~A?" line))
+ (snd-display #__line__ ";peaks 1: ~A?" line))
(set! line (read-line p))
(set! line (read-line p))
(if (or (not (string? line))
(and (not (string=? "oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2" line))
(not (string=? (string-append "oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2" (string #\newline)) line))))
- (snd-display ";peaks 2: ~A?" line))
+ (snd-display #__line__ ";peaks 2: ~A?" line))
(set! line (read-line p))
(set! line (read-line p))
(close-input-port p)))))
@@ -9225,7 +9305,7 @@ EDITS: 5
(if (and (provided? 'xm)
(or (not (list-ref (dialog-widgets) 20))
(not (XtIsManaged (list-ref (dialog-widgets) 20)))))
- (snd-display ";peaks but no help?"))
+ (snd-display #__line__ ";peaks but no help?"))
(dismiss-all-dialogs)
(let* ((num-transforms 6)
(num-transform-graph-types 3))
@@ -9234,24 +9314,24 @@ EDITS: 5
(do ((i 0 (+ 1 i)))
((= i num-transforms))
(set! (transform-type) (integer->transform i))
- (if (not (transform? (integer->transform i))) (snd-display ";transform? ~A?" i))
+ (if (not (transform? (integer->transform i))) (snd-display #__line__ ";transform? ~A?" i))
(do ((j 0 (+ 1 j)))
((= j num-transform-graph-types))
(set! (transform-graph-type index 0) j)
(update-transform-graph index 0))))
(set! (transform-type) fourier-transform)
- (if (not (transform? (transform-type))) (snd-display ";transform? ~A ~A?" (transform-type) fourier-transform))
- (if (not (transform? autocorrelation)) (snd-display ";transform? autocorrelation"))
+ (if (not (transform? (transform-type))) (snd-display #__line__ ";transform? ~A ~A?" (transform-type) fourier-transform))
+ (if (not (transform? autocorrelation)) (snd-display #__line__ ";transform? autocorrelation"))
- (if (read-only index) (snd-display ";read-only open-sound: ~A?" (read-only index)))
+ (if (read-only index) (snd-display #__line__ ";read-only open-sound: ~A?" (read-only index)))
(set! (read-only index) #t)
- (if (not (read-only index)) (snd-display ";set-read-only: ~A?" (read-only index)))
+ (if (not (read-only index)) (snd-display #__line__ ";set-read-only: ~A?" (read-only index)))
(bind-key #\a 0 (lambda () (set! a-ctr 3)))
(key (char->integer #\a) 0)
- (if (not (= a-ctr 3)) (snd-display ";bind-key: ~A?" a-ctr))
+ (if (not (= a-ctr 3)) (snd-display #__line__ ";bind-key: ~A?" a-ctr))
(let ((str (with-output-to-string (lambda () (display (procedure-source (key-binding (char->integer #\a) 0)))))))
(if (not (string=? str "(lambda () (set! a-ctr 3))"))
- (snd-display ";key-binding: ~A?" str)))
+ (snd-display #__line__ ";key-binding: ~A?" str)))
(unbind-key (char->integer #\a) 0)
(set! a-ctr 0)
(key (char->integer #\a) 0)
@@ -9264,186 +9344,186 @@ EDITS: 5
(set! (graph-style) i)
(graph->ps)
(if (not (file-exists? psf))
- (snd-display ";graph->ps: ~A?" psf)
+ (snd-display #__line__ ";graph->ps: ~A?" psf)
(delete-file psf))))))
(let ((err (catch 'cannot-print
(lambda ()
(graph->ps "/bad/bad.eps"))
(lambda args 12345))))
- (if (not (= err 12345)) (snd-display ";graph->ps err: ~A?" err)))
+ (if (not (= err 12345)) (snd-display #__line__ ";graph->ps err: ~A?" err)))
(let ((n2 (or (open-sound "2.snd") (open-sound "4.aiff"))))
(set! (transform-graph? n2) #t)
(set! (channel-style n2) channels-superimposed)
- (if (not (= (channel-style n2) channels-superimposed)) (snd-display ";channel-style->~D: ~A?" channels-superimposed (channel-style n2)))
+ (if (not (= (channel-style n2) channels-superimposed)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-superimposed (channel-style n2)))
(graph->ps "aaa.eps")
(set! (channel-style n2) channels-combined)
- (if (not (= (channel-style n2) channels-combined)) (snd-display ";channel-style->~D: ~A?" channels-combined (channel-style n2)))
+ (if (not (= (channel-style n2) channels-combined)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-combined (channel-style n2)))
(graph->ps "aaa.eps")
(set! (channel-style n2) channels-separate)
- (if (not (= (channel-style n2) channels-separate)) (snd-display ";channel-style->~D: ~A?" channels-separate (channel-style n2)))
+ (if (not (= (channel-style n2) channels-separate)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-separate (channel-style n2)))
(graph->ps "aaa.eps")
(close-sound n2))
(if (= (channels index) 1)
(begin
(set! (channel-style index) channels-superimposed)
- (if (not (= (channel-style index) channels-separate)) (snd-display ";channel-style[0]->~D: ~A?" channels-separate (channel-style index)))))
+ (if (not (= (channel-style index) channels-separate)) (snd-display #__line__ ";channel-style[0]->~D: ~A?" channels-separate (channel-style index)))))
(set! (sync index) 32)
- (if (not (= (sync index) 32)) (snd-display ";sync->32: ~A?" (sync index)))
- (if (not (>= (sync-max) 32)) (snd-display ";sync-max 32: ~A" (sync-max)))
+ (if (not (= (sync index) 32)) (snd-display #__line__ ";sync->32: ~A?" (sync index)))
+ (if (not (>= (sync-max) 32)) (snd-display #__line__ ";sync-max 32: ~A" (sync-max)))
(set! (sync index) 0)
(set! (channel-sync index 0) 12)
- (if (not (= (channel-sync index 0) 12)) (snd-display ";sync-chn->12: ~A?" (channel-sync index 0)))
+ (if (not (= (channel-sync index 0) 12)) (snd-display #__line__ ";sync-chn->12: ~A?" (channel-sync index 0)))
(set! (channel-sync index 0) 0)
- (if (not (= a-ctr 0)) (snd-display ";unbind-key: ~A?" a-ctr))
- (if (fneq xp 0.0) (snd-display ";x-position-slider: ~A?" xp))
- (if (fneq yp 0.0) (snd-display ";y-position-slider: ~A?" yp))
- (if (and (fneq xz 0.04338) (fneq xz 1.0)) (snd-display ";x-zoom-slider: ~A?" xz))
- (if (fneq yz 1.0) (snd-display ";y-zoom-slider: ~A?" yz))
+ (if (not (= a-ctr 0)) (snd-display #__line__ ";unbind-key: ~A?" a-ctr))
+ (if (fneq xp 0.0) (snd-display #__line__ ";x-position-slider: ~A?" xp))
+ (if (fneq yp 0.0) (snd-display #__line__ ";y-position-slider: ~A?" yp))
+ (if (and (fneq xz 0.04338) (fneq xz 1.0)) (snd-display #__line__ ";x-zoom-slider: ~A?" xz))
+ (if (fneq yz 1.0) (snd-display #__line__ ";y-zoom-slider: ~A?" yz))
(if (and (or (fneq (car bnds) 0.0) (fneq (cadr bnds) 0.1))
(or (fneq (car bnds) 0.0) (fneq (cadr bnds) 2.305))) ; open-hook from ~/.snd*
- (snd-display ";x-bounds: ~A?" bnds))
- (if (not (equal? (find-sound "oboe.snd") index)) (snd-display ";oboe: index ~D /= ~D?" (find-sound "oboe.snd") index))
- (if (not (sound? index)) (snd-display ";oboe: ~D not ok?" index))
- (if (not (= (chans index) 1)) (snd-display ";oboe: chans ~D?" (chans index)))
- (if (not (= (channels index) 1)) (snd-display ";oboe: channels ~D?" (channels index)))
- (if (not (= (frames index) 50828)) (snd-display ";oboe: frames ~D?" (frames index)))
- (if (not (= (srate index) 22050)) (snd-display ";oboe: srate ~D?" (srate index)))
- (if (not (= (data-location index) 28)) (snd-display ";oboe: location ~D?" (data-location index)))
- (if (not (= (data-size index) (* 50828 2))) (snd-display ";oboe: size ~D?" (data-size index)))
- (if (not (= (data-format index) mus-bshort)) (snd-display ";oboe: format ~A?" (data-format index)))
- (if (fneq (maxamp index) .14724) (snd-display ";oboe: maxamp ~F?" (maxamp index)))
- (if (not (= (maxamp-position index) 24971)) (snd-display ";oboe: maxamp-position ~A?" (maxamp-position index)))
- (if (comment index) (snd-display ";oboe: comment ~A?" (comment index)))
- (if (not (= (string-length "asdf") 4)) (snd-display ";string-length: ~A?" (string-length "asdf")))
- (if (not (string=? (short-file-name index) "oboe.snd")) (snd-display ";oboe short name: ~S?" (short-file-name index)))
+ (snd-display #__line__ ";x-bounds: ~A?" bnds))
+ (if (not (equal? (find-sound "oboe.snd") index)) (snd-display #__line__ ";oboe: index ~D /= ~D?" (find-sound "oboe.snd") index))
+ (if (not (sound? index)) (snd-display #__line__ ";oboe: ~D not ok?" index))
+ (if (not (= (chans index) 1)) (snd-display #__line__ ";oboe: chans ~D?" (chans index)))
+ (if (not (= (channels index) 1)) (snd-display #__line__ ";oboe: channels ~D?" (channels index)))
+ (if (not (= (frames index) 50828)) (snd-display #__line__ ";oboe: frames ~D?" (frames index)))
+ (if (not (= (srate index) 22050)) (snd-display #__line__ ";oboe: srate ~D?" (srate index)))
+ (if (not (= (data-location index) 28)) (snd-display #__line__ ";oboe: location ~D?" (data-location index)))
+ (if (not (= (data-size index) (* 50828 2))) (snd-display #__line__ ";oboe: size ~D?" (data-size index)))
+ (if (not (= (data-format index) mus-bshort)) (snd-display #__line__ ";oboe: format ~A?" (data-format index)))
+ (if (fneq (maxamp index) .14724) (snd-display #__line__ ";oboe: maxamp ~F?" (maxamp index)))
+ (if (not (= (maxamp-position index) 24971)) (snd-display #__line__ ";oboe: maxamp-position ~A?" (maxamp-position index)))
+ (if (comment index) (snd-display #__line__ ";oboe: comment ~A?" (comment index)))
+ (if (not (= (string-length "asdf") 4)) (snd-display #__line__ ";string-length: ~A?" (string-length "asdf")))
+ (if (not (string=? (short-file-name index) "oboe.snd")) (snd-display #__line__ ";oboe short name: ~S?" (short-file-name index)))
(let ((matches (count-matches (lambda (a) (> a .125)))))
- (if (not (= matches 1313)) (snd-display ";count-matches: ~A?" matches)))
+ (if (not (= matches 1313)) (snd-display #__line__ ";count-matches: ~A?" matches)))
(let ((matches (count-matches (lambda (y) (let ((a (list .1 .2))) (> y (car a))))))) ; force xen not ptree
- (if (not (= matches 2851)) (snd-display ";unopt count-matches: ~A?" matches)))
+ (if (not (= matches 2851)) (snd-display #__line__ ";unopt count-matches: ~A?" matches)))
(let ((spot (find-channel (lambda (a) (> a .13)))))
- (if (or (null? spot) (not (= (cadr spot) 8862))) (snd-display ";find: ~A?" spot)))
+ (if (or (null? spot) (not (= (cadr spot) 8862))) (snd-display #__line__ ";find: ~A?" spot)))
(set! (right-sample) 3000)
(let ((samp (right-sample)))
- (if (> (abs (- samp 3000)) 1) (snd-display ";right-sample: ~A?" samp)))
+ (if (> (abs (- samp 3000)) 1) (snd-display #__line__ ";right-sample: ~A?" samp)))
(set! (left-sample) 1000)
(let ((samp (left-sample)))
- (if (> (abs (- samp 1000)) 1) (snd-display ";left-sample: ~A?" samp)))
+ (if (> (abs (- samp 1000)) 1) (snd-display #__line__ ";left-sample: ~A?" samp)))
(let ((eds (edits)))
(if (or (not (= (car eds) 0)) (not (= (cadr eds) 0)))
- (snd-display ";edits: ~A?" eds))
+ (snd-display #__line__ ";edits: ~A?" eds))
(if (not (= (edit-position) (car eds)))
- (snd-display ";edit-position: ~A ~A?" (edit-position) eds)))
- (play-and-wait 0 index 0)
+ (snd-display #__line__ ";edit-position: ~A ~A?" (edit-position) eds)))
+ (play index :channel 0 :wait #t)
(bomb index #f)
(if (not (selection-creates-region)) (set! (selection-creates-region) #t))
(select-all index 0)
(let ((r0 (car (regions)))
(sel (selection)))
- (if (not (selection?)) (snd-display ";selection?"))
- (if (not (selection? sel)) (snd-display ";selection? sel"))
- (if (not (region? r0)) (snd-display ";region?"))
- (if (not (= (selection-chans) 1)) (snd-display ";selection-chans(1): ~A" (selection-chans)))
- (if (not (= (channels sel) 1)) (snd-display ";generic selection-chans(1): ~A" (channels sel)))
- (if (not (= (selection-srate) (srate index))) (snd-display ";selection-srate: ~A ~A" (selection-srate) (srate index)))
- (if (not (= (srate sel) (srate index))) (snd-display ";generic selection-srate: ~A ~A" (srate sel) (srate index)))
- (if (fneq (region-maxamp r0) (maxamp index)) (snd-display ";region-maxamp (1): ~A?" (region-maxamp r0)))
+ (if (not (selection?)) (snd-display #__line__ ";selection?"))
+ (if (not (selection? sel)) (snd-display #__line__ ";selection? sel"))
+ (if (not (region? r0)) (snd-display #__line__ ";region?"))
+ (if (not (= (selection-chans) 1)) (snd-display #__line__ ";selection-chans(1): ~A" (selection-chans)))
+ (if (not (= (channels sel) 1)) (snd-display #__line__ ";generic selection-chans(1): ~A" (channels sel)))
+ (if (not (= (selection-srate) (srate index))) (snd-display #__line__ ";selection-srate: ~A ~A" (selection-srate) (srate index)))
+ (if (not (= (srate sel) (srate index))) (snd-display #__line__ ";generic selection-srate: ~A ~A" (srate sel) (srate index)))
+ (if (fneq (region-maxamp r0) (maxamp index)) (snd-display #__line__ ";region-maxamp (1): ~A?" (region-maxamp r0)))
(if (not (= (region-maxamp-position r0) (maxamp-position index)))
- (snd-display ";region-maxamp-position (1): ~A ~A?" (region-maxamp-position r0) (maxamp-position index)))
- (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display ";selection-maxamp (1): ~A?" (selection-maxamp index 0)))
- (if (fneq (maxamp sel index 0) (maxamp index)) (snd-display ";generic selection-maxamp (1): ~A?" (maxamp sel index 0)))
+ (snd-display #__line__ ";region-maxamp-position (1): ~A ~A?" (region-maxamp-position r0) (maxamp-position index)))
+ (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display #__line__ ";selection-maxamp (1): ~A?" (selection-maxamp index 0)))
+ (if (fneq (maxamp sel index 0) (maxamp index)) (snd-display #__line__ ";generic selection-maxamp (1): ~A?" (maxamp sel index 0)))
(if (not (= (selection-maxamp-position index 0) (maxamp-position index)))
- (snd-display ";selection-maxamp-position (1): ~A ~A?" (selection-maxamp-position index 0) (maxamp-position index)))
+ (snd-display #__line__ ";selection-maxamp-position (1): ~A ~A?" (selection-maxamp-position index 0) (maxamp-position index)))
(save-region r0 "temp.dat")
(if (file-exists? "temp.dat")
(delete-file "temp.dat")
- (snd-display ";save-region file disappeared?"))
- (play-region r0 #t) ;needs to be #t here or it never gets run
- (if (not (= (length (regions)) 1)) (snd-display ";regions: ~A?" (regions)))
- (if (not (selection-member? index)) (snd-display ";selection-member?: ~A" (selection-member? index)))
- (if (not (= (region-srate r0) 22050)) (snd-display ";region-srate: ~A?" (region-srate r0)))
- (if (not (= (region-chans r0) 1)) (snd-display ";region-chans: ~A?" (region-chans r0)))
- (if (not (equal? (region-home r0) (list "oboe.snd" 0 50827))) (snd-display ";region-home: ~A" (region-home r0)))
- (if (not (= (region-frames r0) 50828)) (snd-display ";region-frames: ~A?" (region-frames r0)))
- (if (not (= (selection-frames) 50828)) (snd-display ";selection-frames: ~A?" (selection-frames 0)))
- (if (not (= (frames sel) 50828)) (snd-display ";generic selection-frames: ~A?" (frames sel)))
- (if (not (= (length sel) 50828)) (snd-display ";generic length selection-frames: ~A?" (length sel)))
- (if (not (= (selection-position) 0)) (snd-display ";selection-position: ~A?" (selection-position)))
- (if (not (= (region-position r0 0) 0)) (snd-display ";region-position: ~A?" (region-position r0 0)))
- (if (fneq (region-maxamp r0) (maxamp index)) (snd-display ";region-maxamp: ~A?" (region-maxamp r0)))
- (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display ";selection-maxamp: ~A?" (selection-maxamp index 0)))
+ (snd-display #__line__ ";save-region file disappeared?"))
+ (play r0 :wait #t) ;needs to be #t here or it never gets run
+ (if (not (= (length (regions)) 1)) (snd-display #__line__ ";regions: ~A?" (regions)))
+ (if (not (selection-member? index)) (snd-display #__line__ ";selection-member?: ~A" (selection-member? index)))
+ (if (not (= (region-srate r0) 22050)) (snd-display #__line__ ";region-srate: ~A?" (region-srate r0)))
+ (if (not (= (region-chans r0) 1)) (snd-display #__line__ ";region-chans: ~A?" (region-chans r0)))
+ (if (not (equal? (region-home r0) (list "oboe.snd" 0 50827))) (snd-display #__line__ ";region-home: ~A" (region-home r0)))
+ (if (not (= (region-frames r0) 50828)) (snd-display #__line__ ";region-frames: ~A?" (region-frames r0)))
+ (if (not (= (selection-frames) 50828)) (snd-display #__line__ ";selection-frames: ~A?" (selection-frames 0)))
+ (if (not (= (frames sel) 50828)) (snd-display #__line__ ";generic selection-frames: ~A?" (frames sel)))
+ (if (not (= (length sel) 50828)) (snd-display #__line__ ";generic length selection-frames: ~A?" (length sel)))
+ (if (not (= (selection-position) 0)) (snd-display #__line__ ";selection-position: ~A?" (selection-position)))
+ (if (not (= (region-position r0 0) 0)) (snd-display #__line__ ";region-position: ~A?" (region-position r0 0)))
+ (if (fneq (region-maxamp r0) (maxamp index)) (snd-display #__line__ ";region-maxamp: ~A?" (region-maxamp r0)))
+ (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display #__line__ ";selection-maxamp: ~A?" (selection-maxamp index 0)))
(let ((samps1 (samples->vct 0 50827 index 0))
(samps2 (region->vct r0 0 50828 0))
(vr (make-sampler 0 index 0 1)))
- (if (not (sampler? vr)) (snd-display ";~A not sampler?" vr))
- (if (not (= (sampler-position vr) 0)) (snd-display ";initial sampler-position: ~A" (sampler-position vr)))
+ (if (not (sampler? vr)) (snd-display #__line__ ";~A not sampler?" vr))
+ (if (not (= (sampler-position vr) 0)) (snd-display #__line__ ";initial sampler-position: ~A" (sampler-position vr)))
(if (not (equal? (sampler-home vr) (list index 0)))
- (snd-display ";sampler-home: ~A ~A?" (sampler-home vr) (list index 0)))
- (if (sampler-at-end? vr) (snd-display ";~A init at end?" vr))
+ (snd-display #__line__ ";sampler-home: ~A ~A?" (sampler-home vr) (list index 0)))
+ (if (sampler-at-end? vr) (snd-display #__line__ ";~A init at end?" vr))
(let ((err (catch #t
(lambda ()
(region->vct r0 -1 1233))
(lambda args (car args)))))
- (if (not (eq? err 'no-such-sample)) (snd-display ";region->vct -1: ~A" err)))
+ (if (not (eq? err 'no-such-sample)) (snd-display #__line__ ";region->vct -1: ~A" err)))
(let ((err (catch #t
(lambda ()
(region->vct r0 12345678 1))
(lambda args (car args)))))
;; should this return 'no-such-sample?
- (if err (snd-display ";region->vct 12345678: ~A" err)))
+ (if err (snd-display #__line__ ";region->vct 12345678: ~A" err)))
(let ((reader-string (format #f "~A" vr)))
(if (not (string=? reader-string "#<sampler: oboe.snd[0: 0] from 0, at 0, forward>"))
- (snd-display ";sampler actually got: [~S]" reader-string)))
+ (snd-display #__line__ ";sampler actually got: [~S]" reader-string)))
(let ((evr vr))
- (if (not (equal? evr vr)) (snd-display ";sampler equal? ~A ~A" vr evr)))
+ (if (not (equal? evr vr)) (snd-display #__line__ ";sampler equal? ~A ~A" vr evr)))
(catch 'break
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 50827))
(if (not (= (if (odd? i) (next-sample vr) (read-sample vr)) (vct-ref samps1 i) (vct-ref samps2 i)))
(begin
- (snd-display ";readers disagree at ~D" i)
+ (snd-display #__line__ ";readers disagree at ~D" i)
(throw 'break)))))
(lambda args (car args)))
(free-sampler vr)))
(let ((var (catch #t (lambda () (make-sampler 0 index -1)) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";make-sampler bad chan (-1): ~A" var)))
+ (snd-display #__line__ ";make-sampler bad chan (-1): ~A" var)))
(let ((var (catch #t (lambda () (make-sampler 0 index 1)) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";make-sampler bad chan (1): ~A, ~A" var index)))
+ (snd-display #__line__ ";make-sampler bad chan (1): ~A, ~A" var index)))
(let ((fd (make-sampler 0)))
- (if (mix-sampler? fd) (snd-display ";sampler: mix ~A" fd))
- (if (region-sampler? fd) (snd-display ";sampler: region ~A" fd))
- (if (not (sampler? fd)) (snd-display ";sampler: normal ~A" fd))
- (if (not (= (sampler-position fd) 0)) (snd-display ";sampler: position: ~A" fd))
+ (if (mix-sampler? fd) (snd-display #__line__ ";sampler: mix ~A" fd))
+ (if (region-sampler? fd) (snd-display #__line__ ";sampler: region ~A" fd))
+ (if (not (sampler? fd)) (snd-display #__line__ ";sampler: normal ~A" fd))
+ (if (not (= (sampler-position fd) 0)) (snd-display #__line__ ";sampler: position: ~A" fd))
(free-sampler fd)
(let ((str (format #f "~A" fd)))
(if (not (string=? (my-substring str (- (string-length str) 16)) "at eof or freed>"))
- (snd-display ";freed sampler: ~A [~A]?" str (my-substring str (- (string-length str) 16))))))
+ (snd-display #__line__ ";freed sampler: ~A [~A]?" str (my-substring str (- (string-length str) 16))))))
(let* ((reg (car (regions)))
(chns (region-chans reg))
(var (catch #t (lambda () (make-region-sampler reg 0 (+ chns 1))) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";make-region-sampler bad chan (2): ~A ~A" var (regions)))
+ (snd-display #__line__ ";make-region-sampler bad chan (2): ~A ~A" var (regions)))
(let ((tag (catch #t (lambda () (make-region-sampler reg 0 0 -2)) (lambda args args))))
(if (not (eq? (car tag) 'no-such-direction))
- (snd-display ";make-region-sampler bad dir (-2): ~A" tag))))
+ (snd-display #__line__ ";make-region-sampler bad dir (-2): ~A" tag))))
(revert-sound index)
(insert-sample 100 .5 index)
(let ((var (catch #t (lambda () (insert-sound "oboe.snd" 0 1)) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";insert-sound bad chan (1): ~A" var)))
+ (snd-display #__line__ ";insert-sound bad chan (1): ~A" var)))
(let ((var (catch #t (lambda () (insert-sample -12 1.0)) (lambda args args))))
(if (not (eq? (car var) 'no-such-sample))
- (snd-display ";insert-sample bad pos: ~A" var)))
+ (snd-display #__line__ ";insert-sample bad pos: ~A" var)))
(set! (show-axes index 0) show-no-axes)
(update-transform-graph index)
(update-time-graph index)
(if (or (fneq (sample 100) .5)
(not (= (frames index) 50829)))
- (snd-display ";insert-sample: ~A ~A?" (sample 100) (frames index)))
+ (snd-display #__line__ ";insert-sample: ~A ~A?" (sample 100) (frames index)))
(let ((v0 (make-vector 3))
(v1 (make-vct 3)))
(vct-fill! v1 .75)
@@ -9453,92 +9533,92 @@ EDITS: 5
(if (or (fneq (sample 201) .25)
(fneq (sample 301) .75)
(not (= (frames index) 50835)))
- (snd-display ";insert-samples: ~A ~A ~A?" (sample 201) (sample 301) (frames index))))
+ (snd-display #__line__ ";insert-samples: ~A ~A ~A?" (sample 201) (sample 301) (frames index))))
(save-sound-as "hiho.snd" index mus-next mus-bshort :srate 22050)
(let ((nindex (view-sound "hiho.snd")))
(if (fneq (sample 101 nindex) (sample 101 index))
- (snd-display ";save-sound-as: ~A ~A?" (sample 101 nindex) (sample 101 index)))
- (if (not (read-only nindex)) (snd-display ";read-only view-sound: ~A?" (read-only nindex)))
+ (snd-display #__line__ ";save-sound-as: ~A ~A?" (sample 101 nindex) (sample 101 index)))
+ (if (not (read-only nindex)) (snd-display #__line__ ";read-only view-sound: ~A?" (read-only nindex)))
(set! (speed-control-style nindex) speed-control-as-semitone)
(if (not (= (speed-control-style nindex) speed-control-as-semitone))
- (snd-display ";speed-control-style set semi: ~A" (speed-control-style nindex)))
+ (snd-display #__line__ ";speed-control-style set semi: ~A" (speed-control-style nindex)))
(set! (speed-control-tones nindex) -8)
(if (not (= (speed-control-tones nindex) 12))
- (snd-display ";speed-control-tones -8: ~A" (speed-control-tones nindex)))
+ (snd-display #__line__ ";speed-control-tones -8: ~A" (speed-control-tones nindex)))
(set! (speed-control-tones nindex) 18)
(if (not (= (speed-control-tones nindex) 18))
- (snd-display ";speed-control-tones 18: ~A" (speed-control-tones nindex)))
+ (snd-display #__line__ ";speed-control-tones 18: ~A" (speed-control-tones nindex)))
(graph->ps "aaa.eps")
(close-sound nindex))
(revert-sound index)
(set! (sample 50 index) .5)
- (if (fneq (sample 50) .5) (snd-display ";set-sample: ~A?" (sample 50)))
+ (if (fneq (sample 50) .5) (snd-display #__line__ ";set-sample: ~A?" (sample 50)))
(let ((v0 (make-vector 3)))
(do ((i 0 (+ 1 i))) ((= i 3)) (vector-set! v0 i .25))
(set! (samples 60 3 index) v0)
(if (or (fneq (sample 60) .25) (fneq (sample 61) .25))
- (snd-display ";set-samples: ~A ~A ~A?" (sample 60) (sample 61) (sample 62))))
+ (snd-display #__line__ ";set-samples: ~A ~A ~A?" (sample 60) (sample 61) (sample 62))))
(set! (samples 10 3 index) (list 0.1 0.2 0.3))
(if (not (vequal (samples->vct 10 3 index) (vct 0.1 0.2 0.3)))
- (snd-display ";set-samples via list: ~A" (samples->vct 10 3 index)))
+ (snd-display #__line__ ";set-samples via list: ~A" (samples->vct 10 3 index)))
(revert-sound index)
(save-sound-as "temporary.snd" index)
(set! (samples 100000 20000 index) "temporary.snd")
(if (not (vequal (samples->vct 110000 10) (samples->vct 10000 10)))
- (snd-display ";set samples to self: ~A ~A" (samples->vct 110000 10) (samples->vct 10000 10)))
+ (snd-display #__line__ ";set samples to self: ~A ~A" (samples->vct 110000 10) (samples->vct 10000 10)))
(revert-sound index)
(delete-sample 100 index)
(if (not (file-exists? "temporary.snd"))
- (snd-display ";set-samples temp deleted?"))
+ (snd-display #__line__ ";set-samples temp deleted?"))
(delete-file "temporary.snd")
- (if (not (= (frames index) 50827)) (snd-display ";delete-sample: ~A?" (frames index)))
+ (if (not (= (frames index) 50827)) (snd-display #__line__ ";delete-sample: ~A?" (frames index)))
(delete-samples 0 100 index)
- (if (not (= (frames index) 50727)) (snd-display ";delete-samples: ~A?" (frames index)))
+ (if (not (= (frames index) 50727)) (snd-display #__line__ ";delete-samples: ~A?" (frames index)))
(revert-sound index)
(let ((maxa (maxamp index)))
(scale-to .5 index)
(let ((newmaxa (maxamp index)))
- (if (fneq newmaxa .5) (snd-display ";scale-to: ~A?" newmaxa))
+ (if (fneq newmaxa .5) (snd-display #__line__ ";scale-to: ~A?" newmaxa))
(undo 1 index)
(scale-by 2.0 index)
(set! newmaxa (maxamp index))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display ";scale-by: ~A?" newmaxa))
+ (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";scale-by: ~A?" newmaxa))
(revert-sound index)
(scale-by -1 index)
(mix "oboe.snd")
- (if (fneq (maxamp index 0) 0.0) (snd-display ";invert+mix->~A" (maxamp)))
+ (if (fneq (maxamp index 0) 0.0) (snd-display #__line__ ";invert+mix->~A" (maxamp)))
(revert-sound index)
(select-all index)
- (if (not (= (length (regions)) 2)) (snd-display ";regions(2): ~A?" (regions)))
+ (if (not (= (length (regions)) 2)) (snd-display #__line__ ";regions(2): ~A?" (regions)))
(scale-selection-to .5)
(set! newmaxa (maxamp index))
- (if (fneq newmaxa .5) (snd-display ";scale-selection-to: ~A?" newmaxa))
+ (if (fneq newmaxa .5) (snd-display #__line__ ";scale-selection-to: ~A?" newmaxa))
(revert-sound index)
(select-all index)
(scale-selection-by 2.0)
(set! newmaxa (maxamp index))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display ";scale-selection-by: ~A?" newmaxa))
+ (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";scale-selection-by: ~A?" newmaxa))
(revert-sound index)
(with-temporary-selection (lambda () (scale-selection-by 2.0)) 0 (frames) index 0)
(set! newmaxa (maxamp index))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display ";with-temporary-selection: ~A?" newmaxa))
+ (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";with-temporary-selection: ~A?" newmaxa))
(revert-sound index)
(let ((samp999 (sample 999 index 0))
(samp1001 (sample 1001 index 0)))
(with-temporary-selection (lambda () (scale-selection-to 2.0)) 1000 1 index 0)
- (if (fneq (sample 1000 index 0) 2.0) (snd-display ";with-temporary-selection 1000: ~A" (sample 1000 index 0)))
- (if (fneq (sample 999 index 0) samp999) (snd-display ";with-temporary-selection 999: ~A from ~A" (sample 999 index 0) samp999))
- (if (fneq (sample 1001 index 0) samp1001) (snd-display ";with-temporary-selection 1001: ~A from ~A" (sample 1001 index 0) samp1001)))
+ (if (fneq (sample 1000 index 0) 2.0) (snd-display #__line__ ";with-temporary-selection 1000: ~A" (sample 1000 index 0)))
+ (if (fneq (sample 999 index 0) samp999) (snd-display #__line__ ";with-temporary-selection 999: ~A from ~A" (sample 999 index 0) samp999))
+ (if (fneq (sample 1001 index 0) samp1001) (snd-display #__line__ ";with-temporary-selection 1001: ~A from ~A" (sample 1001 index 0) samp1001)))
(revert-sound index)
(make-selection 100 199 index 0)
(let ((old-start (selection-position index 0))
(old-len (selection-frames index 0)))
(with-temporary-selection (lambda () (scale-selection-to 2.0)) 1000 1 index 0)
- (if (not (selection?)) (snd-display ";with-temporary-selection restore?"))
- (if (not (selection-member? index 0)) (snd-display ";with-temporary-selection not member?"))
- (if (not (= (selection-position index 0) old-start)) (snd-display ";with-temporary-selection start: ~A" (selection-position index 0)))
- (if (not (= (selection-frames index 0) old-len)) (snd-display ";with-temporary-selection len: ~A" (selection-frames index 0))))
+ (if (not (selection?)) (snd-display #__line__ ";with-temporary-selection restore?"))
+ (if (not (selection-member? index 0)) (snd-display #__line__ ";with-temporary-selection not member?"))
+ (if (not (= (selection-position index 0) old-start)) (snd-display #__line__ ";with-temporary-selection start: ~A" (selection-position index 0)))
+ (if (not (= (selection-frames index 0) old-len)) (snd-display #__line__ ";with-temporary-selection len: ~A" (selection-frames index 0))))
(revert-sound index)
(select-all index)
(let ((rread (make-region-sampler (car (regions)) 0))
@@ -9546,20 +9626,20 @@ EDITS: 5
(rvect (region->vct (car (regions)) 0 100))
(svect (samples 0 100 index)))
(if (fneq (vct-ref rvect 1) (region-sample (car (regions)) 1))
- (snd-display ";region-sample: ~A ~A?" (region-sample (car (regions)) 1) (vct-ref rvect 1)))
+ (snd-display #__line__ ";region-sample: ~A ~A?" (region-sample (car (regions)) 1) (vct-ref rvect 1)))
(do ((i 0 (+ 1 i)))
((= i 100))
(let ((rval (next-sample rread))
(sval (next-sample sread)))
- (if (fneq rval sval) (snd-display ";sample-read: ~A ~A?" rval sval))
- (if (fneq rval (vct-ref rvect i)) (snd-display ";region-samples: ~A ~A?" rval (vct-ref rvect i)))
- (if (fneq sval (vct-ref svect i)) (snd-display ";samples: ~A ~A?" sval (vct-ref svect i)))))
+ (if (fneq rval sval) (snd-display #__line__ ";sample-read: ~A ~A?" rval sval))
+ (if (fneq rval (vct-ref rvect i)) (snd-display #__line__ ";region-samples: ~A ~A?" rval (vct-ref rvect i)))
+ (if (fneq sval (vct-ref svect i)) (snd-display #__line__ ";samples: ~A ~A?" sval (vct-ref svect i)))))
(free-sampler rread)
(let ((val0 (next-sample sread)))
- (if (sampler-at-end? sread) (snd-display ";premature end?"))
+ (if (sampler-at-end? sread) (snd-display #__line__ ";premature end?"))
(previous-sample sread)
(let ((val1 (previous-sample sread)))
- (if (fneq val0 val1) (snd-display ";previous-sample: ~A ~A?" val0 val1))))
+ (if (fneq val0 val1) (snd-display #__line__ ";previous-sample: ~A ~A?" val0 val1))))
(free-sampler sread))))
(revert-sound index)
(let ((s100 (sample 100))
@@ -9570,9 +9650,9 @@ EDITS: 5
(set! (cursor-size) 25)
(set! (cursor index) 50)
(if (not (= (cursor-style) cursor-line))
- (snd-display ";cursor-style: ~A? " (cursor-style)))
+ (snd-display #__line__ ";cursor-style: ~A? " (cursor-style)))
(if (not (= (cursor-size) 25))
- (snd-display ";cursor-size: ~A? " (cursor-size)))
+ (snd-display #__line__ ";cursor-size: ~A? " (cursor-size)))
(set! (cursor-style) cursor-cross)
(set! (cursor-size) 15)
(set! (cursor index 0) 30)
@@ -9585,103 +9665,103 @@ EDITS: 5
(let* ((point (cursor-position))
(x (car point))
(y (cadr point))
- (size (inexact->exact (floor (/ (cursor-size) 2)))))
+ (size (floor (/ (cursor-size) 2))))
(draw-line (- x size) (- y size) (+ x size) (+ y size) snd chn cursor-context)
(draw-line (- x size) (+ y size) (+ x size) (- y size) snd chn cursor-context))))
- (if (not (procedure? (cursor-style index 0))) (snd-display ";set cursor-style to proc: ~A" (cursor-style index 0)))))
+ (if (not (procedure? (cursor-style index 0))) (snd-display #__line__ ";set cursor-style to proc: ~A" (cursor-style index 0)))))
(set! (cursor index) 50)
(insert-sound "fyow.snd" (cursor) 0 index 0)
(if (or (fneq (sample 40) s40) (not (fneq (sample 100) s100)) (fneq (sample 100) 0.001831))
- (snd-display ";insert-sound: ~A?" (sample 100)))
- (if (not (= (frames) (+ len addlen))) (snd-display ";insert-sound len: ~A?" (frames)))
+ (snd-display #__line__ ";insert-sound: ~A?" (sample 100)))
+ (if (not (= (frames) (+ len addlen))) (snd-display #__line__ ";insert-sound len: ~A?" (frames)))
(save-sound-as "not-temporary.snd")
(insert-samples 0 100 "not-temporary.snd")
(set! (cursor index 0 0) (- (frames index 0 0) 2))
(revert-sound)
(if (not (= (cursor index 0) (- (frames index 0) 2)))
- (snd-display ";set edpos cursor: ~A ~A ~A" (cursor) (cursor index 0 0) (- (frames index 0 0) 2)))
+ (snd-display #__line__ ";set edpos cursor: ~A ~A ~A" (cursor) (cursor index 0 0) (- (frames index 0 0) 2)))
(if (not (file-exists? "not-temporary.snd"))
- (snd-display ";insert-samples deleted its file?")
+ (snd-display #__line__ ";insert-samples deleted its file?")
(delete-file "not-temporary.snd"))
(let ((id (make-region 0 99)))
(insert-region id 60 index)
- (if (not (= (frames) (+ len 100))) (snd-display ";insert-region len: ~A?" (frames)))
- (if (fneq (sample 100) s40) (snd-display ";insert-region: ~A ~A?" (sample 100) s40))
+ (if (not (= (frames) (+ len 100))) (snd-display #__line__ ";insert-region len: ~A?" (frames)))
+ (if (fneq (sample 100) s40) (snd-display #__line__ ";insert-region: ~A ~A?" (sample 100) s40))
(let ((var (catch #t (lambda () (insert-region (integer->region (+ 1000 (apply max (map region->integer (regions))))) 0)) (lambda args args))))
(if (not (eq? (car var) 'no-such-region))
- (snd-display ";insert-region bad id: ~A" var)))
+ (snd-display #__line__ ";insert-region bad id: ~A" var)))
(save-region id "fmv.snd")
(if (not (= (mus-sound-header-type "fmv.snd") mus-next))
- (snd-display ";save-region header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";save-region header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-out-format))
- (snd-display ";save-region format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";save-region format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (= (mus-sound-srate "fmv.snd") (region-srate id)))
- (snd-display ";save-region srate: ~A (~A)" (mus-sound-srate "fmv.snd") (region-srate id)))
+ (snd-display #__line__ ";save-region srate: ~A (~A)" (mus-sound-srate "fmv.snd") (region-srate id)))
(if (not (= (mus-sound-chans "fmv.snd") (region-chans id)))
- (snd-display ";save-region chans: ~A (~A)" (mus-sound-chans "fmv.snd") (region-chans id)))
+ (snd-display #__line__ ";save-region chans: ~A (~A)" (mus-sound-chans "fmv.snd") (region-chans id)))
(if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display ";save-region length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
+ (snd-display #__line__ ";save-region length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
(if (not (= (region-position id 0) 0))
- (snd-display ";save-region position: ~A" (region-position id 0)))
+ (snd-display #__line__ ";save-region position: ~A" (region-position id 0)))
(delete-file "fmv.snd")
(save-region id "fmv.snd" mus-riff mus-lshort "this is a comment")
(if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display ";save-region riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";save-region riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-lshort))
- (snd-display ";save-region lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";save-region lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display ";save-region length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
+ (snd-display #__line__ ";save-region length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display ";save-region comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";save-region comment: ~A" (mus-sound-comment "fmv.snd")))
(delete-file "fmv.snd")
(save-region id :file "fmv.snd" :header-type mus-riff :data-format mus-lshort :comment "this is a comment")
(if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display ";save-region opt riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";save-region opt riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-lshort))
- (snd-display ";save-region opt lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";save-region opt lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display ";save-region opt length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
+ (snd-display #__line__ ";save-region opt length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display ";save-region opt comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";save-region opt comment: ~A" (mus-sound-comment "fmv.snd")))
(delete-file "fmv.snd")
(save-region id :comment "this is a comment" :file "fmv.snd" :data-format mus-lshort :header-type mus-riff)
(if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display ";save-region opt1 riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";save-region opt1 riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-lshort))
- (snd-display ";save-region opt1 lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";save-region opt1 lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display ";save-region opt1 length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
+ (snd-display #__line__ ";save-region opt1 length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display ";save-region opt1 comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";save-region opt1 comment: ~A" (mus-sound-comment "fmv.snd")))
(delete-file "fmv.snd")
(save-region id "fmv.snd" :data-format mus-bshort)
(if (not (= (mus-sound-header-type "fmv.snd") mus-next))
- (snd-display ";save-region opt2 next header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";save-region opt2 next header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-bshort))
- (snd-display ";save-region opt2 bshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";save-region opt2 bshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(delete-file "fmv.snd")
))
(close-sound index)
(let ((var (catch #t (lambda () (new-sound "hi.snd" 0 1 100 0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";new-sound bad chan: ~A" var)))
+ (snd-display #__line__ ";new-sound bad chan: ~A" var)))
(set! index (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "unequal lens"))
(insert-silence 0 1000 index 1)
(if (or (not (= (frames index 0) 1))
(not (= (frames index 1) 1001)))
- (snd-display ";silence 1: ~A ~A" (frames index 0) (frames index 1)))
+ (snd-display #__line__ ";silence 1: ~A ~A" (frames index 0) (frames index 1)))
(save-sound index)
(if (or (not (= (frames index 0) 1001))
(not (= (frames index 1) 1001)))
- (snd-display ";saved silence 1: ~A ~A" (frames index 0) (frames index 1)))
+ (snd-display #__line__ ";saved silence 1: ~A ~A" (frames index 0) (frames index 1)))
(if (not (= (mus-sound-frames "fmv.snd") 1001))
- (snd-display ";saved framers silence 1: ~A" (mus-sound-frames "fmv.snd")))
+ (snd-display #__line__ ";saved framers silence 1: ~A" (mus-sound-frames "fmv.snd")))
(let ((v0 (samples->vct 0 1000 index 0))
(v1 (samples->vct 0 1000 index 1)))
(if (fneq (vct-peak v0) 0.0)
- (snd-display ";auto-pad 0: ~A" (vct-peak v0)))
+ (snd-display #__line__ ";auto-pad 0: ~A" (vct-peak v0)))
(if (fneq (vct-peak v1) 0.0)
- (snd-display ";silence 0: ~A" (vct-peak v1))))
+ (snd-display #__line__ ";silence 0: ~A" (vct-peak v1))))
(close-sound index)
(delete-file "fmv.snd")
@@ -9689,18 +9769,18 @@ EDITS: 5
(pad-channel 0 1000 index 1)
(if (or (not (= (frames index 0) 1))
(not (= (frames index 1) 1001)))
- (snd-display ";pad-channel 1: ~A ~A" (frames index 0) (frames index 1)))
+ (snd-display #__line__ ";pad-channel 1: ~A ~A" (frames index 0) (frames index 1)))
(let ((v0 (samples->vct 0 1000 index 0))
(v1 (samples->vct 0 1000 index 1)))
(if (fneq (vct-peak v0) 0.0)
- (snd-display ";pad 0: ~A" (vct-peak v0)))
+ (snd-display #__line__ ";pad 0: ~A" (vct-peak v0)))
(if (fneq (vct-peak v1) 0.0)
- (snd-display ";pad 1: ~A" (vct-peak v1))))
+ (snd-display #__line__ ";pad 1: ~A" (vct-peak v1))))
(map-channel (lambda (n) 1.0) 0 2 index 0)
(map-channel (lambda (n) 1.0) 0 1002 index 1)
(pad-channel 0 1000 index 0 1)
(if (not (= (frames index 1) 1002))
- (snd-display ";pad-channel ed 1: ~A ~A" (frames index 0) (frames index 1)))
+ (snd-display #__line__ ";pad-channel ed 1: ~A ~A" (frames index 0) (frames index 1)))
(close-sound index)
(delete-file "fmv.snd")
@@ -9708,10 +9788,10 @@ EDITS: 5
(scale-to 1.0 ind 0)
(make-selection 1000 2000 ind 0)
(filter-selection-and-smooth .01 (vct .25 .5 .5 .5 .25))
-; (if (fneq (sample 1500 ind 0) -0.0045776) (snd-display ";filter-selection-and-smooth: ~A" (sample 1500 ind 0)))
+ ; (if (fneq (sample 1500 ind 0) -0.0045776) (snd-display #__line__ ";filter-selection-and-smooth: ~A" (sample 1500 ind 0)))
(revert-sound ind)
(close-sound ind))
-
+
(set! index (new-sound "fmv.snd" mus-ircam mus-bshort 22050 1 "this is a comment"))
(let ((v0 (make-vct 128)))
(vct-set! v0 64 .5)
@@ -9721,7 +9801,7 @@ EDITS: 5
(smooth-selection)
(set! v0 (samples->vct 0 128 index 0 v0))
(if (or (fneq (sample 127) .5) (fneq (sample 120) .4962) (fneq (sample 32) 0.07431) (fneq (sample 64) 0.25308))
- (snd-display ";smooth-selection: ~A?" v0))
+ (snd-display #__line__ ";smooth-selection: ~A?" v0))
(revert-sound index)
(vct-fill! v0 0.0)
(vct-set! v0 10 .5)
@@ -9732,7 +9812,7 @@ EDITS: 5
(src-selection 0.5)
(set! v0 (samples->vct 0 128 index 0 v0))
(if (or (fneq (sample 20) .5) (fneq (sample 30) 0.0) (fneq (sample 17) -.1057) )
- (snd-display ";src-selection: ~A?" v0))
+ (snd-display #__line__ ";src-selection: ~A?" v0))
(revert-sound index)
(vct-fill! v0 0.0)
(vct-set! v0 10 .5)
@@ -9742,7 +9822,7 @@ EDITS: 5
(filter-selection '(0 0 .1 1 1 0) 40)
(set! v0 (samples->vct 0 128 index 0 v0))
(if (or (fneq (sample 29) .1945) (fneq (sample 39) -.0137) (fneq (sample 24) -0.01986))
- (snd-display ";filter-selection: ~A?" v0))
+ (snd-display #__line__ ";filter-selection: ~A?" v0))
(revert-sound index)
(vct-fill! v0 1.0)
(vct->samples 0 128 v0 index 0)
@@ -9750,7 +9830,7 @@ EDITS: 5
(filter-selection (make-one-zero :a0 .5 :a1 0.0))
(set! v0 (samples->vct 0 128 index 0 v0))
(if (or (fneq (sample 29) .5) (fneq (sample 39) .5) (fneq (sample 24) 0.5))
- (snd-display ";filter-selection one-zero: ~A?" v0))
+ (snd-display #__line__ ";filter-selection one-zero: ~A?" v0))
(revert-sound index)
(vct-fill! v0 1.0)
(vct->samples 0 128 v0 index 0)
@@ -9759,22 +9839,22 @@ EDITS: 5
(env-selection '(0 0 1 1 2 0) 1.0)
(set! v0 (samples->vct 0 128 index 0 v0))
(if (or (fneq (sample 64) 1.0) (fneq (sample 20) .3125) (fneq (sample 119) 0.127))
- (snd-display ";env-selection [len: ~A]: ~A ~A ~A ~A?" (selection-frames) (sample 64) (sample 20) (sample 119) v0))
+ (snd-display #__line__ ";env-selection [len: ~A]: ~A ~A ~A ~A?" (selection-frames) (sample 64) (sample 20) (sample 119) v0))
(save-selection "fmv5.snd" mus-next mus-bint 22050 "") ;1.0->-1.0 if short
(revert-sound index)
(let ((tag (catch #t (lambda () (file->array "/baddy/hiho" 0 0 128 v0)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-file)) (snd-display ";file->array w/o file: ~A" tag)))
+ (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";file->array w/o file: ~A" tag)))
(let ((tag (catch #t (lambda () (file->array "fmv5.snd" 123 0 128 v0)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display ";file->array w/o channel: ~A" tag)))
+ (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";file->array w/o channel: ~A" tag)))
(file->array "fmv5.snd" 0 0 128 v0)
(if (or (fneq (vct-ref v0 64) 1.0) (fneq (vct-ref v0 20) .3125) (fneq (vct-ref v0 119) 0.127))
- (snd-display ";save-selection: ~A ~A ~A ~A?" (vct-ref v0 64) (vct-ref v0 20) (vct-ref v0 119) v0))
+ (snd-display #__line__ ";save-selection: ~A ~A ~A ~A?" (vct-ref v0 64) (vct-ref v0 20) (vct-ref v0 119) v0))
(if (not (= (mus-sound-header-type "fmv5.snd") mus-next))
- (snd-display ";save-selection type: ~A?" (mus-header-type-name (mus-sound-header-type "fmv5.snd"))))
+ (snd-display #__line__ ";save-selection type: ~A?" (mus-header-type-name (mus-sound-header-type "fmv5.snd"))))
(if (not (= (mus-sound-data-format "fmv5.snd") mus-bint))
- (snd-display ";save-selection format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv5.snd"))))
+ (snd-display #__line__ ";save-selection format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv5.snd"))))
(if (not (= (mus-sound-srate "fmv5.snd") 22050))
- (snd-display ";save-selection srate: ~A?" (mus-sound-srate "fmv5.snd")))
+ (snd-display #__line__ ";save-selection srate: ~A?" (mus-sound-srate "fmv5.snd")))
(vct-fill! v0 0.0)
(vct-set! v0 100 .5)
(vct-set! v0 2 -.5)
@@ -9784,37 +9864,37 @@ EDITS: 5
(save-selection "fmv4.snd" mus-riff mus-lfloat 44100 "this is a comment")
(set! v0 (samples->vct 0 128 index 0 v0))
(if (or (fneq (sample 27) 0.5) (fneq (sample 125) -.5))
- (snd-display ";reverse-selection: ~A?" v0))
+ (snd-display #__line__ ";reverse-selection: ~A?" v0))
(file->array "fmv4.snd" 0 0 128 v0)
(if (or (fneq (sample 27) 0.5) (fneq (sample 125) -.5))
- (snd-display ";save reverse-selection: ~A?" v0))
+ (snd-display #__line__ ";save reverse-selection: ~A?" v0))
(if (not (= (mus-sound-header-type "fmv4.snd") mus-riff))
- (snd-display ";save-selection type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
+ (snd-display #__line__ ";save-selection type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
(if (not (= (mus-sound-data-format "fmv4.snd") mus-lfloat))
- (snd-display ";save-selection format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
+ (snd-display #__line__ ";save-selection format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
(if (not (= (mus-sound-srate "fmv4.snd") 44100))
- (snd-display ";save-selection srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
+ (snd-display #__line__ ";save-selection srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
(if (not (string=? (mus-sound-comment "fmv4.snd") "this is a comment"))
- (snd-display ";save-selection comment: ~A?" (mus-sound-comment "fmv4.snd")))
+ (snd-display #__line__ ";save-selection comment: ~A?" (mus-sound-comment "fmv4.snd")))
(delete-file "fmv4.snd")
(save-selection :file "fmv4.snd" :header-type mus-riff :data-format mus-lfloat :srate 44100 :comment "this is a comment")
(if (not (= (mus-sound-header-type "fmv4.snd") mus-riff))
- (snd-display ";save-selection opt type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
+ (snd-display #__line__ ";save-selection opt type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
(if (not (= (mus-sound-data-format "fmv4.snd") mus-lfloat))
- (snd-display ";save-selection opt format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
+ (snd-display #__line__ ";save-selection opt format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
(if (not (= (mus-sound-srate "fmv4.snd") 44100))
- (snd-display ";save-selection opt srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
+ (snd-display #__line__ ";save-selection opt srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
(if (not (string=? (mus-sound-comment "fmv4.snd") "this is a comment"))
- (snd-display ";save-selection opt comment: ~A?" (mus-sound-comment "fmv4.snd")))
+ (snd-display #__line__ ";save-selection opt comment: ~A?" (mus-sound-comment "fmv4.snd")))
(delete-file "fmv4.snd")
(save-selection :file "fmv4.snd" :data-format mus-bfloat :channel 0)
(if (and (not (= (mus-sound-header-type "fmv4.snd") mus-next))
(not (= (mus-sound-header-type "fmv4.snd") mus-ircam)))
- (snd-display ";save-selection opt1 type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
+ (snd-display #__line__ ";save-selection opt1 type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
(if (not (= (mus-sound-data-format "fmv4.snd") mus-bfloat))
- (snd-display ";save-selection opt1 format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
+ (snd-display #__line__ ";save-selection opt1 format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
(if (not (= (mus-sound-chans "fmv4.snd") 1))
- (snd-display ";save-selection opt1 chans: ~A?" (mus-sound-chans "fmv4.snd")))
+ (snd-display #__line__ ";save-selection opt1 chans: ~A?" (mus-sound-chans "fmv4.snd")))
(delete-file "fmv4.snd")
(revert-sound index)
(vct-fill! v0 0.0)
@@ -9829,68 +9909,68 @@ EDITS: 5
(if (clipping) (set! (clipping) #f))
(convolve-selection-with "fmv5.snd" .5)
(set! v0 (samples->vct 0 128 index 0 v0))
- (if (fneq (sample 66) -.5) (snd-display ";convolve-selection-with: ~A ~A ~A?" (vct-ref v0 66) (sample 66) v0))
+ (if (fneq (sample 66) -.5) (snd-display #__line__ ";convolve-selection-with: ~A ~A ~A?" (vct-ref v0 66) (sample 66) v0))
(close-sound index))
(let* ((obind (open-sound "oboe.snd"))
(vol (maxamp obind))
(dur (frames)))
(set! (amp-control obind) 2.0)
- (if (fffneq (amp-control obind) 2.0) (snd-display ";set amp-control ~A" (amp-control obind)))
+ (if (fffneq (amp-control obind) 2.0) (snd-display #__line__ ";set amp-control ~A" (amp-control obind)))
(reset-controls obind)
- (if (ffneq (amp-control obind) 1.0) (snd-display ";reset amp-control ~A" (amp-control obind)))
+ (if (ffneq (amp-control obind) 1.0) (snd-display #__line__ ";reset amp-control ~A" (amp-control obind)))
(set! (amp-control-bounds obind) (list 0.0 4.0))
- (if (not (equal? (amp-control-bounds obind) (list 0.0 4.0))) (snd-display ";amp-control-bounds: ~A" (amp-control-bounds)))
+ (if (not (equal? (amp-control-bounds obind) (list 0.0 4.0))) (snd-display #__line__ ";amp-control-bounds: ~A" (amp-control-bounds)))
(set! (amp-control obind) 2.0)
- (if (eq? (without-errors (apply-controls obind)) 'no-such-sound) (snd-display ";apply-controls can't find oboe.snd?"))
+ (if (eq? (without-errors (apply-controls obind)) 'no-such-sound) (snd-display #__line__ ";apply-controls can't find oboe.snd?"))
(let ((newamp (maxamp obind)))
- (if (> (abs (- (* 2.0 vol) newamp)) .05) (snd-display ";apply amp: ~A -> ~A?" vol newamp))
+ (if (> (abs (- (* 2.0 vol) newamp)) .05) (snd-display #__line__ ";apply amp: ~A -> ~A?" vol newamp))
(set! (amp-control-bounds obind) (list 0.0 8.0))
(set! (speed-control-bounds obind) (list 1.0 5.0))
- (if (not (equal? (speed-control-bounds obind) (list 1.0 5.0))) (snd-display ";speed-control-bounds: ~A" (speed-control-bounds)))
+ (if (not (equal? (speed-control-bounds obind) (list 1.0 5.0))) (snd-display #__line__ ";speed-control-bounds: ~A" (speed-control-bounds)))
(set! (speed-control obind) 0.5)
(set! (speed-control-bounds obind) (list .05 20.0))
(add-mark 1234)
(apply-controls obind)
(let ((newdur (frames obind)))
(set! (speed-control obind) 1.0)
- (if (not (< (- newdur (* 2.0 dur)) 256)) (snd-display ";apply speed: ~A -> ~A?" dur newdur))
+ (if (not (< (- newdur (* 2.0 dur)) 256)) (snd-display #__line__ ";apply speed: ~A -> ~A?" dur newdur))
;; within 256 which is apply's buffer size (it always flushes full buffers)
(set! (contrast-control? obind) #t)
(set! (contrast-control-bounds obind) (list 0.5 2.5))
- (if (not (equal? (contrast-control-bounds obind) (list 0.5 2.5))) (snd-display ";contrast-control-bounds: ~A" (contrast-control-bounds)))
+ (if (not (equal? (contrast-control-bounds obind) (list 0.5 2.5))) (snd-display #__line__ ";contrast-control-bounds: ~A" (contrast-control-bounds)))
(set! (contrast-control obind) 1.0)
(apply-controls obind)
(set! (contrast-control-bounds obind) (list 0.0 10.0))
- (if (not (equal? (contrast-control-bounds obind) (list 0.0 10.0))) (snd-display ";contrast-control-bounds (2): ~A" (contrast-control-bounds)))
+ (if (not (equal? (contrast-control-bounds obind) (list 0.0 10.0))) (snd-display #__line__ ";contrast-control-bounds (2): ~A" (contrast-control-bounds)))
(let ((secamp (maxamp obind))
(secdur (frames obind)))
- (if (fneq secamp .989) (snd-display ";apply contrast: ~A?" secamp))
- (if (not (= secdur newdur)) (snd-display ";apply contrast length: ~A -> ~A?" newdur secdur))
+ (if (fneq secamp .989) (snd-display #__line__ ";apply contrast: ~A?" secamp))
+ (if (not (= secdur newdur)) (snd-display #__line__ ";apply contrast length: ~A -> ~A?" newdur secdur))
(undo 3 obind)
(set! (reverb-control? obind) #t)
(set! (reverb-control-scale-bounds obind) (list 0.0 1.0))
(if (not (equal? (reverb-control-scale-bounds obind) (list 0.0 1.0)))
- (snd-display ";reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds)))
+ (snd-display #__line__ ";reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds)))
(set! (reverb-control-length-bounds obind) (list 0.0 2.0))
(if (not (equal? (reverb-control-length-bounds obind) (list 0.0 2.0)))
- (snd-display ";reverb-control-length-bounds: ~A" (reverb-control-length-bounds)))
+ (snd-display #__line__ ";reverb-control-length-bounds: ~A" (reverb-control-length-bounds)))
(set! (reverb-control-scale obind) .2)
(apply-controls obind)
(let ((revamp (maxamp obind))
(revdur (frames obind)))
- (if (ffneq revamp .214) (snd-display ";apply reverb scale: ~A?" revamp))
- (if (not (< (- revdur (+ 50828 (inexact->exact (round (* (reverb-control-decay) 22050))))) 256))
- (snd-display ";apply reverb length: ~A?" revdur))
+ (if (ffneq revamp .214) (snd-display #__line__ ";apply reverb scale: ~A?" revamp))
+ (if (not (< (- revdur (+ 50828 (round (* (reverb-control-decay) 22050)))) 256))
+ (snd-display #__line__ ";apply reverb length: ~A?" revdur))
(undo 1 obind)
(set! (expand-control? obind) #t)
(set! (expand-control-bounds obind) (list 1.0 3.0))
- (if (not (equal? (expand-control-bounds obind) (list 1.0 3.0))) (snd-display ";expand-control-bounds: ~A" (expand-control-bounds)))
+ (if (not (equal? (expand-control-bounds obind) (list 1.0 3.0))) (snd-display #__line__ ";expand-control-bounds: ~A" (expand-control-bounds)))
(set! (expand-control obind) 1.5)
(apply-controls obind)
(let ((expamp (maxamp obind))
(expdur (frames obind)))
- (if (> (abs (- expamp .152)) .05) (snd-display ";apply expand-control scale: ~A?" expamp))
- (if (not (> expdur (* 1.25 50828))) (snd-display ";apply expand-control length: ~A?" expdur))
+ (if (> (abs (- expamp .152)) .05) (snd-display #__line__ ";apply expand-control scale: ~A?" expamp))
+ (if (not (> expdur (* 1.25 50828))) (snd-display #__line__ ";apply expand-control length: ~A?" expdur))
(set! (expand-control-bounds obind) (list 0.001 20.0))
(undo 1 obind)
(set! (filter-control? obind) #t)
@@ -9899,8 +9979,8 @@ EDITS: 5
(apply-controls obind)
(let ((fltamp (maxamp obind))
(fltdur (frames obind)))
- (if (> (abs (- fltamp .02)) .005) (snd-display ";apply filter scale: ~A?" fltamp))
- (if (> (- fltdur (+ 40 50828)) 256) (snd-display ";apply filter length: ~A?" fltdur))
+ (if (> (abs (- fltamp .02)) .005) (snd-display #__line__ ";apply filter scale: ~A?" fltamp))
+ (if (> (- fltdur (+ 40 50828)) 256) (snd-display #__line__ ";apply filter length: ~A?" fltdur))
(undo 1 obind)))))))
(revert-sound obind)
(make-selection 1000 1000)
@@ -9933,7 +10013,7 @@ EDITS: 5
(2003 0 2003 50827 1.0 0.0 0.0 0)
(50828 -2 0 0 0.0 0.0 0.0 0))))
(if (not (= (length tree) (length true-tree)))
- (snd-display ";edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
+ (snd-display #__line__ ";edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
(let ((len (length tree)))
(do ((i 0 (+ 1 i)))
((= i len))
@@ -9944,7 +10024,7 @@ EDITS: 5
(not (= (caddr branch) (caddr true-branch)))
(not (= (cadddr branch) (cadddr true-branch)))
(fneq (list-ref branch 4) (list-ref true-branch 4)))
- (snd-display ";edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
+ (snd-display #__line__ ";edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
(insert-silence 1001 8)
(insert-silence 900 50)
(insert-silence 2005 1)
@@ -9968,7 +10048,7 @@ EDITS: 5
(2064 0 2003 50827 1.0 0.0 0.0 0)
(50889 -2 0 0 0.0 0.0 0.0 0))))
(if (not (= (length tree) (length true-tree)))
- (snd-display ";silenced edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
+ (snd-display #__line__ ";silenced edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
(let ((len (length tree)))
(do ((i 0 (+ 1 i)))
((= i len))
@@ -9979,29 +10059,29 @@ EDITS: 5
(not (= (caddr branch) (caddr true-branch)))
(not (= (cadddr branch) (cadddr true-branch)))
(fneq (list-ref branch 4) (list-ref true-branch 4)))
- (snd-display ";silenced edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
+ (snd-display #__line__ ";silenced edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
(if (or (fneq (sample 998) -.03)
(fneq (sample 999) 0.0)
(fneq (sample 1000) 0.0)
(fneq (sample 1001) -.03))
- (snd-display ";insert-silence [999 for 2]: ~A ~A ~A ~A?" (sample 998) (sample 999) (sample 1000) (sample 1001) ))
+ (snd-display #__line__ ";insert-silence [999 for 2]: ~A ~A ~A ~A?" (sample 998) (sample 999) (sample 1000) (sample 1001) ))
(if (or (fneq (sample 2006) -.033)
(fneq (sample 2007) 0.0)
(fneq (sample 2008) -.033))
- (snd-display ";insert-silence [2007 for 1]: ~A ~A ~A?" (sample 2006) (sample 2007) (sample 2008)))
+ (snd-display #__line__ ";insert-silence [2007 for 1]: ~A ~A ~A?" (sample 2006) (sample 2007) (sample 2008)))
(revert-sound obind)
(add-mark 1200 obind 0)
(let ((mark-num (length (marks obind 0))))
(scale-by 2.0 obind 0)
(let ((mark-now (length (marks obind 0))))
(if (not (= mark-num mark-now))
- (snd-display ";mark lost after scaling?"))
+ (snd-display #__line__ ";mark lost after scaling?"))
(set! (selection-position) 0)
(set! (selection-frames) 100)
(scale-selection-to .5)
(set! mark-now (length (marks obind 0)))
(if (not (= mark-num mark-now))
- (snd-display ";mark lost after selection scaling?")))
+ (snd-display #__line__ ";mark lost after selection scaling?")))
(let ((m1 (add-mark 1000)))
(set! (cursor obind 0) 100)
(key (char->integer #\u) 4 obind)
@@ -10010,47 +10090,47 @@ EDITS: 5
(key (char->integer #\0) 0 obind)
(key (char->integer #\o) 4 obind)
(if (not (= (mark-sample m1) 1100))
- (snd-display ";mark after zeros: ~D (1100)? " (mark-sample m1)))
+ (snd-display #__line__ ";mark after zeros: ~D (1100)? " (mark-sample m1)))
(set! (cursor obind) 0)
(key (char->integer #\j) 4 obind)
- (if (not (= (cursor obind) 1100)) (snd-display ";c-j to ~A" (cursor obind)))
+ (if (not (= (cursor obind) 1100)) (snd-display #__line__ ";c-j to ~A" (cursor obind)))
(add-mark 100)
(set! (cursor obind) 0)
(key (char->integer #\u) 4 obind)
(key (char->integer #\2) 0 obind)
(key (char->integer #\j) 4 obind)
- (if (not (= (cursor obind) 1100)) (snd-display ";c-u 2 c-j ~A" (cursor obind)))
+ (if (not (= (cursor obind) 1100)) (snd-display #__line__ ";c-u 2 c-j ~A" (cursor obind)))
(key (char->integer #\-) 4 obind)
(key (char->integer #\j) 4 obind)
- (if (not (= (cursor obind) 100)) (snd-display ";c-- c-j ~A" (cursor obind)))))
+ (if (not (= (cursor obind) 100)) (snd-display #__line__ ";c-- c-j ~A" (cursor obind)))))
(revert-sound obind)
(let ((frs (frames obind)))
(make-region 0 999 obind 0)
- (if (not (selection?)) (snd-display ";make-region but no selection? ~A" (selection?)))
+ (if (not (selection?)) (snd-display #__line__ ";make-region but no selection? ~A" (selection?)))
(delete-selection)
(if (not (= (frames obind) (- frs 1000)))
- (snd-display ";delete-selection: ~A?" (frames obind)))
+ (snd-display #__line__ ";delete-selection: ~A?" (frames obind)))
(let ((val (sample 0 obind 0)))
(undo)
(if (fneq (sample 1000) val)
- (snd-display ";delete-selection val: ~A ~A" val (sample 1000)))
+ (snd-display #__line__ ";delete-selection val: ~A ~A" val (sample 1000)))
(insert-selection)
(let ((var (catch #t (lambda () (insert-selection 0 obind 123)) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";insert-selection bad chan: ~A" var)))
+ (snd-display #__line__ ";insert-selection bad chan: ~A" var)))
(let ((var (catch #t (lambda () (mix-selection 0 obind 123)) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";mix-selection bad chan: ~A" var)))
+ (snd-display #__line__ ";mix-selection bad chan: ~A" var)))
(if (not (= (frames obind) (+ frs 1000)))
- (snd-display ";insert-selection: ~A?" (frames obind)))
+ (snd-display #__line__ ";insert-selection: ~A?" (frames obind)))
(if (fneq (sample 2000) val)
- (snd-display ";insert-selection val: ~A ~A" val (sample 2000)))
+ (snd-display #__line__ ";insert-selection val: ~A ~A" val (sample 2000)))
(set! val (sample 900))
(mix-selection)
(if (fneq (sample 900) (* 2 val))
- (snd-display ";mix-selection val: ~A ~A" (* 2 val) (sample 900)))
+ (snd-display #__line__ ";mix-selection val: ~A ~A" (* 2 val) (sample 900)))
(if (not (= (frames obind) (+ frs 1000)))
- (snd-display ";mix-selection len: ~A?" (frames obind)))))
+ (snd-display #__line__ ";mix-selection len: ~A?" (frames obind)))))
(close-sound obind))
(let* ((ind (open-sound "2.snd"))
@@ -10062,12 +10142,12 @@ EDITS: 5
(set! (speed-control ind) .5)
(apply-controls ind apply-to-sound) ; temp 1
(if (> (abs (- (frames) (* 2 len))) 256)
- (snd-display ";apply srate .5: ~A ~A" (frames) (* 2 len)))
+ (snd-display #__line__ ";apply srate .5: ~A ~A" (frames) (* 2 len)))
(make-selection 0 (frames))
(set! (speed-control ind) .5)
(apply-controls ind apply-to-selection) ; temp 2
(if (> (abs (- (frames) (* 4 len))) 256)
- (snd-display ";apply srate .5 to selection: ~A ~A" (frames) (* 4 len)))
+ (snd-display #__line__ ";apply srate .5 to selection: ~A ~A" (frames) (* 4 len)))
(env-sound '(0 0 1 1) 0 (frames) 32.0) ; temp 3
(let ((reg (select-all))) ; make multi-channel region
(insert-region reg 0) ; temp 4
@@ -10078,16 +10158,16 @@ EDITS: 5
(set! (selected-channel ind) 1)
(apply-controls ind apply-to-channel)
(if (> (abs (- (frames ind 1) (* 2 len))) 256)
- (snd-display ";apply srate .5 to chan 1: ~A ~A" (frames ind 1) (* 2 len)))
+ (snd-display #__line__ ";apply srate .5 to chan 1: ~A ~A" (frames ind 1) (* 2 len)))
(if (not (= (frames ind 0) len))
- (snd-display ";apply srate .5 but chan 0: ~A ~A" (frames ind 0) len))
+ (snd-display #__line__ ";apply srate .5 but chan 0: ~A ~A" (frames ind 0) len))
(set! (speed-control ind) .5)
(apply-controls ind apply-to-sound 1000)
(make-selection 2000 4000)
(set! (speed-control ind) .5)
(apply-controls ind apply-to-selection)
(set! (selected-channel ind) #f)
- (if (selected-channel ind) (snd-display ";selected-channel #f: ~A" (selected-channel ind)))
+ (if (selected-channel ind) (snd-display #__line__ ";selected-channel #f: ~A" (selected-channel ind)))
(close-sound ind))
(let* ((ind1 (open-sound "oboe.snd"))
@@ -10098,22 +10178,22 @@ EDITS: 5
(select-sound ind1)
(scale-sound-by 2.0)
(let ((nmx (maxamp ind1 0)))
- (if (fneq (* 2 mx1) nmx) (snd-display ";scale-sound-by 2.0: ~A ~A?" mx1 nmx))
+ (if (fneq (* 2 mx1) nmx) (snd-display #__line__ ";scale-sound-by 2.0: ~A ~A?" mx1 nmx))
(if (not (equal? (edit-fragment 1 ind1 0) (list "scale-channel 2.000 0 #f" "scale" 0 50828)))
- (snd-display ";scale-sound-by: ~A?" (edit-fragment 1 ind1 0))))
+ (snd-display #__line__ ";scale-sound-by: ~A?" (edit-fragment 1 ind1 0))))
(scale-sound-to 0.5)
(let ((nmx (maxamp ind1 0)))
- (if (fneq nmx 0.5) (snd-display ";scale-sound-to 0.5: ~A?" nmx))
+ (if (fneq nmx 0.5) (snd-display #__line__ ";scale-sound-to 0.5: ~A?" nmx))
(if (not (equal? (edit-fragment 2 ind1 0) (list "scale-channel 1.698 0 #f" "scale" 0 50828)))
- (snd-display ";scale-sound-to: ~A?" (edit-fragment 2 ind1 0))))
+ (snd-display #__line__ ";scale-sound-to: ~A?" (edit-fragment 2 ind1 0))))
(scale-sound-by 0.0 0 1000 ind1 0)
(let ((nmx (maxamp ind1 0)))
- (if (fneq 0.5 nmx) (snd-display ";scale-sound-by 0.0: ~A ~A?" mx1 nmx))
+ (if (fneq 0.5 nmx) (snd-display #__line__ ";scale-sound-by 0.0: ~A ~A?" mx1 nmx))
(if (not (equal? (edit-fragment 3 ind1 0) (list "scale-channel 0.000 0 1000" "scale" 0 1000)))
- (snd-display ";scale-sound-by 0.0: ~A?" (edit-fragment 3 ind1 0))))
+ (snd-display #__line__ ";scale-sound-by 0.0: ~A?" (edit-fragment 3 ind1 0))))
(let* ((v (samples->vct 0 1000 ind1 0))
(pk (vct-peak v)))
- (if (fneq pk 0.0) (snd-display ";scale-sound-by 0.0 [0:1000]: ~A?" pk)))
+ (if (fneq pk 0.0) (snd-display #__line__ ";scale-sound-by 0.0 [0:1000]: ~A?" pk)))
(revert-sound ind1)
(let ((oldv (samples->vct 12000 10 ind1 0)))
(scale-sound-by 2.0 12000 10 ind1 0)
@@ -10121,25 +10201,25 @@ EDITS: 5
(do ((i 0 (+ 1 i)))
((= i 10))
(if (fneq (* 2.0 (vct-ref oldv i)) (vct-ref newv i))
- (snd-display ";scale ~D: ~A ~A?" i (vct-ref oldv i) (vct-ref newv i)))))
+ (snd-display #__line__ ";scale ~D: ~A ~A?" i (vct-ref oldv i) (vct-ref newv i)))))
(if (not (equal? (edit-fragment 1 ind1 0) (list "scale-channel 2.000 12000 10" "scale" 12000 10)))
- (snd-display ";scale-sound-by 2.0 [12000:10]: ~A?" (edit-fragment 1 ind1 0))))
+ (snd-display #__line__ ";scale-sound-by 2.0 [12000:10]: ~A?" (edit-fragment 1 ind1 0))))
(revert-sound ind1)
(select-sound ind2)
(scale-sound-by 2.0)
(let ((nmx (maxamp ind2 0)))
- (if (fneq (* 2 mx20) nmx) (snd-display ";2:0 scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
+ (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
(let ((nmx (maxamp ind2 1)))
- (if (fneq (* 2 mx21) nmx) (snd-display ";2:1 scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
+ (if (fneq (* 2 mx21) nmx) (snd-display #__line__ ";2:1 scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
(scale-sound-to 0.5)
(let ((nmx (max (maxamp ind2 0) (maxamp ind2 1))))
- (if (fneq nmx 0.5) (snd-display ";2 scale-sound-to 0.5: ~A (~A)?" nmx (maxamp ind2))))
+ (if (fneq nmx 0.5) (snd-display #__line__ ";2 scale-sound-to 0.5: ~A (~A)?" nmx (maxamp ind2))))
(scale-sound-by 0.0 0 1000 ind2 1)
(if (not (equal? (edit-fragment 3 ind2 1) (list "scale-channel 0.000 0 1000" "scale" 0 1000)))
- (snd-display ";2:1 scale-sound-by 0.0: ~A?" (edit-fragment 3 ind2 1)))
+ (snd-display #__line__ ";2:1 scale-sound-by 0.0: ~A?" (edit-fragment 3 ind2 1)))
(let* ((v (samples->vct 0 1000 ind2 1))
(pk (vct-peak v)))
- (if (fneq pk 0.0) (snd-display ";2:1 scale-sound-by 0.0 [0:1000]: ~A?" pk)))
+ (if (fneq pk 0.0) (snd-display #__line__ ";2:1 scale-sound-by 0.0 [0:1000]: ~A?" pk)))
(revert-sound ind2)
(let ((oldv (samples->vct 12000 10 ind2 0)))
(scale-sound-by 2.0 12000 10 ind2 0)
@@ -10147,37 +10227,37 @@ EDITS: 5
(do ((i 0 (+ 1 i)))
((= i 10))
(if (fneq (* 2.0 (vct-ref oldv i)) (vct-ref newv i))
- (snd-display ";2 scale ~D: ~A ~A?" i (vct-ref oldv i) (vct-ref newv i))))))
+ (snd-display #__line__ ";2 scale ~D: ~A ~A?" i (vct-ref oldv i) (vct-ref newv i))))))
(revert-sound ind2)
(set! (sync ind2) 3)
(set! (sync ind1) 3)
(scale-sound-by 2.0)
(let ((nmx (maxamp ind1 0)))
- (if (fneq mx1 nmx) (snd-display ";sync scale-sound-by 2.0: ~A ~A?" mx1 nmx)))
+ (if (fneq mx1 nmx) (snd-display #__line__ ";sync scale-sound-by 2.0: ~A ~A?" mx1 nmx)))
(let ((nmx (maxamp ind2 0)))
- (if (fneq (* 2 mx20) nmx) (snd-display ";2:0 sync scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
+ (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 sync scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
(let ((nmx (maxamp ind2 1)))
- (if (fneq (* 2 mx21) nmx) (snd-display ";2:1 sync scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
+ (if (fneq (* 2 mx21) nmx) (snd-display #__line__ ";2:1 sync scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
(scale-sound-to 1.0 20000 40000 ind2 1)
(let ((nmx (maxamp ind1 0)))
- (if (fneq mx1 nmx) (snd-display ";sync scale-sound-to 1.0: ~A ~A?" mx1 nmx)))
+ (if (fneq mx1 nmx) (snd-display #__line__ ";sync scale-sound-to 1.0: ~A ~A?" mx1 nmx)))
(let ((nmx (maxamp ind2 0)))
- (if (fneq (* 2 mx20) nmx) (snd-display ";2:0 sync scale-sound-to 1.0: ~A ~A?" mx20 nmx)))
+ (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 sync scale-sound-to 1.0: ~A ~A?" mx20 nmx)))
(let ((nmx (maxamp ind2 1)))
- (if (fneq nmx 1.0) (snd-display ";2:1 sync scale-sound-to 1.0: ~A?" nmx)))
+ (if (fneq nmx 1.0) (snd-display #__line__ ";2:1 sync scale-sound-to 1.0: ~A?" nmx)))
(close-sound ind1)
(close-sound ind2))
(let* ((ind (open-sound "now.snd")))
(set! (amp-control ind) .5)
- (if (ffneq (amp-control ind) .5) (snd-display ";amp-control (.5): ~A?" (amp-control ind)))
+ (if (ffneq (amp-control ind) .5) (snd-display #__line__ ";amp-control (.5): ~A?" (amp-control ind)))
(set! (amp-control ind 0) .25)
- (if (ffneq (amp-control ind) .5) (snd-display ";amp-control after local set (.5): ~A?" (amp-control ind)))
- (if (ffneq (amp-control ind 0) .25) (snd-display ";amp-control 0 (.25): ~A?" (amp-control ind 0)))
+ (if (ffneq (amp-control ind) .5) (snd-display #__line__ ";amp-control after local set (.5): ~A?" (amp-control ind)))
+ (if (ffneq (amp-control ind 0) .25) (snd-display #__line__ ";amp-control 0 (.25): ~A?" (amp-control ind 0)))
(set! (amp-control ind) 1.0)
- (if (ffneq (amp-control ind) 1.0) (snd-display ";amp-control (1.0): ~A?" (amp-control ind)))
- (if (ffneq (amp-control ind 0) .25) (snd-display ";amp-control 0 after set (.25): ~A?" (amp-control ind 0)))
+ (if (ffneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control (1.0): ~A?" (amp-control ind)))
+ (if (ffneq (amp-control ind 0) .25) (snd-display #__line__ ";amp-control 0 after set (.25): ~A?" (amp-control ind 0)))
(set! (transform-graph? ind 0) #t)
(set! (transform-graph-type ind 0) graph-as-sonogram)
(update-transform-graph ind 0)
@@ -10185,21 +10265,21 @@ EDITS: 5
(if (or (not (list? val))
(fneq (car val) 1.0)
(not (= (caddr val) 256)))
- (snd-display ";transform-frames: ~A (~A)" val (transform-size ind 0))))
+ (snd-display #__line__ ";transform-frames: ~A (~A)" val (transform-size ind 0))))
(close-sound ind)
(set! ind (open-sound "4.aiff"))
- (if (ffneq (amp-control ind) 1.0) (snd-display ";amp-control upon open (1.0): ~A?" (amp-control ind)))
- (if (ffneq (amp-control ind 2) 1.0) (snd-display ";amp-control 2 upon open (1.0): ~A?" (amp-control ind 2)))
+ (if (ffneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control upon open (1.0): ~A?" (amp-control ind)))
+ (if (ffneq (amp-control ind 2) 1.0) (snd-display #__line__ ";amp-control 2 upon open (1.0): ~A?" (amp-control ind 2)))
(set! (amp-control ind) .5)
- (if (ffneq (amp-control ind 2) .5) (snd-display ";amp-control 2 after global set (.5): ~A?" (amp-control ind 2)))
+ (if (ffneq (amp-control ind 2) .5) (snd-display #__line__ ";amp-control 2 after global set (.5): ~A?" (amp-control ind 2)))
(set! (amp-control ind 2) .25)
- (if (ffneq (amp-control ind 2) .25) (snd-display ";amp-control 2 (.25): ~A?" (amp-control ind 2)))
- (if (ffneq (amp-control ind 1) .5) (snd-display ";amp-control 1 after local set (.5): ~A?" (amp-control ind 1)))
+ (if (ffneq (amp-control ind 2) .25) (snd-display #__line__ ";amp-control 2 (.25): ~A?" (amp-control ind 2)))
+ (if (ffneq (amp-control ind 1) .5) (snd-display #__line__ ";amp-control 1 after local set (.5): ~A?" (amp-control ind 1)))
(let ((after-ran #f))
(reset-hook! after-apply-controls-hook)
(add-hook! after-apply-controls-hook (lambda (snd) (set! after-ran snd)))
(apply-controls ind)
- (if (not (equal? ind after-ran)) (snd-display ";after-apply-controls-hook: ~A?" after-ran))
+ (if (not (equal? ind after-ran)) (snd-display #__line__ ";after-apply-controls-hook: ~A?" after-ran))
(reset-hook! after-apply-controls-hook))
(revert-sound ind)
(set! (sync ind) 1)
@@ -10209,30 +10289,30 @@ EDITS: 5
(fneq (list-ref mx 1) .2)
(fneq (list-ref mx 2) .2)
(fneq (list-ref mx 3) .2))
- (snd-display ";scale to with vector: ~A" mx)))
+ (snd-display #__line__ ";scale to with vector: ~A" mx)))
(set! (filter-control-envelope ind) '(0 0 1 1))
(if (not (feql '(0.0 0.0 1.0 1.0) (filter-control-envelope ind)))
- (snd-display ";set filter-control-envelope: ~A?" (filter-control-envelope ind)))
+ (snd-display #__line__ ";set filter-control-envelope: ~A?" (filter-control-envelope ind)))
(set! (filter-control-order ind) 20)
(if (not (vequal (filter-control-coeffs ind)
(vct -0.007 0.010 -0.025 0.029 -0.050 0.055 -0.096 0.109 -0.268 0.241
0.241 -0.268 0.109 -0.096 0.055 -0.050 0.029 -0.025 0.010 -0.007)))
- (snd-display ";highpass coeffs: ~A" (filter-control-coeffs ind)))
+ (snd-display #__line__ ";highpass coeffs: ~A" (filter-control-coeffs ind)))
(set! (filter-control-envelope ind) (filter-control-envelope ind))
(if (not (feql '(0.0 0.0 1.0 1.0) (filter-control-envelope ind)))
- (snd-display ";set filter-control-envelope to self: ~A?" (filter-control-envelope ind)))
+ (snd-display #__line__ ";set filter-control-envelope to self: ~A?" (filter-control-envelope ind)))
(set! (filter-control-envelope ind) '(0 1 1 0))
(if (not (vequal (filter-control-coeffs ind)
(vct 0.003 0.002 0.004 0.002 0.007 0.003 0.014 0.012 0.059 0.394
0.394 0.059 0.012 0.014 0.003 0.007 0.002 0.004 0.002 0.003)))
- (snd-display ";lowpass coeffs: ~A" (filter-control-coeffs ind)))
+ (snd-display #__line__ ";lowpass coeffs: ~A" (filter-control-coeffs ind)))
(close-sound ind))
(let* ((obind (open-sound "4.aiff"))
(amps (maxamp obind #t))
(times (maxamp-position obind #t)))
(if (not (equal? times (list 810071 810071 810071 810071)))
- (snd-display ";4.aiff times: ~A" times))
+ (snd-display #__line__ ";4.aiff times: ~A" times))
(if (< (window-width) 600)
(set! (window-width) 600))
(if (< (window-height) 600)
@@ -10242,13 +10322,13 @@ EDITS: 5
(update-time-graph)
(set! (amp-control obind) 0.1)
(select-channel 2)
- (if (eq? (without-errors (apply-controls obind 1)) 'no-such-sound) (snd-display ";apply-controls can't find 4.aiff?"))
+ (if (eq? (without-errors (apply-controls obind 1)) 'no-such-sound) (snd-display #__line__ ";apply-controls can't find 4.aiff?"))
(let ((newamps (maxamp obind #t)))
(if (or (fneq (car amps) (car newamps))
(fneq (cadr amps) (cadr newamps))
(> (abs (- (* 0.1 (caddr amps)) (caddr newamps))) .05)
(fneq (cadddr amps) (cadddr newamps)))
- (snd-display ";apply amps:~% ~A ->~% ~A?" amps newamps))
+ (snd-display #__line__ ";apply amps:~% ~A ->~% ~A?" amps newamps))
(undo 1 obind 2)
(set! (amp-control obind) 0.1)
(make-region 0 (frames obind) obind 1)
@@ -10258,7 +10338,7 @@ EDITS: 5
(> (abs (- (* 0.1 (cadr amps)) (cadr newamps))) .05)
(fneq (caddr amps) (caddr newamps))
(fneq (cadddr amps) (cadddr newamps)))
- (snd-display ";apply selection amp:~% ~A ->~% ~A?" amps newamps))
+ (snd-display #__line__ ";apply selection amp:~% ~A ->~% ~A?" amps newamps))
(if with-gui
(let* ((axinfo (axis-info obind 0 time-graph))
(losamp (car axinfo))
@@ -10269,72 +10349,72 @@ EDITS: 5
(y1 (list-ref axinfo 5))
(xpos (+ x0 (* .5 (- x1 x0))))
(ypos (+ y0 (* .75 (- y1 y0)))))
- (define (cp-x x) (inexact->exact (floor (+ (list-ref axinfo 10)
- (* (- x x0) (/ (- (list-ref axinfo 12) (list-ref axinfo 10))
- (- x1 x0)))))))
- (define (cp-y y) (inexact->exact (floor (+ (list-ref axinfo 13)
- (* (- y1 y) (/ (- (list-ref axinfo 11) (list-ref axinfo 13))
- (- y1 y0)))))))
+ (define (cp-x x) (floor (+ (list-ref axinfo 10)
+ (* (- x x0) (/ (- (list-ref axinfo 12) (list-ref axinfo 10))
+ (- x1 x0))))))
+ (define (cp-y y) (floor (+ (list-ref axinfo 13)
+ (* (- y1 y) (/ (- (list-ref axinfo 11) (list-ref axinfo 13))
+ (- y1 y0))))))
(select-channel 0)
(set! (cursor obind) 100)
(let ((xy (cursor-position obind)))
(if (fneq (position->x (car xy)) (/ (cursor obind) (srate obind)))
- (snd-display ";cursor-position: ~A ~A ~A?" (car xy) (position->x (car xy)) (/ (cursor obind) (srate obind)))))
+ (snd-display #__line__ ";cursor-position: ~A ~A ~A?" (car xy) (position->x (car xy)) (/ (cursor obind) (srate obind)))))
(if (fneq (position->x (x->position xpos)) xpos)
- (snd-display ";x<->position: ~A ~A?" (position->x (x->position xpos)) xpos))
+ (snd-display #__line__ ";x<->position: ~A ~A?" (position->x (x->position xpos)) xpos))
(if (> (abs (- (position->y (y->position ypos)) ypos)) .5)
- (snd-display ";y<->position: ~A ~A?" (position->y (y->position ypos)) ypos))
+ (snd-display #__line__ ";y<->position: ~A ~A?" (position->y (y->position ypos)) ypos))
(if (not (= losamp (left-sample obind 0)))
- (snd-display ";axis-info[0 losamp]: ~A ~A?" losamp (left-sample obind 0)))
+ (snd-display #__line__ ";axis-info[0 losamp]: ~A ~A?" losamp (left-sample obind 0)))
(if (not (= hisamp (right-sample obind 0)))
- (snd-display ";axis-info[1 hisamp]: ~A ~A?" hisamp (right-sample obind 0)))
+ (snd-display #__line__ ";axis-info[1 hisamp]: ~A ~A?" hisamp (right-sample obind 0)))
(if (fneq (list-ref axinfo 6) 0.0)
- (snd-display ";axis-info[6 xmin]: ~A?" (list-ref axinfo 6)))
+ (snd-display #__line__ ";axis-info[6 xmin]: ~A?" (list-ref axinfo 6)))
(if (fneq (list-ref axinfo 7) -1.0)
- (snd-display ";axis-info[7 ymin]: ~A?" (list-ref axinfo 7)))
+ (snd-display #__line__ ";axis-info[7 ymin]: ~A?" (list-ref axinfo 7)))
(if (fneq (list-ref axinfo 9) 1.0)
- (snd-display ";axis-info[9 ymax]: ~A?" (list-ref axinfo 9)))
+ (snd-display #__line__ ";axis-info[9 ymax]: ~A?" (list-ref axinfo 9)))
(if (> (abs (apply - (our-x->position obind x0))) 1)
- (snd-display ";x0->position: ~A?" (our-x->position obind x0)))
+ (snd-display #__line__ ";x0->position: ~A?" (our-x->position obind x0)))
(if (> (abs (apply - (our-x->position obind x1))) 1)
- (snd-display ";x1->position: ~A?" (our-x->position obind x1)))
+ (snd-display #__line__ ";x1->position: ~A?" (our-x->position obind x1)))
(if (> (abs (apply - (our-x->position obind (* 0.5 (+ x0 x1))))) 1)
- (snd-display ";xmid->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
+ (snd-display #__line__ ";xmid->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
(if (not full-test)
(begin
(if (> (abs (- (x->position xpos) (cp-x xpos))) 1)
- (snd-display ";cp-x .5: ~A ~A?" (x->position xpos) (cp-x xpos)))
+ (snd-display #__line__ ";cp-x .5: ~A ~A?" (x->position xpos) (cp-x xpos)))
(if (> (abs (- (y->position ypos) (cp-y ypos))) 1)
- (snd-display ";cp-y .75: ~A ~A?" (y->position ypos) (cp-y ypos)))
+ (snd-display #__line__ ";cp-y .75: ~A ~A?" (y->position ypos) (cp-y ypos)))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((xpos (+ x0 (random (- x1 x0))))
(ypos (+ y0 (random (- y1 y0)))))
(if (> (abs (- (x->position xpos) (cp-x xpos))) 1)
- (snd-display ";cp-x[~A] ~A: ~A ~A?" i xpos (x->position xpos) (cp-x xpos)))
+ (snd-display #__line__ ";cp-x[~A] ~A: ~A ~A?" i xpos (x->position xpos) (cp-x xpos)))
(if (> (abs (- (y->position ypos) (cp-y ypos))) 1)
- (snd-display ";cp-y[~A] ~A: ~A ~A?" i ypos (y->position ypos) (cp-y ypos)))
+ (snd-display #__line__ ";cp-y[~A] ~A: ~A ~A?" i ypos (y->position ypos) (cp-y ypos)))
(if (fneq (position->x (cp-x xpos)) xpos)
- (snd-display ";x->position cp-x ~A ~A" xpos (position->x (cp-x xpos))))
+ (snd-display #__line__ ";x->position cp-x ~A ~A" xpos (position->x (cp-x xpos))))
(if (fffneq (position->y (cp-y ypos)) ypos)
- (snd-display ";y->position cp-y ~A ~A" ypos (position->y (cp-y ypos))))))))
+ (snd-display #__line__ ";y->position cp-y ~A ~A" ypos (position->y (cp-y ypos))))))))
(set! (left-sample obind 0) 1234)
(if (not (= 1234 (car (axis-info obind 0))))
- (snd-display ";axis-info[0 losamp at 1234]: ~A ~A?" (car (axis-info obind 0)) (left-sample obind 0)))
+ (snd-display #__line__ ";axis-info[0 losamp at 1234]: ~A ~A?" (car (axis-info obind 0)) (left-sample obind 0)))
(set! axinfo (axis-info obind 0))
(set! x0 (list-ref axinfo 2))
(set! x1 (list-ref axinfo 4))
(if (> (abs (apply - (our-x->position obind x0))) 1)
- (snd-display ";x0a->position: ~A?" (our-x->position obind x0)))
+ (snd-display #__line__ ";x0a->position: ~A?" (our-x->position obind x0)))
(if (> (abs (apply - (our-x->position obind x1))) 1)
- (snd-display ";x1a->position: ~A?" (our-x->position obind x1)))
+ (snd-display #__line__ ";x1a->position: ~A?" (our-x->position obind x1)))
(if (> (abs (apply - (our-x->position obind (* 0.5 (+ x0 x1))))) 1)
- (snd-display ";xmida->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
+ (snd-display #__line__ ";xmida->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
(set! (y-bounds obind 0) (list -2.0 3.0))
(if (fneq (list-ref (axis-info obind 0) 7) -2.0)
- (snd-display ";axis-info[7 ymin -2.0]: ~A?" (list-ref (axis-info obind 0) 7)))
+ (snd-display #__line__ ";axis-info[7 ymin -2.0]: ~A?" (list-ref (axis-info obind 0) 7)))
(if (fneq (list-ref (axis-info obind 0) 9) 3.0)
- (snd-display ";axis-info[9 ymax 3.0]: ~A?" (list-ref (axis-info obind 0) 9)))
+ (snd-display #__line__ ";axis-info[9 ymax 3.0]: ~A?" (list-ref (axis-info obind 0) 9)))
))
(close-sound obind)))
@@ -10385,10 +10465,10 @@ EDITS: 5
(let ((var (catch #t (lambda () (src-sound '(0 0 1 1))) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";src-sound env at 0: ~A" var)))
+ (snd-display #__line__ ";src-sound env at 0: ~A" var)))
(let ((var (catch #t (lambda () (src-sound '(0 1 1 -1))) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";src-sound env through 0: ~A" var)))
+ (snd-display #__line__ ";src-sound env through 0: ~A" var)))
(scale-to 1.0 ind1)
(let ((v0 (make-vct 10))
@@ -10400,21 +10480,21 @@ EDITS: 5
(convolve-files "fmv4.snd" "fmv3.snd" 1.0 "fmv5.snd")
(let ((v2 (samples->vct 12000 10 ind1 0)))
(if (not (vfequal v1 v2))
- (snd-display ";~A (orig: 0) ~A ~A" 'convolve-with v1 v2))
+ (snd-display #__line__ ";~A (orig: 0) ~A ~A" 'convolve-with v1 v2))
(file->array "fmv5.snd" 0 12000 10 v2)
(if (not (vfequal v1 v2))
- (snd-display ";convolve-files: (orig: 0) ~A ~A" v1 v2)))
+ (snd-display #__line__ ";convolve-files: (orig: 0) ~A ~A" v1 v2)))
(delete-file "fmv3.snd")
(delete-file "fmv5.snd"))
(convolve-files "2.snd" "oboe.snd" 0.5 "fmv5.snd")
(if (or (fneq (cadr (mus-sound-maxamp "fmv5.snd")) 0.25)
(fneq (cadddr (mus-sound-maxamp "fmv5.snd")) 0.5))
- (snd-display ";convolve-files stereo: ~A" (mus-sound-maxamp "fmv5.snd")))
+ (snd-display #__line__ ";convolve-files stereo: ~A" (mus-sound-maxamp "fmv5.snd")))
(delete-file "fmv5.snd")
(scale-to .25 ind1)
(set! (y-bounds ind1) '())
(if (not (equal? (y-bounds ind1) (list -.25 .25)))
- (snd-display ";y-bounds '(): ~A?" (y-bounds ind1)))
+ (snd-display #__line__ ";y-bounds '(): ~A?" (y-bounds ind1)))
(revert-sound ind1)
(scale-to 1.0 ind1)
@@ -10426,10 +10506,10 @@ EDITS: 5
(convolve-files "fmv4.snd" "fmv3.snd" 1.0 "fmv5.snd")
(let ((v2 (samples->vct 12005 10 ind1 0)))
(if (not (vfequal v1 v2))
- (snd-display ";~A (orig: 2) ~A ~A" 'convolve-with v1 v2))
+ (snd-display #__line__ ";~A (orig: 2) ~A ~A" 'convolve-with v1 v2))
(file->array "fmv5.snd" 0 12005 10 v2)
(if (not (vfequal v1 v2))
- (snd-display ";convolve-files: (orig: 2) ~A ~A" v1 v2)))
+ (snd-display #__line__ ";convolve-files: (orig: 2) ~A ~A" v1 v2)))
(delete-file "fmv3.snd")
(delete-file "fmv4.snd")
(delete-file "fmv5.snd"))
@@ -10441,33 +10521,33 @@ EDITS: 5
(select-all ind1)
(set! (selection-creates-region) old-val)
(if (not (equal? old-regions (regions)))
- (snd-display ";selection-create-region: ~A -> ~A?" old-regions (regions))))
+ (snd-display #__line__ ";selection-create-region: ~A -> ~A?" old-regions (regions))))
(convolve-selection-with "pistol.snd" (maxamp))
(let ((data (samples->vct 12000 10 ind1 0)))
(convolve-with "pistol.snd" (maxamp ind1 0 0) ind1 0 0)
(let ((new-data (samples->vct 12000 10 ind1 0)))
(if (not (vfequal data new-data))
- (snd-display ";convolve-selection-with: ~A ~A?" data new-data))))
+ (snd-display #__line__ ";convolve-selection-with: ~A ~A?" data new-data))))
(revert-sound ind1)
(make-selection 1000 2000 ind1)
(let ((ma (maxamp ind1)))
(convolve-selection-with "pistol.snd" ma)
- (if (fneq (maxamp ind1) ma) (snd-display ";convolve-selection-with 1000: ~A ~A?" ma (maxamp ind1))))
+ (if (fneq (maxamp ind1) ma) (snd-display #__line__ ";convolve-selection-with 1000: ~A ~A?" ma (maxamp ind1))))
(make-selection 1000 2000 ind1)
(let ((id (make-region)))
(if (not (region? id))
- (snd-display ";make-region argless: ~A" id))
+ (snd-display #__line__ ";make-region argless: ~A" id))
(if (not (= (region-frames id 0) (selection-frames)))
- (snd-display ";region/selection-frames: ~A ~A (~A)?" (region-frames id 0) (selection-frames) (region-frames id)))
+ (snd-display #__line__ ";region/selection-frames: ~A ~A (~A)?" (region-frames id 0) (selection-frames) (region-frames id)))
(if (fneq (region-sample id 0) (sample 1000 ind1))
- (snd-display ";region-sample from make-region: ~A ~A?" (region-sample id 0) (sample 1000 ind1))))
+ (snd-display #__line__ ";region-sample from make-region: ~A ~A?" (region-sample id 0) (sample 1000 ind1))))
(close-sound ind1))
(let* ((ind (open-sound "2.snd"))
(reg (make-region 0 100 ind #t)))
(if (not (equal? (region-home reg) (list "2.snd" 0 100)))
- (snd-display ";make + region-home: ~A" (region-home reg)))
+ (snd-display #__line__ ";make + region-home: ~A" (region-home reg)))
(if (not (= (region-chans reg) 2))
- (snd-display ";make-region chan #t: ~A" (region-chans reg)))
+ (snd-display #__line__ ";make-region chan #t: ~A" (region-chans reg)))
(close-sound ind))
(let ((ind1 (open-sound "2.snd")))
@@ -10478,19 +10558,19 @@ EDITS: 5
(v3 (samples->vct 12000 10 ind1 1)))
(if (or (vequal v0 v2)
(vequal v1 v3))
- (snd-display ";swap-channels 0: no change! ~A ~A ~A ~A" v0 v2 v1 v3)))
+ (snd-display #__line__ ";swap-channels 0: no change! ~A ~A ~A ~A" v0 v2 v1 v3)))
(swap-channels ind1)
(let ((v2 (samples->vct 12000 10 ind1 0))
(v3 (samples->vct 12000 10 ind1 1)))
(if (or (not (vequal v0 v2))
(not (vequal v1 v3)))
- (snd-display ";swap-channels 1: ~A ~A ~A ~A" v0 v2 v1 v3)))
+ (snd-display #__line__ ";swap-channels 1: ~A ~A ~A ~A" v0 v2 v1 v3)))
;; as long as we're here...
(set! (cursor ind1 0) 100)
(set! (cursor ind1 1) 200)
(if (or (not (= (cursor ind1 0) 100))
(not (= (cursor ind1 1) 200)))
- (snd-display ";cursor: ~A ~A?" (cursor ind1 0) (cursor ind1 1)))
+ (snd-display #__line__ ";cursor: ~A ~A?" (cursor ind1 0) (cursor ind1 1)))
(set! (sync ind1) 1)
(scale-by (list .5 .25) ind1)
(scale-by (vct 2.0 4.0) ind1)
@@ -10500,12 +10580,12 @@ EDITS: 5
(let ((newamps (maxamp ind1 #t)))
(if (or (fneq (car amps) (cadr newamps))
(fneq (cadr amps) (car newamps)))
- (snd-display ";swap-channels with cp def: ~A ~A" amps newamps)))
+ (snd-display #__line__ ";swap-channels with cp def: ~A ~A" amps newamps)))
(swap-channels ind1 1)
(let ((newamps (maxamp ind1 #t)))
(if (or (fneq (car amps) (car newamps))
(fneq (cadr amps) (cadr newamps)))
- (snd-display ";swap-channels with cp def 0: ~A ~A" amps newamps))))
+ (snd-display #__line__ ";swap-channels with cp def 0: ~A ~A" amps newamps))))
(close-sound ind1)))
(let ((ind1 (open-sound "oboe.snd"))
@@ -10519,7 +10599,7 @@ EDITS: 5
0 (frames ind1) ind1 0)
count)))
(if (not (= ups1 ups2))
- (snd-display ";scan-chan: ~A ~A?" ups1 ups2))
+ (snd-display #__line__ ";scan-chan: ~A ~A?" ups1 ups2))
(set! ups1 (count-matches (lambda (n) (> n .03)) 0 ind2 0))
(set! ups2 (count-matches (lambda (n) (> n .03)) 0 ind2 1))
(let ((ups3 (let ((count 0))
@@ -10537,46 +10617,46 @@ EDITS: 5
0 (frames ind2) ind2 1)
count)))
(if (not (= ups1 ups3))
- (snd-display ";2[0] scan-chan: ~A ~A?" ups1 ups3))
+ (snd-display #__line__ ";2[0] scan-chan: ~A ~A?" ups1 ups3))
(if (not (= ups2 ups4))
- (snd-display ";2[1] scan-chan: ~A ~A?" ups2 ups4))))
+ (snd-display #__line__ ";2[1] scan-chan: ~A ~A?" ups2 ups4))))
(select-sound ind1)
(forward-graph)
(if (or (not (equal? (selected-sound) ind2))
(not (= (selected-channel) 0)))
- (snd-display ";forward from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";forward from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
(forward-graph)
(if (or (not (equal? (selected-sound) ind2))
(not (= (selected-channel) 1)))
- (snd-display ";forward from ~A 0 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";forward from ~A 0 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
(forward-graph 1)
(if (or (not (equal? (selected-sound) ind1))
(not (= (selected-channel) 0)))
- (snd-display ";forward from ~A 1 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";forward from ~A 1 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
(forward-graph 2)
(if (or (not (equal? (selected-sound) ind2))
(not (= (selected-channel) 1)))
- (snd-display ";forward from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";forward from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
(forward-graph 0)
(if (or (not (equal? (selected-sound) ind2))
(not (= (selected-channel) 1)))
- (snd-display ";forward 0 from ~A 1 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";forward 0 from ~A 1 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
(backward-graph 2)
(if (or (not (equal? (selected-sound) ind1))
(not (= (selected-channel) 0)))
- (snd-display ";backward 2 from ~A 1 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";backward 2 from ~A 1 to ~A ~A?" ind2 (selected-sound) (selected-channel)))
(backward-graph)
(if (or (not (equal? (selected-sound) ind2))
(not (= (selected-channel) 1)))
- (snd-display ";backward 2 from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";backward 2 from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
(forward-graph -1)
(if (or (not (equal? (selected-sound) ind2))
(not (= (selected-channel) 0)))
- (snd-display ";forward -1 from ~A 1 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";forward -1 from ~A 1 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
(backward-graph -1)
(if (or (not (equal? (selected-sound) ind2))
(not (= (selected-channel) 1)))
- (snd-display ";backward -1 from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
+ (snd-display #__line__ ";backward -1 from ~A 0 to ~A ~A?" ind1 (selected-sound) (selected-channel)))
(close-sound ind1)
(close-sound ind2))
@@ -10591,7 +10671,7 @@ EDITS: 5
#f))
0 (frames ind1) "ignore: cut 2" ind1 0)
(if (> (frames ind1) (+ (* len 2) 1))
- (snd-display ";map-chan cut: ~A ~A?" len (frames ind1)))
+ (snd-display #__line__ ";map-chan cut: ~A ~A?" len (frames ind1)))
(revert-sound ind1)
(set! ctr 0)
(map-chan (lambda (n)
@@ -10601,7 +10681,7 @@ EDITS: 5
n))
0 (frames ind1) "ignore: cut none" ind1 0)
(if (> ctr 4)
- (snd-display ";map-chan no-edit count: ~A?" ctr))
+ (snd-display #__line__ ";map-chan no-edit count: ~A?" ctr))
(revert-sound ind1)
(let ((v1 (make-vct 2)))
(map-chan (lambda (n)
@@ -10610,35 +10690,35 @@ EDITS: 5
v1)
0 (frames ind1) "ignore: cut 2" ind1 0))
(if (> (abs (- (frames ind1) (* len 2))) 3)
- (snd-display ";map-chan double: ~A ~A?" len (frames ind1)))
+ (snd-display #__line__ ";map-chan double: ~A ~A?" len (frames ind1)))
(revert-sound ind1)
(let ((otime (maxamp-position ind1)))
(set! (sample 1234) .9)
(let* ((ntime (maxamp-position ind1))
(nval (maxamp ind1))
(npos (edit-position ind1 0)))
- (if (not (= ntime 1234)) (snd-display ";maxamp-position 1234: ~A" ntime))
+ (if (not (= ntime 1234)) (snd-display #__line__ ";maxamp-position 1234: ~A" ntime))
(let ((ootime (maxamp-position ind1 0 0)))
- (if (not (= ootime otime)) (snd-display ";maxamp-position edpos 0: ~A ~A" otime ootime)))
+ (if (not (= ootime otime)) (snd-display #__line__ ";maxamp-position edpos 0: ~A ~A" otime ootime)))
(let ((nntime (maxamp-position ind1 0 npos)))
- (if (not (= nntime ntime)) (snd-display ";maxamp-position edpos ~D: ~A ~A" npos ntime nntime)))
- (if (fneq nval .9) (snd-display ";maxamp .9: ~A" nval)))
+ (if (not (= nntime ntime)) (snd-display #__line__ ";maxamp-position edpos ~D: ~A ~A" npos ntime nntime)))
+ (if (fneq nval .9) (snd-display #__line__ ";maxamp .9: ~A" nval)))
(set! (sample 1234) 0.0)
(env-channel '(0 0 1 1))
- (if (not (= (maxamp-position) 35062)) (snd-display ";env-channel maxamp-position: ~A" (maxamp-position)))
+ (if (not (= (maxamp-position) 35062)) (snd-display #__line__ ";env-channel maxamp-position: ~A" (maxamp-position)))
(let ((ootime (maxamp-position ind1 0 0)))
- (if (not (= ootime otime)) (snd-display ";maxamp-position edpos 0(1): ~A ~A" otime ootime)))
+ (if (not (= ootime otime)) (snd-display #__line__ ";maxamp-position edpos 0(1): ~A ~A" otime ootime)))
(let ((nntime (maxamp-position ind1 0 1)))
- (if (not (= nntime 1234)) (snd-display ";maxamp-position edpos 1(1): ~A ~A" 1234 nntime)))
+ (if (not (= nntime 1234)) (snd-display #__line__ ";maxamp-position edpos 1(1): ~A ~A" 1234 nntime)))
(let ((nntime (maxamp-position ind1 0 current-edit-position)))
- (if (not (= nntime 35062)) (snd-display ";maxamp-position edpos current: ~A ~A" 35062 nntime))))
+ (if (not (= nntime 35062)) (snd-display #__line__ ";maxamp-position edpos current: ~A ~A" 35062 nntime))))
(revert-sound ind1)
(make-selection 24000 25000)
(if (not (= (selection-maxamp-position) 971))
- (snd-display ";selection maxamp position: ~A" (selection-maxamp-position)))
+ (snd-display #__line__ ";selection maxamp position: ~A" (selection-maxamp-position)))
(let ((reg (make-region 24000 25000)))
(if (not (= (region-maxamp-position reg) 971))
- (snd-display ";region maxamp position: ~A" (region-maxamp-position))))
+ (snd-display #__line__ ";region maxamp position: ~A" (region-maxamp-position))))
(close-sound ind1))
(let* ((ind1 (open-sound "oboe.snd")))
(test-edpos maxamp 'maxamp (lambda () (scale-by 2.0 ind1 0)) ind1)
@@ -10668,35 +10748,31 @@ EDITS: 5
ind1)
(src-sound 2.0 1.0 ind1 0)
- (play-and-wait 0 ind1 0 #f #f 0)
- (play-and-wait 0 ind1 0 #f #f 1)
- (play-and-wait 0 ind1 0 #f #f (lambda (snd chn) (edit-position snd chn)))
(undo 1 ind1 0)
- (play-and-wait 0 ind1 0 #f #f 1)
(delete-samples 0 10000 ind1 0)
(save-sound-as "fmv.snd" ind1 :edit-position 0)
(save-sound-as "fmv1.snd" ind1 :edit-position (lambda (snd chn) 1))
(let ((var (catch #t (lambda () (save-sound-as "fmv2.snd" ind1 :channel 1234)) (lambda args args))))
(if (not (eq? (car var) 'no-such-channel))
- (snd-display ";save-sound-as bad chan: ~A" var)))
+ (snd-display #__line__ ";save-sound-as bad chan: ~A" var)))
(if (not (= (mus-sound-frames "fmv.snd") (frames ind1 0 0)))
- (snd-display ";save-sound-as (edpos): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 0)))
+ (snd-display #__line__ ";save-sound-as (edpos): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 0)))
(if (not (= (mus-sound-frames "fmv1.snd") (frames ind1 0 1)))
- (snd-display ";save-sound-as (edpos 1): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 1)))
+ (snd-display #__line__ ";save-sound-as (edpos 1): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 1)))
(if (= (mus-sound-frames "fmv.snd") (frames ind1 0 1))
- (snd-display ";save-sound-as (edpos 1)(2): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 1)))
+ (snd-display #__line__ ";save-sound-as (edpos 1)(2): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 1)))
(let ((ind2 (open-sound "fmv.snd"))
(ind3 (open-sound "fmv1.snd")))
(if (not (vequal (samples->vct 12000 10 ind1 0 #f 0) (samples->vct 12000 10 ind2 0)))
- (snd-display ";save-sound-as (edpos 3): ~A ~A?" (samples->vct 12000 10 ind1 0 #f 0) (samples->vct 12000 10 ind2 0)))
+ (snd-display #__line__ ";save-sound-as (edpos 3): ~A ~A?" (samples->vct 12000 10 ind1 0 #f 0) (samples->vct 12000 10 ind2 0)))
(if (not (vequal (samples->vct 12000 10 ind1 0 #f 1) (samples->vct 12000 10 ind3 0)))
- (snd-display ";save-sound-as (edpos 4): ~A ~A?" (samples->vct 12000 10 ind1 0 #f 1) (samples->vct 12000 10 ind3 0)))
+ (snd-display #__line__ ";save-sound-as (edpos 4): ~A ~A?" (samples->vct 12000 10 ind1 0 #f 1) (samples->vct 12000 10 ind3 0)))
(if (vequal (samples->vct 12000 10 ind2 0) (samples->vct 12000 10 ind3 0))
- (snd-display ";save-sound-as (edpos 5): ~A ~A?" (samples->vct 12000 10 ind2 0) (samples->vct 12000 10 ind3 0)))
+ (snd-display #__line__ ";save-sound-as (edpos 5): ~A ~A?" (samples->vct 12000 10 ind2 0) (samples->vct 12000 10 ind3 0)))
(select-sound ind3)
(set! (comment) "hiho")
- (if (not (string=? (comment) "hiho")) (snd-display ";set! comment no index: ~A" (comment)))
+ (if (not (string=? (comment) "hiho")) (snd-display #__line__ ";set! comment no index: ~A" (comment)))
(close-sound ind2)
(close-sound ind3))
(delete-file "fmv.snd")
@@ -10717,20 +10793,20 @@ EDITS: 5
val)))
(vct->channel v 0 2000 ind 0)
(filter-sound '(0 0 .09 0 .1 1 .11 0 1 0) 1024)
- (if (> (maxamp) .025) (snd-display ";filter-sound maxamp 1: ~A" (maxamp)))
+ (if (> (maxamp) .025) (snd-display #__line__ ";filter-sound maxamp 1: ~A" (maxamp)))
(undo)
(filter-sound '(0 0 .19 0 .2 1 .21 0 1 0) 1024)
- (if (< (maxamp) .9) (snd-display ";filter-sound maxamp 2: ~A" (maxamp)))
+ (if (< (maxamp) .9) (snd-display #__line__ ";filter-sound maxamp 2: ~A" (maxamp)))
(undo)
(filter-sound '(0 0 .29 0 .3 1 .31 0 1 0) 1024)
- (if (> (maxamp) .02) (snd-display ";filter-sound maxamp 3: ~A" (maxamp)))
+ (if (> (maxamp) .02) (snd-display #__line__ ";filter-sound maxamp 3: ~A" (maxamp)))
(set! (show-sonogram-cursor) #t)
(set! (cursor-follows-play) #t)
- (if (not (cursor-follows-play)) (snd-display ";cursor-follows-play set to #t: ~A" (cursor-follows-play)))
-
+ (if (not (cursor-follows-play)) (snd-display #__line__ ";cursor-follows-play set to #t: ~A" (cursor-follows-play)))
+
(set! (transform-graph-type) graph-as-sonogram)
- (play-and-wait)
+ (play :wait #t)
(set! (transform-graph?) #t)
(close-sound ind))
@@ -10743,7 +10819,7 @@ EDITS: 5
(define (peak-env-equal? name index e diff)
(let* ((reader (make-sampler 0 index 0))
(e-size (vct-length (car e)))
- (samps-per-bin (inexact->exact (ceiling (/ (frames index) e-size))))
+ (samps-per-bin (ceiling (/ (frames index) e-size)))
(mins (car e))
(maxs (cadr e))
(max-diff 0.0)
@@ -10754,7 +10830,7 @@ EDITS: 5
(mn 10.0))
((or (not happy) (= e-bin e-size))
happy)
- (if (>= samp (inexact->exact (floor samps-per-bin)))
+ (if (>= samp (floor samps-per-bin))
(let ((mxdiff (abs (- mx (vct-ref maxs e-bin))))
(mndiff (abs (- mn (vct-ref mins e-bin)))))
(if (> mxdiff max-diff)
@@ -10764,7 +10840,7 @@ EDITS: 5
(if (or (> mxdiff diff)
(> mndiff diff))
(begin
- (snd-display ";~A: peak-env-equal? [bin ~D of ~D]: (~,4F to ~,4F), diff: ~,5F"
+ (snd-display #__line__ ";~A: peak-env-equal? [bin ~D of ~D]: (~,4F to ~,4F), diff: ~,5F"
name
e-bin e-size
mn mx
@@ -10781,11 +10857,11 @@ EDITS: 5
(set! mx val))))))
(if (null? e0)
- (snd-display ";no amp env data")
+ (snd-display #__line__ ";no amp env data")
(let ((mx1 (vct-peak (car e0)))
(mx2 (vct-peak (cadr e0))))
(if (fneq mx (max mx1 mx2))
- (snd-display ";amp env max: ~A ~A ~A" mx mx1 mx2))
+ (snd-display #__line__ ";amp env max: ~A ~A ~A" mx mx1 mx2))
(peak-env-equal? "straight peak" ind e0 .0001)
(scale-by 3.0)
(let* ((e1 (channel-amp-envs ind 0 1))
@@ -10793,10 +10869,10 @@ EDITS: 5
(mx4 (vct-peak (cadr e1))))
(if (or (fneq (* 3.0 mx1) mx3)
(fneq (* 3.0 mx2) mx4))
- (snd-display ";3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (snd-display #__line__ ";3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
(peak-env-equal? "scaled peak" ind e1 .0001))
(if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display ";maxamp after scale: ~A ~A" mx (maxamp ind 0)))
+ (snd-display #__line__ ";maxamp after scale: ~A ~A" mx (maxamp ind 0)))
(undo)
(set! (selection-member? #t) #f)
(set! (selection-member? ind 0) #t)
@@ -10808,39 +10884,39 @@ EDITS: 5
(mx4 (vct-peak (cadr e1))))
(if (or (fneq (* 3.0 mx1) mx3)
(fneq (* 3.0 mx2) mx4))
- (snd-display ";selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (snd-display #__line__ ";selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
(if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display ";maxamp after selection scale: ~A ~A" mx (maxamp ind 0)))
+ (snd-display #__line__ ";maxamp after selection scale: ~A ~A" mx (maxamp ind 0)))
(peak-env-equal? "selection peak" ind e1 .0001))
(map-chan abs 0 #f "test" ind 0)
(let* ((e1 (channel-amp-envs ind 0 2))
(mx3 (vct-peak (car e1)))
(mx4 (vct-peak (cadr e1))))
(if (fneq (* 3.0 mx2) mx4)
- (snd-display ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (snd-display #__line__ ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
(if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
+ (snd-display #__line__ ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
(if (ffneq mx3 0.03)
- (snd-display ";abs max: ~A ~A" mx3 mx4))
+ (snd-display #__line__ ";abs max: ~A ~A" mx3 mx4))
(peak-env-equal? "map-chan peak" ind e1 .0001))
(delete-samples 10000 5000)
(let* ((e1 (channel-amp-envs ind 0))
(mx3 (vct-peak (car e1)))
(mx4 (vct-peak (cadr e1))))
(if (fneq (* 3.0 mx2) mx4)
- (snd-display ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (snd-display #__line__ ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
(if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
+ (snd-display #__line__ ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
(if (ffneq mx3 0.03)
- (snd-display ";abs max: ~A ~A" mx3 mx4))
+ (snd-display #__line__ ";abs max: ~A ~A" mx3 mx4))
(peak-env-equal? "delete peak" ind e1 .0001))
(scale-selection-by -.333)
(let* ((e1 (channel-amp-envs ind 0 4))
(mx3 (vct-peak (car e1))))
(if (fneq (maxamp ind 0) mx)
- (snd-display ";maxamp after minus abs selection scale: ~A ~A" mx (maxamp ind 0)))
+ (snd-display #__line__ ";maxamp after minus abs selection scale: ~A ~A" mx (maxamp ind 0)))
(if (fneq (maxamp ind 0) mx3)
- (snd-display ";mx3 maxamp after minus abs selection scale: ~A ~A" mx mx3))
+ (snd-display #__line__ ";mx3 maxamp after minus abs selection scale: ~A ~A" mx mx3))
(peak-env-equal? "scale-selection peak" ind e1 .0001))
(revert-sound ind)
@@ -11009,7 +11085,7 @@ EDITS: 5
))
(close-sound ind))
-
+
;; ptree-channel init-func state cases
(let ((ind (new-sound "test.snd" :size 10 :comment "ptree-channel state tests")))
(set! (sample 5) 1.0)
@@ -11022,7 +11098,7 @@ EDITS: 5
0.5)
"ptree channel float arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.250 0.500 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with float state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with float state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val int) (dir boolean))
@@ -11032,7 +11108,7 @@ EDITS: 5
3)
"ptree channel int arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.500 3.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with int state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with int state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val boolean) (dir boolean))
@@ -11042,7 +11118,7 @@ EDITS: 5
#t)
"ptree channel boolean arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with boolean state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with boolean state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val char) (dir boolean))
@@ -11052,7 +11128,7 @@ EDITS: 5
#\f)
"ptree channel char arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with char state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with char state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val string) (dir boolean))
@@ -11062,7 +11138,7 @@ EDITS: 5
"hiho")
"ptree channel string arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with string state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with string state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val vct) (dir boolean))
@@ -11072,7 +11148,7 @@ EDITS: 5
(make-vct 1 2.0))
"ptree channel vct arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.000 2.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with vct state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with vct state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val sound-data) (dir boolean))
@@ -11084,7 +11160,7 @@ EDITS: 5
sd))
"ptree channel sound-data arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -2.000 4.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with sound-data state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with sound-data state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val symbol) (dir boolean))
@@ -11094,7 +11170,7 @@ EDITS: 5
'hiho)
"ptree channel symbol arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with symbol state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with symbol state: ~A" (channel->vct 0 10 ind 0)))
(undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val keyword) (dir boolean))
@@ -11104,7 +11180,7 @@ EDITS: 5
:hiho)
"ptree channel keyword arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with keyword state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with keyword state: ~A" (channel->vct 0 10 ind 0)))
(undo)
;; this works, but can't currently be optimized:
;; (ptree-channel (lambda (y val dir)
@@ -11114,7 +11190,7 @@ EDITS: 5
;; (lambda (beg dur)
;; (list 2.0 100.0)))
;; (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.000 2.000 0.000 0.000 0.000 0.000)))
- ;; (snd-display ";ptree-channel with list state: ~A" (channel->vct 0 10 ind 0)))
+ ;; (snd-display #__line__ ";ptree-channel with list state: ~A" (channel->vct 0 10 ind 0)))
;; (undo)
(ptree-channel (lambda (y val dir)
(declare (y real) (val sampler) (dir boolean))
@@ -11125,22 +11201,22 @@ EDITS: 5
(make-sampler beg ind 0 1 2)) ; beg here is vital! as is "2" for edpos
"ptree channel sampler arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.250 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with reader state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with reader state: ~A" (channel->vct 0 10 ind 0)))
(undo)
-
+
;; this can't work because it needs access to previous samples (the generator has internal state)
-; (ptree-channel (lambda (y val dir)
-; (declare (y real) (val clm) (dir boolean))
-; (one-zero val y))
-; 0 10 ind 0 -1 #t
-; (lambda (beg dur)
-; (make-one-zero .5 .5))
-; "ptree channel clm arg")
-; (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.250 0.250 0.500 0.000 0.000 0.000)))
-; (snd-display ";ptree-channel with clm state: ~A from ~A"
-; (channel->vct 0 10 ind 0)
-; (channel->vct 0 10 ind 0 (- (edit-position ind 0) 1))))
-; (undo)
+ ; (ptree-channel (lambda (y val dir)
+ ; (declare (y real) (val clm) (dir boolean))
+ ; (one-zero val y))
+ ; 0 10 ind 0 -1 #t
+ ; (lambda (beg dur)
+ ; (make-one-zero .5 .5))
+ ; "ptree channel clm arg")
+ ; (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.250 0.250 0.500 0.000 0.000 0.000)))
+ ; (snd-display #__line__ ";ptree-channel with clm state: ~A from ~A"
+ ; (channel->vct 0 10 ind 0)
+ ; (channel->vct 0 10 ind 0 (- (edit-position ind 0) 1))))
+ ; (undo)
(let ((mx (mix-vct (vct .2 .3 .4) 2 ind 0 #t)))
(ptree-channel (lambda (y val dir)
(declare (y real) (val mix-sampler) (dir boolean))
@@ -11149,11 +11225,11 @@ EDITS: 5
0 10 ind 0 -1 #f
(lambda (beg dur)
(make-mix-sampler mx beg))
- "ptree channel mix-sampler arg"))
+ "ptree channel mix-sampler arg"))
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.200 0.300 0.600 0.300 -0.100 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with mix reader state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with mix reader state: ~A" (channel->vct 0 10 ind 0)))
(set! (edit-position ind 0) 2)
-
+
;; now check error handling...
(ptree-channel (lambda (y val dir)
(declare (y real) (val vct) (dir boolean))
@@ -11163,9 +11239,9 @@ EDITS: 5
(make-vct 1 2.0))
"ptree channel vct unrefd arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.000 2.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with unrefd vct state: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";ptree-channel with unrefd vct state: ~A" (channel->vct 0 10 ind 0)))
(undo)
-
+
;; this does print an error message, but trying to halt execution leads to a segfault
;; (let ((tag (catch #t
;; (lambda ()
@@ -11178,7 +11254,7 @@ EDITS: 5
;; "ptree channel vector arg"))
;; (lambda args (car args)))))
;; (if (not (eq? tag 'snd-error))
- ;; (snd-display ";ptree-channel vector arg: ~A" tag)))
+ ;; (snd-display #__line__ ";ptree-channel vector arg: ~A" tag)))
;; now check 3 ptrees with different types
(ptree-channel (lambda (y val dir)
@@ -11203,11 +11279,11 @@ EDITS: 5
#t)
"ptree channel boolean arg")
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ptree-channel with 3 states: ~A" (channel->vct 0 10 ind 0)))
-
+ (snd-display #__line__ ";ptree-channel with 3 states: ~A" (channel->vct 0 10 ind 0)))
+
(close-sound ind)
(if (file-exists? "test.snd") (delete-file "test.snd")))
-
+
(let ((ind (new-sound "test.snd")))
(map-chan (lambda (y) 1.0) 0 50000)
(ramp-channel 0.5 1.0 1000 4000)
@@ -11216,15 +11292,15 @@ EDITS: 5
(mn (car peaks)))
(call-with-current-continuation
(lambda (break)
- (if (not (continuation? break)) (snd-display ";not a continuation: ~A" break))
- (if (continuation? abs) (snd-display ";abs is a continuation?"))
- (if (continuation? open-sound) (snd-display ";open-sound is a continuation?"))
- (if (continuation? 32) (snd-display ";32 is a continuation?"))
- (if (continuation? (let ((hi 1)) (lambda () hi))) (snd-display ";closure is a continuation?"))
+ (if (not (continuation? break)) (snd-display #__line__ ";not a continuation: ~A" break))
+ (if (continuation? abs) (snd-display #__line__ ";abs is a continuation?"))
+ (if (continuation? open-sound) (snd-display #__line__ ";open-sound is a continuation?"))
+ (if (continuation? 32) (snd-display #__line__ ";32 is a continuation?"))
+ (if (continuation? (let ((hi 1)) (lambda () hi))) (snd-display #__line__ ";closure is a continuation?"))
(do ((i 0 (+ 1 i)))
((= i (- (vct-length mn) 4)))
- (if (< (vct-ref mn i) 0.5) (begin (snd-display ";peak min: ~A ~A" (vct-ref mn i) i) (break #f)))
- (if (< (vct-ref mx i) 0.5) (begin (snd-display ";peak max: ~A ~A" (vct-ref mx i) i) (break #f)))))))
+ (if (< (vct-ref mn i) 0.5) (begin (snd-display #__line__ ";peak min: ~A ~A" (vct-ref mn i) i) (break #f)))
+ (if (< (vct-ref mx i) 0.5) (begin (snd-display #__line__ ";peak max: ~A ~A" (vct-ref mx i) i) (break #f)))))))
(undo 2)
(map-chan (lambda (y) -1.0) 0 50000)
(ramp-channel 0.5 1.0 1000 4000)
@@ -11235,10 +11311,10 @@ EDITS: 5
(do ((i 0 (+ 1 i)))
((or (not happy)
(= i (- (vct-length mn) 4))))
- (if (> (vct-ref mn i) -0.5) (begin (snd-display ";1 peak min: ~A ~A" (vct-ref mn i) i) (set! happy #f)))
- (if (> (vct-ref mx i) -0.5) (begin (snd-display ";1 peak max: ~A ~A" (vct-ref mx i) i) (set! happy #f)))))
+ (if (> (vct-ref mn i) -0.5) (begin (snd-display #__line__ ";1 peak min: ~A ~A" (vct-ref mn i) i) (set! happy #f)))
+ (if (> (vct-ref mx i) -0.5) (begin (snd-display #__line__ ";1 peak max: ~A ~A" (vct-ref mx i) i) (set! happy #f)))))
(close-sound ind))
-
+
(let ((index (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "channel tests")))
(define (test-channel-func func val-func init-val)
(let* ((len (frames index))
@@ -11253,7 +11329,7 @@ EDITS: 5
((= i chns))
(map-channel (lambda (n) 0.0) 0 len index i)
(if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index i)
- (snd-display ";init scan: ~A?" (scan-channel (lambda (n) (> (abs n) 0.001))))))
+ (snd-display #__line__ ";init scan: ~A?" (scan-channel (lambda (n) (> (abs n) 0.001))))))
;; now it's cleared
(do ((i 0 (+ 1 i)))
((= i chns))
@@ -11264,9 +11340,9 @@ EDITS: 5
(let ((vi (channel->vct 0 len index j)))
(if (= j i)
(if (not (vequal vi val))
- (snd-display ";chan func: ~A ~A" vi val))
+ (snd-display #__line__ ";chan func: ~A ~A" vi val))
(if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index j)
- (snd-display ";chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (snd-display #__line__ ";chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
(map-channel (lambda (n) 0.0) 0 len index i))
(do ((i 0 (+ 1 i)))
((= i chns))
@@ -11279,11 +11355,11 @@ EDITS: 5
(let ((vi (channel->vct 0 len index j)))
(if (= j i)
(if (not (vequal vi val))
- (snd-display ";ed chan func: ~A ~A" vi val))
+ (snd-display #__line__ ";ed chan func: ~A ~A" vi val))
(if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
- (snd-display ";ed chan func leaks? ~A ~A ~A: ~A" i j ed (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (snd-display #__line__ ";ed chan func leaks? ~A ~A ~A: ~A" i j ed (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
(map-channel (lambda (n) 0.0) 0 len index i)))
- (let* ((beg (inexact->exact (floor (/ len 3))))
+ (let* ((beg (floor (/ len 3)))
(dur beg)
(nv (val-func dur)))
(vct-fill! val 0.0)
@@ -11301,9 +11377,9 @@ EDITS: 5
(let ((vi (channel->vct 0 len index j)))
(if (= j i)
(if (not (vequal vi val))
- (snd-display ";chan func n: ~A ~A" vi val))
+ (snd-display #__line__ ";chan func n: ~A ~A" vi val))
(if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
- (snd-display ";dur chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (snd-display #__line__ ";dur chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
(map-channel (lambda (n) 0.0) 0 len index i))))))
(insert-silence 0 10 index 0)
@@ -11421,7 +11497,7 @@ EDITS: 5
(vct-set! v i (+ 0.5 (* 0.5 (cos (+ pi (/ (* pi i) dur)))))))
v))
1.0)
-
+
(let ((old-max (maxamp index #t))
(regdata (map (lambda (n)
(region->vct n 0 10))
@@ -11440,23 +11516,23 @@ EDITS: 5
(for-each forget-region (regions))
(load (string-append cwd "s61.scm"))
(if (not (equal? old-reglen (map region-frames (regions))))
- (snd-display ";region-frames after save: ~A ~A" old-reglen (map region-frames (regions))))
+ (snd-display #__line__ ";region-frames after save: ~A ~A" old-reglen (map region-frames (regions))))
(for-each (lambda (n data)
(if (not (vequal data (region->vct n 0 10)))
- (snd-display ";region after save ~A: ~A ~A" n data (region->vct n 0 10))))
+ (snd-display #__line__ ";region after save ~A: ~A ~A" n data (region->vct n 0 10))))
(regions)
regdata)
(set! index (find-sound "fmv.snd"))
(if (not (equal? (maxamp index #t) old-max))
- (snd-display ";maxes: ~A ~A" (maxamp index #t) old-max))
+ (snd-display #__line__ ";maxes: ~A ~A" (maxamp index #t) old-max))
(if (not (equal? (edits index) (list 275 0)))
- (snd-display ";saved channel edits: ~A" (edits index)))
+ (snd-display #__line__ ";saved channel edits: ~A" (edits index)))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((pos (random (car (edits index)))))
(scale-channel (random 2.0) (random 5) (random 5) index 0 pos)
- (set! (edit-position index) (inexact->exact (floor (* (car (edits index)) .7))))))
+ (set! (edit-position index) (floor (* (car (edits index)) .7)))))
(close-sound index)
(for-each
@@ -11471,7 +11547,7 @@ EDITS: 5
(delete-file "s61.scm")
(reset-hook! save-state-hook)
))
-
+
(let ((index (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "channel tests"))
(v (make-vct 10))
(sw (sinc-width)))
@@ -11491,32 +11567,32 @@ EDITS: 5
((= i 10))
(vct-set! v i (src s)))
(if (not (vequal v (channel->vct 0 10 index 0)))
- (snd-display ";src-channel: ~A ~A" v (channel->vct 0 10 index 0)))
+ (snd-display #__line__ ";src-channel: ~A ~A" v (channel->vct 0 10 index 0)))
(if (not (vequal (make-vct 10) (channel->vct 0 10 index 1)))
- (snd-display ";src-channel leaks: ~A" (channel->vct 0 10 index 1)))
+ (snd-display #__line__ ";src-channel leaks: ~A" (channel->vct 0 10 index 1)))
(let ((tag (catch #t (lambda () (src s 1.0 (lambda (a b) a))) (lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display ";src bad func: ~A" tag))))
+ (snd-display #__line__ ";src bad func: ~A" tag))))
(let ((tag (catch #t (lambda () (src-channel 120000.0)) (lambda args args))))
- (if (not (eq? (car tag) 'mus-error)) (snd-display ";src-channel crazy srate: ~A" tag)))
+ (if (not (eq? (car tag) 'mus-error)) (snd-display #__line__ ";src-channel crazy srate: ~A" tag)))
(let ((tag (catch #t (lambda () (filter-sound (make-snd->sample))) (lambda args args))))
- (if (not (eq? (car tag) 'mus-error)) (snd-display ";filter-sound + un-run gen: ~A" tag)))
+ (if (not (eq? (car tag) 'mus-error)) (snd-display #__line__ ";filter-sound + un-run gen: ~A" tag)))
(revert-sound index)
(vct->channel v 0 10 index 1)
(vct->channel v 10 10 index 1)
(src-channel (make-env :envelope '(1 1 2 2) :length 21) 0 20 index 1)
(if (not (vequal (channel->vct 0 10 index 1) (vct 1.000 -0.000 -0.048 0.068 -0.059 0.022 0.030 -0.100 0.273 0.606)))
- (snd-display ";src-channel env: ~A" (channel->vct 0 10 index 1)))
+ (snd-display #__line__ ";src-channel env: ~A" (channel->vct 0 10 index 1)))
(if (not (vequal (make-vct 10) (channel->vct 0 10 index 0)))
- (snd-display ";src-channel env leaks: ~A" (channel->vct 0 10 index 0)))
+ (snd-display #__line__ ";src-channel env leaks: ~A" (channel->vct 0 10 index 0)))
(revert-sound index)
(vct->channel v 0 10 index 1)
(vct->channel v 10 10 index 1)
(src-channel '(1 1 2 2) 0 20 index 1) ; end is off above -- should be 19 I think
(if (not (vequal (channel->vct 0 10 index 1) (vct 1.000 -0.000 -0.051 0.069 -0.056 0.015 0.042 -0.117 0.320 0.568)))
- (snd-display ";src-channel lst: ~A" (channel->vct 0 10 index 1)))
+ (snd-display #__line__ ";src-channel lst: ~A" (channel->vct 0 10 index 1)))
(if (not (vequal (make-vct 10) (channel->vct 0 10 index 0)))
- (snd-display ";src-channel lst leaks: ~A" (channel->vct 0 10 index 0)))
+ (snd-display #__line__ ";src-channel lst leaks: ~A" (channel->vct 0 10 index 0)))
(set! (sinc-width) sw)
(close-sound index))
@@ -11525,30 +11601,30 @@ EDITS: 5
(rid0 (make-region 2000 2020 ind 0))
(rid0-data (region2vct rid0 0 20)))
(scale-sound-by 2.0)
- (play-region rid0 #t)
+ (play rid0 :wait #t)
(let ((nv (region2vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display ";deferred region after scaling:~% ~A~% ~A" rid0-data nv)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";deferred region after scaling:~% ~A~% ~A" rid0-data nv)))
(let ((nv (region-to-vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display ";deferred region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";deferred region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
(undo)
(scale-by 4.0)
- (play-region rid0 #t)
+ (play rid0 :wait #t)
(let ((nv (region2vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display ";file region after scaling:~% ~A~% ~A" rid0-data nv)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after scaling:~% ~A~% ~A" rid0-data nv)))
(let ((nv (region-to-vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display ";file region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
(let* ((rid1 (make-region 2000 2020 ind 0))
(rid1-data (region2vct rid1 0 20)))
(scale-to .5)
(let ((nv (region2vct rid1 0 20)))
- (if (not (vequal rid1-data nv)) (snd-display ";deferred region after scale-to:~% ~A~% ~A" rid1-data nv)))
+ (if (not (vequal rid1-data nv)) (snd-display #__line__ ";deferred region after scale-to:~% ~A~% ~A" rid1-data nv)))
(close-sound ind)
- (play-region rid0 #t)
- (play-region rid1 #t)
+ (play rid0 :wait #t)
+ (play rid1 :wait #t)
(let ((nv (region2vct rid1 0 20)))
- (if (not (vequal rid1-data nv)) (snd-display ";deferred region after close:~% ~A~% ~A" rid1-data nv)))
+ (if (not (vequal rid1-data nv)) (snd-display #__line__ ";deferred region after close:~% ~A~% ~A" rid1-data nv)))
(let ((nv (region2vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display ";file region after close:~% ~A~% ~A" rid0-data nv))))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after close:~% ~A~% ~A" rid0-data nv))))
(for-each
(lambda (s1 l1 s2 l2)
@@ -11563,25 +11639,25 @@ EDITS: 5
(let* ((rid2 (make-region))
(rid20-data (region2vct rid2 0 l1))
(rid21-data (region2vct rid2 1 l2)))
- (if (not (= (region-chans rid2) 2)) (snd-display ";region-chans of sync'd sound: ~A?" (region-chans rid2)))
+ (if (not (= (region-chans rid2) 2)) (snd-display #__line__ ";region-chans of sync'd sound: ~A?" (region-chans rid2)))
(swap-channels ind 0 ind 1)
(let ((nv (region2vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
(let ((nv (region-to-vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
(let ((nv (region2vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
(let ((nv (region-to-vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
(close-sound ind)
(let ((nv (region2vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
(let ((nv (region-to-vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
(let ((nv (region2vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
(let ((nv (region-to-vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
))
(list 2000 2000 2000 0 2000 0 2000)
(list 20 10 20 20 20 10 20)
@@ -11595,20 +11671,20 @@ EDITS: 5
(lambda ()
(save-sound ind))
(lambda args args))))
- (if (sound? val) (snd-display ";save-sound read-only: ~A" val))
- (if (not (equal? (edits ind) (list 1 0))) (snd-display ";read-only ignored? ~A" (edits ind))))
+ (if (sound? val) (snd-display #__line__ ";save-sound read-only: ~A" val))
+ (if (not (equal? (edits ind) (list 1 0))) (snd-display #__line__ ";read-only ignored? ~A" (edits ind))))
(set! (read-only ind) #f)
(revert-sound ind)
(let ((tag (catch #t
(lambda () (save-sound ind))
(lambda args args))))
- (if (not (sound? tag)) (snd-display ";save-sound read-write: ~A" tag)))
+ (if (not (sound? tag)) (snd-display #__line__ ";save-sound read-write: ~A" tag)))
(key (char->integer #\j) 4)
(if with-gui
(let ((str (widget-text (list-ref (sound-widgets ind) 3))))
(if (and (not (string=? str "no marks"))
(not (string=? str "no such mark")))
- (snd-display ";C-j w/o marks: ~A?" str))))
+ (snd-display #__line__ ";C-j w/o marks: ~A?" str))))
(key (char->integer #\-) 4)
(key (char->integer #\j) 4)
(key (char->integer #\j) 4)
@@ -11617,13 +11693,13 @@ EDITS: 5
(if with-gui
(let ((str (widget-text (list-ref (sound-widgets ind) 3))))
(if (widget-text (cadr (main-widgets)))
- (snd-display ";widget-text of non-text widget: ~A" (widget-text (cadr (main-widget)))))
+ (snd-display #__line__ ";widget-text of non-text widget: ~A" (widget-text (cadr (main-widget)))))
(set! (widget-text (list-ref (channel-widgets ind 0) 2)) "F")
(if (not (string=? (widget-text (list-ref (channel-widgets ind 0) 2)) "F"))
- (snd-display ";set button label to F: ~A" (widget-text (list-ref (channel-widgets ind 0) 2)) "F"))
+ (snd-display #__line__ ";set button label to F: ~A" (widget-text (list-ref (channel-widgets ind 0) 2)) "F"))
(if (and (not (string=? str "no marks"))
(not (string=? str "no such mark")))
- (snd-display ";C-x c w/o marks: ~A?" str))))
+ (snd-display #__line__ ";C-x c w/o marks: ~A?" str))))
(add-mark 123)
(key (char->integer #\u) 4)
(key (char->integer #\6) 4)
@@ -11631,7 +11707,7 @@ EDITS: 5
(if with-gui
(let ((str (widget-text (list-ref (sound-widgets ind) 3))))
(if (not (string=? str "no such mark"))
- (snd-display ";C-u 6 C-j: ~A?" str))))
+ (snd-display #__line__ ";C-u 6 C-j: ~A?" str))))
(key (char->integer #\u) 4)
(key (char->integer #\6) 4)
(key (char->integer #\x) 4)
@@ -11639,7 +11715,7 @@ EDITS: 5
(if with-gui
(let ((str (widget-text (list-ref (sound-widgets ind) 3))))
(if (not (string=? str "no such mark"))
- (snd-display ";C-u 6 C-x c: ~A?" str))))
+ (snd-display #__line__ ";C-u 6 C-x c: ~A?" str))))
(close-sound ind))
(let ((ind (view-sound "obtest.snd")))
@@ -11647,8 +11723,8 @@ EDITS: 5
(let ((tag (catch #t
(lambda () (save-sound ind))
(lambda args args))))
- (if (integer? tag) (snd-display ";save-viewed-sound: ~A" tag))
- (if (not (equal? (edits ind) (list 1 0))) (snd-display ";view read-only ignored? ~A" (edits ind))))
+ (if (integer? tag) (snd-display #__line__ ";save-viewed-sound: ~A" tag))
+ (if (not (equal? (edits ind) (list 1 0))) (snd-display #__line__ ";view read-only ignored? ~A" (edits ind))))
(close-sound ind))
(let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1)))
@@ -11658,7 +11734,7 @@ EDITS: 5
(fp 1.0 0.3 20)
(let ((old-curse (with-tracking-cursor)))
(set! (with-tracking-cursor) #t)
- (play-and-wait)
+ (play :wait #t)
(set! (with-tracking-cursor) old-curse))
(close-sound ind))
(let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1)))
@@ -11668,7 +11744,7 @@ EDITS: 5
(map-channel (lambda (y) 1.0))
(env-sound '(0 0 1 1 2 0))
(let ((reader (make-sampler (- (frames) 1) ind 0 -1)))
- (if (not (= (sampler-position reader) (- (frames) 1))) (snd-display ";sampler-position: ~A" (sampler-position reader)))
+ (if (not (= (sampler-position reader) (- (frames) 1))) (snd-display #__line__ ";sampler-position: ~A" (sampler-position reader)))
(map-channel (lambda (y) (read-sample reader))))
(scan-channel (let ((pos 0)
(e (make-env '(0 0 1 1 2 0) :length (+ 1 dur))))
@@ -11762,26 +11838,26 @@ EDITS: 5
(let ((samp (sample 1000)))
(set! (cursor ind 0) 1000)
(if (fneq (sample) samp)
- (snd-display ";sample no args: ~A ~A" (sample) samp)))
+ (snd-display #__line__ ";sample no args: ~A ~A" (sample) samp)))
(set! val (my-scan-chan (lambda (y) (> y .1))))
(if (not (equal? val (list #t 4423)))
- (snd-display ";my-scan-chan: ~A" val))
+ (snd-display #__line__ ";my-scan-chan: ~A" val))
(set! val (scan-again))
(if (not (equal? val (list #t 4463)))
- (snd-display ";scan-again: ~A" val))
+ (snd-display #__line__ ";scan-again: ~A" val))
(let ((val (find-channel (lambda (y)
(let ((val (find-channel (lambda (y) (> y .1)))))
val)))))
(if (not (equal? val (list (list #t 4423) 0)))
- (snd-display ";find twice: ~A" val)))
+ (snd-display #__line__ ";find twice: ~A" val)))
(let ((val (find-channel (lambda (y)
(count-matches (lambda (y) (> y .1)))))))
(if (not (equal? val (list 2851 0)))
- (snd-display ";find+count: ~A" val)))
+ (snd-display #__line__ ";find+count: ~A" val)))
(set! (cursor) 1000)
(set! (sample) .5)
(if (fneq (sample 1000) .5)
- (snd-display ";set sample no arg: ~A ~A" (sample 1000) (sample 0)))
+ (snd-display #__line__ ";set sample no arg: ~A ~A" (sample 1000) (sample 0)))
(close-sound ind)))
;; edit-menu.scm tests
@@ -11789,20 +11865,20 @@ EDITS: 5
(let ((ind (view-sound "oboe.snd")))
(make-selection 1000 1999 ind 0)
(let ((newsnd (selection->new)))
- (if (not (sound? newsnd)) (snd-display ";selection->new -> ~A" newsnd))
- (if (not (= (frames newsnd 0) 1000)) (snd-display ";selection->new frames: ~A" (frames newsnd 0)))
- (if (not (equal? (edits ind 0) (list 0 0))) (snd-display ";selection->new edited original? ~A" (edits ind 0)))
+ (if (not (sound? newsnd)) (snd-display #__line__ ";selection->new -> ~A" newsnd))
+ (if (not (= (frames newsnd 0) 1000)) (snd-display #__line__ ";selection->new frames: ~A" (frames newsnd 0)))
+ (if (not (equal? (edits ind 0) (list 0 0))) (snd-display #__line__ ";selection->new edited original? ~A" (edits ind 0)))
(let ((newfile (file-name newsnd)))
(close-sound newsnd)
(delete-file newfile)
(mus-sound-forget newfile)))
(make-selection 1000 1999 ind 0)
(let ((newsnd (cut-selection->new)))
- (if (not (sound? newsnd)) (snd-display ";cut-selection->new -> ~A" newsnd))
- (if (not (= (frames newsnd 0) 1000)) (snd-display ";cut-selection->new frames: ~A" (frames newsnd 0)))
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display ";cut-selection->new did not edit original? ~A" (edits ind 0)))
+ (if (not (sound? newsnd)) (snd-display #__line__ ";cut-selection->new -> ~A" newsnd))
+ (if (not (= (frames newsnd 0) 1000)) (snd-display #__line__ ";cut-selection->new frames: ~A" (frames newsnd 0)))
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";cut-selection->new did not edit original? ~A" (edits ind 0)))
(if (not (= (frames ind 0) (- (frames ind 0 0) 1000)))
- (snd-display ";cut-selection->new cut: ~A ~A" (frames ind 0) (- (frames ind 0 0) 1000)))
+ (snd-display #__line__ ";cut-selection->new cut: ~A ~A" (frames ind 0) (- (frames ind 0 0) 1000)))
(undo 1 ind 0)
(let ((newfile (file-name newsnd)))
(close-sound newsnd)
@@ -11811,28 +11887,28 @@ EDITS: 5
(make-selection 1000 1999 ind 0)
(append-selection)
(if (not (= (frames ind 0) (+ (frames ind 0 0) 1000)))
- (snd-display ";append-selection: ~A ~A" (frames ind 0) (frames ind 0 0)))
+ (snd-display #__line__ ";append-selection: ~A ~A" (frames ind 0) (frames ind 0 0)))
(append-sound "oboe.snd")
(if (not (= (frames ind 0) (+ (* 2 (frames ind 0 0)) 1000)))
- (snd-display ";append-sound: ~A ~A" (frames ind 0) (frames ind 0 0)))
+ (snd-display #__line__ ";append-sound: ~A ~A" (frames ind 0) (frames ind 0 0)))
(revert-sound ind)
(let ((m1 (add-mark 1000))
(m2 (add-mark 12000)))
(trim-front)
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display ";time-front did not edit original? ~A" (edits ind 0)))
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";time-front did not edit original? ~A" (edits ind 0)))
(if (not (= (frames ind 0) (- (frames ind 0 0) 1000)))
- (snd-display ";trim-front: ~A ~A" (frames ind 0) (- (frames ind 0 0) 1000)))
- (if (not (= (mark-sample m2) 11000)) (snd-display ";trim-front m2: ~A" (mark-sample m2)))
+ (snd-display #__line__ ";trim-front: ~A ~A" (frames ind 0) (- (frames ind 0 0) 1000)))
+ (if (not (= (mark-sample m2) 11000)) (snd-display #__line__ ";trim-front m2: ~A" (mark-sample m2)))
(undo 1 ind 0)
(trim-back)
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display ";time-back did not edit original? ~A" (edits ind 0)))
- (if (not (= (frames ind 0) 12001)) (snd-display ";trim-back: ~A" (frames ind 0)))
- (if (not (= (mark-sample m1) 1000)) (snd-display ";trim-back m1: ~A" (mark-sample m1)))
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";time-back did not edit original? ~A" (edits ind 0)))
+ (if (not (= (frames ind 0) 12001)) (snd-display #__line__ ";trim-back: ~A" (frames ind 0)))
+ (if (not (= (mark-sample m1) 1000)) (snd-display #__line__ ";trim-back m1: ~A" (mark-sample m1)))
(undo 1 ind 0)
(add-mark 22000)
(crop)
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display ";crop did not edit original? ~A" (edits ind 0)))
- (if (not (= (frames ind 0) 21001)) (snd-display ";crop: ~A" (frames ind 0)))
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";crop did not edit original? ~A" (edits ind 0)))
+ (if (not (= (frames ind 0) 21001)) (snd-display #__line__ ";crop: ~A" (frames ind 0)))
(undo 1 ind 0)
(close-sound ind))))
@@ -11843,13 +11919,13 @@ EDITS: 5
(check-env-vals "simple scaler" (make-env '(0 1 1 1) :scaler .5 :length 1001))
(if (= (edit-position) 2)
(undo)
- (snd-display ";env+scl was no-op"))
+ (snd-display #__line__ ";env+scl was no-op"))
(env-channel (make-env '(0 1 1 1) :offset .5 :length 1001))
(check-maxamp ind 1.5 "simple offset")
(check-env-vals "simple offset" (make-env '(0 1 1 1) :offset .5 :length 1001))
(if (= (edit-position) 2)
(undo)
- (snd-display ";env+offset was no-op"))
+ (snd-display #__line__ ";env+offset was no-op"))
(env-channel (make-env '(0 0 1 1 2 0) :offset .5 :scaler 2.0 :length 1001))
(check-maxamp ind 2.5 "off+scl")
(check-env-vals "off+scl" (make-env '(0 0 1 1 2 0) :offset .5 :scaler 2.0 :length 1001))
@@ -11861,7 +11937,7 @@ EDITS: 5
(if (> y mx)
(set! mx y))
#f))
- (if (fneq mx 0.5) (snd-display ";non abs max: ~A (correct: 0.5)" mx)))
+ (if (fneq mx 0.5) (snd-display #__line__ ";non abs max: ~A (correct: 0.5)" mx)))
(check-env-vals "off+scl #2" (make-env '(0 -0.5 1 0 2 -1) :offset .5 :scaler 2.0 :length 1001))
(undo)
(env-sound '(0 .5 1 .75 2 .25) 0 (frames) 32.0)
@@ -11880,7 +11956,7 @@ EDITS: 5
((= i 20))
(vct-set! data i (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
(if (not (vequal data (vct 0.0 -0.010 0.0 -0.046 0.0 -0.152 0.0 -0.614 0.0 0.614 0.0 0.152 0.0 0.046 0.0 0.010 0.0 0.0 0.0 0.0)))
- (snd-display ";hilbert-transform 8 impulse response: ~A" data)))
+ (snd-display #__line__ ";hilbert-transform 8 impulse response: ~A" data)))
(let ((hlb (make-hilbert-transform 7))
(data (make-vct 20)))
@@ -11888,7 +11964,7 @@ EDITS: 5
((= i 20))
(vct-set! data i (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
(if (not (vequal data (vct -0.007 0.0 -0.032 0.0 -0.136 0.0 -0.608 0.0 0.608 0.0 0.136 0.0 0.032 0.0 0.007 0.0 0.0 0.0 0.0 0.0)))
- (snd-display ";hilbert-transform 7 impulse response: ~A" data)))
+ (snd-display #__line__ ";hilbert-transform 7 impulse response: ~A" data)))
(let ((ind (new-sound "test.snd")))
(pad-channel 0 1000)
@@ -11900,10 +11976,10 @@ EDITS: 5
(map-channel (lambda (y) (hilbert-transform h y)))
;; now ideally we'd be back to an impulse
(if (> (abs (- (sample 500) .98)) .01)
- (snd-display ";hilbert impulse: ~A" (sample 500)))
+ (snd-display #__line__ ";hilbert impulse: ~A" (sample 500)))
(set! (sample 500) 0.0)
(if (> (maxamp ind 0) .02)
- (snd-display ";hilbert sidelobes: ~A" (maxamp ind 0)))
+ (snd-display #__line__ ";hilbert sidelobes: ~A" (maxamp ind 0)))
(scale-channel 0.0)
(set! (sample 100) 1.0)
(set! h (make-hilbert-transform 101))
@@ -11912,10 +11988,10 @@ EDITS: 5
(map-channel (lambda (y) (hilbert-transform h y)))
(map-channel (lambda (y) (hilbert-transform h y)))
(if (> (abs (- (sample 504) .98)) .01)
- (snd-display ";hilbert 101 impulse: ~A: ~A" (sample 504) (channel->vct 498 10)))
+ (snd-display #__line__ ";hilbert 101 impulse: ~A: ~A" (sample 504) (channel->vct 498 10)))
(set! (sample 504) 0.0)
(if (> (maxamp ind 0) .02)
- (snd-display ";hilbert 101 sidelobes: ~A" (maxamp ind 0)))
+ (snd-display #__line__ ";hilbert 101 sidelobes: ~A" (maxamp ind 0)))
(revert-sound))
(pad-channel 0 1000)
(set! (sample 100) 1.0)
@@ -11923,19 +11999,19 @@ EDITS: 5
(hi (make-highpass (* .1 pi) 20)))
(map-channel (lambda (y) (+ (lowpass lo y) (highpass hi y))))
(if (fneq (sample 120) 1.0)
- (snd-display ";lowpass+highpass impulse: ~A" (sample 120)))
+ (snd-display #__line__ ";lowpass+highpass impulse: ~A" (sample 120)))
(set! (sample 120) 0.0)
(if (fneq (maxamp ind 0) 0.0)
- (snd-display ";lowpass+highpass sidelobes: ~A" (maxamp ind 0))))
+ (snd-display #__line__ ";lowpass+highpass sidelobes: ~A" (maxamp ind 0))))
(undo 2)
(let ((lo (make-bandpass (* .1 pi) (* .2 pi) 20))
(hi (make-bandstop (* .1 pi) (* .2 pi) 20)))
(map-channel (lambda (y) (+ (bandpass lo y) (bandstop hi y))))
(if (fneq (sample 120) 1.0)
- (snd-display ";bandpass+bandstop impulse: ~A" (sample 120)))
+ (snd-display #__line__ ";bandpass+bandstop impulse: ~A" (sample 120)))
(set! (sample 120) 0.0)
(if (fneq (maxamp ind 0) 0.0)
- (snd-display ";bandpass+bandstop sidelobes: ~A" (maxamp ind 0))))
+ (snd-display #__line__ ";bandpass+bandstop sidelobes: ~A" (maxamp ind 0))))
(close-sound ind))
(let ((ind (new-sound "test.snd")))
@@ -11950,7 +12026,7 @@ EDITS: 5
(let ((data1 (channel->vct)))
(vct-subtract! data data1)
(if (> (vct-peak data) .00001)
- (snd-display ";fir-filter 2: ~A" (vct-peak data))))
+ (snd-display #__line__ ";fir-filter 2: ~A" (vct-peak data))))
(undo))))
(close-sound ind))
@@ -11971,7 +12047,7 @@ EDITS: 5
(f2)
(let ((v2 (channel->vct 0 100 ind 0)))
(if (not (vequal v1 v2))
- (snd-display ";env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
+ (snd-display #__line__ ";env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
(set! (edit-position ind 0) edpos)))
(if try-scale
(begin
@@ -11983,7 +12059,7 @@ EDITS: 5
(scale-by 2.0)
(let ((v2 (channel->vct 0 100 ind 0)))
(if (not (vequal v1 v2))
- (snd-display ";scaled (2) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
+ (snd-display #__line__ ";scaled (2) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
(set! (edit-position ind 0) edpos)))
(f1)
(scale-by .5)
@@ -11993,7 +12069,7 @@ EDITS: 5
(f2)
(let ((v2 (channel->vct 0 100 ind 0)))
(if (not (vequal v1 v2))
- (snd-display ";scaled (.5) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
+ (snd-display #__line__ ";scaled (.5) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
(set! (edit-position ind 0) edpos)))))))
(list (list "ramp-xramp" #t
@@ -12145,7 +12221,7 @@ EDITS: 5
))
(close-sound ind))
-
+
(let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "2nd ramp re-order tests" 100))
(oldopt (optimization)))
@@ -12224,7 +12300,7 @@ EDITS: 5
(set! vals1 (channel->vct 0 100 ind 0))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals1))
- (snd-display ";1 virtual op reversed tests: ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A"
+ (snd-display #__line__ ";1 virtual op reversed tests: ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A"
(op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
scalers vals1 rvals
@@ -12241,7 +12317,7 @@ EDITS: 5
(set! (optimization) oldopt)
(set! vals2 (channel->vct 0 100 ind 0))
(if (not (vequal vals1 vals2))
- (snd-display ";1 virtual op tests: ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A at ~A"
+ (snd-display #__line__ ";1 virtual op tests: ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A at ~A"
(op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
saved-scalers vals1 vals2
@@ -12258,7 +12334,7 @@ EDITS: 5
))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals2))
- (snd-display ";1 virtual op reversed tests (2): ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A"
+ (snd-display #__line__ ";1 virtual op reversed tests (2): ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A"
(op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
saved-scalers vals2 rvals
@@ -12303,7 +12379,7 @@ EDITS: 5
(set! vals1 (channel->vct 0 100 ind 0))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals1))
- (snd-display ";2 virtual op reversed tests: ~A(~A(~A~A)) * ~A:~%; ~A~%; ~A => ~A"
+ (snd-display #__line__ ";2 virtual op reversed tests: ~A(~A(~A~A)) * ~A:~%; ~A~%; ~A => ~A"
(op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
scalers vals1 rvals
@@ -12322,7 +12398,7 @@ EDITS: 5
(set! (optimization) oldopt)
(set! vals2 (channel->vct 0 100 ind 0))
(if (not (vequal vals1 vals2))
- (snd-display ";2 virtual op tests: ~A * ~A(~A(~A~A)): ~A ~A => ~A at ~A"
+ (snd-display #__line__ ";2 virtual op tests: ~A * ~A(~A(~A~A)): ~A ~A => ~A at ~A"
saved-scalers (op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
vals1 vals2
@@ -12339,7 +12415,7 @@ EDITS: 5
))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals2))
- (snd-display ";2 virtual op reversed tests (2): ~A(~A(~A~A)) * ~A:~%; ~A~%; ~A => ~A"
+ (snd-display #__line__ ";2 virtual op reversed tests (2): ~A(~A(~A~A)) * ~A:~%; ~A~%; ~A => ~A"
(op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
saved-scalers vals2 rvals
@@ -12396,7 +12472,7 @@ EDITS: 5
(set! vals1 (channel->vct 0 100 ind 0))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals1))
- (snd-display ";3 virtual op reversed tests: ~A(~A(~A(~A~A))) * ~A:~%; ~A~%; ~A => ~A"
+ (snd-display #__line__ ";3 virtual op reversed tests: ~A(~A(~A(~A~A))) * ~A:~%; ~A~%; ~A => ~A"
(op-name fourth) (op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
scalers vals1 rvals
@@ -12417,7 +12493,7 @@ EDITS: 5
(set! (optimization) oldopt)
(set! vals2 (channel->vct 0 100 ind 0))
(if (not (vequal vals1 vals2))
- (snd-display ";3 virtual op tests: ~A * ~A(~A(~A(~A~A))):~% opt vals: ~A~% unopt vals: ~A~% => ~A at ~A"
+ (snd-display #__line__ ";3 virtual op tests: ~A * ~A(~A(~A(~A~A))):~% opt vals: ~A~% unopt vals: ~A~% => ~A at ~A"
saved-scalers
(op-name fourth) (op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
@@ -12435,7 +12511,7 @@ EDITS: 5
))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals2))
- (snd-display ";3 virtual op reversed tests (2): ~A(~A(~A(~A~A))) * ~A: ~A ~A => ~A"
+ (snd-display #__line__ ";3 virtual op reversed tests (2): ~A(~A(~A(~A~A))) * ~A: ~A ~A => ~A"
(op-name fourth) (op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
saved-scalers vals2 rvals
@@ -12445,7 +12521,7 @@ EDITS: 5
op3)))
op2))
op1))
-
+
(if all-args
(let ((op1 (list 0 3 5))
(op2 (list 0 1 3 4 5 6))
@@ -12507,7 +12583,7 @@ EDITS: 5
(set! vals1 (channel->vct 0 100 ind 0))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals1))
- (snd-display ";4 virtual op reversed tests: ~A(~A(~A(~A(~A~A)))) * ~A: ~A ~A => ~A"
+ (snd-display #__line__ ";4 virtual op reversed tests: ~A(~A(~A(~A(~A~A)))) * ~A: ~A ~A => ~A"
(op-name fifth) (op-name fourth) (op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
scalers vals1 rvals
@@ -12530,7 +12606,7 @@ EDITS: 5
(set! (optimization) oldopt)
(set! vals2 (channel->vct 0 100 ind 0))
(if (not (vequal vals1 vals2))
- (snd-display ";4 virtual op tests: ~A * ~A(~A(~A(~A(~A~A)))): ~A ~A => ~A at ~A"
+ (snd-display #__line__ ";4 virtual op tests: ~A * ~A(~A(~A(~A(~A~A)))): ~A ~A => ~A at ~A"
saved-scalers
(op-name fifth) (op-name fourth) (op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
@@ -12548,7 +12624,7 @@ EDITS: 5
))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals2))
- (snd-display ";4 virtual op reversed tests (2): ~A(~A(~A(~A(~A~A)))) * ~A: ~A ~A => ~A"
+ (snd-display #__line__ ";4 virtual op reversed tests (2): ~A(~A(~A(~A(~A~A)))) * ~A: ~A ~A => ~A"
(op-name fifth) (op-name fourth) (op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
saved-scalers vals2 rvals
@@ -12641,7 +12717,7 @@ EDITS: 5
(set! vals1 (channel->vct 0 100 ind 0))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals1))
- (snd-display ";5 virtual op reversed tests: ~A(~A(~A(~A(~A(~A~A))))) * ~A: ~A ~A => ~A"
+ (snd-display #__line__ ";5 virtual op reversed tests: ~A(~A(~A(~A(~A(~A~A))))) * ~A: ~A ~A => ~A"
(op-name sixth) (op-name fifth) (op-name fourth)
(op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
@@ -12667,7 +12743,7 @@ EDITS: 5
(set! (optimization) oldopt)
(set! vals2 (channel->vct 0 100 ind 0))
(if (not (vequal vals1 vals2))
- (snd-display ";5 virtual op tests: ~A * ~A(~A(~A(~A(~A(~A~A))))): ~A ~A => ~A at ~A"
+ (snd-display #__line__ ";5 virtual op tests: ~A * ~A(~A(~A(~A(~A(~A~A))))): ~A ~A => ~A at ~A"
saved-scalers
(op-name sixth) (op-name fifth) (op-name fourth)
(op-name third) (op-name second) (op-name first)
@@ -12686,7 +12762,7 @@ EDITS: 5
))
(let ((rvals (reversed-channel->vct 0 100 ind 0)))
(if (not (vequal rvals vals2))
- (snd-display ";5 virtual op reversed tests (2): ~A(~A(~A(~A(~A(~A~A))))) * ~A: ~A ~A => ~A"
+ (snd-display #__line__ ";5 virtual op reversed tests (2): ~A(~A(~A(~A(~A(~A~A))))) * ~A: ~A ~A => ~A"
(op-name sixth) (op-name fifth) (op-name fourth)
(op-name third) (op-name second) (op-name first)
(if (= k 1) "(ptree_zero)" "")
@@ -12807,7 +12883,7 @@ EDITS: 5
(vct-set! v1 i (r1))
(vct-set! v2 i (r2)))
(if (not (local-vequal v1 v2 n))
- (snd-display ";!~A reversed: ~A ~A" name v1 v2))
+ (snd-display #__line__ ";!~A reversed: ~A ~A" name v1 v2))
(free-sampler r1)
(free-sampler r2)))))
@@ -12832,7 +12908,7 @@ EDITS: 5
(vct->channel (make-vct 20 1.0) 0 20 ind 1)))
(op ind)
(if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display ";unequal: ~A by ~A (~A, ~A, ~A):~%; ~A~%; ~A~%; ~A~%; ~A"
+ (snd-display #__line__ ";unequal: ~A by ~A (~A, ~A, ~A):~%; ~A~%; ~A~%; ~A~%; ~A"
op-name
(vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
(mus-float-equal-fudge-factor) (mus-clipping) (mus-file-clipping ind)
@@ -12841,7 +12917,7 @@ EDITS: 5
(rvequal ind op-name 1))
(revert-sound ind)))
all-ops all-op-names)
-
+
(close-sound ind)
(set! ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat))
(set! (squelch-update ind 0) #t)
@@ -12863,7 +12939,7 @@ EDITS: 5
(op1 ind)
(op2 ind)
(if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display ";unequal: ~A~A by ~A (~A):~%; ~A~%; ~A~%; ~A~%; ~A"
+ (snd-display #__line__ ";unequal: ~A~A by ~A (~A):~%; ~A~%; ~A~%; ~A~%; ~A"
op-name (if (= k 0) "[0]" "")
(vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
(channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)
@@ -12897,7 +12973,7 @@ EDITS: 5
(op2 ind)
(op3 ind)
(if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display ";unequal: ~A by ~A (~A):~%; ~A~%; ~A~%; ~A~%; ~A"
+ (snd-display #__line__ ";unequal: ~A by ~A (~A):~%; ~A~%; ~A~%; ~A~%; ~A"
op-name
(vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
(channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)
@@ -12935,7 +13011,7 @@ EDITS: 5
(op3 ind)
(op4 ind)
(if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display ";unequal: ~A~A by ~A (~A):~%; ~A~%; ~A"
+ (snd-display #__line__ ";unequal: ~A~A by ~A (~A):~%; ~A~%; ~A"
op-name (if (= k 0) "[0]" "")
(vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
(channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
@@ -12976,7 +13052,7 @@ EDITS: 5
(op4 ind)
(op5 ind)
(if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display ";unequal: ~A by ~A (~A), ~A in ~A:~%; ~A~%; ~A"
+ (snd-display #__line__ ";unequal: ~A by ~A (~A), ~A in ~A:~%; ~A~%; ~A"
op-name
(vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
(map (lambda (lst) (edit-fragment-type-name (list-ref lst 7))) (edit-tree ind 0))
@@ -13023,7 +13099,7 @@ EDITS: 5
(op5 ind)
(op6 ind)
(if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display ";unequal: ~A by ~A (~A):~%; ~A~%; ~A"
+ (snd-display #__line__ ";unequal: ~A by ~A (~A):~%; ~A~%; ~A"
op-name
(vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
(channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
@@ -13072,7 +13148,7 @@ EDITS: 5
(op6 ind)
(op7 ind)
(if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display ";unequal: ~A by ~A (~A):~%; ~A~%; ~A"
+ (snd-display #__line__ ";unequal: ~A by ~A (~A):~%; ~A~%; ~A"
op-name
(vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
(channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
@@ -13099,10 +13175,8 @@ EDITS: 5
(XtManageChild edp)))
(close-sound ind)))
- )))
- )) ; if 'run I hope
-
-
+ )))))
+
(let ((ind (open-sound "oboe.snd")))
;; simple cases
@@ -13110,30 +13184,30 @@ EDITS: 5
(as-one-edit
(lambda ()
(set! (sample 10) 1.0)))
- (if (fneq (sample 10) 1.0) (snd-display ";as-one-edit 1: ~A" (sample 10)))
+ (if (fneq (sample 10) 1.0) (snd-display #__line__ ";as-one-edit 1: ~A" (sample 10)))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";as-one-edit 1 edpos: ~A" (edit-position ind 0))
+ (snd-display #__line__ ";as-one-edit 1 edpos: ~A" (edit-position ind 0))
(begin
(if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display ";as-one-edit 1 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 1 edlist: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 0 ind 0) (list #f "init" 0 50828)))
- (snd-display ";as-one-edit 1 original edlist: ~A" (edit-fragment 0 ind 0)))))
+ (snd-display #__line__ ";as-one-edit 1 original edlist: ~A" (edit-fragment 0 ind 0)))))
(revert-sound ind)
(as-one-edit
(lambda ()
(set! (sample 10) 1.0)
(map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit")
- (if (not (= (edit-position ind 0) 2)) (snd-display ";as-one-edit 2 edpos internal: ~A" (edit-position ind 0))))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 2 edpos internal: ~A" (edit-position ind 0))))
"as-one-edit test-2")
- (if (fneq (sample 10) 2.0) (snd-display ";as-one-edit 2: ~A" (sample 10)))
+ (if (fneq (sample 10) 2.0) (snd-display #__line__ ";as-one-edit 2: ~A" (sample 10)))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";as-one-edit 2 edpos: ~A" (edit-position ind 0))
+ (snd-display #__line__ ";as-one-edit 2 edpos: ~A" (edit-position ind 0))
(begin
(if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-2" "set" 0 21)))
- (snd-display ";as-one-edit 2 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 2 edlist: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 0 ind 0) (list #f "init" 0 50828)))
- (snd-display ";as-one-edit 2 original edlist: ~A" (edit-fragment 0 ind 0)))))
+ (snd-display #__line__ ";as-one-edit 2 original edlist: ~A" (edit-fragment 0 ind 0)))))
(revert-sound ind)
(let ((ind2 (open-sound "2a.snd")))
@@ -13144,16 +13218,16 @@ EDITS: 5
(as-one-edit
(lambda ()
(set! (sample 10 ind 0) 1.0)))
- (if (fneq (sample 10 ind 0) 1.0) (snd-display ";as-one-edit 3: ~A" (sample 10 ind 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";as-one-edit 3 edpos: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind2 0) 1)) (snd-display ";as-one-edit 3 2 edpos: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind2 1) 1)) (snd-display ";as-one-edit 3 2 1 edpos: ~A" (edit-position ind2 1)))
+ (if (fneq (sample 10 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 3: ~A" (sample 10 ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 3 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind2 0) 1)) (snd-display #__line__ ";as-one-edit 3 2 edpos: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind2 1) 1)) (snd-display #__line__ ";as-one-edit 3 2 1 edpos: ~A" (edit-position ind2 1)))
(if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display ";as-one-edit 3 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 3 edlist: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 1 1.0000" "set" 1 1)))
- (snd-display ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
+ (snd-display #__line__ ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
(if (not (equal? (edit-fragment 1 ind2 1) (list "set-sample 2 0.5000" "set" 2 1)))
- (snd-display ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
+ (snd-display #__line__ ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
(revert-sound ind)
@@ -13161,17 +13235,17 @@ EDITS: 5
(lambda ()
(set! (sample 10 ind 0) 1.0)
(map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit 2")
- (if (not (= (edit-position ind 0) 2)) (snd-display ";as-one-edit 4 edpos internal: ~A" (edit-position ind 0))))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 4 edpos internal: ~A" (edit-position ind 0))))
"as-one-edit test-4")
- (if (fneq (sample 10) 2.0) (snd-display ";as-one-edit 4: ~A" (sample 10 ind 0)))
+ (if (fneq (sample 10) 2.0) (snd-display #__line__ ";as-one-edit 4: ~A" (sample 10 ind 0)))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";as-one-edit 4 edpos: ~A" (edit-position ind 0))
+ (snd-display #__line__ ";as-one-edit 4 edpos: ~A" (edit-position ind 0))
(if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-4" "set" 0 21)))
- (snd-display ";as-one-edit 4 edlist: ~A" (edit-fragment 1 ind 0))))
+ (snd-display #__line__ ";as-one-edit 4 edlist: ~A" (edit-fragment 1 ind 0))))
(if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 1 1.0000" "set" 1 1)))
- (snd-display ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
+ (snd-display #__line__ ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
(if (not (equal? (edit-fragment 1 ind2 1) (list "set-sample 2 0.5000" "set" 2 1)))
- (snd-display ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
+ (snd-display #__line__ ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
(revert-sound ind)
(set! (sample 3 ind 0) 1.0)
@@ -13181,22 +13255,22 @@ EDITS: 5
(set! (sample 10 ind 0) 1.0)
(set! (sample 10 ind2 0) 0.5)
(set! (sample 10 ind2 1) 0.4)))
- (if (fneq (sample 3 ind 0) 1.0) (snd-display ";as-one-edit 5 (3): ~A" (sample 3 ind 0)))
- (if (fneq (sample 10 ind 0) 1.0) (snd-display ";as-one-edit 5 (10): ~A" (sample 10 ind 0)))
- (if (fneq (sample 10 ind2 0) 0.5) (snd-display ";as-one-edit 5 (2 10): ~A" (sample 10 ind2 0)))
- (if (fneq (sample 10 ind2 1) 0.4) (snd-display ";as-one-edit 5 (2 1 10): ~A" (sample 10 ind2 1)))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";as-one-edit 5 edpos: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind2 0) 2)) (snd-display ";as-one-edit 5 2 edpos: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind2 1) 2)) (snd-display ";as-one-edit 5 2 1 edpos: ~A" (edit-position ind2 1)))
+ (if (fneq (sample 3 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 5 (3): ~A" (sample 3 ind 0)))
+ (if (fneq (sample 10 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 5 (10): ~A" (sample 10 ind 0)))
+ (if (fneq (sample 10 ind2 0) 0.5) (snd-display #__line__ ";as-one-edit 5 (2 10): ~A" (sample 10 ind2 0)))
+ (if (fneq (sample 10 ind2 1) 0.4) (snd-display #__line__ ";as-one-edit 5 (2 1 10): ~A" (sample 10 ind2 1)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 5 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind2 0) 2)) (snd-display #__line__ ";as-one-edit 5 2 edpos: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind2 1) 2)) (snd-display #__line__ ";as-one-edit 5 2 1 edpos: ~A" (edit-position ind2 1)))
(if (not (equal? (edit-fragment 2 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 3 1.0000" "set" 3 1)))
- (snd-display ";as-one-edit 5 edlist 1: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 1: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 0 ind 0) (list #f "init" 0 50828)))
- (snd-display ";as-one-edit 5 original edlist: ~A" (edit-fragment 0 ind 0)))
+ (snd-display #__line__ ";as-one-edit 5 original edlist: ~A" (edit-fragment 0 ind 0)))
(if (not (equal? (edit-fragment 2 ind2 0) (list "set-sample 10 0.5000" "set" 10 1)))
- (snd-display ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
(as-one-edit
(lambda ()
@@ -13205,22 +13279,22 @@ EDITS: 5
"as-one-edit test-6")
- (if (fneq (sample 3 ind 0) 2.0) (snd-display ";as-one-edit 6 (3): ~A" (sample 3 ind 0)))
- (if (fneq (sample 10 ind 0) 2.0) (snd-display ";as-one-edit 6 (10): ~A" (sample 10 ind 0)))
- (if (fneq (sample 10 ind2 0) 0.5) (snd-display ";as-one-edit 6 (2 10): ~A" (sample 10 ind2 0)))
- (if (fneq (sample 10 ind2 1) 0.8) (snd-display ";as-one-edit 6 (2 1 10): ~A" (sample 10 ind2 1)))
- (if (not (= (edit-position ind 0) 3)) (snd-display ";as-one-edit 6 edpos: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind2 0) 2)) (snd-display ";as-one-edit 6 2 edpos: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind2 1) 3)) (snd-display ";as-one-edit 6 2 1 edpos: ~A" (edit-position ind2 1)))
+ (if (fneq (sample 3 ind 0) 2.0) (snd-display #__line__ ";as-one-edit 6 (3): ~A" (sample 3 ind 0)))
+ (if (fneq (sample 10 ind 0) 2.0) (snd-display #__line__ ";as-one-edit 6 (10): ~A" (sample 10 ind 0)))
+ (if (fneq (sample 10 ind2 0) 0.5) (snd-display #__line__ ";as-one-edit 6 (2 10): ~A" (sample 10 ind2 0)))
+ (if (fneq (sample 10 ind2 1) 0.8) (snd-display #__line__ ";as-one-edit 6 (2 1 10): ~A" (sample 10 ind2 1)))
+ (if (not (= (edit-position ind 0) 3)) (snd-display #__line__ ";as-one-edit 6 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind2 0) 2)) (snd-display #__line__ ";as-one-edit 6 2 edpos: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind2 1) 3)) (snd-display #__line__ ";as-one-edit 6 2 1 edpos: ~A" (edit-position ind2 1)))
(if (not (equal? (edit-fragment 2 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 2 ind2 0) (list "set-sample 10 0.5000" "set" 10 1)))
- (snd-display ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
(if (not (equal? (edit-fragment 3 ind 0) (list "as-one-edit test-6" "set" 0 20)))
- (snd-display ";as-one-edit 6 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 6 edlist: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 3 ind2 1) (list "as-one-edit test-6" "set" 0 20)))
- (snd-display ";as-one-edit 6 edlist 2 1: ~A" (edit-fragment 1 ind2 1)))
+ (snd-display #__line__ ";as-one-edit 6 edlist 2 1: ~A" (edit-fragment 1 ind2 1)))
(close-sound ind2))
;; nested cases
@@ -13237,15 +13311,15 @@ EDITS: 5
(if (or (fneq (sample 100) .9)
(fneq (sample 200) .8)
(fneq (sample 300) .6))
- (snd-display ";nested as-one-edit 7: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
+ (snd-display #__line__ ";nested as-one-edit 7: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";nested as-one-edit 7 edpos: ~A" (edit-position ind 0)))
+ (snd-display #__line__ ";nested as-one-edit 7 edpos: ~A" (edit-position ind 0)))
(if (squelch-update ind 0)
(begin
- (snd-display ";nested as-one-edit 7 squelch is on")
+ (snd-display #__line__ ";nested as-one-edit 7 squelch is on")
(set! (squelch-update) #f)))
(if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 300 0.6000" "set" 100 204)))
- (snd-display ";as-one-edit 7 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 7 edlist: ~A" (edit-fragment 1 ind 0)))
(revert-sound ind)
(as-one-edit
@@ -13260,11 +13334,11 @@ EDITS: 5
(if (or (fneq (sample 100) .9)
(fneq (sample 200) .8)
(fneq (sample 300) .6))
- (snd-display ";nested as-one-edit 8: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
+ (snd-display #__line__ ";nested as-one-edit 8: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";nested as-one-edit 8 edpos: ~A" (edit-position ind 0)))
+ (snd-display #__line__ ";nested as-one-edit 8 edpos: ~A" (edit-position ind 0)))
(if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-8" "set" 100 204)))
- (snd-display ";as-one-edit 8 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 8 edlist: ~A" (edit-fragment 1 ind 0)))
(revert-sound ind)
(as-one-edit
@@ -13280,11 +13354,11 @@ EDITS: 5
(if (or (fneq (sample 100) .9)
(fneq (sample 200) .8)
(fneq (sample 300) .6))
- (snd-display ";nested as-one-edit 9: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
+ (snd-display #__line__ ";nested as-one-edit 9: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";nested as-one-edit 9 edpos: ~A" (edit-position ind 0)))
+ (snd-display #__line__ ";nested as-one-edit 9 edpos: ~A" (edit-position ind 0)))
(if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-9" "set" 100 204)))
- (snd-display ";as-one-edit 9 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 9 edlist: ~A" (edit-fragment 1 ind 0)))
(revert-sound ind)
(as-one-edit
@@ -13305,28 +13379,28 @@ EDITS: 5
(fneq (sample 200) .8)
(fneq (sample 300) .6)
(fneq (sample 400) .3))
- (snd-display ";nested as-one-edit 10: ~A ~A ~A ~A" (sample 100) (sample 200) (sample 300) (sample 400)))
+ (snd-display #__line__ ";nested as-one-edit 10: ~A ~A ~A ~A" (sample 100) (sample 200) (sample 300) (sample 400)))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";nested as-one-edit 10 edpos: ~A" (edit-position ind 0)))
+ (snd-display #__line__ ";nested as-one-edit 10 edpos: ~A" (edit-position ind 0)))
(if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-10" "set" 100 305)))
- (snd-display ";as-one-edit 10 edlist: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 10 edlist: ~A" (edit-fragment 1 ind 0)))
;; try implicit as-one-edits nested
(revert-sound ind)
(env-channel-with-base '(0 0 1 1 2 .5 3 .25 4 0) 0.0 0 #f ind 0)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";as-one-edit 11 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 11 edpos: ~A" (edit-position ind 0)))
(if (not (equal? (edit-fragment 1 ind 0)
(list "env-channel-with-base '(0.000 0.000 1.000 1.000 2.000 0.500 3.000 0.250 4.000 0.000) 0.0000 0 #f" "scale" 0 50830)))
- (snd-display ";as-one-edit 11: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 11: ~A" (edit-fragment 1 ind 0)))
(revert-sound ind)
(as-one-edit
(lambda ()
(env-channel-with-base '(0 0 1 1 2 .5 3 .25 4 0) 0.0 0 #f ind 0))
"as-one-edit 12")
- (if (not (= (edit-position ind 0) 1)) (snd-display ";as-one-edit 12 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 12 edpos: ~A" (edit-position ind 0)))
(if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit 12" "scale" 0 50830)))
- (snd-display ";as-one-edit 12: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit 12: ~A" (edit-fragment 1 ind 0)))
(revert-sound ind)
(let ((m1 #f)
@@ -13342,8 +13416,8 @@ EDITS: 5
(set! (sample 123 ind 0) .3)
(set! m2 (add-mark 1235 ind 0)))
"as-one-edit inner 1")
- (if (not (mark? m1)) (snd-display ";as-one-edit stepped on m1: ~A" m1))
- (if (not (mark? m2)) (snd-display ";as-one-edit stepped on m2: ~A" m2))
+ (if (not (mark? m1)) (snd-display #__line__ ";as-one-edit stepped on m1: ~A" m1))
+ (if (not (mark? m2)) (snd-display #__line__ ";as-one-edit stepped on m2: ~A" m2))
(as-one-edit
(lambda ()
(set! m3 (add-mark 1238 ind 0))
@@ -13352,14 +13426,14 @@ EDITS: 5
(set! (sample 1239 ind 0) .9)
(set! m4 (add-mark 1237 ind 0)))
"outer as-one-edit")
- (if (not (mark? m1)) (snd-display ";2nd as-one-edit stepped on m1: ~A" m1))
- (if (not (mark? m2)) (snd-display ";2nd as-one-edit stepped on m2: ~A" m2))
- (if (not (mark? m3)) (snd-display ";2nd as-one-edit stepped on m3: ~A" m3))
- (if (not (mark? m4)) (snd-display ";2nd as-one-edit stepped on m4: ~A" m4))
- (if (not (= (mark-sample m1) 1234)) (snd-display ";as-one-edit m1 sample: ~A (1234)" (mark-sample m1)))
- (if (not (= (mark-sample m2) 1235)) (snd-display ";as-one-edit m2 sample: ~A (1235)" (mark-sample m2)))
- (if (not (= (mark-sample m3) 1238)) (snd-display ";as-one-edit m3 sample: ~A (1238)" (mark-sample m3)))
- (if (not (= (mark-sample m4) 1237)) (snd-display ";as-one-edit m4 sample: ~A (1237)" (mark-sample m4)))
+ (if (not (mark? m1)) (snd-display #__line__ ";2nd as-one-edit stepped on m1: ~A" m1))
+ (if (not (mark? m2)) (snd-display #__line__ ";2nd as-one-edit stepped on m2: ~A" m2))
+ (if (not (mark? m3)) (snd-display #__line__ ";2nd as-one-edit stepped on m3: ~A" m3))
+ (if (not (mark? m4)) (snd-display #__line__ ";2nd as-one-edit stepped on m4: ~A" m4))
+ (if (not (= (mark-sample m1) 1234)) (snd-display #__line__ ";as-one-edit m1 sample: ~A (1234)" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 1235)) (snd-display #__line__ ";as-one-edit m2 sample: ~A (1235)" (mark-sample m2)))
+ (if (not (= (mark-sample m3) 1238)) (snd-display #__line__ ";as-one-edit m3 sample: ~A (1238)" (mark-sample m3)))
+ (if (not (= (mark-sample m4) 1237)) (snd-display #__line__ ";as-one-edit m4 sample: ~A (1237)" (mark-sample m4)))
(if (not (string=? (display-edits ind 0) (string-append "
EDITS: 1
@@ -13378,7 +13452,7 @@ EDITS: 1
(at 1240, cp->sounds[0][1240:50827, 1.000]) [file: " cwd "oboe.snd[0]]
(at 50828, end_mark)
")))
- (snd-display ";as-one-edit edits: ~A" (display-edits ind 0)))
+ (snd-display #__line__ ";as-one-edit edits: ~A" (display-edits ind 0)))
(revert-sound ind))
@@ -13395,8 +13469,8 @@ EDITS: 1
(set! (sample 123 ind 0) .3)
(set! m2 (mix-vct (vct .1 .2 .3) 1235 ind 0)))
"as-one-edit inner 1")
- (if (not (mix? m1)) (snd-display ";as-one-edit stepped on m1: ~A" m1))
- (if (not (mix? m2)) (snd-display ";as-one-edit stepped on m2: ~A" m2))
+ (if (not (mix? m1)) (snd-display #__line__ ";as-one-edit stepped on m1: ~A" m1))
+ (if (not (mix? m2)) (snd-display #__line__ ";as-one-edit stepped on m2: ~A" m2))
(as-one-edit
(lambda ()
(set! m3 (mix-vct (vct .1 .2 .3) 1238 ind 0))
@@ -13405,10 +13479,10 @@ EDITS: 1
(set! (sample 1239 ind 0) .9)
(set! m4 (mix-vct (vct .1 .2 .3) 1237 ind 0)))
"outer as-one-edit")
- (if (not (mix? m1)) (snd-display ";2nd as-one-edit stepped on mx1: ~A" m1))
- (if (not (mix? m2)) (snd-display ";2nd as-one-edit stepped on mx2: ~A" m2))
- (if (not (mix? m3)) (snd-display ";2nd as-one-edit stepped on mx3: ~A" m3))
- (if (not (mix? m4)) (snd-display ";2nd as-one-edit stepped on mx4: ~A" m4))
+ (if (not (mix? m1)) (snd-display #__line__ ";2nd as-one-edit stepped on mx1: ~A" m1))
+ (if (not (mix? m2)) (snd-display #__line__ ";2nd as-one-edit stepped on mx2: ~A" m2))
+ (if (not (mix? m3)) (snd-display #__line__ ";2nd as-one-edit stepped on mx3: ~A" m3))
+ (if (not (mix? m4)) (snd-display #__line__ ";2nd as-one-edit stepped on mx4: ~A" m4))
(revert-sound ind))
(let ((ind2 #f))
@@ -13418,13 +13492,13 @@ EDITS: 1
(set! (sample 100 ind 0) .5)
(set! (sample 200 ind2 0) .6))
"as-one-edit+open")
- (if (not (sound? ind2)) (snd-display ";as-one-edit didn't open sound? ~A ~A" ind2 (sounds)))
- (if (not (= (edit-position ind2 0) 1)) (snd-display ";edpos as-one-edit opened sound: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";edpos as-one-edit original sound: ~A" (edit-position ind 0)))
+ (if (not (sound? ind2)) (snd-display #__line__ ";as-one-edit didn't open sound? ~A ~A" ind2 (sounds)))
+ (if (not (= (edit-position ind2 0) 1)) (snd-display #__line__ ";edpos as-one-edit opened sound: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";edpos as-one-edit original sound: ~A" (edit-position ind 0)))
(if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit+open" "set" 100 1)))
- (snd-display ";as-one-edit open sound edlist orig: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";as-one-edit open sound edlist orig: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 200 0.6000" "set" 200 1)))
- (snd-display ";as-one-edit open sound edlist new: ~A" (edit-fragment 1 ind2 0)))
+ (snd-display #__line__ ";as-one-edit open sound edlist new: ~A" (edit-fragment 1 ind2 0)))
(as-one-edit
(lambda ()
@@ -13433,9 +13507,9 @@ EDITS: 1
"as-one-edit+close")
(if (sound? ind2)
(begin
- (snd-display ";as-one-edit didn't close sound? ~A ~A" ind2 (sounds))
+ (snd-display #__line__ ";as-one-edit didn't close sound? ~A ~A" ind2 (sounds))
(close-sound ind2)))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";edpos as-one-edit close original sound: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";edpos as-one-edit close original sound: ~A" (edit-position ind 0)))
(if (not (string=? (display-edits ind 0) (string-append "
EDITS: 2
@@ -13457,7 +13531,7 @@ EDITS: 2
(at 201, cp->sounds[0][201:50827, 1.000]) [file: " cwd "oboe.snd[0]]
(at 50828, end_mark)
")))
- (snd-display ";as-one-edit open+close: ~A" (display-edits ind 0))))
+ (snd-display #__line__ ";as-one-edit open+close: ~A" (display-edits ind 0))))
(close-sound ind))
@@ -13474,8 +13548,8 @@ EDITS: 2
"inner edit")
(set! (sample 300 ind2 0) .6))
"outer edit")
- (if (sound? ind1) (snd-display ";as-one-edit close inner: ~A ~A" ind1 (sounds)))
- (if (not (sound? ind2)) (snd-display ";as-one-edit open inner: ~A ~A" ind2 (sounds)))
+ (if (sound? ind1) (snd-display #__line__ ";as-one-edit close inner: ~A ~A" ind1 (sounds)))
+ (if (not (sound? ind2)) (snd-display #__line__ ";as-one-edit open inner: ~A ~A" ind2 (sounds)))
(revert-sound ind2)
(as-one-edit
@@ -13496,67 +13570,67 @@ EDITS: 2
(lambda ()
(ptree-channel (lambda (y) (* y 2)))
(env-sound '(0 0 1 1))))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";as-one-edit env+ptree pos: ~A" (edit-position ind 0)))
- (if (fneq (maxamp ind 0) .1825) (snd-display ";as-one-edit env+ptree max: ~A" (maxamp ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit env+ptree pos: ~A" (edit-position ind 0)))
+ (if (fneq (maxamp ind 0) .1825) (snd-display #__line__ ";as-one-edit env+ptree max: ~A" (maxamp ind 0)))
(undo)
(let ((tag (catch #t
(lambda () (as-one-edit (lambda (oops) #f)))
(lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display ";as-one-edit arg? ~A" tag)))
+ (snd-display #__line__ ";as-one-edit arg? ~A" tag)))
(let ((tag (catch #t
(lambda () (as-one-edit (lambda* (oops) #f)))
(lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display ";as-one-edit arg? ~A" tag)))
+ (snd-display #__line__ ";as-one-edit arg? ~A" tag)))
(as-one-edit
(lambda ()
(ptree-channel (lambda (y) (* y 2)))
(ptree-channel (lambda (y) (* y 2)))))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";as-one-edit ptree+ptree pos: ~A" (edit-position ind 0)))
- (if (fneq (maxamp ind 0) (* 4 mx)) (snd-display ";as-one-edit ptree+ptree max: ~A ~A" (maxamp ind 0) (* 4 mx)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit ptree+ptree pos: ~A" (edit-position ind 0)))
+ (if (fneq (maxamp ind 0) (* 4 mx)) (snd-display #__line__ ";as-one-edit ptree+ptree max: ~A ~A" (maxamp ind 0) (* 4 mx)))
(close-sound ind))
(let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "ptree tests" 10)))
;; offset-channel
(offset-channel .1)
(if (not (vequal (channel->vct 0 10) (make-vct 10 .1)))
- (snd-display ";offset-channel (.1): ~A" (channel->vct 0 10)))
+ (snd-display #__line__ ";offset-channel (.1): ~A" (channel->vct 0 10)))
(offset-channel -.2 5 5)
(if (not (vequal (channel->vct 0 10) (vct .1 .1 .1 .1 .1 -.1 -.1 -.1 -.1 -.1)))
- (snd-display ";offset-channel (-.1): ~A" (channel->vct 0 10)))
+ (snd-display #__line__ ";offset-channel (-.1): ~A" (channel->vct 0 10)))
(undo)
(offset-channel .9 0 10 ind 0)
(if (not (vequal (channel->vct 0 10) (make-vct 10 1.0)))
- (snd-display ";offset-channel (1): ~A" (channel->vct 0 10)))
+ (snd-display #__line__ ";offset-channel (1): ~A" (channel->vct 0 10)))
;; sine-env and sine-ramp...
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(sine-ramp 0.0 1.0)
(if (not (vequal (channel->vct) (vct 0.000 0.024 0.095 0.206 0.345 0.500 0.655 0.794 0.905 0.976)))
- (snd-display ";sine-ramp 0 1: ~A" (channel->vct)))
+ (snd-display #__line__ ";sine-ramp 0 1: ~A" (channel->vct)))
(revert-sound ind)
(offset-channel 1.0)
(sine-ramp 1.0 0.0)
(if (not (vequal (channel->vct) (vct 1.000 0.976 0.905 0.794 0.655 0.500 0.345 0.206 0.095 0.024)))
- (snd-display ";sine-ramp 1 0: ~A" (channel->vct)))
+ (snd-display #__line__ ";sine-ramp 1 0: ~A" (channel->vct)))
(if (> (optimization) 0)
(if (not (string=? (edit-fragment-type-name (list-ref (car (edit-tree)) 7)) "ed_ptree_zero"))
- (snd-display ";sine-ramp tree op: ~A ~A" (edit-fragment-type-name (list-ref (car (edit-tree)) 7)) (edit-tree))))
+ (snd-display #__line__ ";sine-ramp tree op: ~A ~A" (edit-fragment-type-name (list-ref (car (edit-tree)) 7)) (edit-tree))))
(close-sound ind)
(set! ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "sine-env tests" 100))
(map-channel (lambda (y) 1.0))
(sine-env-channel '(0 0 1 1 2 -.5 3 1))
(if (or (not (vequal (channel->vct 20 10) (vct 0.664 0.708 0.750 0.790 0.827 0.862 0.893 0.921 0.944 0.964)))
(not (vequal (channel->vct 60 10) (vct -0.381 -0.417 -0.446 -0.470 -0.486 -0.497 -0.500 -0.497 -0.486 -0.470))))
- (snd-display ";sine-env-channel 0: ~A ~A" (channel->vct 20 10) (channel->vct 60 10)))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";as-one-edit sine-env-channel: ~A" (edit-position ind 0)))
+ (snd-display #__line__ ";sine-env-channel 0: ~A ~A" (channel->vct 20 10) (channel->vct 60 10)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit sine-env-channel: ~A" (edit-position ind 0)))
(revert-sound ind)
(offset-channel -1.0)
(sine-env-channel '(0 0 1 1 2 1 3 0) 40 20)
(if (or (not (vequal (channel->vct 40 20) (vct -0.000 -0.050 -0.188 -0.389 -0.611 -0.812 -0.950 -1.000 -1.000 -1.000
-1.000 -1.000 -1.000 -1.000 -1.000 -0.950 -0.812 -0.611 -0.389 -0.188)))
(not (vequal (channel->vct 30 10) (make-vct 10 -1.0))))
- (snd-display ";off+sine-env: ~A ~A" (channel->vct 40 20) (channel->vct 30 10)))
+ (snd-display #__line__ ";off+sine-env: ~A ~A" (channel->vct 40 20) (channel->vct 30 10)))
(revert-sound ind)
(ptree-channel (lambda (y d f) (* y 2)) 0 (frames) ind 0 #f #f (lambda (p d) (vct 1.0)))
(revert-sound ind)
@@ -13564,7 +13638,7 @@ EDITS: 2
(dither-channel)
(let ((mx (maxamp)))
(if (or (< mx .00003) (> mx .0001))
- (snd-display ";dithering: ~A" mx)))
+ (snd-display #__line__ ";dithering: ~A" mx)))
(revert-sound ind)
(map-channel (ring-mod 10 (list 0 0 1 (hz->radians 100))))
(osc-formants .99 (vct 400.0 800.0 1200.0) (vct 400.0 800.0 1200.0) (vct 4.0 2.0 3.0))
@@ -13577,9 +13651,9 @@ EDITS: 2
(map-channel (notch-filter .8 32))
(let ((ind1 (open-sound "now.snd")))
(select-sound ind1)
- (if (fneq (maxamp) .309) (snd-display ";squelch-vowels init: ~A" (maxamp)))
+ (if (fneq (maxamp) .309) (snd-display #__line__ ";squelch-vowels init: ~A" (maxamp)))
(squelch-vowels)
- (if (fneq (maxamp) .047) (snd-display ";squelch-vowels maxamp: ~A" (maxamp)))
+ (if (fneq (maxamp) .047) (snd-display #__line__ ";squelch-vowels maxamp: ~A" (maxamp)))
(select-sound ind)
(map-channel (cross-synthesis ind1 .5 128 6.0))
(revert-sound ind1)
@@ -13600,7 +13674,7 @@ EDITS: 2
(blackman4-env-channel '(0 0 1 1))
(let ((new-vals (channel->vct)))
(if (not (vequal vals new-vals))
- (snd-display ";blackman4-env-channel/ramp: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";blackman4-env-channel/ramp: ~A ~A" vals new-vals))
(undo)
(blackman4-ramp 0.0 1.0 0 50)
(set! vals (channel->vct))
@@ -13608,11 +13682,11 @@ EDITS: 2
(blackman4-env-channel '(0 0 1 1 2 1))
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";blackman4-env-channel/ramp 1: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";blackman4-env-channel/ramp 1: ~A ~A" vals new-vals))
(undo)
(blackman4-env-channel '(0 0 1 1 2 -.5 3 0))
(if (not (vequal (channel->vct 60 10) (vct -0.109 -0.217 -0.313 -0.392 -0.451 -0.488 -0.499 -0.499 -0.499 -0.499)))
- (snd-display ";blackman4 to -.5: ~A" (channel->vct 60 10)))
+ (snd-display #__line__ ";blackman4 to -.5: ~A" (channel->vct 60 10)))
(undo)
(ramp-squared 0.0 1.0)
@@ -13621,7 +13695,7 @@ EDITS: 2
(env-squared-channel '(0 0 1 1))
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-squared/ramp: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-squared/ramp: ~A ~A" vals new-vals))
(undo)
(ramp-squared 0.0 1.0 #t 0 50)
(set! vals (channel->vct))
@@ -13629,15 +13703,15 @@ EDITS: 2
(env-squared-channel '(0 0 1 1 2 1))
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-squared/ramp 1: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-squared/ramp 1: ~A ~A" vals new-vals))
(undo)
(env-squared-channel '(0 0 1 1 2 -.5 3 0))
(if (not (vequal (channel->vct 60 10) (vct -0.450 -0.466 -0.478 -0.488 -0.494 -0.499 -0.500 -0.500 -0.498 -0.496)))
- (snd-display ";env-squared to -.5: ~A" (channel->vct 60 10)))
+ (snd-display #__line__ ";env-squared to -.5: ~A" (channel->vct 60 10)))
(undo)
(env-squared-channel '(0 0 1 1 2 -.5 3 0) #f)
(if (not (vequal (channel->vct 60 10) (vct -0.004 -0.080 -0.158 -0.240 -0.324 -0.410 -0.500 -0.500 -0.498 -0.496)))
- (snd-display ";env-squared unsymmetric to -.5: ~A" (channel->vct 60 10)))
+ (snd-display #__line__ ";env-squared unsymmetric to -.5: ~A" (channel->vct 60 10)))
(undo)
(ramp-squared 0.0 1.0)
@@ -13646,7 +13720,7 @@ EDITS: 2
(env-expt-channel '(0 0 1 1) 2)
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-expt2/ramp: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-expt2/ramp: ~A ~A" vals new-vals))
(undo)
(env-squared-channel '(0 0 1 1 2 -.5 3 0))
(set! vals (channel->vct))
@@ -13654,7 +13728,7 @@ EDITS: 2
(env-expt-channel '(0 0 1 1 2 -.5 3 0) 2.0)
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-expt2/env-squared: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-expt2/env-squared: ~A ~A" vals new-vals))
(undo)
(env-squared-channel '(0 0 1 1 2 -.5 3 0) #f)
(set! vals (channel->vct))
@@ -13662,7 +13736,7 @@ EDITS: 2
(env-expt-channel '(0 0 1 1 2 -.5 3 0) 2.0 #f)
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-expt2/env-squared unsymmetric: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-expt2/env-squared unsymmetric: ~A ~A" vals new-vals))
(undo)
(ramp-expt 0.0 1.0 32.0)
@@ -13671,7 +13745,7 @@ EDITS: 2
(env-expt-channel '(0 0 1 1) 32.0)
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-expt/ramp 32: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-expt/ramp 32: ~A ~A" vals new-vals))
(undo)
(ramp-expt 0.0 1.0 32.0 #f 0 50)
(set! vals (channel->vct))
@@ -13679,7 +13753,7 @@ EDITS: 2
(env-expt-channel '(0 0 1 1 2 1) 32.0)
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-expt/ramp 1 32: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-expt/ramp 1 32: ~A ~A" vals new-vals))
(undo)
(ramp-expt 0.0 1.0 .1)
(set! vals (channel->vct))
@@ -13687,16 +13761,16 @@ EDITS: 2
(env-expt-channel '(0 0 1 1) .1)
(set! new-vals (channel->vct))
(if (not (vequal vals new-vals))
- (snd-display ";env-expt/ramp .1: ~A ~A" vals new-vals))
+ (snd-display #__line__ ";env-expt/ramp .1: ~A ~A" vals new-vals))
(undo)
(env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0)
(if (not (vequal (channel->vct 30 10) (vct 0.319 0.472 0.691 1.000 0.537 0.208 -0.022 -0.182 -0.291 -0.365)))
- (snd-display ";env-expt to -.5 12.0: ~A" (channel->vct 30 10)))
+ (snd-display #__line__ ";env-expt to -.5 12.0: ~A" (channel->vct 30 10)))
(undo)
(env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0 #f)
(if (not (vequal (channel->vct 30 10) (vct 0.319 0.472 0.691 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (snd-display ";env-expt to -.5 12.0 unsymmetric: ~A" (channel->vct 30 10)))
+ (snd-display #__line__ ";env-expt to -.5 12.0 unsymmetric: ~A" (channel->vct 30 10)))
(undo)
(close-sound ind))))
@@ -13713,7 +13787,7 @@ EDITS: 2
(ny (sin (+ (* val 0.5 pi) (* 1.0 (sin (* val 2.0 pi)))))))
(if (fneq y ny)
(begin
- (snd-display ";contrast-channel: ~A ~A ~A" val y ny)
+ (snd-display #__line__ ";contrast-channel: ~A ~A ~A" val y ny)
(set! happy #f))))))
(undo)
(compand-channel)
@@ -13726,7 +13800,7 @@ EDITS: 2
(ny (array-interp compand-table (+ 8.0 (* 8.0 val)) 17)))
(if (fneq y ny)
(begin
- (snd-display ";compand-channel: ~A ~A ~A" val y ny)
+ (snd-display #__line__ ";compand-channel: ~A ~A ~A" val y ny)
(set! happy #f))))))
(undo 2)
(ring-modulate-channel 1000)
@@ -13740,7 +13814,7 @@ EDITS: 2
(ny (sin val)))
(if (fneq y ny)
(begin
- (snd-display ";ring-modulate-channel: ~A ~A ~A" val y ny)
+ (snd-display #__line__ ";ring-modulate-channel: ~A ~A ~A" val y ny)
(set! happy #f))))))
(undo)
(env-sound '(0 0 1 1))
@@ -13755,22 +13829,22 @@ EDITS: 2
(ny (+ 0.5 (* 0.5 (cos val)))))
(if (fneq y ny)
(begin
- (snd-display ";smooth-channel-via-ptree: ~A ~A ~A" val y ny)
+ (snd-display #__line__ ";smooth-channel-via-ptree: ~A ~A ~A" val y ny)
(set! happy #f))))))
(undo 2)
(env-channel '(0 1 1 0 2 1) 10 11)
(if (not (vequal (channel->vct 0 30) (vct 1 1 1 1 1 1 1 1 1 1 1.000 0.800 0.600 0.400 0.200 0.000 0.200 0.400 0.600 0.800 1 1 1 1 1 1 1 1 1 1)))
- (snd-display ";env+ptree: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
+ (snd-display #__line__ ";env+ptree: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
(close-sound ind))
(let ((ind0 (open-sound "oboe.snd"))
(ind1 (open-sound "pistol.snd")))
(let ((clip (channel-clipped? ind0 0)))
- (if clip (snd-display ";channel-clipped? oboe.snd -> ~A" clip)))
+ (if clip (snd-display #__line__ ";channel-clipped? oboe.snd -> ~A" clip)))
(scale-to 1.5 ind0 0)
(let ((clip (channel-clipped? ind0 0)))
- (if (not (equal? clip (list #t 4503))) (snd-display ";channel-clipped after scale: ~A" clip)))
+ (if (not (equal? clip (list #t 4503))) (snd-display #__line__ ";channel-clipped after scale: ~A" clip)))
(revert-sound ind0)
(ramp-channel 0.0 1.0 0 #f ind1 0)
@@ -13783,17 +13857,17 @@ EDITS: 2
(env-selection '(0 0 1 1))
(if (or (not (= (edit-position ind0 0) 0))
(not (= (edit-position ind1 0) 5)))
- (snd-display ";selection override of sync field: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
+ (snd-display #__line__ ";selection override of sync field: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
(env-sound '(0 0 1 1 2 0))
(if (or (not (= (edit-position ind0 0) 1))
(not (= (edit-position ind1 0) 5)))
- (snd-display ";sync field over selection: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
+ (snd-display #__line__ ";sync field over selection: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
(close-sound ind1)
(revert-sound ind0)
(let ((val (sample 1990)))
(delay-channel 10)
- (if (fneq (sample 2000) val) (snd-display ";delay-channel: ~A ~A" val (sample 2000))))
+ (if (fneq (sample 2000) val) (snd-display #__line__ ";delay-channel: ~A ~A" val (sample 2000))))
(close-sound ind0))
(let ((ind (new-sound "test.snd" :size 20)))
@@ -13803,12 +13877,12 @@ EDITS: 2
(env-sound '(0 1 1 .5 2 .5 3 1) 0 20 .6)
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.000 0.049 0.091 0.123 0.146 0.158 0.158 0.184 0.211 0.237 0.263 0.289 0.316 0.342 0.444 0.549 0.658 0.770 0.884 1.000)))
- (snd-display ";env-sound xramp with flat segment: ~A" data)))
+ (snd-display #__line__ ";env-sound xramp with flat segment: ~A" data)))
(ptree-channel (lambda (y) (+ y .5)))
(xramp-channel .1 .2 32.0)
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.050 0.055 0.060 0.064 0.067 0.069 0.070 0.074 0.079 0.084 0.089 0.095 0.102 0.111 0.130 0.154 0.181 0.214 0.253 0.300)))
- (snd-display ";ramp->xramp->ptree->xramp: ~A" data)))
+ (snd-display #__line__ ";ramp->xramp->ptree->xramp: ~A" data)))
(set! (edit-position) 1)
(ramp-channel 0 1)
@@ -13817,7 +13891,7 @@ EDITS: 2
(xramp-channel .1 .2 32.0)
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.050 0.055 0.058 0.060 0.060 0.058 0.053 0.054 0.055 0.057 0.058 0.060 0.063 0.066 0.090 0.119 0.153 0.193 0.241 0.300)))
- (snd-display ";1 ramp->xramp->ptree->xramp: ~A" data)))
+ (snd-display #__line__ ";1 ramp->xramp->ptree->xramp: ~A" data)))
(set! (edit-position) 1)
(env-sound '(0 1 1 0.5 2 0.5 3 1) 0 20 .6)
@@ -13826,18 +13900,18 @@ EDITS: 2
(xramp-channel .1 .2 32.0)
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.150 0.129 0.109 0.091 0.076 0.063 0.053 0.054 0.055 0.057 0.058 0.060 0.063 0.066 0.083 0.107 0.139 0.181 0.234 0.300)))
- (snd-display ";2 ramp->xramp->ptree->xramp: ~A" data)))
+ (snd-display #__line__ ";2 ramp->xramp->ptree->xramp: ~A" data)))
(close-sound ind))
-
+
(let ((s1 (open-sound "oboe.snd")))
(let ((s2 (copy s1)))
(if (not (sound? s2))
- (snd-display ";copy sound oboe -> ~A" s2)
+ (snd-display #__line__ ";copy sound oboe -> ~A" s2)
(begin
- (if (not (= (srate s1) (srate s2))) (snd-display ";copy sounds srates: ~A ~A" (srate s1) (srate s2)))
- (if (not (= (frames s1) (frames s2))) (snd-display ";copy sounds frames: ~A ~A" (frames s1) (frames s2)))
- (if (not (= (chans s1) (chans s2) 1)) (snd-display ";copy sounds chans: ~A ~A" (chans s1) (chans s2)))
+ (if (not (= (srate s1) (srate s2))) (snd-display #__line__ ";copy sounds srates: ~A ~A" (srate s1) (srate s2)))
+ (if (not (= (frames s1) (frames s2))) (snd-display #__line__ ";copy sounds frames: ~A ~A" (frames s1) (frames s2)))
+ (if (not (= (chans s1) (chans s2) 1)) (snd-display #__line__ ";copy sounds chans: ~A ~A" (chans s1) (chans s2)))
(let ((r1 (make-sampler 0 s1))
(r2 (make-sampler 0 s2))
(happy #t))
@@ -13849,22 +13923,22 @@ EDITS: 2
(if (> (abs (- v1 v2)) .0001)
(begin
(set! happy #f)
- (snd-display ";copied sound not equal? pos: ~A, ~A ~A" i v1 v2))))))
+ (snd-display #__line__ ";copied sound not equal? pos: ~A, ~A ~A" i v1 v2))))))
(close-sound s2))))
(fill! s1 0.0)
- (if (fneq (maxamp s1) 0.0) (snd-display ";fill 1 with 0: ~A" (maxamp s1)))
+ (if (fneq (maxamp s1) 0.0) (snd-display #__line__ ";fill 1 with 0: ~A" (maxamp s1)))
(fill! s1 0.3)
- (if (fneq (maxamp s1) 0.3) (snd-display ";fill 1 with 0.3: ~A" (maxamp s1)))
+ (if (fneq (maxamp s1) 0.3) (snd-display #__line__ ";fill 1 with 0.3: ~A" (maxamp s1)))
(close-sound s1))
(let ((s1 (open-sound "2a.snd")))
(let ((s2 (copy s1)))
(if (not (sound? s2))
- (snd-display ";copy sound 2a -> ~A" s2)
+ (snd-display #__line__ ";copy sound 2a -> ~A" s2)
(begin
- (if (not (= (srate s1) (srate s2))) (snd-display ";copy sounds srates 2: ~A ~A" (srate s1) (srate s2)))
- (if (not (= (frames s1) (frames s2))) (snd-display ";copy sounds frames 2: ~A ~A" (frames s1) (frames s2)))
- (if (not (= (chans s1) (chans s2) 2)) (snd-display ";copy sounds chans 2: ~A ~A" (chans s1) (chans s2)))
+ (if (not (= (srate s1) (srate s2))) (snd-display #__line__ ";copy sounds srates 2: ~A ~A" (srate s1) (srate s2)))
+ (if (not (= (frames s1) (frames s2))) (snd-display #__line__ ";copy sounds frames 2: ~A ~A" (frames s1) (frames s2)))
+ (if (not (= (chans s1) (chans s2) 2)) (snd-display #__line__ ";copy sounds chans 2: ~A ~A" (chans s1) (chans s2)))
(let ((r10 (make-sampler 0 s1 0))
(r11 (make-sampler 0 s1 1))
(r20 (make-sampler 0 s2 0))
@@ -13878,24 +13952,24 @@ EDITS: 2
(if (> (abs (- v1 v2)) .0001)
(begin
(set! happy #f)
- (snd-display ";copied sound 2 (0) not equal? pos: ~A, ~A ~A" i v1 v2))))
+ (snd-display #__line__ ";copied sound 2 (0) not equal? pos: ~A, ~A ~A" i v1 v2))))
(let ((v1 (r11))
(v2 (r21)))
(if (> (abs (- v1 v2)) .0001)
(begin
(set! happy #f)
- (snd-display ";copied sound 2 (1) not equal? pos: ~A, ~A ~A" i v1 v2))))))
+ (snd-display #__line__ ";copied sound 2 (1) not equal? pos: ~A, ~A ~A" i v1 v2))))))
(close-sound s2))))
(fill! s1 0.0)
- (if (fneq (maxamp s1) 0.0) (snd-display ";fill 2 with 0: ~A" (maxamp s1)))
+ (if (fneq (maxamp s1) 0.0) (snd-display #__line__ ";fill 2 with 0: ~A" (maxamp s1)))
(fill! s1 0.3)
- (if (fneq (maxamp s1) 0.3) (snd-display ";fill 2 with 0.3: ~A" (maxamp s1)))
+ (if (fneq (maxamp s1) 0.3) (snd-display #__line__ ";fill 2 with 0.3: ~A" (maxamp s1)))
(close-sound s1))
-
+
(for-each close-sound (sounds))
(let ((snd (open-sound "oboe.snd")))
(make-selection 1000 2000 snd 0)
- (if (not (selection?)) (snd-display ";make-selection for copy failed?"))
+ (if (not (selection?)) (snd-display #__line__ ";make-selection for copy failed?"))
(copy (selection))
(let* ((r1 (make-sampler 1000 snd 0))
(snds (sounds))
@@ -13903,7 +13977,7 @@ EDITS: 2
(r2 (make-sampler 0 sel 0))
(happy #t))
(if (equal? sel snd)
- (snd-display ";very weird: ~A equal? ~A from ~A (~A ~A ~A)" sel snd snds (car snds) (cadr snds) (equal? (car snds) snd)))
+ (snd-display #__line__ ";very weird: ~A equal? ~A from ~A (~A ~A ~A)" sel snd snds (car snds) (cadr snds) (equal? (car snds) snd)))
(do ((i 0 (+ i 1)))
((or (not happy)
(= i 1000)))
@@ -13912,10 +13986,10 @@ EDITS: 2
(if (> (abs (- v1 v2)) .0001)
(begin
(set! happy #f)
- (snd-display ";copied selection not equal? pos: ~A, ~A ~A (~A ~A from ~A)" i v1 v2 sel snd snds)))))
+ (snd-display #__line__ ";copied selection not equal? pos: ~A, ~A ~A (~A ~A from ~A)" i v1 v2 sel snd snds)))))
(close-sound sel)
(if (not (selection?))
- (snd-display ";copy selection unselected? ~A" (sounds))
+ (snd-display #__line__ ";copy selection unselected? ~A" (sounds))
(begin
(fill! (selection) 0.0)
(let ((r1 (make-sampler 1000 snd 0))
@@ -13927,10 +14001,10 @@ EDITS: 2
(if (not (= v1 0.0))
(begin
(set! happy #f)
- (snd-display ";fill! selection not 0.0? pos: ~A, ~A" i v1))))))
+ (snd-display #__line__ ";fill! selection not 0.0? pos: ~A, ~A" i v1))))))
(revert-sound snd)
(if (not (selection?))
- (snd-display ";revert-sound selection unselected?")
+ (snd-display #__line__ ";revert-sound selection unselected?")
(begin
(fill! (selection) 0.3)
(let ((r1 (make-sampler 1000 snd 0))
@@ -13942,18 +14016,18 @@ EDITS: 2
(if (not (= v1 0.3))
(begin
(set! happy #f)
- (snd-display ";fill! selection not 0.3? pos: ~A, ~A" i v1)))))))))))
+ (snd-display #__line__ ";fill! selection not 0.3? pos: ~A, ~A" i v1)))))))))))
(for-each close-sound (sounds)))
(let ((snd (open-sound "oboe.snd")))
(make-selection 1000 2000 snd 0)
(if (not (selection?))
- (snd-display ";make-selection failed?")
+ (snd-display #__line__ ";make-selection failed?")
(let ((sel-max (maxamp (selection)))
(sel-len (length (selection))))
(let ((mx (car (selection->mix))))
(if (not (mix? mx))
- (snd-display ";selection->mix: ~A" mx)
+ (snd-display #__line__ ";selection->mix: ~A" mx)
(let ((mx-rd (make-mix-sampler mx 0))
(snd-rd (make-sampler 1000 snd 0))
(orig-rd (make-sampler 1000 snd 0 1 0)))
@@ -13968,9 +14042,9 @@ EDITS: 2
(fneq snd-val orig-val))
(begin
(set! happy #f)
- (snd-display ";selection->mix at ~A: ~A ~A ~A" (+ i 1000) mx-val snd-val orig-val))))))
- (if (not (= (length mx) sel-len 1001)) (snd-display ";selection->mix mix length: ~A (~A)" (length mx) sel-len))
- (if (fneq (maxamp mx) sel-max) (snd-display ";selection->mix maxamps: ~A ~A" (maxamp mx) sel-max)))))))
+ (snd-display #__line__ ";selection->mix at ~A: ~A ~A ~A" (+ i 1000) mx-val snd-val orig-val))))))
+ (if (not (= (length mx) sel-len 1001)) (snd-display #__line__ ";selection->mix mix length: ~A (~A)" (length mx) sel-len))
+ (if (fneq (maxamp mx) sel-max) (snd-display #__line__ ";selection->mix maxamps: ~A ~A" (maxamp mx) sel-max)))))))
(for-each close-sound (sounds)))
(let ((snd (open-sound "2.snd")))
@@ -13978,18 +14052,18 @@ EDITS: 2
;; make-selection claims it follows the sync field
(make-selection 2000 3000 snd)
(if (not (selection?))
- (snd-display ";make-selection (2) failed?")
+ (snd-display #__line__ ";make-selection (2) failed?")
(let ((sel-max (maxamp (selection)))
(sel-len (length (selection)))
(sel-chns (channels (selection))))
- (if (not (= sel-chns 2)) (snd-display ";make-selection stereo syncd chans: ~A" sel-chns))
- (if (not (= sel-len 1001)) (snd-display ";make-selection stereo length: ~A" sel-len))
+ (if (not (= sel-chns 2)) (snd-display #__line__ ";make-selection stereo syncd chans: ~A" sel-chns))
+ (if (not (= sel-len 1001)) (snd-display #__line__ ";make-selection stereo length: ~A" sel-len))
(let* ((mx-list (selection->mix))
(mx0 (car mx-list))
(mx1 (cadr mx-list)))
(if (or (not (mix? mx0))
(not (mix? mx1)))
- (snd-display ";selection->mix stereo: ~A ~A" mx0 mx1)
+ (snd-display #__line__ ";selection->mix stereo: ~A ~A" mx0 mx1)
(let ((mx0-rd (make-mix-sampler mx0 0))
(mx1-rd (make-mix-sampler mx1 0))
(snd0-rd (make-sampler 2000 snd 0))
@@ -14010,24 +14084,24 @@ EDITS: 2
(fneq snd0-val orig0-val))
(begin
(set! happy #f)
- (snd-display ";selection->mix stereo 0 at ~A: ~A ~A ~A" (+ i 2000) mx0-val snd0-val orig0-val)))
+ (snd-display #__line__ ";selection->mix stereo 0 at ~A: ~A ~A ~A" (+ i 2000) mx0-val snd0-val orig0-val)))
(if (or (fneq mx1-val snd1-val)
(fneq snd1-val orig1-val))
(begin
(set! happy #f)
- (snd-display ";selection->mix stereo 1 at ~A: ~A ~A ~A" (+ i 2000) mx1-val snd1-val orig1-val))))))))
+ (snd-display #__line__ ";selection->mix stereo 1 at ~A: ~A ~A ~A" (+ i 2000) mx1-val snd1-val orig1-val))))))))
(if (not (= (length mx0) (length mx1) sel-len 1001))
- (snd-display ";selection->mix stereo mix length: ~A ~A (~A)" (length mx0) (length mx1) sel-len))
+ (snd-display #__line__ ";selection->mix stereo mix length: ~A ~A (~A)" (length mx0) (length mx1) sel-len))
(if (fneq (max (maxamp mx0) (maxamp mx1)) sel-max)
- (snd-display ";selection->mix stereo maxamps: ~A ~A ~A" (maxamp mx0) (maxamp mx1) sel-max)))))
+ (snd-display #__line__ ";selection->mix stereo maxamps: ~A ~A ~A" (maxamp mx0) (maxamp mx1) sel-max)))))
(for-each close-sound (sounds)))
-
+
(clear-save-state-files)))
-
-
+
+
;;; ---------------- test 6: vcts ----------------
-
+
(define (snd_test_6)
(begin
@@ -14036,121 +14110,121 @@ EDITS: 2
(let ((v0 (make-vct 10))
(v1 (make-vct 10))
(vlst (make-vct 3)))
- (if (not (vct? v0)) (snd-display ";v0 isn't a vct?!?"))
- (if (equal? v0 10) (snd-display ";v0 is 10!?"))
- (if (vct? 10) (snd-display ";10 is a vct?"))
- (if (not (= (vct-length v0) 10)) (snd-display ";v0 length = ~D?" (vct-length v0)))
+ (if (not (vct? v0)) (snd-display #__line__ ";v0 isn't a vct?!?"))
+ (if (equal? v0 10) (snd-display #__line__ ";v0 is 10!?"))
+ (if (vct? 10) (snd-display #__line__ ";10 is a vct?"))
+ (if (not (= (vct-length v0) 10)) (snd-display #__line__ ";v0 length = ~D?" (vct-length v0)))
(vct-fill! v0 1.0)
(vct-fill! v1 0.5)
- (if (equal? v0 v1) (snd-display ";vct equal? ~A ~A" v0 v1))
- (if (eq? v0 v1) (snd-display ";vct eq? ~A ~A" v0 v1))
+ (if (equal? v0 v1) (snd-display #__line__ ";vct equal? ~A ~A" v0 v1))
+ (if (eq? v0 v1) (snd-display #__line__ ";vct eq? ~A ~A" v0 v1))
(let ((v2 v1)
(v3 (make-vct 10))
(v4 (make-vct 3)))
- (if (not (eq? v1 v2)) (snd-display ";vct not eq? ~A ~A" v1 v2))
+ (if (not (eq? v1 v2)) (snd-display #__line__ ";vct not eq? ~A ~A" v1 v2))
(vct-fill! v3 0.5)
- (if (not (equal? v3 v1)) (snd-display ";vct not equal? ~A ~A" v3 v1))
- (if (equal? v4 v1) (snd-display ";len diff vct equal? ~A ~A" v4 v1))
+ (if (not (equal? v3 v1)) (snd-display #__line__ ";vct not equal? ~A ~A" v3 v1))
+ (if (equal? v4 v1) (snd-display #__line__ ";len diff vct equal? ~A ~A" v4 v1))
(set! (vct-ref v3 0) 1.0)
- (if (fneq (vct-ref v3 0) 1.0) (snd-display ";set! vct-ref: ~A" (vct-ref v3 0))))
+ (if (fneq (vct-ref v3 0) 1.0) (snd-display #__line__ ";set! vct-ref: ~A" (vct-ref v3 0))))
(vct-set! vlst 1 .1)
- (if (not (feql (vct->list vlst) (list 0.0 0.1 0.0))) (snd-display ";vct->list: ~A?" (vct->list vlst)))
+ (if (not (feql (vct->list vlst) (list 0.0 0.1 0.0))) (snd-display #__line__ ";vct->list: ~A?" (vct->list vlst)))
(let* ((vect '#(0.0 1.0 2.0 3.0))
(v123 (vct 0.0 1.0 2.0 3.0))
(v2 (vector->vct vect))
(v3 v2)
(str (format #f "~A" v2))
(str1 (format #f "~A" (make-vct 32))))
- (if (not (eq? #f (vector->vct (make-vector 0)))) (snd-display ";vector->vct empty vect: ~A" (vector->vct (make-vector 0))))
+ (if (not (eq? #f (vector->vct (make-vector 0)))) (snd-display #__line__ ";vector->vct empty vect: ~A" (vector->vct (make-vector 0))))
(if (not (string=? str "#<vct[len=4]: 0.000 1.000 2.000 3.000>"))
- (snd-display ";vct print: ~% ~A~% ~A?" str v2))
+ (snd-display #__line__ ";vct print: ~% ~A~% ~A?" str v2))
(if (and (= (print-length) 12)
(not (string=? str1 "#<vct[len=32]: 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 ...>")))
- (snd-display ";vct(32) print: ~% ~A~%" str1))
- (if (not (vequal v123 v2)) (snd-display ";vector->vct: ~A" v2))
- (if (not (equal? (vct->vector v123) vect)) (snd-display ";vct->vector: ~A ~A" vect (vct->vector v123)))
- (if (not (equal? v3 v2)) (snd-display ";vct=? ~A ~A?" v2 v3))
- (if (not (= (vct-length v2) 4)) (snd-display ";vector->vct length: ~A?" (vct-length v2)))
- (if (fneq (vct-ref v2 2) 2.0) (snd-display ";vector->vct: ~A?" v2))
+ (snd-display #__line__ ";vct(32) print: ~% ~A~%" str1))
+ (if (not (vequal v123 v2)) (snd-display #__line__ ";vector->vct: ~A" v2))
+ (if (not (equal? (vct->vector v123) vect)) (snd-display #__line__ ";vct->vector: ~A ~A" vect (vct->vector v123)))
+ (if (not (equal? v3 v2)) (snd-display #__line__ ";vct=? ~A ~A?" v2 v3))
+ (if (not (= (vct-length v2) 4)) (snd-display #__line__ ";vector->vct length: ~A?" (vct-length v2)))
+ (if (fneq (vct-ref v2 2) 2.0) (snd-display #__line__ ";vector->vct: ~A?" v2))
(vct-move! v2 0 2)
- (if (fneq (vct-ref v2 0) 2.0) (snd-display ";vct-move!: ~A?" v2)))
+ (if (fneq (vct-ref v2 0) 2.0) (snd-display #__line__ ";vct-move!: ~A?" v2)))
(let ((v2 (make-vct 4)))
(do ((i 0 (+ 1 i)))
((= i 4))
(vct-set! v2 i i))
(vct-move! v2 3 2 #t)
(if (or (fneq (vct-ref v2 3) 2.0) (fneq (vct-ref v2 2) 1.0))
- (snd-display ";vct-move! back: ~A?" v2)))
+ (snd-display #__line__ ";vct-move! back: ~A?" v2)))
(if (not (string=? (vct->string (vct 1.0 2.0)) "(vct 1.000 2.000)"))
- (snd-display ";vct->string: ~A" (vct->string (vct 1.0 2.0))))
+ (snd-display #__line__ ";vct->string: ~A" (vct->string (vct 1.0 2.0))))
- (if (not (vequal (vct 4 3 2 1) (vct-reverse! (vct 1 2 3 4)))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3 4))))
- (if (not (vequal (vct 3 2 1) (vct-reverse! (vct 1 2 3)))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3))))
- (if (not (vequal (vct 2 1) (vct-reverse! (vct 1 2)))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1 2))))
- (if (not (vequal (vct 1) (vct-reverse! (vct 1)))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1))))
- (if (not (vequal (vct 4 3 2 1) (vct-reverse! (vct 1 2 3 4) 4))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3 4))))
- (if (not (vequal (vct 3 2 1) (vct-reverse! (vct 1 2 3) 3))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3))))
- (if (not (vequal (vct 2 1) (vct-reverse! (vct 1 2) 2))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1 2))))
- (if (not (vequal (vct 1) (vct-reverse! (vct 1) 1))) (snd-display ";vct-reverse: ~A" (vct-reverse! (vct 1))))
+ (if (not (vequal (vct 4 3 2 1) (vct-reverse! (vct 1 2 3 4)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3 4))))
+ (if (not (vequal (vct 3 2 1) (vct-reverse! (vct 1 2 3)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3))))
+ (if (not (vequal (vct 2 1) (vct-reverse! (vct 1 2)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2))))
+ (if (not (vequal (vct 1) (vct-reverse! (vct 1)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1))))
+ (if (not (vequal (vct 4 3 2 1) (vct-reverse! (vct 1 2 3 4) 4))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3 4))))
+ (if (not (vequal (vct 3 2 1) (vct-reverse! (vct 1 2 3) 3))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3))))
+ (if (not (vequal (vct 2 1) (vct-reverse! (vct 1 2) 2))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2))))
+ (if (not (vequal (vct 1) (vct-reverse! (vct 1) 1))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1))))
(let ((v0 (make-vct 3)))
(let ((var (catch #t (lambda () (vct-ref v0 10)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-ref high index: ~A" var)))
+ (snd-display #__line__ ";vct-ref high index: ~A" var)))
(let ((var (catch #t (lambda () (vct-ref v0 -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-ref low index: ~A" var)))
+ (snd-display #__line__ ";vct-ref low index: ~A" var)))
(let ((var (catch #t (lambda () (vct-set! v0 10 1.0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-set! high index: ~A" var)))
+ (snd-display #__line__ ";vct-set! high index: ~A" var)))
(let ((var (catch #t (lambda () (vct-set! v0 -1 1.0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-set! low index: ~A" var)))
+ (snd-display #__line__ ";vct-set! low index: ~A" var)))
(let ((var (catch #t (lambda () (vct-move! v0 10 0 #t)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-move! high index: ~A" var)))
+ (snd-display #__line__ ";vct-move! high index: ~A" var)))
(let ((var (catch #t (lambda () (vct-move! v0 0 10 #t)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-move! high 2 index: ~A" var)))
+ (snd-display #__line__ ";vct-move! high 2 index: ~A" var)))
(let ((var (catch #t (lambda () (vct-move! v0 -10 0 #f)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-move! back high index: ~A" var)))
+ (snd-display #__line__ ";vct-move! back high index: ~A" var)))
(let ((var (catch #t (lambda () (vct-move! v0 0 -10 #f)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";vct-move! back high 2 index: ~A" var))))
+ (snd-display #__line__ ";vct-move! back high 2 index: ~A" var))))
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v0 i) 1.0) (snd-display ";fill v0[~D] = ~F?" i (vct-ref v0 i)))
- (if (fneq (vct-ref v1 i) 0.5) (snd-display ";preset v1[~D] = ~F?" i (vct-ref v1 i))))
+ (if (fneq (vct-ref v0 i) 1.0) (snd-display #__line__ ";fill v0[~D] = ~F?" i (vct-ref v0 i)))
+ (if (fneq (vct-ref v1 i) 0.5) (snd-display #__line__ ";preset v1[~D] = ~F?" i (vct-ref v1 i))))
(vct-add! v0 v1)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v0 i) 1.5) (snd-display ";add v0[~D] = ~F?" i (vct-ref v0 i))))
+ (if (fneq (vct-ref v0 i) 1.5) (snd-display #__line__ ";add v0[~D] = ~F?" i (vct-ref v0 i))))
(vct-subtract! v0 v1)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v0 i) 1.0) (snd-display ";subtract v0[~D] = ~F?" i (vct-ref v0 i))))
+ (if (fneq (vct-ref v0 i) 1.0) (snd-display #__line__ ";subtract v0[~D] = ~F?" i (vct-ref v0 i))))
(let ((v2 (vct-copy v0)))
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v2 i) 1.0) (snd-display ";copy v0[~D] = ~F?" i (vct-ref v2 i))))
+ (if (fneq (vct-ref v2 i) 1.0) (snd-display #__line__ ";copy v0[~D] = ~F?" i (vct-ref v2 i))))
(vct-scale! v2 5.0)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v2 i) 5.0) (snd-display ";scale v2[~D] = ~F?" i (vct-ref v2 i))))
+ (if (fneq (vct-ref v2 i) 5.0) (snd-display #__line__ ";scale v2[~D] = ~F?" i (vct-ref v2 i))))
(vct-offset! v0 -1.0)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v0 i) 0.0) (snd-display ";offset v0[~D] = ~F?" i (vct-ref v0 i))))
+ (if (fneq (vct-ref v0 i) 0.0) (snd-display #__line__ ";offset v0[~D] = ~F?" i (vct-ref v0 i))))
(vct-multiply! v2 v1)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v2 i) 2.5) (snd-display ";multiply v2[~D] = ~F?" i (vct-ref v2 i))))
- (if (fneq (vct-peak v2) 2.5) (snd-display ";v2's peak is ~F?" (vct-peak v2)))
+ (if (fneq (vct-ref v2 i) 2.5) (snd-display #__line__ ";multiply v2[~D] = ~F?" i (vct-ref v2 i))))
+ (if (fneq (vct-peak v2) 2.5) (snd-display #__line__ ";v2's peak is ~F?" (vct-peak v2)))
(vct-set! v2 5 123.0)
- (if (fneq (vct-peak v2) 123.0) (snd-display ";v2's set peak is ~F?" (vct-peak v2)))
+ (if (fneq (vct-peak v2) 123.0) (snd-display #__line__ ";v2's set peak is ~F?" (vct-peak v2)))
(let ((vn (make-vct 32))
(vb (make-vct 64))
(vs (make-vct 3))
@@ -14159,141 +14233,141 @@ EDITS: 2
((= i 32))
(vct-set! vn i i))
(let ((vnew (vct-subseq vn 3)))
- (if (fneq (vct-ref vnew 0) 3.0) (snd-display ";vct-subseq[3:] ~A?" (vct-ref vnew 0)))
- (if (not (= (vct-length vnew) 29)) (snd-display ";vct-subseq[3:] length: ~A?" (vct-length vnew))))
+ (if (fneq (vct-ref vnew 0) 3.0) (snd-display #__line__ ";vct-subseq[3:] ~A?" (vct-ref vnew 0)))
+ (if (not (= (vct-length vnew) 29)) (snd-display #__line__ ";vct-subseq[3:] length: ~A?" (vct-length vnew))))
(let ((vnew (vct-subseq vn 3 8)))
- (if (fneq (vct-ref vnew 0) 3.0) (snd-display ";vct-subseq[3:8] ~A?" (vct-ref vnew 0)))
- (if (not (= (vct-length vnew) 6)) (snd-display ";vct-subseq[3:8] length: ~A?" (vct-length vnew))))
+ (if (fneq (vct-ref vnew 0) 3.0) (snd-display #__line__ ";vct-subseq[3:8] ~A?" (vct-ref vnew 0)))
+ (if (not (= (vct-length vnew) 6)) (snd-display #__line__ ";vct-subseq[3:8] length: ~A?" (vct-length vnew))))
(vct-subseq vn 3 3 vs)
(if (or (fneq (vct-ref vs 0) 3.0)
(fneq (vct-ref vs 1) 0.0)
(fneq (vct-ref vs 2) 0.0))
- (snd-display ";vct-subseq[3:3->vs] ~A?" vs))
+ (snd-display #__line__ ";vct-subseq[3:3->vs] ~A?" vs))
(vct-subseq vn 0 32 vs)
- (if (not (= (vct-length vs) 3)) (snd-display ";vct-subseq[0:32->vs] length: ~A?" (vct-length vs)))
+ (if (not (= (vct-length vs) 3)) (snd-display #__line__ ";vct-subseq[0:32->vs] length: ~A?" (vct-length vs)))
(vct-subseq vn 2 3 vss)
- (if (fneq (vct-ref vss 0) 2.0) (snd-display ";vct-subseq[2:3->vss] ~A?" (vct-ref vss 0)))
+ (if (fneq (vct-ref vss 0) 2.0) (snd-display #__line__ ";vct-subseq[2:3->vss] ~A?" (vct-ref vss 0)))
(vct-set! vb 8 123.0)
(vct-subseq vn 1 8 vb)
- (if (fneq (vct-ref vb 0) 1.0) (snd-display ";vct-subseq[1:8->vb] ~A?" (vct-ref vb 0)))
- (if (fneq (vct-ref vb 8) 123.0) (snd-display ";vct-subseq[1:8->vb][8] ~A?" (vct-ref vb 8))))
+ (if (fneq (vct-ref vb 0) 1.0) (snd-display #__line__ ";vct-subseq[1:8->vb] ~A?" (vct-ref vb 0)))
+ (if (fneq (vct-ref vb 8) 123.0) (snd-display #__line__ ";vct-subseq[1:8->vb][8] ~A?" (vct-ref vb 8))))
(let ((v1 (make-vct 3 .1))
(v2 (make-vct 4 .2)))
(let ((val (vct+ (vct-copy v1) v2)))
- (if (not (vequal val (vct .3 .3 .3))) (snd-display ";vct+ .1 .2: ~A" val)))
+ (if (not (vequal val (vct .3 .3 .3))) (snd-display #__line__ ";vct+ .1 .2: ~A" val)))
(vct-set! v1 1 .3)
(let ((val (vct+ (vct-copy v1) v2)))
- (if (not (vequal val (vct .3 .5 .3))) (snd-display ";vct+ .1 .2 (1): ~A" val)))
+ (if (not (vequal val (vct .3 .5 .3))) (snd-display #__line__ ";vct+ .1 .2 (1): ~A" val)))
(let ((val (vct+ (vct-copy v1) 2.0)))
- (if (not (vequal val (vct 2.1 2.3 2.1))) (snd-display ";vct+ .1 2.0: ~A" val)))
+ (if (not (vequal val (vct 2.1 2.3 2.1))) (snd-display #__line__ ";vct+ .1 2.0: ~A" val)))
(let ((val (vct+ 2.0 (vct-copy v1))))
- (if (not (vequal val (vct 2.1 2.3 2.1))) (snd-display ";vct+ .1 2.0 (1): ~A" val)))
+ (if (not (vequal val (vct 2.1 2.3 2.1))) (snd-display #__line__ ";vct+ .1 2.0 (1): ~A" val)))
(let ((val (vct* 2.0 (vct-copy v1))))
- (if (not (vequal val (vct .2 .6 .2))) (snd-display ";vct* 2.0: ~A" val)))
+ (if (not (vequal val (vct .2 .6 .2))) (snd-display #__line__ ";vct* 2.0: ~A" val)))
(let ((val (vct* (vct-copy v1) 2.0)))
- (if (not (vequal val (vct .2 .6 .2))) (snd-display ";vct* 2.0 (1): ~A" val)))
+ (if (not (vequal val (vct .2 .6 .2))) (snd-display #__line__ ";vct* 2.0 (1): ~A" val)))
(let ((val (vct* (vct-copy v1) v2)))
- (if (not (vequal val (vct .02 .06 .02))) (snd-display ";vct* v1 v2: ~A" val))))
+ (if (not (vequal val (vct .02 .06 .02))) (snd-display #__line__ ";vct* v1 v2: ~A" val))))
(vct-map! v0 (lambda () 1.0))
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (vct-ref v0 i) 1.0) (snd-display ";map v0[~D] = ~F?" i (vct-ref v0 i)))))
+ (if (fneq (vct-ref v0 i) 1.0) (snd-display #__line__ ";map v0[~D] = ~F?" i (vct-ref v0 i)))))
(if (fneq ((vct 1.0 2.0 3.0) 1) 2.0)
- (snd-display ";(vct...) = ~A?" ((vct 1.0 2.0 3.0) 1)))
+ (snd-display #__line__ ";(vct...) = ~A?" ((vct 1.0 2.0 3.0) 1)))
(let ((v1 (vct 1 2 3 4)))
(if (fneq (v1 1) 2.0)
- (snd-display ";(v1 1) = ~A?" (v1 1))))
-
+ (snd-display #__line__ ";(v1 1) = ~A?" (v1 1))))
+
(let ((ind (open-sound "oboe.snd"))
(ctr 0))
(set! (speed-control ind) .5)
- (play-and-wait)
+ (play :wait #t)
(apply-controls)
(revert-sound)
(reset-controls ind)
;; try some special cases
(apply-controls)
(if (not (= (edit-position ind) 0))
- (snd-display ";apply-controls with no:change: ~A: ~A" (edits ind) (edit-tree ind)))
+ (snd-display #__line__ ";apply-controls with no:change: ~A: ~A" (edits ind) (edit-tree ind)))
(set! (speed-control ind) -1.0)
(apply-controls)
(if (not (= (edit-position ind) 1))
- (snd-display ";apply-controls with srate -1.0: ~A ~A" (edits ind) (edit-tree ind)))
+ (snd-display #__line__ ";apply-controls with srate -1.0: ~A ~A" (edits ind) (edit-tree ind)))
(if (> (abs (- (frames ind 0) (frames ind 0 0))) 2)
- (snd-display ";apply-controls srate -1.0 lengths: ~A ~A" (frames ind 0) (frames ind 0 0)))
+ (snd-display #__line__ ";apply-controls srate -1.0 lengths: ~A ~A" (frames ind 0) (frames ind 0 0)))
(if (or (fneq (maxamp) .147)
(< (abs (sample 9327)) .01))
- (snd-display ";apply-controls srate -1.0 samples: ~A ~A" (maxamp) (sample 9327)))
- (if (fneq (speed-control ind) 1.0) (snd-display ";apply-controls -1.0 -> ~A?" (speed-control ind)))
-
- (add-hook! dac-hook (lambda (data)
- (set! ctr (+ 1 ctr))
- (if (>= ctr 3) (c-g!))))
- (play-and-wait)
- (if (not (= ctr 3)) (snd-display ";ctr after dac-hook: ~A" ctr))
- (set! ctr 0)
- (set! (speed-control) 1.5)
- (apply-controls)
-; (if (fneq (sample 28245) 0.0) (snd-display ";dac-hook stop apply-controls? ~A" (sample 28245)))
- (reset-hook! dac-hook)
- (revert-sound)
- (set! (speed-control) 1.5)
- (set! ctr 0)
- (add-hook! dac-hook (lambda (data)
- (set! ctr (+ 1 ctr))
- (if (= ctr 3) (apply-controls))))
- (play-and-wait)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";apply-controls from hook: ~A ~A" (edits ind) (edit-tree ind)))
- (revert-sound)
- (reset-hook! dac-hook)
- (set! (speed-control) 1.5)
- (stop-playing)
- (add-hook! after-apply-controls-hook (lambda (s)
- (let ((tag (catch #t
- (lambda () (apply-controls))
- (lambda args args))))
- (if (not (eq? (car tag) 'cannot-apply-controls))
- (snd-display ";after-apply-controls-hook: recursive attempt apply-controls: ~A" tag)))))
- (apply-controls)
- (reset-hook! after-apply-controls-hook)
- (add-hook! dac-hook (lambda (s)
- (let ((tag (catch #t
- (lambda () (apply-controls))
- (lambda args args))))
- (if (not (eq? (car tag) 'cannot-apply-controls))
- (snd-display ";dac-hook: recursive attempt apply-controls: ~A" tag)))))
- (reset-hook! dac-hook)
-
+ (snd-display #__line__ ";apply-controls srate -1.0 samples: ~A ~A" (maxamp) (sample 9327)))
+ (if (fneq (speed-control ind) 1.0) (snd-display #__line__ ";apply-controls -1.0 -> ~A?" (speed-control ind)))
+
+ (add-hook! dac-hook (lambda (data)
+ (set! ctr (+ 1 ctr))
+ (if (>= ctr 3) (c-g!))))
+ (play :wait #t)
+ (if (not (= ctr 3)) (snd-display #__line__ ";ctr after dac-hook: ~A" ctr))
+ (set! ctr 0)
+ (set! (speed-control) 1.5)
+ (apply-controls)
+ ; (if (fneq (sample 28245) 0.0) (snd-display #__line__ ";dac-hook stop apply-controls? ~A" (sample 28245)))
+ (reset-hook! dac-hook)
+ (revert-sound)
+ (set! (speed-control) 1.5)
+ (set! ctr 0)
+ (add-hook! dac-hook (lambda (data)
+ (set! ctr (+ 1 ctr))
+ (if (= ctr 3) (apply-controls))))
+ (play :wait #t)
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";apply-controls from hook: ~A ~A" (edits ind) (edit-tree ind)))
+ (revert-sound)
+ (reset-hook! dac-hook)
+ (set! (speed-control) 1.5)
+ (stop-playing)
+ (add-hook! after-apply-controls-hook (lambda (s)
+ (let ((tag (catch #t
+ (lambda () (apply-controls))
+ (lambda args args))))
+ (if (not (eq? (car tag) 'cannot-apply-controls))
+ (snd-display #__line__ ";after-apply-controls-hook: recursive attempt apply-controls: ~A" tag)))))
+ (apply-controls)
+ (reset-hook! after-apply-controls-hook)
+ (add-hook! dac-hook (lambda (s)
+ (let ((tag (catch #t
+ (lambda () (apply-controls))
+ (lambda args args))))
+ (if (not (eq? (car tag) 'cannot-apply-controls))
+ (snd-display #__line__ ";dac-hook: recursive attempt apply-controls: ~A" tag)))))
+ (reset-hook! dac-hook)
+
(revert-sound)
(close-sound ind))
-
+
(let ((v1 (make-vct 32)))
(vct-map! v1
(lambda ()
(let ((v2 (make-vct 3)))
(vct-map! v2 (lambda () .1))
(vct-ref v2 0))))
- (if (fneq (vct-ref v1 12) .1) (snd-display ";vct-map! twice: ~A" (vct-ref v1 12))))
+ (if (fneq (vct-ref v1 12) .1) (snd-display #__line__ ";vct-map! twice: ~A" (vct-ref v1 12))))
(let ((hi (make-vct 3)))
(let ((tag (catch #t
(lambda () (vct-subseq hi 1 0))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";vct-subseq 1 0: ~A" tag)))
- (if (vct) (snd-display ";(vct) -> ~A" (vct)))
+ (snd-display #__line__ ";vct-subseq 1 0: ~A" tag)))
+ (if (vct) (snd-display #__line__ ";(vct) -> ~A" (vct)))
(let ((tag (catch #t (lambda () (make-vct 0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range)) (snd-display ";make-vct 0 -> ~A" tag)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";make-vct 0 -> ~A" tag)))
(let ((ho (make-vct 3)))
(vct-add! hi ho 4)))
(let ((v0 (make-vct 5 .1))
(v1 (make-vct 6 .2)))
(vct-add! v0 v1 2)
(if (not (vequal v0 (vct .1 .1 .3 .3 .3)))
- (snd-display ";vct-add + offset: ~A" v0)))
-
+ (snd-display #__line__ ";vct-add + offset: ~A" v0)))
+
;; test local var gc protection in vct.h vct_to_vector
(let ((v1 (vct-map!
(make-vct 44100 0.0)
@@ -14304,126 +14378,128 @@ EDITS: 2
(vector->vct vect)
(vector->vct vect)
(set! v1 (vector->vct vect))))
-
+
+#|
;; a test of big vcts (needs 16 Gbytes):
(if (and (string? (getenv "HOSTNAME"))
(string=? (getenv "HOSTNAME") "fatty8"))
(let ((size (+ 2 (expt 2 31))))
(if (not (= size 2147483650))
- (snd-display ";big vct, size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
+ (snd-display #__line__ ";big vct, size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
(set! (mus-max-malloc) (expt 2 40))
(if (not (= (mus-max-malloc) 1099511627776))
- (snd-display ";big vct, mus-max-malloc: ~A" (mus-max-malloc)))
+ (snd-display #__line__ ";big vct, mus-max-malloc: ~A" (mus-max-malloc)))
(let ((hi (make-vct size)))
(if (not (vct? hi))
- (snd-display ";big vct, not a vct?? ~A" hi))
+ (snd-display #__line__ ";big vct, not a vct?? ~A" hi))
(if (fneq (vct-ref hi (expt 2 31)) 0.0)
- (snd-display ";big vct, created at end: ~A" (vct-ref hi (expt 2 31))))
+ (snd-display #__line__ ";big vct, created at end: ~A" (vct-ref hi (expt 2 31))))
(vct+ hi .1)
(if (fneq (vct-ref hi (expt 2 31)) 0.1)
- (snd-display ";big vct, add .1 at end: ~A" (vct-ref hi (expt 2 31))))
+ (snd-display #__line__ ";big vct, add .1 at end: ~A" (vct-ref hi (expt 2 31))))
(let ((pk (vct-peak hi)))
(if (fneq pk .1)
- (snd-display ";big vct, vct-peak: ~A" pk)))
+ (snd-display #__line__ ";big vct, vct-peak: ~A" pk)))
(let ((len (vct-length hi)))
(if (not (= len size))
- (snd-display ";big vct, len: ~A" len)))
+ (snd-display #__line__ ";big vct, len: ~A" len)))
(vct-scale! hi 2.0)
(if (fneq (vct-ref hi (+ 1 (expt 2 31))) .2)
- (snd-display ";big vct, scale: ~A ~A" (vct-ref hi (+ 1 (expt 2 31))) hi))
+ (snd-display #__line__ ";big vct, scale: ~A ~A" (vct-ref hi (+ 1 (expt 2 31))) hi))
(vct-set! hi (expt 2 31) 1.0)
(if (fneq (vct-ref hi (expt 2 31)) 1.0)
- (snd-display ";big vct, set at end: ~A" (vct-ref hi (expt 2 31))))
+ (snd-display #__line__ ";big vct, set at end: ~A" (vct-ref hi (expt 2 31))))
(vct-offset! hi .2)
(if (fneq (vct-ref hi (expt 2 31)) 1.2)
- (snd-display ";big vct, offset: ~A" (vct-ref hi (expt 2 31))))
+ (snd-display #__line__ ";big vct, offset: ~A" (vct-ref hi (expt 2 31))))
(vct-subtract! hi hi)
(let ((pk (vct-peak hi)))
(if (fneq pk 0.0)
- (snd-display ";big vct, subtract vct-peak: ~A ~A" pk hi)))
+ (snd-display #__line__ ";big vct, subtract vct-peak: ~A ~A" pk hi)))
(vct-fill! hi 1.0)
(if (fneq (vct-ref hi (expt 2 31)) 1.0)
- (snd-display ";big vct, fill: ~A ~A" (vct-ref hi (expt 2 31)) hi))
+ (snd-display #__line__ ";big vct, fill: ~A ~A" (vct-ref hi (expt 2 31)) hi))
(vct-set! hi (expt 2 31) 0.0)
(let ((ho (vct-subseq hi (- (expt 2 31) 3) (+ (expt 2 31) 1))))
(if (not (vequal ho (vct 1.0 1.0 1.0 0.0 1.0)))
- (snd-display ";big vct, subseq: ~A" ho)))
+ (snd-display #__line__ ";big vct, subseq: ~A" ho)))
(vct-reverse! hi)
(let ((ho (vct-subseq hi 0 5)))
(if (not (vequal ho (vct 1.0 0.0 1.0 1.0 1.0 1.0)))
- (snd-display ";big vct, reverse: ~A" ho)))
+ (snd-display #__line__ ";big vct, reverse: ~A" ho)))
(vct-set! hi (expt 2 31) 10.0)
(vct-move! hi (- (expt 2 31) 3) (expt 2 31))
(let ((ho (vct-subseq hi (- (expt 2 31) 3) (+ (expt 2 31) 1))))
(if (not (vequal ho (vct 10.0 1.0 1.0 10.0 1.0)))
- (snd-display ";big vct, subseq: ~A" ho)))
+ (snd-display #__line__ ";big vct, subseq: ~A" ho)))
)
-
+
;; big vectors/hash-tables also
(let ((size (+ 2 (expt 2 31))))
(if (not (= size 2147483650))
- (snd-display ";big vector size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
+ (snd-display #__line__ ";big vector size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
(let ((hi (make-vector size '())))
(if (not (vector? hi))
- (snd-display ";big vector not a vector?? ~A" hi))
+ (snd-display #__line__ ";big vector not a vector?? ~A" hi))
(if (not (null? (vector-ref hi (expt 2 31))))
- (snd-display ";big vector created at end: ~A" (vector-ref hi (expt 2 31))))
+ (snd-display #__line__ ";big vector created at end: ~A" (vector-ref hi (expt 2 31))))
(set! (hi (expt 2 31)) 100)
(if (not (= (vector-ref hi (expt 2 31)) 100))
- (snd-display ";big vector set to 100 at end: ~A" (vector-ref hi (expt 2 31))))
+ (snd-display #__line__ ";big vector set to 100 at end: ~A" (vector-ref hi (expt 2 31))))
(let ((len (vector-length hi)))
(if (not (= len size))
- (snd-display ";big vector len: ~A" len)))
+ (snd-display #__line__ ";big vector len: ~A" len)))
(vector-fill! hi 2)
(if (not (= (vector-ref hi (expt 2 31)) 2))
- (snd-display ";big vector fill: ~A" (vector-ref hi (expt 2 31))))))
+ (snd-display #__line__ ";big vector fill: ~A" (vector-ref hi (expt 2 31))))))
(let ((hi (make-vector (list (+ 2 (expt 2 30)) 2) '())))
(if (not (= (vector-length hi) (* 2 (+ 2 (expt 2 30)))))
- (snd-display ";big vector 2dim size: ~A ~A" (vector-length hi) (* 2 (+ 2 (expt 2 30)))))
+ (snd-display #__line__ ";big vector 2dim size: ~A ~A" (vector-length hi) (* 2 (+ 2 (expt 2 30)))))
(if (not (null? (vector-ref hi (expt 2 30) 0)))
- (snd-display ";big vector 2dim created at end (0): ~A" (vector-ref hi (expt 2 30) 0)))
+ (snd-display #__line__ ";big vector 2dim created at end (0): ~A" (vector-ref hi (expt 2 30) 0)))
(if (not (null? (vector-ref hi (expt 2 30) 1)))
- (snd-display ";big vector 2dim created at end (1): ~A" (vector-ref hi (expt 2 30) 1)))
+ (snd-display #__line__ ";big vector 2dim created at end (1): ~A" (vector-ref hi (expt 2 30) 1)))
(set! (hi (expt 2 30) 1) 100)
(if (not (= (vector-ref hi (expt 2 30) 1) 100))
- (snd-display ";big vector 2dim set to 100 at end: ~A" (vector-ref hi (expt 2 30) 1)))
+ (snd-display #__line__ ";big vector 2dim set to 100 at end: ~A" (vector-ref hi (expt 2 30) 1)))
(vector-fill! hi 2)
(if (not (= (vector-ref hi (expt 2 30) 0) 2))
- (snd-display ";big vector 2dim fill: ~A" (vector-ref hi (expt 2 30) 0))))
+ (snd-display #__line__ ";big vector 2dim fill: ~A" (vector-ref hi (expt 2 30) 0))))
(let ((hi (make-hash-table (+ 2 (expt 2 31)))))
(if (not (= (hash-table-size hi) (+ 2 (expt 2 31))))
- (snd-display ";big hash size: ~A ~A" (hash-table-size hi) (+ 2 (expt 2 31))))
+ (snd-display #__line__ ";big hash size: ~A ~A" (hash-table-size hi) (+ 2 (expt 2 31))))
(if (fneq (let () (hash-table-set! hi 'key 3.14) (hash-table-ref hi 'key)) 3.14)
- (snd-display ";big hash 3.14: ~A" (hash-table-ref hi 'key)))
+ (snd-display #__line__ ";big hash 3.14: ~A" (hash-table-ref hi 'key)))
(if (not (equal? (let () (hash-table-set! hi 123 "hiho") (hash-table-ref hi 123)) "hiho"))
- (snd-display ";big hash 123: ~A" (hash-table-ref hi 123)))
+ (snd-display #__line__ ";big hash 123: ~A" (hash-table-ref hi 123)))
(if (not (equal? (let ()
(hash-table-set! hi 'hiho-this-is-a-big-name-to-overflow-32-bits-I-hope "hiho")
(hash-table-ref hi 'hiho-this-is-a-big-name-to-overflow-32-bits-I-hope))
"hiho"))
- (snd-display ";big hash big symbol: ~A" (hash-table-ref hi 'hiho-this-is-a-big-name-to-overflow-32-bits-I-hope)))
+ (snd-display #__line__ ";big hash big symbol: ~A" (hash-table-ref hi 'hiho-this-is-a-big-name-to-overflow-32-bits-I-hope)))
(if (not (equal? (let ()
(hash-table-set! hi 12345678912345 "hiho")
(hash-table-ref hi 12345678912345))
"hiho"))
- (snd-display ";big hash big symbol: ~A" (hash-table-ref hi 12345678912345))))
+ (snd-display #__line__ ";big hash big symbol: ~A" (hash-table-ref hi 12345678912345))))
))
-
+|#
+
(let ((sum 0))
(for-each (lambda (n) (set! sum (+ sum n))) (vct 1 2 3))
(if (not (= sum 6.0))
- (snd-display ";object for-each (vct): ~A" sum)))
-
+ (snd-display #__line__ ";object for-each (vct): ~A" sum)))
+
))))
@@ -14445,16 +14521,16 @@ EDITS: 2
(getfnc (list-ref (car lst) 1))
(setfnc (lambda (val) (set! (getfnc) val)))
(initval (list-ref (car lst) 2)))
- (if (not (color? initval)) (snd-display ";~A not color?" initval))
+ (if (not (color? initval)) (snd-display #__line__ ";~A not color?" initval))
;; we'll get warnings here if the cell chosen didn't exactly match the one requested -- not a bug
;; (if (not (equal? (getfnc) initval))
- ;; (snd-display ";~A /= ~A (~A)?" name initval (getfnc)))
+ ;; (snd-display #__line__ ";~A /= ~A (~A)?" name initval (getfnc)))
(setfnc beige)
(if (not (equal? (getfnc) beige))
- (snd-display ";set-~A /= beige (~A)?" name (getfnc)))
+ (snd-display #__line__ ";set-~A /= beige (~A)?" name (getfnc)))
(setfnc initval)
(test-color (cdr lst)))))))
-
+
(let* ((c1 (catch 'no-such-color
(lambda () (make-color 0 0 1))
(lambda args #f)))
@@ -14462,12 +14538,12 @@ EDITS: 2
(c3 (catch 'no-such-color
(lambda () (make-color 0 0 1))
(lambda args #f))))
- (if (not (equal? c1 c2)) (snd-display ";color equal? ~A ~A?" c1 c2))
- (if (not (eq? c1 c2)) (snd-display ";color eq? ~A ~A?" c1 c2))
- (if (provided? 'snd-motif) (if (not (equal? c1 c3)) (snd-display ";diff color equal? ~A ~A?" c1 c3)))
- (if (eq? c1 c3) (snd-display ";diff color eq? ~A ~A?" c1 c3))
+ (if (not (equal? c1 c2)) (snd-display #__line__ ";color equal? ~A ~A?" c1 c2))
+ (if (not (eq? c1 c2)) (snd-display #__line__ ";color eq? ~A ~A?" c1 c2))
+ (if (provided? 'snd-motif) (if (not (equal? c1 c3)) (snd-display #__line__ ";diff color equal? ~A ~A?" c1 c3)))
+ (if (eq? c1 c3) (snd-display #__line__ ";diff color eq? ~A ~A?" c1 c3))
(if (not (equal? (color->list c1) (list 0.0 0.0 1.0)))
- (snd-display ";color->list: ~A ~A?" c1 (color->list c1))))
+ (snd-display #__line__ ";color->list: ~A ~A?" c1 (color->list c1))))
(do ((i 0 (+ 1 i)))
((not (colormap? (integer->colormap i))))
(let ((val (colormap-ref (integer->colormap i) 0))
@@ -14478,7 +14554,7 @@ EDITS: 2
'(1.0 0.0 0.0) '(0.0 0.0 1.0))
i)))
(if (not (feql val true-val))
- (snd-display ";colormap-ref ~A: ~A (~A)" i val true-val))))
+ (snd-display #__line__ ";colormap-ref ~A: ~A (~A)" i val true-val))))
(catch #t ; might be undefined var as well as no-such-color
(lambda ()
(test-color
@@ -14518,28 +14594,28 @@ EDITS: 2
(set! (foreground-color ind 0 cursor-context) red)
(let ((col (foreground-color ind 0 cursor-context)))
(if (not (feql (color->list col) (color->list red)))
- (snd-display ";set foreground cursor color: ~A ~A" (color->list col) (color->list red))))
+ (snd-display #__line__ ";set foreground cursor color: ~A ~A" (color->list col) (color->list red))))
(set! (foreground-color) blue)
(let ((col (foreground-color)))
(if (not (feql (color->list col) (color->list blue)))
- (snd-display ";set foreground-color: ~A ~A" (color->list col) (color->list blue))))
+ (snd-display #__line__ ";set foreground-color: ~A ~A" (color->list col) (color->list blue))))
(set! (foreground-color ind) red)
(let ((col (foreground-color ind)))
(if (not (feql (color->list col) (color->list red)))
- (snd-display ";set foreground-color with ind (red): ~A ~A" (color->list col) (color->list red))))
+ (snd-display #__line__ ";set foreground-color with ind (red): ~A ~A" (color->list col) (color->list red))))
(set! (foreground-color ind) black)
(let ((col (foreground-color ind)))
(if (not (feql (color->list col) (color->list black)))
- (snd-display ";set foreground-color with ind (black): ~A ~A" (color->list col) (color->list black)))))
+ (snd-display #__line__ ";set foreground-color with ind (black): ~A ~A" (color->list col) (color->list black)))))
(set! (selected-graph-color) (make-color-with-catch 0.96 0.96 0.86))
(set! (data-color) black)
(set! (selected-data-color) blue)
(set! (graph-color) white)
(close-sound ind)))
(lambda args args))
-
+
(if (not (= (length jet-colormap) (colormap-size)))
- (snd-display ";jet-colormap length: ~A ~A" (length jet-colormap) (colormap-size)))
+ (snd-display #__line__ ";jet-colormap length: ~A ~A" (length jet-colormap) (colormap-size)))
(for-each
(lambda (n err)
@@ -14574,7 +14650,7 @@ EDITS: 2
(cfneq r2 r1)
(cfneq g2 g1)
(cfneq b2 b1)))
- (snd-display ";bone ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";bone ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14589,7 +14665,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";copper ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";copper ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14602,7 +14678,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";winter ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";winter ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14615,7 +14691,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";autumn ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";autumn ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14628,7 +14704,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";cool ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";cool ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14649,7 +14725,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";hot ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";hot ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14682,7 +14758,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";jet ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";jet ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(if (colormap? pink-colormap)
@@ -14704,7 +14780,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";pink ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";pink ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1))))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14717,7 +14793,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";spring ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";spring ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14730,7 +14806,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";gray ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";gray ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14743,7 +14819,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";black-and-white ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";black-and-white ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14756,7 +14832,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";summer ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";summer ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14785,7 +14861,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";rainbow ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";rainbow ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(do ((i 0 (+ 1 i))) ((= i 10))
@@ -14798,7 +14874,7 @@ EDITS: 2
(not (feql rgb '(0 1 0)))
(not (feql rgb '(0 0 1)))
(not (feql rgb '(.6667 0 1))))
- (snd-display ";prism ~A" rgb))))
+ (snd-display #__line__ ";prism ~A" rgb))))
(do ((i 0 (+ 1 i))) ((= i 10))
(let* ((x (random 1.0))
@@ -14808,55 +14884,55 @@ EDITS: 2
(not (feql rgb '(1 1 1)))
(not (feql rgb '(0 0 1)))
(not (feql rgb '(0 0 0))))
- (snd-display ";flag: ~A" rgb))))
+ (snd-display #__line__ ";flag: ~A" rgb))))
)
(list 512 64)
(list 0.005 0.04))
(let ((ind (add-colormap "white" (lambda (size) (list (make-vct size 1.0) (make-vct size 1.0) (make-vct size 1.0))))))
(if (not (colormap? ind))
- (snd-display ";add-colormap ~A: ~A" ind (colormap? ind)))
+ (snd-display #__line__ ";add-colormap ~A: ~A" ind (colormap? ind)))
(if (not (feql (colormap-ref ind 0.5) '(1.0 1.0 1.0)))
- (snd-display ";white colormap: ~A" (colormap-ref ind 0.5)))
+ (snd-display #__line__ ";white colormap: ~A" (colormap-ref ind 0.5)))
(let ((tag (catch #t (lambda () (set! (colormap) ind)) (lambda args args))))
(if (or (eq? tag 'no-such-colormap)
(not (equal? (colormap) ind))
(not (= (colormap->integer (colormap)) (colormap->integer ind))))
- (snd-display ";colormap white: ~A ~A ~A" tag ind (colormap))))
+ (snd-display #__line__ ";colormap white: ~A ~A ~A" tag ind (colormap))))
(if (not (string=? (colormap-name ind) "white"))
- (snd-display ";white colormap name: ~A" (colormap-name ind))))
-
+ (snd-display #__line__ ";white colormap name: ~A" (colormap-name ind))))
+
(let ((tag (catch #t (lambda () (delete-colormap (integer->colormap 1234))) (lambda args (car args)))))
(if (not (eq? tag 'no-such-colormap))
- (snd-display ";delete-colormap 1234: ~A" tag)))
+ (snd-display #__line__ ";delete-colormap 1234: ~A" tag)))
(let ((tag (catch #t (lambda () (colormap-ref (integer->colormap 1234) 0.5)) (lambda args (car args)))))
(if (not (eq? tag 'no-such-colormap))
- (snd-display ";colormap-ref 1234: ~A" tag)))
+ (snd-display #__line__ ";colormap-ref 1234: ~A" tag)))
(let ((tag (catch #t (lambda () (colormap-ref (integer->colormap -1) 0.5)) (lambda args (car args)))))
(if (and (not (eq? tag 'no-such-colormap))
(not (eq? tag 'wrong-type-arg)))
- (snd-display ";colormap-ref -1: ~A" tag)))
+ (snd-display #__line__ ";colormap-ref -1: ~A" tag)))
(let ((tag (catch #t (lambda () (set! (colormap) (integer->colormap 1234))) (lambda args (car args)))))
(if (not (eq? tag 'no-such-colormap))
- (snd-display "; set colormap 1234: ~A" tag)))
+ (snd-display #__line__ "; set colormap 1234: ~A" tag)))
(let ((tag (catch #t (lambda () (set! (colormap) (integer->colormap -1))) (lambda args (car args)))))
(if (and (not (eq? tag 'no-such-colormap))
(not (eq? tag 'wrong-type-arg)))
- (snd-display "; set colormap -1: ~A" tag)))
+ (snd-display #__line__ "; set colormap -1: ~A" tag)))
(let ((tag (catch #t (lambda () (colormap-ref copper-colormap 2.0)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";colormap-ref 2.0: ~A" tag)))
+ (snd-display #__line__ ";colormap-ref 2.0: ~A" tag)))
(set! (colormap-size) old-colormap-size)
(if (not (= (colormap-size) old-colormap-size))
- (snd-display ";set colormap-size: ~A ~A" (colormap-size) old-colormap-size))
+ (snd-display #__line__ ";set colormap-size: ~A ~A" (colormap-size) old-colormap-size))
(if (not (string=? (colormap-name black-and-white-colormap) "black-and-white"))
- (snd-display ";black-and-white: ~A" (colormap-name black-and-white-colormap)))
+ (snd-display #__line__ ";black-and-white: ~A" (colormap-name black-and-white-colormap)))
(if (not (string=? (colormap-name gray-colormap) "gray"))
- (snd-display ";gray: ~A" (colormap-name gray-colormap)))
+ (snd-display #__line__ ";gray: ~A" (colormap-name gray-colormap)))
(if (not (string=? (colormap-name rainbow-colormap) "rainbow"))
- (snd-display ";rainbow: ~A" (colormap-name rainbow-colormap)))
+ (snd-display #__line__ ";rainbow: ~A" (colormap-name rainbow-colormap)))
(let ((purple-cmap (add-colormap "purple"
(lambda (size)
@@ -14902,12 +14978,12 @@ EDITS: 2
(list r g b))))))
(delete-colormap pink-colormap)
(if (colormap? pink-colormap)
- (snd-display ";delete-colormap ~A: ~A" pink-colormap (colormap? pink-colormap)))
+ (snd-display #__line__ ";delete-colormap ~A: ~A" pink-colormap (colormap? pink-colormap)))
(let ((tag (catch #t (lambda () (set! (colormap) pink-colormap)) (lambda args args))))
(if (or (not (eq? (car tag) 'no-such-colormap))
(equal? (colormap) pink-colormap))
- (snd-display ";delete pink colormap: ~A ~A ~A" tag pink-colormap (colormap))))
-
+ (snd-display #__line__ ";delete pink colormap: ~A ~A ~A" tag pink-colormap (colormap))))
+
(for-each
(lambda (n)
(set! (colormap-size) n)
@@ -14922,7 +14998,7 @@ EDITS: 2
(g1 (list-ref rgb 1))
(b1 (list-ref rgb 2)))
(if (and (> n 2) (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
- (snd-display ";copper size reset ~A: ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
+ (snd-display #__line__ ";copper size reset ~A: ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
n x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1))))))
(list 1024 256 2 512))
(set! (colormap-size) 512))
@@ -14957,7 +15033,7 @@ EDITS: 2
(comb2 (make-comb 0.733 4999))
(comb3 (make-comb 0.715 5399))
(comb4 (make-comb 0.697 5801))
- (outdel1 (make-delay (inexact->exact (round (* .013 (srate))))))
+ (outdel1 (make-delay (round (* .013 (srate)))))
(dur (+ decay-dur (/ (frames) (srate))))
(envA (if amp-env (make-env :envelope amp-env :scaler volume :duration dur) #f)))
(map-chan
@@ -14981,14 +15057,14 @@ EDITS: 2
(if envA
(* (env envA) (delay outdel1 all-sums))
(* volume (delay outdel1 all-sums)))))))
- 0 (inexact->exact (round (* dur (srate)))))))
+ 0 (round (* dur (srate))))))
;;; -------- scissor-tailed flycatcher
;;;
;;; mix a scissor-tailed flycatcher call into the current sound
;;; see bird.scm for lots more birds
-
-
+
+
(define (scissor begin-time) ; test 23 also
"(scissor beg) is the scissor-tailed flycatcher"
(let ((scissorf '(0 0 40 1 60 1 100 0)))
@@ -14999,7 +15075,7 @@ EDITS: 2
(define (snd_test_8)
-
+
;; ----------------
(define (bumpy)
(let* ((x 0.0)
@@ -15053,7 +15129,7 @@ EDITS: 2
;; ----------------
(define* (array-interp-sound-diff snd chn)
-
+
(define (envelope->vct e len)
(let ((v (make-vct len))
(e (make-env e :length len)))
@@ -15061,21 +15137,21 @@ EDITS: 2
((= i len))
(vct-set! v i (env e)))
v))
-
+
(let ((tbl (envelope->vct (list 0.0 -1.0 1.0 1.0) 1001))
(curpos (edit-position snd chn)))
(map-channel (lambda (y)
(let ((pos (+ 500 (* 500 y))))
(array-interp tbl pos 1000)))
0 #f snd chn)
-
+
(let ((r (make-sampler 0 snd chn 1 curpos))
(mx 0.0))
(scan-channel (lambda (y)
(set! mx (max mx (abs (- y (r))))))
0 #f snd chn)
mx)))
-
+
;; ----------------
(define (make-papoulis-window n)
"(make-papoulis-window size) returns a papoulis window os the given size"
@@ -15089,7 +15165,7 @@ EDITS: 2
(* (- 1.0 (* 2 (abs ratio)))
(cos pratio))))))
v))
-
+
;; ----------------
(define (make-dpss-window n w)
"(make-dpss-window size w) returns a prolate spheriodal (slepian) window of the given size"
@@ -15129,41 +15205,41 @@ EDITS: 2
(vct-set! data i (+ (sin (* 2 pi (/ i n)))
(* .25 (sin (* 4 pi (/ i n))))
(* .125 (sin (* 8 pi (/ i n)))))))))
-
+
(let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (vct 0 1 2 3 4 5 6 7) 8 4) 4 2)))
(if (not (vequal vals (vct 7.906 8.557)))
- (snd-display ";predict ramp: ~A" vals)))
+ (snd-display #__line__ ";predict ramp: ~A" vals)))
(let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (vct 0 1 2 3 4 5 6 7) 8 7) 7 2)))
(if (not (vequal vals (vct 7.971 8.816)))
- (snd-display ";predict ramp 1: ~A" vals)))
+ (snd-display #__line__ ";predict ramp 1: ~A" vals)))
(let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
(lpc-coeffs (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 7) 7 5)))
(if (not (vequal vals (vct 14.999 15.995 16.980 17.940 18.851)))
- (snd-display ";predict ramp 2: ~A" vals)))
+ (snd-display #__line__ ";predict ramp 2: ~A" vals)))
(let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
(lpc-coeffs (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 14) 14 5)))
(if (not (vequal vals (vct 15.000 16.000 16.998 17.991 18.971)))
- (snd-display ";predict ramp 3: ~A" vals)))
+ (snd-display #__line__ ";predict ramp 3: ~A" vals)))
(let ((vals (lpc-predict (make-sine 16) 16 (lpc-coeffs (make-sine 16) 16 8) 8 2)))
(if (not (vequal vals (vct 0.000 0.383)))
- (snd-display ";predict sine: ~A" vals)))
+ (snd-display #__line__ ";predict sine: ~A" vals)))
(let ((vals (lpc-predict (make-sine 16) 16 (lpc-coeffs (make-sine 16) 16 8) 8 8)))
(if (not (vequal vals (vct 0.000 0.383 0.707 0.924 1.000 0.924 0.707 0.383)))
- (snd-display ";predict sine 1: ~A" vals)))
+ (snd-display #__line__ ";predict sine 1: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 8) 8 8)))
(if (not (vequal vals (vct 0.000 0.379 0.686 0.880 0.970 1.001 1.022 1.053)))
- (snd-display ";predict sines: ~A" vals)))
+ (snd-display #__line__ ";predict sines: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 16) 16 8)))
(if (and (not (vequal vals (vct 0.000 0.379 0.684 0.876 0.961 0.987 1.006 1.046)))
(not (vequal vals (vct 0.000 0.379 0.685 0.876 0.961 0.985 0.998 1.029)))) ; if --with-doubles
- (snd-display ";predict sines 1: ~A" vals)))
+ (snd-display #__line__ ";predict sines 1: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 30) 30 4)))
(if (and (not (vequal vals (vct 0.000 0.379 0.685 0.878)))
(not (vequal vals (vct 0.000 0.379 0.684 0.875)))) ; double vcts
- (snd-display ";predict sines 2: ~A" vals)))
+ (snd-display #__line__ ";predict sines 2: ~A" vals)))
(let ((vals (lpc-predict (make-sines 64) 64 (lpc-coeffs (make-sines 64) 64 32) 32 8)))
(if (not (vequal vals (vct 0.000 0.195 0.379 0.545 0.684 0.795 0.875 0.927)))
- (snd-display ";predict sines 3: ~A" vals))))
+ (snd-display #__line__ ";predict sines 3: ~A" vals))))
;; ----------------
(define (test-unclip-channel)
@@ -15181,9 +15257,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 20)) (snd-display ";unclip-channel 0 oboe clips: ~A" clips))
- (if (not (= lmax 1)) (snd-display ";unclip-channel 0 oboe max len: ~A" lmax))
- (if (fneq umax .999) (snd-display ";unclip-channel 0 oboe maxamp: ~A" umax)))
+ (if (not (= clips 20)) (snd-display #__line__ ";unclip-channel 0 oboe clips: ~A" clips))
+ (if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 0 oboe max len: ~A" lmax))
+ (if (fneq umax .999) (snd-display #__line__ ";unclip-channel 0 oboe maxamp: ~A" umax)))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15199,9 +15275,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 1 sine clips: ~A" clips))
- (if (not (= lmax 2)) (snd-display ";unclip-channel 1 sine max len: ~A" lmax))
- (if (fneq umax .999) (snd-display ";unclip-channel 1 sine maxamp: ~A" umax)))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 1 sine clips: ~A" clips))
+ (if (not (= lmax 2)) (snd-display #__line__ ";unclip-channel 1 sine max len: ~A" lmax))
+ (if (fneq umax .999) (snd-display #__line__ ";unclip-channel 1 sine maxamp: ~A" umax)))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15217,9 +15293,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 2 sine clips: ~A" clips))
- (if (not (= lmax 3)) (snd-display ";unclip-channel 2 sine max len: ~A" lmax))
- (if (fneq umax .999) (snd-display ";unclip-channel 2 sine maxamp: ~A" umax)))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 2 sine clips: ~A" clips))
+ (if (not (= lmax 3)) (snd-display #__line__ ";unclip-channel 2 sine max len: ~A" lmax))
+ (if (fneq umax .999) (snd-display #__line__ ";unclip-channel 2 sine maxamp: ~A" umax)))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15236,9 +15312,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 3 sine clips: ~A" clips))
- (if (not (= lmax 1)) (snd-display ";unclip-channel 3 sine max len: ~A" lmax))
- (if (fneq umax .999) (snd-display ";unclip-channel 3 sine maxamp: ~A" umax)))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 3 sine clips: ~A" clips))
+ (if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 3 sine max len: ~A" lmax))
+ (if (fneq umax .999) (snd-display #__line__ ";unclip-channel 3 sine maxamp: ~A" umax)))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15255,9 +15331,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 4 sine clips: ~A" clips))
- (if (not (= lmax 4)) (snd-display ";unclip-channel 4 sine max len: ~A" lmax))
- (if (fneq umax .999) (snd-display ";unclip-channel 4 sine maxamp: ~A" umax)))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 4 sine clips: ~A" clips))
+ (if (not (= lmax 4)) (snd-display #__line__ ";unclip-channel 4 sine max len: ~A" lmax))
+ (if (fneq umax .999) (snd-display #__line__ ";unclip-channel 4 sine maxamp: ~A" umax)))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15274,9 +15350,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 5 click clips: ~A" clips))
- (if (not (= lmax 1)) (snd-display ";unclip-channel 5 click max len: ~A" lmax))
- (if (fneq umax true-max) (snd-display ";unclip-channel 5 click maxamp: ~A ~A" umax true-max)))))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 5 click clips: ~A" clips))
+ (if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 5 click max len: ~A" lmax))
+ (if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 5 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15295,9 +15371,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 6 click clips: ~A" clips))
- (if (not (= lmax 2)) (snd-display ";unclip-channel 6 click max len: ~A" lmax))
- (if (fneq umax true-max) (snd-display ";unclip-channel 6 click maxamp: ~A ~A" umax true-max)))))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 6 click clips: ~A" clips))
+ (if (not (= lmax 2)) (snd-display #__line__ ";unclip-channel 6 click max len: ~A" lmax))
+ (if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 6 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15316,9 +15392,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 7 click clips: ~A" clips))
- (if (not (= lmax 10)) (snd-display ";unclip-channel 7 click max len: ~A" lmax))
- (if (fneq umax true-max) (snd-display ";unclip-channel 7 click maxamp: ~A ~A" umax true-max)))))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 7 click clips: ~A" clips))
+ (if (not (= lmax 10)) (snd-display #__line__ ";unclip-channel 7 click max len: ~A" lmax))
+ (if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 7 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
(let ((data (make-vct 100 0.0))
@@ -15338,9 +15414,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 1)) (snd-display ";unclip-channel 8 click clips: ~A" clips))
- (if (not (= lmax 10)) (snd-display ";unclip-channel 8 click max len: ~A" lmax))
- (if (fneq umax true-max) (snd-display ";unclip-channel 8 click maxamp: ~A ~A" umax true-max)))))
+ (if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 8 click clips: ~A" clips))
+ (if (not (= lmax 10)) (snd-display #__line__ ";unclip-channel 8 click max len: ~A" lmax))
+ (if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 8 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
(let ((data (make-vct 200 0.0))
@@ -15363,9 +15439,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 2)) (snd-display ";unclip-channel 9 collision clips: ~A" clips))
- (if (not (= lmax 10)) (snd-display ";unclip-channel 9 collision max len: ~A" lmax))
- (if (fneq umax true-max) (snd-display ";unclip-channel 9 collision maxamp: ~A ~A" umax true-max)))))
+ (if (not (= clips 2)) (snd-display #__line__ ";unclip-channel 9 collision clips: ~A" clips))
+ (if (not (= lmax 10)) (snd-display #__line__ ";unclip-channel 9 collision max len: ~A" lmax))
+ (if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 9 collision maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
(mix "oboe.snd" 0 0 ind 0 #f)
@@ -15379,9 +15455,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 20)) (snd-display ";unclip-channel 10 oboe clips: ~A" clips))
- (if (not (= lmax 1)) (snd-display ";unclip-channel 10 oboe max len: ~A" lmax))
- (if (fneq umax 0.999) (snd-display ";unclip-channel 10 oboe maxamp: ~A" umax)))
+ (if (not (= clips 20)) (snd-display #__line__ ";unclip-channel 10 oboe clips: ~A" clips))
+ (if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 10 oboe max len: ~A" lmax))
+ (if (fneq umax 0.999) (snd-display #__line__ ";unclip-channel 10 oboe maxamp: ~A" umax)))
(revert-sound ind)
(mix "oboe.snd" 0 0 ind 0 #f)
@@ -15395,9 +15471,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 217)) (snd-display ";unclip-channel 11 oboe clips: ~A" clips))
- (if (not (= lmax 2)) (snd-display ";unclip-channel 11 oboe max len: ~A" lmax))
- (if (fneq umax 0.999) (snd-display ";unclip-channel 11 oboe maxamp: ~A" umax)))
+ (if (not (= clips 217)) (snd-display #__line__ ";unclip-channel 11 oboe clips: ~A" clips))
+ (if (not (= lmax 2)) (snd-display #__line__ ";unclip-channel 11 oboe max len: ~A" lmax))
+ (if (fneq umax 0.999) (snd-display #__line__ ";unclip-channel 11 oboe maxamp: ~A" umax)))
(revert-sound ind)
(mix "oboe.snd" 0 0 ind 0 #f)
@@ -15412,9 +15488,9 @@ EDITS: 2
(umax (list-ref vals 1))
(clips (list-ref vals 3))
(lmax (list-ref vals 5)))
- (if (not (= clips 28)) (snd-display ";unclip-channel 12 oboe clips: ~A" clips))
- (if (not (= lmax 3)) (snd-display ";unclip-channel 12 oboe max len: ~A" lmax))
- (if (fneq umax 0.999) (snd-display ";unclip-channel 12 oboe maxamp: ~A" umax)))
+ (if (not (= clips 28)) (snd-display #__line__ ";unclip-channel 12 oboe clips: ~A" clips))
+ (if (not (= lmax 3)) (snd-display #__line__ ";unclip-channel 12 oboe max len: ~A" lmax))
+ (if (fneq umax 0.999) (snd-display #__line__ ";unclip-channel 12 oboe maxamp: ~A" umax)))
(close-sound ind)))
@@ -15435,7 +15511,7 @@ EDITS: 2
(map-channel flt)
(let* ((mx (maxamp))
(resp (make-vct bins))
- (size (inexact->exact (round (/ 22050 bins)))))
+ (size (round (/ 22050 bins))))
(do ((i 0 (+ 1 i)))
((= i bins))
(let ((data (channel->vct (* i size) size)))
@@ -15469,13 +15545,13 @@ EDITS: 2
((>= i 12))
(let ((vals (butterworth-prototype i)))
(if (not (vequal (cadr vals) (list-ref poles k)))
- (snd-display ";butterworth prototype poles ~A: ~A (~A)" i (cadr vals) (list-ref poles k)))
+ (snd-display #__line__ ";butterworth prototype poles ~A: ~A (~A)" i (cadr vals) (list-ref poles k)))
(let ((zeros (make-vct (* (+ k 1) 3))))
(do ((j 2 (+ j 3)))
((>= j (* (+ k 1) 3)))
(vct-set! zeros j 1.0))
(if (not (vequal (car vals) zeros))
- (snd-display ";butterworth prototype zeros ~A: ~A (~A)" i (car vals) zeros)))))
+ (snd-display #__line__ ";butterworth prototype zeros ~A: ~A (~A)" i (car vals) zeros)))))
(do ((cutoff .1 (+ cutoff .1))
(m 0 (+ 1 m)))
((= m 3))
@@ -15485,11 +15561,11 @@ EDITS: 2
(let ((local (make-butterworth-lowpass i cutoff))
(dsp (make-butter-lp k (* (mus-srate) cutoff))))
(if (not (filter-equal? local dsp))
- (snd-display ";butterworth lowpass ~A ~A ~A" cutoff local dsp)))
+ (snd-display #__line__ ";butterworth lowpass ~A ~A ~A" cutoff local dsp)))
(let ((local (make-butterworth-highpass i cutoff))
(dsp (make-butter-hp k (* (mus-srate) cutoff))))
(if (not (filter-equal? local dsp))
- (snd-display ";butterworth highpass ~A ~A ~A" cutoff local dsp)))))
+ (snd-display #__line__ ";butterworth highpass ~A ~A ~A" cutoff local dsp)))))
(let ((ind (open-sound "oboe.snd")))
(let ((hummer (make-eliminate-hum 550)))
@@ -15501,20 +15577,20 @@ EDITS: 2
(let* ((f1 (make-butterworth-lowpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";butterworth lp 8 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";butterworth lp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.359 0.014 0.001 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";butterworth lp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-lowpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";butterworth lp 12 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";butterworth lp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.499 0.358 0.010 0.000 0.000 0.000)))
- (snd-display ";butterworth lp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-lowpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";butterworth lp 10 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";butterworth lp 10 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.361 0.001)))
(not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.360 0.002))))
- (snd-display ";butterworth lp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
((= i 12))
@@ -15523,41 +15599,41 @@ EDITS: 2
(let* ((f1 (make-butterworth-lowpass i j))
(mx (filter-response-max f1)))
(if (> mx 1.0)
- (snd-display ";butter low max ~A ~A: ~A" i j mx)))))
+ (snd-display #__line__ ";butter low max ~A ~A: ~A" i j mx)))))
(let* ((f1 (make-butterworth-highpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";butterworth hp 8 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";butterworth hp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.001 0.348 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500)))
- (snd-display ";butterworth hp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-highpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";butterworth hp 12 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";butterworth hp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.011 0.348 0.500 0.500 0.500 0.500 0.500)))
- (snd-display ";butterworth hp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-highpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";butterworth hp 10 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";butterworth hp 10 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.005 0.343 0.501 0.501)))
- (snd-display ";butterworth hp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandpass 4 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";butterworth bp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.028 0.350 0.481 0.479 0.346 0.132 0.038 0.009 0.002 0.000)))
- (snd-display ";butterworth bp 4 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandpass 12 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";butterworth bp 12 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bp 12 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.006 0.317 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.012 0.319 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.000 0.323 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))))
- (snd-display ";butterworth bp 12 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth bp 12 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandpass 8 .3 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";butterworth bp 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.003 0.034 0.344 0.499 0.499 0.353 0.002)))
- (snd-display ";butterworth bp 8 .3 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth bp 8 .3 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
((= i 12))
@@ -15566,25 +15642,25 @@ EDITS: 2
(let* ((f1 (make-butterworth-highpass i j))
(mx (filter-response-max f1)))
(if (> mx 1.0)
- (snd-display ";butter high max ~A ~A: ~A" i j mx)))))
+ (snd-display #__line__ ";butter high max ~A ~A: ~A" i j mx)))))
(let* ((f1 (make-butterworth-bandstop 4 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";butterworth bs 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bs 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.347 0.339 0.481 0.499 0.500 0.500 0.500 0.500)))
- (snd-display ";butterworth bs 4 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth bs 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandstop 12 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";butterworth bs 12 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bs 12 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.503 0.503 0.364 0.334 0.500 0.500 0.500 0.500 0.500 0.500)))
(not (vequal1 (cadr vals) (vct 0.502 0.503 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500)))
(not (vequal1 (cadr vals) (vct 0.500 0.500 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500))))
- (snd-display ";butterworth bs 12 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth bs 12 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandstop 8 .3 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";butterworth bs 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bs 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.498 0.354 0.332 0.500 0.500)))
- (snd-display ";butterworth bs 8 .3 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";butterworth bs 8 .3 .4 spect: ~A" (cadr vals))))
;; ---------------- Chebyshev ----------------
@@ -15616,34 +15692,34 @@ EDITS: 2
((>= i 12))
(let ((vals (chebyshev-prototype i .01)))
(if (not (vequal1 (cadr vals) (list-ref poles-01 k)))
- (snd-display ";chebyshev prototype .01 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-01 k))))
+ (snd-display #__line__ ";chebyshev prototype .01 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-01 k))))
(let ((vals (chebyshev-prototype i .1)))
(if (not (vequal1 (cadr vals) (list-ref poles-1 k)))
- (snd-display ";chebyshev prototype .1 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-1 k))))
+ (snd-display #__line__ ";chebyshev prototype .1 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-1 k))))
(let ((vals (chebyshev-prototype i)))
(if (not (vequal1 (cadr vals) (list-ref poles-10 k)))
- (snd-display ";chebyshev prototype 1 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-10 k)))
+ (snd-display #__line__ ";chebyshev prototype 1 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-10 k)))
(if (not (vequal (car vals) (list-ref zeros k)))
- (snd-display ";chebyshev prototype .01 zeros ~A: ~A (~A)" i (car vals) (list-ref zeros k))))))
+ (snd-display #__line__ ";chebyshev prototype .01 zeros ~A: ~A (~A)" i (car vals) (list-ref zeros k))))))
(let* ((f1 (make-chebyshev-lowpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";chebyshev lp 8 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev lp 8 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.508 0.512 0.468 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.507 0.512 0.467 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.508 0.513 0.469 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.509 0.508 0.465 0.001 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display ";chebyshev lp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";chebyshev lp 12 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev lp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.509 0.500 0.508 0.508 0.507 0.413 0.000 0.000 0.000 0.000)))
- (snd-display ";chebyshev lp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";chebyshev lp 10 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev lp 10 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.465 0.493 0.509 0.508 0.477 0.507 0.508 0.507 0.431 0.000)))
- (snd-display ";chebyshev lp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
((= i 10))
@@ -15652,59 +15728,59 @@ EDITS: 2
(let* ((f1 (make-chebyshev-lowpass i j))
(mx (filter-response-max f1)))
(if (> mx 1.0)
- (snd-display ";cheby low max ~A ~A: ~A" i j mx)))))
+ (snd-display #__line__ ";cheby low max ~A ~A: ~A" i j mx)))))
(let* ((f1 (make-chebyshev-lowpass 8 .1 .01))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .49) (snd-display ";chebyshev lp 8 .1 .01 max: ~A" (car vals)))
+ (if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev lp 8 .1 .01 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.492 0.491 0.483 0.006 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";chebyshev lp 8 .1 .01 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev lp 8 .1 .01 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 12 .25 .1))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .49) (snd-display ";chebyshev lp 12 .1 max: ~A" (car vals)))
+ (if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev lp 12 .1 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.488 0.488 0.488 0.488 0.487 0.403 0.000 0.000 0.000 0.000)))
- (snd-display ";chebyshev lp 12 .25 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev lp 12 .25 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 10 .4 .001))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .49) (snd-display ";chebyshev lp 10 .001 max: ~A" (car vals)))
+ (if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev lp 10 .001 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.488 0.000)))
- (snd-display ";chebyshev lp 10 .4 .001 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev lp 10 .4 .001 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .55) (snd-display ";chebyshev hp 8 max: ~A" (car vals)))
+ (if (ffneq (car vals) .55) (snd-display #__line__ ";chebyshev hp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.341 0.551 0.509 0.466 0.501 0.509 0.505 0.481 0.461)))
- (snd-display ";chebyshev hp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .55) (snd-display ";chebyshev hp 12 max: ~A" (car vals)))
+ (if (ffneq (car vals) .55) (snd-display #__line__ ";chebyshev hp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.299 0.554 0.509 0.509 0.500 0.509)))
- (snd-display ";chebyshev hp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 10 .4))
(vals (sweep->bins f1 10)))
(if (and (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.297 0.786 0.677)))
(not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.301 0.788 0.660)))
(not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.322 0.861 0.724)))
(not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.262 0.571 0.509))))
- (snd-display ";chebyshev hp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 8 .1 .01))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .49) (snd-display ";chebyshev hp 8 .1 .01 max: ~A" (car vals)))
+ (if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev hp 8 .1 .01 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.498 0.498 0.492 0.491 0.492 0.492 0.492 0.491 0.491)))
- (snd-display ";chebyshev hp 8 .1 .01 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev hp 8 .1 .01 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 12 .25 .1))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";chebyshev hp 12 .1 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev hp 12 .1 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.453 0.516 0.489 0.489 0.488 0.488)))
- (snd-display ";chebyshev hp 12 .25 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev hp 12 .25 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 10 .4 .001))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .5) (snd-display ";chebyshev hp 10 .001 max: ~A" (car vals)))
+ (if (ffneq (car vals) .5) (snd-display #__line__ ";chebyshev hp 10 .001 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.501 0.504 0.504)))
(not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.505 0.504)))
(not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.501 0.497))))
- (snd-display ";chebyshev hp 10 .4 .001 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev hp 10 .4 .001 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
((= i 10))
@@ -15713,73 +15789,73 @@ EDITS: 2
(let* ((f1 (make-chebyshev-highpass i j))
(mx (filter-response-max f1)))
(if (> mx 1.0)
- (snd-display ";cheby high max ~A ~A: ~A" i j mx)))))
+ (snd-display #__line__ ";cheby high max ~A ~A: ~A" i j mx)))))
(let* ((f1 (make-chebyshev-bandpass 4 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";chebyshev bp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.009 0.449 0.509 0.505 0.442 0.065 0.013 0.003 0.000 0.000)))
- (snd-display ";chebyshev bp 4 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandpass 6 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";chebyshev bp 6 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 6 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.001 0.376 0.505 0.498 0.412 0.011 0.001 0.000 0.000 0.000)))
- (snd-display ";chebyshev bp 6 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev bp 6 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandpass 8 .3 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";chebyshev bp 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.002 0.363 0.517 0.513 0.433 0.000)))
- (snd-display ";chebyshev bp 8 .3 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev bp 8 .3 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandpass 8 .2 .2 .01))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";chebyshev bp 10 .2 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 10 .2 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.015 0.483 0.482 0.021 0.001 0.000 0.000 0.000)))
- (snd-display ";chebyshev bp 10 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev bp 10 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandstop 4 .1 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";chebyshev bs 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bs 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.509 0.505 0.447 0.033 0.006 0.006 0.033 0.445 0.512 0.509)))
- (snd-display ";chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandstop 8 .1 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .51)) .05) (snd-display ";chebyshev bs 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .51)) .05) (snd-display #__line__ ";chebyshev bs 8 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.508 0.512 0.468 0.001 0.000 0.000 0.001 0.345 0.551 0.507)))
(not (vequal1 (cadr vals) (vct 0.507 0.512 0.467 0.001 0.000 0.000 0.001 0.344 0.549 0.508)))
(not (vequal1 (cadr vals) (vct 0.508 0.513 0.469 0.001 0.000 0.000 0.001 0.345 0.552 0.508)))
(not (vequal1 (cadr vals) (vct 0.509 0.508 0.465 0.001 0.000 0.000 0.001 0.343 0.548 0.508))))
- (snd-display ";chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandstop 8 .1 .4 .01))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";chebyshev bs 8 .01 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bs 8 .01 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.492 0.491 0.483 0.006 0.000 0.000 0.006 0.494 0.495 0.492)))
- (snd-display ";chebyshev bs 8 .1 .4 .01 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";chebyshev bs 8 .1 .4 .01 spect: ~A" (cadr vals))))
;; ---------------- inverse-chebyshev ----------------
(let* ((f1 (make-inverse-chebyshev-lowpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev lp 8 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 8 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.501 0.496 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001)))
(not (vequal1 (cadr vals) (vct 0.500 0.498 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001))))
- (snd-display ";inverse-chebyshev lp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-lowpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev lp 12 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.496 0.001 0.001 0.001 0.001 0.001)))
- (snd-display ";inverse-chebyshev lp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-lowpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev lp 10 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 10 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.001 0.001)))
(not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.002 0.002))))
- (snd-display ";inverse-chebyshev lp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev lp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-lowpass 10 .4 120))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev lp 10 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 10 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.501 0.501 0.501 0.501 0.501 0.500 0.345 0.007 0.000 0.000)))
- (snd-display ";inverse-chebyshev lp 10 .4 120 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev lp 10 .4 120 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
((= i 10))
@@ -15788,30 +15864,30 @@ EDITS: 2
(let* ((f1 (make-inverse-chebyshev-lowpass i j))
(mx (filter-response-max f1)))
(if (> mx 1.0)
- (snd-display ";inv cheby low max ~A ~A: ~A" i j mx)))))
+ (snd-display #__line__ ";inv cheby low max ~A ~A: ~A" i j mx)))))
(let* ((f1 (make-inverse-chebyshev-highpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev hp 8 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.440 0.505 0.505 0.503 0.502 0.501 0.501 0.501)))
- (snd-display ";inverse-chebyshev hp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-highpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev hp 12 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.001 0.001 0.001 0.505 0.506 0.503 0.501 0.501)))
- (snd-display ";inverse-chebyshev hp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-highpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev hp 10 .4 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 10 .4 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.503 0.503)))
(not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.505 0.503)))
(not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.509 0.504))))
- (snd-display ";inverse-chebyshev hp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-highpass 10 .1 120))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .51) (snd-display ";inverse-chebyshev hp 10 .1 120 max: ~A" (car vals)))
+ (if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 10 .1 120 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.007 0.328 0.502 0.502 0.502 0.501 0.501 0.501)))
- (snd-display ";inverse-chebyshev hp 10 .1 120 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev hp 10 .1 120 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
((= i 10))
@@ -15820,50 +15896,50 @@ EDITS: 2
(let* ((f1 (make-inverse-chebyshev-highpass i j))
(mx (filter-response-max f1)))
(if (> mx 1.0)
- (snd-display ";inv cheby high max ~A ~A: ~A" i j mx)))))
+ (snd-display #__line__ ";inv cheby high max ~A ~A: ~A" i j mx)))))
(let* ((f1 (make-inverse-chebyshev-bandpass 10 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";inverse-chebyshev bp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.498 0.485 0.001 0.001 0.000 0.001 0.000 0.001)))
- (snd-display ";inverse-chebyshev bp 10 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev bp 10 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandpass 10 .1 .2 30))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";inverse-chebyshev bp 6 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 6 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.026 0.025 0.509 0.505 0.020 0.016 0.012 0.016 0.011 0.016)))
(not (vequal1 (cadr vals) (vct 0.030 0.042 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016)))
(not (vequal1 (cadr vals) (vct 0.022 0.017 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016))))
- (snd-display ";inverse-chebyshev bp 10 .1 .2 30 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev bp 10 .1 .2 30 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandpass 8 .1 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";inverse-chebyshev bp 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.440 0.506 0.505 0.503 0.502 0.434 0.001 0.001)))
- (snd-display ";inverse-chebyshev bp 8 .1 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev bp 8 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandpass 8 .3 .4 40))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";inverse-chebyshev bp 10 .2 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 10 .2 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.002 0.005 0.007 0.007 0.005 0.005 0.503 0.505 0.006 0.005)))
- (snd-display ";inverse-chebyshev bp 10 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev bp 10 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandstop 4 .1 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";inverse-chebyshev bs 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bs 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.054 0.001 0.001 0.000 0.000 0.000 0.001 0.055 0.503)))
- (snd-display ";inverse-chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandstop 8 .1 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";inverse-chebyshev bs 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bs 8 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.501 0.496 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506)))
(not (vequal1 (cadr vals) (vct 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.511)))
(not (vequal1 (cadr vals) (vct 0.500 0.498 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506))))
- (snd-display ";inverse-chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandstop 8 .1 .4 90))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";inverse-chebyshev bs 8 90 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bs 8 90 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.505 0.325 0.000 0.000 0.000 0.000 0.000 0.000 0.270 0.506)))
(not (vequal1 (cadr vals) (vct 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.269 0.509)))
(not (vequal1 (cadr vals) (vct 0.501 0.327 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.506))))
- (snd-display ";inverse-chebyshev bs 8 .1 .4 90 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";inverse-chebyshev bs 8 .1 .4 90 spect: ~A" (cadr vals))))
;; ---------------- bessel ----------------
@@ -15874,26 +15950,26 @@ EDITS: 2
(begin
(let* ((f1 (make-bessel-lowpass 4 .1))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";bessel lp 4 .1 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 4 .1 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.417 0.209 0.062 0.018 0.005 0.001 0.000 0.000 0.000)))
- (snd-display ";bessel lp 4 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel lp 4 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-lowpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";bessel lp 8 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.499 0.365 0.116 0.010 0.001 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";bessel lp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-lowpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";bessel lp 12 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.477 0.410 0.309 0.185 0.063 0.006 0.000 0.000 0.000)))
- (snd-display ";bessel lp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-lowpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";bessel lp 10 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 10 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.001)))
(not (vequal1 (cadr vals) (vct 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.002))))
- (snd-display ";bessel lp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
((= i 12))
@@ -15902,134 +15978,134 @@ EDITS: 2
(let* ((f1 (make-bessel-lowpass i j))
(mx (filter-response-max f1)))
(if (> mx 1.0)
- (snd-display ";bess low max ~A ~A: ~A" i j mx)))))
+ (snd-display #__line__ ";bess low max ~A ~A: ~A" i j mx)))))
(let* ((f1 (make-bessel-highpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";bessel hp 8 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";bessel hp 8 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.001 0.115 0.290 0.386 0.435 0.465 0.483 0.493 0.498 0.500)))
- (snd-display ";bessel hp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-highpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (fneq (car vals) .5) (snd-display ";bessel hp 12 max: ~A" (car vals)))
+ (if (fneq (car vals) .5) (snd-display #__line__ ";bessel hp 12 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.006 0.063 0.181 0.309 0.410 0.477 0.500)))
- (snd-display ";bessel hp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-highpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (ffneq (car vals) .5) (snd-display ";bessel hp 10 max: ~A" (car vals)))
+ (if (ffneq (car vals) .5) (snd-display #__line__ ";bessel hp 10 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.004 0.084 0.343 0.499)))
- (snd-display ";bessel hp 10 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-bandpass 4 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .245)) .05) (snd-display ";bessel bp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .245)) .05) (snd-display #__line__ ";bessel bp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.023 0.176 0.245 0.244 0.179 0.085 0.031 0.008 0.001 0.000)))
- (snd-display ";bessel bp 4 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-bandstop 12 .1 .2))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .05) (snd-display ";bessel bs 12 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";bessel bs 12 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.498 0.325 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500)))
(not (vequal1 (cadr vals) (vct 0.499 0.324 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500))))
- (snd-display ";bessel bs 12 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";bessel bs 12 .1 .2 spect: ~A" (cadr vals))))
;; ---------------- elliptic ----------------
(let* ((f1 (make-elliptic-lowpass 8 .1))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic lp 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.500 0.515 0.379 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.500 0.509 0.385 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.499 0.498 0.373 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display ";elliptic lp 8 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 12 .25))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic lp 12 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 12 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.476 0.500 0.491 0.499 0.494 0.412 0.003 0.001 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.476 0.500 0.491 0.499 0.494 0.561 0.004 0.000 0.000 0.000)))
(not (vequal1 (cadr vals) (vct 0.476 0.500 0.491 0.499 0.493 0.299 0.006 0.001 0.000 0.000))))
- (snd-display ";elliptic lp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 4 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic lp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.447 0.453 0.462 0.477 0.494 0.500 0.497 0.496 0.445 0.003)))
- (snd-display ";elliptic lp 4 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic lp 4 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 8 .1 .1))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic lp 8 .1 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 .1 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";elliptic lp 8 .1 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic lp 8 .1 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 8 .1 .1 90))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic lp 8 .1 90 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 .1 90 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";elliptic lp 8 .1 .1 90 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic lp 8 .1 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 8 .25 .01 90))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic lp 8 .25 90 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 .25 90 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.499 0.495 0.001 0.000 0.000 0.000)))
- (snd-display ";elliptic lp 8 .25 .1 90 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic lp 8 .25 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 4 .1))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.004 0.438 0.516 0.499 0.502 0.495 0.478 0.463 0.453 0.447)))
- (snd-display ";elliptic hp 4 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic hp 4 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 12 .25))
(vals (sweep->bins f1 10)))
- ;(if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 12 max: ~A" (car vals)))
+ ;(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 12 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.000 0.001 0.001 0.001 0.026 0.934 0.518 0.495 0.503 0.477)))
(not (vequal1 (cadr vals) (vct 0.000 0.001 0.001 0.001 0.033 1.185 0.519 0.495 0.503 0.477)))
(not (vequal1 (cadr vals) (vct 0.000 0.001 0.001 0.001 0.018 0.788 0.520 0.495 0.503 0.477))))
- (snd-display ";elliptic hp 12 .25 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 12 .25 .01 90))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 12 90 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 12 90 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.499 0.517 0.503 0.501 0.500 0.500)))
- (snd-display ";elliptic hp 12 .25 90 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic hp 12 .25 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 4 .4))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.002 0.023 0.447 0.515 0.502)))
- (snd-display ";elliptic hp 4 .4 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic hp 4 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 8 .1 .1))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 8 .1 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 8 .1 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.478 0.553 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
- (snd-display ";elliptic hp 8 .1 .1 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic hp 8 .1 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 8 .1 .1 90))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 8 .1 90 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 8 .1 90 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.478 0.554 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
- (snd-display ";elliptic hp 8 .1 .1 90 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic hp 8 .1 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 8 .25 .01 90))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic hp 8 .25 90 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 8 .25 90 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.516 0.517 0.507 0.503 0.501 0.500)))
- (snd-display ";elliptic hp 8 .25 .1 90 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic hp 8 .25 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandpass 4 .1 .2 .1))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic bp 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bp 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.036 0.546 0.550 0.510 0.501 0.032 0.024 0.009 0.021 0.024)))
- (snd-display ";elliptic bp 4 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandpass 6 .1 .2 .1 90))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic bp 6 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bp 6 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.002 0.511 0.532 0.503 0.492 0.003 0.001 0.001 0.001 0.001)))
- (snd-display ";elliptic bp 6 .1 .2 90 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic bp 6 .1 .2 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandstop 4 .1 .3 .1))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic bs 4 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bs 4 max: ~A" (car vals)))
(if (not (vequal1 (cadr vals) (vct 0.499 0.502 0.498 0.037 0.050 0.540 0.544 0.527 0.526 0.521)))
- (snd-display ";elliptic bs 4 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic bs 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandstop 8 .1 .3 .1 120))
(vals (sweep->bins f1 10)))
- (if (> (abs (- (car vals) .5)) .1) (snd-display ";elliptic bs 8 max: ~A" (car vals)))
+ (if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bs 8 max: ~A" (car vals)))
(if (and (not (vequal1 (cadr vals) (vct 0.500 0.499 0.476 0.000 0.000 0.495 0.526 0.505 0.501 0.501)))
(not (vequal1 (cadr vals) (vct 0.500 0.499 0.475 0.000 0.000 0.495 0.526 0.505 0.501 0.501))))
- (snd-display ";elliptic bs 8 .1 .2 spect: ~A" (cadr vals))))
+ (snd-display #__line__ ";elliptic bs 8 .1 .2 spect: ~A" (cadr vals))))
))))
(define (test-polyoid n)
@@ -16084,7 +16160,7 @@ EDITS: 2
(outb i poly-sum))))))))
(snd (find-sound res)))
(channel-distance snd 0 snd 1)))
-
+
;; ----------------
(define (poly-roots-tests)
(letrec ((ceql (lambda (a b)
@@ -16099,126 +16175,126 @@ EDITS: 2
;; degree=0
(let ((val (poly-roots (vct 0.0))))
- (if (not (null? val)) (snd-display ";poly-roots 0.0: ~A" val)))
+ (if (not (null? val)) (snd-display #__line__ ";poly-roots 0.0: ~A" val)))
(let ((val (poly-roots (vct 12.3))))
- (if (not (null? val)) (snd-display ";poly-roots 12.3: ~A" val)))
+ (if (not (null? val)) (snd-display #__line__ ";poly-roots 12.3: ~A" val)))
;; degree 0 + x=0
(let ((val (poly-roots (vct 0.0 1.0))))
- (if (not (ceql val (list 0.0))) (snd-display ";poly-roots 0.0 1.0: ~A" val)))
+ (if (not (ceql val (list 0.0))) (snd-display #__line__ ";poly-roots 0.0 1.0: ~A" val)))
(let ((val (poly-roots (vct 0.0 0.0 0.0 121.0))))
- (if (not (ceql val (list 0.0 0.0 0.0))) (snd-display ";poly-roots 0.0 0.0 0.0 121.0: ~A" val)))
+ (if (not (ceql val (list 0.0 0.0 0.0))) (snd-display #__line__ ";poly-roots 0.0 0.0 0.0 121.0: ~A" val)))
;; degree=1
(let ((val (poly-roots (vct -1.0 1.0))))
- (if (not (ceql val (list 1.0))) (snd-display ";poly-roots -1.0 1.0: ~A" val)))
+ (if (not (ceql val (list 1.0))) (snd-display #__line__ ";poly-roots -1.0 1.0: ~A" val)))
(let ((val (poly-roots (vct -2.0 4.0))))
- (if (not (ceql val (list 0.5))) (snd-display ";poly-roots -2.0 4.0: ~A" val)))
+ (if (not (ceql val (list 0.5))) (snd-display #__line__ ";poly-roots -2.0 4.0: ~A" val)))
(let ((val (poly-as-vector-roots (vector 0.0-i 1))))
- (if (not (ceql val (list -0.0+1.0i))) (snd-display ";poly-roots: -i 1: ~A" val)))
+ (if (not (ceql val (list -0.0+1.0i))) (snd-display #__line__ ";poly-roots: -i 1: ~A" val)))
;; linear x^n
(let ((val (poly-roots (vct -1.0 0.0 0.0 0.0 1.0))))
(if (and (not (ceql val (list 0.0-1.0i -1.0 0.0+1.0i 1.0)))
(not (ceql val (list 1.0 -1.0 0.0+1.0i -0.0-1.0i))))
- (snd-display ";poly-roots -1.0 0.0 0.0 0.0 1.0: ~A" val)))
+ (snd-display #__line__ ";poly-roots -1.0 0.0 0.0 0.0 1.0: ~A" val)))
(let ((val (poly-roots (vct -16.0 0.0 0.0 0.0 1.0))))
(if (and (not (ceql val (list 0.0-2.0i -2.0 0.0+2.0i 2.0)))
(not (ceql val (list 2.0 -2.0 0.0+2.0i -0.0-2.0i))))
- (snd-display ";poly-roots -16.0 0.0 0.0 0.0 1.0: ~A" val)))
+ (snd-display #__line__ ";poly-roots -16.0 0.0 0.0 0.0 1.0: ~A" val)))
(let ((val (poly-roots (vct -32.0 0 0 0 0 0 0.5))))
- (if (not (ceql val (list 1.0-1.7320i -1.0-1.7320i -2.0 -1.0+1.7320i 1.0+1.7320i 2.0))) (snd-display ";poly-roots 32 0 0 0 0 0 0.5: ~A" val)))
+ (if (not (ceql val (list 1.0-1.7320i -1.0-1.7320i -2.0 -1.0+1.7320i 1.0+1.7320i 2.0))) (snd-display #__line__ ";poly-roots 32 0 0 0 0 0 0.5: ~A" val)))
;; linear + x=0
(let ((val (poly-roots (vct 0.0 -2.0 4.0))))
- (if (not (ceql val (list 0.0 0.5))) (snd-display ";poly-roots 0.0 -2.0 4.0: ~A" val)))
+ (if (not (ceql val (list 0.0 0.5))) (snd-display #__line__ ";poly-roots 0.0 -2.0 4.0: ~A" val)))
;; degree=2
(let ((val (poly-roots (vct -1.0 0.0 1.0))))
- (if (not (ceql val (list 1.0 -1.0))) (snd-display ";poly-roots -1.0 0.0 1.0: ~A" val)))
+ (if (not (ceql val (list 1.0 -1.0))) (snd-display #__line__ ";poly-roots -1.0 0.0 1.0: ~A" val)))
(let ((val (poly-roots (vct 15.0 -8.0 1.0))))
- (if (not (ceql val (list 5.0 3.0))) (snd-display ";poly-roots 15.0 -8.0 1.0: ~A" val)))
+ (if (not (ceql val (list 5.0 3.0))) (snd-display #__line__ ";poly-roots 15.0 -8.0 1.0: ~A" val)))
(let ((val (poly-roots (vct 1 -2 1))))
- (if (not (ceql val (list 1.0 1.0))) (snd-display ";poly-roots 1 -2 1: ~A" val)))
+ (if (not (ceql val (list 1.0 1.0))) (snd-display #__line__ ";poly-roots 1 -2 1: ~A" val)))
(let ((val (poly-as-vector-roots (vector -1 0.0+2i 1))))
- (if (not (ceql val (list 0.0-1.0i 0.0-1.0i))) (snd-display ";poly-roots -1 2i 1: ~A" val)))
+ (if (not (ceql val (list 0.0-1.0i 0.0-1.0i))) (snd-display #__line__ ";poly-roots -1 2i 1: ~A" val)))
(let ((val (poly-roots (vct 1 1 5))))
- (if (not (ceql val (list -0.1+0.43589i -0.1-0.43589i))) (snd-display ";poly-roots 1 1 5: ~A" val)))
+ (if (not (ceql val (list -0.1+0.43589i -0.1-0.43589i))) (snd-display #__line__ ";poly-roots 1 1 5: ~A" val)))
;; 2 + x=0
(let ((val (poly-roots (vct 0.0 0.0 -1.0 0.0 1.0))))
- (if (not (ceql val (list 0.0 0.0 1.0 -1.0))) (snd-display ";poly-roots 0.0 0.0 -1.0 0.0 1.0: ~A" val)))
+ (if (not (ceql val (list 0.0 0.0 1.0 -1.0))) (snd-display #__line__ ";poly-roots 0.0 0.0 -1.0 0.0 1.0: ~A" val)))
;; quadratic in x^(n/2)
(let ((vals (poly-roots (vct 1.0 0.0 -2.0 0.0 1.0))))
(if (and (not (ceql vals (list -1.0 1.0 -1.0 1.0)))
(not (ceql vals (list 1.0 1.0 -1.0 -1.0))))
- (snd-display ";poly-roots 1 0 -2 0 1: ~A" vals)))
+ (snd-display #__line__ ";poly-roots 1 0 -2 0 1: ~A" vals)))
(let ((vals (poly-roots (vct 64.0 0.0 0.0 -16.0 0.0 0.0 1.0))))
(if (not (ceql vals (list -1.0-1.73205i -1.0+1.73205i 2.0 -1.0-1.73205i -1.0+1.73205i 2.0)))
- (snd-display ";poly-roots 64 0 0 -16 0 0 1: ~A" vals)))
+ (snd-display #__line__ ";poly-roots 64 0 0 -16 0 0 1: ~A" vals)))
;; degree=3
(let ((val (poly-roots (vct -15.0 23.0 -9.0 1.0))))
- (if (not (ceql val (list 5.0 1.0 3.0))) (snd-display ";poly-roots 5 1 3: ~A" val)))
+ (if (not (ceql val (list 5.0 1.0 3.0))) (snd-display #__line__ ";poly-roots 5 1 3: ~A" val)))
(let ((val (poly-roots (vct -126 -15 0 1))))
- (if (not (ceql val (list 6.0 -3.0+3.46410i -3.0-3.46410i))) (snd-display ";poly-roots -126 -15 0 1: ~A" val)))
-
+ (if (not (ceql val (list 6.0 -3.0+3.46410i -3.0-3.46410i))) (snd-display #__line__ ";poly-roots -126 -15 0 1: ~A" val)))
+
(let ((val (poly-roots (vct -1 3 -3 1))))
- (if (not (ceql val (list 1.0 1.0 1.0))) (snd-display ";poly-roots -1 3 -3 1: ~A" val)))
+ (if (not (ceql val (list 1.0 1.0 1.0))) (snd-display #__line__ ";poly-roots -1 3 -3 1: ~A" val)))
(let ((val (poly-roots (vct 1 -1 -1 1))))
(if (and (not (ceql val (list 1.0 -1.0 1.0)))
(not (ceql val (list -1.0 1.0 1.0))))
- (snd-display ";poly-roots 1 -1 1: ~A" val)))
+ (snd-display #__line__ ";poly-roots 1 -1 1: ~A" val)))
(let ((val (poly-roots (vct 2 -2 -2 2))))
(if (and (not (ceql val (list 1.0 -1.0 1.0)))
(not (ceql val (list -1.0 1.0 1.0))))
- (snd-display ";poly-roots 2 -2 -2 2: ~A" val)))
+ (snd-display #__line__ ";poly-roots 2 -2 -2 2: ~A" val)))
;; degree=4
-; (let ((vals (poly-roots (vct -15 8 14 -8 1))))
-; (if (not (ceql vals (list 5.0 3.0 1.0 -1.0))) (snd-display ";poly-roots -15 8 14 -8 1: ~A" vals)))
-; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 8 1) (vct -9 1)))))))
-; (if (not (ceql vals (list 9.0 3.0 -2.0 -8.0))) (snd-display ";poly-roots 4(1): ~A" vals)))
-; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct .2 1) (vct -3 1)) (poly* (vct .8 1) (vct -9 1)))))))
-; (if (not (ceql vals (list 9.0 3.0 -0.2 -0.8))) (snd-display ";poly-roots 4(2): ~A" vals)))
-; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct .02 1) (vct -32 1)) (poly* (vct .8 1) (vct -9 1)))))))
-; (if (not (ceql vals (list 32.0 9.0 -0.02 -0.8))) (snd-display ";poly-roots 4(3): ~A" vals)))
+ ; (let ((vals (poly-roots (vct -15 8 14 -8 1))))
+ ; (if (not (ceql vals (list 5.0 3.0 1.0 -1.0))) (snd-display #__line__ ";poly-roots -15 8 14 -8 1: ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 8 1) (vct -9 1)))))))
+ ; (if (not (ceql vals (list 9.0 3.0 -2.0 -8.0))) (snd-display #__line__ ";poly-roots 4(1): ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct .2 1) (vct -3 1)) (poly* (vct .8 1) (vct -9 1)))))))
+ ; (if (not (ceql vals (list 9.0 3.0 -0.2 -0.8))) (snd-display #__line__ ";poly-roots 4(2): ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct .02 1) (vct -32 1)) (poly* (vct .8 1) (vct -9 1)))))))
+ ; (if (not (ceql vals (list 32.0 9.0 -0.02 -0.8))) (snd-display #__line__ ";poly-roots 4(3): ~A" vals)))
;; degree>4
-; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct -1 1) (vct -2 1))))))))
-; (if (not (ceql vals (list 3.0 2.0 -1.0 -2.0 1.0)))
-; (snd-display ";poly-roots n(1): ~A from ~A ~A ~A"
-; vals
-; (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct -1 1) (vct -2 1)))))
-; (mus-float-equal-fudge-factor)
-; poly-roots-epsilon)))
-
-; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 8 1) (vct -9 1))))))))
-; (if (not (ceql vals (list 9.0 3.0 -2.0 -8.0 -1.0))) (snd-display ";poly-roots n(2): ~A" vals)))
-; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct 9 1) (vct -3 1)) (poly* (vct -10 1) (vct -2 1))))))))
-; (if (not (ceql vals (list 10.0 3.0 -1.0 -9.0 2.0 1.0))) (snd-display ";poly-roots n(3): ~A" vals)))
-; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct -4 0 1) (vct -3 1)) (poly* (vct -10 1) (vct -9 0 1))))))))
-; (if (not (ceql vals (list 10.0 3.0 -2.0 -3.0 -1.0 3.0 2.0 1.0))) (snd-display ";poly-roots n(4): ~A" vals)))
-; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct -4 0 1) (vct -16 0 1)) (poly* (vct -25 0 1) (vct -9 0 1))))))))
-; (if (not (ceql vals (list 5.0 -3.0 -4.0 -5.0 4.0 -2.0 3.0 -1.0 2.0 1.0))) (snd-display ";poly-roots n(5): ~A" vals)))
-; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 1 1) (vct -2 1))))))))
-; (if (not (ceql vals (list 3.0 -1.0 -1.0 -2.0 2.0))) (snd-display ";poly-roots n(6): ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct -1 1) (vct -2 1))))))))
+ ; (if (not (ceql vals (list 3.0 2.0 -1.0 -2.0 1.0)))
+ ; (snd-display #__line__ ";poly-roots n(1): ~A from ~A ~A ~A"
+ ; vals
+ ; (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct -1 1) (vct -2 1)))))
+ ; (mus-float-equal-fudge-factor)
+ ; poly-roots-epsilon)))
+
+ ; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 8 1) (vct -9 1))))))))
+ ; (if (not (ceql vals (list 9.0 3.0 -2.0 -8.0 -1.0))) (snd-display #__line__ ";poly-roots n(2): ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct 9 1) (vct -3 1)) (poly* (vct -10 1) (vct -2 1))))))))
+ ; (if (not (ceql vals (list 10.0 3.0 -1.0 -9.0 2.0 1.0))) (snd-display #__line__ ";poly-roots n(3): ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct -4 0 1) (vct -3 1)) (poly* (vct -10 1) (vct -9 0 1))))))))
+ ; (if (not (ceql vals (list 10.0 3.0 -2.0 -3.0 -1.0 3.0 2.0 1.0))) (snd-display #__line__ ";poly-roots n(4): ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct -4 0 1) (vct -16 0 1)) (poly* (vct -25 0 1) (vct -9 0 1))))))))
+ ; (if (not (ceql vals (list 5.0 -3.0 -4.0 -5.0 4.0 -2.0 3.0 -1.0 2.0 1.0))) (snd-display #__line__ ";poly-roots n(5): ~A" vals)))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 1 1) (vct -2 1))))))))
+ ; (if (not (ceql vals (list 3.0 -1.0 -1.0 -2.0 2.0))) (snd-display #__line__ ";poly-roots n(6): ~A" vals)))
(let ((vals (poly-roots (vct -64 0 0 0 0 0 1))))
(if (not (ceql vals (list 0.999999999999999-1.73205080756888i -1.0-1.73205080756888i -2.0 -1.0+1.73205080756888i 1.0+1.73205080756888i 2.0)))
- (snd-display ";poly-roots 64 6: ~A" vals)))
+ (snd-display #__line__ ";poly-roots 64 6: ~A" vals)))
(let ((vals (poly-roots (vct 64 0 0 -16 0 0 1))))
(if (not (ceql vals (list -1.0-1.73205080756888i -1.0+1.73205080756888i 2.0 -1.0-1.73205080756888i -1.0+1.73205080756888i 2.0)))
- (snd-display ";poly-roots 64 16 6: ~A" vals)))
+ (snd-display #__line__ ";poly-roots 64 16 6: ~A" vals)))
(do ((i 0 (+ 1 i))) ((= i 10)) (poly-roots (vct (random 1.0) (random 1.0) (random 1.0))))
(do ((i 0 (+ 1 i))) ((= i 10)) (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
(let ((vals1 (convolution (vct 1 2 3 0 0 0 0 0) (vct 1 2 3 0 0 0 0 0) 8))
(vals2 (poly* (vct 1 2 3 0) (vct 1 2 3 0))))
(if (not (vequal vals1 vals2))
- (snd-display ";poly* convolve: ~A ~A" vals1 vals2)))
+ (snd-display #__line__ ";poly* convolve: ~A ~A" vals1 vals2)))
+
-
(do ((i 0 (+ 1 i))) ((= i 10))
(poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
(make-rectangular (mus-random 1.0) (mus-random 1.0)))))
@@ -16236,15 +16312,15 @@ EDITS: 2
(make-rectangular (mus-random 1.0) (mus-random 1.0))
(make-rectangular (mus-random 1.0) (mus-random 1.0)))))
-; (do ((i 0 (+ 1 i))) ((= i 10))
-; (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
-;
-; (do ((i 0 (+ 1 i))) ((= i 10))
-; (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
-; (make-rectangular (mus-random 1.0) (mus-random 1.0))
-; (make-rectangular (mus-random 1.0) (mus-random 1.0))
-; (make-rectangular (mus-random 1.0) (mus-random 1.0))
-; (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
+ ; (do ((i 0 (+ 1 i))) ((= i 10))
+ ; (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+ ;
+ ; (do ((i 0 (+ 1 i))) ((= i 10))
+ ; (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
+ ; (make-rectangular (mus-random 1.0) (mus-random 1.0))
+ ; (make-rectangular (mus-random 1.0) (mus-random 1.0))
+ ; (make-rectangular (mus-random 1.0) (mus-random 1.0))
+ ; (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
(do ((i 3 (+ 1 i))) ((= i 20))
(let ((v (make-vct i 0.0)))
@@ -16258,28 +16334,28 @@ EDITS: 2
(vct-set! v (- i 1) 1.0)
(vct-set! v (/ (- i 1) 2) 1.0)
(poly-roots v)))
-
+
(let ((vals (poly-roots (vct 1 -1 -1 1))))
(if (and (not (ceql vals (list 1.0 -1.0 1.0)))
(not (ceql vals (list -1.0 1.0 1.0))))
- (snd-display ";poly-roots 1-1-11: ~A" vals)))
+ (snd-display #__line__ ";poly-roots 1-1-11: ~A" vals)))
(let ((vals (poly-roots (vct 2 -1 -2 1))))
- (if (not (ceql vals (list 2.0 -1.0 1.0))) (snd-display ";poly-roots 2-1-21: ~A" vals)))
+ (if (not (ceql vals (list 2.0 -1.0 1.0))) (snd-display #__line__ ";poly-roots 2-1-21: ~A" vals)))
(let ((vals (poly-roots (vct -1 1 1 1))))
(if (not (ceql vals (list 0.543689012692076 -0.771844506346038+1.11514250803994i -0.771844506346038-1.11514250803994i)))
- (snd-display ";poly-roots -1111: ~A" vals)))
+ (snd-display #__line__ ";poly-roots -1111: ~A" vals)))
(let ((vals (poly-roots (vct -1 3 -3 1))))
- (if (not (ceql vals (list 1.0 1.0 1.0))) (snd-display ";poly-roots -13-31: ~A" vals)))
-; (let ((vals (poly-roots (vct 1 -4 6 -4 1))))
-; (if (not (ceql vals (list 1.0 1.0 1.0 1.0))) (snd-display ";poly-roots 1-46-41: ~A" vals)))
+ (if (not (ceql vals (list 1.0 1.0 1.0))) (snd-display #__line__ ";poly-roots -13-31: ~A" vals)))
+ ; (let ((vals (poly-roots (vct 1 -4 6 -4 1))))
+ ; (if (not (ceql vals (list 1.0 1.0 1.0 1.0))) (snd-display #__line__ ";poly-roots 1-46-41: ~A" vals)))
(let ((vals (poly-roots (vct 0.5 0 0 1.0))))
(if (and (not (ceql vals (list 0.396850262992049-0.687364818499302i -0.7937005259841 0.39685026299205+0.687364818499301i)))
(not (ceql vals (list 0.39685026299205+0.687364818499301i 0.39685026299205-0.687364818499301i -0.7937005259841)))
(not (ceql vals (list -7.9370052598409979172089E-1 3.968502629920498958E-1+6.873648184993013E-1i 3.96850262992049E-1-6.873648184993E-1i))))
- (snd-display ";poly-roots 0..5 3: ~A" vals)))
+ (snd-display #__line__ ";poly-roots 0..5 3: ~A" vals)))
(let ((vals (poly-roots (poly* (poly* (poly* (vct -1 1) (vct 1 1)) (poly* (vct -2 1) (vct 2 1))) (poly* (vct -3 1) (vct 3 1))))))
(if (not (ceql vals (list -3.0 3.0 -1.0 1.0 -2.0 2.0)))
- (snd-display ";cube in 2: ~A" vals)))
+ (snd-display #__line__ ";cube in 2: ~A" vals)))
))
;; ----------------
@@ -16354,14 +16430,14 @@ EDITS: 2
(define* (print-and-check gen name desc (desc1 "") (desc2 ""))
(if (not (string=? (mus-name gen) name))
- (snd-display ";mus-name ~A: ~A?" name (mus-name gen)))
+ (snd-display #__line__ ";mus-name ~A: ~A?" name (mus-name gen)))
(if (and (not (string=? (mus-describe gen) desc))
(not (string=? (mus-describe gen) desc1))
(not (string=? (mus-describe gen) desc2)))
- (snd-display ";mus-describe ~A: ~A?" (mus-name gen) (mus-describe gen)))
+ (snd-display #__line__ ";mus-describe ~A: ~A?" (mus-name gen) (mus-describe gen)))
(let ((egen gen))
(if (not (equal? egen gen))
- (snd-display ";equal? ~A: ~A?" gen egen))))
+ (snd-display #__line__ ";equal? ~A: ~A?" gen egen))))
;; ----------------
(define (test-gen-equal g0 g1 g2)
@@ -16370,48 +16446,48 @@ EDITS: 2
(let ((g3 g0)
(gad (make-frame 2)))
(if (not (eq? g0 g3))
- (snd-display ";let ~A not eq? ~A ~A" (mus-name g0) g0 g3))
+ (snd-display #__line__ ";let ~A not eq? ~A ~A" (mus-name g0) g0 g3))
(if (eq? g0 g1)
- (snd-display ";arg ~A eq? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";arg ~A eq? ~A ~A" (mus-name g0) g0 g1))
(if (not (equal? g0 g1))
- (snd-display ";~A not equal? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";~A not equal? ~A ~A" (mus-name g0) g0 g1))
(if (equal? g0 g2)
- (snd-display ";~A equal? ~A ~A" (mus-name g0) g0 g2))
+ (snd-display #__line__ ";~A equal? ~A ~A" (mus-name g0) g0 g2))
(if (equal? g0 gad)
- (snd-display ";~A equal frame? ~A ~A" (mus-name g0) g0 gad))
+ (snd-display #__line__ ";~A equal frame? ~A ~A" (mus-name g0) g0 gad))
(g0)
(g3)
(g3)
(if (not (eq? g0 g3))
- (snd-display ";run let ~A not eq? ~A ~A" (mus-name g0) g0 g3))
+ (snd-display #__line__ ";run let ~A not eq? ~A ~A" (mus-name g0) g0 g3))
(if (eq? g0 g1)
- (snd-display ";arg ~A eq? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";arg ~A eq? ~A ~A" (mus-name g0) g0 g1))
(if (equal? g0 g1)
- (snd-display ";run ~A equal? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";run ~A equal? ~A ~A" (mus-name g0) g0 g1))
(if (equal? g0 g2)
- (snd-display ";run ~A equal? ~A ~A" (mus-name g0) g0 g2))))
+ (snd-display #__line__ ";run ~A equal? ~A ~A" (mus-name g0) g0 g2))))
;; ----------------
(define (fm-test gen)
- (if (not (mus-generator? gen)) (snd-display ";~A not a gen?" gen))
+ (if (not (mus-generator? gen)) (snd-display #__line__ ";~A not a gen?" gen))
(set! (mus-frequency gen) 0.0)
(set! (mus-phase gen) 0.0)
(gen 0.0)
- (if (fneq (mus-phase gen) 0.0) (snd-display ";~A phase(0): ~A" gen (mus-phase gen)))
+ (if (fneq (mus-phase gen) 0.0) (snd-display #__line__ ";~A phase(0): ~A" gen (mus-phase gen)))
(gen 1.0)
- (if (fneq (mus-phase gen) 1.0) (snd-display ";~A phase(1): ~A" gen (mus-phase gen)))
+ (if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";~A phase(1): ~A" gen (mus-phase gen)))
(gen 0.0)
- (if (fneq (mus-phase gen) 1.0) (snd-display ";~A phase(1, 0): ~A" gen (mus-phase gen)))
+ (if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";~A phase(1, 0): ~A" gen (mus-phase gen)))
(set! (mus-frequency gen) (radians->hz 2.0))
- (if (fneq (mus-increment gen) 2.0) (snd-display ";~A increment: ~A" gen (mus-increment gen)))
+ (if (fneq (mus-increment gen) 2.0) (snd-display #__line__ ";~A increment: ~A" gen (mus-increment gen)))
(set! (mus-increment gen) 2.0)
- (if (fneq (mus-frequency gen) (radians->hz 2.0)) (snd-display ";~A set increment: ~A ~A" gen (mus-increment gen) (hz->radians (mus-frequency gen))))
+ (if (fneq (mus-frequency gen) (radians->hz 2.0)) (snd-display #__line__ ";~A set increment: ~A ~A" gen (mus-increment gen) (hz->radians (mus-frequency gen))))
(gen 0.0)
- (if (fneq (mus-phase gen) 3.0) (snd-display ";~A phase(1, 2): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
+ (if (fneq (mus-phase gen) 3.0) (snd-display #__line__ ";~A phase(1, 2): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
(gen 1.0)
- (if (fneq (mus-phase gen) 6.0) (snd-display ";~A phase(3, 2, 1): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
+ (if (fneq (mus-phase gen) 6.0) (snd-display #__line__ ";~A phase(3, 2, 1): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
(do ((i 0 (+ 1 i))) ((= i 10)) (gen 10.0))
- (if (fneq (mus-phase gen) (+ 26 (- 100 (* 2 pi 20)))) (snd-display ";~A phase (over): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
+ (if (fneq (mus-phase gen) (+ 26 (- 100 (* 2 pi 20)))) (snd-display #__line__ ";~A phase (over): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
(set! (mus-frequency gen) 0.0)
(set! (mus-phase gen) 0.0)
(gen 1234567812345678)
@@ -16421,7 +16497,7 @@ EDITS: 2
(gen -2.0)
(if (and (fneq (mus-phase gen) -2.0)
(fneq (mus-phase gen) (- (* 2 pi) 2.0)))
- (snd-display ";phase: ~A freq: ~A" (mus-phase gen))))
+ (snd-display #__line__ ";phase: ~A freq: ~A" (mus-phase gen))))
;; ----------------
;; from mixer.scm (commented out)
@@ -16459,7 +16535,7 @@ EDITS: 2
;; ----------------
(define (numerical-reality-checks)
;; a few reality checks from John Burkardt test_values.C
-
+
(let ((vals (vector 1.6709637479564564156 1.5707963267948966192 1.4706289056333368229 1.3694384060045658278 1.2661036727794991113
1.1592794807274085998 1.0471975511965977462 0.92729521800161223243 0.79539883018414355549 0.64350110879328438680
0.45102681179626243254 0.00000000000000000000))
@@ -16471,7 +16547,7 @@ EDITS: 2
(diff (abs (- nval (vector-ref vals i)))))
(if (> diff max-bad) (set! max-bad diff))))
(if (> max-bad 1.0e-15)
- (snd-display ";acos: ~A" max-bad)))
+ (snd-display #__line__ ";acos: ~A" max-bad)))
(let ((vals (vector 0.0000000000000000000 0.14130376948564857735 0.44356825438511518913 0.62236250371477866781 0.75643291085695958624
0.86701472649056510395 0.96242365011920689500 1.3169578969248167086 1.7627471740390860505 1.8115262724608531070
@@ -16484,7 +16560,7 @@ EDITS: 2
(diff (abs (- nval (vector-ref vals i)))))
(if (> diff max-bad) (set! max-bad diff))))
(if (> max-bad 1.0e-15)
- (snd-display ";acosh: ~A" max-bad)))
+ (snd-display #__line__ ";acosh: ~A" max-bad)))
(let ((vals (vector -0.10016742116155979635 0.00000000000000000000 0.10016742116155979635 0.20135792079033079146 0.30469265401539750797
0.41151684606748801938 0.52359877559829887308 0.64350110879328438680 0.77539749661075306374 0.92729521800161223243
@@ -16497,7 +16573,7 @@ EDITS: 2
(diff (abs (- nval (vector-ref vals i)))))
(if (> diff max-bad) (set! max-bad diff))))
(if (> max-bad 1.0e-15)
- (snd-display ";asin: ~A" max-bad)))
+ (snd-display #__line__ ";asin: ~A" max-bad)))
(let ((vals (vector -2.3124383412727526203 -0.88137358701954302523 0.00000000000000000000 0.099834078899207563327 0.19869011034924140647
0.29567304756342243910 0.39003531977071527608 0.48121182505960344750 0.56882489873224753010 0.65266656608235578681
@@ -16511,7 +16587,7 @@ EDITS: 2
(diff (abs (- nval (vector-ref vals i)))))
(if (> diff max-bad) (set! max-bad diff))
(if (> max-bad 1.0e-14)
- (snd-display ";asinh(~A): ~A ~A -> ~A" (vector-ref args i) nval (vector-ref vals i) max-bad)))))
+ (snd-display #__line__ ";asinh(~A): ~A ~A -> ~A" (vector-ref args i) nval (vector-ref vals i) max-bad)))))
(let ((vals (vector 0.00000000000000000000 0.24497866312686415417 0.32175055439664219340 0.46364760900080611621 0.78539816339744830962
1.1071487177940905030 1.2490457723982544258 1.3258176636680324651 1.3734007669450158609 1.4711276743037345919 1.5208379310729538578))
@@ -16524,7 +16600,7 @@ EDITS: 2
(diff (abs (- nval (vector-ref vals i)))))
(if (> diff max-bad) (set! max-bad diff))))
(if (> max-bad 1.0e-15)
- (snd-display ";atan: ~A" max-bad)))
+ (snd-display #__line__ ";atan: ~A" max-bad)))
(let ((vals (vector -0.54930614433405484570 0.00000000000000000000 0.0010000003333335333335 0.10033534773107558064 0.20273255405408219099
0.30951960420311171547 0.42364893019360180686 0.54930614433405484570 0.69314718055994530942 0.86730052769405319443
@@ -16538,7 +16614,7 @@ EDITS: 2
(if (> diff max-bad)
(set! max-bad diff))
(if (> diff 1.0e-10) ; one is > e-11
- (snd-display ";atanh(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";atanh(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
(let ((vals (vector 0.1000000000000000E+01 0.1010025027795146E+01 0.1040401782229341E+01 0.1092045364317340E+01 0.1166514922869803E+01
0.1266065877752008E+01 0.1393725584134064E+01 0.1553395099731217E+01 0.1749980639738909E+01 0.1989559356618051E+01
@@ -16555,7 +16631,7 @@ EDITS: 2
(if (> diff max-bad)
(set! max-bad diff))
(if (> diff 1.0e-4)
- (snd-display ";bes-i0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";bes-i0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
(let ((vals (vector -0.1775967713143383E+00 -0.3971498098638474E+00 -0.2600519549019334E+00 0.2238907791412357E+00 0.7651976865579666E+00
0.1000000000000000E+01 0.7651976865579666E+00 0.2238907791412357E+00 -0.2600519549019334E+00 -0.3971498098638474E+00
@@ -16571,7 +16647,7 @@ EDITS: 2
(if (> diff max-bad)
(set! max-bad diff))
(if (> diff 1.0e-15)
- (snd-display ";bes-j0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";bes-j0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
(let ((vals (vector 0.3275791375914652E+00 0.6604332802354914E-01 -0.3390589585259365E+00 -0.5767248077568734E+00 -0.4400505857449335E+00
0.0000000000000000E+00 0.4400505857449335E+00 0.5767248077568734E+00 0.3390589585259365E+00 -0.6604332802354914E-01
@@ -16587,7 +16663,7 @@ EDITS: 2
(if (> diff max-bad)
(set! max-bad diff))
(if (> diff 1.0e-15)
- (snd-display ";bes-j1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";bes-j1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
(let ((vals (vector 0.1149034849319005E+00 0.3528340286156377E+00 0.4656511627775222E-01 0.2546303136851206E+00 -0.5971280079425882E-01
0.2497577302112344E-03 0.7039629755871685E-02 0.2611405461201701E+00 -0.2340615281867936E+00 -0.8140024769656964E-01
@@ -16604,7 +16680,7 @@ EDITS: 2
(if (> diff max-bad)
(set! max-bad diff))
(if (> diff 1.0e-15)
- (snd-display ";bes-jn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";bes-jn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff)))))
(let ((vals (vector -0.1534238651350367E+01 0.8825696421567696E-01 0.5103756726497451E+00 0.3768500100127904E+00 -0.1694073932506499E-01
-0.3085176252490338E+00 -0.2881946839815792E+00 -0.2594974396720926E-01 0.2235214893875662E+00 0.2499366982850247E+00
@@ -16618,7 +16694,7 @@ EDITS: 2
(if (> diff max-bad)
(set! max-bad diff))
(if (> diff 1.0e-15)
- (snd-display ";bes-y0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";bes-y0(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
(let ((vals (vector -0.6458951094702027E+01 -0.7812128213002887E+00 -0.1070324315409375E+00 0.3246744247918000E+00 0.3979257105571000E+00
0.1478631433912268E+00 -0.1750103443003983E+00 -0.3026672370241849E+00 -0.1580604617312475E+00 0.1043145751967159E+00
@@ -16632,15 +16708,15 @@ EDITS: 2
(if (> diff max-bad)
(set! max-bad diff))
(if (> diff 1.0e-14)
- (snd-display ";bes-y1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";bes-y1(~A): ~A ~A -> ~A" (vector-ref args i) (vector-ref vals i) nval diff)))))
(let ((vals (vector -0.1650682606816254E+01 -0.6174081041906827E+00 0.3676628826055245E+00 -0.5868082442208615E-02 0.9579316872759649E-01
-0.2604058666258122E+03 -0.9935989128481975E+01 -0.4536948224911019E+00 0.1354030476893623E+00 -0.7854841391308165E-01
-0.1216180142786892E+09 -0.1291845422080393E+06 -0.2512911009561010E+02 -0.3598141521834027E+00 0.5723897182053514E-02
-40816513889983664.0 -0.5933965296914321E+09 -0.1597483848269626E+04 0.1644263394811578E-01))
-
+
;; yn(20, 2.0) prints -40816513889983664.0 but I guess due to float inaccuracies (bes-yn 20 2.0) is -40816513889983672.0?
-
+
(ns (vector 2 2 2 2 2 5 5 5 5 5 10 10 10 10 10 20 20 20 20))
(args (vector 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00
50.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00))
@@ -16653,7 +16729,7 @@ EDITS: 2
(set! max-bad diff))
(if (and (> diff 1.0e-6)
(not (= i 15))) ; see above
- (snd-display ";bes-yn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff)))))
+ (snd-display #__line__ ";bes-yn(~A ~A): ~A ~A -> ~A" (vector-ref ns i) (vector-ref args i) (vector-ref vals i) nval diff)))))
;; one (20 1.0) is off by a lot but the val is 1e22
;; numerics stuff
@@ -16666,8 +16742,8 @@ EDITS: 2
(mval (n-choose-k (vector-ref ns i) (vector-ref ks i))))
(if (or (not (= nval (vector-ref vals i)))
(not (= mval (vector-ref vals i))))
- (snd-display ";binomial(~A ~A): ~A ~A ~A" (vector-ref ns i) (vector-ref ks i) nval mval (vector-ref vals i))))))
-
+ (snd-display #__line__ ";binomial(~A ~A): ~A ~A ~A" (vector-ref ns i) (vector-ref ks i) nval mval (vector-ref vals i))))))
+
(let ((ls (vector 1 1 1 1 1 2 2 2 3 3 3 3 4 5 6 7 8 9 10))
(ms (vector 0 0 0 0 1 0 1 2 0 1 2 3 2 2 3 3 4 4 5))
(vals (vector 0.000000 0.500000 0.707107 1.000000 -0.866025 -0.125000 -1.29904 2.25000 -0.437500 -0.324759 5.62500 -9.74278
@@ -16679,8 +16755,8 @@ EDITS: 2
(if (or (not (real? val))
(not (real? (vector-ref vals i)))
(> (abs (- val (vector-ref vals i))) 0.1))
- (snd-display ";plgndr(~A ~A ~A) = ~A (~A)" (vector-ref ls i) (vector-ref ms i) (vector-ref xs i) val (vector-ref vals i))))))
-
+ (snd-display #__line__ ";plgndr(~A ~A ~A) = ~A (~A)" (vector-ref ls i) (vector-ref ms i) (vector-ref xs i) val (vector-ref vals i))))))
+
(let ((vals (vector 1.0000000000 0.8000000000 0.2800000000 -0.3520000000 -0.8432000000 -0.9971200000
-0.7521920000 -0.2063872000 0.4219724800 0.8815431680 0.9884965888 0.7000513741 0.1315856097))
(ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12))
@@ -16690,8 +16766,8 @@ EDITS: 2
((= i 13))
(let ((val (chebyshev (vector-ref ns i) (vector-ref xs i))))
(if (fneq val (vector-ref vals i))
- (snd-display ";chebyshev ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
-
+ (snd-display #__line__ ";chebyshev ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
+
(do ((i 0 (+ 1 i)))
((= i 10))
(let* ((x (random 10.0))
@@ -16699,8 +16775,8 @@ EDITS: 2
(val1 (gegenbauer order x 1.0))
(val2 (chebyshev order x 2)))
(if (fneq val1 val2)
- (snd-display ";gegenbauer/chebyshev (alpha=1) ~A ~A: ~A ~A" order x val1 val2)))))
-
+ (snd-display #__line__ ";gegenbauer/chebyshev (alpha=1) ~A ~A: ~A ~A" order x val1 val2)))))
+
(let ((as (vector 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.0 1.0 2.0 3.0
4.0 5.0 6.0 7.0 8.0 9.0 10.0 3.0 3.0 3.0 3.0 3.0 3.0 3.0 3.0 3.0 3.0 3.0
3.0 3.0 3.0 3.0 3.0))
@@ -16715,11 +16791,11 @@ EDITS: 2
(xs (vector 0.20 0.20 0.20 0.20 0.20 0.20 0.20 0.20 0.20 0.20 0.20 0.40 0.40 0.40 0.40
0.40 0.40 0.40 0.40 0.40 0.40 0.40 -0.50 -0.40 -0.30 -0.20 -0.10 0.00 0.10 0.20
0.30 0.40 0.50 0.60 0.70 0.80 0.90 1.00)))
-
+
(define (g3 x alpha)
(- (* 1/3 alpha x x x (+ (* 4 alpha alpha) (* 12 alpha) 8))
(* 2 alpha x (+ alpha 1))))
-
+
(define (g5 x alpha)
(+ (* 1/15 alpha x x x x x (+ (* 4 alpha alpha alpha alpha)
(* 40 alpha alpha alpha)
@@ -16731,13 +16807,13 @@ EDITS: 2
(* 44 alpha)
24))
(* alpha x (+ (* alpha alpha) (* 3 alpha) 2))))
-
+
(do ((i 0 (+ 1 i)))
((= i 38))
(let ((val (gegenbauer (vector-ref ns i) (vector-ref xs i) (vector-ref as i))))
(if (fneq val (vector-ref vals i))
- (snd-display ";gegenbauer ~A ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) (vector-ref as i) val (vector-ref vals i)))))
-
+ (snd-display #__line__ ";gegenbauer ~A ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) (vector-ref as i) val (vector-ref vals i)))))
+
(do ((i 0 (+ 1 i)))
((= i 10))
(let* ((x (random 10.0))
@@ -16745,8 +16821,8 @@ EDITS: 2
(val1 (gegenbauer 3 x alpha))
(val2 (g3 x alpha)))
(if (fneq val1 val2)
- (snd-display ";gegenbauer 3 ~A ~A: ~A ~A" x alpha val1 val2))))
-
+ (snd-display #__line__ ";gegenbauer 3 ~A ~A: ~A ~A" x alpha val1 val2))))
+
(do ((i 0 (+ 1 i)))
((= i 10))
(let* ((x (random 10.0))
@@ -16754,9 +16830,9 @@ EDITS: 2
(val1 (gegenbauer 5 x alpha))
(val2 (g5 x alpha)))
(if (fneq val1 val2)
- (snd-display ";gegenbauer 5 ~A ~A: ~A ~A" x alpha val1 val2))))
+ (snd-display #__line__ ";gegenbauer 5 ~A ~A: ~A ~A" x alpha val1 val2))))
)
-
+
(let ((vals (vector 1.0000000000 0.0000000000 -0.5000000000 -0.6666666667 -0.6250000000 -0.4666666667
-0.2569444444 -0.0404761905 0.1539930556 0.3097442681 0.4189459325 0.4801341791
0.4962122235 -0.4455729167 0.8500000000 -3.1666666667 34.3333333333))
@@ -16766,9 +16842,9 @@ EDITS: 2
((= i 17))
(let ((val (laguerre (vector-ref ns i) (vector-ref xs i))))
(if (fneq val (vector-ref vals i))
- (snd-display ";laguerre ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
+ (snd-display #__line__ ";laguerre ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
)
-
+
(let ((vals (vector 1.0 10.0 98.0 940.0 8812.0 80600.0
717880.0 6211600.0 52065680.0 ; was off by factor of 10?
421271200 3275529760.0 24329873600.0 171237081280.0 41.0 -8.0 3816.0 3041200.0))
@@ -16778,9 +16854,9 @@ EDITS: 2
((= i 13))
(let ((val (hermite (vector-ref ns i) (vector-ref xs i))))
(if (fneq val (vector-ref vals i))
- (snd-display ";hermite ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
+ (snd-display #__line__ ";hermite ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
)
-
+
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((lv (legendre-polynomial (let ((v (make-vector 10 0.0)))
@@ -16789,8 +16865,8 @@ EDITS: 2
0.5))
(pv (plgndr i 0 0.5)))
(if (fneq lv pv)
- (snd-display ";lv: ~A, pv: ~A (~A)" lv pv i))))
-
+ (snd-display #__line__ ";lv: ~A, pv: ~A (~A)" lv pv i))))
+
(let ((pow-x (lambda (pow x)
;; A&S p798
(if (= pow 0)
@@ -16815,21 +16891,21 @@ EDITS: 2
(let ((lv (pow-x pow x))
(sv (expt x pow)))
(if (fneq lv sv)
- (snd-display ";~A ^ ~A = ~A ~A?" x pow lv sv))))
+ (snd-display #__line__ ";~A ^ ~A = ~A ~A?" x pow lv sv))))
(list 0 1 2 3 4 5 6)))
(list 2.0 0.5 0.1 -0.5 3.0 0.8)))
-
+
(let ((snd (with-sound (:scaled-to 0.5)
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x .02)))
- ((= i 100))
- (outa i (legendre 20 (cos x)))))))
+ (do ((i 0 (+ 1 i))
+ (x 0.0 (+ x .02)))
+ ((= i 100))
+ (outa i (legendre 20 (cos x)))))))
(let ((index (find-sound snd)))
- (if (fneq (sample 0 index 0) 0.5) (snd-display ";legendre(cos(x)) 0: ~A" (sample 0 index 0)))
- (if (fneq (sample 50 index 0) 0.062572978) (snd-display ";legendre(cos(x)) 50: ~A" (sample 50 index 0)))
+ (if (fneq (sample 0 index 0) 0.5) (snd-display #__line__ ";legendre(cos(x)) 0: ~A" (sample 0 index 0)))
+ (if (fneq (sample 50 index 0) 0.062572978) (snd-display #__line__ ";legendre(cos(x)) 50: ~A" (sample 50 index 0)))
(close-sound index)))
-
-
+
+
(let ((h0 (lambda (x) 1.0))
(h1 (lambda (x) (* 2 x)))
(h2 (lambda (x) (- (* 4 x x) 2)))
@@ -16853,13 +16929,13 @@ EDITS: 2
(v55 (hermite 5 x))
(v6 (h6 x))
(v66 (hermite 6 x)))
- (if (fneq v1 v11) (snd-display ";hermite 1 ~A: ~A ~A" x v1 v11)
- (if (fneq v2 v22) (snd-display ";hermite 2 ~A: ~A ~A" x v2 v22)
- (if (fneq v3 v33) (snd-display ";hermite 3 ~A: ~A ~A" x v3 v33)
- (if (fneq v4 v44) (snd-display ";hermite 4 ~A: ~A ~A" x v4 v44)
- (if (fneq v5 v55) (snd-display ";hermite 5 ~A: ~A ~A" x v5 v55)
- (if (fneq v6 v66) (snd-display ";hermite 6 ~A: ~A ~A" x v6 v66)))))))))))
-
+ (if (fneq v1 v11) (snd-display #__line__ ";hermite 1 ~A: ~A ~A" x v1 v11)
+ (if (fneq v2 v22) (snd-display #__line__ ";hermite 2 ~A: ~A ~A" x v2 v22)
+ (if (fneq v3 v33) (snd-display #__line__ ";hermite 3 ~A: ~A ~A" x v3 v33)
+ (if (fneq v4 v44) (snd-display #__line__ ";hermite 4 ~A: ~A ~A" x v4 v44)
+ (if (fneq v5 v55) (snd-display #__line__ ";hermite 5 ~A: ~A ~A" x v5 v55)
+ (if (fneq v6 v66) (snd-display #__line__ ";hermite 6 ~A: ~A ~A" x v6 v66)))))))))))
+
(let ((lg1 (lambda (x) (- 1 x)))
(lg2 (lambda (x) (+ 1 (* 0.5 x x) (* -2 x))))
(lag1 (lambda (x a) (+ 1 a (- x))))
@@ -16882,66 +16958,66 @@ EDITS: 2
(va22 (laguerre 2 x a))
(va3 (lag3 x a))
(va33 (laguerre 3 x a)))
- (if (fneq v1 v11) (snd-display ";laguerre 1 ~A: ~A ~A" x v1 v11)
- (if (fneq v2 v22) (snd-display ";laguerre 2 ~A: ~A ~A" x v2 v22)
- (if (fneq va1 va11) (snd-display ";laguerre 1a ~A ~A: ~A ~A" x alpha va1 va11)
- (if (fneq va2 va22) (snd-display ";laguerre 2a ~A ~A: ~A ~A" x alpha va2 va22)
- (if (fneq va3 va33) (snd-display ";laguerre 3a ~A ~A: ~A ~A" x alpha va3 va33)))))))))
+ (if (fneq v1 v11) (snd-display #__line__ ";laguerre 1 ~A: ~A ~A" x v1 v11)
+ (if (fneq v2 v22) (snd-display #__line__ ";laguerre 2 ~A: ~A ~A" x v2 v22)
+ (if (fneq va1 va11) (snd-display #__line__ ";laguerre 1a ~A ~A: ~A ~A" x alpha va1 va11)
+ (if (fneq va2 va22) (snd-display #__line__ ";laguerre 2a ~A ~A: ~A ~A" x alpha va2 va22)
+ (if (fneq va3 va33) (snd-display #__line__ ";laguerre 3a ~A ~A: ~A ~A" x alpha va3 va33)))))))))
)
-
+
;; ----------------
;; start of test
-
+
(do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
(log-mem clmtest)
(numerical-reality-checks)
-
- (if (mus-generator? 321) (snd-display ";123 is a gen?"))
- (if (mus-generator? (list 321)) (snd-display ";(123) is a gen?"))
- (if (mus-generator? (list 'hi 321)) (snd-display ";(hi 123) is a gen?"))
+
+ (if (mus-generator? 321) (snd-display #__line__ ";123 is a gen?"))
+ (if (mus-generator? (list 321)) (snd-display #__line__ ";(123) is a gen?"))
+ (if (mus-generator? (list 'hi 321)) (snd-display #__line__ ";(hi 123) is a gen?"))
(set! (mus-srate) 22050)
(let ((samps (seconds->samples 1.0))
(secs (samples->seconds 22050)))
- (if (not (= samps 22050)) (snd-display ";seconds->samples: ~A" samps))
- (if (fneq secs 1.0) (snd-display ";samples->seconds: ~A" secs)))
+ (if (not (= samps 22050)) (snd-display #__line__ ";seconds->samples: ~A" samps))
+ (if (fneq secs 1.0) (snd-display #__line__ ";samples->seconds: ~A" secs)))
(if (and (= clmtest 0)
(not (= (mus-file-buffer-size) default-file-buffer-size)))
- (snd-display ";mus-file-buffer-size: ~D?" (mus-file-buffer-size)))
+ (snd-display #__line__ ";mus-file-buffer-size: ~D?" (mus-file-buffer-size)))
(let ((var (catch #t (lambda () (set! (mus-file-buffer-size) #f)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";mus-file-buffer-size bad size: ~A" var)))
+ (snd-display #__line__ ";mus-file-buffer-size bad size: ~A" var)))
(set! (mus-file-buffer-size) 128)
- (if (not (= (mus-file-buffer-size) 128)) (snd-display ";mus-file-buffer-size: ~D?" (mus-file-buffer-size)))
+ (if (not (= (mus-file-buffer-size) 128)) (snd-display #__line__ ";mus-file-buffer-size: ~D?" (mus-file-buffer-size)))
(set! (mus-file-buffer-size) default-file-buffer-size)
(if (and (not (= (mus-array-print-length) 8))
(not (= (mus-array-print-length) 32)))
- (snd-display ";mus-array-print-length: ~D?" (mus-array-print-length)))
+ (snd-display #__line__ ";mus-array-print-length: ~D?" (mus-array-print-length)))
(set! (mus-array-print-length) 32)
- (if (not (= (mus-array-print-length) 32)) (snd-display ";set mus-array-print-length: ~D?" (mus-array-print-length)))
+ (if (not (= (mus-array-print-length) 32)) (snd-display #__line__ ";set mus-array-print-length: ~D?" (mus-array-print-length)))
(set! (mus-array-print-length) 8)
(let ((fudge (mus-float-equal-fudge-factor)))
(if (> (abs (- (mus-float-equal-fudge-factor) 0.0000001)) 0.00000001)
- (snd-display ";mus-float-equal-fudge-factor: ~A?" (mus-float-equal-fudge-factor)))
+ (snd-display #__line__ ";mus-float-equal-fudge-factor: ~A?" (mus-float-equal-fudge-factor)))
(set! (mus-float-equal-fudge-factor) .1)
(if (fneq (mus-float-equal-fudge-factor) .1)
- (snd-display ";set mus-float-equal-fudge-factor: ~A?" (mus-float-equal-fudge-factor)))
+ (snd-display #__line__ ";set mus-float-equal-fudge-factor: ~A?" (mus-float-equal-fudge-factor)))
(set! (mus-float-equal-fudge-factor) fudge))
- (if (fneq (mus-srate) 22050.0) (snd-display ";mus-srate: ~F?" (mus-srate)))
- (if (fneq (hz->radians 1.0) 2.84951704088598e-4) (snd-display ";hz->radians: ~F?" (hz->radians 1.0)))
- (if (fneq (radians->hz 2.84951704088598e-4) 1.0) (snd-display ";radians->hz: ~F?" (radians->hz 2.84951704088598e-4)))
- (if (fneq (radians->degrees 1.0) 57.2957801818848) (snd-display ";radians->degrees: ~F?" (radians->degrees 1.0)))
- (if (fneq (degrees->radians 57.2957801818848) 1.0) (snd-display ";degrees->radians: ~F?" (degrees->radians 57.2957801818848)))
- (if (fneq (linear->db .25) -12.0411996841431) (snd-display ";linear->db: ~F?" (linear->db .25)))
- (if (fneq (db->linear -12.0411996841431) .25) (snd-display ";db->linear: ~F?" (db->linear -12.0411996841431)))
- (if (fneq (ring-modulate .4 .5) .2) (snd-display ";ring-modulate: ~F?" (ring-modulate .4 .5)))
- (if (fneq (amplitude-modulate 1.0 .5 .4) .7) (snd-display ";amplitude-modulate: ~F?" (amplitude-modulate 1.0 .5 .4)))
+ (if (fneq (mus-srate) 22050.0) (snd-display #__line__ ";mus-srate: ~F?" (mus-srate)))
+ (if (fneq (hz->radians 1.0) 2.84951704088598e-4) (snd-display #__line__ ";hz->radians: ~F?" (hz->radians 1.0)))
+ (if (fneq (radians->hz 2.84951704088598e-4) 1.0) (snd-display #__line__ ";radians->hz: ~F?" (radians->hz 2.84951704088598e-4)))
+ (if (fneq (radians->degrees 1.0) 57.2957801818848) (snd-display #__line__ ";radians->degrees: ~F?" (radians->degrees 1.0)))
+ (if (fneq (degrees->radians 57.2957801818848) 1.0) (snd-display #__line__ ";degrees->radians: ~F?" (degrees->radians 57.2957801818848)))
+ (if (fneq (linear->db .25) -12.0411996841431) (snd-display #__line__ ";linear->db: ~F?" (linear->db .25)))
+ (if (fneq (db->linear -12.0411996841431) .25) (snd-display #__line__ ";db->linear: ~F?" (db->linear -12.0411996841431)))
+ (if (fneq (ring-modulate .4 .5) .2) (snd-display #__line__ ";ring-modulate: ~F?" (ring-modulate .4 .5)))
+ (if (fneq (amplitude-modulate 1.0 .5 .4) .7) (snd-display #__line__ ";amplitude-modulate: ~F?" (amplitude-modulate 1.0 .5 .4)))
(if (fneq (contrast-enhancement 0.1 0.75) (sin (+ (* 0.1 (/ pi 2)) (* .75 (sin (* 0.1 2.0 pi))))))
- (snd-display ";contrast-enhancement: ~F (0.562925306221587)" (contrast-enhancement 0.1 0.75)))
- (if (fneq (contrast-enhancement 1.0) 1.0) (snd-display ";contrast-enhancement opt: ~A" (contrast-enhancement 1.0)))
+ (snd-display #__line__ ";contrast-enhancement: ~F (0.562925306221587)" (contrast-enhancement 0.1 0.75)))
+ (if (fneq (contrast-enhancement 1.0) 1.0) (snd-display #__line__ ";contrast-enhancement opt: ~A" (contrast-enhancement 1.0)))
(let ((lv0 (partials->polynomial (vct 1 1 2 1) mus-chebyshev-first-kind))
(lv1 (partials->polynomial '(1 1 2 1) mus-chebyshev-second-kind))
(lv2 (partials->polynomial '(1 1 2 1 3 1 5 1) mus-chebyshev-first-kind))
@@ -16953,45 +17029,45 @@ EDITS: 2
(lv7a (partials->polynomial '(7 1) mus-chebyshev-first-kind))
(lv8 (partials->polynomial '(7 1) mus-chebyshev-second-kind))
)
- (if (not (fveql lv0 '(-1.000 1.000 2.000) 0)) (snd-display ";partials->polynomial(1): ~A?" lv0))
- (if (not (fveql lv1 '(1.000 2.000 0.0) 0)) (snd-display ";partials->polynomial(2): ~A?" lv1))
- (if (not (fveql lv2 '(-1.000 3.000 2.000 -16.000 0.000 16.000) 0)) (snd-display ";partials->polynomial(3): ~A?" lv2))
- (if (not (fveql lv3 '(1.000 2.000 -8.000 0.000 16.000 0.000) 0)) (snd-display ";partials->polynomial(4): ~A?" lv3))
- (if (not (fveql lv4 '(-0.510 0.700 1.180 0.400 -0.480 0.000 0.320) 0)) (snd-display ";partials->polynomial(5): ~A?" lv4))
- (if (not (fveql lv5 '(0.900 1.060 0.400 -0.320 0.000 0.320 0.000) 0)) (snd-display ";partials->polynomial(6): ~A?" lv5))
- (if (not (vequal lv6 (vct 4.000 -1.000 -50.000 0.000 56.000 16.000))) (snd-display ";partials->polynomial(7): ~A?" lv6))
- (if (not (vequal lv7 (vct 0.000 -7.000 0.000 56.000 0.000 -112.000 0.000 64.000))) (snd-display ";partials->polynomial(8): ~A?" lv7))
- (if (not (vequal lv8 (vct -1.000 0.000 24.000 0.000 -80.000 0.000 64.000 0.000))) (snd-display ";partials->polynomial(9): ~A?" lv8))
- (if (not (vequal lv7 lv7a)) (snd-display ";partials->polynomial kind=1? ~A ~A" lv7 lv7a))
-
+ (if (not (fveql lv0 '(-1.000 1.000 2.000) 0)) (snd-display #__line__ ";partials->polynomial(1): ~A?" lv0))
+ (if (not (fveql lv1 '(1.000 2.000 0.0) 0)) (snd-display #__line__ ";partials->polynomial(2): ~A?" lv1))
+ (if (not (fveql lv2 '(-1.000 3.000 2.000 -16.000 0.000 16.000) 0)) (snd-display #__line__ ";partials->polynomial(3): ~A?" lv2))
+ (if (not (fveql lv3 '(1.000 2.000 -8.000 0.000 16.000 0.000) 0)) (snd-display #__line__ ";partials->polynomial(4): ~A?" lv3))
+ (if (not (fveql lv4 '(-0.510 0.700 1.180 0.400 -0.480 0.000 0.320) 0)) (snd-display #__line__ ";partials->polynomial(5): ~A?" lv4))
+ (if (not (fveql lv5 '(0.900 1.060 0.400 -0.320 0.000 0.320 0.000) 0)) (snd-display #__line__ ";partials->polynomial(6): ~A?" lv5))
+ (if (not (vequal lv6 (vct 4.000 -1.000 -50.000 0.000 56.000 16.000))) (snd-display #__line__ ";partials->polynomial(7): ~A?" lv6))
+ (if (not (vequal lv7 (vct 0.000 -7.000 0.000 56.000 0.000 -112.000 0.000 64.000))) (snd-display #__line__ ";partials->polynomial(8): ~A?" lv7))
+ (if (not (vequal lv8 (vct -1.000 0.000 24.000 0.000 -80.000 0.000 64.000 0.000))) (snd-display #__line__ ";partials->polynomial(9): ~A?" lv8))
+ (if (not (vequal lv7 lv7a)) (snd-display #__line__ ";partials->polynomial kind=1? ~A ~A" lv7 lv7a))
+
(if (not (vequal (normalize-partials (list 1 1 2 1)) (vct 1.000 0.500 2.000 0.500)))
- (snd-display ";normalize-partials 1: ~A" (normalize-partials (list 1 1 2 1))))
+ (snd-display #__line__ ";normalize-partials 1: ~A" (normalize-partials (list 1 1 2 1))))
(if (not (vequal (normalize-partials (vct 1 1 2 1)) (vct 1.000 0.500 2.000 0.500)))
- (snd-display ";normalize-partials 2: ~A" (normalize-partials (vct 1 1 2 1))))
+ (snd-display #__line__ ";normalize-partials 2: ~A" (normalize-partials (vct 1 1 2 1))))
(if (not (vequal (normalize-partials (vct 1 1 2 -1)) (vct 1.000 0.500 2.000 -0.500)))
- (snd-display ";normalize-partials 3: ~A" (normalize-partials (vct 1 1 2 -1))))
+ (snd-display #__line__ ";normalize-partials 3: ~A" (normalize-partials (vct 1 1 2 -1))))
(if (not (vequal (normalize-partials (vct 1 -.1 2 -.1)) (vct 1.000 -0.500 2.000 -0.500)))
- (snd-display ";normalize-partials 4: ~A" (normalize-partials (vct 1 -.1 2 -.1))))
+ (snd-display #__line__ ";normalize-partials 4: ~A" (normalize-partials (vct 1 -.1 2 -.1))))
(if (not (vequal (normalize-partials (vct 0 2 1 1 4 1)) (vct 0.000 0.500 1.000 0.250 4.000 0.250)))
- (snd-display ";normalize-partials 4: ~A" (normalize-partials (vct 0 2 1 1 4 1))))
+ (snd-display #__line__ ";normalize-partials 4: ~A" (normalize-partials (vct 0 2 1 1 4 1))))
(if (fneq (polynomial lv7 1.0) (cosh (* 7 (acosh 1.0))))
- (snd-display ";ccosh cheb 7 1.0: ~A ~A" (polynomial lv7 1.0) (cosh (* 7 (acosh 1.0)))))
+ (snd-display #__line__ ";ccosh cheb 7 1.0: ~A ~A" (polynomial lv7 1.0) (cosh (* 7 (acosh 1.0)))))
(if (fneq (polynomial lv7 1.0) (cos (* 7 (acos 1.0))))
- (snd-display ";cos cheb 7 1.0: ~A ~A" (polynomial lv7 1.0) (cos (* 7 (acos 1.0)))))
+ (snd-display #__line__ ";cos cheb 7 1.0: ~A ~A" (polynomial lv7 1.0) (cos (* 7 (acos 1.0)))))
(if (fneq (polynomial lv8 0.5) (/ (sin (* 7 (acos 0.5))) (sin (acos 0.5))))
- (snd-display ";acos cheb 7 1.0: ~A ~A" (polynomial lv8 0.5) (/ (sin (* 7 (acos 0.5))) (sin (acos 0.5)))))
+ (snd-display #__line__ ";acos cheb 7 1.0: ~A ~A" (polynomial lv8 0.5) (/ (sin (* 7 (acos 0.5))) (sin (acos 0.5)))))
;; G&R 8.943 p 984 uses n+1 where we use n in Un? (our numbering keeps harmonics aligned between Tn and Un)
(do ((i 0 (+ 1 i)))
((+ i 10))
(let ((val (mus-random 1.0)))
(if (fneq (polynomial lv7 val) (cosh (* 7 (acosh val))))
- (snd-display ";ccosh cheb 7 ~A: ~A ~A" val (polynomial lv7 val) (cosh (* 7 (acosh val)))))
+ (snd-display #__line__ ";ccosh cheb 7 ~A: ~A ~A" val (polynomial lv7 val) (cosh (* 7 (acosh val)))))
(if (fneq (polynomial lv7 val) (cos (* 7 (acos val))))
- (snd-display ";cos cheb 7 ~A: ~A ~A" (polynomial lv7 val) (cos (* 7 (acos val)))))
+ (snd-display #__line__ ";cos cheb 7 ~A: ~A ~A" (polynomial lv7 val) (cos (* 7 (acos val)))))
(if (fneq (polynomial lv8 val) (/ (sin (* 7 (acos val))) (sin (acos val))))
- (snd-display ";acos cheb 7 ~A: ~A ~A" val (polynomial lv8 val) (/ (sin (* 7 (acos val))) (sin (acos val)))))))
+ (snd-display #__line__ ";acos cheb 7 ~A: ~A ~A" val (polynomial lv8 val) (/ (sin (* 7 (acos val))) (sin (acos val)))))))
)
;; check phase-quadrature cancellations
@@ -17010,35 +17086,35 @@ EDITS: 2
(lower2 (+ 1.0 (cos a))))
(if (or (fneq upper upper2)
(fneq lower lower2))
- (snd-display ";~A ~A, ~A ~A" upper upper2 lower lower2)))))
+ (snd-display #__line__ ";~A ~A, ~A ~A" upper upper2 lower lower2)))))
(let ((tag (catch #t (lambda () (harmonicizer 550.0 (list .5 .3 .2) 10)) (lambda args (car args)))))
- (if (not (eq? tag 'no-data)) (snd-display ";odd length arg to partials->polynomial: ~A" tag)))
+ (if (not (eq? tag 'no-data)) (snd-display #__line__ ";odd length arg to partials->polynomial: ~A" tag)))
(let* ((amps (list->vct '(1.0)))
(phases (list->vct '(0.0)))
(val (sine-bank amps phases)))
- (if (fneq val 0.0) (snd-display ";sine-bank: ~A 0.0?" val))
+ (if (fneq val 0.0) (snd-display #__line__ ";sine-bank: ~A 0.0?" val))
(vct-set! phases 0 (/ pi 2))
(set! val (sine-bank amps phases))
- (if (fneq val 1.0) (snd-display ";sine-bank: ~A 1.0?" val))
+ (if (fneq val 1.0) (snd-display #__line__ ";sine-bank: ~A 1.0?" val))
(set! amps (list->vct '(0.5 0.25 1.0)))
(set! phases (list->vct '(1.0 0.5 2.0)))
(set! val (sine-bank amps phases))
- (if (fneq val 1.44989) (snd-display ";sine-bank: ~A 1.449?" val))
+ (if (fneq val 1.44989) (snd-display #__line__ ";sine-bank: ~A 1.449?" val))
(set! val (sine-bank amps phases 3))
- (if (fneq val 1.44989) (snd-display ";sine-bank (3): ~A 1.449?" val))
+ (if (fneq val 1.44989) (snd-display #__line__ ";sine-bank (3): ~A 1.449?" val))
(set! val (sine-bank amps phases 1))
- (if (fneq val 0.4207) (snd-display ";sine-bank (1): ~A 1.449?" val)))
+ (if (fneq val 0.4207) (snd-display #__line__ ";sine-bank (1): ~A 1.449?" val)))
(let* ((amps (list->vct '(1.0)))
(oscs (make-vector 1 #f)))
(vector-set! oscs 0 (make-oscil 440.0))
(let ((val (oscil-bank amps oscs #f)))
- (if (fneq val 0.0) (snd-display ";oscil-bank: ~A 0.0?" val))
+ (if (fneq val 0.0) (snd-display #__line__ ";oscil-bank: ~A 0.0?" val))
(set! (mus-phase (vector-ref oscs 0)) (/ pi 2))
(set! val (oscil-bank amps oscs #f))
- (if (fneq val 1.0) (snd-display ";oscil-bank: ~A 1.0?" val))))
+ (if (fneq val 1.0) (snd-display #__line__ ";oscil-bank: ~A 1.0?" val))))
(let ((rdat (make-vct 16))
(idat (make-vct 16))
@@ -17050,7 +17126,7 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 8)) ;should all be 1.0 (impulse in)
(if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display ";spectra not equal 1: ~A ~A" v0 v1))))
+ (snd-display #__line__ ";spectra not equal 1: ~A ~A" v0 v1))))
(vct-scale! idat 0.0)
(vct-scale! rdat 0.0)
(vct-set! rdat 0 1.0)
@@ -17059,11 +17135,11 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 8)) ;should all be 1.0 (impulse in)
(if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display ";spectra not equal 0: ~A ~A" v0 v1))))
+ (snd-display #__line__ ";spectra not equal 0: ~A ~A" v0 v1))))
(let ((var (catch #t (lambda () (spectrum rdat idat #f -1)) (lambda args args))))
(if (or (vct? var)
(not (eq? (car var) 'out-of-range)))
- (snd-display ";spectrum bad type: ~A" var))))
+ (snd-display #__line__ ";spectrum bad type: ~A" var))))
(let ((rdat (make-vct 16))
(idat (make-vct 16))
@@ -17079,15 +17155,15 @@ EDITS: 2
(vector-set! ivec 1 1.0)
(let ((v0 (convolution rdat idat 8))
(v1 (vct-convolve! xdat ydat)))
- (if (or (fneq (vct-ref v0 0) 0.0) (fneq (vct-ref v0 1) 1.0)) (snd-display ";vct convolution: ~A?" v0))
- (if (or (fneq (vct-ref v1 0) 0.0) (fneq (vct-ref v1 1) 1.0)) (snd-display ";vct-convolve!: ~A?" v1))
+ (if (or (fneq (vct-ref v0 0) 0.0) (fneq (vct-ref v0 1) 1.0)) (snd-display #__line__ ";vct convolution: ~A?" v0))
+ (if (or (fneq (vct-ref v1 0) 0.0) (fneq (vct-ref v1 1) 1.0)) (snd-display #__line__ ";vct-convolve!: ~A?" v1))
(do ((i 0 (+ 1 i)))
((= i 8))
(if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display ";convolutions not equal: ~A ~A" v0 v1))))
+ (snd-display #__line__ ";convolutions not equal: ~A ~A" v0 v1))))
(let ((var (catch #t (lambda () (convolution rdat idat -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";convolution bad len: ~A" var)))
+ (snd-display #__line__ ";convolution bad len: ~A" var)))
(convolution rdat idat 20)
(set! idat (make-vct 8))
(convolution rdat idat 20))
@@ -17100,19 +17176,19 @@ EDITS: 2
(vct-set! xdat 3 1.0)
(fft rdat idat 1)
(mus-fft xdat ydat 16 1)
- (if (fneq (vct-ref rdat 0) (vct-ref xdat 0)) (snd-display ";ffts: ~A ~A?" rdat xdat))
+ (if (fneq (vct-ref rdat 0) (vct-ref xdat 0)) (snd-display #__line__ ";ffts: ~A ~A?" rdat xdat))
(fft rdat idat -1)
(mus-fft xdat ydat 17 -1) ; mistake is deliberate
(do ((i 0 (+ 1 i)))
((= i 16))
(if (or (and (= i 3) (or (fneq (vct-ref rdat i) 16.0) (fneq (vct-ref xdat i) 16.0)))
(and (not (= i 3)) (or (fneq (vct-ref rdat i) 0.0) (fneq (vct-ref xdat i) 0.0))))
- (snd-display ";fft real[~D]: ~A ~A?" i (vct-ref rdat i) (vct-ref xdat i)))
+ (snd-display #__line__ ";fft real[~D]: ~A ~A?" i (vct-ref rdat i) (vct-ref xdat i)))
(if (or (fneq (vct-ref idat i) 0.0) (fneq (vct-ref ydat i) 0.0))
- (snd-display ";fft imag[~D]: ~A ~A?" i (vct-ref idat i) (vct-ref ydat i))))
+ (snd-display #__line__ ";fft imag[~D]: ~A ~A?" i (vct-ref idat i) (vct-ref ydat i))))
(let ((var (catch #t (lambda () (mus-fft xdat ydat -1 0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";mus-fft bad len: ~A" var))))
+ (snd-display #__line__ ";mus-fft bad len: ~A" var))))
(let ((rdat (make-vct 20))
(idat (make-vct 19)))
@@ -17126,36 +17202,36 @@ EDITS: 2
(vct-fill! v0 1.0)
(multiply-arrays v0 v1 1)
(if (not (vequal v0 (vct 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";multiply-arrays[0]: ~A?" v0))
+ (snd-display #__line__ ";multiply-arrays[0]: ~A?" v0))
(multiply-arrays v0 v1 100)
(if (fneq (vct-peak v0) 0.0)
- (snd-display ";multiply-arrays[100]: ~A?" v0))
+ (snd-display #__line__ ";multiply-arrays[100]: ~A?" v0))
(vct-fill! v0 1.0)
(vct-fill! v1 0.5)
(multiply-arrays v0 v1)
- (if (fneq (vct-ref v0 0) 0.5) (snd-display ";multiple-arrays: ~F?" (vct-ref v0 0)))
+ (if (fneq (vct-ref v0 0) 0.5) (snd-display #__line__ ";multiple-arrays: ~F?" (vct-ref v0 0)))
(let ((sum (dot-product v0 v1)))
- (if (fneq sum 2.5) (snd-display ";dot-product: ~F?" sum)))
+ (if (fneq sum 2.5) (snd-display #__line__ ";dot-product: ~F?" sum)))
(let ((sum (dot-product v0 v1 10)))
- (if (fneq sum 2.5) (snd-display ";dot-product (10): ~F?" sum)))
+ (if (fneq sum 2.5) (snd-display #__line__ ";dot-product (10): ~F?" sum)))
(let ((sum (dot-product v0 v1 3)))
- (if (fneq sum 0.75) (snd-display ";dot-product (3): ~F?" sum)))
+ (if (fneq sum 0.75) (snd-display #__line__ ";dot-product (3): ~F?" sum)))
(clear-array v0)
- (if (fneq (vct-ref v0 3) 0.0) (snd-display ";clear-array: ~A?" v0))
+ (if (fneq (vct-ref v0 3) 0.0) (snd-display #__line__ ";clear-array: ~A?" v0))
(vct-fill! v0 1.0)
(vct-fill! v1 0.5)
(let ((v2 (rectangular->polar v0 v1)))
- (if (fneq (vct-ref v2 0) 1.118) (snd-display ";rectangular->polar: ~A?" v2)))
+ (if (fneq (vct-ref v2 0) 1.118) (snd-display #__line__ ";rectangular->polar: ~A?" v2)))
(vct-set! v0 0 1.0)
(vct-set! v1 0 1.0)
(rectangular->polar v0 v1)
(if (or (fneq (vct-ref v0 0) (sqrt 2.0))
(fneq (vct-ref v1 0) (- (atan 1.0 1.0)))) ;(tan (atan 1.0 1.0)) -> 1.0
- (snd-display ";rectangular->polar (~A ~A): ~A ~A?" (sqrt 2.0) (- (atan 1.0 1.0)) (vct-ref v0 0) (vct-ref v1 0)))
+ (snd-display #__line__ ";rectangular->polar (~A ~A): ~A ~A?" (sqrt 2.0) (- (atan 1.0 1.0)) (vct-ref v0 0) (vct-ref v1 0)))
(polar->rectangular v0 v1)
(if (or (fneq (vct-ref v0 0) 1.0)
(fneq (vct-ref v1 0) 1.0))
- (snd-display ";polar->rectangular (1 1): ~A ~A?" (vct-ref v0 0) (vct-ref v1 0)))
+ (snd-display #__line__ ";polar->rectangular (1 1): ~A ~A?" (vct-ref v0 0) (vct-ref v1 0)))
(let ((v0 (make-vct 1))
(v1 (make-vct 1))
@@ -17168,8 +17244,8 @@ EDITS: 2
(set! val (vct-ref v0 0))
(polar->rectangular v0 v1)
(vct-ref v1 0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display ";run r->p not inverted: ~A" v))
- (if (fneq val (sqrt 2.0)) (snd-display ";r->p: ~A" val)))
+ (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run r->p not inverted: ~A" v))
+ (if (fneq val (sqrt 2.0)) (snd-display #__line__ ";r->p: ~A" val)))
(let* ((ind (open-sound "oboe.snd"))
(rl (samples->vct 1200 512))
@@ -17183,19 +17259,19 @@ EDITS: 2
((= i 512))
(if (or (fneq (vct-ref rl i) (vct-ref rl-copy i))
(fneq (vct-ref im i) (vct-ref im-copy i)))
- (snd-display ";polar->rectangular[~D]: ~A ~A ~A ~A"
+ (snd-display #__line__ ";polar->rectangular[~D]: ~A ~A ~A ~A"
i
(vct-ref rl i) (vct-ref rl-copy i)
(vct-ref im i) (vct-ref im-copy i)))))
(close-sound ind)))
-
+
(let ((v0 (make-vct 8))
(v1 (make-vct 8)))
(do ((i 0 (+ i 1))) ((= i 8)) (vct-set! v0 i i) (vct-set! v1 i (/ (+ i 1))))
(rectangular->magnitudes v0 v1)
(if (not (vequal v0 (vct 1.000 1.118 2.028 3.010 4.005 5.003 6.002 7.001)))
- (snd-display ";rectangular->magnitudes v0: ~A" v0)))
-
+ (snd-display #__line__ ";rectangular->magnitudes v0: ~A" v0)))
+
(let ((v0 (make-vct 8))
(v1 (make-vct 8))
(v2 (make-vct 8))
@@ -17211,32 +17287,32 @@ EDITS: 2
(rectangular->magnitudes v0 v1)
(rectangular->polar v2 v3)
(if (not (vequal v0 v2))
- (snd-display ";rectangular->magnitudes|polar: ~A ~A" v0 v2)))
+ (snd-display #__line__ ";rectangular->magnitudes|polar: ~A ~A" v0 v2)))
(if (defined? 'edot-product) ; needs complex numbers in C
(let* ((vals (make-vct 1 1.0))
(v1 (edot-product 0.0 vals)))
(if (fneq v1 1.0) ; exp 0.0 * 1.0
- (snd-display ";edot a 1.0: ~A" v1))
+ (snd-display #__line__ ";edot a 1.0: ~A" v1))
(vct-set! vals 0 0.0)
(set! v1 (edot-product 0.0 vals))
(if (fneq v1 0.0) ; exp 0.0 * 0.0
- (snd-display ";edot b 0.0: ~A" v1))
+ (snd-display #__line__ ";edot b 0.0: ~A" v1))
(set! vals (make-vector 1 1.0))
(set! v1 (edot-product 0.0 vals))
(if (fneq v1 1.0) ; exp 0.0 * 1.0
- (snd-display ";edot c 1.0: ~A" v1))
+ (snd-display #__line__ ";edot c 1.0: ~A" v1))
(vector-set! vals 0 0.0+i)
(set! v1 (edot-product 0.0 vals))
(if (cneq v1 0.0+i)
- (snd-display ";edot i: ~A" v1))
+ (snd-display #__line__ ";edot i: ~A" v1))
(set! vals (make-vct 4 1.0))
(set! v1 (edot-product (* 0.25 2 pi) vals))
(let ((v2 (+ (exp (* 0 2 pi))
(exp (* 0.25 2 pi))
(exp (* 0.5 2 pi))
(exp (* 0.75 2 pi)))))
- (if (fneq v1 v2) (snd-display ";edot 4: ~A ~A" v1 v2)))
+ (if (fneq v1 v2) (snd-display #__line__ ";edot 4: ~A ~A" v1 v2)))
(set! vals (make-vector 4 0.0))
(do ((i 0 (+ 1 i)))
((= i 4))
@@ -17246,7 +17322,7 @@ EDITS: 2
(* 2 (exp (* 0.25 2 pi 0.0-i)))
(* 3 (exp (* 0.5 2 pi 0.0-i)))
(* 4 (exp (* 0.75 2 pi 0.0-i))))))
- (if (cneq v1 v2) (snd-display ";edot 4 -i: ~A ~A" v1 v2)))
+ (if (cneq v1 v2) (snd-display #__line__ ";edot 4 -i: ~A ~A" v1 v2)))
(do ((i 0 (+ 1 i)))
((= i 4))
(vector-set! vals i (+ i 1.0+i)))
@@ -17255,7 +17331,7 @@ EDITS: 2
(* 2+i (exp (* 0.25 2 pi 0.0-i)))
(* 3+i (exp (* 0.5 2 pi 0.0-i)))
(* 4+i (exp (* 0.75 2 pi 0.0-i))))))
- (if (cneq v1 v2) (snd-display ";edot 4 -i * i: ~A ~A" v1 v2)))))
+ (if (cneq v1 v2) (snd-display #__line__ ";edot 4 -i * i: ~A ~A" v1 v2)))))
(let ((v0 (make-vct 3)))
(vct-set! v0 0 1.0)
@@ -17264,26 +17340,26 @@ EDITS: 2
(if (or (fneq (polynomial v0 0.0) 1.0)
(fneq (polynomial v0 1.0) 1.6)
(fneq (polynomial v0 2.0) 2.4))
- (snd-display ";polynomial: ~A ~A ~A?"
+ (snd-display #__line__ ";polynomial: ~A ~A ~A?"
(polynomial v0 0.0)
(polynomial v0 1.0)
(polynomial v0 2.0))))
(if (fneq (polynomial (vct 0.0 2.0) 0.5) 1.0)
- (snd-display ";polynomial 2.0 * 0.5: ~A" (polynomial (vct 2.0) 0.5)))
+ (snd-display #__line__ ";polynomial 2.0 * 0.5: ~A" (polynomial (vct 2.0) 0.5)))
(let ((var (catch #t (lambda () (polynomial #f 1.0)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";polynomial empty coeffs: ~A" var)))
+ (snd-display #__line__ ";polynomial empty coeffs: ~A" var)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((arg1 (- (random 100.0) 50.0))
+ (arg2 (- (random 100.0) 50.0)))
+ (let ((val1 (fmod arg1 arg2))
+ (val2 (modulo arg1 arg2)))
+ (if (and (> (abs (- val1 val2)) 1e-8)
+ (> (abs (- (abs (- val1 val2)) (abs arg2))) 1e-8))
+ (format #t "~A ~A: ~A ~A -> ~A~%" arg1 arg2 val1 val2 (abs (- val1 val2)))))))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (let ((arg1 (- (random 100.0) 50.0))
- (arg2 (- (random 100.0) 50.0)))
- (let ((val1 (fmod arg1 arg2))
- (val2 (modulo arg1 arg2)))
- (if (and (> (abs (- val1 val2)) 1e-8)
- (> (abs (- (abs (- val1 val2)) (abs arg2))) 1e-8))
- (format #t "~A ~A: ~A ~A -> ~A~%" arg1 arg2 val1 val2 (abs (- val1 val2)))))))
-
(let ((err 0.0)
(coeffs (vct 1.0 0.0 -.4999999963 0.0 .0416666418 0.0 -.0013888397 0.0 .0000247609 0.0 -.0000002605))
(pi2 (* pi 0.5)))
@@ -17306,74 +17382,74 @@ EDITS: 2
(let ((diff (abs (- (cos x) (new-cos x)))))
(if (> diff err)
(set! err diff))))
- (if (> err 1.1e-7) (snd-display ";new-cos poly err: ~A" err))))
+ (if (> err 1.1e-7) (snd-display #__line__ ";new-cos poly err: ~A" err))))
(let ((val (poly+ (vct .1 .2 .3) (vct 0.0 1.0 2.0 3.0 4.0))))
- (if (not (vequal val (vct 0.100 1.200 2.300 3.000 4.000))) (snd-display ";poly+ 1: ~A" val)))
+ (if (not (vequal val (vct 0.100 1.200 2.300 3.000 4.000))) (snd-display #__line__ ";poly+ 1: ~A" val)))
(let ((val (poly+ (vct .1 .2 .3) .5)))
- (if (not (vequal val (vct 0.600 0.200 0.300))) (snd-display ";poly+ 2: ~A" val)))
+ (if (not (vequal val (vct 0.600 0.200 0.300))) (snd-display #__line__ ";poly+ 2: ~A" val)))
(let ((val (poly+ .5 (vct .1 .2 .3))))
- (if (not (vequal val (vct 0.600 0.200 0.300))) (snd-display ";poly+ 3: ~A" val)))
+ (if (not (vequal val (vct 0.600 0.200 0.300))) (snd-display #__line__ ";poly+ 3: ~A" val)))
(let ((val (poly* (vct 1 1) (vct -1 1))))
- (if (not (vequal val (vct -1.000 0.000 1.000 0.000))) (snd-display ";poly* 1: ~A" val)))
+ (if (not (vequal val (vct -1.000 0.000 1.000 0.000))) (snd-display #__line__ ";poly* 1: ~A" val)))
(let ((val (poly* (vct -5 1) (vct 3 7 2))))
- (if (not (vequal val (vct -15.000 -32.000 -3.000 2.000 0.000))) (snd-display ";poly* 2: ~A" val)))
+ (if (not (vequal val (vct -15.000 -32.000 -3.000 2.000 0.000))) (snd-display #__line__ ";poly* 2: ~A" val)))
(let ((val (poly* (vct -30 -4 2) (vct 0.5 1))))
- (if (not (vequal val (vct -15.000 -32.000 -3.000 2.000 0.000))) (snd-display ";poly* 3: ~A" val)))
+ (if (not (vequal val (vct -15.000 -32.000 -3.000 2.000 0.000))) (snd-display #__line__ ";poly* 3: ~A" val)))
(let ((val (poly* (vct -30 -4 2) 0.5)))
- (if (not (vequal val (vct -15.000 -2.000 1.000))) (snd-display ";poly* 4: ~A" val)))
+ (if (not (vequal val (vct -15.000 -2.000 1.000))) (snd-display #__line__ ";poly* 4: ~A" val)))
(let ((val (poly* 2.0 (vct -30 -4 2))))
- (if (not (vequal val (vct -60.000 -8.000 4.000))) (snd-display ";poly* 5: ~A" val)))
+ (if (not (vequal val (vct -60.000 -8.000 4.000))) (snd-display #__line__ ";poly* 5: ~A" val)))
(let ((val (poly/ (vct -1.0 -0.0 1.0) (vct 1.0 1.0))))
(if (or (not (vequal (car val) (vct -1.000 1.000 0.000)))
(not (vequal (cadr val) (vct 0.000 0.000 0.000))))
- (snd-display ";poly/ 1: ~A" val)))
+ (snd-display #__line__ ";poly/ 1: ~A" val)))
(let ((val (poly/ (vct -15 -32 -3 2) (vct -5 1))))
(if (or (not (vequal (car val) (vct 3.000 7.000 2.000 0.000)))
(not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
- (snd-display ";poly/ 2: ~A" val)))
+ (snd-display #__line__ ";poly/ 2: ~A" val)))
(let ((val (poly/ (vct -15 -32 -3 2) (vct 3 1))))
(if (or (not (vequal (car val) (vct -5.000 -9.000 2.000 0.000)))
(not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
- (snd-display ";poly/ 3: ~A" val)))
+ (snd-display #__line__ ";poly/ 3: ~A" val)))
(let ((val (poly/ (vct -15 -32 -3 2) (vct .5 1))))
(if (or (not (vequal (car val) (vct -30.000 -4.000 2.000 0.000)))
(not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
- (snd-display ";poly/ 4: ~A" val)))
+ (snd-display #__line__ ";poly/ 4: ~A" val)))
(let ((val (poly/ (vct -15 -32 -3 2) (vct 3 7 2))))
(if (or (not (vequal (car val) (vct -5.000 1.000 0.000 0.000)))
(not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
- (snd-display ";poly/ 5: ~A" val)))
+ (snd-display #__line__ ";poly/ 5: ~A" val)))
(let ((val (poly/ (vct -15 -32 -3 2) 2.0)))
(if (not (vequal (car val) (vct -7.500 -16.000 -1.500 1.000)))
- (snd-display ";poly/ 6: ~A" val)))
+ (snd-display #__line__ ";poly/ 6: ~A" val)))
(let ((val (poly/ (vct -1.0 0.0 0.0 0.0 1.0) (vct 1.0 0.0 1.0))))
(if (or (not (vequal (car val) (vct -1.0 0.0 1.0 0.0 0.0)))
(not (vequal (cadr val) (make-vct 5))))
- (snd-display ";poly/ 7: ~A" val)))
+ (snd-display #__line__ ";poly/ 7: ~A" val)))
(let ((val (poly/ (vct -1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0) (vct 1.0 0.0 0.0 0.0 1.0))))
(if (or (not (vequal (car val) (vct -1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0)))
(not (vequal (cadr val) (make-vct 9))))
- (snd-display ";poly/ 8: ~A" val)))
+ (snd-display #__line__ ";poly/ 8: ~A" val)))
(let ((val (poly/ (vct -1.0 0.0 1.0) (vct -1.0 0.0 1.0))))
(if (or (not (vequal (car val) (vct 1.0 0.0 0.0)))
(not (vequal (cadr val) (make-vct 3))))
- (snd-display ";poly/ 9: ~A" val)))
+ (snd-display #__line__ ";poly/ 9: ~A" val)))
(let ((val (poly/ (vct -1.0 0.0 1.0) (vct 2.0 1.0))))
(if (or (not (vequal (car val) (vct -2.000 1.000 0.000)))
(not (vequal (cadr val) (vct 3.000 0.000 0.000))))
- (snd-display ";poly/ 10: ~A" val)))
+ (snd-display #__line__ ";poly/ 10: ~A" val)))
(let ((val (poly/ (vct 2 1) (vct -1.0 0.0 1.0))))
(if (or (not (vequal (car val) (vct 0.0)))
(not (vequal (cadr val) (vct -1.000 0.000 1.000))))
- (snd-display ";poly/ 11: ~A" val)))
+ (snd-display #__line__ ";poly/ 11: ~A" val)))
(let ((val (poly/ (vct 1 2 3 0 1) (vct 0 0 0 1))))
(if (or (not (vequal (car val) (vct 0.000 1.000 0.000 0.000 0.000)))
(not (vequal (cadr val) (vct 1.000 2.000 3.000 0.000 0.000))))
- (snd-display ";poly/ 12: ~A" val)))
+ (snd-display #__line__ ";poly/ 12: ~A" val)))
(let ((ind (open-sound "1a.snd")))
(let ((v1 (channel->vct 0 100 ind 0))
@@ -17382,122 +17458,122 @@ EDITS: 2
(res (make-vct 100)))
(vct-set! res 0 1.0)
(if (not (vequal vals res))
- (snd-display ";poly1 1a: ~A" vals))))
+ (snd-display #__line__ ";poly1 1a: ~A" vals))))
(close-sound ind))
(let ((val (poly-derivative (vct 0.5 1.0 2.0 4.0))))
- (if (not (vequal val (vct 1.000 4.000 12.000))) (snd-display ";poly-derivative: ~A" val)))
+ (if (not (vequal val (vct 1.000 4.000 12.000))) (snd-display #__line__ ";poly-derivative: ~A" val)))
(let ((val (poly-reduce (vct 1 2 3))))
- (if (not (vequal val (vct 1.000 2.000 3.000))) (snd-display ";poly-reduce 1: ~A" val)))
+ (if (not (vequal val (vct 1.000 2.000 3.000))) (snd-display #__line__ ";poly-reduce 1: ~A" val)))
(let ((val (poly-reduce (vct 1 2 3 0 0 0))))
- (if (not (vequal val (vct 1.000 2.000 3.000))) (snd-display ";poly-reduce 2: ~A" val)))
+ (if (not (vequal val (vct 1.000 2.000 3.000))) (snd-display #__line__ ";poly-reduce 2: ~A" val)))
(let ((val (poly-reduce (vct 0 0 0 0 1 0))))
- (if (not (vequal val (vct 0.000 0.000 0.000 0.000 1.000))) (snd-display ";poly-reduce 3: ~A" val)))
+ (if (not (vequal val (vct 0.000 0.000 0.000 0.000 1.000))) (snd-display #__line__ ";poly-reduce 3: ~A" val)))
(let ((vals (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct 2 1))))
- (if (not (vequal vals (vct 2.000 1.000))) (snd-display ";poly-gcd 1: ~A" vals)))
+ (if (not (vequal vals (vct 2.000 1.000))) (snd-display #__line__ ";poly-gcd 1: ~A" vals)))
(let ((vals (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct 3 1))))
- (if (not (vequal vals (vct 0.000))) (snd-display ";poly-gcd 2: ~A" vals)))
+ (if (not (vequal vals (vct 0.000))) (snd-display #__line__ ";poly-gcd 2: ~A" vals)))
(let ((vals (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct -3 1))))
- (if (not (vequal vals (vct -3.000 1.000))) (snd-display ";poly-gcd 2: ~A" vals)))
+ (if (not (vequal vals (vct -3.000 1.000))) (snd-display #__line__ ";poly-gcd 2: ~A" vals)))
(let ((vals (poly-gcd (poly-reduce (poly* (vct 8 1) (poly* (vct 2 1) (vct -3 1)))) (vct -3 1))))
- (if (not (vequal vals (vct -3.000 1.000))) (snd-display ";poly-gcd 3: ~A" vals)))
+ (if (not (vequal vals (vct -3.000 1.000))) (snd-display #__line__ ";poly-gcd 3: ~A" vals)))
(let ((vals (poly-gcd (poly-reduce (poly* (vct 8 1) (poly* (vct 2 1) (vct -3 1)))) (poly-reduce (poly* (vct 8 1) (vct -3 1))))))
- (if (not (vequal vals (vct -24.000 5.000 1.000))) (snd-display ";poly-gcd 4: ~A" vals)))
+ (if (not (vequal vals (vct -24.000 5.000 1.000))) (snd-display #__line__ ";poly-gcd 4: ~A" vals)))
(let ((vals (poly-gcd (vct -1 0 1) (vct 2 -2 -1 1))))
- (if (not (vequal vals (vct 0.000))) (snd-display ";poly-gcd 5: ~A" vals)))
+ (if (not (vequal vals (vct 0.000))) (snd-display #__line__ ";poly-gcd 5: ~A" vals)))
(let ((vals (poly-gcd (vct 2 -2 -1 1) (vct -1 0 1))))
- (if (not (vequal vals (vct 1.000 -1.000))) (snd-display ";poly-gcd 6: ~A" vals)))
+ (if (not (vequal vals (vct 1.000 -1.000))) (snd-display #__line__ ";poly-gcd 6: ~A" vals)))
(let ((vals (poly-gcd (vct 2 -2 -1 1) (vct -2.5 1))))
- (if (not (vequal vals (vct 0.000))) (snd-display ";poly-gcd 7: ~A" vals)))
+ (if (not (vequal vals (vct 0.000))) (snd-display #__line__ ";poly-gcd 7: ~A" vals)))
(poly-roots-tests)
(let ((val (poly-as-vector-resultant (vector -1 0 1) (vector 1 -2 1))))
- (if (fneq val 0.0) (snd-display ";poly-resultant 0: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";poly-resultant 0: ~A" val)))
(let ((val (poly-as-vector-resultant (vector -1 0 2) (vector 1 -2 1))))
- (if (fneq val 1.0) (snd-display ";poly-resultant 1: ~A" val)))
+ (if (fneq val 1.0) (snd-display #__line__ ";poly-resultant 1: ~A" val)))
(let ((val (poly-as-vector-resultant (vector -1 0 1) (vector 1 1))))
- (if (fneq val 0.0) (snd-display ";poly-resultant 2: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";poly-resultant 2: ~A" val)))
(let ((val (poly-as-vector-resultant (vector -1 0 1) (vector 2 1))))
- (if (fneq val 3.0) (snd-display ";poly-resultant 3: ~A" val)))
+ (if (fneq val 3.0) (snd-display #__line__ ";poly-resultant 3: ~A" val)))
(let ((val (poly-resultant (vct -1 0 1) (vct 1 -2 1))))
- (if (fneq val 0.0) (snd-display ";poly-resultant 0: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";poly-resultant 0: ~A" val)))
(let ((val (poly-as-vector-discriminant (vector -1 0 1))))
- (if (fneq val -4.0) (snd-display ";poly-discriminant 0: ~A" val)))
+ (if (fneq val -4.0) (snd-display #__line__ ";poly-discriminant 0: ~A" val)))
(let ((val (poly-as-vector-discriminant (vector 1 -2 1))))
- (if (fneq val 0.0) (snd-display ";poly-discriminant 1: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 1: ~A" val)))
(let ((val (poly-discriminant (poly-reduce (poly* (poly* (vct -1 1) (vct -1 1)) (vct 3 1))))))
- (if (fneq val 0.0) (snd-display ";poly-discriminant 2: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 2: ~A" val)))
(let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct -1 1) (vct -1 1)) (vct 3 1)) (vct 2 1))))))
- (if (fneq val 0.0) (snd-display ";poly-discriminant 3: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 3: ~A" val)))
(let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct 1 1) (vct -1 1)) (vct 3 1)) (vct 2 1))))))
- (if (fneq val 2304.0) (snd-display ";poly-discriminant 4: ~A" val)))
+ (if (fneq val 2304.0) (snd-display #__line__ ";poly-discriminant 4: ~A" val)))
(let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct 1 1) (vct -1 1)) (vct 3 1)) (vct 3 1))))))
- (if (fneq val 0.0) (snd-display ";poly-discriminant 5: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 5: ~A" val)))
(let ((v0 (make-vct 10)))
(do ((i 0 (+ 1 i))) ((= i 10))
(vct-set! v0 i i))
- (if (fneq (array-interp v0 3.5) 3.5) (snd-display ";array-interp: ~F?" (array-interp v0 3.5)))
- (if (fneq (array-interp v0 13.5) 3.5) (snd-display ";array-interp(13.5): ~F?" (array-interp v0 13.5)))
- (if (fneq (array-interp v0 -6.5) 3.5) (snd-display ";array-interp(-6.5): ~F?" (array-interp v0 -6.5)))
- (if (fneq (array-interp v0 103.6) 3.6) (snd-display ";array-interp(103.5): ~F?" (array-interp v0 103.6)))
- (if (fneq (array-interp v0 -106.6) 3.4) (snd-display ";array-interp(-106.6): ~F?" (array-interp v0 -106.6)))
- (if (fneq (array-interp v0 -0.5) 4.5) (snd-display ";array-interp(-0.5): ~F?" (array-interp v0 -0.5)))
+ (if (fneq (array-interp v0 3.5) 3.5) (snd-display #__line__ ";array-interp: ~F?" (array-interp v0 3.5)))
+ (if (fneq (array-interp v0 13.5) 3.5) (snd-display #__line__ ";array-interp(13.5): ~F?" (array-interp v0 13.5)))
+ (if (fneq (array-interp v0 -6.5) 3.5) (snd-display #__line__ ";array-interp(-6.5): ~F?" (array-interp v0 -6.5)))
+ (if (fneq (array-interp v0 103.6) 3.6) (snd-display #__line__ ";array-interp(103.5): ~F?" (array-interp v0 103.6)))
+ (if (fneq (array-interp v0 -106.6) 3.4) (snd-display #__line__ ";array-interp(-106.6): ~F?" (array-interp v0 -106.6)))
+ (if (fneq (array-interp v0 -0.5) 4.5) (snd-display #__line__ ";array-interp(-0.5): ~F?" (array-interp v0 -0.5)))
;; interpolating between 9 and 0 here (confusing...)
- (if (fneq (array-interp v0 -0.9) 8.1) (snd-display ";array-interp(-0.9): ~F?" (array-interp v0 -0.9)))
- (if (fneq (array-interp v0 -0.1) 0.9) (snd-display ";array-interp(-0.1): ~F?" (array-interp v0 -0.1)))
- (if (fneq (array-interp v0 9.1) 8.1) (snd-display ";array-interp(9.1): ~F?" (array-interp v0 9.1)))
- (if (fneq (array-interp v0 9.9) 0.9) (snd-display ";array-interp(9.9): ~F?" (array-interp v0 9.9)))
- (if (fneq (array-interp v0 10.1) 0.1) (snd-display ";array-interp(10.1): ~F?" (array-interp v0 10.1)))
+ (if (fneq (array-interp v0 -0.9) 8.1) (snd-display #__line__ ";array-interp(-0.9): ~F?" (array-interp v0 -0.9)))
+ (if (fneq (array-interp v0 -0.1) 0.9) (snd-display #__line__ ";array-interp(-0.1): ~F?" (array-interp v0 -0.1)))
+ (if (fneq (array-interp v0 9.1) 8.1) (snd-display #__line__ ";array-interp(9.1): ~F?" (array-interp v0 9.1)))
+ (if (fneq (array-interp v0 9.9) 0.9) (snd-display #__line__ ";array-interp(9.9): ~F?" (array-interp v0 9.9)))
+ (if (fneq (array-interp v0 10.1) 0.1) (snd-display #__line__ ";array-interp(10.1): ~F?" (array-interp v0 10.1)))
(let ((var (catch #t (lambda () (array-interp v0 1 -10)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";array-interp bad index: ~A" var))))
-
+ (snd-display #__line__ ";array-interp bad index: ~A" var))))
+
(let ((ind (open-sound "oboe.snd")))
(let ((diff (array-interp-sound-diff ind 0)))
- (if (> diff .00001) (snd-display ";array-interp-sound-diff: ~A" diff)))
+ (if (> diff .00001) (snd-display #__line__ ";array-interp-sound-diff: ~A" diff)))
(close-sound ind))
(let ((v0 (make-vct 10)))
(do ((i 0 (+ 1 i))) ((= i 10))
(vct-set! v0 i i))
(let ((val (mus-interpolate mus-interp-linear 1.5 v0)))
- (if (fneq val 1.5) (snd-display ";mus-interpolate linear: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate linear: ~A" val))
(set! val (mus-interpolate mus-interp-all-pass 1.5 v0))
- (if (fneq val 1.5) (snd-display ";mus-interpolate all-pass: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate all-pass: ~A" val))
(set! val (mus-interpolate mus-interp-none 1.5 v0))
- (if (fneq val 1.0) (snd-display ";mus-interpolate none: ~A" val))
+ (if (fneq val 1.0) (snd-display #__line__ ";mus-interpolate none: ~A" val))
(set! val (mus-interpolate mus-interp-hermite 1.5 v0))
- (if (fneq val 1.5) (snd-display ";mus-interpolate hermite: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate hermite: ~A" val))
(set! val (mus-interpolate mus-interp-bezier 1.5 v0))
- (if (fneq val 1.5) (snd-display ";mus-interpolate bezier: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate bezier: ~A" val))
(set! val (mus-interpolate mus-interp-lagrange 1.5 v0))
- (if (fneq val 1.5) (snd-display ";mus-interpolate lagrange: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate lagrange: ~A" val))
(do ((i 0 (+ 1 i))) ((= i 10)) (vct-set! v0 i (sin (* pi (/ i 5)))))
(set! val (mus-interpolate mus-interp-linear 1.5 v0))
- (if (fneq val 0.7694) (snd-display ";mus-interpolate linear sin: ~A" val))
+ (if (fneq val 0.7694) (snd-display #__line__ ";mus-interpolate linear sin: ~A" val))
(set! val (mus-interpolate mus-interp-all-pass 1.5 v0))
- (if (fneq val 0.7694) (snd-display ";mus-interpolate all-pass sin: ~A" val))
+ (if (fneq val 0.7694) (snd-display #__line__ ";mus-interpolate all-pass sin: ~A" val))
(set! val (mus-interpolate mus-interp-none 1.5 v0))
- (if (fneq val 0.5877) (snd-display ";mus-interpolate none sin: ~A" val))
+ (if (fneq val 0.5877) (snd-display #__line__ ";mus-interpolate none sin: ~A" val))
(set! val (mus-interpolate mus-interp-hermite 1.5 v0))
- (if (fneq val 0.8061) (snd-display ";mus-interpolate hermite sin: ~A" val))
+ (if (fneq val 0.8061) (snd-display #__line__ ";mus-interpolate hermite sin: ~A" val))
(set! val (mus-interpolate mus-interp-bezier 1.5 v0))
- (if (fneq val 0.6959) (snd-display ";mus-interpolate bezier sin: ~A" val))
+ (if (fneq val 0.6959) (snd-display #__line__ ";mus-interpolate bezier sin: ~A" val))
(set! val (mus-interpolate mus-interp-lagrange 1.5 v0))
- (if (fneq val 0.7975) (snd-display ";mus-interpolate lagrange sin: ~A" val))))
+ (if (fneq val 0.7975) (snd-display #__line__ ";mus-interpolate lagrange sin: ~A" val))))
(let ((tag (catch #t (lambda () (mus-interpolate 1234 1.0 (make-vct 3))) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";mus-interpolate 1234: ~A" tag)))
+ (snd-display #__line__ ";mus-interpolate 1234: ~A" tag)))
(let ((tag (catch #t (lambda () (mus-interpolate mus-interp-linear 1.0 (make-vct 3) -1)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";mus-interpolate size -1: ~A" tag)))
+ (snd-display #__line__ ";mus-interpolate size -1: ~A" tag)))
(let ((gen (make-delay 3))
(gen2 (make-delay 3))
@@ -17512,32 +17588,32 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (delay gen i)))
(vct-map! v1 (let ((i 0)) (lambda () (let ((val (if (delay? gen2) (delay gen2 i) -1.0))) (set! i (+ 1 i)) val))))
- (if (not (vequal v1 v0)) (snd-display ";map delay: ~A ~A" v0 v1))
- (if (not (delay? gen)) (snd-display ";~A not delay?" gen))
- (if (not (= (mus-length gen) 3)) (snd-display ";delay length: ~D?" (mus-length gen)))
+ (if (not (vequal v1 v0)) (snd-display #__line__ ";map delay: ~A ~A" v0 v1))
+ (if (not (delay? gen)) (snd-display #__line__ ";~A not delay?" gen))
+ (if (not (= (mus-length gen) 3)) (snd-display #__line__ ";delay length: ~D?" (mus-length gen)))
(if (or (fneq (vct-ref v0 1) 0.0) (fneq (vct-ref v0 4) 1.0) (fneq (vct-ref v0 8) 5.0))
- (snd-display ";delay output: ~A" v0))
+ (snd-display #__line__ ";delay output: ~A" v0))
(if (or (fneq (delay gen1) 1.0)
(fneq (delay gen1) 0.5)
(fneq (delay gen1) 0.25)
(fneq (delay gen1) 0.0)
(fneq (delay gen1) 0.0))
- (snd-display ";delay with list initial-contents confused"))
+ (snd-display #__line__ ";delay with list initial-contents confused"))
(if (or (fneq (delay gen3) 1.0)
(fneq (delay gen3) 0.5)
(fneq (delay gen3) 0.25)
(fneq (delay gen3) 0.0)
(fneq (delay gen3) 0.0))
- (snd-display ";delay with vct initial-contents confused"))
+ (snd-display #__line__ ";delay with vct initial-contents confused"))
(let ((var (catch #t (lambda () (make-delay :size #f)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-delay bad size #f: ~A" var)))
+ (snd-display #__line__ ";make-delay bad size #f: ~A" var)))
(let ((var (catch #t (lambda () (make-delay 3 :initial-element (make-oscil))) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-delay bad initial element: ~A" var)))
+ (snd-display #__line__ ";make-delay bad initial element: ~A" var)))
(let ((var (catch #t (lambda () (make-delay -3)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-delay bad size: ~A" var))))
+ (snd-display #__line__ ";make-delay bad size: ~A" var))))
(test-gen-equal (let ((d1 (make-delay 3))) (delay d1 1.0) d1)
(let ((d2 (make-delay 3))) (delay d2 1.0) d2)
@@ -17554,18 +17630,18 @@ EDITS: 2
(let ((data (vct-copy (mus-data gen))))
(vct-set! (mus-data gen) 0 0.3)
(if (fneq (vct-ref (mus-data gen) 0) 0.3)
- (snd-display ";delay data 0: ~A" (vct-ref (mus-data gen) 0)))
+ (snd-display #__line__ ";delay data 0: ~A" (vct-ref (mus-data gen) 0)))
(vct-set! data 0 .75)
(set! (mus-data gen) data)
(if (fneq (vct-ref (mus-data gen) 0) 0.75)
- (snd-display ";delay set data 0: ~A" (vct-ref (mus-data gen) 0)))
+ (snd-display #__line__ ";delay set data 0: ~A" (vct-ref (mus-data gen) 0)))
(delay gen 0.0)
(delay gen 0.0)
(let ((val (delay gen 0.0)))
(if (fneq val 0.75)
- (snd-display ";set delay data: ~A ~A" val (mus-data gen)))))
+ (snd-display #__line__ ";set delay data: ~A ~A" val (mus-data gen)))))
(if (mus-data (make-oscil))
- (snd-display ";mus-data osc: ~A" (mus-data (make-oscil)))))
+ (snd-display #__line__ ";mus-data osc: ~A" (mus-data (make-oscil)))))
(let* ((del (make-delay 5 :max-size 8)))
(delay del 1.0)
@@ -17575,17 +17651,17 @@ EDITS: 2
((= i 5))
(vct-set! v0 i (delay del 0.0 0.4)))
(if (not (vequal v0 (vct 0.600 0.400 0.000 0.000 0.000)))
- (snd-display ";zdelay: ~A" v0))
+ (snd-display #__line__ ";zdelay: ~A" v0))
(delay del 1.0)
(delay del 0.0 0.4)
(if (not (string=? (mus-describe del) "delay line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000]"))
- (snd-display ";describe zdelay: ~A" (mus-describe del)))))
+ (snd-display #__line__ ";describe zdelay: ~A" (mus-describe del)))))
(let ((tag (catch #t (lambda ()
(let ((gen (make-oscil)))
(tap gen)))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";tap of oscil: ~A" tag)))
+ (snd-display #__line__ ";tap of oscil: ~A" tag)))
(let ((dly (make-delay 3))
(flt (make-one-zero .5 .4))
@@ -17596,7 +17672,7 @@ EDITS: 2
(set! inval 0.0)
res)))
(if (not (vequal v (vct 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
- (snd-display ";tap with low pass: ~A" v)))
+ (snd-display #__line__ ";tap with low pass: ~A" v)))
(let ((dly (make-delay 3))
(v (make-vct 20))
@@ -17606,7 +17682,7 @@ EDITS: 2
(set! inval 0.0)
res)))
(if (not (vequal v (vct 0.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0)))
- (snd-display ";simple tap: ~A" v)))
+ (snd-display #__line__ ";simple tap: ~A" v)))
(let ((dly (make-delay 6))
(v (make-vct 20))
@@ -17617,7 +17693,7 @@ EDITS: 2
res)))
(set! (print-length) (max 20 (print-length)))
(if (not (vequal v (vct 0.0 0.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0)))
- (snd-display ";tap back 2: ~A" v)))
+ (snd-display #__line__ ";tap back 2: ~A" v)))
(let ((dly (make-delay 3))
(flt (make-one-zero .5 .4))
@@ -17629,31 +17705,31 @@ EDITS: 2
(set! inval 0.0)
res)))
(if (not (vequal v (vct 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
- (snd-display ";tap with low pass: ~A" v)))
+ (snd-display #__line__ ";tap with low pass: ~A" v)))
(let ((dly (make-delay 3 :initial-element 32.0)))
(if (not (vct? (mus-data dly)))
- (snd-display ";delay data not vct?")
+ (snd-display #__line__ ";delay data not vct?")
(if (not (= (vct-length (mus-data dly)) 3))
- (snd-display ";delay data len not 3: ~A (~A)" (vct-length (mus-data dly)) (mus-data dly))
- (if (fneq (vct-ref (mus-data dly) 1) 32.0) (snd-display ";delay [1] 32: ~A" (vct-ref (mus-data dly) 1)))))
+ (snd-display #__line__ ";delay data len not 3: ~A (~A)" (vct-length (mus-data dly)) (mus-data dly))
+ (if (fneq (vct-ref (mus-data dly) 1) 32.0) (snd-display #__line__ ";delay [1] 32: ~A" (vct-ref (mus-data dly) 1)))))
(let ((tag (catch #t (lambda () (set! (mus-length dly) -1)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display ";len to -1 -> ~A" tag)))
+ (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";len to -1 -> ~A" tag)))
(let ((tag (catch #t (lambda () (set! (mus-length dly) 0)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display ";len to 0 -> ~A" tag)))
+ (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";len to 0 -> ~A" tag)))
(let ((tag (catch #t (lambda () (set! (mus-length dly) 100)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display ";len to 100 -> ~A" tag)))
+ (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";len to 100 -> ~A" tag)))
(let ((tag (catch #t (lambda () (set! (vct-ref (mus-data dly) 100) .1)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display ";data 100 to .1 -> ~A" tag)))
+ (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";data 100 to .1 -> ~A" tag)))
(let ((data (make-vct 32 1.0)))
(set! (mus-data dly) data)
- (if (not (vct? (mus-data dly))) (snd-display ";set delay data not vct?"))
- (if (fneq (vct-ref (mus-data dly) 1) 1.0) (snd-display ";set delay [1] 1: ~A" (vct-ref (mus-data dly) 1)))
- (if (not (= (vct-length (mus-data dly)) 32)) (snd-display ";set delay data len(32): ~A" (vct-length (mus-data dly))))
+ (if (not (vct? (mus-data dly))) (snd-display #__line__ ";set delay data not vct?"))
+ (if (fneq (vct-ref (mus-data dly) 1) 1.0) (snd-display #__line__ ";set delay [1] 1: ~A" (vct-ref (mus-data dly) 1)))
+ (if (not (= (vct-length (mus-data dly)) 32)) (snd-display #__line__ ";set delay data len(32): ~A" (vct-length (mus-data dly))))
(let ((tag (catch #t (lambda () (set! (mus-length dly) 100)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display ";set len to 100 -> ~A" tag)))
+ (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";set len to 100 -> ~A" tag)))
(let ((tag (catch #t (lambda () (set! (vct-ref (mus-data dly) 100) .1)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display ";set data 100 to .1 -> ~A" tag)))))
+ (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";set data 100 to .1 -> ~A" tag)))))
(let ((d1 (make-delay 4))
(d2 (make-delay 4 :max-size 5 :type mus-interp-linear))
@@ -17669,13 +17745,13 @@ EDITS: 2
(v5 (make-vct 20))
(v6 (make-vct 20))
(v7 (make-vct 20)))
- (if (not (= (mus-interp-type d1) mus-interp-none)) (snd-display ";d1 interp type: ~A" (mus-interp-type d1)))
- (if (not (= (mus-interp-type d2) mus-interp-linear)) (snd-display ";d2 interp type: ~A" (mus-interp-type d2)))
- (if (not (= (mus-interp-type d3) mus-interp-all-pass)) (snd-display ";d3 interp type: ~A" (mus-interp-type d3)))
- (if (not (= (mus-interp-type d4) mus-interp-none)) (snd-display ";d4 interp type: ~A" (mus-interp-type d4)))
- (if (not (= (mus-interp-type d5) mus-interp-lagrange)) (snd-display ";d5 interp type: ~A" (mus-interp-type d5)))
- (if (not (= (mus-interp-type d6) mus-interp-hermite)) (snd-display ";d6 interp type: ~A" (mus-interp-type d6)))
- (if (not (= (mus-interp-type d7) mus-interp-linear)) (snd-display ";d7 interp type: ~A" (mus-interp-type d7)))
+ (if (not (= (mus-interp-type d1) mus-interp-none)) (snd-display #__line__ ";d1 interp type: ~A" (mus-interp-type d1)))
+ (if (not (= (mus-interp-type d2) mus-interp-linear)) (snd-display #__line__ ";d2 interp type: ~A" (mus-interp-type d2)))
+ (if (not (= (mus-interp-type d3) mus-interp-all-pass)) (snd-display #__line__ ";d3 interp type: ~A" (mus-interp-type d3)))
+ (if (not (= (mus-interp-type d4) mus-interp-none)) (snd-display #__line__ ";d4 interp type: ~A" (mus-interp-type d4)))
+ (if (not (= (mus-interp-type d5) mus-interp-lagrange)) (snd-display #__line__ ";d5 interp type: ~A" (mus-interp-type d5)))
+ (if (not (= (mus-interp-type d6) mus-interp-hermite)) (snd-display #__line__ ";d6 interp type: ~A" (mus-interp-type d6)))
+ (if (not (= (mus-interp-type d7) mus-interp-linear)) (snd-display #__line__ ";d7 interp type: ~A" (mus-interp-type d7)))
(vct-set! v1 0 (delay d1 1.0))
(vct-set! v2 0 (delay d2 1.0))
(vct-set! v3 0 (delay d3 1.0))
@@ -17703,20 +17779,20 @@ EDITS: 2
(set! (print-length) (max 20 (print-length)))
(if (and (not (vequal v1 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0)))
(not (vequal v1 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
- (snd-display ";delay interp none (1): ~A" v1))
+ (snd-display #__line__ ";delay interp none (1): ~A" v1))
(if (not (vequal v2 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
- (snd-display ";delay interp linear (2): ~A" v2))
+ (snd-display #__line__ ";delay interp linear (2): ~A" v2))
(if (not (vequal v3 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.600 0.160 0.168 -0.168 0.334 0.199 0.520 0.696 -0.696 0.557 -0.334 0.134 -0.027)))
- (snd-display ";delay interp all-pass (3): ~A" v3))
+ (snd-display #__line__ ";delay interp all-pass (3): ~A" v3))
(if (and (not (vequal v4 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0)))
(not (vequal v4 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
- (snd-display ";delay interp none (4): ~A" v4))
+ (snd-display #__line__ ";delay interp none (4): ~A" v4))
(if (not (vequal v5 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360 0.000 -0.080 -0.120 -0.120 -0.080)))
- (snd-display ";delay interp lagrange (5): ~A" v5))
+ (snd-display #__line__ ";delay interp lagrange (5): ~A" v5))
(if (not (vequal v6 (vct 0.0 -0.016 -0.048 -0.072 -0.064 0.0 0.168 0.424 0.696 0.912 1.0 0.912 0.696 0.424 0.168 0.0 -0.064 -0.072 -0.048 -0.016)))
- (snd-display ";delay interp hermite (6): ~A" v6))
+ (snd-display #__line__ ";delay interp hermite (6): ~A" v6))
(if (not (vequal v7 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
- (snd-display ";delay interp linear (7): ~A" v7)))
+ (snd-display #__line__ ";delay interp linear (7): ~A" v7)))
(let ((dly1 (make-delay :size 2 :max-size 3))
(data (make-vct 5))
@@ -17726,7 +17802,7 @@ EDITS: 2
(vct-set! data i (delay dly1 impulse 0.4)) ; longer line
(set! impulse 0.0))
(if (not (vequal data (vct 0.0 0.0 0.6 0.4 0.0)))
- (snd-display ";delay size 2, max 3, off 0.4: ~A" data))
+ (snd-display #__line__ ";delay size 2, max 3, off 0.4: ~A" data))
(set! dly1 (make-delay :size 2 :max-size 3))
(set! impulse 1.0)
@@ -17735,7 +17811,7 @@ EDITS: 2
(vct-set! data i (delay dly1 impulse -0.4)) ; shorter line
(set! impulse 0.0))
(if (not (vequal data (vct 0.0 0.4 0.6 0.0 0.0)))
- (snd-display ";delay size 2, max 3, off -0.4: ~A" data))
+ (snd-display #__line__ ";delay size 2, max 3, off -0.4: ~A" data))
(set! dly1 (make-delay :size 1 :max-size 2))
(set! impulse 1.0)
@@ -17744,7 +17820,7 @@ EDITS: 2
(vct-set! data i (delay dly1 impulse 0.4))
(set! impulse 0.0))
(if (not (vequal data (vct 0.0 0.6 0.4 0.0 0.0)))
- (snd-display ";delay size 1, max 2, off 0.4: ~A" data))
+ (snd-display #__line__ ";delay size 1, max 2, off 0.4: ~A" data))
(set! dly1 (make-delay :size 0 :max-size 1))
(set! impulse 1.0)
@@ -17753,11 +17829,11 @@ EDITS: 2
(vct-set! data i (delay dly1 impulse 0.4))
(set! impulse 0.0))
(if (not (vequal data (vct 0.6 0.0 0.0 0.0 0.0)))
- (snd-display ";delay size 0, max 1, off 0.4: ~A" data))
+ (snd-display #__line__ ";delay size 0, max 1, off 0.4: ~A" data))
(set! dly1 (make-delay :size 0 :max-size 1))
(let ((val (delay dly1 0.0)))
- (if (fneq val 0.0) (snd-display ";initial delay 0 size val: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";initial delay 0 size val: ~A" val)))
(set! dly1 (make-delay :size 0 :max-size 1))
(set! impulse 1.0)
@@ -17766,8 +17842,8 @@ EDITS: 2
(vct-set! data i (delay dly1 impulse -0.4)) ; shorter than 0? should this be an error?
(set! impulse 0.0))
(if (not (vequal data (vct 1.4 0.0 0.0 0.0 0.0))) ; hmmm -- they're asking for undefined values here
- (snd-display ";delay size 0, max 1, off -0.4: ~A" data))
-
+ (snd-display #__line__ ";delay size 0, max 1, off -0.4: ~A" data))
+
(set! dly1 (make-delay 0))
(set! impulse 1.0)
(do ((i 0 (+ 1 i)))
@@ -17775,10 +17851,10 @@ EDITS: 2
(vct-set! data i (delay dly1 impulse))
(set! impulse 0.0))
(if (not (vequal data (vct 1 0 0 0 0)))
- (snd-display ";delay size 0: ~A" data))
-
+ (snd-display #__line__ ";delay size 0: ~A" data))
+
(if (fneq (delay dly1 0.5) 0.5)
- (snd-display ";delay size 0 0.5: ~A" (delay dly 0.5)))
+ (snd-display #__line__ ";delay size 0 0.5: ~A" (delay dly 0.5)))
)
(let ((gen (make-delay :size 0 :max-size 100))
@@ -17787,26 +17863,26 @@ EDITS: 2
((= i 10))
(vct-set! v i (delay gen 0.5 i)))
(if (not (vequal v (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";delay 0 -> 100: ~A" v))
+ (snd-display #__line__ ";delay 0 -> 100: ~A" v))
(do ((i 9 (- i 1)))
((< i 0))
(vct-set! v i (delay gen 0.5 i)))
(if (not (vequal v (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.000)))
- (snd-display ";delay 100 -> 0: ~A" v))
+ (snd-display #__line__ ";delay 100 -> 0: ~A" v))
(mus-reset gen)
(if (not (vequal (mus-data gen) (make-vct 100 0.0)))
- (snd-display ";after reset mus-data delay peak: ~A" (vct-peak (mus-data gen))))
+ (snd-display #__line__ ";after reset mus-data delay peak: ~A" (vct-peak (mus-data gen))))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (delay gen (if (odd? i) 1.0 0.0) (* i .1))))
(if (not (vequal v (vct 0.000 0.900 0.000 0.700 0.000 0.500 0.000 0.300 0.000 0.100)))
- (snd-display ";delay 0 -> 100 .1: ~A (~A)" v gen))
+ (snd-display #__line__ ";delay 0 -> 100 .1: ~A (~A)" v gen))
(mus-reset gen)
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (delay gen (if (odd? i) 1.0 0.0) (+ 1.0 (* i .1)))))
(if (not (vequal v (vct 0.000 0.000 0.800 0.300 0.600 0.500 0.400 0.700 0.200 0.900)))
- (snd-display ";delay 0 -> 100 1.1: ~A" v)))
+ (snd-display #__line__ ";delay 0 -> 100 1.1: ~A" v)))
(let ((gen (make-all-pass .4 .6 3))
@@ -17820,18 +17896,18 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (all-pass gen 1.0)))
(vct-map! v1 (lambda () (if (all-pass? gen1) (all-pass gen1 1.0) -1.0)))
- (if (not (vequal v1 v0)) (snd-display ";map all-pass: ~A ~A" v0 v1))
- (if (not (all-pass? gen)) (snd-display ";~A not all-pass?" gen))
- (if (not (= (mus-length gen) 3)) (snd-display ";all-pass length: ~D?" (mus-length gen)))
- (if (not (= (mus-order gen) 3)) (snd-display ";all-pass order: ~D?" (mus-order gen)))
- (if (fneq (mus-feedback gen) .4) (snd-display ";all-pass feedback: ~F?" (mus-feedback gen)))
- (if (fneq (mus-feedforward gen) .6) (snd-display ";all-pass feedforward: ~F?" (mus-feedforward gen)))
+ (if (not (vequal v1 v0)) (snd-display #__line__ ";map all-pass: ~A ~A" v0 v1))
+ (if (not (all-pass? gen)) (snd-display #__line__ ";~A not all-pass?" gen))
+ (if (not (= (mus-length gen) 3)) (snd-display #__line__ ";all-pass length: ~D?" (mus-length gen)))
+ (if (not (= (mus-order gen) 3)) (snd-display #__line__ ";all-pass order: ~D?" (mus-order gen)))
+ (if (fneq (mus-feedback gen) .4) (snd-display #__line__ ";all-pass feedback: ~F?" (mus-feedback gen)))
+ (if (fneq (mus-feedforward gen) .6) (snd-display #__line__ ";all-pass feedforward: ~F?" (mus-feedforward gen)))
(if (or (fneq (vct-ref v0 1) 0.6) (fneq (vct-ref v0 4) 1.84) (fneq (vct-ref v0 8) 2.336))
- (snd-display ";all-pass output: ~A" v0))
+ (snd-display #__line__ ";all-pass output: ~A" v0))
(set! (mus-feedback gen) 0.5)
- (if (fneq (mus-feedback gen) .5) (snd-display ";all-pass set-feedback: ~F?" (mus-feedback gen)))
+ (if (fneq (mus-feedback gen) .5) (snd-display #__line__ ";all-pass set-feedback: ~F?" (mus-feedback gen)))
(set! (mus-feedforward gen) 0.5)
- (if (fneq (mus-feedforward gen) .5) (snd-display ";all-pass set-feedforward: ~F?" (mus-feedforward gen))))
+ (if (fneq (mus-feedforward gen) .5) (snd-display #__line__ ";all-pass set-feedforward: ~F?" (mus-feedforward gen))))
(test-gen-equal (let ((d1 (make-all-pass 0.7 0.5 3))) (all-pass d1 1.0) d1)
(let ((d2 (make-all-pass 0.7 0.5 3))) (all-pass d2 1.0) d2)
@@ -17847,7 +17923,7 @@ EDITS: 2
(make-all-pass 0.7 0.5 3 :initial-contents '(1.0 1.0 1.0)))
(let ((err (catch #t (lambda () (make-all-pass :feedback .2 :feedforward .1 :size -1)) (lambda args args))))
(if (not (eq? (car err) 'out-of-range))
- (snd-display ";make-all-pass bad size error message: ~A" err)))
+ (snd-display #__line__ ";make-all-pass bad size error message: ~A" err)))
(let ((gen (make-moving-average 4))
(v0 (make-vct 10))
@@ -17860,37 +17936,37 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (moving-average gen 1.0)))
(vct-map! v1 (lambda () (if (moving-average? gen1) (moving-average gen1 1.0) -1.0)))
- (if (not (vequal v1 v0)) (snd-display ";map average: ~A ~A" v0 v1))
- (if (not (moving-average? gen)) (snd-display ";~A not average?" gen))
- (if (not (= (mus-length gen) 4)) (snd-display ";average length: ~D?" (mus-length gen)))
- (if (not (= (mus-order gen) 4)) (snd-display ";average order: ~D?" (mus-order gen)))
+ (if (not (vequal v1 v0)) (snd-display #__line__ ";map average: ~A ~A" v0 v1))
+ (if (not (moving-average? gen)) (snd-display #__line__ ";~A not average?" gen))
+ (if (not (= (mus-length gen) 4)) (snd-display #__line__ ";average length: ~D?" (mus-length gen)))
+ (if (not (= (mus-order gen) 4)) (snd-display #__line__ ";average order: ~D?" (mus-order gen)))
(if (or (fneq (vct-ref v0 1) 0.5) (fneq (vct-ref v0 4) 1.0) (fneq (vct-ref v0 8) 1.0))
- (snd-display ";average output: ~A" v0)))
+ (snd-display #__line__ ";average output: ~A" v0)))
(let* ((gen (make-moving-average 8))
(val (moving-average gen)))
- (if (fneq val 0.0) (snd-display ";empty average: ~A" val))
+ (if (fneq val 0.0) (snd-display #__line__ ";empty average: ~A" val))
(set! val (moving-average gen 1.0))
- (if (fneq val 0.125) (snd-display ";average 1: ~A" val))
+ (if (fneq val 0.125) (snd-display #__line__ ";average 1: ~A" val))
(set! val (moving-average gen 1.0))
- (if (fneq val 0.25) (snd-display ";average 2: ~A" val))
+ (if (fneq val 0.25) (snd-display #__line__ ";average 2: ~A" val))
(set! val (moving-average gen 0.5))
- (if (fneq val 0.3125) (snd-display ";average 2: ~A" val))
+ (if (fneq val 0.3125) (snd-display #__line__ ";average 2: ~A" val))
(do ((i 0 (+ 1 i))) ((= i 5)) (set! val (moving-average gen 0.0)))
- (if (fneq val 0.3125) (snd-display ";average 6: ~A" val))
+ (if (fneq val 0.3125) (snd-display #__line__ ";average 6: ~A" val))
(set! val (moving-average gen 0.0))
- (if (fneq val 0.1875) (snd-display ";average 7: ~A" val))
+ (if (fneq val 0.1875) (snd-display #__line__ ";average 7: ~A" val))
(set! val (moving-average gen 0.0))
- (if (fneq val 0.0625) (snd-display ";average 8: ~A" val))
+ (if (fneq val 0.0625) (snd-display #__line__ ";average 8: ~A" val))
(set! val (moving-average gen 0.0))
- (if (fneq val 0.0) (snd-display ";average 9: ~A" val))
+ (if (fneq val 0.0) (snd-display #__line__ ";average 9: ~A" val))
)
(let* ((gen (make-moving-average 10 :initial-element .5))
(val (moving-average gen 0.5)))
- (if (fneq val 0.5) (snd-display ";average initial-element: ~A" val)))
+ (if (fneq val 0.5) (snd-display #__line__ ";average initial-element: ~A" val)))
(let* ((gen (make-moving-average 3 :initial-contents '(1.0 1.0 1.0)))
(val (moving-average gen 1.0)))
- (if (fneq val 1.0) (snd-display ";average initial-contents: ~A" val)))
+ (if (fneq val 1.0) (snd-display #__line__ ";average initial-contents: ~A" val)))
(test-gen-equal (let ((d1 (make-moving-average 3 :initial-contents '(0.7 0.5 3)))) (moving-average d1 1.0) d1)
(let ((d2 (make-moving-average 3 :initial-contents (vct 0.7 0.5 3)))) (moving-average d2 1.0) d2)
@@ -17906,7 +17982,7 @@ EDITS: 2
(make-moving-average 3 :initial-contents '(1.0 1.0 1.0)))
(let ((err (catch #t (lambda () (make-moving-average :size -1)) (lambda args args))))
(if (not (eq? (car err) 'out-of-range))
- (snd-display ";make-average bad size error message: ~A" err)))
+ (snd-display #__line__ ";make-average bad size error message: ~A" err)))
(let ((gen (make-comb .4 3))
(v0 (make-vct 10))
@@ -17919,13 +17995,13 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (comb gen 1.0)))
(vct-map! v1 (lambda () (if (comb? gen1) (comb gen1 1.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map comb: ~A ~A" v0 v1))
- (if (not (comb? gen)) (snd-display ";~A not comb?" gen))
- (if (not (= (mus-length gen) 3)) (snd-display ";comb length: ~D?" (mus-length gen)))
- (if (not (= (mus-order gen) 3)) (snd-display ";comb order: ~D?" (mus-order gen)))
- (if (fneq (mus-feedback gen) .4) (snd-display ";comb feedback: ~F?" (mus-feedback gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map comb: ~A ~A" v0 v1))
+ (if (not (comb? gen)) (snd-display #__line__ ";~A not comb?" gen))
+ (if (not (= (mus-length gen) 3)) (snd-display #__line__ ";comb length: ~D?" (mus-length gen)))
+ (if (not (= (mus-order gen) 3)) (snd-display #__line__ ";comb order: ~D?" (mus-order gen)))
+ (if (fneq (mus-feedback gen) .4) (snd-display #__line__ ";comb feedback: ~F?" (mus-feedback gen)))
(if (or (fneq (vct-ref v0 1) 0.0) (fneq (vct-ref v0 4) 1.0) (fneq (vct-ref v0 8) 1.4))
- (snd-display ";comb output: ~A" v0)))
+ (snd-display #__line__ ";comb output: ~A" v0)))
(test-gen-equal (let ((d1 (make-comb 0.7 3))) (comb d1 1.0) d1)
(let ((d2 (make-comb 0.7 3))) (comb d2 1.0) d2)
@@ -17939,7 +18015,7 @@ EDITS: 2
(test-gen-equal (make-comb 0.7 3 :initial-contents '(1.0 0.0 0.0))
(make-comb 0.7 3 :initial-contents '(1.0 0.0 0.0))
(make-comb 0.7 3 :initial-contents '(1.0 1.0 1.0)))
-
+
(let* ((del (make-comb 0.0 5 :max-size 8)))
(comb del 1.0)
(do ((i 0 (+ 1 i))) ((= i 4)) (comb del 0.0))
@@ -17948,14 +18024,14 @@ EDITS: 2
((= i 5))
(vct-set! v0 i (comb del 0.0 0.4)))
(if (not (vequal v0 (vct 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
- (snd-display ";zcomb: ~A" v0))
+ (snd-display #__line__ ";zcomb: ~A" v0))
(comb del 1.0)
(comb del 0.0 0.4)
(if (not (string=? (mus-describe del) "comb scaler: 0.000, line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000]"))
- (snd-display ";describe zcomb: ~A" (mus-describe del))))
+ (snd-display #__line__ ";describe zcomb: ~A" (mus-describe del))))
(set! (mus-feedback del) 1.0)
(if (fneq (mus-feedback del) 1.0)
- (snd-display ";comb feedback set: ~A" (mus-feedback del))))
+ (snd-display #__line__ ";comb feedback set: ~A" (mus-feedback del))))
(let ((gen (make-filtered-comb .4 5 :filter (make-one-zero .3 .7)))
@@ -17969,11 +18045,11 @@ EDITS: 2
(vct-set! v0 i (filtered-comb gen val))
(set! val 0.0)))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.120 0.280 0.000 0.000 0.000 0.014 0.067 0.078 0.000 0.000)))
- (snd-display ";filtered-comb: ~A" v0))
- (if (not (filtered-comb? gen)) (snd-display ";~A not filtered-comb?" gen))
- (if (not (= (mus-length gen) 5)) (snd-display ";filtered-comb length: ~D?" (mus-length gen)))
- (if (not (= (mus-order gen) 5)) (snd-display ";filtered-comb order: ~D?" (mus-order gen)))
- (if (fneq (mus-feedback gen) .4) (snd-display ";filtered-comb feedback: ~F?" (mus-feedback gen))))
+ (snd-display #__line__ ";filtered-comb: ~A" v0))
+ (if (not (filtered-comb? gen)) (snd-display #__line__ ";~A not filtered-comb?" gen))
+ (if (not (= (mus-length gen) 5)) (snd-display #__line__ ";filtered-comb length: ~D?" (mus-length gen)))
+ (if (not (= (mus-order gen) 5)) (snd-display #__line__ ";filtered-comb order: ~D?" (mus-order gen)))
+ (if (fneq (mus-feedback gen) .4) (snd-display #__line__ ";filtered-comb feedback: ~F?" (mus-feedback gen))))
(let ((gen (make-filtered-comb .9 5 :filter (make-one-zero .5 .5)))
(v0 (make-vct 20)))
@@ -17986,7 +18062,7 @@ EDITS: 2
(vct-set! v0 i (filtered-comb gen val))
(set! val 0.0)))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.450 0.450 0.000 0.000 0.000 0.202 0.405 0.202 0.000 0.000)))
- (snd-display ";filtered-comb .5 .5: ~A" v0)))
+ (snd-display #__line__ ";filtered-comb .5 .5: ~A" v0)))
(let ((gen (make-filtered-comb .9 5 :filter (make-fir-filter 5 (vct .1 .2 .3 .2 .1))))
(v0 (make-vct 20)))
@@ -17999,7 +18075,7 @@ EDITS: 2
(vct-set! v0 i (filtered-comb gen val))
(set! val 0.0)))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.090 0.180 0.270 0.180 0.090 0.008 0.032 0.081 0.130 0.154)))
- (snd-display ";filtered-comb fir: ~A" v0)))
+ (snd-display #__line__ ";filtered-comb fir: ~A" v0)))
(test-gen-equal (let ((d1 (make-filtered-comb 0.7 3 :filter (make-one-pole .3 .7)))) (filtered-comb d1 1.0) d1)
(let ((d2 (make-filtered-comb 0.7 3 :filter (make-one-pole .3 .7)))) (filtered-comb d2 1.0) d2)
@@ -18022,15 +18098,15 @@ EDITS: 2
((= i 5))
(vct-set! v0 i (filtered-comb del 0.0 0.4)))
(if (not (vequal v0 (vct 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
- (snd-display ";zfiltered-comb: ~A" v0))
+ (snd-display #__line__ ";zfiltered-comb: ~A" v0))
(filtered-comb del 1.0)
(filtered-comb del 0.0 0.4)
(if (not (string=? (mus-describe del)
- "filtered-comb scaler: 0.000, line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]"))
- (snd-display ";describe zfiltered-comb: ~A" (mus-describe del))))
+ "filtered-comb scaler: 0.000, line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]"))
+ (snd-display #__line__ ";describe zfiltered-comb: ~A" (mus-describe del))))
(set! (mus-feedback del) 1.0)
(if (fneq (mus-feedback del) 1.0)
- (snd-display ";filtered-comb feedback set: ~A" (mus-feedback del))))
+ (snd-display #__line__ ";filtered-comb feedback set: ~A" (mus-feedback del))))
(let ((gen (make-notch .4 3))
@@ -18044,16 +18120,16 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (notch gen 1.0)))
(vct-map! v1 (lambda () (if (notch? gen1) (notch gen1 1.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map notch: ~A ~A" v0 v1))
- (if (not (notch? gen)) (snd-display ";~A not notch?" gen))
- (if (not (= (mus-length gen) 3)) (snd-display ";notch length: ~D?" (mus-length gen)))
- (if (not (= (mus-order gen) 3)) (snd-display ";notch order: ~D?" (mus-order gen)))
- (if (fneq (mus-feedforward gen) .4) (snd-display ";notch feedforward: ~F?" (mus-feedforward gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map notch: ~A ~A" v0 v1))
+ (if (not (notch? gen)) (snd-display #__line__ ";~A not notch?" gen))
+ (if (not (= (mus-length gen) 3)) (snd-display #__line__ ";notch length: ~D?" (mus-length gen)))
+ (if (not (= (mus-order gen) 3)) (snd-display #__line__ ";notch order: ~D?" (mus-order gen)))
+ (if (fneq (mus-feedforward gen) .4) (snd-display #__line__ ";notch feedforward: ~F?" (mus-feedforward gen)))
(if (or (fneq (vct-ref v0 1) 0.4) (fneq (vct-ref v0 4) 1.4) (fneq (vct-ref v0 8) 1.4))
- (snd-display ";notch output: ~A" v0))
+ (snd-display #__line__ ";notch output: ~A" v0))
(set! (mus-feedforward gen) 1.0)
(if (fneq (mus-feedforward gen) 1.0)
- (snd-display ";notch feedforward set: ~A" (mus-feedforward gen))))
+ (snd-display #__line__ ";notch feedforward set: ~A" (mus-feedforward gen))))
(test-gen-equal (let ((d1 (make-notch 0.7 3))) (notch d1 1.0) d1)
(let ((d2 (make-notch 0.7 3))) (notch d2 1.0) d2)
@@ -18078,7 +18154,7 @@ EDITS: 2
(vct-set! v0 i (comb gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display ";comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5))
(v0 (make-vct 11))
@@ -18088,7 +18164,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display ";all-pass (5 0 .5): ~A" v0)))
+ (snd-display #__line__ ";all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5))
(v0 (make-vct 11))
@@ -18098,7 +18174,7 @@ EDITS: 2
(vct-set! v0 i (notch gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";notch (5 .5): ~A" v0)))
+ (snd-display #__line__ ";notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5))
(v0 (make-vct 11))
@@ -18108,7 +18184,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";all-pass (5 .5 0): ~A" v0)))
+ (snd-display #__line__ ";all-pass (5 .5 0): ~A" v0)))
;; make sure zall-pass is the same as zcomb/znotch given the appropriate feedback/forward and "pm" settings
@@ -18120,7 +18196,7 @@ EDITS: 2
(vct-set! v0 i (comb gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display ";1comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";1comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
(v0 (make-vct 11))
@@ -18130,7 +18206,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display ";1all-pass (5 0 .5): ~A" v0)))
+ (snd-display #__line__ ";1all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
(v0 (make-vct 11))
@@ -18140,7 +18216,7 @@ EDITS: 2
(vct-set! v0 i (notch gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";1notch (5 .5): ~A" v0)))
+ (snd-display #__line__ ";1notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
(v0 (make-vct 11))
@@ -18150,7 +18226,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";1all-pass (5 .5 0): ~A" v0)))
+ (snd-display #__line__ ";1all-pass (5 .5 0): ~A" v0)))
;; now actually use the size difference
@@ -18163,7 +18239,7 @@ EDITS: 2
(vct-set! v0 i (comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
- (snd-display ";2comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";2comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
(v0 (make-vct 20))
@@ -18174,7 +18250,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
- (snd-display ";2all-pass (5 0 .5): ~A" v0)))
+ (snd-display #__line__ ";2all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18185,7 +18261,7 @@ EDITS: 2
(vct-set! v0 i (notch gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";2notch (5 .5): ~A" v0)))
+ (snd-display #__line__ ";2notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18196,7 +18272,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";2all-pass (5 .5 0): ~A" v0)))
+ (snd-display #__line__ ";2all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-comb 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18207,7 +18283,7 @@ EDITS: 2
(vct-set! v0 i (comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
- (snd-display ";3comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";3comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
(v0 (make-vct 20))
@@ -18218,7 +18294,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
- (snd-display ";3all-pass (5 0 .5): ~A" v0)))
+ (snd-display #__line__ ";3all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18229,7 +18305,7 @@ EDITS: 2
(vct-set! v0 i (notch gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";3notch (5 .5): ~A" v0)))
+ (snd-display #__line__ ";3notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18240,7 +18316,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";3all-pass (5 .5 0): ~A" v0)))
+ (snd-display #__line__ ";3all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-comb 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18251,7 +18327,7 @@ EDITS: 2
(vct-set! v0 i (comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
- (snd-display ";4comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";4comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
(v0 (make-vct 20))
@@ -18262,7 +18338,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
- (snd-display ";4all-pass (5 0 .5): ~A" v0)))
+ (snd-display #__line__ ";4all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18273,7 +18349,7 @@ EDITS: 2
(vct-set! v0 i (notch gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";4notch (5 .5): ~A" v0)))
+ (snd-display #__line__ ";4notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
(v0 (make-vct 20))
@@ -18284,7 +18360,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";4all-pass (5 .5 0): ~A" v0)))
+ (snd-display #__line__ ";4all-pass (5 .5 0): ~A" v0)))
;; now run off either end of the delay line "by accident"
@@ -18297,7 +18373,7 @@ EDITS: 2
(vct-set! v0 i (comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
- (snd-display ";5comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";5comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
(v0 (make-vct 20))
@@ -18308,7 +18384,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
- (snd-display ";5all-pass (5 0 .5): ~A" v0)))
+ (snd-display #__line__ ";5all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 10))
(v0 (make-vct 20))
@@ -18319,7 +18395,7 @@ EDITS: 2
(vct-set! v0 i (notch gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";5notch (5 .5): ~A" v0)))
+ (snd-display #__line__ ";5notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
(v0 (make-vct 20))
@@ -18330,7 +18406,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";5all-pass (5 .5 0): ~A" v0)))
+ (snd-display #__line__ ";5all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-comb 0.5 5 :max-size 10))
@@ -18342,7 +18418,7 @@ EDITS: 2
(vct-set! v0 i (comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
- (snd-display ";6comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";6comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
(v0 (make-vct 20))
@@ -18353,7 +18429,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
- (snd-display ";6all-pass (5 0 .5): ~A" v0)))
+ (snd-display #__line__ ";6all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 10))
(v0 (make-vct 20))
@@ -18364,7 +18440,7 @@ EDITS: 2
(vct-set! v0 i (notch gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";6notch (5 .5): ~A" v0)))
+ (snd-display #__line__ ";6notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
(v0 (make-vct 20))
@@ -18375,7 +18451,7 @@ EDITS: 2
(vct-set! v0 i (all-pass gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";6all-pass (5 .5 0): ~A" v0)))
+ (snd-display #__line__ ";6all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .5 .5)))
(v0 (make-vct 21))
@@ -18386,7 +18462,7 @@ EDITS: 2
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.250 0.250
0.000 0.000 0.000 0.062 0.125 0.062 0.000 0.000 0.016)))
- (snd-display ";filtered-comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .25 .75)))
(v0 (make-vct 21))
@@ -18397,7 +18473,7 @@ EDITS: 2
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
- (snd-display ";1filtered-comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";1filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
(v0 (make-vct 20))
@@ -18408,7 +18484,7 @@ EDITS: 2
(vct-set! v0 i (filtered-comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.080 0.220 0.300 0.140 0.040 0.000 0.000)))
- (snd-display ";2filtered-comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";2filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
(v0 (make-vct 20))
@@ -18419,7 +18495,7 @@ EDITS: 2
(vct-set! v0 i (filtered-comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.080 0.200 0.040 0.020 0.068 0.042 0.019 0.026 0.015 0.011 0.009 0.006 0.004)))
- (snd-display ";3filtered-comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";3filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
(v0 (make-vct 20))
@@ -18430,7 +18506,7 @@ EDITS: 2
(vct-set! v0 i (filtered-comb gen in1 angle))
(set! in1 0.0))
(if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.214 0.251 0.043 0.002 0.000 0.045 0.106 0.081 0.023 0.003)))
- (snd-display ";4filtered-comb (5 .5): ~A" v0)))
+ (snd-display #__line__ ";4filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-one-pole .4 .7))
@@ -18444,19 +18520,19 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (one-pole gen 1.0)))
(vct-map! v1 (lambda () (if (one-pole? gen) (one-pole gen1 1.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map one-pole: ~A ~A" v0 v1))
- (if (not (one-pole? gen)) (snd-display ";~A not one-pole?" gen))
- (if (not (= (mus-order gen) 1)) (snd-display ";one-pole order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display ";one-pole a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) .7) (snd-display ";one-pole b1: ~F?" (mus-b1 gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map one-pole: ~A ~A" v0 v1))
+ (if (not (one-pole? gen)) (snd-display #__line__ ";~A not one-pole?" gen))
+ (if (not (= (mus-order gen) 1)) (snd-display #__line__ ";one-pole order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";one-pole a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-b1 gen) .7) (snd-display #__line__ ";one-pole b1: ~F?" (mus-b1 gen)))
(if (or (fneq (vct-ref v0 1) 0.120) (fneq (vct-ref v0 4) 0.275) (fneq (vct-ref v0 8) 0.245))
- (snd-display ";one-pole output: ~A" v0))
- (if (fneq (mus-ycoeff gen 1) .7) (snd-display ";1p ycoeff 1 .7: ~A" gen))
+ (snd-display #__line__ ";one-pole output: ~A" v0))
+ (if (fneq (mus-ycoeff gen 1) .7) (snd-display #__line__ ";1p ycoeff 1 .7: ~A" gen))
(set! (mus-ycoeff gen 1) .1)
- (if (fneq (mus-ycoeff gen 1) .1) (snd-display ";1p set ycoeff 1 .1: ~A" gen))
- (if (fneq (mus-xcoeff gen 0) .4) (snd-display ";1p xcoeff 0 .4: ~A" gen))
+ (if (fneq (mus-ycoeff gen 1) .1) (snd-display #__line__ ";1p set ycoeff 1 .1: ~A" gen))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";1p xcoeff 0 .4: ~A" gen))
(set! (mus-xcoeff gen 0) .3)
- (if (fneq (mus-xcoeff gen 0) .3) (snd-display ";1p set xcoeff 0 .3: ~A" gen)))
+ (if (fneq (mus-xcoeff gen 0) .3) (snd-display #__line__ ";1p set xcoeff 0 .3: ~A" gen)))
(let ((gen (make-one-zero .4 .7))
@@ -18470,15 +18546,15 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (one-zero gen 1.0)))
(vct-map! v1 (lambda () (if (one-zero? gen) (one-zero gen1 1.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map one-zero: ~A ~A" v0 v1))
- (if (not (one-zero? gen)) (snd-display ";~A not one-zero?" gen))
- (if (not (= (mus-order gen) 1)) (snd-display ";one-zero order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display ";one-zero a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) .7) (snd-display ";one-zero a1: ~F?" (mus-a1 gen)))
- (if (fneq (vct-ref v0 1) 1.1) (snd-display ";one-zero output: ~A" v0))
- (if (fneq (mus-xcoeff gen 0) .4) (snd-display ";1z xcoeff 0 .4: ~A" gen))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map one-zero: ~A ~A" v0 v1))
+ (if (not (one-zero? gen)) (snd-display #__line__ ";~A not one-zero?" gen))
+ (if (not (= (mus-order gen) 1)) (snd-display #__line__ ";one-zero order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";one-zero a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-a1 gen) .7) (snd-display #__line__ ";one-zero a1: ~F?" (mus-a1 gen)))
+ (if (fneq (vct-ref v0 1) 1.1) (snd-display #__line__ ";one-zero output: ~A" v0))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";1z xcoeff 0 .4: ~A" gen))
(set! (mus-xcoeff gen 0) .1)
- (if (fneq (mus-xcoeff gen 0) .1) (snd-display ";1z set xcoeff 0 .1: ~A" gen)))
+ (if (fneq (mus-xcoeff gen 0) .1) (snd-display #__line__ ";1z set xcoeff 0 .1: ~A" gen)))
(let ((gen (make-two-zero .4 .7 .3))
(v0 (make-vct 10))
@@ -18491,37 +18567,37 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (two-zero gen 1.0)))
(vct-map! v1 (lambda () (if (two-zero? gen1) (two-zero gen1 1.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map two-zero: ~A ~A" v0 v1))
- (if (not (two-zero? gen)) (snd-display ";~A not two-zero?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";two-zero order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display ";two-zero a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) .7) (snd-display ";two-zero a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .3) (snd-display ";two-zero a2: ~F?" (mus-a2 gen)))
- (if (or (fneq (vct-ref v0 1) 1.1) (fneq (vct-ref v0 8) 1.4)) (snd-display ";two-zero output: ~A" v0))
- (if (fneq (mus-xcoeff gen 0) .4) (snd-display ";2z xcoeff 0 .4: ~A" gen))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map two-zero: ~A ~A" v0 v1))
+ (if (not (two-zero? gen)) (snd-display #__line__ ";~A not two-zero?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";two-zero order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";two-zero a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-a1 gen) .7) (snd-display #__line__ ";two-zero a1: ~F?" (mus-a1 gen)))
+ (if (fneq (mus-a2 gen) .3) (snd-display #__line__ ";two-zero a2: ~F?" (mus-a2 gen)))
+ (if (or (fneq (vct-ref v0 1) 1.1) (fneq (vct-ref v0 8) 1.4)) (snd-display #__line__ ";two-zero output: ~A" v0))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";2z xcoeff 0 .4: ~A" gen))
(set! (mus-xcoeff gen 0) .1)
- (if (fneq (mus-xcoeff gen 0) .1) (snd-display ";2z set xcoeff 0 .1: ~A" gen))
+ (if (fneq (mus-xcoeff gen 0) .1) (snd-display #__line__ ";2z set xcoeff 0 .1: ~A" gen))
(set! (mus-xcoeff gen 0) 1.0)
(let ((r (mus-scaler gen)))
(set! (mus-frequency gen) 500.0)
- (if (ffneq (mus-frequency gen) 500.0) (snd-display ";set mus-frequency two-zero: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) r) (snd-display ";set mus-frequency two-zero hit r: ~A" (mus-scaler gen)))
+ (if (ffneq (mus-frequency gen) 500.0) (snd-display #__line__ ";set mus-frequency two-zero: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) r) (snd-display #__line__ ";set mus-frequency two-zero hit r: ~A" (mus-scaler gen)))
(set! (mus-scaler gen) .99)
- (if (fneq (mus-scaler gen) .99) (snd-display ";set mus-scaler two-zero: ~A" (mus-scaler gen)))
- (if (ffneq (mus-frequency gen) 500.0) (snd-display ";set mus-scaler hit freq two-zero: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) .99) (snd-display #__line__ ";set mus-scaler two-zero: ~A" (mus-scaler gen)))
+ (if (ffneq (mus-frequency gen) 500.0) (snd-display #__line__ ";set mus-scaler hit freq two-zero: ~A" (mus-frequency gen)))
(let ((g3 (make-two-zero :radius .99 :frequency 500.0)))
(if (or (fneq (mus-a0 gen) (mus-a0 g3))
(fneq (mus-a1 gen) (mus-a1 g3))
(fneq (mus-a2 gen) (mus-a2 g3)))
- (snd-display ";two-zero setters: ~A ~A" gen g3)))))
+ (snd-display #__line__ ";two-zero setters: ~A ~A" gen g3)))))
(let ((gen (make-two-zero .4 .7 .3)))
(let ((val (gen 1.0)))
- (if (fneq val .4) (snd-display ";2zero->0.4: ~A" val))
+ (if (fneq val .4) (snd-display #__line__ ";2zero->0.4: ~A" val))
(set! val (gen 0.5))
- (if (fneq val .9) (snd-display ";2zero->0.9: ~A" val))
+ (if (fneq val .9) (snd-display #__line__ ";2zero->0.9: ~A" val))
(set! val (gen 1.0))
- (if (fneq val 1.05) (snd-display ";2zero->1.05: ~A" val))))
+ (if (fneq val 1.05) (snd-display #__line__ ";2zero->1.05: ~A" val))))
(let ((gen (make-two-pole .4 .7 .3))
(v0 (make-vct 10))
@@ -18534,53 +18610,53 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (two-pole gen 1.0)))
(vct-map! v1 (lambda () (if (two-pole? gen1) (two-pole gen1 1.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map two-pole: ~A ~A" v0 v1))
- (if (not (two-pole? gen)) (snd-display ";~A not two-pole?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";two-pole order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display ";two-pole a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) .7) (snd-display ";two-pole b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .3) (snd-display ";two-pole b2: ~F?" (mus-b2 gen)))
- (if (or (fneq (vct-ref v0 1) 0.12) (fneq (vct-ref v0 8) 0.201)) (snd-display ";two-pole output: ~A" v0))
- (if (fneq (mus-ycoeff gen 1) .7) (snd-display ";2p ycoeff 1 .7: ~A" gen))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map two-pole: ~A ~A" v0 v1))
+ (if (not (two-pole? gen)) (snd-display #__line__ ";~A not two-pole?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";two-pole order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";two-pole a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-b1 gen) .7) (snd-display #__line__ ";two-pole b1: ~F?" (mus-b1 gen)))
+ (if (fneq (mus-b2 gen) .3) (snd-display #__line__ ";two-pole b2: ~F?" (mus-b2 gen)))
+ (if (or (fneq (vct-ref v0 1) 0.12) (fneq (vct-ref v0 8) 0.201)) (snd-display #__line__ ";two-pole output: ~A" v0))
+ (if (fneq (mus-ycoeff gen 1) .7) (snd-display #__line__ ";2p ycoeff 1 .7: ~A" gen))
(set! (mus-ycoeff gen 1) .1)
- (if (fneq (mus-ycoeff gen 1) .1) (snd-display ";2p set ycoeff 1 .1: ~A" gen))
- (if (fneq (mus-xcoeff gen 0) .4) (snd-display ";2p xcoeff 0 .4: ~A" gen))
+ (if (fneq (mus-ycoeff gen 1) .1) (snd-display #__line__ ";2p set ycoeff 1 .1: ~A" gen))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";2p xcoeff 0 .4: ~A" gen))
(set! (mus-xcoeff gen 0) .3)
- (if (fneq (mus-xcoeff gen 0) .3) (snd-display ";2p set xcoeff 0 .3: ~A" gen))
+ (if (fneq (mus-xcoeff gen 0) .3) (snd-display #__line__ ";2p set xcoeff 0 .3: ~A" gen))
(set! (mus-xcoeff gen 0) 1.0)
(let ((r (mus-scaler gen)))
(set! (mus-frequency gen) 500.0)
- (if (ffneq (mus-frequency gen) 500.0) (snd-display ";set mus-frequency two-pole: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) r) (snd-display ";set mus-frequency two-pole hit r: ~A" (mus-scaler gen)))
+ (if (ffneq (mus-frequency gen) 500.0) (snd-display #__line__ ";set mus-frequency two-pole: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) r) (snd-display #__line__ ";set mus-frequency two-pole hit r: ~A" (mus-scaler gen)))
(set! (mus-scaler gen) .99)
- (if (fneq (mus-scaler gen) .99) (snd-display ";set mus-scaler two-pole: ~A" (mus-scaler gen)))
- (if (ffneq (mus-frequency gen) 500.0) (snd-display ";set mus-scaler hit freq two-pole: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) .99) (snd-display #__line__ ";set mus-scaler two-pole: ~A" (mus-scaler gen)))
+ (if (ffneq (mus-frequency gen) 500.0) (snd-display #__line__ ";set mus-scaler hit freq two-pole: ~A" (mus-frequency gen)))
(let ((g3 (make-two-pole :radius .99 :frequency 500.0)))
(if (or (fneq (mus-a0 gen) (mus-a0 g3))
(fneq (mus-b1 gen) (mus-b1 g3))
(fneq (mus-b2 gen) (mus-b2 g3)))
- (snd-display ";two-pole setters: ~A ~A" gen g3)))))
+ (snd-display #__line__ ";two-pole setters: ~A ~A" gen g3)))))
(let ((gen (make-two-pole .4 .7 .3)))
(let ((val (gen 1.0)))
- (if (fneq val .4) (snd-display ";a0->out 2pole: ~A" val))
+ (if (fneq val .4) (snd-display #__line__ ";a0->out 2pole: ~A" val))
(set! val (gen 0.5))
- (if (fneq val -.08) (snd-display ";a0->out 2pole (-0.08): ~A" val))
+ (if (fneq val -.08) (snd-display #__line__ ";a0->out 2pole (-0.08): ~A" val))
(set! val (gen 1.0))
- (if (fneq val 0.336) (snd-display ";a0->out 2pole (0.336): ~A" val))))
+ (if (fneq val 0.336) (snd-display #__line__ ";a0->out 2pole (0.336): ~A" val))))
(let ((var (catch #t (lambda () (make-two-pole :b1 3.0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-two-pole bad b1: ~A" var)))
+ (snd-display #__line__ ";make-two-pole bad b1: ~A" var)))
(let ((var (catch #t (lambda () (make-two-pole :b2 2.0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-two-pole bad b2: ~A" var)))
+ (snd-display #__line__ ";make-two-pole bad b2: ~A" var)))
(let ((var (catch #t (lambda () (make-two-pole :b2 2.0 :b1)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-two-pole bad keys: ~A" var)))
+ (snd-display #__line__ ";make-two-pole bad keys: ~A" var)))
(let ((var (catch #t (lambda () (make-two-pole :b2 2.0 3.0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-two-pole bad args: ~A" var)))
+ (snd-display #__line__ ";make-two-pole bad args: ~A" var)))
(let ((gen (make-oscil 440.0))
(gen1 (make-oscil 440.0))
@@ -18596,22 +18672,22 @@ EDITS: 2
(vct-set! v0 i (oscil gen 0.0))
(vct-set! v1 i (mus-apply gen1 0.0 0.0)))
(vct-map! v2 (lambda () (if (oscil? gen2) (oscil gen2 0.0) -1.0)))
- (if (not (vequal v0 v2)) (snd-display ";map oscil: ~A ~A" v0 v2))
- (if (not (oscil? gen)) (snd-display ";~A not oscil?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";oscil phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";oscil frequency: ~F?" (mus-frequency gen)))
- (if (not (= (mus-length gen) 1)) (snd-display ";oscil cosines: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 8) 0.843)) (snd-display ";oscil output: ~A" v0))
+ (if (not (vequal v0 v2)) (snd-display #__line__ ";map oscil: ~A ~A" v0 v2))
+ (if (not (oscil? gen)) (snd-display #__line__ ";~A not oscil?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";oscil phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";oscil frequency: ~F?" (mus-frequency gen)))
+ (if (not (= (mus-length gen) 1)) (snd-display #__line__ ";oscil cosines: ~D?" (mus-length gen)))
+ (if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 8) 0.843)) (snd-display #__line__ ";oscil output: ~A" v0))
(set! (mus-phase gen) 0.0)
- (if (fneq (mus-phase gen) 0.0) (snd-display ";oscil set-phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-phase gen) 0.0) (snd-display #__line__ ";oscil set-phase: ~F?" (mus-phase gen)))
(set! (mus-frequency gen) 100.0)
- (if (fneq (mus-frequency gen) 100.0) (snd-display ";oscil set-frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";oscil set-frequency: ~F?" (mus-frequency gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display ";mus-apply oscil at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i))))
+ (snd-display #__line__ ";mus-apply oscil at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i))))
(if (fneq (mus-apply) 0.0)
- (snd-display ";(mus-apply): ~A" (mus-apply))))
+ (snd-display #__line__ ";(mus-apply): ~A" (mus-apply))))
(let ((gen1 (make-oscil 100.0))
(gen2 (make-oscil -100.0))
@@ -18620,7 +18696,7 @@ EDITS: 2
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
- (snd-display ";oscil +-: ~A" mx)))
+ (snd-display #__line__ ";oscil +-: ~A" mx)))
(let ((gen1 (make-oscil 100.0 (* pi 0.5)))
(gen2 (make-oscil -100.0 (* pi 0.5)))
@@ -18629,7 +18705,7 @@ EDITS: 2
((= i 100))
(set! mx (max mx (abs (- (gen1) (gen2))))))
(if (fneq mx 0.0)
- (snd-display ";cosil +-: ~A" mx)))
+ (snd-display #__line__ ";cosil +-: ~A" mx)))
(fm-test (make-oscil))
(fm-test (make-nrxysin))
@@ -18650,7 +18726,7 @@ EDITS: 2
(let ((oval (oscil gen .1))
(mval (mus-run gen1 .1)))
(if (fneq oval mval)
- (snd-display ";mus-run ~A but oscil ~A?" mval oval)))))
+ (snd-display #__line__ ";mus-run ~A but oscil ~A?" mval oval)))))
(let ((gen (make-oscil 440.0))
(gen1 (make-oscil 440.0))
@@ -18664,11 +18740,11 @@ EDITS: 2
(vct-set! v0 i (oscil gen (* fm-index (oscil gen1 0.0))))
(vct-set! v1 i (mus-apply gen2 (* fm-index (mus-apply gen3 0.0 0.0)) 0.0)))
(if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 6) 0.830) (fneq (vct-ref v0 8) 0.987))
- (snd-display ";oscil fm output: ~A" v0))
+ (snd-display #__line__ ";oscil fm output: ~A" v0))
(do ((i 0 (+ 1 i)))
((= i 10))
(if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display ";mus-apply fm oscil at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i)))))
+ (snd-display #__line__ ";mus-apply fm oscil at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i)))))
(test-gen-equal (make-oscil 440.0) (make-oscil 440.0) (make-oscil 100.0))
(test-gen-equal (make-oscil 440.0) (make-oscil 440.0) (make-oscil 440.0 1.0))
@@ -18681,7 +18757,7 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (gen 0.0 (* pm-index (gen1 0.0)))))
(if (or (fneq (vct-ref v0 1) 0.367) (fneq (vct-ref v0 6) 0.854) (fneq (vct-ref v0 8) 0.437))
- (snd-display ";oscil pm output: ~A" v0)))
+ (snd-display #__line__ ";oscil pm output: ~A" v0)))
(let ((gen (make-oscil 440.0)))
(do ((i 0 (+ 1 i)))
@@ -18689,7 +18765,7 @@ EDITS: 2
(let* ((val1 (sin (mus-phase gen)))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display ";oscil: ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";oscil: ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-oscil 440.0 :initial-phase (* pi 0.5))))
(do ((i 0 (+ 1 i))
@@ -18698,7 +18774,7 @@ EDITS: 2
(let* ((val1 (cos a))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display ";oscil (cos): ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";oscil (cos): ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-oscil 0.0))
(gen1 (make-oscil 40.0)))
@@ -18708,7 +18784,7 @@ EDITS: 2
(let* ((val1 (sin (sin a)))
(val2 (oscil gen 0.0 (oscil gen1 0.0))))
(if (fneq val1 val2)
- (snd-display ";oscil pm: ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";oscil pm: ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-oscil 0.0))
(gen1 (make-oscil 40.0))
@@ -18721,29 +18797,29 @@ EDITS: 2
(val2 (oscil gen (oscil gen1 0.0))))
(set! a1 (+ a1 fm))
(if (fneq val1 val2)
- (snd-display ";oscil fm: ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";oscil fm: ~A: ~A ~A" i val1 val2)))))
(let ((var (catch #t (lambda () (mus-location (make-oscil))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";mus-location bad gen: ~A" var)))
+ (snd-display #__line__ ";mus-location bad gen: ~A" var)))
(let ((var (catch #t (lambda () (set! (mus-location (make-oscil)) 0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";set mus-location bad gen: ~A" var)))
+ (snd-display #__line__ ";set mus-location bad gen: ~A" var)))
(let ((var (catch #t (lambda () (set! (mus-scaler (make-oscil)) 0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";set mus-scaler bad gen: ~A" var)))
+ (snd-display #__line__ ";set mus-scaler bad gen: ~A" var)))
(let ((var (catch #t (lambda () (mus-frequency (make-one-pole))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";mus-frequency bad gen: ~A" var)))
+ (snd-display #__line__ ";mus-frequency bad gen: ~A" var)))
(let ((var (catch #t (lambda () (set! (mus-frequency (make-one-pole)) 0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";set mus-frequency bad gen: ~A" var)))
+ (snd-display #__line__ ";set mus-frequency bad gen: ~A" var)))
(let ((var (catch #t (lambda () (make-delay (* 1024 1024 40))) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-delay huge line: ~A" var)))
+ (snd-display #__line__ ";make-delay huge line: ~A" var)))
(let ((var (catch #t (lambda () (make-delay 32 :max-size (* 1024 1024 40))) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-delay huge line: ~A" var)))
+ (snd-display #__line__ ";make-delay huge line: ~A" var)))
(let ((amps (make-vector 3))
(oscils (make-vector 3))
@@ -18758,7 +18834,7 @@ EDITS: 2
(if (or (fneq (vector-ref results 1) 0.12639)
(fneq (vector-ref results 5) 0.48203)
(fneq (vector-ref results 9) 0.41001))
- (snd-display ";oscil-bank: ~A?" results)))
+ (snd-display #__line__ ";oscil-bank: ~A?" results)))
(let ((size 1000))
@@ -18782,7 +18858,7 @@ EDITS: 2
(let ((v1 (with-sound (:output (make-vct size) :srate 441000) (test-pm 0 size 20 1 1 1)))
(v2 (with-sound (:output (make-vct size) :srate 441000) (test-fm 0 size 20 1 1 1))))
(if (not (vequal v1 v2))
- (snd-display ";fm/pm peak diff (1 1): ~A" (vct-peak (vct-subtract! v1 v2)))))
+ (snd-display #__line__ ";fm/pm peak diff (1 1): ~A" (vct-peak (vct-subtract! v1 v2)))))
(do ((i 0 (+ 1 i)))
((= i 10))
@@ -18791,8 +18867,8 @@ EDITS: 2
(let ((v1 (with-sound (:output (make-vct size) :srate 441000) (test-pm 0 size 20 1 ratio index)))
(v2 (with-sound (:output (make-vct size) :srate 441000) (test-fm 0 size 20 1 ratio index))))
(if (not (vequal v1 v2))
- (snd-display ";fm/pm peak diff ~A ~A: ~A" ratio index (vct-peak (vct-subtract! v1 v2))))))))
-
+ (snd-display #__line__ ";fm/pm peak diff ~A ~A: ~A" ratio index (vct-peak (vct-subtract! v1 v2))))))))
+
(let ((gen (make-ncos 440.0 10))
(v0 (make-vct 10))
(gen1 (make-ncos 440.0 10))
@@ -18804,17 +18880,17 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (ncos gen 0.0)))
(vct-map! v1 (lambda () (if (ncos? gen1) (ncos gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map ncos: ~A ~A" v0 v1))
- (if (not (ncos? gen)) (snd-display ";~A not ncos?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";ncos phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";ncos frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) .1) (snd-display ";ncos scaler: ~F?" (mus-scaler gen)))
- (if (not (= (mus-length gen) 10)) (snd-display ";ncos n: ~D?" (mus-length gen)))
- (if (not (= (mus-length gen) 10)) (snd-display ";ncos length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.722) (fneq (vct-ref v0 8) -0.143)) (snd-display ";ncos output: ~A" v0))
- (set! (mus-scaler gen) .5) (if (fneq (mus-scaler gen) 0.5) (snd-display ";ncos set-scaler: ~F?" (mus-scaler gen)))
- (set! (mus-length gen) 5) (if (not (= (mus-length gen) 5)) (snd-display ";set ncos n: ~D?" (mus-length gen)))
- (if (fneq (mus-scaler gen) .2) (snd-display ";set n->scaler: ~A" (mus-scaler gen))))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map ncos: ~A ~A" v0 v1))
+ (if (not (ncos? gen)) (snd-display #__line__ ";~A not ncos?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";ncos phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";ncos frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) .1) (snd-display #__line__ ";ncos scaler: ~F?" (mus-scaler gen)))
+ (if (not (= (mus-length gen) 10)) (snd-display #__line__ ";ncos n: ~D?" (mus-length gen)))
+ (if (not (= (mus-length gen) 10)) (snd-display #__line__ ";ncos length: ~D?" (mus-length gen)))
+ (if (or (fneq (vct-ref v0 1) 0.722) (fneq (vct-ref v0 8) -0.143)) (snd-display #__line__ ";ncos output: ~A" v0))
+ (set! (mus-scaler gen) .5) (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";ncos set-scaler: ~F?" (mus-scaler gen)))
+ (set! (mus-length gen) 5) (if (not (= (mus-length gen) 5)) (snd-display #__line__ ";set ncos n: ~D?" (mus-length gen)))
+ (if (fneq (mus-scaler gen) .2) (snd-display #__line__ ";set n->scaler: ~A" (mus-scaler gen))))
(test-gen-equal (make-ncos 440.0 3) (make-ncos 440.0 3) (make-ncos 440.0 5))
(test-gen-equal (make-ncos 440.0 3) (make-ncos 440.0 3) (make-ncos 400.0 3))
@@ -18832,7 +18908,7 @@ EDITS: 2
0.5)))))
(val2 (gen 0.0)))
(if (> (abs (- val1 val2)) .002)
- (snd-display ";ncos: ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";ncos: ~A: ~A ~A" i val1 val2)))))
(let ((gen1 (make-ncos 100.0 10))
(gen2 (make-ncos -100.0 10))
@@ -18841,8 +18917,8 @@ EDITS: 2
((= i 100))
(set! mx (max mx (abs (- (gen1) (gen2))))))
(if (fneq mx 0.0)
- (snd-display ";ncos +-: ~A" mx)))
-
+ (snd-display #__line__ ";ncos +-: ~A" mx)))
+
(let ((gen (make-nsin 440.0 10))
(v0 (make-vct 10))
(gen1 (make-nsin 440.0 10))
@@ -18854,17 +18930,17 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (nsin gen 0.0)))
(vct-map! v1 (lambda () (if (nsin? gen1) (nsin gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map nsin: ~A ~A" v0 v1))
- (if (not (nsin? gen)) (snd-display ";~A not nsin?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";nsin phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";nsin frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) .1315) (snd-display ";nsin scaler: ~F?" (mus-scaler gen)))
- (if (not (= (mus-length gen) 10)) (snd-display ";nsin n: ~D?" (mus-length gen)))
- (if (not (= (mus-length gen) 10)) (snd-display ";nsin length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.784) (fneq (vct-ref v0 8) 0.181)) (snd-display ";nsin output: ~A" v0))
- (set! (mus-scaler gen) .5) (if (fneq (mus-scaler gen) 0.5) (snd-display ";nsin set-scaler: ~F?" (mus-scaler gen)))
- (set! (mus-length gen) 5) (if (not (= (mus-length gen) 5)) (snd-display ";set nsin n: ~D?" (mus-length gen)))
- (if (fneq (mus-scaler gen) .2525) (snd-display ";set sines->scaler: ~A" (mus-scaler gen))))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map nsin: ~A ~A" v0 v1))
+ (if (not (nsin? gen)) (snd-display #__line__ ";~A not nsin?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";nsin phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";nsin frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) .1315) (snd-display #__line__ ";nsin scaler: ~F?" (mus-scaler gen)))
+ (if (not (= (mus-length gen) 10)) (snd-display #__line__ ";nsin n: ~D?" (mus-length gen)))
+ (if (not (= (mus-length gen) 10)) (snd-display #__line__ ";nsin length: ~D?" (mus-length gen)))
+ (if (or (fneq (vct-ref v0 1) 0.784) (fneq (vct-ref v0 8) 0.181)) (snd-display #__line__ ";nsin output: ~A" v0))
+ (set! (mus-scaler gen) .5) (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";nsin set-scaler: ~F?" (mus-scaler gen)))
+ (set! (mus-length gen) 5) (if (not (= (mus-length gen) 5)) (snd-display #__line__ ";set nsin n: ~D?" (mus-length gen)))
+ (if (fneq (mus-scaler gen) .2525) (snd-display #__line__ ";set sines->scaler: ~A" (mus-scaler gen))))
(test-gen-equal (make-nsin 440.0 3) (make-nsin 440.0 3) (make-nsin 440.0 5))
(test-gen-equal (make-nsin 440.0 3) (make-nsin 440.0 3) (make-nsin 400.0 3))
@@ -18875,7 +18951,7 @@ EDITS: 2
(let* ((val1 (* (sum-of-n-sines (mus-phase gen) 5) (mus-scaler gen)))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display ";nsin: ~A ~A" val1 val2)))))
+ (snd-display #__line__ ";nsin: ~A ~A" val1 val2)))))
(let ((gen1 (make-nsin 100.0 10))
(gen2 (make-nsin -100.0 10))
@@ -18884,8 +18960,8 @@ EDITS: 2
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
- (snd-display ";nsin +-: ~A" mx)))
-
+ (snd-display #__line__ ";nsin +-: ~A" mx)))
+
(let ((gen (make-nrxysin 440.0))
(v0 (make-vct 10))
@@ -18898,30 +18974,30 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (nrxysin gen 0.0)))
(vct-map! v1 (lambda () (if (nrxysin? gen1) (nrxysin gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map nrxysin: ~A ~A" v0 v1))
- (if (not (nrxysin? gen)) (snd-display ";~A not nrxysin?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";nrxysin phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";nrxysin frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";mus-scaler (a) nrxysin: ~A" (mus-scaler gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map nrxysin: ~A ~A" v0 v1))
+ (if (not (nrxysin? gen)) (snd-display #__line__ ";~A not nrxysin?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";nrxysin phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";nrxysin frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";mus-scaler (a) nrxysin: ~A" (mus-scaler gen)))
(set! (mus-scaler gen) 0.75)
- (if (fneq (mus-scaler gen) 0.75) (snd-display ";mus-scaler (set a) nrxysin: ~A" (mus-scaler gen)))
- (if (not (= (mus-length gen) 1)) (snd-display ";mus-length nrxysin: ~A" (mus-length gen)))
- (if (fneq (mus-offset gen) 1.0) (snd-display ";mus-offset nrxysin: ~A" (mus-offset gen))))
+ (if (fneq (mus-scaler gen) 0.75) (snd-display #__line__ ";mus-scaler (set a) nrxysin: ~A" (mus-scaler gen)))
+ (if (not (= (mus-length gen) 1)) (snd-display #__line__ ";mus-length nrxysin: ~A" (mus-length gen)))
+ (if (fneq (mus-offset gen) 1.0) (snd-display #__line__ ";mus-offset nrxysin: ~A" (mus-offset gen))))
(test-gen-equal (make-nrxysin 440.0) (make-nrxysin 440.0) (make-nrxysin 100.0))
(test-gen-equal (make-nrxysin 440.0) (make-nrxysin 440.0) (make-nrxysin 440.0 1.5))
(test-gen-equal (make-nrxysin 440.0) (make-nrxysin 440.0) (make-nrxysin 440.0 :n 3))
-
+
(let ((v1 (make-vct 10)))
(with-sound (:output v1 :srate 44100)
- (let ((gen (make-nrxysin 1000 :n 10 :r .99)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (nrxysin gen)))))
+ (let ((gen (make-nrxysin 1000 :n 10 :r .99)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (outa i (nrxysin gen)))))
(if (not (vequal v1 (vct 0.000 0.671 0.637 0.186 0.017 0.169 0.202 0.048 0.007 0.105)))
- (snd-display ";ws nrxysin output: ~A" v1)))
+ (snd-display #__line__ ";ws nrxysin output: ~A" v1)))
+
-
(let ((gen (make-nrxycos 440.0))
(v0 (make-vct 10))
(gen1 (make-nrxycos 440.0))
@@ -18933,49 +19009,49 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (nrxycos gen 0.0)))
(vct-map! v1 (lambda () (if (nrxycos? gen1) (nrxycos gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map nrxycos: ~A ~A" v0 v1))
- (if (not (nrxycos? gen)) (snd-display ";~A not nrxycos?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";nrxycos phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";nrxycos frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";mus-scaler (a) nrxycos: ~A" (mus-scaler gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map nrxycos: ~A ~A" v0 v1))
+ (if (not (nrxycos? gen)) (snd-display #__line__ ";~A not nrxycos?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";nrxycos phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";nrxycos frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";mus-scaler (a) nrxycos: ~A" (mus-scaler gen)))
(set! (mus-scaler gen) 0.75)
- (if (fneq (mus-scaler gen) 0.75) (snd-display ";mus-scaler (set a) nrxycos: ~A" (mus-scaler gen)))
- (if (not (= (mus-length gen) 1)) (snd-display ";mus-length nrxycos: ~A" (mus-length gen)))
- (if (fneq (mus-offset gen) 1.0) (snd-display ";mus-offset nrxycos: ~A" (mus-offset gen))))
+ (if (fneq (mus-scaler gen) 0.75) (snd-display #__line__ ";mus-scaler (set a) nrxycos: ~A" (mus-scaler gen)))
+ (if (not (= (mus-length gen) 1)) (snd-display #__line__ ";mus-length nrxycos: ~A" (mus-length gen)))
+ (if (fneq (mus-offset gen) 1.0) (snd-display #__line__ ";mus-offset nrxycos: ~A" (mus-offset gen))))
(test-gen-equal (make-nrxycos 440.0) (make-nrxycos 440.0) (make-nrxycos 100.0))
(test-gen-equal (make-nrxycos 440.0) (make-nrxycos 440.0) (make-nrxycos 440.0 1.5))
(test-gen-equal (make-nrxycos 440.0) (make-nrxycos 440.0) (make-nrxycos 440.0 :n 3))
-
+
(let ((v1 (with-sound (:output (make-vct 10) :srate 44100)
(let ((gen (make-nrxycos 1000 :n 10 :r .99)))
(do ((i 0 (+ 1 i)))
((= i 10))
(outa i (nrxycos gen)))))))
(if (not (vequal v1 (vct 1.000 0.602 -0.067 -0.242 -0.007 0.071 -0.087 -0.128 -0.007 0.012)))
- (snd-display ";ws nrxycos output: ~A" v1)))
-
-
+ (snd-display #__line__ ";ws nrxycos output: ~A" v1)))
+
+
(let ((ind (new-sound "test.snd" mus-next mus-bfloat)))
(pad-channel 0 1000)
(let ((gen (make-cosine-summation 100.0)))
(map-channel (lambda (y) (* .2 (cosine-summation gen 0.5))))
(let ((vals (channel->vct 280 10)))
(if (not (vequal vals (vct 0.191 0.187 0.181 0.176 0.169 0.163 0.156 0.148 0.141 0.133)))
- (snd-display ";cosine-summation: ~A" vals)))
+ (snd-display #__line__ ";cosine-summation: ~A" vals)))
(undo))
(let ((gen (make-kosine-summation 100.0)))
(map-channel (lambda (y) (* .2 (kosine-summation gen 0.5 1.0))))
(let ((vals (channel->vct 280 10)))
(if (not (vequal vals (vct 0.194 0.191 0.188 0.184 0.180 0.175 0.170 0.166 0.160 0.155)))
- (snd-display ";kosine-summation 1: ~A" vals)))
+ (snd-display #__line__ ";kosine-summation 1: ~A" vals)))
(undo))
(let ((gen (make-kosine-summation 100.0)))
(map-channel (lambda (y) (* .2 (kosine-summation gen 0.5 3.0))))
(let ((vals (channel->vct 280 10)))
(if (not (vequal vals (vct 0.182 0.174 0.165 0.155 0.145 0.134 0.124 0.113 0.103 0.094)))
- (snd-display ";kosine-summation 3: ~A" vals)))
+ (snd-display #__line__ ";kosine-summation 3: ~A" vals)))
(undo))
(let ((angle 0.0)
@@ -18985,8 +19061,8 @@ EDITS: 2
(vct-set! v i (fejer-sum angle 3))
(set! angle (+ angle .1)))
(if (not (vequal v (vct 1.000 0.988 0.951 0.892 0.815 0.723 0.622 0.516 0.412 0.313 0.225 0.150 0.089 0.045 0.017 0.003 0.000 0.007 0.020 0.035)))
- (snd-display ";fejer-sum: ~A" v)))
-
+ (snd-display #__line__ ";fejer-sum: ~A" v)))
+
(for-each
(lambda (n)
(let ((mx 0.0)
@@ -18995,7 +19071,7 @@ EDITS: 2
((= i 300))
(set! mx (max mx (fejer-sum angle n)))
(set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display ";fejer-sum maxamp ~D: ~A" n mx))))
+ (if (fneq mx 1.0) (snd-display #__line__ ";fejer-sum maxamp ~D: ~A" n mx))))
(list 1 4 9 16 32 100))
(let ((angle 0.0)
@@ -19005,8 +19081,8 @@ EDITS: 2
(vct-set! v i (poussin-sum angle 3))
(set! angle (+ angle .1)))
(if (not (vequal v (vct 1.000 0.910 0.663 0.323 -0.024 -0.301 -0.458 -0.486 -0.411 -0.281 -0.147 -0.046 0.008 0.021 0.013 0.003 0.000 0.006 0.012 0.009)))
- (snd-display ";poussin-sum: ~A" v)))
-
+ (snd-display #__line__ ";poussin-sum: ~A" v)))
+
(for-each
(lambda (n)
(let ((mx 0.0)
@@ -19015,7 +19091,7 @@ EDITS: 2
((= i 300))
(set! mx (max mx (poussin-sum angle n)))
(set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display ";poussin-sum maxamp ~D: ~A" n mx))))
+ (if (fneq mx 1.0) (snd-display #__line__ ";poussin-sum maxamp ~D: ~A" n mx))))
(list 1 4 9 16 32 100))
(let ((angle 0.0)
@@ -19025,8 +19101,8 @@ EDITS: 2
(vct-set! v i (jackson-sum angle 3))
(set! angle (+ angle .1)))
(if (not (vequal v (vct 1.000 0.975 0.904 0.796 0.664 0.523 0.386 0.266 0.170 0.098 0.051 0.022 0.008 0.002 0.000 0.000 0.000 0.000 0.000 0.001)))
- (snd-display ";jackson-sum: ~A" v)))
-
+ (snd-display #__line__ ";jackson-sum: ~A" v)))
+
(for-each
(lambda (n)
(let ((mx 0.0)
@@ -19035,7 +19111,7 @@ EDITS: 2
((= i 300))
(set! mx (max mx (jackson-sum angle n)))
(set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display ";jackson-sum maxamp ~D: ~A" n mx))))
+ (if (fneq mx 1.0) (snd-display #__line__ ";jackson-sum maxamp ~D: ~A" n mx))))
(list 1 4 9 16 32 100))
(let ((angle 0.0)
@@ -19045,8 +19121,8 @@ EDITS: 2
(vct-set! v i (legendre-sum angle 3))
(set! angle (+ angle .1)))
(if (not (vequal v (vct 1.000 0.961 0.850 0.688 0.502 0.323 0.174 0.071 0.015 0.000 0.011 0.032 0.049 0.054 0.047 0.032 0.016 0.004 0.000 0.004)))
- (snd-display ";legendre-sum: ~A" v)))
-
+ (snd-display #__line__ ";legendre-sum: ~A" v)))
+
(for-each
(lambda (n)
(let ((mx 0.0)
@@ -19055,7 +19131,7 @@ EDITS: 2
((= i 300))
(set! mx (max mx (legendre-sum angle n)))
(set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display ";legendre-sum maxamp ~D: ~A" n mx))))
+ (if (fneq mx 1.0) (snd-display #__line__ ";legendre-sum maxamp ~D: ~A" n mx))))
(list 1 4 9 16 32 100))
@@ -19066,7 +19142,7 @@ EDITS: 2
val))))
(let ((vals (channel->vct 10 10)))
(if (not (vequal vals (vct -0.118 -0.073 -0.035 0.012 0.062 0.106 0.142 0.185 0.237 0.288)))
- (snd-display ";band-limited-sawtooth: ~A" vals)))
+ (snd-display #__line__ ";band-limited-sawtooth: ~A" vals)))
(undo)
(let ((angle 0.0))
@@ -19076,26 +19152,26 @@ EDITS: 2
val))))
(let ((vals (channel->vct 10 10)))
(if (not (vequal vals (vct 1.000 1.000 1.000 1.000 0.998 0.888 -0.525 -0.988 -1.000 -1.000)))
- (snd-display ";band-limited-square-wave: ~A" vals)))
+ (snd-display #__line__ ";band-limited-square-wave: ~A" vals)))
(undo)
(let ((angle 0.0))
(map-channel (lambda (y) (let ((val (sum-of-n-sines angle 3))) (set! angle (+ angle .1)) (* .1 val))))
(let ((vals (channel->vct 260 10)))
(if (not (vequal vals (vct 0.226 0.200 0.166 0.129 0.091 0.056 0.025 0.001 -0.015 -0.023)))
- (snd-display ";sum-of-n-sines: ~A" vals)))
+ (snd-display #__line__ ";sum-of-n-sines: ~A" vals)))
(undo))
(let ((angle 0.0))
(map-channel (lambda (y) (let ((val (sum-of-n-odd-sines angle 3))) (set! angle (+ angle .1)) (* .1 val))))
(let ((vals (channel->vct 260 10)))
(if (not (vequal vals (vct 0.035 0.007 0.000 0.014 0.039 0.069 0.091 0.100 0.092 0.070)))
- (snd-display ";sum-of-n-odd-sines: ~A" vals)))
+ (snd-display #__line__ ";sum-of-n-odd-sines: ~A" vals)))
(undo))
(let ((angle 0.0))
(map-channel (lambda (y) (let ((val (sum-of-n-odd-cosines angle 3))) (set! angle (+ angle .1)) (* .1 val))))
(let ((vals (channel->vct 250 10)))
(if (not (vequal vals (vct 0.270 0.298 0.292 0.253 0.189 0.112 0.037 -0.024 -0.061 -0.072)))
- (snd-display ";sum-of-n-odd-cosines: ~A" vals)))
+ (snd-display #__line__ ";sum-of-n-odd-cosines: ~A" vals)))
(undo))
(close-sound ind))
@@ -19110,19 +19186,19 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (asymmetric-fm gen 0.0)))
(vct-map! v1 (lambda () (if (asymmetric-fm? gen1) (asymmetric-fm gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map asymmetric-fm: ~A ~A" v0 v1))
- (if (not (asymmetric-fm? gen)) (snd-display ";~A not asymmetric-fm?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";asymmetric-fm phase: ~F?" (mus-phase gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map asymmetric-fm: ~A ~A" v0 v1))
+ (if (not (asymmetric-fm? gen)) (snd-display #__line__ ";~A not asymmetric-fm?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";asymmetric-fm phase: ~F?" (mus-phase gen)))
(set! (mus-phase gen) 1.0)
- (if (fneq (mus-phase gen) 1.0) (snd-display ";set! asymmetric-fm phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";asymmetric-fm frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";set! asymmetric-fm phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";asymmetric-fm frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
- (if (fneq (mus-frequency gen) 100.0) (snd-display ";set! asymmetric-fm frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 2) 0.969) (fneq (vct-ref v0 8) .538)) (snd-display ";asymmetric-fm output: ~A" v0))
- (if (fneq (mus-scaler gen) 1.0) (snd-display ";mus-scaler (r) asymmetric-fm: ~A" (mus-scaler gen)))
+ (if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";set! asymmetric-fm frequency: ~F?" (mus-frequency gen)))
+ (if (or (fneq (vct-ref v0 2) 0.969) (fneq (vct-ref v0 8) .538)) (snd-display #__line__ ";asymmetric-fm output: ~A" v0))
+ (if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";mus-scaler (r) asymmetric-fm: ~A" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";mus-scaler (set r) asymmetric-fm: ~A" (mus-scaler gen)))
- (if (fneq (mus-offset gen) 1.0) (snd-display ";mus-offset asymmetric-fm: ~A" (mus-offset gen))))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";mus-scaler (set r) asymmetric-fm: ~A" (mus-scaler gen)))
+ (if (fneq (mus-offset gen) 1.0) (snd-display #__line__ ";mus-offset asymmetric-fm: ~A" (mus-offset gen))))
(test-gen-equal (make-asymmetric-fm 440.0) (make-asymmetric-fm 440.0) (make-asymmetric-fm 100.0))
(test-gen-equal (make-asymmetric-fm 440.0) (make-asymmetric-fm 440.0) (make-asymmetric-fm 440.0 1.0))
@@ -19137,7 +19213,7 @@ EDITS: 2
(os (oscil gen2 0.0)))
(if (fneq ss os)
(begin
- (snd-display ";asymmetric-fm 1: ~A: os: ~A ss: ~A" i os ss)
+ (snd-display #__line__ ";asymmetric-fm 1: ~A: os: ~A ss: ~A" i os ss)
(set! happy #f))))))
(for-each
@@ -19151,10 +19227,10 @@ EDITS: 2
((= i 1000))
(outa i (asymmetric-fm gen index)))))))))
(if (> (abs (- peak 1.0)) .1)
- (snd-display ";asymmetric-fm peak: ~A, index: ~A, r: ~A" peak index r))))
+ (snd-display #__line__ ";asymmetric-fm peak: ~A, index: ~A, r: ~A" peak index r))))
(list -10.0 -1.5 -0.5 0.5 1.0 1.5 10.0)))
(list 1.0 3.0 10.0))
-
+
(let ((vct0 (make-vct 2048))
(vct1 (make-vct 2048))
(gen3 (make-asymmetric-fm 1000 0 1.0 0.2))
@@ -19173,7 +19249,7 @@ EDITS: 2
(= i 512)))
(if (> (abs (- (vct-ref spectr1 i) (vct-ref spectr2 i))) .02)
(begin
- (snd-display ";asymmetric-fm 2: ~A: ~A ~A" i (vct-ref spectr1 i) (vct-ref spectr2 i))
+ (snd-display #__line__ ";asymmetric-fm 2: ~A: ~A ~A" i (vct-ref spectr1 i) (vct-ref spectr2 i))
(set! happy #f))))))
(let ((gen (make-asymmetric-fm 40.0 0.0 1.0 0.1))
@@ -19196,7 +19272,7 @@ EDITS: 2
(cos (+ th (* index sr (sin mth)))))))
(if (or (fneq val1 val2)
(fneq val1 val3))
- (snd-display ";asyfm by hand: ~A: ~A ~A ~A" i val1 val2 val3)))))
+ (snd-display #__line__ ";asyfm by hand: ~A: ~A ~A ~A" i val1 val2 val3)))))
(let ((vct0 (make-vct 2048))
(vct1 (make-vct 2048))
@@ -19214,9 +19290,9 @@ EDITS: 2
((= i 256))
(if (< (abs (- 1.0 (vct-ref spectr1 i))) .01) (set! s1-loc i))
(if (< (abs (- 1.0 (vct-ref spectr2 i))) .01) (set! s2-loc i)))
- (if (> s2-loc s1-loc) (snd-display ";asymmetric-fm peaks: ~A ~A" s1-loc s2-loc))
+ (if (> s2-loc s1-loc) (snd-display #__line__ ";asymmetric-fm peaks: ~A ~A" s1-loc s2-loc))
(let ((center (* (/ 22050 2048) (* .5 (+ s1-loc s2-loc)))))
- (if (> (abs (- 1000 center)) 60) (snd-display ";asymmetric-fm center: ~A" center)))
+ (if (> (abs (- 1000 center)) 60) (snd-display #__line__ ";asymmetric-fm center: ~A" center)))
(set! (mus-scaler gen3) 0.5)
(do ((i 0 (+ 1 i)))
((= i 2048))
@@ -19255,18 +19331,18 @@ EDITS: 2
(let ((val (if (fir-filter? gen1) (fir-filter gen1 inp) -1.0)))
(set! inp 0.0)
val))))
- (if (not (vequal v0 v1)) (snd-display ";map fir-filter: ~A ~A" v0 v1))
- (if (not (fir-filter? gen)) (snd-display ";~A not fir-filter?" gen))
- (if (not (= (mus-length gen) 3)) (snd-display ";fir-filter length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.25) (fneq (vct-ref v0 2) .125)) (snd-display ";fir-filter output: ~A" v0))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map fir-filter: ~A ~A" v0 v1))
+ (if (not (fir-filter? gen)) (snd-display #__line__ ";~A not fir-filter?" gen))
+ (if (not (= (mus-length gen) 3)) (snd-display #__line__ ";fir-filter length: ~D?" (mus-length gen)))
+ (if (or (fneq (vct-ref v0 1) 0.25) (fneq (vct-ref v0 2) .125)) (snd-display #__line__ ";fir-filter output: ~A" v0))
(let ((data (mus-xcoeffs gen)))
- (if (fneq (vct-ref data 1) .25) (snd-display ";fir-filter xcoeffs: ~A?" data)))
+ (if (fneq (vct-ref data 1) .25) (snd-display #__line__ ";fir-filter xcoeffs: ~A?" data)))
(let ((tag (catch #t (lambda () (mus-xcoeff gen 123)) (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";xcoeff 123: ~A" tag)))
+ (snd-display #__line__ ";xcoeff 123: ~A" tag)))
(let ((tag (catch #t (lambda () (mus-ycoeff gen 123)) (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";fir ycoeff 123: ~A" tag))))
+ (snd-display #__line__ ";fir ycoeff 123: ~A" tag))))
(test-gen-equal (let ((f1 (make-fir-filter 3 (list->vct '(.5 .25 .125))) )) (fir-filter f1 1.0) f1)
(let ((f2 (make-fir-filter 3 (list->vct '(.5 .25 .125))) )) (fir-filter f2 1.0) f2)
@@ -19295,7 +19371,7 @@ EDITS: 2
(fneq (vct-ref data 10) 0.0)
(fneq (vct-ref data 18) 0.166)
(fneq (vct-ref data 89) 0.923))
- (snd-display ";filter xcoeffs: ~A?" data))))
+ (snd-display #__line__ ";filter xcoeffs: ~A?" data))))
(letrec ((make-f-filter (lambda (coeffs)
(list coeffs (make-vct (vct-length coeffs)))))
@@ -19317,31 +19393,31 @@ EDITS: 2
(set! x 0.0)
(if (fneq val1 val2)
(begin
- (snd-display ";f-filter ~A -> ~A ~A" i val1 val2)
+ (snd-display #__line__ ";f-filter ~A -> ~A ~A" i val1 val2)
(set! happy #f)))))))
(let ((gen (make-spencer-filter)))
(if (not (fir-filter? gen))
- (snd-display ";make-spencer-filter returns ~A?" gen)
+ (snd-display #__line__ ";make-spencer-filter returns ~A?" gen)
(begin
- (if (not (= (mus-order gen) 15)) (snd-display ";make-spencer-filter order ~A?" (mus-order gen)))
+ (if (not (= (mus-order gen) 15)) (snd-display #__line__ ";make-spencer-filter order ~A?" (mus-order gen)))
(if (not (vequal (mus-xcoeffs gen) (vct -0.009 -0.019 -0.016 0.009 0.066 0.144 0.209 0.231 0.209 0.144 0.066 0.009 -0.016 -0.019 -0.009)))
- (snd-display ";make-spencer-filter coeffs: ~A" (mus-xcoeffs gen))))))
+ (snd-display #__line__ ";make-spencer-filter coeffs: ~A" (mus-xcoeffs gen))))))
(let ((flt (make-savitzky-golay-filter 5 2)))
(if (not (vequal (mus-xcoeffs flt) (vct -0.086 0.343 0.486 0.343 -0.086)))
- (snd-display ";sg 5 2: ~A" (mus-xcoeffs flt))))
+ (snd-display #__line__ ";sg 5 2: ~A" (mus-xcoeffs flt))))
(let ((flt (make-savitzky-golay-filter 11 2)))
(if (not (vequal (mus-xcoeffs flt) (vct -0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084)))
- (snd-display ";sg 11 2: ~A" (mus-xcoeffs flt))))
+ (snd-display #__line__ ";sg 11 2: ~A" (mus-xcoeffs flt))))
(let ((flt (make-savitzky-golay-filter 11 4)))
(if (not (vequal (mus-xcoeffs flt) (vct 0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042)))
- (snd-display ";sg 11 4: ~A" (mus-xcoeffs flt))))
+ (snd-display #__line__ ";sg 11 4: ~A" (mus-xcoeffs flt))))
(let ((flt (make-savitzky-golay-filter 25 2)))
(if (not (vequal (mus-xcoeffs flt) (vct -0.049 -0.027 -0.006 0.012 0.028 0.043 0.055 0.066 0.075 0.082 0.086
0.089 0.090 0.089 0.086 0.082 0.075 0.066 0.055 0.043
0.028 0.012 -0.006 -0.027 -0.049)))
- (snd-display ";sg 25 2: ~A" (mus-xcoeffs flt))))
+ (snd-display #__line__ ";sg 25 2: ~A" (mus-xcoeffs flt))))
(let ((gen (make-iir-filter 3 (list->vct '(.5 .25 .125))))
(v0 (make-vct 10))
@@ -19360,18 +19436,18 @@ EDITS: 2
(let ((val (if (iir-filter? gen1) (iir-filter gen1 inp) -1.0)))
(set! inp 0.0)
val))))
- (if (not (vequal v0 v1)) (snd-display ";map iir-filter: ~A ~A" v0 v1))
- (if (not (iir-filter? gen)) (snd-display ";~A not iir-filter?" gen))
- (if (not (= (mus-length gen) 3)) (snd-display ";iir-filter length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) -0.25) (fneq (vct-ref v0 2) -.062)) (snd-display ";iir-filter output: ~A" v0))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map iir-filter: ~A ~A" v0 v1))
+ (if (not (iir-filter? gen)) (snd-display #__line__ ";~A not iir-filter?" gen))
+ (if (not (= (mus-length gen) 3)) (snd-display #__line__ ";iir-filter length: ~D?" (mus-length gen)))
+ (if (or (fneq (vct-ref v0 1) -0.25) (fneq (vct-ref v0 2) -.062)) (snd-display #__line__ ";iir-filter output: ~A" v0))
(let ((data (mus-ycoeffs gen)))
- (if (fneq (vct-ref data 1) .25) (snd-display ";iir-filter ycoeffs: ~A?" data)))
+ (if (fneq (vct-ref data 1) .25) (snd-display #__line__ ";iir-filter ycoeffs: ~A?" data)))
(let ((tag (catch #t (lambda () (mus-ycoeff gen 123)) (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";ycoeff 123: ~A" tag)))
+ (snd-display #__line__ ";ycoeff 123: ~A" tag)))
(let ((tag (catch #t (lambda () (mus-xcoeff gen 123)) (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";iir xcoeff 123: ~A" tag))))
+ (snd-display #__line__ ";iir xcoeff 123: ~A" tag))))
(test-gen-equal (let ((f1 (make-iir-filter 3 (list->vct '(.5 .25 .125))))) (iir-filter f1 1.0) f1)
(let ((f2 (make-iir-filter 3 (list->vct '(.5 .25 .125))) )) (iir-filter f2 1.0) f2)
@@ -19398,35 +19474,35 @@ EDITS: 2
(let ((val (if (filter? gen1) (filter gen1 inp) -1.0)))
(set! inp 0.0)
val))))
- (if (not (vequal v0 v1)) (snd-display ";map filter: ~A ~A" v0 v1))
- (if (not (filter? gen)) (snd-display ";~A not filter?" gen))
- (if (not (= (mus-length gen) 3)) (snd-display ";filter length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 2) .031)) (snd-display ";filter output: ~A" v0))
- (if (not (filter? gen2)) (snd-display ";make-biquad: ~A" gen2))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map filter: ~A ~A" v0 v1))
+ (if (not (filter? gen)) (snd-display #__line__ ";~A not filter?" gen))
+ (if (not (= (mus-length gen) 3)) (snd-display #__line__ ";filter length: ~D?" (mus-length gen)))
+ (if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 2) .031)) (snd-display #__line__ ";filter output: ~A" v0))
+ (if (not (filter? gen2)) (snd-display #__line__ ";make-biquad: ~A" gen2))
(let ((xs (mus-xcoeffs gen))
(ys (mus-ycoeffs gen)))
(if (or (not (equal? xs (list->vct '(.5 .25 .125))))
(not (equal? xs ys)))
- (snd-display ";mus-xcoeffs: ~A ~A?" xs ys))))
+ (snd-display #__line__ ";mus-xcoeffs: ~A ~A?" xs ys))))
(let ((var (catch #t (lambda () (make-filter :order 2 :xcoeffs (vct 1.0 0.5) :ycoeffs (vct 2.0 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-filter bad coeffs: ~A" var)))
+ (snd-display #__line__ ";make-filter bad coeffs: ~A" var)))
(let ((var (catch #t (lambda () (make-filter :order 0 :xcoeffs (vct 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-filter bad order: ~A" var)))
+ (snd-display #__line__ ";make-filter bad order: ~A" var)))
(let ((var (catch #t (lambda () (make-fir-filter :order 22 :xcoeffs (vct 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-fir-filter bad coeffs: ~A" var)))
+ (snd-display #__line__ ";make-fir-filter bad coeffs: ~A" var)))
(let ((var (catch #t (lambda () (make-iir-filter :order 22 :ycoeffs (vct 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-iir-filter bad coeffs: ~A" var)))
+ (snd-display #__line__ ";make-iir-filter bad coeffs: ~A" var)))
(let ((var (catch #t (lambda () (make-fir-filter -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-fir-filter bad order: ~A" var)))
+ (snd-display #__line__ ";make-fir-filter bad order: ~A" var)))
(let ((var (make-filter :order 2 :ycoeffs (vct 1.0 0.5))))
(if (not (iir-filter? var))
- (snd-display ";make-filter with only y: ~A" var)))
+ (snd-display #__line__ ";make-filter with only y: ~A" var)))
(test-gen-equal (let ((f1 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))) (filter f1 1.0) f1)
(let ((f2 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))) (filter f2 1.0) f2)
@@ -19436,21 +19512,21 @@ EDITS: 2
(let ((f3 (make-filter 3 (list->vct '(.5 .5 .125)) (list->vct '(.5 .25 .0625))))) (filter f3 1.0) f3))
(let ((fr (make-fir-filter 6 (vct 0 1 2 3 4 5))))
- (if (not (= (mus-length fr) 6)) (snd-display ";filter-length: ~A" (mus-length fr))))
+ (if (not (= (mus-length fr) 6)) (snd-display #__line__ ";filter-length: ~A" (mus-length fr))))
(let ((val (cascade->canonical (list (vct 1.0 0.0 0.0) (vct 1.0 0.5 0.25)))))
(if (not (vequal val (vct 1.000 0.500 0.250 0.000 0.000)))
- (snd-display ";cas2can 0: ~A" val)))
+ (snd-display #__line__ ";cas2can 0: ~A" val)))
(let ((val (cascade->canonical (list (vct 1.0 1.0 0.0) (vct 1.0 0.5 0.25)))))
(if (not (vequal val (vct 1.000 1.500 0.750 0.250 0.000)))
- (snd-display ";cas2can 1: ~A" val)))
+ (snd-display #__line__ ";cas2can 1: ~A" val)))
(let ((val (cascade->canonical (list (vct 1 0.8 0) (vct 1 1.4 0.65) (vct 1 0 0)))))
(if (not (vequal val (vct 1.000 2.200 1.770 0.520 0.000 0.000 0.000)))
- (snd-display ";cascade->canonical: ~A" val)))
+ (snd-display #__line__ ";cascade->canonical: ~A" val)))
(let ((val (cascade->canonical (list (vct 1 -0.9 0) (vct 1 1 0.74) (vct 1 -1.6 0.8)))))
(if (not (vequal val (vct 1.000 -1.500 0.480 -0.330 0.938 -0.533 0.000)))
- (snd-display ";cascade->canonical 1: ~A" val)))
+ (snd-display #__line__ ";cascade->canonical 1: ~A" val)))
(let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050)))
(pad-channel 0 10000)
@@ -19458,20 +19534,20 @@ EDITS: 2
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.962 0.998 0.998 0.998 0.998 0.999 0.999 0.998 0.997 1.000)))
(not (vequal sp (vct 0.963 0.999 0.999 0.999 0.999 0.999 1.000 1.000 0.998 0.997))))
- (snd-display ";initial rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";initial rough spectrum: ~A" sp)))
(let ((b (make-butter-high-pass 440.0))
(v (make-vct 10))
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
- (snd-display ";butter high: ~A" v))
+ (snd-display #__line__ ";butter high: ~A" v))
(set! b (make-butter-high-pass 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000)))
(not (vequal sp (vct 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
- (snd-display ";hp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";hp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-low-pass 440.0))
@@ -19479,12 +19555,12 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
- (snd-display ";butter low: ~A" v))
+ (snd-display #__line__ ";butter low: ~A" v))
(set! b (make-butter-low-pass 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";lp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";lp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-band-pass 440.0 50.0))
@@ -19492,12 +19568,12 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.007 0.014 0.013 0.013 0.012 0.011 0.009 0.008 0.007 0.005)))
- (snd-display ";butter bandpass: ~A" v))
+ (snd-display #__line__ ";butter bandpass: ~A" v))
(set! b (make-butter-band-pass 1000.0 500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 0.888 1.000 0.144 0.056 0.027 0.014 0.008 0.004 0.002 0.000)))
- (snd-display ";bp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";bp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-band-reject 440.0 50.0))
@@ -19505,13 +19581,13 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.993 -0.014 -0.013 -0.013 -0.012 -0.011 -0.009 -0.008 -0.007 -0.005)))
- (snd-display ";butter bandstop: ~A" v))
+ (snd-display #__line__ ";butter bandstop: ~A" v))
(set! b (make-butter-band-reject 1000.0 500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.662 0.687 0.953 0.980 0.989 0.994 0.997 0.997 0.997 1.000)))
(not (vequal sp (vct 0.664 0.689 0.955 0.982 0.992 0.996 0.999 1.000 0.999 0.998))))
- (snd-display ";bs rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";bs rough spectrum: ~A" sp)))
(undo))
(if (defined? 'gsl-roots) (analog-filter-tests))
@@ -19521,9 +19597,9 @@ EDITS: 2
(let ((v (spectrum->coeffs 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0)))
(v1 (make-fir-coeffs 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0))))
(if (not (vequal v (vct -0.190 -0.118 0.000 0.118 0.190 0.190 0.118 0.000 -0.118 -0.190)))
- (snd-display ";spectrum->coeffs: ~A" v))
+ (snd-display #__line__ ";spectrum->coeffs: ~A" v))
(if (not (vequal v v1))
- (snd-display ";spectrum->coeffs v make-fir-coeffs: ~A ~A" v v1)))
+ (snd-display #__line__ ";spectrum->coeffs v make-fir-coeffs: ~A ~A" v v1)))
(let ((notched-spectr (make-vct 20)))
(vct-set! notched-spectr 2 1.0)
@@ -19531,14 +19607,14 @@ EDITS: 2
(v1 (make-fir-coeffs 20 notched-spectr)))
(if (not (vequal v (vct 0.095 0.059 -0.000 -0.059 -0.095 -0.095 -0.059 0.000 0.059 0.095
0.095 0.059 0.000 -0.059 -0.095 -0.095 -0.059 -0.000 0.059 0.095)))
- (snd-display ";spectrum->coeffs (notch): ~A" v))
+ (snd-display #__line__ ";spectrum->coeffs (notch): ~A" v))
(if (not (vequal v v1))
- (snd-display ";spectrum->coeffs v(2) make-fir-coeffs: ~A ~A" v v1))
+ (snd-display #__line__ ";spectrum->coeffs v(2) make-fir-coeffs: ~A ~A" v v1))
(let ((flt (make-fir-filter 20 v)))
(map-channel (lambda (y) (fir-filter flt y)))))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 0.007 0.493 1.000 0.068 0.030 0.019 0.014 0.011 0.009 0.009)))
- (snd-display ";sp->coeff rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";sp->coeff rough spectrum: ~A" sp)))
(undo))
(let ((rspect (make-vct 20)))
@@ -19548,7 +19624,7 @@ EDITS: 2
(let ((v (spectrum->coeffs 20 rspect))
(v1 (make-fir-coeffs 20 rspect)))
(if (not (vequal v v1))
- (snd-display ";spectrum->coeffs v(3) make-fir-coeffs: ~A ~A" v v1))))
+ (snd-display #__line__ ";spectrum->coeffs v(3) make-fir-coeffs: ~A ~A" v v1))))
(let ((b (make-highpass (hz->radians 1000.0) 10))
(v (make-vct 20))
@@ -19556,13 +19632,13 @@ EDITS: 2
(vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct -0.001 -0.002 -0.005 -0.011 -0.021 -0.034 -0.049 -0.065 -0.078 -0.087
0.909 -0.087 -0.078 -0.065 -0.049 -0.034 -0.021 -0.011 -0.005 -0.002)))
- (snd-display ";dsp.scm high: ~A" v))
+ (snd-display #__line__ ";dsp.scm high: ~A" v))
(set! b (make-highpass (hz->radians 1000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.053 0.774 0.998 0.997 0.997 0.996 0.996 0.996 0.997 1.000)))
(not (vequal sp (vct 0.053 0.776 1.000 0.998 0.998 0.998 0.998 0.998 0.998 1.000))))
- (snd-display ";dsp hp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";dsp hp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-lowpass (hz->radians 1000.0) 10))
@@ -19571,12 +19647,12 @@ EDITS: 2
(vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.001 0.002 0.005 0.011 0.021 0.034 0.049 0.065 0.078 0.087 0.091 0.087 0.078 0.065
0.049 0.034 0.021 0.011 0.005 0.002)))
- (snd-display ";dsp.scm low: ~A" v))
+ (snd-display #__line__ ";dsp.scm low: ~A" v))
(set! b (make-lowpass (hz->radians 1000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 1.000 0.054 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";dsp lp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";dsp lp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-bandpass (hz->radians 1500.0) (hz->radians 2000.0) 10))
@@ -19585,12 +19661,12 @@ EDITS: 2
(vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.001 -0.001 -0.005 -0.011 -0.017 -0.019 -0.013 0.003 0.022 0.039 0.045
0.039 0.022 0.003 -0.013 -0.019 -0.017 -0.011 -0.005 -0.001)))
- (snd-display ";dsp.scm bp: ~A" v))
+ (snd-display #__line__ ";dsp.scm bp: ~A" v))
(set! b (make-bandpass (hz->radians 1500.0) (hz->radians 2000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 0.010 1.000 0.154 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";dsp bp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";dsp bp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-bandstop (hz->radians 1500.0) (hz->radians 2000.0) 10))
@@ -19599,13 +19675,13 @@ EDITS: 2
(vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct -0.001 0.001 0.005 0.011 0.017 0.019 0.013 -0.003 -0.022 -0.039 0.955
-0.039 -0.022 -0.003 0.013 0.019 0.017 0.011 0.005 0.001)))
- (snd-display ";dsp.scm bs: ~A" v))
+ (snd-display #__line__ ";dsp.scm bs: ~A" v))
(set! b (make-bandstop (hz->radians 1500.0) (hz->radians 2000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.904 0.425 0.821 0.998 0.997 0.996 0.996 0.996 0.997 1.000)))
(not (vequal sp (vct 0.906 0.425 0.822 1.000 0.999 0.998 0.998 0.998 0.998 1.000))))
- (snd-display ";dsp bs rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";dsp bs rough spectrum: ~A" sp)))
(undo))
(let ((b (make-differentiator 10))
@@ -19614,12 +19690,12 @@ EDITS: 2
(vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct -0.008 0.011 -0.021 0.039 -0.066 0.108 -0.171 0.270 -0.456 0.977
0.000 -0.977 0.456 -0.270 0.171 -0.108 0.066 -0.039 0.021 -0.011)))
- (snd-display ";dsp.scm df: ~A" v))
+ (snd-display #__line__ ";dsp.scm df: ~A" v))
(set! b (make-differentiator 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 0.004 0.027 0.075 0.147 0.242 0.362 0.506 0.674 0.864 1.000)))
- (snd-display ";dsp df rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";dsp df rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-high-pass-1 440.0))
@@ -19627,13 +19703,13 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.941 -0.111 -0.098 -0.086 -0.076 -0.067 -0.059 -0.052 -0.046 -0.041)))
- (snd-display ";iir-1 high: ~A" v))
+ (snd-display #__line__ ";iir-1 high: ~A" v))
(set! b (make-iir-high-pass-1 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.228 0.706 0.879 0.940 0.967 0.982 0.990 0.994 0.996 1.000)))
(not (vequal sp (vct 0.229 0.709 0.883 0.944 0.971 0.986 0.994 0.999 1.000 1.000))))
- (snd-display ";iir-1 hp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";iir-1 hp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-low-pass-1 440.0))
@@ -19641,12 +19717,12 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.059 0.111 0.098 0.086 0.076 0.067 0.059 0.052 0.046 0.041)))
- (snd-display ";iir-1 low: ~A" v))
+ (snd-display #__line__ ";iir-1 low: ~A" v))
(set! b (make-iir-low-pass-1 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 1.000 0.402 0.164 0.080 0.043 0.023 0.013 0.006 0.003 0.001)))
- (snd-display ";iir-1 lp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";iir-1 lp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-high-pass-2 440.0))
@@ -19654,13 +19730,13 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
- (snd-display ";iir-2 high: ~A" v))
+ (snd-display #__line__ ";iir-2 high: ~A" v))
(set! b (make-iir-high-pass-2 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000)))
(not (vequal sp (vct 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
- (snd-display ";iir-2 hp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";iir-2 hp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-low-pass-2 440.0))
@@ -19668,12 +19744,12 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
- (snd-display ";iir-2 low: ~A" v))
+ (snd-display #__line__ ";iir-2 low: ~A" v))
(set! b (make-iir-low-pass-2 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";iir-2 lp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";iir-2 lp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-band-pass-2 440.0 490.0))
@@ -19681,12 +19757,12 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.007 0.014 0.013 0.013 0.012 0.010 0.009 0.008 0.006 0.004)))
- (snd-display ";iir bp-2 bandpass: ~A" v))
+ (snd-display #__line__ ";iir bp-2 bandpass: ~A" v))
(set! b (make-iir-band-pass-2 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (not (vequal sp (vct 0.239 1.000 0.117 0.041 0.019 0.010 0.005 0.003 0.001 0.000)))
- (snd-display ";iir bp-2 rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";iir bp-2 rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-band-stop-2 440.0 500.0))
@@ -19694,13 +19770,13 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.992 -0.017 -0.016 -0.015 -0.014 -0.012 -0.011 -0.009 -0.007 -0.005)))
- (snd-display ";iir-2 bandstop: ~A" v))
+ (snd-display #__line__ ";iir-2 bandstop: ~A" v))
(set! b (make-iir-band-stop-2 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 0.836 0.525 0.943 0.979 0.989 0.994 0.997 0.997 0.997 1.000)))
(not (vequal sp (vct 0.838 0.527 0.945 0.981 0.991 0.996 0.999 1.000 0.999 0.998))))
- (snd-display ";iir bs-2 rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";iir bs-2 rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-hp 4 440.0))
@@ -19710,7 +19786,7 @@ EDITS: 2
(if (and (not (vequal v (vct 0.725 -0.466 -0.315 -0.196 -0.104 -0.036 0.014 0.047 0.0685 0.0775)))
(not (vequal v (vct 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.015 0.049 0.070 0.081)))
(not (vequal v (vct 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.014 0.049 0.069 0.079))))
- (snd-display ";butter hp: ~A" v))
+ (snd-display #__line__ ";butter hp: ~A" v))
(set! b (make-butter-hp 4 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
@@ -19719,7 +19795,7 @@ EDITS: 2
(not (vequal sp (vct 0.051 0.991 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995)))
(not (vequal sp (vct 0.045 0.970 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995)))
(not (vequal sp (vct 0.052 0.971 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))))
- (snd-display ";bhp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";bhp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-lp 4 440.0))
@@ -19727,13 +19803,13 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))) ;; ???
- (snd-display ";butter lp: ~A" v))
+ (snd-display #__line__ ";butter lp: ~A" v))
(set! b (make-butter-lp 4 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
(if (and (not (vequal sp (vct 1.000 0.035 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal sp (vct 1.000 0.038 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display ";blp rough spectrum: ~A" sp)))
+ (snd-display #__line__ ";blp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-bp 4 440.0 500.0))
@@ -19741,7 +19817,7 @@ EDITS: 2
(inv 1.0))
(vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
(if (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";butter bp: ~A" v))
+ (snd-display #__line__ ";butter bp: ~A" v))
(set! b (make-butter-bp 4 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(undo))
@@ -19753,7 +19829,7 @@ EDITS: 2
(if (and (not (vequal v (vct 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.026 -0.0225 -0.015 -0.0085)))
(not (vequal v (vct 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.022 -0.017 -0.011)))
(not (vequal v (vct 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.021 -0.014 -0.011))))
- (snd-display ";butter bs: ~A" v))
+ (snd-display #__line__ ";butter bs: ~A" v))
(set! b (make-butter-bs 4 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(undo))
@@ -19774,16 +19850,16 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (sawtooth-wave gen 0.0)))
(vct-map! v1 (lambda () (if (sawtooth-wave? gen1) (sawtooth-wave gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map sawtooth: ~A ~A" v0 v1))
- (if (not (sawtooth-wave? gen)) (snd-display ";~A not sawtooth-wave?" gen))
- (if (fneq (mus-phase gen) 4.39538) (snd-display ";sawtooth-wave phase: ~F?" (mus-phase gen))) ;starts at pi
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";sawtooth-wave frequency: ~F?" (mus-frequency gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map sawtooth: ~A ~A" v0 v1))
+ (if (not (sawtooth-wave? gen)) (snd-display #__line__ ";~A not sawtooth-wave?" gen))
+ (if (fneq (mus-phase gen) 4.39538) (snd-display #__line__ ";sawtooth-wave phase: ~F?" (mus-phase gen))) ;starts at pi
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";sawtooth-wave frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
- (if (fneq (mus-frequency gen) 100.0) (snd-display ";set! sawtooth-wave frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 1.0) (snd-display ";sawtooth-wave scaler: ~F?" (mus-scaler gen)))
+ (if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";set! sawtooth-wave frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";sawtooth-wave scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";set! sawtooth-wave scaler: ~F?" (mus-scaler gen)))
- (if (or (fneq (vct-ref v0 1) 0.04) (fneq (vct-ref v0 8) .319)) (snd-display ";sawtooth-wave output: ~A" v0)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! sawtooth-wave scaler: ~F?" (mus-scaler gen)))
+ (if (or (fneq (vct-ref v0 1) 0.04) (fneq (vct-ref v0 8) .319)) (snd-display #__line__ ";sawtooth-wave output: ~A" v0)))
(test-gen-equal (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0) (make-sawtooth-wave 120.0))
(test-gen-equal (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0 1.0 1.0))
@@ -19796,8 +19872,8 @@ EDITS: 2
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
- (snd-display ";sawtooth +-: ~A" mx)))
-
+ (snd-display #__line__ ";sawtooth +-: ~A" mx)))
+
(let ((gen (make-square-wave 440.0))
(v0 (make-vct 10))
(gen1 (make-square-wave 440.0))
@@ -19812,18 +19888,18 @@ EDITS: 2
(vct-map! v1 (lambda ()
(set! w (mus-width gen1))
(if (square-wave? gen1) (square-wave gen1 0.0) -1.0)))
- (if (fneq w 0.5) (snd-display ";mus-width opt: ~A" w)))
- (if (not (vequal v0 v1)) (snd-display ";map square-wave: ~A ~A" v0 v1))
- (if (not (square-wave? gen)) (snd-display ";~A not square-wave?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";square-wave phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";square-wave frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 1.0) (snd-display ";square-wave scaler: ~F?" (mus-scaler gen)))
+ (if (fneq w 0.5) (snd-display #__line__ ";mus-width opt: ~A" w)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map square-wave: ~A ~A" v0 v1))
+ (if (not (square-wave? gen)) (snd-display #__line__ ";~A not square-wave?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";square-wave phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";square-wave frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";square-wave scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";set! square-wave scaler: ~F?" (mus-scaler gen)))
- (if (fneq (mus-width gen) 0.5) (snd-display ";square-wave width: ~A" (mus-width gen)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! square-wave scaler: ~F?" (mus-scaler gen)))
+ (if (fneq (mus-width gen) 0.5) (snd-display #__line__ ";square-wave width: ~A" (mus-width gen)))
(set! (mus-width gen) 0.75)
- (if (fneq (mus-width gen) 0.75) (snd-display ";set! square-wave width: ~A" (mus-width gen)))
- (if (or (fneq (vct-ref v0 1) 1.0) (fneq (vct-ref v0 8) 1.0)) (snd-display ";square-wave output: ~A" v0)))
+ (if (fneq (mus-width gen) 0.75) (snd-display #__line__ ";set! square-wave width: ~A" (mus-width gen)))
+ (if (or (fneq (vct-ref v0 1) 1.0) (fneq (vct-ref v0 8) 1.0)) (snd-display #__line__ ";square-wave output: ~A" v0)))
(test-gen-equal (make-square-wave 440.0) (make-square-wave 440.0) (make-square-wave 120.0))
(test-gen-equal (make-square-wave 440.0) (make-square-wave 440.0) (make-square-wave 440.0 1.0 1.0))
@@ -19837,7 +19913,7 @@ EDITS: 2
((= i 20))
(vct-set! v0 i (gen)))
(if (not (vequal v0 (vct -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5)))
- (snd-display ";square-wave -.5: ~A " v0)))
+ (snd-display #__line__ ";square-wave -.5: ~A " v0)))
(set! (mus-srate) old-srate))
(let ((gen (make-triangle-wave 440.0))
@@ -19852,15 +19928,15 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (triangle-wave gen 0.0)))
(vct-map! v1 (lambda () (if (triangle-wave? gen2) (triangle-wave gen2 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map triangle-wave: ~A ~A" v0 v1))
- (if (not (triangle-wave? gen)) (snd-display ";~A not triangle-wave?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";triangle-wave phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-phase gen1) pi) (snd-display ";init triangle-wave phase: ~F?" (mus-phase gen1)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";triangle-wave frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 1.0) (snd-display ";triangle-wave scaler: ~F?" (mus-scaler gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map triangle-wave: ~A ~A" v0 v1))
+ (if (not (triangle-wave? gen)) (snd-display #__line__ ";~A not triangle-wave?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";triangle-wave phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-phase gen1) pi) (snd-display #__line__ ";init triangle-wave phase: ~F?" (mus-phase gen1)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";triangle-wave frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";triangle-wave scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";set! triangle-wave scaler: ~F?" (mus-scaler gen)))
- (if (or (fneq (vct-ref v0 1) 0.080) (fneq (vct-ref v0 8) 0.639)) (snd-display ";triangle-wave output: ~A" v0)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! triangle-wave scaler: ~F?" (mus-scaler gen)))
+ (if (or (fneq (vct-ref v0 1) 0.080) (fneq (vct-ref v0 8) 0.639)) (snd-display #__line__ ";triangle-wave output: ~A" v0)))
(let ((gen1 (make-triangle-wave 100.0))
(gen2 (make-triangle-wave -100.0))
@@ -19869,7 +19945,7 @@ EDITS: 2
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
- (snd-display ";triangle +-: ~A" mx)))
+ (snd-display #__line__ ";triangle +-: ~A" mx)))
(test-gen-equal (make-triangle-wave 440.0) (make-triangle-wave 440.0) (make-triangle-wave 120.0))
(test-gen-equal (make-triangle-wave 440.0) (make-triangle-wave 440.0) (make-triangle-wave 440.0 1.0 1.0))
@@ -19886,14 +19962,14 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (pulse-train gen 0.0)))
(vct-map! v1 (lambda () (if (pulse-train? gen1) (pulse-train gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map pulse-train: ~A ~A" v0 v1))
- (if (not (pulse-train? gen)) (snd-display ";~A not pulse-train?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";pulse-train phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";pulse-train frequency: ~F?" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 1.0) (snd-display ";pulse-train scaler: ~F?" (mus-scaler gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map pulse-train: ~A ~A" v0 v1))
+ (if (not (pulse-train? gen)) (snd-display #__line__ ";~A not pulse-train?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";pulse-train phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";pulse-train frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";pulse-train scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";set! pulse-train scaler: ~F?" (mus-scaler gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 8) 0.0)) (snd-display ";pulse-train output: ~A" v0)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! pulse-train scaler: ~F?" (mus-scaler gen)))
+ (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 8) 0.0)) (snd-display #__line__ ";pulse-train output: ~A" v0)))
(test-gen-equal (make-pulse-train 440.0) (make-pulse-train 440.0) (make-pulse-train 120.0))
(test-gen-equal (make-pulse-train 440.0) (make-pulse-train 440.0) (make-pulse-train 440.0 1.0 1.0))
@@ -19907,7 +19983,7 @@ EDITS: 2
((= i 20))
(vct-set! v0 i (gen)))
(if (not (vequal v0 (vct 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5)))
- (snd-display ";pulse-train -.5: ~A " v0)))
+ (snd-display #__line__ ";pulse-train -.5: ~A " v0)))
(set! (mus-srate) old-srate))
@@ -19917,14 +19993,14 @@ EDITS: 2
(do ((i 1 (+ 1 i)))
((= i 10))
(vct-set! v0 i (two-pole gen 0.0)))
- (if (not (two-pole? gen)) (snd-display ";~A not ppolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";ppolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display ";ppolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) -.188) (snd-display ";ppolar b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .01) (snd-display ";ppolar b2: ~F?" (mus-b2 gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) .188)) (snd-display ";ppolar output: ~A" v0))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";freq ppolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display ";scaler ppolar: ~A" (mus-scaler gen))))
+ (if (not (two-pole? gen)) (snd-display #__line__ ";~A not ppolar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";ppolar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";ppolar a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-b1 gen) -.188) (snd-display #__line__ ";ppolar b1: ~F?" (mus-b1 gen)))
+ (if (fneq (mus-b2 gen) .01) (snd-display #__line__ ";ppolar b2: ~F?" (mus-b2 gen)))
+ (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) .188)) (snd-display #__line__ ";ppolar output: ~A" v0))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq ppolar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler ppolar: ~A" (mus-scaler gen))))
(test-gen-equal (let ((z1 (make-ppolar .1 600.0))) (two-pole z1 1.0) z1)
(let ((z2 (make-ppolar .1 600.0))) (two-pole z2 1.0) z2)
@@ -19937,22 +20013,22 @@ EDITS: 2
(let ((z3 (make-ppolar .1 600.0))) (two-pole z3 0.5) z3))
(let ((gen (make-two-pole 1200.0 .1)))
- (if (not (two-pole? gen)) (snd-display ";~A not 2ppolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";2ppolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display ";2ppolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) -.188) (snd-display ";2ppolar b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .01) (snd-display ";2ppolar b2: ~F?" (mus-b2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";freq 2ppolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display ";scaler 2ppolar: ~A" (mus-scaler gen))))
+ (if (not (two-pole? gen)) (snd-display #__line__ ";~A not 2ppolar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";2ppolar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";2ppolar a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-b1 gen) -.188) (snd-display #__line__ ";2ppolar b1: ~F?" (mus-b1 gen)))
+ (if (fneq (mus-b2 gen) .01) (snd-display #__line__ ";2ppolar b2: ~F?" (mus-b2 gen)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq 2ppolar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler 2ppolar: ~A" (mus-scaler gen))))
(let ((gen (make-two-pole :frequency 1200.0 :radius .1)))
- (if (not (two-pole? gen)) (snd-display ";~A not f2ppolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";f2ppolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display ";f2ppolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) -.188) (snd-display ";f2ppolar b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .01) (snd-display ";f2ppolar b2: ~F?" (mus-b2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";freq f2ppolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display ";scaler f2ppolar: ~A" (mus-scaler gen))))
+ (if (not (two-pole? gen)) (snd-display #__line__ ";~A not f2ppolar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";f2ppolar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";f2ppolar a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-b1 gen) -.188) (snd-display #__line__ ";f2ppolar b1: ~F?" (mus-b1 gen)))
+ (if (fneq (mus-b2 gen) .01) (snd-display #__line__ ";f2ppolar b2: ~F?" (mus-b2 gen)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq f2ppolar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler f2ppolar: ~A" (mus-scaler gen))))
(let ((gen (make-zpolar :radius .1 :frequency 1200.0))
(v0 (make-vct 10)))
@@ -19960,32 +20036,32 @@ EDITS: 2
(do ((i 1 (+ 1 i)))
((= i 10))
(vct-set! v0 i (two-zero gen 0.0)))
- (if (not (two-zero? gen)) (snd-display ";~A not zpolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";zpolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display ";zpolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) -.188) (snd-display ";zpolar a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .01) (snd-display ";zpolar a2: ~F?" (mus-a2 gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) -.188)) (snd-display ";zpolar output: ~A" v0))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";freq zpolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display ";scaler zpolar: ~A" (mus-scaler gen))))
+ (if (not (two-zero? gen)) (snd-display #__line__ ";~A not zpolar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";zpolar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";zpolar a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-a1 gen) -.188) (snd-display #__line__ ";zpolar a1: ~F?" (mus-a1 gen)))
+ (if (fneq (mus-a2 gen) .01) (snd-display #__line__ ";zpolar a2: ~F?" (mus-a2 gen)))
+ (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) -.188)) (snd-display #__line__ ";zpolar output: ~A" v0))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq zpolar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler zpolar: ~A" (mus-scaler gen))))
(let ((gen (make-two-zero :radius .1 :frequency 1200.0)))
- (if (not (two-zero? gen)) (snd-display ";~A not 2zpolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";2zpolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display ";2zpolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) -.188) (snd-display ";2zpolar a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .01) (snd-display ";2zpolar a2: ~F?" (mus-a2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";freq 2zpolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display ";scaler 2zpolar: ~A" (mus-scaler gen))))
+ (if (not (two-zero? gen)) (snd-display #__line__ ";~A not 2zpolar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";2zpolar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";2zpolar a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-a1 gen) -.188) (snd-display #__line__ ";2zpolar a1: ~F?" (mus-a1 gen)))
+ (if (fneq (mus-a2 gen) .01) (snd-display #__line__ ";2zpolar a2: ~F?" (mus-a2 gen)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq 2zpolar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler 2zpolar: ~A" (mus-scaler gen))))
(let ((gen (make-two-zero 1200.0 .1)))
- (if (not (two-zero? gen)) (snd-display ";~A not f2zpolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";f2zpolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display ";f2zpolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) -.188) (snd-display ";f2zpolar a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .01) (snd-display ";f2zpolar a2: ~F?" (mus-a2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";freq f2zpolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display ";scaler f2zpolar: ~A" (mus-scaler gen))))
+ (if (not (two-zero? gen)) (snd-display #__line__ ";~A not f2zpolar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";f2zpolar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";f2zpolar a0: ~F?" (mus-a0 gen)))
+ (if (fneq (mus-a1 gen) -.188) (snd-display #__line__ ";f2zpolar a1: ~F?" (mus-a1 gen)))
+ (if (fneq (mus-a2 gen) .01) (snd-display #__line__ ";f2zpolar a2: ~F?" (mus-a2 gen)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq f2zpolar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler f2zpolar: ~A" (mus-scaler gen))))
(test-gen-equal (let ((z1 (make-zpolar .1 600.0))) (two-zero z1 1.0) z1)
(let ((z2 (make-zpolar .1 600.0))) (two-zero z2 1.0) z2)
@@ -20013,15 +20089,15 @@ EDITS: 2
(let ((val (if (formant? gen1) (formant gen1 inp) -1.0)))
(set! inp 0.0)
val))))
- (if (not (vequal v0 v1)) (snd-display ";map formant: ~A ~A" v0 v1))
- (if (not (formant? gen)) (snd-display ";~A not formant?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";formant order: ~D?" (mus-order gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";formant frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 0) .095) (fneq (vct-ref v0 1) .161)) (snd-display ";formant output: ~A" v0))
- (if (fneq (mus-scaler gen) 0.9) (snd-display ";formant gain: ~F?" (mus-scaler gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map formant: ~A ~A" v0 v1))
+ (if (not (formant? gen)) (snd-display #__line__ ";~A not formant?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";formant order: ~D?" (mus-order gen)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";formant frequency: ~F?" (mus-frequency gen)))
+ (if (or (fneq (vct-ref v0 0) .095) (fneq (vct-ref v0 1) .161)) (snd-display #__line__ ";formant output: ~A" v0))
+ (if (fneq (mus-scaler gen) 0.9) (snd-display #__line__ ";formant gain: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 2.0)
- (if (fneq (mus-scaler gen) 2.0) (snd-display ";formant set gain: ~F?" (mus-scaler gen))))
+ (if (fneq (mus-scaler gen) 2.0) (snd-display #__line__ ";formant set gain: ~F?" (mus-scaler gen))))
(test-gen-equal (let ((f1 (make-formant 1200.0 0.9))) (formant f1 1.0) f1)
(let ((f2 (make-formant 1200.0 0.9))) (formant f2 1.0) f2)
@@ -20035,8 +20111,8 @@ EDITS: 2
(let ((frm (old-make-formant .1 440.0)))
(mus-set-formant-radius-and-frequency frm 2.0 100.0)
- (if (fneq (mus-scaler frm) 2.0) (snd-display ";set-formant-radius-etc: ~A" (mus-scaler frm)))
- (if (fneq (mus-frequency frm) 100.0) (snd-display ";set-radius-etc (frq): ~A" (mus-frequency frm))))
+ (if (fneq (mus-scaler frm) 2.0) (snd-display #__line__ ";set-formant-radius-etc: ~A" (mus-scaler frm)))
+ (if (fneq (mus-frequency frm) 100.0) (snd-display #__line__ ";set-radius-etc (frq): ~A" (mus-frequency frm))))
(let ((fs (make-vector 1))
(f0 (old-make-formant .1 1000.0))
@@ -20050,7 +20126,7 @@ EDITS: 2
(vct-set! v0 i (formant f0 val))
(vct-set! v1 i (old-formant-bank amps fs val))
(set! val 0.0))
- (if (not (vequal v0 v1)) (snd-display ";formant bank: ~A ~A" v0 v1)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";formant bank: ~A ~A" v0 v1)))
(let ((fs (make-vector 2))
(f0 (make-formant 1000.0 .1))
@@ -20068,7 +20144,7 @@ EDITS: 2
(vct-set! v0 i (+ (* 0.5 (formant f0 val)) (* 0.25 (formant f1 val))))
(vct-set! v1 i (old-formant-bank amps fs val))
(set! val 0.0))
- (if (not (vequal v0 v1)) (snd-display ";formant bank 1: ~A ~A" v0 v1)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";formant bank 1: ~A ~A" v0 v1)))
(let ((fs (make-vector 2))
(amps (make-vct 2 1.0))
@@ -20079,7 +20155,7 @@ EDITS: 2
(vct-set! amps 0 0.5)
(vct-set! amps 1 0.25)
(vct-map! v (lambda () (let ((res (formant-bank amps fs val))) (set! val 0.0) res)))
- (if (not (vequal v (vct 0.368 0.095 -0.346 -0.091 -0.020))) (snd-display ";run formant-bank: ~A" v)))
+ (if (not (vequal v (vct 0.368 0.095 -0.346 -0.091 -0.020))) (snd-display #__line__ ";run formant-bank: ~A" v)))
(let ((fs (make-vector 1))
(amps (make-vct 1 1.0)))
@@ -20087,7 +20163,7 @@ EDITS: 2
(let ((tag (catch #t
(lambda () (formant-bank amps fs 1.0))
(lambda args (car args)))))
- (if (not (equal? tag 'wrong-type-arg)) (snd-display ";formant-bank gets oscil: ~A" tag))))
+ (if (not (equal? tag 'wrong-type-arg)) (snd-display #__line__ ";formant-bank gets oscil: ~A" tag))))
(let ((ob (open-sound "oboe.snd")))
(define (poltergeist frek amp R gain frek-env R-env)
@@ -20100,7 +20176,7 @@ EDITS: 2
(mus-set-formant-radius-and-frequency filt (env re) (env fe))
outval))))
(map-chan (poltergeist 300 0.1 0.0 30.0 '(0 100 1 4000.0) '(0 0.99 1 .9))) ;; should sound like "whyieee?"
- (play-and-wait 0 ob)
+ (play ob :wait #t)
(close-sound ob))
(let ((gen (make-firmant 1200.0 0.9))
@@ -20119,15 +20195,15 @@ EDITS: 2
(let ((val (if (firmant? gen1) (firmant gen1 inp) -1.0)))
(set! inp 0.0)
val))))
- (if (not (vequal v0 v1)) (snd-display ";map firmant: ~A ~A" v0 v1))
- (if (not (firmant? gen)) (snd-display ";~A not firmant?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display ";firmant order: ~D?" (mus-order gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display ";firmant frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 0) .058) (fneq (vct-ref v0 1) .099)) (snd-display ";firmant output: ~A" v0))
- (if (fneq (mus-scaler gen) 0.9) (snd-display ";firmant gain: ~F?" (mus-scaler gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map firmant: ~A ~A" v0 v1))
+ (if (not (firmant? gen)) (snd-display #__line__ ";~A not firmant?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";firmant order: ~D?" (mus-order gen)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";firmant frequency: ~F?" (mus-frequency gen)))
+ (if (or (fneq (vct-ref v0 0) .058) (fneq (vct-ref v0 1) .099)) (snd-display #__line__ ";firmant output: ~A" v0))
+ (if (fneq (mus-scaler gen) 0.9) (snd-display #__line__ ";firmant gain: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) .20)
- (if (fneq (mus-scaler gen) .20) (snd-display ";firmant set gain: ~F?" (mus-scaler gen))))
+ (if (fneq (mus-scaler gen) .20) (snd-display #__line__ ";firmant set gain: ~F?" (mus-scaler gen))))
(test-gen-equal (let ((f1 (make-firmant 1200.0 0.9))) (firmant f1 1.0) f1)
(let ((f2 (make-firmant 1200.0 0.9))) (firmant f2 1.0) f2)
@@ -20138,8 +20214,8 @@ EDITS: 2
(test-gen-equal (let ((f1 (make-firmant 1200.0 0.9))) (firmant f1 1.0) f1)
(let ((f2 (make-firmant 1200.0 0.9))) (firmant f2 1.0) f2)
(let ((f3 (make-firmant 1200.0 0.5))) (firmant f3 1.0) f3))
-
-
+
+
(let ((gen (make-mixer 2 .5 .25 .125 1.0))
(fr0 (make-frame 2 1.0 1.0))
(fr1 (make-frame 2 0.0 0.0)))
@@ -20183,119 +20259,119 @@ EDITS: 2
(print-and-check fr0
"frame"
"frame[2]: [1.000 1.000]")
- (if (not (frame? fr0)) (snd-display ";~A not a frame?" fr0))
- (if (not (mixer? gen)) (snd-display ";~A not a mixer?" gen))
- (if (equal? fr0 fr1) (snd-display ";frame=? ~A ~A?" fr0 fr1))
- (if (not (= (mus-channels fr0) 2)) (snd-display ";frame channels: ~D?" (mus-channels fr0)))
- (if (not (= (mus-length fr1) 2)) (snd-display ";frame length: ~D?" (mus-length fr0)))
- (if (not (= (mus-channels gen) 2)) (snd-display ";mixer channels: ~D?" (mus-channels gen)))
+ (if (not (frame? fr0)) (snd-display #__line__ ";~A not a frame?" fr0))
+ (if (not (mixer? gen)) (snd-display #__line__ ";~A not a mixer?" gen))
+ (if (equal? fr0 fr1) (snd-display #__line__ ";frame=? ~A ~A?" fr0 fr1))
+ (if (not (= (mus-channels fr0) 2)) (snd-display #__line__ ";frame channels: ~D?" (mus-channels fr0)))
+ (if (not (= (mus-length fr1) 2)) (snd-display #__line__ ";frame length: ~D?" (mus-length fr0)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";mixer channels: ~D?" (mus-channels gen)))
(frame->frame fr0 gen fr1)
(if (or (fneq (frame-ref fr0 0) 1.0)
(fneq (frame-ref fr1 1) 1.25)
(fneq (mixer-ref gen 0 0) .5))
- (snd-display ";fr0: ~A" fr0))
+ (snd-display #__line__ ";fr0: ~A" fr0))
(frame-set! fr1 0 1.0)
(let ((fr3 (frame+ fr0 fr1))
(fr4 (frame* fr0 fr1))
(fr5 (sample->frame fr1 .5)))
(if (or (fneq (frame-ref fr3 0) 2.0)
(fneq (frame-ref fr4 0) 1.0))
- (snd-display ";fr+*: ~A ~A" fr3 fr4))
+ (snd-display #__line__ ";fr+*: ~A ~A" fr3 fr4))
(if (fneq (frame-ref fr5 0) .5)
- (snd-display ";sample->frame: ~A?" (frame-ref fr5 0)))
+ (snd-display #__line__ ";sample->frame: ~A?" (frame-ref fr5 0)))
(sample->frame fr1 .5 fr5)
(if (fneq (frame-ref fr5 0) .5)
- (snd-display ";repeat sample->frame: ~A?" (frame-ref fr5 0))))
+ (snd-display #__line__ ";repeat sample->frame: ~A?" (frame-ref fr5 0))))
(let ((fr3 (make-frame 2))
(fr4 (make-frame 4)))
(frame-set! fr3 0 1.0)
(set! (frame-ref fr4 0) 0.5)
(frame-set! fr4 2 1.0)
(if (not (feql (frame->list (frame+ fr3 fr4)) (list 1.5 0.0)))
- (snd-display ";frame+ unequal chans: ~A?" (frame+ fr3 fr4)))
+ (snd-display #__line__ ";frame+ unequal chans: ~A?" (frame+ fr3 fr4)))
(mus-reset fr3)
- (if (fneq (frame-ref fr3 0) 0.0) (snd-display ";reset frame: ~A" fr3)))
+ (if (fneq (frame-ref fr3 0) 0.0) (snd-display #__line__ ";reset frame: ~A" fr3)))
(let ((fr3 (make-frame 2))
(fr4 (make-frame 4)))
(frame-set! fr3 0 1.0)
(frame-set! fr4 0 0.5)
(frame-set! fr4 2 1.0)
(if (not (feql (frame->list (frame* fr3 fr4)) (list 0.5 0.0)))
- (snd-display ";frame* unequal chans: ~A?" (frame* fr3 fr4))))
+ (snd-display #__line__ ";frame* unequal chans: ~A?" (frame* fr3 fr4))))
(let* ((mx1 (make-mixer 2 1.0 0.0 0.0 1.0))
(mx2 (mixer* gen mx1))
(fr4 (make-frame 2 1.0 1.0))
(fr5 (make-frame 2 1.0 1.0))
(val (frame->sample mx1 fr1)))
- (if (fneq val 1.0) (snd-display ";frame->sample: ~A?" val))
- (if (fneq (frame->sample fr5 fr4) 2.0) (snd-display ";frame->sample ~A" (frame->sample fr5 fr4)))
- (if (not (equal? (frame->list fr1) (list 1.0 1.25))) (snd-display ";frame->list: ~A?" (frame->list fr1)))
- (if (or (fneq (mixer-ref mx2 0 1) .25) (fneq (mixer-ref mx2 1 0) .125)) (snd-display ";mixer*: ~A?" mx2))
- (if (not (equal? mx2 gen)) (snd-display ";mixer=? ~A ~A?" gen mx2))
- (if (equal? mx2 mx1) (snd-display ";mixer/=? ~A ~A?" mx1 mx2))
+ (if (fneq val 1.0) (snd-display #__line__ ";frame->sample: ~A?" val))
+ (if (fneq (frame->sample fr5 fr4) 2.0) (snd-display #__line__ ";frame->sample ~A" (frame->sample fr5 fr4)))
+ (if (not (equal? (frame->list fr1) (list 1.0 1.25))) (snd-display #__line__ ";frame->list: ~A?" (frame->list fr1)))
+ (if (or (fneq (mixer-ref mx2 0 1) .25) (fneq (mixer-ref mx2 1 0) .125)) (snd-display #__line__ ";mixer*: ~A?" mx2))
+ (if (not (equal? mx2 gen)) (snd-display #__line__ ";mixer=? ~A ~A?" gen mx2))
+ (if (equal? mx2 mx1) (snd-display #__line__ ";mixer/=? ~A ~A?" mx1 mx2))
;; mus-data doesn't apply from scheme level here
- ;(if (not (vct? (mus-data fr4))) (snd-display ";mus-data frame: ~A" (mus-data fr4)))
- ;(if (not (vct? (mus-data mx1))) (snd-display ";mus-data mixer: ~A" (mus-data mx1)))
+ ;(if (not (vct? (mus-data fr4))) (snd-display #__line__ ";mus-data frame: ~A" (mus-data fr4)))
+ ;(if (not (vct? (mus-data mx1))) (snd-display #__line__ ";mus-data mixer: ~A" (mus-data mx1)))
(mixer-set! mx2 0 0 2.0)
- (if (fneq (mixer-ref mx2 0 0) 2.0) (snd-display ";mixer-set: ~A?" mx2))
+ (if (fneq (mixer-ref mx2 0 0) 2.0) (snd-display #__line__ ";mixer-set: ~A?" mx2))
(set! fr0 (sample->frame mx2 1.0))
- (if (or (fneq (frame-ref fr0 0) 2.0) (fneq (frame-ref fr0 1) .25)) (snd-display ";sample->frame: ~A?" fr0))
+ (if (or (fneq (frame-ref fr0 0) 2.0) (fneq (frame-ref fr0 1) .25)) (snd-display #__line__ ";sample->frame: ~A?" fr0))
(let ((tag (catch #t (lambda () (mixer* fr4 fr5)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";mixer* of 2 frames: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mixer* of 2 frames: ~A" tag)))
(let ((frout (make-frame 2)))
(sample->frame mx2 1.0 frout)
- (if (not (equal? frout fr0)) (snd-display ";sample->frame via frout: ~A ~A?" frout fr0)))))
+ (if (not (equal? frout fr0)) (snd-display #__line__ ";sample->frame via frout: ~A ~A?" frout fr0)))))
(let ((fr1 (make-frame 2 .1 .2)))
(let ((val (frame+ fr1 1.0)))
(if (or (fneq (frame-ref val 0) 1.1)
(fneq (frame-ref val 1) 1.2))
- (snd-display ";8 frame-offset: ~A" val)))
+ (snd-display #__line__ ";8 frame-offset: ~A" val)))
(let ((val (frame+ 1.0 fr1)))
(if (or (fneq (frame-ref val 0) 1.1)
(fneq (frame-ref val 1) 1.2))
- (snd-display ";8 frame-offset a: ~A" val)))
+ (snd-display #__line__ ";8 frame-offset a: ~A" val)))
(let ((val (frame* fr1 2.0)))
(if (or (fneq (frame-ref val 0) 0.2)
(fneq (frame-ref val 1) 0.4))
- (snd-display ";8 frame-scale: ~A" val)))
+ (snd-display #__line__ ";8 frame-scale: ~A" val)))
(let ((val (frame* 2.0 fr1)))
(if (or (fneq (frame-ref val 0) 0.2)
(fneq (frame-ref val 1) 0.4))
- (snd-display ";8 frame-scale a: ~A" val)))
+ (snd-display #__line__ ";8 frame-scale a: ~A" val)))
(let ((val (frame-copy fr1)))
(if (or (fneq (frame-ref val 0) 0.1)
(fneq (frame-ref val 1) 0.2))
- (snd-display ";8 frame-copy a: ~A" val))))
-
+ (snd-display #__line__ ";8 frame-copy a: ~A" val))))
+
(let ((fr (make-frame! 3))
(fr1 (make-frame 3)))
- (if (not (equal? fr fr1)) (snd-display ";make-frame!: ~A ~A" fr fr1)))
+ (if (not (equal? fr fr1)) (snd-display #__line__ ";make-frame!: ~A ~A" fr fr1)))
(let ((fr (make-frame! 3 .1 .2 .3))
(fr1 (make-frame 3 .1 .2 .3)))
- (if (not (equal? fr fr1)) (snd-display ";make-frame! (args): ~A ~A" fr fr1)))
-
+ (if (not (equal? fr fr1)) (snd-display #__line__ ";make-frame! (args): ~A ~A" fr fr1)))
+
(let ((fr (frame .1 .2 .3)))
(let ((fr1 (copy fr)))
- (if (not (equal? fr fr1)) (snd-display ";copy frame: ~A ~A" fr fr1)))
+ (if (not (equal? fr fr1)) (snd-display #__line__ ";copy frame: ~A ~A" fr fr1)))
(fill! fr 0.0)
(if (not (equal? fr (frame 0.0 0.0 0.0)))
- (snd-display ";fill! frame 0.0: ~A" fr)))
+ (snd-display #__line__ ";fill! frame 0.0: ~A" fr)))
(let* ((mx1 (make-mixer 2 1 2 3 4))
(mx2 (mixer* mx1 2.0)))
(if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display ";8 mixer-scale 2: ~A" mx2))
+ (snd-display #__line__ ";8 mixer-scale 2: ~A" mx2))
(set! mx2 (mixer* 2.0 mx1))
(if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display ";8 mixer-scale 2a: ~A" mx2))
+ (snd-display #__line__ ";8 mixer-scale 2a: ~A" mx2))
(set! mx2 (mixer+ 2.0 mx1))
(if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display ";8 mixer-offset 2: ~A" mx2))
+ (snd-display #__line__ ";8 mixer-offset 2: ~A" mx2))
(set! mx2 (mixer+ mx1 2.0))
(if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display ";8 mixer-offset 2a: ~A" mx2)))
+ (snd-display #__line__ ";8 mixer-offset 2a: ~A" mx2)))
(let ((mx1 (make-scalar-mixer 2 2.0))
(mx2 (make-mixer 2 .1 .2 .3 .4)))
@@ -20304,61 +20380,61 @@ EDITS: 2
(fneq (mixer-ref mx1 0 1) 0.0)
(fneq (mixer-ref mx1 1 0) 0.0)
(fneq (mixer-ref mx1 1 1) 2.0))
- (snd-display ";make-scalar-mixer 2: ~A" mx1))
+ (snd-display #__line__ ";make-scalar-mixer 2: ~A" mx1))
(if (or (fneq (mixer-ref mx2 0 0) .1)
(fneq (mixer-ref mx2 0 1) .2)
(fneq (mixer-ref mx2 1 0) .3)
(fneq (mixer-ref mx2 1 1) .4))
- (snd-display ";make-mixer .1 .2 .3 .4: ~A" mx2))
+ (snd-display #__line__ ";make-mixer .1 .2 .3 .4: ~A" mx2))
(if (or (fneq (mixer-ref nmx 0 0) 2.1)
(fneq (mixer-ref nmx 0 1) 0.2)
(fneq (mixer-ref nmx 1 0) 0.3)
(fneq (mixer-ref nmx 1 1) 2.4))
- (snd-display ";mixer add ~A ~A: ~A" mx1 mx2 nmx))
+ (snd-display #__line__ ";mixer add ~A ~A: ~A" mx1 mx2 nmx))
(set! mx1 (mixer-scale mx1 .5))
(if (or (fneq (mixer-ref mx1 0 0) 1.0)
(fneq (mixer-ref mx1 0 1) 0.0)
(fneq (mixer-ref mx1 1 0) 0.0)
(fneq (mixer-ref mx1 1 1) 1.0))
- (snd-display ";make-scale (identity): ~A" mx1)))
+ (snd-display #__line__ ";make-scale (identity): ~A" mx1)))
(mus-reset mx1)
- (if (fneq (mixer-ref mx1 0 0) 0.0) (snd-display ";reset mixer: ~A" mx1)))
-
+ (if (fneq (mixer-ref mx1 0 0) 0.0) (snd-display #__line__ ";reset mixer: ~A" mx1)))
+
(let ((mx (mixer .1 .2 .3 .4)))
(let ((mx1 (copy mx)))
- (if (not (equal? mx mx1)) (snd-display ";mixer copy not equal? ~A ~A" mx mx1)))
+ (if (not (equal? mx mx1)) (snd-display #__line__ ";mixer copy not equal? ~A ~A" mx mx1)))
(fill! mx 0.1)
(if (not (equal? mx (mixer .1 .1 .1 .1)))
- (snd-display ";fill! mixer: ~A" mx)))
+ (snd-display #__line__ ";fill! mixer: ~A" mx)))
(let ((var (catch #t (lambda () (make-mixer 2 0.0 0.0 0.0 0.0 0.0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-mixer extra args: ~A" var)))
+ (snd-display #__line__ ";make-mixer extra args: ~A" var)))
(let ((var (catch #t (lambda () (let ((fr1 (make-frame 2 1.0 0.0))) (frame->sample (make-oscil) fr1))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";frame->sample bad arg: ~A" var)))
+ (snd-display #__line__ ";frame->sample bad arg: ~A" var)))
(let* ((hi (make-mixer 1 1))
(tag (catch #t (lambda () (mixer-set! hi 1 1 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display ";mixer-set! 1 1 of 0: ~A (~A)" tag hi)))
+ (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";mixer-set! 1 1 of 0: ~A (~A)" tag hi)))
(let* ((hi (make-mixer 1 1))
(tag (catch #t (lambda () (set! (mixer-ref hi 1 1) 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display ";set! mixer-ref 1 1 of 0: ~A (~A)" tag hi)))
+ (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";set! mixer-ref 1 1 of 0: ~A (~A)" tag hi)))
(let* ((hi (make-mixer 1))
(tag (catch #t (lambda () (mixer-set! hi 1 0 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display ";mixer-set! 1 0 of 0: ~A (~A)" tag hi)))
+ (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";mixer-set! 1 0 of 0: ~A (~A)" tag hi)))
(let* ((hi (make-mixer 1))
(tag (catch #t (lambda () (mixer-set! hi 0 1 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display ";mixer-set! 0 1 of 0: ~A (~A)" tag hi)))
+ (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";mixer-set! 0 1 of 0: ~A (~A)" tag hi)))
(let* ((hi (make-frame 1))
(tag (catch #t (lambda () (frame-set! hi 1 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display ";frame-set! 1 of 0: ~A (~A)" tag hi)))
+ (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";frame-set! 1 of 0: ~A (~A)" tag hi)))
(let* ((hi (make-frame 1))
(tag (catch #t (lambda () (set! (frame-ref hi 1) 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display ";set! frame-ref 1 of 0: ~A (~A)" tag hi)))
+ (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";set! frame-ref 1 of 0: ~A (~A)" tag hi)))
(let* ((tag (catch #t (lambda () (make-frame 0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range)) (snd-display ";make-frame 0: ~A" tag)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";make-frame 0: ~A" tag)))
(let* ((tag (catch #t (lambda () (make-mixer 0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range)) (snd-display ";make-mixer 0: ~A" tag)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";make-mixer 0: ~A" tag)))
(let ((fr1 (make-frame 1 1))
(fr2 (make-frame 2 1 2))
@@ -20380,25 +20456,25 @@ EDITS: 2
((= i 8))
(mixer-set! mx8id i i 1)
(mixer-set! mx8 i 0 1))
- (if (not (equal? (frame->frame fr1 mx1id) (make-frame 1 1))) (snd-display ";frame->frame 1 id: ~A?" (frame->frame fr1 mx1id)))
- (if (not (equal? (frame->frame fr1 mx1) (make-frame 1 5))) (snd-display ";frame->frame 1: ~A?" (frame->frame fr1 mx1)))
- (if (not (equal? (frame->frame fr1 mx2id) (make-frame 2 1 0))) (snd-display ";frame->frame 2 1 id: ~A?" (frame->frame fr1 mx2id)))
- (if (not (equal? (frame->frame fr1 mx2) (make-frame 2 1 2))) (snd-display ";frame->frame 2 1: ~A?" (frame->frame fr1 mx2)))
- (if (not (equal? (frame->frame fr1 mx4) (make-frame 4 1 1 1 1))) (snd-display ";frame->frame 4 1: ~A?" (frame->frame fr1 mx4)))
- (if (not (equal? (frame->frame fr1 mx8) (make-frame 8 1 0 0 0 0 0 0 0))) (snd-display ";frame->frame 8 1: ~A?" (frame->frame fr1 mx8)))
- (if (not (equal? (frame->frame fr2 mx1) (make-frame 1 5))) (snd-display ";frame->frame 1 2: ~A?" (frame->frame fr2 mx1)))
- (if (not (equal? (frame->frame fr2 mx2id) (make-frame 2 1 2))) (snd-display ";frame->frame 2id 2: ~A?" (frame->frame fr2 mx2id)))
- (if (not (equal? (frame->frame fr2 mx2) (make-frame 2 7 10))) (snd-display ";frame->frame 2 2: ~A?" (frame->frame fr2 mx2)))
- (if (not (equal? (frame->frame fr2 mx4id) (make-frame 4 1 2 0 0))) (snd-display ";frame->frame 4id 2: ~A?" (frame->frame fr2 mx4id)))
- (if (not (equal? (frame->frame fr2 mx8id) (make-frame 8 1 2 0 0 0 0 0 0))) (snd-display ";frame->frame 8id 2: ~A?" (frame->frame fr2 mx8id)))
- (if (not (equal? (frame->frame fr2 mx4) (make-frame 4 1 1 1 1))) (snd-display ";frame->frame 4 2: ~A?" (frame->frame fr2 mx4)))
- (if (not (equal? (frame->frame fr2 mx8) (make-frame 8 3 0 0 0 0 0 0 0))) (snd-display ";frame->frame 8 2: ~A?" (frame->frame fr2 mx8)))
- (if (not (equal? (frame->frame fr4 mx1) (make-frame 1 5))) (snd-display ";frame->frame 1 4: ~A?" (frame->frame fr4 mx1)))
- (if (not (equal? (frame->frame fr8 mx1) (make-frame 1 5))) (snd-display ";frame->frame 1 8: ~A?" (frame->frame fr8 mx1)))
- (if (not (equal? (frame->frame fr2 mx8id) (make-frame 8 1 2 0 0 0 0 0 0))) (snd-display ";frame->frame 8id 2: ~A?" (frame->frame fr2 mx8id)))
- (if (not (equal? (frame->frame fr2 mx4id) (make-frame 4 1 2 0 0))) (snd-display ";frame->frame 4id 2: ~A?" (frame->frame fr2 mx4id)))
- (if (not (equal? (frame->frame fr4 mx8) (make-frame 8 10 0 0 0 0 0 0 0))) (snd-display ";frame->frame 8 4: ~A?" (frame->frame fr4 mx8)))
- (if (not (equal? (frame->frame fr4 mx4) (make-frame 4 1 1 1 1))) (snd-display ";frame->frame 4 4: ~A?" (frame->frame fr4 mx4))))
+ (if (not (equal? (frame->frame fr1 mx1id) (make-frame 1 1))) (snd-display #__line__ ";frame->frame 1 id: ~A?" (frame->frame fr1 mx1id)))
+ (if (not (equal? (frame->frame fr1 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1: ~A?" (frame->frame fr1 mx1)))
+ (if (not (equal? (frame->frame fr1 mx2id) (make-frame 2 1 0))) (snd-display #__line__ ";frame->frame 2 1 id: ~A?" (frame->frame fr1 mx2id)))
+ (if (not (equal? (frame->frame fr1 mx2) (make-frame 2 1 2))) (snd-display #__line__ ";frame->frame 2 1: ~A?" (frame->frame fr1 mx2)))
+ (if (not (equal? (frame->frame fr1 mx4) (make-frame 4 1 1 1 1))) (snd-display #__line__ ";frame->frame 4 1: ~A?" (frame->frame fr1 mx4)))
+ (if (not (equal? (frame->frame fr1 mx8) (make-frame 8 1 0 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8 1: ~A?" (frame->frame fr1 mx8)))
+ (if (not (equal? (frame->frame fr2 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1 2: ~A?" (frame->frame fr2 mx1)))
+ (if (not (equal? (frame->frame fr2 mx2id) (make-frame 2 1 2))) (snd-display #__line__ ";frame->frame 2id 2: ~A?" (frame->frame fr2 mx2id)))
+ (if (not (equal? (frame->frame fr2 mx2) (make-frame 2 7 10))) (snd-display #__line__ ";frame->frame 2 2: ~A?" (frame->frame fr2 mx2)))
+ (if (not (equal? (frame->frame fr2 mx4id) (make-frame 4 1 2 0 0))) (snd-display #__line__ ";frame->frame 4id 2: ~A?" (frame->frame fr2 mx4id)))
+ (if (not (equal? (frame->frame fr2 mx8id) (make-frame 8 1 2 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8id 2: ~A?" (frame->frame fr2 mx8id)))
+ (if (not (equal? (frame->frame fr2 mx4) (make-frame 4 1 1 1 1))) (snd-display #__line__ ";frame->frame 4 2: ~A?" (frame->frame fr2 mx4)))
+ (if (not (equal? (frame->frame fr2 mx8) (make-frame 8 3 0 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8 2: ~A?" (frame->frame fr2 mx8)))
+ (if (not (equal? (frame->frame fr4 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1 4: ~A?" (frame->frame fr4 mx1)))
+ (if (not (equal? (frame->frame fr8 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1 8: ~A?" (frame->frame fr8 mx1)))
+ (if (not (equal? (frame->frame fr2 mx8id) (make-frame 8 1 2 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8id 2: ~A?" (frame->frame fr2 mx8id)))
+ (if (not (equal? (frame->frame fr2 mx4id) (make-frame 4 1 2 0 0))) (snd-display #__line__ ";frame->frame 4id 2: ~A?" (frame->frame fr2 mx4id)))
+ (if (not (equal? (frame->frame fr4 mx8) (make-frame 8 10 0 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8 4: ~A?" (frame->frame fr4 mx8)))
+ (if (not (equal? (frame->frame fr4 mx4) (make-frame 4 1 1 1 1))) (snd-display #__line__ ";frame->frame 4 4: ~A?" (frame->frame fr4 mx4))))
(let ((fr1 (make-frame 2))
(fr2 (make-frame 2))
@@ -20406,77 +20482,77 @@ EDITS: 2
(mx2 (make-mixer 2)))
(frame-set! fr1 0 .1)
(let ((fradd (frame+ fr1 fr1 fr2)))
- (if (not (equal? fr2 fradd)) (snd-display ";frame+ with res frame: ~A ~A" fr2 fradd))
- (if (not (equal? fr2 (make-frame 2 0.2 0.0))) (snd-display ";frame+ res: ~A" fr2))
+ (if (not (equal? fr2 fradd)) (snd-display #__line__ ";frame+ with res frame: ~A ~A" fr2 fradd))
+ (if (not (equal? fr2 (make-frame 2 0.2 0.0))) (snd-display #__line__ ";frame+ res: ~A" fr2))
(set! fradd (frame* fr1 fr1 fr2))
- (if (not (equal? fr2 fradd)) (snd-display ";frame* with res frame: ~A ~A" fr2 fradd))
- (if (or (fneq (frame-ref fr2 0) .01) (fneq (frame-ref fr2 1) 0.0)) (snd-display ";frame* res: ~A" fr2)))
+ (if (not (equal? fr2 fradd)) (snd-display #__line__ ";frame* with res frame: ~A ~A" fr2 fradd))
+ (if (or (fneq (frame-ref fr2 0) .01) (fneq (frame-ref fr2 1) 0.0)) (snd-display #__line__ ";frame* res: ~A" fr2)))
(set! (mixer-ref mx1 0 0) .1)
(let ((mxadd (mixer* mx1 mx1 mx2)))
- (if (not (equal? mx2 mxadd)) (snd-display ";mixer* with res frame: ~A ~A" mx2 mxadd))
- (if (fneq (mixer-ref mx2 0 0) .01) (snd-display ";mixer* res: ~A" mx2))))
+ (if (not (equal? mx2 mxadd)) (snd-display #__line__ ";mixer* with res frame: ~A ~A" mx2 mxadd))
+ (if (fneq (mixer-ref mx2 0 0) .01) (snd-display #__line__ ";mixer* res: ~A" mx2))))
+
-
(let ((fr1 (frame .1 .2))
(fr2 (make-frame 2 .1 .2)))
(if (not (equal? fr1 fr2))
- (snd-display ";frame...: ~A ~A" fr1 fr2)))
-
- (let ((fr1 (frame .1)))
- (if (fneq (fr1 0) .1) (snd-display ";frame gen ref (.1): ~A" (fr1 0)))
- (set! (fr1 0) .2)
- (if (fneq (fr1 0) .2) (snd-display ";frame gen ref (.2): ~A" (fr1 0)))
- (if (not (equal? fr1 (frame .2)))
- (snd-display ";frame gen set! (.2): ~A" fr1)))
-
- (let ((fr1 (frame .1 .2 .3 .4)))
- (set! (fr1 2) (+ (fr1 1) (fr1 2)))
- (if (fneq (fr1 2) .5) (snd-display ";frame gen ref/set (.5): ~A" (fr1 2))))
-
- (let ((fr1 (frame)))
- (if (or (not (frame? fr1))
- (not (equal? fr1 (make-frame 1 0.0))))
- (snd-display ";frame no args: ~A" fr1))
- (set! (fr1 0) .5)
- (if (fneq (fr1 0) .5) (snd-display ";frame ref/set no args: ~A" (fr1 0))))
-
- (let ((fr1 (make-frame 2 .1)))
- (if (not (equal? fr1 (frame .1 0.0)))
- (snd-display ";make-frame missing arg: ~A" fr1)))
-
-
- (let ((mx (mixer .1 .2 .3 .4)))
- (if (fneq (mx 0 0) .1) (snd-display ";mixer gen ref (.1): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 .4))) (snd-display ";mixer...: ~A" mx))
- (set! (mx 0 0) .5)
- (if (fneq (mx 0 0) .5) (snd-display ";mixer gen set (.5): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .5 .2 .3 .4))) (snd-display ";mixer... (after set): ~A" mx))
- (if (fneq (mx 1 0) .3) (snd-display ";mixer gen ref (.3): ~A" (mx 1 0)))
- (set! (mx 0 1) .5)
- (if (fneq (mx 0 1) .5) (snd-display ";mixer (0 1) gen set (.5): ~A" (mx 0 1)))
- (if (not (equal? mx (make-mixer 2 .5 .5 .3 .4))) (snd-display ";mixer... (after set 1): ~A" mx)))
-
- (let ((mx (mixer .1)))
- (if (not (equal? mx (make-mixer 1 .1))) (snd-display ";mixer .1: ~A" mx))
- (if (fneq (mx 0 0) .1) (snd-display ";mixer (1) gen ref (.1): ~A" (mx 0 0)))
- (set! (mx 0 0) .5)
- (if (fneq (mx 0 0) .5) (snd-display ";mixer (1) gen set (.5): ~A" (mx 0 0))))
-
- (let ((mx (mixer .1 .2 .3)))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 0.0))) (snd-display ";mixer .1 .2 .3: ~A" mx))
- (set! (mx 1 1) .5)
- (if (fneq (mx 1 1) .5) (snd-display ";mixer (1 1) gen set (.5): ~A" (mx 1 1))))
-
- (let ((mx (mixer)))
- (if (not (equal? mx (make-mixer 1 0.0))) (snd-display ";(mixer): ~A" mx)))
-
-
+ (snd-display #__line__ ";frame...: ~A ~A" fr1 fr2)))
+
+ (let ((fr1 (frame .1)))
+ (if (fneq (fr1 0) .1) (snd-display #__line__ ";frame gen ref (.1): ~A" (fr1 0)))
+ (set! (fr1 0) .2)
+ (if (fneq (fr1 0) .2) (snd-display #__line__ ";frame gen ref (.2): ~A" (fr1 0)))
+ (if (not (equal? fr1 (frame .2)))
+ (snd-display #__line__ ";frame gen set! (.2): ~A" fr1)))
+
+ (let ((fr1 (frame .1 .2 .3 .4)))
+ (set! (fr1 2) (+ (fr1 1) (fr1 2)))
+ (if (fneq (fr1 2) .5) (snd-display #__line__ ";frame gen ref/set (.5): ~A" (fr1 2))))
+
+ (let ((fr1 (frame)))
+ (if (or (not (frame? fr1))
+ (not (equal? fr1 (make-frame 1 0.0))))
+ (snd-display #__line__ ";frame no args: ~A" fr1))
+ (set! (fr1 0) .5)
+ (if (fneq (fr1 0) .5) (snd-display #__line__ ";frame ref/set no args: ~A" (fr1 0))))
+
+ (let ((fr1 (make-frame 2 .1)))
+ (if (not (equal? fr1 (frame .1 0.0)))
+ (snd-display #__line__ ";make-frame missing arg: ~A" fr1)))
+
+
+ (let ((mx (mixer .1 .2 .3 .4)))
+ (if (fneq (mx 0 0) .1) (snd-display #__line__ ";mixer gen ref (.1): ~A" (mx 0 0)))
+ (if (not (equal? mx (make-mixer 2 .1 .2 .3 .4))) (snd-display #__line__ ";mixer...: ~A" mx))
+ (set! (mx 0 0) .5)
+ (if (fneq (mx 0 0) .5) (snd-display #__line__ ";mixer gen set (.5): ~A" (mx 0 0)))
+ (if (not (equal? mx (make-mixer 2 .5 .2 .3 .4))) (snd-display #__line__ ";mixer... (after set): ~A" mx))
+ (if (fneq (mx 1 0) .3) (snd-display #__line__ ";mixer gen ref (.3): ~A" (mx 1 0)))
+ (set! (mx 0 1) .5)
+ (if (fneq (mx 0 1) .5) (snd-display #__line__ ";mixer (0 1) gen set (.5): ~A" (mx 0 1)))
+ (if (not (equal? mx (make-mixer 2 .5 .5 .3 .4))) (snd-display #__line__ ";mixer... (after set 1): ~A" mx)))
+
+ (let ((mx (mixer .1)))
+ (if (not (equal? mx (make-mixer 1 .1))) (snd-display #__line__ ";mixer .1: ~A" mx))
+ (if (fneq (mx 0 0) .1) (snd-display #__line__ ";mixer (1) gen ref (.1): ~A" (mx 0 0)))
+ (set! (mx 0 0) .5)
+ (if (fneq (mx 0 0) .5) (snd-display #__line__ ";mixer (1) gen set (.5): ~A" (mx 0 0))))
+
+ (let ((mx (mixer .1 .2 .3)))
+ (if (not (equal? mx (make-mixer 2 .1 .2 .3 0.0))) (snd-display #__line__ ";mixer .1 .2 .3: ~A" mx))
+ (set! (mx 1 1) .5)
+ (if (fneq (mx 1 1) .5) (snd-display #__line__ ";mixer (1 1) gen set (.5): ~A" (mx 1 1))))
+
+ (let ((mx (mixer)))
+ (if (not (equal? mx (make-mixer 1 0.0))) (snd-display #__line__ ";(mixer): ~A" mx)))
+
+
(for-each
(lambda (chans)
(let ((m1 (make-mixer chans)))
(if (or (not (= (mus-channels m1) chans))
(not (= (mus-length m1) chans)))
- (snd-display ";mixer ~A chans but: ~A ~A" chans (mus-channels m1) (mus-length m1)))
+ (snd-display #__line__ ";mixer ~A chans but: ~A ~A" chans (mus-channels m1) (mus-length m1)))
(do ((i 0 (+ 1 i)))
((= i chans))
(do ((j 0 (+ 1 j)))
@@ -20487,7 +20563,7 @@ EDITS: 2
(do ((j 0 (+ 1 j)))
((= j chans))
(if (fneq (mixer-ref m1 i j) (+ (* i .01) (* j .1)))
- (snd-display ";mixer[~A ~A] = ~A (~A)?" i j (mixer-ref m1 i j) (+ (* i .01) (* j .1))))))
+ (snd-display #__line__ ";mixer[~A ~A] = ~A (~A)?" i j (mixer-ref m1 i j) (+ (* i .01) (* j .1))))))
(let ((mempty (make-mixer chans))
(midentity (make-mixer chans))
(mpick (make-mixer chans)))
@@ -20502,17 +20578,17 @@ EDITS: 2
((= i chans))
(do ((j 0 (+ 1 j)))
((= j chans))
- (if (fneq (mixer-ref mzero i j) 0.0) (snd-display ";mzero ~A ~A = ~A?" i j (mixer-ref mzero i j)))
- (if (fneq (mixer-ref m1 i j) (mixer-ref msame i j)) (snd-display ";msame ~A ~A?" (mixer-ref msame i j) (mixer-ref m1 i j)))
+ (if (fneq (mixer-ref mzero i j) 0.0) (snd-display #__line__ ";mzero ~A ~A = ~A?" i j (mixer-ref mzero i j)))
+ (if (fneq (mixer-ref m1 i j) (mixer-ref msame i j)) (snd-display #__line__ ";msame ~A ~A?" (mixer-ref msame i j) (mixer-ref m1 i j)))
(if (and (fneq (mixer-ref mone i j) 0.0)
(not (= i (- chans 1)))
(not (= j (- chans 1))))
- (snd-display ";mone ~A ~A = ~A?" i j (mixer-ref mone i j)))))))))
+ (snd-display #__line__ ";mone ~A ~A = ~A?" i j (mixer-ref mone i j)))))))))
(list 1 2 4 8))
(let ((mx (make-mixer 4 4)))
(let ((tag (catch #t (lambda () (set! (mus-length mx) 2)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display ";set mixer-length: ~A ~A" tag (mus-length mx)))))
+ (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";set mixer-length: ~A ~A" tag (mus-length mx)))))
(letrec ((mixer-equal? (lambda (m1 m2)
;; this is less demanding than the built-in function
@@ -20583,155 +20659,155 @@ EDITS: 2
mx)))
)
(if (fneq (mixer-determinant (make-mixer 2 1 2 3 4)) -2.0)
- (snd-display ";mixer-determinant -2: ~A" (mixer-determinant (make-mixer 2 1 2 3 4))))
+ (snd-display #__line__ ";mixer-determinant -2: ~A" (mixer-determinant (make-mixer 2 1 2 3 4))))
(if (fneq (mixer-determinant (make-mixer 3 1 2 3 4 5 6 7 8 9)) 0.0)
- (snd-display ";mixer-determinant 0: ~A" (mixer-determinant (make-mixer 3 1 2 3 4 5 6 7 8 9))))
+ (snd-display #__line__ ";mixer-determinant 0: ~A" (mixer-determinant (make-mixer 3 1 2 3 4 5 6 7 8 9))))
(if (fneq (mixer-determinant (make-mixer 4 1 2 3 4 8 7 6 5 1 8 2 7 3 6 4 5)) -144.0) ; Eves Elementary Matrix Theory
- (snd-display ";mixer-determinant -144: ~A" (mixer-determinant (make-mixer 4 1 2 3 4 8 7 6 5 1 8 2 7 3 6 4 5))))
+ (snd-display #__line__ ";mixer-determinant -144: ~A" (mixer-determinant (make-mixer 4 1 2 3 4 8 7 6 5 1 8 2 7 3 6 4 5))))
(if (fneq (mixer-determinant (make-mixer 5 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)) -4656.0)
- (snd-display ";mixer-determinant -4656: ~A" (mixer-determinant (make-mixer 5 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47
- 53 59 61 67 71 73 79 83 89 97))))
+ (snd-display #__line__ ";mixer-determinant -4656: ~A" (mixer-determinant (make-mixer 5 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47
+ 53 59 61 67 71 73 79 83 89 97))))
(if (fneq (mixer-determinant (make-mixer 6 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89
97 101 103 107 109 113 127 131 137 139 149 151)) -14304.0)
- (snd-display ";mixer-determinant -14304: ~A"
+ (snd-display #__line__ ";mixer-determinant -14304: ~A"
(mixer-determinant (make-mixer 6 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89
97 101 103 107 109 113 127 131 137 139 149 151))))
(if (not (mixer-equal? (mixer-transpose (make-mixer 2 1 2 3 4))
(make-mixer 2 1.000 3.000 2.000 4.000)))
- (snd-display ";mixer-transpose 1: ~A" (mixer-transpose (make-mixer 2 1 2 3 4))))
+ (snd-display #__line__ ";mixer-transpose 1: ~A" (mixer-transpose (make-mixer 2 1 2 3 4))))
(if (not (mixer-equal? (mixer-transpose (make-mixer 3 1 2 3 4 5 6 7 8 9))
(make-mixer 3 1.000 4.000 7.000 2.000 5.000 8.000 3.000 6.000 9.000)))
- (snd-display ";mixer-transpose 2: ~A" (mixer-transpose (make-mixer 3 1 2 3 4 5 6 7 8 9))))
+ (snd-display #__line__ ";mixer-transpose 2: ~A" (mixer-transpose (make-mixer 3 1 2 3 4 5 6 7 8 9))))
(if (not (mixer-equal? (mixer* (make-mixer 2 1 0 0 1) (make-mixer 2 2 0 0 2))
(make-mixer 2 2.000 0.000 0.000 2.000)))
- (snd-display ";mixer* 1: ~A" (mixer* (make-mixer 2 1 0 0 1) (make-mixer 2 2 0 0 2))))
+ (snd-display #__line__ ";mixer* 1: ~A" (mixer* (make-mixer 2 1 0 0 1) (make-mixer 2 2 0 0 2))))
(if (not (mixer-equal? (mixer* (make-mixer 3 2 3 5 7 11 13 19 23 29) (make-mixer 3 41 43 47 53 59 61 67 71 73))
(make-mixer 3 576.000 618.000 642.000 1741.000 1873.000 1949.000 3941.000 4233.000 4413.000)))
- (snd-display ";mixer* 2: ~A" (mixer* (make-mixer 3 2 3 5 7 11 13 19 23 29) (make-mixer 3 41 43 47 53 59 61 67 71 73))))
+ (snd-display #__line__ ";mixer* 2: ~A" (mixer* (make-mixer 3 2 3 5 7 11 13 19 23 29) (make-mixer 3 41 43 47 53 59 61 67 71 73))))
(if (not (mixer-equal? (slow-mixer-inverse (make-mixer 2 1 0 0 1))
(make-mixer 2 1.000 0.000 0.000 1.000)))
- (snd-display ";slow-mixer-inverse 1: ~A" (slow-mixer-inverse (make-mixer 2 1 0 0 1))))
+ (snd-display #__line__ ";slow-mixer-inverse 1: ~A" (slow-mixer-inverse (make-mixer 2 1 0 0 1))))
(if (not (mixer-equal? (slow-mixer-inverse (make-mixer 2 2 3 5 8))
(make-mixer 2 8.000 -3.000 -5.000 2.000)))
- (snd-display ";slow-mixer-inverse 2: ~A" (slow-mixer-inverse (make-mixer 2 2 3 5 8))))
+ (snd-display #__line__ ";slow-mixer-inverse 2: ~A" (slow-mixer-inverse (make-mixer 2 2 3 5 8))))
(if (not (mixer-equal? (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))
(make-mixer 3 -0.077 -0.333 0.205 -0.769 0.500 -0.115 0.692 -0.167 -0.013)))
- (snd-display ";slow-mixer-inverse 3: ~A" (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))))
+ (snd-display #__line__ ";slow-mixer-inverse 3: ~A" (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))))
(if (not (mixer-equal? (slow-mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))
(make-mixer 4 -7.000 4.708 -1.042 -0.333 9.000 -6.396 1.396 0.500
-1.000 0.875 -0.042 -0.167 -1.000 0.771 -0.271 0.000)))
- (snd-display ";slow-mixer-inverse 4: ~A" (slow-mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))))
+ (snd-display #__line__ ";slow-mixer-inverse 4: ~A" (slow-mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))))
(if (not (mixer-equal? (slow-mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))
(make-mixer 6 -1.355 0.020 -0.000 1.090 -1.153 0.333 0.092 -0.025 0.000 -0.042 0.070 -0.029
1.612 0.006 -0.250 -1.205 1.249 -0.264 0.079 0.002 0.250 -0.314 0.425 -0.241
-0.551 -0.011 0.250 0.200 -0.476 0.188 0.068 0.009 -0.250 0.306 -0.145 0.028)))
- (snd-display ";slow-mixer-inverse 5: ~A" (slow-mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))))
+ (snd-display #__line__ ";slow-mixer-inverse 5: ~A" (slow-mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
+ 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))))
(if (not (mixer-equal? (mixer* (make-mixer 2 2 3 5 8) (slow-mixer-inverse (make-mixer 2 2 3 5 8)))
(make-scalar-mixer 2 1.0)))
- (snd-display ";slow-mixer-inverse 6: ~A" (mixer* (make-mixer 2 2 3 5 8) (slow-mixer-inverse (make-mixer 2 2 3 5 8)))))
+ (snd-display #__line__ ";slow-mixer-inverse 6: ~A" (mixer* (make-mixer 2 2 3 5 8) (slow-mixer-inverse (make-mixer 2 2 3 5 8)))))
(if (not (mixer-equal? (mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))
(make-scalar-mixer 3 1.0)))
- (snd-display ";slow-mixer-inverse 7: ~A"
+ (snd-display #__line__ ";slow-mixer-inverse 7: ~A"
(mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))))
(if (not (mixer-equal? (mixer-inverse (make-mixer 2 1 0 0 1))
(make-mixer 2 1.000 0.000 0.000 1.000)))
- (snd-display ";mixer-inverse 1: ~A" (mixer-inverse (make-mixer 2 1 0 0 1))))
+ (snd-display #__line__ ";mixer-inverse 1: ~A" (mixer-inverse (make-mixer 2 1 0 0 1))))
(if (not (mixer-equal? (mixer-inverse (make-mixer 2 2 3 5 8))
(make-mixer 2 8.000 -3.000 -5.000 2.000)))
- (snd-display ";mixer-inverse 2: ~A" (mixer-inverse (make-mixer 2 2 3 5 8))))
+ (snd-display #__line__ ";mixer-inverse 2: ~A" (mixer-inverse (make-mixer 2 2 3 5 8))))
(if (not (mixer-equal? (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))
(make-mixer 3 -0.077 -0.333 0.205 -0.769 0.500 -0.115 0.692 -0.167 -0.013)))
- (snd-display ";mixer-inverse 3: ~A" (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))))
+ (snd-display #__line__ ";mixer-inverse 3: ~A" (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))))
(if (not (mixer-equal? (mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))
(make-mixer 4 -7.000 4.708 -1.042 -0.333 9.000 -6.396 1.396 0.500
-1.000 0.875 -0.042 -0.167 -1.000 0.771 -0.271 0.000)))
- (snd-display ";mixer-inverse 4: ~A" (mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))))
+ (snd-display #__line__ ";mixer-inverse 4: ~A" (mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))))
(if (not (mixer-equal? (mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))
(make-mixer 6 -1.355 0.020 -0.000 1.090 -1.153 0.333 0.092 -0.025 0.000 -0.042 0.070 -0.029
1.612 0.006 -0.250 -1.205 1.249 -0.264 0.079 0.002 0.250 -0.314 0.425 -0.241
-0.551 -0.011 0.250 0.200 -0.476 0.188 0.068 0.009 -0.250 0.306 -0.145 0.028)))
- (snd-display ";mixer-inverse 5: ~A" (mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))))
+ (snd-display #__line__ ";mixer-inverse 5: ~A" (mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
+ 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))))
(if (not (mixer-equal? (mixer* (make-mixer 2 2 3 5 8) (mixer-inverse (make-mixer 2 2 3 5 8)))
(make-scalar-mixer 2 1.0)))
- (snd-display ";mixer-inverse 6: ~A" (mixer* (make-mixer 2 2 3 5 8) (mixer-inverse (make-mixer 2 2 3 5 8)))))
+ (snd-display #__line__ ";mixer-inverse 6: ~A" (mixer* (make-mixer 2 2 3 5 8) (mixer-inverse (make-mixer 2 2 3 5 8)))))
(if (not (mixer-equal? (mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))
(make-scalar-mixer 3 1.0)))
- (snd-display ";mixer-inverse 7: ~A"
+ (snd-display #__line__ ";mixer-inverse 7: ~A"
(mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))))
(if (invert-matrix (make-mixer 3 1 2 3 4 5 6 7 8 9))
- (snd-display ";invert-matrix missed singular case? ~A" (invert-matrix (make-mixer 3 1 2 3 4 5 6 7 8 9))))
+ (snd-display #__line__ ";invert-matrix missed singular case? ~A" (invert-matrix (make-mixer 3 1 2 3 4 5 6 7 8 9))))
(if (fneq (mixer-trace (make-mixer 3 1 0 0 0 2 0 0 0 3)) 6.0)
- (snd-display ";mixer-trace (6): ~A" (mixer-trace (make-mixer 3 1 0 0 0 2 0 0 0 3))))
+ (snd-display #__line__ ";mixer-trace (6): ~A" (mixer-trace (make-mixer 3 1 0 0 0 2 0 0 0 3))))
- (if (not (mixer-diagonal? (make-scalar-mixer 2 2.0))) (snd-display ";mixer-diagonal 1"))
- (if (not (mixer-diagonal? (make-mixer 3 1 0 0 0 1 0 0 0 1))) (snd-display ";mixer-diagonal 2"))
- (if (mixer-diagonal? (make-mixer 3 1 0 0 0 1 1 0 0 1)) (snd-display ";mixer-diagonal 3"))
- (if (not (mixer-diagonal? (make-mixer 3 0 0 0 0 1 0 0 0 1))) (snd-display ";mixer-diagonal 4"))
- (if (not (mixer-symmetric? (make-mixer 3 0 0 0 0 1 0 0 0 1))) (snd-display ";mixer-symmetric 1"))
- (if (not (mixer-symmetric? (make-mixer 3 1 2 0 2 1 0 0 0 1))) (snd-display ";mixer-symmetric 2"))
- (if (mixer-symmetric? (make-mixer 3 1 2 0 2 1 0 0 2 1)) (snd-display ";mixer-symmetric 3"))
- (if (not (mixer-equal? (make-scalar-mixer 2 2.0) (make-mixer 2 2.0 0 0 2.0))) (snd-display ";mixer-equal 1"))
- (if (mixer-equal? (make-mixer 2 1 2 3 4) (make-mixer 3 1 2 3 4 5 6 7 8 9)) (snd-display ";mixer-equal 2"))
- (if (mixer-equal? (make-mixer 2 1 2 3 4) (make-mixer 2 1 2 3 5)) (snd-display ";mixer-equal 3"))
+ (if (not (mixer-diagonal? (make-scalar-mixer 2 2.0))) (snd-display #__line__ ";mixer-diagonal 1"))
+ (if (not (mixer-diagonal? (make-mixer 3 1 0 0 0 1 0 0 0 1))) (snd-display #__line__ ";mixer-diagonal 2"))
+ (if (mixer-diagonal? (make-mixer 3 1 0 0 0 1 1 0 0 1)) (snd-display #__line__ ";mixer-diagonal 3"))
+ (if (not (mixer-diagonal? (make-mixer 3 0 0 0 0 1 0 0 0 1))) (snd-display #__line__ ";mixer-diagonal 4"))
+ (if (not (mixer-symmetric? (make-mixer 3 0 0 0 0 1 0 0 0 1))) (snd-display #__line__ ";mixer-symmetric 1"))
+ (if (not (mixer-symmetric? (make-mixer 3 1 2 0 2 1 0 0 0 1))) (snd-display #__line__ ";mixer-symmetric 2"))
+ (if (mixer-symmetric? (make-mixer 3 1 2 0 2 1 0 0 2 1)) (snd-display #__line__ ";mixer-symmetric 3"))
+ (if (not (mixer-equal? (make-scalar-mixer 2 2.0) (make-mixer 2 2.0 0 0 2.0))) (snd-display #__line__ ";mixer-equal 1"))
+ (if (mixer-equal? (make-mixer 2 1 2 3 4) (make-mixer 3 1 2 3 4 5 6 7 8 9)) (snd-display #__line__ ";mixer-equal 2"))
+ (if (mixer-equal? (make-mixer 2 1 2 3 4) (make-mixer 2 1 2 3 5)) (snd-display #__line__ ";mixer-equal 3"))
(if (not (mixer-equal? (mixer-poly (make-mixer 2 1 0 0 1) 1.0 1.0) (make-mixer 2 2.0 0.0 0.0 2.0)))
- (snd-display ";mixer-poly 1: ~A" (mixer-poly (make-mixer 2 1 0 0 1) 1.0 1.0)))
+ (snd-display #__line__ ";mixer-poly 1: ~A" (mixer-poly (make-mixer 2 1 0 0 1) 1.0 1.0)))
(if (not (mixer-equal? (mixer-poly (make-mixer 1 1) 1) (make-mixer 1 1.0)))
- (snd-display ";mixer-poly 2: ~A" (mixer-poly (make-mixer 1 1) 1)))
+ (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 1 1) 1)))
(if (not (mixer-equal? (mixer-poly (make-mixer 2 1 0 0 1) 1 0 0) (make-mixer 2 1.0 0.0 0.0 1.0)))
- (snd-display ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 0 0 1) 1 0 0)))
+ (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 0 0 1) 1 0 0)))
(if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0) (make-mixer 2 9.0 8.0 16.0 17.0)))
- (snd-display ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0)))
+ (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0)))
(if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 1 0) (make-mixer 2 10.0 10.0 20.0 20.0)))
- (snd-display ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 1 0)))
+ (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 1 0)))
(if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 1 2) (make-mixer 2 12.0 10.0 20.0 22.0)))
- (snd-display ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 1 2)))
+ (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 1 2)))
(if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0 0) (make-mixer 2 41.0 42.0 84.0 83.0)))
- (snd-display ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0 0)))
+ (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0 0)))
(if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 0 1 0) (make-mixer 2 42.0 44.0 88.0 86.0)))
- (snd-display ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 1 0)))
+ (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 1 0)))
(let ((fr (slow-mixer-solve (make-mixer 2 1 0 0 2) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 2.000 1.500))) (snd-display ";slow-mixer-solve 1: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 2 2.000 1.500))) (snd-display #__line__ ";slow-mixer-solve 1: ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 2 1 1 0 1) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 -1.000 3.000))) (snd-display ";slow-mixer-solve 2: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 2 -1.000 3.000))) (snd-display #__line__ ";slow-mixer-solve 2: ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 1))))
- (if fr (snd-display ";slow-mixer-solve 3 (#f): ~A" fr)))
+ (if fr (snd-display #__line__ ";slow-mixer-solve 3 (#f): ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 .333))))
- (if fr (snd-display ";slow-mixer-solve 4 (#f): ~A" fr)))
+ (if fr (snd-display #__line__ ";slow-mixer-solve 4 (#f): ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 3 2 1 3 1 -1 1 1 1 2) (make-frame 3 1 1 1))))
- (if (not (frame-equal? fr (make-frame 3 -2.000 -1.000 2.000))) (snd-display ";slow-mixer-solve 5: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 3 -2.000 -1.000 2.000))) (snd-display #__line__ ";slow-mixer-solve 5: ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 3 1 -1 -1 3 -3 2 2 -1 1) (make-frame 3 2 16 9))))
- (if (not (frame-equal? fr (make-frame 3 3.000 -1.000 2.000))) (snd-display ";slow-mixer-solve 6: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 3 3.000 -1.000 2.000))) (snd-display #__line__ ";slow-mixer-solve 6: ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 3 1 1 1 2 3 1 1 -1 -2) (make-frame 3 3 5 -5))))
- (if (not (frame-equal? fr (make-frame 3 0.000 1.000 2.000))) (snd-display ";slow-mixer-solve 7: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 3 0.000 1.000 2.000))) (snd-display #__line__ ";slow-mixer-solve 7: ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 1 .5) (make-frame 1 2))))
- (if (not (frame-equal? fr (make-frame 1 4.000))) (snd-display ";slow-mixer-solve 8: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 1 4.000))) (snd-display #__line__ ";slow-mixer-solve 8: ~A" fr)))
(let ((fr (slow-mixer-solve (make-mixer 4 2 0 0 0 0 3 0 0 0 0 4 0 0 0 0 5) (make-frame 4 1 1 1 1))))
- (if (not (frame-equal? fr (make-frame 4 0.500 0.333 0.250 0.200))) (snd-display ";slow-mixer-solve 9: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 4 0.500 0.333 0.250 0.200))) (snd-display #__line__ ";slow-mixer-solve 9: ~A" fr)))
(let ((fr (mixer-solve (make-mixer 2 1 0 0 2) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 2.000 1.500))) (snd-display ";mixer-solve 1: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 2 2.000 1.500))) (snd-display #__line__ ";mixer-solve 1: ~A" fr)))
(let ((fr (mixer-solve (make-mixer 2 1 1 0 1) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 -1.000 3.000))) (snd-display ";mixer-solve 2: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 2 -1.000 3.000))) (snd-display #__line__ ";mixer-solve 2: ~A" fr)))
(let ((fr (mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 1))))
- (if fr (snd-display ";mixer-solve 3 (#f): ~A" fr)))
+ (if fr (snd-display #__line__ ";mixer-solve 3 (#f): ~A" fr)))
(let ((fr (mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 .333))))
- (if fr (snd-display ";mixer-solve 4 (#f): ~A" fr)))
+ (if fr (snd-display #__line__ ";mixer-solve 4 (#f): ~A" fr)))
(let ((fr (mixer-solve (make-mixer 3 2 1 3 1 -1 1 1 1 2) (make-frame 3 1 1 1))))
- (if (not (frame-equal? fr (make-frame 3 -2.000 -1.000 2.000))) (snd-display ";mixer-solve 5: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 3 -2.000 -1.000 2.000))) (snd-display #__line__ ";mixer-solve 5: ~A" fr)))
(let ((fr (mixer-solve (make-mixer 3 1 -1 -1 3 -3 2 2 -1 1) (make-frame 3 2 16 9))))
- (if (not (frame-equal? fr (make-frame 3 3.000 -1.000 2.000))) (snd-display ";mixer-solve 6: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 3 3.000 -1.000 2.000))) (snd-display #__line__ ";mixer-solve 6: ~A" fr)))
(let ((fr (mixer-solve (make-mixer 3 1 1 1 2 3 1 1 -1 -2) (make-frame 3 3 5 -5))))
- (if (not (frame-equal? fr (make-frame 3 0.000 1.000 2.000))) (snd-display ";mixer-solve 7: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 3 0.000 1.000 2.000))) (snd-display #__line__ ";mixer-solve 7: ~A" fr)))
(let ((fr (mixer-solve (make-mixer 1 .5) (make-frame 1 2))))
- (if (not (frame-equal? fr (make-frame 1 4.000))) (snd-display ";mixer-solve 8: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 1 4.000))) (snd-display #__line__ ";mixer-solve 8: ~A" fr)))
(let ((fr (mixer-solve (make-mixer 4 2 0 0 0 0 3 0 0 0 0 4 0 0 0 0 5) (make-frame 4 1 1 1 1))))
- (if (not (frame-equal? fr (make-frame 4 0.500 0.333 0.250 0.200))) (snd-display ";mixer-solve 9: ~A" fr)))
+ (if (not (frame-equal? fr (make-frame 4 0.500 0.333 0.250 0.200))) (snd-display #__line__ ";mixer-solve 9: ~A" fr)))
;; try random input to mixer-inverse
(do ((k 2 (+ 1 k)))
@@ -20740,162 +20816,162 @@ EDITS: 2
(imx (mixer-inverse (mixer-copy mx)))
(mmx (mixer* mx imx)))
(if (not (mixer-equal? mmx (make-scalar-mixer k 1.0)))
- (snd-display ";mixer-inverse r~D: ~A * ~A -> ~A" k mx imx mmx))))
+ (snd-display #__line__ ";mixer-inverse r~D: ~A * ~A -> ~A" k mx imx mmx))))
(let ((fr (frame-reverse! (make-frame 2 .5 2.0))))
(if (not (frame-equal? fr (make-frame 2 2.0 0.5)))
- (snd-display ";frame-reverse! 2: ~A" fr)))
+ (snd-display #__line__ ";frame-reverse! 2: ~A" fr)))
(let ((fr (frame-reverse! (make-frame 3 .5 1.0 2.0))))
(if (not (frame-equal? fr (make-frame 3 2.0 1.0 0.5)))
- (snd-display ";frame-reverse! 3: ~A" fr)))
+ (snd-display #__line__ ";frame-reverse! 3: ~A" fr)))
(let ((hi (make-mixer 3 10 5 1 1 20 5 1 3 7))
(ho (make-mixer 3 10 5 2 1 3 2 1 3 2)))
;; these adapted from gsl linalg tests
(let ((val (mixer* hi ho)))
(if (not (mixer-equal? val (make-mixer 3 106.000 68.000 32.000 35.000 80.000 52.000 20.000 35.000 22.000)))
- (snd-display ";mixer* 3x3 1: ~A" val)))
+ (snd-display #__line__ ";mixer* 3x3 1: ~A" val)))
(let ((val (mixer* hi (mixer-transpose ho))))
(if (not (mixer-equal? val (make-mixer 3 127.000 27.000 27.000 120.000 71.000 71.000 39.000 24.000 24.000)))
- (snd-display ";mixer* 3x3 2: ~A" val)))
+ (snd-display #__line__ ";mixer* 3x3 2: ~A" val)))
(let ((val (mixer* (mixer-transpose hi) (mixer-transpose ho))))
(if (not (mixer-equal? val (make-mixer 3 107.000 15.000 15.000 156.000 71.000 71.000 49.000 30.000 30.000)))
- (snd-display ";mixer* 3x3 2: ~A" val))))
+ (snd-display #__line__ ";mixer* 3x3 2: ~A" val))))
;; from Golub and van Loan:
(let ((val (mixer-solve (make-mixer 2 .001 1.0 1.0 2.0) (make-frame 2 1.0 3.0))))
(if (not (frame-equal? val (make-frame 2 1.002 0.999)))
- (snd-display ";mixer-solve G1: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G1: ~A" val)))
(let ((val (mixer-solve (make-mixer 2 .0001 1.0 1.0 1.0) (make-frame 2 1.0 3.0))))
(if (not (frame-equal? val (make-frame 2 2.000 1.000)))
- (snd-display ";mixer-solve G2: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G2: ~A" val)))
(let ((val (mixer-solve (make-mixer 2 .986 .579 .409 .237) (make-frame 2 .235 .107))))
(if (not (frame-equal? val (make-frame 2 2.000 -3.000)))
- (snd-display ";mixer-solve G3: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G3: ~A" val)))
(let ((val (invert-matrix (make-mixer 3 2 -1 1 -1 1.0e-6 1.0e-6 1 1.0e-6 1.0e-6) (make-frame 3 (* 2 (+ 1 1.0e-6)) -1.0e-6 1.0e-6))))
(if (or (not val)
(not (frame-equal? (cadr val) (make-frame 3 0.000 -1.000 1.000))))
- (snd-display ";mixer-solve G4: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G4: ~A" val)))
(let ((val (invert-matrix (make-mixer 3 2 -1 1 -1 1.0e-7 1.0e-7 1 1.0e-7 1.0e-7) (make-frame 3 (* 2 (+ 1 1.0e-7)) -1.0e-7 1.0e-7))))
(if (or (not val)
(not (frame-equal? (cadr val) (make-frame 3 0.000 -1.000 1.000))))
- (snd-display ";mixer-solve G5: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G5: ~A" val)))
(let ((val (mixer-solve (make-mixer 3 1 4 7 2 5 8 3 6 10) (make-frame 3 1 1 1))))
(if (not (frame-equal? val (make-frame 3 -0.333 0.333 -0.000)))
- (snd-display ";mixer-solve G6: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G6: ~A" val)))
(let ((val (mixer-solve (make-mixer 2 1 0 0 1.0e-6) (make-frame 2 1 1.0e-6))))
(if (not (frame-equal? val (make-frame 2 1.000 1.000)))
- (snd-display ";mixer-solve G7: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G7: ~A" val)))
(let ((val (invert-matrix (make-mixer 2 1 0 0 1.0e-8) (make-frame 2 1 1.0e-8) 1.0e-10)))
(if (or (not val)
(not (frame-equal? (cadr val) (make-frame 2 1.000 1.000))))
- (snd-display ";mixer-solve G8: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G8: ~A" val)))
(let ((val (invert-matrix (make-mixer 2 1 0 0 1.0e-12) (make-frame 2 1 1.0e-12) 1.0e-14)))
(if (or (not val)
(not (frame-equal? (cadr val) (make-frame 2 1.000 1.000))))
- (snd-display ";mixer-solve G9: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G9: ~A" val)))
(let ((val (mixer-solve (make-mixer 2 10 100000 1 1) (make-frame 2 100000 2))))
(if (not (frame-equal? val (make-frame 2 1.000 1.000)))
- (snd-display ";mixer-solve G10: ~A" val)))
+ (snd-display #__line__ ";mixer-solve G10: ~A" val)))
(let ((val (frame-cross (make-frame 3 0 0 1) (make-frame 3 0 -1 0))))
(if (not (frame-equal? val (make-frame 3 1.000 0.000 0.000)))
- (snd-display ";frame-cross: ~A" val)))
+ (snd-display #__line__ ";frame-cross: ~A" val)))
(let ((val (frame-normalize (make-frame 3 4 3 0))))
(if (not (frame-equal? val (make-frame 3 0.800 0.600 0.000)))
- (snd-display ";frame-normalize: ~A" val)))
+ (snd-display #__line__ ";frame-normalize: ~A" val)))
)
(let ((gen (make-fft-window hamming-window 16)))
(if (not (vequal gen (vct 0.080 0.115 0.215 0.364 0.540 0.716 0.865 1.000 1.000 0.865 0.716 0.540 0.364 0.215 0.115 0.080)))
- (snd-display ";hamming window: ~A" gen)))
+ (snd-display #__line__ ";hamming window: ~A" gen)))
(let ((gen (make-fft-window rectangular-window 16)))
(if (not (vequal gen (vct 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (snd-display ";rectangular window: ~A" gen)))
+ (snd-display #__line__ ";rectangular window: ~A" gen)))
(let ((gen (make-fft-window hann-window 16)))
(if (not (vequal gen (vct 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
- (snd-display ";hann window: ~A" gen)))
+ (snd-display #__line__ ";hann window: ~A" gen)))
(let ((gen (make-fft-window welch-window 16)))
(if (not (vequal gen (vct 0.000 0.234 0.438 0.609 0.750 0.859 0.938 1.000 1.000 0.938 0.859 0.750 0.609 0.438 0.234 0.000)))
- (snd-display ";welch window: ~A" gen)))
+ (snd-display #__line__ ";welch window: ~A" gen)))
(let ((gen (make-fft-window connes-window 16)))
(if (not (vequal gen (vct 0.000 0.055 0.191 0.371 0.562 0.739 0.879 1.000 1.000 0.879 0.739 0.562 0.371 0.191 0.055 0.000)))
- (snd-display ";connes window: ~A" gen)))
+ (snd-display #__line__ ";connes window: ~A" gen)))
(let ((gen (make-fft-window parzen-window 16)))
(if (not (vequal gen (vct 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
- (snd-display ";parzen window: ~A" gen)))
+ (snd-display #__line__ ";parzen window: ~A" gen)))
(let ((gen (make-fft-window bartlett-window 16)))
(if (not (vequal gen (vct 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
- (snd-display ";bartlett window: ~A" gen)))
+ (snd-display #__line__ ";bartlett window: ~A" gen)))
(let ((gen (make-fft-window blackman2-window 16)))
(if (not (vequal gen (vct 0.005 0.020 0.071 0.177 0.344 0.558 0.775 1.000 1.000 0.775 0.558 0.344 0.177 0.071 0.020 0.005)))
- (snd-display ";blackman2 window: ~A" gen)))
+ (snd-display #__line__ ";blackman2 window: ~A" gen)))
(let ((gen (make-fft-window blackman3-window 16)))
(if (not (vequal gen (vct 0.000 0.003 0.022 0.083 0.217 0.435 0.696 1.000 1.000 0.696 0.435 0.217 0.083 0.022 0.003 0.000)))
- (snd-display ";blackman3 window: ~A" gen)))
+ (snd-display #__line__ ";blackman3 window: ~A" gen)))
(let ((gen (make-fft-window blackman4-window 16)))
(if (not (vequal gen (vct 0.002 0.002 0.003 0.017 0.084 0.263 0.562 1.000 1.000 0.562 0.263 0.084 0.017 0.003 0.002 0.002)))
- (snd-display ";blackman4 window: ~A" gen)))
-
+ (snd-display #__line__ ";blackman4 window: ~A" gen)))
+
(let ((gen (make-fft-window blackman5-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.003 0.022 0.097 0.280 0.574 1.000 1.000 0.574 0.280 0.097 0.022 0.003 0.000 0.000)))
- (snd-display ";blackman5 window: ~A" gen)))
+ (snd-display #__line__ ";blackman5 window: ~A" gen)))
(let ((gen (make-fft-window blackman6-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.001 0.011 0.064 0.223 0.520 1.000 1.000 0.520 0.223 0.064 0.011 0.001 0.000 0.000)))
- (snd-display ";blackman6 window: ~A" gen)))
+ (snd-display #__line__ ";blackman6 window: ~A" gen)))
(let ((gen (make-fft-window blackman7-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.000 0.006 0.042 0.177 0.471 1.000 1.000 0.471 0.177 0.042 0.006 0.000 0.000 0.000)))
- (snd-display ";blackman7 window: ~A" gen)))
+ (snd-display #__line__ ";blackman7 window: ~A" gen)))
(let ((gen (make-fft-window blackman8-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.000 0.003 0.028 0.141 0.426 1.000 1.000 0.426 0.141 0.028 0.003 0.000 0.000 0.000)))
- (snd-display ";blackman8 window: ~A" gen)))
+ (snd-display #__line__ ";blackman8 window: ~A" gen)))
(let ((gen (make-fft-window blackman9-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.000 0.001 0.018 0.112 0.385 1.000 1.000 0.385 0.112 0.018 0.001 0.000 0.000 -0.000)))
- (snd-display ";blackman9 window: ~A" gen)))
+ (snd-display #__line__ ";blackman9 window: ~A" gen)))
(let ((gen (make-fft-window blackman10-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.000 0.001 0.012 0.089 0.349 1.000 1.000 0.349 0.089 0.012 0.001 0.000 0.000 -0.000)))
- (snd-display ";blackman10 window: ~A" gen)))
+ (snd-display #__line__ ";blackman10 window: ~A" gen)))
(let ((gen (make-fft-window rv2-window 16)))
(if (not (vequal gen (vct 0.000 0.001 0.021 0.095 0.250 0.478 0.729 1.000 1.000 0.729 0.478 0.250 0.095 0.021 0.001 0.000)))
- (snd-display ";rv2 window: ~A" gen)))
+ (snd-display #__line__ ";rv2 window: ~A" gen)))
(let ((gen (make-fft-window rv3-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.003 0.029 0.125 0.330 0.622 1.000 1.000 0.622 0.330 0.125 0.029 0.003 0.000 0.000)))
- (snd-display ";rv3 window: ~A" gen)))
+ (snd-display #__line__ ";rv3 window: ~A" gen)))
(let ((gen (make-fft-window rv4-window 16)))
(if (not (vequal gen (vct 0.000 0.000 0.000 0.009 0.062 0.228 0.531 1.000 1.000 0.531 0.228 0.062 0.009 0.000 0.000 0.000)))
- (snd-display ";rv4 window: ~A" gen)))
-
+ (snd-display #__line__ ";rv4 window: ~A" gen)))
+
(let ((gen (make-fft-window exponential-window 16)))
(if (not (vequal gen (vct 0.000 0.087 0.181 0.283 0.394 0.515 0.646 0.944 0.944 0.646 0.515 0.394 0.283 0.181 0.087 0.000)))
- (snd-display ";exponential window: ~A" gen)))
+ (snd-display #__line__ ";exponential window: ~A" gen)))
(let ((gen (make-fft-window riemann-window 16)))
(if (not (vequal gen (vct 0.000 0.139 0.300 0.471 0.637 0.784 0.900 1.000 1.000 0.900 0.784 0.637 0.471 0.300 0.139 0.000)))
- (snd-display ";riemann window: ~A" gen)))
+ (snd-display #__line__ ";riemann window: ~A" gen)))
(let ((gen (make-fft-window kaiser-window 16 2.5)))
(if (not (vequal gen (vct 0.304 0.426 0.550 0.670 0.779 0.871 0.941 1.000 1.000 0.941 0.871 0.779 0.670 0.550 0.426 0.304)))
- (snd-display ";kaiser window: ~A" gen)))
+ (snd-display #__line__ ";kaiser window: ~A" gen)))
(let ((gen (make-fft-window cauchy-window 16 2.5)))
(if (not (vequal gen (vct 0.138 0.173 0.221 0.291 0.390 0.532 0.719 1.000 1.000 0.719 0.532 0.390 0.291 0.221 0.173 0.138)))
- (snd-display ";cauchy window: ~A" gen)))
+ (snd-display #__line__ ";cauchy window: ~A" gen)))
(let ((gen (make-fft-window poisson-window 16 2.5)))
(if (not (vequal gen (vct 0.082 0.112 0.153 0.210 0.287 0.392 0.535 1.000 1.000 0.535 0.392 0.287 0.210 0.153 0.112 0.082)))
- (snd-display ";poisson window: ~A" gen)))
+ (snd-display #__line__ ";poisson window: ~A" gen)))
(let ((gen (make-fft-window gaussian-window 16 1.0)))
(if (not (vequal gen (vct 0.607 0.682 0.755 0.823 0.882 0.932 0.969 1.000 1.000 0.969 0.932 0.882 0.823 0.755 0.682 0.607)))
- (snd-display ";gaussian window: ~A" gen)))
+ (snd-display #__line__ ";gaussian window: ~A" gen)))
(let ((gen (make-fft-window tukey-window 16)))
(if (not (vequal gen (vct 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
- (snd-display ";tukey window: ~A" gen)))
+ (snd-display #__line__ ";tukey window: ~A" gen)))
(let ((gen (make-fft-window hann-poisson-window 16)))
(if (not (vequal gen (vct 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
- (snd-display ";tukey window: ~A" gen)))
+ (snd-display #__line__ ";tukey window: ~A" gen)))
(let ((gen (make-fft-window bohman-window 16)))
(if (not (vequal gen (vct 0.000 0.006 0.048 0.151 0.318 0.533 0.755 1.000 1.000 0.755 0.533 0.318 0.151 0.048 0.006 0.000)))
- (snd-display ";bohman window: ~A" gen)))
-
+ (snd-display #__line__ ";bohman window: ~A" gen)))
+
(for-each
(lambda (window-data)
(let ((window (car window-data))
@@ -20911,7 +20987,7 @@ EDITS: 2
(vct-set! v2 i val)
(vct-set! v2 j val)))
(if (not (vequal v1 v2))
- (snd-display ";~A by hand:~%; mus: ~A~%; loc: ~A" name v1 v2)))))
+ (snd-display #__line__ ";~A by hand:~%; mus: ~A~%; loc: ~A" name v1 v2)))))
(list
(list hann-window "hann" (lambda (ang)
@@ -21086,7 +21162,7 @@ EDITS: 2
(set! expsum (* expsum (+ 1.0 (/ (log 2) 8.0))))
result))))
))
-
+
(let ((win (make-fft-window bartlett-hann-window 32))
(unhappy #f))
(do ((i 0 (+ 1 i)))
@@ -21095,7 +21171,7 @@ EDITS: 2
(if (> (abs (- val (vct-ref win i))) .03)
(begin
(set! unhappy #t)
- (snd-display ";bartlett-hann at ~D: ~A ~A" i val (vct-ref win i)))))))
+ (snd-display #__line__ ";bartlett-hann at ~D: ~A ~A" i val (vct-ref win i)))))))
(let ((win (make-fft-window flat-top-window 32))
(unhappy #f))
(do ((i 0 (+ 1 i)))
@@ -21108,23 +21184,23 @@ EDITS: 2
(if (> (abs (- val (vct-ref win i))) .1) ; error is much less, of course, in a bigger window
(begin
(set! unhappy #t)
- (snd-display ";flat-top at ~D: ~A ~A" i val (vct-ref win i)))))))
+ (snd-display #__line__ ";flat-top at ~D: ~A ~A" i val (vct-ref win i)))))))
(catch #t
(lambda ()
(let ((gen (make-fft-window samaraki-window 16)))
(if (not (vequal gen (vct 1.000 0.531 0.559 0.583 0.604 0.620 0.631 0.638 0.640 0.638 0.631 0.620 0.604 0.583 0.559 0.531)))
- (snd-display ";samaraki window: ~A" gen)))
+ (snd-display #__line__ ";samaraki window: ~A" gen)))
(let ((gen (make-fft-window ultraspherical-window 16)))
(if (not (vequal gen (vct 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
- (snd-display ";ultraspherical window: ~A" gen)))
+ (snd-display #__line__ ";ultraspherical window: ~A" gen)))
(let ((gen (make-fft-window dolph-chebyshev-window 16)))
(if (not (vequal gen (vct 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
- (snd-display ";dolph-chebyshev window: ~A" gen)))
+ (snd-display #__line__ ";dolph-chebyshev window: ~A" gen)))
(without-errors
(let ((gen (make-fft-window dolph-chebyshev-window 16 1.0)))
(if (not (vequal gen (vct 1.000 0.274 0.334 0.393 0.446 0.491 0.525 0.546 0.553 0.546 0.525 0.491 0.446 0.393 0.334 0.274)))
- (snd-display ";dolph-chebyshev window: ~A" gen))))
+ (snd-display #__line__ ";dolph-chebyshev window: ~A" gen))))
(let ((multra (lambda (N gamma xmu)
(let* ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N)))
@@ -21149,56 +21225,56 @@ EDITS: 2
im))))
(let ((val1 (make-fft-window ultraspherical-window 16 0.0 0.0))
(val2 (make-fft-window dolph-chebyshev-window 16 0.0)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/dolph 0: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/dolph 0: ~A ~A" val1 val2)))
(let ((val1 (make-fft-window ultraspherical-window 16 0.0 1.0))
(val2 (make-fft-window samaraki-window 16 0.0)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/sam 0: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 0: ~A ~A" val1 val2)))
(let ((val1 (make-fft-window ultraspherical-window 16 0.5 0.0))
(val2 (make-fft-window dolph-chebyshev-window 16 0.5)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/dolph 5: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/dolph 5: ~A ~A" val1 val2)))
(let ((val1 (make-fft-window ultraspherical-window 16 0.5 1.0))
(val2 (make-fft-window samaraki-window 16 0.5)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/sam 5: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 5: ~A ~A" val1 val2)))
(let ((val1 (dolph 16 1.0))
(val2 (make-fft-window dolph-chebyshev-window 16 1.0)))
- (if (not (vequal val1 val2)) (snd-display ";dolph/dolph 1: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";dolph/dolph 1: ~A ~A" val1 val2)))
(let ((val1 (vector->vct (dolph-1 16 1.0)))
(val2 (make-fft-window dolph-chebyshev-window 16 1.0)))
- (if (not (vequal val1 val2)) (snd-display ";dolph-1/dolph 1: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";dolph-1/dolph 1: ~A ~A" val1 val2)))
(if (and (provided? 'gsl)
(defined? 'gsl-gegenbauer))
(begin
(let ((val1 (multra 16 1.0 1.0))
(val2 (make-fft-window samaraki-window 16 1.0)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/sam 0: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 0: ~A ~A" val1 val2)))
(let ((val1 (multra 16 0.5 1.0))
(val2 (make-fft-window samaraki-window 16 0.5)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/sam 5: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 5: ~A ~A" val1 val2)))
(let ((val1 (multra 16 0.5 0.5))
(val2 (make-fft-window ultraspherical-window 16 0.5 0.5)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/ultra 5: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/ultra 5: ~A ~A" val1 val2)))
(let ((val1 (multra 16 0.5 2.5))
(val2 (make-fft-window ultraspherical-window 16 0.5 2.5)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/ultra 5: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/ultra 5: ~A ~A" val1 val2)))
(let ((val1 (multra 16 2.5 2.5))
(val2 (make-fft-window ultraspherical-window 16 2.5 2.5)))
- (if (not (vequal val1 val2)) (snd-display ";ultra/ultra 5: ~A ~A" val1 val2)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/ultra 5: ~A ~A" val1 val2)))
))))
- (lambda args (snd-display ";new windows: ~A" args)))
-
+ (lambda args (snd-display #__line__ ";new windows: ~A" args)))
+
(if (defined? 'gsl-eigenvectors)
(begin
(let ((win (make-dpss-window 16 .01)))
(if (not (vequal win (vct 0.964 0.973 0.981 0.987 0.992 0.996 0.999 1.000 1.000 0.999 0.996 0.992 0.987 0.981 0.973 0.964)))
- (snd-display ";make-dpss-window 16 .01: ~A" win)))
+ (snd-display #__line__ ";make-dpss-window 16 .01: ~A" win)))
(let ((win (make-dpss-window 16 .1)))
(if (not (vequal win (vct 0.090 0.193 0.332 0.494 0.664 0.818 0.936 1.000 1.000 0.936 0.818 0.664 0.494 0.332 0.193 0.090)))
- (snd-display ";make-dpss-window 16 .1: ~A" win)))
+ (snd-display #__line__ ";make-dpss-window 16 .1: ~A" win)))
(let ((win (make-dpss-window 32 .09)))
(if (not (vequal win (vct 0.004 0.011 0.025 0.050 0.086 0.138 0.206 0.290 0.388 0.496 0.610 0.722 0.823 0.908 0.968 1.000
1.000 0.968 0.908 0.823 0.722 0.610 0.496 0.388 0.290 0.206 0.138 0.086 0.050 0.025 0.011 0.004)))
- (snd-display ";make-dpss-window 32 .09: ~A" win)))
-
+ (snd-display #__line__ ";make-dpss-window 32 .09: ~A" win)))
+
(for-each
(lambda (n)
(for-each
@@ -21206,23 +21282,23 @@ EDITS: 2
(let ((win1 (make-dpss-window n beta))
(win2 (make-fft-window dpss-window n beta)))
(if (not (vequal win1 win2))
- (snd-display ";dpss-windows:~% ~A~% ~A" win1 win2))))
+ (snd-display #__line__ ";dpss-windows:~% ~A~% ~A" win1 win2))))
(list .01 .07 .12 .2)))
(list 16 32))))
-
+
(let ((win (make-papoulis-window 32)))
(if (not (vequal win (vct 0.000 0.001 0.006 0.021 0.048 0.091 0.151 0.227 0.318 0.422 0.533 0.647 0.755 0.852 0.930 0.982
1.000 0.982 0.930 0.852 0.755 0.647 0.533 0.422 0.318 0.227 0.151 0.091 0.048 0.021 0.006 0.001)))
- (snd-display ";make-papoulis-window 32: ~A" win)))
-
+ (snd-display #__line__ ";make-papoulis-window 32: ~A" win)))
+
(for-each
(lambda (n)
(let ((win1 (make-papoulis-window n))
(win2 (make-fft-window papoulis-window n)))
(if (not (vequal win1 win2))
- (snd-display ";papoulis-windows:~% ~A~% ~A" win1 win2))))
+ (snd-display #__line__ ";papoulis-windows:~% ~A~% ~A" win1 win2))))
(list 32 64 256))
-
+
(let ((v0 (make-vct 10))
(gen (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 11))
@@ -21231,10 +21307,10 @@ EDITS: 2
(print-and-check gen
"env"
"env linear, pass: 0 (dur: 11), index: 0, scaler: 0.5000, offset: 0.0000, data: [0.000 0.000 1.000 1.000 2.000 0.000]")
- (if (not (env? gen)) (snd-display ";~A not env?" gen))
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";env scaler ~F?" (mus-scaler gen)))
- (if (fneq (mus-increment gen) 1.0) (snd-display ";env base (1.0): ~A?" (mus-increment gen)))
- (if (not (= (mus-length gen) 11)) (snd-display ";env length: ~A" (mus-length gen)))
+ (if (not (env? gen)) (snd-display #__line__ ";~A not env?" gen))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";env scaler ~F?" (mus-scaler gen)))
+ (if (fneq (mus-increment gen) 1.0) (snd-display #__line__ ";env base (1.0): ~A?" (mus-increment gen)))
+ (if (not (= (mus-length gen) 11)) (snd-display #__line__ ";env length: ~A" (mus-length gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (env gen)))
@@ -21242,59 +21318,59 @@ EDITS: 2
(vct-map! v1 (lambda ()
(set! off (mus-offset gen1))
(if (env? gen1) (env gen1) -1.0)))
- (if (fneq off 0.0) (snd-display ";mus-offset opt: ~A" off)))
- (if (not (vequal v0 v1)) (snd-display ";map env: ~A ~A" v0 v1))
+ (if (fneq off 0.0) (snd-display #__line__ ";mus-offset opt: ~A" off)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map env: ~A ~A" v0 v1))
(if (or (fneq (vct-ref v0 0) 0.0) (fneq (vct-ref v0 1) .1) (fneq (vct-ref v0 6) .4))
- (snd-display ";~A output: ~A" gen v0))
- (if (fneq (env-interp 1.6 gen) 0.2) (snd-display ";env-interp ~A at 1.6: ~F?" gen (env-interp 1.5 gen)))
+ (snd-display #__line__ ";~A output: ~A" gen v0))
+ (if (fneq (env-interp 1.6 gen) 0.2) (snd-display #__line__ ";env-interp ~A at 1.6: ~F?" gen (env-interp 1.5 gen)))
(set! gen (make-env :envelope '(0 1 1 0) :base 32.0 :length 11))
- (if (fneq (mus-increment gen) 32.0) (snd-display ";env base (32.0): ~A?" (mus-increment gen)))
+ (if (fneq (mus-increment gen) 32.0) (snd-display #__line__ ";env base (32.0): ~A?" (mus-increment gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (env gen)))
(if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) .698) (fneq (vct-ref v0 8) .032))
- (snd-display ";~A output: ~A" gen v0))
+ (snd-display #__line__ ";~A output: ~A" gen v0))
(set! gen (make-env :envelope '(0 1 1 0) :base .0325 :length 11))
- (if (fneq (mus-increment gen) .0325) (snd-display ";env base (.0325): ~A?" (mus-increment gen)))
+ (if (fneq (mus-increment gen) .0325) (snd-display #__line__ ";env base (.0325): ~A?" (mus-increment gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (env gen)))
(if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) .986) (fneq (vct-ref v0 8) .513))
- (snd-display ";~A output: ~A" gen v0))
+ (snd-display #__line__ ";~A output: ~A" gen v0))
(set! gen (make-env :envelope '(0 1 1 .5 2 0) :base 0.0 :length 11 :offset 1.0))
- (if (fneq (mus-offset gen) 1.0) (snd-display ";mus-offset: ~A" (mus-offset gen)))
- (if (fneq (mus-increment gen) 0.0) (snd-display ";env base (0.0): ~A?" (mus-increment gen)))
+ (if (fneq (mus-offset gen) 1.0) (snd-display #__line__ ";mus-offset: ~A" (mus-offset gen)))
+ (if (fneq (mus-increment gen) 0.0) (snd-display #__line__ ";env base (0.0): ~A?" (mus-increment gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(if (= i 3)
(if (not (= (mus-location gen) 3))
- (snd-display ";env location: ~A?" (mus-location gen))))
+ (snd-display #__line__ ";env location: ~A?" (mus-location gen))))
(vct-set! v0 i (env gen)))
(if (or (fneq (vct-ref v0 0) 2.0) (fneq (vct-ref v0 6) 1.5) (fneq (vct-ref v0 8) 1.5))
- (snd-display ";~A output: ~A" gen v0))
- (if (fneq (env-interp 1.5 gen) 1.5) (snd-display ";env-interp ~A at 1.5: ~F?" gen (env-interp 1.5 gen)))
+ (snd-display #__line__ ";~A output: ~A" gen v0))
+ (if (fneq (env-interp 1.5 gen) 1.5) (snd-display #__line__ ";env-interp ~A at 1.5: ~F?" gen (env-interp 1.5 gen)))
(set! (mus-location gen) 6)
- (if (not (= (mus-location gen) 6)) (snd-display ";set! mus-location ~A (6)?" (mus-location gen)))
+ (if (not (= (mus-location gen) 6)) (snd-display #__line__ ";set! mus-location ~A (6)?" (mus-location gen)))
(let ((val (env gen)))
- (if (fneq val 1.5) (snd-display ";set! mus-location 6 -> ~A (1.5)?" val)))
+ (if (fneq val 1.5) (snd-display #__line__ ";set! mus-location 6 -> ~A (1.5)?" val)))
(set! (mus-location gen) 0)
(let ((val (env gen)))
- (if (fneq val 2.0) (snd-display ";set! mus-location 0 -> ~A (2.0)?" val)))
+ (if (fneq val 2.0) (snd-display #__line__ ";set! mus-location 0 -> ~A (2.0)?" val)))
(let ((gen (make-env '(0 0 1 -1 2 0) :length 11)))
(do ((i 0 (+ 1 i)))
((= i 5))
(let ((val (env gen)))
- (if (fneq val (/ i -5.0)) (snd-display ";neg env: ~D ~A" i val))))
+ (if (fneq val (/ i -5.0)) (snd-display #__line__ ";neg env: ~D ~A" i val))))
(do ((i 0 (+ 1 i)))
((= i 5))
(let ((val (env gen)))
- (if (fneq val (+ -1.0 (/ i 5.0))) (snd-display ";neg env: ~D ~A" (+ i 5) val)))))
+ (if (fneq val (+ -1.0 (/ i 5.0))) (snd-display #__line__ ";neg env: ~D ~A" (+ i 5) val)))))
(let ((gen (make-env '(0 0 1 -1 2 0) :length 11 :base 0.5))
(v (vct 0.0 -0.14869 -0.31950 -0.51571 -0.74110 -1.0 -0.74110 -0.51571 -0.31950 -0.14869)))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((val (env gen)))
- (if (fneq val (vct-ref v i)) (snd-display ";neg exp env: ~D ~A" i val))))
+ (if (fneq val (vct-ref v i)) (snd-display #__line__ ";neg exp env: ~D ~A" i val))))
(mus-apply gen))
(let ((v (make-vct 10)))
@@ -21303,113 +21379,113 @@ EDITS: 2
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
- (snd-display ";simple ramp: ~A" v)))
- (let ((v (make-vct 10)))
- (let ((e (make-env '(0 0 1 1) :base 0 :length 8)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
- (snd-display ";simple ramp, base 0: ~A" v))))
- (let ((v (make-vct 10)))
- (let ((e (make-env '(0 0 1 1 2 .5) :base 0 :length 8)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
- (snd-display ";two-step, base 0: ~A" v))))
+ (snd-display #__line__ ";simple ramp: ~A" v)))
+ (let ((v (make-vct 10)))
+ (let ((e (make-env '(0 0 1 1) :base 0 :length 8)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! v i (env e)))
+ (if (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
+ (snd-display #__line__ ";simple ramp, base 0: ~A" v))))
+ (let ((v (make-vct 10)))
+ (let ((e (make-env '(0 0 1 1 2 .5) :base 0 :length 8)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! v i (env e)))
+ (if (not (vequal v (vct 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
+ (snd-display #__line__ ";two-step, base 0: ~A" v))))
(let ((e (make-env '((0 0) (1 1)) :length 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
- (snd-display ";simple ramp embedded: ~A" v)))
+ (snd-display #__line__ ";simple ramp embedded: ~A" v)))
(let ((e (make-env '(0 1 1 0) :length 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
- (snd-display ";simple ramp down: ~A" v)))
+ (snd-display #__line__ ";simple ramp down: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 0) :length 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";simple pyr: ~A" v)))
+ (snd-display #__line__ ";simple pyr: ~A" v)))
(let ((e (make-env '((0 0) (1 1) (2 0)) :length 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";simple pyr embedded: ~A" v)))
+ (snd-display #__line__ ";simple pyr embedded: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 -.5) :length 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
- (snd-display ";simple pyr -.5: ~A" v)))
+ (snd-display #__line__ ";simple pyr -.5: ~A" v)))
(let ((e (make-env '((0 0) (1 1) (2 -.5)) :length 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
- (snd-display ";simple pyr -.5 embedded: ~A" v)))
+ (snd-display #__line__ ";simple pyr -.5 embedded: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 -.5) :length 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
- (snd-display ";simple pyr -.5: ~A" v))))
-
+ (snd-display #__line__ ";simple pyr -.5: ~A" v))))
+
(let ((e (make-env '(0 0 1 1) :length 10)))
- (if (fneq (env-interp 1.0 e) 1.0) (snd-display ";env-interp 0011 at 1: ~A" (env-interp 1.0 e)))
- (if (fneq (env-interp 2.0 e) 1.0) (snd-display ";env-interp 0011 at 2: ~A" (env-interp 2.0 e)))
- (if (fneq (env-interp 0.0 e) 0.0) (snd-display ";env-interp 0011 at 0: ~A" (env-interp 0.0 e)))
- (if (fneq (env-interp 0.444 e) 0.444) (snd-display ";env-interp 0011 at .444: ~A" (env-interp 0.45 e)))
+ (if (fneq (env-interp 1.0 e) 1.0) (snd-display #__line__ ";env-interp 0011 at 1: ~A" (env-interp 1.0 e)))
+ (if (fneq (env-interp 2.0 e) 1.0) (snd-display #__line__ ";env-interp 0011 at 2: ~A" (env-interp 2.0 e)))
+ (if (fneq (env-interp 0.0 e) 0.0) (snd-display #__line__ ";env-interp 0011 at 0: ~A" (env-interp 0.0 e)))
+ (if (fneq (env-interp 0.444 e) 0.444) (snd-display #__line__ ";env-interp 0011 at .444: ~A" (env-interp 0.45 e)))
(mus-reset e)
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((val (env e)))
- (if (fneq val (* i .111111)) (snd-display ";ramp env over 10: ~A at ~A" val i)))))
+ (if (fneq val (* i .111111)) (snd-display #__line__ ";ramp env over 10: ~A at ~A" val i)))))
(let ((e (make-env '(0 0 .5 .5 1 1) :base 32 :length 10))
(v (vct 0.0 0.0243 0.0667 0.1412 0.2716 0.5000 0.5958 0.7090 0.8425 1.0)))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display ";(0 .5 1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(0 .5 1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
(let ((e (make-env '(0 -1.0 1 1) :base 32 :length 10))
(v (vct -1.0 -0.9697 -0.9252 -0.8597 -0.7635 -0.6221 -0.4142 -0.1088 0.34017 1.0)))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display ";(-1 1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(-1 1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
(let ((e (make-env '(0 -1.0 .5 .5 1 0) :base 32 :length 10))
(v (vct -1.0 -0.952 -0.855 -0.661 -0.274 0.5 0.356 0.226 0.107 0.0)))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display ";(-1 .5 0) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(-1 .5 0) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
(let ((e (make-env '(0 0.0 .5 .5 1 -1.0) :base 32 :length 10))
(v (vct 0.0 0.085 0.177 0.276 0.384 0.5 -0.397 -0.775 -0.933 -1.0)))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display ";(0 .5 -1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(0 .5 -1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
(let ((e (make-env '(0 0 1 1) :length 10 :base 4.0)))
- (if (fneq (env-interp 1.0 e) 1.0) (snd-display ";env-interp 0011 4 at 1: ~A" (env-interp 1.0 e)))
- (if (fneq (env-interp 0.0 e) 0.0) (snd-display ";env-interp 0011 4 at 0: ~A" (env-interp 0.0 e)))
- (if (fneq (env-interp 0.45 e) 0.2839) (snd-display ";env-interp 0011 4 at .45: ~A" (env-interp 0.45 e))))
+ (if (fneq (env-interp 1.0 e) 1.0) (snd-display #__line__ ";env-interp 0011 4 at 1: ~A" (env-interp 1.0 e)))
+ (if (fneq (env-interp 0.0 e) 0.0) (snd-display #__line__ ";env-interp 0011 4 at 0: ~A" (env-interp 0.0 e)))
+ (if (fneq (env-interp 0.45 e) 0.2839) (snd-display #__line__ ";env-interp 0011 4 at .45: ~A" (env-interp 0.45 e))))
(let ((e (make-env '(0 0 1 1) :length 10 :base 0.2)))
- (if (fneq (env-interp 1.0 e) 1.0) (snd-display ";env-interp 0011 2 at 1: ~A" (env-interp 1.0 e)))
- (if (fneq (env-interp 0.0 e) 0.0) (snd-display ";env-interp 0011 2 at 0: ~A" (env-interp 0.0 e)))
- (if (fneq (env-interp 0.45 e) 0.6387) (snd-display ";env-interp 0011 2 at .45: ~A" (env-interp 0.45 e))))
+ (if (fneq (env-interp 1.0 e) 1.0) (snd-display #__line__ ";env-interp 0011 2 at 1: ~A" (env-interp 1.0 e)))
+ (if (fneq (env-interp 0.0 e) 0.0) (snd-display #__line__ ";env-interp 0011 2 at 0: ~A" (env-interp 0.0 e)))
+ (if (fneq (env-interp 0.45 e) 0.6387) (snd-display #__line__ ";env-interp 0011 2 at .45: ~A" (env-interp 0.45 e))))
(let ((val (let ((e (make-env '(0 0 1 1) :offset 2.0))) (set! (mus-offset e) 3.0) (mus-offset e))))
- (if (fneq val 3.0) (snd-display ";set mus-offset env: ~A" val)))
+ (if (fneq val 3.0) (snd-display #__line__ ";set mus-offset env: ~A" val)))
(let ((e (make-env '(0 0 1 1 2 0) :length 10))
(v (make-vct 10 0.0)))
@@ -21417,37 +21493,37 @@ EDITS: 2
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";e set off 0: ~A" v))
- (if (not (= (mus-length e) 10)) (snd-display ";e set off 0 len: ~A" (mus-length e)))
- (if (fneq (mus-scaler e) 1.0) (snd-display ";e set off 0 scl: ~A" (mus-scaler e)))
- (if (fneq (mus-offset e) 0.0) (snd-display ";e set off 0 off: ~A" (mus-offset e)))
+ (snd-display #__line__ ";e set off 0: ~A" v))
+ (if (not (= (mus-length e) 10)) (snd-display #__line__ ";e set off 0 len: ~A" (mus-length e)))
+ (if (fneq (mus-scaler e) 1.0) (snd-display #__line__ ";e set off 0 scl: ~A" (mus-scaler e)))
+ (if (fneq (mus-offset e) 0.0) (snd-display #__line__ ";e set off 0 off: ~A" (mus-offset e)))
(set! (mus-scaler e) 2.0)
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.400 0.800 1.200 1.600 2.000 1.500 1.000 0.500 0.000)))
- (snd-display ";e set off 1: ~A" v))
- (if (not (= (mus-length e) 10)) (snd-display ";e set off 1 len: ~A" (mus-length e)))
- (if (fneq (mus-scaler e) 2.0) (snd-display ";e set off 1 scl: ~A" (mus-scaler e)))
- (if (fneq (mus-offset e) 0.0) (snd-display ";e set off 1 off: ~A" (mus-offset e)))
+ (snd-display #__line__ ";e set off 1: ~A" v))
+ (if (not (= (mus-length e) 10)) (snd-display #__line__ ";e set off 1 len: ~A" (mus-length e)))
+ (if (fneq (mus-scaler e) 2.0) (snd-display #__line__ ";e set off 1 scl: ~A" (mus-scaler e)))
+ (if (fneq (mus-offset e) 0.0) (snd-display #__line__ ";e set off 1 off: ~A" (mus-offset e)))
(set! (mus-offset e) 1.0)
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 1.000 1.400 1.800 2.200 2.600 3.000 2.500 2.000 1.500 1.000)))
- (snd-display ";e set off 2: ~A" v))
- (if (not (= (mus-length e) 10)) (snd-display ";e set off 2 len: ~A" (mus-length e)))
- (if (fneq (mus-scaler e) 2.0) (snd-display ";e set off 2 scl: ~A" (mus-scaler e)))
- (if (fneq (mus-offset e) 1.0) (snd-display ";e set off 2 off: ~A" (mus-offset e)))
+ (snd-display #__line__ ";e set off 2: ~A" v))
+ (if (not (= (mus-length e) 10)) (snd-display #__line__ ";e set off 2 len: ~A" (mus-length e)))
+ (if (fneq (mus-scaler e) 2.0) (snd-display #__line__ ";e set off 2 scl: ~A" (mus-scaler e)))
+ (if (fneq (mus-offset e) 1.0) (snd-display #__line__ ";e set off 2 off: ~A" (mus-offset e)))
(set! (mus-length e) 19)
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 1.000 1.222 1.444 1.667 1.889 2.111 2.333 2.556 2.778 3.000)))
- (snd-display ";e set off 3: ~A" v))
- (if (not (= (mus-length e) 19)) (snd-display ";e set off 3 len: ~A" (mus-length e)))
- (if (fneq (mus-scaler e) 2.0) (snd-display ";e set off 3 scl: ~A" (mus-scaler e)))
- (if (fneq (mus-offset e) 1.0) (snd-display ";e set off 3 off: ~A" (mus-offset e))))
+ (snd-display #__line__ ";e set off 3: ~A" v))
+ (if (not (= (mus-length e) 19)) (snd-display #__line__ ";e set off 3 len: ~A" (mus-length e)))
+ (if (fneq (mus-scaler e) 2.0) (snd-display #__line__ ";e set off 3 scl: ~A" (mus-scaler e)))
+ (if (fneq (mus-offset e) 1.0) (snd-display #__line__ ";e set off 3 off: ~A" (mus-offset e))))
(let ((e (make-env (vct 0 0 1 1 2 0) :length 10))
(v (make-vct 10 0.0)))
@@ -21455,7 +21531,7 @@ EDITS: 2
((= i 10))
(vct-set! v i (env e)))
(if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display ";e from vct: ~A" v)))
+ (snd-display #__line__ ";e from vct: ~A" v)))
(let ((e1 (make-env '(0 0 1 1) :base 32.0 :length 11))
(v (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.00)))
@@ -21463,7 +21539,7 @@ EDITS: 2
((> i 10))
(let ((val (env e1)))
(if (fneq val (vct-ref v i))
- (snd-display ";exp env direct (32.0): ~A ~A" val (vct-ref v i))))))
+ (snd-display #__line__ ";exp env direct (32.0): ~A ~A" val (vct-ref v i))))))
(let ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
(v (vct 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
@@ -21471,21 +21547,21 @@ EDITS: 2
((> i 10))
(let ((val (env e1)))
(if (fneq val (vct-ref v i))
- (snd-display ";exp env direct (32.0) offset: ~A ~A" val (vct-ref v i))))))
+ (snd-display #__line__ ";exp env direct (32.0) offset: ~A ~A" val (vct-ref v i))))))
(let ((e1 (make-env '((0 1) (1 2)) :base 32.0 :length 11))
(v (vct 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
(do ((i 0 (+ 1 i)))
((> i 10))
(let ((val (env e1)))
(if (fneq val (vct-ref v i))
- (snd-display ";exp env direct (32.0) offset embedded: ~A ~A" val (vct-ref v i))))))
+ (snd-display #__line__ ";exp env direct (32.0) offset embedded: ~A ~A" val (vct-ref v i))))))
(let ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
(v (vct 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
(do ((i 0 (+ 1 i)))
((> i 10))
(let ((val (env e1)))
(if (fneq val (vct-ref v i))
- (snd-display ";exp env direct (32.0) offset (and dur): ~A ~A" val (vct-ref v i))))))
+ (snd-display #__line__ ";exp env direct (32.0) offset (and dur): ~A ~A" val (vct-ref v i))))))
(let ((e1 (make-env '(0 0 1 1) :base 0.032 :length 11))
(v (vct 0.000 0.301 0.514 0.665 0.772 0.848 0.902 0.940 0.967 0.986 1.0)))
@@ -21493,7 +21569,7 @@ EDITS: 2
((> i 10))
(let ((val (env e1)))
(if (fneq val (vct-ref v i))
- (snd-display ";exp env direct (.032): ~A ~A" val (vct-ref v i))))))
+ (snd-display #__line__ ";exp env direct (.032): ~A ~A" val (vct-ref v i))))))
(let ((e1 (make-env '(0 0 1 1) :base .03125 :length 11))
(e2 (make-env '(0 0 1 1 2 0) :base 32.0 :length 11))
@@ -21504,13 +21580,13 @@ EDITS: 2
(lv2 (env e1))
(lv3 (env-interp (* i .2) e2))
(lv4 (env e2)))
- (if (ffneq lv1 lv2) (snd-display ";env-interp[rmp ~F]: ~A (~A)?" (* .1 i) lv1 lv2))
- (if (ffneq lv3 lv4) (snd-display ";env-interp[pyr ~F]: ~A (~A)?" (* .2 i) lv3 lv4))))
+ (if (ffneq lv1 lv2) (snd-display #__line__ ";env-interp[rmp ~F]: ~A (~A)?" (* .1 i) lv1 lv2))
+ (if (ffneq lv3 lv4) (snd-display #__line__ ";env-interp[pyr ~F]: ~A (~A)?" (* .2 i) lv3 lv4))))
(do ((i 0 (+ 1 i)))
((= i 100))
(let ((lv5 (env-interp (* i .02) e3))
(lv6 (env e3)))
- (if (ffneq lv5 lv6) (snd-display ";env-interp[tri ~F]: ~A (~A)?" (* .02 i) lv5 lv6)))))
+ (if (ffneq lv5 lv6) (snd-display #__line__ ";env-interp[tri ~F]: ~A (~A)?" (* .02 i) lv5 lv6)))))
(let ((e1 (make-env '(0 0 1 1 2 0) :length 10))
(lv1 (make-vct 11))
@@ -21520,31 +21596,31 @@ EDITS: 2
(do ((i 0 (+ 1 i))) ((= i 11)) (vct-set! lv2 i (env e1)))
(mus-reset e1)
(do ((i 0 (+ 1 i))) ((= i 11)) (vct-set! lv3 i (env e1)))
- (if (not (vequal lv1 lv3)) (snd-display ";mus-reset: ~A ~A?" lv1 lv3))
- (if (not (vequal lv2 (make-vct 11))) (snd-display ";mus-reset 1: ~A?" lv2)))
+ (if (not (vequal lv1 lv3)) (snd-display #__line__ ";mus-reset: ~A ~A?" lv1 lv3))
+ (if (not (vequal lv2 (make-vct 11))) (snd-display #__line__ ";mus-reset 1: ~A?" lv2)))
(set! gen (make-env '(0 0 1 1 2 0) :length 11))
(do ((i 0 (+ 1 i))) ((= i 4)) (env gen))
(let ((val (env gen)))
- (if (fneq val .8) (snd-display ";env(5): ~A?" val))
+ (if (fneq val .8) (snd-display #__line__ ";env(5): ~A?" val))
(mus-reset gen)
(do ((i 0 (+ 1 i))) ((= i 4)) (env gen))
(set! val (env gen))
- (if (fneq val .8) (snd-display ";mus-reset (via reset): ~A?" val))
+ (if (fneq val .8) (snd-display #__line__ ";mus-reset (via reset): ~A?" val))
(set! (mus-location gen) 6)
(let ((val (env gen)))
- (if (fneq val 0.8) (snd-display ";set! mus-location 6 -> ~A (0.8)?" val)))))
+ (if (fneq val 0.8) (snd-display #__line__ ";set! mus-location 6 -> ~A (0.8)?" val)))))
(let ((gen (make-env '(0 0 1 1) :base .032 :length 12)))
(set! (mus-location gen) 5)
(let ((val (env gen)))
(if (fneq val 0.817)
- (snd-display ";set env location with base: ~A ~A" val gen))))
+ (snd-display #__line__ ";set env location with base: ~A ~A" val gen))))
(let ((gen (make-env '(0 0 1 1) :base .032 :length 12)))
(set! (mus-location gen) 5)
(let ((val (env gen)))
(if (fneq val 0.817)
- (snd-display ";set env location with base and dur: ~A ~A" val gen))))
+ (snd-display #__line__ ";set env location with base and dur: ~A ~A" val gen))))
(test-gen-equal (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 10) (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 10) (make-env '(0 0 1 1 2 0) :scaler 0.25 :length 10))
(test-gen-equal (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 10) (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 10) (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 11))
@@ -21553,34 +21629,34 @@ EDITS: 2
(let ((var (catch #t (lambda () (make-env :envelope '())) (lambda args args))))
(if (not (eq? (car var) 'no-data))
- (snd-display ";make-env null env: ~A" var)))
+ (snd-display #__line__ ";make-env null env: ~A" var)))
(let ((var (catch #t (lambda () (make-env :length 1)) (lambda args args))))
(if (not (eq? (car var) 'no-data))
- (snd-display ";make-env no env: ~A" var)))
+ (snd-display #__line__ ";make-env no env: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope '(0 0) :length -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-env bad dur: ~A" var)))
+ (snd-display #__line__ ";make-env bad dur: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope '(0 0) :duration -1.0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-env bad duration: ~A" var)))
+ (snd-display #__line__ ";make-env bad duration: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope '(0 0) :base -1.0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-env bad base: ~A" var)))
+ (snd-display #__line__ ";make-env bad base: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope '(1 1 0 0) :length 11)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-env bad env 1 1 0 0: ~A" var)))
+ (snd-display #__line__ ";make-env bad env 1 1 0 0: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope '(0 1 -1 0) :length 11)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-env bad env 0 1 -1 0: ~A" var)))
+ (snd-display #__line__ ";make-env bad env 0 1 -1 0: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope '(0 1 1 0) :length 11 :length 10)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-env bad end/dur: ~A" var)))
+ (snd-display #__line__ ";make-env bad end/dur: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope '(0 0 1 1 2 0 1) :duration 1.0)) (lambda args args))))
(if (not (eq? (car var) 'bad-type))
- (snd-display ";make-env odd length env: ~A" var)))
+ (snd-display #__line__ ";make-env odd length env: ~A" var)))
(let ((var (catch #t (lambda () (make-env :envelope (list "hi" 0 1 1 2 0) :duration 1.0)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-env env of non-number: ~A" var)))
+ (snd-display #__line__ ";make-env env of non-number: ~A" var)))
;; env-any
(let* ((env-any-1 (lambda (e func)
@@ -21636,9 +21712,9 @@ EDITS: 2
((= i 20))
(outa i (sine-env-1 e)))))))
(if (not (vequal val1 val2))
- (snd-display ";sine-env straight and run: ~%; ~A~%; ~A" val1 val2))
+ (snd-display #__line__ ";sine-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (vequal val1 val3))
- (snd-display ";sine-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
+ (snd-display #__line__ ";sine-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
(let ((val1 (with-sound (:output (make-vct 20))
@@ -21660,9 +21736,9 @@ EDITS: 2
((= i 20))
(outa i (square-env-1 e)))))))
(if (not (vequal val1 val2))
- (snd-display ";square-env straight and run: ~%; ~A~%; ~A" val1 val2))
+ (snd-display #__line__ ";square-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (vequal val1 val3))
- (snd-display ";square-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
+ (snd-display #__line__ ";square-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
(let ((val1 (with-sound (:output (make-vct 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
@@ -21684,9 +21760,9 @@ EDITS: 2
((= i 20))
(outa i (blackman4-env-1 e)))))))
(if (not (vequal val1 val2))
- (snd-display ";blackman4-env straight and run: ~%; ~A~%; ~A" val1 val2))
+ (snd-display #__line__ ";blackman4-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (vequal val1 val3))
- (snd-display ";blackman4-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
+ (snd-display #__line__ ";blackman4-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
(let ((val1 (with-sound (:output (make-vct 20))
@@ -21711,9 +21787,9 @@ EDITS: 2
((= i 20))
(outa i (multi-expt-env-1 e bases)))))))
(if (not (vequal val1 val2))
- (snd-display ";multi-expt-env straight and run: ~%; ~A~%; ~A" val1 val2))
+ (snd-display #__line__ ";multi-expt-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (vequal val1 val3))
- (snd-display ";multi-expt-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
+ (snd-display #__line__ ";multi-expt-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
(let ((val1 (with-sound (:output (make-vct 220))
(let ((e1 (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 220))
@@ -21740,28 +21816,28 @@ EDITS: 2
(declare (y2 float))
y2))))))))))))
(if (not (vequal val1 val2))
- (snd-display ";env-any recursive: ~%; ~A~%; ~A" val1 val2))))
-
+ (snd-display #__line__ ";env-any recursive: ~%; ~A~%; ~A" val1 val2))))
+
(let ((ind (new-sound :size 20)))
(select-sound ind)
(map-channel (lambda (y) 1.0))
(bumpy)
(let ((vals (channel->vct)))
(if (not (vequal vals (vct 0.0 0.0 0.001 0.021 0.105 0.264 0.467 0.673 0.846 0.960 1.000 0.960 0.846 0.673 0.467 0.264 0.105 0.021 0.001 0.0)))
- (snd-display ";bumpy: ~A" vals)))
+ (snd-display #__line__ ";bumpy: ~A" vals)))
(if (fneq (channel-lp-inf) 1.0) ; just a fancy name for maxamp
- (snd-display ";channel-lp-inf: ~A" (channel-lp-inf)))
+ (snd-display #__line__ ";channel-lp-inf: ~A" (channel-lp-inf)))
(linear-src-channel 2.0)
(let ((vals (channel->vct)))
(if (not (vequal vals (vct 0.000 0.001 0.105 0.467 0.846 1.000 0.846 0.467 0.105 0.001)))
- (snd-display ";linear-src-channel: ~A" vals)))
+ (snd-display #__line__ ";linear-src-channel: ~A" vals)))
(let ((old-clip (clipping)))
(set! (clipping) #t)
(save-sound-as "tst.snd")
(let ((fvals (file->vct "tst.snd")) ; in frame.scm
(vals (channel->vct)))
(if (not (vequal vals fvals))
- (snd-display ";file->vct: ~A ~A" vals fvals)))
+ (snd-display #__line__ ";file->vct: ~A ~A" vals fvals)))
(mus-sound-forget "tst.snd")
(delete-file "tst.snd")
(set! (clipping) old-clip))
@@ -21769,18 +21845,18 @@ EDITS: 2
(map-channel (lambda (y)
(differentiator hp y))))
(if (fneq (maxamp) .0013)
- (snd-display ";differentiator: ~A" (maxamp)))
+ (snd-display #__line__ ";differentiator: ~A" (maxamp)))
(revert-sound ind)
(let ((val (window-rms)))
- (if (fneq val 0.0) (snd-display ";window-rms empty: ~A" val))
+ (if (fneq val 0.0) (snd-display #__line__ ";window-rms empty: ~A" val))
(set! (sample 10) 1.0)
(set! val (window-rms))
- (if (fneq val .218) (snd-display ";window-rms 1: ~A" val))
+ (if (fneq val .218) (snd-display #__line__ ";window-rms 1: ~A" val))
(let ((vals (window-samples)))
(if (or (not (vct? vals))
(not (= (vct-length vals) 21))
(fneq (vct-ref vals 10) 1.0))
- (snd-display ";window-samples: ~A" vals))))
+ (snd-display #__line__ ";window-samples: ~A" vals))))
(revert-sound ind)
(let ((new-file-name (file-name ind)))
(close-sound ind)
@@ -21797,72 +21873,72 @@ EDITS: 2
(print-and-check gen
"table-lookup"
"table-lookup freq: 440.000Hz, phase: 0.000, length: 512, interp: linear")
- (if (not (= (mus-length gen) 512)) (snd-display ";table-lookup length: ~A?" (mus-length gen)))
- (if (not (= (mus-length gen3) 512)) (snd-display ";default table-lookup length: ~A?" (mus-length gen3)))
+ (if (not (= (mus-length gen) 512)) (snd-display #__line__ ";table-lookup length: ~A?" (mus-length gen)))
+ (if (not (= (mus-length gen3) 512)) (snd-display #__line__ ";default table-lookup length: ~A?" (mus-length gen3)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (table-lookup gen 0.0))
(vct-set! v1 i (mus-apply gen1 0.0)))
(vct-map! v2 (lambda () (if (table-lookup? gen4) (table-lookup gen4 0.0) -1.0)))
- (if (not (vequal v0 v2)) (snd-display ";map table-lookup: ~A ~A" v0 v2))
+ (if (not (vequal v0 v2)) (snd-display #__line__ ";map table-lookup: ~A ~A" v0 v2))
(set! gen4 (make-table-lookup 440.0 :wave (partials->wave (vct 1 1 2 1))))
(vct-map! v2 (lambda () (table-lookup gen4)))
- (if (not (vequal v0 v2)) (snd-display ";map table-lookup (no fm): ~A ~A" v0 v2))
- (if (not (table-lookup? gen)) (snd-display ";~A not table-lookup?" gen))
- (if (not (vct? (mus-data gen))) (snd-display ";mus-data table-lookup: ~A" (mus-data gen)))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";table-lookup phase: ~F?" (mus-phase gen)))
+ (if (not (vequal v0 v2)) (snd-display #__line__ ";map table-lookup (no fm): ~A ~A" v0 v2))
+ (if (not (table-lookup? gen)) (snd-display #__line__ ";~A not table-lookup?" gen))
+ (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data table-lookup: ~A" (mus-data gen)))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";table-lookup phase: ~F?" (mus-phase gen)))
(set! (mus-phase gen) 1.0)
- (if (fneq (mus-phase gen) 1.0) (snd-display ";set! table-lookup phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";table-lookup frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";set! table-lookup phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";table-lookup frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
- (if (fneq (mus-frequency gen) 100.0) (snd-display ";set! table-lookup frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 1) 0.373) (fneq (vct-ref v0 8) 1.75)) (snd-display ";table-lookup output: ~A" v0))
+ (if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";set! table-lookup frequency: ~F?" (mus-frequency gen)))
+ (if (or (fneq (vct-ref v0 1) 0.373) (fneq (vct-ref v0 8) 1.75)) (snd-display #__line__ ";table-lookup output: ~A" v0))
(do ((i 0 (+ 1 i)))
((= i 10))
(if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display ";mus-apply table-lookup at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i))))
+ (snd-display #__line__ ";mus-apply table-lookup at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i))))
(set! gen (make-table-lookup 440.0 :wave (phase-partials->wave (list 1 1 0 2 1 (* pi .5)))))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (table-lookup gen 0.0)))
- (if (or (fneq (vct-ref v0 1) 1.094) (fneq (vct-ref v0 8) .421)) (snd-display ";table-lookup phase output: ~A" v0))
+ (if (or (fneq (vct-ref v0 1) 1.094) (fneq (vct-ref v0 8) .421)) (snd-display #__line__ ";table-lookup phase output: ~A" v0))
(if (or (fneq (vct-peak (partials->wave '(1 1 2 1))) 1.76035475730896)
(fneq (vct-peak (partials->wave '(1 1 2 1) #f #t)) 1.0)
(fneq (vct-peak (partials->wave '(1 1 2 1 3 1 4 1) #f #t)) 1.0))
- (snd-display ";normalized partials?"))
+ (snd-display #__line__ ";normalized partials?"))
(set! (mus-data gen) (phase-partials->wave (list 1 1 0 2 1 (* pi .5)) #f #t)))
(let ((tag (catch #t (lambda () (phase-partials->wave (list 1 .3 2 .2))) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";bad length arg to phase-partials->wave: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";bad length arg to phase-partials->wave: ~A" tag)))
(let ((tag (catch #t (lambda () (phase-partials->wave (list "hiho" .3 2 .2))) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";bad harmonic arg to phase-partials->wave: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";bad harmonic arg to phase-partials->wave: ~A" tag)))
(let ((tag (catch #t (lambda () (phase-partials->wave (list))) (lambda args (car args)))))
- (if (not (eq? tag 'no-data)) (snd-display ";nil list to phase-partials->wave: ~A" tag)))
+ (if (not (eq? tag 'no-data)) (snd-display #__line__ ";nil list to phase-partials->wave: ~A" tag)))
(let ((vals (phase-partials->wave (list 1 1 0) (make-vct 16) #f)))
(do ((i 0 (+ 1 i)))
((= i 16))
(if (fneq (vct-ref vals i) (sin (/ (* 2 pi i) 16)))
- (snd-display ";phase-partials->wave 1 1 0 at ~D: ~A ~A" i (vct-ref vals i) (sin (/ (* 2 pi i) 16))))))
+ (snd-display #__line__ ";phase-partials->wave 1 1 0 at ~D: ~A ~A" i (vct-ref vals i) (sin (/ (* 2 pi i) 16))))))
(let ((vals (phase-partials->wave (list 1 1 (* .25 pi)) (make-vct 16) #f)))
(do ((i 0 (+ 1 i)))
((= i 16))
(if (fneq (vct-ref vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))
- (snd-display ";phase-partials->wave 1 1 .25 at ~D: ~A ~A" i (vct-ref vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16)))))))
+ (snd-display #__line__ ";phase-partials->wave 1 1 .25 at ~D: ~A ~A" i (vct-ref vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16)))))))
(let ((vals (phase-partials->wave (vct 1 1 0 2 1 0) (make-vct 16) #f)))
(do ((i 0 (+ 1 i)))
((= i 16))
(if (fneq (vct-ref vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16))))
- (snd-display ";phase-partials->wave 1 1 0 2 1 0 at ~D: ~A ~A" i (vct-ref vals i)
+ (snd-display #__line__ ";phase-partials->wave 1 1 0 2 1 0 at ~D: ~A ~A" i (vct-ref vals i)
(+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16)))))))
(let ((vals (phase-partials->wave (vct 1 1 0 2 1 (* .5 pi)) (make-vct 16) #f)))
(do ((i 0 (+ 1 i)))
((= i 16))
(if (fneq (vct-ref vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16)))))
- (snd-display ";phase-partials->wave 1 1 0 2 1 .5 at ~D: ~A ~A" i (vct-ref vals i)
+ (snd-display #__line__ ";phase-partials->wave 1 1 0 2 1 .5 at ~D: ~A ~A" i (vct-ref vals i)
(+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16))))))))
(test-gen-equal (make-table-lookup 440.0 :wave (partials->wave (vct 1 1 2 1)))
@@ -21875,12 +21951,12 @@ EDITS: 2
(make-table-lookup-with-env 440.0 (list 0 0 1 1))
(make-table-lookup-with-env 440.0 '(0 0 1 1 2 0)))
(let ((tag (catch #t (lambda () (partials->wave (list .5 .3 .2))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-type)) (snd-display ";odd length arg to partials->wave: ~A" tag)))
+ (if (not (eq? tag 'bad-type)) (snd-display #__line__ ";odd length arg to partials->wave: ~A" tag)))
(let ((hi (make-table-lookup :size 256)))
- (if (not (= (mus-length hi) 256)) (snd-display ";table-lookup set length: ~A?" (mus-length hi))))
+ (if (not (= (mus-length hi) 256)) (snd-display #__line__ ";table-lookup set length: ~A?" (mus-length hi))))
(let ((tag (catch #t (lambda () (make-table-lookup :size 0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range)) (snd-display ";table-lookup size 0: ~A" tag)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";table-lookup size 0: ~A" tag)))
(let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 1)))))
(do ((i 0 (+ 1 i))
@@ -21889,7 +21965,7 @@ EDITS: 2
(let* ((val1 (sin a))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display ";table lookup (1 1): ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";table lookup (1 1): ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-table-lookup 4.0 :wave (partials->wave '(1 1)))))
(do ((i 0 (+ 1 i))
@@ -21898,7 +21974,7 @@ EDITS: 2
(let* ((val1 (sin a))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display ";table lookup (1 1) 4: ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";table lookup (1 1) 4: ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 .75 3 .25)))))
(do ((i 0 (+ 1 i))
@@ -21907,7 +21983,7 @@ EDITS: 2
(let* ((val1 (+ (* .75 (sin a)) (* .25 (sin (* 3 a)))))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display ";table lookup (1 .75 3 .25): ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";table lookup (1 .75 3 .25): ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-table-lookup 0.0 :wave (partials->wave '(1 1))))
(gen1 (make-table-lookup 40.0 :wave (partials->wave '(1 1))))
@@ -21920,7 +21996,7 @@ EDITS: 2
(val2 (table-lookup gen (table-lookup gen1 0.0))))
(set! a1 (+ a1 fm))
(if (fneq val1 val2)
- (snd-display ";lookup/lookup fm: ~A: ~A ~A" i val1 val2)))))
+ (snd-display #__line__ ";lookup/lookup fm: ~A: ~A ~A" i val1 val2)))))
(for-each
(lambda (args)
@@ -21936,8 +22012,8 @@ EDITS: 2
(not (= type mus-interp-all-pass))
(or (not (= type mus-interp-none))
(not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000)))))
- (snd-display ";tbl interp ~A: ~A" type v))
- (if (not (= (mus-interp-type tbl1) type)) (snd-display ";tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
+ (snd-display #__line__ ";tbl interp ~A: ~A" type v))
+ (if (not (= (mus-interp-type tbl1) type)) (snd-display #__line__ ";tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
(list
(list mus-interp-none (vct 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 1.000))
(list mus-interp-linear (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200))
@@ -21945,7 +22021,7 @@ EDITS: 2
(list mus-interp-all-pass (vct 1.000 0.000 0.429 0.143 0.095 0.905 0.397 0.830 0.793 0.912))
(list mus-interp-hermite (vct 0.000 0.168 0.424 0.696 0.912 1.000 0.912 0.696 0.424 0.168))))
;; this is different if doubles -- not sure whether it's a bug or not
-
+
(let ((size 1000)
(tbl-size 1024))
@@ -21972,8 +22048,8 @@ EDITS: 2
(v2 (with-sound (:output (make-vct size) :srate 44100) (test-fm1 0 size 200 1 1 1))))
(if (and (not (vequal v1 v2))
(> (vct-peak (vct-subtract! v1 v2)) .002))
- (snd-display ";fm/tbl peak diff (1 1): ~A" (vct-peak (vct-subtract! v1 v2)))))
-
+ (snd-display #__line__ ";fm/tbl peak diff (1 1): ~A" (vct-peak (vct-subtract! v1 v2)))))
+
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((ratio (+ 1 (random 4)))
@@ -21982,8 +22058,8 @@ EDITS: 2
(v2 (with-sound (:output (make-vct size) :srate 44100) (test-fm1 0 size 20 1 ratio index))))
(if (and (not (vequal v1 v2))
(> (vct-peak (vct-subtract! v1 v2)) .002))
- (snd-display ";fm/tbl peak diff ~A ~A: ~A" ratio index (vct-peak (vct-subtract! v1 v2))))))))
-
+ (snd-display #__line__ ";fm/tbl peak diff ~A ~A: ~A" ratio index (vct-peak (vct-subtract! v1 v2))))))))
+
(let ((gen0 (make-polyshape 440.0 :coeffs (partials->polynomial '(1 1))))
(gen (make-polyshape 440.0 :partials '(1 1) :kind mus-chebyshev-first-kind))
@@ -21993,30 +22069,30 @@ EDITS: 2
(print-and-check gen
"polyshape"
"polyshape freq: 440.000Hz, phase: 0.000, coeffs[2]: [0.000 1.000]")
- (if (not (= (mus-length gen) 2)) (snd-display ";polyshape length: ~A?" (mus-length gen)))
+ (if (not (= (mus-length gen) 2)) (snd-display #__line__ ";polyshape length: ~A?" (mus-length gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((val0 (polyshape gen0 1.0 0.0))
(val (polyshape gen 1.0 0.0)))
- (if (fneq val val0) (snd-display ";polyshape: ~A /= ~F?" val val0))
+ (if (fneq val val0) (snd-display #__line__ ";polyshape: ~A /= ~F?" val val0))
(vct-set! v0 i val)))
(vct-map! v1 (lambda () (if (polyshape? gen1) (polyshape gen1 1.0 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map polyshape: ~A ~A" v0 v1))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map polyshape: ~A ~A" v0 v1))
(set! gen1 (make-polyshape 440.0 :coeffs (partials->polynomial '(1 1))))
(vct-map! v1 (lambda () (polyshape gen1 1.0)))
- (if (not (vequal v0 v1)) (snd-display ";1 map polyshape: ~A ~A" v0 v1))
- (if (not (polyshape? gen)) (snd-display ";~A not polyshape?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";polyshape phase: ~F?" (mus-phase gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";1 map polyshape: ~A ~A" v0 v1))
+ (if (not (polyshape? gen)) (snd-display #__line__ ";~A not polyshape?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";polyshape phase: ~F?" (mus-phase gen)))
(set! (mus-phase gen) 1.0)
- (if (fneq (mus-phase gen) 1.0) (snd-display ";set! polyshape phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";polyshape frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";set! polyshape phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";polyshape frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
- (if (fneq (mus-frequency gen) 100.0) (snd-display ";polyshape frequency: ~F?" (mus-frequency gen)))
- (if (not (vct? (mus-data gen))) (snd-display ";mus-data polyshape: ~A" (mus-data gen)))
- (if (or (fneq (vct-ref v0 1) 0.992) (fneq (vct-ref v0 8) 0.538)) (snd-display ";polyshape output: ~A" v0))
+ (if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";polyshape frequency: ~F?" (mus-frequency gen)))
+ (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data polyshape: ~A" (mus-data gen)))
+ (if (or (fneq (vct-ref v0 1) 0.992) (fneq (vct-ref v0 8) 0.538)) (snd-display #__line__ ";polyshape output: ~A" v0))
(set! (mus-data gen0) (make-vct 32))
(set! (mus-length gen0) 32)
- (if (not (= (mus-length gen0) 32)) (snd-display ";set mus-length polyshape: ~A" (mus-length gen0))))
+ (if (not (= (mus-length gen0) 32)) (snd-display #__line__ ";set mus-length polyshape: ~A" (mus-length gen0))))
(test-gen-equal (make-polyshape 440.0 :partials '(1 1))
(make-polyshape 440.0)
@@ -22040,7 +22116,7 @@ EDITS: 2
(val2 (gen 1.0 0.0)))
(if (fneq val1 val2)
(begin
- (snd-display ";polyshaper (1 1) ~A: ~A ~A" i val1 val2)
+ (snd-display #__line__ ";polyshaper (1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
(let ((gen (make-polyshape 440.0)) ; check default for partials: '(1 1)
@@ -22053,7 +22129,7 @@ EDITS: 2
(val2 (gen 1.0 0.0)))
(if (fneq val1 val2)
(begin
- (snd-display ";polyshaper default: '(1 1) ~A: ~A ~A" i val1 val2)
+ (snd-display #__line__ ";polyshaper default: '(1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
(let ((gen (make-polyshape 440.0 :partials (vct 1 1)))
@@ -22065,12 +22141,12 @@ EDITS: 2
(val2 (gen 0.5 0.0)))
(if (fneq val1 val2)
(begin
- (snd-display ";polyshaper (1 1) .5 index ~A: ~A ~A" i val1 val2)
+ (snd-display #__line__ ";polyshaper (1 1) .5 index ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
(let ((var (catch #t (lambda () (make-polyshape 440.0 :coeffs 3.14)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-polyshape bad coeffs: ~A" var)))
+ (snd-display #__line__ ";make-polyshape bad coeffs: ~A" var)))
(let ((gen (make-polyshape 0.0 :coeffs (partials->polynomial '(1 1))))
(gen1 (make-polyshape 40.0 :coeffs (partials->polynomial '(1 1))))
@@ -22085,7 +22161,7 @@ EDITS: 2
(set! a1 (+ a1 fm))
(if (> (abs (- val1 val2)) .002)
(begin
- (snd-display ";polyshape fm: ~A: ~A ~A" i val1 val2)
+ (snd-display #__line__ ";polyshape fm: ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
(for-each
@@ -22104,7 +22180,7 @@ EDITS: 2
(set! angle (+ angle incr))
(if (fneq cval sum)
(begin
- (snd-display ";cheb-t-sum ~A: [~D] ~A ~A" name i cval sum)
+ (snd-display #__line__ ";cheb-t-sum ~A: [~D] ~A ~A" name i cval sum)
(set! happy #f)))))))
(list (vct 0.0 1.0)
(vct 0.0 0.5 0.25 0.25)
@@ -22131,7 +22207,7 @@ EDITS: 2
(set! angle (+ angle incr))
(if (fneq cval sum)
(begin
- (snd-display ";cheb-u-sum ~A: [~D] ~A ~A" name i cval sum)
+ (snd-display #__line__ ";cheb-u-sum ~A: [~D] ~A ~A" name i cval sum)
(set! happy #f)))))))
(list (vct 0.0 1.0)
(vct 0.0 0.5 0.25 0.25)
@@ -22159,7 +22235,7 @@ EDITS: 2
(set! angle (+ angle incr))
(if (fneq cval sum)
(begin
- (snd-display ";cheb-tu-sum ~A: [~D] ~A ~A" name i cval sum)
+ (snd-display #__line__ ";cheb-tu-sum ~A: [~D] ~A ~A" name i cval sum)
(set! happy #f)))))))
(list (vct 0.0 1.0)
(vct 0.0 0.25 0.0 0.25)
@@ -22173,21 +22249,21 @@ EDITS: 2
'three-tu
'hundred-tu
'thousand-tu))
-
+
(for-each
(lambda (n)
(let ((distance (test-polyoid n)))
(if (fneq distance 0.0)
- (snd-display ";test polyoid ~A ~A" n distance))))
+ (snd-display #__line__ ";test polyoid ~A ~A" n distance))))
(list 1 3 10))
-
+
(for-each
(lambda (n)
(let ((distance (test-polyoid-run n)))
(if (fneq distance 0.0)
- (snd-display ";test polyoid run ~A ~A" n distance))))
+ (snd-display #__line__ ";test polyoid run ~A ~A" n distance))))
(list 1 8 32 100))
-
+
;; polywave
(let ((gen0 (make-polywave 440.0 '(1 1)))
(gen (make-polywave 440.0 :partials '(1 1) :type mus-chebyshev-first-kind))
@@ -22197,27 +22273,27 @@ EDITS: 2
(print-and-check gen
"polywave"
"polywave freq: 440.000Hz, phase: 0.000, coeffs[2]: [0.000 1.000]")
- (if (not (= (mus-length gen) 2)) (snd-display ";polywave length: ~A?" (mus-length gen)))
+ (if (not (= (mus-length gen) 2)) (snd-display #__line__ ";polywave length: ~A?" (mus-length gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((val0 (polywave gen0 0.0))
(val (polywave gen 0.0)))
- (if (fneq val val0) (snd-display ";polywave: ~A /= ~F?" val val0))
+ (if (fneq val val0) (snd-display #__line__ ";polywave: ~A /= ~F?" val val0))
(vct-set! v0 i val)))
(vct-map! v1 (lambda () (if (polywave? gen1) (polywave gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map polywave: ~A ~A" v0 v1))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map polywave: ~A ~A" v0 v1))
(set! gen1 (make-polywave 440.0 (vct 1 1)))
(vct-map! v1 (lambda () (polywave gen1)))
- (if (not (vequal v0 v1)) (snd-display ";1 map polywave: ~A ~A" v0 v1))
- (if (not (polywave? gen)) (snd-display ";~A not polywave?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";polywave phase: ~F?" (mus-phase gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";1 map polywave: ~A ~A" v0 v1))
+ (if (not (polywave? gen)) (snd-display #__line__ ";~A not polywave?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";polywave phase: ~F?" (mus-phase gen)))
(set! (mus-phase gen) 1.0)
- (if (fneq (mus-phase gen) 1.0) (snd-display ";set! polywave phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";polywave frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";set! polywave phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";polywave frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
- (if (fneq (mus-frequency gen) 100.0) (snd-display ";polywave frequency: ~F?" (mus-frequency gen)))
- (if (not (vct? (mus-data gen))) (snd-display ";mus-data polywave: ~A" (mus-data gen)))
- (if (or (fneq (vct-ref v0 1) 0.992) (fneq (vct-ref v0 8) 0.538)) (snd-display ";polywave output: ~A" v0)))
+ (if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";polywave frequency: ~F?" (mus-frequency gen)))
+ (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data polywave: ~A" (mus-data gen)))
+ (if (or (fneq (vct-ref v0 1) 0.992) (fneq (vct-ref v0 8) 0.538)) (snd-display #__line__ ";polywave output: ~A" v0)))
(test-gen-equal (make-polywave 440.0 :partials '(1 1))
(make-polywave 440.0)
@@ -22241,7 +22317,7 @@ EDITS: 2
(val2 (gen 0.0)))
(if (fneq val1 val2)
(begin
- (snd-display ";polywaver (1 1) ~A: ~A ~A" i val1 val2)
+ (snd-display #__line__ ";polywaver (1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
(let ((gen (make-polywave 440.0)) ; check default for partials: '(1 1)
@@ -22253,7 +22329,7 @@ EDITS: 2
(val2 (gen 0.0)))
(if (fneq val1 val2)
(begin
- (snd-display ";polywaver default: '(1 1) ~A: ~A ~A" i val1 val2)
+ (snd-display #__line__ ";polywaver default: '(1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
(let ((gen (make-polywave 440.0 (vct 1 1)))
@@ -22266,9 +22342,9 @@ EDITS: 2
(val2 (gen 0.0)))
(if (fneq val1 val2)
(begin
- (snd-display ";polywaver (1 1) .5 index ~A: ~A ~A" i val1 val2)
+ (snd-display #__line__ ";polywaver (1 1) .5 index ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
-
+
(let ((old-srate (mus-srate)))
(set! (mus-srate) 44100)
(for-each
@@ -22290,7 +22366,7 @@ EDITS: 2
(set! err-max err-local)))
(set! err (+ err err-local))))
(if (> err-max 2.0e-3)
- (snd-display ";polywave vs sin: ~D: ~A ~A ~A" k err err-max err-max-loc)))))
+ (snd-display #__line__ ";polywave vs sin: ~D: ~A ~A ~A" k err err-max err-max-loc)))))
(list 2 19 20 29 30 39 40 60 100))
(for-each
@@ -22305,7 +22381,7 @@ EDITS: 2
(if (fneq val1 val2)
(begin
(set! happy #f)
- (snd-display ";polywave ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (snd-display #__line__ ";polywave ~A at ~A: ~A ~A" n i val1 val2)))))))
(list 1 8 50 128))
(for-each
@@ -22320,7 +22396,7 @@ EDITS: 2
(if (fneq val1 val2)
(begin
(set! happy #f)
- (snd-display ";polywave 2nd ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (snd-display #__line__ ";polywave 2nd ~A at ~A: ~A ~A" n i val1 val2)))))))
(list 1 8 50 128))
(for-each
@@ -22335,7 +22411,7 @@ EDITS: 2
(if (fneq val1 val2)
(begin
(set! happy #f)
- (snd-display ";polyshape ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (snd-display #__line__ ";polyshape ~A at ~A: ~A ~A" n i val1 val2)))))))
(list 1 8 16))
(for-each
@@ -22350,7 +22426,7 @@ EDITS: 2
(if (fneq val1 val2)
(begin
(set! happy #f)
- (snd-display ";polyshape 2nd ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (snd-display #__line__ ";polyshape 2nd ~A at ~A: ~A ~A" n i val1 val2)))))))
(list 1 8 16))
(for-each
@@ -22365,7 +22441,7 @@ EDITS: 2
(val2 (oscil gen2)))
(set! max-dist (max max-dist (abs (- val1 val2)))))))
(if (fneq max-dist 0.0)
- (snd-display ";polywave run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polywave run ~A: ~A ~A" n val1 val2))))
(list 1 3 30 200))
(for-each
@@ -22380,7 +22456,7 @@ EDITS: 2
(val2 (oscil gen2)))
(set! max-dist (max max-dist (abs (- val1 val2)))))))
(if (fneq max-dist 0.0)
- (snd-display ";polywave 2nd run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polywave 2nd run ~A: ~A ~A" n val1 val2))))
(list 1 3 30 200))
(for-each
@@ -22395,7 +22471,7 @@ EDITS: 2
(val2 (oscil gen2)))
(set! max-dist (max max-dist (abs (- val1 val2)))))))
(if (fneq max-dist 0.0)
- (snd-display ";polyshape run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polyshape run ~A: ~A ~A" n val1 val2))))
(list 1 3 25))
(for-each
@@ -22410,14 +22486,14 @@ EDITS: 2
(val2 (oscil gen2)))
(set! max-dist (max max-dist (abs (- val1 val2)))))))
(if (fneq max-dist 0.0)
- (snd-display ";polyshape 2nd run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polyshape 2nd run ~A: ~A ~A" n val1 val2))))
(list 1 3 25))
(let ((gen (make-polywave 100.0 (list 1 .9 3 .1))))
(let ((vals (mus-data gen)))
(if (or (not (vct? vals))
(not (vequal vals (vct 0.000 0.900 0.000 0.100))))
- (snd-display ";polywave mus-data: ~A" vals)
+ (snd-display #__line__ ";polywave mus-data: ~A" vals)
(begin
(vct-set! (mus-data gen) 2 .1)
(vct-set! (mus-data gen) 3 0.0)
@@ -22432,12 +22508,12 @@ EDITS: 2
(if (fneq val1 val2)
(begin
(set! happy #f)
- (snd-display ";polywave set mus-data at ~A: ~A ~A" i val1 val2))))))))))
+ (snd-display #__line__ ";polywave set mus-data at ~A: ~A ~A" i val1 val2))))))))))
(set! (mus-srate) old-srate))
-
+
(let ((var (catch #t (lambda () (make-polywave 440.0 3.14)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-polywave bad coeffs: ~A" var)))
+ (snd-display #__line__ ";make-polywave bad coeffs: ~A" var)))
(let ((gen (make-wave-train 440.0 0.0 (make-vct 20)))
(v0 (make-vct 10))
@@ -22450,40 +22526,40 @@ EDITS: 2
((= i 20))
(vct-set! (mus-data gen) i (* i .5))
(vct-set! (mus-data gen1) i (vct-ref (mus-data gen) i)))
- (if (not (= (vct-length (mus-data gen)) 20)) (snd-display ";wave-train data length: ~A?" (vct-length (mus-data gen))))
- (if (not (= (mus-length gen) 20)) (snd-display ";wave-train length: ~A?" (mus-length gen)))
+ (if (not (= (vct-length (mus-data gen)) 20)) (snd-display #__line__ ";wave-train data length: ~A?" (vct-length (mus-data gen))))
+ (if (not (= (mus-length gen) 20)) (snd-display #__line__ ";wave-train length: ~A?" (mus-length gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (wave-train gen 0.0)))
(vct-map! v1 (lambda () (if (wave-train? gen1) (wave-train gen1) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map wave-train: ~A ~A" v0 v1))
- (if (not (wave-train? gen)) (snd-display ";~A not wave-train?" gen))
- (if (fneq (mus-phase gen) 0.0) (snd-display ";wave-train phase: ~F?" (mus-phase gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map wave-train: ~A ~A" v0 v1))
+ (if (not (wave-train? gen)) (snd-display #__line__ ";~A not wave-train?" gen))
+ (if (fneq (mus-phase gen) 0.0) (snd-display #__line__ ";wave-train phase: ~F?" (mus-phase gen)))
(set! (mus-phase gen) 1.0)
- (if (fneq (mus-phase gen) 1.0) (snd-display ";set wave-train phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";wave-train frequency: ~F?" (mus-frequency gen)))
+ (if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";set wave-train phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";wave-train frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
- (if (fneq (mus-frequency gen) 100.0) (snd-display ";set wave-train freq: ~A" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 1) 0.5) (fneq (vct-ref v0 8) 4.0)) (snd-display ";wave-train output: ~A" v0))
+ (if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";set wave-train freq: ~A" (mus-frequency gen)))
+ (if (or (fneq (vct-ref v0 1) 0.5) (fneq (vct-ref v0 8) 4.0)) (snd-display #__line__ ";wave-train output: ~A" v0))
(mus-reset gen)
- (if (fneq (mus-phase gen) 0.0) (snd-display ";wt reset phase: ~A" (mus-phase gen)))
+ (if (fneq (mus-phase gen) 0.0) (snd-display #__line__ ";wt reset phase: ~A" (mus-phase gen)))
(let ((val (wave-train gen 0.0)))
- (if (fneq val 0.0) (snd-display ";wt reset data: ~A" val)))
- (if (not (vct? (mus-data gen))) (snd-display ";mus-data wave-train: ~A" (mus-data gen)))
+ (if (fneq val 0.0) (snd-display #__line__ ";wt reset data: ~A" val)))
+ (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data wave-train: ~A" (mus-data gen)))
(set! (mus-data gen) (make-vct 3)))
(set! (mus-data (make-oscil)) (make-vct 3))
(test-gen-equal (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 100.0 0.0 (make-vct 20)))
(test-gen-equal (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 440.0 1.0 (make-vct 20)))
-
+
(test-gen-equal (make-wave-train-with-env 440.0 '(0 0 1 1))
(make-wave-train-with-env 440.0 (list 0 0 1 1))
(make-wave-train-with-env 440.0 '(0 0 1 1 2 0)))
(let ((hi (make-wave-train :size 256)))
- (if (not (= (mus-length hi) 256)) (snd-display ";wave-train set length: ~A?" (mus-length hi)))
+ (if (not (= (mus-length hi) 256)) (snd-display #__line__ ";wave-train set length: ~A?" (mus-length hi)))
(set! (mus-length hi) 128)
- (if (not (= (mus-length hi) 128)) (snd-display ";set wave-train set length: ~A?" (mus-length hi))))
+ (if (not (= (mus-length hi) 128)) (snd-display #__line__ ";set wave-train set length: ~A?" (mus-length hi))))
(for-each
(lambda (args)
@@ -22496,8 +22572,8 @@ EDITS: 2
((= i 10))
(vct-set! v i (wave-train tbl1 0.0))) ;(wave-train tbl1 (/ (* 2 pi .2) 4))))
(if (not (vequal v vals))
- (snd-display ";wt tbl interp ~A: ~A ~A" type v (mus-describe tbl1)))
- (if (not (= (mus-interp-type tbl1) type)) (snd-display ";wt tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
+ (snd-display #__line__ ";wt tbl interp ~A: ~A ~A" type v (mus-describe tbl1)))
+ (if (not (= (mus-interp-type tbl1) type)) (snd-display #__line__ ";wt tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
(list
(list mus-interp-none (vct 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000))
(list mus-interp-linear (vct 0.200 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.200 0.800))
@@ -22505,44 +22581,44 @@ EDITS: 2
(list mus-interp-hermite (vct 0.168 0.912 -0.064 -0.016 0.000 0.000 0.000 0.000 0.168 0.912))))
(let ((tag (catch #t (lambda () (make-wave-train :size 0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range)) (snd-display ";wave-train size 0: ~A" tag)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";wave-train size 0: ~A" tag)))
(let ((ind (new-sound "fmv.snd" :size 10 :comment "line 20501")))
- (if (not (= (frames) 10)) (snd-display ";new-sound size(10): ~A" (frames)))
+ (if (not (= (frames) 10)) (snd-display #__line__ ";new-sound size(10): ~A" (frames)))
(map-channel (lambda (y) 1.0) 7 8)
- (if (not (= (frames) 15)) (snd-display ";map-channel 7 8: ~A" (frames)))
+ (if (not (= (frames) 15)) (snd-display #__line__ ";map-channel 7 8: ~A" (frames)))
(map-channel (lambda (y) 1.0))
- (if (not (= (frames) 15)) (snd-display ";map-channel (no dur): ~A" (frames)))
+ (if (not (= (frames) 15)) (snd-display #__line__ ";map-channel (no dur): ~A" (frames)))
(revert-sound ind)
(map-channel (lambda (y) 1.0) 9 10)
- (if (not (= (frames) 19)) (snd-display ";map-channel 9 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display ";map-channel pad edits: ~A" (edit-position ind 0)))
+ (if (not (= (frames) 19)) (snd-display #__line__ ";map-channel 9 10: ~A" (frames)))
+ (if (> (edit-position ind 0) 2) (snd-display #__line__ ";map-channel pad edits: ~A" (edit-position ind 0)))
(revert-sound ind)
(map-channel (lambda (y) 1.0) 10 10)
- (if (not (= (frames) 20)) (snd-display ";map-channel 10 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display ";map-channel pad edits (2): ~A" (edit-position ind 0)))
+ (if (not (= (frames) 20)) (snd-display #__line__ ";map-channel 10 10: ~A" (frames)))
+ (if (> (edit-position ind 0) 2) (snd-display #__line__ ";map-channel pad edits (2): ~A" (edit-position ind 0)))
(revert-sound ind)
(map-channel (lambda (y) 1.0) 20 10)
- (if (not (= (frames) 30)) (snd-display ";map-channel 20 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display ";map-channel pad edits (3): ~A" (edit-position ind 0)))
+ (if (not (= (frames) 30)) (snd-display #__line__ ";map-channel 20 10: ~A" (frames)))
+ (if (> (edit-position ind 0) 2) (snd-display #__line__ ";map-channel pad edits (3): ~A" (edit-position ind 0)))
(revert-sound ind)
- (if (scan-channel (lambda (y) #f) 30 10) (snd-display ";scan-channel past end?"))
+ (if (scan-channel (lambda (y) #f) 30 10) (snd-display #__line__ ";scan-channel past end?"))
(ptree-channel (lambda (y) 1.0) 7 8)
- (if (not (= (frames) 15)) (snd-display ";ptree-channel 7 8: ~A" (frames)))
+ (if (not (= (frames) 15)) (snd-display #__line__ ";ptree-channel 7 8: ~A" (frames)))
(ptree-channel (lambda (y) 1.0))
- (if (not (= (frames) 15)) (snd-display ";ptree-channel (no dur): ~A" (frames)))
+ (if (not (= (frames) 15)) (snd-display #__line__ ";ptree-channel (no dur): ~A" (frames)))
(revert-sound ind)
(ptree-channel (lambda (y) 1.0) 9 10)
- (if (not (= (frames) 19)) (snd-display ";ptree-channel 9 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display ";ptree-channel pad edits: ~A" (edit-position ind 0)))
+ (if (not (= (frames) 19)) (snd-display #__line__ ";ptree-channel 9 10: ~A" (frames)))
+ (if (> (edit-position ind 0) 2) (snd-display #__line__ ";ptree-channel pad edits: ~A" (edit-position ind 0)))
(revert-sound ind)
(ptree-channel (lambda (y) 1.0) 10 10)
- (if (not (= (frames) 20)) (snd-display ";ptree-channel 10 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display ";ptree-channel pad edits (2): ~A" (edit-position ind 0)))
+ (if (not (= (frames) 20)) (snd-display #__line__ ";ptree-channel 10 10: ~A" (frames)))
+ (if (> (edit-position ind 0) 2) (snd-display #__line__ ";ptree-channel pad edits (2): ~A" (edit-position ind 0)))
(revert-sound ind)
(ptree-channel (lambda (y) 1.0) 20 10)
- (if (not (= (frames) 30)) (snd-display ";ptree-channel 20 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display ";ptree-channel pad edits (3): ~A" (edit-position ind 0)))
+ (if (not (= (frames) 30)) (snd-display #__line__ ";ptree-channel 20 10: ~A" (frames)))
+ (if (> (edit-position ind 0) 2) (snd-display #__line__ ";ptree-channel pad edits (3): ~A" (edit-position ind 0)))
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
@@ -22552,28 +22628,28 @@ EDITS: 2
(gen (make-wave-train 1000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
- (if (fneq mx 0.6) (snd-display ";wt 0 max: ~A" mx)))
+ (if (fneq mx 0.6) (snd-display #__line__ ";wt 0 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600)))
- (snd-display ";wt 0 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";wt 0 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 85 30)
(vct 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300)))
- (snd-display ";wt 0 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";wt 0 data 85: ~A" (channel->vct 85 30)))
(undo))
(let* ((table (make-vct 10 .1))
(gen (make-wave-train 1000.0 :initial-phase pi :wave table))) ; initial-phase is confusing in this context!
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";wt 1 max: ~A" mx)))
+ (if (fneq mx 0.1) (snd-display #__line__ ";wt 1 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000)))
(let ((op (print-length)))
(set! (print-length) 32)
- (snd-display ";wt 1 data: ~A" (channel->vct 0 30))
+ (snd-display #__line__ ";wt 1 data: ~A" (channel->vct 0 30))
(set! (print-length) op)))
(undo))
@@ -22581,11 +22657,11 @@ EDITS: 2
(gen (make-wave-train 2000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";wt 2 max: ~A" mx)))
+ (if (fneq mx 0.1) (snd-display #__line__ ";wt 2 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
- (snd-display ";wt 2 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";wt 2 data: ~A" (channel->vct 0 30)))
(if (and (not (vequal (channel->vct 440 30)
(vct 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100)))
@@ -22593,37 +22669,37 @@ EDITS: 2
(not (vequal (channel->vct 440 30)
(vct 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100))))
- (snd-display ";wt 2 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 2 data 440: ~A" (channel->vct 440 30)))
(undo))
(let* ((table (make-vct 10 .1))
(gen (make-wave-train 3000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
- (if (fneq mx 0.2) (snd-display ";wt 3 max: ~A" mx)))
+ (if (fneq mx 0.2) (snd-display #__line__ ";wt 3 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100
0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100)))
- (snd-display ";wt 3 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";wt 3 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 440 30)
(vct 0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100
0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100)))
- (snd-display ";wt 3 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 3 data 440: ~A" (channel->vct 440 30)))
(undo))
(let* ((table (make-vct 10 .1))
(gen (make-wave-train 5000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
- (if (fneq mx 0.3) (snd-display ";wt 4 max: ~A" mx)))
+ (if (fneq mx 0.3) (snd-display #__line__ ";wt 4 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300
0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200)))
- (snd-display ";wt 4 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";wt 4 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 440 30)
(vct 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.300 0.200 0.200 0.200
0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200)))
- (snd-display ";wt 4 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 4 data 440: ~A" (channel->vct 440 30)))
(undo))
(let* ((table (make-vct 10 .1))
@@ -22636,19 +22712,19 @@ EDITS: 2
(set! (mus-frequency gen) (* base-freq (env e)))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";wt 5 max: ~A" mx)))
+ (if (fneq mx 0.1) (snd-display #__line__ ";wt 5 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
- (snd-display ";wt 5 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";wt 5 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 440 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.100)))
- (snd-display ";wt 5 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 5 data 440: ~A" (channel->vct 440 30)))
(if (not (vequal (channel->vct 900 30)
(vct 0.100 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100 0.100)))
- (snd-display ";wt 5 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";wt 5 data 900: ~A" (channel->vct 900 30)))
(undo))
(let* ((table (make-vct 10 .1))
@@ -22664,22 +22740,22 @@ EDITS: 2
(set! ctr (+ 1 ctr)))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.704) (snd-display ";wt 6 max: ~A" mx)))
+ (if (fneq mx 0.704) (snd-display #__line__ ";wt 6 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";wt 6 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";wt 6 data: ~A" (channel->vct 0 30)))
(if (and (not (vequal (channel->vct 440 30)
(vct 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal (channel->vct 440 30)
(vct 0.000 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display ";wt 6 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 6 data 440: ~A" (channel->vct 440 30)))
(if (not (vequal (channel->vct 900 30)
(vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.639 0.639 0.639)))
- (snd-display ";wt 6 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";wt 6 data 900: ~A" (channel->vct 900 30)))
(undo))
(let ((fname (file-name ind)))
(close-sound ind)
@@ -22703,23 +22779,23 @@ EDITS: 2
(if (string=? (mus-file-name gen1) "oboe.snd")
-1.0
-1.0))))
- (if (not (vequal v0 v1)) (snd-display ";map readin: ~A ~A" v0 v1))
- (if (not (readin? gen)) (snd-display ";~A not readin?" gen))
- (if (not (mus-input? gen)) (snd-display ";~A not input?" gen))
- (if (not (= (mus-length gen) 50828)) (snd-display ";readin length: ~A?" (mus-length gen)))
- (if (not (= (mus-channel gen) 0)) (snd-display ";readin chan: ~A?" (mus-channel gen)))
- (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display ";readin mus-file-name: ~A" (mus-file-name gen)))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display ";readin output: ~A" v0))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map readin: ~A ~A" v0 v1))
+ (if (not (readin? gen)) (snd-display #__line__ ";~A not readin?" gen))
+ (if (not (mus-input? gen)) (snd-display #__line__ ";~A not input?" gen))
+ (if (not (= (mus-length gen) 50828)) (snd-display #__line__ ";readin length: ~A?" (mus-length gen)))
+ (if (not (= (mus-channel gen) 0)) (snd-display #__line__ ";readin chan: ~A?" (mus-channel gen)))
+ (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display #__line__ ";readin mus-file-name: ~A" (mus-file-name gen)))
+ (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";readin output: ~A" v0))
(set! (mus-location gen) 1000)
- (if (not (= (mus-location gen) 1000)) (snd-display ";set! mus-location: ~A?" (mus-location gen)))
+ (if (not (= (mus-location gen) 1000)) (snd-display #__line__ ";set! mus-location: ~A?" (mus-location gen)))
(let ((val (readin gen)))
- (if (fneq val 0.033) (snd-display ";set! mus-location readin: ~A?" val)))
+ (if (fneq val 0.033) (snd-display #__line__ ";set! mus-location readin: ~A?" val)))
(set! (mus-increment gen) -1)
- (if (fneq (mus-increment gen) -1.0) (snd-display ";set increment readin: ~A" (mus-increment gen))))
+ (if (fneq (mus-increment gen) -1.0) (snd-display #__line__ ";set increment readin: ~A" (mus-increment gen))))
(let ((tag (catch #t (lambda () (make-readin "/baddy/hiho" 0 124)) (lambda args args))))
- (if (not (eq? (car tag) 'no-such-file)) (snd-display ";make-readin w/o file: ~A" tag)))
+ (if (not (eq? (car tag) 'no-such-file)) (snd-display #__line__ ";make-readin w/o file: ~A" tag)))
(let ((tag (catch #t (lambda () (make-readin "oboe.snd" 123 124)) (lambda args args))))
- (if (not (eq? (car tag) 'out-of-range)) (snd-display ";make-readin with bad chan: ~A" tag)))
+ (if (not (eq? (car tag) 'out-of-range)) (snd-display #__line__ ";make-readin with bad chan: ~A" tag)))
(test-gen-equal (make-readin "oboe.snd" 0) (make-readin "oboe.snd" 0) (make-readin "oboe.snd" 0 1230))
(test-gen-equal (make-readin "oboe.snd" 0 :size 512) (make-readin "oboe.snd" 0 :size 512) (make-readin "pistol.snd" 0 :size 512))
@@ -22733,8 +22809,8 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (readin gen)))
- (if (not (= (mus-channel gen) 1)) (snd-display ";readin chan 1: ~A?" (mus-channel gen)))
- (if (or (fneq (vct-ref v0 1) 0.010) (fneq (vct-ref v0 7) -.006)) (snd-display ";readin 1 output: ~A" v0))
+ (if (not (= (mus-channel gen) 1)) (snd-display #__line__ ";readin chan 1: ~A?" (mus-channel gen)))
+ (if (or (fneq (vct-ref v0 1) 0.010) (fneq (vct-ref v0 7) -.006)) (snd-display #__line__ ";readin 1 output: ~A" v0))
(print-and-check gen
"readin"
"readin 2.snd[chan 1], loc: 10, dir: 1"))
@@ -22744,17 +22820,17 @@ EDITS: 2
(print-and-check gen
"file->sample"
"file->sample oboe.snd")
- (if (not (mus-input? gen)) (snd-display ";~A not input?" gen))
- (if (not (= (mus-length gen) 50828)) (snd-display ";file->sample length: ~A?" (mus-length gen)))
- (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display ";file->sample mus-file-name: ~A" (mus-file-name gen)))
+ (if (not (mus-input? gen)) (snd-display #__line__ ";~A not input?" gen))
+ (if (not (= (mus-length gen) 50828)) (snd-display #__line__ ";file->sample length: ~A?" (mus-length gen)))
+ (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display #__line__ ";file->sample mus-file-name: ~A" (mus-file-name gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (file->sample gen (+ 1490 i))))
- (if (not (file->sample? gen)) (snd-display ";~A not file->sample?" gen))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display ";file->sample output: ~A" v0))
- (if (fneq (mus-increment gen) 0.0) (snd-display ";file->sample increment: ~A" (mus-increment gen)))
+ (if (not (file->sample? gen)) (snd-display #__line__ ";~A not file->sample?" gen))
+ (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";file->sample output: ~A" v0))
+ (if (fneq (mus-increment gen) 0.0) (snd-display #__line__ ";file->sample increment: ~A" (mus-increment gen)))
(set! (mus-increment gen) 1.0)
- (if (fneq (mus-increment gen) 1.0) (snd-display ";file->sample set increment: ~A" (mus-increment gen)))
+ (if (fneq (mus-increment gen) 1.0) (snd-display #__line__ ";file->sample set increment: ~A" (mus-increment gen)))
(mus-reset gen)) ; a no-op I hope
(let* ((ind (open-sound "oboe.snd"))
@@ -22764,23 +22840,23 @@ EDITS: 2
(print-and-check gen
"snd->sample"
"snd->sample reading oboe.snd (1 chan) at 0:[no readers]")
- (if (not (equal? gen gen)) (snd-display ";snd->sample not eq? itself?"))
- (if (equal? gen gen1) (snd-display ";snd->sample eq? not itself?"))
- (if (not (mus-input? gen)) (snd-display ";snd->sample ~A not input?" gen))
- (if (not (= (frames ind) (mus-length gen))) (snd-display ";snd->sample len: ~A ~A" (frames ind) (mus-length gen)))
+ (if (not (equal? gen gen)) (snd-display #__line__ ";snd->sample not eq? itself?"))
+ (if (equal? gen gen1) (snd-display #__line__ ";snd->sample eq? not itself?"))
+ (if (not (mus-input? gen)) (snd-display #__line__ ";snd->sample ~A not input?" gen))
+ (if (not (= (frames ind) (mus-length gen))) (snd-display #__line__ ";snd->sample len: ~A ~A" (frames ind) (mus-length gen)))
(if (not (string=? (mus-file-name gen) (string-append cwd "oboe.snd")))
- (snd-display ";snd->sample mus-file-name: ~A ~A" (mus-file-name gen) (string-append cwd "oboe.snd")))
+ (snd-display #__line__ ";snd->sample mus-file-name: ~A ~A" (mus-file-name gen) (string-append cwd "oboe.snd")))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (snd->sample gen (+ 1490 i))))
- (if (not (snd->sample? gen)) (snd-display ";~A not snd->sample?" gen))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display ";snd->sample output: ~A" v0))
- (if (not (= (mus-channels gen) 1)) (snd-display ";snd->sample channels: ~A" (mus-channels gen)))
- (if (not (= (mus-location gen) 1499)) (snd-display ";snd->sample location: ~A" (mus-location gen)))
+ (if (not (snd->sample? gen)) (snd-display #__line__ ";~A not snd->sample?" gen))
+ (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";snd->sample output: ~A" v0))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";snd->sample channels: ~A" (mus-channels gen)))
+ (if (not (= (mus-location gen) 1499)) (snd-display #__line__ ";snd->sample location: ~A" (mus-location gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (ina (+ 1490 i) gen)))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display ";snd->sample ina output: ~A" v0))
+ (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";snd->sample ina output: ~A" v0))
(close-sound ind))
(let* ((ind (open-sound "2.snd"))
@@ -22793,12 +22869,12 @@ EDITS: 2
(print-and-check gen
"snd->sample"
"snd->sample reading 2.snd (2 chans) at 1499:[#<sampler: 2.snd[0: 0] from 1490, at 1500, forward>, #<sampler: 2.snd[1: 0] from 1490, at 1500, forward>]")
- (if (not (mus-input? gen)) (snd-display ";snd->sample ~A not input?" gen))
+ (if (not (mus-input? gen)) (snd-display #__line__ ";snd->sample ~A not input?" gen))
(if (not (string=? (mus-file-name gen) (string-append cwd "2.snd")))
- (snd-display ";snd->sample mus-file-name: ~A ~A" (mus-file-name gen) (string-append cwd "2.snd")))
- (if (not (snd->sample? gen)) (snd-display ";~A not snd->sample?" gen))
- (if (not (= (mus-channels gen) 2)) (snd-display ";snd->sample channels (2): ~A" (mus-channels gen)))
- (if (not (= (mus-location gen) 1499)) (snd-display ";snd->sample location (2): ~A" (mus-location gen)))
+ (snd-display #__line__ ";snd->sample mus-file-name: ~A ~A" (mus-file-name gen) (string-append cwd "2.snd")))
+ (if (not (snd->sample? gen)) (snd-display #__line__ ";~A not snd->sample?" gen))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";snd->sample channels (2): ~A" (mus-channels gen)))
+ (if (not (= (mus-location gen) 1499)) (snd-display #__line__ ";snd->sample location (2): ~A" (mus-location gen)))
(close-sound ind))
(let ((gen (make-file->frame "oboe.snd"))
@@ -22806,14 +22882,14 @@ EDITS: 2
(print-and-check gen
"file->frame"
"file->frame oboe.snd")
- (if (not (mus-input? gen)) (snd-display ";~A not input?" gen))
- (if (not (= (mus-length gen) 50828)) (snd-display ";file->frame length: ~A?" (mus-length gen)))
- (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display ";file->frame mus-file-name: ~A" (mus-file-name gen)))
+ (if (not (mus-input? gen)) (snd-display #__line__ ";~A not input?" gen))
+ (if (not (= (mus-length gen) 50828)) (snd-display #__line__ ";file->frame length: ~A?" (mus-length gen)))
+ (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display #__line__ ";file->frame mus-file-name: ~A" (mus-file-name gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (frame-ref (file->frame gen (+ 1490 i)) 0)))
- (if (not (file->frame? gen)) (snd-display ";~A not file->frame?" gen))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display ";file->frame output: ~A" v0)))
+ (if (not (file->frame? gen)) (snd-display #__line__ ";~A not file->frame?" gen))
+ (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";file->frame output: ~A" v0)))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(if (file-exists? "fmv1.snd") (delete-file "fmv1.snd"))
@@ -22823,12 +22899,12 @@ EDITS: 2
(print-and-check gen
"sample->file"
"sample->file fmv.snd")
- (if (not (mus-output? gen)) (snd-display ";~A not output?" gen))
- (if (not (sample->file? gen)) (snd-display ";~A not sample->file?" gen))
- (if (not (= (mus-length gen) (mus-file-buffer-size))) (snd-display ";sample->file length: ~A?" (mus-length gen)))
+ (if (not (mus-output? gen)) (snd-display #__line__ ";~A not output?" gen))
+ (if (not (sample->file? gen)) (snd-display #__line__ ";~A not sample->file?" gen))
+ (if (not (= (mus-length gen) (mus-file-buffer-size))) (snd-display #__line__ ";sample->file length: ~A?" (mus-length gen)))
(let ((genx gen))
- (if (not (equal? genx gen)) (snd-display ";sample->file equal? ~A ~A" genx gen)))
- (if (not (string=? (mus-file-name gen) "fmv.snd")) (snd-display ";sample->file mus-file-name: ~A" (mus-file-name gen)))
+ (if (not (equal? genx gen)) (snd-display #__line__ ";sample->file equal? ~A ~A" genx gen)))
+ (if (not (string=? (mus-file-name gen) "fmv.snd")) (snd-display #__line__ ";sample->file mus-file-name: ~A" (mus-file-name gen)))
(do ((i 0 (+ 1 i)))
((= i 100))
(sample->file gen i 0 (* i .001))
@@ -22852,13 +22928,13 @@ EDITS: 2
(print-and-check gen
"file->sample"
"file->sample fmv.snd")
- (if (not (= (mus-channels gen) 2)) (snd-display ";make-sample->file chans: ~A?" (mus-channels gen)))
- (if (not (mus-input? gen)) (snd-display ";~A not input?" gen))
- (if (or (fneq val0 .02) (fneq val1 .2)) (snd-display ";in-any: ~A ~A?" val0 val1))
- (if (or (fneq val2 .03) (fneq val3 .3)) (snd-display ";inab: ~A ~A?" val2 val3))
- (if (or (fneq val4 .04) (fneq val5 .4)) (snd-display ";sample->file: ~A ~A?" val4 val5))
- (if (or (fneq val6 .065) (fneq val7 .65)) (snd-display ";outab: ~A ~A?" val6 val7))
- (if (or (fneq val8 .075) (fneq val9 .75)) (snd-display ";out-any: ~A ~A?" val8 val9)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-sample->file chans: ~A?" (mus-channels gen)))
+ (if (not (mus-input? gen)) (snd-display #__line__ ";~A not input?" gen))
+ (if (or (fneq val0 .02) (fneq val1 .2)) (snd-display #__line__ ";in-any: ~A ~A?" val0 val1))
+ (if (or (fneq val2 .03) (fneq val3 .3)) (snd-display #__line__ ";inab: ~A ~A?" val2 val3))
+ (if (or (fneq val4 .04) (fneq val5 .4)) (snd-display #__line__ ";sample->file: ~A ~A?" val4 val5))
+ (if (or (fneq val6 .065) (fneq val7 .65)) (snd-display #__line__ ";outab: ~A ~A?" val6 val7))
+ (if (or (fneq val8 .075) (fneq val9 .75)) (snd-display #__line__ ";out-any: ~A ~A?" val8 val9)))
(let ((gen (make-vct 10)))
(do ((i 0 (+ 1 i))
@@ -22866,14 +22942,14 @@ EDITS: 2
((= i 10))
(outa i x gen))
(if (not (vequal gen (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))
- (snd-display ";outa->vct ramp: ~A" gen))
+ (snd-display #__line__ ";outa->vct ramp: ~A" gen))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x 0.1)))
((= i 10))
(outa i x gen))
(if (not (vequal gen (vct-scale! (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9) 2.0)))
- (snd-display ";outa->vct ramp 2: ~A" gen))
- (if (not (= (mus-channels gen) 1)) (snd-display ";mus-channels vct: ~A" (mus-channels gen))))
+ (snd-display #__line__ ";outa->vct ramp 2: ~A" gen))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";mus-channels vct: ~A" (mus-channels gen))))
(let ((gen (make-sound-data 4 100)))
(do ((i 0 (+ 1 i)))
@@ -22895,8 +22971,8 @@ EDITS: 2
(fneq (inb i gen) .22)
(fneq (in-any i 2 gen) .33)
(fneq (in-any i 3 gen) .44))
- (snd-display ";4-chan sd out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen))))
- (if (not (= (mus-channels gen) 4)) (snd-display ";mus-channels sd 4: ~A" (mus-channels gen))))
+ (snd-display #__line__ ";4-chan sd out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen))))
+ (if (not (= (mus-channels gen) 4)) (snd-display #__line__ ";mus-channels sd 4: ~A" (mus-channels gen))))
(let ((gen (make-sound-data 4 100)))
(do ((i 0 (+ 1 i)))
@@ -22917,13 +22993,13 @@ EDITS: 2
(fneq (in-any i 1 gen) .22)
(fneq (in-any i 2 gen) .33)
(fneq (in-any i 3 gen) .44))
- (snd-display ";4-chan sd out/in-any[~A]: ~A ~A ~A ~A?" i (in-any i 0 gen) (in-any i 1 gen) (in-any i 2 gen) (in-any i 3 gen)))))
+ (snd-display #__line__ ";4-chan sd out/in-any[~A]: ~A ~A ~A ~A?" i (in-any i 0 gen) (in-any i 1 gen) (in-any i 2 gen) (in-any i 3 gen)))))
(let ((gen (make-oscil 440.0)))
(let ((tag (catch #t (lambda () (outa 0 .1 gen)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";outa -> oscil: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";outa -> oscil: ~A" tag)))
(let ((val (catch #t (lambda () (outa 0 .1 #f)) (lambda args (car args)))))
- (if (or (not (number? val)) (fneq val .1)) (snd-display ";outa -> #f: ~A" val))))
+ (if (or (not (number? val)) (fneq val .1)) (snd-display #__line__ ";outa -> #f: ~A" val))))
(let ((gen (make-sample->file "fmv.snd" 4 mus-lshort mus-riff)))
(print-and-check gen
@@ -22952,7 +23028,7 @@ EDITS: 2
(fneq (inb i gen) .22)
(fneq (in-any i 2 gen) .33)
(fneq (in-any i 3 gen) .44))
- (snd-display ";4-chan out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen)))))
+ (snd-display #__line__ ";4-chan out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen)))))
(let ((gen (make-sample->file "fmv.snd" 4 mus-lshort mus-riff)))
(run
@@ -22976,20 +23052,28 @@ EDITS: 2
(fneq (inb i gen) .22)
(fneq (in-any i 2 gen) .33)
(fneq (in-any i 3 gen) .44))
- (snd-display ";4-chan out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen)))))
+ (snd-display #__line__ ";4-chan out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen)))))
(let ((var (catch #t (lambda () (make-sample->file "fmv.snd" -1 mus-lshort mus-next)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-sample->file bad chans: ~A" var)))
+ (snd-display #__line__ ";make-sample->file bad chans: ~A" var)))
(let ((var (catch #t (lambda () (mus-location (make-oscil))) (lambda args args))))
(if (or (not (list? var)) (not (eq? (car var) 'mus-error)))
- (snd-display ";mus-location oscil: ~A" var)))
+ (snd-display #__line__ ";mus-location oscil: ~A" var)))
(let ((var (catch #t (lambda () (make-sample->file "fmv.snd" 1 -1 mus-next)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-sample->file bad format: ~A" var)))
+ (snd-display #__line__ ";make-sample->file bad format: ~A" var)))
(let ((var (catch #t (lambda () (make-sample->file "fmv.snd" 1 mus-lshort -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-sample->file bad type: ~A" var)))
+ (snd-display #__line__ ";make-sample->file bad type: ~A" var)))
+
+ (let ((v (vector 1.0 0.5 0.25 0.125 0.0))
+ (v1 (make-vct 5 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 5))
+ (set! (v1 i) (in-any i 0 v)))
+ (if (not (vequal v1 (vct 1.0 0.5 0.25 0.125 0.0)))
+ (snd-display #__line__ ";vector in-any -> ~A?" v1)))
(let ((sum 0.0))
(let ((result (with-sound (:output (make-vct 10))
@@ -22999,7 +23083,7 @@ EDITS: 2
(set! sum (+ sum (* loc 0.1)))
sum)))))))
(if (not (vequal result (vct 0.000 0.100 0.300 0.600 1.000 1.500 2.100 2.800 3.600 4.500)))
- (snd-display ";ina function: ~A" result))))
+ (snd-display #__line__ ";ina function: ~A" result))))
(let ((sum 0.0))
(let ((result (with-sound (:output (make-vct 10))
@@ -23010,7 +23094,7 @@ EDITS: 2
(set! sum (+ sum (* loc 0.1)))
sum))))))))
(if (not (vequal result (vct 0.000 0.100 0.300 0.600 1.000 1.500 2.100 2.800 3.600 4.500)))
- (snd-display ";run ina function: ~A" result))))
+ (snd-display #__line__ ";run ina function: ~A" result))))
(let ((invals (make-vct 10)))
(do ((i 0 (+ 1 i)))
@@ -23021,7 +23105,7 @@ EDITS: 2
((= i 10))
(outa i (ina i invals))))))
(if (not (vequal result (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";ina from vct: ~A" result))))
+ (snd-display #__line__ ";ina from vct: ~A" result))))
(let ((invals (make-vct 10)))
(do ((i 0 (+ 1 i)))
@@ -23033,13 +23117,13 @@ EDITS: 2
((= i 10))
(outa i (ina i invals)))))))
(if (not (vequal result (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run ina from vct: ~A" result))))
+ (snd-display #__line__ ";run ina from vct: ~A" result))))
(let ((old-buffer-size (mus-file-buffer-size))
(old-clm-buffer-size *clm-file-buffer-size*))
(set! (mus-file-buffer-size) 1024)
(set! *clm-file-buffer-size* 1024)
-
+
(let ((input (make-readin "oboe.snd" :start 1000)))
(let ((result (with-sound (:output (make-vct 10))
(do ((i 0 (+ 1 i)))
@@ -23047,7 +23131,7 @@ EDITS: 2
(outa i (ina i (lambda (loc chn)
(readin input))))))))
(if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display ";ina function readin: ~A" result)))
+ (snd-display #__line__ ";ina function readin: ~A" result)))
(mus-close input))
(let ((input (make-readin "oboe.snd" :start 1000)))
@@ -23058,7 +23142,7 @@ EDITS: 2
(outa i (ina i (lambda (loc chn)
(readin input)))))))))
(if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display ";run ina function readin: ~A" result)))
+ (snd-display #__line__ ";run ina function readin: ~A" result)))
(mus-close input))
(let ((input (make-file->sample "oboe.snd")))
@@ -23068,7 +23152,7 @@ EDITS: 2
(outa i (ina (+ i 1000) (lambda (loc chn)
(in-any loc chn input))))))))
(if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display ";ina function in-any: ~A" result)))
+ (snd-display #__line__ ";ina function in-any: ~A" result)))
(mus-close input))
(let ((input (make-file->sample "oboe.snd")))
@@ -23079,7 +23163,7 @@ EDITS: 2
(outa i (ina (+ i 1000) (lambda (loc chn)
(in-any loc chn input)))))))))
(if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display ";run ina function in-any: ~A" result)))
+ (snd-display #__line__ ";run ina function in-any: ~A" result)))
(mus-close input))
(set! *clm-file-buffer-size* old-clm-buffer-size)
@@ -23098,9 +23182,9 @@ EDITS: 2
(outb i (ina i (lambda (loc chn)
(sound-data-ref invals chn loc))))))))
(if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";inb from sound-data function: ~A" (sound-data->vct result 0)))
+ (snd-display #__line__ ";inb from sound-data function: ~A" (sound-data->vct result 0)))
(if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";ina from sound-data function: ~A" (sound-data->vct result 1)))))
+ (snd-display #__line__ ";ina from sound-data function: ~A" (sound-data->vct result 1)))))
(let ((invals (make-sound-data 2 10)))
(do ((i 0 (+ 1 i)))
@@ -23116,9 +23200,9 @@ EDITS: 2
(outb i (ina i (lambda (loc chn)
(sound-data-ref invals chn loc)))))))))
(if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";run inb from sound-data function: ~A" (sound-data->vct result 0)))
+ (snd-display #__line__ ";run inb from sound-data function: ~A" (sound-data->vct result 0)))
(if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run ina from sound-data function: ~A" (sound-data->vct result 1)))))
+ (snd-display #__line__ ";run ina from sound-data function: ~A" (sound-data->vct result 1)))))
(let ((invals (make-sound-data 2 10)))
(do ((i 0 (+ 1 i)))
@@ -23133,9 +23217,9 @@ EDITS: 2
(outb i (in-any i 0 (lambda (loc chn)
(in-any loc chn invals))))))))
(if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";in-any 1 from sound-data function: ~A" (sound-data->vct result 0)))
+ (snd-display #__line__ ";in-any 1 from sound-data function: ~A" (sound-data->vct result 0)))
(if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";in-any 0 from sound-data function: ~A" (sound-data->vct result 1)))))
+ (snd-display #__line__ ";in-any 0 from sound-data function: ~A" (sound-data->vct result 1)))))
(let ((invals (make-sound-data 2 10)))
(do ((i 0 (+ 1 i)))
@@ -23151,9 +23235,9 @@ EDITS: 2
(outb i (in-any i 0 (lambda (loc chn)
(in-any loc chn invals)))))))))
(if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";run in-any 1 from sound-data function: ~A" (sound-data->vct result 0)))
+ (snd-display #__line__ ";run in-any 1 from sound-data function: ~A" (sound-data->vct result 0)))
(if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run in-any 0 from sound-data function: ~A" (sound-data->vct result 1)))))
+ (snd-display #__line__ ";run in-any 0 from sound-data function: ~A" (sound-data->vct result 1)))))
(let ((input (make-file->sample "oboe.snd")))
(let ((result (with-sound (:output (make-vct 10))
@@ -23162,7 +23246,7 @@ EDITS: 2
(outa i (in-any (+ i 1000) 0 (lambda (loc chn)
(in-any loc chn input))))))))
(if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display ";in-any file->sample in-any: ~A" result))))
+ (snd-display #__line__ ";in-any file->sample in-any: ~A" result))))
(let ((input (make-file->sample "oboe.snd")))
(let ((result (with-sound (:output (make-vct 10))
@@ -23172,9 +23256,9 @@ EDITS: 2
(outa i (in-any (+ i 1000) 0 (lambda (loc chn)
(in-any loc chn input)))))))))
(if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display ";run in-any file->sample in-any: ~A" result))))
-
-
+ (snd-display #__line__ ";run in-any file->sample in-any: ~A" result))))
+
+
(let ((avg 0.0)
(samps 0))
(with-sound (:output (lambda (frame val chan)
@@ -23186,7 +23270,7 @@ EDITS: 2
(outa i (* i .1))))
(let ((result (/ avg samps)))
(if (fneq result 0.5)
- (snd-display ";output as avg: ~A" result))))
+ (snd-display #__line__ ";output as avg: ~A" result))))
(let ((avg 0.0)
(samps 0))
@@ -23201,7 +23285,7 @@ EDITS: 2
(outa i (* i .1)))))
(let ((result (/ avg samps)))
(if (fneq result 0.5)
- (snd-display ";run output as avg: ~A" result))))
+ (snd-display #__line__ ";run output as avg: ~A" result))))
(let ((outv (make-vct 10)))
(with-sound ()
@@ -23210,7 +23294,7 @@ EDITS: 2
(outa i (* i .1) (lambda (loc val chan)
(vct-set! outv loc val)))))
(if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";outa func vct: ~A" outv)))
+ (snd-display #__line__ ";outa func vct: ~A" outv)))
(let ((outv (make-vct 10)))
(with-sound ()
@@ -23220,7 +23304,7 @@ EDITS: 2
(outa i (* i .1) (lambda (loc val chan)
(vct-set! outv loc val))))))
(if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run outa func vct: ~A" outv)))
+ (snd-display #__line__ ";run outa func vct: ~A" outv)))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4)
@@ -23235,35 +23319,35 @@ EDITS: 2
(outd i (* i .4) (lambda (loc val chan)
(sound-data-set! outv chan loc val)))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";outa 1 to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";outa 1 to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";outb 1 to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";outb 1 to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";outc 1 to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";outc 1 to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";outd 1 to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";outd 1 to sound-data function: ~A" (sound-data->vct outv 3))))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4)
(run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outb i (* i .2) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outc i (* i .3) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outd i (* i .4) (lambda (loc val chan)
- (sound-data-set! outv chan loc val))))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (outa i (* i .1) (lambda (loc val chan)
+ (sound-data-set! outv chan loc val)))
+ (outb i (* i .2) (lambda (loc val chan)
+ (sound-data-set! outv chan loc val)))
+ (outc i (* i .3) (lambda (loc val chan)
+ (sound-data-set! outv chan loc val)))
+ (outd i (* i .4) (lambda (loc val chan)
+ (sound-data-set! outv chan loc val))))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run outa 1 to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";run outa 1 to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";run outb 1 to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";run outb 1 to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";run outc 1 to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";run outc 1 to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";run outd 1 to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";run outd 1 to sound-data function: ~A" (sound-data->vct outv 3))))
(let ((outv (make-vct 10)))
(with-sound ()
@@ -23272,7 +23356,7 @@ EDITS: 2
(out-any i (* i .1) 0 (lambda (loc val chan)
(vct-set! outv loc val)))))
(if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";out-any func to vct: ~A" outv)))
+ (snd-display #__line__ ";out-any func to vct: ~A" outv)))
(let ((outv (make-vct 10)))
(with-sound ()
@@ -23282,7 +23366,7 @@ EDITS: 2
(out-any i (* i .1) 0 (lambda (loc val chan)
(vct-set! outv loc val))))))
(if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run out-any func to vct: ~A" outv)))
+ (snd-display #__line__ ";run out-any func to vct: ~A" outv)))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4)
@@ -23291,15 +23375,15 @@ EDITS: 2
(do ((k 0 (+ 1 k)))
((= k 4))
(out-any i (* i .1 (+ 1 k)) k (lambda (loc val chan)
- (sound-data-set! outv chan loc val))))))
+ (sound-data-set! outv chan loc val))))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";out-any 0 to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";out-any 0 to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";out-any 1 to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";out-any 1 to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";out-any 2 to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";out-any 2 to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";out-any 3 to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";out-any 3 to sound-data function: ~A" (sound-data->vct outv 3))))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4)
@@ -23311,13 +23395,13 @@ EDITS: 2
(out-any i (* i .1 (+ 1 k)) k (lambda (loc val chan)
(sound-data-set! outv chan loc val)))))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run out-any 0 to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";run out-any 0 to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";run out-any 1 to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";run out-any 1 to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";run out-any 2 to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";run out-any 2 to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";run out-any 3 to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";run out-any 3 to sound-data function: ~A" (sound-data->vct outv 3))))
(let ((outv (make-vct 10)))
(with-sound (:output (lambda (loc val chan)
@@ -23326,7 +23410,7 @@ EDITS: 2
((= i 10))
(outa i (* i .1))))
(if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";outa output func to vct: ~A" outv)))
+ (snd-display #__line__ ";outa output func to vct: ~A" outv)))
(let ((outv (make-vct 10)))
(with-sound (:output (lambda (loc val chan)
@@ -23337,7 +23421,7 @@ EDITS: 2
((= i 10))
(outa i (* i .1)))))
(if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run outa output func to vct: ~A" outv)))
+ (snd-display #__line__ ";run outa output func to vct: ~A" outv)))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4 :output (lambda (loc val chan)
@@ -23349,13 +23433,13 @@ EDITS: 2
(outc i (* i .3))
(outd i (* i .4))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";outa output to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";outa output to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";outb output to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";outb output to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";outc output to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";outc output to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";outd output to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";outd output to sound-data function: ~A" (sound-data->vct outv 3))))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4 :output (lambda (loc val chan)
@@ -23369,13 +23453,13 @@ EDITS: 2
(outc i (* i .3))
(outd i (* i .4)))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run outa output to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";run outa output to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";run outb output to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";run outb output to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";run outc output to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";run outc output to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";run outd output to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";run outd output to sound-data function: ~A" (sound-data->vct outv 3))))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4 :output (lambda (loc val chan)
@@ -23386,13 +23470,13 @@ EDITS: 2
((= k 4))
(out-any i (* i .1 (+ 1 k)) k))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";out-any 0 output to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";out-any 0 output to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";out-any 1 output to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";out-any 1 output to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";out-any 2 output to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";out-any 2 output to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";out-any 3 output to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";out-any 3 output to sound-data function: ~A" (sound-data->vct outv 3))))
(let ((outv (make-sound-data 4 10)))
(with-sound (:channels 4 :output (lambda (loc val chan)
@@ -23405,48 +23489,48 @@ EDITS: 2
((= k 4))
(out-any i (* i .1 (+ 1 k)) k)))))
(if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display ";run out-any 0 output to sound-data function: ~A" (sound-data->vct outv 0)))
+ (snd-display #__line__ ";run out-any 0 output to sound-data function: ~A" (sound-data->vct outv 0)))
(if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display ";run out-any 1 output to sound-data function: ~A" (sound-data->vct outv 1)))
+ (snd-display #__line__ ";run out-any 1 output to sound-data function: ~A" (sound-data->vct outv 1)))
(if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display ";run out-any 2 output to sound-data function: ~A" (sound-data->vct outv 2)))
+ (snd-display #__line__ ";run out-any 2 output to sound-data function: ~A" (sound-data->vct outv 2)))
(if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display ";run out-any 3 output to sound-data function: ~A" (sound-data->vct outv 3))))
+ (snd-display #__line__ ";run out-any 3 output to sound-data function: ~A" (sound-data->vct outv 3))))
(for-each close-sound (sounds))
-
+
(let ((vals (with-sound (:output (make-vct 4410))
(fm-violin 0 .1 440 .1))))
(if (fneq (vct-peak vals) .1)
- (snd-display ";locsig to vct fm-violin peak: ~A" (vct-peak vals))))
+ (snd-display #__line__ ";locsig to vct fm-violin peak: ~A" (vct-peak vals))))
;; TODO: get vector with-sound output to work in run
-
+
(let ((vals (with-sound (:output (make-sound-data 2 4410))
(fm-violin 0 .1 440 .1 :degree 30))))
(let ((mxs (sound-data-maxamp vals)))
(if (or (fneq (car mxs) 0.0666)
(fneq (cadr mxs) 0.0333))
- (snd-display ";locsig to sound-data fm-violin peak: ~A" mxs))))
+ (snd-display #__line__ ";locsig to sound-data fm-violin peak: ~A" mxs))))
(let ((data (make-vct 4410)))
(with-sound (:output (lambda (loc val chan)
(vct-set! data loc val)))
(fm-violin 0 .1 440 .1))
(if (fneq (vct-peak data) .1)
- (snd-display ";locsig to func fm-violin peak: ~A" (vct-peak data))))
-
+ (snd-display #__line__ ";locsig to func fm-violin peak: ~A" (vct-peak data))))
+
(let ((gen (make-frame->file "fmv1.snd" 2 mus-bshort mus-next)))
(print-and-check gen
"frame->file"
"frame->file fmv1.snd")
- (if (not (mus-output? gen)) (snd-display ";~A not output?" gen))
- (if (not (frame->file? gen)) (snd-display ";~A not frame->file?" gen))
- (if (not (= (mus-length gen) (mus-file-buffer-size))) (snd-display ";frame->file length: ~A?" (mus-length gen)))
- (if (not (string=? (mus-file-name gen) "fmv1.snd")) (snd-display ";frame->file mus-file-name: ~A" (mus-file-name gen)))
+ (if (not (mus-output? gen)) (snd-display #__line__ ";~A not output?" gen))
+ (if (not (frame->file? gen)) (snd-display #__line__ ";~A not frame->file?" gen))
+ (if (not (= (mus-length gen) (mus-file-buffer-size))) (snd-display #__line__ ";frame->file length: ~A?" (mus-length gen)))
+ (if (not (string=? (mus-file-name gen) "fmv1.snd")) (snd-display #__line__ ";frame->file mus-file-name: ~A" (mus-file-name gen)))
(set! (mus-length gen) 4096)
- (if (not (= (mus-length gen) 4096)) (snd-display ";frame->file length (1): ~A?" (mus-length gen)))
+ (if (not (= (mus-length gen) 4096)) (snd-display #__line__ ";frame->file length (1): ~A?" (mus-length gen)))
(set! (mus-length gen) 8192)
(let ((fr0 (make-frame 2 0.0 0.0)))
(do ((i 0 (+ 1 i)))
@@ -23459,17 +23543,17 @@ EDITS: 2
(val4 (file->frame gen 40))
(frout (make-frame 2)))
(if (or (fneq (frame-ref val4 0) .04) (fneq (frame-ref val4 1) .4))
- (snd-display ";frame->file output: ~A?" val4))
+ (snd-display #__line__ ";frame->file output: ~A?" val4))
(file->frame gen 40 frout)
(if (not (equal? frout val4))
- (snd-display ";frame->file output via frame: ~A ~A?" frout val4)))
+ (snd-display #__line__ ";frame->file output via frame: ~A ~A?" frout val4)))
(let ((gen (make-sample->file "fmv2.snd" 4 mus-bshort mus-aifc)))
(print-and-check gen
"sample->file"
"sample->file fmv2.snd")
- (if (not (mus-output? gen)) (snd-display ";~A not output?" gen))
- (if (not (sample->file? gen)) (snd-display ";~A not sample->file?" gen))
+ (if (not (mus-output? gen)) (snd-display #__line__ ";~A not output?" gen))
+ (if (not (sample->file? gen)) (snd-display #__line__ ";~A not sample->file?" gen))
(do ((i 0 (+ 1 i)))
((= i 100))
(sample->file gen i 0 (* i .001))
@@ -23492,11 +23576,11 @@ EDITS: 2
(val3 (file->sample gen 50 3))
(val4 (file->sample gen 60 2))
(val5 (file->sample gen 60 3)))
- (if (not (= (mus-channels gen) 4)) (snd-display ";make-file->sample (4) chans: ~A?" (mus-channels gen)))
- (if (not (= (mus-increment gen) 0.0)) (snd-display ";file->sample increment: ~A" (mus-increment gen))) ; dir never set in this case
- (if (or (fneq val0 .04) (fneq val1 .06)) (snd-display ";in-any(0, 4): ~A ~A?" val0 val1))
- (if (or (fneq val2 .12) (fneq val3 .18)) (snd-display ";file->sample(4): ~A ~A?" val2 val3))
- (if (or (fneq val4 .14) (fneq val5 .21)) (snd-display ";in-any(4, 4): ~A ~A?" val4 val5)))
+ (if (not (= (mus-channels gen) 4)) (snd-display #__line__ ";make-file->sample (4) chans: ~A?" (mus-channels gen)))
+ (if (not (= (mus-increment gen) 0.0)) (snd-display #__line__ ";file->sample increment: ~A" (mus-increment gen))) ; dir never set in this case
+ (if (or (fneq val0 .04) (fneq val1 .06)) (snd-display #__line__ ";in-any(0, 4): ~A ~A?" val0 val1))
+ (if (or (fneq val2 .12) (fneq val3 .18)) (snd-display #__line__ ";file->sample(4): ~A ~A?" val2 val3))
+ (if (or (fneq val4 .14) (fneq val5 .21)) (snd-display #__line__ ";in-any(4, 4): ~A ~A?" val4 val5)))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(mus-sound-forget "fmv.snd")
@@ -23507,17 +23591,17 @@ EDITS: 2
(sample->file sf i 1 (* i .01)))
(mus-close sf)
(if (not (= (mus-sound-chans "fmv.snd") 2))
- (snd-display ";sample->file chans: ~A" (mus-sound-chans "fmv.snd")))
+ (snd-display #__line__ ";sample->file chans: ~A" (mus-sound-chans "fmv.snd")))
(if (not (= (mus-sound-frames "fmv.snd") 10))
- (snd-display ";sample->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (snd-display #__line__ ";sample->file frames: ~A" (mus-sound-frames "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 20))
- (snd-display ";sample->file samples: ~A" (mus-sound-samples "fmv.snd")))
+ (snd-display #__line__ ";sample->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-next))
- (snd-display ";sample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";sample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-bshort))
- (snd-display ";sample->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";sample->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display ";sample->file comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";sample->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((rd (make-file->sample "fmv.snd"))
(happy #t))
(do ((i 0 (+ 1 i)))
@@ -23527,7 +23611,7 @@ EDITS: 2
(if (or (fneq c0 (* i .1))
(fneq c1 (* i .01)))
(begin
- (snd-display ";sample->file->sample at ~A: ~A ~A" i c0 c1)
+ (snd-display #__line__ ";sample->file->sample at ~A: ~A ~A" i c0 c1)
(set! happy #f)))))
(mus-close rd))
(set! sf (continue-sample->file "fmv.snd"))
@@ -23538,24 +23622,24 @@ EDITS: 2
(mus-close sf)
(mus-sound-forget "fmv.snd")
(if (not (= (mus-sound-chans "fmv.snd") 2))
- (snd-display ";continue-sample->file chans: ~A" (mus-sound-chans "fmv.snd")))
+ (snd-display #__line__ ";continue-sample->file chans: ~A" (mus-sound-chans "fmv.snd")))
(if (not (= (mus-sound-frames "fmv.snd") 15))
- (snd-display ";continue-sample->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (snd-display #__line__ ";continue-sample->file frames: ~A" (mus-sound-frames "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 30))
- (snd-display ";continue-sample->file samples: ~A" (mus-sound-samples "fmv.snd")))
+ (snd-display #__line__ ";continue-sample->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-next))
- (snd-display ";continue-sample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";continue-sample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-bshort))
- (snd-display ";continue-sample->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";continue-sample->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display ";continue-sample->file comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";continue-sample->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((ind (open-sound "fmv.snd")))
(let ((c0 (channel->vct 0 15 ind 0))
(c1 (channel->vct 0 15 ind 1)))
(if (not (vequal c0 (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
- (snd-display ";continue-sample->file (0): ~A" c0))
+ (snd-display #__line__ ";continue-sample->file (0): ~A" c0))
(if (not (vequal c1 (vct 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
- (snd-display ";continue-sample->file (1): ~A" c1)))
+ (snd-display #__line__ ";continue-sample->file (1): ~A" c1)))
(close-sound ind))
(delete-file "fmv.snd")
(mus-sound-forget "fmv.snd"))
@@ -23566,17 +23650,17 @@ EDITS: 2
(frame->file sf i (make-frame 2 (* i .1) (* i .01))))
(mus-close sf)
(if (not (= (mus-sound-chans "fmv.snd") 2))
- (snd-display ";frame->file chans: ~A" (mus-sound-chans "fmv.snd")))
+ (snd-display #__line__ ";frame->file chans: ~A" (mus-sound-chans "fmv.snd")))
(if (not (= (mus-sound-frames "fmv.snd") 10))
- (snd-display ";frame->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (snd-display #__line__ ";frame->file frames: ~A" (mus-sound-frames "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 20))
- (snd-display ";frame->file samples: ~A" (mus-sound-samples "fmv.snd")))
+ (snd-display #__line__ ";frame->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display ";frame->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";frame->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-lfloat))
- (snd-display ";frame->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";frame->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display ";frame->file comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";frame->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((rd (make-file->frame "fmv.snd"))
(happy #t))
(do ((i 0 (+ 1 i)))
@@ -23586,7 +23670,7 @@ EDITS: 2
(fneq (frame-ref f0 0) (* i .1))
(fneq (frame-ref f0 1) (* i .01)))
(begin
- (snd-display ";frame->file->frame at ~A: ~A" i f0)
+ (snd-display #__line__ ";frame->file->frame at ~A: ~A" i f0)
(set! happy #f)))))
(mus-close rd))
(set! sf (continue-frame->file "fmv.snd"))
@@ -23596,24 +23680,24 @@ EDITS: 2
(mus-close sf)
(mus-sound-forget "fmv.snd")
(if (not (= (mus-sound-chans "fmv.snd") 2))
- (snd-display ";continue-frame->file chans: ~A" (mus-sound-chans "fmv.snd")))
+ (snd-display #__line__ ";continue-frame->file chans: ~A" (mus-sound-chans "fmv.snd")))
(if (not (= (mus-sound-frames "fmv.snd") 15))
- (snd-display ";continue-frame->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (snd-display #__line__ ";continue-frame->file frames: ~A" (mus-sound-frames "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 30))
- (snd-display ";continue-frame->file samples: ~A" (mus-sound-samples "fmv.snd")))
+ (snd-display #__line__ ";continue-frame->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display ";continue-frame->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (snd-display #__line__ ";continue-frame->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
(if (not (= (mus-sound-data-format "fmv.snd") mus-lfloat))
- (snd-display ";continue-frame->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";continue-frame->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display ";continue-frame->file comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";continue-frame->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((ind (open-sound "fmv.snd")))
(let ((c0 (channel->vct 0 15 ind 0))
(c1 (channel->vct 0 15 ind 1)))
(if (not (vequal c0 (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
- (snd-display ";continue-frame->file (0): ~A" c0))
+ (snd-display #__line__ ";continue-frame->file (0): ~A" c0))
(if (not (vequal c1 (vct 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
- (snd-display ";continue-frame->file (1): ~A" c1)))
+ (snd-display #__line__ ";continue-frame->file (1): ~A" c1)))
(close-sound ind))
(delete-file "fmv.snd")
(mus-sound-forget "fmv.snd"))
@@ -23629,17 +23713,17 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 1000))
(if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display ";array->file->array: ~A ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i)))))
+ (snd-display #__line__ ";array->file->array: ~A ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i)))))
(let ((var (catch #t (lambda () (array->file "fmv3.snd" v0 -1 1000 1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";array->file bad samps: ~A" var)))
+ (snd-display #__line__ ";array->file bad samps: ~A" var)))
(let ((var (catch #t (lambda () (array->file "/bad/baddy/fmv3.snd" v0 1 1000 1)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";array->file bad file: ~A" var)))
+ (snd-display #__line__ ";array->file bad file: ~A" var)))
(let ((var (catch #t (lambda () (file->array "fmv3.snd" -1 0 -1 v0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";file->array bad samps: ~A" var))))
+ (snd-display #__line__ ";file->array bad samps: ~A" var))))
(let ((gen (make-rand 10000.0))
(v0 (make-vct 10)))
@@ -23649,12 +23733,12 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (rand gen 0.0)))
- (if (not (rand? gen)) (snd-display ";~A not rand?" gen))
- (if (fneq (mus-phase gen) 3.3624296) (snd-display ";rand phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 10000.0) (snd-display ";rand frequency: ~F?" (mus-frequency gen)))
+ (if (not (rand? gen)) (snd-display #__line__ ";~A not rand?" gen))
+ (if (fneq (mus-phase gen) 3.3624296) (snd-display #__line__ ";rand phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 10000.0) (snd-display #__line__ ";rand frequency: ~F?" (mus-frequency gen)))
(set! (mus-scaler gen) 0.5)
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";set! mus-scaler rand: ~A" (mus-scaler gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display ";rand output: ~A" v0)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! mus-scaler rand: ~A" (mus-scaler gen)))
+ (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";rand output: ~A" v0)))
(let ((gen (make-rand 10000.0 :envelope '(0 0 1 1)))
(v0 (make-vct 10)))
@@ -23664,13 +23748,13 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (rand gen 0.0)))
- (if (not (rand? gen)) (snd-display ";(dist) ~A not rand?" gen))
- (if (fneq (mus-frequency gen) 10000.0) (snd-display ";(dist) rand frequency: ~F?" (mus-frequency gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display ";(dist) rand output: ~A" v0))
+ (if (not (rand? gen)) (snd-display #__line__ ";(dist) ~A not rand?" gen))
+ (if (fneq (mus-frequency gen) 10000.0) (snd-display #__line__ ";(dist) rand frequency: ~F?" (mus-frequency gen)))
+ (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";(dist) rand output: ~A" v0))
(if (or (not (vct? (mus-data gen)))
(not (= (mus-length gen) (vct-length (mus-data gen))))
(not (= (mus-length gen) 512)))
- (snd-display ";(dist) rand data: ~A ~A" (mus-length gen) (mus-data gen))))
+ (snd-display #__line__ ";(dist) rand data: ~A ~A" (mus-length gen) (mus-data gen))))
(let ((gen1 (make-rand 10000.0 :envelope '(0 0 1 1)))
(gen2 (make-rand 10000.0 :envelope '(0 1 1 0)))
@@ -23698,7 +23782,7 @@ EDITS: 2
(not (= bad2 0))
(> (* 2 down1) up1)
(> (* 2 up2) down2))
- (snd-display "; rand dist: ~A ~A ~A, ~A ~A ~A" down1 up1 bad1 down2 up2 bad2)))
+ (snd-display #__line__ "; rand dist: ~A ~A ~A, ~A ~A ~A" down1 up1 bad1 down2 up2 bad2)))
; (test-gen-equal (make-rand 1000) (make-rand 1000) (make-rand 500))
; (test-gen-equal (make-rand 1000) (make-rand 1000) (make-rand 1000 0.5))
@@ -23711,12 +23795,12 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (rand-interp gen 0.0)))
- (if (not (rand-interp? gen)) (snd-display ";~A not rand-interp?" gen))
- (if (fneq (mus-phase gen) 5.114882) (snd-display ";rand-interp phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 4000.0) (snd-display ";rand-interp frequency: ~F?" (mus-frequency gen)))
+ (if (not (rand-interp? gen)) (snd-display #__line__ ";~A not rand-interp?" gen))
+ (if (fneq (mus-phase gen) 5.114882) (snd-display #__line__ ";rand-interp phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 4000.0) (snd-display #__line__ ";rand-interp frequency: ~F?" (mus-frequency gen)))
(set! (mus-scaler gen) 0.5)
- (if (fneq (mus-scaler gen) 0.5) (snd-display ";set! mus-scaler rand-interp: ~A" (mus-scaler gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display ";rand-interp output: ~A" v0)))
+ (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! mus-scaler rand-interp: ~A" (mus-scaler gen)))
+ (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";rand-interp output: ~A" v0)))
(let ((gen (make-rand-interp 4000.0 :envelope '(-1 1 0 0 1 1)))
(v0 (make-vct 10)))
@@ -23726,12 +23810,12 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (rand-interp gen 0.0)))
- (if (not (rand-interp? gen)) (snd-display ";(dist) ~A not rand-interp?" gen))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display ";(dist) rand-interp output: ~A" v0))
+ (if (not (rand-interp? gen)) (snd-display #__line__ ";(dist) ~A not rand-interp?" gen))
+ (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";(dist) rand-interp output: ~A" v0))
(if (or (not (vct? (mus-data gen)))
(not (= (mus-length gen) (vct-length (mus-data gen))))
(not (= (mus-length gen) 512)))
- (snd-display ";(dist) rand-interp data: ~A ~A" (mus-length gen) (mus-data gen))))
+ (snd-display #__line__ ";(dist) rand-interp data: ~A ~A" (mus-length gen) (mus-data gen))))
(let ((gen (make-rand 10000.0 1.0))
(gen1 (make-rand-interp 10000.0 1.0)))
@@ -23741,10 +23825,10 @@ EDITS: 2
(val2 (gen1 0.0)))
(if (or (> val1 1.0)
(< val1 -1.0))
- (snd-display ";rand: ~A ~A" val1 gen))
+ (snd-display #__line__ ";rand: ~A ~A" val1 gen))
(if (or (> val2 1.0)
(< val2 -1.0))
- (snd-display ";rand-interp: ~A ~A" val2 gen1)))))
+ (snd-display #__line__ ";rand-interp: ~A ~A" val2 gen1)))))
(let ((gen (make-rand 10000.0 :distribution (inverse-integrate '(0 0 1 1))))
(v0 (make-vct 10)))
@@ -23754,13 +23838,13 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v0 i (rand gen 0.0)))
- (if (not (rand? gen)) (snd-display ";(dist 2) ~A not rand?" gen))
- (if (fneq (mus-frequency gen) 10000.0) (snd-display ";(dist 2) rand frequency: ~F?" (mus-frequency gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display ";(dist 2) rand output: ~A" v0))
+ (if (not (rand? gen)) (snd-display #__line__ ";(dist 2) ~A not rand?" gen))
+ (if (fneq (mus-frequency gen) 10000.0) (snd-display #__line__ ";(dist 2) rand frequency: ~F?" (mus-frequency gen)))
+ (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";(dist 2) rand output: ~A" v0))
(if (or (not (vct? (mus-data gen)))
(not (= (mus-length gen) (vct-length (mus-data gen))))
(not (= (mus-length gen) 512)))
- (snd-display ";(dist 2) rand data: ~A ~A" (mus-length gen) (mus-data gen))))
+ (snd-display #__line__ ";(dist 2) rand data: ~A ~A" (mus-length gen) (mus-data gen))))
(let ((gen1 (make-rand 10000.0 :distribution (inverse-integrate '(0 0 1 1))))
(gen2 (make-rand 10000.0 :distribution (inverse-integrate '(0 1 1 0))))
@@ -23788,17 +23872,17 @@ EDITS: 2
(not (= bad2 0))
(> (* 2.5 down1) up1)
(> (* 2.0 up2) down2))
- (snd-display "; rand dist 2: ~A ~A ~A, ~A ~A ~A" down1 up1 bad1 down2 up2 bad2))) ; 234 766 0, 705 295 0
+ (snd-display #__line__ "; rand dist 2: ~A ~A ~A, ~A ~A ~A" down1 up1 bad1 down2 up2 bad2))) ; 234 766 0, 705 295 0
(let ((ind (new-sound :size 100)))
(select-sound ind)
(map-channel (lambda (y) (any-random 1.0 '(0 1 1 1))))
(let ((place (scan-channel (lambda (y) (or (< y 0.0) (> y 1.0))))))
- (if place (snd-display ";any-random 0 to 1: ~A" place)))
- (if (< (maxamp) .5) (snd-display ";any-random maxamp: ~A" (maxamp))) ; possible, but extremely unlikely
+ (if place (snd-display #__line__ ";any-random 0 to 1: ~A" place)))
+ (if (< (maxamp) .5) (snd-display #__line__ ";any-random maxamp: ~A" (maxamp))) ; possible, but extremely unlikely
(let ((avg 0.0))
(scan-channel (lambda (y) (set! avg (+ avg y)) #f))
- (if (> (abs (- (/ avg (frames)) .5)) .2) (snd-display ";any-random skewed?")))
+ (if (> (abs (- (/ avg (frames)) .5)) .2) (snd-display #__line__ ";any-random skewed?")))
(let ((g (gaussian-distribution 1.0)))
(map-channel (lambda (y) (any-random 1.0 g))))
(let ((g (pareto-distribution 1.0)))
@@ -23809,19 +23893,19 @@ EDITS: 2
(let ((v1 (inverse-integrate '(-1 1 1 1))))
(if (fneq (vct-ref v1 4) -0.984)
- (snd-display ";inverse-integrate -1 to 1 uniform: ~A" v1)))
+ (snd-display #__line__ ";inverse-integrate -1 to 1 uniform: ~A" v1)))
(let ((v1 (inverse-integrate '(0 1 1 1))))
(if (fneq (vct-ref v1 4) .008)
- (snd-display ";inverse-integrate 0 to 1 uniform: ~A" v1)))
+ (snd-display #__line__ ";inverse-integrate 0 to 1 uniform: ~A" v1)))
(let ((v1 (inverse-integrate '(0 1 1 0))))
(if (fneq (vct-ref v1 4) .004)
- (snd-display ";inverse-integrate 0 to 1 1 to 0: ~A" v1)))
+ (snd-display #__line__ ";inverse-integrate 0 to 1 1 to 0: ~A" v1)))
(let ((v1 (inverse-integrate '(0 0 .5 1 1 0))))
(if (fneq (vct-ref v1 4) .073)
- (snd-display ";inverse-integrate triangle: ~A" v1)))
+ (snd-display #__line__ ";inverse-integrate triangle: ~A" v1)))
(let ((v1 (inverse-integrate (gaussian-envelope 1.0))))
(if (fneq (vct-ref v1 4) -0.593)
- (snd-display ";inverse-integrate gaussian: ~A" v1)))
+ (snd-display #__line__ ";inverse-integrate gaussian: ~A" v1)))
(let ((minp 1.0)
(maxp -1.0))
@@ -23832,10 +23916,10 @@ EDITS: 2
(if (> val1 maxp) (set! maxp val1))
(if (or (> val1 1.0)
(< val1 -1.0))
- (snd-display ";mus-random: ~A" val1))))
+ (snd-display #__line__ ";mus-random: ~A" val1))))
(if (or (< maxp .9)
(> minp -.9))
- (snd-display ";mus-random: ~A ~A" minp maxp))
+ (snd-display #__line__ ";mus-random: ~A ~A" minp maxp))
(set! minp 12.0)
(set! maxp -12.0)
(do ((i 0 (+ 1 i)))
@@ -23845,16 +23929,16 @@ EDITS: 2
(if (> val1 maxp) (set! maxp val1))
(if (or (> val1 12.0)
(< val1 -12.0))
- (snd-display ";mus-random (12): ~A" val1))))
+ (snd-display #__line__ ";mus-random (12): ~A" val1))))
(if (or (< maxp 11.0)
(> minp -11.0))
- (snd-display ";mus-random (12): ~A ~A" minp maxp)))
-
+ (snd-display #__line__ ";mus-random (12): ~A ~A" minp maxp)))
+
(let ((v (lambda (n) ; chi^2 or mus-random
(let ((hits (make-vector 10 0)))
(do ((i 0 (+ 1 i )))
((= i n))
- (let ((y (inexact->exact (floor (+ 5 (mus-random 5.0))))))
+ (let ((y (floor (+ 5 (mus-random 5.0)))))
(vector-set! hits y (+ 1 (vector-ref hits y)))))
(let ((sum 0.0)
(p (/ n 10.0)))
@@ -23869,14 +23953,14 @@ EDITS: 2
(let ((vr (v 10000)))
(if (< vr 4.0)
- (snd-display ";mus-random not so random? ~A (chi)" vr))))
+ (snd-display #__line__ ";mus-random not so random? ~A (chi)" vr))))
(let ((v1 (lambda (n)
(let ((hits (make-vector 10 0))
(gen (make-rand 22050.0)))
(do ((i 0 (+ 1 i )))
((= i n))
- (let ((y (inexact->exact (floor (+ 5 (* 5 (rand gen 0.0)))))))
+ (let ((y (floor (+ 5 (* 5 (rand gen 0.0))))))
(vector-set! hits y (+ 1 (vector-ref hits y)))))
(let ((sum 0.0)
(p (/ n 10.0)))
@@ -23890,7 +23974,7 @@ EDITS: 2
(let ((vr (v1 10000)))
(if (< vr 4.0)
- (snd-display ";rand not so random? ~A (chi)" vr))))
+ (snd-display #__line__ ";rand not so random? ~A (chi)" vr))))
(let ((data (make-vct 65536)))
(do ((i 0 (+ 1 i)))
@@ -23900,12 +23984,12 @@ EDITS: 2
(peak (vct-peak ndat))
(sum 0.0))
(if (> peak 1000.0)
- (snd-display ";mus-random spectral peak: ~A" peak))
+ (snd-display #__line__ ";mus-random spectral peak: ~A" peak))
(do ((i 0 (+ 1 i)))
((= i 32768))
(set! sum (+ sum (vct-ref ndat i))))
(if (> (/ sum 32768.0) 200.0)
- (snd-display ";random average: ~A ~A" (/ sum 32768.0) (vct-ref ndat 0)))
+ (snd-display #__line__ ";random average: ~A ~A" (/ sum 32768.0) (vct-ref ndat 0)))
(do ((i 0 (+ 1 i)))
((= i 65536))
(vct-set! data i (mus-random 1.0)))
@@ -23913,13 +23997,13 @@ EDITS: 2
(vct-set! data 0 0.0)
(let ((pk (vct-peak data)))
(if (> pk 1000)
- (snd-display ";random autocorrelate peak: ~A" (vct-peak data)))
+ (snd-display #__line__ ";random autocorrelate peak: ~A" (vct-peak data)))
(set! sum 0.0)
(do ((i 0 (+ 1 i)))
((= i 32768))
(set! sum (+ sum (abs (vct-ref data i)))))
(if (> (/ sum 32768.0) 200.0)
- (snd-display ";random autocorrelate average: ~A" (/ sum 32768.0))))))
+ (snd-display #__line__ ";random autocorrelate average: ~A" (/ sum 32768.0))))))
(set! (locsig-type) mus-interp-linear)
(let* ((gen (make-locsig 30.0 :channels 2))
@@ -23931,139 +24015,139 @@ EDITS: 2
(print-and-check gen
"locsig"
"locsig chans 2, outn: [0.667 0.333], interp: linear")
- (if (not (locsig? gen)) (snd-display ";~A not locsig?" gen))
- (if (not (eq? gen1 gen3)) (snd-display ";locsig eq? ~A ~A" gen1 gen3))
- (if (not (equal? gen1 gen3)) (snd-display ";locsig equal? ~A ~A" gen1 gen3))
- (if (eq? gen1 gen2) (snd-display ";locsig 1 eq? ~A ~A" gen1 gen2))
- (if (equal? gen gen1) (snd-display ";locsig 2 equal? ~A ~A" gen gen1))
- (if (equal? gen gen2) (snd-display ";locsig 3 equal? ~A ~A" gen gen2))
+ (if (not (locsig? gen)) (snd-display #__line__ ";~A not locsig?" gen))
+ (if (not (eq? gen1 gen3)) (snd-display #__line__ ";locsig eq? ~A ~A" gen1 gen3))
+ (if (not (equal? gen1 gen3)) (snd-display #__line__ ";locsig equal? ~A ~A" gen1 gen3))
+ (if (eq? gen1 gen2) (snd-display #__line__ ";locsig 1 eq? ~A ~A" gen1 gen2))
+ (if (equal? gen gen1) (snd-display #__line__ ";locsig 2 equal? ~A ~A" gen gen1))
+ (if (equal? gen gen2) (snd-display #__line__ ";locsig 3 equal? ~A ~A" gen gen2))
(if (or (fneq (locsig-ref gen 0) .667) (fneq (locsig-ref gen 1) .333))
- (snd-display ";locsig ref: ~F ~F?" (locsig-ref gen 0) (locsig-ref gen 1)))
+ (snd-display #__line__ ";locsig ref: ~F ~F?" (locsig-ref gen 0) (locsig-ref gen 1)))
(if (not (vequal (mus-data gen) (vct 0.667 0.333)))
- (snd-display ";locsig gen outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen outn: ~A" (mus-data gen)))
(if (not (vequal (mus-data gen1) (vct 0.333 0.667)))
- (snd-display ";locsig gen2 outn: ~A" (mus-data gen1)))
+ (snd-display #__line__ ";locsig gen2 outn: ~A" (mus-data gen1)))
(if (not (vequal (mus-data gen2) (vct 0.333 0.667 0.000 0.000)))
- (snd-display ";locsig gen2 outn: ~A" (mus-data gen2)))
+ (snd-display #__line__ ";locsig gen2 outn: ~A" (mus-data gen2)))
(if (not (vequal (mus-data gen200) (vct 0.000 0.000 0.778 0.222)))
- (snd-display ";locsig gen200 outn: ~A" (mus-data gen200)))
+ (snd-display #__line__ ";locsig gen200 outn: ~A" (mus-data gen200)))
(set! (locsig-ref gen 0) .25)
(if (not (vequal (mus-data gen) (vct 0.250 0.333)))
- (snd-display ";locsig gen .25 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen .25 outn: ~A" (mus-data gen)))
(set! fr0 (locsig gen 0 1.0))
(locsig-set! gen 0 .5)
(if (not (vequal (mus-data gen) (vct 0.500 0.333)))
- (snd-display ";locsig gen .5 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen .5 outn: ~A" (mus-data gen)))
(set! fr0 (locsig gen 0 1.0))
(set! gen (make-locsig 120.0 2.0 .1 :channels 4))
(if (not (vequal (mus-data gen) (vct 0.000 0.333 0.167 0.000)))
- (snd-display ";locsig gen 120 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen 120 outn: ~A" (mus-data gen)))
(set! fr0 (locsig gen 0 1.0))
(set! gen (make-locsig 300.0 2.0 .1 :channels 4))
(if (not (vequal (mus-data gen) (vct 0.167 0.000 0.000 0.333)))
- (snd-display ";locsig gen 300 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen 300 outn: ~A" (mus-data gen)))
(set! fr0 (locsig gen 0 1.0))
(move-locsig gen1 90.0 1.0)
(if (not (vequal (mus-data gen1) (vct 0.000 1.000)))
- (snd-display ";locsig gen1 90 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen1 90 outn: ~A" (mus-data gen)))
(move-locsig gen1 0.0 1.0)
(if (not (vequal (mus-data gen1) (vct 1.000 0.000)))
- (snd-display ";locsig gen1 0 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen1 0 outn: ~A" (mus-data gen)))
(move-locsig gen1 45.0 1.0)
(if (not (vequal (mus-data gen1) (vct 0.500 0.500)))
- (snd-display ";locsig gen1 45 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen1 45 outn: ~A" (mus-data gen)))
(move-locsig gen1 135.0 2.0)
(if (not (vequal (mus-data gen1) (vct 0.000 0.500)))
- (snd-display ";locsig gen1 135 outn: ~A" (mus-data gen)))
+ (snd-display #__line__ ";locsig gen1 135 outn: ~A" (mus-data gen)))
(move-locsig gen1 -270.0 3.0)
(if (not (vequal (mus-data gen1) (vct 0.000 0.333)))
- (snd-display ";locsig gen1 -270 outn: ~A" (mus-data gen))))
+ (snd-display #__line__ ";locsig gen1 -270 outn: ~A" (mus-data gen))))
(for-each
(lambda (chans)
(let ((m1 (make-locsig :channels chans)))
(if (or (not (= (mus-channels m1) chans))
(not (= (mus-length m1) chans)))
- (snd-display ";locsig ~A chans but: ~A ~A" chans (mus-channels m1) (mus-length m1)))
+ (snd-display #__line__ ";locsig ~A chans but: ~A ~A" chans (mus-channels m1) (mus-length m1)))
(do ((i 0 (+ 1 i)))
((= i chans))
(locsig-set! m1 i (* i .1)))
(do ((i 0 (+ 1 i)))
((= i chans))
(if (fneq (locsig-ref m1 i) (* i .1))
- (snd-display ";locsig[~A] = ~A (~A)?" i (locsig-ref m1 i) (* i .1))))))
+ (snd-display #__line__ ";locsig[~A] = ~A (~A)?" i (locsig-ref m1 i) (* i .1))))))
(list 1 2 4 8))
(let ((var (catch #t (lambda () (make-locsig :channels 0)) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
- (snd-display ";make-locsig bad (0) chans: ~A" var)))
+ (snd-display #__line__ ";make-locsig bad (0) chans: ~A" var)))
(let ((var (catch #t (lambda () (make-locsig :channels -2)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-locsig bad (-2) chans: ~A" var)))
+ (snd-display #__line__ ";make-locsig bad (-2) chans: ~A" var)))
(let ((var (catch #t (lambda () (make-locsig :output 1)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-locsig bad output: ~A" var)))
+ (snd-display #__line__ ";make-locsig bad output: ~A" var)))
(let ((var (catch #t (lambda () (locsig-ref (make-locsig) 1)) (lambda args args))))
(if (and (pair? var)
(not (eq? (car var) 'mus-error)))
- (snd-display ";locsig-ref bad chan: ~A" var)))
+ (snd-display #__line__ ";locsig-ref bad chan: ~A" var)))
(let ((var (catch #t (lambda () (make-locsig :revout 1)) (lambda args args))))
(if (and (pair? var)
(not (eq? (car var) 'wrong-type-arg)))
- (snd-display ";make-locsig bad revout: ~A" var)))
+ (snd-display #__line__ ";make-locsig bad revout: ~A" var)))
(let ((var (catch #t (lambda () (let ((locs (make-locsig 200 :channels 2))) (locsig-ref locs -1))) (lambda args args))))
(if (and (pair? var)
(not (eq? (car var) 'mus-error)))
- (snd-display ";locsig-ref bad chan: ~A" var)))
+ (snd-display #__line__ ";locsig-ref bad chan: ~A" var)))
(let ((var (catch #t (lambda () (let ((locs (make-locsig))) (locsig-set! locs 2 .1))) (lambda args args))))
(if (and (pair? var)
(not (eq? (car var) 'mus-error)))
- (snd-display ";locsig-set! bad chan (2): ~A" var)))
+ (snd-display #__line__ ";locsig-set! bad chan (2): ~A" var)))
(let ((var (catch #t (lambda () (let ((locs (make-locsig :reverb .1))) (locsig-reverb-ref locs 2))) (lambda args args))))
(if (and (pair? var)
(not (eq? (car var) 'mus-error)))
- (snd-display ";locsig-reverb-ref bad reverb chan (2): ~A" var)))
+ (snd-display #__line__ ";locsig-reverb-ref bad reverb chan (2): ~A" var)))
(let ((var (catch #t (lambda () (let ((locs (make-locsig :reverb .1))) (locsig-reverb-set! locs 2 .1))) (lambda args args))))
(if (and (pair? var)
(not (eq? (car var) 'mus-error)))
- (snd-display ";locsig-reverb-set! bad reverb chan (2): ~A" var)))
+ (snd-display #__line__ ";locsig-reverb-set! bad reverb chan (2): ~A" var)))
(let ((locs (make-locsig :channels 8 :degree 0)))
(move-locsig locs 180 1.0)
- (if (fneq (locsig-ref locs 0) 0.0) (snd-display ";move-locsig by jump: ~A" (mus-data locs)))
+ (if (fneq (locsig-ref locs 0) 0.0) (snd-display #__line__ ";move-locsig by jump: ~A" (mus-data locs)))
(if (not (vequal (mus-data locs) (vct 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000)))
- (snd-display ";move-locsig by jump data: ~A" (mus-data locs)))
+ (snd-display #__line__ ";move-locsig by jump data: ~A" (mus-data locs)))
(move-locsig locs 120.0 1.0)
(if (not (vequal (mus-data locs) (vct 0.000 0.000 0.333 0.667 0.000 0.000 0.000 0.000)))
- (snd-display ";move-locsig by jump 120 data: ~A" (mus-data locs)))
+ (snd-display #__line__ ";move-locsig by jump 120 data: ~A" (mus-data locs)))
(move-locsig locs -20.0 1.0)
(if (not (vequal (mus-data locs) (vct 0.556 0.000 0.000 0.000 0.000 0.000 0.000 0.444)))
- (snd-display ";move-locsig by jump -20 data: ~A" (mus-data locs))))
+ (snd-display #__line__ ";move-locsig by jump -20 data: ~A" (mus-data locs))))
(let ((sf (make-sample->file "fmv4.snd" 8 mus-bshort mus-next "this is a comment"))
(sfrev (make-sample->file "fmv4.reverb" 8 mus-bshort mus-next "this is a comment")))
(let ((locs (make-locsig :channels 8 :degree 0 :distance 1.0 :reverb 0.1
:output sf :revout sfrev :type mus-interp-linear)))
(if (not (vequal (mus-data locs) (vct 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";ws not move-locsig by jump data: ~A" (mus-data locs)))
+ (snd-display #__line__ ";ws not move-locsig by jump data: ~A" (mus-data locs)))
(if (not (vequal (mus-xcoeffs locs) (vct 0.100 0.000 0.000 0.000 0.0 0.0 0.0 0.0)))
- (snd-display ";ws not move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
+ (snd-display #__line__ ";ws not move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs 180 2.0)
- (if (fneq (locsig-ref locs 0) 0.0) (snd-display ";ws move-locsig by jump: ~A" (mus-data locs)))
+ (if (fneq (locsig-ref locs 0) 0.0) (snd-display #__line__ ";ws move-locsig by jump: ~A" (mus-data locs)))
(if (not (vequal (mus-data locs) (vct 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000)))
- (snd-display ";ws move-locsig by jump data: ~A" (mus-data locs)))
+ (snd-display #__line__ ";ws move-locsig by jump data: ~A" (mus-data locs)))
(if (not (vequal (mus-xcoeffs locs) (vct 0.000 0.000 0.000 0.000 0.071 0.000 0.000 0.000)))
- (snd-display ";ws move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
+ (snd-display #__line__ ";ws move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs 120.0 3.0)
(if (not (vequal (mus-data locs) (vct 0.000 0.000 0.111 0.222 0.000 0.000 0.000 0.000)))
- (snd-display ";ws move-locsig by jump 120 data: ~A" (mus-data locs)))
+ (snd-display #__line__ ";ws move-locsig by jump 120 data: ~A" (mus-data locs)))
(if (not (vequal (mus-xcoeffs locs) (vct 0.000 0.000 0.019 0.038 0.000 0.000 0.000 0.000)))
- (snd-display ";ws move-locsig by jump 120 rev data: ~A" (mus-xcoeffs locs)))
+ (snd-display #__line__ ";ws move-locsig by jump 120 rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs -20.0 4.0)
(if (not (vequal (mus-data locs) (vct 0.139 0.000 0.000 0.000 0.000 0.000 0.000 0.111)))
- (snd-display ";ws move-locsig by jump -20 data: ~A" (mus-data locs)))
+ (snd-display #__line__ ";ws move-locsig by jump -20 data: ~A" (mus-data locs)))
(if (not (vequal (mus-xcoeffs locs) (vct 0.028 0.000 0.000 0.000 0.000 0.000 0.000 0.022)))
- (snd-display ";ws move-locsig by jump -20 rev data: ~A" (mus-xcoeffs locs))))
+ (snd-display #__line__ ";ws move-locsig by jump -20 rev data: ~A" (mus-xcoeffs locs))))
(mus-close sf)
(mus-close sfrev))
@@ -24074,32 +24158,32 @@ EDITS: 2
(for-each
(lambda (ht)
(let ((ind (find-sound (with-sound (:channels 8)
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (locsig (make-locsig :degree (* i 45) :output *output*) i 0.5))))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 8))
+ (locsig (make-locsig :degree (* i 45) :output *output*) i 0.5))))))
(do ((i 0 (+ 1 i)))
((= i 8))
(let ((samps (channel->vct 0 8 ind i)))
(do ((k 0 (+ 1 k)))
((= k 8))
(if (and (= k i) (fneq (vct-ref samps k) 0.5))
- (snd-display ";8 out ~A chan ~A samp ~A (0.5): ~A" (mus-header-type->string ht) i k (vct-ref samps k)))
+ (snd-display #__line__ ";8 out ~A chan ~A samp ~A (0.5): ~A" (mus-header-type->string ht) i k (vct-ref samps k)))
(if (and (not (= i k)) (fneq (vct-ref samps k) 0.0))
- (snd-display ";8 out ~A chan ~A samp ~A (0.0): ~A" (mus-header-type->string ht) i k (vct-ref samps k))))))
+ (snd-display #__line__ ";8 out ~A chan ~A samp ~A (0.0): ~A" (mus-header-type->string ht) i k (vct-ref samps k))))))
(close-sound ind)))
(list mus-caff mus-aifc mus-next mus-riff mus-rf64))
-
+
(let* ((gen (make-frame->file "fmv4.snd" 2 mus-bshort mus-next))
(rev (make-frame->file "fmv4.reverb" 1 mus-bshort mus-next))
(lc (make-locsig 60.0 :reverb .1 :channels 2 :output gen :revout rev)))
(do ((i 0 (+ 1 i)))
((= i 100))
(locsig lc i 1.0))
- (if (fneq (locsig-reverb-ref lc 0) .1) (snd-display ";locsig reverb ref: ~A?" (locsig-reverb-ref lc 0)))
+ (if (fneq (locsig-reverb-ref lc 0) .1) (snd-display #__line__ ";locsig reverb ref: ~A?" (locsig-reverb-ref lc 0)))
(set! (locsig-reverb-ref lc 0) .3)
- (if (fneq (locsig-reverb-ref lc 0) .3) (snd-display ";set locsig reverb ref: ~A?" (locsig-reverb-ref lc 0)))
+ (if (fneq (locsig-reverb-ref lc 0) .3) (snd-display #__line__ ";set locsig reverb ref: ~A?" (locsig-reverb-ref lc 0)))
(locsig-reverb-set! lc 0 .2)
- (if (fneq (locsig-reverb-ref lc 0) .2) (snd-display ";locsig reverb set: ~A?" (locsig-reverb-ref lc 0)))
+ (if (fneq (locsig-reverb-ref lc 0) .2) (snd-display #__line__ ";locsig reverb set: ~A?" (locsig-reverb-ref lc 0)))
(mus-close gen)
(mus-close rev)
(let ((v0 (make-vct 100))
@@ -24108,8 +24192,8 @@ EDITS: 2
(file->array "fmv4.snd" 0 0 100 v0)
(file->array "fmv4.snd" 1 0 100 v1)
(file->array "fmv4.reverb" 0 0 100 v2)
- (if (fneq (vct-ref v2 0) .1) (snd-display ";locsig reverb: ~A?" v2))
- (if (fneq (* 2 (vct-ref v0 0)) (vct-ref v1 0)) (snd-display ";locsig direct: ~A ~A?" (vct-ref v0 0) (vct-ref v1 0)))))
+ (if (fneq (vct-ref v2 0) .1) (snd-display #__line__ ";locsig reverb: ~A?" v2))
+ (if (fneq (* 2 (vct-ref v0 0)) (vct-ref v1 0)) (snd-display #__line__ ";locsig direct: ~A ~A?" (vct-ref v0 0) (vct-ref v1 0)))))
(let* ((gen (make-frame->file "fmv4.snd" 4 mus-bshort mus-next))
(rev (make-frame->file "fmv4.reverb" 4 mus-bshort mus-next))
@@ -24124,15 +24208,15 @@ EDITS: 2
((= i 4))
(locsig-reverb-set! lc i (* i .1))
(if (fneq (locsig-reverb-ref lc i) (* i .1))
- (snd-display ";locsig reverb set![~A]: ~A?" i (locsig-reverb-ref lc i))))
+ (snd-display #__line__ ";locsig reverb set![~A]: ~A?" i (locsig-reverb-ref lc i))))
(print-and-check lc
"locsig"
"locsig chans 4, outn: [0.083 0.167 0.000 0.000], revn: [0.000 0.100 0.200 0.300], interp: linear")
- (if (not (vct? (mus-data lc))) (snd-display ";out data locsig: ~A" (mus-data lc)))
- (if (not (vct? (mus-xcoeffs lc))) (snd-display ";rev data locsig: ~A" (mus-xcoeffs lc)))
+ (if (not (vct? (mus-data lc))) (snd-display #__line__ ";out data locsig: ~A" (mus-data lc)))
+ (if (not (vct? (mus-xcoeffs lc))) (snd-display #__line__ ";rev data locsig: ~A" (mus-xcoeffs lc)))
(let ((xcs (mus-xcoeffs lc)))
- (if (fneq (mus-xcoeff lc 0) (vct-ref xcs 0)) (snd-display ";locsig xcoeff: ~A ~A" (mus-xcoeff lc 0) (vct-ref xcs 0)))
- (if (fneq (mus-xcoeff lc 1) .1) (snd-display ";locsig xcoeff 1: ~A ~A (.1)" (mus-xcoeff lc 0) (vct-ref xcs 0))))
+ (if (fneq (mus-xcoeff lc 0) (vct-ref xcs 0)) (snd-display #__line__ ";locsig xcoeff: ~A ~A" (mus-xcoeff lc 0) (vct-ref xcs 0)))
+ (if (fneq (mus-xcoeff lc 1) .1) (snd-display #__line__ ";locsig xcoeff 1: ~A ~A (.1)" (mus-xcoeff lc 0) (vct-ref xcs 0))))
(mus-close gen)
(mus-close rev))
@@ -24173,44 +24257,44 @@ EDITS: 2
dat))))
(let ((gen (make-locsig -.1 :channels 8)))
(if (not (vequal (locsig-data gen) (vct 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
- (snd-display ";locsig -.1(8): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig -.1(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -359.9 :channels 8))
(if (not (vequal (locsig-data gen) (vct 0.998 0.002 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";locsig -359.9(8): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig -359.9(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -359.9 :channels 4))
(if (not (vequal (locsig-data gen) (vct 0.999 0.001 0.000 0.000)))
- (snd-display ";locsig -359.9(4): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig -359.9(4): ~A" (locsig-data gen)))
(set! gen (make-locsig -360.1 :channels 8))
(if (not (vequal (locsig-data gen) (vct 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
- (snd-display ";locsig -360.1(8): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig -360.1(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -700 :channels 8))
(if (not (vequal (locsig-data gen) (vct 0.556 0.444 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";locsig -700(8): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig -700(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -700 :channels 2))
(if (not (vequal (locsig-data gen) (vct 0.778 0.222)))
- (snd-display ";locsig -700(2): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig -700(2): ~A" (locsig-data gen)))
(set! gen (make-locsig 20 :channels 2))
(if (not (vequal (locsig-data gen) (vct 0.778 0.222)))
- (snd-display ";locsig 20(2): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig 20(2): ~A" (locsig-data gen)))
(set! gen (make-locsig 123456.0 :channels 8))
(if (not (vequal (locsig-data gen) (vct 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
- (snd-display ";locsig 123456(8): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig 123456(8): ~A" (locsig-data gen)))
(set! gen (make-locsig 336.0 :channels 8))
(if (not (vequal (locsig-data gen) (vct 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
- (snd-display ";locsig 336(8): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig 336(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -123456.0 :channels 8))
(if (not (vequal (locsig-data gen) (vct 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";locsig -123456(8): ~A" (locsig-data gen)))
+ (snd-display #__line__ ";locsig -123456(8): ~A" (locsig-data gen)))
(set! gen (make-locsig 24.0 :channels 8))
(if (not (vequal (locsig-data gen) (vct 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";locsig 24(8): ~A" (locsig-data gen)))))
+ (snd-display #__line__ ";locsig 24(8): ~A" (locsig-data gen)))))
(for-each
(lambda (rev-chans)
(define (locsig-scalers chans degree type)
(define (fmod a b)
- (let ((pos (inexact->exact (floor (/ a b)))))
+ (let ((pos (floor (/ a b))))
(- a (* pos b))))
(if (= chans 1)
(vct 1.0)
@@ -24221,7 +24305,7 @@ EDITS: 2
90.0
(/ 360.0 chans)))
(pos (/ deg degs-per-chan))
- (left (inexact->exact (floor pos)))
+ (left (floor pos))
(right (modulo (+ left 1) chans))
(frac (- pos left))
(v (make-vct chans)))
@@ -24249,20 +24333,20 @@ EDITS: 2
(if happy
(begin
(set! (locsig-type) type)
- (if (not (= (locsig-type) type)) (snd-display ";locsig-type: ~A ~A" type (locsig-type)))
+ (if (not (= (locsig-type) type)) (snd-display #__line__ ";locsig-type: ~A ~A" type (locsig-type)))
(for-each
(lambda (deg)
(let ((gen (make-locsig deg :channels 1 :revout revfile :reverb .1 :distance 2.0))
(revs (if revfile (locsig-scalers rev-chans deg type))))
- (if (not (= (mus-channels gen) 1)) (snd-display ";locsig ~A: ~A" deg gen))
- (if (fneq (locsig-ref gen 0) 0.5) (snd-display ";locsig scaler[~A] ~A: ~A" type deg (locsig-ref gen 0)))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";locsig ~A: ~A" deg gen))
+ (if (fneq (locsig-ref gen 0) 0.5) (snd-display #__line__ ";locsig scaler[~A] ~A: ~A" type deg (locsig-ref gen 0)))
(if revfile
(do ((i 0 (+ 1 i)))
((or (not happy) (= i rev-chans)))
(if (fneq (locsig-reverb-ref gen i) (* (/ .1 (sqrt 2.0)) (vct-ref revs i)))
(begin
- (snd-display ";mono locrev[~A] ~A at ~A: ~A ~A"
+ (snd-display #__line__ ";mono locrev[~A] ~A at ~A: ~A ~A"
type gen deg
(locsig-reverb-ref gen i)
(* (/ .1 (sqrt 2.0)) (vct-ref revs i)))
@@ -24274,8 +24358,8 @@ EDITS: 2
(for-each
(lambda (deg)
(let ((gen (make-locsig deg :channels 1 :type ltype)))
- (if (not (= (mus-channels gen) 1)) (snd-display ";locsig ~A: ~A" deg gen))
- (if (fneq (locsig-ref gen 0) 1.0) (snd-display ";locsig[~A] scaler ~A: ~A" ltype deg (locsig-ref gen 0)))))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";locsig ~A: ~A" deg gen))
+ (if (fneq (locsig-ref gen 0) 1.0) (snd-display #__line__ ";locsig[~A] scaler ~A: ~A" ltype deg (locsig-ref gen 0)))))
(list 0.0 45.0 90.0 1234.0)))
(list mus-interp-linear mus-interp-sinusoidal))
@@ -24284,21 +24368,21 @@ EDITS: 2
(for-each
(lambda (deg)
(let ((gen (make-locsig deg :channels chans :revout revfile :reverb .1)))
- (if (not (= (mus-channels gen) chans)) (begin (snd-display ";multi locsig ~A: ~A" deg gen) (quit)))
+ (if (not (= (mus-channels gen) chans)) (begin (snd-display #__line__ ";multi locsig ~A: ~A" deg gen) (quit)))
(let ((scalers (locsig-scalers chans deg type))
(revs (if revfile (locsig-scalers rev-chans deg type))))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i chans)))
(if (fneq (locsig-ref gen i) (vct-ref scalers i))
(begin
- (snd-display ";locsig[~A] ~A at ~A: ~A ~A" type gen deg (locsig-ref gen i) (vct-ref scalers i))
+ (snd-display #__line__ ";locsig[~A] ~A at ~A: ~A ~A" type gen deg (locsig-ref gen i) (vct-ref scalers i))
(set! happy #f))))
(if revfile
(do ((i 0 (+ 1 i)))
((or (not happy) (= i rev-chans)))
(if (fneq (locsig-reverb-ref gen i) (* .1 (vct-ref revs i)))
(begin
- (snd-display ";locrev[~A] ~A at ~A: ~A ~A"
+ (snd-display #__line__ ";locrev[~A] ~A at ~A: ~A ~A"
type gen deg
(locsig-reverb-ref gen i)
(* .1 (vct-ref revs i)))
@@ -24313,21 +24397,21 @@ EDITS: 2
(for-each
(lambda (deg)
(let ((gen (make-locsig deg :channels chans :type ltype :revout revfile :reverb .1)))
- (if (not (= (mus-channels gen) chans)) (begin (snd-display ";stereo locsig ~A: ~A" deg gen) (quit)))
+ (if (not (= (mus-channels gen) chans)) (begin (snd-display #__line__ ";stereo locsig ~A: ~A" deg gen) (quit)))
(let ((scalers (locsig-scalers chans deg ltype))
(revs (if revfile (locsig-scalers rev-chans deg ltype))))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i chans)))
(if (fneq (locsig-ref gen i) (vct-ref scalers i))
(begin
- (snd-display ";locsig[~A] ~A at ~A: ~A ~A" ltype gen deg (locsig-ref gen i) (vct-ref scalers i))
+ (snd-display #__line__ ";locsig[~A] ~A at ~A: ~A ~A" ltype gen deg (locsig-ref gen i) (vct-ref scalers i))
(set! happy #f))))
(if revfile
(do ((i 0 (+ 1 i)))
((or (not happy) (= i rev-chans)))
(if (fneq (locsig-reverb-ref gen i) (* .1 (vct-ref revs i)))
(begin
- (snd-display ";locrev[~A] ~A at ~A: ~A ~A"
+ (snd-display #__line__ ";locrev[~A] ~A at ~A: ~A ~A"
type gen deg
(locsig-reverb-ref gen i)
(* .1 (vct-ref revs i)))
@@ -24343,84 +24427,84 @@ EDITS: 2
(set! (locsig-type) mus-interp-linear)
(let* ((outp (make-sound-data 1 10))
(gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 1)) (snd-display ";make-locsig->sd chans (1): ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";make-locsig->sd chans (1): ~A" (mus-channels gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display ";locsig->sd chan 0: ~A" (sound-data->vct outp 0))))
+ (snd-display #__line__ ";locsig->sd chan 0: ~A" (sound-data->vct outp 0))))
(let* ((outp (make-sound-data 2 10))
(gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display ";make-locsig->sd chans: ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-locsig->sd chans: ~A" (mus-channels gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display ";locsig->sd chan 0: ~A" (sound-data->vct outp 0)))
+ (snd-display #__line__ ";locsig->sd chan 0: ~A" (sound-data->vct outp 0)))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.0)))
- (snd-display ";locsig->sd chan 1: ~A" (sound-data->vct outp 1))))
+ (snd-display #__line__ ";locsig->sd chan 1: ~A" (sound-data->vct outp 1))))
(let* ((outp (make-sound-data 2 10))
(gen (make-locsig 45.0 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display ";make-locsig->sd chans: ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-locsig->sd chans: ~A" (mus-channels gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.5)))
- (snd-display ";locsig->sd chan 0 (0.5): ~A (~A)" (sound-data->vct outp 0) gen))
+ (snd-display #__line__ ";locsig->sd chan 0 (0.5): ~A (~A)" (sound-data->vct outp 0) gen))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display ";locsig->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
+ (snd-display #__line__ ";locsig->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 0.5))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.75)))
- (snd-display ";locsig->sd chan 0 (0.75) (~A): ~A" (sound-data->vct outp 0) gen))
+ (snd-display #__line__ ";locsig->sd chan 0 (0.75) (~A): ~A" (sound-data->vct outp 0) gen))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.75)))
- (snd-display ";locsig->sd chan 1 (0.75): ~A" (sound-data->vct outp 1))))
+ (snd-display #__line__ ";locsig->sd chan 1 (0.75): ~A" (sound-data->vct outp 1))))
(let* ((outp (make-vct 10))
(gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 1)) (snd-display ";make-locsig->vct chans: ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";make-locsig->vct chans: ~A" (mus-channels gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))
(if (not (vequal outp (make-vct 10 1.0)))
- (snd-display ";locsig->vct chan 0: ~A" outp))
+ (snd-display #__line__ ";locsig->vct chan 0: ~A" outp))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 0.5))
(if (not (vequal outp (make-vct 10 1.5)))
- (snd-display ";locsig->vct chan 0: ~A" outp)))
+ (snd-display #__line__ ";locsig->vct chan 0: ~A" outp)))
(let* ((outp (make-vct 10))
(gen (make-locsig 45.0 :channels 2 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display ";make-locsig->vct chans (2): ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-locsig->vct chans (2): ~A" (mus-channels gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))
(if (not (vequal outp (make-vct 10 0.5)))
- (snd-display ";locsig(2)->vct chan 0: ~A" outp))
+ (snd-display #__line__ ";locsig(2)->vct chan 0: ~A" outp))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 0.5))
(if (not (vequal outp (make-vct 10 0.75)))
- (snd-display ";locsig(2)->vct chan 0: ~A" outp)))
+ (snd-display #__line__ ";locsig(2)->vct chan 0: ~A" outp)))
(let* ((outp (make-sound-data 4 10))
(gen (make-locsig 135.0 :output outp)))
- (if (not (= (mus-channels gen) 4)) (snd-display ";make-locsig->sd chans (4): ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 4)) (snd-display #__line__ ";make-locsig->sd chans (4): ~A" (mus-channels gen)))
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.0)))
- (snd-display ";locsig(4)->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
+ (snd-display #__line__ ";locsig(4)->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display ";locsig(4)->sd chan 1 (0.5) (~A): ~A" (sound-data->vct outp 1) gen))
+ (snd-display #__line__ ";locsig(4)->sd chan 1 (0.5) (~A): ~A" (sound-data->vct outp 1) gen))
(if (not (vequal (sound-data->vct outp 2) (make-vct 10 0.5)))
- (snd-display ";locsig(4)->sd chan 2 (0.5): ~A" (sound-data->vct outp 2)))
+ (snd-display #__line__ ";locsig(4)->sd chan 2 (0.5): ~A" (sound-data->vct outp 2)))
(if (not (vequal (sound-data->vct outp 3) (make-vct 10 0.0)))
- (snd-display ";locsig(4)->sd chan 3 (0.5): ~A" (sound-data->vct outp 3))))
+ (snd-display #__line__ ";locsig(4)->sd chan 3 (0.5): ~A" (sound-data->vct outp 3))))
(set! (mus-array-print-length) 8)
@@ -24513,10 +24597,10 @@ EDITS: 2
free: arrays: true, gens: false
")
- (if (not (move-sound? gen1)) (snd-display ";move-sound?"))
- (if (equal? gen1 gen2) (snd-display ";move-sounds are equal?"))
- (if (not (= (mus-channels gen1) 1)) (snd-display ";mus-channels move-sound (1): ~A" (mus-channels gen1)))
- (if (not (= (mus-channels gen2) 4)) (snd-display ";mus-channels move-sound (4): ~A" (mus-channels gen2)))
+ (if (not (move-sound? gen1)) (snd-display #__line__ ";move-sound?"))
+ (if (equal? gen1 gen2) (snd-display #__line__ ";move-sounds are equal?"))
+ (if (not (= (mus-channels gen1) 1)) (snd-display #__line__ ";mus-channels move-sound (1): ~A" (mus-channels gen1)))
+ (if (not (= (mus-channels gen2) 4)) (snd-display #__line__ ";mus-channels move-sound (4): ~A" (mus-channels gen2)))
(mus-reset gen1) ; a no-op
(let ((v (make-vct 10 0.0)))
@@ -24526,7 +24610,7 @@ EDITS: 2
(gen2 i 0.25)
(move-sound gen3 i 0.125))))
(if (not (vequal v (make-vct 10 0.875)))
- (snd-display ";move-sound output: ~A" v)))
+ (snd-display #__line__ ";move-sound output: ~A" v)))
(let ((var (catch #t (lambda () (make-move-sound (list 0 1000 1 0 (make-oscil 32) (make-env '(0 0 1 1) :length 1001)
(make-env '(0 0 1 1) :length 1001) (vector (make-delay 32))
@@ -24534,20 +24618,20 @@ EDITS: 2
outf1))
(lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-move-sound bad doppler delay: ~A" var)))
+ (snd-display #__line__ ";make-move-sound bad doppler delay: ~A" var)))
(let ((var (catch #t (lambda () (make-move-sound (list 0 1000 1 0 (make-oscil 32) (make-env '(0 0 1 1) :length 1001)
(make-env '(0 0 1 1) :length 1001) (vector (make-delay 32)))
outf1))
(lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-move-sound truncated list: ~A" var)))
+ (snd-display #__line__ ";make-move-sound truncated list: ~A" var)))
(let ((var (catch #t (lambda () (make-move-sound (list 0 1000 1 0 (make-delay 32) (make-env '(0 0 1 1) :length 1001)
#f (vector #f)
(vector (make-env '(0 0 1 1) :length 1001)) #f #f)
outf1))
(lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
- (snd-display ";make-move-sound no out map: ~A" var)))
+ (snd-display #__line__ ";make-move-sound no out map: ~A" var)))
(mus-close outf1)
@@ -24577,9 +24661,9 @@ EDITS: 2
(fneq (vct-ref vo i) 0.0))
(set! start i)))
(if (not (= start 64))
- (snd-display ";move-sound vct output start: ~A" start))
+ (snd-display #__line__ ";move-sound vct output start: ~A" start))
(if (fneq (vct-peak vo) 0.484)
- (snd-display ";move-sound vct output: ~A" (vct-peak vo))))
+ (snd-display #__line__ ";move-sound vct output: ~A" (vct-peak vo))))
(let* ((vo (make-sound-data 1 1000))
(gen1 (make-move-sound (list 0 1000 1 0
@@ -24599,11 +24683,11 @@ EDITS: 2
(fneq (sound-data-ref vo 0 i) 0.0))
(set! start i)))
(if (not (= start 64))
- (snd-display ";move-sound sd output start: ~A" start))
+ (snd-display #__line__ ";move-sound sd output start: ~A" start))
(if (fneq (sound-data-peak vo) 0.484)
- (snd-display ";move-sound sd peak output: ~A" (sound-data-peak vo)))
+ (snd-display #__line__ ";move-sound sd peak output: ~A" (sound-data-peak vo)))
(if (fneq (apply max (sound-data-maxamp vo)) 0.484)
- (snd-display ";move-sound sd output: ~A" (sound-data-maxamp vo))))
+ (snd-display #__line__ ";move-sound sd output: ~A" (sound-data-maxamp vo))))
(let* ((vo (make-vct 1000))
(gen1 (make-move-sound (list 0 1000 1 0
@@ -24624,9 +24708,9 @@ EDITS: 2
(> (abs (vct-ref vo i)) 0.001))
(set! start i))))
(if (not (= start 64))
- (snd-display ";move-sound opt vct output start: ~A" start))
+ (snd-display #__line__ ";move-sound opt vct output start: ~A" start))
(if (fneq (vct-peak vo) 0.484)
- (snd-display ";move-sound opt vct output: ~A" (vct-peak vo))))
+ (snd-display #__line__ ";move-sound opt vct output: ~A" (vct-peak vo))))
(let* ((vo (make-sound-data 1 1000))
(gen1 (make-move-sound (list 0 1000 1 0
@@ -24640,16 +24724,16 @@ EDITS: 2
vo))
(start -1))
(run
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (move-sound gen1 i 0.5)
- (if (and (< start 0)
- (> (abs (sound-data-ref vo 0 i)) 0.001))
- (set! start i))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (move-sound gen1 i 0.5)
+ (if (and (< start 0)
+ (> (abs (sound-data-ref vo 0 i)) 0.001))
+ (set! start i))))
(if (not (= start 64))
- (snd-display ";move-sound opt sd output start: ~A" start))
+ (snd-display #__line__ ";move-sound opt sd output start: ~A" start))
(if (fneq (apply max (sound-data-maxamp vo)) 0.484)
- (snd-display ";move-sound opt sd output: ~A" (sound-data-maxamp vo))))
+ (snd-display #__line__ ";move-sound opt sd output: ~A" (sound-data-maxamp vo))))
(let ((gen (make-src :srate 2.0))
@@ -24666,21 +24750,21 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (src gen 0.0 (lambda (dir) (readin rd)))))
(vct-map! v1 (lambda () (if (src? gen1) (src gen1 0.0 (lambda (dir) (readin rd1a))))))
- (if (not (vequal v0 v1)) (snd-display ";run src: ~A ~A" v0 v1))
- (if (not (src? gen)) (snd-display ";~A not scr?" gen))
- (if (or (fneq (vct-ref v0 1) .001) (fneq (vct-ref v0 7) .021)) (snd-display ";src output: ~A" v0))
- (if (fneq (mus-increment gen) 2.0) (snd-display ";src increment: ~F?" (mus-increment gen)))
- (if (fneq (mus-increment gen2) 0.0) (snd-display ";src 0.0 increment: ~F?" (mus-increment gen2)))
- (if (fneq (mus-increment rd) 1.0) (snd-display ";readin increment: ~F?" (mus-increment rd)))
- (if (not (= (mus-length gen) 10)) (snd-display ";src length: ~A" (mus-length gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";run src: ~A ~A" v0 v1))
+ (if (not (src? gen)) (snd-display #__line__ ";~A not scr?" gen))
+ (if (or (fneq (vct-ref v0 1) .001) (fneq (vct-ref v0 7) .021)) (snd-display #__line__ ";src output: ~A" v0))
+ (if (fneq (mus-increment gen) 2.0) (snd-display #__line__ ";src increment: ~F?" (mus-increment gen)))
+ (if (fneq (mus-increment gen2) 0.0) (snd-display #__line__ ";src 0.0 increment: ~F?" (mus-increment gen2)))
+ (if (fneq (mus-increment rd) 1.0) (snd-display #__line__ ";readin increment: ~F?" (mus-increment rd)))
+ (if (not (= (mus-length gen) 10)) (snd-display #__line__ ";src length: ~A" (mus-length gen)))
(let ((gold gen))
(set! gen (make-src (lambda (dir)
0.0)))
- (if (equal? gen gold) (snd-display ";src eqaul? ~A ~A" gen gold))))
+ (if (equal? gen gold) (snd-display #__line__ ";src eqaul? ~A ~A" gen gold))))
(let ((var (catch #t (lambda () (make-src :width -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-src bad width: ~A" var)))
+ (snd-display #__line__ ";make-src bad width: ~A" var)))
(let ((s1 (make-src (lambda (y) 1.0) 2.0)))
(src s1 25.0) ; try to tickle segfault
@@ -24706,7 +24790,7 @@ EDITS: 2
(let ((old-val (vct-ref v0 i))
(new-val (src gen 0.0)))
(if (fneq old-val new-val)
- (snd-display ";reset src ~A ~A ~A" i old-val new-val))))))
+ (snd-display #__line__ ";reset src ~A ~A ~A" i old-val new-val))))))
(let ((gen (make-granulate :expansion 2.0))
(v0 (make-vct 1000))
@@ -24722,37 +24806,37 @@ EDITS: 2
(vct-set! v0 i (granulate gen (lambda (dir) (readin rd)))))
(vct-map! v1 (lambda () (if (granulate? gen1) (granulate gen1 (lambda (dir) (readin rd1b))))))
(let ((worst (abs (- (vct-peak v0) (vct-peak v1)))))
- (if (> worst .01) (snd-display ";run granulate: ~A" worst)))
+ (if (> worst .01) (snd-display #__line__ ";run granulate: ~A" worst)))
(let ((genx gen1))
(if (not (equal? genx gen1))
- (snd-display ";granulate equal? ~A ~A ~A" genx gen1 (equal? genx gen1))))
- (if (equal? gen gen1) (snd-display ";granulate equal? ~A ~A" gen gen1))
- (if (= (vct-peak v0) 0.0) (snd-display ";granulate output peak: ~F?" (vct-peak v0)))
- (if (not (granulate? gen)) (snd-display ";~A not granulate?" gen))
- (if (fneq (mus-increment gen) 2.0) (snd-display ";granulate increment: ~F?" (mus-increment gen)))
- (if (fneq (mus-scaler gen) 0.6) (snd-display ";granulate scaler: ~F?" (mus-scaler gen)))
- (if (ffneq (mus-frequency gen) 0.05) (snd-display ";granulate frequency: ~F?" (mus-frequency gen)))
- (if (not (= (mus-ramp gen) 1323)) (snd-display ";granulate ramp: ~F?" (mus-ramp gen)))
- (if (not (= (mus-length gen) 3308)) (snd-display ";granulate length: ~A?" (mus-length gen)))
- (if (not (= (mus-hop gen) 1102)) (snd-display ";granulate hop: ~A?" (mus-hop gen)))
- (set! (mus-hop gen) 1000) (if (not (= (mus-hop gen) 1000)) (snd-display ";granulate set-hop: ~A?" (mus-hop gen)))
- (set! (mus-ramp gen) 1000) (if (not (= (mus-ramp gen) 1000)) (snd-display ";granulate set-ramp: ~A?" (mus-ramp gen)))
- (set! (mus-length gen) 3000) (if (not (= (mus-length gen) 3000)) (snd-display ";granulate set-length: ~A?" (mus-length gen)))
+ (snd-display #__line__ ";granulate equal? ~A ~A ~A" genx gen1 (equal? genx gen1))))
+ (if (equal? gen gen1) (snd-display #__line__ ";granulate equal? ~A ~A" gen gen1))
+ (if (= (vct-peak v0) 0.0) (snd-display #__line__ ";granulate output peak: ~F?" (vct-peak v0)))
+ (if (not (granulate? gen)) (snd-display #__line__ ";~A not granulate?" gen))
+ (if (fneq (mus-increment gen) 2.0) (snd-display #__line__ ";granulate increment: ~F?" (mus-increment gen)))
+ (if (fneq (mus-scaler gen) 0.6) (snd-display #__line__ ";granulate scaler: ~F?" (mus-scaler gen)))
+ (if (ffneq (mus-frequency gen) 0.05) (snd-display #__line__ ";granulate frequency: ~F?" (mus-frequency gen)))
+ (if (not (= (mus-ramp gen) 1323)) (snd-display #__line__ ";granulate ramp: ~F?" (mus-ramp gen)))
+ (if (not (= (mus-length gen) 3308)) (snd-display #__line__ ";granulate length: ~A?" (mus-length gen)))
+ (if (not (= (mus-hop gen) 1102)) (snd-display #__line__ ";granulate hop: ~A?" (mus-hop gen)))
+ (set! (mus-hop gen) 1000) (if (not (= (mus-hop gen) 1000)) (snd-display #__line__ ";granulate set-hop: ~A?" (mus-hop gen)))
+ (set! (mus-ramp gen) 1000) (if (not (= (mus-ramp gen) 1000)) (snd-display #__line__ ";granulate set-ramp: ~A?" (mus-ramp gen)))
+ (set! (mus-length gen) 3000) (if (not (= (mus-length gen) 3000)) (snd-display #__line__ ";granulate set-length: ~A?" (mus-length gen)))
(set! (mus-increment gen) 3.0)
- (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display ";granulate set-increment: ~F?" (mus-increment gen)))
+ (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display #__line__ ";granulate set-increment: ~F?" (mus-increment gen)))
(set! (mus-increment gen) 0.0) ; should be a no-op
- (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display ";granulate set-increment 0.0: ~F?" (mus-increment gen)))
+ (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display #__line__ ";granulate set-increment 0.0: ~F?" (mus-increment gen)))
(set! (mus-location gen) 1)
- (if (not (= (mus-location gen) 1)) (snd-display ";mus-location grn: ~A" (mus-location gen)))
+ (if (not (= (mus-location gen) 1)) (snd-display #__line__ ";mus-location grn: ~A" (mus-location gen)))
(set! (mus-frequency gen) .1)
- (if (fneq (mus-frequency gen) .1) (snd-display ";set granulate freq: ~A" (mus-frequency gen)))
+ (if (fneq (mus-frequency gen) .1) (snd-display #__line__ ";set granulate freq: ~A" (mus-frequency gen)))
(let ((tag (catch #t (lambda () (granulate gen (lambda (a b) a))) (lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display ";granulate bad func: ~A" tag))))
+ (snd-display #__line__ ";granulate bad func: ~A" tag))))
(let ((var (catch #t (lambda () (make-granulate :hop 35.0 :length 35.0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
- (snd-display ";make-granulate bad sizes: ~A" var)))
-
+ (snd-display #__line__ ";make-granulate bad sizes: ~A" var)))
+
(let ((ind (open-sound "oboe.snd"))
(mx (maxamp)))
(let ((rd (make-sampler 0)))
@@ -24767,7 +24851,7 @@ EDITS: 2
0)))))
(map-channel (lambda (y) (granulate grn)))
(if (or (< (/ (maxamp) mx) 1.4) (> (/ mx (maxamp)) 2.5))
- (snd-display ";gran edit 2* (0): ~A ~A" mx (maxamp)))
+ (snd-display #__line__ ";gran edit 2* (0): ~A ~A" mx (maxamp)))
(undo)))
(let ((rd (make-sampler 0)))
(let ((grn (make-granulate :expansion 2.0
@@ -24781,7 +24865,7 @@ EDITS: 2
0)))))
(map-channel (lambda (y) (granulate grn)))
(if (or (< (/ (maxamp) mx) 3.0) (> (/ mx (maxamp)) 6.0))
- (snd-display ";gran edit 4* (0): ~A ~A" mx (maxamp)))
+ (snd-display #__line__ ";gran edit 4* (0): ~A ~A" mx (maxamp)))
(revert-sound ind)))
(let ((grn (make-granulate :expansion 2.0
:edit (lambda (g)
@@ -24794,7 +24878,7 @@ EDITS: 2
(rd (make-sampler 0)))
(map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
(if (or (< (/ (maxamp) mx) 1.4) (> (/ mx (maxamp)) 2.5))
- (snd-display ";gran edit 2* (1): ~A ~A" mx (maxamp)))
+ (snd-display #__line__ ";gran edit 2* (1): ~A ~A" mx (maxamp)))
(undo)
(let ((grn (make-granulate :expansion 2.0
:edit (lambda (g)
@@ -24807,7 +24891,7 @@ EDITS: 2
(rd (make-sampler 0)))
(map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
(if (or (< (/ (maxamp) mx) 3.0) (> (/ mx (maxamp)) 6.0))
- (snd-display ";gran edit 4* (1): ~A ~A" mx (maxamp)))
+ (snd-display #__line__ ";gran edit 4* (1): ~A ~A" mx (maxamp)))
(revert-sound ind)))
(let ((grn (make-granulate :expansion 2.0))
(rd (make-sampler 0)))
@@ -24822,7 +24906,7 @@ EDITS: 2
(vct-set! grain i (* 2 (vct-ref grain i))))
0)))))
(if (or (< (/ (maxamp) mx) 1.4) (> (/ mx (maxamp)) 2.5))
- (snd-display ";gran edit 2* (2): ~A ~A" mx (maxamp)))
+ (snd-display #__line__ ";gran edit 2* (2): ~A ~A" mx (maxamp)))
(undo)
(let ((grn (make-granulate :expansion 2.0))
(rd (make-sampler 0)))
@@ -24837,7 +24921,7 @@ EDITS: 2
(vct-set! grain i (* 4 (vct-ref grain i))))
0)))))
(if (or (< (/ (maxamp) mx) 3.0) (> (/ mx (maxamp)) 6.0))
- (snd-display ";gran edit 4* (2): ~A ~A" mx (maxamp)))))
+ (snd-display #__line__ ";gran edit 4* (2): ~A ~A" mx (maxamp)))))
(close-sound ind))
(let ((ind (open-sound "oboe.snd")))
@@ -24845,25 +24929,25 @@ EDITS: 2
(rd (make-sampler 0)))
(map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
(let ((mx (maxamp)))
- (if (> mx .2) (snd-display ";trouble in granulate len .01 hop .05: ~A" mx))
+ (if (> mx .2) (snd-display #__line__ ";trouble in granulate len .01 hop .05: ~A" mx))
(undo)))
(let ((grn (make-granulate :expansion 2.0 :length .04 :hop .05))
(rd (make-sampler 0)))
(map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
(let ((mx (maxamp)))
- (if (> mx .2) (snd-display ";trouble in granulate len .04 hop .05: ~A" mx))
+ (if (> mx .2) (snd-display #__line__ ";trouble in granulate len .04 hop .05: ~A" mx))
(undo)))
(let ((grn (make-granulate :expansion 2.0 :length .01 :hop .25))
(rd (make-sampler 0)))
(map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
(let ((mx (maxamp)))
- (if (> mx .2) (snd-display ";trouble in granulate len .01 hop .25: ~A" mx))
+ (if (> mx .2) (snd-display #__line__ ";trouble in granulate len .01 hop .25: ~A" mx))
(undo)))
(let ((grn (make-granulate :expansion 2.0 :length .4 :hop .5))
(rd (make-sampler 0)))
(map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
(let ((mx (maxamp)))
- (if (> mx .2) (snd-display ";trouble in granulate len .4 hop .5: ~A" mx))
+ (if (> mx .2) (snd-display #__line__ ";trouble in granulate len .4 hop .5: ~A" mx))
(undo)))
(close-sound ind))
@@ -24871,141 +24955,141 @@ EDITS: 2
(let ((gen (make-granulate :jitter 0.0 :hop .004 :length .001)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";gran 0 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";gran 0 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 0 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 0 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 85 30)
(vct 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060
0.060 0.060 0.053 0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 0 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 0 data 85: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";gran 1 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";gran 1 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 1 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 1 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 40 30)
(vct 0.000 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060
0.060 0.060 0.060 0.053 0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000)))
- (snd-display ";gran 1 data 40: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 1 data 40: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp .1)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";gran 2 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";gran 2 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.030 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 2 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 2 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 40 30)
(vct 0.000 0.000 0.000 0.000 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.030 0.000 0.000 0.000)))
- (snd-display ";gran 2 data 40: ~A" (channel->vct 40 30)))
+ (snd-display #__line__ ";gran 2 data 40: ~A" (channel->vct 40 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp .5)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";gran 3 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";gran 3 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 3 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 3 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 85 30)
(vct 0.000 0.000 0.000 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
0.055 0.049 0.044 0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 3 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 3 data 85: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .001 :length .001 :ramp .5)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";gran 4 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";gran 4 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038)))
- (snd-display ";gran 4 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 4 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 85 30)
(vct 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
0.055 0.049 0.044 0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022)))
- (snd-display ";gran 4 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 4 data 85: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .001 :length .001 :ramp .25 :scaler 1.0)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";gran 5 max: ~A" mx)))
+ (if (fneq mx 0.1) (snd-display #__line__ ";gran 5 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100)))
- (snd-display ";gran 5 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 5 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 85 30)
(vct 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080)))
- (snd-display ";gran 5 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 5 data 85: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .001 :length .002 :ramp .5 :scaler 1.0)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.105) (snd-display ";gran 6 max: ~A" mx)))
+ (if (fneq mx 0.105) (snd-display #__line__ ";gran 6 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.005 0.009 0.014 0.018 0.023 0.027 0.032 0.036 0.041 0.045 0.050 0.055 0.059 0.064 0.068
0.073 0.077 0.082 0.086 0.091 0.095 0.100 0.105 0.105 0.105 0.105 0.105 0.105 0.105)))
- (snd-display ";gran 6 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 6 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 85 30)
(vct 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105
0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105)))
- (snd-display ";gran 6 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 6 data 85: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.264) (snd-display ";gran 7 max: ~A" mx)))
+ (if (fneq mx 0.264) (snd-display #__line__ ";gran 7 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
- (snd-display ";gran 7 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 7 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 85 30)
(vct 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
- (snd-display ";gran 7 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 7 data 85: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 2.0)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";gran 8 max: ~A" mx)))
+ (if (fneq mx 0.1) (snd-display #__line__ ";gran 8 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 8 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 8 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 220 30)
(vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 8 data 220: ~A" (channel->vct 220 30)))
+ (snd-display #__line__ ";gran 8 data 220: ~A" (channel->vct 220 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";gran 9 max: ~A" mx))) ; same as 8 because expansion hits the input counter
+ (if (fneq mx 0.1) (snd-display #__line__ ";gran 9 max: ~A" mx))) ; same as 8 because expansion hits the input counter
(if (not (vequal (channel->vct 0 30)
(vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 9 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 9 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 220 30)
(vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 9 data 220: ~A" (channel->vct 220 30)))
+ (snd-display #__line__ ";gran 9 data 220: ~A" (channel->vct 220 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0)))
@@ -25019,15 +25103,15 @@ EDITS: 2
(vct-set! grain i (* 2 (vct-ref grain i)))))
0))))
(let ((mx (maxamp)))
- (if (fneq mx (* 2 0.264)) (snd-display ";gran 10 max: ~A" mx)))
+ (if (fneq mx (* 2 0.264)) (snd-display #__line__ ";gran 10 max: ~A" mx)))
(if (not (vequal (vct-scale! (channel->vct 0 30) 0.5)
(vct 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
- (snd-display ";gran 10 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 10 data: ~A" (channel->vct 0 30)))
(if (not (vequal (vct-scale! (channel->vct 85 30) 0.5)
(vct 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
- (snd-display ";gran 10 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 10 data 85: ~A" (channel->vct 85 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .005 :length .002 :ramp 0.0 :scaler 1.0))
@@ -25046,15 +25130,15 @@ EDITS: 2
(vct-reverse! grain len))) ; should get ramps going up then down across overall rising ramp
len)))))
(let ((mx (maxamp)))
- (if (> mx 0.6) (snd-display ";gran 11 max: ~A" mx)))
+ (if (> mx 0.6) (snd-display #__line__ ";gran 11 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
- (snd-display ";gran 11 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 11 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 100 30)
(vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
-0.350 -0.351 -0.352 -0.353 -0.354 -0.355 -0.356 -0.357 -0.358 -0.359 -0.360 -0.361 -0.362 -0.363 -0.364)))
- (snd-display ";gran 11 data 100: ~A" (channel->vct 100 30)))
+ (snd-display #__line__ ";gran 11 data 100: ~A" (channel->vct 100 30)))
(undo))
(let* ((forward #t)
@@ -25064,15 +25148,15 @@ EDITS: 2
:input (lambda (dir) (set! ctr (+ ctr incr)) ctr))))
(map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
- (if (> mx 0.6) (snd-display ";gran 12 max: ~A" mx)))
+ (if (> mx 0.6) (snd-display #__line__ ";gran 12 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
- (snd-display ";gran 12 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 12 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 100 30)
(vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.389 -0.388 -0.387 -0.386 -0.385
-0.384 -0.383 -0.382 -0.381 -0.380 -0.379 -0.378 -0.377 -0.376 -0.375 -0.374 -0.373 -0.372 -0.371 -0.370)))
- (snd-display ";gran 12 data 100: ~A" (channel->vct 100 30)))
+ (snd-display #__line__ ";gran 12 data 100: ~A" (channel->vct 100 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0
@@ -25086,15 +25170,15 @@ EDITS: 2
0))))
(map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
- (if (> mx .6) (snd-display ";gran 13 max: ~A" mx)))
+ (if (> mx .6) (snd-display #__line__ ";gran 13 max: ~A" mx)))
(if (not (vequal (vct-scale! (channel->vct 0 30) 0.5)
(vct 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
- (snd-display ";gran 13 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 13 data: ~A" (channel->vct 0 30)))
(if (not (vequal (vct-scale! (channel->vct 85 30) 0.5)
(vct 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
- (snd-display ";gran 13 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 13 data 85: ~A" (channel->vct 85 30)))
(undo))
(let* ((forward #t)
@@ -25113,15 +25197,15 @@ EDITS: 2
len)))))
(map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
- (if (> mx 0.6) (snd-display ";gran 14 max: ~A" mx)))
+ (if (> mx 0.6) (snd-display #__line__ ";gran 14 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
- (snd-display ";gran 14 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 14 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 100 30)
(vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
-0.350 -0.351 -0.352 -0.353 -0.354 -0.355 -0.356 -0.357 -0.358 -0.359 -0.360 -0.361 -0.362 -0.363 -0.364)))
- (snd-display ";gran 14 data 100: ~A" (channel->vct 100 30)))
+ (snd-display #__line__ ";gran 14 data 100: ~A" (channel->vct 100 30)))
(undo))
(let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0))
@@ -25130,24 +25214,24 @@ EDITS: 2
(map-channel
(lambda (y)
(let ((result (granulate gen (lambda (dir) .1))))
- (set! (mus-ramp gen) (inexact->exact (round (* base-ramp-len (env e)))))
+ (set! (mus-ramp gen) (round (* base-ramp-len (env e))))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";granf 0 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";granf 0 max: ~A" mx)))
(if (> (abs (- (mus-ramp gen) (* .5 (mus-length gen)))) 1)
- (snd-display ";granf 0 ramp: ~A ~A" (mus-ramp gen) (mus-length gen)))
+ (snd-display #__line__ ";granf 0 ramp: ~A ~A" (mus-ramp gen) (mus-length gen)))
(if (not (vequal (channel->vct 0 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 0 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";granf 0 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 440 30)
(vct 0.000 0.012 0.024 0.036 0.048 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.048 0.036 0.024 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 0 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";granf 0 data 440: ~A" (channel->vct 440 30)))
(if (not (vequal (channel->vct 880 30)
(vct 0.000 0.006 0.012 0.018 0.024 0.030 0.036 0.042 0.048 0.054 0.060 0.060 0.060 0.060
0.054 0.048 0.042 0.036 0.030 0.024 0.018 0.012 0.006 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 0 data 880: ~A" (channel->vct 880 30)))
+ (snd-display #__line__ ";granf 0 data 880: ~A" (channel->vct 880 30)))
(undo))
@@ -25157,20 +25241,20 @@ EDITS: 2
(map-channel
(lambda (y)
(let ((result (granulate gen (lambda (dir) .1))))
- (set! (mus-hop gen) (inexact->exact (round (* base-hop-len (env e)))))
+ (set! (mus-hop gen) (round (* base-hop-len (env e))))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";granf 1 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";granf 1 max: ~A" mx)))
(if (> (abs (- (mus-hop gen) (* .001 (mus-srate)))) 1)
- (snd-display ";granf 1 hop: ~A ~A, ~A ~A" (mus-hop gen) (abs (- (mus-hop gen) (* .001 (srate)))) (srate) (mus-srate)))
+ (snd-display #__line__ ";granf 1 hop: ~A ~A, ~A ~A" (mus-hop gen) (abs (- (mus-hop gen) (* .001 (srate)))) (srate) (mus-srate)))
(if (not (vequal (channel->vct 0 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 1 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";granf 1 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 900 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
0.000 0.000 0.000 0.000 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display ";granf 1 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";granf 1 data 900: ~A" (channel->vct 900 30)))
(undo))
(let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0))
@@ -25182,27 +25266,27 @@ EDITS: 2
(set! (mus-frequency gen) (* base-freq (env e)))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";granf 2 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";granf 2 max: ~A" mx)))
(if (> (abs (- (mus-hop gen) (* .001 (mus-srate)))) 1)
- (snd-display ";granf 2 hop: ~A" (mus-hop gen)))
+ (snd-display #__line__ ";granf 2 hop: ~A" (mus-hop gen)))
(if (not (vequal (channel->vct 0 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 2 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";granf 2 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 900 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display ";granf 2 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";granf 2 data 900: ~A" (channel->vct 900 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp 0.0 :scaler 1.0)))
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";granf 3 max: ~A" mx)))
+ (if (fneq mx 0.1) (snd-display #__line__ ";granf 3 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";gran 3 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 3 data: ~A" (channel->vct 0 30)))
(undo))
(let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0 :scaler 1.0))
@@ -25213,19 +25297,19 @@ EDITS: 2
(set! (mus-scaler gen) (env e))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.1) (snd-display ";granf 4 max: ~A" mx)))
+ (if (fneq mx 0.1) (snd-display #__line__ ";granf 4 max: ~A" mx)))
(if (not (vequal (channel->vct 0 30)
(vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 4 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";granf 4 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 440 30)
(vct 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056
0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 4 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";granf 4 data 440: ~A" (channel->vct 440 30)))
(if (not (vequal (channel->vct 900 30)
(vct 0.012 0.012 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 4 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";granf 4 data 900: ~A" (channel->vct 900 30)))
(undo))
(let* ((gen (make-granulate :jitter 0.0 :hop .006 :length .001 :ramp 0.0 :max-size 2200))
@@ -25234,24 +25318,24 @@ EDITS: 2
(map-channel
(lambda (y)
(let ((result (granulate gen (lambda (dir) .1))))
- (set! (mus-length gen) (inexact->exact (round (* base-len (env e)))))
+ (set! (mus-length gen) (round (* base-len (env e))))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";granf 5 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";granf 5 max: ~A" mx)))
(if (> (abs (- (mus-length gen) (* 5 base-len))) 10)
- (snd-display ";granf 5 length: ~A ~A" (mus-length gen) (* 5 base-len)))
+ (snd-display #__line__ ";granf 5 length: ~A ~A" (mus-length gen) (* 5 base-len)))
(if (not (vequal (channel->vct 0 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 5 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";granf 5 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 440 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 5 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";granf 5 data 440: ~A" (channel->vct 440 30)))
(if (not (vequal (channel->vct 800 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display ";granf 5 data 800: ~A" (channel->vct 800 30)))
+ (snd-display #__line__ ";granf 5 data 800: ~A" (channel->vct 800 30)))
(undo))
(let* ((gen (make-granulate :jitter 0.0 :hop .006 :length .005 :ramp 0.0 :max-size 2200))
@@ -25260,20 +25344,20 @@ EDITS: 2
(map-channel
(lambda (y)
(let ((result (granulate gen (lambda (dir) .1))))
- (set! (mus-length gen) (inexact->exact (round (* base-len (env e)))))
+ (set! (mus-length gen) (round (* base-len (env e))))
result)))
(let ((mx (maxamp)))
- (if (fneq mx 0.06) (snd-display ";granf 6 max: ~A" mx)))
+ (if (fneq mx 0.06) (snd-display #__line__ ";granf 6 max: ~A" mx)))
(if (> (abs (- (mus-length gen) (* .2 base-len))) 4)
- (snd-display ";granf 6 length: ~A ~A" (mus-length gen) (* .2 base-len)))
+ (snd-display #__line__ ";granf 6 length: ~A ~A" (mus-length gen) (* .2 base-len)))
(if (not (vequal (channel->vct 0 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display ";granf 6 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";granf 6 data: ~A" (channel->vct 0 30)))
(if (not (vequal (channel->vct 820 30)
(vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";granf 6 data 820: ~A" (channel->vct 820 30)))
+ (snd-display #__line__ ";granf 6 data 820: ~A" (channel->vct 820 30)))
(undo))
(let ((max-list (lambda ()
@@ -25292,7 +25376,7 @@ EDITS: 2
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((vals (max-list)))
(if (not (equal? vals (list 11 231 451 671 891)))
- (snd-display ";grn jitter 0 max: ~A" vals)))
+ (snd-display #__line__ ";grn jitter 0 max: ~A" vals)))
(undo))
(let ((oldvals #f))
@@ -25301,7 +25385,7 @@ EDITS: 2
;; (11 232 490 736 982) or whatever
(let ((vals (max-list)))
(if (equal? vals (list 11 231 451 671 891))
- (snd-display ";grn jitter 0.3 max: ~A" vals))
+ (snd-display #__line__ ";grn jitter 0.3 max: ~A" vals))
(set! oldvals vals))
(undo))
@@ -25309,7 +25393,7 @@ EDITS: 2
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((vals (max-list)))
(if (equal? vals oldvals)
- (snd-display ";grn jitter 0.3 max: ~A ~A" vals oldvals)))
+ (snd-display #__line__ ";grn jitter 0.3 max: ~A ~A" vals oldvals)))
(undo)))
(let ((oldvals #f)
@@ -25325,7 +25409,7 @@ EDITS: 2
(map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
(let ((vals (max-list)))
(if (not (equal? vals oldvals))
- (snd-display ";grn jitter 1.0 max with seed: ~A ~A" vals oldvals)))
+ (snd-display #__line__ ";grn jitter 1.0 max with seed: ~A ~A" vals oldvals)))
(undo))))
(let ((fname (file-name ind)))
@@ -25335,7 +25419,7 @@ EDITS: 2
(begin
(set! (view-files-files (view-files-dialog #f)) '())
(if (not (null? (view-files-files (view-files-dialog #f))))
- (snd-display ";set vf files list null: ~A" (view-files-files (view-files-dialog #f)))))))
+ (snd-display #__line__ ";set vf files list null: ~A" (view-files-files (view-files-dialog #f)))))))
)
;; granulate with jitter=0, small hop (comb filter effect)
@@ -25348,9 +25432,9 @@ EDITS: 2
:scaler 1.0
:jitter 0.0)))
(clm-channel gen) ; -> .01 max (stable)
- (if (fneq (maxamp) .01) (snd-display ";granulate stable 1: ~A" (maxamp)))
+ (if (fneq (maxamp) .01) (snd-display #__line__ ";granulate stable 1: ~A" (maxamp)))
(let ((minval (scan-channel (lambda (y) (< y .0099)))))
- (if minval (snd-display ";granulate stable 1 min: ~A" minval)))
+ (if minval (snd-display #__line__ ";granulate stable 1 min: ~A" minval)))
(undo)
(set! gen (make-granulate :expansion 20.0
:input (lambda (dir) .1)
@@ -25360,9 +25444,9 @@ EDITS: 2
:scaler 0.5
:jitter 0.0))
(clm-channel gen) ; -> .05 max (stable)
- (if (fneq (maxamp) .05) (snd-display ";granulate stable 2: ~A" (maxamp)))
+ (if (fneq (maxamp) .05) (snd-display #__line__ ";granulate stable 2: ~A" (maxamp)))
(let ((minval (scan-channel (lambda (y) (< y .0499)))))
- (if minval (snd-display ";granulate stable 2 min: ~A" minval)))
+ (if minval (snd-display #__line__ ";granulate stable 2 min: ~A" minval)))
(undo)
(set! gen (make-granulate :expansion 10.0
@@ -25373,9 +25457,9 @@ EDITS: 2
:scaler 1.0
:jitter 0.0))
(clm-channel gen) ; -> .05 max (stable)
- (if (fneq (maxamp) .05) (snd-display ";granulate stable 3: ~A" (maxamp)))
+ (if (fneq (maxamp) .05) (snd-display #__line__ ";granulate stable 3: ~A" (maxamp)))
(let ((minval (scan-channel (lambda (y) (< y .0499)))))
- (if minval (snd-display ";granulate stable 3 min: ~A ~A" minval (sample (cadr minval)))))
+ (if minval (snd-display #__line__ ";granulate stable 3 min: ~A ~A" minval (sample (cadr minval)))))
(undo)
(let ((ctr 0))
@@ -25390,16 +25474,16 @@ EDITS: 2
:scaler 1.0
:jitter 0.0))
(clm-channel gen)
- (if (fneq (maxamp) .462) (snd-display ";granulate ramped 4: ~A" (maxamp)))
+ (if (fneq (maxamp) .462) (snd-display #__line__ ";granulate ramped 4: ~A" (maxamp)))
(let ((vals (count-matches (lambda (y) (not (= y 0.0))))))
- (if (> (abs (- vals 1104)) 10) (snd-display ";granulate ramped 4 not 0.0: ~A" vals)))
+ (if (> (abs (- vals 1104)) 10) (snd-display #__line__ ";granulate ramped 4 not 0.0: ~A" vals)))
(if (or (not (vequal (channel->vct 2203 10)
(vct 0.000 0.000 0.110 0.110 0.110 0.111 0.111 0.111 0.111 0.111)))
(not (vequal (channel->vct 4523 10)
(vct 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.233 0.233)))
(not (vequal (channel->vct 8928 10)
(vct 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452))))
- (snd-display ";granulate ramped 4 data off: ~A ~A ~A"
+ (snd-display #__line__ ";granulate ramped 4 data off: ~A ~A ~A"
(channel->vct 2203 10) (channel->vct 4523 10) (channel->vct 8928 10)))
(undo)
@@ -25415,7 +25499,7 @@ EDITS: 2
:scaler 1.0
:jitter 0.0))
(clm-channel gen)
- (if (fneq (maxamp) .505) (snd-display ";granulate ramped 5: ~A" (maxamp)))
+ (if (fneq (maxamp) .505) (snd-display #__line__ ";granulate ramped 5: ~A" (maxamp)))
(let* ((mxoff 0.0)
(mx (maxamp))
(len (frames))
@@ -25426,7 +25510,7 @@ EDITS: 2
(if (> diff mxoff) (set! mxoff diff))
(set! cur (+ cur incr))
#f)))
- (if (> mxoff .02) (snd-display ";granulate ramped 5 mxoff: ~A" mxoff))) ; .0108 actually
+ (if (> mxoff .02) (snd-display #__line__ ";granulate ramped 5 mxoff: ~A" mxoff))) ; .0108 actually
(undo)
(set! ctr 0)
@@ -25441,12 +25525,12 @@ EDITS: 2
:scaler 1.0
:jitter 0.0))
(clm-channel gen)
- (if (fneq (maxamp) .495) (snd-display ";granulate ramped 6: ~A" (maxamp)))
+ (if (fneq (maxamp) .495) (snd-display #__line__ ";granulate ramped 6: ~A" (maxamp)))
(if (or (not (vequal (channel->vct 2000 10)
(vct 0.018 0.019 0.020 0.021 0.022 0.023 0.024 0.025 0.026 0.027)))
(not (vequal (channel->vct 8000 10)
(vct 0.294 0.298 0.301 0.305 0.309 0.313 0.316 0.320 0.324 0.328))))
- (snd-display ";granulate ramped 6 data: ~A ~A"
+ (snd-display #__line__ ";granulate ramped 6 data: ~A ~A"
(channel->vct 2000 10) (channel->vct 8000 10)))
(undo)
@@ -25462,12 +25546,12 @@ EDITS: 2
:scaler 1.0
:jitter 0.0))
(clm-channel gen)
- (if (fneq (maxamp) .505) (snd-display ";granulate ramped 7: ~A" (maxamp)))
+ (if (fneq (maxamp) .505) (snd-display #__line__ ";granulate ramped 7: ~A" (maxamp)))
(if (or (not (vequal (channel->vct 2000 10)
(vct 0.037 0.039 0.040 0.042 0.044 0.046 0.048 0.050 0.052 0.054)))
(not (vequal (channel->vct 8000 10)
(vct 0.404 0.404 0.404 0.404 0.404 0.405 0.405 0.405 0.405 0.405))))
- (snd-display ";granulate ramped 7 data: ~A ~A"
+ (snd-display #__line__ ";granulate ramped 7 data: ~A ~A"
(channel->vct 2000 10) (channel->vct 8000 10)))
(undo)
@@ -25483,7 +25567,7 @@ EDITS: 2
:scaler 0.1
:jitter 0.0))
(clm-channel gen)
- (if (fneq (maxamp) .201) (snd-display ";granulate ramped 7: ~A" (maxamp)))
+ (if (fneq (maxamp) .201) (snd-display #__line__ ";granulate ramped 7: ~A" (maxamp)))
(let* ((mxoff 0.0)
(mx (maxamp))
(len (frames))
@@ -25494,7 +25578,7 @@ EDITS: 2
(if (> diff mxoff) (set! mxoff diff))
(set! cur (+ cur incr))
#f)))
- (if (> mxoff .01) (snd-display ";granulate ramped 7 mxoff: ~A" mxoff))) ; .0097 actually
+ (if (> mxoff .01) (snd-display #__line__ ";granulate ramped 7 mxoff: ~A" mxoff))) ; .0097 actually
(undo)
(set! ctr 0)
@@ -25509,7 +25593,7 @@ EDITS: 2
:scaler 0.1
:jitter 0.0))
(clm-channel gen)
- (if (fneq (maxamp) .501) (snd-display ";granulate ramped 8: ~A" (maxamp)))
+ (if (fneq (maxamp) .501) (snd-display #__line__ ";granulate ramped 8: ~A" (maxamp)))
(let* ((mxoff 0.0)
(mx (maxamp))
(len (- (frames) 2000))
@@ -25521,7 +25605,7 @@ EDITS: 2
(set! cur (+ cur incr))
#f))
2000)
- (if (> mxoff .001) (snd-display ";granulate ramped 8 mxoff: ~A" mxoff)))
+ (if (> mxoff .001) (snd-display #__line__ ";granulate ramped 8 mxoff: ~A" mxoff)))
(undo)
@@ -25537,7 +25621,7 @@ EDITS: 2
:scaler 0.025
:jitter 0.0))
(clm-channel gen)
- (if (fneq (maxamp) .433) (snd-display ";granulate ramped 9: ~A" (maxamp)))
+ (if (fneq (maxamp) .433) (snd-display #__line__ ";granulate ramped 9: ~A" (maxamp)))
(undo)
(close-sound ind))))
@@ -25560,73 +25644,73 @@ EDITS: 2
(print-and-check gen
"convolve"
"convolve size: 64")
- (if (not (convolve? gen)) (snd-display ";~A not convolve?" gen))
+ (if (not (convolve? gen)) (snd-display #__line__ ";~A not convolve?" gen))
(let ((genx gen1))
- (if (not (equal? genx gen1)) (snd-display ";convolve equal?: ~A ~A ~A" genx gen1 (equal? genx gen1))))
- (if (equal? gen gen1) (snd-display ";convolve equal? ~A ~A" gen gen1))
- (if (not (= (mus-length gen) 64)) (snd-display ";convolve fft len: ~D?" (mus-length gen)))
+ (if (not (equal? genx gen1)) (snd-display #__line__ ";convolve equal?: ~A ~A ~A" genx gen1 (equal? genx gen1))))
+ (if (equal? gen gen1) (snd-display #__line__ ";convolve equal? ~A ~A" gen gen1))
+ (if (not (= (mus-length gen) 64)) (snd-display #__line__ ";convolve fft len: ~D?" (mus-length gen)))
(do ((i 0 (+ 1 i)))
((= i 128))
(vct-set! v2 i (convolve gen (lambda (dir) (set! n (+ n 1)) (vct-ref v1 n)))))
(vct-map! v21 (lambda () (if (convolve? gen1) (convolve gen1 (lambda (dir) (set! n1 (+ n1 1)) (vct-ref v11 n1))))))
- (if (not (vequal v2 v21)) (snd-display ";run gran: ~A ~A" v2 v21))
+ (if (not (vequal v2 v21)) (snd-display #__line__ ";run gran: ~A ~A" v2 v21))
(if (or (fneq (vct-ref v2 0) 0.0)
(fneq (vct-ref v2 1) 1.0)
(fneq (vct-ref v2 4) 0.25)
(fneq (vct-ref v2 7) 0.143))
- (snd-display ";convolve output: ~A?" v2))
+ (snd-display #__line__ ";convolve output: ~A?" v2))
(let ((tag (catch #t (lambda () (convolve gen (lambda (a b) a))) (lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display ";convolve bad func: ~A" tag))))
+ (snd-display #__line__ ";convolve bad func: ~A" tag))))
(convolve-files "oboe.snd" "fyow.snd" .5 "fmv.snd")
(if (fneq (cadr (mus-sound-maxamp "fmv.snd")) .5)
- (snd-display ";convolve-files: ~A /= .5?" (cadr (mus-sound-maxamp "fmv.snd"))))
+ (snd-display #__line__ ";convolve-files: ~A /= .5?" (cadr (mus-sound-maxamp "fmv.snd"))))
(play-sound-1 "fmv.snd"))
(let* ((fd (mus-sound-open-input "oboe.snd"))
(chans (mus-sound-chans "oboe.snd"))
(data (make-sound-data chans 2000)))
- (if (not (sound-data? data)) (snd-display ";~A not sound-data?" data))
- (if (not (= (sound-data-chans data) 1)) (snd-display ";sound-data chans: ~A?" (sound-data-chans data)))
- (if (not (= (sound-data-length data) 2000)) (snd-display ";sound-data length: ~A?" (sound-data-length data)))
+ (if (not (sound-data? data)) (snd-display #__line__ ";~A not sound-data?" data))
+ (if (not (= (sound-data-chans data) 1)) (snd-display #__line__ ";sound-data chans: ~A?" (sound-data-chans data)))
+ (if (not (= (sound-data-length data) 2000)) (snd-display #__line__ ";sound-data length: ~A?" (sound-data-length data)))
(mus-sound-read fd 0 1999 chans data)
(let ((val (sound-data-ref data 0 1497)))
(mus-sound-close-input fd)
- (if (fneq val 0.02893066) (snd-display ";mus-sound-read: ~F?" val))))
+ (if (fneq val 0.02893066) (snd-display #__line__ ";mus-sound-read: ~F?" val))))
(let ((ind (new-sound "fmv.snd")))
(set! (sample 1) .1)
(save-sound ind)
(if (not (equal? (edits ind 0) (list 0 0)))
- (snd-display ";weird: edits not cleared after save-sound?: ~A" (edits ind 0)))
+ (snd-display #__line__ ";weird: edits not cleared after save-sound?: ~A" (edits ind 0)))
(close-sound ind)
(set! ind (open-sound "fmv.snd"))
(if (not (= (frames ind 0) 2))
- (snd-display ";save-sound 2 samps: ~A?" (frames ind 0)))
+ (snd-display #__line__ ";save-sound 2 samps: ~A?" (frames ind 0)))
(if (or (fneq (sample 0) 0.0)
(fneq (sample 1) 0.1))
- (snd-display ";save-sound: ~A ~A?" (sample 0) (sample 1)))
+ (snd-display #__line__ ";save-sound: ~A ~A?" (sample 0) (sample 1)))
(do ((i 3 (+ 1 i)))
((= i 6))
(set! (sample i) (* i .1))
(save-sound ind)
(if (not (equal? (edits ind 0) (list 0 0)))
- (snd-display ";weird: edits not cleared after save-sound ~A?: ~A" i (edits ind 0)))
+ (snd-display #__line__ ";weird: edits not cleared after save-sound ~A?: ~A" i (edits ind 0)))
(close-sound ind)
(set! ind (open-sound "fmv.snd"))
(if (not (= (frames ind 0) (+ i 1)))
- (snd-display ";save-sound ~A samps: ~A?" (+ i 1) (frames ind 0)))
+ (snd-display #__line__ ";save-sound ~A samps: ~A?" (+ i 1) (frames ind 0)))
(if (or (fneq (sample 0) 0.0)
(fneq (sample 1) 0.1)
(fneq (sample i) (* i 0.1)))
- (snd-display ";save-sound ~A: ~A ~A ~A?" i (sample 0) (sample 1) (sample i))))
+ (snd-display #__line__ ";save-sound ~A: ~A ~A ~A?" i (sample 0) (sample 1) (sample i))))
(close-sound ind))
(let ((ind (new-sound "test.snd" :srate 22050 :channels 1 :size 1000))
(gen (make-ssb-am 100.0)))
(map-channel (lambda (y) (ssb-am gen 0.0)))
- (if (fneq (maxamp) 0.0) (snd-display ";ssb-am 0.0: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";ssb-am 0.0: ~A" (maxamp)))
(let ((gen1 (make-oscil 220.0)))
(map-channel (lambda (y) (* 0.5 (oscil gen1))))
(set! gen (make-ssb-am 100.0 100))
@@ -25634,14 +25718,14 @@ EDITS: 2
(delete-samples 0 200)
(set! gen1 (make-oscil 320.0 :initial-phase (asin (* 2 (sample 0))))) ; depends on rising side
(map-channel (lambda (y) (- y (* 0.5 (oscil gen1)))))
- (if (> (maxamp) .004) (snd-display ";ssb-am cancelled: ~A" (maxamp)))
+ (if (> (maxamp) .004) (snd-display #__line__ ";ssb-am cancelled: ~A" (maxamp)))
(undo 3)
(set! gen (make-ssb-am 100.0 100))
(map-channel (lambda (y) (ssb-am gen y (hz->radians 50.0))))
(delete-samples 0 180)
(set! gen1 (make-oscil 370.0 :initial-phase (asin (* 2 (sample 0))))) ; depends on rising side
(map-channel (lambda (y) (- y (* 0.5 (oscil gen1)))))
- (if (> (maxamp) .004) (snd-display ";ssb-am fm cancelled: ~A" (maxamp)))
+ (if (> (maxamp) .004) (snd-display #__line__ ";ssb-am fm cancelled: ~A" (maxamp)))
(close-sound ind)))
(if (defined? 'mus-ssb-bank)
@@ -25661,57 +25745,57 @@ EDITS: 2
(delete-samples 0 217)
(let ((gen1 (make-oscil 882.0 :initial-phase (asin (sample 0)))))
(map-channel (lambda (y) (- y (oscil gen1))))
- (if (> (maxamp) .04) (snd-display ";ssb-bank cancelled: ~A" (maxamp))))
+ (if (> (maxamp) .04) (snd-display #__line__ ";ssb-bank cancelled: ~A" (maxamp))))
(close-sound ind))
(if *output*
(begin
- (snd-display ";*output* ~A")
+ (snd-display #__line__ ";*output* ~A")
(set! *output* #f)))
(let ((nind (new-sound "fmv.snd" mus-aifc mus-bshort 22050 1 "this is a comment")))
(time (mix-vct (with-temp-sound (:output (make-vct 22050)) (fm-violin 0 1 440 .1)) 0 nind 0))
- (play-and-wait 0 nind)
+ (play nind :wait #t)
(save-sound nind)
- (if (not (sound? nind)) (snd-display ";save sound clobbered ~A?" nind))
+ (if (not (sound? nind)) (snd-display #__line__ ";save sound clobbered ~A?" nind))
(let ((oboe-index (or (find-sound "oboe.snd") (open-sound "oboe.snd"))))
- (if (equal? oboe-index nind) (snd-display ";find-sound found bogus case: ~A" oboe-index))
+ (if (equal? oboe-index nind) (snd-display #__line__ ";find-sound found bogus case: ~A" oboe-index))
(cnvtest oboe-index nind .1)
(select-sound nind)
(select-channel 0)
- (if (not (equal? (selected-sound) nind)) (snd-display ";selected-sound: ~A?" (selected-sound)))
- (if (not (= (selected-channel) 0)) (snd-display ";selected-channel: ~A?" (selected-channel)))
+ (if (not (equal? (selected-sound) nind)) (snd-display #__line__ ";selected-sound: ~A?" (selected-sound)))
+ (if (not (= (selected-channel) 0)) (snd-display #__line__ ";selected-channel: ~A?" (selected-channel)))
(snd-test-jc-reverb 1.0 #f .1 #f)
- (play-and-wait 0 nind)
+ (play nind :wait #t)
(voiced->unvoiced 1.0 256 2.0 2.0)
(pulse-voice 80 20.0 1.0 1024 0.01)
(map-chan (fltit))
(close-sound oboe-index))
- (if (not (sound? nind)) (snd-display ";close sound clobbered ~A?" nind))
+ (if (not (sound? nind)) (snd-display #__line__ ";close sound clobbered ~A?" nind))
(let ((fr (frames nind 0)))
(do ((k 0 (+ 1 k)))
((= k 10))
(delete-samples 10 100 nind 0)
(save-sound nind)) ;flush out memory leaks here
(if (not (= (frames nind 0) (- fr 1000)))
- (snd-display ";delete-samples: ~A ~A" fr (frames nind 0))))
+ (snd-display #__line__ ";delete-samples: ~A ~A" fr (frames nind 0))))
(revert-sound nind)
(close-sound nind))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(let ((nind (new-sound "fmv.snd")))
(if (not (= (header-type nind) (default-output-header-type)))
- (snd-display ";new-sound default header-type: ~A ~A?"
+ (snd-display #__line__ ";new-sound default header-type: ~A ~A?"
(mus-header-type-name (header-type nind))
(mus-header-type-name (default-output-header-type))))
(if (not (= (data-format nind) (default-output-data-format)))
- (snd-display ";new-sound default data-format: ~A ~A?"
+ (snd-display #__line__ ";new-sound default data-format: ~A ~A?"
(mus-data-format-name (data-format nind))
(mus-data-format-name (default-output-data-format))))
(if (not (= (chans nind) (default-output-chans)))
- (snd-display ";new-sound default chans: ~A ~A?" (chans nind) (default-output-chans)))
+ (snd-display #__line__ ";new-sound default chans: ~A ~A?" (chans nind) (default-output-chans)))
(if (not (= (srate nind) (default-output-srate)))
- (snd-display ";new-sound default srate: ~A ~A?" (srate nind) (default-output-srate)))
+ (snd-display #__line__ ";new-sound default srate: ~A ~A?" (srate nind) (default-output-srate)))
(close-sound nind)
(if (file-exists? "fmv.snd") (delete-file "fmv.snd")))
(let ((nind (new-sound "fmv.snd" mus-nist mus-bshort 22050 1 "this is a comment")))
@@ -25719,7 +25803,7 @@ EDITS: 2
(start-progress-report nind)
(convolve-with "oboe.snd")
(progress-report .1 nind)
- (if (fneq (sample 1000) 0.223) (snd-display ";convolve-with: ~A?" (sample 1000)))
+ (if (fneq (sample 1000) 0.223) (snd-display #__line__ ";convolve-with: ~A?" (sample 1000)))
(progress-report .3 nind)
(revert-sound nind)
(progress-report .5 nind)
@@ -25729,44 +25813,42 @@ EDITS: 2
(smooth-sound 0 100)
(finish-progress-report nind)
(if (or (fneq (sample 50) .5) (fneq (sample 30) 0.20608) (fneq (sample 90) 0.9755))
- (snd-display ";smooth: ~A ~A ~A?" (sample 50) (sample 30) (sample 90)))
+ (snd-display #__line__ ";smooth: ~A ~A ~A?" (sample 50) (sample 30) (sample 90)))
(undo)
(set! (sinc-width) 40)
(set! (sample 100) 0.5)
- (if (fneq (sample 100) 0.5) (snd-display ";set-sample 100: ~A?" (sample 100)))
+ (if (fneq (sample 100) 0.5) (snd-display #__line__ ";set-sample 100: ~A?" (sample 100)))
(src-sound .1)
(if (or (fneq (sample 1000) 0.5) (fneq (sample 1024) 0.0625) (fneq (sample 1010) 0.0))
- (snd-display ";src-sound: ~A ~A ~A?" (sample 1000) (sample 1024) (sample 1010)))
+ (snd-display #__line__ ";src-sound: ~A ~A ~A?" (sample 1000) (sample 1024) (sample 1010)))
(revert-sound)
(close-sound nind))
(let ((nind (new-sound "fmv.snd" mus-riff mus-lshort 22050 1 "this is a comment" 22050)))
- (if (not (= (frames nind) 22050)) (snd-display "; new-sound initial-length: ~A" (frames nind)))
+ (if (not (= (frames nind) 22050)) (snd-display #__line__ "; new-sound initial-length: ~A" (frames nind)))
(mix "pistol.snd")
(map-chan (expsrc 2.0 nind))
- ;(play-and-wait 0 nind)
(undo)
(let ((eds (edits)))
(if (or (not (= (car eds) 1)) (not (= (cadr eds) 1)))
- (snd-display ";undo edits: ~A?" eds))
+ (snd-display #__line__ ";undo edits: ~A?" eds))
(if (not (= (edit-position) (car eds)))
- (snd-display ";undo edit-position: ~A ~A?" (edit-position) eds)))
+ (snd-display #__line__ ";undo edit-position: ~A ~A?" (edit-position) eds)))
(expsnd '(0 1 2 .4))
(map-chan (comb-chord .95 100 .3))
(map-chan (formants .99 900 .02 1800 .01 2700))
(map-chan (moving-formant .99 '(0 1200 1 2400)))
(scale-to .3)
- ;(play-and-wait 0)
(let ((eds (edits)))
(if (or (not (= (car eds) 6)) (not (= (cadr eds) 0)))
- (snd-display ";edits(6): ~A?" eds))
+ (snd-display #__line__ ";edits(6): ~A?" eds))
(if (not (= (edit-position) (car eds)))
- (snd-display ";edit-position(6): ~A ~A?" (edit-position) eds)))
+ (snd-display #__line__ ";edit-position(6): ~A ~A?" (edit-position) eds)))
(set! (edit-position) 1)
(if (not (= (edit-position) 1))
- (snd-display ";set edit-position(1) ~A?" (edit-position)))
+ (snd-display #__line__ ";set edit-position(1) ~A?" (edit-position)))
(set! (edit-position) 4)
(if (not (= (edit-position) 4))
- (snd-display ";set edit-position(4): ~A?" (edit-position)))
+ (snd-display #__line__ ";set edit-position(4): ~A?" (edit-position)))
(revert-sound nind)
(mix "pistol.snd")
(map-chan (zecho .5 .75 6 10.0) 0 65000)
@@ -25776,29 +25858,26 @@ EDITS: 2
(key (char->integer #\x) 4)
(key (char->integer #\c) 0) ; trigger mark-define-region
(reverse-sound nind)
- ;(play-and-wait 0 nind)
(revert-sound nind)
(let ((mid (mix-sound "pistol.snd" 0)))
(if (and (mix? mid)
(not (equal? (mix-home mid) (list (selected-sound) 0 #f 0))))
- (snd-display ";mix-sound mix-home: ~A" (mix-home mid))))
+ (snd-display #__line__ ";mix-sound mix-home: ~A" (mix-home mid))))
(hello-dentist 40.0 .1)
(fp 1.0 .3 20)
- ;(play-and-wait 0 nind)
(revert-sound nind)
(enveloped-mix "oboe.snd" 0 '(0 0 1 1 2 0))
(if all-args (pvoc :pitch 0.5 :time 1.0 :snd nind))
- ;(play-and-wait 0 nind)
(revert-sound nind)
(close-sound nind))
-
+
(if (and all-args (defined? 'edot-product))
(let* ((ind (open-sound "1a.snd"))
(len (frames ind 0)))
(stretch-sound-via-dft 2.0 ind 0)
(let ((new-len (frames ind 0)))
(if (> (abs (- (* 2 len) new-len)) 10)
- (snd-display ";stretch-sound-via-dft: ~A ~A" len new-len)))
+ (snd-display #__line__ ";stretch-sound-via-dft: ~A ~A" len new-len)))
(close-sound ind)))
(let ((make-mix-output (lambda (name i)
@@ -25847,14 +25926,14 @@ EDITS: 2
((or (not happy) (= i 12)))
(if (fneq (vct-ref v0 i) (+ 0.1 (* i .01)))
(begin
- (snd-display ";~D mus-mix(1->1): ~A?" k v0)
+ (snd-display #__line__ ";~D mus-mix(1->1): ~A?" k v0)
(set! happy #f)))))
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 3 9 0 (make-mixer 2 0.3 0.0 0.7 0.0))
(file->array "fmv.snd" 0 0 12 v0)
- (if (or (fneq (vct-ref v0 0) .1) (fneq (vct-ref v0 3) .33) (fneq (vct-ref v0 9) .19)) (snd-display ";~D mus-mix(2->1): ~A?" k v0))
+ (if (or (fneq (vct-ref v0 0) .1) (fneq (vct-ref v0 3) .33) (fneq (vct-ref v0 9) .19)) (snd-display #__line__ ";~D mus-mix(2->1): ~A?" k v0))
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv3.snd" k))
(file->array "fmv.snd" 0 0 12 v0)
- (if (or (fneq (vct-ref v0 0) .4) (fneq (vct-ref v0 3) .33)) (snd-display ";~D mus-mix(4->1): ~A?" k v0))
+ (if (or (fneq (vct-ref v0 0) .4) (fneq (vct-ref v0 3) .33)) (snd-display #__line__ ";~D mus-mix(4->1): ~A?" k v0))
(let ((e0 (make-env '(0 0 1 1) :length 11))
(vf (make-vector 1))
(vf1 (make-vector 1)))
@@ -25862,7 +25941,7 @@ EDITS: 2
(vector-set! vf1 0 e0)
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k) 0 12 0 (make-mixer 1 1.0) vf)
(file->array "fmv.snd" 0 0 12 v0)
- (if (or (fneq (vct-ref v0 0) .4) (fneq (vct-ref v0 3) .360) (fneq (vct-ref v0 9) .28)) (snd-display ";~D mus-mix(env): ~A?" k v0))
+ (if (or (fneq (vct-ref v0 0) .4) (fneq (vct-ref v0 3) .360) (fneq (vct-ref v0 9) .28)) (snd-display #__line__ ";~D mus-mix(env): ~A?" k v0))
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (make-mixer 2 1.0 1.0 1.0 1.0) vf))
;; clm2xen should protect us here
(let ((vf (make-vector 2))
@@ -25879,7 +25958,7 @@ EDITS: 2
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (make-mixer 2 1.0 1.0 1.0 1.0) vf))
(lambda args (car args)))))
(if (not (eq? tag 'bad-type))
- (snd-display ";~D mix w oscil-vect: ~A" k tag)))
+ (snd-display #__line__ ";~D mix w oscil-vect: ~A" k tag)))
(vector-set! vf 0 vf1)
(vector-set! vf 1 vf2)
(let ((tag (catch #t
@@ -25889,19 +25968,19 @@ EDITS: 2
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (make-mixer 2 1.0 1.0 1.0 1.0) vf))
(lambda args (car args)))))
(if (not (eq? tag 'bad-type))
- (snd-display ";~D mix w oscil-env: ~A" k tag))))
+ (snd-display #__line__ ";~D mix w oscil-env: ~A" k tag))))
(delete-file "fmv.snd")
(do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! v0 i (* i .01)))
(array->file "fmv.snd" v0 12 22050 4)
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k))
(file->array "fmv.snd" 0 0 3 v0) ; chan 0 start 0 len 3
- (if (or (fneq (vct-ref v0 0) .1) (fneq (vct-ref v0 2) .18)) (snd-display ";~D mus-mix(1->4): ~A?" k v0))
+ (if (or (fneq (vct-ref v0 0) .1) (fneq (vct-ref v0 2) .18)) (snd-display #__line__ ";~D mus-mix(1->4): ~A?" k v0))
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 3 0 (make-mixer 2 0.3 0.0 0.7 0.0))
(file->array "fmv.snd" 0 0 3 v0)
- (if (or (fneq (vct-ref v0 0) .3) (fneq (vct-ref v0 2) .38)) (snd-display ";~D mus-mix(2->4): ~A?" k v0))
+ (if (or (fneq (vct-ref v0 0) .3) (fneq (vct-ref v0 2) .38)) (snd-display #__line__ ";~D mus-mix(2->4): ~A?" k v0))
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv3.snd" k) 0 2 0)
(file->array "fmv.snd" 0 0 3 v0)
- (if (or (fneq (vct-ref v0 0) .6) (fneq (vct-ref v0 2) .38)) (snd-display ";~D mus-mix(4->4): ~A?" k v0)))
+ (if (or (fneq (vct-ref v0 0) .6) (fneq (vct-ref v0 2) .38)) (snd-display #__line__ ";~D mus-mix(4->4): ~A?" k v0)))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(let ((v0 (make-vct 12))
@@ -25920,7 +25999,7 @@ EDITS: 2
(ind-mix (open-sound "fmv.snd")))
(if (not (vequal (samples->vct 1000 10 ind-oboe)
(vct-scale! (samples->vct 1000 10 ind-mix) (/ 1.0 2.5))))
- (snd-display ";~D mus-mix 1 chan: ~A ~A" k
+ (snd-display #__line__ ";~D mus-mix 1 chan: ~A ~A" k
(samples->vct 1000 10 ind-oboe)
(samples->vct 1000 10 ind-mix)))
(close-sound ind-oboe)
@@ -25930,7 +26009,7 @@ EDITS: 2
(len (mus-sound-frames "2.snd")))
(array->file "fmv.snd" v0 12 22050 2)
(if (not (= (mus-sound-chans "fmv.snd") 2))
- (snd-display ";~D array->file chans? ~A" k (mus-sound-chans "fmv.snd")))
+ (snd-display #__line__ ";~D array->file chans? ~A" k (mus-sound-chans "fmv.snd")))
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k))
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k) 0 len 0 (make-mixer 2 0.5 0.0 0.0 0.5))
(let* ((egen0 (make-vector 2))
@@ -25943,10 +26022,10 @@ EDITS: 2
(mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k) 0 len 0 #f outv))
(let ((ind-mix (open-sound "fmv.snd")))
(if (not (= (channels ind-mix) 2))
- (snd-display ";~D fmv re-read chans? ~A ~A" k (mus-sound-chans "fmv.snd") (channels ind-mix)))
+ (snd-display #__line__ ";~D fmv re-read chans? ~A ~A" k (mus-sound-chans "fmv.snd") (channels ind-mix)))
(if (not (vequal (samples->vct 1000 10 ind-mix 0)
(vct 0.003 0.010 0.012 0.011 0.008 0.004 0.002 0.002 0.007 0.017)))
- (snd-display ";~D mus-mix 2 chan (2.snd written: ~A): ~A ~A" k
+ (snd-display #__line__ ";~D mus-mix 2 chan (2.snd written: ~A): ~A ~A" k
(strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "2.snd")))
(samples->vct 1000 10 ind-mix 0)
(samples->vct 1000 10 ind-mix 1)))
@@ -25957,9 +26036,9 @@ EDITS: 2
(let* ((gen (make-phase-vocoder #f 512 4 256 1.0 #f #f #f))
(val (catch #t (lambda () (phase-vocoder gen)) (lambda args (car args)))))
- (if (fneq val 0.0) (snd-display ";simple no-in pv call: ~A" val))
+ (if (fneq val 0.0) (snd-display #__line__ ";simple no-in pv call: ~A" val))
(set! val (catch #t (lambda () (set! gen (make-phase-vocoder :fft-size 1234))) (lambda args (car args))))
- (if (not (equal? val 'out-of-range)) (snd-display ";pv bad fft: ~A" val))
+ (if (not (equal? val 'out-of-range)) (snd-display #__line__ ";pv bad fft: ~A" val))
)
(let* ((ind (open-sound "oboe.snd"))
@@ -25971,12 +26050,12 @@ EDITS: 2
#f ;no change to synthesis
))
(reader (make-sampler 0)))
- (if (not (phase-vocoder? pv)) (snd-display ";~A not phase-vocoder?" pv))
+ (if (not (phase-vocoder? pv)) (snd-display #__line__ ";~A not phase-vocoder?" pv))
(print-and-check pv
"phase-vocoder"
"phase-vocoder outctr: 128, interp: 128, filptr: 0, N: 512, D: 128, in_data: nil")
(let ((val (let ((pv (make-phase-vocoder))) (set! (mus-location pv) 120) (mus-location pv))))
- (if (not (= val 120)) (snd-display ";pv set outctr: ~A" val)))
+ (if (not (= val 120)) (snd-display #__line__ ";pv set outctr: ~A" val)))
(select-sound ind)
(map-chan (lambda (val)
@@ -25984,19 +26063,19 @@ EDITS: 2
(next-sample reader)))))
(vct-set! (phase-vocoder-amp-increments pv) 0 .1)
(if (fneq (vct-ref (phase-vocoder-amp-increments pv) 0) .1)
- (snd-display ";set phase-vocoder-amp-increments: ~A?" (vct-ref (phase-vocoder-amp-increments pv) 0)))
+ (snd-display #__line__ ";set phase-vocoder-amp-increments: ~A?" (vct-ref (phase-vocoder-amp-increments pv) 0)))
(vct-set! (phase-vocoder-amps pv) 0 .1)
(if (fneq (vct-ref (phase-vocoder-amps pv) 0) .1)
- (snd-display ";set phase-vocoder-amps: ~A?" (vct-ref (phase-vocoder-amps pv) 0)))
+ (snd-display #__line__ ";set phase-vocoder-amps: ~A?" (vct-ref (phase-vocoder-amps pv) 0)))
(vct-set! (phase-vocoder-phases pv) 0 .1)
(if (fneq (vct-ref (phase-vocoder-phases pv) 0) .1)
- (snd-display ";set phase-vocoder-phases: ~A?" (vct-ref (phase-vocoder-phases pv) 0)))
+ (snd-display #__line__ ";set phase-vocoder-phases: ~A?" (vct-ref (phase-vocoder-phases pv) 0)))
(vct-set! (phase-vocoder-phase-increments pv) 0 .1)
(if (fneq (vct-ref (phase-vocoder-phase-increments pv) 0) .1)
- (snd-display ";set phase-vocoder-phase-increments: ~A?" (vct-ref (phase-vocoder-phase-increments pv) 0)))
+ (snd-display #__line__ ";set phase-vocoder-phase-increments: ~A?" (vct-ref (phase-vocoder-phase-increments pv) 0)))
(vct-set! (phase-vocoder-freqs pv) 0 .1)
(if (fneq (vct-ref (phase-vocoder-freqs pv) 0) .1)
- (snd-display ";set phase-vocoder-freqs: ~A?" (vct-ref (phase-vocoder-freqs pv) 0)))
+ (snd-display #__line__ ";set phase-vocoder-freqs: ~A?" (vct-ref (phase-vocoder-freqs pv) 0)))
(undo 1)
(free-sampler reader)
(let ((lastphases (make-vct 512)))
@@ -26006,22 +26085,22 @@ EDITS: 2
(lambda (v)
; new editing func changes pitch
(run
- (let* ((N (mus-length v)) ;mus-increment => interp, mus-data => in-data
- (D (mus-hop v))
- (freqs (phase-vocoder-freqs v)))
- (do ((k 0 (+ 1 k))
- (pscl (/ 1.0 D))
- (kscl (/ pi2 N)))
- ((= k (inexact->exact (floor (/ N 2)))))
- (let ((phasediff (- (vct-ref freqs k) (vct-ref lastphases k))))
- (vct-set! lastphases k (vct-ref freqs k))
- (if (> phasediff pi) (do () ((<= phasediff pi)) (set! phasediff (- phasediff pi2))))
- (if (< phasediff (- pi)) (do () ((>= phasediff (- pi))) (set! phasediff (+ phasediff pi2))))
- (vct-set! freqs k
- (* 0.5
- (+ (* pscl phasediff)
- (* k kscl))))))
- #f)))
+ (let* ((N (mus-length v)) ;mus-increment => interp, mus-data => in-data
+ (D (mus-hop v))
+ (freqs (phase-vocoder-freqs v)))
+ (do ((k 0 (+ 1 k))
+ (pscl (/ 1.0 D))
+ (kscl (/ pi2 N)))
+ ((= k (floor (/ N 2))))
+ (let ((phasediff (- (vct-ref freqs k) (vct-ref lastphases k))))
+ (vct-set! lastphases k (vct-ref freqs k))
+ (if (> phasediff pi) (do () ((<= phasediff pi)) (set! phasediff (- phasediff pi2))))
+ (if (< phasediff (- pi)) (do () ((>= phasediff (- pi))) (set! phasediff (+ phasediff pi2))))
+ (vct-set! freqs k
+ (* 0.5
+ (+ (* pscl phasediff)
+ (* k kscl))))))
+ #f)))
#f ; no change to synthesis
))
(set! reader (make-sampler 0))
@@ -26031,13 +26110,13 @@ EDITS: 2
(undo 1)
(free-sampler reader)
(set! pv (make-phase-vocoder #f
- 512 4 (inexact->exact (* 128 2.0)) 1.0
+ 512 4 (* 128 2) 1.0
#f ;no change to analysis
#f ;no change to edits
#f ;no change to synthesis
))
(set! reader (make-sampler 0))
- (let* ((len (inexact->exact (* 2.0 (frames ind))))
+ (let* ((len (* 2 (frames ind)))
(data (make-vct len)))
(vct-map! data
(lambda ()
@@ -26049,7 +26128,7 @@ EDITS: 2
(let ((incalls 0)
(outcalls 0))
(set! pv (make-phase-vocoder #f
- 512 4 (inexact->exact (* 128 2.0)) 1.0
+ 512 4 (* 128 2) 1.0
(lambda (v infunc)
(set! incalls (+ incalls 1))
#t)
@@ -26059,7 +26138,7 @@ EDITS: 2
0.0)
))
(set! reader (make-sampler 0))
- (let* ((len (inexact->exact (* 2.0 (frames ind))))
+ (let* ((len (* 2 (frames ind)))
(data (make-vct len)))
(vct-map! data
(lambda ()
@@ -26069,47 +26148,47 @@ EDITS: 2
(free-sampler reader)
(if (or (= incalls 0)
(= outcalls 0))
- (snd-display ";phase-vocoder incalls: ~A, outcalls: ~A" incalls outcalls))
+ (snd-display #__line__ ";phase-vocoder incalls: ~A, outcalls: ~A" incalls outcalls))
(set! (mus-location pv) (mus-location pv))
(let ((tag (catch #t (lambda () (phase-vocoder pv (lambda (a b) a))) (lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display ";phase-vocoder bad func: ~A" tag))))
+ (snd-display #__line__ ";phase-vocoder bad func: ~A" tag))))
(let ((tag (catch #t
(lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b c) #f) #f #f))
(lambda args args))))
- (if (not (eq? (car tag) 'bad-arity)) (snd-display ";make-phase-vocoder bad analyze func: ~A" tag)))
+ (if (not (eq? (car tag) 'bad-arity)) (snd-display #__line__ ";make-phase-vocoder bad analyze func: ~A" tag)))
(let ((tag (catch #t
(lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b) 0.0) (lambda (a b c) #f) #f))
(lambda args args))))
- (if (not (eq? (car tag) 'bad-arity)) (snd-display ";make-phase-vocoder bad edit func: ~A" tag)))
+ (if (not (eq? (car tag) 'bad-arity)) (snd-display #__line__ ";make-phase-vocoder bad edit func: ~A" tag)))
(let ((tag (catch #t
(lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b) 0.0) (lambda (a) #f) (lambda (a b) 0)))
(lambda args args))))
- (if (not (eq? (car tag) 'bad-arity)) (snd-display ";make-phase-vocoder bad synthesize func: ~A" tag)))
+ (if (not (eq? (car tag) 'bad-arity)) (snd-display #__line__ ";make-phase-vocoder bad synthesize func: ~A" tag)))
(let ((geno (make-phase-vocoder (lambda (dir) 0.0))))
(let ((genx (make-phase-vocoder :input (lambda (dir) 0.0))))
- (if (equal? geno genx) (snd-display ";phase-vocoder equal? ~A ~A" geno genx))
- (if (fneq (mus-frequency genx) 1.0) (snd-display ";mus-frequency phase-vocoder: ~A" (mus-frequency genx)))
+ (if (equal? geno genx) (snd-display #__line__ ";phase-vocoder equal? ~A ~A" geno genx))
+ (if (fneq (mus-frequency genx) 1.0) (snd-display #__line__ ";mus-frequency phase-vocoder: ~A" (mus-frequency genx)))
(set! (mus-frequency genx) 2.0)
- (if (fneq (mus-frequency genx) 2.0) (snd-display ";set mus-frequency phase-vocoder: ~A" (mus-frequency genx)))
- (if (fneq (mus-increment genx) 128) (snd-display ";mus-increment phase-vocoder: ~A" (mus-increment genx)))
+ (if (fneq (mus-frequency genx) 2.0) (snd-display #__line__ ";set mus-frequency phase-vocoder: ~A" (mus-frequency genx)))
+ (if (fneq (mus-increment genx) 128) (snd-display #__line__ ";mus-increment phase-vocoder: ~A" (mus-increment genx)))
(set! (mus-increment genx) 256)
- (if (fneq (mus-increment genx) 256) (snd-display ";set mus-increment phase-vocoder: ~A" (mus-increment genx)))
- (if (not (= (mus-hop genx) 128)) (snd-display ";phase vocoder hop: ~A" (mus-hop genx)))
+ (if (fneq (mus-increment genx) 256) (snd-display #__line__ ";set mus-increment phase-vocoder: ~A" (mus-increment genx)))
+ (if (not (= (mus-hop genx) 128)) (snd-display #__line__ ";phase vocoder hop: ~A" (mus-hop genx)))
(set! (mus-hop genx) 64)
- (if (not (= (mus-hop genx) 64)) (snd-display ";set phase vocoder hop: ~A" (mus-hop genx)))
- (if (not (= (mus-length genx) 512)) (snd-display ";phase vocoder length: ~A" (mus-length genx)))
+ (if (not (= (mus-hop genx) 64)) (snd-display #__line__ ";set phase vocoder hop: ~A" (mus-hop genx)))
+ (if (not (= (mus-length genx) 512)) (snd-display #__line__ ";phase vocoder length: ~A" (mus-length genx)))
(let ((genxx genx))
- (if (not (equal? genx genxx)) (snd-display ";phase-vocoder equal: ~A ~A" genxx genx)))))
+ (if (not (equal? genx genxx)) (snd-display #__line__ ";phase-vocoder equal: ~A ~A" genxx genx)))))
(close-sound ind))
(let ((ind (open-sound "oboe.snd")))
(let ((gen (make-moog-filter 500.0 .1)))
- (if (fneq 500.0 (moog-frequency gen)) (snd-display ";moog freq: ~A" (moog-frequency gen)))
- (if (fneq .1 (moog-Q gen)) (snd-display ";moog Q: ~A" (moog-Q gen)))
- (if (not (vct? (moog-s gen))) (snd-display ";moog state: ~A" (moog-s gen)))
- (if (fneq 0.0 (moog-y gen)) (snd-display ";moog A? ~A" (moog-y gen)))
- (if (fneq -0.861 (moog-fc gen)) (snd-display ";moog freqtable: ~A" (moog-fc gen)))
+ (if (fneq 500.0 (moog-frequency gen)) (snd-display #__line__ ";moog freq: ~A" (moog-frequency gen)))
+ (if (fneq .1 (moog-Q gen)) (snd-display #__line__ ";moog Q: ~A" (moog-Q gen)))
+ (if (not (vct? (moog-s gen))) (snd-display #__line__ ";moog state: ~A" (moog-s gen)))
+ (if (fneq 0.0 (moog-y gen)) (snd-display #__line__ ";moog A? ~A" (moog-y gen)))
+ (if (fneq -0.861 (moog-fc gen)) (snd-display #__line__ ";moog freqtable: ~A" (moog-fc gen)))
(let ((vals (make-vct 20)))
(vct-set! vals 0 (moog-filter gen 1.0))
(do ((i 1 (+ 1 i)))
@@ -26117,7 +26196,7 @@ EDITS: 2
(vct-set! vals i (moog-filter gen 0.0)))
(if (not (vequal vals (vct 0.0 0.0 0.0025 0.0062 0.0120 0.0198 0.0292 0.0398 0.0510 0.0625
0.0739 0.0847 0.0946 0.1036 0.1113 0.1177 0.1228 0.1266 0.1290 0.1301)))
- (snd-display ";moog output: ~A" vals))))
+ (snd-display #__line__ ";moog output: ~A" vals))))
(close-sound ind))
(let ((gen (make-ssb-am 440.0))
@@ -26133,17 +26212,17 @@ EDITS: 2
((= i 10))
(vct-set! v0 i (ssb-am gen 0.0)))
(vct-map! v1 (lambda () (if (ssb-am? gen1) (ssb-am gen1 0.0) -1.0)))
- (if (not (vequal v0 v1)) (snd-display ";map ssb-am: ~A ~A" v0 v1))
- (if (not (ssb-am? gen)) (snd-display ";~A not ssb-am?" gen))
- (if (fneq (mus-phase gen) 1.253787) (snd-display ";ssb-am phase: ~F?" (mus-phase gen)))
- (if (fneq (mus-frequency gen) 440.0) (snd-display ";ssb-am frequency: ~F?" (mus-frequency gen)))
- (if (not (= (mus-order gen) 41)) (snd-display ";ssb-am order: ~F?" (mus-order gen)))
- (if (not (= (mus-length gen) 41)) (snd-display ";ssb-am length: ~D?" (mus-length gen)))
- (if (not (= (mus-interp-type gen) mus-interp-none)) (snd-display ";ssb-am interp type: ~D?" (mus-interp-type gen)))
- (if (fneq (mus-xcoeff gen 0) -0.00124) (snd-display ";ssb-am xcoeff 0: ~A" (mus-xcoeff gen 0)))
- (if (fneq (mus-xcoeff gen 1) 0.0) (snd-display ";ssb-am xcoeff 1: ~A" (mus-xcoeff gen 1)))
- ; (if (not (vct? (mus-data gen))) (snd-display ";mus-data ssb-am: ~A" (mus-data gen)))
- ; (if (not (vct? (mus-xcoeffs gen))) (snd-display ";mus-xcoeffs ssb-am: ~A" (mus-xcoeffs gen)))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";map ssb-am: ~A ~A" v0 v1))
+ (if (not (ssb-am? gen)) (snd-display #__line__ ";~A not ssb-am?" gen))
+ (if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";ssb-am phase: ~F?" (mus-phase gen)))
+ (if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";ssb-am frequency: ~F?" (mus-frequency gen)))
+ (if (not (= (mus-order gen) 41)) (snd-display #__line__ ";ssb-am order: ~F?" (mus-order gen)))
+ (if (not (= (mus-length gen) 41)) (snd-display #__line__ ";ssb-am length: ~D?" (mus-length gen)))
+ (if (not (= (mus-interp-type gen) mus-interp-none)) (snd-display #__line__ ";ssb-am interp type: ~D?" (mus-interp-type gen)))
+ (if (fneq (mus-xcoeff gen 0) -0.00124) (snd-display #__line__ ";ssb-am xcoeff 0: ~A" (mus-xcoeff gen 0)))
+ (if (fneq (mus-xcoeff gen 1) 0.0) (snd-display #__line__ ";ssb-am xcoeff 1: ~A" (mus-xcoeff gen 1)))
+ ; (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data ssb-am: ~A" (mus-data gen)))
+ ; (if (not (vct? (mus-xcoeffs gen))) (snd-display #__line__ ";mus-xcoeffs ssb-am: ~A" (mus-xcoeffs gen)))
;; these apparently aren't handled in clm2xen
)
@@ -26159,7 +26238,7 @@ EDITS: 2
(o2o (ssb-am-1 o2 inval)))
(if (fneq o1o o2o)
(begin
- (snd-display ";ssb-am (up): ~A ~A at ~A" o1o o2o i)
+ (snd-display #__line__ ";ssb-am (up): ~A ~A at ~A" o1o o2o i)
(set! happy #f))))))
(let ((o1 (make-ssb-am 400.0))
@@ -26173,7 +26252,7 @@ EDITS: 2
(o2o (ssb-am-1 o2 inval fmval)))
(if (fneq o1o o2o)
(begin
- (snd-display ";ssb-am + fm (up): ~A ~A at ~A" o1o o2o i)
+ (snd-display #__line__ ";ssb-am + fm (up): ~A ~A at ~A" o1o o2o i)
(set! happy #f))))))
(let ((o1 (make-ssb-am -100.0))
@@ -26186,7 +26265,7 @@ EDITS: 2
(o2o (ssb-am-1 o2 inval)))
(if (fneq o1o o2o)
(begin
- (snd-display ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
+ (snd-display #__line__ ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
(set! happy #f))))))
(let ((o1 (make-ssb-am 1000.0 100))
@@ -26199,7 +26278,7 @@ EDITS: 2
(o2o (ssb-am-1 o2 inval)))
(if (fneq o1o o2o)
(begin
- (snd-display ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
+ (snd-display #__line__ ";ssb-am (down): ~A ~A at ~A" o1o o2o i)
(set! happy #f))))))
(let ((index (open-sound "pistol.snd"))
@@ -26208,16 +26287,16 @@ EDITS: 2
(let ((scl (maxamp)))
(convolve-with "oboe.snd" scl index 0 0)
(if (ffneq (maxamp) scl)
- (snd-display ";convolve-with amps: ~A ~A" (maxamp) scl)))
+ (snd-display #__line__ ";convolve-with amps: ~A ~A" (maxamp) scl)))
(revert-sound index)
(agc)
- (if (fneq (maxamp index 0) 1.29) (snd-display ";agc: ~A" (maxamp index 0)))
+ (if (fneq (maxamp index 0) 1.29) (snd-display #__line__ ";agc: ~A" (maxamp index 0)))
(close-sound index)
(let ((reader (make-sampler 0 "pistol.snd")))
(do ((i 0 (+ 1 i)))
((= i 10))
(if (fneq (vct-ref data i) (next-sample reader))
- (snd-display ";external reader trouble")))
+ (snd-display #__line__ ";external reader trouble")))
(free-sampler reader)))
(let ((make-procs (list
@@ -26274,28 +26353,28 @@ EDITS: 2
(for-each
(lambda (make runp ques arg name)
(let ((gen (make)))
- (if (not (ques gen)) (snd-display ";~A: ~A -> ~A?" name make gen))
+ (if (not (ques gen)) (snd-display #__line__ ";~A: ~A -> ~A?" name make gen))
(let ((tag (catch #t (lambda () (if arg (runp gen arg) (runp gen))) (lambda args args))))
(if (and (not (number? tag))
(not (frame? tag)))
- (snd-display ";~A: ~A ~A ~A: ~A" name runp gen arg tag)))
+ (snd-display #__line__ ";~A: ~A ~A ~A: ~A" name runp gen arg tag)))
(for-each
(lambda (func genname)
(let ((tag (catch #t (lambda () (func #f)) (lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";generic func with #f: (~A #f) -> ~A" genname tag)))
+ (snd-display #__line__ ";generic func with #f: (~A #f) -> ~A" genname tag)))
(let ((g1 (make-oscil))
(g2 (make-one-pole .1 .9)))
(let ((tag (catch #t (lambda () (func g1)) (lambda args (car args)))))
(if (and (symbol? tag)
(not (eq? tag 'wrong-type-arg))
(not (eq? tag 'mus-error)))
- (snd-display ";generic ~A of oscil: ~A" genname tag)))
+ (snd-display #__line__ ";generic ~A of oscil: ~A" genname tag)))
(let ((tag (catch #t (lambda () (func g2)) (lambda args (car args)))))
(if (and (symbol? tag)
(not (eq? tag 'wrong-type-arg))
(not (eq? tag 'mus-error)))
- (snd-display ";generic ~A of delay: ~A" genname tag))))
+ (snd-display #__line__ ";generic ~A of delay: ~A" genname tag))))
(let ((tag (catch #t (lambda () (func gen)) (lambda args (car args)))))
(if (and (not (symbol? tag))
(procedure-with-setter? func)
@@ -26305,7 +26384,7 @@ EDITS: 2
(if (and (symbol? tag1)
(not (eq? tag1 'mus-error))
(not (eq? tag1 'out-of-range)))
- (snd-display ";~A set ~A ~A ~A -> ~A" name genname gen tag tag1))))))
+ (snd-display #__line__ ";~A set ~A ~A ~A -> ~A" name genname gen tag tag1))))))
generic-procs generic-names)
(mus-reset gen)))
make-procs run-procs ques-procs gen-args func-names)
@@ -26375,18 +26454,18 @@ EDITS: 2
(let ((first-val (if (= k 0) (runp gen 1.0) (mus-apply gen 1.0 0.0))))
(if (not (= (vct-ref data 0) 0.0)) (set! not-zero #t))
(if (fneq (vct-ref data 0) first-val)
- (snd-display ";[~A] ~A: ~A ~A ~A" (if (= k 0) 'run 'apply) name 0 (vct-ref data 0) first-val)))
+ (snd-display #__line__ ";[~A] ~A: ~A ~A ~A" (if (= k 0) 'run 'apply) name 0 (vct-ref data 0) first-val)))
(do ((i 1 (+ 1 i)))
((= i 10))
(let ((old-val (vct-ref data i))
(new-val (if (= k 0) (runp gen 0.0) (mus-apply gen 0.0 0.0))))
(if (not (= old-val 0.0)) (set! not-zero #t))
(if (fneq old-val new-val)
- (snd-display ";[~A] ~A: ~A ~A ~A" (if (= k 0) 'run 'apply) name i old-val new-val))))
+ (snd-display #__line__ ";[~A] ~A: ~A ~A ~A" (if (= k 0) 'run 'apply) name i old-val new-val))))
(if (and (not (eq? name 'polyshape))
(not (eq? name 'ssb-am))
(not not-zero))
- (snd-display ";~A not much of a reset test!" name)))))))
+ (snd-display #__line__ ";~A not much of a reset test!" name)))))))
make-procs run-procs func-names))
(if (and all-args (= clmtest 0))
@@ -26454,7 +26533,7 @@ EDITS: 2
(lambda (g name)
(let ((tag (catch #t (lambda () (g :frequency 440.0)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";srate ~A: ~A -> ~A" n name tag))))
+ (snd-display #__line__ ";srate ~A: ~A -> ~A" n name tag))))
(list make-oscil make-asymmetric-fm
make-triangle-wave make-square-wave make-pulse-train make-sawtooth-wave
make-rand make-rand-interp)
@@ -26515,13 +26594,13 @@ EDITS: 2
random-args))
random-args)))))
-
+
(let ((gen (make-moving-max 4)))
(let ((descr (mus-describe gen)))
(if (and (not (string=? descr "moving-max n: 4, gen: #<delay line[4, step]: [0.000 0.000 0.000 0.000]>"))
(not (string=? descr "moving-max n: 4, gen: delay line[4, step]: [0.000 0.000 0.000 0.000]")))
- (snd-display ";moving-max mus-describe: ~A" descr))
- (if (not (string=? (mus-name gen) "moving-max")) (snd-display ";moving-max mus-name: ~A" (mus-name gen))))
+ (snd-display #__line__ ";moving-max mus-describe: ~A" descr))
+ (if (not (string=? (mus-name gen) "moving-max")) (snd-display #__line__ ";moving-max mus-name: ~A" (mus-name gen))))
(let ((ov (make-vct 10))
(iv (vct .1 .05 -.2 .15 -1.5 0.1 0.01 0.001 0.0 0.0))
(tv (vct .1 .1 .2 .2 1.5 1.5 1.5 1.5 0.1 0.01)))
@@ -26529,7 +26608,7 @@ EDITS: 2
((= i 10))
(vct-set! ov i (moving-max gen (vct-ref iv i))))
(if (not (vequal tv ov))
- (snd-display ";moving-max: ~A ~A" ov tv))))
+ (snd-display #__line__ ";moving-max: ~A ~A" ov tv))))
(let ((g1 (make-moving-max 10)))
(do ((i 0 (+ 1 i)))
@@ -26537,35 +26616,35 @@ EDITS: 2
(let ((val (moving-max g1 (random 1.0))))
(let ((pk (vct-peak (mus-data g1))))
(if (not (= pk val))
- (snd-display ";moving-max ~A ~A" pk val))))))
+ (snd-display #__line__ ";moving-max ~A ~A" pk val))))))
(let ((odata (make-vct 15 0.0))
(data (vct 1.0 0.0 -1.1 1.1001 0.1 -1.1 1.0 1.0 0.5 -0.01 0.02 0.0 0.0 0.0 0.0))
(g (make-moving-max 3)))
(do ((i 0 (+ 1 i))) ((= i 15)) (vct-set! odata i (moving-max g (vct-ref data i))))
(if (not (vequal odata (vct 1.000 1.000 1.100 1.100 1.100 1.100 1.100 1.100 1.000 1.000 0.500 0.020 0.020 0.000 0.000)))
- (snd-display ";moving max odata: ~A" odata))
+ (snd-display #__line__ ";moving max odata: ~A" odata))
(if (= (vct-ref odata 4) (vct-ref odata 7))
- (snd-display ";moving-max .0001 offset?"))
+ (snd-display #__line__ ";moving-max .0001 offset?"))
(set! odata (make-vct 15 0.0))
(set! data (vct 0.1 -0.2 0.3 0.4 -0.5 0.6 0.7 0.8 -0.9 1.0 0.0 0.0))
(set! g (make-moving-sum 3))
(do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-sum g (vct-ref data i))))
(if (not (vequal odata (vct 0.100 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700 1.900 1.000 0.000 0.000 0.000)))
- (snd-display ";moving-sum odata: ~A" odata))
+ (snd-display #__line__ ";moving-sum odata: ~A" odata))
(set! odata (make-vct 15 0.0))
(set! g (make-moving-rms 4))
(do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-rms g (vct-ref data i))))
(if (not (vequal odata (vct 0.050 0.112 0.187 0.274 0.367 0.464 0.561 0.660 0.758 0.857 0.783 0.673 0.000 0.000 0.000)))
- (snd-display ";moving-rms odata: ~A" odata))
+ (snd-display #__line__ ";moving-rms odata: ~A" odata))
(set! odata (make-vct 15 0.0))
(set! g (make-moving-length 4))
(do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-length g (vct-ref data i))))
(if (not (vequal odata (vct 0.100 0.224 0.374 0.548 0.735 0.927 1.122 1.319 1.517 1.715 1.565 1.345 0.000 0.000 0.000)))
- (snd-display ";moving-length odata: ~A" odata))
+ (snd-display #__line__ ";moving-length odata: ~A" odata))
(let ((ind (new-sound "test.snd" :size 20)))
(set! (sample 3) 1.0)
@@ -26577,7 +26656,7 @@ EDITS: 2
(map-channel (lambda (y) (fir-filter gen2 y)))
(let ((data2 (channel->vct)))
(if (not (vequal data1 data2))
- (snd-display ";weighted-moving-average and fir:~%; ~A~%: ~A" data1 data2)))
+ (snd-display #__line__ ";weighted-moving-average and fir:~%; ~A~%: ~A" data1 data2)))
(undo)))
(close-sound ind))
@@ -26588,8 +26667,8 @@ EDITS: 2
(let ((descr (mus-describe g)))
(if (and (not (string=? descr "moving-length n: 4, gen: #<moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]>"))
(not (string=? descr "moving-length n: 4, gen: moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")))
- (snd-display ";moving-length mus-describe: ~A" descr))
- (if (not (string=? (mus-name g) "moving-length")) (snd-display ";moving-length mus-name: ~A" (mus-name g))))
+ (snd-display #__line__ ";moving-length mus-describe: ~A" descr))
+ (if (not (string=? (mus-name g) "moving-length")) (snd-display #__line__ ";moving-length mus-name: ~A" (mus-name g))))
(do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-length g (vct-ref data i))))
(do ((i -3 (+ 1 i))
(k 0 (+ 1 k)))
@@ -26599,7 +26678,7 @@ EDITS: 2
((= j 4))
(if (>= (+ i j) 0)
(set! sum (+ sum (* (vct-ref data (+ i j)) (vct-ref data (+ i j)))))))
- (if (fneq (vct-ref odata k) (sqrt sum)) (snd-display ";moving length ran: ~A ~A" (vct-ref odata k) (sqrt sum)))))
+ (if (fneq (vct-ref odata k) (sqrt sum)) (snd-display #__line__ ";moving length ran: ~A ~A" (vct-ref odata k) (sqrt sum)))))
(do ((i 0 (+ 1 i)))
((= i 10))
@@ -26608,8 +26687,8 @@ EDITS: 2
(let ((descr (mus-describe g)))
(if (and (not (string=? descr "moving-sum n: 4, gen: #<moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]>"))
(not (string=? descr "moving-sum n: 4, gen: moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")))
- (snd-display ";moving-sum mus-describe: ~A" descr))
- (if (not (string=? (mus-name g) "moving-sum")) (snd-display ";moving-sum mus-name: ~A" (mus-name g))))
+ (snd-display #__line__ ";moving-sum mus-describe: ~A" descr))
+ (if (not (string=? (mus-name g) "moving-sum")) (snd-display #__line__ ";moving-sum mus-name: ~A" (mus-name g))))
(do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-sum g (vct-ref data i))))
(do ((i -3 (+ 1 i))
(k 0 (+ 1 k)))
@@ -26619,7 +26698,7 @@ EDITS: 2
((= j 4))
(if (>= (+ i j) 0)
(set! sum (+ sum (abs (vct-ref data (+ i j)))))))
- (if (fneq (vct-ref odata k) sum) (snd-display ";moving sum ran: ~A ~A" (vct-ref odata k) sum))))
+ (if (fneq (vct-ref odata k) sum) (snd-display #__line__ ";moving sum ran: ~A ~A" (vct-ref odata k) sum))))
(do ((i 0 (+ 1 i)))
((= i 10))
@@ -26628,8 +26707,8 @@ EDITS: 2
(let ((descr (mus-describe g)))
(if (and (not (string=? descr "moving-rms n: 4, gen: #<moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]>"))
(not (string=? descr "moving-rms n: 4, gen: moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")))
- (snd-display ";moving-rms mus-describe: ~A" descr))
- (if (not (string=? (mus-name g) "moving-rms")) (snd-display ";moving-rms mus-name: ~A" (mus-name g))))
+ (snd-display #__line__ ";moving-rms mus-describe: ~A" descr))
+ (if (not (string=? (mus-name g) "moving-rms")) (snd-display #__line__ ";moving-rms mus-name: ~A" (mus-name g))))
(do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-rms g (vct-ref data i))))
(do ((i -3 (+ 1 i))
(k 0 (+ 1 k)))
@@ -26639,7 +26718,7 @@ EDITS: 2
((= j 4))
(if (>= (+ i j) 0)
(set! sum (+ sum (* (vct-ref data (+ i j)) (vct-ref data (+ i j)))))))
- (if (fneq (vct-ref odata k) (sqrt (/ sum 4))) (snd-display ";moving rms ran: ~A ~A" (vct-ref odata k) (sqrt (/ sum 4)))))))
+ (if (fneq (vct-ref odata k) (sqrt (/ sum 4))) (snd-display #__line__ ";moving rms ran: ~A ~A" (vct-ref odata k) (sqrt (/ sum 4)))))))
(let ((ind (open-sound "oboe.snd")))
(harmonicizer 550.0 (list 1 .5 2 .3 3 .2) 10)
@@ -26656,7 +26735,7 @@ EDITS: 2
(lambda () (apply make arglist))
(lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";long arglist to ~A: ~A" name tag))))
+ (snd-display #__line__ ";long arglist to ~A: ~A" name tag))))
(list make-wave-train make-polyshape make-delay make-moving-average make-comb make-filtered-comb make-notch
make-rand make-rand-interp make-table-lookup make-env
make-readin make-locsig make-granulate make-convolve make-phase-vocoder)
@@ -26667,85 +26746,85 @@ EDITS: 2
(let ((v1 (make-vct 10 .1)))
(let ((g1 (make-table-lookup :wave v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";table-lookup data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";table-lookup data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";table-lookup data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";table-lookup data not eq?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";table-lookup data not eqv?: ~A ~A" v1 (mus-data g1)))
+ (if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";table-lookup data not equal?: ~A ~A" v1 (mus-data g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display ";table-lookup vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
+ (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";table-lookup vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
(vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";table-lookup vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";table-lookup vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
(let ((g1 (make-wave-train :wave v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";wave-train data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";wave-train data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";wave-train data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";wave-train data not eq?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";wave-train data not eqv?: ~A ~A" v1 (mus-data g1)))
+ (if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";wave-train data not equal?: ~A ~A" v1 (mus-data g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display ";wave-train vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
+ (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";wave-train vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
(vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";wave-train vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";wave-train vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
(let ((g1 (make-polyshape :coeffs v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";polyshape data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";polyshape data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";polyshape data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";polyshape data not eq?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";polyshape data not eqv?: ~A ~A" v1 (mus-data g1)))
+ (if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";polyshape data not equal?: ~A ~A" v1 (mus-data g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display ";polyshape vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
+ (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";polyshape vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
(vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";polyshape vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";polyshape vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
(let ((g1 (make-delay :initial-contents v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";delay data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";delay data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";delay data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";delay data not eq?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";delay data not eqv?: ~A ~A" v1 (mus-data g1)))
+ (if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";delay data not equal?: ~A ~A" v1 (mus-data g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display ";delay vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
+ (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";delay vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
(vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";delay vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";delay vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
(let ((g1 (make-filtered-comb :scaler .5 :initial-contents v1 :filter (make-one-zero .1 .2))))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";filtered-comb data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";filtered-comb data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";filtered-comb data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";filtered-comb data not eq?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";filtered-comb data not eqv?: ~A ~A" v1 (mus-data g1)))
+ (if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";filtered-comb data not equal?: ~A ~A" v1 (mus-data g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display ";filtered-comb vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
+ (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";filtered-comb vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
(vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";filtered-comb vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";filtered-comb vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
(let ((g1 (make-rand :distribution v1)))
- (if (not (eq? v1 (mus-data g1))) (snd-display ";rand data not eq?: ~A ~A" v1 (mus-data g1)))
- (if (not (eqv? v1 (mus-data g1))) (snd-display ";rand data not eqv?: ~A ~A" v1 (mus-data g1)))
- (if (not (equal? v1 (mus-data g1))) (snd-display ";rand data not equal?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";rand data not eq?: ~A ~A" v1 (mus-data g1)))
+ (if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";rand data not eqv?: ~A ~A" v1 (mus-data g1)))
+ (if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";rand data not equal?: ~A ~A" v1 (mus-data g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display ";rand vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
+ (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";rand vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
(vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";rand vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";rand vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
(let ((g1 (make-fir-filter :xcoeffs v1)))
- (if (not (eq? v1 (mus-xcoeffs g1))) (snd-display ";fir-filter xcoeffs not eq?: ~A ~A" v1 (mus-xcoeffs g1)))
- (if (not (eqv? v1 (mus-xcoeffs g1))) (snd-display ";fir-filter xcoeffs not eqv?: ~A ~A" v1 (mus-xcoeffs g1)))
- (if (not (equal? v1 (mus-xcoeffs g1))) (snd-display ";fir-filter xcoeffs not equal?: ~A ~A" v1 (mus-xcoeffs g1)))
+ (if (not (eq? v1 (mus-xcoeffs g1))) (snd-display #__line__ ";fir-filter xcoeffs not eq?: ~A ~A" v1 (mus-xcoeffs g1)))
+ (if (not (eqv? v1 (mus-xcoeffs g1))) (snd-display #__line__ ";fir-filter xcoeffs not eqv?: ~A ~A" v1 (mus-xcoeffs g1)))
+ (if (not (equal? v1 (mus-xcoeffs g1))) (snd-display #__line__ ";fir-filter xcoeffs not equal?: ~A ~A" v1 (mus-xcoeffs g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-xcoeffs g1) 1) .3) (snd-display ";fir-filter vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-xcoeffs g1) 1)))
+ (if (fneq (vct-ref (mus-xcoeffs g1) 1) .3) (snd-display #__line__ ";fir-filter vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-xcoeffs g1) 1)))
(vct-set! (mus-xcoeffs g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";fir-filter vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-xcoeffs g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";fir-filter vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-xcoeffs g1) 1))))
(let ((g1 (make-iir-filter :ycoeffs v1)))
- (if (not (eq? v1 (mus-ycoeffs g1))) (snd-display ";iir-filter ycoeffs not eq?: ~A ~A" v1 (mus-ycoeffs g1)))
- (if (not (eqv? v1 (mus-ycoeffs g1))) (snd-display ";iir-filter ycoeffs not eqv?: ~A ~A" v1 (mus-ycoeffs g1)))
- (if (not (equal? v1 (mus-ycoeffs g1))) (snd-display ";iir-filter ycoeffs not equal?: ~A ~A" v1 (mus-ycoeffs g1)))
+ (if (not (eq? v1 (mus-ycoeffs g1))) (snd-display #__line__ ";iir-filter ycoeffs not eq?: ~A ~A" v1 (mus-ycoeffs g1)))
+ (if (not (eqv? v1 (mus-ycoeffs g1))) (snd-display #__line__ ";iir-filter ycoeffs not eqv?: ~A ~A" v1 (mus-ycoeffs g1)))
+ (if (not (equal? v1 (mus-ycoeffs g1))) (snd-display #__line__ ";iir-filter ycoeffs not equal?: ~A ~A" v1 (mus-ycoeffs g1)))
(vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-ycoeffs g1) 1) .3) (snd-display ";iir-filter vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-ycoeffs g1) 1)))
+ (if (fneq (vct-ref (mus-ycoeffs g1) 1) .3) (snd-display #__line__ ";iir-filter vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-ycoeffs g1) 1)))
(vct-set! (mus-ycoeffs g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display ";iir-filter vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-ycoeffs g1) 1))))
+ (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";iir-filter vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-ycoeffs g1) 1))))
(let ((f1 (make-frame 2 .1 .2))
(f2 (make-frame 2 .3 .5))
(f3 (make-frame 2 0 0)))
(let ((f4 (frame+ f1 f2 f3)))
- (if (not (eq? f3 f4)) (snd-display ";frame+ data not eq?: ~A ~A" f3 f4))
+ (if (not (eq? f3 f4)) (snd-display #__line__ ";frame+ data not eq?: ~A ~A" f3 f4))
(set! f4 (frame* f1 f2 f3))
- (if (not (eq? f3 f4)) (snd-display ";frame* data not eq?: ~A ~A" f3 f4)))))
-
+ (if (not (eq? f3 f4)) (snd-display #__line__ ";frame* data not eq?: ~A ~A" f3 f4)))))
+
(let ((tanh-1 (lambda (x)
(+ x
(* -1/3 x x x)
@@ -26773,9 +26852,9 @@ EDITS: 2
(val2 (tanh-2 x)))
(if (or (fneq val val1)
(fneq val1 val2))
- (snd-display ";tanh(~A): ~A ~A ~A" x val val1 val2))))
+ (snd-display #__line__ ";tanh(~A): ~A ~A ~A" x val val1 val2))))
(list 1.0 0.1 0.1 0.333)))
-
+
(if all-args
(let ((maxerr 0.0)
(max-case #f)
@@ -26795,38 +26874,38 @@ EDITS: 2
(set! max-case (/ m n)))))))))
(if (> maxerr 1e-12)
(format #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case))))
-
+
(let ((tag (catch #t
(lambda () (with-sound () (outa -1 .1)))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";outa -1 -> ~A" tag)))
-
+ (snd-display #__line__ ";outa -1 -> ~A" tag)))
+
(let ((tag (catch #t
(lambda () (let ((v (with-sound (:output (make-vct 10)) (outa -1 .1)))) v))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";outa (vct) -1 -> ~A" tag)))
-
+ (snd-display #__line__ ";outa (vct) -1 -> ~A" tag)))
+
(let ((tag (catch #t
(lambda () (let ((v (with-sound (:output (make-sound-data 1 10)) (outa -1 .1)))) v))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";outa (sound-data) -1 -> ~A" tag)))
-
+ (snd-display #__line__ ";outa (sound-data) -1 -> ~A" tag)))
+
(let ((v (with-sound () (run (outa -1 .1)))))
(if (file-exists? v)
(begin
(if (> (cadr (mus-sound-maxamp v)) 0.0)
- (snd-display ";outa to file at -1: ~A" v))
+ (snd-display #__line__ ";outa to file at -1: ~A" v))
(if (> (mus-sound-chans v) 1)
- (snd-display ";outa to file at -1 chans: ~A" (mus-sound-chans v)))
+ (snd-display #__line__ ";outa to file at -1 chans: ~A" (mus-sound-chans v)))
(if (find-sound v) (close-sound (find-sound v)))
(delete-file v))))
(let ((v (with-sound (:output (make-vct 10)) (run (outa -1 .1)))))
- (if (> (vct-peak v) 0.0) (snd-display ";outa to vct at -1: ~A" v)))
+ (if (> (vct-peak v) 0.0) (snd-display #__line__ ";outa to vct at -1: ~A" v)))
(let ((v (with-sound (:output (make-sound-data 1 10)) (run (outa -1 .1)))))
- (if (> (sound-data-peak v) 0.0) (snd-display ";outa to sound-data at -1: ~A" v)))
+ (if (> (sound-data-peak v) 0.0) (snd-display #__line__ ";outa to sound-data at -1: ~A" v)))
))
@@ -26835,11 +26914,11 @@ EDITS: 2
;;; ---------------- test 9: mix ----------------
(define (snd_test_9)
-
+
(define (make-waltz)
-
+
(define (frequency->tag-y freq lo octs) ; tag height dependent on freq
- (inexact->exact (round (* 100 (- 1.0 (/ (log (/ freq lo)) (* (log 2.0) octs)))))))
+ (round (* 100 (- 1.0 (/ (log (/ freq lo)) (* (log 2.0) octs))))))
(let ((oldie (find-sound "test.snd")))
(if (sound? oldie)
@@ -26853,7 +26932,7 @@ EDITS: 2
(define (violin beg dur freq amp)
(let ((id (car (mix (with-temp-sound () ; write instrument output to temp sound
- (fm-violin 0 dur (->frequency freq #t) amp)) ; our favorite FM instrument
+ (fm-violin 0 dur (->frequency freq #t) amp)) ; our favorite FM instrument
(->sample beg) 0 index 0 ; mix start, file in-chan, sound, channel
#t #t)))) ; mix with tag and auto-delete
(if (symbol? freq)
@@ -26864,7 +26943,7 @@ EDITS: 2
(define (cello beg dur freq amp)
(let ((id (car (mix (with-temp-sound ()
- (fm-violin 0 dur (->frequency freq #t) amp :fm-index 1.5))
+ (fm-violin 0 dur (->frequency freq #t) amp :fm-index 1.5))
(->sample beg) 0 index 0
#t #t))))
(if (symbol? freq)
@@ -26886,7 +26965,7 @@ EDITS: 2
(violin 9 3 'd4 .2)
(cello 9 3 'b2 .2)
-
+
(violin 12 1 'f4 .2) (violin 13 1.5 'a4 .2) (violin 14.5 .5 'g3 .2)
(cello 12 1 'd3 .2) (cello 13 1.5 'f3 .2) (cello 14.5 .5 'g2 .2)
@@ -26948,18 +27027,18 @@ EDITS: 2
(let* ((freq1 (if (> freq (/ (mus-srate) 8)) (/ freq 8) freq))
(amp1 (* amp .175)))
(let ((id (car (mix (with-temp-sound ()
- (fm-violin 0 dur freq1 amp1
- :fm1-rat (* 1.002 rat1)
- :fm1-index (* .5 rat1 indx1 (hz->radians freq))
- :fm1-env f6
- :fm2-rat (* 1.003 rat2)
- :fm2-index (* .5 indx2 rat2 (hz->radians freq))
- :fm2-env f7
- :fm3-index 0.0
- :reverb-amount 1.0
- :amp-env ampfunc))
+ (fm-violin 0 dur freq1 amp1
+ :fm1-rat (* 1.002 rat1)
+ :fm1-index (* .5 rat1 indx1 (hz->radians freq))
+ :fm1-env f6
+ :fm2-rat (* 1.003 rat2)
+ :fm2-index (* .5 indx2 rat2 (hz->radians freq))
+ :fm2-env f7
+ :fm3-index 0.0
+ :reverb-amount 1.0
+ :amp-env ampfunc))
(->sample beg) 0 ind 0 #t #t)))) ; with tag and auto-delete
- (set! (mix-name id) (number->string (inexact->exact (floor freq))))
+ (set! (mix-name id) (number->string (floor freq)))
(if (> freq 700) (set! soprano (cons id soprano))
(if (> freq 500) (set! alto (cons id alto))
(if (> freq 300) (set! tenor (cons id tenor))
@@ -27111,115 +27190,115 @@ EDITS: 2
(do ((test-ctr 0 (+ 1 test-ctr)))
((= test-ctr tests))
-
+
(let ((ind (new-sound "test.snd" :size 10)))
(let ((v (vct .1 .2 .3)))
(let ((id (mix-vct v 0)))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct .1 .2 .3 0 0 0 0 0 0 0)))
- (snd-display ";mix v at 0: ~A" nv)))
+ (snd-display #__line__ ";mix v at 0: ~A" nv)))
(let ((eds (edit-tree ind 0)))
(if (not (feql eds '((0 0 0 2 0.0 0.0 0.0 3) (3 0 3 9 0.0 0.0 0.0 2) (10 -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";mix v at 0 eds: ~A" eds)))
+ (snd-display #__line__ ";mix v at 0 eds: ~A" eds)))
(if (not (mix? id))
- (snd-display ";mix v at 0 id from mix?: ~A" id))
- (if (fneq (mix-amp id) 1.0) (snd-display ";mix v at 0 amp: ~A" (mix-amp id)))
- (if (fneq (mix-speed id) 1.0) (snd-display ";mix v at 0 speed: ~A" (mix-speed id)))
- (if (not (= (mix-sync id) 0)) (snd-display ";mix v at 0 sync: ~A" (mix-sync id)))
- (if (not (equal? (mix-amp-env id) '())) (snd-display ";mix v at 0 amp-env: ~A" (mix-amp-env id)))
- (if (not (= (mix-position id) 0)) (snd-display ";mix v at 0 beg: ~A" (mix-position id)))
- (if (not (= (mix-length id) 3)) (snd-display ";mix v at 0 length: ~A" (mix-length id)))
- (if (not (equal? (mix-name id) #f)) (snd-display ";mix v at 0 name: ~A" (mix-name id)))
- (if (not (equal? (mix-properties id) '())) (snd-display ";mix v at 0 properties: ~A" (mix-properties id)))
- (if (not (equal? (mix-color id) (mix-color))) (snd-display ";mix v at 0 color: ~A" (mix-color id)))
- (if (not (= (mix-tag-y id) 0)) (snd-display ";mix v at 0 tag-y: ~A" (mix-tag-y id)))
+ (snd-display #__line__ ";mix v at 0 id from mix?: ~A" id))
+ (if (fneq (mix-amp id) 1.0) (snd-display #__line__ ";mix v at 0 amp: ~A" (mix-amp id)))
+ (if (fneq (mix-speed id) 1.0) (snd-display #__line__ ";mix v at 0 speed: ~A" (mix-speed id)))
+ (if (not (= (mix-sync id) 0)) (snd-display #__line__ ";mix v at 0 sync: ~A" (mix-sync id)))
+ (if (not (equal? (mix-amp-env id) '())) (snd-display #__line__ ";mix v at 0 amp-env: ~A" (mix-amp-env id)))
+ (if (not (= (mix-position id) 0)) (snd-display #__line__ ";mix v at 0 beg: ~A" (mix-position id)))
+ (if (not (= (mix-length id) 3)) (snd-display #__line__ ";mix v at 0 length: ~A" (mix-length id)))
+ (if (not (equal? (mix-name id) #f)) (snd-display #__line__ ";mix v at 0 name: ~A" (mix-name id)))
+ (if (not (equal? (mix-properties id) '())) (snd-display #__line__ ";mix v at 0 properties: ~A" (mix-properties id)))
+ (if (not (equal? (mix-color id) (mix-color))) (snd-display #__line__ ";mix v at 0 color: ~A" (mix-color id)))
+ (if (not (= (mix-tag-y id) 0)) (snd-display #__line__ ";mix v at 0 tag-y: ~A" (mix-tag-y id)))
(let ((sf (make-mix-sampler id))
(data (make-vct 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! data i (read-mix-sample sf)))
(if (not (vequal data (channel->vct)))
- (snd-display ";mix v at 0 read mix samples: ~A" data))
- (if (not (sampler-at-end? sf)) (snd-display ";mix v at 0 reader not at end?"))
+ (snd-display #__line__ ";mix v at 0 read mix samples: ~A" data))
+ (if (not (sampler-at-end? sf)) (snd-display #__line__ ";mix v at 0 reader not at end?"))
(free-sampler sf))
- (if (not (equal? (mixes ind 0) (list id))) (snd-display ";mix v at 0 mixes: ~A" (mixes ind 0)))
- (if (not (equal? (mix-home id) (list ind 0 #f 0))) (snd-display ";mix v at 0 home: ~A" (mix-home id)))
+ (if (not (equal? (mixes ind 0) (list id))) (snd-display #__line__ ";mix v at 0 mixes: ~A" (mixes ind 0)))
+ (if (not (equal? (mix-home id) (list ind 0 #f 0))) (snd-display #__line__ ";mix v at 0 home: ~A" (mix-home id)))
(undo))
(let ((id (mix-vct v 8)))
- (if (not (= (frames ind 0) 11)) (snd-display ";mix v at 8 new len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 0) 11)) (snd-display #__line__ ";mix v at 8 new len: ~A" (frames ind 0)))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct 0 0 0 0 0 0 0 0 .1 .2 .3)))
- (snd-display ";mix v at 8: ~A" nv)))
+ (snd-display #__line__ ";mix v at 8: ~A" nv)))
(undo))
(let ((id (mix-vct v 3)))
- (if (not (= (frames ind 0) 10)) (snd-display ";mix v at 3 new len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";mix v at 3 new len: ~A" (frames ind 0)))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct 0 0 0 .1 .2 .3 0 0 0 0)))
- (snd-display ";mix v at 3: ~A" nv)))
+ (snd-display #__line__ ";mix v at 3: ~A" nv)))
(undo)))
(let ((v (make-vct 20 .5)))
(let ((id (mix-vct v 0)))
- (if (not (= (frames ind 0) 20)) (snd-display ";mix v20 at 0 new len: ~A" (frames ind 0)))))
+ (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";mix v20 at 0 new len: ~A" (frames ind 0)))))
(close-sound ind))
(let ((ind (new-sound "test.snd" :size 100000)))
(let ((id (car (mix "oboe.snd" 0))))
(if (not (mix? id))
- (snd-display ";mix oboe at 0 id from mix?: ~A" id))
- (if (fneq (mix-amp id) 1.0) (snd-display ";mix oboe at 0 amp: ~A" (mix-amp id)))
- (if (fneq (mix-speed id) 1.0) (snd-display ";mix oboe at 0 speed: ~A" (mix-speed id)))
- (if (not (= (mix-sync id) 0)) (snd-display ";mix oboe at 0 sync: ~A" (mix-sync id)))
- (if (not (equal? (mix-amp-env id) '())) (snd-display ";mix oboe at 0 amp-env: ~A" (mix-amp-env id)))
- (if (not (= (mix-position id) 0)) (snd-display ";mix oboe at 0 beg: ~A" (mix-position id)))
- (if (not (= (mix-length id) 50828)) (snd-display ";mix oboe at 0 length: ~A" (mix-length id)))
- (if (not (equal? (mix-name id) #f)) (snd-display ";mix oboe at 0 name: ~A" (mix-name id)))
- (if (not (equal? (mix-properties id) '())) (snd-display ";mix oboe at 0 properties: ~A" (mix-properties id)))
- (if (not (equal? (mix-color id) (mix-color))) (snd-display ";mix oboe at 0 color: ~A" (mix-color id)))
- (if (not (= (mix-tag-y id) 0)) (snd-display ";mix oboe at 0 tag-y: ~A" (mix-tag-y id)))
+ (snd-display #__line__ ";mix oboe at 0 id from mix?: ~A" id))
+ (if (fneq (mix-amp id) 1.0) (snd-display #__line__ ";mix oboe at 0 amp: ~A" (mix-amp id)))
+ (if (fneq (mix-speed id) 1.0) (snd-display #__line__ ";mix oboe at 0 speed: ~A" (mix-speed id)))
+ (if (not (= (mix-sync id) 0)) (snd-display #__line__ ";mix oboe at 0 sync: ~A" (mix-sync id)))
+ (if (not (equal? (mix-amp-env id) '())) (snd-display #__line__ ";mix oboe at 0 amp-env: ~A" (mix-amp-env id)))
+ (if (not (= (mix-position id) 0)) (snd-display #__line__ ";mix oboe at 0 beg: ~A" (mix-position id)))
+ (if (not (= (mix-length id) 50828)) (snd-display #__line__ ";mix oboe at 0 length: ~A" (mix-length id)))
+ (if (not (equal? (mix-name id) #f)) (snd-display #__line__ ";mix oboe at 0 name: ~A" (mix-name id)))
+ (if (not (equal? (mix-properties id) '())) (snd-display #__line__ ";mix oboe at 0 properties: ~A" (mix-properties id)))
+ (if (not (equal? (mix-color id) (mix-color))) (snd-display #__line__ ";mix oboe at 0 color: ~A" (mix-color id)))
+ (if (not (= (mix-tag-y id) 0)) (snd-display #__line__ ";mix oboe at 0 tag-y: ~A" (mix-tag-y id)))
- (if (fneq (maxamp ind 0) .14724) (snd-display ";mix oboe maxamp: ~A" (maxamp ind 0)))
- (if (not (equal? (mixes ind 0) (list id))) (snd-display ";mix oboe at 0 mixes: ~A" (mixes ind 0)))
- (if (not (equal? (mix-home id) (list ind 0 "/home/bil/cl/oboe.snd" 0))) (snd-display ";mix oboe at 0 home: ~A" (mix-home id))))
+ (if (fneq (maxamp ind 0) .14724) (snd-display #__line__ ";mix oboe maxamp: ~A" (maxamp ind 0)))
+ (if (not (equal? (mixes ind 0) (list id))) (snd-display #__line__ ";mix oboe at 0 mixes: ~A" (mixes ind 0)))
+ (if (not (equal? (mix-home id) (list ind 0 "/home/bil/cl/oboe.snd" 0))) (snd-display #__line__ ";mix oboe at 0 home: ~A" (mix-home id))))
(undo)
(let ((id (car (mix "oboe.snd" 70000))))
- (if (not (= (frames ind 0) (+ 70000 50828))) (snd-display ";mix oboe at 70k frames: ~A" (frames ind 0))))
+ (if (not (= (frames ind 0) (+ 70000 50828))) (snd-display #__line__ ";mix oboe at 70k frames: ~A" (frames ind 0))))
(close-sound ind))
(let ((ind (new-sound "test.snd" :size 10)))
(let ((v (vct .1 .2 .3)))
(let ((id (mix-vct v 0)))
(scale-by 2.0)
- (if (not (mix? id)) (snd-display ";scaled (2) mix not active?"))
+ (if (not (mix? id)) (snd-display #__line__ ";scaled (2) mix not active?"))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct-scale! (vct .1 .2 .3 0 0 0 0 0 0 0) 2.0)))
- (snd-display ";mix v at 0 scale-by 2: ~A" nv)))
- (if (fneq (mix-amp id) 2.0) (snd-display ";mix then scale mix amp: ~A" (mix-amp id)))
+ (snd-display #__line__ ";mix v at 0 scale-by 2: ~A" nv)))
+ (if (fneq (mix-amp id) 2.0) (snd-display #__line__ ";mix then scale mix amp: ~A" (mix-amp id)))
(undo)
(delete-sample 1)
- (if (not (mix? id)) (snd-display ";delete hit mix: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";delete hit mix: ~A" (mix? id)))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct .1 .3 0 0 0 0 0 0 0)))
- (snd-display ";mix v at 0 delete .2: ~A" nv)))
+ (snd-display #__line__ ";mix v at 0 delete .2: ~A" nv)))
(revert-sound ind))
(let ((id (mix-vct v 0)))
(delete-sample 7)
(reverse-sound ind 0)
- (if (not (mix? id)) (snd-display ";reversed mix: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";reversed mix: ~A" (mix? id)))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct-reverse! (vct .1 .2 .3 0 0 0 0 0 0))))
- (snd-display ";mix v at 0 reversed: ~A" nv)))
+ (snd-display #__line__ ";mix v at 0 reversed: ~A" nv)))
(undo)
- (if (not (mix? id)) (snd-display ";revert reverse mix: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";revert reverse mix: ~A" (mix? id)))
(map-channel (lambda (y) .1))
- (if (not (mix? id)) (snd-display ";clobbered mix: ~A" (mixes)))
+ (if (not (mix? id)) (snd-display #__line__ ";clobbered mix: ~A" (mixes)))
(scale-by 2.0)
(let ((id (mix-vct v 0)))
- (if (not (mix? id)) (snd-display ";mix on scale (2) not active?"))
+ (if (not (mix? id)) (snd-display #__line__ ";mix on scale (2) not active?"))
(scale-by 3.0)
- (if (not (mix? id)) (snd-display ";scaled (3) mix not active?"))
+ (if (not (mix? id)) (snd-display #__line__ ";scaled (3) mix not active?"))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct-scale! (vct-add! (make-vct 9 .2) (vct .1 .2 .3)) 3.0)))
- (snd-display ";mix v at 0 scale-by 2 and 3: ~A" nv))))
+ (snd-display #__line__ ";mix v at 0 scale-by 2 and 3: ~A" nv))))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(env-channel '(0 0 1 1 2 0) 0 11)
@@ -27227,1597 +27306,1597 @@ EDITS: 2
(let ((id (mix-vct v 3)))
(let ((nv (channel->vct)))
(if (not (vequal nv (vct 0.000 0.200 0.400 0.700 1.000 1.300 0.800 0.600 0.400 0.200)))
- (snd-display ";mix v at 3 after env: ~A" nv)))))
+ (snd-display #__line__ ";mix v at 3 after env: ~A" nv)))))
(close-sound ind))))
(let ((ind (new-sound "test.snd" :size 100)))
(let ((v (vct .1 .2 .3)))
(let ((id (mix-vct v 10)))
(pad-channel 0 10)
- (if (not (mix? id)) (snd-display ";padded mix not active?"))
- (if (not (= (mix-position id) 20)) (snd-display ";after pad mix pos: ~A" (mix-position id)))
+ (if (not (mix? id)) (snd-display #__line__ ";padded mix not active?"))
+ (if (not (= (mix-position id) 20)) (snd-display #__line__ ";after pad mix pos: ~A" (mix-position id)))
(set! (mix-sync id) 2)
- (if (not (= (mix-sync id) 2)) (snd-display ";set mix sync 2: ~A" (mix-sync id)))
- (if (and full-test (< (mix-sync-max) 2)) (snd-display ";mix-sync-max: ~A" (mix-sync-max)))
+ (if (not (= (mix-sync id) 2)) (snd-display #__line__ ";set mix sync 2: ~A" (mix-sync id)))
+ (if (and full-test (< (mix-sync-max) 2)) (snd-display #__line__ ";mix-sync-max: ~A" (mix-sync-max)))
(pad-channel 50 10)
- (if (not (mix? id)) (snd-display ";padded 50 mix not active?"))
- (if (not (= (mix-position id) 20)) (snd-display ";after pad 50 mix pos: ~A" (mix-position id)))
+ (if (not (mix? id)) (snd-display #__line__ ";padded 50 mix not active?"))
+ (if (not (= (mix-position id) 20)) (snd-display #__line__ ";after pad 50 mix pos: ~A" (mix-position id)))
(undo 1)
(let ((id1 (mix-vct v 22))
(id2 (mix-vct v 21)))
(let ((vals (channel->vct 18 10)))
(if (not (vequal vals (vct 0.000 0.000 0.100 0.300 0.600 0.500 0.300 0.000 0.000 0.000)))
- (snd-display ";mix 3 vs: ~A" vals))
- (if (not (mix? id)) (snd-display ";mix 3vs 1 not active?"))
- (if (not (mix? id1)) (snd-display ";mix 3vs 2 not active?"))
- (if (not (mix? id2)) (snd-display ";mix 3vs 3 not active?"))
+ (snd-display #__line__ ";mix 3 vs: ~A" vals))
+ (if (not (mix? id)) (snd-display #__line__ ";mix 3vs 1 not active?"))
+ (if (not (mix? id1)) (snd-display #__line__ ";mix 3vs 2 not active?"))
+ (if (not (mix? id2)) (snd-display #__line__ ";mix 3vs 3 not active?"))
(set! (mix-position id) 10)
(set! vals (channel->vct 18 10))
(if (not (vequal vals (vct 0.000 0.000 0.000 0.100 0.300 0.500 0.300 0.000 0.000 0.000)))
- (snd-display ";mix 3 vs then move 1st: ~A" vals))
+ (snd-display #__line__ ";mix 3 vs then move 1st: ~A" vals))
(set! (mix-position id2) 30)
(set! vals (channel->vct 18 10))
(if (not (vequal vals (vct 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.000 0.000 0.000)))
- (snd-display ";mix 3 vs then move 2: ~A" vals))
+ (snd-display #__line__ ";mix 3 vs then move 2: ~A" vals))
(scale-by 2.0)
- (if (not (mix? id)) (snd-display ";mix 3vs 1 scl not active?"))
- (if (not (mix? id1)) (snd-display ";mix 3vs 2 scl not active?"))
- (if (not (mix? id2)) (snd-display ";mix 3vs 3 scl not active?"))
+ (if (not (mix? id)) (snd-display #__line__ ";mix 3vs 1 scl not active?"))
+ (if (not (mix? id1)) (snd-display #__line__ ";mix 3vs 2 scl not active?"))
+ (if (not (mix? id2)) (snd-display #__line__ ";mix 3vs 3 scl not active?"))
(set! vals (channel->vct 18 10))
(if (not (vequal vals (vct 0.000 0.000 0.000 0.000 0.200 0.400 0.600 0.000 0.000 0.000)))
- (snd-display ";mix 3 vs then move 2 scl: ~A" vals))
+ (snd-display #__line__ ";mix 3 vs then move 2 scl: ~A" vals))
(delete-sample 15)
- (if (not (mix? id)) (snd-display ";mix 3vs 1 scl del not active?"))
- (if (not (mix? id1)) (snd-display ";mix 3vs 2 scl del not active?"))
- (if (not (mix? id2)) (snd-display ";mix 3vs 3 scl del not active?"))
- (if (not (= (mix-position id) 10)) (snd-display ";mix 3vs etc pos: ~A" (mix-position id)))
- (if (not (= (mix-position id1) 21)) (snd-display ";mix 3vs etc pos 1: ~A" (mix-position id1)))
- (if (not (= (mix-position id2) 29)) (snd-display ";mix 3vs etc pos 2: ~A" (mix-position id2)))
+ (if (not (mix? id)) (snd-display #__line__ ";mix 3vs 1 scl del not active?"))
+ (if (not (mix? id1)) (snd-display #__line__ ";mix 3vs 2 scl del not active?"))
+ (if (not (mix? id2)) (snd-display #__line__ ";mix 3vs 3 scl del not active?"))
+ (if (not (= (mix-position id) 10)) (snd-display #__line__ ";mix 3vs etc pos: ~A" (mix-position id)))
+ (if (not (= (mix-position id1) 21)) (snd-display #__line__ ";mix 3vs etc pos 1: ~A" (mix-position id1)))
+ (if (not (= (mix-position id2) 29)) (snd-display #__line__ ";mix 3vs etc pos 2: ~A" (mix-position id2)))
))))
(close-sound ind))
-
+
(let ((ind (new-sound "test.snd" :size 15)))
(let ((id (mix-vct (make-vct 11 1.0) 2)))
(set! (mix-amp-env id) '(0 0 1 1))
(let ((vals (channel->vct)))
(if (not (vequal vals (vct 0 0 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 0 0)))
- (snd-display ";ramp mix amp env: ~A" vals)))
+ (snd-display #__line__ ";ramp mix amp env: ~A" vals)))
(set! (mix-amp-env id) #f)
- (if (not (null? (mix-amp-env id))) (snd-display ";set mix-amp-env to null: ~A" (mix-amp-env id)))
+ (if (not (null? (mix-amp-env id))) (snd-display #__line__ ";set mix-amp-env to null: ~A" (mix-amp-env id)))
(set! (mix-speed id) 0.5)
- (if (not (= (frames) 24)) (snd-display ";mix speed lengthens 24: ~A" (frames)))
+ (if (not (= (frames) 24)) (snd-display #__line__ ";mix speed lengthens 24: ~A" (frames)))
(set! (mix-speed id) 1.0)
(let ((vals (channel->vct)))
(if (not (vequal vals (vct 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
- (snd-display ";return to mix original index: ~A" vals)))
+ (snd-display #__line__ ";return to mix original index: ~A" vals)))
(set! (mix-amp-env id) '(0 0 1 1 2 1 3 0))
(set! (mix-speed id) 0.5)
(set! (mix-amp-env id) #f)
(set! (mix-speed id) 1.0)
(let ((vals (channel->vct)))
(if (not (vequal vals (vct 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
- (snd-display ";return again to mix original index: ~A" vals)))
+ (snd-display #__line__ ";return again to mix original index: ~A" vals)))
(close-sound ind)))
-
- (let ((id (open-sound "oboe.snd")))
- (make-selection 1000 2000 id 0)
- (let ((mix-id (car (mix-selection 3000 id 0))))
- (set! (mix-amp mix-id) .5)
- (if (fneq (mix-amp mix-id) .5)
- (snd-display ";mix-amp .5: ~A" (mix-amp mix-id)))
- (scale-by .5)
- (undo)
- (close-sound id)))
- (set! (print-length) 30)
-
- (let* ((ind (open-sound "2.snd"))
- (md (car (mix "1a.snd" 1000 0 ind 1 #t))))
- (if (fneq (maxamp ind 1) .1665) (snd-display ";maxamp after mix into chan 2: ~A" (maxamp ind 1)))
- (set! (mix-amp md) 0.0)
- (if (or (not (equal? (edits ind 0) (list 0 0)))
- (not (equal? (edits ind 1) (list 2 0))))
- (snd-display ";mix into chan2 zeroed: ~A ~A" (edits ind 0) (edits ind 1)))
- (if (fneq (maxamp ind 1) .066) (snd-display ";maxamp after mix zeroed into chan 2: ~A" (maxamp ind 1)))
- (set! (mix-amp md) 0.5)
- (if (fneq (maxamp ind 1) .116) (snd-display ";maxamp after mix 0.5 into chan 2: ~A" (maxamp ind 1)))
- (set! (mix-speed md) 2.0)
- (if (fneq (/ (mix-length md) (mus-sound-frames "1a.snd")) 0.5)
- (snd-display ";mix srate chan 2: ~A ~A" (mix-length md) (mus-sound-frames "1a.snd")))
- (update-time-graph)
- (set! (mix-speed md) 0.5)
- (update-time-graph)
- (set! (mix-amp md) 1.0)
- (if (fneq (maxamp ind 1) .166)
- (snd-display ";non-sync mix-speed maxamp: ~A" (maxamp ind 1)))
- (set! (mix-amp-env md) '(0 0 1 1 2 0))
- (update-time-graph)
- (set! (mix-speed md) 1.0)
- (update-time-graph)
- (revert-sound ind)
- (set! (sync ind) 1)
- (let ((m0 (maxamp ind 0))
- (m1 (maxamp ind 1))
- (len (frames ind 0)))
- (set! md (mix "2.snd" 0 #t)) ; should double both chans, no len change
- (if (or (not (= (frames ind 0) len))
- (fneq (maxamp ind 0) (* 2 m0))
- (fneq (maxamp ind 1) (* 2 m1)))
- (snd-display ";mix twice syncd: 0: ~A -> ~A, m1: ~A -> ~A, len: ~A -> ~A"
- m0 (maxamp ind 0) m1 (maxamp ind 1) len (frames ind 0)))
- (reset-hook! mix-release-hook)
- (close-sound ind)))
-
- (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "mix tests")))
- (insert-silence 0 20 ind)
- (let ((indout (new-sound "test.snd" mus-next mus-bshort 22050 1 "mix tests")))
- (insert-silence 0 10 indout)
- (set! (sample 2 indout 0) .5)
- (set! (sample 5 indout 0) .25)
- (save-sound indout)
- (close-sound indout))
- (let ((tag (car (mix "test.snd"))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
- (if (not (vequal samps v))
- (snd-display ";mix 1->1: ~A ~A" samps v)))
- (if (not (mix? tag)) (snd-display ";mix 1->1 tag: ~A" tag))
- (undo))
- (let ((tag (car (mix "test.snd" 5))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 7 .5)
- (vct-set! v 10 .25)
- (if (not (vequal samps v))
- (snd-display ";mix 1->1 at 5: ~A ~A" samps v)))
- (if (not (mix? tag)) (snd-display ";mix 1->1 at 5 tag: ~A" tag))
- (undo))
- (let ((tag (mix "test.snd" 0 0 ind 0 #f)))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
- (if (not (vequal samps v))
- (snd-display ";mix 1->1 at 0 #f: ~A ~A" samps v)))
- (if (mix? tag) (snd-display ";mix 1->1 at 5 #f tag: ~A" tag))
- (undo))
- (let ((indout (new-sound "test.snd" mus-next mus-bshort 22050 2 "mix tests")))
- (insert-silence 0 10 indout 0)
- (insert-silence 0 10 indout 1)
- (set! (sample 2 indout 0) .5)
- (set! (sample 5 indout 0) .25)
- (set! (sample 2 indout 1) .95)
- (set! (sample 5 indout 1) .125)
- (save-sound indout)
- (close-sound indout))
- (let ((tag (car (mix "test.snd" 0 1))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
- (if (not (vequal samps v))
- (snd-display ";mix 2->1: ~A ~A" samps v)))
- (if (not (mix? tag)) (snd-display ";mix 2->1 tag: ~A" tag))
- (undo))
- (let ((tag (car (mix "test.snd" 5 1))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 7 .95)
- (vct-set! v 10 .125)
- (if (not (vequal samps v))
- (snd-display ";mix 2->1 at 5: ~A ~A" samps v)))
- (if (not (mix? tag)) (snd-display ";mix 2->1 at 5 tag: ~A" tag))
- (undo))
- (close-sound ind)
- (set! ind (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "mix tests"))
- (insert-silence 0 20 ind 0)
- (insert-silence 0 20 ind 1)
- (let ((tag (car (mix "test.snd" 0 #t))))
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
- (if (not (vequal samps1 v))
- (snd-display ";mix 1->1 (2): ~A ~A" samps1 v))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
- (if (not (vequal samps0 v))
- (snd-display ";mix 1->1 (3): ~A ~A" samps0 v)))
- (if (not (mix? tag)) (snd-display ";mix 1->1 tag: ~A" tag))
- (undo 1 ind 0)
- (undo 1 ind 1))
- (let ((tag (mix "test.snd" 0 1 ind 1 #f))) ; samp:0, in-chan: 1
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
- (if (not (vequal samps0 v))
- (snd-display ";mix 1->1 (4): ~A ~A" samps0 v))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
- (if (not (vequal samps1 v))
- (snd-display ";mix 1->1 (5): ~A ~A" samps1 v)))
- (if (mix? tag) (snd-display ";mix 1->1 tag (5): ~A" tag))
- (undo 1 ind 1))
- (set! (sync ind) 1)
- (let ((tag (car (mix "test.snd" 0 #t))))
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
- (if (not (vequal samps0 v))
- (snd-display ";mix 1->1 (6): ~A ~A" samps0 v))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
- (if (not (vequal samps1 v))
- (snd-display ";mix 1->1 (7): ~A ~A" samps1 v)))
- (undo))
- (set! (cursor ind) 5)
- (let ((tag (car (mix "test.snd" (cursor) #t))))
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
- (vct-set! v 7 .5)
- (vct-set! v 10 .25)
- (if (not (vequal samps0 v))
- (snd-display ";mix 1->1 (8): ~A ~A" samps0 v))
- (vct-set! v 7 .95)
- (vct-set! v 10 .125)
- (if (not (vequal samps1 v))
- (snd-display ";mix 1->1 (9): ~A ~A" samps1 v)))
- (undo))
- (close-sound ind))
- (delete-file "test.snd")
- (delete-file "fmv.snd")
-
- ;; check ripple_mixes
- (let* ((ind (open-sound "oboe.snd"))
- (data (channel->vct 100 100))
- (m1 (mix-vct data 321 ind 0 #t))
- (m2 (mix-vct data 123 ind 0 #t)))
- (set! (mix-position m1) 500)
- (if (not (= (mix-position m1) 500)) (snd-display ";mix-position m1[0]: ~A" (mix-position m1)))
- (if (not (= (mix-position m2) 123)) (snd-display ";mix-position m2[0]: ~A" (mix-position m2)))
- (undo)
- (set! (mix-position m2) 500)
- (if (not (= (mix-position m2) 500)) (snd-display ";mix-position m2[1]: ~A" (mix-position m2)))
- (if (not (= (mix-position m1) 321)) (snd-display ";mix-position m1[1]: ~A" (mix-position m1)))
- (undo)
- (insert-silence 0 100)
- (if (not (= (mix-position m1) (+ 100 321))) (snd-display ";mix-position m1[2]: ~A" (mix-position m1)))
- (if (not (= (mix-position m2) (+ 100 123))) (snd-display ";mix-position m2[2]: ~A" (mix-position m2)))
- (delete-samples 0 50)
- (if (not (= (mix-position m1) (+ 50 321))) (snd-display ";mix-position m1[3]: ~A" (mix-position m1)))
- (if (not (= (mix-position m2) (+ 50 123))) (snd-display ";mix-position m2[3]: ~A" (mix-position m2)))
- (undo 2)
- (set! (mix-position m2) 500)
- (undo)
- (scale-channel 0.5 1000 100)
- (if (not (= (mix-position m2) 123)) (snd-display ";mix-position m2[5]: ~A" (mix-position m2)))
- (if (not (= (mix-position m1) 321)) (snd-display ";mix-position m1[5]: ~A" (mix-position m1)))
- (undo)
- (set! (mix-position m2) 500)
- (undo)
- (ptree-channel (lambda (y) (* y 0.5)) 2000 100)
- (if (not (= (mix-position m2) 123)) (snd-display ";mix-position m2[6]: ~A" (mix-position m2)))
- (if (not (= (mix-position m1) 321)) (snd-display ";mix-position m1[6]: ~A" (mix-position m1)))
- (undo)
- (set! (mix-position m2) 500)
- (undo-edit)
- (ramp-channel 0.0 1.0 3000 100)
- (catch #t
- (lambda ()
- (if (not (= (mix-position m2) 123)) (snd-display ";mix-position m2[7]: ~A" (mix-position m2)))
- (if (not (= (mix-position m1) 321)) (snd-display ";mix-position m1[7]: ~A" (mix-position m1))))
- (lambda args (snd-display ";mix-position trouble: ~A" args)))
- (undo)
- (delay-channel-mixes 200 100 ind 0)
- (if (not (= (mix-position m2) 123)) (snd-display ";delay-channel mixes mix-position m2: ~A" (mix-position m2)))
- (if (not (= (mix-position m1) 421)) (snd-display ";delay-channel-mixes mix-position m1: ~A" (mix-position m1)))
- (check-mix-tags ind 0)
- (close-sound ind))
-
- ;; check that current console is correct
- (let ((ind (open-sound "storm.snd")))
- (set! (x-bounds) (list 0 80.0))
- (make-selection 1000000 1050000)
- (let ((m1 (car (mix-selection 900000)))
- (m2 (car (mix-selection 400000))))
- (as-one-edit (lambda ()
- (set! (mix-position m1) 0)
- (set! (mix-position m2) 1)))
- (if (or (not (= (mix-position m1) 0))
- (not (= (mix-position m2) 1)))
- (snd-display ";as-one-edit positions: ~A ~A" (mix-position m1) (mix-position m2)))
- (undo-channel)
- (if (or (not (= (mix-position m1) 900000))
- (not (= (mix-position m2) 400000)))
- (snd-display ";as-one-edit positions after undo: (~A): ~A (~A): ~A" m1 (mix-position m1) m2 (mix-position m2)))
- (redo-channel)
- (if (or (not (= (mix-position m1) 0))
- (not (= (mix-position m2) 1)))
- (snd-display ";as-one-edit positions after redo: ~A ~A" (mix-position m1) (mix-position m2)))
- (close-sound ind)))
-
- (let ((ind (open-sound "2.snd")))
- (make-selection 0 10000 ind)
- (if (not (= (selection-chans) 2))
- (snd-display ";stereo selection: ~A" (selection-chans)))
- (set! (sync ind) #t)
- (let ((md (car (mix-selection 500 ind))))
- (if (not (mix? (integer->mix (+ 1 (mix->integer md)))))
- (snd-display ";where is 2nd mix? ~A ~A" md (mixes)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display ";edit-position 0 after stereo mix selection: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind 1) 1))
- (snd-display ";edit-position 1 after stereo mix selection: ~A" (edit-position ind 1)))
- (set! (sync ind) #f)
- (undo-edit 1 ind 0)
- (delete-sample 25 ind 0)
- (set! (mix-position (integer->mix (+ 1 (mix->integer md)))) 750)
- (if (not (= (edit-position ind 1) 2))
- (snd-display ";edit-position 1 after stereo mix selection moved: ~A" (edit-position ind 2)))
- (revert-sound ind)
- (close-sound ind)))
-
- (let ((ind (new-sound "test.snd"))
- (v (make-vct 20)))
- (do ((i 0 (+ 1 i))) ((= i 20)) (vct-set! v i (* i .01)))
- (vct->channel v)
- (do ((i 0 (+ 1 i))) ((= i 20)) (vct-set! v i (* i -.01)))
- (let ((mx (mix-vct v 10)))
- (let ((hi (make-mix-sampler mx))
- (ho (make-mix-sampler mx 5))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 10)))
- (let ((ho-val (ho))
- (hi-val (hi)))
- (if (fneq hi-val (* i -.01))
- (begin
- (snd-display ";mix-reader at ~A from 0: ~A" i hi-val)
- (set! happy #f)))
- (if (fneq ho-val (* (+ i 5) -.01))
- (begin
- (snd-display ";mix-reader at ~A from 5: ~A" i ho-val)
- (set! happy #f)))))))
- (revert-sound ind)
- (set! v (make-vct 21))
- (vct-fill! v 0.5)
- (vct->channel v)
- (let ((mx (mix-vct v 10)))
- (set! (mix-amp-env mx) '(0 0 1 1))
- (let ((hi (make-mix-sampler mx 0))
- (ho (make-mix-sampler mx 10))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 10)))
- (let ((ho-val (ho))
- (hi-val (hi)))
- (if (fneq hi-val (* i .025))
- (begin
- (snd-display ";mix-reader env'd at ~A from 0: ~A" i hi-val)
- (set! happy #f)))
- (if (fneq ho-val (* (+ i 10) .025))
- (begin
- (snd-display ";mix-reader env'd at ~A from 10: ~A" i ho-val)
- (set! happy #f)))))))
- (close-sound ind))
-
- (let* ((ind (open-sound "oboe.snd"))
- (id (mix-vct (make-vct 10 .1))))
- (set! (mix-position id) 100)
- (if (or (not (= (mix-position id) 100))
- (not (= (edit-position ind 0) 2)))
- (snd-display ";mix-position init: ~A ~A" (mix-position id) (edit-position ind 0)))
- (set! (mix-position id) 100)
- (if (or (not (= (mix-position id) (mix-position id)))
- (not (= (edit-position ind 0) 2)))
- (snd-display ";mix-position 2 (no-op): ~A ~A" (mix-position id) (edit-position ind 0)))
- (set! (mix-amp id) 1.0)
- (if (or (fneq (mix-amp id) 1.0)
- (not (= (edit-position ind 0) 2)))
- (snd-display ";mix-amp no-op: ~A ~A" (mix-amp id) (edit-position ind 0)))
- (set! (mix-amp id) 0.5)
- (if (or (fneq (mix-amp id) 0.5)
- (not (= (edit-position ind 0) 3)))
- (snd-display ";mix-amp .5: ~A ~A" (mix-amp id) (edit-position ind 0)))
- (set! (mix-amp id) (mix-amp id))
- (if (or (fneq (mix-amp id) 0.5)
- (not (= (edit-position ind 0) 3)))
- (snd-display ";mix-amp no-op: ~A ~A" (mix-amp id) (edit-position ind 0)))
- (set! (mix-speed id) 1.0)
- (if (or (fneq (mix-speed id) 1.0)
- (not (= (edit-position ind 0) 3)))
- (snd-display ";mix-speed no-op: ~A ~A" (mix-speed id) (edit-position ind 0)))
- (set! (mix-speed id) .5)
- (if (or (fneq (mix-speed id) 0.5)
- (not (= (edit-position ind 0) 4)))
- (snd-display ";mix-speed .5: ~A ~A" (mix-speed id) (edit-position ind 0)))
- (set! (mix-speed id) (mix-speed id))
- (if (or (fneq (mix-speed id) 0.5)
- (not (= (edit-position ind 0) 4)))
- (snd-display ";mix-speed 2 no-op: ~A ~A" (mix-speed id) (edit-position ind 0)))
- (set! (mix-amp-env id) '(0 0 1 1))
- (if (not (= (edit-position ind 0) 5))
- (snd-display ";mix-amp-env init: ~A ~A" (mix-amp-env id) (edit-position ind 0)))
- (set! (mix-amp-env id) '(0 0 1 1))
- (if (not (= (edit-position ind 0) 5))
- (snd-display ";mix-amp-env no-op: ~A ~A" (mix-amp-env id) (edit-position ind 0)))
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "color-mix tests" 300))
- (old-color (mix-color)))
- (set! (mix-color) (make-color-with-catch 1 1 0))
- (let ((mix1 (mix-vct (make-vct 10 .5) 10)))
- (if (or (not (equal? (color->list (mix-color)) (list 1.0 1.0 0.0)))
- (not (equal? (color->list (mix-color mix1)) (list 1.0 1.0 0.0))))
- (snd-display ";set mix-color: ~A ~A ~A ~A"
- (color->list (mix-color)) (color->list (mix-color mix1)) (list 1.0 1.0 0.0) (color->list old-color)))
- (set! (mix-color) old-color)
- (save-mix mix1 "test1.snd")
- (let ((ind1 (open-sound "test1.snd")))
- (if (not (= (frames ind1) (mix-length mix1))) (snd-display ";save-mix frames: ~A ~A" (mix-length mix1) (frames ind1)))
- (if (not (vequal (channel->vct 0 10) (mix->vct mix1)))
- (snd-display ";save-mix data: ~A ~A" (mix->vct mix1) (channel->vct 0 10 ind1)))
- (close-sound ind1)
- (if (file-exists? "test1.snd") (delete-file "test1.snd"))))
- (close-sound ind))
-
- (let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "lock mix tests" 300))
- (mix1 (mix-vct (make-vct 10 .5) 10)))
- (set! (mix-amp mix1) 0.0)
- (if (fneq (maxamp ind 0) 0.0) (snd-display ";delete-mix maxamp: ~A" (maxamp ind 0)))
- (undo-channel 1 ind 0)
- (if (fneq (maxamp ind 0) 0.5) (snd-display ";undelete-mix maxamp: ~A" (maxamp ind 0)))
- (redo-channel 1 ind 0)
- (if (fneq (maxamp ind 0) 0.0) (snd-display ";redelete-mix maxamp: ~A" (maxamp ind 0)))
- (undo 2)
-; (if (mix? mix1) (snd-display ";undo 2 kept mix?"))
- (if (fneq (maxamp ind 0) 0.0) (snd-display ";no delete-mix maxamp: ~A" (maxamp ind 0)))
- (redo)
- (if (fneq (maxamp ind 0) 0.5) (snd-display ";reundelete-mix maxamp: ~A" (maxamp ind 0)))
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd" :size 100)))
- (let ((id (mix-vct (make-vct 5 .5) 11)))
-
- ;; pad-channel
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11: ~A" (channel->vct 10 10)))
- (pad-channel 0 10)
- (if (not (mix? id))
- (snd-display ";pad locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 21))
- (snd-display ";vct .5 at 21 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 21: ~A" (channel->vct 20 10)))
- (if (not (vequal (channel->vct 10 10) (make-vct 10 0.0)))
- (snd-display ";vct .5 at 21 at 10: ~A" (channel->vct 10 10)))
- (pad-channel 30 10)
- (if (not (mix? id))
- (snd-display ";pad 30 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 21))
- (snd-display ";vct .5 at 21 position 30: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 21 30: ~A" (channel->vct 20 10)))
- (pad-channel 150 10)
- (if (not (mix? id))
- (snd-display ";pad 150 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 21))
- (snd-display ";vct .5 at 21 position 150: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 21 150: ~A" (channel->vct 20 10)))
- (pad-channel 20 10)
- (if (not (mix? id))
- (snd-display ";pad 20 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 31))
- (snd-display ";vct .5 at 31 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 30 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 31: ~A" (channel->vct 30 10)))
- (pad-channel 32 3)
-; (if (mix? id) (snd-display ";pad within mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display ";pad within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 30 10) (vct 0 .5 0 0 0 .5 .5 .5 .5 0)))
- (snd-display ";vct .5 at 31 pad at 32: ~A" (channel->vct 30 10)))
-
- (set! (edit-position) 1)
- (if (not (mix? id)) (snd-display ";mix vct after reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display ";mix vct position after reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 after reset edit: ~A" (channel->vct 10 10)))
-
- ;; delete
- (delete-samples 0 10)
- (if (not (mix? id))
- (snd-display ";delete locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 1))
- (snd-display ";vct .5 at 1 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 1: ~A" (channel->vct 0 10)))
- (delete-samples 30 10)
- (if (not (mix? id))
- (snd-display ";delete 30 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 1))
- (snd-display ";vct .5 at 1 position del 30: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 1 del 30: ~A" (channel->vct 0 10)))
- (delete-samples 3 3)
-; (if (mix? id) (snd-display ";delete within mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display ";delete within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 0 0 0 0 0 0 0)))
- (snd-display ";vct .5 at 1 del at 3: ~A" (channel->vct 0 10)))
-
- (set! (edit-position) 1)
- (if (not (mix? id)) (snd-display ";mix vct after del reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display ";mix vct position after del reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 after del reset edit: ~A" (channel->vct 10 10)))
-
- ;; change
- (set! (samples 0 5) (make-vct 5 .6))
- (if (not (mix? id))
- (snd-display ";set locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 set position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 set: ~A" (channel->vct 10 10)))
- (set! (samples 20 5) (make-vct 5 .7))
- (if (not (mix? id))
- (snd-display ";set 20 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 set 20 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 set 20: ~A" (channel->vct 10 10)))
- (set! (samples 12 2) (vct -.5 .8))
-; (if (mix? id) (snd-display ";set within mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display ";set within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 -.5 .8 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 set at 12: ~A" (channel->vct 10 10)))
-
- (set! (edit-position) 1)
- (if (not (mix? id)) (snd-display ";mix vct after set reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display ";mix vct position after set reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 after set reset edit: ~A" (channel->vct 10 10)))
-
- ;; scale
- (scale-channel 2.0)
- (if (not (mix? id))
- (snd-display ";scale locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 scale position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 1 1 1 1 1 0 0 0 0)))
- (snd-display ";vct 1 at 11 scale: ~A" (channel->vct 10 10)))
- (scale-channel 0.5)
- (if (not (mix? id))
- (snd-display ";unscale locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 unscale position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct 1 at 11 unscale: ~A" (channel->vct 10 10)))
- (scale-channel -1.0 0 5)
- (if (not (mix? id))
- (snd-display ";scale at 0 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 scale at 0 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct 1 at 11 scale at 0: ~A" (channel->vct 10 10)))
- (scale-channel -1.0 22 10)
- (if (not (mix? id))
- (snd-display ";scale at 22 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 scale at 22 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct 1 at 11 scale at 22: ~A" (channel->vct 10 10)))
- (scale-channel 2.0 12 2)
-; (if (mix? id) (snd-display ";scale within mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display ";scale within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 1 1 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 scale at 12: ~A" (channel->vct 10 10)))
-
- (set! (edit-position) 1)
- (if (not (mix? id)) (snd-display ";mix vct after scale reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display ";mix vct position after scale reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 after scale reset edit: ~A" (channel->vct 10 10)))
-
- ;; envelopes
- (env-channel '(0 0 1 1) 0 8)
- (if (not (mix? id))
- (snd-display ";env locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 env position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct 1 at 11 env: ~A" (channel->vct 10 10)))
- (env-channel '(0 0 1 1) 17 10)
- (if (not (mix? id))
- (snd-display ";env 17 locked mix? ~A" (mix? id)))
- (if (not (= (mix-position id) 11))
- (snd-display ";vct .5 at 11 env 17 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct 1 at 11 env 17: ~A" (channel->vct 10 10)))
- (env-channel '(0 0 1 1))
-; (if (mix? id) (snd-display ";env over mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display ";env over mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0.000 0.056 0.061 0.066 0.071 0.076 0.000 0.000 0.000 0.000)))
- (snd-display ";vct .5 at 11 over env: ~A" (channel->vct 10 10)))
-
- (set! (edit-position) 1)
-; (if (not (mix? id)) (snd-display ";mix vct after env reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display ";mix vct position after env reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display ";vct .5 at 11 after env reset edit: ~A" (channel->vct 10 10)))
-
- (ptree-channel (lambda (y) (* y 2)))
-; (if (mix? id) (snd-display ";ptree over mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display ";ptree over mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 1 1 1 1 1 0 0 0 0)))
- (snd-display ";vct 1 at 11 after ptree: ~A" (channel->vct 10 10)))
- (undo)
- (scale-by 0.0)
-; (if (mix? id) (snd-display ";zero mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display ";zero mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 0 0 0 0 0 0 0 0 0)))
- (snd-display ";vct 1 at 11 scale 0: ~A" (channel->vct 10 10)))
- (undo 2)
-
- (let ((ids '()))
- (do ((i 0 (+ 1 i)))
- ((= i 5))
- (set! ids (cons (mix-vct (make-vct 5 .1) (+ i 10)) ids)))
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
- (snd-display ";pile up mixes: ~A" vals)))
- (let ((mx (mixes-maxamp ids)))
- (if (fneq mx .1)
- (snd-display ";mixes-maxamp: ~A" mx)))
- (let ((len (mixes-length ids)))
- (if (not (= len 10))
- (snd-display ";mixes-length: ~A" len)))
- (sync-all-mixes 21)
- (for-each (lambda (m) (if (not (= (mix-sync m) 21)) (snd-display ";sync-all-mixes ~A: ~A" m (mix-sync m)))) ids)
- (sync-all-mixes 0)
- (for-each (lambda (m) (if (not (= (mix-sync m) 0)) (snd-display ";re sync-all-mixes ~A: ~A" m (mix-sync m)))) ids)
- (scale-mixes ids -2.0)
- (for-each (lambda (m) (if (fneq (mix-amp m) -2.0) (snd-display ";scale-mixes ~A: ~A" m (mix-amp m)))) ids)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 -0.200 -0.400 -0.600 -0.800 -1.000 -0.800 -0.600 -0.400 -0.200 0.000 0.000 0.000)))
- (snd-display ";scale piled up mixes: ~A" vals)))
- (silence-mixes ids)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (make-vct 14 0.0)))
- (snd-display ";silence piled up mixes: ~A" vals)))
- (undo 2)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
- (snd-display ";undo 2 to pile up mixes: ~A" vals)))
- (play-mixes ids)
- (set-mixes-tag-y ids 100)
- (for-each (lambda (m) (if (not (= (mix-tag-y m) 100)) (snd-display ";set-mixes-tag-y ~A: ~A" m (mix-tag-y m)))) ids)
- (set-mixes-tag-y ids 0)
- (move-mixes ids 10)
- (let ((vals (channel->vct 18 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
- (snd-display ";move piled up mixes: ~A" vals)))
- (let ((vals (channel->vct 8 8)))
- (if (not (vequal vals (make-vct 8 0.0)))
- (snd-display ";move piled up mixes original: ~A" vals)))
- (move-mixes ids -10)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
- (snd-display ";move piled up mixes -10: ~A" vals)))
- (let ((vals (channel->vct 23 8)))
- (if (not (vequal vals (make-vct 8 0.0)))
- (snd-display ";move piled up mixes -10: ~A" vals)))
- (for-each (lambda (m) (set! (mix-sync m) 24)) ids)
- (let ((mxs (syncd-mixes 24)))
- (if (not (= (length mxs) (length ids)))
- (snd-display ";syncd-mixes: ~A ~A" mxs ids))
- (for-each (lambda (m) (if (not (member m ids)) (snd-display ";syncd-mixes: ~A not in ~A" m ids))) mxs))
- (sync-all-mixes 0)
- (save-mixes ids "fmv.snd")
- (let ((ind1 (open-sound "fmv.snd")))
- (let ((data (channel->vct 0 #f ind1)))
- (if (not (vequal data (vct 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0)))
- (snd-display ";save-mixes: ~A" data)))
- (close-sound ind1)
- (mus-sound-forget "fmv.snd")
- (delete-file "fmv.snd"))
- (env-mixes ids '(0 0 1 1 2 0))
- (let ((vals (channel->vct 10 10)))
- (if (not (vequal vals (vct 0.000 0.045 0.137 0.278 0.460 0.360 0.203 0.087 0.020 0.000)))
- (snd-display ";env-mixes: ~A" vals)))
- (undo 3)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
- (snd-display ";undo 3 mixes envd: ~A" vals)))
- (color-mixes ids (make-color 0 1 0))
- (scale-tempo ids 2.0)
- (let ((begs (map mix-position ids)))
- (if (not (equal? begs (list 18 16 14 12 10)))
- (snd-display ";scale-tempo by 2: ~A" begs)))
- (let ((vals (channel->vct 10 15)))
- (if (not (vequal vals (vct 0.100 0.100 0.200 0.200 0.300 0.200 0.300 0.200 0.300 0.200 0.200 0.100 0.100 0.000 0.000)))
- (snd-display ";scale-tempo 2 vals: ~A" vals)))
- (scale-tempo ids 0.5)
- (let ((begs (map mix-position ids)))
- (if (not (equal? begs (list 14 13 12 11 10)))
- (snd-display ";scale-tempo by 0.5: ~A" begs)))
- (let ((vals (channel->vct 10 10)))
- (if (not (vequal vals (vct 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
- (snd-display ";scale-tempo back 0.5: ~A" vals)))
- (scale-tempo ids -1.0)
- (let ((begs (map mix-position ids)))
- (if (not (equal? begs (list 6 7 8 9 10)))
- (snd-display ";scale-tempo by -1: ~A" begs)))
- (let ((vals (channel->vct 0 15)))
- (if (not (vequal vals (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100)))
- (snd-display ";scale-tempo -1 vals: ~A" vals)))
- (undo 3)
- (set! (sinc-width) 10)
- (src-mixes ids 0.5)
- (if (fneq (mix-speed (car ids)) 0.5)
- (snd-display ";src-mixes speed: ~A" (mix-speed (car ids))))
- (if (not (= (mixes-length ids) 15))
- (snd-display ";src-mixes length: ~A" (mixes-length ids)))
- (let ((vals (channel->vct 10 15)))
- (if (not (vequal vals (vct 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
- (snd-display ";src-mixes 0.5 vals: ~A" vals)))
- (if (not (vequal (mix->vct (car ids)) (mix->vct (cadr ids))))
- (snd-display ";src-mixes vals don't match: ~A ~A" (mix->vct (car ids)) (mix->vct (cadr ids))))
+
+ (let ((id (open-sound "oboe.snd")))
+ (make-selection 1000 2000 id 0)
+ (let ((mix-id (car (mix-selection 3000 id 0))))
+ (set! (mix-amp mix-id) .5)
+ (if (fneq (mix-amp mix-id) .5)
+ (snd-display #__line__ ";mix-amp .5: ~A" (mix-amp mix-id)))
+ (scale-by .5)
(undo)
- (transpose-mixes ids -12)
- (if (fneq (mix-speed (car ids)) 0.5)
- (snd-display ";transpose-mixes speed: ~A" (mix-speed (car ids))))
- (if (not (= (mixes-length ids) 15))
- (snd-display ";transpose-mixes length: ~A" (mixes-length ids)))
- (let ((vals (channel->vct 10 15)))
- (if (not (vequal vals (vct 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
- (snd-display ";transpose-mixes 0.5 vals: ~A" vals)))
- (if (not (vequal (mix->vct (car ids)) (mix->vct (cadr ids))))
- (snd-display ";transpose-mixes vals don't match: ~A ~A" (mix->vct (car ids)) (mix->vct (cadr ids))))
- (revert-sound))
- (close-sound ind)))
-
- ;; check locks
- (let ((ind (new-sound "test.snd" :size 100)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (if (not (mix? id))
- (snd-display ";mix lock 0: ~A ~A" id (mix? id)))
- (ptree-channel (lambda (y) .5) 0 20)
- (if (not (mix? id))
- (snd-display ";mix lock 1: ~A ~A" id (mix? id)))
- (ptree-channel (lambda (y) .5) 0 20)
- (if (not (mix? id))
- (snd-display ";mix lock 2: ~A ~A" id (mix? id)))
- (undo)
- (if (not (mix? id))
- (snd-display ";mix lock 3: ~A ~A" id (mix? id)))
- (ptree-channel (lambda (y) .5) 25 20)
- (if (not (mix? id))
- (snd-display ";mix lock 4: ~A ~A" id (mix? id)))
+ (close-sound id)))
+ (set! (print-length) 30)
+
+ (let* ((ind (open-sound "2.snd"))
+ (md (car (mix "1a.snd" 1000 0 ind 1 #t))))
+ (if (fneq (maxamp ind 1) .1665) (snd-display #__line__ ";maxamp after mix into chan 2: ~A" (maxamp ind 1)))
+ (set! (mix-amp md) 0.0)
+ (if (or (not (equal? (edits ind 0) (list 0 0)))
+ (not (equal? (edits ind 1) (list 2 0))))
+ (snd-display #__line__ ";mix into chan2 zeroed: ~A ~A" (edits ind 0) (edits ind 1)))
+ (if (fneq (maxamp ind 1) .066) (snd-display #__line__ ";maxamp after mix zeroed into chan 2: ~A" (maxamp ind 1)))
+ (set! (mix-amp md) 0.5)
+ (if (fneq (maxamp ind 1) .116) (snd-display #__line__ ";maxamp after mix 0.5 into chan 2: ~A" (maxamp ind 1)))
+ (set! (mix-speed md) 2.0)
+ (if (fneq (/ (mix-length md) (mus-sound-frames "1a.snd")) 0.5)
+ (snd-display #__line__ ";mix srate chan 2: ~A ~A" (mix-length md) (mus-sound-frames "1a.snd")))
+ (update-time-graph)
+ (set! (mix-speed md) 0.5)
+ (update-time-graph)
+ (set! (mix-amp md) 1.0)
+ (if (fneq (maxamp ind 1) .166)
+ (snd-display #__line__ ";non-sync mix-speed maxamp: ~A" (maxamp ind 1)))
+ (set! (mix-amp-env md) '(0 0 1 1 2 0))
+ (update-time-graph)
+ (set! (mix-speed md) 1.0)
+ (update-time-graph)
+ (revert-sound ind)
+ (set! (sync ind) 1)
+ (let ((m0 (maxamp ind 0))
+ (m1 (maxamp ind 1))
+ (len (frames ind 0)))
+ (set! md (mix "2.snd" 0 #t)) ; should double both chans, no len change
+ (if (or (not (= (frames ind 0) len))
+ (fneq (maxamp ind 0) (* 2 m0))
+ (fneq (maxamp ind 1) (* 2 m1)))
+ (snd-display #__line__ ";mix twice syncd: 0: ~A -> ~A, m1: ~A -> ~A, len: ~A -> ~A"
+ m0 (maxamp ind 0) m1 (maxamp ind 1) len (frames ind 0)))
+ (reset-hook! mix-release-hook)
+ (close-sound ind)))
+
+ (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "mix tests")))
+ (insert-silence 0 20 ind)
+ (let ((indout (new-sound "test.snd" mus-next mus-bshort 22050 1 "mix tests")))
+ (insert-silence 0 10 indout)
+ (set! (sample 2 indout 0) .5)
+ (set! (sample 5 indout 0) .25)
+ (save-sound indout)
+ (close-sound indout))
+ (let ((tag (car (mix "test.snd"))))
+ (let ((samps (channel->vct 0 20))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 2 .5)
+ (vct-set! v 5 .25)
+ (if (not (vequal samps v))
+ (snd-display #__line__ ";mix 1->1: ~A ~A" samps v)))
+ (if (not (mix? tag)) (snd-display #__line__ ";mix 1->1 tag: ~A" tag))
+ (undo))
+ (let ((tag (car (mix "test.snd" 5))))
+ (let ((samps (channel->vct 0 20))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 7 .5)
+ (vct-set! v 10 .25)
+ (if (not (vequal samps v))
+ (snd-display #__line__ ";mix 1->1 at 5: ~A ~A" samps v)))
+ (if (not (mix? tag)) (snd-display #__line__ ";mix 1->1 at 5 tag: ~A" tag))
+ (undo))
+ (let ((tag (mix "test.snd" 0 0 ind 0 #f)))
+ (let ((samps (channel->vct 0 20))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 2 .5)
+ (vct-set! v 5 .25)
+ (if (not (vequal samps v))
+ (snd-display #__line__ ";mix 1->1 at 0 #f: ~A ~A" samps v)))
+ (if (mix? tag) (snd-display #__line__ ";mix 1->1 at 5 #f tag: ~A" tag))
+ (undo))
+ (let ((indout (new-sound "test.snd" mus-next mus-bshort 22050 2 "mix tests")))
+ (insert-silence 0 10 indout 0)
+ (insert-silence 0 10 indout 1)
+ (set! (sample 2 indout 0) .5)
+ (set! (sample 5 indout 0) .25)
+ (set! (sample 2 indout 1) .95)
+ (set! (sample 5 indout 1) .125)
+ (save-sound indout)
+ (close-sound indout))
+ (let ((tag (car (mix "test.snd" 0 1))))
+ (let ((samps (channel->vct 0 20))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 2 .95)
+ (vct-set! v 5 .125)
+ (if (not (vequal samps v))
+ (snd-display #__line__ ";mix 2->1: ~A ~A" samps v)))
+ (if (not (mix? tag)) (snd-display #__line__ ";mix 2->1 tag: ~A" tag))
+ (undo))
+ (let ((tag (car (mix "test.snd" 5 1))))
+ (let ((samps (channel->vct 0 20))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 7 .95)
+ (vct-set! v 10 .125)
+ (if (not (vequal samps v))
+ (snd-display #__line__ ";mix 2->1 at 5: ~A ~A" samps v)))
+ (if (not (mix? tag)) (snd-display #__line__ ";mix 2->1 at 5 tag: ~A" tag))
+ (undo))
+ (close-sound ind)
+ (set! ind (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "mix tests"))
+ (insert-silence 0 20 ind 0)
+ (insert-silence 0 20 ind 1)
+ (let ((tag (car (mix "test.snd" 0 #t))))
+ (let ((samps0 (channel->vct 0 20 ind 0))
+ (samps1 (channel->vct 0 20 ind 1))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 2 .95)
+ (vct-set! v 5 .125)
+ (if (not (vequal samps1 v))
+ (snd-display #__line__ ";mix 1->1 (2): ~A ~A" samps1 v))
+ (vct-set! v 2 .5)
+ (vct-set! v 5 .25)
+ (if (not (vequal samps0 v))
+ (snd-display #__line__ ";mix 1->1 (3): ~A ~A" samps0 v)))
+ (if (not (mix? tag)) (snd-display #__line__ ";mix 1->1 tag: ~A" tag))
+ (undo 1 ind 0)
+ (undo 1 ind 1))
+ (let ((tag (mix "test.snd" 0 1 ind 1 #f))) ; samp:0, in-chan: 1
+ (let ((samps0 (channel->vct 0 20 ind 0))
+ (samps1 (channel->vct 0 20 ind 1))
+ (v (make-vct 20 0.0)))
+ (if (not (vequal samps0 v))
+ (snd-display #__line__ ";mix 1->1 (4): ~A ~A" samps0 v))
+ (vct-set! v 2 .95)
+ (vct-set! v 5 .125)
+ (if (not (vequal samps1 v))
+ (snd-display #__line__ ";mix 1->1 (5): ~A ~A" samps1 v)))
+ (if (mix? tag) (snd-display #__line__ ";mix 1->1 tag (5): ~A" tag))
+ (undo 1 ind 1))
+ (set! (sync ind) 1)
+ (let ((tag (car (mix "test.snd" 0 #t))))
+ (let ((samps0 (channel->vct 0 20 ind 0))
+ (samps1 (channel->vct 0 20 ind 1))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 2 .5)
+ (vct-set! v 5 .25)
+ (if (not (vequal samps0 v))
+ (snd-display #__line__ ";mix 1->1 (6): ~A ~A" samps0 v))
+ (vct-set! v 2 .95)
+ (vct-set! v 5 .125)
+ (if (not (vequal samps1 v))
+ (snd-display #__line__ ";mix 1->1 (7): ~A ~A" samps1 v)))
+ (undo))
+ (set! (cursor ind) 5)
+ (let ((tag (car (mix "test.snd" (cursor) #t))))
+ (let ((samps0 (channel->vct 0 20 ind 0))
+ (samps1 (channel->vct 0 20 ind 1))
+ (v (make-vct 20 0.0)))
+ (vct-set! v 7 .5)
+ (vct-set! v 10 .25)
+ (if (not (vequal samps0 v))
+ (snd-display #__line__ ";mix 1->1 (8): ~A ~A" samps0 v))
+ (vct-set! v 7 .95)
+ (vct-set! v 10 .125)
+ (if (not (vequal samps1 v))
+ (snd-display #__line__ ";mix 1->1 (9): ~A ~A" samps1 v)))
+ (undo))
+ (close-sound ind))
+ (delete-file "test.snd")
+ (delete-file "fmv.snd")
+
+ ;; check ripple_mixes
+ (let* ((ind (open-sound "oboe.snd"))
+ (data (channel->vct 100 100))
+ (m1 (mix-vct data 321 ind 0 #t))
+ (m2 (mix-vct data 123 ind 0 #t)))
+ (set! (mix-position m1) 500)
+ (if (not (= (mix-position m1) 500)) (snd-display #__line__ ";mix-position m1[0]: ~A" (mix-position m1)))
+ (if (not (= (mix-position m2) 123)) (snd-display #__line__ ";mix-position m2[0]: ~A" (mix-position m2)))
(undo)
- (ramp-channel 0.0 1.0 0 20)
- (if (not (mix? id))
- (snd-display ";mix lock 5: ~A ~A" id (mix? id)))
+ (set! (mix-position m2) 500)
+ (if (not (= (mix-position m2) 500)) (snd-display #__line__ ";mix-position m2[1]: ~A" (mix-position m2)))
+ (if (not (= (mix-position m1) 321)) (snd-display #__line__ ";mix-position m1[1]: ~A" (mix-position m1)))
(undo)
- (xramp-channel 0.0 1.0 32.0 0 20)
- (if (not (mix? id))
- (snd-display ";mix lock 6: ~A ~A" id (mix? id)))
+ (insert-silence 0 100)
+ (if (not (= (mix-position m1) (+ 100 321))) (snd-display #__line__ ";mix-position m1[2]: ~A" (mix-position m1)))
+ (if (not (= (mix-position m2) (+ 100 123))) (snd-display #__line__ ";mix-position m2[2]: ~A" (mix-position m2)))
+ (delete-samples 0 50)
+ (if (not (= (mix-position m1) (+ 50 321))) (snd-display #__line__ ";mix-position m1[3]: ~A" (mix-position m1)))
+ (if (not (= (mix-position m2) (+ 50 123))) (snd-display #__line__ ";mix-position m2[3]: ~A" (mix-position m2)))
(undo 2)
- (delete-sample 52)
- (if (not (mix? id))
- (snd-display ";mix lock 7: ~A ~A" id (mix? id)))
- (undo)
- (delete-sample 10)
- (if (not (mix? id))
- (snd-display ";mix lock 8: ~A ~A" id (mix? id)))
+ (set! (mix-position m2) 500)
(undo)
- (insert-samples 51 2 (vct .1 .2))
- (if (not (mix? id))
- (snd-display ";mix lock 9: ~A ~A" id (mix? id)))
+ (scale-channel 0.5 1000 100)
+ (if (not (= (mix-position m2) 123)) (snd-display #__line__ ";mix-position m2[5]: ~A" (mix-position m2)))
+ (if (not (= (mix-position m1) 321)) (snd-display #__line__ ";mix-position m1[5]: ~A" (mix-position m1)))
(undo)
- (insert-samples 1 2 (vct .1 .2))
- (if (not (mix? id))
- (snd-display ";mix lock 10: ~A ~A" id (mix? id)))
+ (set! (mix-position m2) 500)
(undo)
- (set! (sample 51) 1.0)
- (if (not (mix? id))
- (snd-display ";mix lock 11: ~A ~A" id (mix? id)))
+ (ptree-channel (lambda (y) (* y 0.5)) 2000 100)
+ (if (not (= (mix-position m2) 123)) (snd-display #__line__ ";mix-position m2[6]: ~A" (mix-position m2)))
+ (if (not (= (mix-position m1) 321)) (snd-display #__line__ ";mix-position m1[6]: ~A" (mix-position m1)))
(undo)
- (set! (sample 1) 1.0)
- (if (not (mix? id))
- (snd-display ";mix lock 12: ~A ~A" id (mix? id)))
+ (set! (mix-position m2) 500)
+ (undo-edit)
+ (ramp-channel 0.0 1.0 3000 100)
+ (catch #t
+ (lambda ()
+ (if (not (= (mix-position m2) 123)) (snd-display #__line__ ";mix-position m2[7]: ~A" (mix-position m2)))
+ (if (not (= (mix-position m1) 321)) (snd-display #__line__ ";mix-position m1[7]: ~A" (mix-position m1))))
+ (lambda args (snd-display #__line__ ";mix-position trouble: ~A" args)))
(undo)
- (xramp-channel 0 1 32 0 40)
- (if (not (mix? id))
- (snd-display ";mix lock 13: ~A ~A" id (mix? id)))
- (xramp-channel 0 1 32 0 40)
- (if (not (mix? id))
- (snd-display ";mix lock 14: ~A ~A" id (mix? id)))
- (close-sound ind)))
-
- (do ((i 0 (+ 1 i)))
- ((= i 2))
-
- (let ((ind (new-sound "test.snd" :size 100))
- (tag (with-mix-tags)))
-
- ;; check various mix ops briefly
- (map-channel (lambda (y) 1.0))
- (env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576)))
- (snd-display ";mix on env: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on env: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 5)))
- (snd-display ";mix on env edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576))))
- (snd-display ";read mix on env reversed: ~A" data)))
- (undo))
-
- (env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331)))
- (snd-display ";mix on env 1: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on env 1: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 7)))
- (snd-display ";mix on env1 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331))))
- (snd-display ";read mix on env1 reversed: ~A" data)))
- (undo))
-
- (env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191)))
- (snd-display ";mix on env 2: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on env 2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
- (snd-display ";mix on env2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191))))
- (snd-display ";read mix on env2 reversed: ~A" data)))
- (undo))
-
- (env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110)))
- (snd-display ";mix on env 3: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on env 3: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
- (snd-display ";mix on env3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110))))
- (snd-display ";read mix on env3 reversed: ~A" data)))
- (undo))
-
- (env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063)))
- (snd-display ";mix on env 4: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on env 4: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
- (snd-display ";mix on env4 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063))))
- (snd-display ";read mix on env4 reversed: ~A" data)))
- (undo))
-
- (set! (edit-position ind 0) 1)
- (xramp-channel 1 0 32.0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108)))
- (snd-display ";mix on xramp: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on xramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 9)))
- (snd-display ";mix on xramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108))))
- (snd-display ";read mix on xramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (xramp-channel 1 0 32.0)
- (xramp-channel 1 0 32.0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012)))
- (snd-display ";mix on xramp2: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on xramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 13)))
- (snd-display ";mix on xramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012))))
- (snd-display ";read mix on xramp2 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (xramp-channel 1 0 32.0)
- (xramp-channel 1 0 32.0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005)))
- (snd-display ";mix on xramp2_ramp: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on xramp2_ramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display ";mix on xramp2_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005))))
- (snd-display ";read mix on xramp2_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (xramp-channel 1 0 32.0)
- (xramp-channel 1 0 32.0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002)))
- (snd-display ";mix on xramp2_ramp2: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on xramp2_ramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display ";mix on xramp2_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002))))
- (snd-display ";read mix on xramp2_ramp2 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (xramp-channel 1 0 32.0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046)))
- (snd-display ";mix on xramp_ramp: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on xramp_ramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display ";mix on xramp_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046))))
- (snd-display ";read mix on xramp_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (xramp-channel 1 0 32.0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019)))
- (snd-display ";mix on xramp_ramp2: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on xramp_ramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display ";mix on xramp_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019))))
- (snd-display ";read mix on xramp_ramp2 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (xramp-channel 1 0 32.0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008)))
- (snd-display ";mix on xramp_ramp3: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on xramp_ramp3: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display ";mix on xramp_ramp3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008))))
- (snd-display ";read mix on xramp_ramp3 reversed: ~A" data))))
-
- (set! (with-mix-tags) #t)
- (set! (optimization) 6)
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.500 0.500 0.600 0.700 0.800 0.500 0.500 0.500 0.500 0.500)))
- (snd-display ";mix on ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 17)))
- (snd-display ";mix on ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.500 0.500 0.600 0.700 0.800 0.500 0.500 0.500 0.500 0.500))))
- (snd-display ";read mix on ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
- (snd-display ";mix on ptree_ramp: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ptree_ramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display ";mix on ptree_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
- (snd-display ";read mix on ptree_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display ";mix on ptree_ramp2: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ptree_ramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display ";mix on ptree_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display ";read mix on ptree_ramp2 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display ";mix on ptree_ramp3: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ptree_ramp3: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display ";mix on ptree_ramp3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display ";read mix on ptree_ramp3 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display ";mix on ptree_ramp4: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ptree_ramp4: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display ";mix on ptree_ramp4 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display ";read mix on ptree_ramp4 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 0)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 1.0))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 1.000 1.000 1.100 1.200 1.300 1.000 1.000 1.000 1.000 1.000)))
- (snd-display ";mix on ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 19)))
- (snd-display ";mix on ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 1.000 1.000 1.100 1.200 1.300 1.000 1.000 1.000 1.000 1.000))))
- (snd-display ";read mix on ptree_zero reversed: ~A" data))))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
- (snd-display ";mix on ramp_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display ";mix on ramp_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
- (snd-display ";read mix on ramp_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display ";mix on ramp2_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp2_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display ";mix on ramp2_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display ";read mix on ramp2_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display ";mix on ramp3_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp3_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display ";mix on ramp3_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display ";read mix on ramp3_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display ";mix on ramp4_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp4_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display ";mix on ramp4_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display ";read mix on ramp4_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
- (snd-display ";mix on ramp_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display ";mix on ramp_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
- (snd-display ";read mix on ramp_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display ";mix on ramp2_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp2_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display ";mix on ramp2_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display ";read mix on ramp2_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display ";mix on ramp3_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp3_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display ";mix on ramp3_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display ";read mix on ramp3_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display ";mix on ramp4_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display ";mix on ramp4_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display ";mix on ramp4_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display ";read mix on ramp4_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display ";mix on ramp_ptree_ramp: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display ";read mix on ramp_ptree_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display ";mix on ramp_ptree_ramp2: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
+ (delay-channel-mixes 200 100 ind 0)
+ (if (not (= (mix-position m2) 123)) (snd-display #__line__ ";delay-channel mixes mix-position m2: ~A" (mix-position m2)))
+ (if (not (= (mix-position m1) 421)) (snd-display #__line__ ";delay-channel-mixes mix-position m1: ~A" (mix-position m1)))
+ (check-mix-tags ind 0)
+ (close-sound ind))
+
+ ;; check that current console is correct
+ (let ((ind (open-sound "storm.snd")))
+ (set! (x-bounds) (list 0 80.0))
+ (make-selection 1000000 1050000)
+ (let ((m1 (car (mix-selection 900000)))
+ (m2 (car (mix-selection 400000))))
+ (as-one-edit (lambda ()
+ (set! (mix-position m1) 0)
+ (set! (mix-position m2) 1)))
+ (if (or (not (= (mix-position m1) 0))
+ (not (= (mix-position m2) 1)))
+ (snd-display #__line__ ";as-one-edit positions: ~A ~A" (mix-position m1) (mix-position m2)))
+ (undo-channel)
+ (if (or (not (= (mix-position m1) 900000))
+ (not (= (mix-position m2) 400000)))
+ (snd-display #__line__ ";as-one-edit positions after undo: (~A): ~A (~A): ~A" m1 (mix-position m1) m2 (mix-position m2)))
+ (redo-channel)
+ (if (or (not (= (mix-position m1) 0))
+ (not (= (mix-position m2) 1)))
+ (snd-display #__line__ ";as-one-edit positions after redo: ~A ~A" (mix-position m1) (mix-position m2)))
+ (close-sound ind)))
+
+ (let ((ind (open-sound "2.snd")))
+ (make-selection 0 10000 ind)
+ (if (not (= (selection-chans) 2))
+ (snd-display #__line__ ";stereo selection: ~A" (selection-chans)))
+ (set! (sync ind) #t)
+ (let ((md (car (mix-selection 500 ind))))
+ (if (not (mix? (integer->mix (+ 1 (mix->integer md)))))
+ (snd-display #__line__ ";where is 2nd mix? ~A ~A" md (mixes)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";edit-position 0 after stereo mix selection: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 1) 1))
+ (snd-display #__line__ ";edit-position 1 after stereo mix selection: ~A" (edit-position ind 1)))
+ (set! (sync ind) #f)
+ (undo-edit 1 ind 0)
+ (delete-sample 25 ind 0)
+ (set! (mix-position (integer->mix (+ 1 (mix->integer md)))) 750)
+ (if (not (= (edit-position ind 1) 2))
+ (snd-display #__line__ ";edit-position 1 after stereo mix selection moved: ~A" (edit-position ind 2)))
+ (revert-sound ind)
+ (close-sound ind)))
+
+ (let ((ind (new-sound "test.snd"))
+ (v (make-vct 20)))
+ (do ((i 0 (+ 1 i))) ((= i 20)) (vct-set! v i (* i .01)))
+ (vct->channel v)
+ (do ((i 0 (+ 1 i))) ((= i 20)) (vct-set! v i (* i -.01)))
+ (let ((mx (mix-vct v 10)))
+ (let ((hi (make-mix-sampler mx))
+ (ho (make-mix-sampler mx 5))
+ (happy #t))
(do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display ";read mix on ramp_ptree_ramp2 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display ";mix on ramp_ptree_ramp3: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
+ ((or (not happy) (= i 10)))
+ (let ((ho-val (ho))
+ (hi-val (hi)))
+ (if (fneq hi-val (* i -.01))
+ (begin
+ (snd-display #__line__ ";mix-reader at ~A from 0: ~A" i hi-val)
+ (set! happy #f)))
+ (if (fneq ho-val (* (+ i 5) -.01))
+ (begin
+ (snd-display #__line__ ";mix-reader at ~A from 5: ~A" i ho-val)
+ (set! happy #f)))))))
+ (revert-sound ind)
+ (set! v (make-vct 21))
+ (vct-fill! v 0.5)
+ (vct->channel v)
+ (let ((mx (mix-vct v 10)))
+ (set! (mix-amp-env mx) '(0 0 1 1))
+ (let ((hi (make-mix-sampler mx 0))
+ (ho (make-mix-sampler mx 10))
+ (happy #t))
(do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display ";read mix on ramp_ptree_ramp3 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display ";mix on ramp2_ptree_ramp: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
+ ((or (not happy) (= i 10)))
+ (let ((ho-val (ho))
+ (hi-val (hi)))
+ (if (fneq hi-val (* i .025))
+ (begin
+ (snd-display #__line__ ";mix-reader env'd at ~A from 0: ~A" i hi-val)
+ (set! happy #f)))
+ (if (fneq ho-val (* (+ i 10) .025))
+ (begin
+ (snd-display #__line__ ";mix-reader env'd at ~A from 10: ~A" i ho-val)
+ (set! happy #f)))))))
+ (close-sound ind))
+
+ (let* ((ind (open-sound "oboe.snd"))
+ (id (mix-vct (make-vct 10 .1))))
+ (set! (mix-position id) 100)
+ (if (or (not (= (mix-position id) 100))
+ (not (= (edit-position ind 0) 2)))
+ (snd-display #__line__ ";mix-position init: ~A ~A" (mix-position id) (edit-position ind 0)))
+ (set! (mix-position id) 100)
+ (if (or (not (= (mix-position id) (mix-position id)))
+ (not (= (edit-position ind 0) 2)))
+ (snd-display #__line__ ";mix-position 2 (no-op): ~A ~A" (mix-position id) (edit-position ind 0)))
+ (set! (mix-amp id) 1.0)
+ (if (or (fneq (mix-amp id) 1.0)
+ (not (= (edit-position ind 0) 2)))
+ (snd-display #__line__ ";mix-amp no-op: ~A ~A" (mix-amp id) (edit-position ind 0)))
+ (set! (mix-amp id) 0.5)
+ (if (or (fneq (mix-amp id) 0.5)
+ (not (= (edit-position ind 0) 3)))
+ (snd-display #__line__ ";mix-amp .5: ~A ~A" (mix-amp id) (edit-position ind 0)))
+ (set! (mix-amp id) (mix-amp id))
+ (if (or (fneq (mix-amp id) 0.5)
+ (not (= (edit-position ind 0) 3)))
+ (snd-display #__line__ ";mix-amp no-op: ~A ~A" (mix-amp id) (edit-position ind 0)))
+ (set! (mix-speed id) 1.0)
+ (if (or (fneq (mix-speed id) 1.0)
+ (not (= (edit-position ind 0) 3)))
+ (snd-display #__line__ ";mix-speed no-op: ~A ~A" (mix-speed id) (edit-position ind 0)))
+ (set! (mix-speed id) .5)
+ (if (or (fneq (mix-speed id) 0.5)
+ (not (= (edit-position ind 0) 4)))
+ (snd-display #__line__ ";mix-speed .5: ~A ~A" (mix-speed id) (edit-position ind 0)))
+ (set! (mix-speed id) (mix-speed id))
+ (if (or (fneq (mix-speed id) 0.5)
+ (not (= (edit-position ind 0) 4)))
+ (snd-display #__line__ ";mix-speed 2 no-op: ~A ~A" (mix-speed id) (edit-position ind 0)))
+ (set! (mix-amp-env id) '(0 0 1 1))
+ (if (not (= (edit-position ind 0) 5))
+ (snd-display #__line__ ";mix-amp-env init: ~A ~A" (mix-amp-env id) (edit-position ind 0)))
+ (set! (mix-amp-env id) '(0 0 1 1))
+ (if (not (= (edit-position ind 0) 5))
+ (snd-display #__line__ ";mix-amp-env no-op: ~A ~A" (mix-amp-env id) (edit-position ind 0)))
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "color-mix tests" 300))
+ (old-color (mix-color)))
+ (set! (mix-color) (make-color-with-catch 1 1 0))
+ (let ((mix1 (mix-vct (make-vct 10 .5) 10)))
+ (if (or (not (equal? (color->list (mix-color)) (list 1.0 1.0 0.0)))
+ (not (equal? (color->list (mix-color mix1)) (list 1.0 1.0 0.0))))
+ (snd-display #__line__ ";set mix-color: ~A ~A ~A ~A"
+ (color->list (mix-color)) (color->list (mix-color mix1)) (list 1.0 1.0 0.0) (color->list old-color)))
+ (set! (mix-color) old-color)
+ (save-mix mix1 "test1.snd")
+ (let ((ind1 (open-sound "test1.snd")))
+ (if (not (= (frames ind1) (mix-length mix1))) (snd-display #__line__ ";save-mix frames: ~A ~A" (mix-length mix1) (frames ind1)))
+ (if (not (vequal (channel->vct 0 10) (mix->vct mix1)))
+ (snd-display #__line__ ";save-mix data: ~A ~A" (mix->vct mix1) (channel->vct 0 10 ind1)))
+ (close-sound ind1)
+ (if (file-exists? "test1.snd") (delete-file "test1.snd"))))
+ (close-sound ind))
+
+ (let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "lock mix tests" 300))
+ (mix1 (mix-vct (make-vct 10 .5) 10)))
+ (set! (mix-amp mix1) 0.0)
+ (if (fneq (maxamp ind 0) 0.0) (snd-display #__line__ ";delete-mix maxamp: ~A" (maxamp ind 0)))
+ (undo-channel 1 ind 0)
+ (if (fneq (maxamp ind 0) 0.5) (snd-display #__line__ ";undelete-mix maxamp: ~A" (maxamp ind 0)))
+ (redo-channel 1 ind 0)
+ (if (fneq (maxamp ind 0) 0.0) (snd-display #__line__ ";redelete-mix maxamp: ~A" (maxamp ind 0)))
+ (undo 2)
+ ; (if (mix? mix1) (snd-display #__line__ ";undo 2 kept mix?"))
+ (if (fneq (maxamp ind 0) 0.0) (snd-display #__line__ ";no delete-mix maxamp: ~A" (maxamp ind 0)))
+ (redo)
+ (if (fneq (maxamp ind 0) 0.5) (snd-display #__line__ ";reundelete-mix maxamp: ~A" (maxamp ind 0)))
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd" :size 100)))
+ (let ((id (mix-vct (make-vct 5 .5) 11)))
+
+ ;; pad-channel
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11: ~A" (channel->vct 10 10)))
+ (pad-channel 0 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";pad locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 21))
+ (snd-display #__line__ ";vct .5 at 21 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 21: ~A" (channel->vct 20 10)))
+ (if (not (vequal (channel->vct 10 10) (make-vct 10 0.0)))
+ (snd-display #__line__ ";vct .5 at 21 at 10: ~A" (channel->vct 10 10)))
+ (pad-channel 30 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";pad 30 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 21))
+ (snd-display #__line__ ";vct .5 at 21 position 30: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 21 30: ~A" (channel->vct 20 10)))
+ (pad-channel 150 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";pad 150 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 21))
+ (snd-display #__line__ ";vct .5 at 21 position 150: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 21 150: ~A" (channel->vct 20 10)))
+ (pad-channel 20 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";pad 20 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 31))
+ (snd-display #__line__ ";vct .5 at 31 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 30 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 31: ~A" (channel->vct 30 10)))
+ (pad-channel 32 3)
+ ; (if (mix? id) (snd-display #__line__ ";pad within mix but exists?: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";pad within mix but no mix?: ~A" (mix? id)))
+ (if (not (vequal (channel->vct 30 10) (vct 0 .5 0 0 0 .5 .5 .5 .5 0)))
+ (snd-display #__line__ ";vct .5 at 31 pad at 32: ~A" (channel->vct 30 10)))
+
+ (set! (edit-position) 1)
+ (if (not (mix? id)) (snd-display #__line__ ";mix vct after reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 after reset edit: ~A" (channel->vct 10 10)))
+
+ ;; delete
+ (delete-samples 0 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";delete locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 1))
+ (snd-display #__line__ ";vct .5 at 1 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 1: ~A" (channel->vct 0 10)))
+ (delete-samples 30 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";delete 30 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 1))
+ (snd-display #__line__ ";vct .5 at 1 position del 30: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 1 del 30: ~A" (channel->vct 0 10)))
+ (delete-samples 3 3)
+ ; (if (mix? id) (snd-display #__line__ ";delete within mix but exists?: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";delete within mix but no mix?: ~A" (mix? id)))
+ (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 1 del at 3: ~A" (channel->vct 0 10)))
+
+ (set! (edit-position) 1)
+ (if (not (mix? id)) (snd-display #__line__ ";mix vct after del reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after del reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 after del reset edit: ~A" (channel->vct 10 10)))
+
+ ;; change
+ (set! (samples 0 5) (make-vct 5 .6))
+ (if (not (mix? id))
+ (snd-display #__line__ ";set locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 set position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 set: ~A" (channel->vct 10 10)))
+ (set! (samples 20 5) (make-vct 5 .7))
+ (if (not (mix? id))
+ (snd-display #__line__ ";set 20 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 set 20 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 set 20: ~A" (channel->vct 10 10)))
+ (set! (samples 12 2) (vct -.5 .8))
+ ; (if (mix? id) (snd-display #__line__ ";set within mix but exists?: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";set within mix but no mix?: ~A" (mix? id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 -.5 .8 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 set at 12: ~A" (channel->vct 10 10)))
+
+ (set! (edit-position) 1)
+ (if (not (mix? id)) (snd-display #__line__ ";mix vct after set reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after set reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 after set reset edit: ~A" (channel->vct 10 10)))
+
+ ;; scale
+ (scale-channel 2.0)
+ (if (not (mix? id))
+ (snd-display #__line__ ";scale locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 scale position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 1 1 1 1 1 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 scale: ~A" (channel->vct 10 10)))
+ (scale-channel 0.5)
+ (if (not (mix? id))
+ (snd-display #__line__ ";unscale locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 unscale position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 unscale: ~A" (channel->vct 10 10)))
+ (scale-channel -1.0 0 5)
+ (if (not (mix? id))
+ (snd-display #__line__ ";scale at 0 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 scale at 0 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 scale at 0: ~A" (channel->vct 10 10)))
+ (scale-channel -1.0 22 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";scale at 22 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 scale at 22 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 scale at 22: ~A" (channel->vct 10 10)))
+ (scale-channel 2.0 12 2)
+ ; (if (mix? id) (snd-display #__line__ ";scale within mix but exists?: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";scale within mix but no mix?: ~A" (mix? id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 1 1 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 scale at 12: ~A" (channel->vct 10 10)))
+
+ (set! (edit-position) 1)
+ (if (not (mix? id)) (snd-display #__line__ ";mix vct after scale reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after scale reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 after scale reset edit: ~A" (channel->vct 10 10)))
+
+ ;; envelopes
+ (env-channel '(0 0 1 1) 0 8)
+ (if (not (mix? id))
+ (snd-display #__line__ ";env locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 env position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 env: ~A" (channel->vct 10 10)))
+ (env-channel '(0 0 1 1) 17 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";env 17 locked mix? ~A" (mix? id)))
+ (if (not (= (mix-position id) 11))
+ (snd-display #__line__ ";vct .5 at 11 env 17 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 env 17: ~A" (channel->vct 10 10)))
+ (env-channel '(0 0 1 1))
+ ; (if (mix? id) (snd-display #__line__ ";env over mix but exists?: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";env over mix but no mix?: ~A" (mix? id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0.000 0.056 0.061 0.066 0.071 0.076 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";vct .5 at 11 over env: ~A" (channel->vct 10 10)))
+
+ (set! (edit-position) 1)
+ ; (if (not (mix? id)) (snd-display #__line__ ";mix vct after env reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after env reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";vct .5 at 11 after env reset edit: ~A" (channel->vct 10 10)))
+
+ (ptree-channel (lambda (y) (* y 2)))
+ ; (if (mix? id) (snd-display #__line__ ";ptree over mix but exists?: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";ptree over mix but no mix?: ~A" (mix? id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 1 1 1 1 1 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 after ptree: ~A" (channel->vct 10 10)))
+ (undo)
+ (scale-by 0.0)
+ ; (if (mix? id) (snd-display #__line__ ";zero mix but exists?: ~A" (mix? id)))
+ (if (not (mix? id)) (snd-display #__line__ ";zero mix but no mix?: ~A" (mix? id)))
+ (if (not (vequal (channel->vct 10 10) (vct 0 0 0 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";vct 1 at 11 scale 0: ~A" (channel->vct 10 10)))
+ (undo 2)
+
+ (let ((ids '()))
(do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display ";read mix on ramp2_ptree_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
+ ((= i 5))
+ (set! ids (cons (mix-vct (make-vct 5 .1) (+ i 10)) ids)))
+ (let ((vals (channel->vct 8 14)))
+ (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (snd-display #__line__ ";pile up mixes: ~A" vals)))
+ (let ((mx (mixes-maxamp ids)))
+ (if (fneq mx .1)
+ (snd-display #__line__ ";mixes-maxamp: ~A" mx)))
+ (let ((len (mixes-length ids)))
+ (if (not (= len 10))
+ (snd-display #__line__ ";mixes-length: ~A" len)))
+ (sync-all-mixes 21)
+ (for-each (lambda (m) (if (not (= (mix-sync m) 21)) (snd-display #__line__ ";sync-all-mixes ~A: ~A" m (mix-sync m)))) ids)
+ (sync-all-mixes 0)
+ (for-each (lambda (m) (if (not (= (mix-sync m) 0)) (snd-display #__line__ ";re sync-all-mixes ~A: ~A" m (mix-sync m)))) ids)
+ (scale-mixes ids -2.0)
+ (for-each (lambda (m) (if (fneq (mix-amp m) -2.0) (snd-display #__line__ ";scale-mixes ~A: ~A" m (mix-amp m)))) ids)
+ (let ((vals (channel->vct 8 14)))
+ (if (not (vequal vals (vct 0.000 0.000 -0.200 -0.400 -0.600 -0.800 -1.000 -0.800 -0.600 -0.400 -0.200 0.000 0.000 0.000)))
+ (snd-display #__line__ ";scale piled up mixes: ~A" vals)))
+ (silence-mixes ids)
+ (let ((vals (channel->vct 8 14)))
+ (if (not (vequal vals (make-vct 14 0.0)))
+ (snd-display #__line__ ";silence piled up mixes: ~A" vals)))
+ (undo 2)
+ (let ((vals (channel->vct 8 14)))
+ (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (snd-display #__line__ ";undo 2 to pile up mixes: ~A" vals)))
+ (play-mixes ids)
+ (set-mixes-tag-y ids 100)
+ (for-each (lambda (m) (if (not (= (mix-tag-y m) 100)) (snd-display #__line__ ";set-mixes-tag-y ~A: ~A" m (mix-tag-y m)))) ids)
+ (set-mixes-tag-y ids 0)
+ (move-mixes ids 10)
+ (let ((vals (channel->vct 18 14)))
+ (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (snd-display #__line__ ";move piled up mixes: ~A" vals)))
+ (let ((vals (channel->vct 8 8)))
+ (if (not (vequal vals (make-vct 8 0.0)))
+ (snd-display #__line__ ";move piled up mixes original: ~A" vals)))
+ (move-mixes ids -10)
+ (let ((vals (channel->vct 8 14)))
+ (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (snd-display #__line__ ";move piled up mixes -10: ~A" vals)))
+ (let ((vals (channel->vct 23 8)))
+ (if (not (vequal vals (make-vct 8 0.0)))
+ (snd-display #__line__ ";move piled up mixes -10: ~A" vals)))
+ (for-each (lambda (m) (set! (mix-sync m) 24)) ids)
+ (let ((mxs (syncd-mixes 24)))
+ (if (not (= (length mxs) (length ids)))
+ (snd-display #__line__ ";syncd-mixes: ~A ~A" mxs ids))
+ (for-each (lambda (m) (if (not (member m ids)) (snd-display #__line__ ";syncd-mixes: ~A not in ~A" m ids))) mxs))
+ (sync-all-mixes 0)
+ (save-mixes ids "fmv.snd")
+ (let ((ind1 (open-sound "fmv.snd")))
+ (let ((data (channel->vct 0 #f ind1)))
+ (if (not (vequal data (vct 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0)))
+ (snd-display #__line__ ";save-mixes: ~A" data)))
+ (close-sound ind1)
+ (mus-sound-forget "fmv.snd")
+ (delete-file "fmv.snd"))
+ (env-mixes ids '(0 0 1 1 2 0))
+ (let ((vals (channel->vct 10 10)))
+ (if (not (vequal vals (vct 0.000 0.045 0.137 0.278 0.460 0.360 0.203 0.087 0.020 0.000)))
+ (snd-display #__line__ ";env-mixes: ~A" vals)))
+ (undo 3)
+ (let ((vals (channel->vct 8 14)))
+ (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (snd-display #__line__ ";undo 3 mixes envd: ~A" vals)))
+ (color-mixes ids (make-color 0 1 0))
+ (scale-tempo ids 2.0)
+ (let ((begs (map mix-position ids)))
+ (if (not (equal? begs (list 18 16 14 12 10)))
+ (snd-display #__line__ ";scale-tempo by 2: ~A" begs)))
+ (let ((vals (channel->vct 10 15)))
+ (if (not (vequal vals (vct 0.100 0.100 0.200 0.200 0.300 0.200 0.300 0.200 0.300 0.200 0.200 0.100 0.100 0.000 0.000)))
+ (snd-display #__line__ ";scale-tempo 2 vals: ~A" vals)))
+ (scale-tempo ids 0.5)
+ (let ((begs (map mix-position ids)))
+ (if (not (equal? begs (list 14 13 12 11 10)))
+ (snd-display #__line__ ";scale-tempo by 0.5: ~A" begs)))
+ (let ((vals (channel->vct 10 10)))
+ (if (not (vequal vals (vct 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
+ (snd-display #__line__ ";scale-tempo back 0.5: ~A" vals)))
+ (scale-tempo ids -1.0)
+ (let ((begs (map mix-position ids)))
+ (if (not (equal? begs (list 6 7 8 9 10)))
+ (snd-display #__line__ ";scale-tempo by -1: ~A" begs)))
+ (let ((vals (channel->vct 0 15)))
+ (if (not (vequal vals (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100)))
+ (snd-display #__line__ ";scale-tempo -1 vals: ~A" vals)))
+ (undo 3)
+ (set! (sinc-width) 10)
+ (src-mixes ids 0.5)
+ (if (fneq (mix-speed (car ids)) 0.5)
+ (snd-display #__line__ ";src-mixes speed: ~A" (mix-speed (car ids))))
+ (if (not (= (mixes-length ids) 15))
+ (snd-display #__line__ ";src-mixes length: ~A" (mixes-length ids)))
+ (let ((vals (channel->vct 10 15)))
+ (if (not (vequal vals (vct 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
+ (snd-display #__line__ ";src-mixes 0.5 vals: ~A" vals)))
+ (if (not (vequal (mix->vct (car ids)) (mix->vct (cadr ids))))
+ (snd-display #__line__ ";src-mixes vals don't match: ~A ~A" (mix->vct (car ids)) (mix->vct (cadr ids))))
+ (undo)
+ (transpose-mixes ids -12)
+ (if (fneq (mix-speed (car ids)) 0.5)
+ (snd-display #__line__ ";transpose-mixes speed: ~A" (mix-speed (car ids))))
+ (if (not (= (mixes-length ids) 15))
+ (snd-display #__line__ ";transpose-mixes length: ~A" (mixes-length ids)))
+ (let ((vals (channel->vct 10 15)))
+ (if (not (vequal vals (vct 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
+ (snd-display #__line__ ";transpose-mixes 0.5 vals: ~A" vals)))
+ (if (not (vequal (mix->vct (car ids)) (mix->vct (cadr ids))))
+ (snd-display #__line__ ";transpose-mixes vals don't match: ~A ~A" (mix->vct (car ids)) (mix->vct (cadr ids))))
+ (revert-sound))
+ (close-sound ind)))
+
+ ;; check locks
+ (let ((ind (new-sound "test.snd" :size 100)))
(let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display ";mix on ramp3_ptree_ramp: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display ";read mix on ramp3_ptree_ramp reversed: ~A" data))))
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 0: ~A ~A" id (mix? id)))
+ (ptree-channel (lambda (y) .5) 0 20)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 1: ~A ~A" id (mix? id)))
+ (ptree-channel (lambda (y) .5) 0 20)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 2: ~A ~A" id (mix? id)))
+ (undo)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 3: ~A ~A" id (mix? id)))
+ (ptree-channel (lambda (y) .5) 25 20)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 4: ~A ~A" id (mix? id)))
+ (undo)
+ (ramp-channel 0.0 1.0 0 20)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 5: ~A ~A" id (mix? id)))
+ (undo)
+ (xramp-channel 0.0 1.0 32.0 0 20)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 6: ~A ~A" id (mix? id)))
+ (undo 2)
+ (delete-sample 52)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 7: ~A ~A" id (mix? id)))
+ (undo)
+ (delete-sample 10)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 8: ~A ~A" id (mix? id)))
+ (undo)
+ (insert-samples 51 2 (vct .1 .2))
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 9: ~A ~A" id (mix? id)))
+ (undo)
+ (insert-samples 1 2 (vct .1 .2))
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 10: ~A ~A" id (mix? id)))
+ (undo)
+ (set! (sample 51) 1.0)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 11: ~A ~A" id (mix? id)))
+ (undo)
+ (set! (sample 1) 1.0)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 12: ~A ~A" id (mix? id)))
+ (undo)
+ (xramp-channel 0 1 32 0 40)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 13: ~A ~A" id (mix? id)))
+ (xramp-channel 0 1 32 0 40)
+ (if (not (mix? id))
+ (snd-display #__line__ ";mix lock 14: ~A ~A" id (mix? id)))
+ (close-sound ind)))
+
+ (do ((i 0 (+ 1 i)))
+ ((= i 2))
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display ";mix on ramp2_ptree_ramp2: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display ";read mix on ramp2_ptree_ramp2 reversed: ~A" data))))
+ (let ((ind (new-sound "test.snd" :size 100))
+ (tag (with-mix-tags)))
+
+ ;; check various mix ops briefly
+ (map-channel (lambda (y) 1.0))
+ (env-channel '(0 0 1 1))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576)))
+ (snd-display #__line__ ";mix on env: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on env: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 5)))
+ (snd-display #__line__ ";mix on env edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576))))
+ (snd-display #__line__ ";read mix on env reversed: ~A" data)))
+ (undo))
+
+ (env-channel '(0 0 1 1))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331)))
+ (snd-display #__line__ ";mix on env 1: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on env 1: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 7)))
+ (snd-display #__line__ ";mix on env1 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331))))
+ (snd-display #__line__ ";read mix on env1 reversed: ~A" data)))
+ (undo))
+
+ (env-channel '(0 0 1 1))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191)))
+ (snd-display #__line__ ";mix on env 2: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on env 2: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
+ (snd-display #__line__ ";mix on env2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191))))
+ (snd-display #__line__ ";read mix on env2 reversed: ~A" data)))
+ (undo))
+
+ (env-channel '(0 0 1 1))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110)))
+ (snd-display #__line__ ";mix on env 3: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on env 3: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
+ (snd-display #__line__ ";mix on env3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110))))
+ (snd-display #__line__ ";read mix on env3 reversed: ~A" data)))
+ (undo))
+
+ (env-channel '(0 0 1 1))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063)))
+ (snd-display #__line__ ";mix on env 4: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on env 4: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
+ (snd-display #__line__ ";mix on env4 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063))))
+ (snd-display #__line__ ";read mix on env4 reversed: ~A" data)))
+ (undo))
+
+ (set! (edit-position ind 0) 1)
+ (xramp-channel 1 0 32.0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108)))
+ (snd-display #__line__ ";mix on xramp: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on xramp: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 9)))
+ (snd-display #__line__ ";mix on xramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108))))
+ (snd-display #__line__ ";read mix on xramp reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (xramp-channel 1 0 32.0)
+ (xramp-channel 1 0 32.0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012)))
+ (snd-display #__line__ ";mix on xramp2: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on xramp2: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 13)))
+ (snd-display #__line__ ";mix on xramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012))))
+ (snd-display #__line__ ";read mix on xramp2 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (xramp-channel 1 0 32.0)
+ (xramp-channel 1 0 32.0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005)))
+ (snd-display #__line__ ";mix on xramp2_ramp: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on xramp2_ramp: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp2_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005))))
+ (snd-display #__line__ ";read mix on xramp2_ramp reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (xramp-channel 1 0 32.0)
+ (xramp-channel 1 0 32.0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002)))
+ (snd-display #__line__ ";mix on xramp2_ramp2: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on xramp2_ramp2: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp2_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002))))
+ (snd-display #__line__ ";read mix on xramp2_ramp2 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (xramp-channel 1 0 32.0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046)))
+ (snd-display #__line__ ";mix on xramp_ramp: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on xramp_ramp: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046))))
+ (snd-display #__line__ ";read mix on xramp_ramp reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (xramp-channel 1 0 32.0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019)))
+ (snd-display #__line__ ";mix on xramp_ramp2: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on xramp_ramp2: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019))))
+ (snd-display #__line__ ";read mix on xramp_ramp2 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (xramp-channel 1 0 32.0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008)))
+ (snd-display #__line__ ";mix on xramp_ramp3: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on xramp_ramp3: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp_ramp3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008))))
+ (snd-display #__line__ ";read mix on xramp_ramp3 reversed: ~A" data))))
+
+ (set! (with-mix-tags) #t)
+ (set! (optimization) 6)
+ (set! (edit-position ind 0) 1)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.500 0.500 0.600 0.700 0.800 0.500 0.500 0.500 0.500 0.500)))
+ (snd-display #__line__ ";mix on ptree: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ptree: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 17)))
+ (snd-display #__line__ ";mix on ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.500 0.500 0.600 0.700 0.800 0.500 0.500 0.500 0.500 0.500))))
+ (snd-display #__line__ ";read mix on ptree reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
+ (snd-display #__line__ ";mix on ptree_ramp: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ptree_ramp: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
+ (snd-display #__line__ ";mix on ptree_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
+ (snd-display #__line__ ";read mix on ptree_ramp reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
+ (snd-display #__line__ ";mix on ptree_ramp2: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ptree_ramp2: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
+ (snd-display #__line__ ";mix on ptree_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
+ (snd-display #__line__ ";read mix on ptree_ramp2 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
+ (snd-display #__line__ ";mix on ptree_ramp3: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ptree_ramp3: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
+ (snd-display #__line__ ";mix on ptree_ramp3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
+ (snd-display #__line__ ";read mix on ptree_ramp3 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
+ (snd-display #__line__ ";mix on ptree_ramp4: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ptree_ramp4: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
+ (snd-display #__line__ ";mix on ptree_ramp4 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
+ (snd-display #__line__ ";read mix on ptree_ramp4 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 0)
+ (scale-by 0.0)
+ (ptree-channel (lambda (y) 1.0))
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 1.000 1.000 1.100 1.200 1.300 1.000 1.000 1.000 1.000 1.000)))
+ (snd-display #__line__ ";mix on ptree_zero: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ptree_zero: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 19)))
+ (snd-display #__line__ ";mix on ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 1.000 1.000 1.100 1.200 1.300 1.000 1.000 1.000 1.000 1.000))))
+ (snd-display #__line__ ";read mix on ptree_zero reversed: ~A" data))))
+
+ (revert-sound)
+ (map-channel (lambda (y) 1.0))
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
+ (snd-display #__line__ ";mix on ramp_ptree: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp_ptree: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
+ (snd-display #__line__ ";mix on ramp_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
+ (snd-display #__line__ ";read mix on ramp_ptree reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
+ (snd-display #__line__ ";mix on ramp2_ptree: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp2_ptree: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
+ (snd-display #__line__ ";mix on ramp2_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
+ (snd-display #__line__ ";read mix on ramp2_ptree reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
+ (snd-display #__line__ ";mix on ramp3_ptree: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp3_ptree: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
+ (snd-display #__line__ ";mix on ramp3_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
+ (snd-display #__line__ ";read mix on ramp3_ptree reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
+ (snd-display #__line__ ";mix on ramp4_ptree: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp4_ptree: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
+ (snd-display #__line__ ";mix on ramp4_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
+ (snd-display #__line__ ";read mix on ramp4_ptree reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (scale-by 0.0)
+ (ptree-channel (lambda (y) 0.5))
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
+ (snd-display #__line__ ";mix on ramp_ptree_zero: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp_ptree_zero: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
+ (snd-display #__line__ ";mix on ramp_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
+ (snd-display #__line__ ";read mix on ramp_ptree_zero reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (scale-by 0.0)
+ (ptree-channel (lambda (y) 0.5))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
+ (snd-display #__line__ ";mix on ramp2_ptree_zero: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp2_ptree_zero: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
+ (snd-display #__line__ ";mix on ramp2_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
+ (snd-display #__line__ ";read mix on ramp2_ptree_zero reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (scale-by 0.0)
+ (ptree-channel (lambda (y) 0.5))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
+ (snd-display #__line__ ";mix on ramp3_ptree_zero: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp3_ptree_zero: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
+ (snd-display #__line__ ";mix on ramp3_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
+ (snd-display #__line__ ";read mix on ramp3_ptree_zero reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (scale-by 0.0)
+ (ptree-channel (lambda (y) 0.5))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
+ (snd-display #__line__ ";mix on ramp4_ptree_zero: ~A" vals)))
+ (if (and tag (not (mix? id)))
+ (snd-display #__line__ ";mix on ramp4_ptree_zero: ~A ~A" id (mix? id)))
+ (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
+ (snd-display #__line__ ";mix on ramp4_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
+ (snd-display #__line__ ";read mix on ramp4_ptree_zero reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
+ (snd-display #__line__ ";mix on ramp_ptree_ramp: ~A" vals)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
+ (snd-display #__line__ ";read mix on ramp_ptree_ramp reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
+ (snd-display #__line__ ";mix on ramp_ptree_ramp2: ~A" vals)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
+ (snd-display #__line__ ";read mix on ramp_ptree_ramp2 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
+ (snd-display #__line__ ";mix on ramp_ptree_ramp3: ~A" vals)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
+ (snd-display #__line__ ";read mix on ramp_ptree_ramp3 reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
+ (snd-display #__line__ ";mix on ramp2_ptree_ramp: ~A" vals)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
+ (snd-display #__line__ ";read mix on ramp2_ptree_ramp reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
+ (snd-display #__line__ ";mix on ramp3_ptree_ramp: ~A" vals)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
+ (snd-display #__line__ ";read mix on ramp3_ptree_ramp reversed: ~A" data))))
+
+ (set! (edit-position ind 0) 1)
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (ptree-channel (lambda (y) (* y 0.5)))
+ (ramp-channel 1 0)
+ (ramp-channel 1 0)
+ (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((vals (channel->vct 48 10)))
+ (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
+ (snd-display #__line__ ";mix on ramp2_ptree_ramp2: ~A" vals)))
+ (let ((data (make-vct 10))
+ (reader (make-sampler 57 ind 0 -1)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! data i (reader)))
+ (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
+ (snd-display #__line__ ";read mix on ramp2_ptree_ramp2 reversed: ~A" data))))
+
+ (revert-sound)
+ (mix-vct (vct .1 .2 .3) 50)
+ (reverse-sound)
+ (let ((vals (channel->vct 45 8)))
+ (if (not (vequal vals (vct 0.000 0.000 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (snd-display #__line__ ";reversed mix vals: ~A" vals)))
+ (close-sound ind))
+ (set! (with-mix-tags) #f))
+ (set! (with-mix-tags) #t)
+
+ (let ((ind (open-sound "oboe.snd"))
+ (mx (mix-vct (make-vct 100 .1) 1000)))
+ (for-each
+ (lambda (mtest)
+ (let ((func (car mtest))
+ (beg (cadr mtest))
+ (lock (caddr mtest))
+ (name (cadddr mtest))
+ (edpos (edit-position ind 0)))
+ (func)
+ (set! (edit-position ind 0) edpos)))
+ (list
+ (list (lambda () (pad-channel 0 100)) 1100 #f 'pad0)
+ (list (lambda () (pad-channel 0 2000)) 3000 #f 'pad20)
+ (list (lambda () (pad-channel 800 100)) 1100 #f 'pad800)
+ (list (lambda () (pad-channel 850 100)) 1100 #f 'pad800)
+ (list (lambda () (pad-channel 990 100)) 1100 #f 'pad990)
+ (list (lambda () (pad-channel 1010 100)) 1000 #t 'pad1010)
+ (list (lambda () (pad-channel 1050 10)) 1000 #t 'pad1050)
+ (list (lambda () (pad-channel 1110 100)) 1000 #f 'pad1110)
+ (list (lambda () (pad-channel 2000 100)) 1000 #f 'pad2000)
+
+ (list (lambda () (insert-samples 0 100 (make-vct 100 .2))) 1100 #f 'insert0)
+ (list (lambda () (insert-samples 800 100 (make-vct 100 .2))) 1100 #f 'insert800)
+ (list (lambda () (insert-samples 990 100 (make-vct 100 .2))) 1100 #f 'insert990)
+ (list (lambda () (insert-samples 1010 100 (make-vct 100 .2))) 1000 #t 'insert1010)
+ (list (lambda () (insert-samples 1050 10 (make-vct 100 .2))) 1000 #t 'insert1050)
+ (list (lambda () (insert-samples 1110 100 (make-vct 100 .2))) 1000 #f 'insert1110)
+ (list (lambda () (insert-samples 2000 100 (make-vct 100 .2))) 1000 #f 'insert2000)
+
+ (let ((fr (mus-sound-frames "1a.snd")))
+ (list (lambda () (insert-sound "1a.snd" 0)) (+ fr 1000) #f 'inserts0)
+ (list (lambda () (insert-sound "1a.snd" 800)) (+ fr 1000) #f 'inserts800)
+ (list (lambda () (insert-sound "1a.snd" 990)) (+ fr 1000) #f 'inserts990)
+ (list (lambda () (insert-sound "1a.snd" 1010)) 1000 #t 'inserts1010)
+ (list (lambda () (insert-sound "1a.snd" 1050)) 1000 #t 'inserts1050)
+ (list (lambda () (insert-sound "1a.snd" 1110)) 1000 #f 'inserts1110)
+ (list (lambda () (insert-sound "1a.snd" 2000)) 1000 #f 'inserts2000))
+
+ (list (lambda () (delete-samples 0 100)) 900 #f 'delete0)
+ (list (lambda () (delete-samples 0 2000)) 1000 #t 'delete20)
+ (list (lambda () (delete-samples 800 100)) 900 #f 'delete800)
+ (list (lambda () (delete-samples 850 100)) 900 #f 'delete850)
+ (list (lambda () (delete-samples 950 40)) 960 #f 'delete950)
+ (list (lambda () (delete-samples 990 100)) 1000 #t 'delete990)
+ (list (lambda () (delete-samples 1010 100)) 1000 #t 'delete1010)
+ (list (lambda () (delete-samples 1050 10)) 1000 #t 'delete1050)
+ (list (lambda () (delete-samples 1110 100)) 1000 #f 'delete1110)
+ (list (lambda () (delete-samples 2000 100)) 1000 #f 'delete2000)
+
+ (list (lambda () (set! (samples 0 100) (make-vct 100 .2))) 1000 #f 'set0)
+ (list (lambda () (set! (samples 0 2000) (make-vct 2000 .2))) 1000 #t 'set0)
+ (list (lambda () (set! (samples 800 100) (make-vct 100 .2))) 1000 #f 'set800)
+ (list (lambda () (set! (samples 990 100) (make-vct 100 .2))) 1000 #t 'set990)
+ (list (lambda () (set! (samples 1010 100) (make-vct 100 .2))) 1000 #t 'set1010)
+ (list (lambda () (set! (samples 1050 10) (make-vct 100 .2))) 1000 #t 'set1050)
+ (list (lambda () (set! (samples 1110 100) (make-vct 100 .2))) 1000 #f 'set1110)
+ (list (lambda () (set! (samples 2000 100) (make-vct 100 .2))) 1000 #f 'set2000)
+
+ (list (lambda () (scale-channel 2.0 0 100)) 1000 #f 'scale0)
+ (list (lambda () (scale-channel 2.0 0 2000)) 1000 #t 'scale20)
+ (list (lambda () (scale-channel 2.0 800 100)) 1000 #f 'scale800)
+ (list (lambda () (scale-channel 2.0 850 100)) 1000 #f 'scale850)
+ (list (lambda () (scale-channel 2.0 950 40)) 1000 #f 'scale950)
+ (list (lambda () (scale-channel 2.0 990 100)) 1000 #t 'scale990)
+ (list (lambda () (scale-channel 2.0 1010 100)) 1000 #t 'scale1010)
+ (list (lambda () (scale-channel 2.0 1050 10)) 1000 #t 'scale1050)
+ (list (lambda () (scale-channel 2.0 1110 100)) 1000 #f 'scale1110)
+ (list (lambda () (scale-channel 2.0 2000 100)) 1000 #f 'scale2000)
+
+ (list (lambda () (env-channel '(0 0 1 1) 0 100)) 1000 #f 'env0)
+ (list (lambda () (env-channel '(0 0 1 1) 0 2000)) 1000 #t 'env20)
+ (list (lambda () (env-channel '(0 0 1 1) 800 100)) 1000 #f 'env800)
+ (list (lambda () (env-channel '(0 0 1 1) 850 100)) 1000 #f 'env850)
+ (list (lambda () (env-channel '(0 0 1 1) 950 40)) 1000 #f 'env950)
+ (list (lambda () (env-channel '(0 0 1 1) 990 100)) 1000 #t 'env990)
+ (list (lambda () (env-channel '(0 0 1 1) 1010 100)) 1000 #t 'env1010)
+ (list (lambda () (env-channel '(0 0 1 1) 1050 10)) 1000 #t 'env1050)
+ (list (lambda () (env-channel '(0 0 1 1) 1110 100)) 1000 #f 'env1110)
+ (list (lambda () (env-channel '(0 0 1 1) 2000 100)) 1000 #f 'env2000)
+
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 0 100)) 1000 #f 'ptree0)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 0 2000)) 1000 #t 'ptree20)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 800 100)) 1000 #f 'ptree800)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 850 100)) 1000 #f 'ptree850)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 950 40)) 1000 #f 'ptree950)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 990 100)) 1000 #t 'ptree990)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1010 100)) 1000 #t 'ptree1010)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1050 10)) 1000 #t 'ptree1050)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1110 100)) 1000 #f 'ptree1110)
+ (list (lambda () (ptree-channel (lambda (y) (* y 2)) 2000 100)) 1000 #f 'ptree2000)))
- (revert-sound)
- (mix-vct (vct .1 .2 .3) 50)
- (reverse-sound)
- (let ((vals (channel->vct 45 8)))
- (if (not (vequal vals (vct 0.000 0.000 0.300 0.200 0.100 0.000 0.000 0.000)))
- (snd-display ";reversed mix vals: ~A" vals)))
(close-sound ind))
- (set! (with-mix-tags) #f))
- (set! (with-mix-tags) #t)
-
- (let ((ind (open-sound "oboe.snd"))
- (mx (mix-vct (make-vct 100 .1) 1000)))
- (for-each
- (lambda (mtest)
- (let ((func (car mtest))
- (beg (cadr mtest))
- (lock (caddr mtest))
- (name (cadddr mtest))
- (edpos (edit-position ind 0)))
- (func)
- (set! (edit-position ind 0) edpos)))
- (list
- (list (lambda () (pad-channel 0 100)) 1100 #f 'pad0)
- (list (lambda () (pad-channel 0 2000)) 3000 #f 'pad20)
- (list (lambda () (pad-channel 800 100)) 1100 #f 'pad800)
- (list (lambda () (pad-channel 850 100)) 1100 #f 'pad800)
- (list (lambda () (pad-channel 990 100)) 1100 #f 'pad990)
- (list (lambda () (pad-channel 1010 100)) 1000 #t 'pad1010)
- (list (lambda () (pad-channel 1050 10)) 1000 #t 'pad1050)
- (list (lambda () (pad-channel 1110 100)) 1000 #f 'pad1110)
- (list (lambda () (pad-channel 2000 100)) 1000 #f 'pad2000)
-
- (list (lambda () (insert-samples 0 100 (make-vct 100 .2))) 1100 #f 'insert0)
- (list (lambda () (insert-samples 800 100 (make-vct 100 .2))) 1100 #f 'insert800)
- (list (lambda () (insert-samples 990 100 (make-vct 100 .2))) 1100 #f 'insert990)
- (list (lambda () (insert-samples 1010 100 (make-vct 100 .2))) 1000 #t 'insert1010)
- (list (lambda () (insert-samples 1050 10 (make-vct 100 .2))) 1000 #t 'insert1050)
- (list (lambda () (insert-samples 1110 100 (make-vct 100 .2))) 1000 #f 'insert1110)
- (list (lambda () (insert-samples 2000 100 (make-vct 100 .2))) 1000 #f 'insert2000)
-
- (let ((fr (mus-sound-frames "1a.snd")))
- (list (lambda () (insert-sound "1a.snd" 0)) (+ fr 1000) #f 'inserts0)
- (list (lambda () (insert-sound "1a.snd" 800)) (+ fr 1000) #f 'inserts800)
- (list (lambda () (insert-sound "1a.snd" 990)) (+ fr 1000) #f 'inserts990)
- (list (lambda () (insert-sound "1a.snd" 1010)) 1000 #t 'inserts1010)
- (list (lambda () (insert-sound "1a.snd" 1050)) 1000 #t 'inserts1050)
- (list (lambda () (insert-sound "1a.snd" 1110)) 1000 #f 'inserts1110)
- (list (lambda () (insert-sound "1a.snd" 2000)) 1000 #f 'inserts2000))
-
- (list (lambda () (delete-samples 0 100)) 900 #f 'delete0)
- (list (lambda () (delete-samples 0 2000)) 1000 #t 'delete20)
- (list (lambda () (delete-samples 800 100)) 900 #f 'delete800)
- (list (lambda () (delete-samples 850 100)) 900 #f 'delete850)
- (list (lambda () (delete-samples 950 40)) 960 #f 'delete950)
- (list (lambda () (delete-samples 990 100)) 1000 #t 'delete990)
- (list (lambda () (delete-samples 1010 100)) 1000 #t 'delete1010)
- (list (lambda () (delete-samples 1050 10)) 1000 #t 'delete1050)
- (list (lambda () (delete-samples 1110 100)) 1000 #f 'delete1110)
- (list (lambda () (delete-samples 2000 100)) 1000 #f 'delete2000)
-
- (list (lambda () (set! (samples 0 100) (make-vct 100 .2))) 1000 #f 'set0)
- (list (lambda () (set! (samples 0 2000) (make-vct 2000 .2))) 1000 #t 'set0)
- (list (lambda () (set! (samples 800 100) (make-vct 100 .2))) 1000 #f 'set800)
- (list (lambda () (set! (samples 990 100) (make-vct 100 .2))) 1000 #t 'set990)
- (list (lambda () (set! (samples 1010 100) (make-vct 100 .2))) 1000 #t 'set1010)
- (list (lambda () (set! (samples 1050 10) (make-vct 100 .2))) 1000 #t 'set1050)
- (list (lambda () (set! (samples 1110 100) (make-vct 100 .2))) 1000 #f 'set1110)
- (list (lambda () (set! (samples 2000 100) (make-vct 100 .2))) 1000 #f 'set2000)
-
- (list (lambda () (scale-channel 2.0 0 100)) 1000 #f 'scale0)
- (list (lambda () (scale-channel 2.0 0 2000)) 1000 #t 'scale20)
- (list (lambda () (scale-channel 2.0 800 100)) 1000 #f 'scale800)
- (list (lambda () (scale-channel 2.0 850 100)) 1000 #f 'scale850)
- (list (lambda () (scale-channel 2.0 950 40)) 1000 #f 'scale950)
- (list (lambda () (scale-channel 2.0 990 100)) 1000 #t 'scale990)
- (list (lambda () (scale-channel 2.0 1010 100)) 1000 #t 'scale1010)
- (list (lambda () (scale-channel 2.0 1050 10)) 1000 #t 'scale1050)
- (list (lambda () (scale-channel 2.0 1110 100)) 1000 #f 'scale1110)
- (list (lambda () (scale-channel 2.0 2000 100)) 1000 #f 'scale2000)
-
- (list (lambda () (env-channel '(0 0 1 1) 0 100)) 1000 #f 'env0)
- (list (lambda () (env-channel '(0 0 1 1) 0 2000)) 1000 #t 'env20)
- (list (lambda () (env-channel '(0 0 1 1) 800 100)) 1000 #f 'env800)
- (list (lambda () (env-channel '(0 0 1 1) 850 100)) 1000 #f 'env850)
- (list (lambda () (env-channel '(0 0 1 1) 950 40)) 1000 #f 'env950)
- (list (lambda () (env-channel '(0 0 1 1) 990 100)) 1000 #t 'env990)
- (list (lambda () (env-channel '(0 0 1 1) 1010 100)) 1000 #t 'env1010)
- (list (lambda () (env-channel '(0 0 1 1) 1050 10)) 1000 #t 'env1050)
- (list (lambda () (env-channel '(0 0 1 1) 1110 100)) 1000 #f 'env1110)
- (list (lambda () (env-channel '(0 0 1 1) 2000 100)) 1000 #f 'env2000)
-
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 0 100)) 1000 #f 'ptree0)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 0 2000)) 1000 #t 'ptree20)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 800 100)) 1000 #f 'ptree800)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 850 100)) 1000 #f 'ptree850)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 950 40)) 1000 #f 'ptree950)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 990 100)) 1000 #t 'ptree990)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1010 100)) 1000 #t 'ptree1010)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1050 10)) 1000 #t 'ptree1050)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1110 100)) 1000 #f 'ptree1110)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 2000 100)) 1000 #f 'ptree2000)))
- (close-sound ind))
-
- (set! (optimization) old-opt-val)
-
- (let ((ind (open-sound "4.aiff"))
- (selind (open-sound "oboe.snd")))
- (make-selection 100 500 selind 0)
- (mix-selection 500 ind 2)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";mix-selection 0->2 0: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind 1) 0)) (snd-display ";mix-selection 0->2 1: ~A" (edit-position ind 1)))
- (if (not (= (edit-position ind 2) 1)) (snd-display ";mix-selection 0->2 2: ~A" (edit-position ind 2)))
- (if (not (= (edit-position ind 3) 0)) (snd-display ";mix-selection 0->2 3: ~A" (edit-position ind 3)))
- (revert-sound ind)
- (set! (sync ind) 1234)
- (mix-selection 500 ind 1)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";mix-selection 1->2 0: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind 1) 1)) (snd-display ";mix-selection 1->2 1: ~A" (edit-position ind 1)))
- (if (not (= (edit-position ind 2) 0)) (snd-display ";mix-selection 1->2 2: ~A" (edit-position ind 2)))
- (if (not (= (edit-position ind 3) 0)) (snd-display ";mix-selection 1->2 3: ~A" (edit-position ind 3)))
- (revert-sound ind)
- (set! (sync ind) 0)
- (insert-selection 500 ind 2)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";insert-selection 0->2 0: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind 1) 0)) (snd-display ";insert-selection 0->2 1: ~A" (edit-position ind 1)))
- (if (not (= (edit-position ind 2) 1)) (snd-display ";insert-selection 0->2 2: ~A" (edit-position ind 2)))
- (if (not (= (edit-position ind 3) 0)) (snd-display ";insert-selection 0->2 3: ~A" (edit-position ind 3)))
- (revert-sound ind)
- (set! (sync ind) 1234)
- (insert-selection 500 ind 1)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";insert-selection 1->2 0: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind 1) 1)) (snd-display ";insert-selection 1->2 1: ~A" (edit-position ind 1)))
- (if (not (= (edit-position ind 2) 0)) (snd-display ";insert-selection 1->2 2: ~A" (edit-position ind 2)))
- (if (not (= (edit-position ind 3) 0)) (snd-display ";insert-selection 1->2 3: ~A" (edit-position ind 3)))
- (revert-sound ind)
- (set! (sync ind) 0)
- (close-sound ind)
- (close-sound selind))
-
-
+ (set! (optimization) old-opt-val)
+
+ (let ((ind (open-sound "4.aiff"))
+ (selind (open-sound "oboe.snd")))
+ (make-selection 100 500 selind 0)
+ (mix-selection 500 ind 2)
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";mix-selection 0->2 0: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 1) 0)) (snd-display #__line__ ";mix-selection 0->2 1: ~A" (edit-position ind 1)))
+ (if (not (= (edit-position ind 2) 1)) (snd-display #__line__ ";mix-selection 0->2 2: ~A" (edit-position ind 2)))
+ (if (not (= (edit-position ind 3) 0)) (snd-display #__line__ ";mix-selection 0->2 3: ~A" (edit-position ind 3)))
+ (revert-sound ind)
+ (set! (sync ind) 1234)
+ (mix-selection 500 ind 1)
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";mix-selection 1->2 0: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 1) 1)) (snd-display #__line__ ";mix-selection 1->2 1: ~A" (edit-position ind 1)))
+ (if (not (= (edit-position ind 2) 0)) (snd-display #__line__ ";mix-selection 1->2 2: ~A" (edit-position ind 2)))
+ (if (not (= (edit-position ind 3) 0)) (snd-display #__line__ ";mix-selection 1->2 3: ~A" (edit-position ind 3)))
+ (revert-sound ind)
+ (set! (sync ind) 0)
+ (insert-selection 500 ind 2)
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";insert-selection 0->2 0: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 1) 0)) (snd-display #__line__ ";insert-selection 0->2 1: ~A" (edit-position ind 1)))
+ (if (not (= (edit-position ind 2) 1)) (snd-display #__line__ ";insert-selection 0->2 2: ~A" (edit-position ind 2)))
+ (if (not (= (edit-position ind 3) 0)) (snd-display #__line__ ";insert-selection 0->2 3: ~A" (edit-position ind 3)))
+ (revert-sound ind)
+ (set! (sync ind) 1234)
+ (insert-selection 500 ind 1)
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";insert-selection 1->2 0: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 1) 1)) (snd-display #__line__ ";insert-selection 1->2 1: ~A" (edit-position ind 1)))
+ (if (not (= (edit-position ind 2) 0)) (snd-display #__line__ ";insert-selection 1->2 2: ~A" (edit-position ind 2)))
+ (if (not (= (edit-position ind 3) 0)) (snd-display #__line__ ";insert-selection 1->2 3: ~A" (edit-position ind 3)))
+ (revert-sound ind)
+ (set! (sync ind) 0)
+ (close-sound ind)
+ (close-sound selind))
+
+
(let ((new-index (new-sound "hiho.wave" mus-next mus-bshort 22050 1)))
(log-mem test-ctr)
(select-sound new-index)
- (if (find-mix 0 new-index 0) (snd-display ";found non-existent mix? ~A" (find-mix 0 new-index 0)))
+ (if (find-mix 0 new-index 0) (snd-display #__line__ ";found non-existent mix? ~A" (find-mix 0 new-index 0)))
(let ((mix-id (car (mix "pistol.snd" 100))))
- (if (not (mix? mix-id)) (snd-display ";~A not mix?" mix-id))
+ (if (not (mix? mix-id)) (snd-display #__line__ ";~A not mix?" mix-id))
(view-mixes-dialog)
(let ((pos (mix-position mix-id))
(len (mix-length mix-id))
@@ -28827,50 +28906,50 @@ EDITS: 2
(nam (mix-name mix-id))
(amp (mix-amp mix-id))
(mr (make-mix-sampler mix-id)))
- (if (not (mix-sampler? mr)) (snd-display ";~A not mix-sampler?" mr))
- (if (region-sampler? mr) (snd-display ";mix sampler: region ~A" mr))
-; (if (sampler? mr) (snd-display ";mix sampler: normal ~A" mr))
- (if (not (= (sampler-position mr) 0)) (snd-display ";mix sampler position: ~A" (sampler-position mr)))
- (if (sampler-at-end? mr) (snd-display ";mix sampler at end? ~A" mr))
+ (if (not (mix-sampler? mr)) (snd-display #__line__ ";~A not mix-sampler?" mr))
+ (if (region-sampler? mr) (snd-display #__line__ ";mix sampler: region ~A" mr))
+ ; (if (sampler? mr) (snd-display #__line__ ";mix sampler: normal ~A" mr))
+ (if (not (= (sampler-position mr) 0)) (snd-display #__line__ ";mix sampler position: ~A" (sampler-position mr)))
+ (if (sampler-at-end? mr) (snd-display #__line__ ";mix sampler at end? ~A" mr))
(if (not (equal? (sampler-home mr) mix-id))
- (snd-display ";~A home: ~A" mr (sampler-home mr)))
+ (snd-display #__line__ ";~A home: ~A" mr (sampler-home mr)))
(let ((reader-string (format #f "~A" mr)))
(if (not (string=? (substring reader-string 0 16) "#<mix-sampler mi"))
- (snd-display ";mix sampler actually got: [~S]" (substring reader-string 0 16))))
+ (snd-display #__line__ ";mix sampler actually got: [~S]" (substring reader-string 0 16))))
(do ((i 0 (+ 1 i)))
((= i 99))
(let ((mx (if (odd? i) (read-mix-sample mr) (read-mix-sample mr)))
(sx (sample (+ 100 i))))
- (if (fneq mx sx) (snd-display ";read-mix-sample: ~A ~A?" mx sx))))
+ (if (fneq mx sx) (snd-display #__line__ ";read-mix-sample: ~A ~A?" mx sx))))
(let ((mx (mr))
(sx (sample 199)))
- (if (fneq mx sx) (snd-display ";mix-sample 100: ~A ~A?" mx sx)))
+ (if (fneq mx sx) (snd-display #__line__ ";mix-sample 100: ~A ~A?" mx sx)))
(free-sampler mr)
- (if (not (= pos 100)) (snd-display ";mix-position: ~A?" pos))
- (if (not (= len 41623)) (snd-display ";mix-length: ~A?" len))
- (if (not (equal? snd new-index)) (snd-display ";s mix-home: ~A?" snd))
- (if (not (= chn 0)) (snd-display ";c mix-home: ~A?" chn))
- (if (fneq amp 1.0) (snd-display ";mix-amp: ~A?" amp))
- (if (fneq spd 1.0) (snd-display ";mix-speed: ~A?" spd))
- (if nam (snd-display ";mix-name: ~A" nam))
+ (if (not (= pos 100)) (snd-display #__line__ ";mix-position: ~A?" pos))
+ (if (not (= len 41623)) (snd-display #__line__ ";mix-length: ~A?" len))
+ (if (not (equal? snd new-index)) (snd-display #__line__ ";s mix-home: ~A?" snd))
+ (if (not (= chn 0)) (snd-display #__line__ ";c mix-home: ~A?" chn))
+ (if (fneq amp 1.0) (snd-display #__line__ ";mix-amp: ~A?" amp))
+ (if (fneq spd 1.0) (snd-display #__line__ ";mix-speed: ~A?" spd))
+ (if nam (snd-display #__line__ ";mix-name: ~A" nam))
(catch 'mus-error
- (lambda () (play-mix mix-id))
- (lambda args (snd-display ";can't play mix: ~A" args)))
+ (lambda () (play mix-id))
+ (lambda args (snd-display #__line__ ";can't play mix: ~A" args)))
(catch 'mus-error
- (lambda () (play-mix mix-id 1000))
- (lambda args (snd-display ";can't play mix from 1000: ~A" args)))
+ (lambda () (play mix-id 1000))
+ (lambda args (snd-display #__line__ ";can't play mix from 1000: ~A" args)))
(set! (mix-name mix-id) "test-mix")
(if (or (not (string? (mix-name mix-id)))
(not (string=? (mix-name mix-id) "test-mix")))
- (snd-display ";mix-name set: ~A" (mix-name mix-id)))
+ (snd-display #__line__ ";mix-name set: ~A" (mix-name mix-id)))
(let ((id (mix-name->id "test-mix")))
- (if (not (equal? id mix-id)) (snd-display ";mix-name->id: ~A ~A" id mix-id)))
+ (if (not (equal? id mix-id)) (snd-display #__line__ ";mix-name->id: ~A ~A" id mix-id)))
(set! (mix-name mix-id) "test-mix-again") ; make sure previous name is freed
(if (or (not (string? (mix-name mix-id)))
(not (string=? (mix-name mix-id) "test-mix-again")))
- (snd-display ";mix-name set again: ~A" (mix-name mix-id)))
+ (snd-display #__line__ ";mix-name set again: ~A" (mix-name mix-id)))
(set! (mix-name mix-id) #f)
- (if (mix-name mix-id) (snd-display ";set mix-name #f: ~A" (mix-name mix-id)))
+ (if (mix-name mix-id) (snd-display #__line__ ";set mix-name #f: ~A" (mix-name mix-id)))
(set! (mix-position mix-id) 200)
(set! (mix-amp mix-id) 0.5)
(set! (mix-speed mix-id) 2.0)
@@ -28879,72 +28958,72 @@ EDITS: 2
(let ((val (mix-amp-env mix-id)))
(set! (mix-amp-env mix-id) (mix-amp-env mix-id))
(if (not (feql (mix-amp-env mix-id) val))
- (snd-display ";set mix-amp-env to self: ~A ~A" val (mix-amp-env mix-id))))
+ (snd-display #__line__ ";set mix-amp-env to self: ~A ~A" val (mix-amp-env mix-id))))
(set! (mix-tag-y mix-id) 20)
(let ((pos (mix-position mix-id))
(spd (mix-speed mix-id))
(amp (mix-amp mix-id))
(my (mix-tag-y mix-id)))
- (if (not (= pos 200)) (snd-display ";set-mix-position: ~A?" pos))
- (if (not (= my 20)) (snd-display ";set-mix-tag-y: ~A?" my))
- (if (fneq amp 0.5) (snd-display ";set-mix-amp: ~A?" amp))
- (if (fneq spd 2.0) (snd-display ";set-mix-speed: ~A?" spd))
- (if (not (equal? (mix-amp-env mix-id) '(0.0 0.0 1.0 1.0))) (snd-display ";set-mix-amp-env: ~A?" (mix-amp-env mix-id))))
+ (if (not (= pos 200)) (snd-display #__line__ ";set-mix-position: ~A?" pos))
+ (if (not (= my 20)) (snd-display #__line__ ";set-mix-tag-y: ~A?" my))
+ (if (fneq amp 0.5) (snd-display #__line__ ";set-mix-amp: ~A?" amp))
+ (if (fneq spd 2.0) (snd-display #__line__ ";set-mix-speed: ~A?" spd))
+ (if (not (equal? (mix-amp-env mix-id) '(0.0 0.0 1.0 1.0))) (snd-display #__line__ ";set-mix-amp-env: ~A?" (mix-amp-env mix-id))))
))
(mix-vct (make-vct 3 .1) 100)
(set! (cursor) 0)
(let ((nid (forward-mix)))
(if (or (not (mix? nid))
(not (= (cursor) (mix-position nid))))
- (snd-display ";forward-mix ~A ~A ~A?" nid (cursor) (and (mix? nid) (mix-position nid))))
+ (snd-display #__line__ ";forward-mix ~A ~A ~A?" nid (cursor) (and (mix? nid) (mix-position nid))))
(let ((nid1 (forward-mix 2)))
(if (or (not (mix? nid1))
(not (= (cursor) (mix-position nid1))))
- (snd-display ";forward-mix(2) ~A ~A ~A ~A ~A?" nid nid1 (cursor) (and (mix? nid1) (mix-position nid1)) (mixes)))
+ (snd-display #__line__ ";forward-mix(2) ~A ~A ~A ~A ~A?" nid nid1 (cursor) (and (mix? nid1) (mix-position nid1)) (mixes)))
(set! nid1 (backward-mix))
(if (or (not (mix? nid1))
(not (= (cursor) (mix-position nid1))))
- (snd-display ";backward-mix(2) ~A ~A ~A?" nid1 (cursor) (and (mix? nid1) (mix-position nid1))))))
+ (snd-display #__line__ ";backward-mix(2) ~A ~A ~A?" nid1 (cursor) (and (mix? nid1) (mix-position nid1))))))
(let ((nid (find-mix 100)))
(if (or (not (mix? nid))
(not (= (mix-position nid) 100)))
- (snd-display ";find-mix(100): ~A ~A ~A?" nid (and (mix? nid) (mix-position nid)) (map mix-position (mixes new-index 0)))))
+ (snd-display #__line__ ";find-mix(100): ~A ~A ~A?" nid (and (mix? nid) (mix-position nid)) (map mix-position (mixes new-index 0)))))
(let ((nid (find-mix 200)))
(if (or (not (mix? nid))
(not (= (mix-position nid) 200)))
- (snd-display ";find-mix(200): ~A ~A?" nid (and (mix? nid) (mix-position nid)))))
+ (snd-display #__line__ ";find-mix(200): ~A ~A?" nid (and (mix? nid) (mix-position nid)))))
(let ((mix-id (car (mix "oboe.snd" 100))))
(set! (mix-waveform-height) 40)
(set! (mix-property :hiho mix-id) 123)
- (if (not (= (mix-property :hiho mix-id) 123)) (snd-display ";mix-property: ~A" (mix-property :hiho mix-id)))
- (if (mix-property :not-there mix-id) (snd-display ";mix-not-property: ~A" (mix-property :not-there mix-id)))
+ (if (not (= (mix-property :hiho mix-id) 123)) (snd-display #__line__ ";mix-property: ~A" (mix-property :hiho mix-id)))
+ (if (mix-property :not-there mix-id) (snd-display #__line__ ";mix-not-property: ~A" (mix-property :not-there mix-id)))
(update-time-graph)
(set! (mix-waveform-height) 20))
(close-sound new-index))
)
(dismiss-all-dialogs)
-
+
;; pan-mix tests
(let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "pan-mix tests")))
(let ((id0 (car (pan-mix "1a.snd" 10000 '(0 0 1 1)))))
(if (or (fneq (mix-amp id0) 1.0)
(not (feql (mix-amp-env id0) '(0 1 1 0))))
- (snd-display ";pan-mix 1->1 2: ~A ~A" (mix-amp id0) (mix-amp-env id0)))
- (if (not (= (mix-position id0) 10000)) (snd-display ";pan-mix 1->1 pos 2: ~A" (mix-position id0)))
+ (snd-display #__line__ ";pan-mix 1->1 2: ~A ~A" (mix-amp id0) (mix-amp-env id0)))
+ (if (not (= (mix-position id0) 10000)) (snd-display #__line__ ";pan-mix 1->1 pos 2: ~A" (mix-position id0)))
(revert-sound ind))
(let* ((ids (pan-mix "2a.snd" 100 '(0 0 1 1)))
(id0 (car ids))
(id1 (cadr ids)))
(if (or (not (mix? id0)) (not (mix? id1)))
- (snd-display ";pan-mix 2->1: ~A ~A" id0 id1))
+ (snd-display #__line__ ";pan-mix 2->1: ~A ~A" id0 id1))
(if (not (= (mix-position id0) (mix-position id1) 100))
- (snd-display ";pan-mix 2->1 pos: ~A ~A" (mix-position id0) (mix-position id1)))
+ (snd-display #__line__ ";pan-mix 2->1 pos: ~A ~A" (mix-position id0) (mix-position id1)))
(if (or (fneq (mix-amp id0) 1.0) (fneq (mix-amp id1) 1.0))
- (snd-display ";pan-mix 2->1 mix amps 3: ~A ~A" (mix-amp id0) (mix-amp id1)))
+ (snd-display #__line__ ";pan-mix 2->1 mix amps 3: ~A ~A" (mix-amp id0) (mix-amp id1)))
(if (not (feql (mix-amp-env id0) '(0 1 1 0)))
- (snd-display ";pan-mix 2->1 ramp env: ~A" (mix-amp-env id0)))
+ (snd-display #__line__ ";pan-mix 2->1 ramp env: ~A" (mix-amp-env id0)))
(revert-sound ind))
(close-sound ind))
@@ -28953,15 +29032,15 @@ EDITS: 2
(id0 (car ids))
(id1 (cadr ids)))
(if (or (not (mix? id0)) (not (mix? id1)))
- (snd-display ";pan-mix 1->2: ~A ~A" id0 id1))
+ (snd-display #__line__ ";pan-mix 1->2: ~A ~A" id0 id1))
(if (not (= (mix-position id0) (mix-position id1) 100))
- (snd-display ";pan-mix 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
+ (snd-display #__line__ ";pan-mix 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
(if (or (fneq (mix-amp id0) 1.0) (fneq (mix-amp id1) 1.0))
- (snd-display ";pan-mix 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
+ (snd-display #__line__ ";pan-mix 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
(if (not (feql (mix-amp-env id0) '(0 1 1 0 2 1)))
- (snd-display ";pan-mix 1->2 env 0: ~A" (mix-amp-env id0)))
+ (snd-display #__line__ ";pan-mix 1->2 env 0: ~A" (mix-amp-env id0)))
(if (not (feql (mix-amp-env id1) '(0 0 1 1 2 0)))
- (snd-display ";pan-mix 1->2 env 1: ~A" (mix-amp-env id1)))
+ (snd-display #__line__ ";pan-mix 1->2 env 1: ~A" (mix-amp-env id1)))
(revert-sound ind))
(let* ((ids (pan-mix "2a.snd" 100 '(0 0 1 1 2 0)))
@@ -28971,19 +29050,19 @@ EDITS: 2
(id3 (cadddr ids)))
(if (or (not (mix? id0)) (not (mix? id1)) (not (mix? id2)) (not (mix? id3)))
- (snd-display ";pan-mix 2->2: ~A ~A ~A ~A" id0 id1 id2 id3))
+ (snd-display #__line__ ";pan-mix 2->2: ~A ~A ~A ~A" id0 id1 id2 id3))
(if (not (= (mix-position id0) (mix-position id1) (mix-position id2) (mix-position id3) 100))
- (snd-display ";pan-mix 2->2 pos: ~A ~A ~A ~A" (mix-position id0) (mix-position id1) (mix-position id2) (mix-position id3)))
+ (snd-display #__line__ ";pan-mix 2->2 pos: ~A ~A ~A ~A" (mix-position id0) (mix-position id1) (mix-position id2) (mix-position id3)))
(if (or (fneq (mix-amp id0) 1.0) (fneq (mix-amp id1) 1.0))
- (snd-display ";pan-mix 2->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
+ (snd-display #__line__ ";pan-mix 2->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
(if (not (feql (mix-amp-env id0) '(0 1 1 0 2 1)))
- (snd-display ";pan-mix 2->2 env 0: ~A" (mix-amp-env id0)))
+ (snd-display #__line__ ";pan-mix 2->2 env 0: ~A" (mix-amp-env id0)))
(if (not (feql (mix-amp-env id1) '(0 0 1 1 2 0)))
- (snd-display ";pan-mix 2->2 env 1: ~A" (mix-amp-env id1)))
+ (snd-display #__line__ ";pan-mix 2->2 env 1: ~A" (mix-amp-env id1)))
(if (not (feql (mix-amp-env id2) '(0 1 1 0 2 1)))
- (snd-display ";pan-mix 2->2 env 2: ~A" (mix-amp-env id2)))
+ (snd-display #__line__ ";pan-mix 2->2 env 2: ~A" (mix-amp-env id2)))
(if (not (feql (mix-amp-env id3) '(0 0 1 1 2 0)))
- (snd-display ";pan-mix 2->2 env 3: ~A" (mix-amp-env id3)))
+ (snd-display #__line__ ";pan-mix 2->2 env 3: ~A" (mix-amp-env id3)))
(revert-sound ind))
(close-sound ind))
@@ -28992,15 +29071,15 @@ EDITS: 2
(id0 (car ids))
(id1 (cadr ids)))
(if (or (not (mix? id0)) (not (mix? id1)))
- (snd-display ";pan-mix-vct 1->2: ~A ~A" id0 id1))
+ (snd-display #__line__ ";pan-mix-vct 1->2: ~A ~A" id0 id1))
(if (not (= (mix-position id0) (mix-position id1) 100))
- (snd-display ";pan-mix-vct 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
+ (snd-display #__line__ ";pan-mix-vct 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
(if (or (fneq (mix-amp id0) 1.0) (fneq (mix-amp id1) 1.0))
- (snd-display ";pan-mix-vct 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
+ (snd-display #__line__ ";pan-mix-vct 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
(if (not (feql (mix-amp-env id0) '(0 1 1 0)))
- (snd-display ";pan-mix-vct 1->2 env 0: ~A" (mix-amp-env id0)))
+ (snd-display #__line__ ";pan-mix-vct 1->2 env 0: ~A" (mix-amp-env id0)))
(if (not (feql (mix-amp-env id1) '(0 0 1 1)))
- (snd-display ";pan-mix-vct 1->2 env 1: ~A" (mix-amp-env id1)))
+ (snd-display #__line__ ";pan-mix-vct 1->2 env 1: ~A" (mix-amp-env id1)))
(revert-sound ind))
(let* ((reg (make-region 0 50 ind 0))
@@ -29008,15 +29087,15 @@ EDITS: 2
(id0 (car ids))
(id1 (cadr ids)))
(if (or (not (mix? id0)) (not (mix? id1)))
- (snd-display ";pan-mix-region 1->2: ~A ~A" id0 id1))
+ (snd-display #__line__ ";pan-mix-region 1->2: ~A ~A" id0 id1))
(if (not (= (mix-position id0) (mix-position id1) 100))
- (snd-display ";pan-mix-region 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
+ (snd-display #__line__ ";pan-mix-region 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
(if (or (fneq (mix-amp id0) 1.0) (fneq (mix-amp id1) 1.0))
- (snd-display ";pan-mix-region 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
+ (snd-display #__line__ ";pan-mix-region 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
(if (not (feql (mix-amp-env id0) '(0 1 1 0)))
- (snd-display ";pan-mix-region 1->2 env 0: ~A" (mix-amp-env id0)))
+ (snd-display #__line__ ";pan-mix-region 1->2 env 0: ~A" (mix-amp-env id0)))
(if (not (feql (mix-amp-env id1) '(0 0 1 1)))
- (snd-display ";pan-mix-region 1->2 env 1: ~A" (mix-amp-env id1)))
+ (snd-display #__line__ ";pan-mix-region 1->2 env 1: ~A" (mix-amp-env id1)))
(revert-sound ind))
(select-all)
@@ -29024,15 +29103,15 @@ EDITS: 2
(id0 (car ids))
(id1 (cadr ids)))
(if (or (not (mix? id0)) (not (mix? id1)))
- (snd-display ";pan-mix-selection 1->2: ~A ~A" id0 id1))
+ (snd-display #__line__ ";pan-mix-selection 1->2: ~A ~A" id0 id1))
(if (not (= (mix-position id0) (mix-position id1) 100))
- (snd-display ";pan-mix-selection 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
+ (snd-display #__line__ ";pan-mix-selection 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
(if (or (fneq (mix-amp id0) 1.0) (fneq (mix-amp id1) 1.0))
- (snd-display ";pan-mix-selection 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
+ (snd-display #__line__ ";pan-mix-selection 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
(if (not (feql (mix-amp-env id0) '(0 1 1 0)))
- (snd-display ";pan-mix-selection 1->2 env 0: ~A" (mix-amp-env id0)))
+ (snd-display #__line__ ";pan-mix-selection 1->2 env 0: ~A" (mix-amp-env id0)))
(if (not (feql (mix-amp-env id1) '(0 0 1 1)))
- (snd-display ";pan-mix-selection 1->2 env 1: ~A" (mix-amp-env id1)))
+ (snd-display #__line__ ";pan-mix-selection 1->2 env 1: ~A" (mix-amp-env id1)))
(revert-sound ind))
(close-sound ind))
@@ -29045,9 +29124,9 @@ EDITS: 2
(let ((mx (mix-vct v 0 snd 0)))
(let ((mx-copy (copy mx)))
(if (not (= (length mx) (length mx-copy)))
- (snd-display ";copy mix lengths: ~A ~A" (length mx) (length mx-copy)))
+ (snd-display #__line__ ";copy mix lengths: ~A ~A" (length mx) (length mx-copy)))
(if (not (= (mix-position mx) (mix-position mx-copy)))
- (snd-display ";copy mix positions: ~A ~A" (mix-position mx) (mix-position mx-copy)))
+ (snd-display #__line__ ";copy mix positions: ~A ~A" (mix-position mx) (mix-position mx-copy)))
(set! (mix-position mx-copy) 2000)
(let ((rd1 (make-sampler 0))
(rd2 (make-sampler 2000))
@@ -29060,7 +29139,7 @@ EDITS: 2
(if (or (fneq x1 x2) (fneq x1 (* i .001)))
(begin
(set! happy #f)
- (snd-display ";copy mix at ~A: ~A ~A ~A" i x1 x2 (* i .001))))))))))
+ (snd-display #__line__ ";copy mix at ~A: ~A ~A ~A" i x1 x2 (* i .001))))))))))
(close-sound snd))
(let ((ind (make-waltz)))
@@ -29158,7 +29237,7 @@ EDITS: 2
((= test-ctr tests))
(clear-sincs)
(log-mem test-ctr)
-
+
(let ((ind0 (view-sound "oboe.snd"))
(ind1 (view-sound "pistol.snd"))
(v0 (make-vct 100))
@@ -29181,34 +29260,34 @@ EDITS: 2
(do ((i 0 (+ 1 i))) ((= i 10)) (vector-set! v0 i 1.0))
(insert-samples 0 10 v0 ind0)
(time (env-sound '(0 0 1 1) 0 10 1.0 ind0))
- (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display ";1 env-sound[~D]: ~A?" i (sample i))))
+ (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display #__line__ ";1 env-sound[~D]: ~A?" i (sample i))))
(undo)
(env-sound (make-env '(0 0 1 1) :length 10) 0 10 1.0 ind0)
- (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display ";2 env-sound[~D]: ~A?" i (sample i))))
+ (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display #__line__ ";2 env-sound[~D]: ~A?" i (sample i))))
(undo)
(env-sound '(0 0 .5 1 1 1) 0 10 0.0 ind0)
(if (or (fneq (sample 3) 0.0) (fneq (sample 8) 1.0) )
- (snd-display ";env-sound stepped: ~A ~A?" (sample 3) (sample 8)))
+ (snd-display #__line__ ";env-sound stepped: ~A ~A?" (sample 3) (sample 8)))
(undo)
(env-sound '(0 0 1 1) 0 10 32.0 ind0)
(if (or (fneq (sample 3) 0.070) (fneq (sample 8) 0.67) )
- (snd-display ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
+ (snd-display #__line__ ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
(undo)
(env-sound (make-env '(0 0 1 1) :base 32.0 :length 10) 0 10 32.0 ind0)
(if (or (fneq (sample 3) 0.070) (fneq (sample 8) 0.67) )
- (snd-display ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
+ (snd-display #__line__ ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
(undo)
(env-sound '(0 2))
- (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) 2.0) (snd-display ";3 env-sound[~D]: ~A?" i (sample i))))
+ (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) 2.0) (snd-display #__line__ ";3 env-sound[~D]: ~A?" i (sample i))))
(undo)
(env-sound '(0 2) 2 4 1.0 ind0)
(if (or (fneq (sample 1) 1.0) (fneq (sample 2) 2.0) (fneq (sample 5) 2.0) (fneq (sample 8) 1.0))
- (snd-display ";3 env-sound exp: ~A ~A ~A ~A?" (sample 1) (sample 2) (sample 5) (sample 8)))
+ (snd-display #__line__ ";3 env-sound exp: ~A ~A ~A ~A?" (sample 1) (sample 2) (sample 5) (sample 8)))
(undo)
(do ((i 1 (+ 1 i))) ((= i 10)) (set! (sample i) 0.0))
(filter-sound '(0 1 1 0) 4)
(if (or (fneq (sample 1) 0.3678) (fneq (sample 2) .3678) (fneq (sample 3) .132) (fneq (sample 4) 0.0))
- (snd-display ";filter-sound env: ~A?" (samples 0 8)))
+ (snd-display #__line__ ";filter-sound env: ~A?" (samples 0 8)))
(undo)
(filter-sound '(0 1 1 0) 1024)
(undo)
@@ -29222,7 +29301,7 @@ EDITS: 2
(vct-set! vc0 0 .125) (vct-set! vc0 1 .25) (vct-set! vc0 2 .25) (vct-set! vc0 3 .125)
(filter-sound vc0 4)
(if (or (fneq (sample 0) 0.125) (fneq (sample 1) .25) (fneq (sample 2) .25) (fneq (sample 5) 0.0))
- (snd-display ";filter-sound direct: ~A?" (samples 0 8)))
+ (snd-display #__line__ ";filter-sound direct: ~A?" (samples 0 8)))
(revert-sound)))
(close-sound ind0)
@@ -29238,24 +29317,24 @@ EDITS: 2
(env-sound '(0 0 1 1) 0 10 1.0 ind0)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (sample i ind0 0) (* i .1111)) (snd-display ";ind0:0 1 env-sound[~D]: ~A?" i (sample i ind0 0)))
- (if (fneq (sample i ind0 1) (* i .1111)) (snd-display ";ind0:1 1 env-sound[~D]: ~A?" i (sample i ind0 1)))
- (if (fneq (sample i ind1 0) (* i .1111)) (snd-display ";ind1:0 1 env-sound[~D]: ~A?" i (sample i ind1 0))))
+ (if (fneq (sample i ind0 0) (* i .1111)) (snd-display #__line__ ";ind0:0 1 env-sound[~D]: ~A?" i (sample i ind0 0)))
+ (if (fneq (sample i ind0 1) (* i .1111)) (snd-display #__line__ ";ind0:1 1 env-sound[~D]: ~A?" i (sample i ind0 1)))
+ (if (fneq (sample i ind1 0) (* i .1111)) (snd-display #__line__ ";ind1:0 1 env-sound[~D]: ~A?" i (sample i ind1 0))))
(undo)
(env-sound (make-env '(0 0 1 1) :length 10) 0 10 1.0 ind0)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (sample i ind0 0) (* i .1111)) (snd-display ";ind0:0 2 env-sound[~D]: ~A?" i (sample i ind0 0)))
- (if (fneq (sample i ind0 1) (* i .1111)) (snd-display ";ind0:1 2 env-sound[~D]: ~A?" i (sample i ind0 1)))
- (if (fneq (sample i ind1 0) (* i .1111)) (snd-display ";ind1:0 2 env-sound[~D]: ~A?" i (sample i ind1 0))))
+ (if (fneq (sample i ind0 0) (* i .1111)) (snd-display #__line__ ";ind0:0 2 env-sound[~D]: ~A?" i (sample i ind0 0)))
+ (if (fneq (sample i ind0 1) (* i .1111)) (snd-display #__line__ ";ind0:1 2 env-sound[~D]: ~A?" i (sample i ind0 1)))
+ (if (fneq (sample i ind1 0) (* i .1111)) (snd-display #__line__ ";ind1:0 2 env-sound[~D]: ~A?" i (sample i ind1 0))))
(undo)
(env-sound '(0 0 .5 1 1 1) 0 10 0.0 ind0)
(if (or (fneq (sample 3 ind0 0) 0.0) (fneq (sample 8 ind0 0) 1.0) )
- (snd-display ";ind0:0 env-sound stepped: ~A ~A?" (sample 3 ind0 0) (sample 8 ind0 0)))
+ (snd-display #__line__ ";ind0:0 env-sound stepped: ~A ~A?" (sample 3 ind0 0) (sample 8 ind0 0)))
(if (or (fneq (sample 3 ind0 1) 0.0) (fneq (sample 8 ind0 1) 1.0) )
- (snd-display ";ind0:1 env-sound stepped: ~A ~A?" (sample 3 ind0 1) (sample 8 ind0 1)))
+ (snd-display #__line__ ";ind0:1 env-sound stepped: ~A ~A?" (sample 3 ind0 1) (sample 8 ind0 1)))
(if (or (fneq (sample 3 ind1 0) 0.0) (fneq (sample 8 ind1 0) 1.0) )
- (snd-display ";ind1:0 env-sound stepped: ~A ~A?" (sample 3 ind1 0) (sample 8 ind1 0)))
+ (snd-display #__line__ ";ind1:0 env-sound stepped: ~A ~A?" (sample 3 ind1 0) (sample 8 ind1 0)))
(undo)
(revert-sound ind0)
(revert-sound ind1)
@@ -29265,9 +29344,9 @@ EDITS: 2
(filter-sound (make-one-zero :a0 0.5 :a1 0.0) 0 ind0)
(do ((i 0 (+ 1 i)))
((= i 10))
- (if (fneq (sample i ind0 0) 0.5) (snd-display ";ind0:0 1 filter-sound[~D]: ~A?" i (sample i ind0 0)))
- (if (fneq (sample i ind0 1) 0.5) (snd-display ";ind0:1 1 filter-sound[~D]: ~A?" i (sample i ind0 1)))
- (if (fneq (sample i ind1 0) 0.5) (snd-display ";ind1:0 1 filter-sound[~D]: ~A?" i (sample i ind1 0))))
+ (if (fneq (sample i ind0 0) 0.5) (snd-display #__line__ ";ind0:0 1 filter-sound[~D]: ~A?" i (sample i ind0 0)))
+ (if (fneq (sample i ind0 1) 0.5) (snd-display #__line__ ";ind0:1 1 filter-sound[~D]: ~A?" i (sample i ind0 1)))
+ (if (fneq (sample i ind1 0) 0.5) (snd-display #__line__ ";ind1:0 1 filter-sound[~D]: ~A?" i (sample i ind1 0))))
(close-sound ind1))
(close-sound ind0)
@@ -29279,16 +29358,16 @@ EDITS: 2
(insert-samples 10 10 v0 ind0)
(env-sound '(0 0 1 2) 10 10 1.0 ind0)
(do ((i 0 (+ 1 i))) ((= i 10))
- (if (fneq (sample (+ i 10) ind0) (* i .0222)) (snd-display ";env-sound [~D]: ~A?" (+ i 10) (sample (+ i 10) ind0))))
- (if (fneq (sample 5 ind0) old5) (snd-display ";env-sound 5: ~A ~A?" old5 (sample 5 ind0)))
+ (if (fneq (sample (+ i 10) ind0) (* i .0222)) (snd-display #__line__ ";env-sound [~D]: ~A?" (+ i 10) (sample (+ i 10) ind0))))
+ (if (fneq (sample 5 ind0) old5) (snd-display #__line__ ";env-sound 5: ~A ~A?" old5 (sample 5 ind0)))
(undo)
(env-sound '(0 0 1 2) 10 10 4.0 ind0)
(set! v0 (samples->vct 10 10))
- (if (or (fneq (vct-ref v0 3) 0.039) (fneq (vct-ref v0 8) .162)) (snd-display ";env-sound 4: ~A" v0))
+ (if (or (fneq (vct-ref v0 3) 0.039) (fneq (vct-ref v0 8) .162)) (snd-display #__line__ ";env-sound 4: ~A" v0))
(undo)
(env-sound '(0 0 1 2) 10 10 .05 ind0)
(set! v0 (samples->vct 10 10))
- (if (or (fneq (vct-ref v0 3) 0.133) (fneq (vct-ref v0 8) .196)) (snd-display ";env-sound 05: ~A" v0)))
+ (if (or (fneq (vct-ref v0 3) 0.133) (fneq (vct-ref v0 8) .196)) (snd-display #__line__ ";env-sound 05: ~A" v0)))
(close-sound ind0)
(set! ind0 (new-sound "fmv.snd" mus-aifc mus-bshort 22050 2 "this is a comment"))
@@ -29301,17 +29380,17 @@ EDITS: 2
(do ((i 0 (+ 1 i))) ((= i 10)) (vector-set! v0 i 0.01))
(insert-samples 0 10 v0 ind1 0)
(let ((val (data-max1 0 9 ind0 0)))
- (if (fneq val 1.0) (snd-display ";scan-chan[0,0]: ~A?" val)))
+ (if (fneq val 1.0) (snd-display #__line__ ";scan-chan[0,0]: ~A?" val)))
(let ((val (data-max1 0 9 ind0 1)))
- (if (fneq val 0.1) (snd-display ";scan-chan[0,1]: ~A?" val)))
+ (if (fneq val 0.1) (snd-display #__line__ ";scan-chan[0,1]: ~A?" val)))
(let ((val (data-max1 0 9 ind1 0)))
- (if (fneq val 0.01) (snd-display ";scan-chan[1,0]: ~A?" val)))
+ (if (fneq val 0.01) (snd-display #__line__ ";scan-chan[1,0]: ~A?" val)))
(let ((val (data-max1 0 9 #f #f)))
- (if (fneq val 0.01) (snd-display ";scan-chans: ~A?" val)))
+ (if (fneq val 0.01) (snd-display #__line__ ";scan-chans: ~A?" val)))
(let ((val (data-max 0 9)))
- (if (fneq val 1.0) (snd-display ";scan-all-chans: ~A?" val)))
+ (if (fneq val 1.0) (snd-display #__line__ ";scan-all-chans: ~A?" val)))
(let ((val (data-max2 0 9 ind0)))
- (if (fneq val 1.0) (snd-display ";scan-across-sound-chans: ~A?" val))))
+ (if (fneq val 1.0) (snd-display #__line__ ";scan-across-sound-chans: ~A?" val))))
(close-sound ind0)
(close-sound ind1)
@@ -29325,108 +29404,108 @@ EDITS: 2
(undo)
(save-sound)
(if (not (= (length (marks ind0 0)) 2))
- (snd-display ";marks after save: ~A" (marks ind0 0)))
+ (snd-display #__line__ ";marks after save: ~A" (marks ind0 0)))
(if (or (not (mark? m1))
(not (= (mark-sample m1) 99)))
- (snd-display ";save-sound mark1: ~A" (mark-sample m1)))
+ (snd-display #__line__ ";save-sound mark1: ~A" (mark-sample m1)))
(if (or (not (mark? m2))
(not (= (mark-sample m2) 200)))
- (snd-display ";save-sound mark2: ~A" (mark-sample m2)))
- (if (mark? m3) (snd-display ";save-sound mark3: ~A" m3)))))
+ (snd-display #__line__ ";save-sound mark2: ~A" (mark-sample m2)))
+ (if (mark? m3) (snd-display #__line__ ";save-sound mark3: ~A" m3)))))
(close-sound ind0)
(let ((fd (open-sound "oboe.snd"))
(m1 (add-mark 123))
(sync-val (+ 1 (mark-sync-max))))
- (if (not (mark? m1)) (snd-display ";mark?"))
- (if (not (= (mark-sample m1) 123)) (snd-display ";add-mark: ~A? " (mark-sample m1)))
+ (if (not (mark? m1)) (snd-display #__line__ ";mark?"))
+ (if (not (= (mark-sample m1) 123)) (snd-display #__line__ ";add-mark: ~A? " (mark-sample m1)))
(set! (mark-property :hiho m1) 123)
- (if (not (= (mark-property :hiho m1) 123)) (snd-display ";mark-property: ~A" (mark-property :hiho m1)))
- (if (mark-property :not-there m1) (snd-display ";mark-not-property: ~A" (mark-property :not-there m1)))
+ (if (not (= (mark-property :hiho m1) 123)) (snd-display #__line__ ";mark-property: ~A" (mark-property :hiho m1)))
+ (if (mark-property :not-there m1) (snd-display #__line__ ";mark-not-property: ~A" (mark-property :not-there m1)))
(if (not (eq? (without-errors (mark-sample (integer->mark 12345678))) 'no-such-mark))
- (snd-display ";mark-sample err: ~A?" (without-errors (mark-sample 12345678))))
+ (snd-display #__line__ ";mark-sample err: ~A?" (without-errors (mark-sample 12345678))))
(if (not (eq? (without-errors (add-mark 123 123)) 'no-such-sound))
- (snd-display ";add-mark err: ~A?" (without-errors (add-mark 123 123))))
+ (snd-display #__line__ ";add-mark err: ~A?" (without-errors (add-mark 123 123))))
(let ((m2 (without-errors (add-mark 12345 fd 0))))
- (if (eq? m2 'no-such-mark) (snd-display ";add-mark failed?"))
- (if (not (= (mark-sample m2) 12345)) (snd-display ";add-mark 0 0: ~A?" (mark-sample m2)))
- (if (not (= (mark-sync m2) 0)) (snd-display ";init mark-sync: ~A?" (mark-sync m2)))
+ (if (eq? m2 'no-such-mark) (snd-display #__line__ ";add-mark failed?"))
+ (if (not (= (mark-sample m2) 12345)) (snd-display #__line__ ";add-mark 0 0: ~A?" (mark-sample m2)))
+ (if (not (= (mark-sync m2) 0)) (snd-display #__line__ ";init mark-sync: ~A?" (mark-sync m2)))
(set! (mark-sync m2) sync-val)
- (if (not (= (mark-sync m2) sync-val)) (snd-display ";set-mark-sync (~A): ~A?" sync-val (mark-sync m2)))
+ (if (not (= (mark-sync m2) sync-val)) (snd-display #__line__ ";set-mark-sync (~A): ~A?" sync-val (mark-sync m2)))
(let* ((syncs (syncd-marks sync-val))
(chans (marks fd 0))
(samps (map mark-sample chans)))
- (if (not (equal? syncs (list m2))) (snd-display ";syncd-marks: ~A?" syncs))
- (if (not (equal? chans (list m1 m2))) (snd-display ";marks: ~A?" chans))
- (if (not (equal? samps (list (mark-sample m1) (mark-sample m2)))) (snd-display ";map samps: ~A?" samps))
+ (if (not (equal? syncs (list m2))) (snd-display #__line__ ";syncd-marks: ~A?" syncs))
+ (if (not (equal? chans (list m1 m2))) (snd-display #__line__ ";marks: ~A?" chans))
+ (if (not (equal? samps (list (mark-sample m1) (mark-sample m2)))) (snd-display #__line__ ";map samps: ~A?" samps))
(delete-samples 200 100 fd 0)
(set! chans (marks fd))
(set! samps (map mark-sample (car chans)))
- (if (not (equal? samps (list (mark-sample m1 0) (- (mark-sample m2 0) 100)))) (snd-display ";map samps: ~A?" samps))
+ (if (not (equal? samps (list (mark-sample m1 0) (- (mark-sample m2 0) 100)))) (snd-display #__line__ ";map samps: ~A?" samps))
(let ((descr (describe-mark m2)))
(if (not (list? descr))
- (snd-display ";describe-mark: ~A?" descr)))
+ (snd-display #__line__ ";describe-mark: ~A?" descr)))
(set! (mark-sync m1) (mark-sync m2))
(move-syncd-marks sync-val 100)
(set! chans (marks fd))
(set! samps (map mark-sample (car chans)))
- (if (not (equal? samps (list (+ (mark-sample m1 0) 100) (mark-sample m2 0)))) (snd-display ";syncd move samps: ~A?" samps))
+ (if (not (equal? samps (list (+ (mark-sample m1 0) 100) (mark-sample m2 0)))) (snd-display #__line__ ";syncd move samps: ~A?" samps))
(set! (cursor) 500)
(backward-mark)
- (if (not (= (cursor) (mark-sample m1))) (snd-display ";backward-mark: ~A?" (cursor)))
+ (if (not (= (cursor) (mark-sample m1))) (snd-display #__line__ ";backward-mark: ~A?" (cursor)))
(forward-mark 1)
- (if (not (= (cursor) (mark-sample m2))) (snd-display ";forward-mark: ~A?" (cursor)))
+ (if (not (= (cursor) (mark-sample m2))) (snd-display #__line__ ";forward-mark: ~A?" (cursor)))
(set! (mark-sync m1) #t)
- (if (not (= (mark-sync m1) 1)) (snd-display ";mark-sync via bool: ~A" (mark-sync m1)))
+ (if (not (= (mark-sync m1) 1)) (snd-display #__line__ ";mark-sync via bool: ~A" (mark-sync m1)))
(delete-mark m1)
(set! chans (marks fd 0))
- (if (not (equal? chans (list m2))) (snd-display ";delete-mark? ~A" chans))
+ (if (not (equal? chans (list m2))) (snd-display #__line__ ";delete-mark? ~A" chans))
(undo)
(set! chans (marks fd 0))
- (if (not (equal? chans (list m1 m2))) (snd-display ";delete-mark then undo? ~A" chans))
+ (if (not (equal? chans (list m1 m2))) (snd-display #__line__ ";delete-mark then undo? ~A" chans))
(redo)
- (if (not (string=? (mark-name m2) "")) (snd-display ";init mark-name: ~A?" (mark-name m2)))
+ (if (not (string=? (mark-name m2) "")) (snd-display #__line__ ";init mark-name: ~A?" (mark-name m2)))
(set! (mark-name m2) "hiho!")
- (if (not (string=? (mark-name m2) "hiho!")) (snd-display ";set-mark-name: ~A?" (mark-name m2)))
+ (if (not (string=? (mark-name m2) "hiho!")) (snd-display #__line__ ";set-mark-name: ~A?" (mark-name m2)))
(undo)
- (if (not (string=? (mark-name m2) "")) (snd-display ";undo mark-name: ~A?" (mark-name m2)))
+ (if (not (string=? (mark-name m2) "")) (snd-display #__line__ ";undo mark-name: ~A?" (mark-name m2)))
(redo)
- (if (not (string=? (mark-name m2) "hiho!")) (snd-display ";redo mark-name: ~A?" (mark-name m2)))
+ (if (not (string=? (mark-name m2) "hiho!")) (snd-display #__line__ ";redo mark-name: ~A?" (mark-name m2)))
(let ((m3 (find-mark "hiho!"))
(m4 (find-mark (mark-sample m2)))
(m5 (find-mark "not-a-mark"))
(m6 (find-mark 123456787))
(m7 (mark-name->id "hiho!")))
- (if (or (not (equal? m2 m3)) (not (equal? m4 m7)) (not (equal? m2 m4))) (snd-display ";find-mark: ~A ~A ~A ~A?" m2 m3 m4 m7))
- (if (or (not (equal? m5 m6)) (not (equal? m5 #f))) (snd-display ";find-not-a-mark: ~A ~A?" m5 m6))
+ (if (or (not (equal? m2 m3)) (not (equal? m4 m7)) (not (equal? m2 m4))) (snd-display #__line__ ";find-mark: ~A ~A ~A ~A?" m2 m3 m4 m7))
+ (if (or (not (equal? m5 m6)) (not (equal? m5 #f))) (snd-display #__line__ ";find-not-a-mark: ~A ~A?" m5 m6))
(set! (mark-sample m2) 2000)
(set! m1 (add-mark 1000))
(set! m3 (add-mark 3000))
(set! m4 (add-mark 4000))
(insert-samples 2500 500 (make-vct 500) fd 0)
(set! samps (map mark-sample (marks fd 0)))
- (if (not (equal? samps '(1000 2000 3500 4500))) (snd-display ";insert ripple: ~A?" samps))
+ (if (not (equal? samps '(1000 2000 3500 4500))) (snd-display #__line__ ";insert ripple: ~A?" samps))
(set! (mark-sample m3) 300)
(set! (cursor) 500)
(backward-mark)
- (if (not (= (cursor) 300)) (snd-display ";sort marks: ~A?" (cursor)))
- (if (not (equal? (mark-home m2) (list fd 0))) (snd-display ";mark-home: ~A?" (mark-home m2)))
+ (if (not (= (cursor) 300)) (snd-display #__line__ ";sort marks: ~A?" (cursor)))
+ (if (not (equal? (mark-home m2) (list fd 0))) (snd-display #__line__ ";mark-home: ~A?" (mark-home m2)))
(let ((sd (open-sound "4.aiff")))
(set! m3 (add-mark 1000 sd 2))
(set! m4 (add-mark 1000 sd 3))
- (if (not (equal? (mark-home m3) (list sd 2))) (snd-display ";marks->sound 4: ~A?" (mark-home m3)))
+ (if (not (equal? (mark-home m3) (list sd 2))) (snd-display #__line__ ";marks->sound 4: ~A?" (mark-home m3)))
(close-sound sd))
(let ((file (save-marks fd)))
(if (or (not file)
(not (string=? file (string-append cwd "oboe.marks"))))
- (snd-display ";save-marks -> ~A?" file)))
+ (snd-display #__line__ ";save-marks -> ~A?" file)))
(let ((file (save-marks fd "hiho.marks")))
(if (or (not file)
(not (string=? file "hiho.marks")))
- (snd-display ";save-marks with arg -> ~A?" file))
+ (snd-display #__line__ ";save-marks with arg -> ~A?" file))
(let ((val (system (format #f "diff hiho.marks ~A" (string-append cwd "oboe.marks")))))
(if (not (= val 0))
- (snd-display ";save marks differs"))))
+ (snd-display #__line__ ";save marks differs"))))
(close-sound fd)
(let ((s1 (open-sound "oboe.snd"))
(s2 (open-sound "oboe.snd")))
@@ -29439,35 +29518,35 @@ EDITS: 2
(close-sound s1)
(close-sound s2))
(load (string-append cwd "s61.scm"))
- (if (not (with-verbose-cursor)) (snd-display ";save-state with-verbose-cursor?"))
+ (if (not (with-verbose-cursor)) (snd-display #__line__ ";save-state with-verbose-cursor?"))
(let ((s1 (find-sound "oboe.snd" 0))
(s2 (find-sound "oboe.snd" 1)))
(if (or (not (sound? s1)) (not (sound? s2)))
- (snd-display ";can't re-open sounds? ~A ~A" s1 s2)
+ (snd-display #__line__ ";can't re-open sounds? ~A ~A" s1 s2)
(let ((m1 (marks s1))
(m2 (marks s2)))
(if (or (not (= (length m1) 1))
(not (= (length m2) 1))
(not (= (length (car m1)) 1))
(not (= (length (car m2)) 1)))
- (snd-display ";save-marks via save-state to: ~A ~A" m1 m2)
+ (snd-display #__line__ ";save-marks via save-state to: ~A ~A" m1 m2)
(let ((samp1 (mark-sample (caar m1)))
(samp2 (mark-sample (caar m2))))
(if (or (not (= samp1 123))
(not (= samp2 321)))
- (snd-display ";save-marks via save-state positions: ~A ~A" samp1 samp2))))))
+ (snd-display #__line__ ";save-marks via save-state positions: ~A ~A" samp1 samp2))))))
(if (sound? s1) (close-sound s1))
(if (sound? s2) (close-sound s2)))
(let ((fd (open-sound "pistol.snd")))
(let ((file (save-marks)))
(if file
- (snd-display ";save-marks no marks -> ~A?" file)))
+ (snd-display #__line__ ";save-marks no marks -> ~A?" file)))
(close-sound fd))
(let ((fd (open-sound "oboe.snd")))
(load (string-append cwd "oboe.marks"))
(let ((mlst (marks fd 0)))
(if (not (= (length mlst) 4))
- (snd-display ";restore oboe.marks: ~A, marks: ~A" (file->string "oboe.marks") (marks fd 0))))
+ (snd-display #__line__ ";restore oboe.marks: ~A, marks: ~A" (file->string "oboe.marks") (marks fd 0))))
(close-sound fd))
(let ((fd (open-sound "oboe.snd")))
(let ((m1 (add-mark 1000)))
@@ -29476,17 +29555,17 @@ EDITS: 2
(let ((ms (marks fd 0)))
(src-sound -.5)
(if (not (equal? (marks fd 0) (reverse (marks fd 0 0))))
- (snd-display ";src rev marks: ~A ~A" (marks fd 0) (reverse (marks fd 0 0))))
+ (snd-display #__line__ ";src rev marks: ~A ~A" (marks fd 0) (reverse (marks fd 0 0))))
(let ((ms1 (map mark-sample (marks fd 0))))
(if (not (equal? ms1 (list 7998 96654 99654))) ; off-by-1 somewhere...
- (snd-display ";src rev mark locs: ~A" ms1)))))))
+ (snd-display #__line__ ";src rev mark locs: ~A" ms1)))))))
(close-sound fd))
(let ((fd (open-sound "4.aiff")))
(let ((m1 (add-mark 1000 fd 0))
(m2 (add-mark 2000 fd 1))
(m3 (add-mark 3000 fd 2))
(m4 (add-mark 4000 fd 3)))
- (if (= (length (marks)) 0) (snd-display ";marks (no args): ~A" (marks)))
+ (if (= (length (marks)) 0) (snd-display #__line__ ";marks (no args): ~A" (marks)))
(save-marks fd)
(close-sound fd)
(set! fd (open-sound "4.aiff"))
@@ -29496,9 +29575,9 @@ EDITS: 2
((= i 4))
(let ((mlst (marks fd i)))
(if (not (= (length mlst) 1))
- (snd-display ";save-marks[~A]: ~A?" i mlst))
+ (snd-display #__line__ ";save-marks[~A]: ~A?" i mlst))
(if (not (= (mark-sample (car mlst)) (* (+ i 1) 1000)))
- (snd-display ";save-marks[~A] at ~A?" i (mark-sample (car mlst))))))
+ (snd-display #__line__ ";save-marks[~A] at ~A?" i (mark-sample (car mlst))))))
(close-sound fd)))
))))
@@ -29509,16 +29588,16 @@ EDITS: 2
(set! (mark-sync m1) 1234)
(let ((m2 (copy m1)))
(if (not (mark? m2))
- (snd-display "; copy mark: ~A?" m2)
+ (snd-display #__line__ "; copy mark: ~A?" m2)
(begin
(if (not (= (mark-sample m1) (mark-sample m2) 1234))
- (snd-display ";copy mark sample: ~A ~A" (mark-sample m1) (mark-sample m2)))
+ (snd-display #__line__ ";copy mark sample: ~A ~A" (mark-sample m1) (mark-sample m2)))
(if (not (= (mark-sync m1) (mark-sync m2) 1234))
- (snd-display ";copy mark sync: ~A ~A" (mark-sync m1) (mark-sync m2)))
+ (snd-display #__line__ ";copy mark sync: ~A ~A" (mark-sync m1) (mark-sync m2)))
(if (not (string=? (mark-name m2) "1234"))
- (snd-display ";copy mark name: ~A?" (mark-name m2))))))
+ (snd-display #__line__ ";copy mark name: ~A?" (mark-name m2))))))
(close-sound fd))
-
+
(let* ((ind (open-sound "pistol.snd"))
(samp1 1834)
(samp2 8345)
@@ -29526,82 +29605,82 @@ EDITS: 2
(m2 (add-mark samp2)))
(set! (mark-sync m1) 123)
(set! (mark-sync m2) 100)
- (if (not (= (mark-sync-max) 1234)) (snd-display ";mark-sync-max: ~A" (mark-sync-max)))
+ (if (not (= (mark-sync-max) 1234)) (snd-display #__line__ ";mark-sync-max: ~A" (mark-sync-max)))
(src-sound -1)
(if (not (= (mark-sample m1) 39788))
- (snd-display ";src -1 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";src -1 m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) 33277))
- (snd-display ";src -1 m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";src -1 m2 -> ~A" (mark-sample m2)))
(undo)
(src-sound .5)
(if (not (= (mark-sample m1) (* 2 samp1)))
- (snd-display ";src .5 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";src .5 m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) (* 2 samp2)))
- (snd-display ";src .5 m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";src .5 m2 -> ~A" (mark-sample m2)))
(undo)
(delete-samples 1000 100)
(if (not (= (mark-sample m1) (- samp1 100)))
- (snd-display ";delete 100 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";delete 100 m1 -> ~A" (mark-sample m1)))
(insert-silence 1000 100)
(if (not (= (mark-sample m1) samp1))
- (snd-display ";insert 100 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";insert 100 m1 -> ~A" (mark-sample m1)))
(revert-sound ind)
(delete-samples 2000 100)
(if (not (= (mark-sample m1) samp1))
- (snd-display ";delete(2) 100 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";delete(2) 100 m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) (- samp2 100)))
- (snd-display ";delete(2) 100 m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";delete(2) 100 m2 -> ~A" (mark-sample m2)))
(insert-silence 2000 100)
(if (not (= (mark-sample m1) samp1))
- (snd-display ";insert(2) 100 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";insert(2) 100 m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) samp2))
- (snd-display ";insert(2) 100 m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";insert(2) 100 m2 -> ~A" (mark-sample m2)))
(revert-sound ind)
(delete-samples 10000 100)
(if (not (= (mark-sample m1) samp1))
- (snd-display ";delete(3) 100 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";delete(3) 100 m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) samp2))
- (snd-display ";delete(3) 100 m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";delete(3) 100 m2 -> ~A" (mark-sample m2)))
(insert-silence 10000 100)
(if (not (= (mark-sample m1) samp1))
- (snd-display ";insert(3) 100 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";insert(3) 100 m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) samp2))
- (snd-display ";insert(3) 100 m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";insert(3) 100 m2 -> ~A" (mark-sample m2)))
(src-sound '(0 .5 1 .5 2 1))
(if (not (= (mark-sample m1) (* 2 samp1)))
- (snd-display ";src env .5 m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";src env .5 m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) (* 2 samp2)))
- (snd-display ";src env .5 m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";src env .5 m2 -> ~A" (mark-sample m2)))
(undo)
(reverse-sound)
(if (not (= (mark-sample m1) 39788))
- (snd-display ";reverse-sound m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";reverse-sound m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) 33277))
- (snd-display ";reverse-sound m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";reverse-sound m2 -> ~A" (mark-sample m2)))
(undo)
(src-sound '(0 -.5 1 -.5 2 -1))
(if (not (= (mark-sample m1) 68598))
- (snd-display ";src -env m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";src -env m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) 61160))
- (snd-display ";src -env m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";src -env m2 -> ~A" (mark-sample m2)))
(revert-sound ind)
(src-channel (make-env '(0 .5 1 1) :length 8001) 2000 10000)
(if (not (= (mark-sample m1) samp1))
- (snd-display ";src-channel(1) m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";src-channel(1) m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) 11345))
- (snd-display ";src-channel(1) m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";src-channel(1) m2 -> ~A" (mark-sample m2)))
(undo)
(src-channel (make-env '(0 .5 1 1) :length 8001) 0 8000)
(if (not (= (mark-sample m1) 3303))
- (snd-display ";src-channel(2) m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";src-channel(2) m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) samp2))
- (snd-display ";src-channel(2) m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";src-channel(2) m2 -> ~A" (mark-sample m2)))
(undo)
(src-channel (make-env '(0 .5 1 1) :length 8001) 10000 8000)
(if (not (= (mark-sample m1) samp1))
- (snd-display ";src-channel(3) m1 -> ~A" (mark-sample m1)))
+ (snd-display #__line__ ";src-channel(3) m1 -> ~A" (mark-sample m1)))
(if (not (= (mark-sample m2) samp2))
- (snd-display ";src-channel(3) m2 -> ~A" (mark-sample m2)))
+ (snd-display #__line__ ";src-channel(3) m2 -> ~A" (mark-sample m2)))
(close-sound ind)
(set! ind (open-sound "2.snd"))
(set! (sync ind) #t)
@@ -29610,10 +29689,10 @@ EDITS: 2
(swap-channels)
(if (or (not (equal? (mark-home m3) (list ind 1)))
(not (equal? (mark-home m4) (list ind 0))))
- (snd-display ";swapped mark homes: ~A ~A?" (mark-home m3) (mark-home m4)))
+ (snd-display #__line__ ";swapped mark homes: ~A ~A?" (mark-home m3) (mark-home m4)))
(if (or (not (= (mark-sample m3) 1000))
(not (= (mark-sample m4) 8000)))
- (snd-display ";swapped mark samples: ~A ~A?" (mark-sample m3) (mark-sample m4)))
+ (snd-display #__line__ ";swapped mark samples: ~A ~A?" (mark-sample m3) (mark-sample m4)))
(close-sound ind))
(set! ind (open-sound "2.snd"))
(set! (sync ind) #t)
@@ -29621,9 +29700,9 @@ EDITS: 2
(delete-samples 1000 10 ind 1)
(swap-channels)
(if (not (equal? (mark-home m3) (list ind 1)))
- (snd-display ";edited swapped mark home: ~A?" (mark-home m3)))
+ (snd-display #__line__ ";edited swapped mark home: ~A?" (mark-home m3)))
(if (not (= (mark-sample m3) 1000))
- (snd-display ";edited swapped mark sample: ~A" (mark-sample m3)))
+ (snd-display #__line__ ";edited swapped mark sample: ~A" (mark-sample m3)))
(delete-marks))
(close-sound ind))
@@ -29635,35 +29714,35 @@ EDITS: 2
(set! sel (selection))
(if (or (not (selection?))
(not (selection? sel)))
- (snd-display ";define-selection-via-marks failed?")
+ (snd-display #__line__ ";define-selection-via-marks failed?")
(let ((mc (selection-members)))
- (if (not (equal? mc (list (list ind 0)))) (snd-display ";selection-members after mark definition: ~A (should be '((~A 0)))" mc ind))
- (if (not (= (selection-position) 123)) (snd-display ";selection-position 123: ~A" (selection-position)))
- (if (not (= (selection-frames) 112)) (snd-display ";selection-frames 112: ~A" (selection-frames)))))
+ (if (not (equal? mc (list (list ind 0)))) (snd-display #__line__ ";selection-members after mark definition: ~A (should be '((~A 0)))" mc ind))
+ (if (not (= (selection-position) 123)) (snd-display #__line__ ";selection-position 123: ~A" (selection-position)))
+ (if (not (= (selection-frames) 112)) (snd-display #__line__ ";selection-frames 112: ~A" (selection-frames)))))
(set! m1 (add-mark 1000 ind 0))
(set! m2 (add-mark 2000 ind 0))
(define-selection-via-marks m1 m2)
(if (not (selection?))
- (snd-display ";define-selection-via-marks repeat failed?")
+ (snd-display #__line__ ";define-selection-via-marks repeat failed?")
(let ((mc (selection-members)))
- (if (not (equal? mc (list (list ind 0)))) (snd-display ";selection-members after 2nd mark definition: ~A (should be '((~A 0)))" mc ind))
- (if (not (= (selection-position) 1000)) (snd-display ";selection-position 1000: ~A" (selection-position)))
- (if (not (= (selection-frames) 1001)) (snd-display ";selection-frames 1001: ~A" (selection-frames)))))
+ (if (not (equal? mc (list (list ind 0)))) (snd-display #__line__ ";selection-members after 2nd mark definition: ~A (should be '((~A 0)))" mc ind))
+ (if (not (= (selection-position) 1000)) (snd-display #__line__ ";selection-position 1000: ~A" (selection-position)))
+ (if (not (= (selection-frames) 1001)) (snd-display #__line__ ";selection-frames 1001: ~A" (selection-frames)))))
(set! (selection-member? #t) #f)
- (if (selection?) (snd-display ";can't clear selection via selection-member?"))
- (if (selection) (snd-display ";(inactive) selection returns: ~A" (selection)))
- (if (selection? sel) (snd-display ";(obsolete) selection returns: ~A" (selection? sel)))
+ (if (selection?) (snd-display #__line__ ";can't clear selection via selection-member?"))
+ (if (selection) (snd-display #__line__ ";(inactive) selection returns: ~A" (selection)))
+ (if (selection? sel) (snd-display #__line__ ";(obsolete) selection returns: ~A" (selection? sel)))
(set! (selection-member? ind 0) #t)
(set! (selection-position ind 0) 2000)
(set! (selection-frames ind 0) 1234)
(snap-marks)
(set! m1 (find-mark 2000 ind 0))
- (if (not (mark? m1)) (snd-display ";snap-marks start: ~A" (map mark-sample (marks ind 0))))
+ (if (not (mark? m1)) (snd-display #__line__ ";snap-marks start: ~A" (map mark-sample (marks ind 0))))
(set! m2 (find-mark (+ 2000 1234)))
- (if (not (mark? m2)) (snd-display ";snap-marks end: ~A" (map mark-sample (marks ind 0))))
+ (if (not (mark? m2)) (snd-display #__line__ ";snap-marks end: ~A" (map mark-sample (marks ind 0))))
(set! (selection-position ind 0) (+ (frames ind 0) 1123))
(if (not (= (selection-position ind 0) (- (frames ind) 1)))
- (snd-display ";selection position past eof: ~A ~A" (selection-position ind 0) (- (frames ind) 1)))
+ (snd-display #__line__ ";selection position past eof: ~A ~A" (selection-position ind 0) (- (frames ind) 1)))
(revert-sound ind)
(src-sound '(0 .5 1 1.75665))
;; trying to hit previous dur on the nose "by accident..."
@@ -29689,8 +29768,8 @@ EDITS: 2
(if (not (null? current-marks))
(let ((id (list-ref current-marks (random (- (length current-marks) 1)))))
(if (not (equal? id (find-mark (mark-sample id))))
- (snd-display ";two marks at ~A? ~A" (mark-sample id) (map mark-sample current-marks)))
- (if (find-mark "not-a-name") (snd-display ";find-bogus-mark: ~A" (find-mark "not-a-name")))))
+ (snd-display #__line__ ";two marks at ~A? ~A" (mark-sample id) (map mark-sample current-marks)))
+ (if (find-mark "not-a-name") (snd-display #__line__ ";find-bogus-mark: ~A" (find-mark "not-a-name")))))
(case (random 15)
((0) (let* ((beg (random (frames)))
@@ -29704,23 +29783,23 @@ EDITS: 2
(if (> old-loc beg)
(begin
(if (not (mark? id))
- (snd-display ";insert clobbered mark: ~A" id)
+ (snd-display #__line__ ";insert clobbered mark: ~A" id)
(if (not (= (mark-sample id) (+ old-loc dur)))
- (snd-display ";insert, mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur))))))
+ (snd-display #__line__ ";insert, mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur))))))
current-marks
current-samples))))
((1) (if (> (car (edits ind 0)) 0) (undo)))
((2) (if (> (cadr (edits ind 0)) 0) (redo)))
((3) (if (> (maxamp ind 0) .1) (scale-channel .5) (scale-channel 2.0))
(if (not (equal? (marks ind 0) current-marks))
- (snd-display ";scaling changed marks: ~A ~A" (marks ind 0) current-marks))
+ (snd-display #__line__ ";scaling changed marks: ~A ~A" (marks ind 0) current-marks))
(if (not (equal? (map mark-sample (marks ind 0)) current-samples))
- (snd-display ";scaling changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
+ (snd-display #__line__ ";scaling changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
((4) (set! (sample (random (- (frames) 1))) .5)
(if (not (equal? (marks ind 0) current-marks))
- (snd-display ";set-sample changed marks: ~A ~A" (marks ind 0) current-marks))
+ (snd-display #__line__ ";set-sample changed marks: ~A ~A" (marks ind 0) current-marks))
(if (not (equal? (map mark-sample (marks ind 0)) current-samples))
- (snd-display ";set-sample changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
+ (snd-display #__line__ ";set-sample changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
((5) (let* ((beg (random (frames)))
(dur (max 1 (random 100)))
(end (+ beg dur)))
@@ -29731,13 +29810,13 @@ EDITS: 2
(if (and (> old-loc beg)
(< old-loc end)
(mark? id))
- (snd-display ";delete did not clobber mark: ~A ~A [~A ~A]" id old-loc beg end)
+ (snd-display #__line__ ";delete did not clobber mark: ~A ~A [~A ~A]" id old-loc beg end)
(if (and (> old-loc end)
(not (= (mark-sample id) (- old-loc dur))))
- (snd-display ";delete ripple mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur)
+ (snd-display #__line__ ";delete ripple mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur)
(if (and (< old-loc beg)
(not (= (mark-sample id) old-loc)))
- (snd-display ";delete but mark before: ~A ~A ~A ~A" id old-loc (mark-sample id) beg)))))
+ (snd-display #__line__ ";delete but mark before: ~A ~A ~A ~A" id old-loc (mark-sample id) beg)))))
current-marks
current-samples))))
((6) (revert-sound))
@@ -29746,18 +29825,18 @@ EDITS: 2
(let ((id (list-ref current-marks (random (- (length current-marks) 1)))))
(delete-mark id)
(if (mark? id)
- (snd-display ";delete-mark failed? ~A" id))
+ (snd-display #__line__ ";delete-mark failed? ~A" id))
(if (not (= (length (marks ind 0)) (- (length current-marks) 1)))
- (snd-display ";delete-mark list trouble: ~A ~A ~A" id current-marks (marks ind 0))))))
+ (snd-display #__line__ ";delete-mark list trouble: ~A ~A ~A" id current-marks (marks ind 0))))))
((8) (let ((rate (if (> (frames) 200000) 2.0 0.5)))
(src-channel rate)
(if (not (null? current-marks))
(for-each
(lambda (id old-loc)
(if (not (mark? id))
- (snd-display ";src-channel clobbered mark: ~A" id)
+ (snd-display #__line__ ";src-channel clobbered mark: ~A" id)
(if (> (abs (- (/ old-loc rate) (mark-sample id))) 2)
- (snd-display ";src moved mark: ~A ~A ~A (~A -> ~A)"
+ (snd-display #__line__ ";src moved mark: ~A ~A ~A (~A -> ~A)"
id old-loc (mark-sample id) rate (- (/ old-loc rate) (mark-sample id))))))
current-marks
current-samples))))
@@ -29766,9 +29845,9 @@ EDITS: 2
(for-each
(lambda (id old-loc)
(if (not (mark? id))
- (snd-display ";reverse-channel clobbered mark: ~A" id)
+ (snd-display #__line__ ";reverse-channel clobbered mark: ~A" id)
(if (> (abs (- (- (frames) old-loc) (mark-sample id))) 2)
- (snd-display ";reverse moved mark: ~A ~A ~A (~A)"
+ (snd-display #__line__ ";reverse moved mark: ~A ~A ~A (~A)"
id old-loc (- (frames) old-loc) (mark-sample id)))))
current-marks
current-samples)))
@@ -29787,13 +29866,13 @@ EDITS: 2
(not (= (list-ref (car val0) 5) 0))
(not (= (list-ref val0 1) 4321))
(not (= (list-ref val0 2) 4320)))
- (snd-display ";describe-mark m0: ~A" val0))
+ (snd-display #__line__ ";describe-mark m0: ~A" val0))
(if (or (not (equal? (list-ref (car val1) 0) m1))
(not (equal? (list-ref (car val1) 2) ind))
(not (= (list-ref (car val1) 5) 0))
(not (eq? (list-ref val1 1) #f))
(not (= (list-ref val1 2) 1234)))
- (snd-display ";describe-mark m1: ~A" val1))
+ (snd-display #__line__ ";describe-mark m1: ~A" val1))
(delete-mark m0)
(delete-sample 5000)
(set! val0 (describe-mark m0))
@@ -29804,14 +29883,14 @@ EDITS: 2
(not (= (list-ref val0 1) 4321))
(not (eq? (list-ref val0 2) #f))
(not (eq? (list-ref val0 3) #f)))
- (snd-display ";describe-mark m0 [1]: ~A" val0))
+ (snd-display #__line__ ";describe-mark m0 [1]: ~A" val0))
(if (or (not (equal? (list-ref (car val1) 0) m1))
(not (equal? (list-ref (car val1) 2) ind))
(not (= (list-ref (car val1) 5) 0))
(not (eq? (list-ref val1 1) #f))
(not (= (list-ref val1 2) 1234))
(not (= (list-ref val1 3) 1234)))
- (snd-display ";describe-mark m1 [1]: ~A" val1)))))
+ (snd-display #__line__ ";describe-mark m1 [1]: ~A" val1)))))
(revert-sound ind)
(add-hook! draw-mark-hook (lambda (id) #t))
(let ((m0 (add-mark 4321))
@@ -29819,17 +29898,17 @@ EDITS: 2
(dur (/ (frames ind) (srate ind))))
(pad-marks (list m0 m1) .01)
(if (fneq (/ (frames ind) (srate ind)) (+ dur .02))
- (snd-display ";pad-marks: ~A ~A" dur (/ (frames ind) (srate ind))))
+ (snd-display #__line__ ";pad-marks: ~A ~A" dur (/ (frames ind) (srate ind))))
(if (and (not (= (mark-sample m0) 4763))
(not (= (mark-sample m0) 4761)))
- (snd-display ";pad-marks m0 pos: ~A" (mark-sample m0)))
- (if (fneq (sample 1235) 0.0) (snd-display ";pad-marks 1235: ~A" (sample 1235))))
+ (snd-display #__line__ ";pad-marks m0 pos: ~A" (mark-sample m0)))
+ (if (fneq (sample 1235) 0.0) (snd-display #__line__ ";pad-marks 1235: ~A" (sample 1235))))
(close-sound ind))
(reset-hook! draw-mark-hook)
(let ((ind (open-sound "oboe.snd")))
- (if (forward-mark) (snd-display ";forward-mark when no marks: ~A" (forward-mark)))
- (if (backward-mark) (snd-display ";backward-mark when no marks: ~A" (backward-mark)))
- (if (find-mark 12345) (snd-display ";find-mark when no marks: ~A" (find-mark 12345)))
+ (if (forward-mark) (snd-display #__line__ ";forward-mark when no marks: ~A" (forward-mark)))
+ (if (backward-mark) (snd-display #__line__ ";backward-mark when no marks: ~A" (backward-mark)))
+ (if (find-mark 12345) (snd-display #__line__ ";find-mark when no marks: ~A" (find-mark 12345)))
(let ((m0 (add-mark 123 ind 0)))
(delete-sample 0)
(let ((m1 (add-mark 23 ind 0)))
@@ -29838,9 +29917,9 @@ EDITS: 2
(let ((m00 (find-mark 123 ind 0 0))
(m01 (find-mark "23"))
(m02 (find-mark 121)))
- (if (not m00) (snd-display ";can't find 00th mark"))
- (if (not m01) (snd-display ";can't find 01th mark"))
- (if (not m02) (snd-display ";can't find 02th mark"))
+ (if (not m00) (snd-display #__line__ ";can't find 00th mark"))
+ (if (not m01) (snd-display #__line__ ";can't find 01th mark"))
+ (if (not m02) (snd-display #__line__ ";can't find 02th mark"))
(delete-mark (find-mark "23"))
(scale-by 2.0)
(set! m1 (add-mark 1234))
@@ -29848,25 +29927,25 @@ EDITS: 2
(let ((m10 (find-mark "23"))
(m11 (find-mark "23" ind 0 1))
(m12 (find-mark "23" ind 0 2)))
- (if (not m10) (snd-display ";can't find 10th mark")
- (if (not (= (mark-sample m10) 1234)) (snd-display ";mark 10th: ~A" (mark-sample m10))))
- (if (not m11) (snd-display ";can't find 11th mark")
- (if (not (= (mark-sample m11 1) 23)) (snd-display ";mark 11th: ~A" (mark-sample m11 1))))
- (if (mark? m12) (snd-display ";found 12th mark: ~A ~A ~A" m12 (mark-sample m12 2) (mark-name m12 2)))))
+ (if (not m10) (snd-display #__line__ ";can't find 10th mark")
+ (if (not (= (mark-sample m10) 1234)) (snd-display #__line__ ";mark 10th: ~A" (mark-sample m10))))
+ (if (not m11) (snd-display #__line__ ";can't find 11th mark")
+ (if (not (= (mark-sample m11 1) 23)) (snd-display #__line__ ";mark 11th: ~A" (mark-sample m11 1))))
+ (if (mark? m12) (snd-display #__line__ ";found 12th mark: ~A ~A ~A" m12 (mark-sample m12 2) (mark-name m12 2)))))
(set! (mark-name m1) #f)))
(close-sound ind))
(if (provided? 'snd-debug)
(let ((ind (open-sound "oboe.snd")))
(let ((m0 (add-mark 1223 ind 0)))
(internal-test-control-drag-mark ind 0 m0)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";test C-drag mark failed?")))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";test C-drag mark failed?")))
(close-sound ind)))
(if (string? sf-dir)
(let ((ind (open-sound (string-append sf-dir "forest.aiff"))))
(mark-loops)
(let ((pos (map mark-sample (marks ind 0))))
(if (not (equal? pos (list 24981 144332)))
- (snd-display ";forest marked loops: ~A ~A" (marks ind 0) pos)))
+ (snd-display #__line__ ";forest marked loops: ~A ~A" (marks ind 0) pos)))
(close-sound ind)))
))
@@ -29884,39 +29963,39 @@ EDITS: 2
(load (string-append cwd "oboe.marks"))
(let ((m (find-mark 123 ind 0)))
(if (not (mark? m))
- (snd-display ";save marks missed 123?")
+ (snd-display #__line__ ";save marks missed 123?")
(begin
- (if (not (= (string-length (mark-name m)) 0)) (snd-display ";saved mark 123 name: ~A" (mark-name m)))
- (if (not (= (mark-sync m) 0)) (snd-display ";saved mark 123 sync: ~A" (mark-sync m))))))
+ (if (not (= (string-length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 123 name: ~A" (mark-name m)))
+ (if (not (= (mark-sync m) 0)) (snd-display #__line__ ";saved mark 123 sync: ~A" (mark-sync m))))))
(let ((m1-sync 0))
(let ((m (find-mark 234 ind 0)))
(if (not (mark? m))
- (snd-display ";save marks missed 234?")
+ (snd-display #__line__ ";save marks missed 234?")
(begin
- (if (not (string=? (mark-name m) "hiho")) (snd-display ";saved mark 234 name: ~A" (mark-name m)))
- (if (or (= (mark-sync m) 0) (= (mark-sync m) 1)) (snd-display ";saved mark 234 sync: ~A" (mark-sync m)))
+ (if (not (string=? (mark-name m) "hiho")) (snd-display #__line__ ";saved mark 234 name: ~A" (mark-name m)))
+ (if (or (= (mark-sync m) 0) (= (mark-sync m) 1)) (snd-display #__line__ ";saved mark 234 sync: ~A" (mark-sync m)))
(set! m1-sync (mark-sync m)))))
(let ((m (find-mark 345 ind 0)))
(if (not (mark? m))
- (snd-display ";save marks missed 345?")
+ (snd-display #__line__ ";save marks missed 345?")
(begin
- (if (not (= (string-length (mark-name m)) 0)) (snd-display ";saved mark 345 name: ~A" (mark-name m)))
- (if (not (= (mark-sync m) m1-sync)) (snd-display ";saved mark 345 sync: ~A ~A" (mark-sync m) m1-sync)))))
+ (if (not (= (string-length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 345 name: ~A" (mark-name m)))
+ (if (not (= (mark-sync m) m1-sync)) (snd-display #__line__ ";saved mark 345 sync: ~A ~A" (mark-sync m) m1-sync)))))
(let ((m (find-mark 567 ind 0)))
(if (not (mark? m))
- (snd-display ";save marks missed 567?")
+ (snd-display #__line__ ";save marks missed 567?")
(begin
- (if (not (= (string-length (mark-name m)) 0)) (snd-display ";saved mark 567 name: ~A" (mark-name m)))
- (if (not (= (mark-sync m) m1-sync)) (snd-display ";saved mark 567 sync: ~A ~A" (mark-sync m) m1-sync)))))
+ (if (not (= (string-length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 567 name: ~A" (mark-name m)))
+ (if (not (= (mark-sync m) m1-sync)) (snd-display #__line__ ";saved mark 567 sync: ~A ~A" (mark-sync m) m1-sync)))))
(let ((m (find-mark 456 ind 0)))
(if (not (mark? m))
- (snd-display ";save marks missed 456?")
+ (snd-display #__line__ ";save marks missed 456?")
(begin
- (if (not (string=? (mark-name m) "a mark")) (snd-display ";saved mark 456 name: ~A" (mark-name m)))
+ (if (not (string=? (mark-name m) "a mark")) (snd-display #__line__ ";saved mark 456 name: ~A" (mark-name m)))
(if (or (= (mark-sync m) m1-sync)
(= (mark-sync m) 0)
(= (mark-sync m) 1))
- (snd-display ";saved mark 456 sync: ~A ~A" (mark-sync m) m1-sync)))))
+ (snd-display #__line__ ";saved mark 456 sync: ~A ~A" (mark-sync m) m1-sync)))))
)
(delete-file "oboe.marks")
@@ -29942,47 +30021,47 @@ EDITS: 2
(let ((m1 (find-mark 1 ind 0))
(m2 (find-mark 2 ind 1)))
(if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display ";save-marks 2a 1,2: ~A ~A" m1 m2)
+ (snd-display #__line__ ";save-marks 2a 1,2: ~A ~A" m1 m2)
(if (or (not (= (mark-sync m1) 0)) (not (= (mark-sync m2) 0)))
- (snd-display ";save-marks 2a 1,2 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
+ (snd-display #__line__ ";save-marks 2a 1,2 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
(let ((m1 (find-mark 5 ind 0))
(m2 (find-mark 10 ind 1)))
(if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display ";save-marks 2a 5,10: ~A ~A" m1 m2)
+ (snd-display #__line__ ";save-marks 2a 5,10: ~A ~A" m1 m2)
(if (or (= (mark-sync m1) 0)
(not (= (mark-sync m1) (mark-sync m2))))
- (snd-display ";save-marks 2a 5,10 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
+ (snd-display #__line__ ";save-marks 2a 5,10 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
(let ((m1 (find-mark 4 ind 0))
(m2 (find-mark 8 ind 1))
(m3 (find-mark 5 ind 0)))
(if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display ";save-marks 2a 4,8: ~A ~A" m1 m2)
+ (snd-display #__line__ ";save-marks 2a 4,8: ~A ~A" m1 m2)
(if (or (= (mark-sync m1) 0)
(= (mark-sync m2) 0)
(= (mark-sync m1) (mark-sync m2))
(= (mark-sync m1) (mark-sync m3)))
- (snd-display ";save-marks 2a 4,8 syncs: ~A ~A ~A" (mark-sync m1) (mark-sync m2) (mark-sync m3)))))
+ (snd-display #__line__ ";save-marks 2a 4,8 syncs: ~A ~A ~A" (mark-sync m1) (mark-sync m2) (mark-sync m3)))))
(let ((m1 (find-mark 3 ind 0))
(m2 (find-mark 6 ind 1)))
(if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display ";save-marks 2a 3,6: ~A ~A" m1 m2)
+ (snd-display #__line__ ";save-marks 2a 3,6: ~A ~A" m1 m2)
(begin
(if (or (not (= (mark-sync m1) 0)) (not (= (mark-sync m2) 0)))
- (snd-display ";save-marks 2a 3,6 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))
- (if (not (string=? (mark-name m1) "hi3")) (snd-display ";save-marks 2a 3 name: ~A" (mark-name m1)))
- (if (not (string=? (mark-name m2) "hi6")) (snd-display ";save-marks 2a 6 name: ~A" (mark-name m2))))))
+ (snd-display #__line__ ";save-marks 2a 3,6 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))
+ (if (not (string=? (mark-name m1) "hi3")) (snd-display #__line__ ";save-marks 2a 3 name: ~A" (mark-name m1)))
+ (if (not (string=? (mark-name m2) "hi6")) (snd-display #__line__ ";save-marks 2a 6 name: ~A" (mark-name m2))))))
(let ((m1 (find-mark 4 ind 0))
(m2 (find-mark 5 ind 0))
(m3 (find-mark 20 ind 0))
(m4 (find-mark 40 ind 1))
(m5 (find-mark 60 ind 1)))
(if (or (not (mark? m3)) (not (mark? m4)) (not (mark? m5)))
- (snd-display ";save-marks 2a 20...: ~A ~A ~A" m3 m4 m5)
+ (snd-display #__line__ ";save-marks 2a 20...: ~A ~A ~A" m3 m4 m5)
(if (or (= (mark-sync m3) 0)
(= (mark-sync m1) (mark-sync m3))
(= (mark-sync m2) (mark-sync m3))
(not (= (mark-sync m3) (mark-sync m4) (mark-sync m5))))
- (snd-display ";save-marks 2a 10... syncs: ~A ~A ~A" (mark-sync m3) (mark-sync m4) (mark-sync m5)))))
+ (snd-display #__line__ ";save-marks 2a 10... syncs: ~A ~A ~A" (mark-sync m3) (mark-sync m4) (mark-sync m5)))))
(delete-file "test.marks")
(close-sound ind))
@@ -30003,16 +30082,16 @@ EDITS: 2
(eval-header ind)
(let ((ms (marks ind 0)))
- (if (not (= (length ms) 5)) (snd-display ";eval-header + marks->string: ~A" ms))
+ (if (not (= (length ms) 5)) (snd-display #__line__ ";eval-header + marks->string: ~A" ms))
(let ((samps (map mark-sample ms)))
(if (or (not (member 123 samps))
(not (member 567 samps)))
- (snd-display ";eval marked header samps: ~A" samps)))
- (if (not (find-mark 234)) (snd-display ";eval mark header no mark at 234?"))
+ (snd-display #__line__ ";eval marked header samps: ~A" samps)))
+ (if (not (find-mark 234)) (snd-display #__line__ ";eval mark header no mark at 234?"))
(if (mark? (find-mark 456))
(if (not (= (mark-sync (find-mark 456)) 2))
- (snd-display ";eval mark header sync: ~A" (mark-sync (find-mark 456))))
- (snd-display ";no mark at 456")))
+ (snd-display #__line__ ";eval mark header sync: ~A" (mark-sync (find-mark 456))))
+ (snd-display #__line__ ";no mark at 456")))
(close-sound ind)
(mus-sound-forget "tst.snd")
@@ -30028,26 +30107,26 @@ EDITS: 2
(mark-explode)
(if (file-exists? "mark-0.snd")
(let ((ind1 (open-sound "mark-0.snd")))
- (if (not (= (frames ind1 0) 10)) (snd-display ";mark-0 frames: ~A" (frames ind1 0)))
- (if (not (vequal (channel->vct) (make-vct 10 .1))) (snd-display ";mark-0 vals: ~A" (channel->vct)))
+ (if (not (= (frames ind1 0) 10)) (snd-display #__line__ ";mark-0 frames: ~A" (frames ind1 0)))
+ (if (not (vequal (channel->vct) (make-vct 10 .1))) (snd-display #__line__ ";mark-0 vals: ~A" (channel->vct)))
(close-sound ind1)
(delete-file "mark-0.snd"))
- (snd-display ";mark-explode did not write mark-0.snd?"))
+ (snd-display #__line__ ";mark-explode did not write mark-0.snd?"))
(if (file-exists? "mark-1.snd")
(let ((ind1 (open-sound "mark-1.snd")))
- (if (not (= (frames ind1 0) 10)) (snd-display ";mark-1 frames: ~A" (frames ind1 0)))
- (if (not (vequal (channel->vct) (make-vct 10 .4))) (snd-display ";mark-1 vals: ~A" (channel->vct)))
+ (if (not (= (frames ind1 0) 10)) (snd-display #__line__ ";mark-1 frames: ~A" (frames ind1 0)))
+ (if (not (vequal (channel->vct) (make-vct 10 .4))) (snd-display #__line__ ";mark-1 vals: ~A" (channel->vct)))
(close-sound ind1)
(delete-file "mark-1.snd"))
- (snd-display ";mark-explode did not write mark-1.snd?"))
+ (snd-display #__line__ ";mark-explode did not write mark-1.snd?"))
(if (file-exists? "mark-2.snd")
(let ((ind1 (open-sound "mark-2.snd")))
- (if (not (= (frames ind1 0) 10)) (snd-display ";mark-2 frames: ~A" (frames ind1 0)))
- (if (not (vequal (channel->vct) (make-vct 10 .8))) (snd-display ";mark-2 vals: ~A" (channel->vct)))
+ (if (not (= (frames ind1 0) 10)) (snd-display #__line__ ";mark-2 frames: ~A" (frames ind1 0)))
+ (if (not (vequal (channel->vct) (make-vct 10 .8))) (snd-display #__line__ ";mark-2 vals: ~A" (channel->vct)))
(close-sound ind1)
(delete-file "mark-2.snd"))
- (snd-display ";mark-explode did not write mark-2.snd?"))
- (if (file-exists? "mark-3.snd") (snd-display ";mark-explode wrote too many files?"))
+ (snd-display #__line__ ";mark-explode did not write mark-2.snd?"))
+ (if (file-exists? "mark-3.snd") (snd-display #__line__ ";mark-explode wrote too many files?"))
(let ((name (file-name ind)))
(close-sound ind)
(if (file-exists? name) (delete-file name))))
@@ -30101,7 +30180,7 @@ EDITS: 2
(help-dialog "Test" "snd-test here")
(save-envelopes "hiho.env")
(load (string-append cwd "hiho.env"))
- (if (not (equal? env4 (list 0.0 1.0 1.0 0.0))) (snd-display ";save-envelopes: ~A?" env4))
+ (if (not (equal? env4 (list 0.0 1.0 1.0 0.0))) (snd-display #__line__ ";save-envelopes: ~A?" env4))
(delete-file "hiho.env")
(help-dialog "test2" "this is the next test"
(list "string 1{open-sound}" "{env-sound}string2" "string{close-sound}3")
@@ -30114,10 +30193,10 @@ EDITS: 2
(dismiss-all-dialogs)
(close-sound ind))
(if (not (string=? (snd-url 'open-sound) "extsnd.html#opensound"))
- (snd-display ";snd-url 'open-sound: ~A" (snd-url 'open-sound)))
+ (snd-display #__line__ ";snd-url 'open-sound: ~A" (snd-url 'open-sound)))
(if (not (string=? (snd-url "open-sound") "extsnd.html#opensound"))
- (snd-display ";snd-url \"open-sound\": ~A" (snd-url "open-sound")))
- (if (not (list? (snd-urls))) (snd-display ";snd-urls: ~A" (snd-urls)))
+ (snd-display #__line__ ";snd-url \"open-sound\": ~A" (snd-url "open-sound")))
+ (if (not (list? (snd-urls))) (snd-display #__line__ ";snd-urls: ~A" (snd-urls)))
(let ((str1 (snd-help open-sound))
(str2 (snd-help 'open-sound))
(str3 (snd-help "open-sound")))
@@ -30125,25 +30204,25 @@ EDITS: 2
(not (string? str2))
(not (string? str3))
(not (string-equal-ignoring-white-space str2 str3)))
- (snd-display ";snd-help open-sound: ~A ~A ~A" str1 str2 str3)))
-; (if (not (string? (snd-help 'open-soud)))
-; (snd-display ";snd-help open-soud (misspelled on purpose) failed"))
+ (snd-display #__line__ ";snd-help open-sound: ~A ~A ~A" str1 str2 str3)))
+ ; (if (not (string? (snd-help 'open-soud)))
+ ; (snd-display #__line__ ";snd-help open-soud (misspelled on purpose) failed"))
(if (not (string-equal-ignoring-white-space (snd-help enved-base) "(enved-base): envelope editor exponential base value (1.0)"))
- (snd-display ";snd-help enved-base: ~A?" (snd-help enved-base)))
+ (snd-display #__line__ ";snd-help enved-base: ~A?" (snd-help enved-base)))
(if (not (string-equal-ignoring-white-space (snd-help 'enved-base) "(enved-base): envelope editor exponential base value (1.0)"))
- (snd-display ";snd-help 'enved-base: ~A?" (snd-help 'enved-base)))
+ (snd-display #__line__ ";snd-help 'enved-base: ~A?" (snd-help 'enved-base)))
(if (not (string-equal-ignoring-white-space (snd-help "enved-base") "(enved-base): envelope editor exponential base value (1.0)"))
- (snd-display ";snd-help \"enved-base\": ~A?" (snd-help "enved-base")))
+ (snd-display #__line__ ";snd-help \"enved-base\": ~A?" (snd-help "enved-base")))
(let ((old-val hamming-window))
(let ((str1 (snd-help 'hamming-window))
(str2 (snd-help "hamming-window")))
(if (or (not (string? str1)) (not (string? str2))
(not (string-equal-ignoring-white-space str1 str2))
(not (string-equal-ignoring-white-space str1 "A raised cosine")))
- (snd-display ";snd-help hamming-window: ~A ~A" str1 str2)))
+ (snd-display #__line__ ";snd-help hamming-window: ~A ~A" str1 str2)))
(if (or (not (number? hamming-window))
(not (= hamming-window old-val)))
- (snd-display ";snd-help clobbered out-of-module variable: ~A ~A" old-value hamming-window)))
+ (snd-display #__line__ ";snd-help clobbered out-of-module variable: ~A ~A" old-value hamming-window)))
(let ((vals (snd-urls)))
(do ((i 0 (+ 1 i)))
((= i 25)) ; need to cycle the 8's
@@ -30153,24 +30232,23 @@ EDITS: 2
(set! (show-indices) #t)
(let ((ind (open-sound "oboe.snd")))
(if (< (length (sound-widgets ind)) 4)
- (snd-display ";sound-widgets: ~A?" (sound-widgets ind)))
+ (snd-display #__line__ ";sound-widgets: ~A?" (sound-widgets ind)))
(report-in-minibuffer "hi there" ind)
(if with-gui
(let ((str (widget-text (list-ref (sound-widgets ind) 3))))
(if (not (string=? str "hi there"))
- (snd-display ";report-in-minibuffer: ~A?" str))))
- (append-to-minibuffer "away!" ind)
+ (snd-display #__line__ ";report-in-minibuffer: ~A?" str))))
(if with-gui
(let ((str (widget-text (list-ref (sound-widgets ind) 3))))
- (if (not (string=? str "hi thereaway!"))
- (snd-display ";report-in-minibuffer 1: ~A?" str))
+ (if (not (string=? str "hi there"))
+ (snd-display #__line__ ";report-in-minibuffer 1: ~A?" str))
(if (widget-text (cadr (main-widgets)))
- (snd-display ";widget text should be #f: ~A" (widget-text (cadr (main-widgets)))))
+ (snd-display #__line__ ";widget text should be #f: ~A" (widget-text (cadr (main-widgets)))))
(let ((str (format #f "~A: ~A" (sound->integer ind) (short-file-name ind)))
(txt (widget-text (cadr (sound-widgets ind)))))
(if (or (not (string? txt))
(not (string=? str txt)))
- (snd-display ";name text: ~A ~A" str txt)))))
+ (snd-display #__line__ ";name text: ~A ~A" str txt)))))
(clear-minibuffer)
(close-sound ind))
(if (file-exists? "link-oboe.snd")
@@ -30178,7 +30256,7 @@ EDITS: 2
(linked-str (format #f "~A: (~A)" (sound->integer ind) (short-file-name ind))))
(if with-gui
(if (not (string=? linked-str (widget-text (cadr (sound-widgets ind)))))
- (snd-display ";linked name text: ~A ~A" linked-str (widget-text (cadr (sound-widgets ind))))))
+ (snd-display #__line__ ";linked name text: ~A ~A" linked-str (widget-text (cadr (sound-widgets ind))))))
(if (and (provided? 'xm) (provided? 'snd-debug))
(XtCallCallbacks (cadr (sound-widgets ind)) XmNactivateCallback (snd-sound-pointer ind)))
(close-sound ind)))
@@ -30188,19 +30266,19 @@ EDITS: 2
(linked-str (format #f "(~A)" (short-file-name ind))))
(if with-gui
(if (not (string=? linked-str (widget-text (cadr (sound-widgets ind)))))
- (snd-display ";linked name text (no index): ~A ~A" linked-str (widget-text (cadr (sound-widgets ind))))))
+ (snd-display #__line__ ";linked name text (no index): ~A ~A" linked-str (widget-text (cadr (sound-widgets ind))))))
(close-sound ind)))
(define-envelope test-ramp '(0 0 1 1))
- (if (not (equal? test-ramp '(0 0 1 1))) (snd-display ";define-envelope test-ramp: ~A" test-ramp))
+ (if (not (equal? test-ramp '(0 0 1 1))) (snd-display #__line__ ";define-envelope test-ramp: ~A" test-ramp))
(define-envelope test-ramp '(0 1 1 0))
- (if (not (equal? test-ramp '(0 1 1 0))) (snd-display ";re-define-envelope test-ramp: ~A" test-ramp))
+ (if (not (equal? test-ramp '(0 1 1 0))) (snd-display #__line__ ";re-define-envelope test-ramp: ~A" test-ramp))
(if (or (provided? 'xm) (provided? 'xg))
(begin
(load "oscope.scm")
;; oscope exists
- (if (not (sound-data? (cadr oscope))) (snd-display ";oscope: ~A" oscope))
+ (if (not (sound-data? (cadr oscope))) (snd-display #__line__ ";oscope: ~A" oscope))
(if (provided? 'snd-motif)
(XtUnmanageChild oscope-dialog)
(gtk_widget_hide oscope-dialog))))
@@ -30214,28 +30292,28 @@ EDITS: 2
(vffiles (view-files-files dialog))
(vfsel (view-files-selected-files dialog))
(selected-file #f))
- (if (fneq vfamp 1.0) (snd-display ";vf amp: ~A" vfamp))
- (if (fneq vfs 1.0) (snd-display ";vf spd: ~A" vfs))
- (if (not (= vfsort 0)) (snd-display ";vf sort: ~A" vfsort))
- (if (not (= vfsort1 0)) (snd-display ";vf sort(d): ~A" vfsort1))
- (if (not (feql vfe (list 0.0 1.0 1.0 1.0))) (snd-display ";vf amp env: ~A" vfe))
- (if (not (list? vffiles)) (snd-display ";vf files: ~A" vffiles))
- (if (not (list? vfsel)) (snd-display ";vf selected files: ~A" vfsel))
+ (if (fneq vfamp 1.0) (snd-display #__line__ ";vf amp: ~A" vfamp))
+ (if (fneq vfs 1.0) (snd-display #__line__ ";vf spd: ~A" vfs))
+ (if (not (= vfsort 0)) (snd-display #__line__ ";vf sort: ~A" vfsort))
+ (if (not (= vfsort1 0)) (snd-display #__line__ ";vf sort(d): ~A" vfsort1))
+ (if (not (feql vfe (list 0.0 1.0 1.0 1.0))) (snd-display #__line__ ";vf amp env: ~A" vfe))
+ (if (not (list? vffiles)) (snd-display #__line__ ";vf files: ~A" vffiles))
+ (if (not (list? vfsel)) (snd-display #__line__ ";vf selected files: ~A" vfsel))
(if (not (= (view-files-speed-style dialog) (speed-control-style)))
- (snd-display ";vf speed-style def: ~A ~A" (view-files-speed-style dialog) (speed-control-style)))
+ (snd-display #__line__ ";vf speed-style def: ~A ~A" (view-files-speed-style dialog) (speed-control-style)))
(set! (view-files-amp dialog) 0.5)
- (if (fneq (view-files-amp dialog) 0.5) (snd-display ";set vf amp: ~A" (view-files-amp dialog)))
+ (if (fneq (view-files-amp dialog) 0.5) (snd-display #__line__ ";set vf amp: ~A" (view-files-amp dialog)))
(set! (view-files-speed dialog) 0.5)
- (if (fneq (view-files-speed dialog) 0.5) (snd-display ";set vf spd: ~A" (view-files-speed dialog)))
+ (if (fneq (view-files-speed dialog) 0.5) (snd-display #__line__ ";set vf spd: ~A" (view-files-speed dialog)))
(set! (view-files-speed-style dialog) speed-control-as-ratio)
(if (not (= (view-files-speed-style dialog) speed-control-as-ratio))
- (snd-display ";vf speed-style set: ~A" (view-files-speed-style dialog)))
+ (snd-display #__line__ ";vf speed-style set: ~A" (view-files-speed-style dialog)))
(set! (view-files-sort dialog) 2)
- (if (not (= (view-files-sort) 0)) (snd-display ";vf global sort after local set: ~A" (view-files-sort)))
- (if (not (= (view-files-sort dialog) 2)) (snd-display ";vf local sort after local set: ~A" (view-files-sort dialog)))
+ (if (not (= (view-files-sort) 0)) (snd-display #__line__ ";vf global sort after local set: ~A" (view-files-sort)))
+ (if (not (= (view-files-sort dialog) 2)) (snd-display #__line__ ";vf local sort after local set: ~A" (view-files-sort dialog)))
(set! (view-files-sort) 4)
- (if (not (= (view-files-sort) 4)) (snd-display ";vf global sort after global set: ~A" (view-files-sort)))
- (if (not (= (view-files-sort dialog) 2)) (snd-display ";vf local sort after global set: ~A" (view-files-sort dialog)))
+ (if (not (= (view-files-sort) 4)) (snd-display #__line__ ";vf global sort after global set: ~A" (view-files-sort)))
+ (if (not (= (view-files-sort dialog) 2)) (snd-display #__line__ ";vf local sort after global set: ~A" (view-files-sort dialog)))
(set! (view-files-files dialog) (list "oboe.snd" "1a.snd" "pistol.snd" "storm.snd"))
(let ((vf-files (view-files-files dialog)))
(if (or (and (not (member "1a.snd" vf-files))
@@ -30245,23 +30323,23 @@ EDITS: 2
(not (member (string-append home-dir "/cl/pistol.snd") vf-files))
(not (member (string-append home-dir "/snd-11/pistol.snd") vf-files)))
(not (= (length vf-files) 4)))
- (snd-display ";vf files set: ~A (~A, ~A)" vf-files (string-append home-dir "/cl/1a.snd") (length vf-files))))
+ (snd-display #__line__ ";vf files set: ~A (~A, ~A)" vf-files (string-append home-dir "/cl/1a.snd") (length vf-files))))
(reset-hook! view-files-select-hook)
(add-hook! view-files-select-hook (lambda (w file)
(if (not (string? file))
- (snd-display ";vf select hook arg: ~A" file))
- (if (not w) (snd-display ";vf select hook dialog: ~A" w))
+ (snd-display #__line__ ";vf select hook arg: ~A" file))
+ (if (not w) (snd-display #__line__ ";vf select hook dialog: ~A" w))
(set! selected-file file)))
(set! (view-files-selected-files dialog) (list "1a.snd"))
(if (or (not (string? selected-file))
(and (not (equal? selected-file "1a.snd"))
(not (equal? selected-file (string-append home-dir "/cl/1a.snd")))
(not (equal? selected-file (string-append home-dir "/snd-11/1a.snd")))))
- (snd-display ";vf set selected select hook arg: ~A" selected-file))
+ (snd-display #__line__ ";vf set selected select hook arg: ~A" selected-file))
(if (and (not (equal? (view-files-selected-files dialog) (list "1a.snd")))
(not (equal? (view-files-selected-files dialog) (list (string-append home-dir "/cl/1a.snd"))))
(not (equal? (view-files-selected-files dialog) (list (string-append home-dir "/snd-11/1a.snd")))))
- (snd-display ";vf selected files set: ~A" (view-files-selected-files dialog)))
+ (snd-display #__line__ ";vf selected files set: ~A" (view-files-selected-files dialog)))
(hide-widget dialog)
))
@@ -30273,8 +30351,8 @@ EDITS: 2
(define (spectral-difference snd1 snd2)
(let* ((size (max (frames snd1) (frames snd2)))
- (pow2 (inexact->exact (ceiling (/ (log size) (log 2)))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (pow2 (ceiling (/ (log size) (log 2))))
+ (fftlen (expt 2 pow2))
(fdr1 (make-vct fftlen))
(fdr2 (make-vct fftlen)) )
(samples->vct 0 fftlen snd1 0 fdr1)
@@ -30293,12 +30371,12 @@ EDITS: 2
(s2 (open-sound snd2)))
(if (or (not (sound? s1))
(not (sound? s2)))
- (snd-display ";open-sound ~A or ~A failed?" snd1 snd2))
+ (snd-display #__line__ ";open-sound ~A or ~A failed?" snd1 snd2))
(let ((diff (spectral-difference s1 s2)))
(close-sound s1)
(close-sound s2)
(if (> diff maxok)
- (snd-display ";translate spectral difference ~A ~A: ~A > ~A?" snd1 snd2 diff maxok)))))
+ (snd-display #__line__ ";translate spectral difference ~A ~A: ~A > ~A?" snd1 snd2 diff maxok)))))
(define (remove-if p l)
@@ -30339,13 +30417,13 @@ EDITS: 2
(add-sound-file-extension "wave")
(let ((exts (sound-file-extensions)))
(if (not (member "wave" exts))
- (snd-display ";sound-file-extensions: ~A" exts))
+ (snd-display #__line__ ";sound-file-extensions: ~A" exts))
(set! (sound-file-extensions) (list))
(if (not (null? (sound-file-extensions)))
- (snd-display ";sound-file-extesions set to '(): ~A" (sound-file-extensions)))
+ (snd-display #__line__ ";sound-file-extesions set to '(): ~A" (sound-file-extensions)))
(set! (sound-file-extensions) exts)
(if (not (member "wave" exts))
- (snd-display ";sound-file-extensions reset: ~A" (sound-file-extensions))))
+ (snd-display #__line__ ";sound-file-extensions reset: ~A" (sound-file-extensions))))
(do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
(log-mem clmtest)
@@ -30356,7 +30434,7 @@ EDITS: 2
(open-chance (* (- 8 len) .125))
(close-chance (* len .125)))
(if (or (= len 0) (> (random 1.0) .5))
- (let* ((choice (inexact->exact (floor (random sf-dir-len))))
+ (let* ((choice (floor (random sf-dir-len)))
(name (string-append sf-dir (list-ref sf-dir-files choice)))
(ht (catch #t (lambda () (mus-sound-header-type name)) (lambda args 0)))
(df (catch #t (lambda () (mus-sound-data-format name)) (lambda args 0)))
@@ -30367,7 +30445,7 @@ EDITS: 2
(or (catch #t
(lambda () (view-sound name))
(lambda args
- (snd-display ";~A ~A ~A" name ht df)
+ (snd-display #__line__ ";~A ~A ~A" name ht df)
-1))
-1))))
(if (not (equal? fd -1))
@@ -30375,16 +30453,16 @@ EDITS: 2
(set! open-ctr (+ open-ctr 1))
(set! open-files (cons fd open-files)))))
(if (and (> len 0) (> (random 1.0) 0.3))
- (let* ((choice (inexact->exact (floor (random (exact->inexact (length open-files))))))
+ (let* ((choice (floor (random (exact->inexact (length open-files)))))
(fd (list-ref open-files choice)))
(close-sound fd)
(set! open-files (remove-if (lambda (a) (equal? a fd)) open-files)))))))
(if open-files (for-each close-sound open-files))
(set! open-files '())
- (if (not (= (length (sounds)) 0)) (snd-display ";active-sounds: ~A ~A?" (sounds) (map short-file-name (sounds))))
+ (if (not (= (length (sounds)) 0)) (snd-display #__line__ ";active-sounds: ~A ~A?" (sounds) (map short-file-name (sounds))))
(let ((fd (open-raw-sound :file (string-append sf-dir "addf8.nh") :channels 1 :srate 8012 :data-format mus-mulaw)))
- (if (not (= (data-format fd) mus-mulaw)) (snd-display ";open-raw-sound: ~A?" (mus-data-format-name (data-format fd))))
+ (if (not (= (data-format fd) mus-mulaw)) (snd-display #__line__ ";open-raw-sound: ~A?" (mus-data-format-name (data-format fd))))
(close-sound fd))
(reset-hook! bad-header-hook)
@@ -30400,18 +30478,18 @@ EDITS: 2
(let ((ind (open-sound "oboe.snd")))
(let ((hi (make-sampler 0 ind 0)))
(close-sound ind)
- (if (not (sampler? hi)) (snd-display ";dangling reader? ~A" hi))
+ (if (not (sampler? hi)) (snd-display #__line__ ";dangling reader? ~A" hi))
(let ((name (format #f "~A" hi)))
- (if (not (string? name)) (snd-display ";dangling reader format: ~A" name)))
+ (if (not (string? name)) (snd-display #__line__ ";dangling reader format: ~A" name)))
(let* ((val (hi))
(val1 (next-sample hi))
(val2 (previous-sample hi))
(val3 (read-sample hi)))
(if (or (fneq val 0.0) (fneq val1 0.0) (fneq val2 0.0) (fneq val3 0.0))
- (snd-display ";dangling read: ~A ~A ~A ~A" val val1 val2 val3))
- (if (sampler-home hi) (snd-display ";dangling reader home: ~A" (sampler-home hi)))
- (if (not (= (sampler-position hi) 0)) (snd-display ";dangling sampler-position: ~A" (sampler-position hi)))
- (if (not (sampler-at-end? hi)) (snd-display ";dangling reader eof: ~A" (sampler-at-end? hi)))
+ (snd-display #__line__ ";dangling read: ~A ~A ~A ~A" val val1 val2 val3))
+ (if (sampler-home hi) (snd-display #__line__ ";dangling reader home: ~A" (sampler-home hi)))
+ (if (not (= (sampler-position hi) 0)) (snd-display #__line__ ";dangling sampler-position: ~A" (sampler-position hi)))
+ (if (not (sampler-at-end? hi)) (snd-display #__line__ ";dangling reader eof: ~A" (sampler-at-end? hi)))
(free-sampler hi))))
;; same (pruned edit)
(let ((ind (open-sound "oboe.snd")))
@@ -30419,31 +30497,31 @@ EDITS: 2
(let ((hi (make-sampler 0 ind 0)))
(revert-sound)
(delete-samples 100 100)
- (if (not (sampler? hi)) (snd-display ";pruned dangling reader? ~A" hi))
+ (if (not (sampler? hi)) (snd-display #__line__ ";pruned dangling reader? ~A" hi))
(let ((name (format #f "~A" hi)))
- (if (not (string? name)) (snd-display ";pruned dangling reader format: ~A" name)))
+ (if (not (string? name)) (snd-display #__line__ ";pruned dangling reader format: ~A" name)))
(let* ((val (hi))
(val1 (next-sample hi))
(val2 (previous-sample hi))
(val3 (read-sample hi)))
(if (or (fneq val 0.0) (fneq val1 0.0) (fneq val2 0.0) (fneq val3 0.0))
- (snd-display ";pruned dangling read: ~A ~A ~A ~A" val val1 val2 val3))
- (if (not (equal? (sampler-home hi) (list ind 0))) (snd-display ";pruned dangling reader home: ~A" (sampler-home hi)))
- (if (not (sampler-at-end? hi)) (snd-display ";pruned dangling reader eof: ~A" (sampler-at-end? hi)))
+ (snd-display #__line__ ";pruned dangling read: ~A ~A ~A ~A" val val1 val2 val3))
+ (if (not (equal? (sampler-home hi) (list ind 0))) (snd-display #__line__ ";pruned dangling reader home: ~A" (sampler-home hi)))
+ (if (not (sampler-at-end? hi)) (snd-display #__line__ ";pruned dangling reader eof: ~A" (sampler-at-end? hi)))
(free-sampler hi)))
(close-sound ind))
-
+
;; region reader
(let ((ind (open-sound "2.snd")))
(set! (sync ind) 1)
(let ((reg (make-region 90 220 ind #t)))
- (if (not (= (region-frames reg) (+ 1 (- 220 90)))) (snd-display ";make-region frames: ~A" (region-frames reg)))
- (if (not (= (region-chans reg) 2)) (snd-display ";make-region chans: ~A" (region-chans reg)))
- (if (not (= (region-frames reg 0) (+ 1 (- 220 90)))) (snd-display ";make-region frames[0]: ~A" (region-frames reg 0)))
- (if (not (= (region-frames reg 1) (+ 1 (- 220 90)))) (snd-display ";make-region frames[1]: ~A" (region-frames reg 1)))
- (if (not (= (region-position reg 0) 90)) (snd-display ";make-region position[0]: ~A" (region-position reg 0)))
- (if (not (= (region-position reg 1) 90)) (snd-display ";make-region position[1]: ~A" (region-position reg 1)))
- (if (not (= (region-position reg) 90)) (snd-display ";make-region position[]: ~A" (region-position reg)))
+ (if (not (= (region-frames reg) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region frames: ~A" (region-frames reg)))
+ (if (not (= (region-chans reg) 2)) (snd-display #__line__ ";make-region chans: ~A" (region-chans reg)))
+ (if (not (= (region-frames reg 0) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region frames[0]: ~A" (region-frames reg 0)))
+ (if (not (= (region-frames reg 1) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region frames[1]: ~A" (region-frames reg 1)))
+ (if (not (= (region-position reg 0) 90)) (snd-display #__line__ ";make-region position[0]: ~A" (region-position reg 0)))
+ (if (not (= (region-position reg 1) 90)) (snd-display #__line__ ";make-region position[1]: ~A" (region-position reg 1)))
+ (if (not (= (region-position reg) 90)) (snd-display #__line__ ";make-region position[]: ~A" (region-position reg)))
;; beg = 0, chan 2 not highlighted
@@ -30452,45 +30530,45 @@ EDITS: 2
(let ((rd11 (copy-sampler rd1))
(rd22 (copy-sampler rd2)))
(if (or (not (region-sampler? rd11)) (not (region-sampler? rd22)))
- (snd-display ";copy-sampler (region): ~A ~A" rd11 rd22))
+ (snd-display #__line__ ";copy-sampler (region): ~A ~A" rd11 rd22))
(if (or (mix-sampler? rd11) (mix-sampler? rd22)
(sampler? rd11) (sampler? rd22))
- (snd-display ";copy (region) sampler-p trouble: ~A ~A ~A ~A ~A ~A"
+ (snd-display #__line__ ";copy (region) sampler-p trouble: ~A ~A ~A ~A ~A ~A"
(mix-sampler? rd11) (mix-sampler? rd22)
(sampler? rd11) (sampler? rd22)))
(if (or (not (equal? (sampler-home rd11) (list reg 0)))
(not (equal? (sampler-home rd22) (list reg 1))))
- (snd-display ";copy region reader home: ~A ~A" (sampler-home rd11) (sampler-home rd22)))
+ (snd-display #__line__ ";copy region reader home: ~A ~A" (sampler-home rd11) (sampler-home rd22)))
(if (or (sampler-at-end? rd11) (sampler-at-end? rd22))
- (snd-display ";copy region reader end?: ~A ~A" (sampler-at-end? rd11) (sampler-at-end? rd22)))
+ (snd-display #__line__ ";copy region reader end?: ~A ~A" (sampler-at-end? rd11) (sampler-at-end? rd22)))
(if (or (not (= (sampler-position rd11) (sampler-position rd1) 0))
(not (= (sampler-position rd22) (sampler-position rd2) 100)))
- (snd-display ";copy region reader position: ~A ~A ~A ~A"
+ (snd-display #__line__ ";copy region reader position: ~A ~A ~A ~A"
(sampler-position rd11) (sampler-position rd1)
(sampler-position rd22) (sampler-position rd2)))
(free-sampler rd1)
(free-sampler rd11))))
(close-sound ind))
-
+
(let* ((ind (open-sound "oboe.snd"))
(reg (make-region 1000 2000 ind 0))
(rd (make-region-sampler reg 0)))
- (if (mix-sampler? rd) (snd-display ";region sampler: mix ~A" rd))
- (if (not (region-sampler? rd)) (snd-display ";region sampler: region ~A" rd))
- (if (sampler? rd) (snd-display ";region sampler: normal ~A" rd))
- ;(if (not (= (sampler-position rd) 0)) (snd-display ";region sampler position: ~A" (sampler-position rd)))
- (if (not (equal? (sampler-home rd) (list reg 0))) (snd-display ";region sampler home: ~A" (sampler-home rd)))
- (if (sampler-at-end? rd) (snd-display ";region sampler at end?: ~A" (sampler-at-end? rd)))
+ (if (mix-sampler? rd) (snd-display #__line__ ";region sampler: mix ~A" rd))
+ (if (not (region-sampler? rd)) (snd-display #__line__ ";region sampler: region ~A" rd))
+ (if (sampler? rd) (snd-display #__line__ ";region sampler: normal ~A" rd))
+ ;(if (not (= (sampler-position rd) 0)) (snd-display #__line__ ";region sampler position: ~A" (sampler-position rd)))
+ (if (not (equal? (sampler-home rd) (list reg 0))) (snd-display #__line__ ";region sampler home: ~A" (sampler-home rd)))
+ (if (sampler-at-end? rd) (snd-display #__line__ ";region sampler at end?: ~A" (sampler-at-end? rd)))
(let ((val (rd)))
- (if (fneq val .0328) (snd-display ";region-sampler at start: ~A" val))
- (if (not (string? (format #f "~A" rd))) (snd-display ";region-sampler: ~A" (format #f "~A" rd)))
+ (if (fneq val .0328) (snd-display #__line__ ";region-sampler at start: ~A" val))
+ (if (not (string? (format #f "~A" rd))) (snd-display #__line__ ";region-sampler: ~A" (format #f "~A" rd)))
(close-sound ind)
(forget-region reg)
(set! val (read-sample rd))
- (if (fneq val 0.0) (snd-display ";region-sampler at end: ~A" val))
- (if (not (sampler-at-end? rd)) (snd-display ";region-sampler after deletion?"))
+ (if (fneq val 0.0) (snd-display #__line__ ";region-sampler at end: ~A" val))
+ (if (not (sampler-at-end? rd)) (snd-display #__line__ ";region-sampler after deletion?"))
(free-sampler rd)))
-
+
;; mix reader
(let ((save-md 0))
(mix-click-sets-amp)
@@ -30500,21 +30578,21 @@ EDITS: 2
(rd (make-mix-sampler md)))
(set! (mix-property :hi md) "hi")
(set! save-md md)
- (if (not (string=? (mix-property :hi md) "hi")) (snd-display ";mix(9)-property: ~A" (mix-property :hi md)))
+ (if (not (string=? (mix-property :hi md) "hi")) (snd-display #__line__ ";mix(9)-property: ~A" (mix-property :hi md)))
(let ((val (rd)))
- (if (fneq val .0328) (snd-display ";mix-sampler at start: ~A" val))
- (if (not (string? (format #f "~A" rd))) (snd-display ";mix-sampler: ~A" (format #f "~A" rd)))
+ (if (fneq val .0328) (snd-display #__line__ ";mix-sampler at start: ~A" val))
+ (if (not (string? (format #f "~A" rd))) (snd-display #__line__ ";mix-sampler: ~A" (format #f "~A" rd)))
(close-sound ind)
(let ((tag (catch #t
(lambda () (mix-property :hi md))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-mix)) (snd-display ";mix-property bad mix: ~A" tag)))
+ (if (not (eq? tag 'no-such-mix)) (snd-display #__line__ ";mix-property bad mix: ~A" tag)))
(let ((str (format #f "~A" rd)))
- (if (not (string=? str "#<mix-sampler: inactive>")) (snd-display ";mix-sampler released: ~A" str))
+ (if (not (string=? str "#<mix-sampler: inactive>")) (snd-display #__line__ ";mix-sampler released: ~A" str))
(free-sampler rd)))))
(reset-hook! mix-click-hook)
(reset-hook! close-hook)
-
+
(let ((sfiles '())
(ffiles '()))
(for-each-sound-file
@@ -30528,11 +30606,11 @@ EDITS: 2
(if (and (file-exists? "s24.snd")
(or (not (equal? ffiles (list "s24.snd")))
(not (equal? sfiles (list "s24.snd")))))
- (snd-display ";map|for-each-sound-file(s): ~A ~A" ffiles sfiles)))
+ (snd-display #__line__ ";map|for-each-sound-file(s): ~A ~A" ffiles sfiles)))
)
; (if sf-dir-files
; (for-each (lambda (n) (mus-sound-forget (string-append sf-dir n))) sf-dir-files))
-
+
)))))
@@ -30592,7 +30670,7 @@ EDITS: 2
(data (make-sound-data 1 block-size))
(audio-port (mus-audio-open-output 0 (srate) 1 mus-lshort (* block-size 2)))
(ra (ladspa-run-adding descriptor handle block-size)))
- (if ra (snd-display ";ladspa-run-adding: ~A" ra))
+ (if ra (snd-display #__line__ ";ladspa-run-adding: ~A" ra))
(ladspa-set-run-adding-gain descriptor handle block-size)
(dynamic-wind
(lambda ()
@@ -30618,7 +30696,7 @@ EDITS: 2
(ladspa-run descriptor handle block-size)
(vct->sound-data out-block data 0)
(mus-audio-write audio-port data block-size)))
- (lambda args (snd-display ";ladspa-it: ~A" args))))
+ (lambda args (snd-display #__line__ ";ladspa-it: ~A" args))))
(lambda ()
(ladspa-deactivate descriptor handle)
(mus-audio-close audio-port)
@@ -30629,37 +30707,37 @@ EDITS: 2
(defmacro carg0 (hook)
`(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list ,hook)))))))
(if (not (string=? str "((lambda () 32))"))
- (snd-display ";~A: ~A?" ',hook str))))
+ (snd-display #__line__ ";~A: ~A?" ',hook str))))
(defmacro carg1 (hook)
`(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list ,hook)))))))
(if (not (string=? str "((lambda (n) (if (number? n) (+ n 32) n)))"))
- (snd-display ";~A: ~A?" ',hook str))))
+ (snd-display #__line__ ";~A: ~A?" ',hook str))))
(defmacro carg2 (hook)
`(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list ,hook)))))))
(if (not (string=? str "((lambda (n m) (if (and (number? n) (number? m)) (+ n m 32) n)))"))
- (snd-display ";~A: ~A?" ',hook str))))
+ (snd-display #__line__ ";~A: ~A?" ',hook str))))
(defmacro carg3 (hook)
`(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list ,hook)))))))
(if (not (string=? str "((lambda (a b c) (if (and (number? a) (number? b) (number? c)) (+ a b c 32) a)))"))
- (snd-display ";~A: ~A?" ',hook str))))
+ (snd-display #__line__ ";~A: ~A?" ',hook str))))
(defmacro carg4 (hook)
`(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list ,hook)))))))
(if (not (string=? str "((lambda (a b c d) (if (and (number? a) (number? b) (number? c) (number? d)) (+ a b c 32) a)))"))
- (snd-display ";~A: ~A?" ',hook str))))
+ (snd-display #__line__ ";~A: ~A?" ',hook str))))
(defmacro carg5 (hook)
`(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list ,hook)))))))
(if (not (string=? str "((lambda (a b c d e) (list 0 0 1 1)))"))
- (snd-display ";~A: ~A?" ',hook str))))
+ (snd-display #__line__ ";~A: ~A?" ',hook str))))
(defmacro carg6 (hook)
`(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list ,hook)))))))
(if (not (string=? str "((lambda (a b c d e f) (if (and (number? a) (number? b) (number? c) (number? d) (number? e)) (+ a b c d e f 32) a)))"))
- (snd-display ";~A: ~A?" ',hook str))))
+ (snd-display #__line__ ";~A: ~A?" ',hook str))))
(define ladspa_inited #f)
(define clm_buffer_added #f)
@@ -30760,7 +30838,7 @@ EDITS: 2
(lambda (n)
(if (and (not (hook-empty? n))
(not (eq? n optimization-hook)))
- (snd-display ";~A not empty?" n)))
+ (snd-display #__line__ ";~A not empty?" n)))
(snd-hooks))
)
@@ -30792,59 +30870,59 @@ EDITS: 2
(define (mdt-test id x time drg) #f)
(reset-almost-all-hooks)
-
+
(let ((fd (view-sound "oboe.snd")))
(let ((mb #f))
(if (not clm_buffer_added)
(set! mb (add-to-main-menu "clm")))
-
+
(let ((var (catch #t (lambda () (add-to-menu -1 "fm-violin" (lambda () #f))) (lambda args args))))
(if (not (eq? (car var) 'no-such-menu))
- (snd-display ";add-to-menu bad menu: ~A" var)))
-
+ (snd-display #__line__ ";add-to-menu bad menu: ~A" var)))
+
(let ((tag (catch #t (lambda () (add-to-main-menu "oops" (make-delay 11)))
(lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display ";add-to-main-menu non-thunk: ~A" tag)))
+ (snd-display #__line__ ";add-to-main-menu non-thunk: ~A" tag)))
(let ((tag (catch #t (lambda () (add-to-menu 3 "oops" (make-delay 12)))
(lambda args (car args)))))
(if (and (not (eq? tag 'bad-arity))
(not (eq? tag 'wrong-type-arg)))
- (snd-display ";add-to-menu non-thunk: ~A" tag)))
-
+ (snd-display #__line__ ";add-to-menu non-thunk: ~A" tag)))
+
(set! (cursor fd) 2000)
(set! (transform-graph-type) graph-once)
(set! (transform-graph? fd) #t)
(if (and with-gui
(not clm_buffer_added))
(begin
- (add-to-menu mb "not here" (lambda () (snd-display ";oops")))
+ (add-to-menu mb "not here" (lambda () (snd-display #__line__ ";oops")))
(remove-from-menu mb "not here")
(add-to-menu 3 "Denoise" (lambda () (report-in-minibuffer "denoise")))))
-
+
(set! clm_buffer_added #t))
-
+
(reset-hook! help-hook)
(let ((hi (snd-help 'cursor-position)))
(add-hook! help-hook (lambda (a b)
(if (not (string=? a "cursor-position"))
- (snd-display ";help-hook subject: ~A" a))
+ (snd-display #__line__ ";help-hook subject: ~A" a))
(if (not (string=? b "(cursor-position :optional snd chn): current cursor position (x y in pixels) in snd's channel chn"))
- (snd-display ";help-hook text: ~A" b))
+ (snd-display #__line__ ";help-hook text: ~A" b))
(string-append "hiho:" b)))
(let ((ho (snd-help 'cursor-position)))
(if (not (= (string-length ho) (+ 5 (string-length hi))))
- (snd-display ";help-hook ~A -> ~A" hi ho))
+ (snd-display #__line__ ";help-hook ~A -> ~A" hi ho))
(reset-hook! help-hook)
(add-hook! help-hook (lambda (a b) #f))
(set! ho (snd-help 'cursor-position))
(if (not (string=? hi ho))
- (snd-display ";help-hook #f: ~A ~A" hi ho))
+ (snd-display #__line__ ";help-hook #f: ~A ~A" hi ho))
(reset-hook! help-hook)))
(reset-hook! mark-drag-triangle-hook)
- (if (hook-member mdt-test mark-drag-triangle-hook) (snd-display ";hook-member #t? ~A" (hook->list mark-drag-triangle-hook)))
+ (if (hook-member mdt-test mark-drag-triangle-hook) (snd-display #__line__ ";hook-member #t? ~A" (hook->list mark-drag-triangle-hook)))
(add-hook! mark-drag-triangle-hook mdt-test)
- (if (not (hook-member mdt-test mark-drag-triangle-hook)) (snd-display ";hook-member #f? ~A" (hook->list mark-drag-triangle-hook)))
+ (if (not (hook-member mdt-test mark-drag-triangle-hook)) (snd-display #__line__ ";hook-member #f? ~A" (hook->list mark-drag-triangle-hook)))
(reset-hook! mark-drag-triangle-hook)
(set! (transform-size fd 0) 256)
(for-each
@@ -30854,12 +30932,12 @@ EDITS: 2
(update-transform-graph fd 0)
(let ((vals (transform->vct fd 0)))
(if (not vals)
- (snd-display ";transform graph-type: ~A type: ~A -> data: ~A" dpy-type fft-type vals)
+ (snd-display #__line__ ";transform graph-type: ~A type: ~A -> data: ~A" dpy-type fft-type vals)
(begin
(if (fneq (transform-sample 0 0 fd 0) (vct-ref vals 0))
- (snd-display ";transform-sample ~A ~A -> ~A ~A" dpy-type fft-type (vct-ref vals 0) (transform-sample 0 0 fd 0)))
+ (snd-display #__line__ ";transform-sample ~A ~A -> ~A ~A" dpy-type fft-type (vct-ref vals 0) (transform-sample 0 0 fd 0)))
(if (not (>= (vct-length vals) 256))
- (snd-display ";transform-> vct size: ~A" (vct-length vals)))))))
+ (snd-display #__line__ ";transform-> vct size: ~A" (vct-length vals)))))))
(list graph-once graph-as-sonogram graph-as-spectrogram
graph-once graph-as-sonogram graph-as-spectrogram)
(list fourier-transform fourier-transform fourier-transform
@@ -30869,13 +30947,13 @@ EDITS: 2
(transform-sample 5000 0 fd 0))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-sample))
- (snd-display ";access invalid (bin) transform sample: ~A" tag)))
+ (snd-display #__line__ ";access invalid (bin) transform sample: ~A" tag)))
(let ((tag (catch #t
(lambda ()
(transform-sample 0 5000 fd 0))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-sample))
- (snd-display ";access invalid (slice) transform sample: ~A" tag)))
+ (snd-display #__line__ ";access invalid (slice) transform sample: ~A" tag)))
(close-sound fd)
(set! (transform-type) fourier-transform)
@@ -30885,7 +30963,7 @@ EDITS: 2
(set! fd (open-sound "2.snd"))
(close-sound fd)
(reset-hook! after-open-hook)
-
+
(add-hook! after-open-hook
(lambda (snd)
(set! (x-axis-style snd #t) x-axis-as-percentage)))
@@ -30913,12 +30991,12 @@ EDITS: 2
(fneq (list-ref ax 7) -4.0)
(fneq (list-ref ax 8) (mus-sound-duration "2.snd"))
(fneq (list-ref ax 9) 4.0)))
- (snd-display ";initial-graph-hook with ymin/max: ~A" ax))
+ (snd-display #__line__ ";initial-graph-hook with ymin/max: ~A" ax))
(reset-hook! initial-graph-hook))
(set! (selection-position fd 1) 1000)
(set! (selection-frames fd 1) 10)
(set! (selection-member? fd 1) #t)
- (if (selection-member? fd 0) (snd-display ";chan 0 is selection-member?"))
+ (if (selection-member? fd 0) (snd-display #__line__ ";chan 0 is selection-member?"))
(do ((i 0 (+ 1 i))) ((= i 2))
(set! (selection-position fd i) 1000)
(set! (selection-frames fd i) 10)
@@ -30926,9 +31004,9 @@ EDITS: 2
(scale-selection-to (vct .5 .25))
(if (or (fneq (maxamp fd 0) .5)
(fneq (maxamp fd 1) .25))
- (snd-display ";scale-selection-to with vector: ~A" (maxamp fd #t)))
+ (snd-display #__line__ ";scale-selection-to with vector: ~A" (maxamp fd #t)))
(close-sound fd)
-
+
(set! fd (open-sound "obtest.snd"))
(let ((ctr 0))
@@ -30946,13 +31024,13 @@ EDITS: 2
(for-each close-sound (sounds))
(if (sound? fd)
(begin
- (snd-display ";close all didn't? ~A ~A ~A ~A ~A" fd (sound? fd) (short-file-name fd) (hook->list close-hook) (sounds))
+ (snd-display #__line__ ";close all didn't? ~A ~A ~A ~A ~A" fd (sound? fd) (short-file-name fd) (hook->list close-hook) (sounds))
(close-sound fd)))
(set! fd (open-sound "obtest.snd"))
(set! (with-background-processes) #f)
(if (and (provided? 'snd-motif)
(= added 0))
- (snd-display ";no widgets added?"))
+ (snd-display #__line__ ";no widgets added?"))
(reset-hook! new-widget-hook))
(if (and (not ladspa_inited)
@@ -30974,28 +31052,28 @@ EDITS: 2
(count (.PortCount ptr))
(descs (.PortDescriptors ptr)))
(if (not (string=? label "delay_5s"))
- (snd-display ";ladspa .Label: ~A" label))
+ (snd-display #__line__ ";ladspa .Label: ~A" label))
(if (not (string=? name "Simple Delay Line"))
- (snd-display ";ladspa .Name: ~A" name))
+ (snd-display #__line__ ";ladspa .Name: ~A" name))
(if (not (string=? maker "Richard Furse (LADSPA example plugins)"))
- (snd-display ";ladspa .Maker: ~A" maker))
+ (snd-display #__line__ ";ladspa .Maker: ~A" maker))
(if (not (string=? copy "None"))
- (snd-display ";ladspa .Copyright: ~A" copy))
- (if (not (= id 1043)) (snd-display ";ladspa .UniqueID: ~A" id))
- (if (not (= count 4)) (snd-display ";ladspa .PortCount: ~A" count))
- (if (not (= props 4)) (snd-display ";ladspa .Properties: ~A" prop))
+ (snd-display #__line__ ";ladspa .Copyright: ~A" copy))
+ (if (not (= id 1043)) (snd-display #__line__ ";ladspa .UniqueID: ~A" id))
+ (if (not (= count 4)) (snd-display #__line__ ";ladspa .PortCount: ~A" count))
+ (if (not (= props 4)) (snd-display #__line__ ";ladspa .Properties: ~A" prop))
(if (not (equal? names (list "Delay (Seconds)" "Dry/Wet Balance" "Input" "Output")))
- (snd-display ";ladspa .PortNames: ~A" names))
+ (snd-display #__line__ ";ladspa .PortNames: ~A" names))
(if (not (equal? hints (list (list 579 0.0 5.0) (list 195 0.0 1.0) (list 0 0.0 0.0) (list 0 0.0 0.0))))
- (snd-display ";ladspa .PortRangeHints: ~A" hints))
+ (snd-display #__line__ ";ladspa .PortRangeHints: ~A" hints))
(if (not (equal? descs (list 5 5 9 10)))
- (snd-display ";ladspa .PortDescriptors: ~A" descs))
+ (snd-display #__line__ ";ladspa .PortDescriptors: ~A" descs))
(if (not (= (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT) 1))
- (snd-display ";ladspa port hint: ~A" (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT))))
+ (snd-display #__line__ ";ladspa port hint: ~A" (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT))))
(apply-ladspa (make-sampler 0) (list "delay" "delay_5s" .3 .5) 1000 "delayed")
(if (not (equal? (analyze-ladspa "delay" "delay_5s")
(list "Simple Delay Line" "Richard Furse (LADSPA example plugins)" "None" (list "Dry/Wet Balance" "minimum" 0.0 "maximum" 1.0) (list "Delay (Seconds)" "minimum" 0.0 "maximum" 5.0))))
- (snd-display ";analyze-ladspa: ~A" (analyze-ladspa "delay" "delay_5s")))
+ (snd-display #__line__ ";analyze-ladspa: ~A" (analyze-ladspa "delay" "delay_5s")))
(ladspa-it "delay" "delay_5s" .3 .5)
(if (provided? 'xm)
(let ((w (list-ref (menu-widgets) 5)))
@@ -31015,40 +31093,40 @@ EDITS: 2
(apply-ladspa (make-sampler 0) (list "delay" "delay_4s" .3 .5) 1000 "delayed"))
(lambda args args))))
(if (not (eq? (car tag) 'no-such-plugin))
- (snd-display ";apply-ladspa bad plugin: ~A" tag)))
+ (snd-display #__line__ ";apply-ladspa bad plugin: ~A" tag)))
(let ((tag (catch #t
(lambda ()
(apply-ladspa (list (make-sampler 0) (make-sampler 0)) (list "delay" "delay_5s" .3 .5) 1000 "delayed"))
(lambda args args))))
(if (not (eq? (car tag) 'plugin-error))
- (snd-display ";apply-ladspa reader mismatch: ~A" tag)))
+ (snd-display #__line__ ";apply-ladspa reader mismatch: ~A" tag)))
(let ((vals (list-ladspa)))
(if (not (list-p vals))
- (snd-display ";ladspa list: ~A" vals))
+ (snd-display #__line__ ";ladspa list: ~A" vals))
(let ((descr (analyse-ladspa "delay" "delay_5s")))
(if (or (not (list-p descr))
(not (string? (car descr)))
(not (string=? (car descr) "Simple Delay Line")))
- (snd-display ";analyse-ladspa: ~A" descr))))
+ (snd-display #__line__ ";analyse-ladspa: ~A" descr))))
(let ((tag (catch #t
(lambda () (analyse-ladspa "delay" "delay_no_delay"))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-plugin)) (snd-display ";analyse-ladspa tag: ~A" tag)))
+ (if (not (eq? tag 'no-such-plugin)) (snd-display #__line__ ";analyse-ladspa tag: ~A" tag)))
(let ((tag (catch #t
(lambda ()
(apply-ladspa (list (make-sampler 0) (make-sampler 0)) (list #f) 1000 "delayed"))
(lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";apply-ladspa tag: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";apply-ladspa tag: ~A" tag)))
(set! (ladspa-dir) "/home/bil/test/ladspa/vocoder-0.3")
(init-ladspa)
(if (not (equal? (list-ladspa) (list (list "vocoder" "vocoder"))))
- (snd-display ";list-ladspa vocoder: ~A" (list-ladspa)))
+ (snd-display #__line__ ";list-ladspa vocoder: ~A" (list-ladspa)))
(if (not (list? (analyze-ladspa "vocoder" "vocoder")))
- (snd-display ";analyze-ladspa vocoder: ~A" (analyze-ladspa "vocoder" "vocoder")))
+ (snd-display #__line__ ";analyze-ladspa vocoder: ~A" (analyze-ladspa "vocoder" "vocoder")))
(let ((hi (ladspa-descriptor "vocoder" "vocoder")))
(if (not (string=? (.Name hi) "Vocoder"))
- (snd-display ";ladspa vocoder name: ~A" (.Name hi))))
+ (snd-display #__line__ ";ladspa vocoder name: ~A" (.Name hi))))
(let ((snd (open-sound "1a.snd")))
(apply-ladspa (list (make-sampler 0) (make-sampler 0))
@@ -31061,7 +31139,7 @@ EDITS: 2
(for-each (lambda (plug) (apply analyse-ladspa plug)) (list-ladspa))
(if (not (list? (analyse-ladspa "amp_1181" "amp")))
- (snd-display ";analyze-ladspa can't find amp_1181"))
+ (snd-display #__line__ ";analyze-ladspa can't find amp_1181"))
(apply-ladspa (make-sampler 0) (list "amp_1181" "amp" -6) (frames) "amp")
(apply-ladspa (make-sampler 0) (list "amp_1181" "amp" 6) (frames) "amp")
@@ -31076,7 +31154,7 @@ EDITS: 2
(list "amp_1181" "amp" 6 -6) (frames) "amp"))
(lambda args (car args)))))
(if (not (equal? tag 'plugin-error))
- (snd-display ";apply-ladspa bad inputs: ~A" tag)))
+ (snd-display #__line__ ";apply-ladspa bad inputs: ~A" tag)))
(apply-ladspa (list (make-sampler 0 snd 0) (make-sampler 0 snd 0))
(list "ringmod_1188" "ringmod_2i1o" 1) (frames) "ringmod")
@@ -31086,7 +31164,7 @@ EDITS: 2
(list "dj_eq_1901" "dj_eq" -6 0 6) (frames) "djeq")
(close-sound snd)))
- (snd-display ";ladspa loaded but can't find plugin directory: ~A" (ladspa-dir)))))
+ (snd-display #__line__ ";ladspa loaded but can't find plugin directory: ~A" (ladspa-dir)))))
(revert-sound fd)
(close-sound fd)
@@ -31103,9 +31181,9 @@ EDITS: 2
(key (char->integer #\x) 4 ind)
(key (char->integer #\z) 4 ind)
(if (not (equal? (edit-fragment) (list "smooth-channel 2000 100" "set" 2000 100)))
- (snd-display ";C-x C-z fragment: ~A" (edit-fragment)))
+ (snd-display #__line__ ";C-x C-z fragment: ~A" (edit-fragment)))
(if (not (vequal (samples->vct 2010 10) (vct 0.064 0.063 0.063 0.062 0.062 0.061 0.060 0.059 0.059 0.058)))
- (snd-display ";C-x C-z samps: ~A" (samples->vct 2010 10)))
+ (snd-display #__line__ ";C-x C-z samps: ~A" (samples->vct 2010 10)))
(set! (cursor) 0)
(select-all)
(key (char->integer #\x) 4 ind)
@@ -31122,42 +31200,42 @@ EDITS: 2
(set! (search-procedure ind) (lambda (n4) (> n4 .1)))
(key (char->integer #\a) 4 ind 0)
(if (not (= (cursor ind 0) 0))
- (snd-display ";C-a cursor: ~D?" (cursor ind 0)))
+ (snd-display #__line__ ";C-a cursor: ~D?" (cursor ind 0)))
(key (char->integer #\s) 4 ind 0)
(key (char->integer #\s) 4 ind 0)
(if (not (= (cursor ind 0) 4423))
- (snd-display ";search-procedure C-s C-s cursor: ~D?" (cursor ind 0)))
+ (snd-display #__line__ ";search-procedure C-s C-s cursor: ~D?" (cursor ind 0)))
(let ((str (with-output-to-string (lambda () (display (procedure-source (search-procedure ind)))))))
(if (not (string=? str "(lambda (n4) (> n4 0.1))"))
- (snd-display ";search-procedure: ~A?" str)))
+ (snd-display #__line__ ";search-procedure: ~A?" str)))
(set! (search-procedure ind) (lambda (n) (> n .2)))
(set! (cursor ind 0) 0)
(key (char->integer #\s) 4 ind 0)
(key (char->integer #\s) 4 ind 0)
(if (not (= (cursor ind 0) 0))
- (snd-display ";search-procedure C-s C-s cursor failed: ~D?" (cursor ind 0)))
+ (snd-display #__line__ ";search-procedure C-s C-s cursor failed: ~D?" (cursor ind 0)))
(let ((str (with-output-to-string (lambda () (display (procedure-source (search-procedure ind)))))))
(if (not (string=? str "(lambda (n) (> n 0.2))"))
- (snd-display ";search-procedure (1): ~A?" str)))
+ (snd-display #__line__ ";search-procedure (1): ~A?" str)))
(reset-hook! (edit-hook ind 0))
(add-hook! (edit-hook ind 0) (lambda () (+ snd chn)))
(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list (edit-hook ind 0))))))))
(if (not (string=? str "((lambda () (+ snd chn)))"))
- (snd-display ";edit-hook: ~A?" str)))
+ (snd-display #__line__ ";edit-hook: ~A?" str)))
(reset-hook! (edit-hook ind 0))
(reset-hook! (after-edit-hook ind 0))
(add-hook! (after-edit-hook ind 0) (lambda () (+ snd chn)))
(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list (after-edit-hook ind 0))))))))
(if (not (string=? str "((lambda () (+ snd chn)))"))
- (snd-display ";after-edit-hook: ~A?" str)))
+ (snd-display #__line__ ";after-edit-hook: ~A?" str)))
(reset-hook! (after-edit-hook ind 0))
(reset-hook! (undo-hook ind 0))
(add-hook! (undo-hook ind 0) (lambda () (+ snd chn)))
(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook->list (undo-hook ind 0))))))))
(if (not (string=? str "((lambda () (+ snd chn)))"))
- (snd-display ";undo-hook: ~A?" str)))
+ (snd-display #__line__ ";undo-hook: ~A?" str)))
(reset-hook! (undo-hook ind 0))
(let ((calls 0))
(add-hook! (undo-hook ind 0) (lambda () (set! calls (+ 1 calls))))
@@ -31165,7 +31243,7 @@ EDITS: 2
(undo 1)
(redo 1)
(revert-sound ind)
- (if (not (= calls 3)) (snd-display ";undo-hook called ~A times" calls)))
+ (if (not (= calls 3)) (snd-display #__line__ ";undo-hook called ~A times" calls)))
(reset-hook! (undo-hook ind 0))
(let ((opt (optimization)))
@@ -31175,7 +31253,7 @@ EDITS: 2
(key (char->integer #\s) 4 ind 0)
(key (char->integer #\s) 4 ind 0)
(if (not (= (cursor ind 0) 4423))
- (snd-display ";unopt search-procedure C-s C-s cursor: ~D?" (cursor ind 0)))
+ (snd-display #__line__ ";unopt search-procedure C-s C-s cursor: ~D?" (cursor ind 0)))
(set! (search-procedure ind) (lambda (n) (> n .2)))
(set! (cursor ind 0) (- (frames) 1))
(key (char->integer #\r) 4 ind 0)
@@ -31188,13 +31266,13 @@ EDITS: 2
(if (not (hook-empty? open-raw-sound-hook)) (reset-hook! open-raw-sound-hook))
(add-hook! open-raw-sound-hook (lambda (file choices) (list 1 22050 mus-bshort)))
(let* ((ind (open-sound "../sf1/addf8.nh")))
- (play-and-wait 0 ind)
+ (play ind :wait #t)
(reset-hook! open-raw-sound-hook)
(if (or (not (= (chans ind) 1))
(not (= (srate ind) 22050))
(not (= (data-format ind) mus-bshort))
(not (= (frames ind) 23808)))
- (snd-display ";open-raw: ~A ~A ~A ~A"
+ (snd-display #__line__ ";open-raw: ~A ~A ~A ~A"
(chans ind) (srate ind) (data-format ind) (frames ind)))
(set! (search-procedure ind) (lambda (n) (> n .2)))
(close-sound ind))
@@ -31213,17 +31291,17 @@ EDITS: 2
(close-sound ind)
(reset-hook! open-raw-sound-hook)
(reset-hook! after-save-as-hook)
- (if save-as-dialog (snd-display ";after-save-as-hook dialog: ~A" save-as-dialog))
- (if (not (equal? ind save-as-index)) (snd-display ";after-save-as-hook index: ~A ~A" ind save-as-index))
+ (if save-as-dialog (snd-display #__line__ ";after-save-as-hook dialog: ~A" save-as-dialog))
+ (if (not (equal? ind save-as-index)) (snd-display #__line__ ";after-save-as-hook index: ~A ~A" ind save-as-index))
(if (and (not (string=? (string-append home-dir "/cl/test.snd") save-as-name))
(not (string=? (string-append home-dir "/snd-11/test.snd") save-as-name)))
- (snd-display ";after-save-as-hook name: ~A (~A)" save-as-name (string-append home-dir "/cl/test.snd")))
+ (snd-display #__line__ ";after-save-as-hook name: ~A (~A)" save-as-name (string-append home-dir "/cl/test.snd")))
(add-hook! open-raw-sound-hook
(lambda (file choice)
(if (not (string=? (my-substring file (- (string-length file) 8)) "test.snd"))
- (snd-display ";open-raw-sound-hook file: ~A?" (my-substring file (- (string-length file) 8))))
+ (snd-display #__line__ ";open-raw-sound-hook file: ~A?" (my-substring file (- (string-length file) 8))))
(if (not (eq? choice #f))
- (snd-display ";open-raw-sound-hook choice: ~A?" choice))
+ (snd-display #__line__ ";open-raw-sound-hook choice: ~A?" choice))
(list 2 44100 mus-mulaw)))
(set! ind (open-sound "test.snd"))
(if (or (not (= (header-type ind) mus-raw))
@@ -31231,13 +31309,13 @@ EDITS: 2
(not (= (chans ind) 2))
(not (= (srate ind) 44100))
(not (= (frames ind) 50828)))
- (snd-display ";open-raw-sound-hook 1: ~A ~A ~A ~A ~A"
+ (snd-display #__line__ ";open-raw-sound-hook 1: ~A ~A ~A ~A ~A"
(header-type ind) (data-format ind) (chans ind) (srate ind) (frames ind)))
(close-sound ind)
(add-hook! open-raw-sound-hook
(lambda (file choice)
(if (not (equal? choice (list 2 44100 mus-mulaw)))
- (snd-display ";open-raw-sound-hook 2: ~A" choice))
+ (snd-display #__line__ ";open-raw-sound-hook 2: ~A" choice))
(list 1 22050 mus-lint))
#t)
@@ -31247,7 +31325,7 @@ EDITS: 2
(not (= (chans ind) 1))
(not (= (srate ind) 22050))
(not (= (frames ind) (/ 50828 2))))
- (snd-display ";open-raw-sound-hook 3: ~A ~A ~A ~A ~A"
+ (snd-display #__line__ ";open-raw-sound-hook 3: ~A ~A ~A ~A ~A"
(header-type ind) (data-format ind) (chans ind) (srate ind) (frames ind)))
(close-sound ind)
(reset-hook! open-raw-sound-hook)
@@ -31259,7 +31337,7 @@ EDITS: 2
(not (= (data-format ind) mus-lint))
(not (= (chans ind) 2))
(not (= (srate ind) 22050)))
- (snd-display ";open-raw-sound-hook 4: ~A ~A ~A ~A"
+ (snd-display #__line__ ";open-raw-sound-hook 4: ~A ~A ~A ~A"
(header-type ind) (data-format ind) (chans ind) (srate ind)))
(close-sound ind)
(reset-hook! open-raw-sound-hook)
@@ -31274,7 +31352,7 @@ EDITS: 2
(not (= (data-location ind) 120))
(not (= (data-size ind) 320))
(not (= (frames ind) 160)))
- (snd-display ";open-raw-sound-hook 5: ~A ~A ~A ~A ~A ~A ~A"
+ (snd-display #__line__ ";open-raw-sound-hook 5: ~A ~A ~A ~A ~A ~A ~A"
(header-type ind) (data-format ind) (chans ind) (srate ind)
(data-location ind) (data-size ind) (/ (frames ind) 2)))
(close-sound ind)
@@ -31293,7 +31371,7 @@ EDITS: 2
(add-hook! open-hook
(lambda (filename)
(if (not (string=? filename (mus-expand-filename "oboe.snd")))
- (snd-display ";open-hook: ~A?" filename))
+ (snd-display #__line__ ";open-hook: ~A?" filename))
(set! op #t)
#f))
(add-hook! after-open-hook
@@ -31303,23 +31381,23 @@ EDITS: 2
(lambda (fd filename reason)
(set! dop #t)
(if (not (string=? filename (mus-expand-filename "oboe.snd")))
- (snd-display ";during-open-hook filename: ~A?" filename))
+ (snd-display #__line__ ";during-open-hook filename: ~A?" filename))
(if (not (= reason 1))
- (snd-display ";during-open-hook reason: ~A?" reason))))
+ (snd-display #__line__ ";during-open-hook reason: ~A?" reason))))
(add-hook! initial-graph-hook
(lambda (snd chn dur)
(if (not (= chn 0))
- (snd-display ";initial-graph-hook (channel): ~A not 0?" chn))
+ (snd-display #__line__ ";initial-graph-hook (channel): ~A not 0?" chn))
(set! ig #t)
#f))
(set! ind (open-sound "oboe.snd"))
- (if (not op) (snd-display ";open-hook not called?"))
- (if (not dop) (snd-display ";during-open-hook not called?"))
- (if (not ig) (snd-display ";initial-graph-hook not called?"))
- (if (not (sound? aop)) (snd-display ";after-open-hook not called?"))
- (if (not (equal? aop ind)) (snd-display ";after-open-hook ~A but ind: ~A?" aop ind))
+ (if (not op) (snd-display #__line__ ";open-hook not called?"))
+ (if (not dop) (snd-display #__line__ ";during-open-hook not called?"))
+ (if (not ig) (snd-display #__line__ ";initial-graph-hook not called?"))
+ (if (not (sound? aop)) (snd-display #__line__ ";after-open-hook not called?"))
+ (if (not (equal? aop ind)) (snd-display #__line__ ";after-open-hook ~A but ind: ~A?" aop ind))
(select-all)
(reset-hook! open-hook)
(reset-hook! during-open-hook)
@@ -31330,7 +31408,7 @@ EDITS: 2
(let ((pistol (open-sound "pistol.snd")))
(if (not (eq? pistol #f))
(begin
- (snd-display ";open-hook #t, but open-sound -> ~A" pistol)
+ (snd-display #__line__ ";open-hook #t, but open-sound -> ~A" pistol)
(if (sound? pistol) (close-sound pistol)))))
(reset-hook! open-hook)
@@ -31345,17 +31423,17 @@ EDITS: 2
(add-hook! graph-hook
(lambda (snd chn y0 y1)
(if (not (equal? snd ind))
- (snd-display ";graph-hook: ~A not ~A?" snd ind))
+ (snd-display #__line__ ";graph-hook: ~A not ~A?" snd ind))
(if (not (= chn 0))
- (snd-display ";graph-hook (channel): ~A not 0?" chn))
+ (snd-display #__line__ ";graph-hook (channel): ~A not 0?" chn))
(set! gr #t)
#f))
(add-hook! after-graph-hook
(lambda (snd chn)
(if (not (equal? snd ind))
- (snd-display ";after-graph-hook: ~A not ~A?" snd ind))
+ (snd-display #__line__ ";after-graph-hook: ~A not ~A?" snd ind))
(if (not (= chn 0))
- (snd-display ";after-graph-hook (channel): ~A not 0?" chn))
+ (snd-display #__line__ ";after-graph-hook (channel): ~A not 0?" chn))
(set! agr #t)))
(add-hook! before-transform-hook
(lambda (snd chn)
@@ -31387,10 +31465,10 @@ EDITS: 2
(set! happy #t)
(XtDispatchEvent (XtAppNextEvent app)))))))
- (if (not gr) (snd-display ";graph-hook not called? ~A ~A ~A ~A" (time-graph? ind) (short-file-name ind) ind (sounds)))
- (if (not agr) (snd-display ";after-graph-hook not called?"))
- (if (not gbf) (snd-display ";before-transform-hook not called?"))
- (if (not abf) (snd-display ";after-transform-hook not called?"))
+ (if (not gr) (snd-display #__line__ ";graph-hook not called? ~A ~A ~A ~A" (time-graph? ind) (short-file-name ind) ind (sounds)))
+ (if (not agr) (snd-display #__line__ ";after-graph-hook not called?"))
+ (if (not gbf) (snd-display #__line__ ";before-transform-hook not called?"))
+ (if (not abf) (snd-display #__line__ ";after-transform-hook not called?"))
(reset-hook! before-transform-hook)
(set! (transform-graph? ind 0) #f)
(reset-hook! graph-hook)
@@ -31401,19 +31479,19 @@ EDITS: 2
(add-hook! select-sound-hook
(lambda (snd)
(if (not (equal? snd ind))
- (snd-display ";select-sound-hook: ~A not ~A?" snd ind))
+ (snd-display #__line__ ";select-sound-hook: ~A not ~A?" snd ind))
(set! sl #t)))
(add-hook! select-channel-hook
(lambda (snd chn)
(if (not (equal? snd ind))
- (snd-display ";select-channel-hook: ~A not ~A?" snd ind))
+ (snd-display #__line__ ";select-channel-hook: ~A not ~A?" snd ind))
(if (not (= chn 0))
- (snd-display ";select-channel-hook (channel): ~A not 0?" chn))
+ (snd-display #__line__ ";select-channel-hook (channel): ~A not 0?" chn))
(set! scl #t)))
(select-sound ind)
- (if (not sl) (snd-display ";select-sound-hook not called?"))
- (if (not scl) (snd-display ";select-channel-hook not called?"))
+ (if (not sl) (snd-display #__line__ ";select-sound-hook not called?"))
+ (if (not scl) (snd-display #__line__ ";select-channel-hook not called?"))
(reset-hook! select-sound-hook)
(reset-hook! select-channel-hook)
@@ -31424,18 +31502,18 @@ EDITS: 2
(add-hook! start-playing-hook
(lambda (snd)
(if (not (equal? snd ind))
- (snd-display ";start-playing-hook: ~A not ~A?" snd ind))
+ (snd-display #__line__ ";start-playing-hook: ~A not ~A?" snd ind))
(set! spl #t)
#f))
(add-hook! stop-playing-hook
(lambda (snd)
(if (not (equal? snd ind))
- (snd-display ";stop-playing-hook: ~A not ~A?" snd ind))
+ (snd-display #__line__ ";stop-playing-hook: ~A not ~A?" snd ind))
(set! stl #t)))
(add-hook! play-hook
(lambda (n)
(if (< n 128)
- (snd-display ";play-hook samps: ~A?" n))
+ (snd-display #__line__ ";play-hook samps: ~A?" n))
(set! (expand-control-hop) (expand-control-hop))
(set! (expand-control-length) (expand-control-length))
(set! (expand-control-ramp) (expand-control-ramp))
@@ -31446,22 +31524,22 @@ EDITS: 2
(add-hook! dac-hook
(lambda (n)
(if (not (sound-data? n))
- (snd-display ";dac-hook data: ~A?" n))
+ (snd-display #__line__ ";dac-hook data: ~A?" n))
(if (and (< (sound-data-length n) 128)
(not (= (sound-data-length n) 64))) ; mac case
- (snd-display ";dac-hook data length: ~A?" (sound-data-length n)))
+ (snd-display #__line__ ";dac-hook data length: ~A?" (sound-data-length n)))
(set! ph1 #t)))
(set! (expand-control? ind) #t)
(set! (reverb-control? ind) #t)
- (play-and-wait 0 ind)
+ (play ind :wait #t)
(set! (reverb-control? ind) #f)
(set! (expand-control? ind) #f)
- (if (not spl) (snd-display ";start-playing-hook not called?"))
- (if (not stl) (snd-display ";stop-playing-hook not called?"))
- (if (not ph) (snd-display ";play-hook not called?"))
- (if (not ph1) (snd-display ";dac-hook not called?"))
+ (if (not spl) (snd-display #__line__ ";start-playing-hook not called?"))
+ (if (not stl) (snd-display #__line__ ";stop-playing-hook not called?"))
+ (if (not ph) (snd-display #__line__ ";play-hook not called?"))
+ (if (not ph1) (snd-display #__line__ ";dac-hook not called?"))
(reset-hook! start-playing-hook)
(reset-hook! start-playing-selection-hook)
(reset-hook! stop-playing-hook)
@@ -31477,7 +31555,7 @@ EDITS: 2
(set! (reverb-control-lowpass) .02)
(set! (reverb-control-feedback) .02)))
- (play-and-wait 0 ind)
+ (play ind :wait #t)
(reset-hook! play-hook)
(add-hook! start-playing-hook (lambda (sp) #t))
@@ -31489,9 +31567,9 @@ EDITS: 2
(set! (selection-creates-region) #t)
(add-hook! stop-playing-selection-hook (lambda () (set! ss #t)))
(let ((reg (select-all)))
- (play-selection #t)
- (play-region reg #t)
- (if (not ss) (snd-display ";stop-playing-selection-hook: ~A" ss)))
+ (play (selection) :wait #t)
+ (if (region? reg) (play reg :wait #t))
+ (if (not ss) (snd-display #__line__ ";stop-playing-selection-hook: ~A" ss)))
(reset-hook! stop-playing-selection-hook)
(set! (selection-creates-region) old-reg))
@@ -31500,29 +31578,29 @@ EDITS: 2
(lambda (n)
(set! ctr (+ 1 ctr))
(stop-playing)))
- (play-and-wait 0 ind)
- (if (> ctr 2) (snd-display ";stop-playing: ~A" ctr))
+ (play ind :wait #t)
+ (if (> ctr 2) (snd-display #__line__ ";stop-playing: ~A" ctr))
(reset-hook! dac-hook))
(let ((pl (make-player ind 0))
(ctr 0))
- (if (not (player? pl)) (snd-display ";make-player: ~A" pl))
- (if (= (length (players)) 0) (snd-display ";players: ~A" (players)))
+ (if (not (player? pl)) (snd-display #__line__ ";make-player: ~A" pl))
+ (if (= (length (players)) 0) (snd-display #__line__ ";players: ~A" (players)))
(add-hook! dac-hook
(lambda (n)
(set! ctr (+ 1 ctr))
(if (player? pl)
(stop-player pl)
(if (= ctr 1)
- (snd-display ";player messed up")))))
+ (snd-display #__line__ ";player messed up")))))
(add-player pl)
(start-playing 1 22050 #f)
- (if (> ctr 2) (snd-display ";stop-player: ~A" ctr))
+ (if (> ctr 2) (snd-display #__line__ ";stop-player: ~A" ctr))
(reset-hook! dac-hook))
(let ((pl (make-player ind 0)))
(free-player pl)
- (if (player? pl) (snd-display ";free-player: ~A" pl)))
+ (if (player? pl) (snd-display #__line__ ";free-player: ~A" pl)))
)
(let ((e0 #f)
@@ -31555,19 +31633,19 @@ EDITS: 2
;; edit of ind should be disallowed, but not other
(delete-sample 0 ind 0)
(if (not (= (edit-position ind 0) 0))
- (snd-display ";edit-hook #t didn't disallow edit!"))
- (if (not e0) (snd-display ";edit-hook #t not called?"))
- (if a0 (snd-display ";after-edit-hook 0 called?"))
+ (snd-display #__line__ ";edit-hook #t didn't disallow edit!"))
+ (if (not e0) (snd-display #__line__ ";edit-hook #t not called?"))
+ (if a0 (snd-display #__line__ ";after-edit-hook 0 called?"))
(undo 1 ind 0)
- (if u0 (snd-display ";undo-hook called?"))
+ (if u0 (snd-display #__line__ ";undo-hook called?"))
(delete-sample 0 other 0)
(if (not (= (edit-position other 0) 1))
- (snd-display ";edit-hook #f didn't allow edit!"))
- (if (not e1) (snd-display ";edit-hook #f not called?"))
- (if (not a1) (snd-display ";after-edit-hook 1 not called?"))
+ (snd-display #__line__ ";edit-hook #f didn't allow edit!"))
+ (if (not e1) (snd-display #__line__ ";edit-hook #f not called?"))
+ (if (not a1) (snd-display #__line__ ";after-edit-hook 1 not called?"))
(undo 1 other 0)
- (if (not u1) (snd-display ";undo-hook not called?"))
+ (if (not u1) (snd-display #__line__ ";undo-hook not called?"))
(reset-hook! (edit-hook ind 0))
(reset-hook! (edit-hook other 0))
@@ -31596,9 +31674,9 @@ EDITS: 2
(snd-warning "hiho")
(mus-sound-samples "/bad/baddy")
- (if (not se) (snd-display ";snd-error-hook not called?"))
- (if (not sw) (snd-display ";snd-warning-hook not called?"))
- (if (not me) (snd-display ";mus-error-hook not called?"))
+ (if (not se) (snd-display #__line__ ";snd-error-hook not called?"))
+ (if (not sw) (snd-display #__line__ ";snd-warning-hook not called?"))
+ (if (not me) (snd-display #__line__ ";mus-error-hook not called?"))
(reset-hook! snd-error-hook)
(reset-hook! snd-warning-hook)
(reset-hook! mus-error-hook)
@@ -31610,7 +31688,7 @@ EDITS: 2
(if (or (not (string? se))
(not (string=? se "not an error")))
- (snd-display ";snd-error-hook saw: ~A" se))
+ (snd-display #__line__ ";snd-error-hook saw: ~A" se))
(reset-hook! snd-error-hook))
(add-hook! before-exit-hook (lambda () #f))
@@ -31626,16 +31704,16 @@ EDITS: 2
(lambda (snd filename)
(if (or (not (string? filename))
(not (string=? filename (mus-expand-filename "baddy.snd"))))
- (snd-display ";save-hook filename: ~A?" filename))
+ (snd-display #__line__ ";save-hook filename: ~A?" filename))
(if (not (equal? snd ind))
- (snd-display ";save-hook snd: ~A ~A?" snd ind))
+ (snd-display #__line__ ";save-hook snd: ~A ~A?" snd ind))
(set! sh #t)
#t))
(save-sound-as "baddy.snd" ind)
- (if (not sh) (snd-display ";save-hook not called?"))
+ (if (not sh) (snd-display #__line__ ";save-hook not called?"))
(if (file-exists? "baddy.snd")
(begin
- (snd-display ";save-hook didn't cancel save?")
+ (snd-display #__line__ ";save-hook didn't cancel save?")
(delete-file "baddy.snd")))
(reset-hook! save-hook))
@@ -31644,11 +31722,11 @@ EDITS: 2
(add-hook! close-hook
(lambda (snd)
(if (not (equal? snd ind))
- (snd-display ";close-hook: ~A not ~A?" snd ind))
+ (snd-display #__line__ ";close-hook: ~A not ~A?" snd ind))
(set! cl #t)))
(close-sound ind)
- (if (not cl) (snd-display ";close-hook not called?"))
+ (if (not cl) (snd-display #__line__ ";close-hook not called?"))
(reset-hook! close-hook)
(close-sound other))
@@ -31658,7 +31736,7 @@ EDITS: 2
(not (string=? str "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)")))
(and (= (print-length) 12) ; just test 13
(not (string=? str "#(0 0 0 0 0 0 0 0 0 0 0 0 ...)")))))
- (snd-display ";vector abbreviation: ~A" str))
+ (snd-display #__line__ ";vector abbreviation: ~A" str))
#f))
(let ((v (make-vector 128 0)))
(snd-print v)
@@ -31675,11 +31753,11 @@ EDITS: 2
; (sleep 1) ; make sure write dates differ(!)
; (system "cp oboe.snd fmv1.snd") ; ind1 needs auto-update now
; (set-sample 100 0.55 ind 0 #f)
- ; (if (fneq (sample 100 ind 0) 0.55) (snd-display ";set-sample: ~A" (sample 100 ind 0)))
+ ; (if (fneq (sample 100 ind 0) 0.55) (snd-display #__line__ ";set-sample: ~A" (sample 100 ind 0)))
; (save-sound ind) ; this should cause auto-update scan of all files
; (set! ind1 (find-sound "fmv1.snd")) ; hmmm auto-update can change any file's index!
; (if (not (= (frames ind1) (mus-sound-frames "oboe.snd")))
- ; (snd-display ";fmv1 after update: ~A" (frames ind1)))
+ ; (snd-display #__line__ ";fmv1 after update: ~A" (frames ind1)))
; (set! (auto-update) old-update)
; (close-sound ind)
; (close-sound ind1)
@@ -31691,7 +31769,7 @@ EDITS: 2
(in2 (open-sound "2.snd")))
(set! (sync in1) 1)
(set! (sync in2) 1)
- (play-and-wait 0 #f #f #t)
+ (play :with-sync #t :wait #t)
(close-sound in1)
(close-sound in2)))
@@ -31860,11 +31938,11 @@ EDITS: 2
(let ((func (cadr func-and-name))
(name (car func-and-name)))
(func)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";~A: blocked edit: ~A" name (edit-position ind 0)))
- (if (not (= edit-hook-ctr 1)) (snd-display ";~A: edit hook calls: ~A" name edit-hook-ctr))
- (if (not (= after-edit-hook-ctr 0)) (snd-display ";~A: after edit hook calls: ~A" name after-edit-hook-ctr))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";~A: blocked edit: ~A" name (edit-position ind 0)))
+ (if (not (= edit-hook-ctr 1)) (snd-display #__line__ ";~A: edit hook calls: ~A" name edit-hook-ctr))
+ (if (not (= after-edit-hook-ctr 0)) (snd-display #__line__ ";~A: after edit hook calls: ~A" name after-edit-hook-ctr))
(set! edit-hook-ctr 0)
- (if (not (equal? (mixes ind 0) '())) (snd-display ";[27315] ~A: mixes: ~A" name (mixes ind 0)))))
+ (if (not (equal? (mixes ind 0) '())) (snd-display #__line__ ";[27315] ~A: mixes: ~A" name (mixes ind 0)))))
all-tests)
(set! edit-hook-ctr 0)
@@ -31884,9 +31962,9 @@ EDITS: 2
(let ((func (cadr func-and-name))
(name (car func-and-name)))
(func)
- (if (not (> (edit-position ind 0) 0)) (snd-display ";~A: unblocked edit: ~A" name (edit-position ind 0)))
- (if (not (> edit-hook-ctr 0)) (snd-display ";~A: unblocked edit hook calls: ~A" name edit-hook-ctr))
- (if (not (> after-edit-hook-ctr 0)) (snd-display ";~A: unblocked after edit hook calls: ~A" name after-edit-hook-ctr))
+ (if (not (> (edit-position ind 0) 0)) (snd-display #__line__ ";~A: unblocked edit: ~A" name (edit-position ind 0)))
+ (if (not (> edit-hook-ctr 0)) (snd-display #__line__ ";~A: unblocked edit hook calls: ~A" name edit-hook-ctr))
+ (if (not (> after-edit-hook-ctr 0)) (snd-display #__line__ ";~A: unblocked after edit hook calls: ~A" name after-edit-hook-ctr))
(set! edit-hook-ctr 0)
(set! after-edit-hook-ctr 0)
(revert-sound ind)))
@@ -31915,41 +31993,41 @@ EDITS: 2
(scale-by 2.0)
(add-hook! (edit-hook ind 0) (lambda () #t))
(mix-vct (make-vct 10 .1) 0)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";mix-vct: blocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) '())) (snd-display ";mix-vct edit-hook: mixes: ~A" (mixes ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";mix-vct: blocked edit: ~A" (edit-position ind 0)))
+ (if (not (equal? (mixes ind 0) '())) (snd-display #__line__ ";mix-vct edit-hook: mixes: ~A" (mixes ind 0)))
(mix "pistol.snd" 1000)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";mix: blocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) '())) (snd-display ";mix edit-hook: mixes: ~A" (mixes ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";mix: blocked edit: ~A" (edit-position ind 0)))
+ (if (not (equal? (mixes ind 0) '())) (snd-display #__line__ ";mix edit-hook: mixes: ~A" (mixes ind 0)))
(reset-hook! (edit-hook ind 0))
(let ((mx (mix-vct (make-vct 10 .1) 1000)))
(if (mix? mx) ; might be no-gui case
(begin
- (if (not (= (edit-position ind 0) 2)) (snd-display ";mix-vct: unblocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) (list mx))) (snd-display ";mix-vct un edit-hook: mixes: ~A" (mixes ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix-vct: unblocked edit: ~A" (edit-position ind 0)))
+ (if (not (equal? (mixes ind 0) (list mx))) (snd-display #__line__ ";mix-vct un edit-hook: mixes: ~A" (mixes ind 0)))
(add-hook! (edit-hook ind 0) (lambda () #t))
(set! (mix-amp mx) 2.0)
- (if (not (= (edit-position ind 0) 2)) (snd-display ";mix amp: blocked edit: ~A" (edit-position ind 0)))
- (if (fneq (mix-amp mx) 1.0) (snd-display ";mix amp: blocked edit: ~A" (mix-amp mx)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix amp: blocked edit: ~A" (edit-position ind 0)))
+ (if (fneq (mix-amp mx) 1.0) (snd-display #__line__ ";mix amp: blocked edit: ~A" (mix-amp mx)))
(set! (mix-amp-env mx) '(0 0 1 1 2 0))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";mix amp env: blocked edit: ~A" (edit-position ind 0)))
- (if (not (null? (mix-amp-env mx))) (snd-display ";mix amp env: blocked edit: ~A" (mix-amp-env mx)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix amp env: blocked edit: ~A" (edit-position ind 0)))
+ (if (not (null? (mix-amp-env mx))) (snd-display #__line__ ";mix amp env: blocked edit: ~A" (mix-amp-env mx)))
(set! (mix-speed mx) 2.0)
- (if (not (= (edit-position ind 0) 2)) (snd-display ";mix speed: blocked edit: ~A" (edit-position ind 0)))
- (if (fneq (mix-speed mx) 1.0) (snd-display ";mix speed: blocked edit: ~A" (mix-speed mx)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix speed: blocked edit: ~A" (edit-position ind 0)))
+ (if (fneq (mix-speed mx) 1.0) (snd-display #__line__ ";mix speed: blocked edit: ~A" (mix-speed mx)))
(set! (mix-position mx) 2000)
- (if (not (= (edit-position ind 0) 2)) (snd-display ";mix position: blocked edit: ~A" (edit-position ind 0)))
- (if (not (= (mix-position mx) 1000)) (snd-display ";mix position: blocked edit: ~A" (mix-position mx)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix position: blocked edit: ~A" (edit-position ind 0)))
+ (if (not (= (mix-position mx) 1000)) (snd-display #__line__ ";mix position: blocked edit: ~A" (mix-position mx)))
(mix-vct (make-vct 10 .2) 0)
- (if (not (= (edit-position ind 0) 2)) (snd-display ";mix-vct 1: blocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) (list mx))) (snd-display ";mix-vct 1 edit-hook: mixes: ~A" (mixes ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix-vct 1: blocked edit: ~A" (edit-position ind 0)))
+ (if (not (equal? (mixes ind 0) (list mx))) (snd-display #__line__ ";mix-vct 1 edit-hook: mixes: ~A" (mixes ind 0)))
)))
(close-sound ind))
-
+
(let ((ind (open-sound "oboe.snd")))
- (if (not (hook-empty? (edit-hook ind 0))) (snd-display ";edit-hook not cleared at close?"))
- (if (not (hook-empty? (after-edit-hook ind 0))) (snd-display ";after-edit-hook not cleared at close?"))
+ (if (not (hook-empty? (edit-hook ind 0))) (snd-display #__line__ ";edit-hook not cleared at close?"))
+ (if (not (hook-empty? (after-edit-hook ind 0))) (snd-display #__line__ ";after-edit-hook not cleared at close?"))
(close-sound ind))
-
+
(reset-almost-all-hooks)
;; before|after-save-as-hook
@@ -31971,11 +32049,11 @@ EDITS: 2
#f)))
(let ((ind (open-sound "2.snd")))
(save-sound-as "test.snd" :srate 44100)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";before-save-as-hook undo: ~A" (edit-position ind 0)))
- (if (not hook-called) (snd-display ";before-save-as-hook not called?"))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";before-save-as-hook undo: ~A" (edit-position ind 0)))
+ (if (not hook-called) (snd-display #__line__ ";before-save-as-hook not called?"))
(close-sound ind)
(set! ind (open-sound "test.snd"))
- (if (not (= (srate ind) 44100)) (snd-display ";before-save-as-hook src: ~A" (srate ind)))
+ (if (not (= (srate ind) 44100)) (snd-display #__line__ ";before-save-as-hook src: ~A" (srate ind)))
(close-sound ind))
(reset-hook! before-save-as-hook))
@@ -31993,10 +32071,10 @@ EDITS: 2
(if need-save-as-undo (undo))))
(let ((ind (open-sound "oboe.snd")))
(save-sound-as "test.snd" :srate 44100)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";after-save-as-hook undo: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";after-save-as-hook undo: ~A" (edit-position ind 0)))
(close-sound ind)
(set! ind (open-sound "test.snd"))
- (if (not (= (srate ind) 44100)) (snd-display ";before|after-save-as-hook src: ~A" (srate ind)))
+ (if (not (= (srate ind) 44100)) (snd-display #__line__ ";before|after-save-as-hook src: ~A" (srate ind)))
(close-sound ind))
(reset-hook! before-save-as-hook)
(reset-hook! after-save-as-hook))
@@ -32040,71 +32118,71 @@ EDITS: 2
(set! cur-selected-channel (and cur-selected-sound (selected-channel)))))))))
(let ((ind (open-sound "oboe.snd")))
(if (not sound-changed)
- (snd-display ";watcher missed sound open? ")
+ (snd-display #__line__ ";watcher missed sound open? ")
(set! sound-changed #f))
(set! (read-only ind) #t)
(if (not read-only-changed)
- (snd-display ";watcher missed read-only? ")
+ (snd-display #__line__ ";watcher missed read-only? ")
(set! read-only-changed #f))
(let ((m1 (add-mark 123 ind 0)))
(if (not marks-changed)
- (snd-display ";watcher missed add mark? ")
+ (snd-display #__line__ ";watcher missed add mark? ")
(set! marks-changed #f))
(set! called #f) ; too hard to track mark samples here
(set! (mark-sample m1) 321)
(if (not called)
- (snd-display ";watcher missed move mark? ")
+ (snd-display #__line__ ";watcher missed move mark? ")
(set! marks-changed #f))
(delete-mark m1)
(if (not marks-changed)
- (snd-display ";watcher missed delete mark? ")
+ (snd-display #__line__ ";watcher missed delete mark? ")
(set! marks-changed #f)))
-
+
(let ((ind1 (open-sound "2.snd")))
(if (not sound-changed)
- (snd-display ";watcher missed 2 sound open? ")
+ (snd-display #__line__ ";watcher missed 2 sound open? ")
(set! sound-changed #f))
(select-sound ind)
(if (not sound-selection-changed)
- (snd-display ";watcher missed select sound?")
+ (snd-display #__line__ ";watcher missed select sound?")
(set! sound-selection-changed #f))
(select-sound ind1)
(if (not sound-selection-changed)
- (snd-display ";watcher missed select sound 1?")
+ (snd-display #__line__ ";watcher missed select sound 1?")
(set! sound-selection-changed #f))
(select-channel 1)
(if (not sound-selection-changed)
- (snd-display ";watcher missed select channel?")
+ (snd-display #__line__ ";watcher missed select channel?")
(set! sound-selection-changed #f))
(close-sound ind1)
(if (not sound-changed)
- (snd-display ";watcher missed 2 sound close? ")
+ (snd-display #__line__ ";watcher missed 2 sound close? ")
(set! sound-changed #f)))
-
+
(select-all ind)
(if (not selection-changed)
- (snd-display ";watcher missed selection")
+ (snd-display #__line__ ";watcher missed selection")
(set! selection-changed #f))
(set! (selection-member? ind 0) #f)
(if (not selection-changed)
- (snd-display ";watcher missed selection change")
+ (snd-display #__line__ ";watcher missed selection change")
(set! selection-changed #f))
(set! sound-changed #f)
(delete-watcher w1)
(close-sound ind)
(if sound-changed
- (snd-display ";deleted watcher runs anyway?")))))
-
+ (snd-display #__line__ ";deleted watcher runs anyway?")))))
+
(let ((old-clip (clipping))
(old-mus-clip (mus-clipping)))
(set! (clipping) #t)
(set! (mus-clipping) #t)
(reset-hook! clip-hook)
-
+
(let ((index (new-sound "test.snd" mus-next mus-bshort 22050 1 "clip-hook test" 10)))
(map-channel (lambda (y) (mus-random 0.999))) ; -amp to amp
(set! (sample 2) 1.0001)
@@ -32117,12 +32195,12 @@ EDITS: 2
(if (and (fneq val 1.0)
(fneq val 1.5)
(fneq val -1.5))
- (snd-display ";clip-hook called upon: ~A" val))
+ (snd-display #__line__ ";clip-hook called upon: ~A" val))
(set! hook-called (+ 1 hook-called))
0.0))
(save-sound index)
(reset-hook! clip-hook)
- (if (not (= hook-called 3)) (snd-display ";clip-hook called ~A times" hook-called))
+ (if (not (= hook-called 3)) (snd-display #__line__ ";clip-hook called ~A times" hook-called))
(close-sound index)
(set! index (open-sound "test.snd"))
(let ((new-vals (channel->vct 0 10 index))
@@ -32131,7 +32209,7 @@ EDITS: 2
(vct-set! fixed-vals 6 0.0)
(vct-set! fixed-vals 8 0.0)
(if (not (vequal fixed-vals new-vals))
- (snd-display ";clip-hook results:~% ~A~% ~A~% ~A" new-vals fixed-vals vals)))
+ (snd-display #__line__ ";clip-hook results:~% ~A~% ~A~% ~A" new-vals fixed-vals vals)))
(close-sound index)))
(set! (clipping) old-clip)
(set! (mus-clipping) old-mus-clip))
@@ -32170,7 +32248,7 @@ EDITS: 2
(define (test-panel func name)
(if (and (not (feql (func #t) (map func (sounds))))
(not (feql (func #t) (map func (reverse (sounds))))))
- (snd-display ";test-panel ~A: ~A ~A?" name (func #t) (map func (sounds)))))
+ (snd-display #__line__ ";test-panel ~A: ~A ~A?" name (func #t) (map func (sounds)))))
(define (all-chans-reversed)
(let ((sndlist '())
@@ -32186,7 +32264,7 @@ EDITS: 2
(define (test-channel func name)
(if (and (not (equal? (flatten (func #t #t)) (apply map func (all-chans))))
(not (equal? (flatten (func #t #t)) (apply map func (all-chans-reversed)))))
- (snd-display ";test-channel ~A: ~A ~A?" name (flatten (func #t #t)) (apply map func (all-chans)))))
+ (snd-display #__line__ ";test-channel ~A: ~A ~A?" name (flatten (func #t #t)) (apply map func (all-chans)))))
(define duration
(lambda (ind)
@@ -32270,7 +32348,7 @@ EDITS: 2
(set! mxpos (+ mxpos (edit-position snd chn)))))
(if (or (> mxpos 100) (> chns 4))
(begin
- (snd-display ";revert ~A at ~A" (file-name snd) mxpos)
+ (snd-display #__line__ ";revert ~A at ~A" (file-name snd) mxpos)
(revert-sound snd)))))
(sounds))))
(clear-sincs)
@@ -32294,7 +32372,7 @@ EDITS: 2
(load (string-append cwd "s61.scm")))
(lambda args args))
(if (not (= (length (sounds)) files))
- (snd-display ";save state restart from ~A to ~A sounds?" files (length (sounds))))
+ (snd-display #__line__ ";save state restart from ~A to ~A sounds?" files (length (sounds))))
(set! open-files (sounds))))
(let* ((len (length open-files))
@@ -32327,38 +32405,38 @@ EDITS: 2
(let ((xb (x-bounds curfd)))
(if (or (fneq (car xb) 0.0)
(fneq (cadr xb) (min (duration curfd) 1.0)))
- (snd-display ";x-bounds: ~A?" xb)))))
+ (snd-display #__line__ ";x-bounds: ~A?" xb)))))
(set! (y-bounds curfd) (list -0.5 0.5))
(let ((yb (y-bounds curfd)))
- (if (or (fneq (car yb) -0.5) (fneq (cadr yb) 0.5)) (snd-display ";y-bounds: ~A?" yb)))
+ (if (or (fneq (car yb) -0.5) (fneq (cadr yb) 0.5)) (snd-display #__line__ ";y-bounds: ~A?" yb)))
(set! (cursor curfd 0) curloc)
(let ((cl (cursor curfd 0)))
(if (and (not (= cl curloc))
(> (frames curfd 0) curloc))
(begin
- (snd-display ";cursor ~A /= ~A (frames: ~A)?" cl curloc (frames curfd 0))
+ (snd-display #__line__ ";cursor ~A /= ~A (frames: ~A)?" cl curloc (frames curfd 0))
(set! curloc (cursor curfd 0)))))
(if (>= curloc (frames curfd 0)) (set! curloc 0))
(let* ((id (catch #t (lambda () (add-mark curloc curfd)) (lambda args -1))))
(if (and (number? id) (not (= id -1)))
(let* ((cl (mark-sample id))
(new-marks (length (marks curfd 0))))
- (if (not (= cl curloc)) (snd-display ";mark ~A /= ~A?" cl curloc))
- (if (not (= new-marks (+ 1 old-marks))) (snd-display ";marks ~A ~A?" new-marks old-marks))
+ (if (not (= cl curloc)) (snd-display #__line__ ";mark ~A /= ~A?" cl curloc))
+ (if (not (= new-marks (+ 1 old-marks))) (snd-display #__line__ ";marks ~A ~A?" new-marks old-marks))
(let ((new-id (find-mark curloc curfd)))
(if (or (not (mark? new-id))
(not (= id new-id)))
- (snd-display ";find-mark (by sample): ~A ~A (~A for ~A ~A)?"
+ (snd-display #__line__ ";find-mark (by sample): ~A ~A (~A for ~A ~A)?"
id new-id curloc (mark-sample id) (mark-sample new-id))))
(set! (mark-name id) "hiho")
(let ((new-id (find-mark "hiho" curfd)))
(if (or (not (mark? new-id))
(not (= id new-id)))
- (snd-display ";find-mark (by name): ~A ~A?" id new-id)))
- (if (not (string=? (mark-name id) "hiho")) (snd-display ";mark name: ~A?" (mark-name id)))
+ (snd-display #__line__ ";find-mark (by name): ~A ~A?" id new-id)))
+ (if (not (string=? (mark-name id) "hiho")) (snd-display #__line__ ";mark name: ~A?" (mark-name id)))
(set! (mark-sample id) (max 0 (- curloc 100)))
(set! cl (mark-sample id))
- (if (not (= cl (max 0 (- curloc 100)))) (snd-display ";set mark ~A /= ~A?" cl curloc))
+ (if (not (= cl (max 0 (- curloc 100)))) (snd-display #__line__ ";set mark ~A /= ~A?" cl curloc))
(delete-mark id)))
(if (> (duration curfd) 1.2) (set! (x-bounds curfd) '(1.0 1.1)))
(if (> (frames curfd) 25)
@@ -32370,16 +32448,16 @@ EDITS: 2
(forward-mark 1 curfd)
(if (and (> (frames curfd) 10)
(not (= (cursor curfd) 10)))
- (snd-display ";forward-mark (10): ~A (~A)?" (cursor curfd) (frames curfd)))
+ (snd-display #__line__ ";forward-mark (10): ~A (~A)?" (cursor curfd) (frames curfd)))
(forward-mark 1 curfd)
(if (and (> (frames curfd) 20)
(not (= (cursor curfd) 20)))
- (snd-display ";forward-mark (20): ~A (~A)?" (cursor curfd) (frames curfd)))
+ (snd-display #__line__ ";forward-mark (20): ~A (~A)?" (cursor curfd) (frames curfd)))
(set! (cursor curfd) 25)
(backward-mark 2 curfd)
(if (and (> (frames curfd) 10)
(not (= (cursor curfd) 10)))
- (snd-display ";backward-mark (10): ~A (~A)?" (cursor curfd) (frames curfd)))
+ (snd-display #__line__ ";backward-mark (10): ~A (~A)?" (cursor curfd) (frames curfd)))
(let ((new-marks (length (marks curfd 0))))
(delete-marks curfd)
(if (> (duration curfd) 0.0)
@@ -32387,7 +32465,7 @@ EDITS: 2
(set! (y-bounds curfd) '(-1.0 1.0))
(if (or (> (length (marks curfd 0)) 0)
(not (= new-marks (+ old-marks 3))))
- (snd-display ";delete marks: ~A ~A?" new-marks old-marks)))))
+ (snd-display #__line__ ";delete marks: ~A ~A?" new-marks old-marks)))))
))
(revert-sound)
@@ -32402,17 +32480,17 @@ EDITS: 2
(r3 (selection-rms-1))
(r4 (region-rms-1 (car (regions)))))
(if (fneq r1 r4)
- (snd-display ";region rms: ~A ~A?" r1 r4))
+ (snd-display #__line__ ";region rms: ~A ~A?" r1 r4))
(if (fneq r2 r3)
- (snd-display ";selection rms: ~A ~A?" r2 r3))))))
+ (snd-display #__line__ ";selection rms: ~A ~A?" r2 r3))))))
(set! (selection-creates-region) old-setting))
(forward-graph 1)
(backward-graph 1)
- (without-errors (play-region (list-ref (regions) 2) #t))
+ (without-errors (if (region? (cadr (regions))) (play (cadr (regions)) :wait #t)))
(without-errors (mix-region (car (regions))))
- (if (< (frames) 100000) (play-and-wait))
+ (if (< (frames) 100000) (play :wait #t))
(scale-to .1 (choose-fd))
(scale-by 2.0 (choose-fd))
(save-controls)
@@ -32420,7 +32498,6 @@ EDITS: 2
(test-panel amp-control 'amp-control)
(restore-controls)
(report-in-minibuffer "hi")
- (append-to-minibuffer "ho")
(without-errors
(begin
@@ -32489,7 +32566,7 @@ EDITS: 2
(begin
(make-region 0 (frames))
(convolve-selection-with "fyow.snd" .5)
- (play-and-wait)))
+ (play :wait #t)))
(if (and (> (frames) 1)
(< (frames) 1000000))
(convolve-with "fyow.snd" .25))
@@ -32540,43 +32617,43 @@ EDITS: 2
(lambda (beg) (insert-silence beg 100)))))
(let ((ind (open-sound "z.snd")))
- (if (not (= (frames ind) 0)) (snd-display ";frames z.snd ~A" (frames ind)))
- (if (not (eq? (samples) #f)) (snd-display ";samples of empty file (z): ~A" (samples)))
- (if (not (eq? (channel->vct) #f)) (snd-display ";channel->vct of empty file (z): ~A" (channel->vct)))
- (if (fneq (maxamp ind) 0.0) (snd-display ";maxamp z.snd ~A" (maxamp ind)))
- (if (fneq (sample 100 ind) 0.0) (snd-display ";sample 100 z.snd ~A" (sample 100 ind)))
+ (if (not (= (frames ind) 0)) (snd-display #__line__ ";frames z.snd ~A" (frames ind)))
+ (if (not (eq? (samples) #f)) (snd-display #__line__ ";samples of empty file (z): ~A" (samples)))
+ (if (not (eq? (channel->vct) #f)) (snd-display #__line__ ";channel->vct of empty file (z): ~A" (channel->vct)))
+ (if (fneq (maxamp ind) 0.0) (snd-display #__line__ ";maxamp z.snd ~A" (maxamp ind)))
+ (if (fneq (sample 100 ind) 0.0) (snd-display #__line__ ";sample 100 z.snd ~A" (sample 100 ind)))
(scale-by 2.0)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";scale z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";scale z: ~A" (edit-position ind 0)))
(env-sound '(0 0 1 1))
- (if (not (= (edit-position ind 0) 0)) (snd-display ";env z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";env z: ~A" (edit-position ind 0)))
(smooth-sound)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";smooth z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";smooth z: ~A" (edit-position ind 0)))
(reverse-sound)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";reverse z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";reverse z: ~A" (edit-position ind 0)))
(src-sound 2.0)
- (if (not (= (edit-position ind 0) 0)) (snd-display ";src z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";src z: ~A" (edit-position ind 0)))
(insert-sound "z.snd")
- (if (not (= (edit-position ind 0) 0)) (snd-display ";insert z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";insert z: ~A" (edit-position ind 0)))
(mix "z.snd")
- (if (not (= (edit-position ind 0) 0)) (snd-display ";mix z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";mix z: ~A" (edit-position ind 0)))
(filter-sound (make-one-zero :a0 2.0 :a1 0.0))
- (if (not (= (edit-position ind 0) 0)) (snd-display ";filter z: ~A" (edit-position ind 0)))
- (if (not (= (mus-sound-duration "z.snd") 0.0)) (snd-display ";duration z.snd: ~A" (mus-sound-duration "z.snd")))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";filter z: ~A" (edit-position ind 0)))
+ (if (not (= (mus-sound-duration "z.snd") 0.0)) (snd-display #__line__ ";duration z.snd: ~A" (mus-sound-duration "z.snd")))
(catch 'IO-error
(lambda () (convolve-with "z.snd" 1.0))
(lambda args args))
- (if (not (= (edit-position ind 0) 0)) (snd-display ";convolve z: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";convolve z: ~A" (edit-position ind 0)))
(let ((tag (catch #t (lambda () (find-channel (lambda (y) *> y .1))) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample)) (snd-display ";find z: ~A" tag)))
+ (if (not (eq? tag 'no-such-sample)) (snd-display #__line__ ";find z: ~A" tag)))
(let ((tag (catch #t (lambda () (count-matches (lambda (y) *> y .1))) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample)) (snd-display ";count z: ~A" tag)))
+ (if (not (eq? tag 'no-such-sample)) (snd-display #__line__ ";count z: ~A" tag)))
(let* ((reader (make-sampler 0))
(val (next-sample reader))
(str (format #f "~A" reader)))
- (if (fneq val 0.0) (snd-display ";sampler z.snd: ~A" val))
- (if (not (string? str)) (snd-display ";z.snd reader: ~A" str)))
- (if (not (equal? (cursor-position) (list 0 0))) (snd-display ";cursor-position z: ~A" (cursor-position)))
- (if (not (= (cursor) 0)) (snd-display ";cursor z: ~A" (cursor)))
+ (if (fneq val 0.0) (snd-display #__line__ ";sampler z.snd: ~A" val))
+ (if (not (string? str)) (snd-display #__line__ ";z.snd reader: ~A" str)))
+ (if (not (equal? (cursor-position) (list 0 0))) (snd-display #__line__ ";cursor-position z: ~A" (cursor-position)))
+ (if (not (= (cursor) 0)) (snd-display #__line__ ";cursor z: ~A" (cursor)))
(let ((outer (make-player ind 0)))
(let ((pl (make-player ind 0)))
(add-player pl)
@@ -32590,9 +32667,9 @@ EDITS: 2
(close-sound ind)
(let ((tag (catch #t (lambda () (add-player outer)) (lambda args (car args)))))
(if (not (eq? tag 'no-such-player))
- (snd-display ";dangling player: ~A" tag)))))
+ (snd-display #__line__ ";dangling player: ~A" tag)))))
(if (channel-amp-envs "z.snd" 0 100)
- (snd-display ";channel-amp-envs of empty file: ~A" (channel-amp-envs "z.snd" 0 100)))
+ (snd-display #__line__ ";channel-amp-envs of empty file: ~A" (channel-amp-envs "z.snd" 0 100)))
(let ((zz (view-sound "z.snd")))
(select-sound zz)
@@ -32605,7 +32682,7 @@ EDITS: 2
(let ((editctr (edit-position zz))
(old-selection-choice (selection-creates-region)))
(set! (selection-creates-region) #t)
- (if (not (= (edit-position) 0)) (snd-display ";revert-sound edit-position: ~A" (edit-position)))
+ (if (not (= (edit-position) 0)) (snd-display #__line__ ";revert-sound edit-position: ~A" (edit-position)))
(as-one-edit
(lambda ()
(mix s8-snd 24000)
@@ -32615,7 +32692,7 @@ EDITS: 2
(filter-selection '(0 0 .2 1 .5 0 1 0) 40)
(delete-selection)
(mix-region reg))))))
- (if (not (= (edit-position) 1)) (snd-display ";as-one-edit mix zz: ~A -> ~A" editctr (edit-position)))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";as-one-edit mix zz: ~A -> ~A" editctr (edit-position)))
(set! (selection-creates-region) old-selection-choice))
(close-sound zz))
(let ((s8 (view-sound s8-snd)))
@@ -32625,7 +32702,7 @@ EDITS: 2
(select-channel 5)
(if (or (not (number? (selected-channel)))
(not (= (selected-channel) 5)))
- (snd-display ";select-channel: ~A?" (selected-channel)))))
+ (snd-display #__line__ ";select-channel: ~A?" (selected-channel)))))
(let ((editctr (edit-position)))
(as-one-edit
(lambda ()
@@ -32640,7 +32717,7 @@ EDITS: 2
(select-channel 3))
(if (region? reg)
(insert-region reg 80000)))))
- (if (not (= (edit-position) (+ 1 editctr))) (snd-display ";as-one-edit s8: ~A -> ~A" editctr (edit-position))))
+ (if (not (= (edit-position) (+ 1 editctr))) (snd-display #__line__ ";as-one-edit s8: ~A -> ~A" editctr (edit-position))))
(revert-sound s8)
(close-sound s8))
@@ -32648,7 +32725,7 @@ EDITS: 2
(if (> (chans cfd) 1)
(let ((uval (random 3)))
(set! (channel-style cfd) uval)
- (if (not (= uval (channel-style cfd))) (snd-display ";channel-style: ~A ~A?" uval (channel-style cfd)))))
+ (if (not (= uval (channel-style cfd))) (snd-display #__line__ ";channel-style: ~A ~A?" uval (channel-style cfd)))))
(src-sound 2.5 1.0 cfd)
(src-sound -2.5 1.0 cfd)
(src-sound .5 1.0 cfd)
@@ -32661,9 +32738,9 @@ EDITS: 2
(filter-sound '(0 0 .1 0 .11 1 .12 0 1 0) 2048 cfd)
(env-sound '(0 0 .5 1 1 0) 0 (frames cfd) 1.0 cfd)
(insert-sample 1200 .1 cfd)
- (if (fneq (sample 1200 cfd) .1) (snd-display ";insert-sample(looped): ~A?" (sample 1200 cfd)))
+ (if (fneq (sample 1200 cfd) .1) (snd-display #__line__ ";insert-sample(looped): ~A?" (sample 1200 cfd)))
(revert-sound cfd))
-
+
(let ((cfd (open-sound "obtest.snd")))
(select-sound cfd)
(let ((cfd2 (open-sound "pistol.snd")))
@@ -32673,10 +32750,10 @@ EDITS: 2
(set! (speed-control) 2.0)
(test-panel speed-control 'speed-control)
(apply-controls)
- (if (< (frames) 100000) (play-and-wait))
+ (if (< (frames) 100000) (play :wait #t))
(if (fneq (reverb-control-decay cfd) (reverb-control-decay))
- (snd-display ";reverb-control-decay local: ~A, global: ~A" (reverb-control-decay cfd) (reverb-control-decay)))
+ (snd-display #__line__ ";reverb-control-decay local: ~A, global: ~A" (reverb-control-decay cfd) (reverb-control-decay)))
(set! (reverb-control?) #t)
(set! (reverb-control-scale) .2)
(test-panel reverb-control-scale 'reverb-control-scale)
@@ -32684,13 +32761,13 @@ EDITS: 2
(test-panel reverb-control-lowpass 'reverb-control-lowpass)
(test-panel reverb-control-feedback 'reverb-control-feedback)
(apply-controls)
- (if (< (frames) 100000) (play-and-wait))
+ (if (< (frames) 100000) (play :wait #t))
(set! (contrast-control?) #t)
(set! (contrast-control) .5)
(test-panel contrast-control 'contrast-control)
(test-panel contrast-control-amp 'contrast-control-amp)
(apply-controls)
- (if (< (frames) 100000) (play-and-wait))
+ (if (< (frames) 100000) (play :wait #t))
(set! (expand-control?) #t)
(set! (expand-control) 2.5)
(test-panel expand-control 'expand-control)
@@ -32698,38 +32775,38 @@ EDITS: 2
(test-panel expand-control-hop 'expand-control-hop)
(test-panel expand-control-ramp 'expand-control-ramp)
(apply-controls)
- (if (< (frames) 100000) (play-and-wait))
+ (if (< (frames) 100000) (play :wait #t))
(set! (filter-control?) #t)
(set! (filter-control-order) 40)
(test-panel filter-control-order 'filter-control-order)
(set! (filter-control-envelope) '(0 0 .1 1 .2 0 1 0))
(filter-control-envelope)
(apply-controls)
- (if (< (frames) 100000) (play-and-wait))
+ (if (< (frames) 100000) (play :wait #t))
(set! (amp-control) 1.5)
(test-panel amp-control 'amp-control)
(apply-controls)
- (if (< (frames) 100000) (play-and-wait))
+ (if (< (frames) 100000) (play :wait #t))
(swap-channels cfd 0 cfd2 0)
(set! (amp-control #t) .75)
(test-panel amp-control 'amp-control)
- (if (> (abs (- (amp-control cfd2) .75)) .05) (snd-display ";set-amp .75 #t -> ~A?" (amp-control cfd2)))
+ (if (> (abs (- (amp-control cfd2) .75)) .05) (snd-display #__line__ ";set-amp .75 #t -> ~A?" (amp-control cfd2)))
(set! (contrast-control-amp #t) .75)
- (if (fneq (contrast-control-amp cfd2) .75) (snd-display ";set-contrast-control-amp .75 #t -> ~A?" (contrast-control-amp cfd2)))
+ (if (fneq (contrast-control-amp cfd2) .75) (snd-display #__line__ ";set-contrast-control-amp .75 #t -> ~A?" (contrast-control-amp cfd2)))
(set! (contrast-control-bounds cfd2) (list 2.0 3.0))
(if (not (feql (contrast-control-bounds cfd2) (list 2.0 3.0)))
- (snd-display ";cfd2 contrast-control-bounds: ~A" (contrast-control-bounds cfd2)))
+ (snd-display #__line__ ";cfd2 contrast-control-bounds: ~A" (contrast-control-bounds cfd2)))
(set! (expand-control-length #t) .025)
- (if (fneq (expand-control-length cfd2) .025) (snd-display ";set-expand-control-length .025 #t -> ~A?" (expand-control-length cfd2)))
+ (if (fneq (expand-control-length cfd2) .025) (snd-display #__line__ ";set-expand-control-length .025 #t -> ~A?" (expand-control-length cfd2)))
(set! (expand-control-hop #t) .025)
- (if (fneq (expand-control-hop cfd2) .025) (snd-display ";set-expand-control-hop .025 #t -> ~A?" (expand-control-hop cfd2)))
+ (if (fneq (expand-control-hop cfd2) .025) (snd-display #__line__ ";set-expand-control-hop .025 #t -> ~A?" (expand-control-hop cfd2)))
(set! (expand-control-jitter #t) .025)
- (if (fneq (expand-control-jitter cfd2) .025) (snd-display ";set-expand-control-jitter .025 #t -> ~A?" (expand-control-jitter cfd2)))
+ (if (fneq (expand-control-jitter cfd2) .025) (snd-display #__line__ ";set-expand-control-jitter .025 #t -> ~A?" (expand-control-jitter cfd2)))
(set! (expand-control-ramp #t) .025)
- (if (fneq (expand-control-ramp cfd2) .025) (snd-display ";set-expand-control-ramp .025 #t -> ~A?" (expand-control-ramp cfd2)))
+ (if (fneq (expand-control-ramp cfd2) .025) (snd-display #__line__ ";set-expand-control-ramp .025 #t -> ~A?" (expand-control-ramp cfd2)))
(let ((clone (clone-sound-as "/tmp/cloned.snd" cfd2)))
(if (not (= (frames cfd2) (frames clone)))
- (snd-display ";clone frames: ~A ~A" (frames cfd2) (frames clone)))
+ (snd-display #__line__ ";clone frames: ~A ~A" (frames cfd2) (frames clone)))
(close-sound clone))
(delete-file "/tmp/cloned.snd")
(mus-sound-forget "/tmp/cloned.snd")
@@ -32738,9 +32815,9 @@ EDITS: 2
(add-hook! (edit-hook) (lambda () #f))
(let ((editctr (edit-position)))
(as-one-edit (lambda () (set! (sample 200) .2) (set! (sample 300) .3)))
- (if (not (= (edit-position) (+ 1 editctr))) (snd-display ";as-one-edit: ~A -> ~A" editctr (edit-position)))
+ (if (not (= (edit-position) (+ 1 editctr))) (snd-display #__line__ ";as-one-edit: ~A -> ~A" editctr (edit-position)))
(as-one-edit (lambda () #f))
- (if (not (= (edit-position) (+ 1 editctr))) (snd-display ";as-one-edit nil: ~A -> ~A" editctr (edit-position))))
+ (if (not (= (edit-position) (+ 1 editctr))) (snd-display #__line__ ";as-one-edit nil: ~A -> ~A" editctr (edit-position))))
(delete-sample 250)
(add-hook! (undo-hook) (lambda () #f))
(undo)
@@ -32754,12 +32831,12 @@ EDITS: 2
(reset-hook! (edit-hook))
; (add-hook! snd-error-hook
; (lambda (msg)
- ; (if (not (string=? msg "hiho")) (snd-display ";snd-error-hook: ~A?" msg))
+ ; (if (not (string=? msg "hiho")) (snd-display #__line__ ";snd-error-hook: ~A?" msg))
; #t))
; (snd-error "hiho")
(add-hook! snd-warning-hook
(lambda (msg)
- (if (not (string=? msg "hiho")) (snd-display ";snd-warning-hook: ~A?" msg))
+ (if (not (string=? msg "hiho")) (snd-display #__line__ ";snd-warning-hook: ~A?" msg))
#t))
(snd-warning "hiho")
(reset-hook! snd-error-hook)
@@ -32801,7 +32878,7 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i len) v)
(let* ((val (abs (next-sample fd)))
- (bin (inexact->exact (round (* val 16.0)))))
+ (bin (round (* val 16.0))))
(if (< bin steps)
(do ((j 0 (+ 1 j)))
((= j steps))
@@ -32848,10 +32925,10 @@ EDITS: 2
(let ((maxval1 (+ (maxamp) .01)))
(if (not (every-sample? (lambda (y) (< y maxval1))))
(let ((res (scan-chan (lambda (y) (>= y maxval1)))))
- (snd-display ";~A, every-sample: ~A ~A [~A: ~A]?" (short-file-name) maxval1 res (cursor) (sample (cursor)))
+ (snd-display #__line__ ";~A, every-sample: ~A ~A [~A: ~A]?" (short-file-name) maxval1 res (cursor) (sample (cursor)))
(do ((i 0 (+ 1 i)))
((= i (edit-position)))
- (snd-display ";~D: ~A ~A" i (maxamp #f 0 i) (edit-fragment i))))))
+ (snd-display #__line__ ";~D: ~A ~A" i (maxamp #f 0 i) (edit-fragment i))))))
(map-chan (echo .5 .75) 0 60000)
(reset-hook! after-transform-hook)
@@ -32865,7 +32942,7 @@ EDITS: 2
(for-each
(lambda (snd)
- (set! (sync snd) (inexact->exact (floor (random 3))))
+ (set! (sync snd) (floor (random 3)))
(update-lisp-graph snd))
(sounds))
(add-hook! graph-hook superimpose-ffts)
@@ -32900,24 +32977,21 @@ EDITS: 2
(if index
(if (equal? minval #f)
(setfnc #t index)
- (if (exact? minval)
+ (if (rational? minval)
(if (equal? name #t)
- (setfnc (inexact->exact
- (floor (expt 2 (min 31 (inexact->exact
- (ceiling (/ (log (+ minval (floor (* (- maxval minval) (random 1.0)))))
- (log 2))))))))
+ (setfnc (floor (expt 2 (min 31
+ (ceiling (/ (log (+ minval (floor (* (- maxval minval) (random 1.0)))))
+ (log 2))))))
index)
- (setfnc (+ minval (inexact->exact (floor (* (- maxval minval) (random 1.0))))) index))
+ (setfnc (+ minval (floor (* (- maxval minval) (random 1.0)))) index))
(setfnc (+ minval (* (- maxval minval) (random 1.0))) index)))
(if (equal? minval #f)
(setfnc-1 #t)
- (if (exact? minval)
+ (if (rational? minval)
(if (equal? name #t)
- (setfnc-1 (inexact->exact
- (floor (expt 2 (min 31 (inexact->exact
- (ceiling (/ (log (+ minval (floor (* (- maxval minval) (random 1.0)))))
- (log 2)))))))))
- (setfnc-1 (+ minval (inexact->exact (floor (* (- maxval minval) (random 1.0)))))))
+ (setfnc-1 (floor (expt 2 (min 31 (ceiling (/ (log (+ minval (floor (* (- maxval minval) (random 1.0)))))
+ (log 2)))))))
+ (setfnc-1 (+ minval (floor (* (- maxval minval) (random 1.0))))))
(setfnc-1 (+ minval (* (- maxval minval) (random 1.0)))))))
(reset-vars (cdr lst)))))))
(reset-vars
@@ -33033,19 +33107,19 @@ EDITS: 2
(if open-files (for-each close-sound open-files))
(set! open-files '())
(set! (mus-rand-seed) 1234)
- (if (not (= (mus-rand-seed) 1234)) (snd-display ";mus-rand-seed: ~A (1234)!" (mus-rand-seed)))
+ (if (not (= (mus-rand-seed) 1234)) (snd-display #__line__ ";mus-rand-seed: ~A (1234)!" (mus-rand-seed)))
(let ((val (mus-random 1.0))
(val1 (mus-random 1.0)))
(if (or (fneq val -0.7828)
(fneq val1 -0.8804))
- (snd-display ";mus-random: ~A ~A?" val val1))
- (if (= (mus-rand-seed) 1234) (snd-display ";mus-rand-seed: ~A!" (mus-rand-seed))))
+ (snd-display #__line__ ";mus-random: ~A ~A?" val val1))
+ (if (= (mus-rand-seed) 1234) (snd-display #__line__ ";mus-rand-seed: ~A!" (mus-rand-seed))))
(set! (mus-rand-seed) 1234)
(let ((val (mus-random 1.0))
(val1 (mus-random 1.0)))
(if (or (fneq val -0.7828)
(fneq val1 -0.8804))
- (snd-display ";mus-random repeated: ~A ~A?" val val1)))
+ (snd-display #__line__ ";mus-random repeated: ~A ~A?" val val1)))
(reset-hook! after-open-hook)
(reset-hook! close-hook)
(reset-hook! open-hook)
@@ -33119,7 +33193,7 @@ EDITS: 2
(define test-equal
(lambda (nv new-value)
(if (and (number? nv)
- (inexact? nv))
+ (not (rational? nv)))
(not (fneq nv new-value))
(equal? nv new-value))))
(define chan-equal?
@@ -33130,28 +33204,28 @@ EDITS: 2
(else (test-equal vals new-value)))))
(if (and (not (equal? (flatten (func #t #t)) (apply map func (all-chans))))
(not (equal? (flatten (func #t #t)) (apply map func (all-chans-reversed)))))
- (snd-display ";test-history-channel ~A[0]: ~A ~A?" name (flatten (func #t #t)) (apply map func (all-chans))))
+ (snd-display #__line__ ";test-history-channel ~A[0]: ~A ~A?" name (flatten (func #t #t)) (apply map func (all-chans))))
(let ((old-value (func))
(old-chan-value (func snd1 0)))
(set! (func snd1 0) new-value)
(let ((nv (func snd1 0)))
(if (not (test-equal nv new-value))
- (snd-display ";test-history-channel set-~A[1]: ~A ~A?" name new-value (func snd1 0))))
+ (snd-display #__line__ ";test-history-channel set-~A[1]: ~A ~A?" name new-value (func snd1 0))))
(set! (func snd3 2) new-value)
(let ((nv (func snd3 2)))
(if (not (test-equal nv new-value))
- (snd-display ";test-history-channel set-~A[2]: ~A ~A?" name new-value (func snd3 2))))
+ (snd-display #__line__ ";test-history-channel set-~A[2]: ~A ~A?" name new-value (func snd3 2))))
(if (not (test-equal old-value new-value))
(let ((nv (func snd3 1)))
(if (test-equal nv new-value)
- (snd-display ";test-history-channel set-~A[3]: ~A ~A?" name new-value (func snd3 1)))))
+ (snd-display #__line__ ";test-history-channel set-~A[3]: ~A ~A?" name new-value (func snd3 1)))))
(set! (func snd2 #t) new-value)
(let ((nv (func snd2 1)))
(if (not (test-equal nv new-value))
- (snd-display ";test-history-channel set-~A[4]: ~A ~A?" name new-value (func snd2 1))))
+ (snd-display #__line__ ";test-history-channel set-~A[4]: ~A ~A?" name new-value (func snd2 1))))
(set! (func) new-value)
(if (not (chan-equal? (flatten (func #t #t)) new-value))
- (snd-display ";test-history-channel ~A[5]: ~A ~A?" name (flatten (func #t #t)) (apply map func (all-chans))))
+ (snd-display #__line__ ";test-history-channel ~A[5]: ~A ~A?" name (flatten (func #t #t)) (apply map func (all-chans))))
(set! (func) old-value)
))
@@ -33202,7 +33276,7 @@ EDITS: 2
(nv (next-sample new-reader))
(val (abs (- ov nv))))
(set! diff (+ diff val))))
- (if (> diff 0.0) (snd-display ";diff (~D ~D): ~A" beg len diff))
+ (if (> diff 0.0) (snd-display #__line__ ";diff (~D ~D): ~A" beg len diff))
(set! diff 0.0)
(do ((i 0 (+ 1 i)))
((= i 100))
@@ -33210,7 +33284,7 @@ EDITS: 2
(nv (next-sample new-reader))
(val (abs (- ov nv))))
(set! diff (+ diff val))))
- (if (> diff 0.0) (snd-display ";zdiff (~D ~D): ~A" beg len diff))
+ (if (> diff 0.0) (snd-display #__line__ ";zdiff (~D ~D): ~A" beg len diff))
(free-sampler old-reader)
(free-sampler new-reader)))
@@ -33226,7 +33300,7 @@ EDITS: 2
(let* ((nv (abs (next-sample new-reader))))
(if (> nv newmax) (set! newmax nv))))
(if (fneq newmax maxval)
- (snd-display ";scale-selection-to (~D ~D) ~A: ~A?" beg len maxval newmax))
+ (snd-display #__line__ ";scale-selection-to (~D ~D) ~A: ~A?" beg len maxval newmax))
(free-sampler new-reader)))
(define play-with-amps
@@ -33235,10 +33309,10 @@ EDITS: 2
(do ((chan 0 (+ 1 chan)))
((= chan chans))
(let ((player (make-player sound chan)))
- (if (not (player? player)) (snd-display ";player? ~A -> #f?" player))
- (if (not (member player (players))) (snd-display ";player: ~A, but players: ~A" player (players)))
+ (if (not (player? player)) (snd-display #__line__ ";player? ~A -> #f?" player))
+ (if (not (member player (players))) (snd-display #__line__ ";player: ~A, but players: ~A" player (players)))
(if (not (equal? (player-home player) (list sound chan)))
- (snd-display ";player-home ~A ~A?" (player-home player) (list sound chan)))
+ (snd-display #__line__ ";player-home ~A ~A?" (player-home player) (list sound chan)))
(set! (amp-control player) (list-ref amps chan))
(set! (speed-control player) .5)
(set! (expand-control? player) #t)
@@ -33257,10 +33331,10 @@ EDITS: 2
(rd (make-sampler 0 snd2 0))
(mx (maxamp snd2 0)))
(map-channel (lambda (val)
- (sound-interp intrp (inexact->exact (floor (* len (* 0.5 (+ 1.0 (/ (read-sample rd) mx)))))))))))
+ (sound-interp intrp (floor (* len (* 0.5 (+ 1.0 (/ (read-sample rd) mx))))))))))
(set! (transform-type) fourier-transform)
-
+
(if with-gui
(begin
@@ -33271,27 +33345,27 @@ EDITS: 2
(and (not (= (mus-sound-header-type file) mus-raw))
(= (mus-sound-chans file) 1))))))))
- (if (not (equal? (all-chans) (list (list obi) (list 0)))) (snd-display ";all-chans: ~A?" (all-chans)))
+ (if (not (equal? (all-chans) (list (list obi) (list 0)))) (snd-display #__line__ ";all-chans: ~A?" (all-chans)))
(let ((s2i (open-sound (car (match-sound-files (lambda (file) (= (mus-sound-chans file) 2)))))))
(if (and (not (equal? (all-chans) (list (list obi s2i s2i) (list 0 0 1))))
(not (equal? (all-chans) (list (list s2i s2i obi) (list 0 1 0)))))
- (snd-display ";all-chans(2): ~A?" (all-chans)))
+ (snd-display #__line__ ";all-chans(2): ~A?" (all-chans)))
(if (not (string=? (finfo "oboe.snd") "oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.305"))
- (snd-display ";finfo: ~A?" (finfo "oboe.snd")))
+ (snd-display #__line__ ";finfo: ~A?" (finfo "oboe.snd")))
(close-sound s2i)
(close-sound obi)
- (if (not (equal? (all-chans) '(() ()))) (snd-display ";all-chans(0): ~A?" (all-chans)))
+ (if (not (equal? (all-chans) '(() ()))) (snd-display #__line__ ";all-chans(0): ~A?" (all-chans)))
(set! obi (open-sound "oboe.snd"))
(set! (cursor obi) 1000)
(let ((tick (locate-zero .001)))
(if (not (= tick 1050))
- (snd-display ";locate-zero: ~A = ~A (second try: ~A)?" tick (sample tick) (locate-zero .001))))
+ (snd-display #__line__ ";locate-zero: ~A = ~A (second try: ~A)?" tick (sample tick) (locate-zero .001))))
(add-hook! graph-hook auto-dot)
(add-hook! graph-hook superimpose-ffts)
(set! (transform-graph? obi 0) #t)
(update-graphs)
(set! s2i (open-sound (car (match-sound-files (lambda (file) (= (mus-sound-chans file) 2))))))
- (if (not (= (chans s2i) 2)) (snd-display ";match 2 got ~A with ~A chans" (short-file-name s2i) (chans s2i)))
+ (if (not (= (chans s2i) 2)) (snd-display #__line__ ";match 2 got ~A with ~A chans" (short-file-name s2i) (chans s2i)))
(update-graphs)
(remove-hook! graph-hook auto-dot)
(remove-hook! graph-hook superimpose-ffts)
@@ -33299,17 +33373,17 @@ EDITS: 2
(select-sound obi)
(let ((m1 (add-mark 100 obi 0)))
(first-mark-in-window-at-left)
- (if (> (abs (- (left-sample obi 0) 100)) 1) (snd-display ";mark-in-window: ~A ~A?" (left-sample obi 0) (mark-sample m1)))
+ (if (> (abs (- (left-sample obi 0) 100)) 1) (snd-display #__line__ ";mark-in-window: ~A ~A?" (left-sample obi 0) (mark-sample m1)))
(delete-mark m1))
(close-sound s2i)
(safe-make-selection 1000 2000 obi)
(delete-selection-and-smooth)
(if (not (equal? (edit-fragment 0 obi 0) '(#f "init" 0 50828)))
- (snd-display ";edit-fragment(0): ~S?" (edit-fragment 0 obi 0)))
+ (snd-display #__line__ ";edit-fragment(0): ~S?" (edit-fragment 0 obi 0)))
(if (not (equal? (edit-fragment 1 obi 0) '("delete-samples 1000 1001" "delete" 1000 1001)))
- (snd-display ";edit-fragment(1): ~S?" (edit-fragment 1 obi 0)))
+ (snd-display #__line__ ";edit-fragment(1): ~S?" (edit-fragment 1 obi 0)))
(if (not (equal? (edit-fragment 2 obi 0) '("smooth-channel 984 32" "set" 984 32)))
- (snd-display ";edit-fragment(2): ~S?" (edit-fragment 2 obi 0)))
+ (snd-display #__line__ ";edit-fragment(2): ~S?" (edit-fragment 2 obi 0)))
(let ((samp100 (sample 1100 obi 0)))
(select-sound obi)
@@ -33317,26 +33391,26 @@ EDITS: 2
(eval-over-selection (lambda (val) (* 2.0 val)))
(let ((nsamp100 (sample 1100 obi 0)))
(if (fneq (* 2.0 samp100) nsamp100)
- (snd-display ";eval-over-selection: ~A ~A [~A ~A]?"
+ (snd-display #__line__ ";eval-over-selection: ~A ~A [~A ~A]?"
samp100 nsamp100 (selection-position) (selection-frames)))
(let ((m2 (add-mark 1000 obi 0))
(m3 (add-mark 2000 obi 0)))
- (if (not (equal? (marks obi 0) (list m2 m3))) (snd-display ";add-mark: ~A ~A?" (marks obi 0) (list m2 m3)))
+ (if (not (equal? (marks obi 0) (list m2 m3))) (snd-display #__line__ ";add-mark: ~A ~A?" (marks obi 0) (list m2 m3)))
(set! (left-sample obi 0) 950)
(eval-between-marks (lambda (val) (* 2.0 val)))
(let ((msamp100 (sample 1100 obi 0)))
- (if (fneq (* 2.0 nsamp100) msamp100) (snd-display ";eval-between-marks: ~A ~A?" nsamp100 msamp100))
+ (if (fneq (* 2.0 nsamp100) msamp100) (snd-display #__line__ ";eval-between-marks: ~A ~A?" nsamp100 msamp100))
(revert-sound obi)))))
(let ((maxa (maxamp obi)))
(normalized-mix "pistol.snd" 1000 0 obi 0)
(let ((nmaxa (maxamp obi)))
- (if (fneq maxa nmaxa) (snd-display ";normalized-mix: ~A ~A?" maxa nmaxa)))
+ (if (fneq maxa nmaxa) (snd-display #__line__ ";normalized-mix: ~A ~A?" maxa nmaxa)))
(revert-sound obi))
(set! s2i (open-sound (car (match-sound-files (lambda (file)
(and (= (mus-sound-chans file) 2)
(not (= (mus-sound-header-type file) mus-raw))
(> (mus-sound-frames file) 1000)))))))
- (if (not (= (chans s2i) 2)) (snd-display ";match 2+1000 got ~A with ~A chans" (short-file-name s2i) (chans s2i)))
+ (if (not (= (chans s2i) 2)) (snd-display #__line__ ";match 2+1000 got ~A with ~A chans" (short-file-name s2i) (chans s2i)))
(let ((o1 (sample 1000 obi 0))
(s1 (sample 1000 s2i 0))
(s2 (sample 1000 s2i 1)))
@@ -33347,7 +33421,7 @@ EDITS: 2
(if (or (fneq (* 2.0 o1) o11)
(fneq (* 2.0 s1) s11)
(fneq (* 2.0 s2) s21))
- (snd-display ";do-all-chans: ~A?" (list o1 s1 s2 o11 s11 s21)))))
+ (snd-display #__line__ ";do-all-chans: ~A?" (list o1 s1 s2 o11 s11 s21)))))
(update-graphs)
(let ((m1 (maxamp obi 0))
(m2 (maxamp s2i 0))
@@ -33356,7 +33430,7 @@ EDITS: 2
(if (or (fneq m1 (car mc))
(fneq m2 (cadr mc))
(fneq m3 (caddr mc)))
- (snd-display ";map maxamp all-chans: ~A ~A ~A ~A?" m1 m2 m3 mc))
+ (snd-display #__line__ ";map maxamp all-chans: ~A ~A ~A ~A?" m1 m2 m3 mc))
(set! (sync obi) 1)
(set! (sync s2i) 1)
(do-chans (lambda (val) (if val (* 2.0 val) #f)) "*2")
@@ -33364,7 +33438,7 @@ EDITS: 2
(if (or (fneq (* 2.0 m1) (car mc1))
(fneq (* 2.0 m2) (cadr mc1))
(fneq (* 2.0 m3) (caddr mc1)))
- (snd-display ";do-chans: ~A ~A?" mc mc1))
+ (snd-display #__line__ ";do-chans: ~A ~A?" mc mc1))
(set! (sync obi) 0)
(set! (sync s2i) 0)
(select-sound s2i)
@@ -33373,18 +33447,18 @@ EDITS: 2
(if (or (fneq (* 2.0 m1) (car mc2))
(fneq m2 (cadr mc2))
(fneq m3 (caddr mc2)))
- (snd-display ";do-sound-chans: ~A ~A ~A?" mc mc1 mc2)))
-; (if (every-sample? (lambda (val) (> val .5))) (snd-display ";every-sample(0)?"))
- (if (not (every-sample? (lambda (val) (< val 5.0)))) (snd-display ";every-sample(1)?"))
+ (snd-display #__line__ ";do-sound-chans: ~A ~A ~A?" mc mc1 mc2)))
+ ; (if (every-sample? (lambda (val) (> val .5))) (snd-display #__line__ ";every-sample(0)?"))
+ (if (not (every-sample? (lambda (val) (< val 5.0)))) (snd-display #__line__ ";every-sample(1)?"))
(select-sound obi)
(let ((bins (sort-samples 32)))
- (if (not (= (vector-ref bins 1) 4504)) (snd-display ";sort-samples: ~A?" bins)))
+ (if (not (= (vector-ref bins 1) 4504)) (snd-display #__line__ ";sort-samples: ~A?" bins)))
))
(revert-sound s2i)
(revert-sound obi)
(set! (sync obi) 3)
(set! (sync s2i) 3)
- (let* ((half-way (inexact->exact (floor (* 0.5 (frames obi)))))
+ (let* ((half-way (floor (* 0.5 (frames obi))))
(o1 (sample half-way obi 0))
(s1 (sample half-way s2i 0))
(s2 (sample half-way s2i 1)))
@@ -33399,7 +33473,7 @@ EDITS: 2
(fneq (+ s2 (* 0.5 o1)) s22)
(fneq s21 s31)
(fneq s22 s32))
- (snd-display ";place: ~A " (list o1 s1 s2 s21 s22 s31 s32))))))
+ (snd-display #__line__ ";place: ~A " (list o1 s1 s2 s21 s22 s31 s32))))))
(revert-sound s2i)
(revert-sound obi)
(set! (sync obi) 0)
@@ -33409,7 +33483,7 @@ EDITS: 2
(fneq ((compand) .1) .2)
(fneq ((compand) .99) .997)
(fneq ((compand) .95) .984))
- (snd-display ";compand: ~A?" (list ((compand) 0.0) ((compand) 1.0) ((compand) .1) ((compand) .99) ((compand) .95))))
+ (snd-display #__line__ ";compand: ~A?" (list ((compand) 0.0) ((compand) 1.0) ((compand) .1) ((compand) .99) ((compand) .95))))
(close-sound obi)
(revert-sound s2i)
@@ -33419,53 +33493,53 @@ EDITS: 2
(select-all)
(if (not (= (selection-chans) 2))
(begin
- (snd-display ";selection-chans(2): ~A?" (selection-chans))
+ (snd-display #__line__ ";selection-chans(2): ~A?" (selection-chans))
(for-each
(lambda (snd)
(do ((i 0 (+ 1 i)))
((= i (chans snd)))
(if (selection-member? snd i)
- (snd-display "; ~A[~A] at ~A" (short-file-name snd) i (selection-position snd i)))))
+ (snd-display #__line__ "; ~A[~A] at ~A" (short-file-name snd) i (selection-position snd i)))))
(sounds))))
- (if (not (= (selection-srate) (srate s2i))) (snd-display ";selection-srate: ~A ~A?" (selection-srate) (srate s2i)))
+ (if (not (= (selection-srate) (srate s2i))) (snd-display #__line__ ";selection-srate: ~A ~A?" (selection-srate) (srate s2i)))
(if (= (selection-chans) 2)
(begin
(swap-selection-channels)
(if (or (fneq s1 (sample 1000 s2i 1))
(fneq s2 (sample 1000 s2i 0)))
- (snd-display ";swap-selection-channels: ~A?" (list s1 s2 (sample 1000 s2i 0) (sample 1000 s2i 1)))))))
+ (snd-display #__line__ ";swap-selection-channels: ~A?" (list s1 s2 (sample 1000 s2i 0) (sample 1000 s2i 1)))))))
(revert-sound s2i)
(close-sound s2i)
(set! obi (open-sound "oboe.snd"))
(select-all)
(for-each forget-region (regions))
- (if (not (equal? (regions) '())) (snd-display ";no regions? ~A" (regions)))
+ (if (not (equal? (regions) '())) (snd-display #__line__ ";no regions? ~A" (regions)))
(let ((id (make-region 100 200 obi 0)))
- (if (not (equal? (regions) (list id))) (snd-display ";make-region regions: ~A?" (regions))))
+ (if (not (equal? (regions) (list id))) (snd-display #__line__ ";make-region regions: ~A?" (regions))))
(revert-sound obi)
(let ((oldlen (frames obi)))
(env-sound-interp '(0 0 1 1 2 0) 2.0 obi 0)
(let ((newlen (frames obi)))
(if (> (abs (- (* 2 oldlen) newlen)) 3)
- (snd-display ";env-sound-interp: ~A ~A?" oldlen newlen))))
+ (snd-display #__line__ ";env-sound-interp: ~A ~A?" oldlen newlen))))
(revert-sound obi)
(granulated-sound-interp '(0 0 1 .1 2 1) 1.0 0.2 '(0 0 1 1 2 0))
- (if (not (= (edit-position obi 0) 1)) (snd-display ";granulated-sound-interp no-op 1?"))
- (if (< (maxamp obi 0) .15) (snd-display ";granulated-sound-interp 1 maxamp: ~A" (maxamp obi 0)))
- (if (> (abs (- (frames obi 0) 50828)) 1000) (snd-display ";granulated-sound-interp 1 frames: ~A" (frames obi 0)))
+ (if (not (= (edit-position obi 0) 1)) (snd-display #__line__ ";granulated-sound-interp no-op 1?"))
+ (if (< (maxamp obi 0) .15) (snd-display #__line__ ";granulated-sound-interp 1 maxamp: ~A" (maxamp obi 0)))
+ (if (> (abs (- (frames obi 0) 50828)) 1000) (snd-display #__line__ ";granulated-sound-interp 1 frames: ~A" (frames obi 0)))
(revert-sound obi)
(granulated-sound-interp '(0 0 1 1) 2.0)
- (if (not (= (edit-position obi 0) 1)) (snd-display ";granulated-sound-interp no-op 2?"))
- (if (< (maxamp obi 0) .15) (snd-display ";granulated-sound-interp 2 maxamp: ~A" (maxamp obi 0)))
- (if (> (abs (- (frames obi 0) 101656)) 1000) (snd-display ";granulated-sound-interp 2 frames: ~A" (frames obi 0)))
+ (if (not (= (edit-position obi 0) 1)) (snd-display #__line__ ";granulated-sound-interp no-op 2?"))
+ (if (< (maxamp obi 0) .15) (snd-display #__line__ ";granulated-sound-interp 2 maxamp: ~A" (maxamp obi 0)))
+ (if (> (abs (- (frames obi 0) 101656)) 1000) (snd-display #__line__ ";granulated-sound-interp 2 frames: ~A" (frames obi 0)))
(revert-sound obi)
(granulated-sound-interp '(0 0 1 .1 2 1) 1.0 0.2 '(0 0 1 1 2 0) 0.02)
- (if (not (= (edit-position obi 0) 1)) (snd-display ";granulated-sound-interp no-op 3?"))
- (if (< (maxamp obi 0) .2) (snd-display ";granulated-sound-interp 3 maxamp: ~A" (maxamp obi 0)))
- (if (> (abs (- (frames obi 0) 50828)) 1000) (snd-display ";granulated-sound-interp 3 frames: ~A" (frames obi 0)))
+ (if (not (= (edit-position obi 0) 1)) (snd-display #__line__ ";granulated-sound-interp no-op 3?"))
+ (if (< (maxamp obi 0) .2) (snd-display #__line__ ";granulated-sound-interp 3 maxamp: ~A" (maxamp obi 0)))
+ (if (> (abs (- (frames obi 0) 50828)) 1000) (snd-display #__line__ ";granulated-sound-interp 3 frames: ~A" (frames obi 0)))
(close-sound obi)
)
@@ -33483,7 +33557,7 @@ EDITS: 2
(sound-interp reader (* len (+ 0.5 (* 0.5 (oscil osc)))))))
(if (not (vequal (channel->vct) (vct 0.000 0.020 0.079 0.172 0.291 0.427 0.569 0.706 0.825 0.919
0.979 1.000 0.981 0.923 0.831 0.712 0.576 0.434 0.298 0.177)))
- (snd-display ";sound-interp: ~A" (channel->vct))))
+ (snd-display #__line__ ";sound-interp: ~A" (channel->vct))))
(undo)
(let ((osc (make-oscil :frequency 0.5 :initial-phase (+ pi (/ pi 2))))
@@ -33496,22 +33570,22 @@ EDITS: 2
(env-sound-interp '(0 0 1 1))
(if (not (vequal (channel->vct) (vct 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474
0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
- (snd-display ";env-sound-interp no change: ~A" (channel->vct)))
+ (snd-display #__line__ ";env-sound-interp no change: ~A" (channel->vct)))
(undo)
(env-sound-interp '(0 0 1 .95 2 0) 2.0)
(if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450
0.500 0.550 0.600 0.650 0.700 0.750 0.800 0.850 0.900 0.950
1.000 0.950 0.900 0.850 0.800 0.750 0.700 0.650 0.600 0.550
0.500 0.450 0.400 0.350 0.300 0.250 0.200 0.150 0.100 0.050)))
- (snd-display ";env-sound-interp twice len and back: ~A" (channel->vct)))
+ (snd-display #__line__ ";env-sound-interp twice len and back: ~A" (channel->vct)))
(revert-sound ind)
(set! (sample 10) .5)
(remove-clicks)
- (if (fneq (sample 10) 0.0) (snd-display ";remove-clicks: ~A" (channel->vct)))
+ (if (fneq (sample 10) 0.0) (snd-display #__line__ ";remove-clicks: ~A" (channel->vct)))
(undo)
(let ((vals (scan-channel (search-for-click))))
- (if (not (equal? vals (list -1 11)))
- (snd-display ";search-for-click: ~A" vals)))
+ (if (not (equal? vals (list #t 11)))
+ (snd-display #__line__ ";search-for-click: ~A" vals)))
(close-sound ind))
(set! (mus-srate) old-srate))
@@ -33523,7 +33597,7 @@ EDITS: 2
(sound-via-sound ind1 ind2)
(let ((vals (channel->vct 0 20 ind1)))
(if (not (vequal vals (vct 0.95 0.90 0.85 0.80 0.75 0.70 0.65 0.60 0.55 0.50 0.45 0.40 0.35 0.30 0.25 0.20 0.15 0.10 0.05 0.00)))
- (snd-display ";sound-via-sound: ~A" vals)))
+ (snd-display #__line__ ";sound-via-sound: ~A" vals)))
(let ((new-file-name (file-name ind2)))
(close-sound ind2)
(if (file-exists? new-file-name) (delete-file new-file-name)))
@@ -33531,18 +33605,18 @@ EDITS: 2
(let ((val -.5)) (map-channel (lambda (y) (set! val (+ val .05)) val)))
(let ((val (scan-channel (zero+))))
(if (or (not val)
- (not (equal? val (list -1 10)))) ; optimization > 0 wants bool (change in run wrecked the back-one cursor placement)
- (snd-display ";zero+: ~A" val)))
+ (not (equal? val (list #t 10))))
+ (snd-display #__line__ ";zero+: ~A" val)))
(set! (sample 8) .8)
(let ((val (scan-channel (next-peak))))
(if (or (not val)
- (not (equal? val (list -1 9)))) ; this gets the -1 because run can't deal with the bool/float mismatch
- (snd-display ";next-peak: ~A" val)))
+ (not (equal? val (list #t 9))))
+ (snd-display #__line__ ";next-peak: ~A" val)))
(let ((val (scan-channel (search-for-click))))
(if (or (not val)
- (not (equal? val (list -1 9))))
- (snd-display ";search-for-click: ~A" val)))
- (if (not (= (find-click 0) 8)) (snd-display ";find-click: ~A" (find-click 0)))
+ (not (equal? val (list #t 9))))
+ (snd-display #__line__ ";search-for-click: ~A" val)))
+ (if (not (= (find-click 0) 8)) (snd-display #__line__ ";find-click: ~A" (find-click 0)))
(let ((new-file-name (file-name ind1)))
(close-sound ind1)
(if (file-exists? new-file-name) (delete-file new-file-name))))
@@ -33551,163 +33625,163 @@ EDITS: 2
(fr (frames id 0))
(mx (maxamp id 0)))
(set! (frames id 0) 25000)
- (if (not (= (frames id 0) 25000)) (snd-display ";set-frames 25000: ~A?" (frames id 0)))
- (if (not (= (edit-position id 0) 1)) (snd-display ";set-frames 25000 edit: ~A?" (edit-position id 0)))
+ (if (not (= (frames id 0) 25000)) (snd-display #__line__ ";set-frames 25000: ~A?" (frames id 0)))
+ (if (not (= (edit-position id 0) 1)) (snd-display #__line__ ";set-frames 25000 edit: ~A?" (edit-position id 0)))
(set! (frames id 0) 75000)
- (if (not (= (frames id 0) 75000)) (snd-display ";set-frames 75000: ~A?" (frames id 0)))
- (if (not (= (edit-position id 0) 2)) (snd-display ";set-frames 75000 edit: ~A?" (edit-position id 0)))
- (if (fneq (sample 30000 id 0) 0.0) (snd-display ";set-frames 75000 zeros: ~A?" (sample 30000 id 0)))
+ (if (not (= (frames id 0) 75000)) (snd-display #__line__ ";set-frames 75000: ~A?" (frames id 0)))
+ (if (not (= (edit-position id 0) 2)) (snd-display #__line__ ";set-frames 75000 edit: ~A?" (edit-position id 0)))
+ (if (fneq (sample 30000 id 0) 0.0) (snd-display #__line__ ";set-frames 75000 zeros: ~A?" (sample 30000 id 0)))
(set! (frames id 0) 0)
- (if (not (= (frames id 0) 0)) (snd-display ";set-frames 0: ~A?" (frames id 0)))
+ (if (not (= (frames id 0) 0)) (snd-display #__line__ ";set-frames 0: ~A?" (frames id 0)))
(set! (frames id 0) 100)
- (if (not (= (frames id 0) 100)) (snd-display ";set-frames 100: ~A?" (frames id 0)))
+ (if (not (= (frames id 0) 100)) (snd-display #__line__ ";set-frames 100: ~A?" (frames id 0)))
(revert-sound)
- (if (fneq (sample 30000 id 0) -0.0844) (snd-display ";revert from set-frames: ~A?" (sample 30000 id 0)))
- (if (not (= fr (frames id 0))) (snd-display ";revert set-frames: ~A != ~A?" (frames id 0) fr))
+ (if (fneq (sample 30000 id 0) -0.0844) (snd-display #__line__ ";revert from set-frames: ~A?" (sample 30000 id 0)))
+ (if (not (= fr (frames id 0))) (snd-display #__line__ ";revert set-frames: ~A != ~A?" (frames id 0) fr))
(set! (maxamp id 0) .5)
- (if (fneq (maxamp id 0) .5) (snd-display ";set-maxamp: ~A?" (maxamp id 0)))
- (if (not (= (edit-position id 0) 1)) (snd-display ";set-maxamp edit: ~A?" (edit-position id 0)))
+ (if (fneq (maxamp id 0) .5) (snd-display #__line__ ";set-maxamp: ~A?" (maxamp id 0)))
+ (if (not (= (edit-position id 0) 1)) (snd-display #__line__ ";set-maxamp edit: ~A?" (edit-position id 0)))
(set! (maxamp id 0) .1)
- (if (fneq (maxamp id 0) .1) (snd-display ";set-maxamp .1: ~A?" (maxamp id 0)))
- (if (not (= (edit-position id 0) 2)) (snd-display ";set-maxamp .1 edit: ~A?" (edit-position id 0)))
+ (if (fneq (maxamp id 0) .1) (snd-display #__line__ ";set-maxamp .1: ~A?" (maxamp id 0)))
+ (if (not (= (edit-position id 0) 2)) (snd-display #__line__ ";set-maxamp .1 edit: ~A?" (edit-position id 0)))
(revert-sound)
- (if (fneq (maxamp id 0) mx) (snd-display ";maxamp after set: ~A ~A?" (maxamp id 0) mx))
+ (if (fneq (maxamp id 0) mx) (snd-display #__line__ ";maxamp after set: ~A ~A?" (maxamp id 0) mx))
(set! (x-position-slider id 0) .1)
- (if (fneq (x-position-slider id 0) .1) (snd-display ";set x-position-slider .1: ~A?" (x-position-slider id 0)))
- ;(if (> (abs (- (left-sample id 0) 5083)) 3) (snd-display ";set x-position-slider sample 5083: ~A?" (left-sample id 0)))
+ (if (fneq (x-position-slider id 0) .1) (snd-display #__line__ ";set x-position-slider .1: ~A?" (x-position-slider id 0)))
+ ;(if (> (abs (- (left-sample id 0) 5083)) 3) (snd-display #__line__ ";set x-position-slider sample 5083: ~A?" (left-sample id 0)))
(set! (x-zoom-slider id 0) .5)
- (if (fneq (x-zoom-slider id 0) .5) (snd-display ";set x-zoom-slider: ~A?" (x-zoom-slider id 0)))
+ (if (fneq (x-zoom-slider id 0) .5) (snd-display #__line__ ";set x-zoom-slider: ~A?" (x-zoom-slider id 0)))
(if (> (abs (- fr (* 2 (- (right-sample id 0) (left-sample id 0))))) 10)
- (snd-display ";set x-zoom-slider: ~A ~A -> ~A?"
+ (snd-display #__line__ ";set x-zoom-slider: ~A ~A -> ~A?"
(left-sample id 0) (right-sample id 0)
(abs (- fr (* 2 (right-sample id 0) (left-sample id 0))))))
(set! (y-position-slider id 0) .1)
- (if (fneq (y-position-slider id 0) .1) (snd-display ";set y-position-slider .1: ~A?" (y-position-slider id 0)))
+ (if (fneq (y-position-slider id 0) .1) (snd-display #__line__ ";set y-position-slider .1: ~A?" (y-position-slider id 0)))
(set! (y-zoom-slider id 0) .5)
- (if (fneq (y-zoom-slider id 0) .5) (snd-display ";set y-zoom-slider: ~A?" (y-zoom-slider id 0)))
+ (if (fneq (y-zoom-slider id 0) .5) (snd-display #__line__ ";set y-zoom-slider: ~A?" (y-zoom-slider id 0)))
(let ((vals (channel-amp-envs "oboe.snd" 0 10)))
(if (not (equal? vals
(list (vct -4.8828125e-4 -0.104156494140625 -0.125213623046875 -0.1356201171875 -0.138916015625
-0.14093017578125 -0.14093017578125 -0.131439208984375 -0.11248779296875 -0.080047607421875)
(vct 0.0 0.10955810546875 0.130706787109375 0.14068603515625 0.141204833984375 0.147247314453125
0.145904541015625 0.140289306640625 0.126861572265625 0.08172607421875))))
- (snd-display ";channel-amp-envs: ~A?" vals)))
+ (snd-display #__line__ ";channel-amp-envs: ~A?" vals)))
(let ((len (length (channel-properties id 0))))
(if (channel-property 'hiho id 0)
- (snd-display ";channel-property 'hiho: ~A?" (channel-property 'hiho id 0)))
+ (snd-display #__line__ ";channel-property 'hiho: ~A?" (channel-property 'hiho id 0)))
(set! (channel-property 'hiho id 0) 123)
(if (not (= (channel-property 'hiho id 0) 123))
- (snd-display ";channel-property 'hiho (123): ~A?" (channel-property 'hiho id 0)))
+ (snd-display #__line__ ";channel-property 'hiho (123): ~A?" (channel-property 'hiho id 0)))
(if (channel-property 'hi id 0)
- (snd-display ";channel-property 'hi: ~A?" (channel-property 'hi id 0)))
+ (snd-display #__line__ ";channel-property 'hi: ~A?" (channel-property 'hi id 0)))
(set! (channel-property 'hi id 0) pi)
(if (fneq (channel-property 'hi id 0) pi)
- (snd-display ";channel-property 'hi (pi): ~A?" (channel-property 'hi id 0)))
+ (snd-display #__line__ ";channel-property 'hi (pi): ~A?" (channel-property 'hi id 0)))
(if (not (= (channel-property 'hiho id 0) 123))
- (snd-display ";channel-property '2nd hiho (123): ~A?" (channel-property 'hiho id 0)))
+ (snd-display #__line__ ";channel-property '2nd hiho (123): ~A?" (channel-property 'hiho id 0)))
(if (not (= (length (channel-properties id 0)) (+ len 2)))
- (snd-display ";channel-properties: ~A?" (channel-properties id 0))))
+ (snd-display #__line__ ";channel-properties: ~A?" (channel-properties id 0))))
(let ((len (length (sound-properties id))))
(if (sound-property 'hiho id)
- (snd-display ";sound-property 'hiho: ~A?" (sound-property 'hiho id)))
+ (snd-display #__line__ ";sound-property 'hiho: ~A?" (sound-property 'hiho id)))
(set! (sound-property 'hiho id) 123)
(if (not (= (sound-property 'hiho id) 123))
- (snd-display ";sound-property 'hiho (123): ~A?" (sound-property 'hiho id)))
+ (snd-display #__line__ ";sound-property 'hiho (123): ~A?" (sound-property 'hiho id)))
(if (sound-property 'hi id)
- (snd-display ";sound-property 'hi: ~A?" (sound-property 'hi id)))
+ (snd-display #__line__ ";sound-property 'hi: ~A?" (sound-property 'hi id)))
(set! (sound-property 'hi id) pi)
(if (fneq (sound-property 'hi id) pi)
- (snd-display ";sound-property 'hi (pi): ~A?" (sound-property 'hi id)))
+ (snd-display #__line__ ";sound-property 'hi (pi): ~A?" (sound-property 'hi id)))
(if (not (= (sound-property 'hiho id) 123))
- (snd-display ";sound-property '2nd hiho (123): ~A?" (sound-property 'hiho id)))
+ (snd-display #__line__ ";sound-property '2nd hiho (123): ~A?" (sound-property 'hiho id)))
(if (not (= (length (sound-properties id)) (+ len 2)))
- (snd-display ";sound-properties: ~A?" (sound-properties id))))
+ (snd-display #__line__ ";sound-properties: ~A?" (sound-properties id))))
(let ((tag (catch #t (lambda () (map-channel (lambda (y) "hiho"))) (lambda args args))))
- (if (not (eq? (car tag) 'bad-type)) (snd-display ";map-channel bad val: ~A" tag)))
+ (if (not (eq? (car tag) 'bad-type)) (snd-display #__line__ ";map-channel bad val: ~A" tag)))
(close-sound id))
-
+
(let ((ind (open-sound "oboe.snd")))
(if (not (equal? (edit-properties ind 0 0) '()))
- (snd-display ";initial edit-properties: ~A?" (edit-properties ind 0 0)))
+ (snd-display #__line__ ";initial edit-properties: ~A?" (edit-properties ind 0 0)))
(let ((tag (catch #t
(lambda () (edit-properties ind 0 123))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-edit))
- (snd-display ";edit-properties of non-existent edit: ~A" tag)))
+ (snd-display #__line__ ";edit-properties of non-existent edit: ~A" tag)))
(let ((tag (catch #t
(lambda () (edit-properties ind 1 0))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-channel))
- (snd-display ";edit-properties of non-existent channel: ~A" tag)))
+ (snd-display #__line__ ";edit-properties of non-existent channel: ~A" tag)))
(if (edit-property 'test-key ind 0 0)
- (snd-display ";edit-property never set: ~A?" (edit-property ind 0 0)))
+ (snd-display #__line__ ";edit-property never set: ~A?" (edit-property ind 0 0)))
(set! (edit-property 'test-key ind 0 0) 3210)
(let ((val (edit-property 'test-key ind 0 0)))
(if (or (not (number? val))
(not (= val 3210)))
- (snd-display ";edit-property 0: ~A" val)))
+ (snd-display #__line__ ";edit-property 0: ~A" val)))
(pad-channel 0 10 ind 0)
(let ((val (edit-property 'test-key ind 0 0)))
(if (or (not (number? val))
(not (= val 3210)))
- (snd-display ";edit-property look back to 0: ~A" val)))
+ (snd-display #__line__ ";edit-property look back to 0: ~A" val)))
(let ((val (edit-property 'test-key ind 0 1)))
- (if val (snd-display ";edit-property current: ~A ~A?" val val1)))
+ (if val (snd-display #__line__ ";edit-property current: ~A ~A?" val val1)))
(undo)
(let ((val (edit-property 'test-key ind 0 0)))
(if (or (not (number? val))
(not (= val 3210)))
- (snd-display ";edit-property go back to 0: ~A" val)))
+ (snd-display #__line__ ";edit-property go back to 0: ~A" val)))
(close-sound ind)
(set! ind (open-sound "oboe.snd"))
(if (edit-property 'test-key ind 0 0)
- (snd-display ";edit-property not cleared: ~A?" (edit-property ind 0 0)))
+ (snd-display #__line__ ";edit-property not cleared: ~A?" (edit-property ind 0 0)))
(pad-channel 0 10 ind 0)
(set! (edit-property 'test-key ind 0 1) 'hiho)
(undo)
(pad-channel 0 10 ind 0)
(let ((val (edit-property 'test-key ind 0 1)))
- (if val (snd-display ";edit-property not erased upon re-edit: ~A ~A?" val val1)))
+ (if val (snd-display #__line__ ";edit-property not erased upon re-edit: ~A ~A?" val val1)))
(close-sound ind))
-
+
(let ((id (open-sound "oboe.snd")))
(prefix-it 1000 id)
(key (char->integer #\x) 4 id)
(key (char->integer #\b) 4 id)
(let ((left (left-sample id)))
- (if (not (= left 0)) (snd-display ";u1000: ~A" left)))
+ (if (not (= left 0)) (snd-display #__line__ ";u1000: ~A" left)))
(prefix-it 0 id)
(key (char->integer #\x) 4 id)
(key (char->integer #\b) 4 id)
(let ((left (left-sample id)))
- (if (not (= left 0)) (snd-display ";u0: ~A" left)))
+ (if (not (= left 0)) (snd-display #__line__ ";u0: ~A" left)))
(set! (cursor id) 1234)
(prefix-it 0 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1234)) (snd-display ";0f: ~A" cr)))
+ (if (not (= cr 1234)) (snd-display #__line__ ";0f: ~A" cr)))
(prefix-it 100 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1334)) (snd-display ";100f: ~A" cr)))
+ (if (not (= cr 1334)) (snd-display #__line__ ";100f: ~A" cr)))
(prefix-it -100 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1234)) (snd-display ";-100f: ~A" cr)))
+ (if (not (= cr 1234)) (snd-display #__line__ ";-100f: ~A" cr)))
(prefix-it 1 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1235)) (snd-display ";1f: ~A" cr)))
+ (if (not (= cr 1235)) (snd-display #__line__ ";1f: ~A" cr)))
(prefix-it 1000 id)
(key (char->integer #\x) 4 id)
(key (char->integer #\p) 4 id)
(let ((left (left-sample id))
(right (right-sample id)))
- (if (> (abs (- right left 1000)) 2) (snd-display ";1000xp: ~A:~A" left right)))
+ (if (> (abs (- right left 1000)) 2) (snd-display #__line__ ";1000xp: ~A:~A" left right)))
(prefix-it 1 id)
(key (char->integer #\.) 0 id)
(key (char->integer #\2) 0 id)
@@ -33715,41 +33789,41 @@ EDITS: 2
(key (char->integer #\p) 4 id)
(let ((left (left-sample id))
(right (right-sample id)))
- (if (> (abs (- right left (* 22050 1.2))) 2) (snd-display ";1.2xp: ~A:~A" left right)))
+ (if (> (abs (- right left (* 22050 1.2))) 2) (snd-display #__line__ ";1.2xp: ~A:~A" left right)))
(prefix-uit 1000 id)
(key (char->integer #\x) 4 id)
(key (char->integer #\b) 4 id)
(let ((left (left-sample id)))
- (if (and (not (= left 1000)) (not (= left 1001))) (snd-display ";uu1000: ~A" left)))
+ (if (and (not (= left 1000)) (not (= left 1001))) (snd-display #__line__ ";uu1000: ~A" left)))
(prefix-uit 0 id)
(key (char->integer #\x) 4 id)
(key (char->integer #\b) 4 id)
(let ((left (left-sample id)))
- (if (not (= left 0)) (snd-display ";uu0: ~A" left)))
+ (if (not (= left 0)) (snd-display #__line__ ";uu0: ~A" left)))
(set! (cursor id) 1234)
(prefix-uit 0 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1234)) (snd-display ";u0f: ~A" cr)))
+ (if (not (= cr 1234)) (snd-display #__line__ ";u0f: ~A" cr)))
(prefix-uit 100 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1334)) (snd-display ";u100f: ~A" cr)))
+ (if (not (= cr 1334)) (snd-display #__line__ ";u100f: ~A" cr)))
(prefix-uit -100 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1234)) (snd-display ";u-100f: ~A" cr)))
+ (if (not (= cr 1234)) (snd-display #__line__ ";u-100f: ~A" cr)))
(prefix-uit 1 id)
(key (char->integer #\f) 4 id)
(let ((cr (cursor id)))
- (if (not (= cr 1235)) (snd-display ";u1f: ~A" cr)))
+ (if (not (= cr 1235)) (snd-display #__line__ ";u1f: ~A" cr)))
(prefix-uit 1000 id)
(key (char->integer #\x) 4 id)
(key (char->integer #\p) 4 id)
(let ((left (left-sample id))
(right (right-sample id)))
- (if (> (abs (- right left 1000)) 2) (snd-display ";u1000xp: ~A:~A" left right)))
+ (if (> (abs (- right left 1000)) 2) (snd-display #__line__ ";u1000xp: ~A:~A" left right)))
(prefix-uit 1 id)
(key (char->integer #\.) 0 id)
(key (char->integer #\2) 0 id)
@@ -33757,7 +33831,7 @@ EDITS: 2
(key (char->integer #\p) 4 id)
(let ((left (left-sample id))
(right (right-sample id)))
- (if (> (abs (- right left (* 22050 1.2))) 2) (snd-display ";u1.2xp: ~A:~A" left right)))
+ (if (> (abs (- right left (* 22050 1.2))) 2) (snd-display #__line__ ";u1.2xp: ~A:~A" left right)))
(close-sound id))
(let ((id (open-sound (car (match-sound-files (lambda (file)
(and (>= (mus-sound-chans file) 2)
@@ -33773,7 +33847,7 @@ EDITS: 2
(x1 (x-bounds id 1)))
(if (or (fneq (car x0) (car x1))
(fneq (cadr x0) (cadr x1)))
- (snd-display ";C-X v: ~A ~A?" x0 x1)))
+ (snd-display #__line__ ";C-X v: ~A ~A?" x0 x1)))
(key (char->integer #\u) 4 id)
(key (char->integer #\1) 0 id)
(key (char->integer #\x) 4 id)
@@ -33796,56 +33870,56 @@ EDITS: 2
(set! (time-graph-style snd3 #t) graph-filled)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-filled))
- (snd-display ";set time-graph-style ~A ~A: ~A" snd3 i (time-graph-style snd3 i))))
+ (snd-display #__line__ ";set time-graph-style ~A ~A: ~A" snd3 i (time-graph-style snd3 i))))
(set! (time-graph-style snd3 2) graph-lines)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (and (not (= i 2))
(not (= (time-graph-style snd3 i) graph-filled)))
- (snd-display ";set (2) time-graph-style ~A ~A: ~A" snd3 i (time-graph-style snd3 i))))
+ (snd-display #__line__ ";set (2) time-graph-style ~A ~A: ~A" snd3 i (time-graph-style snd3 i))))
(if (not (= (time-graph-style snd3 2) graph-lines))
- (snd-display ";set time-graph-style (2): ~A" (time-graph-style snd3 2)))
+ (snd-display #__line__ ";set time-graph-style (2): ~A" (time-graph-style snd3 2)))
(set! (time-graph-style snd3 #t) graph-dots)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots))
- (snd-display ";set time-graph-style (all): ~A" (time-graph-style snd3 i))))
+ (snd-display #__line__ ";set time-graph-style (all): ~A" (time-graph-style snd3 i))))
(set! (graph-style) graph-dots-and-lines)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots-and-lines))
- (snd-display ";set time-graph-style (dal): ~A" (time-graph-style snd3 i))))
+ (snd-display #__line__ ";set time-graph-style (dal): ~A" (time-graph-style snd3 i))))
(set! (lisp-graph-style snd3 #t) graph-filled)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (lisp-graph-style snd3 i) graph-filled))
- (snd-display ";set lisp-graph-style ~A ~A: ~A" snd3 i (lisp-graph-style snd3 i))))
+ (snd-display #__line__ ";set lisp-graph-style ~A ~A: ~A" snd3 i (lisp-graph-style snd3 i))))
(set! (lisp-graph-style snd3 2) graph-lines)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (and (not (= i 2))
(not (= (lisp-graph-style snd3 i) graph-filled)))
- (snd-display ";set (2) lisp-graph-style ~A ~A: ~A" snd3 i (lisp-graph-style snd3 i))))
+ (snd-display #__line__ ";set (2) lisp-graph-style ~A ~A: ~A" snd3 i (lisp-graph-style snd3 i))))
(if (not (= (lisp-graph-style snd3 2) graph-lines))
- (snd-display ";set lisp-graph-style (2): ~A" (lisp-graph-style snd3 2)))
+ (snd-display #__line__ ";set lisp-graph-style (2): ~A" (lisp-graph-style snd3 2)))
(set! (lisp-graph-style snd3 #t) graph-lines)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots-and-lines))
- (snd-display ";set lisp -> time-graph-style (dal): ~A" (time-graph-style snd3 i))))
+ (snd-display #__line__ ";set lisp -> time-graph-style (dal): ~A" (time-graph-style snd3 i))))
(set! (transform-graph-style snd3 #t) graph-filled)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (transform-graph-style snd3 i) graph-filled))
- (snd-display ";set transform-graph-style ~A ~A: ~A" snd3 i (transform-graph-style snd3 i))))
+ (snd-display #__line__ ";set transform-graph-style ~A ~A: ~A" snd3 i (transform-graph-style snd3 i))))
(set! (transform-graph-style snd3 2) graph-lines)
(do ((i 0 (+ 1 i))) ((= i 4))
(if (and (not (= i 2))
(not (= (transform-graph-style snd3 i) graph-filled)))
- (snd-display ";set (2) transform-graph-style ~A ~A: ~A" snd3 i (transform-graph-style snd3 i))))
+ (snd-display #__line__ ";set (2) transform-graph-style ~A ~A: ~A" snd3 i (transform-graph-style snd3 i))))
(if (not (= (transform-graph-style snd3 2) graph-lines))
- (snd-display ";set transform-graph-style (2): ~A" (transform-graph-style snd3 2)))
+ (snd-display #__line__ ";set transform-graph-style (2): ~A" (transform-graph-style snd3 2)))
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots-and-lines))
- (snd-display ";set fft and lisp -> time-graph-style (dal): ~A" (time-graph-style snd3 i))))
+ (snd-display #__line__ ";set fft and lisp -> time-graph-style (dal): ~A" (time-graph-style snd3 i))))
(do ((i 0 (+ 1 i))) ((= i 4))
(if (not (= (lisp-graph-style snd3 i) graph-lines))
- (snd-display ";set fft and lisp -> lisp-graph-style (dal): ~A" (lisp-graph-style snd3 i))))
+ (snd-display #__line__ ";set fft and lisp -> lisp-graph-style (dal): ~A" (lisp-graph-style snd3 i))))
(close-sound snd3))
@@ -33860,7 +33934,7 @@ EDITS: 2
(player (make-player ind 0))
(len (frames ind 0))
(incr (dac-size))
- (e (make-env '(0 0 1 1) :length (+ 1 (inexact->exact (floor (exact->inexact (/ len incr)))))))
+ (e (make-env '(0 0 1 1) :length (+ 1 (floor (exact->inexact (/ len incr))))))
(samp 0))
(add-player player 0 -1 -1
(lambda (reason)
@@ -33869,56 +33943,56 @@ EDITS: 2
(add-hook! play-hook
(lambda (fr)
(set! (amp-control player) (env e))
- (if (fneq (amp-control ind) 1.0) (snd-display ";amp-control snd: ~A" (amp-control ind)))
+ (if (fneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control snd: ~A" (amp-control ind)))
(if (> (abs (- (amp-control player) (exact->inexact (/ samp len)))) 1.0)
- (snd-display ";amp-control player: ~A ~A" (amp-control player) (exact->inexact (/ samp len))))
+ (snd-display #__line__ ";amp-control player: ~A ~A" (amp-control player) (exact->inexact (/ samp len))))
(set! samp (+ samp incr))))
(start-playing 1 (srate ind)))
- (if (find-sound "1a.snd") (snd-display ";stop proc didn't close?"))
+ (if (find-sound "1a.snd") (snd-display #__line__ ";stop proc didn't close?"))
(set! (with-background-processes) old-bp))
(let ((ind (open-sound "pistol.snd")))
(if (selection-member? ind 0)
- (snd-display ";initial selection-member? ~A ~A?"
+ (snd-display #__line__ ";initial selection-member? ~A ~A?"
(selection-member? ind 0)
(selection?)))
(set! (selection-member? ind 0) #t)
(if (or (not (selection-member? ind 0))
(not (selection-member? ind)))
- (snd-display ";selection-member? ~A ~A ~A?"
+ (snd-display #__line__ ";selection-member? ~A ~A ~A?"
(selection-member? ind 0)
(selection-member? ind)
(selection?)))
(if (not (= (selection-frames) 1))
- (snd-display ";initial selection-frames: ~A?" (selection-frames)))
+ (snd-display #__line__ ";initial selection-frames: ~A?" (selection-frames)))
(set! (selection-frames) 1200)
(if (not (= (selection-frames) 1200))
- (snd-display ";selection-frames: 1200 ~A?" (selection-frames)))
+ (snd-display #__line__ ";selection-frames: 1200 ~A?" (selection-frames)))
(delete-selection)
- (if (selection?) (snd-display ";selection active after cut?"))
+ (if (selection?) (snd-display #__line__ ";selection active after cut?"))
(undo)
- (if (not (selection?)) (snd-display ";selection inactive after undo?"))
+ (if (not (selection?)) (snd-display #__line__ ";selection inactive after undo?"))
(if (or (not (selection-member? ind 0))
(not (selection-member? ind)))
- (snd-display ";selection-member? after undo ~A ~A ~A?"
+ (snd-display #__line__ ";selection-member? after undo ~A ~A ~A?"
(selection-member? ind 0)
(selection-member? ind)
(selection?)))
(if (or (not (= (selection-frames) 1200))
(not (= (selection-position) 0)))
- (snd-display ";selection after undo: '(0 1200) '(~A ~A)?"
+ (snd-display #__line__ ";selection after undo: '(0 1200) '(~A ~A)?"
(selection-position)
(selection-frames)))
(set! (selection-position) 1000)
(if (or (not (= (selection-frames) 200))
(not (= (selection-position) 1000)))
- (snd-display ";selection after reposition: '(1000 200) '(~A ~A)?"
+ (snd-display #__line__ ";selection after reposition: '(1000 200) '(~A ~A)?"
(selection-position)
(selection-frames)))
(reverse-selection)
(if (or (not (= (selection-frames) 200))
(not (= (selection-position) 1000)))
- (snd-display ";selection after reverse: '(1000 200) '(~A ~A)?"
+ (snd-display #__line__ ";selection after reverse: '(1000 200) '(~A ~A)?"
(selection-position)
(selection-frames)))
@@ -33926,14 +34000,14 @@ EDITS: 2
(src-selection .5)
(if (or (> (abs (- (frames ind) (+ 200 old-frames))) 5)
(> (abs (- (selection-frames) 400)) 5))
- (snd-display ";selection after src .5: '(1000 400) '(~A ~A)?"
+ (snd-display #__line__ ";selection after src .5: '(1000 400) '(~A ~A)?"
(selection-position)
(selection-frames)))
(undo)
(redo)
(if (or (> (abs (- (frames ind) (+ 200 old-frames))) 5)
(> (abs (- (selection-frames) 400)) 5))
- (snd-display ";selection after src .5 with undo/redo: '(1000 400) '(~A ~A)?"
+ (snd-display #__line__ ";selection after src .5 with undo/redo: '(1000 400) '(~A ~A)?"
(selection-position)
(selection-frames)))
(undo 3))
@@ -33952,7 +34026,7 @@ EDITS: 2
(fneq (src-duration '(0 2 1 1)) (src-duration '(0 1 1 2)))
(fneq (src-duration '(0 1 .5 2)) (src-duration '(0 1 1 2)))
(fneq (src-duration '(.5 1 .75 2)) (src-duration '(0 1 1 2))))
- (snd-display ";src-duration test1 ~A ~A ~A ~A"
+ (snd-display #__line__ ";src-duration test1 ~A ~A ~A ~A"
(src-duration '(0 1 1 2))
(src-duration '(0 2 1 1))
(src-duration '(0 1 .5 2))
@@ -33961,59 +34035,59 @@ EDITS: 2
(fneq (src-duration '(0 0.5 1 1)) (src-duration '(0 1 1 0.5)))
(fneq (src-duration '(0 1 .5 0.5)) (src-duration '(0 1 1 0.5)))
(fneq (src-duration '(.5 1 .75 0.5)) (src-duration '(0 1 1 0.5))))
- (snd-display ";src-duration test2 ~A ~A ~A ~A"
+ (snd-display #__line__ ";src-duration test2 ~A ~A ~A ~A"
(src-duration '(0 1 1 0.5))
(src-duration '(0 0.5 1 1))
(src-duration '(0 1 .5 0.5))
(src-duration '(.5 1 .75 0.5))))
(if (or (fneq (src-duration '(0 1 1 1)) 1.0)
(fneq (src-duration '(0 2 1 2)) 0.5))
- (snd-display ";src-duration test3: ~A ~A" (src-duration '(0 1 1 1)) (src-duration '(0 2 1 2))))
+ (snd-display #__line__ ";src-duration test3: ~A ~A" (src-duration '(0 1 1 1)) (src-duration '(0 2 1 2))))
(if (fneq (src-duration '(0 .5 .5 3 .6 1 .7 .1 .8 1.5 1 1)) 1.02474349685432)
- (snd-display ";src-duration test4 ~A" (src-duration '(0 .5 .5 3 .6 1 .7 .1 .8 1.5 1 1))))
+ (snd-display #__line__ ";src-duration test4 ~A" (src-duration '(0 .5 .5 3 .6 1 .7 .1 .8 1.5 1 1))))
(if (fneq (src-duration '(0 1 1 2 2 1)) 0.693147180559945)
- (snd-display ";src-duration test5: ~A" (src-duration '(0 1 1 2 2 1))))
+ (snd-display #__line__ ";src-duration test5: ~A" (src-duration '(0 1 1 2 2 1))))
(if (fneq (src-duration '(0 1 1 1)) 1.0)
- (snd-display ";src-duration test6: ~A" (src-duration '(0 1 1 1))))
+ (snd-display #__line__ ";src-duration test6: ~A" (src-duration '(0 1 1 1))))
(if (fneq (src-duration '(0 2 1 2)) 0.5)
- (snd-display ";src-duration test7: ~A" (src-duration '(0 2 1 2))))
+ (snd-display #__line__ ";src-duration test7: ~A" (src-duration '(0 2 1 2))))
(if (fneq (src-duration '(0 0.5 2 0.5)) 2.0)
- (snd-display ";src-duration test8: ~A" (src-duration '(0 0.5 2 0.5))))
-
+ (snd-display #__line__ ";src-duration test8: ~A" (src-duration '(0 0.5 2 0.5))))
+
(if (fneq (src-duration (src-fit-envelope '(0 1 1 2) 2.0)) 2.0)
- (snd-display ";src-fit-envelope 2.0: ~A" (src-duration (src-fit-envelope '(0 1 1 2) 2.0))))
+ (snd-display #__line__ ";src-fit-envelope 2.0: ~A" (src-duration (src-fit-envelope '(0 1 1 2) 2.0))))
(if (fneq (src-duration (src-fit-envelope '(0 1 1 2) 0.5)) 0.5)
- (snd-display ";src-fit-envelope 0.5: ~A" (src-duration (src-fit-envelope '(0 1 1 2) 0.5))))
-
-
+ (snd-display #__line__ ";src-fit-envelope 0.5: ~A" (src-duration (src-fit-envelope '(0 1 1 2) 0.5))))
+
+
(if (fneq (fm-parallel-component 100 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t) 0.69287)
- (snd-display ";fm-parallel-component 100: ~A" (fm-parallel-component 100 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t)))
+ (snd-display #__line__ ";fm-parallel-component 100: ~A" (fm-parallel-component 100 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t)))
(if (fneq (fm-parallel-component 500 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t) 0.17047)
- (snd-display ";fm-parallel-component 500: ~A" (fm-parallel-component 500 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t)))
-
+ (snd-display #__line__ ";fm-parallel-component 500: ~A" (fm-parallel-component 500 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t)))
+
(if (fneq (cheby-hka 3 0.25 (vct 0 0 0 0 1.0 1.0)) -0.0732421875)
- (snd-display ";cheby-hka 0: ~A" (cheby-hka 3 0.25 (vct 0 0 0 0 1.0 1.0))))
+ (snd-display #__line__ ";cheby-hka 0: ~A" (cheby-hka 3 0.25 (vct 0 0 0 0 1.0 1.0))))
(if (fneq (cheby-hka 2 0.25 (vct 0 0 0 0 1.0 1.0)) -0.234375)
- (snd-display ";cheby-hka 1: ~A" (cheby-hka 2 0.25 (vct 0 0 0 0 1.0 1.0))))
+ (snd-display #__line__ ";cheby-hka 1: ~A" (cheby-hka 2 0.25 (vct 0 0 0 0 1.0 1.0))))
(if (fneq (cheby-hka 1 0.25 (vct 0 0 0 0 1.0 1.0)) 1.025390625)
- (snd-display ";cheby-hka 2: ~A" (cheby-hka 1 0.25 (vct 0 0 0 0 1.0 1.0))))
+ (snd-display #__line__ ";cheby-hka 2: ~A" (cheby-hka 1 0.25 (vct 0 0 0 0 1.0 1.0))))
(if (fneq (cheby-hka 0 0.25 (vct 0 0 0 0 1.0 1.0)) 1.5234375)
- (snd-display ";cheby-hka 3: ~A" (cheby-hka 0 0.25 (vct 0 0 0 0 1.0 1.0)) 1.5234375))
-
-
+ (snd-display #__line__ ";cheby-hka 3: ~A" (cheby-hka 0 0.25 (vct 0 0 0 0 1.0 1.0)) 1.5234375))
+
+
(map-channel (lambda (y) (* .5 (oscil osc))))
(let ((vals (freq-peak 0 ind 8192)))
(if (or (f4neq (car vals) 500.0)
(fneq (cadr vals) 1.0))
- (snd-display ";src no-test: ~A" vals)))
+ (snd-display #__line__ ";src no-test: ~A" vals)))
(for-each
(lambda (sr dur)
(src-sound sr 1.0 ind 0)
- (if (fneq (/ (frames ind 0) 10000.0) dur) (snd-display ";src-sound ~A: ~A (~A)" sr (/ (frames ind 0) 10000.0) dur))
+ (if (fneq (/ (frames ind 0) 10000.0) dur) (snd-display #__line__ ";src-sound ~A: ~A (~A)" sr (/ (frames ind 0) 10000.0) dur))
(let ((vals (freq-peak 0 ind 8192)))
(if (or (f4neq (car vals) (* 500 sr))
(fneq (cadr vals) 1.0))
- (snd-display ";src ~A freq: ~A" sr vals)))
+ (snd-display #__line__ ";src ~A freq: ~A" sr vals)))
(undo))
(list 2.0 0.5 5.0 0.2)
(list 0.5 2.0 0.2 5.0))
@@ -34021,14 +34095,14 @@ EDITS: 2
(lambda (e f0 f1)
(src-sound e 1.0 ind 0)
(if (fneq (/ (frames ind 0) 10000.0) (src-duration e))
- (snd-display ";src-sound (env) ~A: ~A (~A)"
+ (snd-display #__line__ ";src-sound (env) ~A: ~A (~A)"
e (/ (frames ind 0) 10000.0) (src-duration e)))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) f0)
- (snd-display ";src (env) 0 ~A freq: ~A" f0 vals)))
- (let ((vals (freq-peak (- (inexact->exact (floor (* (src-duration e) 10000.0))) 256) ind 256)))
+ (snd-display #__line__ ";src (env) 0 ~A freq: ~A" f0 vals)))
+ (let ((vals (freq-peak (- (floor (* (src-duration e) 10000.0)) 256) ind 256)))
(if (f5neq (car vals) f1)
- (snd-display ";src (env) 1 ~A freq: ~A" f1 vals)))
+ (snd-display #__line__ ";src (env) 1 ~A freq: ~A" f1 vals)))
(undo))
(list (list 0 1 1 2) (list 0 2 1 1) (list 0 1 1 2 2 1) (list 0 .5 1 1) (list 0 .5 1 2))
(list 500.0 1000.0 500.0 250.0 250.0)
@@ -34037,14 +34111,14 @@ EDITS: 2
(lambda (e f0 f1)
(src-sound (make-env e :length (frames)) 1.0 ind 0)
(if (fneq (/ (frames ind 0) 10000.0) (src-duration e))
- (snd-display ";src-sound (make-env) ~A: ~A (~A)"
+ (snd-display #__line__ ";src-sound (make-env) ~A: ~A (~A)"
e (/ (frames ind 0) 10000.0) (src-duration e)))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) f0)
- (snd-display ";src (make-env) 0 ~A freq: ~A" f0 vals)))
- (let ((vals (freq-peak (- (inexact->exact (floor (* (src-duration e) 10000.0))) 256) ind 256)))
+ (snd-display #__line__ ";src (make-env) 0 ~A freq: ~A" f0 vals)))
+ (let ((vals (freq-peak (- (floor (* (src-duration e) 10000.0)) 256) ind 256)))
(if (f5neq (car vals) f1)
- (snd-display ";src (env) 1 ~A freq: ~A" f1 vals)))
+ (snd-display #__line__ ";src (env) 1 ~A freq: ~A" f1 vals)))
(undo))
(list (list 0 1 1 2) (list 0 2 1 1) (list 0 1 1 2 2 1) (list 0 .5 1 1) (list 0 .5 1 2))
(list 500.0 1000.0 500.0 250.0 250.0)
@@ -34053,11 +34127,11 @@ EDITS: 2
(for-each
(lambda (sr dur)
(src-channel sr)
- (if (fneq (/ (frames ind 0) 10000.0) dur) (snd-display ";src-channel ~A: ~A (~A)" sr (/ (frames ind 0) 10000.0) dur))
+ (if (fneq (/ (frames ind 0) 10000.0) dur) (snd-display #__line__ ";src-channel ~A: ~A (~A)" sr (/ (frames ind 0) 10000.0) dur))
(let ((vals (freq-peak 0 ind 8192)))
(if (or (f4neq (car vals) (* 500 sr))
(fneq (cadr vals) 1.0))
- (snd-display ";src ~A freq: ~A" sr vals)))
+ (snd-display #__line__ ";src ~A freq: ~A" sr vals)))
(undo))
(list 2.0 0.5 5.0 0.2)
(list 0.5 2.0 0.2 5.0))
@@ -34065,14 +34139,14 @@ EDITS: 2
(lambda (e f0 f1)
(src-channel e)
(if (fneq (/ (frames ind 0) 10000.0) (src-duration e))
- (snd-display ";src-channel (env) ~A: ~A (~A)"
+ (snd-display #__line__ ";src-channel (env) ~A: ~A (~A)"
e (/ (frames ind 0) 10000.0) (src-duration e)))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) f0)
- (snd-display ";src-channel (env f0) ~A: ~A" f0 vals)))
- (let ((vals (freq-peak (- (inexact->exact (floor (* (src-duration e) 10000.0))) 256) ind 256)))
+ (snd-display #__line__ ";src-channel (env f0) ~A: ~A" f0 vals)))
+ (let ((vals (freq-peak (- (floor (* (src-duration e) 10000.0)) 256) ind 256)))
(if (f5neq (car vals) f1)
- (snd-display ";src-channel (env f1) ~A: ~A" f1 vals)))
+ (snd-display #__line__ ";src-channel (env f1) ~A: ~A" f1 vals)))
(undo))
(list (list 0 1 1 2) (list 0 2 1 1) (list 0 1 1 2 2 1) (list 0 .5 1 1) (list 0 .5 1 2))
(list 500.0 1000.0 500.0 250.0 250.0)
@@ -34082,16 +34156,16 @@ EDITS: 2
(lambda (sr dur)
(src-channel sr 1000 2500)
(if (f4neq (frames ind 0) (+ 7500 (* dur 2500)))
- (snd-display ";src-channel section: ~A ~A" (frames) (+ 7500 (* dur 2500))))
+ (snd-display #__line__ ";src-channel section: ~A ~A" (frames) (+ 7500 (* dur 2500))))
(let ((vals (freq-peak 0 ind 512)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-channel section 0 ~A freq: ~A" sr vals)))
- (let ((vals (freq-peak (- (+ 7500 (inexact->exact (floor (* dur 2500)))) 512) ind 512)))
+ (snd-display #__line__ ";src-channel section 0 ~A freq: ~A" sr vals)))
+ (let ((vals (freq-peak (- (+ 7500 (floor (* dur 2500))) 512) ind 512)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-channel section 8000 ~A freq: ~A" sr vals)))
+ (snd-display #__line__ ";src-channel section 8000 ~A freq: ~A" sr vals)))
(let ((vals (freq-peak 1000 ind 512)))
(if (f5neq (car vals) (* sr 500.0))
- (snd-display ";src-channel section ~A freq: ~A" sr vals)))
+ (snd-display #__line__ ";src-channel section ~A freq: ~A" sr vals)))
(undo))
(list 2.0 0.5 5.0 0.2)
(list 0.5 2.0 0.2 5.0))
@@ -34100,14 +34174,14 @@ EDITS: 2
(lambda (e)
(src-channel (make-env e :length 2500) 1000 2500)
(if (f3neq (frames ind 0) (+ 7500 (* (src-duration e) 2500)))
- (snd-display ";src-channel section (make-env duration) ~A: ~A (~A ~A)"
+ (snd-display #__line__ ";src-channel section (make-env duration) ~A: ~A (~A ~A)"
e (src-duration e) (frames) (+ 7500 (* (src-duration e) 2500))))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-channel section (make-env e) ~A: ~A" e vals)))
- (let ((vals (freq-peak (- (+ 7500 (inexact->exact (floor (* (src-duration e) 2500)))) 256) ind 256)))
+ (snd-display #__line__ ";src-channel section (make-env e) ~A: ~A" e vals)))
+ (let ((vals (freq-peak (- (+ 7500 (floor (* (src-duration e) 2500))) 256) ind 256)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-channel section (make-env e) ~A: ~A" e vals)))
+ (snd-display #__line__ ";src-channel section (make-env e) ~A: ~A" e vals)))
(undo))
(list (list 0 1 1 2) (list 0 2 1 1) (list 0 1 1 2 2 1) (list 0 .5 1 1) (list 0 .5 1 2)))
@@ -34116,16 +34190,16 @@ EDITS: 2
(lambda (sr dur)
(src-selection sr)
(if (f3neq (frames ind 0) (+ 7500 (* dur 2500)))
- (snd-display ";src-selection section: ~A ~A" (frames) (+ 7500 (* dur 2500))))
+ (snd-display #__line__ ";src-selection section: ~A ~A" (frames) (+ 7500 (* dur 2500))))
(let ((vals (freq-peak 0 ind 512)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-selection section 0 ~A freq: ~A" sr vals)))
- (let ((vals (freq-peak (- (+ 7500 (inexact->exact (floor (* dur 2500)))) 512) ind 512)))
+ (snd-display #__line__ ";src-selection section 0 ~A freq: ~A" sr vals)))
+ (let ((vals (freq-peak (- (+ 7500 (floor (* dur 2500))) 512) ind 512)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-selection section 8000 ~A freq: ~A" sr vals)))
+ (snd-display #__line__ ";src-selection section 8000 ~A freq: ~A" sr vals)))
(let ((vals (freq-peak 1000 ind 512)))
(if (f5neq (car vals) (* sr 500.0))
- (snd-display ";src-selection section ~A freq: ~A" sr vals)))
+ (snd-display #__line__ ";src-selection section ~A freq: ~A" sr vals)))
(undo))
(list 2.0 0.5 5.0 0.2)
(list 0.5 2.0 0.2 5.0))
@@ -34134,14 +34208,14 @@ EDITS: 2
(lambda (e)
(src-selection (make-env e :length 2500))
(if (f3neq (frames ind 0) (+ 7500 (* (src-duration e) 2500)))
- (snd-display ";src-selection section (make-env duration) ~A: ~A (~A ~A)"
+ (snd-display #__line__ ";src-selection section (make-env duration) ~A: ~A (~A ~A)"
e (src-duration e) (frames) (+ 7500 (* (src-duration e) 2500))))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-selection section (make-env e) ~A: ~A" e vals)))
- (let ((vals (freq-peak (- (+ 7500 (inexact->exact (floor (* (src-duration e) 2500)))) 256) ind 256)))
+ (snd-display #__line__ ";src-selection section (make-env e) ~A: ~A" e vals)))
+ (let ((vals (freq-peak (- (+ 7500 (floor (* (src-duration e) 2500))) 256) ind 256)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-selection section (make-env e) ~A: ~A" e vals)))
+ (snd-display #__line__ ";src-selection section (make-env e) ~A: ~A" e vals)))
(undo))
(list (list 0 1 1 2) (list 0 2 1 1) (list 0 1 1 2 2 1) (list 0 .5 1 1) (list 0 .5 1 2)))
@@ -34149,14 +34223,14 @@ EDITS: 2
(lambda (e)
(src-selection e)
(if (f3neq (frames ind 0) (+ 7500 (* (src-duration e) 2500)))
- (snd-display ";src-selection section (env duration) ~A: ~A (~A ~A)"
+ (snd-display #__line__ ";src-selection section (env duration) ~A: ~A (~A ~A)"
e (src-duration e) (frames) (+ 7500 (* (src-duration e) 2500))))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-selection section (env e) ~A: ~A" e vals)))
- (let ((vals (freq-peak (- (+ 7500 (inexact->exact (floor (* (src-duration e) 2500)))) 256) ind 256)))
+ (snd-display #__line__ ";src-selection section (env e) ~A: ~A" e vals)))
+ (let ((vals (freq-peak (- (+ 7500 (floor (* (src-duration e) 2500))) 256) ind 256)))
(if (f5neq (car vals) 500.0)
- (snd-display ";src-selection section (env f1) ~A: ~A" e vals)))
+ (snd-display #__line__ ";src-selection section (env f1) ~A: ~A" e vals)))
(undo))
(list (list 0 1 1 2) (list 0 2 1 1) (list 0 1 1 2 2 1) (list 0 .5 1 1) (list 0 .5 1 2)))
@@ -34172,7 +34246,7 @@ EDITS: 2
(set! (sample 10 ind) 1.0)
(smooth-selection)
(if (not (vequal (vct-subseq (samples->vct 0 11 ind) 0 9) (vct-subseq (smoother 0.0 1.0 10) 0 9)))
- (snd-display ";smooth-selection: ~A ~A?" (samples->vct 0 11 ind) (smoother 0.0 1.0 10)))
+ (snd-display #__line__ ";smooth-selection: ~A ~A?" (samples->vct 0 11 ind) (smoother 0.0 1.0 10)))
(revert-sound)
(do ((i 0 (+ 1 i)))
((= i 10))
@@ -34181,7 +34255,7 @@ EDITS: 2
(set! (sample 10 ind) 0.0)
(smooth-selection)
(if (not (vequal (vct-subseq (samples->vct 0 11 ind) 0 9) (vct-subseq (smoother 1.0 0.0 10) 0 9)))
- (snd-display ";smooth-selection back: ~A ~A?" (samples->vct 0 11 ind) (smoother 1.0 0.0 10)))
+ (snd-display #__line__ ";smooth-selection back: ~A ~A?" (samples->vct 0 11 ind) (smoother 1.0 0.0 10)))
(close-sound ind))
(let ((ind (new-sound "hi.snd")))
@@ -34191,7 +34265,7 @@ EDITS: 2
(set! (sample 10 ind) 1.0)
(smooth-sound 0 10 ind)
(if (not (vequal (vct-subseq (samples->vct 0 11 ind) 0 9) (vct-subseq (smoother 0.0 1.0 10) 0 9)))
- (snd-display ";smooth-sound: ~A ~A?" (samples->vct 0 11 ind) (smoother 0.0 1.0 10)))
+ (snd-display #__line__ ";smooth-sound: ~A ~A?" (samples->vct 0 11 ind) (smoother 0.0 1.0 10)))
(revert-sound)
(do ((i 0 (+ 1 i)))
((= i 10))
@@ -34199,7 +34273,7 @@ EDITS: 2
(set! (sample 10 ind) 0.0)
(smooth-sound 0 10 ind)
(if (not (vequal (vct-subseq (samples->vct 0 11 ind) 0 9) (vct-subseq (smoother 1.0 0.0 10) 0 9)))
- (snd-display ";smooth-sound back: ~A ~A?" (samples->vct 0 11 ind) (smoother 1.0 0.0 10)))
+ (snd-display #__line__ ";smooth-sound back: ~A ~A?" (samples->vct 0 11 ind) (smoother 1.0 0.0 10)))
(close-sound ind))
(if (file-exists? "hi.snd") (delete-file "hi.snd"))
@@ -34212,14 +34286,14 @@ EDITS: 2
(key (char->integer #\0) 0 ind)
(key (char->integer #\o) 4 ind)
(if (not (= (frames ind) (+ 100 len)))
- (snd-display ";C-o len: ~A? " (frames)))
+ (snd-display #__line__ ";C-o len: ~A? " (frames)))
(if with-gui
(let ((reader (make-sampler 1200 ind)))
(do ((i 0 (+ 1 i)))
((= i 100))
(let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display ";C-o[~D]: ~A?" i val))))
- (if (not (= (sampler-position reader) 1300)) (snd-display ";reader pos: ~A" (sampler-position reader)))
+ (if (fneq val 0.0) (snd-display #__line__ ";C-o[~D]: ~A?" i val))))
+ (if (not (= (sampler-position reader) 1300)) (snd-display #__line__ ";reader pos: ~A" (sampler-position reader)))
(free-sampler reader)))
(revert-sound ind)
(set! (cursor ind) 1200)
@@ -34229,13 +34303,13 @@ EDITS: 2
(key (char->integer #\0) 0 ind)
(key (char->integer #\z) 4 ind)
(if (not (= (frames ind) len))
- (snd-display ";C-z len: ~A? " (frames)))
+ (snd-display #__line__ ";C-z len: ~A? " (frames)))
(if with-gui
(let ((reader (make-sampler 1200 ind)))
(do ((i 0 (+ 1 i)))
((= i 100))
(let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display ";C-z[~D]: ~A?" i val))))
+ (if (fneq val 0.0) (snd-display #__line__ ";C-z[~D]: ~A?" i val))))
(free-sampler reader)))
(set! (cursor ind) 0)
(key (char->integer #\u) 4 ind)
@@ -34243,7 +34317,7 @@ EDITS: 2
(key (char->integer #\.) 0 ind)
(key (char->integer #\0) 0 ind)
(key (char->integer #\z) 4 ind)
- (if (fneq (maxamp ind 0) 0.0) (snd-display ";C-z full: ~A" (maxamp)))
+ (if (fneq (maxamp ind 0) 0.0) (snd-display #__line__ ";C-z full: ~A" (maxamp)))
(revert-sound ind)
(set! (cursor ind) 1200)
(key (char->integer #\u) 4 ind)
@@ -34252,13 +34326,13 @@ EDITS: 2
(key (char->integer #\0) 0 ind)
(key (char->integer #\o) 4 ind)
(if (not (= (frames ind) (+ (srate ind) len)))
- (snd-display ";C-o 1.0 len: ~A? " (frames)))
+ (snd-display #__line__ ";C-o 1.0 len: ~A? " (frames)))
(if with-gui
(let ((reader (make-sampler 1200 ind)))
(do ((i 0 (+ 1 i)))
((= i (srate ind)))
(let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display ";C-o 1.0[~D]: ~A?" i val))))
+ (if (fneq val 0.0) (snd-display #__line__ ";C-o 1.0[~D]: ~A?" i val))))
(free-sampler reader)))
(revert-sound ind)
(set! (cursor ind) 1200)
@@ -34268,13 +34342,13 @@ EDITS: 2
(key (char->integer #\0) 0 ind)
(key (char->integer #\z) 4 ind)
(if (not (= (frames ind) len))
- (snd-display ";C-z 1.0 len: ~A? " (frames)))
+ (snd-display #__line__ ";C-z 1.0 len: ~A? " (frames)))
(if with-gui
(let ((reader (make-sampler 1200 ind)))
(do ((i 0 (+ 1 i)))
((= i (srate ind)))
(let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display ";C-z 1.0[~D]: ~A?" i val))))
+ (if (fneq val 0.0) (snd-display #__line__ ";C-z 1.0[~D]: ~A?" i val))))
(free-sampler reader)))
(close-sound ind))
@@ -34289,7 +34363,7 @@ EDITS: 2
(not (= (selection-position ind 1) 0))
(not (= (selection-frames ind 0) (frames ind 0)))
(not (= (selection-frames ind 1) (frames ind 1))))
- (snd-display ";sync selection via <-: ~A ~A ~A ~A ~A ~A"
+ (snd-display #__line__ ";sync selection via <-: ~A ~A ~A ~A ~A ~A"
(selection-member? ind 0) (selection-member? ind 1)
(selection-position ind 0) (selection-position ind 1)
(selection-frames ind 0) (selection-frames ind 1)))
@@ -34301,35 +34375,35 @@ EDITS: 2
(not (= (selection-position ind 1) 0))
(not (= (selection-frames ind 0) (frames ind 0)))
(not (= (selection-frames ind 1) (frames ind 1))))
- (snd-display ";sync selection via ->: ~A ~A ~A ~A ~A ~A"
+ (snd-display #__line__ ";sync selection via ->: ~A ~A ~A ~A ~A ~A"
(selection-member? ind 0) (selection-member? ind 1)
(selection-position ind 0) (selection-position ind 1)
(selection-frames ind 0) (selection-frames ind 1)))
(set! (cursor ind 1) 0)
(set! (cursor ind 0) 1000)
- (if (not (= (cursor ind 1) 1000)) (snd-display ";syncd cursors: ~A ~A" (cursor ind 0) (cursor ind 1)))
+ (if (not (= (cursor ind 1) 1000)) (snd-display #__line__ ";syncd cursors: ~A ~A" (cursor ind 0) (cursor ind 1)))
(close-sound ind))
(let ((ind (open-sound "2a.snd")))
(let ((reg (make-region 100 200 ind #t)))
(if (not (= (region-chans reg) 2))
- (snd-display ";make-region #t for chan in 2a.snd: ~A chans" (region-chans reg)))
+ (snd-display #__line__ ";make-region #t for chan in 2a.snd: ~A chans" (region-chans reg)))
(let ((id (mix-region reg 1000)))
(if (or (not (= (edit-position ind 0) 1))
(not (= (edit-position ind 1) 0)))
- (snd-display ";mix-region default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-region default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(undo)
(set! (sync ind) 1)
(set! id (mix-region reg 1000))
(if (or (not (= (edit-position ind 0) 1))
(not (= (edit-position ind 1) 1)))
- (snd-display ";mix-region sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-region sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(undo)
(set! (sync ind) 0)
(set! id (mix-region reg 1000 ind 1))
(if (or (not (= (edit-position ind 0) 0))
(not (= (edit-position ind 1) 1)))
- (snd-display ";mix-region mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-region mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(revert-sound ind)))
(set! (selection-member? #t #t) #f)
@@ -34340,27 +34414,27 @@ EDITS: 2
(set! (selection-frames ind 0) 100)
(set! (selection-frames ind 1) 100)
(if (not (= (selection-chans) 2))
- (snd-display ";laboriously make 2 chan selection: ~A" (selection-chans)))
+ (snd-display #__line__ ";laboriously make 2 chan selection: ~A" (selection-chans)))
(let ((id (mix-selection 100)))
(if (or (not (= (edit-position ind 0) 1))
(not (= (edit-position ind 1) 0)))
- (snd-display ";mix-selection default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-selection default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(undo)
(set! (sync ind) 1)
(set! id (mix-selection 100))
(if (or (not (= (edit-position ind 0) 1))
(not (= (edit-position ind 1) 1)))
- (snd-display ";mix-selection sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-selection sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(undo)
(set! (sync ind) 0)
(set! id (mix-selection 100 ind 1))
(if (or (not (= (edit-position ind 0) 0))
(not (= (edit-position ind 1) 1)))
- (snd-display ";mix-selection mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-selection mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(close-sound ind)))
-
+
(let ((ind (open-sound "oboe.snd")))
(test-selection ind 1200 100 2.0)
(test-selection ind 600 1200 2.0)
@@ -34376,28 +34450,28 @@ EDITS: 2
(revert-sound ind)
(make-selection 1200 1200)
- (if (not (selection?)) (snd-display ";no selection from 1 samp region?"))
- (if (not (= (selection-frames) 1)) (snd-display ";1 samp selection: ~A samps?" (selection-frames)))
+ (if (not (selection?)) (snd-display #__line__ ";no selection from 1 samp region?"))
+ (if (not (= (selection-frames) 1)) (snd-display #__line__ ";1 samp selection: ~A samps?" (selection-frames)))
(scale-selection-to 1.0)
- (if (fneq (sample 1200 ind 0) 1.0) (snd-display ";scale 1 samp selection: ~A?" (sample 1200 ind 0)))
+ (if (fneq (sample 1200 ind 0) 1.0) (snd-display #__line__ ";scale 1 samp selection: ~A?" (sample 1200 ind 0)))
(revert-sound ind)
(let ((id (make-region 500 1000)))
(src-selection .5)
- (if (> (abs (- (region-frames id) 500)) 1) (snd-display ";region-frames after src-selection: ~A?" (region-frames id)))
+ (if (> (abs (- (region-frames id) 500)) 1) (snd-display #__line__ ";region-frames after src-selection: ~A?" (region-frames id)))
(let ((reg-mix-id (car (mix-region id 1500 ind 0))))
(if (not (= (mix-length reg-mix-id) (region-frames id)))
- (snd-display ";mix-region: ~A != ~A?" (region-frames id) (mix-length reg-mix-id)))
+ (snd-display #__line__ ";mix-region: ~A != ~A?" (region-frames id) (mix-length reg-mix-id)))
(if (not (equal? (mix-home reg-mix-id) (list ind 0 #f 0)))
- (snd-display ";mix-region mix-home ~A (~A 0 #f 0)?" (mix-home reg-mix-id) ind))
+ (snd-display #__line__ ";mix-region mix-home ~A (~A 0 #f 0)?" (mix-home reg-mix-id) ind))
(let ((sel-mix-id (car (mix-selection 2500 ind 0))))
(if (not (= (selection-frames) (mix-length sel-mix-id)))
- (snd-display ";mix-selection frames: ~A != ~A?" (selection-frames) (mix-length sel-mix-id)))
+ (snd-display #__line__ ";mix-selection frames: ~A != ~A?" (selection-frames) (mix-length sel-mix-id)))
(if (> (abs (- (* 2 (mix-length reg-mix-id)) (mix-length sel-mix-id))) 3)
- (snd-display ";mix selection and region: ~A ~A (~A ~A)?"
+ (snd-display #__line__ ";mix selection and region: ~A ~A (~A ~A)?"
(mix-length reg-mix-id) (mix-length sel-mix-id) (region-frames id) (selection-frames)))
(if (not (equal? (mix-home sel-mix-id) (list ind 0 #f 0)))
- (snd-display ";mix-selection mix-home: ~A (~A 0 #f 0)?" (mix-home sel-mix-id) ind))
+ (snd-display #__line__ ";mix-selection mix-home: ~A (~A 0 #f 0)?" (mix-home sel-mix-id) ind))
(insert-selection 3000 ind 0)
(insert-selection 3000 ind)
(if (and (provided? 'xm) (provided? 'snd-debug))
@@ -34443,24 +34517,24 @@ EDITS: 2
(com (comment oboe)))
(save-sound-as "test.aif" oboe mus-aifc)
(let ((oboe-aif (open-sound "test.aif")))
- (if (not (= (header-type oboe-aif) mus-aifc)) (snd-display ";oboe-aif header: ~A?" (mus-header-type-name (header-type oboe-aif))))
+ (if (not (= (header-type oboe-aif) mus-aifc)) (snd-display #__line__ ";oboe-aif header: ~A?" (mus-header-type-name (header-type oboe-aif))))
(set! (srate oboe-aif) (* sr 2.0))
- (if (fneq (* sr 2.0) (srate oboe-aif)) (snd-display ";set! srate: ~A ~A" (* sr 2.0) (srate oboe-aif)))
+ (if (fneq (* sr 2.0) (srate oboe-aif)) (snd-display #__line__ ";set! srate: ~A ~A" (* sr 2.0) (srate oboe-aif)))
(set! (header-type oboe-aif) mus-next)
- (if (not (= (header-type oboe-aif) mus-next)) (snd-display ";set! header: ~A?" (mus-header-type-name (header-type oboe-aif))))
+ (if (not (= (header-type oboe-aif) mus-next)) (snd-display #__line__ ";set! header: ~A?" (mus-header-type-name (header-type oboe-aif))))
(set! (data-location oboe-aif) 28)
- (if (not (= (data-location oboe-aif) 28)) (snd-display ";set! data-location: ~A?" (data-location oboe-aif)))
+ (if (not (= (data-location oboe-aif) 28)) (snd-display #__line__ ";set! data-location: ~A?" (data-location oboe-aif)))
(set! (data-format oboe-aif) mus-mulaw)
- (if (not (= (data-format oboe-aif) mus-mulaw)) (snd-display ";set! format: ~A?" (mus-data-format-name (data-format oboe-aif))))
+ (if (not (= (data-format oboe-aif) mus-mulaw)) (snd-display #__line__ ";set! format: ~A?" (mus-data-format-name (data-format oboe-aif))))
(save-sound-as "test.aif" oboe-aif mus-aifc mus-bshort 22050 0)
(close-sound oboe-aif)
(delete-file "test.aif")
(set! (selected-sound) a4)
- (if (not (equal? (selected-sound) a4)) (snd-display ";set! selected-sound: ~A ~A?" (selected-sound) a4))
+ (if (not (equal? (selected-sound) a4)) (snd-display #__line__ ";set! selected-sound: ~A ~A?" (selected-sound) a4))
(set! (selected-channel) 2)
- (if (not (= (selected-channel a4) 2)) (snd-display ";set! selected-channel: ~A?" (selected-channel a4)))
+ (if (not (= (selected-channel a4) 2)) (snd-display #__line__ ";set! selected-channel: ~A?" (selected-channel a4)))
(set! (selected-channel a4) 3)
- (if (not (= (selected-channel a4) 3)) (snd-display ";set! selected-channel a4: ~A?" (selected-channel a4)))
+ (if (not (= (selected-channel a4) 3)) (snd-display #__line__ ";set! selected-channel a4: ~A?" (selected-channel a4)))
(close-sound a4)
(close-sound oboe)))
@@ -34468,144 +34542,144 @@ EDITS: 2
(v2 (envelope-interp 1.0 '(0 0.0 1 1.0 2 0.0)))
(v3 (envelope-interp 2.0 '(0 0.0 1 1.0)))
(v4 (envelope-interp 0.0 '(1 .5 2 0))))
- (if (fneq v1 0.5) (snd-display ";envelope-interp(1): ~F (0.5)?" v1))
- (if (fneq v2 1.0) (snd-display ";envelope-interp(2): ~F (1.0)?" v2))
- (if (fneq v3 1.0) (snd-display ";envelope-interp(3): ~F (1.0)?" v3))
- (if (fneq v4 0.5) (snd-display ";envelope-interp(4): ~F (0.5)?" v4)))
+ (if (fneq v1 0.5) (snd-display #__line__ ";envelope-interp(1): ~F (0.5)?" v1))
+ (if (fneq v2 1.0) (snd-display #__line__ ";envelope-interp(2): ~F (1.0)?" v2))
+ (if (fneq v3 1.0) (snd-display #__line__ ";envelope-interp(3): ~F (1.0)?" v3))
+ (if (fneq v4 0.5) (snd-display #__line__ ";envelope-interp(4): ~F (0.5)?" v4)))
(let ((v1 (envelope-interp 0.0 '(-1 0 0 1 1 -1)))
(v2 (envelope-interp -0.5 '(-1 0 0 1 1 -1)))
(v3 (envelope-interp -0.5 '(-1 -1 0 1 1 -1)))
(v4 (envelope-interp -0.5 '(-1 -1 1 1)))
(v5 (envelope-interp -1.5 '(-1 -1 1 1)))
(v6 (envelope-interp 1.5 '(-1 -1 1 1))))
- (if (fneq v1 1.0) (snd-display ";envelope-interp(1a): ~A" v1))
- (if (fneq v2 0.5) (snd-display ";envelope-interp(2a): ~A" v2))
- (if (fneq v3 0.0) (snd-display ";envelope-interp(3a): ~A" v3))
- (if (fneq v4 -0.5) (snd-display ";envelope-interp(4a): ~A" v4))
- (if (fneq v5 -1.0) (snd-display ";envelope-interp(5a): ~A" v5))
- (if (fneq v6 1.0) (snd-display ";envelope-interp(6a): ~A" v6)))
+ (if (fneq v1 1.0) (snd-display #__line__ ";envelope-interp(1a): ~A" v1))
+ (if (fneq v2 0.5) (snd-display #__line__ ";envelope-interp(2a): ~A" v2))
+ (if (fneq v3 0.0) (snd-display #__line__ ";envelope-interp(3a): ~A" v3))
+ (if (fneq v4 -0.5) (snd-display #__line__ ";envelope-interp(4a): ~A" v4))
+ (if (fneq v5 -1.0) (snd-display #__line__ ";envelope-interp(5a): ~A" v5))
+ (if (fneq v6 1.0) (snd-display #__line__ ";envelope-interp(6a): ~A" v6)))
(let ((v1 (multiply-envelopes '(0.0 0.0 2.0 0.5) '(0.0 0.0 1.0 2.0 2.0 1.0)))
(v2 (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0))))
- (if (not (feql v1 (list 0.0 0.0 0.5 0.5 1.0 0.5))) (snd-display ";multiply-envelopes: ~A?" v1))
- (if (not (feql v2 (list 1.0 0.2 3.0 0.6))) (snd-display ";window-envelope: ~A?" v2)))
-
+ (if (not (feql v1 (list 0.0 0.0 0.5 0.5 1.0 0.5))) (snd-display #__line__ ";multiply-envelopes: ~A?" v1))
+ (if (not (feql v2 (list 1.0 0.2 3.0 0.6))) (snd-display #__line__ ";window-envelope: ~A?" v2)))
+
(if (fneq (envelope-interp .1 '(0 0 1 1)) 0.1)
- (snd-display ";envelope-interp .1 -> ~A?" (envelope-interp .1 '(0 0 1 1))))
+ (snd-display #__line__ ";envelope-interp .1 -> ~A?" (envelope-interp .1 '(0 0 1 1))))
(if (fneq (envelope-interp .1 '(0 0 1 1) 32.0) 0.01336172)
- (snd-display ";envelope-interp .013 -> ~A?" (envelope-interp .1 '(0 0 1 1) 32.0)))
+ (snd-display #__line__ ";envelope-interp .013 -> ~A?" (envelope-interp .1 '(0 0 1 1) 32.0)))
(if (fneq (envelope-interp .1 '(0 0 1 1) .012) 0.36177473)
- (snd-display ";envelope-interp .361 -> ~A?" (envelope-interp .1 '(0 0 1 1) .012)))
+ (snd-display #__line__ ";envelope-interp .361 -> ~A?" (envelope-interp .1 '(0 0 1 1) .012)))
(if (fneq (envelope-interp .3 '(0 0 .5 1 1 0)) .6)
- (snd-display ";envelope-interp .3 '(0 0 .5 1 1 0)) -> ~A" (envelope-interp .3 '(0 0 .5 1 1 0))))
-
+ (snd-display #__line__ ";envelope-interp .3 '(0 0 .5 1 1 0)) -> ~A" (envelope-interp .3 '(0 0 .5 1 1 0))))
+
(if (fneq (envelope-interp .9 '(0 0 1 1)) 0.9)
- (snd-display ";envelope-interp .9 -> ~A?" (envelope-interp .9 '(0 0 1 1))))
+ (snd-display #__line__ ";envelope-interp .9 -> ~A?" (envelope-interp .9 '(0 0 1 1))))
(if (fneq (envelope-interp .9 '(0 0 1 1) 32.0) 0.698)
- (snd-display ";envelope-interp .698 -> ~A?" (envelope-interp .9 '(0 0 1 1) 32.0)))
+ (snd-display #__line__ ";envelope-interp .698 -> ~A?" (envelope-interp .9 '(0 0 1 1) 32.0)))
(if (fneq (envelope-interp .9 '(0 0 1 1) .012) 0.993)
- (snd-display ";envelope-interp .993 -> ~A?" (envelope-interp .9 '(0 0 1 1) .012)))
-
+ (snd-display #__line__ ";envelope-interp .993 -> ~A?" (envelope-interp .9 '(0 0 1 1) .012)))
+
(if (fneq (envelope-interp 1.1 '(0 0 1 0 2 1)) 0.1)
- (snd-display ";envelope-interp .1 (2) -> ~A?" (envelope-interp 1.1 '(0 0 1 0 2 1))))
+ (snd-display #__line__ ";envelope-interp .1 (2) -> ~A?" (envelope-interp 1.1 '(0 0 1 0 2 1))))
(if (fneq (envelope-interp 1.1 '(0 0 1 0 2 1) 32.0) 0.01336172)
- (snd-display ";envelope-interp .013 (2) -> ~A?" (envelope-interp 1.1 '(0 0 1 0 2 1) 32.0)))
+ (snd-display #__line__ ";envelope-interp .013 (2) -> ~A?" (envelope-interp 1.1 '(0 0 1 0 2 1) 32.0)))
(if (fneq (envelope-interp 1.1 '(0 0 1 0 2 1) .012) 0.36177473)
- (snd-display ";envelope-interp .361 (2) -> ~A?" (envelope-interp 1.1 '(0 0 1 0 2 1) .012)))
-
+ (snd-display #__line__ ";envelope-interp .361 (2) -> ~A?" (envelope-interp 1.1 '(0 0 1 0 2 1) .012)))
+
(if (fneq (envelope-interp 1.9 '(0 0 1 0 2 1)) 0.9)
- (snd-display ";envelope-interp .9 (2) -> ~A?" (envelope-interp 1.9 '(0 0 1 0 2 1))))
+ (snd-display #__line__ ";envelope-interp .9 (2) -> ~A?" (envelope-interp 1.9 '(0 0 1 0 2 1))))
(if (fneq (envelope-interp 1.9 '(0 0 1 0 2 1) 32.0) 0.698)
- (snd-display ";envelope-interp .698 (2) -> ~A?" (envelope-interp 1.9 '(0 0 1 0 2 1) 32.0)))
+ (snd-display #__line__ ";envelope-interp .698 (2) -> ~A?" (envelope-interp 1.9 '(0 0 1 0 2 1) 32.0)))
(if (fneq (envelope-interp 1.9 '(0 0 1 0 2 1) .012) 0.993)
- (snd-display ";envelope-interp .993 (2) -> ~A?" (envelope-interp 1.9 '(0 0 1 0 2 1) .012)))
-
+ (snd-display #__line__ ";envelope-interp .993 (2) -> ~A?" (envelope-interp 1.9 '(0 0 1 0 2 1) .012)))
+
(if (fneq (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1)) 0.1)
- (snd-display ";envelope-interp .1 (3) -> ~A?" (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1))))
+ (snd-display #__line__ ";envelope-interp .1 (3) -> ~A?" (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1))))
(if (fneq (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1) 32.0) 0.01336172)
- (snd-display ";envelope-interp .013 (3) -> ~A?" (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1) 32.0)))
+ (snd-display #__line__ ";envelope-interp .013 (3) -> ~A?" (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1) 32.0)))
(if (fneq (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1) .012) 0.36177473)
- (snd-display ";envelope-interp .361 (3) -> ~A?" (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1) .012)))
-
+ (snd-display #__line__ ";envelope-interp .361 (3) -> ~A?" (envelope-interp 1.1 '(0 0 0.5 1 1 0 2 1) .012)))
+
(if (fneq (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1)) 0.9)
- (snd-display ";envelope-interp .9 (3) -> ~A?" (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1))))
+ (snd-display #__line__ ";envelope-interp .9 (3) -> ~A?" (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1))))
(if (fneq (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1) 32.0) 0.698)
- (snd-display ";envelope-interp .698 (3) -> ~A?" (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1) 32.0)))
+ (snd-display #__line__ ";envelope-interp .698 (3) -> ~A?" (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1) 32.0)))
(if (fneq (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1) .012) 0.993)
- (snd-display ";envelope-interp .993 (3) -> ~A?" (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1) .012)))
-
+ (snd-display #__line__ ";envelope-interp .993 (3) -> ~A?" (envelope-interp 1.9 '(0 0 0.5 1 1 0 2 1) .012)))
+
(if (not (feql (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) (list 1.0 0.2 3.0 0.6)))
- (snd-display ";window-envelope: ~A?" (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0))))
+ (snd-display #__line__ ";window-envelope: ~A?" (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0))))
(if (not (feql (multiply-envelopes '(0 0 1 1) '(0 0 1 1 2 0)) (list 0 0 0.5 0.5 1 0)))
- (snd-display ";multiply-envelopes: ~A?" (multiply-envelopes '(0 0 1 1) '(0 0 1 1 2 0))))
+ (snd-display #__line__ ";multiply-envelopes: ~A?" (multiply-envelopes '(0 0 1 1) '(0 0 1 1 2 0))))
(if (fneq (max-envelope '(0 0 1 1 2 3 4 0)) 3.0)
- (snd-display ";max-envelope: ~A?" (max-envelope '(0 0 1 1 2 3 4 0))))
+ (snd-display #__line__ ";max-envelope: ~A?" (max-envelope '(0 0 1 1 2 3 4 0))))
(if (fneq (max-envelope '(0 1)) 1.0)
- (snd-display ";1 max-envelope: ~A?" (max-envelope '(0 1))))
+ (snd-display #__line__ ";1 max-envelope: ~A?" (max-envelope '(0 1))))
(if (fneq (max-envelope '(0 1 1 1 2 2)) 2.0)
- (snd-display ";2 max-envelope: ~A?" (max-envelope '(0 1 1 1 2 2))))
+ (snd-display #__line__ ";2 max-envelope: ~A?" (max-envelope '(0 1 1 1 2 2))))
(if (fneq (max-envelope '(0 -1 1 -2)) -1.0)
- (snd-display ";3 max-envelope: ~A?" (max-envelope '(0 -1 1 -2))))
+ (snd-display #__line__ ";3 max-envelope: ~A?" (max-envelope '(0 -1 1 -2))))
(if (fneq (max-envelope '(0 -2 1 -1)) -1.0)
- (snd-display ";4 max-envelope: ~A?" (max-envelope '(0 -2 1 -1))))
+ (snd-display #__line__ ";4 max-envelope: ~A?" (max-envelope '(0 -2 1 -1))))
(if (fneq (min-envelope '(0 0 1 1 2 3 4 0)) 0.0)
- (snd-display ";min-envelope: ~A?" (min-envelope '(0 0 1 1 2 3 4 0))))
+ (snd-display #__line__ ";min-envelope: ~A?" (min-envelope '(0 0 1 1 2 3 4 0))))
(if (fneq (min-envelope '(0 1)) 1.0)
- (snd-display ";1 min-envelope: ~A?" (min-envelope '(0 1))))
+ (snd-display #__line__ ";1 min-envelope: ~A?" (min-envelope '(0 1))))
(if (fneq (min-envelope '(0 1 1 1 2 2)) 1.0)
- (snd-display ";2 min-envelope: ~A?" (min-envelope '(0 1 1 1 2 2))))
+ (snd-display #__line__ ";2 min-envelope: ~A?" (min-envelope '(0 1 1 1 2 2))))
(if (fneq (min-envelope '(0 -1 1 -2)) -2.0)
- (snd-display ";3 min-envelope: ~A?" (min-envelope '(0 -1 1 -2))))
+ (snd-display #__line__ ";3 min-envelope: ~A?" (min-envelope '(0 -1 1 -2))))
(if (fneq (min-envelope '(0 -2 1 -1)) -2.0)
- (snd-display ";4 min-envelope: ~A?" (min-envelope '(0 -2 1 -1))))
+ (snd-display #__line__ ";4 min-envelope: ~A?" (min-envelope '(0 -2 1 -1))))
(if (fneq (integrate-envelope '(0 0 1 1)) 0.5)
- (snd-display ";integrate-envelope: ~A?" (integrate-envelope '(0 0 1 1))))
+ (snd-display #__line__ ";integrate-envelope: ~A?" (integrate-envelope '(0 0 1 1))))
(if (fneq (integrate-envelope '(0 1 1 1)) 1.0)
- (snd-display ";integrate-envelope: ~A?" (integrate-envelope '(0 1 1 1))))
+ (snd-display #__line__ ";integrate-envelope: ~A?" (integrate-envelope '(0 1 1 1))))
(if (fneq (integrate-envelope '(0 0 1 1 2 .5)) 1.25)
- (snd-display ";integrate-envelope: ~A?" (integrate-envelope '(0 0 1 1 2 .5))))
+ (snd-display #__line__ ";integrate-envelope: ~A?" (integrate-envelope '(0 0 1 1 2 .5))))
(if (not (feql (stretch-envelope '(0 0 1 1) .1 .2) (list 0 0 0.2 0.1 1.0 1)))
- (snd-display ";stretch-envelope att: ~A?" (stretch-envelope '(0 0 1 1) .1 .2)))
+ (snd-display #__line__ ";stretch-envelope att: ~A?" (stretch-envelope '(0 0 1 1) .1 .2)))
(if (not (feql (stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6) (list 0 0 0.2 0.1 1.1 1 1.6 0.5 2.0 0)))
- (snd-display ";stretch-envelope dec: ~A?" (stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6)))
+ (snd-display #__line__ ";stretch-envelope dec: ~A?" (stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6)))
(if (not (feql (add-envelopes '(0 0 1 1 2 0) '(0 0 1 1)) '(0 0 0.5 1.5 1 1)))
- (snd-display ";add-envelopes: ~A" (add-envelopes '(0 0 1 1 2 0) '(0 0 1 1))))
+ (snd-display #__line__ ";add-envelopes: ~A" (add-envelopes '(0 0 1 1 2 0) '(0 0 1 1))))
(if (not (feql (scale-envelope '(0 0 1 1) 2) '(0 0 1 2)))
- (snd-display ";scale-envelope: ~A" (scale-envelope '(0 0 1 1) 2)))
+ (snd-display #__line__ ";scale-envelope: ~A" (scale-envelope '(0 0 1 1) 2)))
(if (not (feql (scale-envelope '(0 0 1 1) 2 1) '(0 1 1 3)))
- (snd-display ";scale-envelope off: ~A" (scale-envelope '(0 0 1 1) 2 1)))
+ (snd-display #__line__ ";scale-envelope off: ~A" (scale-envelope '(0 0 1 1) 2 1)))
(if (not (feql (reverse-envelope '(0 0 1 1)) '(0 1 1 0)))
- (snd-display ";reverse-envelope ramp: ~A" (reverse-envelope '(0 0 1 1))))
+ (snd-display #__line__ ";reverse-envelope ramp: ~A" (reverse-envelope '(0 0 1 1))))
(if (not (feql (reverse-envelope '(0 0 .5 1 2 0)) '(0 0 1.5 1 2 0)))
- (snd-display ";reverse-envelope ramp 2: ~A" (reverse-envelope '(0 0 .5 1 2 0))))
+ (snd-display #__line__ ";reverse-envelope ramp 2: ~A" (reverse-envelope '(0 0 .5 1 2 0))))
(if (not (feql (reverse-envelope '(0 0 .5 1 2 1)) '(0 1 1.5 1 2 0)))
- (snd-display ";reverse-envelope ramp 2: ~A" (reverse-envelope '(0 0 .5 1 2 1))))
+ (snd-display #__line__ ";reverse-envelope ramp 2: ~A" (reverse-envelope '(0 0 .5 1 2 1))))
(if (not (feql (concatenate-envelopes '(0 0 1 1) '(0 1 1 0)) '(0.0 0 1.0 1 2.0 0)))
- (snd-display ";concatenate-envelopes: ~A" (concatenate-envelopes '(0 0 1 1) '(0 1 1 0))))
+ (snd-display #__line__ ";concatenate-envelopes: ~A" (concatenate-envelopes '(0 0 1 1) '(0 1 1 0))))
(if (not (feql (concatenate-envelopes '(0 0 1 1.5) '(0 1 1 0)) '(0.0 0 1.0 1.5 1.01 1 2.01 0)))
- (snd-display ";concatenate-envelopes: ~A" (concatenate-envelopes '(0 0 1 1.5) '(0 1 1 0))))
+ (snd-display #__line__ ";concatenate-envelopes: ~A" (concatenate-envelopes '(0 0 1 1.5) '(0 1 1 0))))
(if (not (feql (repeat-envelope '(0 0 1 100) 2) '(0 0 1 100 1.01 0 2.01 100)))
- (snd-display ";repeat-envelope 0: ~A" (repeat-envelope '(0 0 1 100) 2)))
+ (snd-display #__line__ ";repeat-envelope 0: ~A" (repeat-envelope '(0 0 1 100) 2)))
(if (not (feql (repeat-envelope '(0 0 1.5 1 2 0) 2) '(0 0 1.5 1 2.0 0 3.5 1 4.0 0)))
- (snd-display ";repeat-envelope 1: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 2)))
+ (snd-display #__line__ ";repeat-envelope 1: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 2)))
(if (not (feql (repeat-envelope '(0 0 1.5 1 2 0) 2 #f #t) '(0.0 0 0.75 1 1.0 0 1.75 1 2.0 0)))
- (snd-display ";repeat-envelope 2: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 2 #f #t)))
+ (snd-display #__line__ ";repeat-envelope 2: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 2 #f #t)))
(if (not (feql (repeat-envelope '(0 0 1.5 1 2 0) 2 #t) '(0 0 1.5 1 2.0 0 2.5 1 4.0 0)))
- (snd-display ";repeat-envelope 3: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 2 #t)))
+ (snd-display #__line__ ";repeat-envelope 3: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 2 #t)))
(if (not (feql (repeat-envelope '(0 0 1.5 1 2 0) 3) '(0 0 1.5 1 2.0 0 3.5 1 4.0 0 5.5 1 6.0 0)))
- (snd-display ";repeat-envelope 4: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 3)))
+ (snd-display #__line__ ";repeat-envelope 4: ~A" (repeat-envelope '(0 0 1.5 1 2 0) 3)))
(if (not (feql (normalize-envelope '(0 0 1 1.5 2.0 1.0)) '(0 0.0 1 1.0 2.0 0.667)))
- (snd-display ";normalize-envelope: ~A" (normalize-envelope '(0 0 1 1.5 2.0 1.0))))
+ (snd-display #__line__ ";normalize-envelope: ~A" (normalize-envelope '(0 0 1 1.5 2.0 1.0))))
(if (not (feql (normalize-envelope '(0 0 1 .5 2 -.8)) '(0 0.0 1 0.625 2 -1.0)))
- (snd-display ";normalize-envelope: ~A" (normalize-envelope '(0 0 1 .5 2 -.8))))
+ (snd-display #__line__ ";normalize-envelope: ~A" (normalize-envelope '(0 0 1 .5 2 -.8))))
(let ((val (envelope-exp '(0 0 1 1) 2.0 10)))
(if (not (feql val '(0.000 0.000 0.100 0.010 0.200 0.040 0.300 0.090 0.400 0.160
0.500 0.250 0.600 0.360 0.700 0.490 0.800 0.640 0.900 0.810 1.000 1.000)))
- (snd-display ";envelope-exp: ~A" val))
+ (snd-display #__line__ ";envelope-exp: ~A" val))
(set! val (envelope-exp '(0 0 1 1 2 0) 1.0 10))
(if (not (feql val '(0.000 0.000 0.200 0.200 0.400 0.400 0.600 0.600 0.800 0.800
1.000 1.000 1.200 0.800 1.400 0.600 1.600 0.400 1.800 0.200 2.000 0.000)))
- (snd-display ";envelope exp 2: ~A" val)))
+ (snd-display #__line__ ";envelope exp 2: ~A" val)))
(let ((ind (new-sound "fmv.snd"))
(v (make-vct 20 1.0)))
@@ -34614,14 +34688,14 @@ EDITS: 2
(make-selection 5 9 ind 0)
(scale-selection-to 0.5)
(insert-selection 15 ind)
- (if (not (= (frames ind) 25)) (snd-display ";insert-selection 5: ~A" (frames ind)))
+ (if (not (= (frames ind) 25)) (snd-display #__line__ ";insert-selection 5: ~A" (frames ind)))
(if (not (vequal (channel->vct 0 25) (vct 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";insert-selection: ~A" (channel->vct 0 25)))
+ (snd-display #__line__ ";insert-selection: ~A" (channel->vct 0 25)))
(mix-selection 1 ind 0) ; this is being confused by clipping settings
(if (not (vequal (channel->vct 0 10 ind 0) (vct 1.000 1.500 1.500 1.500 1.500 1.000 0.500 0.500 0.500 0.500)))
- (snd-display ";mix-selection vals: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";mix-selection vals: ~A" (channel->vct 0 10 ind 0)))
(close-sound ind))
(let ((ind (new-sound "fmv.snd"))
@@ -34649,24 +34723,24 @@ EDITS: 2
(let* ((data (transform->vct))
(peak (vct-peak data))
(val (transform-sample 0)))
- (if (= peak 0.0) (snd-display ";transform selection peak: ~A" peak))
- (if (fneq val (vct-ref data 0)) (snd-display ";transform-sample: ~A, data: ~A" val (vct-ref data 0)))
+ (if (= peak 0.0) (snd-display #__line__ ";transform selection peak: ~A" peak))
+ (if (fneq val (vct-ref data 0)) (snd-display #__line__ ";transform-sample: ~A, data: ~A" val (vct-ref data 0)))
(if (and (>= (vct-length data) 64)
(> (* .5 peak) (vct-ref data 51)))
- (snd-display ";transform selection at 51: ~A, peak: ~A" (vct-ref data 51) peak)))
+ (snd-display #__line__ ";transform selection at 51: ~A, peak: ~A" (vct-ref data 51) peak)))
(for-each
(lambda (pad)
(set! (zero-pad) pad)
(update-transform-graph)
(let* ((data (transform->vct))
(peak (vct-peak data))
- (pval (vct-ref data (inexact->exact (floor (* .1 (vct-length data)))))))
+ (pval (vct-ref data (floor (* .1 (vct-length data))))))
(if (> (* .5 peak) pval)
- (snd-display ";transform selection padded ~D: ~A, peak: ~A" pad pval peak))))
+ (snd-display #__line__ ";transform selection padded ~D: ~A, peak: ~A" pad pval peak))))
(list 1 0 3 31))
(set! (zero-pad) 100000)
(if (> (zero-pad) 1000)
- (snd-display ";zero-pad: ~A" (zero-pad)))
+ (snd-display #__line__ ";zero-pad: ~A" (zero-pad)))
(set! (zero-pad) 0)
(set! (transform-size) old-size)
(set! (transform-type) old-type)
@@ -34678,9 +34752,9 @@ EDITS: 2
(maxes (vct 0.8387 0.5169 0.3318 0.2564 0.1982 0.1532)))
(do ((i 0 (+ 1 i)))
((= i 5))
- (if (fneq (maxamp) (vct-ref maxes i)) (snd-display ";enving storm ~D: ~A ~A" i (vct-ref maxes i) (maxamp)))
+ (if (fneq (maxamp) (vct-ref maxes i)) (snd-display #__line__ ";enving storm ~D: ~A ~A" i (vct-ref maxes i) (maxamp)))
(env-sound '(0 0 1 1 2 0))
- (if (fneq (maxamp) (vct-ref maxes (+ 1 i))) (snd-display ";enving storm ~D: ~A ~A" (+ 1 i) (vct-ref maxes (+ 1 i)) (maxamp))))
+ (if (fneq (maxamp) (vct-ref maxes (+ 1 i))) (snd-display #__line__ ";enving storm ~D: ~A ~A" (+ 1 i) (vct-ref maxes (+ 1 i)) (maxamp))))
(close-sound ind))
))
@@ -34688,7 +34762,7 @@ EDITS: 2
;; length as generic function:
;; string-length vector-length hash-table-size vct-length
;; frames mus-length sound-data-length mix-length region-frames
-
+
(let ((snd (open-sound "oboe.snd"))
(v (vct .1 .2 .3))
(vc (vector .1 .2 .3 .4))
@@ -34703,22 +34777,22 @@ EDITS: 2
(dly (make-delay 32))
(ply (make-player snd 0))
)
- (if (not (= (length snd) 50828)) (snd-display ";length of sound: ~A" (length snd)))
- (if (not (= (length v) 3)) (snd-display ";length of vct: ~A" (length v)))
- (if (not (= (length vc) 4)) (snd-display ";length of vector: ~A" (length vc)))
- (if (not (= (length lst) 5)) (snd-display ";length of list: ~A" (length lst)))
- (if (not (= (length str) 6)) (snd-display ";length of string: ~A" (length str)))
- (if (not (= (length sd) 10)) (snd-display ";length of sound-data: ~A" (length sd)))
- (if (not (= (length hsh) 100)) (snd-display ";length of hash-table: ~A" (length hsh)))
- (if (not (= (length fr) 2)) (snd-display ";length of frame: ~A" (length fr)))
- (if (not (= (length mx) 2)) (snd-display ";length of mixer: ~A" (length mx)))
- (if (not (= (length mxv) 3)) (snd-display ";length of mix: ~A" (length mxv)))
- (if (not (= (length reg) 101)) (snd-display ";length of region: ~A" (length reg)))
- (if (not (= (length dly) 32)) (snd-display ";length of delay: ~A" (length dly)))
- (if (not (= (length ply) 50828)) (snd-display ";length of player: ~A" (length ply)))
+ (if (not (= (length snd) 50828)) (snd-display #__line__ ";length of sound: ~A" (length snd)))
+ (if (not (= (length v) 3)) (snd-display #__line__ ";length of vct: ~A" (length v)))
+ (if (not (= (length vc) 4)) (snd-display #__line__ ";length of vector: ~A" (length vc)))
+ (if (not (= (length lst) 5)) (snd-display #__line__ ";length of list: ~A" (length lst)))
+ (if (not (= (length str) 6)) (snd-display #__line__ ";length of string: ~A" (length str)))
+ (if (not (= (length sd) 10)) (snd-display #__line__ ";length of sound-data: ~A" (length sd)))
+ (if (not (= (length hsh) 100)) (snd-display #__line__ ";length of hash-table: ~A" (length hsh)))
+ (if (not (= (length fr) 2)) (snd-display #__line__ ";length of frame: ~A" (length fr)))
+ (if (not (= (length mx) 2)) (snd-display #__line__ ";length of mixer: ~A" (length mx)))
+ (if (not (= (length mxv) 3)) (snd-display #__line__ ";length of mix: ~A" (length mxv)))
+ (if (not (= (length reg) 101)) (snd-display #__line__ ";length of region: ~A" (length reg)))
+ (if (not (= (length dly) 32)) (snd-display #__line__ ";length of delay: ~A" (length dly)))
+ (if (not (= (length ply) 50828)) (snd-display #__line__ ";length of player: ~A" (length ply)))
)
(close-sound snd))
-
+
;; srate as generic: mus-sound-srate region-srate srate
(let ((snd (open-sound "oboe.snd"))
@@ -34726,10 +34800,10 @@ EDITS: 2
(let ((reg (make-region 0 100))
(ply (make-player snd 0))
)
- (if (not (= (srate snd) 22050)) (snd-display ";srate of sound: ~A" (srate snd)))
- (if (not (= (srate str) 22050)) (snd-display ";srate of string: ~A" (srate str)))
- (if (not (= (srate reg) 22050)) (snd-display ";srate of region: ~A" (srate reg)))
- (if (not (= (srate ply) 22050)) (snd-display ";srate of player: ~A" (srate ply)))
+ (if (not (= (srate snd) 22050)) (snd-display #__line__ ";srate of sound: ~A" (srate snd)))
+ (if (not (= (srate str) 22050)) (snd-display #__line__ ";srate of string: ~A" (srate str)))
+ (if (not (= (srate reg) 22050)) (snd-display #__line__ ";srate of region: ~A" (srate reg)))
+ (if (not (= (srate ply) 22050)) (snd-display #__line__ ";srate of player: ~A" (srate ply)))
)
(close-sound snd))
@@ -34746,18 +34820,18 @@ EDITS: 2
(reg (make-region 0 100))
(ply (make-player snd 0))
)
- (if (not (= (channels snd) 1)) (snd-display ";channels of sound: ~A" (channels snd)))
- (if (not (= (channels v) 1)) (snd-display ";channels of vct: ~A" (channels v)))
- (if (not (= (channels str) 1)) (snd-display ";channels of string: ~A" (channels str)))
- (if (not (= (channels sd) 2)) (snd-display ";channels of sound-data: ~A" (channels sd)))
- (if (not (= (channels fr) 2)) (snd-display ";channels of frame: ~A" (channels fr)))
- (if (not (= (channels mx) 2)) (snd-display ";channels of mixer: ~A" (channels mx)))
- (if (not (= (channels mxv) 1)) (snd-display ";channels of mix: ~A" (channels mxv)))
- (if (not (= (channels reg) 1)) (snd-display ";channels of region: ~A" (channels reg)))
- (if (not (= (channels ply) 1)) (snd-display ";channels of player: ~A" (channels ply)))
+ (if (not (= (channels snd) 1)) (snd-display #__line__ ";channels of sound: ~A" (channels snd)))
+ (if (not (= (channels v) 1)) (snd-display #__line__ ";channels of vct: ~A" (channels v)))
+ (if (not (= (channels str) 1)) (snd-display #__line__ ";channels of string: ~A" (channels str)))
+ (if (not (= (channels sd) 2)) (snd-display #__line__ ";channels of sound-data: ~A" (channels sd)))
+ (if (not (= (channels fr) 2)) (snd-display #__line__ ";channels of frame: ~A" (channels fr)))
+ (if (not (= (channels mx) 2)) (snd-display #__line__ ";channels of mixer: ~A" (channels mx)))
+ (if (not (= (channels mxv) 1)) (snd-display #__line__ ";channels of mix: ~A" (channels mxv)))
+ (if (not (= (channels reg) 1)) (snd-display #__line__ ";channels of region: ~A" (channels reg)))
+ (if (not (= (channels ply) 1)) (snd-display #__line__ ";channels of player: ~A" (channels ply)))
)
(close-sound snd))
-
+
;; frames as generic
(let ((snd (open-sound "oboe.snd"))
@@ -34771,19 +34845,19 @@ EDITS: 2
(dly (make-delay 32))
(ply (make-player snd 0))
)
- (if (not (= (frames snd) 50828)) (snd-display ";frames of sound: ~A" (frames snd)))
- (if (not (= (frames v) 3)) (snd-display ";frames of vct: ~A" (frames v)))
- (if (not (= (frames str) 50828)) (snd-display ";frames of string: ~A" (frames str)))
- (if (not (= (frames sd) 10)) (snd-display ";frames of sound-data: ~A" (frames sd)))
- (if (not (= (frames fr) 2)) (snd-display ";frames of frame: ~A" (frames fr)))
- (if (not (= (frames mx) 2)) (snd-display ";frames of mixer: ~A" (frames mx)))
- (if (not (= (frames mxv) 3)) (snd-display ";frames of mix: ~A" (frames mxv)))
- (if (not (= (frames reg) 101)) (snd-display ";frames of region: ~A" (frames reg)))
- (if (not (= (frames dly) 32)) (snd-display ";frames of delay: ~A" (frames dly)))
- (if (not (= (frames ply) 50828)) (snd-display ";frames of player: ~A" (frames ply)))
+ (if (not (= (frames snd) 50828)) (snd-display #__line__ ";frames of sound: ~A" (frames snd)))
+ (if (not (= (frames v) 3)) (snd-display #__line__ ";frames of vct: ~A" (frames v)))
+ (if (not (= (frames str) 50828)) (snd-display #__line__ ";frames of string: ~A" (frames str)))
+ (if (not (= (frames sd) 10)) (snd-display #__line__ ";frames of sound-data: ~A" (frames sd)))
+ (if (not (= (frames fr) 2)) (snd-display #__line__ ";frames of frame: ~A" (frames fr)))
+ (if (not (= (frames mx) 2)) (snd-display #__line__ ";frames of mixer: ~A" (frames mx)))
+ (if (not (= (frames mxv) 3)) (snd-display #__line__ ";frames of mix: ~A" (frames mxv)))
+ (if (not (= (frames reg) 101)) (snd-display #__line__ ";frames of region: ~A" (frames reg)))
+ (if (not (= (frames dly) 32)) (snd-display #__line__ ";frames of delay: ~A" (frames dly)))
+ (if (not (= (frames ply) 50828)) (snd-display #__line__ ";frames of player: ~A" (frames ply)))
)
(close-sound snd))
-
+
;; file-name as generic
(let ((snd (open-sound "oboe.snd"))
@@ -34793,37 +34867,37 @@ EDITS: 2
(let ((mxv (car (mix "pistol.snd" 1000)))
(reg (make-region 0 100))
)
- (if (not (string=? (file-name snd) (string-append (getcwd) "/oboe.snd"))) (snd-display ";file-name of sound: ~A" (file-name snd)))
- (if (not (string=? (file-name str) (string-append (getcwd) "/oboe.snd"))) (snd-display ";file-name of string: ~A" (file-name str)))
- (if (not (string=? (file-name frm) "oboe.snd")) (snd-display ";file-name of file->sample: ~A" (file-name frm)))
- (if (not (string=? (file-name prt) "tst.dat")) (snd-display ";file-name of output port: ~A" (file-name prt)))
- (if (not (string=? (file-name mxv) (string-append (getcwd) "/pistol.snd"))) (snd-display ";file-name of mix: ~A" (file-name mxv)))
- (if (not (string=? (file-name reg) "oboe.snd")) (snd-display ";file-name of region: ~A" (file-name reg)))
+ (if (not (string=? (file-name snd) (string-append (getcwd) "/oboe.snd"))) (snd-display #__line__ ";file-name of sound: ~A" (file-name snd)))
+ (if (not (string=? (file-name str) (string-append (getcwd) "/oboe.snd"))) (snd-display #__line__ ";file-name of string: ~A" (file-name str)))
+ (if (not (string=? (file-name frm) "oboe.snd")) (snd-display #__line__ ";file-name of file->sample: ~A" (file-name frm)))
+ (if (not (string=? (file-name prt) "tst.dat")) (snd-display #__line__ ";file-name of output port: ~A" (file-name prt)))
+ (if (not (string=? (file-name mxv) (string-append (getcwd) "/pistol.snd"))) (snd-display #__line__ ";file-name of mix: ~A" (file-name mxv)))
+ (if (not (string=? (file-name reg) "oboe.snd")) (snd-display #__line__ ";file-name of region: ~A" (file-name reg)))
)
(close-output-port prt)
(mus-close frm)
(close-sound snd))
-
+
;; sync as generic: mix-sync mark-sync sync
(let ((snd (open-sound "oboe.snd")))
(let ((mrk (add-mark 123))
(mx (mix-vct (vct .1 .2 .3)))
)
- (if (not (= (sync snd) 0)) (snd-display ";sync of sound (0): ~A" (sync snd)))
- (if (not (= (sync mrk) 0)) (snd-display ";sync of mark (0): ~A" (sync mrk)))
- (if (not (= (sync mx) 0)) (snd-display ";sync of mx (0): ~A" (sync mx)))
+ (if (not (= (sync snd) 0)) (snd-display #__line__ ";sync of sound (0): ~A" (sync snd)))
+ (if (not (= (sync mrk) 0)) (snd-display #__line__ ";sync of mark (0): ~A" (sync mrk)))
+ (if (not (= (sync mx) 0)) (snd-display #__line__ ";sync of mx (0): ~A" (sync mx)))
(set! (sync snd) 12)
(set! (sync mrk) 24)
(set! (sync mx) 36)
- (if (not (= (sync snd) 12)) (snd-display ";sync of sound (12): ~A" (sync snd)))
- (if (not (= (sync mrk) 24)) (snd-display ";sync of mark (24): ~A" (sync mrk)))
- (if (not (= (sync mx) 36)) (snd-display ";sync of mx (36): ~A" (sync mx)))
+ (if (not (= (sync snd) 12)) (snd-display #__line__ ";sync of sound (12): ~A" (sync snd)))
+ (if (not (= (sync mrk) 24)) (snd-display #__line__ ";sync of mark (24): ~A" (sync mrk)))
+ (if (not (= (sync mx) 36)) (snd-display #__line__ ";sync of mx (36): ~A" (sync mx)))
)
(close-sound snd))
-
+
;; maxamp as generic
(let ((snd (open-sound "oboe.snd"))
@@ -34841,18 +34915,18 @@ EDITS: 2
(delay dly .1)
(delay dly .2)
- (if (fneq (maxamp snd) .334) (snd-display ";maxamp of sound: ~A" (maxamp snd)))
- (if (fneq (maxamp snd 0) .334) (snd-display ";maxamp of sound (0): ~A" (maxamp snd)))
- (if (fneq (maxamp snd 0 0) .14724) (snd-display ";maxamp of sound (0 0): ~A" (maxamp snd)))
- (if (fneq (maxamp v) .3) (snd-display ";maxamp of vct: ~A" (maxamp v)))
- (if (fneq (maxamp vc) .4) (snd-display ";maxamp of vector: ~A" (maxamp vc)))
- (if (fneq (maxamp lst) 5.0) (snd-display ";maxamp of list: ~A" (maxamp lst)))
- (if (fneq (maxamp str) .49267) (snd-display ";maxamp of string: ~A" (maxamp str)))
- (if (fneq (maxamp sd) 0.1) (snd-display ";maxamp of sound-data: ~A" (maxamp sd)))
- (if (fneq (maxamp fr) .2) (snd-display ";maxamp of frame: ~A" (maxamp fr)))
- (if (fneq (maxamp mxv) .3) (snd-display ";maxamp of mix: ~A" (maxamp mxv)))
- (if (fneq (maxamp reg) .02139) (snd-display ";maxamp of region: ~A" (maxamp reg)))
- (if (fneq (maxamp dly) .2) (snd-display ";maxamp of delay: ~A" (maxamp dly)))
+ (if (fneq (maxamp snd) .334) (snd-display #__line__ ";maxamp of sound: ~A" (maxamp snd)))
+ (if (fneq (maxamp snd 0) .334) (snd-display #__line__ ";maxamp of sound (0): ~A" (maxamp snd)))
+ (if (fneq (maxamp snd 0 0) .14724) (snd-display #__line__ ";maxamp of sound (0 0): ~A" (maxamp snd)))
+ (if (fneq (maxamp v) .3) (snd-display #__line__ ";maxamp of vct: ~A" (maxamp v)))
+ (if (fneq (maxamp vc) .4) (snd-display #__line__ ";maxamp of vector: ~A" (maxamp vc)))
+ (if (fneq (maxamp lst) 5.0) (snd-display #__line__ ";maxamp of list: ~A" (maxamp lst)))
+ (if (fneq (maxamp str) .49267) (snd-display #__line__ ";maxamp of string: ~A" (maxamp str)))
+ (if (fneq (maxamp sd) 0.1) (snd-display #__line__ ";maxamp of sound-data: ~A" (maxamp sd)))
+ (if (fneq (maxamp fr) .2) (snd-display #__line__ ";maxamp of frame: ~A" (maxamp fr)))
+ (if (fneq (maxamp mxv) .3) (snd-display #__line__ ";maxamp of mix: ~A" (maxamp mxv)))
+ (if (fneq (maxamp reg) .02139) (snd-display #__line__ ";maxamp of region: ~A" (maxamp reg)))
+ (if (fneq (maxamp dly) .2) (snd-display #__line__ ";maxamp of delay: ~A" (maxamp dly)))
)
(close-sound snd))
@@ -34898,27 +34972,27 @@ EDITS: 2
(scale-channel scaler 0 (frames cursnd curchn) cursnd curchn)
(if (and (not (= (edit-position cursnd curchn) (+ 1 cur-edit)))
(not (= (edit-position cursnd curchn) cur-edit)))
- (snd-display ";scale-channel ~A[~A] edit pos: ~A ~A" (short-file-name cursnd) curchn (edit-position cursnd curchn) cur-edit))
+ (snd-display #__line__ ";scale-channel ~A[~A] edit pos: ~A ~A" (short-file-name cursnd) curchn (edit-position cursnd curchn) cur-edit))
(if (not (= (frames cursnd curchn) cur-frame))
- (snd-display ";scale-channel ~A[~A] frames: ~A ~A" (short-file-name cursnd) curchn (frames cursnd curchn) cur-frame))
+ (snd-display #__line__ ";scale-channel ~A[~A] frames: ~A ~A" (short-file-name cursnd) curchn (frames cursnd curchn) cur-frame))
(if (fneq (maxamp cursnd curchn) (* scaler cur-amp))
- (snd-display ";scale-channel ~A[~A] maxamp: ~A ~A (~A, scaler: ~A)"
+ (snd-display #__line__ ";scale-channel ~A[~A] maxamp: ~A ~A (~A, scaler: ~A)"
(short-file-name cursnd) curchn (maxamp cursnd curchn) (* scaler cur-amp)
(abs (- (maxamp cursnd curchn) (* scaler cur-amp)))
scaler))
(if (fneq (sample cur-loc cursnd curchn) (* scaler cur-samp))
- (snd-display ";scale-channel ~A[~A] cur-samp: ~A ~A" (short-file-name cursnd) curchn (sample cur-loc cursnd curchn) (* scaler cur-samp)))
+ (snd-display #__line__ ";scale-channel ~A[~A] cur-samp: ~A ~A" (short-file-name cursnd) curchn (sample cur-loc cursnd curchn) (* scaler cur-samp)))
(for-each
(lambda (s c amp ed fr)
(if (not (and (equal? s cursnd)
(= c curchn)))
(begin
(if (not (= (edit-position s c) ed))
- (snd-display ";scale-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";scale-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";scale-channel ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";scale-channel ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
(if (fneq (maxamp s c) amp)
- (snd-display ";scale-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
+ (snd-display #__line__ ";scale-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
(car chan-list)
(cadr chan-list)
cur-maxamps
@@ -34937,19 +35011,19 @@ EDITS: 2
(not (= (sync s) (sync cursnd))))
(begin
(if (not (= (edit-position s c) ed))
- (snd-display ";scale-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";scale-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";scale-by ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";scale-by ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
(if (fneq (maxamp s c) amp)
- (snd-display ";scale-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
+ (snd-display #__line__ ";scale-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
(begin
(if (and (not (= (edit-position s c) (+ 1 ed)))
(not (= (edit-position s c) ed)))
- (snd-display ";scale-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";scale-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";scale-by ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";scale-by ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr))
(if (fneq (maxamp s c) (* scaler amp))
- (snd-display ";scale-by ~A[~A] maxamp: ~A ~A" (short-file-name s) c (maxamp s c) (* scaler amp))))))
+ (snd-display #__line__ ";scale-by ~A[~A] maxamp: ~A ~A" (short-file-name s) c (maxamp s c) (* scaler amp))))))
(car chan-list)
(cadr chan-list)
cur-maxamps
@@ -34965,17 +35039,17 @@ EDITS: 2
(if (not (equal? s cursnd))
(begin
(if (not (= (edit-position s c) ed))
- (snd-display ";scale-sound-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";scale-sound-by ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
(if (fneq (maxamp s c) amp)
- (snd-display ";scale-sound-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
(begin
(if (and (not (= (edit-position s c) (+ 1 ed)))
(not (= (edit-position s c) ed)))
- (snd-display ";scale-sound-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";scale-sound-by ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr)))))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr)))))
(car chan-list)
(cadr chan-list)
cur-maxamps
@@ -34988,7 +35062,7 @@ EDITS: 2
((6) (let ((len (frames cursnd curchn)))
(if (> len 10000)
- (let ((beg (random (inexact->exact (floor (/ len 2))))))
+ (let ((beg (random (floor (/ len 2)))))
(delete-samples beg (+ 10 (random 100)) cursnd curchn)))))
((7) (let ((beg (random (+ (frames cursnd curchn) 100)))
@@ -35023,7 +35097,7 @@ EDITS: 2
(if (or (fneq (* val0 2) val1)
(fneq (* pval0 2) pval1))
(begin
- (snd-display ";read ptree at ~A: ~A ~A ~A ~A (~A ~A ~A ~A): ~A"
+ (snd-display #__line__ ";read ptree at ~A: ~A ~A ~A ~A (~A ~A ~A ~A): ~A"
i val0 val1 pval0 pval1
reader0 reader1 preader0 preader1
(safe-display-edits cursnd curchn))
@@ -35089,7 +35163,7 @@ EDITS: 2
(begin
(if (file-exists? "baddy.scm") (delete-file "baddy.scm"))
(save-state "baddy.scm")
- (snd-display ";read env off by ~A: ~% (~A) at ~A: ~% ~A ~A (~A ~A) [~A ~A]:~% ~A"
+ (snd-display #__line__ ";read env off by ~A: ~% (~A) at ~A: ~% ~A ~A (~A ~A) [~A ~A]:~% ~A"
(abs (- val0 val1))
e i val0 val1
reader0 reader1 e0 val00
@@ -35122,12 +35196,12 @@ EDITS: 2
(env-channel e 0 (frames cursnd curchn) cursnd curchn) ; can be a no-op
(if (and (not (= (edit-position cursnd curchn) (+ 1 cur-edit)))
(not (= (edit-position cursnd curchn) cur-edit)))
- (snd-display ";env-channel ~A[~A] edit pos: ~A ~A" (short-file-name cursnd) curchn (edit-position cursnd curchn) cur-edit))
+ (snd-display #__line__ ";env-channel ~A[~A] edit pos: ~A ~A" (short-file-name cursnd) curchn (edit-position cursnd curchn) cur-edit))
(if (not (= (frames cursnd curchn) cur-frame))
- (snd-display ";env-channel ~A[~A] frames: ~A ~A" (short-file-name cursnd) curchn (frames cursnd curchn) cur-frame))
+ (snd-display #__line__ ";env-channel ~A[~A] frames: ~A ~A" (short-file-name cursnd) curchn (frames cursnd curchn) cur-frame))
(if (> (- (maxamp cursnd curchn) .01) (* maxpt cur-amp))
(begin
- (snd-display ";env-channel ~A[~A] maxamp: ~A ~A from ~A" (short-file-name cursnd) curchn (maxamp cursnd curchn) (* maxpt cur-amp) e)
+ (snd-display #__line__ ";env-channel ~A[~A] maxamp: ~A ~A from ~A" (short-file-name cursnd) curchn (maxamp cursnd curchn) (* maxpt cur-amp) e)
(throw 'mus-error)))
(for-each
(lambda (s c amp ed fr)
@@ -35135,11 +35209,11 @@ EDITS: 2
(= c curchn)))
(begin
(if (not (= (edit-position s c) ed))
- (snd-display ";env-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";env-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";env-channel ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";env-channel ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
(if (fneq (maxamp s c) amp)
- (snd-display ";env-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
+ (snd-display #__line__ ";env-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
(car chan-list)
(cadr chan-list)
cur-maxamps
@@ -35163,7 +35237,7 @@ EDITS: 2
(set! x (+ x (+ .01 (random 1.0)))))
(reverse e1)))
(end (apply min cur-frames)) ; env-sound can lengthen a shorter sound if syncd+multichannel
- (beg (random (inexact->exact (floor (/ end 2))))))
+ (beg (random (floor (/ end 2)))))
(for-each
(lambda (s c)
(if (not (or (and (= (sync cursnd) 0)
@@ -35191,17 +35265,17 @@ EDITS: 2
(not (= (sync s) (sync cursnd))))
(begin
(if (not (= (edit-position s c) ed))
- (snd-display ";env-sound ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";env-sound ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";env-sound ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";env-sound ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
(if (fneq (maxamp s c) amp)
- (snd-display ";env-sound ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
+ (snd-display #__line__ ";env-sound ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
(begin
(if (and (not (= (edit-position s c) (+ 1 ed)))
(not (= (edit-position s c) ed)))
- (snd-display ";env-sound ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (snd-display #__line__ ";env-sound ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
(if (not (= (frames s c) fr))
- (snd-display ";env-sound ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr)))))
+ (snd-display #__line__ ";env-sound ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr)))))
(car chan-list)
(cadr chan-list)
cur-maxamps
@@ -35221,8 +35295,8 @@ EDITS: 2
(inc1 (/ len1 minlen))
(e0 (cadr env0))
(e1 (cadr env1)))
- (if (and (integer? inc0) (exact? inc0)
- (integer? inc1) (exact? inc1))
+ (if (and (integer? inc0)
+ (integer? inc1))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i (- minlen 1)))
happy)
@@ -35242,12 +35316,12 @@ EDITS: 2
(set! max1 (vct-ref e1 (+ j (* inc1 i)))))))
(if (> (abs (- max0 max1)) df)
(begin
- (snd-display ";amp-env ~A: ~A ~A" i max0 max1)
+ (snd-display #__line__ ";amp-env ~A: ~A ~A" i max0 max1)
(set! happy #f)))
(set! max0 -1.0)
(set! max1 -1.0)))
(begin
- (snd-display ";lens: ~A ~A" len0 len1)
+ (snd-display #__line__ ";lens: ~A ~A" len0 len1)
#f)))
#f)))
@@ -35267,7 +35341,7 @@ EDITS: 2
(if (> max-diff 0.0)
(list max-diff max-loc)
#f)))
-
+
(define* (edit-distance s1 c1 e1 e2 (offset 0))
(let* ((r1 (make-sampler 0 s1 c1 1 e1))
(r2 (make-sampler offset s1 c1 1 e2))
@@ -35279,8 +35353,8 @@ EDITS: 2
(f2 (r2)))
(set! sum (+ sum (abs (- (* f1 f1) (* f2 f2)))))))
(sqrt sum)))
-
-
+
+
(define (check-edit-tree expected-tree expected-vals name)
(define (vequal-at v0 v1)
(call-with-exit
@@ -35309,14 +35383,14 @@ EDITS: 2
(let* ((current-vals (channel->vct))
(len (vct-length current-vals)))
(if (and expected-vals (not (= len (vct-length expected-vals))))
- (snd-display ";~A: lengths differ: ~A ~A" name len (vct-length expected-vals))
+ (snd-display #__line__ ";~A: lengths differ: ~A ~A" name len (vct-length expected-vals))
(if (and expected-vals (not (vequal current-vals expected-vals)))
(let ((bad-data (vequal-at current-vals expected-vals)))
- (snd-display ";checking ~A, vals disagree (loc cur expect): ~A" name bad-data))
+ (snd-display #__line__ ";checking ~A, vals disagree (loc cur expect): ~A" name bad-data))
(let* ((tree (edit-tree))
(bad-data (edits-not-equal? tree expected-tree 0)))
(if bad-data
- (snd-display ";checking ~A, trees disagree (loc cur expect): ~A~% in~%~A" name bad-data (edit-tree)))
+ (snd-display #__line__ ";checking ~A, trees disagree (loc cur expect): ~A~% in~%~A" name bad-data (edit-tree)))
(if (> len 5)
(let* ((split-loc (+ 2 (random (- len 3))))
(fread (make-sampler split-loc))
@@ -35330,7 +35404,7 @@ EDITS: 2
(vct-set! split-vals i (bread)))
(if (and expected-vals (not (vequal split-vals expected-vals)))
(let ((bad-data (vequal-at split-vals expected-vals)))
- (snd-display ";checking ~A, split vals disagree (loc cur expect): ~A" name bad-data)
+ (snd-display #__line__ ";checking ~A, split vals disagree (loc cur expect): ~A" name bad-data)
(throw 'uhoh1)
)))))))))
@@ -35365,12 +35439,12 @@ EDITS: 2
((= i 8))
(let ((val (next-sample sf)))
(if (fneq (vct-ref data i) val)
- (snd-display ";~A: forward data[~D]: ~A ~A" name i val (vct-ref data i)))))
+ (snd-display #__line__ ";~A: forward data[~D]: ~A ~A" name i val (vct-ref data i)))))
(do ((i 7 (- i 1)))
((= i 0))
(let ((val (previous-sample sf)))
(if (fneq (vct-ref data i) val)
- (snd-display ";~A: backward data[~D]: ~A ~A" name i val (vct-ref data i)))))))
+ (snd-display #__line__ ";~A: backward data[~D]: ~A ~A" name i val (vct-ref data i)))))))
(define (init-sound val dur chans)
(let ((ind (new-sound "test.snd" mus-next mus-bshort 22050 chans)))
@@ -35385,11 +35459,11 @@ EDITS: 2
(if (not (vequal v (channel->vct 0 (frames) ind 0)))
(begin
(set! happy #f)
- (snd-display ";~A forth:~% current: ~A~% expected: ~A" name (channel->vct 0 (frames) ind 0) v)))
+ (snd-display #__line__ ";~A forth:~% current: ~A~% expected: ~A" name (channel->vct 0 (frames) ind 0) v)))
(if (not (vequal v (reversed-read ind 0)))
(begin
(set! happy #f)
- (snd-display ";~A back: ~A ~A" name (reversed-read ind 0) v)))
+ (snd-display #__line__ ";~A back: ~A ~A" name (reversed-read ind 0) v)))
happy))
@@ -35399,10 +35473,10 @@ EDITS: 2
(define (check-both-chans ind name f0 f1)
(let ((c0 (scan-channel f0 0 (frames) ind 0))
(c1 (scan-channel f1 0 (frames) ind 1)))
- (if c0 (snd-display ";~A swap c0: ~A" name c0))
- (if c1 (snd-display ";~A swap c1: ~A" name c1))))
+ (if c0 (snd-display #__line__ ";~A swap c0: ~A" name c0))
+ (if c1 (snd-display #__line__ ";~A swap c1: ~A" name c1))))
+
-
(define (convolve-coeffs v1 v2)
(let* ((v1-len (vct-length v1))
(v2-len (vct-length v2))
@@ -35428,7 +35502,7 @@ EDITS: 2
(lambda (func name)
(func)
(if (not (= (edit-position oboe) 0))
- (snd-display ";dur:0 ~A? ~A ~A" name (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";dur:0 ~A? ~A ~A" name (edit-position oboe) (edit-fragment))))
(list
(lambda () (scale-channel 2.0 0 0 oboe))
(lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 0 oboe))
@@ -35440,7 +35514,7 @@ EDITS: 2
(lambda () (mix-channel "pistol.snd" 0 0 oboe))
(lambda () (insert-channel "pistol.snd" 0 0 oboe))
(lambda () (reverse-channel 0 0 oboe))
- (lambda () (play-channel 0 0 oboe))
+ (lambda () (play oboe :start 0 :end 0))
(lambda () (scale-sound-by 2.0 0 0 oboe))
(lambda () (env-sound '(0 0 1 1) 0 0 oboe))
(lambda () (set-samples 0 0 (make-vct 3) oboe))
@@ -35448,7 +35522,7 @@ EDITS: 2
(lambda () (insert-silence 0 0 oboe)))
(list
"scale-channel" "env-channel" "clm-channel" "vct->channel" "smooth-channel" "pad-channel" "src-channel"
- "mix-channel" "insert-channel" "reverse-channel" "play-channel"
+ "mix-channel" "insert-channel" "reverse-channel" "play"
"scale-sound-by" "env-sound" "set-samples" "smooth-sound" "insert-silence"))
(for-each
@@ -35457,9 +35531,9 @@ EDITS: 2
func
(lambda args (car args)))))
(if (not (eq? tag 'no-such-sample))
- (snd-display ";~A beg -1->~A" name tag))
+ (snd-display #__line__ ";~A beg -1->~A" name tag))
(if (not (= (edit-position oboe) 0))
- (snd-display ";beg:-1 ~A? ~A ~A" name (edit-position oboe) (edit-fragment)))))
+ (snd-display #__line__ ";beg:-1 ~A? ~A ~A" name (edit-position oboe) (edit-fragment)))))
(list
(lambda () (scale-channel 2.0 -1 123 oboe))
(lambda () (env-channel (make-env '(0 0 1 1) :length 124) -1 123 oboe))
@@ -35484,156 +35558,154 @@ EDITS: 2
(scale-channel 2.0 12345678 123 oboe)
(if (not (= (edit-position oboe) 0))
- (snd-display ";beg:12345678 scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";beg:12345678 scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(env-channel (make-env '(0 0 1 1) :length 124) 12345678 123 oboe)
(if (not (= (edit-position oboe) 0))
- (snd-display ";beg:12345678 env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";beg:12345678 env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(smooth-channel 12345678 123 oboe)
(if (not (= (edit-position oboe) 0))
- (snd-display ";beg:12345678 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";beg:12345678 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(src-channel 2.0 12345678 123 oboe)
(if (not (= (edit-position oboe) 0))
- (snd-display ";beg:12345678 src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";beg:12345678 src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(reverse-channel 12345678 123 oboe)
(if (not (= (edit-position oboe) 0))
- (snd-display ";beg:12345678 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (play-channel 12345678 123 oboe)
+ (snd-display #__line__ ";beg:12345678 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (play oboe :start 12345678 :end (+ 12345678 123))
(scale-channel 2.0 0 123 oboe 0)
(if (not (= (edit-position oboe) 1))
- (snd-display ";oboe scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0)
(if (not (= (edit-position oboe) 2))
- (snd-display ";oboe env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(clm-channel (make-oscil) 0 123 oboe 0)
(if (not (= (edit-position oboe) 3))
- (snd-display ";oboe clm-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe clm-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(vct->channel (make-vct 3) 0 123 oboe 0)
(if (not (= (edit-position oboe) 4))
- (snd-display ";oboe vct->channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe vct->channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(smooth-channel 0 123 oboe 0)
(if (not (= (edit-position oboe) 5))
- (snd-display ";oboe smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(pad-channel 0 123 oboe 0)
(if (not (= (edit-position oboe) 6))
- (snd-display ";oboe pad-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe pad-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(src-channel 2.0 0 123 oboe 0)
(if (not (= (edit-position oboe) 7))
- (snd-display ";oboe src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(mix-channel "pistol.snd" 0 123 oboe 0)
(if (not (= (edit-position oboe) 8))
- (snd-display ";oboe mix-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe mix-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(insert-channel "pistol.snd" 0 123 oboe 0)
(if (not (= (edit-position oboe) 9))
- (snd-display ";oboe insert-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe insert-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(reverse-channel 0 123 oboe 0)
(if (not (= (edit-position oboe) 10))
- (snd-display ";oboe reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (snd-display #__line__ ";oboe reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
(let* ((rd (make-sampler 0))
(sr (make-src :srate 2.0 :input (lambda (dir) (rd)))))
(clm-channel sr 0 12345 oboe 0)
(if (not (= (edit-position oboe) 11))
- (snd-display ";oboe clm-channel src? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";oboe clm-channel src? ~A ~A" (edit-position oboe) (edit-fragment))))
(let* ((rd (make-sampler 0))
(sr (make-granulate :expansion 2.0 :input (lambda (dir) (rd)))))
(clm-channel sr 0 12345 oboe 0)
(if (not (= (edit-position oboe) 12))
- (snd-display ";oboe clm-channel granulate? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";oboe clm-channel granulate? ~A ~A" (edit-position oboe) (edit-fragment))))
(let* ((rd (make-sampler 0))
(flt (vct 1.0 0.0 0.0 0.0))
(sr (make-convolve :input (lambda (dir) (rd)) :filter flt)))
(clm-channel sr 0 12345 oboe 0)
(if (not (= (edit-position oboe) 13))
- (snd-display ";oboe clm-channel convolve? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";oboe clm-channel convolve? ~A ~A" (edit-position oboe) (edit-fragment))))
(let* ((rd (make-sampler 0))
(sr (make-phase-vocoder :input (lambda (dir) (rd)))))
(clm-channel sr 0 12345 oboe 0)
(if (not (= (edit-position oboe) 14))
- (snd-display ";oboe clm-channel phase-vocoder? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";oboe clm-channel phase-vocoder? ~A ~A" (edit-position oboe) (edit-fragment))))
(revert-sound)
(let ((tag (catch #t (lambda () (scale-channel 2.0 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity)) (snd-display ";bad edpos scale-channel: ~A" tag))
+ (if (not (eq? tag 'bad-arity)) (snd-display #__line__ ";bad edpos scale-channel: ~A" tag))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func scale-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func scale-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func env-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func env-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (clm-channel (make-oscil) 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func clm-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func clm-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (vct->channel (make-vct 3) 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func vct->channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func vct->channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (smooth-channel 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (pad-channel 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func pad-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func pad-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (src-channel 2.0 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func src-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func src-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (mix-channel "pistol.snd" 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func mix-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func mix-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (insert-channel "pistol.snd" 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func insert-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func insert-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (reverse-channel 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos:func reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos:func reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (scale-channel 2.0 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-edit)) (snd-display ";bad edpos scale-channel: ~A" tag))
+ (if (not (eq? tag 'no-such-edit)) (snd-display #__line__ ";bad edpos scale-channel: ~A" tag))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 scale-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 scale-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 env-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 env-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (clm-channel (make-oscil) 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 clm-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 clm-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (vct->channel (make-vct 3) 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 vct->channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 vct->channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (smooth-channel 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (pad-channel 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 pad-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 pad-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (src-channel 2.0 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 src-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 src-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (mix-channel "pistol.snd" 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 mix-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 mix-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (insert-channel "pistol.snd" 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 insert-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (snd-display #__line__ ";edpos 123 insert-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(let ((tag (catch #t (lambda () (reverse-channel 0 123 oboe 0 123)) (lambda args (car args)))))
(if (not (= (edit-position oboe) 0))
- (snd-display ";edpos 123 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (play-channel 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-edit)) (snd-display ";bad edpos play-channel: ~A" tag)))
+ (snd-display #__line__ ";edpos 123 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
(revert-sound oboe)
(let ((oldv (channel->vct 1000 10 oboe)))
(mix-channel "oboe.snd" 0)
(vct-scale! oldv 2.0)
(if (not (vequal oldv (channel->vct 1000 10 oboe)))
- (snd-display ";mix-channel at 0: ~A ~A" oldv (channel->vct 1000 10 oboe)))
+ (snd-display #__line__ ";mix-channel at 0: ~A ~A" oldv (channel->vct 1000 10 oboe)))
(revert-sound oboe)
(vct-scale! oldv 0.5)
(insert-channel "oboe.snd" 0)
(if (not (vequal oldv (channel->vct 1000 10 oboe)))
- (snd-display ";insert-channel at 0: ~A ~A" oldv (channel->vct 1000 10 oboe)))
+ (snd-display #__line__ ";insert-channel at 0: ~A ~A" oldv (channel->vct 1000 10 oboe)))
(if (not (= (frames oboe 0) (* 2 (frames oboe 0 0))))
- (snd-display ";insert-channel frames: ~A ~A" (frames oboe 0) (frames oboe 0 0)))
+ (snd-display #__line__ ";insert-channel frames: ~A ~A" (frames oboe 0) (frames oboe 0 0)))
(revert-sound oboe))
(close-sound oboe)
-
+
(let* ((ind (new-sound "test.snd" :size 10 :channels 2)))
(set! (sample 3 ind 0) .5)
(set! (sample 2 ind 1) -.4)
@@ -35641,44 +35713,44 @@ EDITS: 2
(revert-sound ind)
(let ((val (mix-channel "fmv.snd")))
(if (mix? val)
- (snd-display ";mix-channel returned a mix: ~A?" val)))
+ (snd-display #__line__ ";mix-channel returned a mix: ~A?" val)))
(if (not (vequal (channel->vct 0 #f ind 1) (make-vct 10 0.0)))
- (snd-display ";mix-channel mixed channel 1: A?" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";mix-channel mixed channel 1: A?" (channel->vct 0 #f ind 1)))
(if (not (vequal (channel->vct 0 #f ind 0) (vct 0 0 0 .5 0 0 0 0 0 0)))
- (snd-display ";mix-channel chan 0: ~A" (channel->vct 0 #f ind 0)))
+ (snd-display #__line__ ";mix-channel chan 0: ~A" (channel->vct 0 #f ind 0)))
(revert-sound ind)
(let ((val (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0)))
(if (mix? val)
- (snd-display ";mix-channel 2 returned a mix: ~A?" val)))
+ (snd-display #__line__ ";mix-channel 2 returned a mix: ~A?" val)))
(if (not (vequal (channel->vct 0 #f ind 1) (make-vct 10 0.0)))
- (snd-display ";mix-channel mixed channel 1a: A?" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";mix-channel mixed channel 1a: A?" (channel->vct 0 #f ind 1)))
(if (not (vequal (channel->vct 0 #f ind 0) (vct -.4 0 0 0 0 0 0 0 0 0)))
- (snd-display ";mix-channel chan 0a: ~A" (channel->vct 0 #f ind 0)))
+ (snd-display #__line__ ";mix-channel chan 0a: ~A" (channel->vct 0 #f ind 0)))
(revert-sound ind)
(set! (sample 2 ind 1) -.4)
(let ((val (mix-channel (list ind 2 1) 0 #f ind 0 -1 #t)))
(if (not (mix? val))
- (snd-display ";mix-channel with-tag: ~A" val)))
+ (snd-display #__line__ ";mix-channel with-tag: ~A" val)))
(if (not (vequal (channel->vct 0 #f ind 1) (vct 0 0 -.4 0 0 0 0 0 0 0)))
- (snd-display ";mix-channel mixed channel 1b: A?" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";mix-channel mixed channel 1b: A?" (channel->vct 0 #f ind 1)))
(if (not (vequal (channel->vct 0 #f ind 0) (vct -.4 0 0 0 0 0 0 0 0 0)))
- (snd-display ";mix-channel chan 0b: ~A" (channel->vct 0 #f ind 0)))
+ (snd-display #__line__ ";mix-channel chan 0b: ~A" (channel->vct 0 #f ind 0)))
(revert-sound ind)
(let ((val (car (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0 -1 #t))))
(if (not (mix? val))
- (snd-display ";mix-channel file with-tag: ~A" val)))
+ (snd-display #__line__ ";mix-channel file with-tag: ~A" val)))
(if (not (vequal (channel->vct 0 #f ind 1) (make-vct 10 0.0)))
- (snd-display ";mix-channel mixed channel 1c: A?" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";mix-channel mixed channel 1c: A?" (channel->vct 0 #f ind 1)))
(if (not (vequal (channel->vct 0 #f ind 0) (vct -.4 0 0 0 0 0 0 0 0 0)))
- (snd-display ";mix-channel chan 0c: ~A" (channel->vct 0 #f ind 0)))
+ (snd-display #__line__ ";mix-channel chan 0c: ~A" (channel->vct 0 #f ind 0)))
(revert-sound ind)
(let ((val (car (mix-channel (list "fmv.snd") 0 #f ind 1 -1 #t))))
(if (not (mix? val))
- (snd-display ";mix-channel file 1 with-tag: ~A" val)))
+ (snd-display #__line__ ";mix-channel file 1 with-tag: ~A" val)))
(if (not (vequal (channel->vct 0 #f ind 0) (make-vct 10 0.0)))
- (snd-display ";mix-channel mixed channel 0d: A?" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";mix-channel mixed channel 0d: A?" (channel->vct 0 #f ind 1)))
(if (not (vequal (channel->vct 0 #f ind 1) (vct 0 0 0 .5 0 0 0 0 0 0)))
- (snd-display ";mix-channel chan 1d: ~A" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";mix-channel chan 1d: ~A" (channel->vct 0 #f ind 1)))
(revert-sound ind)
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(close-sound ind))
@@ -35687,47 +35759,47 @@ EDITS: 2
(let ((ind (new-sound "fmv.snd"))
(v0 (vct-fill! (make-vct 20) 1.0)))
(vct->channel v0)
- (if (not (= (frames) 20)) (snd-display ";vct->channel new 20: ~A" (frames)))
- (if (fneq (maxamp) 1.0) (snd-display ";vct 1->new: ~A" (maxamp)))
+ (if (not (= (frames) 20)) (snd-display #__line__ ";vct->channel new 20: ~A" (frames)))
+ (if (fneq (maxamp) 1.0) (snd-display #__line__ ";vct 1->new: ~A" (maxamp)))
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20))
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
- (snd-display ";env-channel step 1: ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20) 8)
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1)))
- (snd-display ";env-channel step 1 at 8: ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1 at 8: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12))
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
- (snd-display ";env-channel step 1 at 0: ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1 at 0: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4)
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
- (snd-display ";env-channel step 1 at 4: ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1 at 4: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4 3)
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)))
- (snd-display ";env-channel step 1 at 4 by 3: ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1 at 4 by 3: ~A" v1)))
(undo)
(env-channel (make-env '(0 1 1 0 2 0) :base 0 :length 8) 0 12)
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)))
- (snd-display ";env-channel step 1 at 0 for 7: ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1 at 0 for 7: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1 3 0 4 0) :base 0 :length 20))
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0)))
- (snd-display ";env-channel step 1: ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1: ~A" v1)))
(env-channel (make-env '(0 0 1 .5 2 .25 3 0 4 0) :base 0 :length 21))
(let ((v1 (channel->vct)))
(if (not (vequal v1 (vct 0 0 0 0 0 0 .5 .5 .5 .5 .5 .25 .25 .25 .25 0 0 0 0 0)))
- (snd-display ";env-channel step 1 (.5): ~A" v1)))
+ (snd-display #__line__ ";env-channel step 1 (.5): ~A" v1)))
(close-sound ind))
(set! (x-axis-style) x-axis-as-percentage)
@@ -35738,17 +35810,17 @@ EDITS: 2
(set! (sync ind) 64)
(insert-sound "2.snd")
(insert-sound "2.snd")
- (if (not (= (frames) (* 3 fr))) (snd-display ";2.snd 3x = ~A ~A" fr (frames)))
- (if (not (= (frames ind 0) (frames ind 1))) (snd-display ";insert sync'd: ~A ~A" (frames ind 0) (frames ind 1)))
+ (if (not (= (frames) (* 3 fr))) (snd-display #__line__ ";2.snd 3x = ~A ~A" fr (frames)))
+ (if (not (= (frames ind 0) (frames ind 1))) (snd-display #__line__ ";insert sync'd: ~A ~A" (frames ind 0) (frames ind 1)))
(swap-channels)
(if (or (fneq m0 (maxamp ind 1)) (fneq m1 (maxamp ind 0)))
- (snd-display ";swapped: ~A ~A -> ~A ~A" m0 m1 (maxamp ind 0) (maxamp ind 1)))
+ (snd-display #__line__ ";swapped: ~A ~A -> ~A ~A" m0 m1 (maxamp ind 0) (maxamp ind 1)))
(close-sound ind))
(set! (x-axis-style) x-axis-in-seconds)
(let ((new-snd (mono-files->stereo "test.snd" "oboe.snd" "pistol.snd")))
- (if (not (= (channels new-snd) 2)) (snd-display ";mono-files->stereo not stereo? ~A" (channels new-snd)))
- (if (not (string=? (short-file-name new-snd) "test.snd")) (snd-display ";mono-files->stereo filename: ~A" (short-file-name new-snd)))
- (if (not (= (frames new-snd) 50828)) (snd-display ";mono-files->stereo frames: ~A" (frames new-snd)))
+ (if (not (= (channels new-snd) 2)) (snd-display #__line__ ";mono-files->stereo not stereo? ~A" (channels new-snd)))
+ (if (not (string=? (short-file-name new-snd) "test.snd")) (snd-display #__line__ ";mono-files->stereo filename: ~A" (short-file-name new-snd)))
+ (if (not (= (frames new-snd) 50828)) (snd-display #__line__ ";mono-files->stereo frames: ~A" (frames new-snd)))
(close-sound new-snd))
(let ((oboe0 (open-sound "oboe.snd"))
@@ -35758,7 +35830,7 @@ EDITS: 2
(func0 #f #f oboe0)
(func1 #f #f oboe1)
(if (not (vequal (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (snd-display ";~A via #f: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
+ (snd-display #__line__ ";~A via #f: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
(revert-sound oboe0)
(revert-sound oboe1)
(select-sound oboe0)
@@ -35766,13 +35838,13 @@ EDITS: 2
(select-sound oboe1)
(func1)
(if (not (vequal (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (snd-display ";~A via none: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
+ (snd-display #__line__ ";~A via none: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
(revert-sound oboe0)
(revert-sound oboe1)
(func0 0 (frames oboe0) oboe0)
(func1 0 (frames oboe1) oboe1)
(if (not (vequal (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (snd-display ";~A via frames: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
+ (snd-display #__line__ ";~A via frames: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
(revert-sound oboe0)
(revert-sound oboe1))
@@ -35859,7 +35931,7 @@ EDITS: 2
(lambda (func name)
(let ((tag (catch #t (lambda () (func ind)) (lambda args (car args)))))
(if (not (eq? tag 'no-such-edit))
- (snd-display ";~A upon about-to-be-clobbered data: ~A" name tag))))
+ (snd-display #__line__ ";~A upon about-to-be-clobbered data: ~A" name tag))))
(list (lambda (n) (scale-channel .5 0 #f n 0 2))
(lambda (n) (env-channel '(0 0 1 1 2 0) 0 #f n 0 2))
(if (> (optimization) 0)
@@ -35882,7 +35954,7 @@ EDITS: 2
(ptree-channel (lambda (y) (* y .5)))
(insert-silence 100 200)
(if (fneq (sample 500) 0.5)
- (snd-display ";trailing ptree rmp0 trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree rmp0 trouble: ~A" (sample 500)))
(revert-sound ind)
(insert-silence 0 1000)
@@ -35891,10 +35963,10 @@ EDITS: 2
(ptree-channel (lambda (y) (* y .5)))
(insert-silence 100 200)
(if (fneq (sample 500) 0.25)
- (snd-display ";trailing ptree scaled rmp0 trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree scaled rmp0 trouble: ~A" (sample 500)))
(scale-by 2.0)
(if (fneq (sample 500) 0.5)
- (snd-display ";trailing ptree post scaled rmp0 trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree post scaled rmp0 trouble: ~A" (sample 500)))
(revert-sound ind)
(insert-silence 0 1000)
@@ -35902,9 +35974,9 @@ EDITS: 2
(ptree-channel (lambda (y) (* y .5)))
(delete-samples 100 200)
(if (fneq (sample 500) 0.5)
- (snd-display ";trailing ptree post delete rmp0 trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree post delete rmp0 trouble: ~A" (sample 500)))
(if (fneq (sample 0) 0.5)
- (snd-display ";trailing ptree pre delete rmp0 trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree pre delete rmp0 trouble: ~A" (sample 500)))
(revert-sound ind)
(insert-silence 0 1000)
@@ -35912,9 +35984,9 @@ EDITS: 2
(ptree-channel (lambda (y) (* y .5)))
(set! (sample 100) .95)
(if (fneq (sample 500) 0.5)
- (snd-display ";trailing ptree post change rmp0 trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree post change rmp0 trouble: ~A" (sample 500)))
(if (fneq (sample 0) 0.5)
- (snd-display ";trailing ptree pre change rmp0 trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree pre change rmp0 trouble: ~A" (sample 500)))
(revert-sound ind)
(insert-silence 0 1000)
@@ -35922,9 +35994,9 @@ EDITS: 2
(ptree-channel (lambda (y) (* y .1)))
(delete-samples 100 200)
(if (fneq (sample 500) 0.1)
- (snd-display ";trailing ptree post delete(1) loc trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree post delete(1) loc trouble: ~A" (sample 500)))
(if (fneq (sample 0) 0.1)
- (snd-display ";trailing ptree pre delete(1) loc trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";trailing ptree pre delete(1) loc trouble: ~A" (sample 500)))
(insert-silence 0 1000)
(map-chan (lambda (y) 1.0))
@@ -35932,7 +36004,7 @@ EDITS: 2
(ptree-channel (lambda (y) (* y .5)))
(scale-by .5)
(if (fneq (sample 500) 0.125)
- (snd-display ";scl-ptree-scl trouble: ~A" (sample 500)))
+ (snd-display #__line__ ";scl-ptree-scl trouble: ~A" (sample 500)))
(revert-sound ind)
(insert-silence 0 1000)
@@ -35944,7 +36016,7 @@ EDITS: 2
(fneq (sample 500) 0.5)
(fneq (sample 250) 0.25)
(fneq (sample 750) 0.25))
- (snd-display ";ptree-env trouble: ~A"
+ (snd-display #__line__ ";ptree-env trouble: ~A"
(map sample (list 0 999 500 250 750))))
(insert-silence 0 1000)
@@ -35955,7 +36027,7 @@ EDITS: 2
(if (or (fneq (sample 500) 0.5)
(fneq (sample 50) 0.5)
(fneq (sample 150) 0.25))
- (snd-display ";ptree-scl-selection trouble: ~A" (map sample (list 500 50 150))))
+ (snd-display #__line__ ";ptree-scl-selection trouble: ~A" (map sample (list 500 50 150))))
(revert-sound ind)
(close-sound ind))
@@ -35975,10 +36047,10 @@ EDITS: 2
(load (string-append cwd "hiho.scm"))
(set! ind (find-sound "oboe.snd"))
(if (not (sound? ind))
- (snd-display ";save hiho failed?")
+ (snd-display #__line__ ";save hiho failed?")
(let ((new-vals (channel->vct (- 12345 50) 200 ind 0)))
(if (not (vequal vals new-vals))
- (snd-display ";save state hiho vals: ~A ~A" vals new-vals))))
+ (snd-display #__line__ ";save state hiho vals: ~A ~A" vals new-vals))))
(close-sound ind))
(set! (save-dir) old-save-dir))
@@ -35993,7 +36065,7 @@ EDITS: 2
(load (string-append cwd "s61.scm"))
(set! ind (find-sound "oboe.snd"))
(if (fneq (maxamp ind) val)
- (snd-display ";saved ~A max: ~A ~A (at ~A of ~A)"
+ (snd-display #__line__ ";saved ~A max: ~A ~A (at ~A of ~A)"
name (maxamp ind) val (edit-position ind 0) (display-edits ind 0)))
(revert-sound ind))
(list (lambda (ind)
@@ -36056,23 +36128,23 @@ EDITS: 2
(let ((ptv (samples->vct 0 (frames ind-ptree) ind-ptree 0))
(ptc (samples->vct 0 (frames ind-closure) ind-closure 0))
(ptm (samples->vct 0 (frames ind-map) ind-map 0)))
- (if (not (vequal ptv vc)) (snd-display ";~A ptree: ~A ~A" name ptv vc))
- (if (not (vequal ptc vc)) (snd-display ";~A closure: ~A ~A" name ptc vc))
- (if (not (vequal ptm vc)) (snd-display ";~A map: ~A ~A" name ptm vc)))
+ (if (not (vequal ptv vc)) (snd-display #__line__ ";~A ptree: ~A ~A" name ptv vc))
+ (if (not (vequal ptc vc)) (snd-display #__line__ ";~A closure: ~A ~A" name ptc vc))
+ (if (not (vequal ptm vc)) (snd-display #__line__ ";~A map: ~A ~A" name ptm vc)))
(let ((ptv (reversed-read ind-ptree 0))
(ptc (reversed-read ind-closure 0))
(ptm (reversed-read ind-map 0)))
- (if (not (vequal ptv vc)) (snd-display ";reversed ~A ptree: ~A ~A" name ptv vc))
- (if (not (vequal ptc vc)) (snd-display ";reversed ~A closure: ~A ~A" name ptc vc))
- (if (not (vequal ptm vc)) (snd-display ";reversed ~A map: ~A ~A" name ptm vc)))
+ (if (not (vequal ptv vc)) (snd-display #__line__ ";reversed ~A ptree: ~A ~A" name ptv vc))
+ (if (not (vequal ptc vc)) (snd-display #__line__ ";reversed ~A closure: ~A ~A" name ptc vc))
+ (if (not (vequal ptm vc)) (snd-display #__line__ ";reversed ~A map: ~A ~A" name ptm vc)))
(let ((ptv (zigzag-read ind-ptree 0))
(ptc (zigzag-read ind-closure 0))
(ptm (zigzag-read ind-map 0)))
- (if (not (vequal ptv vc)) (snd-display ";zigzag ~A ptree: ~A ~A" name ptv vc))
- (if (not (vequal ptc vc)) (snd-display ";zigzag ~A closure: ~A ~A" name ptc vc))
- (if (not (vequal ptm vc)) (snd-display ";zigzag ~A map: ~A ~A" name ptm vc)))
+ (if (not (vequal ptv vc)) (snd-display #__line__ ";zigzag ~A ptree: ~A ~A" name ptv vc))
+ (if (not (vequal ptc vc)) (snd-display #__line__ ";zigzag ~A closure: ~A ~A" name ptc vc))
+ (if (not (vequal ptm vc)) (snd-display #__line__ ";zigzag ~A map: ~A ~A" name ptm vc)))
(set! (edit-position ind-ptree 0) edpt)
(set! (edit-position ind-closure 0) edcl)
@@ -36800,7 +36872,7 @@ EDITS: 2
(fneq (sample 21) .632)
(fneq (sample 31) .822)
(fneq (sample 50) 1.0))
- (snd-display ";cosine-chan with edits: ~A"
+ (snd-display #__line__ ";cosine-chan with edits: ~A"
(map sample (list 12 0 25 30 20 21 31 50))))
(close-sound ind))
@@ -36810,7 +36882,7 @@ EDITS: 2
(set! (sample 100) .05)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";scale+ptree+set -> ~A" mx)))
+ (snd-display #__line__ ";scale+ptree+set -> ~A" mx)))
(if (and (> (optimization) 0)
(not (string=? (display-edits) (string-append "
EDITS: 3
@@ -36833,119 +36905,119 @@ EDITS: 3
(at 101, cp->sounds[0][101:50827, 1.000, loc: 0, pos: 101, scl: 0.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
(at 50828, end_mark)
"))))
- (snd-display ";ptree split: ~A" (display-edits)))
+ (snd-display #__line__ ";ptree split: ~A" (display-edits)))
(undo)
(delete-sample 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";scale+ptree+delete -> ~A" mx)))
+ (snd-display #__line__ ";scale+ptree+delete -> ~A" mx)))
(undo)
(insert-samples 100 3 (make-vct 3 .01))
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";scale+ptree+insert -> ~A" mx)))
+ (snd-display #__line__ ";scale+ptree+insert -> ~A" mx)))
(undo)
(mix-vct (make-vct 3 .01) 100)
(let ((mx (maxamp)))
(if (fneq mx .11)
- (snd-display ";scale+ptree+mix -> ~A" mx)))
+ (snd-display #__line__ ";scale+ptree+mix -> ~A" mx)))
(undo)
(ptree-channel (lambda (y) .01) 100 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";scale+ptree+ptree -> ~A" mx)))
+ (snd-display #__line__ ";scale+ptree+ptree -> ~A" mx)))
(undo)
(env-channel '(0 0 1 1) 100 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";scale+ptree+env -> ~A" mx)))
+ (snd-display #__line__ ";scale+ptree+env -> ~A" mx)))
(revert-sound)
(scale-by 0.01)
(ptree-channel (lambda (y) .1))
(set! (sample 100) .05)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(1)scale+ptree+set -> ~A" mx)))
+ (snd-display #__line__ ";(1)scale+ptree+set -> ~A" mx)))
(undo)
(delete-sample 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(1)scale+ptree+delete -> ~A" mx)))
+ (snd-display #__line__ ";(1)scale+ptree+delete -> ~A" mx)))
(undo)
(insert-samples 100 3 (make-vct 3 .01))
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(1)scale+ptree+insert -> ~A" mx)))
+ (snd-display #__line__ ";(1)scale+ptree+insert -> ~A" mx)))
(undo)
(mix-vct (make-vct 3 .01) 100)
(let ((mx (maxamp)))
(if (fneq mx .11)
- (snd-display ";(1)scale+ptree+mix -> ~A" mx)))
+ (snd-display #__line__ ";(1)scale+ptree+mix -> ~A" mx)))
(revert-sound)
(ptree-channel (lambda (y) .1))
(set! (sample 100) .05)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(2)scale+ptree+set -> ~A" mx)))
+ (snd-display #__line__ ";(2)scale+ptree+set -> ~A" mx)))
(undo)
(delete-sample 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(2)scale+ptree+delete -> ~A" mx)))
+ (snd-display #__line__ ";(2)scale+ptree+delete -> ~A" mx)))
(undo)
(insert-samples 100 3 (make-vct 3 .01))
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(2)scale+ptree+insert -> ~A" mx)))
+ (snd-display #__line__ ";(2)scale+ptree+insert -> ~A" mx)))
(undo)
(mix-vct (make-vct 3 .01) 100)
(let ((mx (maxamp)))
(if (fneq mx .11)
- (snd-display ";(2)scale+ptree+mix -> ~A" mx)))
+ (snd-display #__line__ ";(2)scale+ptree+mix -> ~A" mx)))
(revert-sound)
(env-sound '(0 0 1 .01 2 0))
(ptree-channel (lambda (y) .1))
(set! (sample 100) .05)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(3)env+ptree+set -> ~A" mx)))
+ (snd-display #__line__ ";(3)env+ptree+set -> ~A" mx)))
(undo)
(delete-sample 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(3)env+ptree+delete -> ~A" mx)))
+ (snd-display #__line__ ";(3)env+ptree+delete -> ~A" mx)))
(undo)
(insert-samples 100 3 (make-vct 3 .01))
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(3)env+ptree+insert -> ~A" mx)))
+ (snd-display #__line__ ";(3)env+ptree+insert -> ~A" mx)))
(undo)
(mix-vct (make-vct 3 .01) 100)
(let ((mx (maxamp)))
(if (fneq mx .11)
- (snd-display ";(3)env+ptree+mix -> ~A" mx)))
+ (snd-display #__line__ ";(3)env+ptree+mix -> ~A" mx)))
(revert-sound)
(env-sound '(0 0 1 .679 2 0))
(set! (sample 100) .05)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(1)env+set -> ~A" mx)))
+ (snd-display #__line__ ";(1)env+set -> ~A" mx)))
(undo)
(delete-sample 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(1)env+delete -> ~A" mx)))
+ (snd-display #__line__ ";(1)env+delete -> ~A" mx)))
(undo)
(insert-samples 100 3 (make-vct 3 .01))
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(1)env+insert -> ~A" mx)))
+ (snd-display #__line__ ";(1)env+insert -> ~A" mx)))
(undo)
(mix-vct (make-vct 3 .01) 100)
(let ((mx (maxamp)))
(if (fneq mx .1)
- (snd-display ";(1)env+mix -> ~A" mx)))
+ (snd-display #__line__ ";(1)env+mix -> ~A" mx)))
(revert-sound)
(close-sound ind))
@@ -36959,7 +37031,7 @@ EDITS: 3
(smooth-channel-via-ptree 0 99)
(let ((diff (vct-peak (vct-subtract! orig-data (channel->vct)))))
(if (> diff .00001)
- (snd-display ";smooth-channel-via-ptree diff: ~A" diff))))
+ (snd-display #__line__ ";smooth-channel-via-ptree diff: ~A" diff))))
(close-sound ind))
(set! (x-axis-style) x-axis-in-beats)
@@ -36967,7 +37039,7 @@ EDITS: 3
(reverse-channel 500000 1000000)
(set! (sample 0 ind 0 current-edit-position) .1)
(if (fneq (sample 0 ind 0 current-edit-position) .1)
- (snd-display ";set sample + edpos: ~A" (sample 0 ind 0 current-edit-position)))
+ (snd-display #__line__ ";set sample + edpos: ~A" (sample 0 ind 0 current-edit-position)))
(close-sound ind))
(set! (x-axis-style) x-axis-in-seconds)
@@ -36994,10 +37066,10 @@ EDITS: 3
(lambda (posfunc)
(let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
(if (not (vequal (channel->vct 0 (frames ind chn) ind chn 0) (vct 0.0)))
- (snd-display ";start bad: ~A" (channel->vct 0 (frames ind chn) ind chn 0)))
+ (snd-display #__line__ ";start bad: ~A" (channel->vct 0 (frames ind chn) ind chn 0)))
(set! (sample 0 ind chn) .1)
(if (not (vequal (channel->vct 0 (frames ind chn) ind chn) (vct 0.1)))
- (snd-display ";set bad: ~A" (channel->vct 0 (frames ind chn) ind chn)))
+ (snd-display #__line__ ";set bad: ~A" (channel->vct 0 (frames ind chn) ind chn)))
(pad-channel 0 1 ind chn (posfunc))
(let ((pos (posfunc))) (if (procedure? pos)
(set! pos (pos ind chn)))
@@ -37009,7 +37081,7 @@ EDITS: 3
(not (vequal data (vct 0.0 0.1))))
(and (= pos (- (edit-position ind chn) 1))
(not (vequal data (vct 0.0 0.0)))))
- (snd-display ";pos[~A]: edpos ~A of ~A, pad result[~A, ~A]: ~A"
+ (snd-display #__line__ ";pos[~A]: edpos ~A of ~A, pad result[~A, ~A]: ~A"
chn pos (edit-position ind chn) (frames ind chn pos) (frames ind chn) data))
(if (> (chans ind) 1)
(do ((i 0 (+ 1 i)))
@@ -37017,7 +37089,7 @@ EDITS: 3
(if (not (= i chn))
(let ((data (channel->vct 0 (frames ind i) ind i)))
(if (not (vequal data (vct 0.0)))
- (snd-display ";pad[~A / ~A] empty: ~A" i chn data))))))))))
+ (snd-display #__line__ ";pad[~A / ~A] empty: ~A" i chn data))))))))))
(lambda (posfunc)
(let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
(set! (sample 0 ind chn) .1)
@@ -37032,7 +37104,7 @@ EDITS: 3
(not (vequal data (vct 0.2))))
(and (= pos (- (edit-position ind chn) 1))
(not (vequal data (vct 0.0)))))
- (snd-display ";pos[~A]: edpos ~A of ~A, set *2 result[~A, ~A]: ~A"
+ (snd-display #__line__ ";pos[~A]: edpos ~A of ~A, set *2 result[~A, ~A]: ~A"
chn pos (edit-position ind chn) (frames ind chn pos) (frames ind chn) data))
(if (> (chans ind) 1)
(do ((i 0 (+ 1 i)))
@@ -37040,37 +37112,37 @@ EDITS: 3
(if (not (= i chn))
(let ((data (channel->vct 0 (frames ind i) ind i)))
(if (not (vequal data (vct 0.0)))
- (snd-display ";scale[~A / ~A] empty: ~A" i chn data)))))))))))))
+ (snd-display #__line__ ";scale[~A / ~A] empty: ~A" i chn data)))))))))))))
(list "2a.snd" "1a.snd" "4a.snd"))
(close-sound ind)))
(list 1 2 4))
(let ((ind (open-sound "oboe.snd")))
(map-channel (lambda (y) #f))
- (if (not (= (frames ind) 0)) (snd-display ";map-channel #f frames: ~A" (frames ind)))
- (if (equal? (edits ind) (list 0 0)) (snd-display ";map-channel #f edits backed up"))
+ (if (not (= (frames ind) 0)) (snd-display #__line__ ";map-channel #f frames: ~A" (frames ind)))
+ (if (equal? (edits ind) (list 0 0)) (snd-display #__line__ ";map-channel #f edits backed up"))
(undo 1 ind)
- (if (= (frames ind) 0) (snd-display ";map-channel #f frames after undo: ~A" (frames ind)))
+ (if (= (frames ind) 0) (snd-display #__line__ ";map-channel #f frames after undo: ~A" (frames ind)))
(let ((tag (catch #t (lambda () (map-channel (lambda (y) "hiho"))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-type)) (snd-display ";map-channel bad-type: ~A" tag)))
+ (if (not (eq? tag 'bad-type)) (snd-display #__line__ ";map-channel bad-type: ~A" tag)))
(let* ((ctr 0)
(tag (catch #t (lambda () (scan-channel (lambda (y) (set! ctr (+ 1 ctr)) (asdf)))) (lambda args (car args)))))
- (if (not (= ctr 1)) (snd-display ";scan-channel error exit: ~A" ctr))
+ (if (not (= ctr 1)) (snd-display #__line__ ";scan-channel error exit: ~A" ctr))
(if (and (not (eq? tag 'unbound-variable))
(not (eq? tag 'syntax-error))
(not (eq? tag 'error)))
- (snd-display ";scan-channel unbound: ~A" tag)))
- (let ((val (scan-channel (lambda (y) #f)))) (if val (snd-display ";scan-channel func #f: ~A" val)))
- (let ((val (scan-channel (lambda (y) #f) 1234))) (if val (snd-display ";scan-channel func #f with beg: ~A" val)))
- (let ((val (scan-channel (lambda (y) #f) 1234 4321))) (if val (snd-display ";scan-channel func #f with beg+dur: ~A" val)))
+ (snd-display #__line__ ";scan-channel unbound: ~A" tag)))
+ (let ((val (scan-channel (lambda (y) #f)))) (if val (snd-display #__line__ ";scan-channel func #f: ~A" val)))
+ (let ((val (scan-channel (lambda (y) #f) 1234))) (if val (snd-display #__line__ ";scan-channel func #f with beg: ~A" val)))
+ (let ((val (scan-channel (lambda (y) #f) 1234 4321))) (if val (snd-display #__line__ ";scan-channel func #f with beg+dur: ~A" val)))
(revert-sound ind)
(let ((del (make-delay 1000))
(len (frames)))
(clm-channel del 0 (frames) ind 0 0 2000)
(if (not (= (frames ind) (+ 2000 len)))
- (snd-display ";clm-channel overlap length: ~A ~A" len (frames)))
+ (snd-display #__line__ ";clm-channel overlap length: ~A ~A" len (frames)))
(if (not (equal? (edit-tree) '((0 1 0 52827 1.0 0.0 0.0 0) (52828 -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";clm-channel overlaps: ~A" (edit-tree)))
+ (snd-display #__line__ ";clm-channel overlaps: ~A" (edit-tree)))
(let ((reader (make-sampler 0))
(preader (make-sampler 0 ind 0 1 0))
(happy #t))
@@ -37079,7 +37151,7 @@ EDITS: 3
(let ((val (reader)))
(if (fneq val 0.0)
(begin
- (snd-display ";clm-channel overlap delayed: ~A: ~A" i val)
+ (snd-display #__line__ ";clm-channel overlap delayed: ~A: ~A" i val)
(set! happy #f)))))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i len)))
@@ -37087,13 +37159,13 @@ EDITS: 3
(val1 (reader)))
(if (fneq val0 val1)
(begin
- (snd-display ";clm-channel overlap main: ~A: ~A ~A" (+ i 1000) val0 val1)
+ (snd-display #__line__ ";clm-channel overlap main: ~A: ~A ~A" (+ i 1000) val0 val1)
(set! happy #f)))))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i 1000)))
(if (fneq (reader) 0.0)
(begin
- (snd-display ";clm-channel overlap trailing garbage")
+ (snd-display #__line__ ";clm-channel overlap trailing garbage")
(set! happy #f))))))
(close-sound ind))
@@ -37124,7 +37196,7 @@ EDITS: 3
;; can't use maxamp here because it may be set by scaling process
(if (or (fneq oldamp (* .1 amp))
(not (= loc oldloc)))
- (snd-display ";reverse edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
+ (snd-display #__line__ ";reverse edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
(undo)
(reverse-channel 0 #f ind 0 2)
(let ((amp 0.0)
@@ -37140,7 +37212,7 @@ EDITS: 3
;; can't use maxamp here because it may be set by scaling process
(if (or (fneq oldamp amp)
(not (= loc oldloc)))
- (snd-display ";reverse unscaled edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
+ (snd-display #__line__ ";reverse unscaled edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
(close-sound ind))
@@ -37174,7 +37246,7 @@ EDITS: 3
vals "env-channel 15 10 a")
(select-all)
(if (fneq (selection-maxamp) 1.0)
- (snd-display ";selection-maxamp in checker: ~A" (selection-maxamp)))
+ (snd-display #__line__ ";selection-maxamp in checker: ~A" (selection-maxamp)))
(scale-selection-to 1.0)
(check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
(25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
@@ -37207,7 +37279,7 @@ EDITS: 3
(21 1 21 24 0.5 0.6 0.1 4) (25 1 25 29 0.5 0.0 0.0 0)
(30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "reverse-channel 5 10")
- (if (fneq (selection-maxamp) .5) (snd-display ";selection-maxamp before: ~A" (selection-maxamp)))
+ (if (fneq (selection-maxamp) .5) (snd-display #__line__ ";selection-maxamp before: ~A" (selection-maxamp)))
(let ((mixvals (make-vct 10))
(old-sample4 (sample 4))
(old-sample5 (sample 5)))
@@ -37226,9 +37298,9 @@ EDITS: 3
old-sample4 old-sample5
(sample 4) (sample 5)
(vct-ref vals 4) (vct-ref vals 5)))))
-
- ; (list global-position data-number local-position local-end scaler ramp0 ramp1 type)
-
+
+ ; (list global-position data-number local-position local-end scaler ramp0 ramp1 type)
+
(delete-samples 28 12)
(insert-silence 28 12)
(do ((i 28 (+ 1 i)))
@@ -37241,11 +37313,11 @@ EDITS: 3
(25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
(40 1 40 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "delete/insert")
- (if (fneq (selection-maxamp) .6) (snd-display ";selection-maxamp after: ~A" (selection-maxamp)))
+ (if (fneq (selection-maxamp) .6) (snd-display #__line__ ";selection-maxamp after: ~A" (selection-maxamp)))
(set! (selection-position) 50)
(set! (selection-frames) 10)
(scale-selection-by .1)
- (if (fneq (selection-maxamp) .1) (snd-display ";re-selection-maxamp: ~A" (selection-maxamp)))
+ (if (fneq (selection-maxamp) .1) (snd-display #__line__ ";re-selection-maxamp: ~A" (selection-maxamp)))
(do ((i 50 (+ 1 i)))
((= i 60))
(vct-set! vals i .1))
@@ -37319,7 +37391,7 @@ EDITS: 3
(set! (selection-position) 20)
(set! (selection-frames) 70)
(env-selection '(0 0 1 1))
- (if (fneq (selection-maxamp ind 0) 1.0) (snd-display ";selection-maxamp after env-selection: ~A" (selection-maxamp ind 0)))
+ (if (fneq (selection-maxamp ind 0) 1.0) (snd-display #__line__ ";selection-maxamp after env-selection: ~A" (selection-maxamp ind 0)))
(do ((i 20 (+ 1 i))
(x 0.0)
(incr (/ 1.0 69.0)))
@@ -37342,7 +37414,7 @@ EDITS: 3
(71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 0.5 0.797101438045502 0.014492753893137 4)
(85 1 85 89 0.5 0.942028999328613 0.014492753893137 4) (90 1 90 99 0.5 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
vals "scale-to")
- (if (fneq (selection-maxamp) .5) (snd-display ";selection-maxamp after scale: ~A" (selection-maxamp)))
+ (if (fneq (selection-maxamp) .5) (snd-display #__line__ ";selection-maxamp after scale: ~A" (selection-maxamp)))
(delete-samples 0 100)
(insert-silence 0 100)
(vct-fill! vals 0.0)
@@ -37402,7 +37474,7 @@ EDITS: 3
; (load (string-append cwd "hiho.scm"))
; (check-edit-tree '((0 14 0 24 1.0 0.0 0.0 0) (25 12 25 49 1.0 0.0 0.0 0) (50 13 0 0 1.0 0.0 0.0 0) (51 12 51 74 1.0 0.0 0.0 0) (75 15 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
; vals "reload edits")
- ; (if (not (equal? (edits) (list 27 0))) (snd-display ";edits after reload: ~A" (edits)))
+ ; (if (not (equal? (edits) (list 27 0))) (snd-display #__line__ ";edits after reload: ~A" (edits)))
; (delete-file "hiho.scm")
(env-channel (make-env '(0 1 1 0 2 1) :length 20) 50 20)
@@ -37459,7 +37531,7 @@ EDITS: 3
(ev (e)))
(if (fneq rv ev)
(begin
- (snd-display ";~A env check [~A]: ~A ~A" name i rv ev)
+ (snd-display #__line__ ";~A env check [~A]: ~A ~A" name i rv ev)
(set! happy #f)))))))
(vct->channel v)
(env-sound '(0 0 1 1))
@@ -37559,7 +37631,7 @@ EDITS: 3
(vct->channel v1 3 3)
(let ((vals (channel->vct 0 10)))
(if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display "; 1 vals: ~A" vals))))
+ (snd-display #__line__ "; 1 vals: ~A" vals))))
(undo 2)
(env-sound '(0 0 1 1))
(let ((v1 (vct-fill! (make-vct 3) 1.0)))
@@ -37567,7 +37639,7 @@ EDITS: 3
(insert-samples 3 3 v1)
(let ((vals (channel->vct 0 10)))
(if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display "; 2 vals: ~A" vals))))
+ (snd-display #__line__ "; 2 vals: ~A" vals))))
(undo 3)
(env-sound '(0 0 1 1))
(let ((v1 (vct-fill! (make-vct 3) 1.0)))
@@ -37582,13 +37654,13 @@ EDITS: 3
(vct->channel v1 3 3)
(let ((vals (channel->vct 0 10)))
(if (not (vequal vals (vct 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
- (snd-display "; 4 vals (~A): ~A" dur vals))))
+ (snd-display #__line__ "; 4 vals (~A): ~A" dur vals))))
(begin
(vct-fill! v1 0.0)
(vct->channel v1 4998 3)
(let ((vals (channel->vct 4995 10)))
(if (not (vequal vals (vct 0.999 0.999 1.000 0.000 0.000 0.000 1.000 0.999 0.999 0.999)))
- (snd-display "; 4 vals big: ~A" vals))))))
+ (snd-display #__line__ "; 4 vals big: ~A" vals))))))
(undo 2)
(if (= dur 10)
(begin
@@ -37598,21 +37670,21 @@ EDITS: 3
(insert-samples 3 3 v1)
(let ((vals (channel->vct 0 10)))
(if (not (vequal vals (vct 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
- (snd-display "; 2 vals: ~A" vals))))
+ (snd-display #__line__ "; 2 vals: ~A" vals))))
(undo 3)
(env-sound '(0 0 1 1 2 0))
(let ((v1 (vct-fill! (make-vct 3) 1.0)))
(vct->channel v1 0 3)
(let ((vals (channel->vct 0 10)))
(if (not (vequal vals (vct 1.000 1.000 1.000 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display "; 4 vals: ~A" vals))))
+ (snd-display #__line__ "; 4 vals: ~A" vals))))
(undo 2)
(env-sound '(0 0 1 1 2 0))
(let ((v1 (vct-fill! (make-vct 3) 1.0)))
(vct->channel v1 7 3)
(let ((vals (channel->vct 0 10)))
(if (not (vequal vals (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 1.000 1.000 1.000)))
- (snd-display "; 5 vals: ~A" vals))))
+ (snd-display #__line__ "; 5 vals: ~A" vals))))
(undo 2)))
(let ((file (file-name i1)))
(close-sound i1)
@@ -37727,7 +37799,7 @@ EDITS: 3
(+ (reader) y)))
(check-edit-tree '((0 2 0 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
(make-vct 100000) "invert and add")
- (if (fneq (maxamp) 0.0) (snd-display ";invert-and-add maxamp: ~A" (maxamp))))
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";invert-and-add maxamp: ~A" (maxamp))))
(undo 1)
(ramp-channel -1.0 1.0 50000 30000)
@@ -37740,8 +37812,8 @@ EDITS: 3
(env-sound '(0 0 1 1))
(reverse-channel)
(delete-samples 1 99999)
- (if (fneq (sample 0) -1.0) (snd-display ";sample at end: ~A" (sample 0)))
- (if (not (= (frames) 1)) (snd-display ";length at end: ~A" (frames)))
+ (if (fneq (sample 0) -1.0) (snd-display #__line__ ";sample at end: ~A" (sample 0)))
+ (if (not (= (frames) 1)) (snd-display #__line__ ";length at end: ~A" (frames)))
(check-edit-tree '((0 2 0 0 1.0 0.0 0.0 0) (1 -2 0 0 0.0 0.0 0.0 0))
(vct-fill! (make-vct 1) -1.0) "at end")
(close-sound ind))
@@ -37753,7 +37825,7 @@ EDITS: 3
(let ((val (sample 50827)))
(if (or (not (number? val))
(fneq val 0.0))
- (snd-display ";round-off env: ~A" val)))
+ (snd-display #__line__ ";round-off env: ~A" val)))
(check-edit-tree '((0 0 0 15111 1.0 0.984011590480804 -5.77709688514005e-5 4) (15112 0 15112 27516 1.0 0.110976688563824 2.20663678192068e-5 4) (27517 0 27517 29482 1.0 0.384709984064102 8.4813182184007e-5 4) (29483 0 29483 33763 1.0 0.551452696323395 6.82959798723459e-5 4) (33764 0 33764 50827 1.0 0.843827784061432 -3.61598467861768e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
#f "round-off test")
(revert-sound ind)
@@ -37762,7 +37834,7 @@ EDITS: 3
(scale-channel .5 1000 1000)
(let ((val (sample 800)))
(if (fneq val .0314)
- (snd-display ";scl on env trouble: ~A" val)))
+ (snd-display #__line__ ";scl on env trouble: ~A" val)))
(check-edit-tree '((0 1 0 999 1.0 0.0 3.93483896914404e-5 4) (1000 1 1000 1999 0.5 0.0393483899533749 3.93483896914404e-5 4) (2000 1 2000 25413 1.0 0.0786967799067497 3.93483896914404e-5 4) (25414 1 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
#f "scl on env")
(revert-sound ind)
@@ -37772,7 +37844,7 @@ EDITS: 3
(ramp-channel 0.0 1.0)
(let ((val (sample 20000)))
(if (fneq val (expt (/ 20000.0 50828) 3))
- (snd-display ";ramp-channels piled up: ~A" val)))
+ (snd-display #__line__ ";ramp-channels piled up: ~A" val)))
(check-edit-tree '((0 1 0 50827 1.0 0.0 1.96745822904631e-5 10) (50828 -2 0 0 0.0 0.0 0.0 0))
#f "ramp upon ramp")
(revert-sound ind)
@@ -37787,7 +37859,7 @@ EDITS: 3
(val2 (* val1 (* 0.5 ratio)))
(val3 (* val2 (+ 0.1 (* ratio 0.3)))))
(if (fneq val val3)
- (snd-display ";ramp-channels piled up (2): ~A ~A" val val3)))
+ (snd-display #__line__ ";ramp-channels piled up (2): ~A ~A" val val3)))
(revert-sound ind)
(env-channel '(0 0 1 1 2 0))
@@ -37837,7 +37909,7 @@ EDITS: 3
(ev (e)))
(if (fneq rv ev)
(begin
- (snd-display ";~A env check [~A]: ~A ~A" name i rv ev)
+ (snd-display #__line__ ";~A env check [~A]: ~A ~A" name i rv ev)
(throw 'uhoh2)
(set! happy #f)))))))
(define (check-envs name r-maker e-maker)
@@ -37881,13 +37953,13 @@ EDITS: 3
(vct->channel v1 3 3 i2 1)
(let ((vals (channel->vct 0 10 i1 0)))
(if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display "; 1 0 vals: ~A" vals))
+ (snd-display #__line__ "; 1 0 vals: ~A" vals))
(set! vals (channel->vct 0 10 i2 0))
(if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display "; 2 0 vals: ~A" vals))
+ (snd-display #__line__ "; 2 0 vals: ~A" vals))
(set! vals (channel->vct 0 10 i2 1))
(if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display "; 2 1 vals: ~A" vals))))
+ (snd-display #__line__ "; 2 1 vals: ~A" vals))))
(let ((file (file-name i1)))
(close-sound i1)
(if (file-exists? file) (delete-file file)))
@@ -37936,12 +38008,12 @@ EDITS: 3
(list "1a.snd" "oboe.snd" "storm.snd" away)
(list "1a.snd" "oboe.snd" "storm.snd" "lola.snd"))))))
- (snd-display "; scl rev env map ptree scn pad wrt clm mix src del")
- (snd-display ";1a: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (car data)))
- (snd-display ";oboe: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cdar data)))
- (snd-display ";storm:~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (caddr data)))
+ (snd-display #__line__ "; scl rev env map ptree scn pad wrt clm mix src del")
+ (snd-display #__line__ ";1a: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (car data)))
+ (snd-display #__line__ ";oboe: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cdar data)))
+ (snd-display #__line__ ";storm:~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (caddr data)))
(if (list-p (cadddr data))
- (snd-display ";away: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cadddr data))))
+ (snd-display #__line__ ";away: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cadddr data))))
)
(if (and all-args with-big-file)
@@ -37962,15 +38034,15 @@ EDITS: 3
(list (lambda ()
(let ((ma (maxamp)))
(scale-channel 2.0)
- (if (fneq (maxamp) (* 2 ma)) (snd-display ";bigger scale max: ~A ~A" ma (maxamp)))))
+ (if (fneq (maxamp) (* 2 ma)) (snd-display #__line__ ";bigger scale max: ~A ~A" ma (maxamp)))))
(lambda ()
(let ((ma (maxamp)))
(env-channel '(0 0 1 1))
- (if (fneq (maxamp) ma) (snd-display ";bigger env max: ~A ~A" ma (maxamp)))))
+ (if (fneq (maxamp) ma) (snd-display #__line__ ";bigger env max: ~A ~A" ma (maxamp)))))
(lambda ()
(let ((ma (maxamp)))
(ptree-channel (lambda (y) (+ y .2)) #f #f ind 0 #f #t)
- (if (fneq (maxamp) (+ ma .2)) (snd-display ";bigger ptree max: ~A ~A" ma (maxamp)))))
+ (if (fneq (maxamp) (+ ma .2)) (snd-display #__line__ ";bigger ptree max: ~A ~A" ma (maxamp)))))
(lambda () (pad-channel 0 2000))
(lambda () (pad-channel 1336909605 297671280))
(lambda () (insert-silence (+ (frames ind) 100) 100))
@@ -37984,7 +38056,7 @@ EDITS: 3
))))
(set! (optimization) old-opt)
(set! (squelch-update ind) #f)
- (snd-display ";big: ~{~6,2F~}" times)
+ (snd-display #__line__ ";big: ~{~6,2F~}" times)
))
(lambda args (set! (squelch-update) #f)))
(close-sound ind)))
@@ -38018,21 +38090,21 @@ EDITS: 3
(select-channel 0)
(set! (squelch-update) #t)
(if (not (fieql (edit-tree) (list (list 0 0 0 (- big-file-frames 1) 1.0 0.0 0.0 0) (list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger initial tree: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger initial tree: ~A" (edit-tree)))
(vct-fill! vals 1.0)
(set! maxa (maxamp))
(scale-channel 0.5)
(set! old-vals (channel->vct (- (* 44100 50000) 50) 200))
- (if (fneq (maxamp) (* 0.5 maxa)) (snd-display ";bigger scale: ~A ~A" maxa (maxamp)))
+ (if (fneq (maxamp) (* 0.5 maxa)) (snd-display #__line__ ";bigger scale: ~A ~A" maxa (maxamp)))
(set! (samples (* 44100 50000) 100) vals)
(if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 0.5 0.0 0.0 0)
(list 2205000000 1 0 99 1.0 0.0 0.0 0)
(list 2205000100 0 2205000100 (- big-file-frames 1) 0.5 0.0 0.0 0)
(list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger set tree: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger set tree: ~A" (edit-tree)))
(set! new-vals (channel->vct (- (* 44100 50000) 50) 200))
(do ((i 50 (+ 1 i))) ((= i 150)) (vct-set! old-vals i 1.0))
- (if (not (vequal new-vals old-vals)) (snd-display ";bigger set ~A ~A" old-vals new-vals))
+ (if (not (vequal new-vals old-vals)) (snd-display #__line__ ";bigger set ~A ~A" old-vals new-vals))
(env-channel (make-env '(0 0 1 1) :length (* 44100 60000)) 1000 (* 44100 60000))
(if (not (fieql (edit-tree) (list (list 0 0 0 999 0.5 0.0 0.0 0)
(list 1000 0 1000 2204999999 0.5 1.12130420080871e-17 0.83333295583725 1)
@@ -38040,7 +38112,7 @@ EDITS: 3
(list 2205000100 0 2205000100 2646000999 0.5 0.833333015441895 1.0 1)
(list 2646001000 0 2646001000 (- big-file-frames 1) 0.5 0.0 0.0 0)
(list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger with env: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger with env: ~A" (edit-tree)))
(revert-sound ind)
(env-channel (make-env '(0 0 1 1 2 0) :length 101) (* 44100 50000) 100)
(if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
@@ -38048,72 +38120,72 @@ EDITS: 3
(list 2205000051 0 2205000051 2205000099 1.0 0.979591846466064 -5.55111512312578e-17 2)
(list 2205000100 0 2205000100 (- big-file-frames 1) 1.0 0.0 0.0 0)
(list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger short env: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger short env: ~A" (edit-tree)))
(let ((r (make-sampler (+ 75 (* 44100 50000))))
(v (make-vct 10)))
(do ((i 0 (+ 1 i)))
((= i 10))
(vct-set! v i (read-sample r)))
(if (not (vequal v (vct -0.021 -0.020 -0.020 -0.019 -0.018 -0.017 -0.016 -0.016 -0.015 -0.014)))
- (snd-display ";bigger short env vals: ~A" v)))
+ (snd-display #__line__ ";bigger short env vals: ~A" v)))
(revert-sound)
(let ((v (channel->vct (+ 75 (* 44100 50000)) 10)))
(if (not (vequal v (vct -0.042 -0.043 -0.044 -0.045 -0.045 -0.045 -0.045 -0.045 -0.045 -0.046)))
- (snd-display ";bigger no env vals: ~A" v)))
+ (snd-display #__line__ ";bigger no env vals: ~A" v)))
(scale-to 1.0)
- (if (fneq (maxamp) 1.0) (snd-display ";bigger scale-to 1.0 maxamp: ~A" (maxamp)))
+ (if (fneq (maxamp) 1.0) (snd-display #__line__ ";bigger scale-to 1.0 maxamp: ~A" (maxamp)))
(set! (sample (* 44100 51000)) 0.0)
(if (not (fieql (edit-tree) (list (list 0 0 0 2249099999 1.18574941158295 0.0 0.0 0)
(list 2249100000 1 0 0 1.0 0.0 0.0 0)
(list 2249100001 0 2249100001 (- big-file-frames 1) 1.18574941158295 0.0 0.0 0)
(list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger set 0 samp: ~A" (edit-tree)))
- (if (fneq (sample (* 44100 51000)) 0.0) (snd-display ";bigger 0 samp: ~A" (sample (* 44100 51000))))
+ (snd-display #__line__ ";bigger set 0 samp: ~A" (edit-tree)))
+ (if (fneq (sample (* 44100 51000)) 0.0) (snd-display #__line__ ";bigger 0 samp: ~A" (sample (* 44100 51000))))
(delete-samples (* 44100 52000) 100)
(if (not (= (frames) (- big-file-frames 100)))
- (snd-display ";bigger deletion frames: ~A (~A)" (frames) (- big-file-frames 100)))
+ (snd-display #__line__ ";bigger deletion frames: ~A (~A)" (frames) (- big-file-frames 100)))
(if (not (= (frames ind 0 0) big-file-frames))
- (snd-display ";bigger edpos deletion frames: ~A (~A)" (frames ind 0 0) big-file-frames))
+ (snd-display #__line__ ";bigger edpos deletion frames: ~A (~A)" (frames ind 0 0) big-file-frames))
(if (not (= (frames ind 0 (edit-position)) (- big-file-frames 100)))
- (snd-display ";bigger ed deletion frames: ~A (~A)" (frames ind 0 (edit-position)) (- big-file-frames 100)))
+ (snd-display #__line__ ";bigger ed deletion frames: ~A (~A)" (frames ind 0 (edit-position)) (- big-file-frames 100)))
(if (not (fieql (edit-tree) (list (list 0 0 0 2249099999 1.18574941158295 0.0 0.0 0)
(list 2249100000 1 0 0 1.0 0.0 0.0 0)
(list 2249100001 0 2249100001 2293199999 1.18574941158295 0.0 0.0 0)
(list 2293200000 0 2293200100 (- big-file-frames 1) 1.18574941158295 0.0 0.0 0)
(list (- big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger deletion: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger deletion: ~A" (edit-tree)))
(delete-samples 954624868 67)
(revert-sound)
(delete-samples 1000 (* 44100 50000))
- (if (not (= (frames) (- big-file-frames (* 44100 50000)))) (snd-display ";bigger big deletion: ~A" (frames)))
+ (if (not (= (frames) (- big-file-frames (* 44100 50000)))) (snd-display #__line__ ";bigger big deletion: ~A" (frames)))
(if (not (fieql (edit-tree) (list (list 0 0 0 999 1.0 0.0 0.0 0)
(list 1000 0 1085232704 (- big-file-frames 1) 1.0 0.0 0.0 0)
(list 970200000 -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger big delete: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger big delete: ~A" (edit-tree)))
(insert-silence 0 (* 44100 50000))
- (if (not (= (frames) big-file-frames)) (snd-display ";bigger silence: ~A (~A)" (frames) big-file-frames))
+ (if (not (= (frames) big-file-frames)) (snd-display #__line__ ";bigger silence: ~A (~A)" (frames) big-file-frames))
(if (not (fieql (edit-tree) (list (list 0 -1 0 2204999999 0.0 0.0 0.0 0)
(list 2205000000 0 0 999 1.0 0.0 0.0 0)
(list 2205001000 0 1085232704 (- big-file-frames 1) 1.0 0.0 0.0 0)
(list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger pad: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger pad: ~A" (edit-tree)))
(revert-sound)
(pad-channel (* 44100 50000) 100)
(if (fneq (sample (+ (* 44100 50000) 10)) 0.0)
- (snd-display ";bigger pad samp: ~A" (sample (+ (* 44100 50000) 10))))
+ (snd-display #__line__ ";bigger pad samp: ~A" (sample (+ (* 44100 50000) 10))))
(if (not (= (frames) (+ big-file-frames 100)))
- (snd-display ";bigger pad frames: ~A (~A)" (frames) (+ big-file-frames 100)))
+ (snd-display #__line__ ";bigger pad frames: ~A (~A)" (frames) (+ big-file-frames 100)))
(map-channel (lambda (y) (+ y .2)) (* 44100 50000) 10)
- (if (fneq (sample (+ (* 44100 50000) 1)) 0.2) (snd-display ";bigger map samp: ~A" (sample (+ (* 44100 50000) 1))))
+ (if (fneq (sample (+ (* 44100 50000) 1)) 0.2) (snd-display #__line__ ";bigger map samp: ~A" (sample (+ (* 44100 50000) 1))))
(if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
(list 2205000000 1 0 9 1.0 0.0 0.0 0)
(list 2205000010 -1 10 99 0.0 0.0 0.0 0)
(list 2205000100 0 2205000000 (- big-file-frames 1) 1.0 0.0 0.0 0)
(list (+ big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger map: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger map: ~A" (edit-tree)))
(save-edit-history "hiho.scm")
(revert-sound)
@@ -38124,14 +38196,14 @@ EDITS: 3
(list 2205000010 -1 10 99 0.0 0.0 0.0 0)
(list 2205000100 0 2205000000 (- big-file-frames 1) 1.0 0.0 0.0 0)
(list (+ big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger reload: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger reload: ~A" (edit-tree)))
(delete-file "hiho.scm")
(let ((flt (make-one-zero 0.5 0.5))
(flt1 (make-one-zero 0.5 0.5)))
(let ((lvals (channel->vct (+ 1000 (* 44100 65000)) 10 ind 0 0)))
(if (not (vequal lvals (vct -0.006 0.052 0.103 0.146 0.182 0.210 0.232 0.249 0.262 0.272)))
- (snd-display ";bigger (orig) vals: ~A" lvals))
+ (snd-display #__line__ ";bigger (orig) vals: ~A" lvals))
(clm-channel flt (+ (* 44100 65000) 1000) 10)
(if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
(list 2205000000 1 0 9 1.0 0.0 0.0 0)
@@ -38140,10 +38212,10 @@ EDITS: 3
(list 2866500000 2 0 9 1.0 0.0 0.0 0)
(list 2866500010 0 2866499910 (- big-file-frames 1) 1.0 0.0 0.0 0)
(list (+ big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";bigger clm: ~A" (edit-tree)))
+ (snd-display #__line__ ";bigger clm: ~A" (edit-tree)))
(if (not (vequal (channel->vct (+ 1000 (* 44100 65000)) 10)
(vct -0.006 0.015 0.065 0.107 0.142 0.169 0.190 0.205 0.216 0.222)))
- (snd-display ";bigger clm vals: ~A" (channel->vct (+ 1000 (* 44100 65000)) 10)))
+ (snd-display #__line__ ";bigger clm vals: ~A" (channel->vct (+ 1000 (* 44100 65000)) 10)))
(let ((r (make-readin big-file-name :start (+ 1000 (* 44100 65000))))
(v (make-vct 10)))
@@ -38151,11 +38223,11 @@ EDITS: 3
((= i 10))
(vct-set! v i (readin r)))
(if (not (vequal v lvals))
- (snd-display ";bigger (orig) readin vals: ~A (~A)" v lvals)))))
+ (snd-display #__line__ ";bigger (orig) readin vals: ~A (~A)" v lvals)))))
(revert-sound)
(let ((found (scan-channel (lambda (y) (> y .5)) (* 44100 50000))))
(if (not (equal? found (list #t 2205000925)))
- (snd-display ";bigger scan: ~A" found)))
+ (snd-display #__line__ ";bigger scan: ~A" found)))
(set! (squelch-update) #f)
(close-sound ind))))
@@ -38164,7 +38236,7 @@ EDITS: 3
(map-channel (lambda (y) (+ y .1)) #f #f ind-map)
(ptree-channel (lambda (y) (+ y .1)) #f #f ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree + .1 differs"))
+ (snd-display #__line__ ";ptree + .1 differs"))
(undo 1 ind-map)
(undo 1 ind-ptree)
(scale-by 2.0 ind-map)
@@ -38172,11 +38244,11 @@ EDITS: 3
(map-channel (lambda (y) (+ y .1)) #f #f ind-map)
(ptree-channel (lambda (y) (+ y .1)) #f #f ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree + .1 differs"))
+ (snd-display #__line__ ";ptree + .1 differs"))
(scale-by 2.0 ind-map)
(scale-by 2.0 ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree + .1 differs"))
+ (snd-display #__line__ ";ptree + .1 differs"))
(if (and (> (optimization) 0)
(not (string=? (safe-display-edits ind-ptree) (string-append "
EDITS: 3
@@ -38197,18 +38269,18 @@ EDITS: 3
(at 0, cp->sounds[0][0:50827, 2.000, loc: 0, pos: 0, scl: 2.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
(at 50828, end_mark)
"))))
- (snd-display ";ptree display edits: ~A" (safe-display-edits ind-ptree)))
+ (snd-display #__line__ ";ptree display edits: ~A" (safe-display-edits ind-ptree)))
(revert-sound ind-map)
(revert-sound ind-ptree)
(map-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-map)
(ptree-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree sin differs"))
+ (snd-display #__line__ ";ptree sin differs"))
(map-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-map)
(ptree-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree sin (2) differs"))
+ (snd-display #__line__ ";ptree sin (2) differs"))
(if (and (> (optimization) 0)
(not (string=? (safe-display-edits ind-ptree) (string-append "
EDITS: 2
@@ -38225,7 +38297,7 @@ EDITS: 2
(at 0, cp->sounds[0][0:50827, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* 2.0 (sin y)))]) [file: " cwd "oboe.snd[0]]
(at 50828, end_mark)
"))))
- (snd-display ";ptree display: ~A" (safe-display-edits ind-ptree)))
+ (snd-display #__line__ ";ptree display: ~A" (safe-display-edits ind-ptree)))
(revert-sound ind-map)
(revert-sound ind-ptree)
@@ -38234,7 +38306,7 @@ EDITS: 2
(map-channel (lambda (y) (* y y)) #f #f ind-map)
(ptree-channel (lambda (y) (* y y)) #f #f ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree y*y differs"))
+ (snd-display #__line__ ";ptree y*y differs"))
(revert-sound ind-map)
(revert-sound ind-ptree)
@@ -38243,20 +38315,20 @@ EDITS: 2
(env-channel '(0 0 1 1 2 0) #f #f ind-map)
(env-channel '(0 0 1 1 2 0) #f #f ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree y*y differs"))
+ (snd-display #__line__ ";ptree y*y differs"))
(revert-sound ind-map)
(revert-sound ind-ptree)
(map-channel (lambda (y) (+ y .1)) 100 100 ind-map)
(ptree-channel (lambda (y) (+ y .1)) 100 100 ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree[100] + .1 differs"))
+ (snd-display #__line__ ";ptree[100] + .1 differs"))
(scale-by 2.0 ind-map)
(scale-by 2.0 ind-ptree)
(map-channel (lambda (y) (+ y .2)) 1000 100 ind-map)
(ptree-channel (lambda (y) (+ y .2)) 1000 100 ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree[1000] + .2 differs"))
+ (snd-display #__line__ ";ptree[1000] + .2 differs"))
(if (and (> (optimization) 0)
(not (string=? (safe-display-edits ind-ptree) (string-append "
EDITS: 3
@@ -38285,18 +38357,18 @@ EDITS: 3
(at 1100, cp->sounds[0][1100:50827, 2.000]) [file: " cwd "oboe.snd[0]]
(at 50828, end_mark)
"))))
- (snd-display ";ptree[1000] display: ~A" (safe-display-edits ind-ptree)))
+ (snd-display #__line__ ";ptree[1000] display: ~A" (safe-display-edits ind-ptree)))
(env-channel '(0 0 1 1 2 0) 2000 1000 ind-map)
(env-channel '(0 0 1 1 2 0) 2000 1000 ind-ptree)
(map-channel (lambda (y) (+ y .3)) 4000 100 ind-map)
(ptree-channel (lambda (y) (+ y .3)) 4000 100 ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree[2000] + .2 differs"))
+ (snd-display #__line__ ";ptree[2000] + .2 differs"))
(map-channel (lambda (y) (+ y .1)) 0 3200 ind-map)
(ptree-channel (lambda (y) (+ y .1)) 0 3200 ind-ptree)
(if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display ";ptree[3200] + .2 differs"))
+ (snd-display #__line__ ";ptree[3200] + .2 differs"))
(undo 1 ind-ptree)
(let ((reader (make-sampler (- (frames) 1) ind-ptree 0 -1)))
(map-channel (lambda (y) (read-sample reader)) 0 (frames) ind-ptree))
@@ -38320,23 +38392,23 @@ EDITS: 3
(set! (sinc-width) 10)
(pad-channel 0 1000 ind)
(set! (sample 100) 0.5)
- (if (fneq (sample 100 ind 0 2) 0.5) (snd-display ";sample 100 (2): ~A" (sample 100 ind 0 2)))
- (if (fneq (sample 100 ind 0 1) 0.0) (snd-display ";sample 100 (1): ~A" (sample 100 ind 0 1)))
+ (if (fneq (sample 100 ind 0 2) 0.5) (snd-display #__line__ ";sample 100 (2): ~A" (sample 100 ind 0 2)))
+ (if (fneq (sample 100 ind 0 1) 0.0) (snd-display #__line__ ";sample 100 (1): ~A" (sample 100 ind 0 1)))
(src-channel 0.5)
(let ((mx (maxamp ind 0)))
- (if (fneq mx 0.5) (snd-display ";src-channel max .5: ~A" mx)))
- (if (fneq (sample 200) 0.5) (snd-display ";src-channel 0.5 200: ~A" (sample 200)))
+ (if (fneq mx 0.5) (snd-display #__line__ ";src-channel max .5: ~A" mx)))
+ (if (fneq (sample 200) 0.5) (snd-display #__line__ ";src-channel 0.5 200: ~A" (sample 200)))
(if (not (vequal (channel->vct 180 40 ind 0)
(vct 0.000 -0.000 0.000 0.001 -0.000 -0.003 0.000 0.007 -0.000 -0.012
0.000 0.020 -0.000 -0.033 0.000 0.054 -0.000 -0.100 -0.000 0.316
0.500 0.316 -0.000 -0.100 -0.000 0.054 0.000 -0.033 -0.000 0.020
0.000 -0.012 -0.000 0.007 0.000 -0.003 -0.000 0.001 0.000 -0.000)))
- (snd-display ";scr-channel 0.5 -> ~A" (channel->vct 180 40 ind 0)))
+ (snd-display #__line__ ";scr-channel 0.5 -> ~A" (channel->vct 180 40 ind 0)))
(undo 1 ind 0)
(src-channel 0.25)
(let ((mx (maxamp ind 0)))
- (if (fneq mx 0.5) (snd-display ";src-channel max .25: ~A" mx)))
- (if (fneq (sample 400) 0.5) (snd-display ";src-channel 0.25 400: ~A" (sample 400)))
+ (if (fneq mx 0.5) (snd-display #__line__ ";src-channel max .25: ~A" mx)))
+ (if (fneq (sample 400) 0.5) (snd-display #__line__ ";src-channel 0.25 400: ~A" (sample 400)))
(if (not (vequal (channel->vct 360 80 ind 0)
(vct 0.000 -0.000 -0.000 -0.000 0.000 0.000 0.001 0.001 -0.000 -0.002
-0.003 -0.003 0.000 0.004 0.007 0.006 -0.000 -0.008 -0.012 -0.010
@@ -38346,31 +38418,31 @@ EDITS: 3
0.054 0.034 0.000 -0.026 -0.033 -0.021 -0.000 0.016 0.020 0.013
0.000 -0.010 -0.012 -0.008 -0.000 0.006 0.007 0.004 0.000 -0.003
-0.003 -0.002 -0.000 0.001 0.001 0.000 0.000 -0.000 -0.000 -0.000)))
- (snd-display ";scr-channel 0.25 -> ~A" (channel->vct 360 80 ind 0)))
+ (snd-display #__line__ ";scr-channel 0.25 -> ~A" (channel->vct 360 80 ind 0)))
(undo 2 ind 0)
(map-channel (let ((i 0)) (lambda (y) (let ((val (sin (* i (/ pi 100))))) (set! i (+ 1 i)) (* .5 val)))))
(for-each
(lambda (sr df)
(src-channel sr)
- (if (> (abs (- (maxamp ind 0) .5)) df) (snd-display ";src-channel sine ~A: ~A" sr (maxamp ind 0)))
+ (if (> (abs (- (maxamp ind 0) .5)) df) (snd-display #__line__ ";src-channel sine ~A: ~A" sr (maxamp ind 0)))
(if (integer? sr)
(let ((r0 (make-sampler 0))
(r1 (make-sampler 0 ind 0 1 (- (edit-position) 1)))
- (sri (inexact->exact (floor sr))))
+ (sri (floor sr)))
(do ((i 0 (+ 1 i)))
((= i 500))
(let ((diff (abs (- (r0) (r1)))))
- (if (> diff df) (snd-display ";src-channel ~A diff ~D: ~A" sr i diff))
+ (if (> diff df) (snd-display #__line__ ";src-channel ~A diff ~D: ~A" sr i diff))
(do ((j 1 (+ 1 j)))
((= j sri))
(r1))))))
(do ((i 0 (+ 1 i)))
((= i 50))
(let ((s1 (sample i ind 0 (edit-position)))
- (s2 (sample (inexact->exact (round (* sr i))) ind 0 (- (edit-position) 1)))
+ (s2 (sample (round (* sr i)) ind 0 (- (edit-position) 1)))
(s3 (sample i ind 0 1)))
- (if (> (abs (- s1 s2)) df) (snd-display ";sample ~D src(~A): ~A ~A" i sr s1 s2))
- (if (fneq s3 0.0) (snd-display ";sample ~D (1): ~A" i s3))))
+ (if (> (abs (- s1 s2)) df) (snd-display #__line__ ";sample ~D src(~A): ~A ~A" i sr s1 s2))
+ (if (fneq s3 0.0) (snd-display #__line__ ";sample ~D (1): ~A" i s3))))
(undo 1 ind 0))
(list 2.0 1.5 3.0 3.14)
(list 0.008 0.01 0.015 0.025))
@@ -38380,15 +38452,15 @@ EDITS: 3
(for-each
(lambda (sr df)
(src-channel sr)
- (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
+ (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display #__line__ ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
(if (integer? sr)
(let ((r0 (make-sampler 0))
(r1 (make-sampler 0 ind 0 1 (- (edit-position) 1)))
- (sri (inexact->exact (floor sr))))
+ (sri (floor sr)))
(do ((i 0 (+ 1 i)))
((= i 5000))
(let ((diff (abs (- (r0) (r1)))))
- (if (> diff df) (snd-display ";src-channel oboe ~A diff ~D: ~A" sr i diff))
+ (if (> diff df) (snd-display #__line__ ";src-channel oboe ~A diff ~D: ~A" sr i diff))
(do ((j 1 (+ 1 j)))
((= j sri))
(r1))))))
@@ -38399,13 +38471,13 @@ EDITS: 3
(for-each
(lambda (sr df)
(src-channel sr)
- (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
+ (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display #__line__ ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
(do ((i 0 (+ 1 i)))
((= i 50))
(let* ((samp (* i 100))
(s1 (sample samp ind 0 (edit-position)))
- (s2 (sample (inexact->exact (floor (* sr samp))) ind 0 (- (edit-position) 1))))
- (if (> (abs (- s1 s2)) df) (snd-display ";sample ~D oboe src(~A): ~A ~A" i sr s1 s2))))
+ (s2 (sample (floor (* sr samp)) ind 0 (- (edit-position) 1))))
+ (if (> (abs (- s1 s2)) df) (snd-display #__line__ ";sample ~D oboe src(~A): ~A ~A" i sr s1 s2))))
(undo 1 ind 0)
(amp-envs-equal? ind 0 (edit-position) (+ 1 (edit-position)) .01))
(list 0.5 0.25 0.9 0.1)
@@ -38429,10 +38501,10 @@ EDITS: 3
(let ((val (reader)))
(if (fneq val .1)
(begin
- (snd-display ";ptree previous: ~A ~A" i val)
+ (snd-display #__line__ ";ptree previous: ~A ~A" i val)
(set! happy #f))))))
(close-sound ind))
-
+
;; recursion tests
(let ((old-opt (optimization))
(ind (open-sound "oboe.snd")))
@@ -38444,29 +38516,29 @@ EDITS: 3
(> n5 .1)))))
bigger)))))
(if (not (equal? val (list (list #t 4423) 0)))
- (snd-display ";scan-channel in scan-channel (~A): ~A" n val)))
+ (snd-display #__line__ ";scan-channel in scan-channel (~A): ~A" n val)))
(let ((hi (make-vct 3))
(ho (make-vct 3)))
(vct-map! hi (lambda ()
(if (scan-channel (lambda (y)
(> y .1)))
1.0 0.0)))
- (if (not (vequal hi (vct 1.0 1.0 1.0))) (snd-display ";vct-map! with scan-channel (~A): ~A" n hi))
+ (if (not (vequal hi (vct 1.0 1.0 1.0))) (snd-display #__line__ ";vct-map! with scan-channel (~A): ~A" n hi))
(vct-fill! ho .1)
(vct-map! hi (lambda ()
(vct-map! ho (lambda ()
(+ (vct-ref ho 0) .1)))
(vct-ref ho 0)))
- (if (not (vequal hi (vct .2 .3 .4))) (snd-display ";vct-map! with vct-map! (~A): ~A ~A" n hi ho)))
+ (if (not (vequal hi (vct .2 .3 .4))) (snd-display #__line__ ";vct-map! with vct-map! (~A): ~A ~A" n hi ho)))
(let ((val (find-channel (lambda (y) (if (find-channel (lambda (n6) (> n6 .1))) #t #f)))))
- (if (not (equal? val (list #t 0))) (snd-display ";find with find: ~A" val)))
+ (if (not (equal? val (list #t 0))) (snd-display #__line__ ";find with find: ~A" val)))
(let ((val (find-channel (lambda (y) (if (scan-channel (lambda (n7) (> n7 .1))) #t #f)))))
- (if (not (equal? val (list #t 0))) (snd-display ";find with scan-channel: ~A" val)))
+ (if (not (equal? val (list #t 0))) (snd-display #__line__ ";find with scan-channel: ~A" val)))
(let ((mx (maxamp ind 0))
(val (scan-channel (lambda (y) (map-channel (lambda (n) (* n 2))) #t))))
- (if (not (equal? val (list #t 0))) (snd-display ";scan-channel with map-channel: ~A" val))
- (if (fneq mx (/ (maxamp ind 0) 2)) (snd-display ";scan+map max: ~A ~A" mx (maxamp ind 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";scan+map edit-pos: ~A" (edit-position ind 0)))
+ (if (not (equal? val (list #t 0))) (snd-display #__line__ ";scan-channel with map-channel: ~A" val))
+ (if (fneq mx (/ (maxamp ind 0) 2)) (snd-display #__line__ ";scan+map max: ~A ~A" mx (maxamp ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";scan+map edit-pos: ~A" (edit-position ind 0)))
(revert-sound ind)
(map-channel (let ((ctr 0))
(lambda (y)
@@ -38474,9 +38546,9 @@ EDITS: 3
(* n 2))))
(set! ctr 1)
y)))
- (if (fneq mx (maxamp ind 0)) (snd-display ";map+map max 2: ~A ~A" mx (maxamp ind 0)))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";map+map edit-pos: ~A" (edit-position ind 0)))
- (if (fneq mx (/ (maxamp ind 0 1) 2)) (snd-display ";map+map max 1: ~A ~A" mx (maxamp ind 0 1)))
+ (if (fneq mx (maxamp ind 0)) (snd-display #__line__ ";map+map max 2: ~A ~A" mx (maxamp ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";map+map edit-pos: ~A" (edit-position ind 0)))
+ (if (fneq mx (/ (maxamp ind 0 1) 2)) (snd-display #__line__ ";map+map max 1: ~A ~A" mx (maxamp ind 0 1)))
(revert-sound ind))
@@ -38491,7 +38563,7 @@ EDITS: 3
(let ((old-len (frames ind)))
(func beg dur)
(if (not (= (frames ind) len))
- (snd-display ";(~A ~A ~A) with ~A -> ~A (~A)?" func beg dur old-len (frames ind) len))))
+ (snd-display #__line__ ";(~A ~A ~A) with ~A -> ~A (~A)?" func beg dur old-len (frames ind) len))))
(list (lambda (beg dur) (env-channel '(0 0 1 1) beg dur))
(lambda (beg dur) (map-channel (lambda (y) (* y .5)) beg dur))
(lambda (beg dur) (reverse-channel beg dur))
@@ -38512,7 +38584,7 @@ EDITS: 3
(let ((old-len (frames ind)))
(pad-channel beg dur)
(if (not (= (frames ind) len))
- (snd-display ";(pad-channel ~A ~A) with ~A -> ~A (~A)?" beg dur old-len (frames ind) len))))
+ (snd-display #__line__ ";(pad-channel ~A ~A) with ~A -> ~A (~A)?" beg dur old-len (frames ind) len))))
(list 1000 60000 0 62000 62000 62004)
(list 1000 1000 1000 1 2 1)
(list 51828 61000 62000 62001 62003 62005))
@@ -38524,7 +38596,7 @@ EDITS: 3
(let ((old-len (frames ind)))
(func (+ old-len 100) dur)
(if (not (= (frames ind) len))
- (snd-display ";(~A ~A) with ~A -> ~A (~A)?" func dur old-len (frames ind) len))))
+ (snd-display #__line__ ";(~A ~A) with ~A -> ~A (~A)?" func dur old-len (frames ind) len))))
(list (lambda (beg dur) (env-channel '(0 0 1 1) beg dur))
(lambda (beg dur) (reverse-channel beg dur))
(lambda (beg dur) (scale-channel 2.0 beg dur))
@@ -38543,7 +38615,7 @@ EDITS: 3
(do ((i 0 (+ 1 i)))
((= i 100))
- (case (inexact->exact (floor (random 10)))
+ (case (floor (random 10))
((0) (pad-channel (random (* 1.25 (frames))) (random 1000)))
((1) (env-channel '(0 0 1 1 2 0) (random (* 1.25 (frames))) (random 1000)))
((2) (env-sound '(0 0 1 1 2 0) (random (* 1.25 (frames))) (random 1000)))
@@ -38552,7 +38624,7 @@ EDITS: 3
((5) (src-channel (+ .9 (random .2)) (random (* 1.25 (frames))) (random 1000)))
((6) (ramp-channel (random 1.0) (random 1.0) (random (* 1.25 (frames))) (random 1000)))
((7) (reverse-channel (random (* 1.25 (frames))) (random 1000)))
- ((8) (let ((dur (max 2 (inexact->exact (floor (random 100)))))) (vct->channel (make-vct dur) (random (* 1.25 (frames))) dur)))
+ ((8) (let ((dur (max 2 (floor (random 100))))) (vct->channel (make-vct dur) (random (* 1.25 (frames))) dur)))
((9) (map-channel (lambda (y) (* y 2)) (random (* .5 (frames))) (random 1000)))))
(close-sound ind))
@@ -38561,7 +38633,7 @@ EDITS: 3
(pad-channel 0 100000) ; force tempfile in fallback
(ptree-channel (lambda (y) (if (current-input-port) 1.0 0.0)))
(if (fneq (maxamp ind) 1.0)
- (snd-display ";ptree fallback: ~A" (maxamp ind)))
+ (snd-display #__line__ ";ptree fallback: ~A" (maxamp ind)))
(undo)
(ptree-channel (lambda (y data dir)
(if (current-input-port) (* y 0.5) (* y (vct-ref data 0))))
@@ -38585,7 +38657,7 @@ EDITS: 3
(set! (sync ind2) (random 3))
(opt-test (random 22))))
(lambda args
- (snd-display ";caught mus-error")
+ (snd-display #__line__ ";caught mus-error")
#f))
(set! (squelch-update ind0 #t) #f)
(set! (squelch-update ind1 #t) #f)
@@ -38607,19 +38679,19 @@ EDITS: 3
(ptree-channel (lambda (y) (+ y .1)) 0 2000)
(let ((val (sample 100)))
(if (fneq val .1)
- (snd-display ";pad+ptree: ~A" val)))
+ (snd-display #__line__ ";pad+ptree: ~A" val)))
(undo 2)
(pad-channel 0 2000)
(ptree-channel (lambda (y) (+ y .1)) 1000 200)
(let ((val (sample 1100)))
(if (fneq val .1)
- (snd-display ";pad+ptree(2): ~A" val)))
+ (snd-display #__line__ ";pad+ptree(2): ~A" val)))
(undo 2)
(pad-channel 1000 1000)
(ptree-channel (lambda (y) (+ y .1)) 0 1500)
(let ((val (sample 1100)))
(if (fneq val .1)
- (snd-display ";pad+ptree(3): ~A" val)))
+ (snd-display #__line__ ";pad+ptree(3): ~A" val)))
(undo 2)
(close-sound ind))
@@ -38631,11 +38703,11 @@ EDITS: 3
(swap-channels)
(update-time-graph)
(let ((tm (- (real-time) start)))
- (if (> tm .1) (snd-display ";swap-channels not optimized? ~A" tm)))
+ (if (> tm .1) (snd-display #__line__ ";swap-channels not optimized? ~A" tm)))
(let ((new-mxs (maxamp ind #t)))
(if (or (fneq (car mxs) (cadr new-mxs))
(fneq (cadr mxs) (car new-mxs)))
- (snd-display ";swap-channels amps: ~A -> ~A" mxs new-mxs)))
+ (snd-display #__line__ ";swap-channels amps: ~A -> ~A" mxs new-mxs)))
(revert-sound ind)
(close-sound ind)))
(lambda args args)) ; away.snd may not exist
@@ -38656,37 +38728,37 @@ EDITS: 3
(delete-samples 2 3 ind 0)
(env-channel '(0 0 1 1 2 0) 0 (frames ind 1) ind 1)
(swap-channels)
- (if (not (= (frames ind 1) 11)) (snd-display ";frames swapped: ~A" (frames ind 1)))
+ (if (not (= (frames ind 1) 11)) (snd-display #__line__ ";frames swapped: ~A" (frames ind 1)))
(if (not (vequal (channel->vct 0 (frames ind 0) ind 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
- (snd-display ";swapped env: ~A" (channel->vct 0 (frames ind 0) ind 0)))
+ (snd-display #__line__ ";swapped env: ~A" (channel->vct 0 (frames ind 0) ind 0)))
(undo 2 ind 0)
(undo 2 ind 1)
(delete-samples 2 7 ind 0)
(swap-channels ind 0 ind 1 5 4)
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0.500 0.500 0.500 0.500 0.000 0.500 0.500 0.500 0.500 0.000)))
- (snd-display ";partial swap 1: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";partial swap 1: ~A" (channel->vct 0 10 ind 0)))
(if (not (vequal (channel->vct 0 10 ind 1) (vct 0.500 0.500 0.500 0.500 0.500 0.000 0.000 0.000 0.000 0.500)))
- (snd-display ";partial swap 2: ~A" (channel->vct 0 10 ind 1)))
+ (snd-display #__line__ ";partial swap 2: ~A" (channel->vct 0 10 ind 1)))
(revert-sound ind)
(let ((m0 (add-mark 3 ind 0))
(m1 (add-mark 4 ind 1))
(m2 (add-mark 5 ind 1)))
(scale-channel 0.5)
(swap-channels)
- (if (not (= (mark-sample m0) 3)) (snd-display ";swapped m0: ~A" (mark-sample m0)))
- (if (not (= (mark-sample m1) 4)) (snd-display ";swapped m1: ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 5)) (snd-display ";swapped m2: ~A" (mark-sample m2)))
- (if (not (equal? (mark-home m0) (list ind 1))) (snd-display ";mark-home m0: ~A" (mark-home m0)))
- (if (not (equal? (mark-home m1) (list ind 0))) (snd-display ";mark-home m1: ~A" (mark-home m1)))
- (if (not (equal? (mark-home m2) (list ind 0))) (snd-display ";mark-home m2: ~A" (mark-home m2)))
+ (if (not (= (mark-sample m0) 3)) (snd-display #__line__ ";swapped m0: ~A" (mark-sample m0)))
+ (if (not (= (mark-sample m1) 4)) (snd-display #__line__ ";swapped m1: ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 5)) (snd-display #__line__ ";swapped m2: ~A" (mark-sample m2)))
+ (if (not (equal? (mark-home m0) (list ind 1))) (snd-display #__line__ ";mark-home m0: ~A" (mark-home m0)))
+ (if (not (equal? (mark-home m1) (list ind 0))) (snd-display #__line__ ";mark-home m1: ~A" (mark-home m1)))
+ (if (not (equal? (mark-home m2) (list ind 0))) (snd-display #__line__ ";mark-home m2: ~A" (mark-home m2)))
(undo 1 ind 0)
(undo 1 ind 1)
- (if (not (= (mark-sample m0) 3)) (snd-display ";swapped m0 2: ~A" (mark-sample m0)))
- (if (not (= (mark-sample m1) 4)) (snd-display ";swapped m1 2: ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 5)) (snd-display ";swapped m2 2: ~A" (mark-sample m2)))
- (if (not (equal? (mark-home m0) (list ind 0))) (snd-display ";mark-home m0 2: ~A" (mark-home m0)))
- (if (not (equal? (mark-home m1) (list ind 1))) (snd-display ";mark-home m1 2: ~A" (mark-home m1)))
- (if (not (equal? (mark-home m2) (list ind 1))) (snd-display ";mark-home m2 2: ~A" (mark-home m2))))
+ (if (not (= (mark-sample m0) 3)) (snd-display #__line__ ";swapped m0 2: ~A" (mark-sample m0)))
+ (if (not (= (mark-sample m1) 4)) (snd-display #__line__ ";swapped m1 2: ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 5)) (snd-display #__line__ ";swapped m2 2: ~A" (mark-sample m2)))
+ (if (not (equal? (mark-home m0) (list ind 0))) (snd-display #__line__ ";mark-home m0 2: ~A" (mark-home m0)))
+ (if (not (equal? (mark-home m1) (list ind 1))) (snd-display #__line__ ";mark-home m1 2: ~A" (mark-home m1)))
+ (if (not (equal? (mark-home m2) (list ind 1))) (snd-display #__line__ ";mark-home m2 2: ~A" (mark-home m2))))
(close-sound ind)
(delete-file "test.snd"))
@@ -38697,7 +38769,7 @@ EDITS: 3
(swap-channels ind 1 ind 2)
(let ((maxs (maxamp ind #t)))
(if (or (fneq (list-ref maxs 0) 0.5) (fneq (list-ref maxs 1) 0.125) (fneq (list-ref maxs 2) 0.25) (fneq (list-ref maxs 3) 0.0625))
- (snd-display ";swap midchans: ~A" maxs))
+ (snd-display #__line__ ";swap midchans: ~A" maxs))
(close-sound ind)))
(let* ((ind0 (open-sound "oboe.snd"))
@@ -38705,8 +38777,8 @@ EDITS: 3
(mx0 (maxamp ind0 0))
(mx1 (maxamp ind1 0)))
(swap-channels ind0 0 ind1 0)
- (if (fneq (maxamp ind0 0) mx1) (snd-display ";maxamp cross swap 0: ~A" (maxamp ind0 0)))
- (if (fneq (maxamp ind1 0) mx0) (snd-display ";maxamp cross swap 1: ~A" (maxamp ind1 0)))
+ (if (fneq (maxamp ind0 0) mx1) (snd-display #__line__ ";maxamp cross swap 0: ~A" (maxamp ind0 0)))
+ (if (fneq (maxamp ind1 0) mx0) (snd-display #__line__ ";maxamp cross swap 1: ~A" (maxamp ind1 0)))
(close-sound ind1)
(if (and (> (optimization) 0)
(not (string=? (display-edits) (string-append "
@@ -38720,7 +38792,7 @@ EDITS: 1
(at 0, cp->sounds[1][0:41622, 1.000]) [file: " cwd "pistol.snd[0]]
(at 41623, end_mark)
"))))
- (snd-display ";cross swap state: ~A" (display-edits)))
+ (snd-display #__line__ ";cross swap state: ~A" (display-edits)))
(close-sound ind0))
(let ((ind (init-sound 1.0 10 1)))
@@ -39075,7 +39147,7 @@ EDITS: 1
(undo 2)
(xramp-channel 0.0 1.0 .0325)
(if (not (vequal orig-data (channel->vct)))
- (snd-display ";xramp cases: ~A ~A" orig-data (channel->vct)))
+ (snd-display #__line__ ";xramp cases: ~A ~A" orig-data (channel->vct)))
(check-back-and-forth ind "xramp(+ptree) 0" (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000))
(ptree-channel (lambda (y) (* y 2.0)))
(check-back-and-forth ind "xramp+ptree 1" (vct-scale! (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000) 2.0))
@@ -39090,7 +39162,7 @@ EDITS: 1
(undo 2)
(env-sound '(0 0 1 1 2 0) 0 11 .0325)
(if (not (vequal orig-data (channel->vct)))
- (snd-display ";xramp cases 1: ~A ~A" orig-data (channel->vct)))
+ (snd-display #__line__ ";xramp cases 1: ~A ~A" orig-data (channel->vct)))
(check-back-and-forth ind "xramp(+ptree) 4" (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000))
(ptree-channel (lambda (y) (* y 2.0)))
(check-back-and-forth ind "xramp+ptree 4" (vct-scale! (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000) 2.0))
@@ -39152,10 +39224,10 @@ EDITS: 1
(let ((old-opt (optimization))
(tries 256))
(set! (optimization) 6)
- (snd-display ";frames: ~,2F ~,2F"
+ (snd-display #__line__ ";frames: ~,2F ~,2F"
(exact->inexact (/ (mus-sound-frames "1.snd") (mus-sound-frames "oboe.snd")))
(exact->inexact (/ (mus-sound-frames "1.snd") (mus-sound-frames "1a.snd"))))
- (snd-display ";~12T~A~28T~A~44T~A~56T(1/oboe, 1/1a)" "1.snd" "oboe.snd" "1a.snd")
+ (snd-display #__line__ ";~12T~A~28T~A~44T~A~56T(1/oboe, 1/1a)" "1.snd" "oboe.snd" "1a.snd")
(for-each
(lambda (name func)
(let* ((ind (open-sound "1.snd"))
@@ -39194,7 +39266,7 @@ EDITS: 1
(set! (squelch-update ind 0) #f)
(close-sound ind)
(let ((end-time (real-time)))
- (snd-display ";~A:~12T~A~18T~A~28T~A~34T~A~44T~A~50T~A~56T(~,2F, ~,2F)"
+ (snd-display #__line__ ";~A:~12T~A~18T~A~28T~A~34T~A~44T~A~50T~A~56T(~,2F, ~,2F)"
name
(hundred (- mid-time-1 start-time-1)) (hundred (- end-time-1 mid-time-1))
@@ -39266,147 +39338,147 @@ EDITS: 1
(set! (sinc-width) 10)
(set! (sample 20 ind 0) 0.5)
(let ((edpos (edit-position ind 0)))
-
+
;; -------- no-ops
(src-channel 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";src-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(src-sound 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";src-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(select-all)
(src-selection 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";src-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
-
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+
(filter-channel (vct 1.0))
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";filter-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";filter-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(env-channel '(0 1 1 1))
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";env-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(env-sound '(0 1 1 1))
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";env-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(env-selection '(0 1 1 1))
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";env-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(scale-channel 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";scale-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(scale-by 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";scale-by 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-by 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(scale-selection-by 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display ";scale-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
-
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+
;; -------- other special cases
(src-channel -1)
(reverse-channel)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";src -1 and reverse diff: ~A" diff)))
-
+ (if diff (snd-display #__line__ ";src -1 and reverse diff: ~A" diff)))
+
(set! (edit-position ind 0) edpos)
(scale-by 2)
(filter-channel (vct 2) 1 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 (+ 1 edpos) (+ edpos 2))))
- (if diff (snd-display ";scale and filter 2 diff: ~A" diff)))
-
+ (if diff (snd-display #__line__ ";scale and filter 2 diff: ~A" diff)))
+
;; -------- not no-ops!
(scale-channel 1.0 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";edpos scale 1 diff: ~A" diff)))
- (if (fneq (maxamp ind 0) 0.5) (snd-display ";scale 1 of original: ~A" (maxamp ind 0)))
+ (if diff (snd-display #__line__ ";edpos scale 1 diff: ~A" diff)))
+ (if (fneq (maxamp ind 0) 0.5) (snd-display #__line__ ";scale 1 of original: ~A" (maxamp ind 0)))
(if (= (edit-position ind 0) (+ edpos 2))
- (snd-display ";edpos scl copy opted out?")
+ (snd-display #__line__ ";edpos scl copy opted out?")
(undo))
-
+
(filter-channel (vct 1) 1 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";edpos flt 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";edpos flt 1 diff: ~A" diff)))
(if (= (edit-position ind 0) (+ edpos 2))
- (snd-display ";edpos flt copy opted out?")
+ (snd-display #__line__ ";edpos flt copy opted out?")
(undo))
(env-channel '(0 1 1 1) 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";edpos env 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";edpos env 1 diff: ~A" diff)))
(if (= (edit-position ind 0) (+ edpos 2))
- (snd-display ";edpos env copy opted out?")
+ (snd-display #__line__ ";edpos env copy opted out?")
(undo))
(src-channel 1.0 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if (and diff (> (car diff) .0001)) (snd-display ";edpos src 1 diff: ~A" diff)))
+ (if (and diff (> (car diff) .0001)) (snd-display #__line__ ";edpos src 1 diff: ~A" diff)))
(if (= (edit-position ind 0) (+ edpos 2))
- (snd-display ";edpos src copy opted out?")
+ (snd-display #__line__ ";edpos src copy opted out?")
(undo))
-
+
(set! edpos (edit-position ind 0))
(let ((len (frames ind 0)))
(src-channel 0.5)
-
+
(scale-channel 1.0 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";1 edpos scale 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";1 edpos scale 1 diff: ~A" diff)))
(if (not (= (frames ind 0) len))
- (snd-display ";scl len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";scl len edpos: ~A ~A" len (frames ind 0)))
(undo)
-
+
(filter-channel (vct 1) 1 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";1 edpos flt 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";1 edpos flt 1 diff: ~A" diff)))
(if (not (= (frames ind 0) len))
- (snd-display ";flt len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";flt len edpos: ~A ~A" len (frames ind 0)))
(undo)
-
+
(env-channel '(0 1 1 1) 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";1 edpos env 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";1 edpos env 1 diff: ~A" diff)))
(if (not (= (frames ind 0) len))
- (snd-display ";env len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";env len edpos: ~A ~A" len (frames ind 0)))
(undo)
-
+
(reverse-channel 0 #f ind 0 edpos)
(reverse-channel 0 #f ind 0)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";1 edpos rev 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";1 edpos rev 1 diff: ~A" diff)))
(if (not (= (frames ind 0) len))
- (snd-display ";rev len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";rev len edpos: ~A ~A" len (frames ind 0)))
(undo 2)
-
+
(src-channel 1.0 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if (and diff (> (car diff) .0001)) (snd-display ";1 edpos src 1 diff: ~A" diff)))
+ (if (and diff (> (car diff) .0001)) (snd-display #__line__ ";1 edpos src 1 diff: ~A" diff)))
(if (> (abs (- (frames ind 0) len)) 2)
- (snd-display ";src len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";src len edpos: ~A ~A" len (frames ind 0)))
(undo)
-
+
(let ((opt (optimization)))
(set! (optimization) 0)
(map-channel (lambda (y) y) 0 #f ind 0 edpos)
(set! (optimization) opt))
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";1 edpos map 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";1 edpos map 1 diff: ~A" diff)))
(if (not (= (frames ind 0) len))
- (snd-display ";map len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";map len edpos: ~A ~A" len (frames ind 0)))
(undo)
-
+
(ptree-channel (lambda (y) y) 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";1 edpos ptree 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";1 edpos ptree 1 diff: ~A" diff)))
(if (not (= (frames ind 0) len))
- (snd-display ";ptree len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";ptree len edpos: ~A ~A" len (frames ind 0)))
(undo)
-
+
(smooth-channel 0 len ind 0 edpos)
(if (not (= (frames ind 0) len))
- (snd-display ";smooth len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";smooth len edpos: ~A ~A" len (frames ind 0)))
(undo)
-
+
(clm-channel (make-one-zero 1.0 0.0) 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display ";1 edpos clm 1 diff: ~A" diff)))
+ (if diff (snd-display #__line__ ";1 edpos clm 1 diff: ~A" diff)))
(if (not (= (frames ind 0) len))
- (snd-display ";clm len edpos: ~A ~A" len (frames ind 0)))
+ (snd-display #__line__ ";clm len edpos: ~A ~A" len (frames ind 0)))
(undo))
-
+
;; dur of 0 is ignored no matter what -- else I have a million special cases
;; -> insert 0 at other edpos, delete 0, change 0 (x|ramp-channel) (map? etc)
-
+
(revert-sound ind)
(close-sound ind)
@@ -39425,103 +39497,103 @@ EDITS: 1
(set! (samples 20 10 ind 0) (make-vct 10 -.75))
(pad-channel 0 10 ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display ";pad edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";pad edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";pad edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";pad edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(delete-samples 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 5)) (snd-display ";del edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";del edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 5)) (snd-display #__line__ ";del edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";del edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(set! (samples 5 5 ind 0 #f "set" 0 edpos) (make-vct 5 0.0))
- (if (not (= (frames ind 0) 10)) (snd-display ";set edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .04) (snd-display ";set edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";set edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .04) (snd-display #__line__ ";set edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(ramp-channel 0.0 1.0 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display ";rmp edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";rmp edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";rmp edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";rmp edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(xramp-channel 0.0 1.0 32.0 5 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display ";xrmp edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";xrmp edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";xrmp edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";xrmp edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(env-channel '(0 0 1 1) 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display ";env edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";env edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";env edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";env edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(ptree-channel (lambda (y) y) 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display ";ptree edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";ptree edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";ptree edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";ptree edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(smooth-channel 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display ";smooth edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";smooth edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";smooth edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";smooth edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(src-channel 0.5 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 16)) (snd-display ";src edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";src edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 16)) (snd-display #__line__ ";src edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";src edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(reverse-channel 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display ";rev edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";rev edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";rev edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";rev edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(filter-channel (vct .1 .2 .1) 3 0 5 ind 0 edpos #t) ; truncate
- (if (not (= (frames ind 0) 10)) (snd-display ";flt edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";flt edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";flt edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";flt edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(scale-channel 1.5 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display ";scl edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display ";scl edpos max: ~A" (maxamp ind 0)))
+ (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";scl edpos len: ~A" (frames ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";scl edpos max: ~A" (maxamp ind 0)))
(undo)
-
+
(close-sound ind)))
-
+
(let ((ind (new-sound "fmv.snd" :size 20)))
(map-channel (lambda (y) 1.0))
(let ((edpos (edit-position ind 0)))
(delete-samples 5 10)
(delete-samples 15 5 ind 0 edpos)
- (if (not (= (frames ind 0) 15)) (snd-display ";delete-samples edpos len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 0) 15)) (snd-display #__line__ ";delete-samples edpos len: ~A" (frames ind 0)))
(undo)
(vct->channel (make-vct 5 0.5) 15 5 ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display ";delete-samples edpos len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";delete-samples edpos len: ~A" (frames ind 0)))
(if (not (vequal (channel->vct 10 10) (vct 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5)))
- (snd-display ";set samples edpos: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";set samples edpos: ~A" (channel->vct 10 10)))
(undo)
(env-channel '(0 0 1 1) 0 #f ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display ";env edpos len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";env edpos len: ~A" (frames ind 0)))
(if (not (vequal (channel->vct 0 20) (vct 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474 0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
- (snd-display ";env edpos: ~A" (channel->vct 0 20)))
+ (snd-display #__line__ ";env edpos: ~A" (channel->vct 0 20)))
(undo)
(ptree-channel (lambda (y) 0.5) 0 #f ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display ";ptree edpos len: ~A" (frames ind 0)))
- (if (not (vequal (channel->vct 0 20) (make-vct 20 0.5))) (snd-display ";ptree edpos: ~A" (channel->vct 0 20)))
+ (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";ptree edpos len: ~A" (frames ind 0)))
+ (if (not (vequal (channel->vct 0 20) (make-vct 20 0.5))) (snd-display #__line__ ";ptree edpos: ~A" (channel->vct 0 20)))
(undo)
(close-sound ind)))
-
+
;; virtual filter as ptree
(let ((ind (new-sound "fmv.snd" :size 20)))
(set! (sample 5) 1.0)
;; forward all
(filter-channel (vct 1.0 0.5 0.25))
- (let ((data (channel->vct 0 20)))
+ (let ((data (channel->vct 0 20 ind 0)))
(undo)
(virtual-filter-channel (vct 1.0 0.5 0.25) 0 #f ind 0 1)
- (let ((vdata (channel->vct 0 20)))
+ (let ((vdata (channel->vct 0 20 ind 0)))
(undo)
(if (not (vequal data vdata))
- (snd-display ";virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (snd-display #__line__ ";virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
;; reverse all
(filter-channel (vct 0.25 0.5 1.0))
@@ -39533,7 +39605,7 @@ EDITS: 1
(let ((vdata (channel->vct 0 20)))
(undo 2)
(if (not (vequal data vdata))
- (snd-display ";reverse virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (snd-display #__line__ ";reverse virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
;; insert block
(filter-channel (vct 0.25 0.5 1.0 0.9 0.6 0.3))
@@ -39545,7 +39617,7 @@ EDITS: 1
(let ((vdata (channel->vct 0 20)))
(undo 2)
(if (not (vequal data vdata))
- (snd-display ";pad virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (snd-display #__line__ ";pad virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
;; delete block
(filter-channel (vct 0.25 0.5 1.0 0.9 0.6 0.3))
@@ -39557,7 +39629,7 @@ EDITS: 1
(let ((vdata (channel->vct 0 20)))
(undo 2)
(if (not (vequal data vdata))
- (snd-display ";delete virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (snd-display #__line__ ";delete virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
;; forward partial
(filter-channel (vct 1.0 0.5 0.25) 3 3 10) ; 3=order! + pre-ring?? -- this is too clever
@@ -39567,7 +39639,7 @@ EDITS: 1
(let ((vdata (channel->vct 2 20)))
(undo)
(if (not (vequal data vdata))
- (snd-display ";partial virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (snd-display #__line__ ";partial virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
;; forward partial reversed
(filter-channel (vct 1.0 0.5 0.25 .6 .3) 5 2 10)
@@ -39579,10 +39651,10 @@ EDITS: 1
(let ((vdata (channel->vct 0 20)))
(undo)
(if (not (vequal data vdata))
- (snd-display ";partial virtual filter reversed: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (snd-display #__line__ ";partial virtual filter reversed: ~% standard: ~A~% virtual: ~A~%" data vdata))))
(close-sound ind))
-
+
(let ((ind (new-sound "fmv.snd" :size 20)))
(set! (sample 5) 1.0)
(filter-channel (vct 1.0 0.5))
@@ -39593,7 +39665,7 @@ EDITS: 1
(filter-channel v)
(let ((vdata (channel->vct 0 20)))
(if (not (vequal data vdata))
- (snd-display ";filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
+ (snd-display #__line__ ";filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
(undo)))
(let ((v1 (make-vct 8))
(v2 (make-vct 5)))
@@ -39607,7 +39679,7 @@ EDITS: 1
(filter-channel v)
(let ((vdata (channel->vct 0 20)))
(if (not (vequal data vdata))
- (snd-display ";random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
+ (snd-display #__line__ ";random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
(undo))))
(let ((v1 (make-vct 18))
(v2 (make-vct 15)))
@@ -39621,10 +39693,10 @@ EDITS: 1
(filter-channel v)
(let ((vdata (channel->vct 0 20)))
(if (not (vequal data vdata))
- (snd-display ";big random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
+ (snd-display #__line__ ";big random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
(undo))))
(close-sound ind))
-
+
(let ((ind (new-sound "fmv.snd" :size 100)))
(set! (sample 5) .5)
(set! (sample 85) .5)
@@ -39632,13 +39704,13 @@ EDITS: 1
(src-channel -1.001) ; avoid optimization
(src-channel '(0 -1.0 1 -1.0) 0 #f ind 0 2)
(let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display ";src-channel -1, distance: ~A" dis)))
+ (if (> dis .2) (snd-display #__line__ ";src-channel -1, distance: ~A" dis)))
(undo 2)
(src-channel 1.001) ; avoid optimization
(src-channel '(0 1.0 1 1.0) 0 #f ind 0 2)
(let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display ";src-channel 1, distance: ~A" dis)))
+ (if (> dis .2) (snd-display #__line__ ";src-channel 1, distance: ~A" dis)))
(undo 2)
(for-each
@@ -39646,7 +39718,7 @@ EDITS: 1
(src-channel rate)
(src-channel (list 0 rate 1 rate) 0 #f ind 0 2)
(let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display ";src-channel ~A, distance: ~A" rate dis)))
+ (if (> dis .2) (snd-display #__line__ ";src-channel ~A, distance: ~A" rate dis)))
(undo 2))
(list 2.0 -2.0 0.5 -0.5 1.5 -1.5 3.0 -3.0 0.2 -0.2))
@@ -39654,13 +39726,13 @@ EDITS: 1
(src-sound -1.001) ; avoid optimization
(src-sound '(0 -1.0 1 -1.0) 1.0 ind 0 2)
(let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display ";src-sound -1, distance: ~A" dis)))
+ (if (> dis .2) (snd-display #__line__ ";src-sound -1, distance: ~A" dis)))
(undo 2)
(src-sound 1.001) ; avoid optimization
(src-sound '(0 1.0 1 1.0) 1.0 ind 0 2)
(let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display ";src-sound 1, distance: ~A" dis)))
+ (if (> dis .2) (snd-display #__line__ ";src-sound 1, distance: ~A" dis)))
(undo 2)
(for-each
@@ -39668,72 +39740,72 @@ EDITS: 1
(src-sound rate)
(src-sound (list 0 rate 1 rate) 1.0 ind 0 2)
(let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display ";src-sound ~A, distance: ~A" rate dis)))
+ (if (> dis .2) (snd-display #__line__ ";src-sound ~A, distance: ~A" rate dis)))
(undo 2))
(list 2.0 -2.0 0.5 -0.5 1.5 -1.5 3.0 -3.0 0.2 -0.2))
(close-sound ind))
-
+
;; additional coverage tests
-
+
(let ((ind (new-sound "test.snd" :size 10)))
(vct->channel (make-vct 10 .4))
(make-selection 3 7) ; beg end just for confusion
(env-selection '(0 0.5 1 0.5))
(let ((data (channel->vct)))
(if (not (vequal data (vct .4 .4 .4 .2 .2 .2 .2 .2 .4 .4)))
- (snd-display ";env-selection constant: ~A" data)))
+ (snd-display #__line__ ";env-selection constant: ~A" data)))
(undo)
(let ((edpos (edit-position ind 0)))
(smooth-channel 10 10 ind 0)
(if (not (= (edit-position ind 0) edpos))
- (snd-display ";smooth past end: ~A ~A" (edit-position ind 0) edpos))
+ (snd-display #__line__ ";smooth past end: ~A ~A" (edit-position ind 0) edpos))
(let ((ctr 0))
(map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (> ctr 3) #t (* y 2)))))
(if (not (= (frames ind 0) 3))
- (snd-display ";map-channel -> #t at 3: ~A" (frames ind 0))
+ (snd-display #__line__ ";map-channel -> #t at 3: ~A" (frames ind 0))
(if (not (vequal (channel->vct) (vct 0.8 0.8 0.8)))
- (snd-display ";map-channel #t result: ~A" (channel->vct))))
+ (snd-display #__line__ ";map-channel #t result: ~A" (channel->vct))))
(undo)
(let ((ctr 0))
(map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (= ctr 3) (make-vct 5 .1) (* y .5)))))
(if (not (= (frames ind 0) 14))
- (snd-display ";map-channel -> vct at 3: ~A" (frames ind 0))
+ (snd-display #__line__ ";map-channel -> vct at 3: ~A" (frames ind 0))
(if (not (vequal (channel->vct) (vct 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.200 0.200 0.200)))
- (snd-display ";map-channel vct result: ~A" (channel->vct))))
+ (snd-display #__line__ ";map-channel vct result: ~A" (channel->vct))))
(undo)
(let ((data (make-vct 2 0.0)))
(map-channel (lambda (y) (vct-set! data 0 y) data)))
(if (not (= (frames ind 0) 20))
- (snd-display ";map-channel -> vct ptree: ~A" (frames ind 0))
+ (snd-display #__line__ ";map-channel -> vct ptree: ~A" (frames ind 0))
(if (not (vequal (channel->vct) (vct 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000)))
- (snd-display ";map-channel vct ptree result: ~A" (channel->vct))))
+ (snd-display #__line__ ";map-channel vct ptree result: ~A" (channel->vct))))
(undo))
(set! (amp-control ind) 2.0)
(apply-controls ind 1 0)
- (if (> (abs (- (maxamp ind 0) .8)) .01) (snd-display ";apply-controls 10: ~A" (channel->vct)))
+ (if (> (abs (- (maxamp ind 0) .8)) .01) (snd-display #__line__ ";apply-controls 10: ~A" (channel->vct)))
(undo)
(set! (amp-control ind) 2.0)
(apply-controls ind 1 5)
(if (not (vequal (channel->vct 0 5) (vct 0.4 0.4 0.4 0.4 0.4)))
- (snd-display ";apply controls from 5: ~A" (channel->vct)))
- (if (ffneq (sample 5) .8) (snd-display ";apply-controls at 5: ~A" (sample 5)))
+ (snd-display #__line__ ";apply controls from 5: ~A" (channel->vct)))
+ (if (ffneq (sample 5) .8) (snd-display #__line__ ";apply-controls at 5: ~A" (sample 5)))
(let ((tag (catch 'no-such-edit
(lambda ()
(save-sound-as "nope.snd" :edit-position 21))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-edit)) (snd-display ";save-sound-as at bad edpos: ~A" tag)))
+ (if (not (eq? tag 'no-such-edit)) (snd-display #__line__ ";save-sound-as at bad edpos: ~A" tag)))
(let ((tag (catch 'no-such-file
(lambda ()
(channel-amp-envs "/baddy/hiho"))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-file)) (snd-display ";channel-amp-envs bad file: ~A" tag)))
+ (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";channel-amp-envs bad file: ~A" tag)))
(close-sound ind))
@@ -39742,28 +39814,28 @@ EDITS: 1
(let ((ctr 0))
(map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (> ctr 3) #t (* y 2)))))
(if (not (= (frames ind 0) 3))
- (snd-display ";map-channel oboe -> #t at 3: ~A" (frames ind 0))
+ (snd-display #__line__ ";map-channel oboe -> #t at 3: ~A" (frames ind 0))
(if (not (vequal (channel->vct) (vct 0.0 -.001 -.001)))
- (snd-display ";map-channel #t oboe result: ~A" (channel->vct))))
+ (snd-display #__line__ ";map-channel #t oboe result: ~A" (channel->vct))))
(undo)
(let ((ctr 0))
(map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (= ctr 3) (make-vct 5 .1) (* y .5)))))
(if (not (= (frames ind 0) (+ 50828 4)))
- (snd-display ";map-channel oboe -> vct at 3: ~A" (frames ind 0))
+ (snd-display #__line__ ";map-channel oboe -> vct at 3: ~A" (frames ind 0))
(if (not (vequal (channel->vct 0 10) (vct 0.000 -0.000 0.100 0.100 0.100 0.100 0.100 -0.000 -0.000 -0.000)))
- (snd-display ";map-channel vct result: ~A" (channel->vct 0 10))))
+ (snd-display #__line__ ";map-channel vct result: ~A" (channel->vct 0 10))))
(undo)
(let ((data (make-vct 2 0.0)))
(map-channel (lambda (y) (vct-set! data 0 y) data)))
(if (not (= (frames ind 0) (* 2 50828)))
- (snd-display ";map-channel oboe -> vct ptree: ~A" (frames ind 0))
+ (snd-display #__line__ ";map-channel oboe -> vct ptree: ~A" (frames ind 0))
(if (not (vequal (channel->vct 0 10) (vct 0.000 0.000 -0.000 0.000 -0.000 0.000 -0.000 0.000 -0.000 0.0)))
- (snd-display ";map-channel vct ptree result: ~A" (channel->vct 0 10))))
+ (snd-display #__line__ ";map-channel vct ptree result: ~A" (channel->vct 0 10))))
(revert-sound)
(close-sound ind))
-
+
(let ((ind (open-sound "2.snd")))
(ramp-channel 0.9 1.0)
(ramp-channel 0.9 1.0)
@@ -39776,11 +39848,11 @@ EDITS: 1
(let ((mxs1 (maxamp ind #t)))
(if (or (fneq (car mxs) (* 2.0 (car mxs1)))
(fneq (cadr mxs) (* 2.0 (cadr mxs1))))
- (snd-display ";env-sound sync'd maxes: ~A -> ~A" mxs mxs1)))
+ (snd-display #__line__ ";env-sound sync'd maxes: ~A -> ~A" mxs mxs1)))
(undo 1))
(close-sound ind))
-
-
+
+
(let ((ind (new-sound :channels 2 :size 10 :comment "new-sound for ramp2-xramp2")))
(map-channel (lambda (y) 1.0))
(ramp-channel 0.9 1.0)
@@ -39794,16 +39866,16 @@ EDITS: 1
(let ((mxs1 (maxamp ind #t)))
(if (or (fneq (car mxs) (* 2.0 (car mxs1)))
(fneq (cadr mxs) (* 2.0 (cadr mxs1))))
- (snd-display ";env-sound sync'd maxes buf: ~A -> ~A" mxs mxs1)))
+ (snd-display #__line__ ";env-sound sync'd maxes buf: ~A -> ~A" mxs mxs1)))
(undo 1))
(let ((name (file-name ind)))
(if (not (= (srate ind) (default-output-srate)))
- (snd-display ";new-sound default srate: ~A ~A" (srate ind) (default-output-srate)))
+ (snd-display #__line__ ";new-sound default srate: ~A ~A" (srate ind) (default-output-srate)))
(close-sound ind)
(if (not (file-exists? name))
- (snd-display ";new-sound temp? ~A" name)
+ (snd-display #__line__ ";new-sound temp? ~A" name)
(delete-file name))))
-
+
))
))
@@ -39831,9 +39903,9 @@ EDITS: 1
(fill-polygon points snd chn))
(arrow-head x0 y0)
(fill-rectangle (- x0 (* 4 size))
- (inexact->exact (floor (- y0 (* .4 size))))
+ (floor (- y0 (* .4 size)))
(* 2 size)
- (inexact->exact (floor (* .8 size)))
+ (floor (* .8 size))
snd chn)))
(if with-gui
@@ -39892,7 +39964,7 @@ EDITS: 1
(and (provided? 'snd-motif)
(or (not (= (length wids1) 11))
(not (= (length wids2) 11)))))
- (snd-display ";channel-widgets confused: ~A ~A ~A ~A ~A" wids wids1 wids2 wids3 wids4))
+ (snd-display #__line__ ";channel-widgets confused: ~A ~A ~A ~A ~A" wids wids1 wids2 wids3 wids4))
(hide-widget (car (channel-widgets)))
(show-widget (car (channel-widgets)))
(close-sound ind1))
@@ -39911,10 +39983,10 @@ EDITS: 1
(start-enveloping)
(let ((nind (open-sound "oboe.snd")))
(if (not (equal? (channel-envelope nind 0) (list 0.0 1.0 1.0 1.0)))
- (snd-display ";channel-envelope: ~A?" (channel-envelope nind 0)))
+ (snd-display #__line__ ";channel-envelope: ~A?" (channel-envelope nind 0)))
(set! (channel-envelope nind 0) (list 0 0 1 1 2 0))
(if (not (equal? (channel-envelope nind 0) (list 0 0 1 1 2 0)))
- (snd-display ";set channel-envelope: ~A?" (channel-envelope nind 0)))
+ (snd-display #__line__ ";set channel-envelope: ~A?" (channel-envelope nind 0)))
(close-sound nind)
(stop-enveloping))
)))
@@ -39937,7 +40009,7 @@ EDITS: 1
(define* (hilbert-transform-via-fft snd chn)
"same as FIR version but use FFT and change phases by hand"
(let* ((size (frames snd chn))
- (len (expt 2 (inexact->exact (ceiling (/ (log size) (log 2.0))))))
+ (len (expt 2 (ceiling (/ (log size) (log 2.0)))))
(rl (make-vct len))
(im (make-vct len))
(rd (make-sampler 0 snd chn)))
@@ -39972,8 +40044,8 @@ EDITS: 1
(bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
(vector-set! ssbs (- i 1) (make-ssb-am (* i factor old-freq)))
(vector-set! bands (- i 1) (make-bandpass (hz->radians (- aff bwf))
- (hz->radians (+ aff bwf))
- order))))
+ (hz->radians (+ aff bwf))
+ order))))
(list ssbs bands)))
(define (ssb-transpose transposer input)
@@ -39997,12 +40069,12 @@ EDITS: 1
(delay dly (+ input (* scaler (ssb-transpose ssb (tap dly))))))))
(define (transposed-echo pitch scaler secs)
- (let ((del (make-fdelay (inexact->exact (round (* secs (srate)))) pitch scaler)))
+ (let ((del (make-fdelay (round (* secs (srate))) pitch scaler)))
(map-channel (lambda (y) (fdelay del y)))))
(define (local-eq? a b)
(if (number? a)
- (if (exact? a)
+ (if (rational? a)
(= a b)
(< (abs (- a b)) .001))
(eq? a b)))
@@ -40050,35 +40122,35 @@ EDITS: 1
(load (string-append cwd (save-state-file)))
(let ((ind (find-sound "oboe.snd")))
(if (not (sound? ind))
- (snd-display ";can't restore oboe.snd from ~A?" (save-state-file))
+ (snd-display #__line__ ";can't restore oboe.snd from ~A?" (save-state-file))
(begin
(if (or (> (abs (- (car old-bounds) (car (x-bounds ind 0)))) .05)
(> (abs (- (cadr old-bounds) (cadr (x-bounds ind 0)))) .05))
- (snd-display ";save bounds: ~A" (x-bounds ind 0)))
+ (snd-display #__line__ ";save bounds: ~A" (x-bounds ind 0)))
(if (not (= (length (marks ind 0)) 1))
- (snd-display ";save marks: ~A (~A)?" (marks ind 0) (save-state-file))
+ (snd-display #__line__ ";save marks: ~A (~A)?" (marks ind 0) (save-state-file))
(begin
(if (not (= (mark-sample (car (marks ind 0))) 122))
- (snd-display ";save mark: ~A?" (mark-sample (car (marks ind 0)))))
+ (snd-display #__line__ ";save mark: ~A?" (mark-sample (car (marks ind 0)))))
(if (not (= (edit-position ind 0) 1))
- (snd-display ";save edit-position: ~A" (edit-position ind 0)))))
+ (snd-display #__line__ ";save edit-position: ~A" (edit-position ind 0)))))
(if (not (equal? (edit-fragment 1 ind 0) (list "delete-samples 12 1" "delete" 12 1)))
- (snd-display ";save edits: ~A" (edit-fragment 1 ind 0)))
+ (snd-display #__line__ ";save edits: ~A" (edit-fragment 1 ind 0)))
(if (not (equal? (edit-tree ind 0)
(list (list 0 0 0 11 1.0 0.0 0.0 0) (list 12 0 13 50827 1.0 0.0 0.0 0) (list 50827 -2 0 0 0.0 0.0 0.0 0))))
- (snd-display ";save edit tree: ~A" (edit-tree ind 0)))
+ (snd-display #__line__ ";save edit tree: ~A" (edit-tree ind 0)))
(if (or (not (number? (sound-property 'ho ind)))
(not (= (sound-property 'ho ind) 1234)))
- (snd-display ";sound-property saved: 1234 -> ~A" (sound-property 'ho ind)))
+ (snd-display #__line__ ";sound-property saved: 1234 -> ~A" (sound-property 'ho ind)))
(if (or (not (string? (sound-property :hi ind)))
(not (string=? (sound-property :hi ind) "hi")))
- (snd-display ";sound-property saved: hi -> ~A" (sound-property :hi ind)))
+ (snd-display #__line__ ";sound-property saved: hi -> ~A" (sound-property :hi ind)))
(if (or (not (number? (channel-property :ha ind 0)))
(fneq (channel-property :ha ind 0) 3.14))
- (snd-display ";channel-property saved: 3.14 -> ~A" (channel-property :ha ind 0)))
+ (snd-display #__line__ ";channel-property saved: 3.14 -> ~A" (channel-property :ha ind 0)))
(close-sound ind)))
(if (not (= after-save-state-hook-var 1234))
- (snd-display ";after-save-state-hook: ~A" after-save-state-hook-var))
+ (snd-display #__line__ ";after-save-state-hook: ~A" after-save-state-hook-var))
(reset-hook! after-save-state-hook)
(reset-hook! before-save-state-hook)
@@ -40086,13 +40158,13 @@ EDITS: 1
(lambda ()
(save-state "/bad/bad.save"))
(lambda args 12345))))
- (if (not (= err 12345)) (snd-display ";save-state err: ~A?" err)))
+ (if (not (= err 12345)) (snd-display #__line__ ";save-state err: ~A?" err)))
(let ((err (catch 'cannot-save
(lambda ()
(save-listener "/bad/bad.save"))
(lambda args 12345))))
- (if (not (= err 12345)) (snd-display ";save-listener err: ~A?" err)))
+ (if (not (= err 12345)) (snd-display #__line__ ";save-listener err: ~A?" err)))
))
(set! nind (open-sound "oboe.snd"))
(set! (sample 1) .5)
@@ -40104,21 +40176,21 @@ EDITS: 1
(revert-sound nind)
(set! sfile nind)
(load (string-append cwd "hiho.scm"))
- (if (not (equal? (edit-fragment 1) '("set-sample 1 0.5000" "set" 1 1))) (snd-display ";save-edit-history 1: ~A?" (edit-fragment 1)))
- (if (not (equal? (edit-fragment 2) '("delete-samples 100 1" "delete" 100 1))) (snd-display ";save-edit-history 2: ~A?" (edit-fragment 2)))
- (if (not (equal? (edit-fragment 3) '("insert-sample 10 0.5000" "insert" 10 1))) (snd-display ";save-edit-history 3: ~A?" (edit-fragment 3)))
- (if (not (equal? (edit-fragment 4) '("scale-channel 2.000 0 #f" "scale" 0 50828))) (snd-display ";save-edit-history 4: ~A?" (edit-fragment 4)))
- (if (not (equal? (edit-fragment 5) '("pad-channel" "zero" 100 20))) (snd-display ";save-edit-history 5: ~A?" (edit-fragment 5)))
+ (if (not (equal? (edit-fragment 1) '("set-sample 1 0.5000" "set" 1 1))) (snd-display #__line__ ";save-edit-history 1: ~A?" (edit-fragment 1)))
+ (if (not (equal? (edit-fragment 2) '("delete-samples 100 1" "delete" 100 1))) (snd-display #__line__ ";save-edit-history 2: ~A?" (edit-fragment 2)))
+ (if (not (equal? (edit-fragment 3) '("insert-sample 10 0.5000" "insert" 10 1))) (snd-display #__line__ ";save-edit-history 3: ~A?" (edit-fragment 3)))
+ (if (not (equal? (edit-fragment 4) '("scale-channel 2.000 0 #f" "scale" 0 50828))) (snd-display #__line__ ";save-edit-history 4: ~A?" (edit-fragment 4)))
+ (if (not (equal? (edit-fragment 5) '("pad-channel" "zero" 100 20))) (snd-display #__line__ ";save-edit-history 5: ~A?" (edit-fragment 5)))
(save-edit-history "hiho.scm" nind 0)
(scale-sound-to 1.0 0 (frames nind 0) nind 0)
(let ((eds (edit-position nind 0))
(val (insert-sound "zero.snd")))
(if (or (not (= 0 val))
(not (= eds (edit-position nind 0))))
- (snd-display ";insert-sound zero.snd was an edit? ~A ~A ~A" val eds (edit-position nind 0))))
+ (snd-display #__line__ ";insert-sound zero.snd was an edit? ~A ~A ~A" val eds (edit-position nind 0))))
(revert-sound nind)
(scale-sound-to 0.5 0 (frames nind 0) nind 0)
- (if (fneq (maxamp nind 0) 0.5) (snd-display ";scale-sound-to 0.5: ~A" (maxamp nind)))
+ (if (fneq (maxamp nind 0) 0.5) (snd-display #__line__ ";scale-sound-to 0.5: ~A" (maxamp nind)))
(close-sound nind)
(let ((nind (open-sound "oboe.snd")))
@@ -40129,15 +40201,15 @@ EDITS: 1
(set! sfile nind)
(load (string-append cwd "hiho.scm"))
(if (not (equal? (edit-fragment 1) '("ramp-channel 0.000 1.000 0 #f" "env" 0 50828)))
- (snd-display ";save-edit-history ramp 1: ~A?" (edit-fragment 1)))
+ (snd-display #__line__ ";save-edit-history ramp 1: ~A?" (edit-fragment 1)))
(if (not (equal? (edit-fragment 2) '("xramp-channel 0.000 1.000 32.000 0 #f" "env" 0 50828)))
- (snd-display ";save-edit-history xramp 2: ~A?" (edit-fragment 2)))
+ (snd-display #__line__ ";save-edit-history xramp 2: ~A?" (edit-fragment 2)))
(revert-sound nind)
(let ((str (file->string "hiho.scm")))
(if (not (string=? str " (ramp-channel 0.000 1.000 0 #f sfile 0 #f)
(xramp-channel 0.000 1.000 32.000 0 #f sfile 0 #f)
"))
- (snd-display ";file->string: ~A" str)))
+ (snd-display #__line__ ";file->string: ~A" str)))
(let ((old-opt (optimization)))
(set! (optimization) 5)
(ptree-channel (lambda (y) (* y 2)))
@@ -40147,7 +40219,7 @@ EDITS: 1
(load (string-append cwd "hiho.scm"))
(set! (optimization) old-opt))
(if (not (equal? (edit-fragment 1) '("ptree-channel" "ptree" 0 50828)))
- (snd-display ";save-edit-history ptree 1: ~A?" (edit-fragment 1)))
+ (snd-display #__line__ ";save-edit-history ptree 1: ~A?" (edit-fragment 1)))
(close-sound nind))
(let ((ind (open-sound "oboe.snd")))
@@ -40160,31 +40232,31 @@ EDITS: 1
(save-state "s61.scm")
(close-sound ind)
(if (not (file-exists? "savehook.snd"))
- (snd-display ";save-state-hook redirect failed? ~A" (hook->list save-state-hook))
+ (snd-display #__line__ ";save-state-hook redirect failed? ~A" (hook->list save-state-hook))
(begin
(load (string-append cwd "s61.scm"))
(set! ind (find-sound "oboe.snd"))
(if (not (sound? ind))
- (snd-display ";save-state after hook restored but no sound?")
+ (snd-display #__line__ ";save-state after hook restored but no sound?")
(begin
- (if (fneq (speed-control ind) .6667) (snd-display ";save-state w/hook speed: ~A" (speed-control ind)))
+ (if (fneq (speed-control ind) .6667) (snd-display #__line__ ";save-state w/hook speed: ~A" (speed-control ind)))
(if (or (not (number? (sound-property :hi ind)))
(not (= (sound-property :hi ind) 12345)))
- (snd-display ";save-state w/hook hi: ~A" (sound-property :hi ind)))
+ (snd-display #__line__ ";save-state w/hook hi: ~A" (sound-property :hi ind)))
(if (not (feql (filter-control-envelope ind) (list 0.0 0.0 1.0 1.0)))
- (snd-display ";save-state w/hook filter env: ~A" (filter-control-envelope ind)))
+ (snd-display #__line__ ";save-state w/hook filter env: ~A" (filter-control-envelope ind)))
;; now check that save-state-hook is not called by other funcs
(reset-hook! save-state-hook)
- (add-hook! save-state-hook (lambda (file) (snd-display ";bogus save-state-hook call!") "edit-list-to-function-saved.snd"))
+ (add-hook! save-state-hook (lambda (file) (snd-display #__line__ ";bogus save-state-hook call!") "edit-list-to-function-saved.snd"))
(let ((func (edit-list->function ind 0)))
(if (file-exists? "edit-list-to-function-saved.snd")
(begin
- (snd-display ";edit-list->function called save-state-hook")
+ (snd-display #__line__ ";edit-list->function called save-state-hook")
(delete-file "edit-list-to-function-saved.snd"))))
(save-edit-history "save-edit-history-saved.scm" ind 0)
(if (file-exists? "edit-list-to-function-saved.snd")
(begin
- (snd-display ";save-edit-history called save-state-hook")
+ (snd-display #__line__ ";save-edit-history called save-state-hook")
(delete-file "edit-list-to-function-saved.snd")))
(delete-file "save-edit-history-saved.scm")
(delete-file "savehook.snd")
@@ -40227,7 +40299,7 @@ EDITS: 1
(load (string-append cwd "t1.scm"))
(set! ind (find-sound "fmv.snd"))
(if (not (sound? ind))
- (snd-display ";save-state restored but no sound?"))
+ (snd-display #__line__ ";save-state restored but no sound?"))
(do ((i 3 (+ 1 i)))
((= i 6))
(set! (sample i) (* i .1))
@@ -40239,7 +40311,7 @@ EDITS: 1
(load (string-append cwd "t1.scm"))
(set! ind (find-sound "fmv.snd"))
(if (not (sound? ind))
- (snd-display ";save-state ~A restored but no sound?" i))))
+ (snd-display #__line__ ";save-state ~A restored but no sound?" i))))
(close-sound ind)
(delete-file "t1.scm"))
@@ -40271,7 +40343,7 @@ EDITS: 1
(set! ind1 (find-sound "fmv1.snd"))
(if (or (not (sound? ind))
(not (sound? ind1)))
- (snd-display ";save-state(2) restored but no sound? ~A ~A" ind ind1)))
+ (snd-display #__line__ ";save-state(2) restored but no sound? ~A ~A" ind ind1)))
(close-sound ind)
(close-sound ind1)
(delete-file "t1.scm"))
@@ -40313,40 +40385,40 @@ EDITS: 1
(close-sound ind)
(for-each forget-region (regions))
(load (string-append cwd "s61.scm"))
- (if (fneq (mus-srate) 48000.0) (snd-display ";save/restore mus-srate: ~A" (mus-srate)))
- (if (not (= (mus-file-buffer-size) 4096)) (snd-display ";save/restore mus-file-buffer-size: ~A" (mus-file-buffer-size)))
- (if (not (= (mus-array-print-length) 24)) (snd-display ";save/restore mus-array-print-length: ~A" (mus-array-print-length)))
- (if (not (= (clm-table-size) 256)) (snd-display ";save/restore clm-table-size: ~A" (clm-table-size)))
+ (if (fneq (mus-srate) 48000.0) (snd-display #__line__ ";save/restore mus-srate: ~A" (mus-srate)))
+ (if (not (= (mus-file-buffer-size) 4096)) (snd-display #__line__ ";save/restore mus-file-buffer-size: ~A" (mus-file-buffer-size)))
+ (if (not (= (mus-array-print-length) 24)) (snd-display #__line__ ";save/restore mus-array-print-length: ~A" (mus-array-print-length)))
+ (if (not (= (clm-table-size) 256)) (snd-display #__line__ ";save/restore clm-table-size: ~A" (clm-table-size)))
(set! (mus-srate) old-srate)
(set! (mus-array-print-length) old-array-print-length)
(set! (mus-file-buffer-size) old-file-buffer-size)
(set! (clm-table-size) old-clm-table-size))
(set! (save-dir) old-save-dir)
(set! ind (find-sound "oboe.snd"))
- (if (not (= (show-axes ind 0) show-no-axes)) (snd-display ";save show-no-axes: ~A" (show-axes ind 0)))
- (if (not (= (zoom-focus-style) zoom-focus-middle)) (snd-display ";save zoom-focus-middle: ~A" (zoom-focus-style)))
- (if (not (= (transform-normalization ind 0) dont-normalize)) (snd-display ";save dont-normalize: ~A" (transform-normalization ind 0)))
- (if (not (= (graph-style ind 0) graph-filled)) (snd-display ";save graph-filled: ~A" (graph-style ind 0)))
- (if (not (= (transform-graph-type ind 0) graph-as-spectrogram)) (snd-display ";save graph-as-spectrogram: ~A" (transform-graph-type ind 0)))
- (if (not (= (time-graph-type ind 0) graph-as-wavogram)) (snd-display ";save graph-as-wavogram: ~A" (time-graph-type ind 0)))
- (if (not (= (x-axis-style ind 0) x-axis-as-percentage)) (snd-display ";save x-axis-as-percentage: ~A" (x-axis-style ind 0)))
- (if (not (= (speed-control-style ind) speed-control-as-semitone)) (snd-display ";save speed-control-style: ~A" (speed-control-style ind)))
- (if (not (= (cursor ind 0) 1234)) (snd-display ";save cursor 1234: ~A" (cursor ind 0)))
- (if (not (string=? (eps-file) "hiho.eps")) (snd-display ";save eps-file: ~A" (eps-file)))
+ (if (not (= (show-axes ind 0) show-no-axes)) (snd-display #__line__ ";save show-no-axes: ~A" (show-axes ind 0)))
+ (if (not (= (zoom-focus-style) zoom-focus-middle)) (snd-display #__line__ ";save zoom-focus-middle: ~A" (zoom-focus-style)))
+ (if (not (= (transform-normalization ind 0) dont-normalize)) (snd-display #__line__ ";save dont-normalize: ~A" (transform-normalization ind 0)))
+ (if (not (= (graph-style ind 0) graph-filled)) (snd-display #__line__ ";save graph-filled: ~A" (graph-style ind 0)))
+ (if (not (= (transform-graph-type ind 0) graph-as-spectrogram)) (snd-display #__line__ ";save graph-as-spectrogram: ~A" (transform-graph-type ind 0)))
+ (if (not (= (time-graph-type ind 0) graph-as-wavogram)) (snd-display #__line__ ";save graph-as-wavogram: ~A" (time-graph-type ind 0)))
+ (if (not (= (x-axis-style ind 0) x-axis-as-percentage)) (snd-display #__line__ ";save x-axis-as-percentage: ~A" (x-axis-style ind 0)))
+ (if (not (= (speed-control-style ind) speed-control-as-semitone)) (snd-display #__line__ ";save speed-control-style: ~A" (speed-control-style ind)))
+ (if (not (= (cursor ind 0) 1234)) (snd-display #__line__ ";save cursor 1234: ~A" (cursor ind 0)))
+ (if (not (string=? (eps-file) "hiho.eps")) (snd-display #__line__ ";save eps-file: ~A" (eps-file)))
(if (not (string=? (x-axis-label ind 0 time-graph) "time-x"))
- (snd-display ";save x-axis-label: ~A" (x-axis-label ind 0 time-graph)))
+ (snd-display #__line__ ";save x-axis-label: ~A" (x-axis-label ind 0 time-graph)))
(if (not (string=? (y-axis-label ind 0 time-graph) "amp-y"))
- (snd-display ";save y-axis-label: ~A" (y-axis-label ind 0 time-graph)))
+ (snd-display #__line__ ";save y-axis-label: ~A" (y-axis-label ind 0 time-graph)))
(if (not (feql (amp-control-bounds ind) (list 0 2.5)))
- (snd-display ";save amp-control-bounds: ~A" (amp-control-bounds ind)))
+ (snd-display #__line__ ";save amp-control-bounds: ~A" (amp-control-bounds ind)))
(if (not (feql (speed-control-bounds ind) (list 1.0 2.5)))
- (snd-display ";save speed-control-bounds: ~A" (speed-control-bounds ind)))
+ (snd-display #__line__ ";save speed-control-bounds: ~A" (speed-control-bounds ind)))
(if (not (feql (contrast-control-bounds ind) (list 0 2.5)))
- (snd-display ";save contrast-control-bounds: ~A" (contrast-control-bounds ind)))
+ (snd-display #__line__ ";save contrast-control-bounds: ~A" (contrast-control-bounds ind)))
(if (not (feql (reverb-control-scale-bounds ind) (list 0 2.5)))
- (snd-display ";save reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds ind)))
+ (snd-display #__line__ ";save reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds ind)))
(if (not (feql (reverb-control-length-bounds ind) (list 0 2.5)))
- (snd-display ";save reverb-control-length-bounds: ~A" (reverb-control-length-bounds ind)))
+ (snd-display #__line__ ";save reverb-control-length-bounds: ~A" (reverb-control-length-bounds ind)))
(set! (eps-file) old-eps-file)
(delete-file "s61.scm")
(close-sound ind))
@@ -40372,19 +40444,19 @@ EDITS: 1
(close-sound ind)
(for-each forget-region (regions))
(load (string-append cwd "s61.scm"))
- (if (not (string=? (tiny-font) "8x13")) (snd-display ";save tiny-font: ~A" (tiny-font)))
- (if (not (string=? (peaks-font) "8x13")) (snd-display ";save peaks-font: ~A" (peaks-font)))
- (if (not (string=? (bold-peaks-font) "8x13")) (snd-display ";save bold-peaks-font: ~A" (bold-peaks-font)))
+ (if (not (string=? (tiny-font) "8x13")) (snd-display #__line__ ";save tiny-font: ~A" (tiny-font)))
+ (if (not (string=? (peaks-font) "8x13")) (snd-display #__line__ ";save peaks-font: ~A" (peaks-font)))
+ (if (not (string=? (bold-peaks-font) "8x13")) (snd-display #__line__ ";save bold-peaks-font: ~A" (bold-peaks-font)))
(if (not (feql (amp-control-bounds) (list 0 2.5)))
- (snd-display ";save amp-control-bounds: ~A" (amp-control-bounds)))
+ (snd-display #__line__ ";save amp-control-bounds: ~A" (amp-control-bounds)))
(if (not (feql (speed-control-bounds) (list 1.0 2.5)))
- (snd-display ";save speed-control-bounds: ~A" (speed-control-bounds)))
+ (snd-display #__line__ ";save speed-control-bounds: ~A" (speed-control-bounds)))
(if (not (feql (contrast-control-bounds) (list 0 2.5)))
- (snd-display ";save contrast-control-bounds: ~A" (contrast-control-bounds)))
+ (snd-display #__line__ ";save contrast-control-bounds: ~A" (contrast-control-bounds)))
(if (not (feql (reverb-control-scale-bounds) (list 0 2.5)))
- (snd-display ";save reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds)))
+ (snd-display #__line__ ";save reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds)))
(if (not (feql (reverb-control-length-bounds) (list 0 2.5)))
- (snd-display ";save reverb-control-length-bounds: ~A" (reverb-control-length-bounds)))
+ (snd-display #__line__ ";save reverb-control-length-bounds: ~A" (reverb-control-length-bounds)))
(set! (tiny-font) old-tiny-font)
(set! (peaks-font) old-peaks-font)
(set! (bold-peaks-font) old-bold-peaks-font)
@@ -40428,11 +40500,11 @@ EDITS: 1
(for-each (lambda (func func-name global local)
(if (or (not (local-eq? (func) global))
(not (local-eq? (func ind 0) local)))
- (snd-display "; save ~A reversed: ~A [~A] ~A [~A]"
+ (snd-display #__line__ "; save ~A reversed: ~A [~A] ~A [~A]"
func-name (func) global (func ind 0) local)))
funcs func-names new-globals new-locals)
(if (not (= (channel-style ind) channels-separate))
- (snd-display ";save channel-style reversed: ~A ~A" (channel-style) (channel-style ind)))
+ (snd-display #__line__ ";save channel-style reversed: ~A ~A" (channel-style) (channel-style ind)))
(for-each (lambda (func val) (set! (func) val)) funcs old-globals)
(close-sound ind)
(set! (zoom-focus-style) zoom-focus-active)
@@ -40442,9 +40514,9 @@ EDITS: 1
(let* ((ind0 (open-sound "oboe.snd"))
(ind1 (open-sound "oboe.snd")))
(if (not (equal? (find-sound "oboe.snd" 0) ind0))
- (snd-display ";find-sound 0: ~A ~A" ind0 (find-sound "oboe.snd" 0)))
+ (snd-display #__line__ ";find-sound 0: ~A ~A" ind0 (find-sound "oboe.snd" 0)))
(if (not (equal? (find-sound "oboe.snd" 1) ind1))
- (snd-display ";find-sound 1: ~A ~A" ind1 (find-sound "oboe.snd" 1)))
+ (snd-display #__line__ ";find-sound 1: ~A ~A" ind1 (find-sound "oboe.snd" 1)))
(add-mark 123 ind0)
(add-mark 321 ind1)
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
@@ -40454,11 +40526,11 @@ EDITS: 1
(load (string-append cwd "s61.scm"))
(set! ind0 (find-sound "oboe.snd" 0))
(set! ind1 (find-sound "oboe.snd" 1))
- (if (or (not ind0) (not ind1)) (snd-display ";saved 2oboes, found: ~A" (map short-file-name (sounds))))
- (if (not (find-mark 123 ind0)) (snd-display ";saved 2oboes mark 0?"))
- (if (find-mark 123 ind1) (snd-display ";saved 2oboes mark 1->0?"))
- (if (not (find-mark 321 ind1)) (snd-display ";saved 2oboes mark 1?"))
- (if (find-mark 321 ind0) (snd-display ";saved 2oboes mark 0->1?"))
+ (if (or (not ind0) (not ind1)) (snd-display #__line__ ";saved 2oboes, found: ~A" (map short-file-name (sounds))))
+ (if (not (find-mark 123 ind0)) (snd-display #__line__ ";saved 2oboes mark 0?"))
+ (if (find-mark 123 ind1) (snd-display #__line__ ";saved 2oboes mark 1->0?"))
+ (if (not (find-mark 321 ind1)) (snd-display #__line__ ";saved 2oboes mark 1?"))
+ (if (find-mark 321 ind0) (snd-display #__line__ ";saved 2oboes mark 0->1?"))
(close-sound ind0)
(close-sound ind1))
@@ -40473,7 +40545,7 @@ EDITS: 1
(load (string-append cwd "s61.scm"))
(set! ind (find-sound "test.snd"))
(if (not (sound? ind))
- (snd-display ";save-state test ~D no test.snd?" ctr)
+ (snd-display #__line__ ";save-state test ~D no test.snd?" ctr)
(begin
(test ind)
(close-sound ind)))
@@ -40528,64 +40600,64 @@ EDITS: 1
(list
;; basic cases
(lambda (ind)
- (if (fneq (sample 10) .5) (snd-display ";insert-sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 101)) (snd-display ";insert-sample save-state len: ~A" (frames ind 0))))
+ (if (fneq (sample 10) .5) (snd-display #__line__ ";insert-sample save-state: ~A" (channel->vct 5 10 ind 0)))
+ (if (not (= (frames ind 0) 101)) (snd-display #__line__ ";insert-sample save-state len: ~A" (frames ind 0))))
(lambda (ind)
- (if (fneq (sample 10) 0.0) (snd-display ";delete-sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 99)) (snd-display ";delete-sample save-state len: ~A" (frames ind 0))))
+ (if (fneq (sample 10) 0.0) (snd-display #__line__ ";delete-sample save-state: ~A" (channel->vct 5 10 ind 0)))
+ (if (not (= (frames ind 0) 99)) (snd-display #__line__ ";delete-sample save-state len: ~A" (frames ind 0))))
(lambda (ind)
- (if (fneq (sample 10) .5) (snd-display ";set sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 100)) (snd-display ";set sample save-state len: ~A" (frames ind 0))))
+ (if (fneq (sample 10) .5) (snd-display #__line__ ";set sample save-state: ~A" (channel->vct 5 10 ind 0)))
+ (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";set sample save-state len: ~A" (frames ind 0))))
(lambda (ind)
- (if (fneq (sample 10) .25) (snd-display ";scl sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 100)) (snd-display ";scl sample save-state len: ~A" (frames ind 0)))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";scl sample save-state edpos: ~A" (edit-position ind 0))))
+ (if (fneq (sample 10) .25) (snd-display #__line__ ";scl sample save-state: ~A" (channel->vct 5 10 ind 0)))
+ (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";scl sample save-state len: ~A" (frames ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";scl sample save-state edpos: ~A" (edit-position ind 0))))
(lambda (ind)
- (if (not (= (frames ind 0) 105)) (snd-display ";pad sample save-state len: ~A" (frames ind 0)))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";pad sample save-state edpos: ~A" (edit-position ind 0)))
+ (if (not (= (frames ind 0) 105)) (snd-display #__line__ ";pad sample save-state len: ~A" (frames ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";pad sample save-state edpos: ~A" (edit-position ind 0)))
(if (not (vequal (vct .5 .5 0 0 0 0 0 .5 .5 .5) (channel->vct 10 10 ind 0)))
- (snd-display ";pad sample save-state: ~A" (channel->vct 10 10 ind 0))))
+ (snd-display #__line__ ";pad sample save-state: ~A" (channel->vct 10 10 ind 0))))
(lambda (ind)
- (if (not (= (frames ind 0) 100)) (snd-display ";env sample save-state len: ~A" (frames ind 0)))
- (if (not (= (edit-position ind 0) 2)) (snd-display ";env sample save-state edpos: ~A" (edit-position ind 0)))
+ (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";env sample save-state len: ~A" (frames ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";env sample save-state edpos: ~A" (edit-position ind 0)))
(if (not (vequal (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 1.0 1.0 1.0 1.0) (channel->vct 0 15 ind 0)))
- (snd-display ";env sample save-state: ~A" (channel->vct 0 15 ind 0))))
+ (snd-display #__line__ ";env sample save-state: ~A" (channel->vct 0 15 ind 0))))
(lambda (ind)
- (if (not (= (frames ind 0) 100)) (snd-display ";ptree sample save-state len: ~A" (frames ind 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";ptree sample save-state edpos: ~A" (edit-position ind 0)))
- (if (fneq (maxamp ind 0) .1) (snd-display ";ptree save-state max: ~A" (maxamp ind 0)))
- (if (not (vequal (make-vct 10 .1) (channel->vct 0 10))) (snd-display ";ptree save-state vals: ~A" (channel->vct 0 10 ind 0))))
+ (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";ptree sample save-state len: ~A" (frames ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";ptree sample save-state edpos: ~A" (edit-position ind 0)))
+ (if (fneq (maxamp ind 0) .1) (snd-display #__line__ ";ptree save-state max: ~A" (maxamp ind 0)))
+ (if (not (vequal (make-vct 10 .1) (channel->vct 0 10))) (snd-display #__line__ ";ptree save-state vals: ~A" (channel->vct 0 10 ind 0))))
;; map-channel as backup
(lambda (ind)
- (if (not (= (frames ind 0) 50)) (snd-display ";map #f save-state len: ~A" (frames ind 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";map #f save-state edpos: ~A" (edit-position ind 0)))
- (if (fneq (maxamp ind 0) .1) (snd-display ";map #f save-state max: ~A" (maxamp ind 0)))
- (if (not (vequal (make-vct 10 .1) (channel->vct 0 10))) (snd-display ";map #f save-state vals: ~A" (channel->vct 0 10 ind 0))))
+ (if (not (= (frames ind 0) 50)) (snd-display #__line__ ";map #f save-state len: ~A" (frames ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";map #f save-state edpos: ~A" (edit-position ind 0)))
+ (if (fneq (maxamp ind 0) .1) (snd-display #__line__ ";map #f save-state max: ~A" (maxamp ind 0)))
+ (if (not (vequal (make-vct 10 .1) (channel->vct 0 10))) (snd-display #__line__ ";map #f save-state vals: ~A" (channel->vct 0 10 ind 0))))
;; as-one-edit
(lambda (ind)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";save-state backup 2 vcts edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup 2 vcts edpos: ~A" (edit-position ind 0)))
(if (not (vequal (channel->vct 0 10 ind 0) (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
- (snd-display ";as-one-edit save-state 1: ~A" (channel->vct 0 10 ind 0)))
+ (snd-display #__line__ ";as-one-edit save-state 1: ~A" (channel->vct 0 10 ind 0)))
(if (not (vequal (channel->vct 20 10 ind 0) (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
- (snd-display ";as-one-edit save-state 2: ~A" (channel->vct 0 10 ind 0))))
+ (snd-display #__line__ ";as-one-edit save-state 2: ~A" (channel->vct 0 10 ind 0))))
(lambda (ind)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";save-state backup vct+scl edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup vct+scl edpos: ~A" (edit-position ind 0)))
(if (not (vequal (channel->vct 0 10 ind 0) (vct-scale! (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) .5)))
- (snd-display ";as-one-edit save-state 3: ~A" (channel->vct 0 10 ind 0))))
+ (snd-display #__line__ ";as-one-edit save-state 3: ~A" (channel->vct 0 10 ind 0))))
(lambda (ind)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";save-state backup vct+del edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup vct+del edpos: ~A" (edit-position ind 0)))
(if (not (vequal (channel->vct 0 10 ind 0) (vct .1 .2 .3 .4 .5 0 0 0 0 0)))
- (snd-display ";as-one-edit save-state 4: ~A" (channel->vct 0 10 ind 0))))
+ (snd-display #__line__ ";as-one-edit save-state 4: ~A" (channel->vct 0 10 ind 0))))
(lambda (ind)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";save-state backup del+insert edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup del+insert edpos: ~A" (edit-position ind 0)))
(if (not (vequal (channel->vct 0 10 ind 0) (vct 0 0 0 0 0 .1 .2 0 0 0)))
- (snd-display ";as-one-edit save-state 5: ~A" (channel->vct 0 10 ind 0)))
- (if (not (= (frames ind 0) 97)) (snd-display ";save-state backup del+insert len: ~A" (frames ind 0))))
+ (snd-display #__line__ ";as-one-edit save-state 5: ~A" (channel->vct 0 10 ind 0)))
+ (if (not (= (frames ind 0) 97)) (snd-display #__line__ ";save-state backup del+insert len: ~A" (frames ind 0))))
)))
@@ -40597,180 +40669,180 @@ EDITS: 1
;; ---- simple scale
(scale-channel 2.0)
- (if (fneq (* 2 mx0) (maxamp)) (snd-display ";edit-list->function off to a bad start: ~A" (maxamp)))
+ (if (fneq (* 2 mx0) (maxamp)) (snd-display #__line__ ";edit-list->function off to a bad start: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 1: ~A" func))
+ (snd-display #__line__ ";edit-list->function 1: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))"))
- (snd-display ";edit-list->function 1: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 1: ~A" (object->string (procedure-source func))))
(func ind 0)
(let ((mx (maxamp)))
- (if (fneq (* 4 mx0) mx) (snd-display ";edit-list->function called (1): ~A ~A" mx mx0))))
+ (if (fneq (* 4 mx0) mx) (snd-display #__line__ ";edit-list->function called (1): ~A ~A" mx mx0))))
(revert-sound ind)
(scale-by 2.0)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 1a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 1a: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))"))
- (snd-display ";edit-list->function 1a: ~A" (object->string (procedure-source func)))))
+ (snd-display #__line__ ";edit-list->function 1a: ~A" (object->string (procedure-source func)))))
(revert-sound ind)
(normalize-channel 1.0)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 1c: ~A" func))
+ (snd-display #__line__ ";edit-list->function 1c: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (normalize-channel 1.0 0 #f snd chn))"))
- (snd-display ";edit-list->function 1c: ~A" (object->string (procedure-source func)))))
+ (snd-display #__line__ ";edit-list->function 1c: ~A" (object->string (procedure-source func)))))
(revert-sound ind)
;; ---- simple delete
(delete-samples 10 100)
- (if (not (= (frames) (- frs 100))) (snd-display ";edit-list->function delete: ~A ~A" frs (frames)))
+ (if (not (= (frames) (- frs 100))) (snd-display #__line__ ";edit-list->function delete: ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 2: ~A" func))
+ (snd-display #__line__ ";edit-list->function 2: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (delete-samples 10 100 snd chn))"))
- (snd-display ";edit-list->function 2: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 2: ~A" (object->string (procedure-source func))))
(func ind 0)
- (if (not (= (frames) (- frs 200))) (snd-display ";edit-list->function called (2): ~A ~A" frs (frames))))
+ (if (not (= (frames) (- frs 200))) (snd-display #__line__ ";edit-list->function called (2): ~A ~A" frs (frames))))
(revert-sound ind)
;; ---- simple delete (a)
(delete-sample 100)
- (if (not (= (frames) (- frs 1))) (snd-display ";edit-list->function delete (2a): ~A ~A" frs (frames)))
+ (if (not (= (frames) (- frs 1))) (snd-display #__line__ ";edit-list->function delete (2a): ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 2a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 2a: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (delete-samples 100 1 snd chn))"))
- (snd-display ";edit-list->function 2a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 2a: ~A" (object->string (procedure-source func))))
(func ind 0)
- (if (not (= (frames) (- frs 2))) (snd-display ";edit-list->function called (2a): ~A ~A" frs (frames))))
+ (if (not (= (frames) (- frs 2))) (snd-display #__line__ ";edit-list->function called (2a): ~A ~A" frs (frames))))
(revert-sound ind)
;; ---- simple zero pad
(pad-channel 10 100)
- (if (not (= (frames) (+ frs 100))) (snd-display ";edit-list->function pad: ~A ~A" frs (frames)))
+ (if (not (= (frames) (+ frs 100))) (snd-display #__line__ ";edit-list->function pad: ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 3: ~A" func))
+ (snd-display #__line__ ";edit-list->function 3: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (pad-channel 10 100 snd chn))"))
- (snd-display ";edit-list->function 3: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 3: ~A" (object->string (procedure-source func))))
(func ind 0)
- (if (not (= (frames) (+ frs 200))) (snd-display ";edit-list->function called (3): ~A ~A" frs (frames))))
+ (if (not (= (frames) (+ frs 200))) (snd-display #__line__ ";edit-list->function called (3): ~A ~A" frs (frames))))
(revert-sound ind)
;; ---- simple zero pad (a)
(insert-silence 10 100)
- (if (not (= (frames) (+ frs 100))) (snd-display ";edit-list->function pad (3a): ~A ~A" frs (frames)))
+ (if (not (= (frames) (+ frs 100))) (snd-display #__line__ ";edit-list->function pad (3a): ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 3a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 3a: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (pad-channel 10 100 snd chn))"))
- (snd-display ";edit-list->function 3a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 3a: ~A" (object->string (procedure-source func))))
(func ind 0)
- (if (not (= (frames) (+ frs 200))) (snd-display ";edit-list->function called (3a): ~A ~A" frs (frames))))
+ (if (not (= (frames) (+ frs 200))) (snd-display #__line__ ";edit-list->function called (3a): ~A ~A" frs (frames))))
(revert-sound ind)
;; --- simple ramp
(ramp-channel 0.2 0.9)
- (if (fneq (maxamp) 0.0899) (snd-display ";edit-list ramp: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.0899) (snd-display #__line__ ";edit-list ramp: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 4: ~A" func))
+ (snd-display #__line__ ";edit-list->function 4: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (ramp-channel 0.2 0.9 0 #f snd chn))"))
- (snd-display ";edit-list->function 4: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 4: ~A" (object->string (procedure-source func))))
(func ind 0)
(let ((mx (maxamp)))
- (if (fneq mx 0.061) (snd-display ";edit-list->function called (4): ~A" mx))))
+ (if (fneq mx 0.061) (snd-display #__line__ ";edit-list->function called (4): ~A" mx))))
(revert-sound ind)
;; --- simple xramp
(xramp-channel 0.2 0.9 32.0)
- (if (and (fneq (maxamp) 0.055) (fneq (maxamp) .056)) (snd-display ";edit-list xramp: ~A" (maxamp)))
+ (if (and (fneq (maxamp) 0.055) (fneq (maxamp) .056)) (snd-display #__line__ ";edit-list xramp: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 5: ~A" func))
+ (snd-display #__line__ ";edit-list->function 5: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (xramp-channel 0.2 0.9 32.0 0 #f snd chn))"))
- (snd-display ";edit-list->function 5: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 5: ~A" (object->string (procedure-source func))))
(func ind 0)
(let ((mx (maxamp)))
- (if (fneq mx 0.0266) (snd-display ";edit-list->function called (5): ~A" mx))))
+ (if (fneq mx 0.0266) (snd-display #__line__ ";edit-list->function called (5): ~A" mx))))
(revert-sound ind)
;; ---- simple env
(env-sound '(0 0 1 1))
- (if (fneq (maxamp) 0.0906) (snd-display ";edit-list env: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.0906) (snd-display #__line__ ";edit-list env: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 6: ~A" func))
+ (snd-display #__line__ ";edit-list->function 6: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (quote (0.0 0.0 1.0 1.0)) 0 #f snd chn))"))
- (snd-display ";edit-list->function 6: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 6: ~A" (object->string (procedure-source func))))
(func ind 0)
(let ((mx (maxamp)))
- (if (fneq mx 0.0634) (snd-display ";edit-list->function called (6): ~A" mx))))
+ (if (fneq mx 0.0634) (snd-display #__line__ ";edit-list->function called (6): ~A" mx))))
(revert-sound ind)
;; ---- less simple env
(env-sound '(0 0 1 .3 2 .8 3 0))
- (if (fneq (maxamp) 0.107) (snd-display ";edit-list env: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.107) (snd-display #__line__ ";edit-list env: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (quote (0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0)) 0 #f snd chn))"))
- (snd-display ";edit-list->function 7: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 7: ~A" (object->string (procedure-source func))))
(func ind 0)
(let ((mx (maxamp)))
- (if (fneq mx 0.0857) (snd-display ";edit-list->function called (7): ~A" mx))))
+ (if (fneq mx 0.0857) (snd-display #__line__ ";edit-list->function called (7): ~A" mx))))
(revert-sound ind)
(env-channel '(0 0 1 .3 2 .8 3 0))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7a: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (quote (0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0)) 0 #f snd chn))"))
- (snd-display ";edit-list->function 7a: ~A" (object->string (procedure-source func)))))
+ (snd-display #__line__ ";edit-list->function 7a: ~A" (object->string (procedure-source func)))))
(revert-sound ind)
(env-channel '(0 0 1 .3 2 .8 3 0) 1000 2000)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7b: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7b: ~A" func))
(if (and (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0)) :base 1.0 :end 1999) 1000 2000 snd chn))"))
(not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0)) #:base 1.0 #:end 1999) 1000 2000 snd chn))")))
- (snd-display ";edit-list->function 7b: ~A" (object->string (procedure-source func)))))
+ (snd-display #__line__ ";edit-list->function 7b: ~A" (object->string (procedure-source func)))))
(revert-sound ind)
(env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 32.0 :length 2000) 1000 2000)
(let ((func (edit-list->function))
(mxenv0 (maxamp)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7c: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7c: ~A" func))
(if (and (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0)) :base 32.0 :end 1999) 1000 2000 snd chn))"))
(not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0)) #:base 32.0 #:end 1999) 1000 2000 snd chn))")))
- (snd-display ";edit-list->function 7c: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 7c: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :length 2000 :offset 2.0 :scaler 3.0) 1000 2000)
(let ((func (edit-list->function))
(mxenv1 (maxamp)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7d: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7d: ~A" func))
(if (and (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 2.0 1.0 2.9 2.0 4.4 3.0 2.0)) :base 1.0 :end 1999) 1000 2000 snd chn))"))
(not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 2.0 1.0 2.9 2.0 4.4 3.0 2.0)) #:base 1.0 #:end 1999) 1000 2000 snd chn))")))
- (snd-display ";edit-list->function 7d: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 7d: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(let ((nmx (maxamp)))
- (if (fneq nmx mxenv1) (snd-display ";edit-list->function 7d max: ~A ~A ~A" nmx mxenv1 mxenv0)))))
+ (if (fneq nmx mxenv1) (snd-display #__line__ ";edit-list->function 7d max: ~A ~A ~A" nmx mxenv1 mxenv0)))))
(revert-sound ind)
(do ((i 0 (+ 1 i)))
@@ -40778,166 +40850,166 @@ EDITS: 1
(env-channel '(0 0 1 1 2 0)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7e: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7e: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (quote (0.0 0.0 1.0 1.0 2.0 0.0)) 0 #f snd chn) (env-channel (quote (0.0 0.0 1.0 1.0 2.0 0.0)) 0 #f snd chn) (env-channel (quote (0.0 0.0 1.0 1.0 2.0 0.0)) 0 #f snd chn) (env-channel (quote (0.0 0.0 1.0 1.0 2.0 0.0)) 0 #f snd chn) (env-channel (quote (0.0 0.0 1.0 1.0 2.0 0.0)) 0 #f snd chn))"))
- (snd-display ";edit-list->function 7e: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 7e: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (fneq (maxamp) 0.1459) (snd-display ";edit-list->function 7e max: ~A" (maxamp)))
- (if (not (= (edit-position) 5)) (snd-display ";edit-list->function 7e edpos: ~A" (edit-position))))
+ (if (fneq (maxamp) 0.1459) (snd-display #__line__ ";edit-list->function 7e max: ~A" (maxamp)))
+ (if (not (= (edit-position) 5)) (snd-display #__line__ ";edit-list->function 7e edpos: ~A" (edit-position))))
(revert-sound ind)
(env-sound '(0 0 1 1 2 0) 0 (frames) 32.0)
- (if (fneq (maxamp) 0.146) (snd-display ";edit-list env 7f: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.146) (snd-display #__line__ ";edit-list env 7f: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7f: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7f: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel-with-base (quote (0.0 0.0 1.0 1.0 2.0 0.0)) 32.0 0 #f snd chn))"))
- (snd-display ";edit-list->function 7f: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 7f: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(let ((mx (maxamp)))
- (if (fneq mx 0.146) (snd-display ";edit-list->function called (7f): ~A" mx))))
+ (if (fneq mx 0.146) (snd-display #__line__ ";edit-list->function called (7f): ~A" mx))))
(revert-sound ind)
(env-sound '(0 0 1 1 2 1 3 0) 0 (frames) 0.0)
- (if (fneq (sample 4000) 0.0) (snd-display ";edit-list env 7g: ~A" (sample 4000)))
+ (if (fneq (sample 4000) 0.0) (snd-display #__line__ ";edit-list env 7g: ~A" (sample 4000)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 7g: ~A" func))
+ (snd-display #__line__ ";edit-list->function 7g: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel-with-base (quote (0.0 0.0 1.0 1.0 2.0 1.0 3.0 0.0)) 0.0 0 #f snd chn))"))
- (snd-display ";edit-list->function 7g: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 7g: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (fneq (sample 4000) 0.0) (snd-display ";edit-list function 7g: ~A" (sample 4000))))
+ (if (fneq (sample 4000) 0.0) (snd-display #__line__ ";edit-list function 7g: ~A" (sample 4000))))
(revert-sound ind)
;; ---- simple ptree
- (if (provided? 'run)
- (let ((old-opt (optimization)))
- (set! (optimization) 6)
- (ptree-channel (lambda (y) (+ y .1)))
- (if (fneq (maxamp) 0.247) (snd-display ";edit-list ptree: ~A" (maxamp)))
- (let ((func (edit-list->function)))
- (if (not (procedure? func))
- (snd-display ";edit-list->function 8: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (ptree-channel (lambda (y) (+ y 0.1)) 0 #f snd chn))"))
- (snd-display ";edit-list->function 8: ~A" (object->string (procedure-source func))))
- (func ind 0)
- (let ((mx (maxamp)))
- (if (fneq mx 0.347) (snd-display ";edit-list->function called (8): ~A" mx))))
- (revert-sound ind)
- (set! (optimization) old-opt)))
+
+ (let ((old-opt (optimization)))
+ (set! (optimization) 6)
+ (ptree-channel (lambda (y) (+ y .1)))
+ (if (fneq (maxamp) 0.247) (snd-display #__line__ ";edit-list ptree: ~A" (maxamp)))
+ (let ((func (edit-list->function)))
+ (if (not (procedure? func))
+ (snd-display #__line__ ";edit-list->function 8: ~A" func))
+ (if (not (string=? (object->string (procedure-source func))
+ "(lambda (snd chn) (ptree-channel (lambda (y) (+ y 0.1)) 0 #f snd chn))"))
+ (snd-display #__line__ ";edit-list->function 8: ~A" (object->string (procedure-source func))))
+ (func ind 0)
+ (let ((mx (maxamp)))
+ (if (fneq mx 0.347) (snd-display #__line__ ";edit-list->function called (8): ~A" mx))))
+ (revert-sound ind)
+ (set! (optimization) old-opt))
;; ---- simple 1 sample insert
(insert-sample 100 .1)
- (if (not (= (frames) (+ frs 1))) (snd-display ";edit-list->function insert-sample: ~A ~A" frs (frames)))
+ (if (not (= (frames) (+ frs 1))) (snd-display #__line__ ";edit-list->function insert-sample: ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 9: ~A" func))
+ (snd-display #__line__ ";edit-list->function 9: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (insert-sample 100 0.1 snd chn))"))
- (snd-display ";edit-list->function 9: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 9: ~A" (object->string (procedure-source func))))
(func ind 0)
(if (not (vequal (channel->vct 99 4) (vct 0.0 0.1 0.1 0.0)))
- (snd-display ";edit-list->function func 9: ~A" (channel->vct 99 4)))
- (if (not (= (frames) (+ frs 2))) (snd-display ";edit-list->function called (9): ~A ~A" frs (frames))))
+ (snd-display #__line__ ";edit-list->function func 9: ~A" (channel->vct 99 4)))
+ (if (not (= (frames) (+ frs 2))) (snd-display #__line__ ";edit-list->function called (9): ~A ~A" frs (frames))))
(revert-sound ind)
;; ---- insert-samples with data
(insert-samples 0 100 (make-vct 100 .1))
- (if (not (= (frames) (+ frs 100))) (snd-display ";edit-list->function insert-samples (100): ~A ~A" frs (frames)))
+ (if (not (= (frames) (+ frs 100))) (snd-display #__line__ ";edit-list->function insert-samples (100): ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 9a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 9a: ~A" func))
(func ind 0)
- (if (not (= (frames) (+ frs 200))) (snd-display ";edit-list->function insert-samples (200): ~A ~A" frs (frames)))
+ (if (not (= (frames) (+ frs 200))) (snd-display #__line__ ";edit-list->function insert-samples (200): ~A ~A" frs (frames)))
(if (not (vequal (channel->vct 0 5) (vct 0.1 0.1 0.1 0.1 0.1)))
- (snd-display ";edit-list->function func 9a: ~A" (channel->vct 0 5))))
+ (snd-display #__line__ ";edit-list->function func 9a: ~A" (channel->vct 0 5))))
(revert-sound ind)
;; ---- set-samples with data
(set! (samples 0 100) (make-vct 100 .1))
- (if (not (= (frames) frs)) (snd-display ";edit-list->function set-samples (1): ~A ~A" frs (frames)))
+ (if (not (= (frames) frs)) (snd-display #__line__ ";edit-list->function set-samples (1): ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 9b: ~A" func))
+ (snd-display #__line__ ";edit-list->function 9b: ~A" func))
(func ind 0)
- (if (not (= (frames) frs)) (snd-display ";edit-list->function set-samples (2): ~A ~A" frs (frames)))
+ (if (not (= (frames) frs)) (snd-display #__line__ ";edit-list->function set-samples (2): ~A ~A" frs (frames)))
(if (not (vequal (channel->vct 0 5) (vct 0.1 0.1 0.1 0.1 0.1)))
- (snd-display ";edit-list->function func 9b: ~A" (channel->vct 0 5))))
+ (snd-display #__line__ ";edit-list->function func 9b: ~A" (channel->vct 0 5))))
(revert-sound ind)
;; ---- simple 1 sample set
(let ((val (sample 100)))
(set! (sample 100) .1)
- (if (not (= (frames) frs)) (snd-display ";edit-list->function set-sample frames: ~A ~A" frs (frames)))
- (if (fneq (sample 100) .1) (snd-display ";edit-list->function set-sample val: ~A ~A" val (sample 100)))
+ (if (not (= (frames) frs)) (snd-display #__line__ ";edit-list->function set-sample frames: ~A ~A" frs (frames)))
+ (if (fneq (sample 100) .1) (snd-display #__line__ ";edit-list->function set-sample val: ~A ~A" val (sample 100)))
(let ((func (edit-list->function)))
(revert-sound)
- (if (fneq val (sample 100)) (snd-display ";edit-list->function unset-sample val: ~A ~A" val (sample 100)))
+ (if (fneq val (sample 100)) (snd-display #__line__ ";edit-list->function unset-sample val: ~A ~A" val (sample 100)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 10: ~A" func))
+ (snd-display #__line__ ";edit-list->function 10: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (set-sample 100 0.1 snd chn))"))
- (snd-display ";edit-list->function 10: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 10: ~A" (object->string (procedure-source func))))
(func ind 0)
(if (not (vequal (channel->vct 99 4) (vct 0.0 0.1 0.0 0.0)))
- (snd-display ";edit-list->function func 10: ~A" (channel->vct 99 4)))))
+ (snd-display #__line__ ";edit-list->function func 10: ~A" (channel->vct 99 4)))))
(revert-sound ind)
(let ((pfrs (mus-sound-frames "pistol.snd")))
(insert-sound "pistol.snd" 1000)
- (if (not (= (frames) (+ frs pfrs))) (snd-display ";edit-list->function insert-sound: ~A ~A" frs (frames)))
+ (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function insert-sound: ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 10a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 10a: ~A" func))
(if (and (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (insert-sound \"/home/bil/cl/pistol.snd\" 1000 0 snd chn))"))
(not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (insert-sound \"/home/bil/snd-11/pistol.snd\" 1000 0 snd chn))")))
- (snd-display ";edit-list->function 10a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 10a: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (not (= (frames) (+ frs pfrs))) (snd-display ";edit-list->function called (10): ~A ~A" frs (frames)))))
+ (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function called (10): ~A ~A" frs (frames)))))
(revert-sound ind)
(let ((pfrs (mus-sound-frames "pistol.snd")))
(insert-samples 1000 pfrs "pistol.snd")
- (if (not (= (frames) (+ frs pfrs))) (snd-display ";edit-list->function insert-samples: ~A ~A" frs (frames)))
+ (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function insert-samples: ~A ~A" frs (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 11: ~A" func))
+ (snd-display #__line__ ";edit-list->function 11: ~A" func))
(if (and (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (insert-samples 1000 41623 \"/home/bil/cl/pistol.snd\" snd chn))"))
(not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (insert-samples 1000 41623 \"/home/bil/snd-11/pistol.snd\" snd chn))")))
- (snd-display ";edit-list->function 11: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 11: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (not (= (frames) (+ frs pfrs))) (snd-display ";edit-list->function called (11): ~A ~A" frs (frames)))))
+ (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function called (11): ~A ~A" frs (frames)))))
(revert-sound ind)
(smooth-channel 1000 100)
(let ((func (edit-list->function))
(val (sample 1050)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 12: ~A" func))
+ (snd-display #__line__ ";edit-list->function 12: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (smooth-channel 1000 100 snd chn))"))
- (snd-display ";edit-list->function 12: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 12: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (fneq (sample 1050) val) (snd-display ";edit-list->function 12: ~A ~A" (sample 1050) val)))
+ (if (fneq (sample 1050) val) (snd-display #__line__ ";edit-list->function 12: ~A ~A" (sample 1050) val)))
(revert-sound ind)
(smooth-sound 1000 100)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 12a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 12a: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (smooth-channel 1000 100 snd chn))"))
- (snd-display ";edit-list->function 12a: ~A" (object->string (procedure-source func)))))
+ (snd-display #__line__ ";edit-list->function 12a: ~A" (object->string (procedure-source func)))))
(revert-sound ind)
@@ -40946,37 +41018,37 @@ EDITS: 1
(scale-selection-by 2.0)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 13: ~A" func))
+ (snd-display #__line__ ";edit-list->function 13: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 1000 10001 snd chn))"))
- (snd-display ";edit-list->function 13: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 13: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(let ((mx (maxamp)))
- (if (fneq mx .269) (snd-display ";edit-list->function called (13): ~A" mx))))
+ (if (fneq mx .269) (snd-display #__line__ ";edit-list->function called (13): ~A" mx))))
(revert-sound ind)
(scale-selection-to 1.0)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 13a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 13a: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (normalize-channel 1.0 1000 10001 snd chn))"))
- (snd-display ";edit-list->function 13a: ~A" (object->string (procedure-source func)))))
+ (snd-display #__line__ ";edit-list->function 13a: ~A" (object->string (procedure-source func)))))
(revert-sound ind)
(env-selection '(0 0 1 1 2 0))
(let ((func (edit-list->function)))
- (if (fneq (sample 4000) 0.0173) (snd-display ";edit-list->function 14 samp: ~A" (sample 4000)))
+ (if (fneq (sample 4000) 0.0173) (snd-display #__line__ ";edit-list->function 14 samp: ~A" (sample 4000)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 14: ~A" func))
+ (snd-display #__line__ ";edit-list->function 14: ~A" func))
(if (and (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 0.0 1.0 1.0 2.0 0.0)) :base 1.0 :end 10000) 1000 10001 snd chn))"))
(not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (env-channel (make-env (quote (0.0 0.0 1.0 1.0 2.0 0.0)) #:base 1.0 #:end 10000) 1000 10001 snd chn))")))
- (snd-display ";edit-list->function 14: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 14: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (fneq (sample 4000) 0.0173) (snd-display ";edit-list->function 14 re-samp: ~A" (sample 4000))))
+ (if (fneq (sample 4000) 0.0173) (snd-display #__line__ ";edit-list->function 14 re-samp: ~A" (sample 4000))))
(revert-sound ind)
(make-selection 1000 1100)
@@ -40984,20 +41056,20 @@ EDITS: 1
(let ((func (edit-list->function))
(val (sample 1050)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 14a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 14a: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (smooth-channel 1000 101 snd chn))"))
- (snd-display ";edit-list->function 14a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 14a: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (fneq (sample 1050) val) (snd-display ";edit-list->function 14a: ~A ~A" (sample 1050) val)))
+ (if (fneq (sample 1050) val) (snd-display #__line__ ";edit-list->function 14a: ~A ~A" (sample 1050) val)))
(revert-sound ind)
(reverse-selection)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 14b: ~A" func))
+ (snd-display #__line__ ";edit-list->function 14b: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 1000 101 snd chn))"))
- (snd-display ";edit-list->function 14b: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 14b: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0))
(revert-sound ind)
@@ -41005,9 +41077,9 @@ EDITS: 1
(delete-selection)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 14c: ~A" func))
+ (snd-display #__line__ ";edit-list->function 14c: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (delete-samples 1000 101 snd chn))"))
- (snd-display ";edit-list->function 14c: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 14c: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0))
(revert-sound ind)
@@ -41022,7 +41094,7 @@ EDITS: 1
(func ind 0)
(let ((data (channel->vct)))
(if (not (vequal data (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.0)))
- (snd-display ";edit-list->function env reapply: ~A" data)))
+ (snd-display #__line__ ";edit-list->function env reapply: ~A" data)))
(close-sound ind)
(set! ind (open-sound "oboe.snd")))
@@ -41032,13 +41104,13 @@ EDITS: 1
(let ((func (edit-list->function))
(val (sample 2050)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 16: ~A" func))
-; (if (not (string=? (object->string (procedure-source func))
-; (string-append "(lambda (snd chn) (insert-region (integer->region " (number->string (region->integer reg)) " 2000 snd chn))")))
-; (snd-display ";edit-list->function 16: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 16: ~A" func))
+ ; (if (not (string=? (object->string (procedure-source func))
+ ; (string-append "(lambda (snd chn) (insert-region (integer->region " (number->string (region->integer reg)) " 2000 snd chn))")))
+ ; (snd-display #__line__ ";edit-list->function 16: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (fneq (sample 2050) val) (snd-display ";edit-list->function 16: ~A ~A" (sample 2050) val))))
+ (if (fneq (sample 2050) val) (snd-display #__line__ ";edit-list->function 16: ~A ~A" (sample 2050) val))))
(revert-sound ind)
;; ---- reverse
@@ -41046,82 +41118,82 @@ EDITS: 1
(let ((func (edit-list->function))
(val (sample 2000)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 17: ~A" func))
+ (snd-display #__line__ ";edit-list->function 17: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 0 #f snd chn))"))
- (snd-display ";edit-list->function 17: ~A" (object->string (procedure-source func))))
- (if (fneq val -.002) (snd-display ";edit-list->function val: ~A" val))
+ (snd-display #__line__ ";edit-list->function 17: ~A" (object->string (procedure-source func))))
+ (if (fneq val -.002) (snd-display #__line__ ";edit-list->function val: ~A" val))
(revert-sound ind)
(func ind 0)
- (if (fneq val -.002) (snd-display ";edit-list->function 17 re-val: ~A" val)))
+ (if (fneq val -.002) (snd-display #__line__ ";edit-list->function 17 re-val: ~A" val)))
(revert-sound ind)
(reverse-sound)
(let ((func (edit-list->function))
(val (sample 2000)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 17a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 17a: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 0 #f snd chn))"))
- (snd-display ";edit-list->function 17a: ~A" (object->string (procedure-source func))))
- (if (fneq val -.002) (snd-display ";edit-list->function 17a val: ~A" val)))
+ (snd-display #__line__ ";edit-list->function 17a: ~A" (object->string (procedure-source func))))
+ (if (fneq val -.002) (snd-display #__line__ ";edit-list->function 17a val: ~A" val)))
(revert-sound ind)
(reverse-channel 1000 500)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 17b: ~A" func))
+ (snd-display #__line__ ";edit-list->function 17b: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 1000 500 snd chn))"))
- (snd-display ";edit-list->function 17b: ~A" (object->string (procedure-source func)))))
+ (snd-display #__line__ ";edit-list->function 17b: ~A" (object->string (procedure-source func)))))
(revert-sound ind)
;; ---- src
(src-sound 2.0)
- (if (> (abs (- (frames) 25415)) 2) (snd-display ";edit-list->function 18 len: ~A" (frames)))
+ (if (> (abs (- (frames) 25415)) 2) (snd-display #__line__ ";edit-list->function 18 len: ~A" (frames)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 18: ~A" func))
+ (snd-display #__line__ ";edit-list->function 18: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (src-channel 2.0 0 #f snd chn))"))
- (snd-display ";edit-list->function 18: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 18: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (> (abs (- (frames) 25415)) 2) (snd-display ";edit-list->function 18 re-len: ~A" (frames))))
+ (if (> (abs (- (frames) 25415)) 2) (snd-display #__line__ ";edit-list->function 18 re-len: ~A" (frames))))
(revert-sound ind)
(src-channel 2.0 1000 500)
(let ((func (edit-list->function))
(frs (frames)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 18a: ~A" func))
+ (snd-display #__line__ ";edit-list->function 18a: ~A" func))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (src-channel 2.0 1000 500 snd chn))"))
- (snd-display ";edit-list->function 18a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 18a: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (not (= frs (frames))) (snd-display ";edit-list->function 18a re-len: ~A ~A" frs (frames))))
+ (if (not (= frs (frames))) (snd-display #__line__ ";edit-list->function 18a re-len: ~A ~A" frs (frames))))
(revert-sound)
(src-sound '(0 1 1 2 2 1))
(let ((func (edit-list->function))
(frs (frames)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 18b: ~A" func))
+ (snd-display #__line__ ";edit-list->function 18b: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (src-channel (quote (0.0 1.0 1.0 2.0 2.0 1.0)) 0 #f snd chn))"))
- (snd-display ";edit-list->function 18b: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 18b: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (not (= frs (frames))) (snd-display ";edit-list->function 18b re-len: ~A ~A" frs (frames))))
+ (if (not (= frs (frames))) (snd-display #__line__ ";edit-list->function 18b re-len: ~A ~A" frs (frames))))
(revert-sound)
(src-channel '(0 1 1 2) 1000 500)
(let ((func (edit-list->function))
(frs (frames)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 18c: ~A" func))
+ (snd-display #__line__ ";edit-list->function 18c: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (src-channel (quote (0.0 1.0 1.0 2.0)) 1000 500 snd chn))"))
- (snd-display ";edit-list->function 18c: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 18c: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (not (= frs (frames))) (snd-display ";edit-list->function 18c re-len: ~A ~A" frs (frames))))
+ (if (not (= frs (frames))) (snd-display #__line__ ";edit-list->function 18c re-len: ~A ~A" frs (frames))))
(revert-sound)
;; ---- filter-channel
@@ -41129,13 +41201,13 @@ EDITS: 1
(let ((func (edit-list->function))
(mx (maxamp)))
(if (not (procedure? func))
- (snd-display ";edit-list->function 19: ~A" func))
+ (snd-display #__line__ ";edit-list->function 19: ~A" func))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (filter-channel (quote (0.0 1.0 1.0 0.0)) 10 0 #f snd chn))"))
- (snd-display ";edit-list->function 19: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 19: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
- (if (fneq mx (maxamp)) (snd-display ";edit-list->function 19 re-filter: ~A ~A" mx (maxamp))))
+ (if (fneq mx (maxamp)) (snd-display #__line__ ";edit-list->function 19 re-filter: ~A ~A" mx (maxamp))))
(revert-sound)
(let ((op (make-one-zero .5 .5))) (filter-fft op))
@@ -41154,13 +41226,13 @@ EDITS: 1
(if (not (vequal vals (vct -0.000 0.500 0.000 -0.500 0.000 0.500 0.000 -0.500 0.000 0.500 -0.000
-0.500 -0.000 0.500 -0.000 -0.500 -0.000 0.500 0.000 -0.500 0.000 0.500
0.000 -0.500 0.000 0.500 -0.000 -0.500 -0.000 0.500 -0.000 -0.500)))
- (snd-display ";fft-env-data: ~A" vals)))
+ (snd-display #__line__ ";fft-env-data: ~A" vals)))
(hilbert-transform-via-fft)
(let ((vals (channel->vct)))
(if (not (vequal vals (vct -0.500 -0.000 0.500 -0.000 -0.500 0.000 0.500 0.000 -0.500 0.000 0.500
0.000 -0.500 -0.000 0.500 -0.000 -0.500 -0.000 0.500 -0.000 -0.500 0.000
0.500 0.000 -0.500 0.000 0.500 0.000 -0.500 -0.000 0.500 -0.000)))
- (snd-display ";hilbert via dft: ~A" vals)))
+ (snd-display #__line__ ";hilbert via dft: ~A" vals)))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
@@ -41169,7 +41241,7 @@ EDITS: 1
(if (not (vequal vals (vct 0.000 0.107 0.206 0.298 0.384 0.463 0.536 0.605 0.668 0.727 0.781 0.832 0.879
0.922 0.963 1.000 1.000 0.787 0.618 0.484 0.377 0.293 0.226 0.173 0.130 0.097
0.070 0.049 0.032 0.019 0.008 0.000)))
- (snd-display ";powenv-channel: ~A" vals)))
+ (snd-display #__line__ ";powenv-channel: ~A" vals)))
(undo)
(revert-sound ind)
(map-channel (lambda (y) 1.0))
@@ -41177,21 +41249,21 @@ EDITS: 1
(set! (cursor ind 0) 10)
(make-selection 0 7 ind 0)
(if (not (selection?))
- (snd-display ";make-selection failed??")
+ (snd-display #__line__ ";make-selection failed??")
(begin
(replace-with-selection)
(let ((vals (channel->vct)))
(if (not (vequal vals (vct 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.000 0.032 0.065
0.097 0.129 0.161 0.194 0.226 0.581 0.613 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
- (snd-display ";replace-with-selection: ~A" vals)))))
+ (snd-display #__line__ ";replace-with-selection: ~A" vals)))))
(set! (cursor ind 0) 2)
(replace-with-selection)
(let ((vals (channel->vct)))
(if (not (vequal vals (vct 0.000 0.032 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.000 0.032 0.065
0.097 0.129 0.161 0.194 0.226 0.581 0.613 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
- (snd-display ";replace-with-selection (at 2): ~A" vals)))
+ (snd-display #__line__ ";replace-with-selection (at 2): ~A" vals)))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(env-sound '(0 0 1 1))
@@ -41203,7 +41275,7 @@ EDITS: 1
(if (not (vequal vals (vct 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.323 0.387 0.452
0.516 0.581 0.645 0.710 0.774 0.839 0.903 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
- (snd-display ";fit-selection-between-marks: ~A" vals))))
+ (snd-display #__line__ ";fit-selection-between-marks: ~A" vals))))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(let ((ramper (make-ramp 10)))
@@ -41211,10 +41283,10 @@ EDITS: 1
(let ((vals (channel->vct 0 20)))
(if (not (vequal vals (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000
1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (snd-display ";make-ramp: ~A" vals))))
+ (snd-display #__line__ ";make-ramp: ~A" vals))))
(revert-sound ind)
(vct->channel (with-sound (:output (make-vct 44100)) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2)))
- (if (and (ffneq (maxamp) .142) (ffneq (maxamp) .155)) (snd-display ";cross fade maxamp: ~A" (maxamp)))
+ (if (and (ffneq (maxamp) .142) (ffneq (maxamp) .155)) (snd-display #__line__ ";cross fade maxamp: ~A" (maxamp)))
(revert-sound)
(vct->channel (with-sound (:output (make-vct 44100)) (dissolve-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 512 2 2 #f)))
(let ((new-file-name (file-name ind)))
@@ -41224,7 +41296,7 @@ EDITS: 1
(let ((vals (apply vct (rms-envelope "oboe.snd" :rfreq 4))))
(if (not (vequal vals (vct 0.0 0.0430 0.25 0.0642 0.5 0.0695 0.75 0.0722 1.0 0.0738 1.25 0.0713
1.5 0.065 1.75 0.0439 2.0 0.01275 2.25 0.0)))
- (snd-display ";rms-envelope: ~A" vals)))
+ (snd-display #__line__ ";rms-envelope: ~A" vals)))
(let ((ind (open-sound "2a.snd")))
(add-hook! graph-hook display-correlation)
@@ -41234,19 +41306,19 @@ EDITS: 1
(let ((hi1 (find-sound "hi1.snd"))
(hi2 (find-sound "hi2.snd")))
(if (or (not hi1) (not hi2) (not (= (chans hi1) 1)) (not (= (chans hi2) 1)))
- (snd-display ";stereo->mono: ~A ~A" (map file-name (sounds)) (map chans (sounds)))
+ (snd-display #__line__ ";stereo->mono: ~A ~A" (map file-name (sounds)) (map chans (sounds)))
(let ((dist1 (channel-distance ind 0 hi1 0))
(dist2 (channel-distance ind 1 hi2 0)))
(if (or (fneq dist1 0.0) (fneq dist2 0.0))
- (snd-display ";stereo->mono distances: ~A ~A" dist1 dist2))
+ (snd-display #__line__ ";stereo->mono distances: ~A ~A" dist1 dist2))
(mono->stereo "ho2.snd" hi1 0 hi2 0)
(let ((ho2 (find-sound "ho2.snd")))
(if (or (not ho2) (not (= (chans ho2) 2)))
- (snd-display ";mono->stereo: ~A" (map file-name (sounds)))
+ (snd-display #__line__ ";mono->stereo: ~A" (map file-name (sounds)))
(let ((dist1 (channel-distance ho2 0 ind 0))
(dist2 (channel-distance ho2 1 ind 1)))
(if (or (fneq dist1 0.0) (fneq dist2 0.0))
- (snd-display ";stereo->mono->stereo distances: ~A ~A" dist1 dist2))))
+ (snd-display #__line__ ";stereo->mono->stereo distances: ~A ~A" dist1 dist2))))
(close-sound ho2))))
(close-sound hi1)
(close-sound hi2))
@@ -41263,14 +41335,14 @@ EDITS: 1
0.341 0.308 0.281 0.262 0.251 0.251 0.261 0.280)))
(not (vequal vals (vct 0.375 0.393 0.410 0.427 0.442 0.457 0.469 0.480 0.489 0.495 0.499 0.500
0.499 0.495 0.489 0.480 0.470 0.457 0.443 0.428))))
- (snd-display ";no vibro? ~A" vals)))
+ (snd-display #__line__ ";no vibro? ~A" vals)))
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let ((ind (open-sound "pistol.snd")))
(transposed-echo 1.1 .95 .25)
- (play-and-wait)
+ (play :wait #t)
(set! (channel-property 'colored-samples ind 0) (list (list (cursor-color) 0 100)))
(add-hook! after-graph-hook display-samples-in-color)
(update-time-graph)
@@ -41282,7 +41354,7 @@ EDITS: 1
(let ((val 0))
(tree-for-each (lambda (n) (set! val (+ val n))) (list (list 1 0) (list 2) 3))
- (if (not (= val 6)) (snd-display ";tree-for-each: ~A" val)))
+ (if (not (= val 6)) (snd-display #__line__ ";tree-for-each: ~A" val)))
(let ((ind (new-sound :channels 4 :size 32)))
(set! (sample 0 ind 0) 0.5)
@@ -41294,7 +41366,7 @@ EDITS: 1
(fneq (sample 10 ind 3) .25)
(fneq (sample 20 ind 1) .125)
(fneq (sample 30 ind 0) .0625))
- (snd-display ";scramble-channels: ~A ~A ~A ~A (~A ~A ~A ~A)"
+ (snd-display #__line__ ";scramble-channels: ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 2) (sample 10 ind 3) (sample 20 ind 1) (sample 30 ind 2)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
(do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
@@ -41303,7 +41375,7 @@ EDITS: 1
(fneq (sample 10 ind 2) .25)
(fneq (sample 20 ind 3) .125)
(fneq (sample 30 ind 0) .0625))
- (snd-display ";scramble-channels (1): ~A ~A ~A ~A (~A ~A ~A ~A)"
+ (snd-display #__line__ ";scramble-channels (1): ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 1) (sample 10 ind 2) (sample 20 ind 3) (sample 30 ind 0)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
(do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
@@ -41312,7 +41384,7 @@ EDITS: 1
(fneq (sample 10 ind 1) .25)
(fneq (sample 20 ind 3) .125)
(fneq (sample 30 ind 2) .0625))
- (snd-display ";scramble-channels (2): ~A ~A ~A ~A (~A ~A ~A ~A)"
+ (snd-display #__line__ ";scramble-channels (2): ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 3) (sample 30 ind 2)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
(do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
@@ -41321,7 +41393,7 @@ EDITS: 1
(fneq (sample 10 ind 0) .25)
(fneq (sample 20 ind 1) .125)
(fneq (sample 30 ind 2) .0625))
- (snd-display ";scramble-channels (3): ~A ~A ~A ~A (~A ~A ~A ~A)"
+ (snd-display #__line__ ";scramble-channels (3): ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 3) (sample 10 ind 0) (sample 20 ind 1) (sample 30 ind 2)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
(do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
@@ -41340,7 +41412,7 @@ EDITS: 1
(fneq (sample 6 ind 5) .5)
(fneq (sample 5 ind 6) .5)
(fneq (sample 0 ind 7) .5))
- (snd-display ";scramble-channels 8 ways: ~A"
+ (snd-display #__line__ ";scramble-channels 8 ways: ~A"
(list (sample 1 ind 0) (sample 2 ind 1) (sample 3 ind 2) (sample 4 ind 3)
(sample 7 ind 4) (sample 6 ind 5) (sample 5 ind 6) (sample 0 ind 7))))
(let ((new-file-name (file-name ind)))
@@ -41349,9 +41421,7 @@ EDITS: 1
;; ---- *.scm
- (if (or (not (list? (procedure-source (lambda () (+ 1 2)))))
- (eq? (car (procedure-source (lambda () (+ 1 2)))) '%internal-eval))
- (snd-display ";skipping edit-list->function tests since procedure-source is useless")
+ (if (defined? 'effects-squelch-channel)
(begin
(if (or (provided? 'xm) (provided? 'xg))
(let ((ctr 1))
@@ -41361,7 +41431,7 @@ EDITS: 1
(let ((func (edit-list->function)))
;(display (format #f "~A: ~A~%" ctr (procedure-source func)))
(if (not (string=? (object->string (procedure-source func)) descr))
- (snd-display ";edit-list->function 20[~D]:~%; [~A]~%; [~A]" ctr descr (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function 20[~D]:~%; [~A]~%; [~A]" ctr descr (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0))
(set! ctr (+ 1 ctr))
@@ -41425,7 +41495,7 @@ EDITS: 1
(lambda () (effects-echo #f 0.5 0.1 0 #f))
(lambda () (effects-flecho-1 0.5 0.1 #f 0 #f))
(lambda () (effects-zecho-1 0.75 0.75 6.0 10.0 #f 0 #f))
-;; (lambda () (effects-comb-filter 0.1 50 0 #f))
+ ;; (lambda () (effects-comb-filter 0.1 50 0 #f))
(lambda () (effects-moog 10000 0.5 0 #f))
(lambda () (effects-remove-dc))
(lambda () (effects-compand))
@@ -41496,7 +41566,7 @@ EDITS: 1
"(lambda (snd chn) (effects-echo #f 0.5 0.1 0 #f snd chn))"
"(lambda (snd chn) (effects-flecho-1 0.5 0.1 #f 0 #f snd chn))"
"(lambda (snd chn) (effects-zecho-1 0.75 0.75 6.0 10.0 #f 0 #f snd chn))"
-;; "(lambda (snd chn) (effects-comb-filter 0.1 50 0 #f snd chn))"
+ ;; "(lambda (snd chn) (effects-comb-filter 0.1 50 0 #f snd chn))"
"(lambda (snd chn) (effects-moog 10000 0.5 0 #f snd chn))"
"(lambda (snd chn) (effects-remove-dc snd chn))"
"(lambda (snd chn) (effects-compand snd chn))"
@@ -41522,93 +41592,93 @@ EDITS: 1
(original-maxamp (maxamp)))
(reset-controls)
(controls->channel (list 2.0))
- (if (fneq (amp-control ind) 1.0) (snd-display ";controls->channel amp: ~A" (amp-control ind)))
- (if (fneq (maxamp) (* 2 original-maxamp)) (snd-display ";controls->channel maxamp: ~A" (maxamp)))
+ (if (fneq (amp-control ind) 1.0) (snd-display #__line__ ";controls->channel amp: ~A" (amp-control ind)))
+ (if (fneq (maxamp) (* 2 original-maxamp)) (snd-display #__line__ ";controls->channel maxamp: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 1: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 1: ~A" (object->string (procedure-source func))))
(func ind 0)
(revert-sound ind))
(controls->channel (list #f 2.0))
(let ((pk (vct-peak (channel->vct 22000 22100))))
- (if (fneq pk 0.0479) (snd-display ";dp->end screwed up again!?!: ~A" pk)))
+ (if (fneq pk 0.0479) (snd-display #__line__ ";dp->end screwed up again!?!: ~A" pk)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel (quote (#f 2.0)) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 2: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 2: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (fneq (speed-control ind) 1.0) (snd-display ";controls->channel speed: ~A" (speed-control ind))))
+ (if (fneq (speed-control ind) 1.0) (snd-display #__line__ ";controls->channel speed: ~A" (speed-control ind))))
(controls->channel (list #f #f (list 0.5)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel (quote (#f #f (0.5))) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 3: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 3: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (fneq (contrast-control ind) 0.0) (snd-display ";controls->channel contrast: ~A" (contrast-control ind))))
+ (if (fneq (contrast-control ind) 0.0) (snd-display #__line__ ";controls->channel contrast: ~A" (contrast-control ind))))
(controls->channel (list #f #f (list 0.5 2.0)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel (quote (#f #f (0.5 2.0))) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 3a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 3a: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (fneq (contrast-control ind) 0.0) (snd-display ";controls->channel contrast 3a: ~A" (contrast-control ind))))
+ (if (fneq (contrast-control ind) 0.0) (snd-display #__line__ ";controls->channel contrast 3a: ~A" (contrast-control ind))))
(controls->channel (list #f #f #f (list 0.5)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel (quote (#f #f #f (0.5))) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 4: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 4: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (ffneq (expand-control ind) 1.0) (snd-display ";controls->channel expand: ~A" (expand-control ind))))
+ (if (ffneq (expand-control ind) 1.0) (snd-display #__line__ ";controls->channel expand: ~A" (expand-control ind))))
(controls->channel (list #f #f #f (list 0.5 .1 .2 .06 0.0)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (controls->channel (quote (#f #f #f (0.5 0.1 0.2 0.06 0.0))) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 4a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 4a: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (ffneq (expand-control ind) 1.0) (snd-display ";controls->channel expand 4a: ~A" (expand-control ind))))
+ (if (ffneq (expand-control ind) 1.0) (snd-display #__line__ ";controls->channel expand 4a: ~A" (expand-control ind))))
(controls->channel (list #f #f #f #f (list 0.1)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel (quote (#f #f #f #f (0.1))) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 5: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 5: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (fneq (reverb-control-scale ind) 0.0) (snd-display ";controls->channel reverb: ~A" (reverb-control-scale ind))))
+ (if (fneq (reverb-control-scale ind) 0.0) (snd-display #__line__ ";controls->channel reverb: ~A" (reverb-control-scale ind))))
(controls->channel (list #f #f #f #f (list 0.1 1.2 0.9 0.9 2.0)))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (controls->channel (quote (#f #f #f #f (0.1 1.2 0.9 0.9 2.0))) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 5a: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 5a: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (fneq (reverb-control-scale ind) 0.0) (snd-display ";controls->channel reverb 5a: ~A" (reverb-control-scale ind))))
+ (if (fneq (reverb-control-scale ind) 0.0) (snd-display #__line__ ";controls->channel reverb 5a: ~A" (reverb-control-scale ind))))
(let ((order (filter-control-order ind)))
(controls->channel (list #f #f #f #f #f (list 10 '(0 0 1 1))))
(let ((func (edit-list->function)))
(if (not (string=? (object->string (procedure-source func))
"(lambda (snd chn) (controls->channel (quote (#f #f #f #f #f (10 (0 0 1 1)))) 0 #f snd chn))"))
- (snd-display ";edit-list->function controls->channel 6: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function controls->channel 6: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
- (if (not (= (filter-control-order ind) order)) (snd-display ";controls->channel filter: ~A" (filter-control-order ind)))))
+ (if (not (= (filter-control-order ind) order)) (snd-display #__line__ ";controls->channel filter: ~A" (filter-control-order ind)))))
+
-
(if (not (provided? 'snd-nogui))
;; ---- mix stuff
(let ((id (make-v-mix ind 0)))
@@ -41616,19 +41686,19 @@ EDITS: 1
(if (mix? id)
(begin
(set! (mix-position id) 200)
- (if (not (= (mix-position id) 200)) (snd-display ";edit-list->function mix off to a bad start: ~A" (mix-position id)))
+ (if (not (= (mix-position id) 200)) (snd-display #__line__ ";edit-list->function mix off to a bad start: ~A" (mix-position id)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function mix 1: ~A" func))
+ (snd-display #__line__ ";edit-list->function mix 1: ~A" func))
(if (not (string=? (object->string (procedure-source func))
(format #f "(lambda (snd chn) (let ((-mix-~D #f)) (set! -mix-~D (mix-vct (vct 0.1 0.2 0.3) 100 snd chn)) (set! (mix-position -mix-~D) 200)))"
(mix->integer id) (mix->integer id) (mix->integer id))))
- (snd-display ";edit-list->function mix 1: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function mix 1: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(if (or (null? (mixes ind 0))
(not (member 200 (map (lambda (m) (and (mix? m) (mix-position m))) (mixes ind 0)))))
- (snd-display ";edit-list->function mix 1 repos: ~A ~A"
+ (snd-display #__line__ ";edit-list->function mix 1 repos: ~A ~A"
(mixes ind 0) (map (lambda (m) (and (mix? m) (mix-position m))) (mixes ind 0)))))))
(revert-sound ind)
@@ -41639,11 +41709,11 @@ EDITS: 1
(set! (mix-amp id) 0.5)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function mix 4: ~A" func))
+ (snd-display #__line__ ";edit-list->function mix 4: ~A" func))
(if (not (string=? (object->string (procedure-source func))
(format #f "(lambda (snd chn) (let ((-mix-~D #f)) (set! -mix-~D (mix-vct (vct 0.1 0.2 0.3) 100 snd chn)) (set! (mix-amp -mix-~D) 0.5)))"
(mix->integer id) (mix->integer id) (mix->integer id))))
- (snd-display ";edit-list->function mix 4: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function mix 4: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0))))
(revert-sound ind)
@@ -41655,15 +41725,15 @@ EDITS: 1
(set! (mix-speed id) 0.5)
(let ((func (edit-list->function)))
(if (not (procedure? func))
- (snd-display ";edit-list->function mix 5: ~A" func))
+ (snd-display #__line__ ";edit-list->function mix 5: ~A" func))
(if (not (string=? (object->string (procedure-source func))
(format #f "(lambda (snd chn) (let ((-mix-~D #f)) (set! -mix-~D (mix-vct (vct 0.1 0.2 0.3) 100 snd chn)) (set! (mix-speed -mix-~D) 0.5)))"
(mix->integer id) (mix->integer id) (mix->integer id))))
- (snd-display ";edit-list->function mix 5: ~A" (object->string (procedure-source func))))
+ (snd-display #__line__ ";edit-list->function mix 5: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0))))
(revert-sound ind)))
-
+
(close-sound ind))
(let ((ind (open-sound "2.snd")))
@@ -41671,25 +41741,25 @@ EDITS: 1
(save-sound-as "test.snd")
(close-sound ind)
(set! ind (open-sound "test.snd"))
- (if (not (= (chans ind) 2)) (snd-display ";src-sound/save-sound-as-> ~D chans" (chans ind)))
+ (if (not (= (chans ind) 2)) (snd-display #__line__ ";src-sound/save-sound-as-> ~D chans" (chans ind)))
(let ((tag (scan-channel (lambda (y) (not (= y 0.0))) 8000 #f)))
- (if tag (snd-display ";src-sound/save-sound-as not zeros: ~A ~A" tag (sample (cadr tag) ind 0))))
+ (if tag (snd-display #__line__ ";src-sound/save-sound-as not zeros: ~A ~A" tag (sample (cadr tag) ind 0))))
(close-sound ind))
(let ((ind (open-sound "oboe.snd")))
(let ((tag (catch #t (lambda () (save-sound-as "test.snd" :edit-position 1)) (lambda args args))))
(if (or (not tag)
(not (eq? (car tag) 'no-such-edit)))
- (snd-display ";save-sound-as bad edpos: ~A" tag)))
+ (snd-display #__line__ ";save-sound-as bad edpos: ~A" tag)))
(let ((tag (catch #t (lambda () (save-sound-as "test.snd" :channel 1 :edit-position 1)) (lambda args args))))
(if (or (not tag)
(not (eq? (car tag) 'no-such-channel)))
- (snd-display ";save-sound-as bad chan: ~A" tag)))
+ (snd-display #__line__ ";save-sound-as bad chan: ~A" tag)))
(save-sound-as "test.snd" :comment "this is a comment")
(close-sound ind)
(set! ind (open-sound "test.snd"))
(if (not (string=? (comment ind) "this is a comment"))
- (snd-display ";save-sound-as with comment: ~A" (comment ind)))
+ (snd-display #__line__ ";save-sound-as with comment: ~A" (comment ind)))
(close-sound ind))
(mus-sound-prune)
@@ -41698,7 +41768,7 @@ EDITS: 1
;;; ---------------- test 20: transforms ----------------
(define (snd_test_20)
-
+
(define (bes-j0-1 x) ;returns J0(x) for any real x
(if (< (abs x) 8.0) ;direct rational function fit
(let* ((y (* x x))
@@ -41736,13 +41806,13 @@ EDITS: 1
(for-each
(lambda (x)
(if (fneq (bes-j0 x) (bes-j0-1 x))
- (snd-display ";(bes-j0 ~A) -> ~A ~A" x (bes-j0 x) (bes-j0-1 x))))
+ (snd-display #__line__ ";(bes-j0 ~A) -> ~A ~A" x (bes-j0 x) (bes-j0-1 x))))
(list 0.0 0.5 1.0 2.0 20.0))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-j0 x) (bes-j0-1 x))
- (snd-display ";(bes-j0 ~A) -> ~A ~A" x (bes-j0 x) (bes-j0-1 x))))))
+ (snd-display #__line__ ";(bes-j0 ~A) -> ~A ~A" x (bes-j0 x) (bes-j0-1 x))))))
(define (bes-j1-1 x) ;returns J1(x) for any real x
@@ -41785,13 +41855,13 @@ EDITS: 1
(for-each
(lambda (x)
(if (fneq (bes-j1 x) (bes-j1-1 x))
- (snd-display ";(bes-j1 ~A) -> ~A ~A" x (bes-j1 x) (bes-j1-1 x))))
+ (snd-display #__line__ ";(bes-j1 ~A) -> ~A ~A" x (bes-j1 x) (bes-j1-1 x))))
(list 0.0 0.5 1.0 2.0 20.0))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-j1 x) (bes-j1-1 x))
- (snd-display ";(bes-j1 ~A) -> ~A ~A" x (bes-j1 x) (bes-j1-1 x))))))
+ (snd-display #__line__ ";(bes-j1 ~A) -> ~A ~A" x (bes-j1 x) (bes-j1-1 x))))))
(define (bes-jn-1 nn x) ;return Jn(x) for any integer n, real x
(let* ((n (abs nn))
@@ -41816,7 +41886,7 @@ EDITS: 1
(set! bjm bj)
(set! bj bjp))
(let ((tox (/ 2.0 (abs x))) ;else use downward recurrence from even value (m)
- (m (* 2 (inexact->exact (floor (/ (+ n (sqrt (* iacc n))) 2)))))
+ (m (* 2 (floor (/ (+ n (sqrt (* iacc n))) 2))))
(jsum 0) ;alternate 0 and 1 -- when 1, accumulate even terms in sum
(bjm 0.0)
(sum 0.0)
@@ -41851,7 +41921,7 @@ EDITS: 1
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-jn k x) (bes-jn-1 k x))
- (snd-display ";(bes-jn ~A ~A) -> ~A ~A" k x (bes-jn k x) (bes-jn-1 k x)))))))
+ (snd-display #__line__ ";(bes-jn ~A ~A) -> ~A ~A" k x (bes-jn k x) (bes-jn-1 k x)))))))
(define (bes-y0-1 x) ;Bessel function Y0(x)
@@ -41889,58 +41959,58 @@ EDITS: 1
(for-each
(lambda (x)
(if (fneq (bes-y0 x) (bes-y0-1 x))
- (snd-display ";(bes-y0 ~A) -> ~A ~A" x (bes-y0 x) (bes-y0-1 x))))
+ (snd-display #__line__ ";(bes-y0 ~A) -> ~A ~A" x (bes-y0 x) (bes-y0-1 x))))
(list 0.5 1.0 2.0 20.0))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-y0 x) (bes-y0-1 x))
- (snd-display ";(bes-y0 ~A) -> ~A ~A" x (bes-y0 x) (bes-y0-1 x))))))
+ (snd-display #__line__ ";(bes-y0 ~A) -> ~A ~A" x (bes-y0 x) (bes-y0-1 x))))))
(define (bes-y1-1 x) ;Bessel function Y1(x)
(if (= x 0.0)
-inf.0
- (if (< x 8.0)
- (let* ((y (* x x))
- (ans1 (* x (+ -0.4900604943e13
- (* y (+ 0.1275274390e13
- (* y (+ -0.5153438139e11
- (* y (+ 0.7349264551e9
- (* y (+ -0.4237922726e7
- (* y 0.8511937935e4))))))))))))
- (ans2 (+ 0.2499580570e14
- (* y (+ 0.4244419664e12
- (* y (+ 0.3733650367e10
- (* y (+ 0.2245904002e8
- (* y (+ 0.1020426050e6
- (* y (+ 0.3549632885e3 y)))))))))))))
- (+ (/ ans1 ans2) (* 0.636619772 (- (* (bes-j1 x) (log x)) (/ 1.0 x)))))
- (let* ((z (/ 8.0 x))
- (y (* z z))
- (xx (- x 2.356194491))
- (ans1 (+ 1.0
- (* y (+ 0.183105e-2
- (* y (+ -0.3516396496e-4
- (* y (+ 0.2457520174e-5
- (* y -0.240337019e-6)))))))))
- (ans2 (+ 0.04687499995
- (* y (+ -0.200269087e-3
- (* y (+ 0.8449199096e-5
- (* y (+ -0.88228987e-6
- (* y 0.105787412e-6))))))))))
- (* (sqrt (/ 0.636619772 x)) (+ (* (sin xx) ans1) (* z (cos xx) ans2)))))))
+ (if (< x 8.0)
+ (let* ((y (* x x))
+ (ans1 (* x (+ -0.4900604943e13
+ (* y (+ 0.1275274390e13
+ (* y (+ -0.5153438139e11
+ (* y (+ 0.7349264551e9
+ (* y (+ -0.4237922726e7
+ (* y 0.8511937935e4))))))))))))
+ (ans2 (+ 0.2499580570e14
+ (* y (+ 0.4244419664e12
+ (* y (+ 0.3733650367e10
+ (* y (+ 0.2245904002e8
+ (* y (+ 0.1020426050e6
+ (* y (+ 0.3549632885e3 y)))))))))))))
+ (+ (/ ans1 ans2) (* 0.636619772 (- (* (bes-j1 x) (log x)) (/ 1.0 x)))))
+ (let* ((z (/ 8.0 x))
+ (y (* z z))
+ (xx (- x 2.356194491))
+ (ans1 (+ 1.0
+ (* y (+ 0.183105e-2
+ (* y (+ -0.3516396496e-4
+ (* y (+ 0.2457520174e-5
+ (* y -0.240337019e-6)))))))))
+ (ans2 (+ 0.04687499995
+ (* y (+ -0.200269087e-3
+ (* y (+ 0.8449199096e-5
+ (* y (+ -0.88228987e-6
+ (* y 0.105787412e-6))))))))))
+ (* (sqrt (/ 0.636619772 x)) (+ (* (sin xx) ans1) (* z (cos xx) ans2)))))))
(define (test-y1)
(for-each
(lambda (x)
(if (fneq (bes-y1 x) (bes-y1-1 x))
- (snd-display ";(bes-y1 ~A) -> ~A ~A" x (bes-y1 x) (bes-y1-1 x))))
+ (snd-display #__line__ ";(bes-y1 ~A) -> ~A ~A" x (bes-y1 x) (bes-y1-1 x))))
(list 0.01 0.5 1.0 2.0 20.0))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-y1 x) (bes-y1-1 x))
- (snd-display ";(bes-y1 ~A) -> ~A ~A" x (bes-y1 x) (bes-y1-1 x))))))
+ (snd-display #__line__ ";(bes-y1 ~A) -> ~A ~A" x (bes-y1 x) (bes-y1-1 x))))))
(define (bes-yn-1 n x) ;return Yn(x) for any integer n, real x
(if (= n 0)
@@ -41964,7 +42034,7 @@ EDITS: 1
((= i 10))
(let ((x (random 100.0)))
(if (fneq (/ (bes-yn k x) (bes-yn-1 k x)) 1.0)
- (snd-display ";(bes-yn ~A ~A) -> ~A ~A" k x (bes-yn k x) (bes-yn-1 k x)))))))
+ (snd-display #__line__ ";(bes-yn ~A ~A) -> ~A ~A" k x (bes-yn k x) (bes-yn-1 k x)))))))
(define (bes-i0-1 x) ;I0(x)
@@ -41994,13 +42064,13 @@ EDITS: 1
(for-each
(lambda (x)
(if (fneq (bes-i0 x) (bes-i0-1 x))
- (snd-display ";(bes-i0 ~A) -> ~A ~A" x (bes-i0 x) (bes-i0-1 x))))
+ (snd-display #__line__ ";(bes-i0 ~A) -> ~A ~A" x (bes-i0 x) (bes-i0-1 x))))
(list 0.0 0.5 1.0 2.0 0.01))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((x (random 1.0)))
(if (fneq (bes-i0 x) (bes-i0-1 x))
- (snd-display ";(bes-i0 ~A) -> ~A ~A" x (bes-i0 x) (bes-i0-1 x))))))
+ (snd-display #__line__ ";(bes-i0 ~A) -> ~A ~A" x (bes-i0 x) (bes-i0-1 x))))))
(define (bes-i1 x) ;I1(x)
(if (< (abs x) 3.75)
@@ -42027,10 +42097,10 @@ EDITS: 1
(* (/ (exp ax) (sqrt ax)) ans2 sign))))
(define (test-i1)
- (if (fneq (bes-i1 1.0) 0.565159) (snd-display ";bes-i1 1.0: ~A" (bes-i1 1.0)))
- (if (fneq (bes-i1 2.0) 1.59063685) (snd-display ";bes-i1 2.0: ~A" (bes-i1 2.0)))
- (if (fneq (bes-i1 5.0) 24.33564) (snd-display ";bes-i1 5.0: ~A" (bes-i1 5.0)))
- (if (fneq (bes-i1 10.0) 2670.9883) (snd-display ";bes-i1 10.0: ~A" (bes-i1 10.0))))
+ (if (fneq (bes-i1 1.0) 0.565159) (snd-display #__line__ ";bes-i1 1.0: ~A" (bes-i1 1.0)))
+ (if (fneq (bes-i1 2.0) 1.59063685) (snd-display #__line__ ";bes-i1 2.0: ~A" (bes-i1 2.0)))
+ (if (fneq (bes-i1 5.0) 24.33564) (snd-display #__line__ ";bes-i1 5.0: ~A" (bes-i1 5.0)))
+ (if (fneq (bes-i1 10.0) 2670.9883) (snd-display #__line__ ";bes-i1 10.0: ~A" (bes-i1 10.0))))
(define (bes-in n x) ;return In(x) for any integer n, real x
(if (= n 0)
@@ -42046,7 +42116,7 @@ EDITS: 1
(tox (/ 2.0 (abs x)))
(bip 0.0)
(bi 1.0)
- (m (* 2 (+ n (inexact->exact (truncate (sqrt (* iacc n)))))))
+ (m (* 2 (+ n (truncate (sqrt (* iacc n))))))
(bim 0.0))
(do ((j m (- j 1)))
((= j 0))
@@ -42063,23 +42133,23 @@ EDITS: 1
(* ans (/ (bes-i0 x) bi)))))))
(define (test-in)
- (if (fneq (bes-in 1 1.0) 0.565159) (snd-display ";bes-in 1 1.0: ~A" (bes-in 1 1.0)))
- (if (fneq (bes-in 2 1.0) 0.13574767) (snd-display ";bes-in 2 1.0: ~A" (bes-in 2 1.0)))
- (if (fneq (bes-in 3 1.0) 0.02216842) (snd-display ";bes-in 3 1.0: ~A" (bes-in 3 1.0)))
- (if (fneq (bes-in 5 1.0) 2.71463e-4) (snd-display ";bes-in 5 1.0: ~A" (bes-in 5 1.0)))
- (if (fneq (bes-in 10 1.0) 2.752948e-10) (snd-display ";bes-in 10 1.0: ~A" (bes-in 10 1.0)))
-
- (if (fneq (bes-in 1 2.0) 1.5906368) (snd-display ";bes-in 1 2.0: ~A" (bes-in 1 2.0)))
- (if (fneq (bes-in 2 2.0) 0.6889484) (snd-display ";bes-in 2 2.0: ~A" (bes-in 2 2.0)))
- (if (fneq (bes-in 3 2.0) 0.21273995) (snd-display ";bes-in 3 2.0: ~A" (bes-in 3 2.0)))
- (if (fneq (bes-in 5 2.0) 0.009825679) (snd-display ";bes-in 5 2.0: ~A" (bes-in 5 2.0)))
- (if (fneq (bes-in 10 2.0) 3.016963e-7) (snd-display ";bes-in 10 2.0: ~A" (bes-in 10 2.0)))
-
- (if (fneq (bes-in 1 5.0) 24.33564) (snd-display ";bes-in 1 5.0: ~A" (bes-in 1 5.0)))
- (if (fneq (bes-in 2 5.0) 17.505615) (snd-display ";bes-in 2 5.0: ~A" (bes-in 2 5.0)))
- (if (fneq (bes-in 3 5.0) 10.331150) (snd-display ";bes-in 3 5.0: ~A" (bes-in 3 5.0)))
- (if (fneq (bes-in 5 5.0) 2.157974) (snd-display ";bes-in 5 5.0: ~A" (bes-in 5 5.0)))
- (if (fneq (bes-in 10 5.0) 0.004580044) (snd-display ";bes-in 10 5.0: ~A" (bes-in 10 5.0))))
+ (if (fneq (bes-in 1 1.0) 0.565159) (snd-display #__line__ ";bes-in 1 1.0: ~A" (bes-in 1 1.0)))
+ (if (fneq (bes-in 2 1.0) 0.13574767) (snd-display #__line__ ";bes-in 2 1.0: ~A" (bes-in 2 1.0)))
+ (if (fneq (bes-in 3 1.0) 0.02216842) (snd-display #__line__ ";bes-in 3 1.0: ~A" (bes-in 3 1.0)))
+ (if (fneq (bes-in 5 1.0) 2.71463e-4) (snd-display #__line__ ";bes-in 5 1.0: ~A" (bes-in 5 1.0)))
+ (if (fneq (bes-in 10 1.0) 2.752948e-10) (snd-display #__line__ ";bes-in 10 1.0: ~A" (bes-in 10 1.0)))
+
+ (if (fneq (bes-in 1 2.0) 1.5906368) (snd-display #__line__ ";bes-in 1 2.0: ~A" (bes-in 1 2.0)))
+ (if (fneq (bes-in 2 2.0) 0.6889484) (snd-display #__line__ ";bes-in 2 2.0: ~A" (bes-in 2 2.0)))
+ (if (fneq (bes-in 3 2.0) 0.21273995) (snd-display #__line__ ";bes-in 3 2.0: ~A" (bes-in 3 2.0)))
+ (if (fneq (bes-in 5 2.0) 0.009825679) (snd-display #__line__ ";bes-in 5 2.0: ~A" (bes-in 5 2.0)))
+ (if (fneq (bes-in 10 2.0) 3.016963e-7) (snd-display #__line__ ";bes-in 10 2.0: ~A" (bes-in 10 2.0)))
+
+ (if (fneq (bes-in 1 5.0) 24.33564) (snd-display #__line__ ";bes-in 1 5.0: ~A" (bes-in 1 5.0)))
+ (if (fneq (bes-in 2 5.0) 17.505615) (snd-display #__line__ ";bes-in 2 5.0: ~A" (bes-in 2 5.0)))
+ (if (fneq (bes-in 3 5.0) 10.331150) (snd-display #__line__ ";bes-in 3 5.0: ~A" (bes-in 3 5.0)))
+ (if (fneq (bes-in 5 5.0) 2.157974) (snd-display #__line__ ";bes-in 5 5.0: ~A" (bes-in 5 5.0)))
+ (if (fneq (bes-in 10 5.0) 0.004580044) (snd-display #__line__ ";bes-in 10 5.0: ~A" (bes-in 10 5.0))))
(define (bes-k0 x) ;K0(x)
(if (<= x 2.0)
@@ -42102,9 +42172,9 @@ EDITS: 1
(* y -0.53208e-3))))))))))))))))
(define (test-k0)
- (if (fneq (bes-k0 1.0) 0.4210244) (snd-display ";bes-k0 1.0: ~A" (bes-k0 1.0)))
- (if (fneq (bes-k0 2.0) 0.1138938) (snd-display ";bes-k0 2.0: ~A" (bes-k0 2.0)))
- (if (fneq (bes-k0 10.0) 1.7780e-5) (snd-display ";bes-k0 10.0: ~A" (bes-k0 10.0))))
+ (if (fneq (bes-k0 1.0) 0.4210244) (snd-display #__line__ ";bes-k0 1.0: ~A" (bes-k0 1.0)))
+ (if (fneq (bes-k0 2.0) 0.1138938) (snd-display #__line__ ";bes-k0 2.0: ~A" (bes-k0 2.0)))
+ (if (fneq (bes-k0 10.0) 1.7780e-5) (snd-display #__line__ ";bes-k0 10.0: ~A" (bes-k0 10.0))))
(define (bes-k1 x) ;K1(x)
(if (<= x 2.0)
@@ -42129,9 +42199,9 @@ EDITS: 1
(* y -0.68245e-3))))))))))))))))
(define (test-k1)
- (if (fneq (bes-k1 1.0) 0.60190723) (snd-display ";bes-k1 1.0: ~A" (bes-k1 1.0)))
- (if (fneq (bes-k1 2.0) 0.1398658) (snd-display ";bes-k1 2.0: ~A" (bes-k1 2.0)))
- (if (fneq (bes-k1 10.0) 1.86487e-5) (snd-display ";bes-k1 10.0: ~A" (bes-k1 10.0))))
+ (if (fneq (bes-k1 1.0) 0.60190723) (snd-display #__line__ ";bes-k1 1.0: ~A" (bes-k1 1.0)))
+ (if (fneq (bes-k1 2.0) 0.1398658) (snd-display #__line__ ";bes-k1 2.0: ~A" (bes-k1 2.0)))
+ (if (fneq (bes-k1 10.0) 1.86487e-5) (snd-display #__line__ ";bes-k1 10.0: ~A" (bes-k1 10.0))))
(define (bes-kn n x) ;return Kn(x) for any integer n, real x
@@ -42150,20 +42220,20 @@ EDITS: 1
(set! bk bkp)))))
(define (test-kn)
- (if (fneq (bes-kn 1 1.0) 0.6019072) (snd-display ";bes-kn 1 1.0: ~A" (bes-kn 1 1.0)))
- (if (fneq (bes-kn 2 1.0) 1.6248389) (snd-display ";bes-kn 2 1.0: ~A" (bes-kn 2 1.0)))
- (if (fneq (bes-kn 3 1.0) 7.1012629) (snd-display ";bes-kn 3 1.0: ~A" (bes-kn 3 1.0)))
- (if (fneq (bes-kn 5 1.0) 360.96059) (snd-display ";bes-kn 5 1.0: ~A" (bes-kn 5 1.0)))
-
- (if (fneq (bes-kn 1 2.0) 0.139865) (snd-display ";bes-kn 1 2.0: ~A" (bes-kn 1 2.0)))
- (if (fneq (bes-kn 2 2.0) 0.2537597) (snd-display ";bes-kn 2 2.0: ~A" (bes-kn 2 2.0)))
- (if (fneq (bes-kn 3 2.0) 0.6473854) (snd-display ";bes-kn 3 2.0: ~A" (bes-kn 3 2.0)))
- (if (fneq (bes-kn 5 2.0) 9.431049) (snd-display ";bes-kn 5 2.0: ~A" (bes-kn 5 2.0)))
-
- (if (fneq (bes-kn 1 5.0) 0.00404461) (snd-display ";bes-kn 1 5.0: ~A" (bes-kn 1 5.0)))
- (if (fneq (bes-kn 2 5.0) 0.0053089) (snd-display ";bes-kn 2 5.0: ~A" (bes-kn 2 5.0)))
- (if (fneq (bes-kn 3 5.0) 0.0082917) (snd-display ";bes-kn 3 5.0: ~A" (bes-kn 3 5.0)))
- (if (fneq (bes-kn 5 5.0) 0.0327062) (snd-display ";bes-kn 5 5.0: ~A" (bes-kn 5 5.0))))
+ (if (fneq (bes-kn 1 1.0) 0.6019072) (snd-display #__line__ ";bes-kn 1 1.0: ~A" (bes-kn 1 1.0)))
+ (if (fneq (bes-kn 2 1.0) 1.6248389) (snd-display #__line__ ";bes-kn 2 1.0: ~A" (bes-kn 2 1.0)))
+ (if (fneq (bes-kn 3 1.0) 7.1012629) (snd-display #__line__ ";bes-kn 3 1.0: ~A" (bes-kn 3 1.0)))
+ (if (fneq (bes-kn 5 1.0) 360.96059) (snd-display #__line__ ";bes-kn 5 1.0: ~A" (bes-kn 5 1.0)))
+
+ (if (fneq (bes-kn 1 2.0) 0.139865) (snd-display #__line__ ";bes-kn 1 2.0: ~A" (bes-kn 1 2.0)))
+ (if (fneq (bes-kn 2 2.0) 0.2537597) (snd-display #__line__ ";bes-kn 2 2.0: ~A" (bes-kn 2 2.0)))
+ (if (fneq (bes-kn 3 2.0) 0.6473854) (snd-display #__line__ ";bes-kn 3 2.0: ~A" (bes-kn 3 2.0)))
+ (if (fneq (bes-kn 5 2.0) 9.431049) (snd-display #__line__ ";bes-kn 5 2.0: ~A" (bes-kn 5 2.0)))
+
+ (if (fneq (bes-kn 1 5.0) 0.00404461) (snd-display #__line__ ";bes-kn 1 5.0: ~A" (bes-kn 1 5.0)))
+ (if (fneq (bes-kn 2 5.0) 0.0053089) (snd-display #__line__ ";bes-kn 2 5.0: ~A" (bes-kn 2 5.0)))
+ (if (fneq (bes-kn 3 5.0) 0.0082917) (snd-display #__line__ ";bes-kn 3 5.0: ~A" (bes-kn 3 5.0)))
+ (if (fneq (bes-kn 5 5.0) 0.0327062) (snd-display #__line__ ";bes-kn 5 5.0: ~A" (bes-kn 5 5.0))))
(define (gammln xx) ;Ln(gamma(xx)), xx>0
@@ -42185,17 +42255,17 @@ EDITS: 1
((= i 10))
(let ((x (random 100.0)))
(if (fneq (lgamma x) (gammln x))
- (snd-display ";(lgamma ~A) -> ~A ~A" x (lgamma x) (gammln x))))))
+ (snd-display #__line__ ";(lgamma ~A) -> ~A ~A" x (lgamma x) (gammln x))))))
(define (test-erf)
- (if (fneq (erf 0.0) 0.0) (snd-display ";erf 0.0: ~A" (erf 0.0)))
- (if (fneq (erf 0.5) 0.5204998) (snd-display ";erf 0.5: ~A" (erf 0.5)))
- (if (fneq (erf 1.0) 0.8427007) (snd-display ";erf 0.0: ~A" (erf 1.0)))
+ (if (fneq (erf 0.0) 0.0) (snd-display #__line__ ";erf 0.0: ~A" (erf 0.0)))
+ (if (fneq (erf 0.5) 0.5204998) (snd-display #__line__ ";erf 0.5: ~A" (erf 0.5)))
+ (if (fneq (erf 1.0) 0.8427007) (snd-display #__line__ ";erf 0.0: ~A" (erf 1.0)))
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((val (random 2.0)))
(if (fneq (+ (erf val) (erfc val)) 1.0)
- (snd-display ";erf+erfc: ~A (~A + ~A)"
+ (snd-display #__line__ ";erf+erfc: ~A (~A + ~A)"
(+ (erf val) (erfc val))
(erf val)
(erfc val))))))
@@ -42245,8 +42315,8 @@ EDITS: 1
(n1 (- n 1))
(ncof (vct-length cc))
(nmod (* ncof n))
- (nh (inexact->exact (floor (/ n 2))))
- (joff (inexact->exact (- (floor (/ ncof 2)))))
+ (nh (floor (/ n 2)))
+ (joff (- (floor (/ ncof 2))))
(ioff joff))
(if (>= isign 0)
(do ((ii 0 (+ 1 ii))
@@ -42320,8 +42390,8 @@ EDITS: 1
(let* ((len0 (frames snd0 chn0))
(len1 (frames snd1 chn1))
(ilen (max len0 len1))
- (pow2 (inexact->exact (ceiling (/ (log ilen) (log 2)))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (pow2 (ceiling (/ (log ilen) (log 2))))
+ (fftlen (expt 2 pow2))
(fftlen2 (/ fftlen 2))
(fftscale (/ 1.0 fftlen))
(rl1 (channel->vct 0 fftlen snd1 chn1))
@@ -42340,7 +42410,7 @@ EDITS: 1
(vct-add! tmprl tmpim) ; add the first two
(vct-subtract! im2 rl2) ; subtract the 4th from the 3rd
(vct-scale! (fft tmprl im2 -1) fftscale))))
-
+
(define (cross-correlate-3 rl1 rl2 fftlen)
(let* ((fftlen2 (/ fftlen 2))
(fftscale (/ 1.0 fftlen))
@@ -42361,8 +42431,8 @@ EDITS: 1
(define* (automorph a b c d snd chn)
(let* ((len (frames snd chn))
- (pow2 (inexact->exact (ceiling (/ (log len) (log 2)))))
- (fftlen (inexact->exact (expt 2 pow2)))
+ (pow2 (ceiling (/ (log len) (log 2))))
+ (fftlen (expt 2 pow2))
(fftscale (/ 1.0 fftlen))
(rl (channel->vct 0 fftlen snd chn))
(im (make-vct fftlen)))
@@ -42502,7 +42572,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 16))
(if (fneq (vct-ref d0 i) 1.0)
- (snd-display ";fourier (1.0) [~D]: ~A?" i (vct-ref d0 i))))
+ (snd-display #__line__ ";fourier (1.0) [~D]: ~A?" i (vct-ref d0 i))))
(set! d0 (make-vct 19))
(vct-set! d0 0 1.0)
@@ -42512,19 +42582,19 @@ EDITS: 1
((or (not happy) (= i 16)))
(if (fneq (vct-ref d0 i) 1.0)
(begin
- (snd-display ";fourier (1.0) [~D]: ~A?" i (vct-ref d0 i))
+ (snd-display #__line__ ";fourier (1.0) [~D]: ~A?" i (vct-ref d0 i))
(set! happy #f)))))
(snd-transform fourier-transform d0 0)
(if (and (fneq (vct-ref d0 0) 256.0)
(fneq (vct-ref d0 0) 361.0)) ; fftw funny length
- (snd-display ";fourier (256.0): ~A?" (vct-ref d0 0)))
+ (snd-display #__line__ ";fourier (256.0): ~A?" (vct-ref d0 0)))
(let ((happy #t))
(do ((i 1 (+ 1 i)))
((or (not happy) (= i 16)))
(if (fneq (vct-ref d0 i) 0.0)
(begin
- (snd-display ";fourier (0.0) [~D]: ~A?" i (vct-ref d0 i))
+ (snd-display #__line__ ";fourier (0.0) [~D]: ~A?" i (vct-ref d0 i))
(set! happy #f)))))
(let ((r0 (make-vct 8))
@@ -42548,7 +42618,7 @@ EDITS: 1
(vct-add! i0 i1)
(if (or (not (vequal r0 r2))
(not (vequal i0 i2)))
- (snd-display ";fft additions/scaling: ~A ~A: ~A ~A" r2 i2 r0 i0)))
+ (snd-display #__line__ ";fft additions/scaling: ~A ~A: ~A ~A" r2 i2 r0 i0)))
(set! d0 (make-vct 8))
(set! d1 (make-vct 8))
@@ -42556,22 +42626,22 @@ EDITS: 1
(mus-fft d0 d1 8 1)
(if (or (not (vequal d0 (vct 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000 0.000)))
(not (vequal d1 (vct 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
- (snd-display ";mus-fft 1: ~A ~A?" d0 d1))
+ (snd-display #__line__ ";mus-fft 1: ~A ~A?" d0 d1))
(mus-fft d0 d1 8 -1)
(if (or (not (vequal d0 (vct 0.000 0.000 8.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal d1 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display ";mus-fft -1: ~A ~A?" d0 d1))
+ (snd-display #__line__ ";mus-fft -1: ~A ~A?" d0 d1))
(vct-fill! d0 1.0)
(vct-fill! d1 0.0)
(mus-fft d0 d1 8)
(if (or (not (vequal d0 (vct 8.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(not (vequal d1 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display ";mus-fft 2: ~A ~A?" d0 d1))
+ (snd-display #__line__ ";mus-fft 2: ~A ~A?" d0 d1))
(mus-fft d0 d1 8 -1)
(if (or (not (vequal d0 (vct 8.000 8.000 8.000 8.000 8.000 8.000 8.000 8.000)))
(not (vequal d1 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display ";mus-fft -2: ~A ~A?" d0 d1))
+ (snd-display #__line__ ";mus-fft -2: ~A ~A?" d0 d1))
(vct-fill! d1 0.0)
(vct-map! d0 (lambda () (random 1.0)))
@@ -42580,7 +42650,7 @@ EDITS: 1
(mus-fft d0 d1 8 -1)
(vct-scale! d0 (/ 1.0 8.0))
(if (not (vequal d0 fn))
- (snd-display ";mus-fft 3: ~A ~A?" d0 fn))
+ (snd-display #__line__ ";mus-fft 3: ~A ~A?" d0 fn))
(let ((d0 (make-vct 8))
(d1 (make-vct 8)))
@@ -42603,17 +42673,17 @@ EDITS: 1
(do ((i 0 (+ 1 i))) ; one sample rotation here
((= i 7))
(if (fneq (vct-ref d0 (+ 1 i)) (vct-ref reversed-d0 i))
- (snd-display ";mus-fft d0 reversed: ~A ~A" d0 reversed-d0))
+ (snd-display #__line__ ";mus-fft d0 reversed: ~A ~A" d0 reversed-d0))
(if (fneq (vct-ref d1 (+ 1 i)) (vct-ref reversed-d1 i))
- (snd-display ";mus-fft d1 reversed: ~A ~A" d1 reversed-d1)))
+ (snd-display #__line__ ";mus-fft d1 reversed: ~A ~A" d1 reversed-d1)))
(mus-fft d0 d1 8)
(mus-fft d0 d1 8)
(vct-scale! d0 .125)
(vct-scale! d1 .125)
(if (not (vequal d0 save-d0))
- (snd-display ";mus-fft d0 saved: ~A ~A" d0 save-d0))
+ (snd-display #__line__ ";mus-fft d0 saved: ~A ~A" d0 save-d0))
(if (not (vequal d1 save-d1))
- (snd-display ";mus-fft d1 saved: ~A ~A" d1 save-d1))))
+ (snd-display #__line__ ";mus-fft d1 saved: ~A ~A" d1 save-d1))))
(for-each
(lambda (size)
@@ -42622,25 +42692,25 @@ EDITS: 1
(vct-set! d0 0 1.0)
(set! dcopy (vct-copy d0))
(set! d1 (snd-spectrum d0 rectangular-window size))
- (if (not (vequal d0 dcopy)) (snd-display ";snd-spectrum not in-place? ~A ~A" d0 dcopy)))
+ (if (not (vequal d0 dcopy)) (snd-display #__line__ ";snd-spectrum not in-place? ~A ~A" d0 dcopy)))
(let ((happy #t))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i (/ size 2))))
(if (fneq (vct-ref d1 i) 1.0)
(begin
- (snd-display ";snd-spectrum (1.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum (1.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
(set! happy #f)))))
(set! d0 (make-vct size 1.0))
(set! d1 (snd-spectrum d0 rectangular-window))
(if (fneq (vct-ref d1 0) 1.0)
- (snd-display ";snd-spectrum back (1.0 ~D): ~A?" size (vct-ref d1 0)))
+ (snd-display #__line__ ";snd-spectrum back (1.0 ~D): ~A?" size (vct-ref d1 0)))
(let ((happy #t))
(do ((i 1 (+ 1 i)))
((or (not happy) (= i (/ size 2))))
(if (fneq (vct-ref d1 i) 0.0)
(begin
- (snd-display ";snd-spectrum (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
(set! happy #f)))))
(set! d0 (make-vct size))
@@ -42651,19 +42721,19 @@ EDITS: 1
((or (not happy) (= i (/ size 2))))
(if (fneq (vct-ref d1 i) 0.0)
(begin
- (snd-display ";snd-spectrum dB (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum dB (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
(set! happy #f)))))
(set! d0 (make-vct size 1.0))
(set! d1 (snd-spectrum d0 rectangular-window size #f))
(if (fneq (vct-ref d1 0) 0.0)
- (snd-display ";snd-spectrum dB back (0.0 ~D): ~A?" size (vct-ref d1 0)))
+ (snd-display #__line__ ";snd-spectrum dB back (0.0 ~D): ~A?" size (vct-ref d1 0)))
(let ((happy #t))
(do ((i 1 (+ 1 i)))
((or (not happy) (= i (/ size 2))))
(if (fneq (vct-ref d1 i) -90.0) ; currently ignores min-dB (snd-sig.c 5023)
(begin
- (snd-display ";snd-spectrum dB (1.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum dB (1.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
(set! happy #f)))))
(let ((dcopy #f))
@@ -42671,14 +42741,14 @@ EDITS: 1
(vct-set! d0 0 1.0)
(set! dcopy (vct-copy d0))
(set! d1 (snd-spectrum d0 rectangular-window size #t 1.0 #t)) ; in-place
- (if (vequal d0 dcopy) (snd-display ";snd-spectrum in-place? ~A ~A" d0 dcopy))
- (if (not (vequal d0 d1)) (snd-display ";snd-spectrum returns in-place? ~A ~A" d0 d1)))
+ (if (vequal d0 dcopy) (snd-display #__line__ ";snd-spectrum in-place? ~A ~A" d0 dcopy))
+ (if (not (vequal d0 d1)) (snd-display #__line__ ";snd-spectrum returns in-place? ~A ~A" d0 d1)))
(let ((happy #t))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i (/ size 2))))
(if (fneq (vct-ref d1 i) 1.0)
(begin
- (snd-display ";snd-spectrum (1.0 #t) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum (1.0 #t) [~D: ~D]: ~A?" i size (vct-ref d1 i))
(set! happy #f)))))
(let ((dcopy #f))
@@ -42686,44 +42756,44 @@ EDITS: 1
(vct-set! d0 0 1.0)
(set! dcopy (vct-copy d0))
(set! d1 (snd-spectrum d0 rectangular-window size #f 1.0 #t)) ; in-place dB
- (if (vequal d0 dcopy) (snd-display ";snd-spectrum dB in-place? ~A ~A" d0 dcopy))
- (if (not (vequal d0 d1)) (snd-display ";snd-spectrum dB returns in-place? ~A ~A" d0 d1)))
+ (if (vequal d0 dcopy) (snd-display #__line__ ";snd-spectrum dB in-place? ~A ~A" d0 dcopy))
+ (if (not (vequal d0 d1)) (snd-display #__line__ ";snd-spectrum dB returns in-place? ~A ~A" d0 d1)))
(let ((happy #t))
(do ((i 0 (+ 1 i)))
((or (not happy) (= i (/ size 2))))
(if (fneq (vct-ref d1 i) 0.0)
(begin
- (snd-display ";snd-spectrum dB (1.0 #t) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum dB (1.0 #t) [~D: ~D]: ~A?" i size (vct-ref d1 i))
(set! happy #f)))))
(set! d0 (make-vct size 1.0))
(set! d1 (snd-spectrum d0 rectangular-window size #t 0.0 #f #f)) ; linear (in-place) not normalized
- (if (fneq (vct-ref d1 0) size) (snd-display ";snd-spectrum no norm 0: ~A" d1))
+ (if (fneq (vct-ref d1 0) size) (snd-display #__line__ ";snd-spectrum no norm 0: ~A" d1))
(let ((happy #t))
(do ((i 1 (+ 1 i)))
((or (not happy) (= i (/ size 2))))
(if (fneq (vct-ref d1 i) 0.0)
(begin
- (snd-display ";snd-spectrum no norm (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum no norm (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
(set! happy #f)))))
(set! d0 (make-vct size 1.0))
(set! d1 (snd-spectrum d0 blackman2-window size))
(if (and (not (vequal d1 (vct 1.000 0.721 0.293 0.091)))
(not (vequal d1 (vct 1.000 0.647 0.173 0.037 0.024 0.016 0.011 0.005))))
- (snd-display ";blackman2 snd-spectrum: ~A~%" d1))
+ (snd-display #__line__ ";blackman2 snd-spectrum: ~A~%" d1))
(set! d0 (make-vct size 1.0))
(set! d1 (snd-spectrum d0 gaussian-window size #t 0.5))
(if (and (not (vequal d1 (vct 1.000 0.900 0.646 0.328)))
(not (vequal d1 (vct 1.000 0.870 0.585 0.329 0.177 0.101 0.059 0.028))))
- (snd-display ";gaussian 0.5 snd-spectrum: ~A~%" d1))
+ (snd-display #__line__ ";gaussian 0.5 snd-spectrum: ~A~%" d1))
(set! d0 (make-vct size 1.0))
(set! d1 (snd-spectrum d0 gaussian-window size #t 0.85))
(if (and (not (vequal d1 (vct 1.000 0.924 0.707 0.383)))
(not (vequal d1 (vct 1.000 0.964 0.865 0.725 0.566 0.409 0.263 0.128))))
- (snd-display ";gaussian 0.85 snd-spectrum: ~A~%" d1))
+ (snd-display #__line__ ";gaussian 0.85 snd-spectrum: ~A~%" d1))
)
@@ -42743,11 +42813,11 @@ EDITS: 1
((or (not happy) (= i len2)))
(if (fneq (vct-ref rl i) (vct-ref xrl i))
(begin
- (snd-display ";flat fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";flat fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
(set! happy #f)))))
- (if (fneq (vct-ref rl 0) (* len len)) (snd-display ";snd-transform ~A at 0: ~A" len (vct-ref rl 0)))
+ (if (fneq (vct-ref rl 0) (* len len)) (snd-display #__line__ ";snd-transform ~A at 0: ~A" len (vct-ref rl 0)))
(vct-set! rl 0 0.0)
- (if (> (vct-peak rl) .001) (snd-display ";snd-transform ~A impulse: ~A" len (vct-peak rl)))))
+ (if (> (vct-peak rl) .001) (snd-display #__line__ ";snd-transform ~A impulse: ~A" len (vct-peak rl)))))
(list 16 128 512 1024))
(for-each
@@ -42764,9 +42834,9 @@ EDITS: 1
((or (not happy) (= i len2)))
(if (fneq (vct-ref rl i) (vct-ref xrl i))
(begin
- (snd-display ";impulse fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";impulse fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
(set! happy #f)))))
- (if (fneq (vct-ref rl 0) 1.0) (snd-display ";flat ~A at 0: ~A" len (vct-ref rl 0)))))
+ (if (fneq (vct-ref rl 0) 1.0) (snd-display #__line__ ";flat ~A at 0: ~A" len (vct-ref rl 0)))))
(list 16 128 512 1024))
(for-each
@@ -42788,7 +42858,7 @@ EDITS: 1
((or (not happy) (= i len2)))
(if (fneq (vct-ref rl i) (vct-ref xrl i))
(begin
- (snd-display ";random fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";random fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
(set! happy #f)))))))
(list 16 128 512 1024 4096))
@@ -42811,7 +42881,7 @@ EDITS: 1
((or (not happy) (= i len2)))
(if (fneq (vct-ref rl i) (vct-ref xrl i))
(begin
- (snd-display ";random fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";random fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
(set! happy #f)))))))
(list 16 128 512 1024 4096))
@@ -42821,21 +42891,21 @@ EDITS: 1
(vct-set! rl 0 1.0)
(autocorrelate rl)
(if (not (vequal rl (vct 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
- (snd-display ";autocorrelate 1: ~A" rl)))
+ (snd-display #__line__ ";autocorrelate 1: ~A" rl)))
(let ((rl (make-vct 16 0.0)))
(vct-set! rl 0 1.0)
(vct-set! rl 1 -1.0)
(autocorrelate rl)
(if (not (vequal rl (vct 2 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
- (snd-display ";autocorrelate 1 -1: ~A" rl)))
+ (snd-display #__line__ ";autocorrelate 1 -1: ~A" rl)))
(let ((rl (make-vct 16 0.0)))
(vct-set! rl 0 1.0)
(vct-set! rl 4 -1.0)
(autocorrelate rl)
(if (not (vequal rl (vct 2 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0)))
- (snd-display ";autocorrelate 1 0 0 0 -1: ~A" rl)))
+ (snd-display #__line__ ";autocorrelate 1 0 0 0 -1: ~A" rl)))
(let ((rl (make-vct 16))
(rl1 (make-vct 16)))
@@ -42846,7 +42916,7 @@ EDITS: 1
(let ((nr (vct-subseq (corr rl rl 16 16) 0 15)))
(autocorrelate rl1)
(if (not (vequal rl1 nr))
- (snd-display ";autocorrelate/corr (ramp):~%; ~A~%; ~A" rl1 nr))))
+ (snd-display #__line__ ";autocorrelate/corr (ramp):~%; ~A~%; ~A" rl1 nr))))
(let ((rl (make-vct 16))
(rl1 (make-vct 16)))
@@ -42857,7 +42927,7 @@ EDITS: 1
(let ((nr (vct-subseq (corr rl rl 16 16) 0 15)))
(autocorrelate rl1)
(if (not (vequal rl1 nr))
- (snd-display ";autocorrelate/corr:~%; ~A~%; ~A" rl1 nr))))
+ (snd-display #__line__ ";autocorrelate/corr:~%; ~A~%; ~A" rl1 nr))))
(let ((ind0 (new-sound "test.snd" :size 16))
(ind1 (new-sound "fmv.snd" :size 16)))
@@ -42866,16 +42936,16 @@ EDITS: 1
(let ((data0 (cross-correlate-1 ind0 0 ind1 0))
(data1 (cross-correlate-2 ind0 0 ind1 0)))
(if (not (vequal data0 data1))
- (snd-display ";cross-correlate: ~A ~A" data0 data1)))
+ (snd-display #__line__ ";cross-correlate: ~A ~A" data0 data1)))
(set! (sample 3 ind0 0) 0.0)
(set! (sample 8 ind0 0) 1.0)
(let ((data0 (cross-correlate-1 ind0 0 ind1 0))
(data1 (cross-correlate-2 ind0 0 ind1 0)))
(if (not (vequal data0 data1))
- (snd-display ";cross-correlate 1: ~A ~A" data0 data1)))
+ (snd-display #__line__ ";cross-correlate 1: ~A ~A" data0 data1)))
(close-sound ind0)
(close-sound ind1))
-
+
(let ((v1 (make-vct 16))
(v2 (make-vct 16))
(v3 (make-vct 16))
@@ -42887,7 +42957,7 @@ EDITS: 1
(set! v1 (cross-correlate-3 v1 v2 16))
(set! v3 (correlate v3 v4))
(if (not (vequal v1 v3))
- (snd-display ";correlate 16:~%; ~A~%; ~A" v1 v3)))
+ (snd-display #__line__ ";correlate 16:~%; ~A~%; ~A" v1 v3)))
(let ((v1 (make-vct 128))
(v2 (make-vct 128))
@@ -42900,7 +42970,7 @@ EDITS: 1
(set! v1 (cross-correlate-3 v1 v2 128))
(set! v3 (correlate v3 v4))
(if (not (vequal v1 v3))
- (snd-display ";correlate 128:~%; ~A~%; ~A" v1 v3)))
+ (snd-display #__line__ ";correlate 128:~%; ~A~%; ~A" v1 v3)))
(let ((v1 (make-vct 128))
(v2 (make-vct 128))
@@ -42915,7 +42985,7 @@ EDITS: 1
(set! v1 (cross-correlate-3 v1 v2 128))
(set! v3 (correlate v3 v4))
(if (not (vequal v1 v3))
- (snd-display ";correlate 128 at random:~%; ~A~%; ~A" v1 v3)))
+ (snd-display #__line__ ";correlate 128 at random:~%; ~A~%; ~A" v1 v3)))
(let ((v1 (make-vct 16))
(v2 (make-vct 16)))
@@ -42924,8 +42994,8 @@ EDITS: 1
(set! v1 (correlate v1 (vct-copy v1)))
(set! v2 (autocorrelate v2))
(if (not (vequal v1 v2))
- (snd-display ";auto/correlate 16:~%; ~A~%; ~A" v1 v2)))
-
+ (snd-display #__line__ ";auto/correlate 16:~%; ~A~%; ~A" v1 v2)))
+
(for-each
(lambda (len)
(let ((rl (make-vct len))
@@ -42936,14 +43006,14 @@ EDITS: 1
(vct-set! rl 0 1.0)
(vct-set! rl 4 1.0)
(snd-transform autocorrelation rl 0) ; this is exactly the same as (autocorrelate rl)
- (if (fneq (vct-ref rl 0) 2.0) (snd-display ";autocorrelation ~A 0: ~A" len (vct-ref rl 0)))
- (if (fneq (vct-ref rl 4) 1.0) (snd-display ";autocorrelation ~A 4: ~A" len (vct-ref rl 4)))
+ (if (fneq (vct-ref rl 0) 2.0) (snd-display #__line__ ";autocorrelation ~A 0: ~A" len (vct-ref rl 0)))
+ (if (fneq (vct-ref rl 4) 1.0) (snd-display #__line__ ";autocorrelation ~A 4: ~A" len (vct-ref rl 4)))
(vct-set! rla 0 1.0)
(vct-set! rla 4 1.0)
(autocorrelate rla)
- (if (fneq (vct-ref rla 0) 2.0) (snd-display ";autocorrelate ~A 0: ~A" len (vct-ref rla 0)))
- (if (fneq (vct-ref rla 4) 1.0) (snd-display ";autocorrelate ~A 4: ~A" len (vct-ref rla 4)))
+ (if (fneq (vct-ref rla 0) 2.0) (snd-display #__line__ ";autocorrelate ~A 0: ~A" len (vct-ref rla 0)))
+ (if (fneq (vct-ref rla 4) 1.0) (snd-display #__line__ ";autocorrelate ~A 4: ~A" len (vct-ref rla 4)))
(vct-set! xrl 0 1.0)
(vct-set! xrl 4 1.0)
@@ -42960,14 +43030,14 @@ EDITS: 1
((or (not happy) (= i len2)))
(if (fneq (vct-ref rl i) (vct-ref xrl i))
(begin
- (snd-display ";mus-fft? ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";mus-fft? ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
(set! happy #f)))))
(vct-set! rl 0 0.0)
(vct-set! rl 4 0.0)
(do ((i (/ len 2) (+ 1 i)))
((= i len))
(vct-set! rl i 0.0))
- (if (> (vct-peak rl) .001) (snd-display ";autocorrelate peak: ~A" (vct-peak rl)))))
+ (if (> (vct-peak rl) .001) (snd-display #__line__ ";autocorrelate peak: ~A" (vct-peak rl)))))
(list 16 64 256 512))
(for-each
@@ -43000,7 +43070,7 @@ EDITS: 1
((or (not happy) (= i len2)))
(if (fneq (vct-ref rl i) (vct-ref xrl i))
(begin
- (snd-display ";random ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";random ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
(set! happy #f)))))))
(list 16 64 256 512))
@@ -43015,13 +43085,13 @@ EDITS: 1
(if (not (vequal nrl (vct 1.3994950 0.1416877 0.0952407 0.0052814 -0.0613192 0.0082986 -0.0233993
-0.0476585 0.0259498 -0.0476585 -0.0233993 0.0082986 -0.0613192 0.0052814
0.0952407 0.1416877)))
- (snd-display ";cepstrum 16: ~A" nrl))))
+ (snd-display #__line__ ";cepstrum 16: ~A" nrl))))
(let ((rl (make-vct 16)))
(do ((i 0 (+ 1 i))) ((= i 16)) (vct-set! rl i i))
(let ((nrl (vct-scale! (snd-transform cepstrum rl 0) 2.72)))
(if (not (vequal nrl (vct 2.720 0.452 0.203 0.122 0.082 0.061 0.048 0.041 0.039 0.041 0.048 0.061 0.082 0.122 0.203 0.452)))
- (snd-display ";cepstrum 16 by ones: ~A" nrl))))
+ (snd-display #__line__ ";cepstrum 16 by ones: ~A" nrl))))
(for-each
(lambda (len)
@@ -43053,7 +43123,7 @@ EDITS: 1
((or (not happy) (= i len)))
(if (fneq (vct-ref rl i) (vct-ref xrl i))
(begin
- (snd-display ";mus-fft?? ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";mus-fft?? ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
(set! happy #f)))))))
(list 16 64 256 512))
@@ -43064,29 +43134,29 @@ EDITS: 1
(vct-set! d0 0 1.0)
(snd-transform walsh-transform d0)
(if (not (vequal d0 (vct 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (snd-display ";walsh 1: ~A" d0))
+ (snd-display #__line__ ";walsh 1: ~A" d0))
(snd-transform walsh-transform d0)
(if (not (vequal d0 (vct 8.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";walsh -1: ~A" d0))
+ (snd-display #__line__ ";walsh -1: ~A" d0))
(set! d0 (make-vct 8))
(vct-set! d0 1 1.0)
(snd-transform walsh-transform d0)
(if (not (vequal d0 (vct 1.000 -1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
- (snd-display ";walsh 2: ~A" d0))
+ (snd-display #__line__ ";walsh 2: ~A" d0))
(snd-transform walsh-transform d0)
(if (not (vequal d0 (vct 0.000 8.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";walsh -2: ~A" d0))
+ (snd-display #__line__ ";walsh -2: ~A" d0))
(set! d0 (make-vct 8))
(vct-set! d0 1 1.0)
(vct-set! d0 0 0.5)
(snd-transform walsh-transform d0)
(if (not (vequal d0 (vct 1.500 -0.500 1.500 -0.500 1.500 -0.500 1.500 -0.500)))
- (snd-display ";walsh 3: ~A" d0))
+ (snd-display #__line__ ";walsh 3: ~A" d0))
(snd-transform walsh-transform d0)
(if (not (vequal d0 (vct 4.000 8.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";walsh -3: ~A" d0))
+ (snd-display #__line__ ";walsh -3: ~A" d0))
(set! d0 (make-vct 8))
(vct-map! d0 (lambda () (random 1.0)))
@@ -43095,22 +43165,22 @@ EDITS: 1
(snd-transform walsh-transform d0)
(vct-scale! d0 (/ 1.0 8.0))
(if (not (vequal d0 d1))
- (snd-display ";walsh 4: ~A ~A" d0 d1))
+ (snd-display #__line__ ";walsh 4: ~A ~A" d0 d1))
(set! d0 (vct 1 1 1 -1 1 1 1 -1 1 1 1 -1 -1 -1 -1 1))
(set! d1 (snd-transform walsh-transform d0))
(if (not (vequal d1 (vct 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 -4.00 -4.00 -4.00 4.00)))
- (snd-display ";walsh 5: ~A" d1))
+ (snd-display #__line__ ";walsh 5: ~A" d1))
(set! d0 (vct 1 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0))
(set! d1 (snd-transform walsh-transform d0))
(if (not (vequal d1 (vct 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000)))
- (snd-display ";walsh 6: ~A" d1))
+ (snd-display #__line__ ";walsh 6: ~A" d1))
(set! d0 (vct 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612 0.006 -0.613 0.334 -0.111 -0.821 0.130 0.030 -0.229 0.170))
(set! d1 (snd-transform walsh-transform d0))
(if (not (vequal d1 (vct -3.122 -0.434 2.940 -0.468 -3.580 2.716 -0.178 -1.386 -0.902 0.638 1.196 1.848 -0.956 2.592 -1.046 2.926)))
- (snd-display ";walsh 7: ~A" d1))
+ (snd-display #__line__ ";walsh 7: ~A" d1))
;; -------- haar
@@ -43119,33 +43189,33 @@ EDITS: 1
(vct-set! d0 2 1.0)
(snd-transform haar-transform d0)
(if (not (vequal d0 (vct 0.354 0.354 -0.500 0.000 0.000 0.707 0.000 0.000)))
- (snd-display ";haar 1: ~A" d0))
+ (snd-display #__line__ ";haar 1: ~A" d0))
(inverse-haar d0)
(if (not (vequal d0 (vct 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";inverse haar 1: ~A" d0))
+ (snd-display #__line__ ";inverse haar 1: ~A" d0))
(set! d0 (make-vct 8))
(vct-set! d0 0 1.0)
(snd-transform haar-transform d0)
(if (not (vequal d0 (vct 0.354 0.354 0.500 0.000 0.707 0.000 0.000 0.000)))
- (snd-display ";haar 2: ~A" d0))
+ (snd-display #__line__ ";haar 2: ~A" d0))
(inverse-haar d0)
(if (not (vequal d0 (vct 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";inverse haar 2: ~A" d0))
+ (snd-display #__line__ ";inverse haar 2: ~A" d0))
(set! d0 (snd-transform haar-transform (vct -0.483 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612)))
(if (not (vequal d0 (vct -0.884 -0.349 0.563 -0.462 -0.465 -0.230 -0.648 0.925)))
- (snd-display ";haar 3: ~A" d0))
+ (snd-display #__line__ ";haar 3: ~A" d0))
;; from "A Primer on Wavelets"
(let ((sq2 (sqrt 2.0)))
(set! d0 (snd-transform haar-transform (vct 4 6 10 12 8 6 5 5)))
(if (not (vequal d0 (vct (* 14 sq2) (* 2 sq2) -6 2 (- sq2) (- sq2) sq2 0)))
- (snd-display ";haar 4: ~A" d0))
+ (snd-display #__line__ ";haar 4: ~A" d0))
(set! d0 (snd-transform haar-transform (vct 2 4 6 8 10 12 14 16)))
(if (not (vequal d0 (vct (* 18 sq2) (* -8 sq2) -4 -4 (- sq2) (- sq2) (- sq2) (- sq2))))
- (snd-display ";haar 5: ~A" d0)))
+ (snd-display #__line__ ";haar 5: ~A" d0)))
(set! d0 (make-vct 8))
(set! d1 (make-vct 8))
@@ -43156,7 +43226,7 @@ EDITS: 1
(snd-transform haar-transform d0)
(inverse-haar d0)
(if (not (vequal d0 d1))
- (snd-display ";inverse haar 6: ~A ~A" d0 d1))
+ (snd-display #__line__ ";inverse haar 6: ~A ~A" d0 d1))
;; --------- wavelet
@@ -43164,7 +43234,7 @@ EDITS: 1
;; test against fxt output
(set! d0 (snd-transform wavelet-transform (vct 1 1 0 0 0 0 0 0) 0)) ;"daub4"
(if (not (vequal d0 (vct 0.625 0.375 -0.217 1.083 -0.354 0.000 0.000 0.354)))
- (snd-display ";fxt wavelet 1: ~A" d0))
+ (snd-display #__line__ ";fxt wavelet 1: ~A" d0))
(for-each
(lambda (size)
@@ -43177,7 +43247,7 @@ EDITS: 1
(wavelet d1 size 0 pwt (list-ref wts i))
(snd-transform wavelet-transform d2 i)
(if (not (vequal d1 d2))
- (snd-display ";wavelet ~D: ~A ~A" i d1 d2))
+ (snd-display #__line__ ";wavelet ~D: ~A ~A" i d1 d2))
(wavelet d2 size -1 pwt (list-ref wts i))
(vct-fill! d1 0.0)
(vct-set! d1 2 1.0)
@@ -43186,13 +43256,13 @@ EDITS: 1
(begin
(vct-set! d2 2 0.0)
(if (> (vct-peak d2) .1)
- (snd-display ";inverse wavelet ~D: ~A ~A" i d1 d2)))
+ (snd-display #__line__ ";inverse wavelet ~D: ~A ~A" i d1 d2)))
(if (> i 14)
(let ((pk (vct-ref d2 2)))
(vct-set! d2 2 0.0)
(if (> (vct-peak d2) pk)
- (snd-display ";inverse wavelet ~D: ~A ~A" i d1 d2)))
- (snd-display ";inverse wavelet ~D: ~A ~A" i d1 d2))))))
+ (snd-display #__line__ ";inverse wavelet ~D: ~A ~A" i d1 d2)))
+ (snd-display #__line__ ";inverse wavelet ~D: ~A ~A" i d1 d2))))))
(do ((i 0 (+ 1 i)))
((= i 9))
(let ((d1 #f)
@@ -43202,7 +43272,7 @@ EDITS: 1
(snd-transform wavelet-transform d2 i)
(wavelet d2 size -1 pwt (list-ref wts i))
(if (not (vequal d1 d2))
- (snd-display ";random wavelet ~D: ~A ~A" i d1 d2)))))
+ (snd-display #__line__ ";random wavelet ~D: ~A ~A" i d1 d2)))))
(list 16 64))
(set! (max-transform-peaks) 100)
@@ -43217,16 +43287,13 @@ EDITS: 1
(make-vct len)
(lambda ()
(fir-filter flt (read-sample fd)))))))))
- (if (not (transform? ftype)) (snd-display ";transform added: ~A?" ftype))
+ (if (not (transform? ftype)) (snd-display #__line__ ";transform added: ~A?" ftype))
(set! (transform-normalization) dont-normalize)
(set! (transform-type ind 0) ftype)
(set! (transform-size ind 0) 16)
(set! (transform-graph-type ind 0) graph-once)
(set! (transform-graph? ind 0) #t)
(set! (cursor ind 0) 12000)
- (let* ((samps (transform->vct ind 0)))
- (if (fneq (vct-ref samps 2) .002)
- (snd-display ";add-transform filtering (~A): ~A" ftype samps)))
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
(save-state "s61.scm")
(delete-file "s61.scm") ; added transform needs to be saved somehow?
@@ -43252,164 +43319,164 @@ EDITS: 1
((or (not happy) (= i 256)))
(if (fneq (vct-ref samps i) (vct-ref orig i))
(begin
- (snd-display ";add-transform same (~A): ~D ~A ~A" ftype i (vct-ref samps i) (vct-ref orig i))
+ (snd-display #__line__ ";add-transform same (~A): ~D ~A ~A" ftype i (vct-ref samps i) (vct-ref orig i))
(set! happy #f)))))
(set! (dot-size ind 0) 60)
(set! (graph-style ind 0) graph-lollipops)
(set! (x-bounds) (list 2.579 2.580))
(update-time-graph)
(delete-transform ftype)
- (if (transform? ftype) (snd-display ";transform deleted: ~A" ftype))
- (if (transform? -1) (snd-display ";transform? -1"))
- (if (transform? (integer->transform 123)) (snd-display ";transform? 123"))
+ (if (transform? ftype) (snd-display #__line__ ";transform deleted: ~A" ftype))
+ (if (transform? -1) (snd-display #__line__ ";transform? -1"))
+ (if (transform? (integer->transform 123)) (snd-display #__line__ ";transform? 123"))
(if (not (equal? (transform-type ind 0) fourier-transform))
- (snd-display ";after delete-transform ~A -> ~A" ftype (transform-type ind 0)))
+ (snd-display #__line__ ";after delete-transform ~A -> ~A" ftype (transform-type ind 0)))
(close-sound ind))
-
- (if (defined? 'bignum-fft)
- (let ()
-
- (define* (vectors-equal? v1 v2 (error 1e-30))
- (let ((len (vector-length v1)))
- (if (= (vector-length v2) len)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (= i len) (not happy)) happy)
- (set! happy (< (magnitude (- (vector-ref v1 i) (vector-ref v2 i))) error))))
- #f)))
-
- (define* (bignum-vector :rest args)
- (let* ((len (length args))
- (v (make-vector len)))
- (do ((i 0 (+ i 1))
- (arg args (cdr arg)))
- ((= i len) v)
- (if (bignum? (car arg))
- (vector-set! v i (car arg))
- (vector-set! v i (bignum (number->string (car arg))))))))
-
- ;; -------- -1 -1 at 1
- (let ((rl (make-vector 8))
- (im (make-vector 8)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (vector-set! rl i (bignum "0.0"))
- (vector-set! im i (bignum "0.0")))
+
+ (if (defined? 'bignum-fft)
+ (let ()
+
+ (define* (vectors-equal? v1 v2 (error 1e-30))
+ (let ((len (vector-length v1)))
+ (if (= (vector-length v2) len)
+ (let ((happy #t))
+ (do ((i 0 (+ i 1)))
+ ((or (= i len) (not happy)) happy)
+ (set! happy (< (magnitude (- (vector-ref v1 i) (vector-ref v2 i))) error))))
+ #f)))
+
+ (define* (bignum-vector :rest args)
+ (let* ((len (length args))
+ (v (make-vector len)))
+ (do ((i 0 (+ i 1))
+ (arg args (cdr arg)))
+ ((= i len) v)
+ (if (bignum? (car arg))
+ (vector-set! v i (car arg))
+ (vector-set! v i (bignum (number->string (car arg))))))))
+
+ ;; -------- -1 -1 at 1
+ (let ((rl (make-vector 8))
+ (im (make-vector 8)))
+ (do ((i 0 (+ i 1)))
+ ((= i 8))
+ (vector-set! rl i (bignum "0.0"))
+ (vector-set! im i (bignum "0.0")))
+ (vector-set! rl 1 (bignum "-1.0"))
+ (vector-set! im 1 (bignum "-1.0"))
+ (bignum-fft rl im 8) ; 3rd arg is size
+ (let ((crl (bignum-vector -1.000 0.000 1.000 (sqrt (bignum "2")) 1.000 0.000 -1.000 (- (sqrt (bignum "2")))))
+ (cim (bignum-vector -1.000 (- (sqrt (bignum "2"))) -1.000 0.000 1.000 (sqrt (bignum "2")) 1.000 0.000)))
+ (if (or (not (vectors-equal? rl crl))
+ (not (vectors-equal? im cim)))
+ (format #t "big-fft -1 -1 at 1:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
+ (bignum-fft rl im 8 -1)
+ (let ((crl (bignum-vector 0.0 -8.0 0.0 0.0 0.0 0.0 0.0 0.0))
+ (cim (bignum-vector 0.0 -8.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (if (or (not (vectors-equal? rl crl))
+ (not (vectors-equal? im cim)))
+ (format #t "big-fft -1 -1 at 1 inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
(vector-set! rl 1 (bignum "-1.0"))
(vector-set! im 1 (bignum "-1.0"))
- (bignum-fft rl im 8) ; 3rd arg is size
- (let ((crl (bignum-vector -1.000 0.000 1.000 (sqrt (bignum "2")) 1.000 0.000 -1.000 (- (sqrt (bignum "2")))))
- (cim (bignum-vector -1.000 (- (sqrt (bignum "2"))) -1.000 0.000 1.000 (sqrt (bignum "2")) 1.000 0.000)))
- (if (or (not (vectors-equal? rl crl))
- (not (vectors-equal? im cim)))
- (format #t "big-fft -1 -1 at 1:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
- (bignum-fft rl im 8 -1)
- (let ((crl (bignum-vector 0.0 -8.0 0.0 0.0 0.0 0.0 0.0 0.0))
- (cim (bignum-vector 0.0 -8.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (if (or (not (vectors-equal? rl crl))
- (not (vectors-equal? im cim)))
- (format #t "big-fft -1 -1 at 1 inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
- (vector-set! rl 1 (bignum "-1.0"))
- (vector-set! im 1 (bignum "-1.0"))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (bignum-fft rl im 8))
- (vector-set! crl 1 (bignum "-64.0"))
- (vector-set! cim 1 (bignum "-64.0"))
- (if (or (not (vectors-equal? rl crl))
- (not (vectors-equal? im cim)))
- (format #t "big-fft -1 -1 at 1 rotate:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
-
- ;; -------- -1 1 at 3
- (let ((rl (make-vector 8))
- (im (make-vector 8)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (vector-set! rl i (bignum "0.0"))
- (vector-set! im i (bignum "0.0")))
- (vector-set! rl 3 (bignum "-1.0"))
- (vector-set! im 3 (bignum "1.0"))
- (bignum-fft rl im 8)
- (let ((crl (bignum-vector -1.000 0.000 1.000 (- (sqrt (bignum "2"))) 1.000 0.000 -1.000 (sqrt (bignum "2"))))
- (cim (bignum-vector 1.000 (- (sqrt (bignum "2"))) 1.000 0.000 -1.000 (sqrt (bignum "2")) -1.000 0.000)))
- (if (or (not (vectors-equal? rl crl))
- (not (vectors-equal? im cim)))
- (format #t "big-fft -1 1 at 3:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
-
- ;; -------- 1 0 at 0 with bignum arg to make-vector (so it should copy)
- (let ((rl (make-vector 8 (bignum "0.0")))
- (im (make-vector 8 (bignum "0.0"))))
- (vector-set! rl 0 (bignum "1.0"))
- (bignum-fft rl im 8)
- (let ((crl (bignum-vector 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0))
- (cim (bignum-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (if (or (not (vectors-equal? rl crl))
- (not (vectors-equal? im cim)))
- (format #t "big-fft 1 0 at 0 (and copied fill):~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
-
- ;; -------- cos/sin
- (let ((rl (make-vector 64))
- (im (make-vector 64)))
- (do ((i 0 (+ i 1)))
- ((= i 64))
- (vector-set! rl i (bignum "0.0"))
- (vector-set! im i (bignum "0.0")))
- (vector-set! rl 1 (bignum "1.0"))
- (bignum-fft rl im 64 -1)
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (= i 64) (not happy)))
- (let ((cerr (magnitude (- (vector-ref rl i) (cos (/ (* 2 pi i) 64)))))
- (serr (magnitude (- (vector-ref im i) (sin (/ (* -2 pi i) 64))))))
- (set! happy (and (< cerr 1e-30)
- (< serr 1e-30)))
- (if (not happy)
- (format #t "big fft 1 at 0 (sin/cos) differs by ~A in ~A at ~A (~A ~A)~%"
- (max cerr serr)
- (if (> cerr serr) "cos" "sin")
- i
- (if (> cerr serr)
- (cos (/ (* 2 pi i) 64))
- (sin (/ (* -2 pi i) 64)))
- (if (> cerr serr)
- (vector-ref rl i)
- (vector-ref im i)))))))
- (bignum-fft rl im 64)
- (let ((crl (make-vector 64 (bignum "0.0")))
- (cim (make-vector 64 (bignum "0.0"))))
- (vector-set! crl 1 (bignum "64"))
- (if (or (not (vectors-equal? rl crl))
- (not (vectors-equal? im cim)))
- (format #t "big-fft 1 at 0 fill cos/sin inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
-
- ;; -------- random
- (let ((rl (make-vector 64))
- (im (make-vector 64))
- (crl (make-vector 64))
- (cim (make-vector 64))
- (rs (make-random-state (bignum "12345678"))))
- (do ((i 0 (+ i 1)))
- ((= i 64))
- (vector-set! rl i (random (bignum "1.0") rs))
- (vector-set! crl i (+ (vector-ref rl i) 0.0)) ; try to force a copy
- (vector-set! im i (random (bignum "1.0") rs))
- (vector-set! cim i (+ (vector-ref im i) 0.0)))
- (bignum-fft rl im 64 1)
- (if (or (vectors-equal? rl crl)
- (vectors-equal? im cim))
- (format #t "big-fft random not copied?:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
- (bignum-fft rl im 64 -1)
(do ((i 0 (+ i 1)))
- ((= i 64))
- (vector-set! rl i (/ (vector-ref rl i) 64.0))
- (vector-set! im i (/ (vector-ref im i) 64.0)))
+ ((= i 4))
+ (bignum-fft rl im 8))
+ (vector-set! crl 1 (bignum "-64.0"))
+ (vector-set! cim 1 (bignum "-64.0"))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft random:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
- ))
-
-
+ (format #t "big-fft -1 -1 at 1 rotate:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+
+ ;; -------- -1 1 at 3
+ (let ((rl (make-vector 8))
+ (im (make-vector 8)))
+ (do ((i 0 (+ i 1)))
+ ((= i 8))
+ (vector-set! rl i (bignum "0.0"))
+ (vector-set! im i (bignum "0.0")))
+ (vector-set! rl 3 (bignum "-1.0"))
+ (vector-set! im 3 (bignum "1.0"))
+ (bignum-fft rl im 8)
+ (let ((crl (bignum-vector -1.000 0.000 1.000 (- (sqrt (bignum "2"))) 1.000 0.000 -1.000 (sqrt (bignum "2"))))
+ (cim (bignum-vector 1.000 (- (sqrt (bignum "2"))) 1.000 0.000 -1.000 (sqrt (bignum "2")) -1.000 0.000)))
+ (if (or (not (vectors-equal? rl crl))
+ (not (vectors-equal? im cim)))
+ (format #t "big-fft -1 1 at 3:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+
+ ;; -------- 1 0 at 0 with bignum arg to make-vector (so it should copy)
+ (let ((rl (make-vector 8 (bignum "0.0")))
+ (im (make-vector 8 (bignum "0.0"))))
+ (vector-set! rl 0 (bignum "1.0"))
+ (bignum-fft rl im 8)
+ (let ((crl (bignum-vector 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0))
+ (cim (bignum-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (if (or (not (vectors-equal? rl crl))
+ (not (vectors-equal? im cim)))
+ (format #t "big-fft 1 0 at 0 (and copied fill):~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+
+ ;; -------- cos/sin
+ (let ((rl (make-vector 64))
+ (im (make-vector 64)))
+ (do ((i 0 (+ i 1)))
+ ((= i 64))
+ (vector-set! rl i (bignum "0.0"))
+ (vector-set! im i (bignum "0.0")))
+ (vector-set! rl 1 (bignum "1.0"))
+ (bignum-fft rl im 64 -1)
+ (let ((happy #t))
+ (do ((i 0 (+ i 1)))
+ ((or (= i 64) (not happy)))
+ (let ((cerr (magnitude (- (vector-ref rl i) (cos (/ (* 2 pi i) 64)))))
+ (serr (magnitude (- (vector-ref im i) (sin (/ (* -2 pi i) 64))))))
+ (set! happy (and (< cerr 1e-30)
+ (< serr 1e-30)))
+ (if (not happy)
+ (format #t "big fft 1 at 0 (sin/cos) differs by ~A in ~A at ~A (~A ~A)~%"
+ (max cerr serr)
+ (if (> cerr serr) "cos" "sin")
+ i
+ (if (> cerr serr)
+ (cos (/ (* 2 pi i) 64))
+ (sin (/ (* -2 pi i) 64)))
+ (if (> cerr serr)
+ (vector-ref rl i)
+ (vector-ref im i)))))))
+ (bignum-fft rl im 64)
+ (let ((crl (make-vector 64 (bignum "0.0")))
+ (cim (make-vector 64 (bignum "0.0"))))
+ (vector-set! crl 1 (bignum "64"))
+ (if (or (not (vectors-equal? rl crl))
+ (not (vectors-equal? im cim)))
+ (format #t "big-fft 1 at 0 fill cos/sin inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+
+ ;; -------- random
+ (let ((rl (make-vector 64))
+ (im (make-vector 64))
+ (crl (make-vector 64))
+ (cim (make-vector 64))
+ (rs (make-random-state (bignum "12345678"))))
+ (do ((i 0 (+ i 1)))
+ ((= i 64))
+ (vector-set! rl i (random (bignum "1.0") rs))
+ (vector-set! crl i (+ (vector-ref rl i) 0.0)) ; try to force a copy
+ (vector-set! im i (random (bignum "1.0") rs))
+ (vector-set! cim i (+ (vector-ref im i) 0.0)))
+ (bignum-fft rl im 64 1)
+ (if (or (vectors-equal? rl crl)
+ (vectors-equal? im cim))
+ (format #t "big-fft random not copied?:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
+ (bignum-fft rl im 64 -1)
+ (do ((i 0 (+ i 1)))
+ ((= i 64))
+ (vector-set! rl i (/ (vector-ref rl i) 64.0))
+ (vector-set! im i (/ (vector-ref im i) 64.0)))
+ (if (or (not (vectors-equal? rl crl))
+ (not (vectors-equal? im cim)))
+ (format #t "big-fft random:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
+ ))
+
+
(if (defined? 'gsl-dht)
(begin
(add-transform "Hankel" "Hankel" 0.0 1.0
@@ -43423,21 +43490,21 @@ EDITS: 1
(do ((i 0 (+ 1 i))) ((= i n)) (vct-set! v i 1.0))
(gsl-dht n v 1.0 1.0))
(let ((tag (catch #t (lambda () (gsl-dht -1 (make-vct 3) 1.0 1.0)) (lambda args args))))
- (if (not (eq? (car tag) 'out-of-range)) (snd-display ";gsl-dht bad size: ~A" tag)))))
-
+ (if (not (eq? (car tag) 'out-of-range)) (snd-display #__line__ ";gsl-dht bad size: ~A" tag)))))
+
(if (defined? 'gsl-eigenvectors)
(let ((vals (gsl-eigenvectors (make-mixer 4 -1.0 1.0 -1.0 1.0
-8.0 4.0 -2.0 1.0
27.0 9.0 3.0 1.0
64.0 16.0 4.0 1.0))))
(if (not (vequal (vector->vct (car vals)) (vct -6.41391102627093 5.54555349890946 5.54555349890946 2.32280402845201)))
- (snd-display ";gsl-eigenvalues: ~A" (car vals)))
+ (snd-display #__line__ ";gsl-eigenvalues: ~A" (car vals)))
(if (or (not (= (vector-length (cadr vals)) 4))
(not (vequal (vector->vct (vector-ref (cadr vals) 0)) (vct -0.0998821746683654 -0.111251309674367 0.292500673281302 0.94450518972065)))
(not (vequal (vector->vct (vector-ref (cadr vals) 1)) (vct -0.0434869537653505 0.0642376994169207 -0.515252756143484 -0.840592191366022)))
(not (vequal (vector->vct (vector-ref (cadr vals) 2)) (vct -0.0434869537653505 0.0642376994169207 -0.515252756143484 -0.840592191366022)))
(not (vequal (vector->vct (vector-ref (cadr vals) 3)) (vct -0.144932944248023 0.356601443087312 0.91936884368837 0.0811836295983152))))
- (snd-display ";gsl eigenvectors: ~A" (cadr vals)))))
+ (snd-display #__line__ ";gsl eigenvectors: ~A" (cadr vals)))))
(let ((ind1 (open-sound "oboe.snd")))
(set! (time-graph-style ind1 0) graph-lollipops)
@@ -43449,18 +43516,18 @@ EDITS: 1
(let ((size (transform-frames ind1 0)))
(if (or (number? size)
(not (= (length size) 3)))
- (snd-display ";transform-frames of sonogram: ~A" size)))
+ (snd-display #__line__ ";transform-frames of sonogram: ~A" size)))
(graph->ps "aaa.eps")
(catch #t
(lambda ()
(let ((ax (axis-info ind1 0 transform-graph)))
- (if (not ax) (snd-display ";axis-info transform-graph?"))
+ (if (not ax) (snd-display #__line__ ";axis-info transform-graph?"))
(if (and (provided? 'xm) (provided? 'snd-debug))
(let ((cwid (car (channel-widgets ind1 0))))
(focus-widget cwid)
(click-event cwid 0 0
- (inexact->exact (floor (* .5 (+ (list-ref ax 10) (list-ref ax 12)))))
- (inexact->exact (floor (* .5 (+ (list-ref ax 11) (list-ref ax 13))))))
+ (floor (* .5 (+ (list-ref ax 10) (list-ref ax 12))))
+ (floor (* .5 (+ (list-ref ax 11) (list-ref ax 13)))))
(force-event)))))
(lambda args args))
(let ((old-colormap (colormap)))
@@ -43472,13 +43539,13 @@ EDITS: 1
(catch #t
(lambda ()
(let ((ax (axis-info ind1 0 transform-graph)))
- (if (not ax) (snd-display ";axis-info transform-graph?"))
+ (if (not ax) (snd-display #__line__ ";axis-info transform-graph?"))
(if (and (provided? 'xm) (provided? 'snd-debug))
(let ((cwid (car (channel-widgets ind1 0))))
(focus-widget cwid)
(click-event cwid 0 0
- (inexact->exact (floor (* .5 (+ (list-ref ax 10) (list-ref ax 12)))))
- (inexact->exact (floor (* .5 (+ (list-ref ax 11) (list-ref ax 13))))))
+ (floor (* .5 (+ (list-ref ax 10) (list-ref ax 12))))
+ (floor (* .5 (+ (list-ref ax 11) (list-ref ax 13)))))
(force-event)))))
(lambda args args))
(set! (colormap) old-colormap))
@@ -43533,7 +43600,7 @@ EDITS: 1
(let ((v (dolph 16 2.5)))
(if (not (vequal v (vct 0.097 0.113 0.221 0.366 0.536 0.709 0.860 0.963 1.000 0.963 0.860 0.709 0.536 0.366 0.221 0.113)))
- (snd-display ";dolph 16 2.5 (dsp.scm): ~A" v)))
+ (snd-display #__line__ ";dolph 16 2.5 (dsp.scm): ~A" v)))
(let ((v (make-vct 8))
(v0 (make-vct 8)))
@@ -43543,30 +43610,30 @@ EDITS: 1
(vct-set! v0 i (vct-ref v i)))
(set! v (vct-scale! (dht (dht v)) (/ 1.0 8.0)))
(if (not (vvequal v v0))
- (snd-display ";dht twice: ~A ~A" v v0))
+ (snd-display #__line__ ";dht twice: ~A ~A" v v0))
(vct-fill! v 0.0)
(vct-set! v 1 1.0)
(set! v (dht v))
(if (not (vequal v (vct 1.000 1.414 1.000 0.000 -1.000 -1.414 -1.000 0.000)))
- (snd-display ";dht of pulse: ~A" v)))
+ (snd-display #__line__ ";dht of pulse: ~A" v)))
(let* ((ind (open-sound "oboe.snd"))
(val1 (car (find-sine 553.0 2000 3000 ind)))
(val2 (car (find-sine 620.0 2000 3000 ind))))
(if (or (fneq val1 .03835)
(fneq val2 .0012))
- (snd-display ";find-sine: ~A ~A" val1 val2))
+ (snd-display #__line__ ";find-sine: ~A ~A" val1 val2))
(let ((frq (spot-freq 2000 ind 0)))
- (if (not (= (inexact->exact (round frq)) 553))
- (snd-display ";spot-freq: ~A" frq)))
+ (if (not (= (round frq) 553))
+ (snd-display #__line__ ";spot-freq: ~A" frq)))
(down-oct 2)
(let ((frq (spot-freq 2000 ind 0)))
- (if (and (not (= (inexact->exact (round frq)) 276))
- (not (= (inexact->exact (round frq)) 277)))
- (snd-display ";spot-freq down oct: ~A" frq)))
+ (if (and (not (= (round frq) 276))
+ (not (= (round frq) 277)))
+ (snd-display #__line__ ";spot-freq down oct: ~A" frq)))
(undo)
(zero-phase)
- (if (fneq (sample 0) .1472) (snd-display ";zero-phase: ~A" (sample 0)))
+ (if (fneq (sample 0) .1472) (snd-display #__line__ ";zero-phase: ~A" (sample 0)))
(undo)
(rotate-phase (lambda (x) x))
(undo)
@@ -43585,69 +43652,69 @@ EDITS: 1
(valg2 (* 2 (/ (goertzel 440.0 0 (frames) ind) (frames))))
(valf3 (car (find-sine 437.0 0 (frames) ind)))
(valg3 (* 2 (/ (goertzel 437.0 0 (frames) ind) (frames)))))
- (if (fneq valf valg) (snd-display ";goertzel 0: ~A ~A" valf valg))
- (if (fneq valf1 valg1) (snd-display ";goertzel 1: ~A ~A" valf1 valg1))
- (if (fneq valf2 valg2) (snd-display ";goertzel 2: ~A ~A" valf2 valg2))
- (if (fneq valf3 valg3) (snd-display ";goertzel 3: ~A ~A" valf3 valg3))
+ (if (fneq valf valg) (snd-display #__line__ ";goertzel 0: ~A ~A" valf valg))
+ (if (fneq valf1 valg1) (snd-display #__line__ ";goertzel 1: ~A ~A" valf1 valg1))
+ (if (fneq valf2 valg2) (snd-display #__line__ ";goertzel 2: ~A ~A" valf2 valg2))
+ (if (fneq valf3 valg3) (snd-display #__line__ ";goertzel 3: ~A ~A" valf3 valg3))
(close-sound ind))
- (set! (optimization) old-opt))
+ (set! (optimization) old-opt))
(let ((v (vct-polynomial (vct 0.0 2.0) (vct 1.0 2.0))))
(if (not (vequal v (vct 1.0 5.0)))
- (snd-display ";vct-polynomial 0: ~A" v)))
+ (snd-display #__line__ ";vct-polynomial 0: ~A" v)))
(let ((v (vct-polynomial (vct 0 1 2) (vct 0 2 1))))
(if (not (vequal v (vct 0.000 3.000 8.000)))
- (snd-display ";vct-polynomial 1: ~A" v)))
+ (snd-display #__line__ ";vct-polynomial 1: ~A" v)))
(let ((v (vct-polynomial (vct 0 1 2) (vct 0 2 1 .5))))
(if (not (vequal v (vct 0.000 3.500 12.000)))
- (snd-display ";vct-polynomial 2: ~A" v)))
+ (snd-display #__line__ ";vct-polynomial 2: ~A" v)))
(let ((v (vct-polynomial (vct 0 1 2) (vct 1))))
(if (not (vequal v (vct 1 1 1)))
- (snd-display ";vct-polynomial 3: ~A" v)))
+ (snd-display #__line__ ";vct-polynomial 3: ~A" v)))
(let* ((ind (open-sound "pistol.snd"))
(mx (maxamp ind 0)))
(channel-polynomial (vct 0.0 2.0) ind 0)
(if (fneq (maxamp) (* mx 2))
- (snd-display ";channel-polynomial 2: ~A" (maxamp)))
+ (snd-display #__line__ ";channel-polynomial 2: ~A" (maxamp)))
(undo)
(channel-polynomial (vct 0.0 0.5 0.25 0.25) ind 0)
(if (fneq (maxamp) .222)
- (snd-display ";channel-polynomial 3: ~A" (maxamp)))
+ (snd-display #__line__ ";channel-polynomial 3: ~A" (maxamp)))
(undo)
(channel-polynomial (vct 0.0 0.0 1.0) ind 0)
(let ((pos (scan-channel (lambda (y) (< y 0.0)))))
(if pos
- (snd-display ";channel-polynomial squares: ~A" pos)))
+ (snd-display #__line__ ";channel-polynomial squares: ~A" pos)))
(undo)
(channel-polynomial (vct 0.5 1.0) ind 0)
(let ((pos (scan-channel (lambda (y) (< y 0.0)))))
(if pos
- (snd-display ";channel-polynomial offset: ~A" pos)))
+ (snd-display #__line__ ";channel-polynomial offset: ~A" pos)))
(if (fneq (maxamp) .8575)
- (snd-display ";channel-polynomial off mx: ~A" (maxamp)))
+ (snd-display #__line__ ";channel-polynomial off mx: ~A" (maxamp)))
(undo)
(spectral-polynomial (vct 0.0 1.0) ind 0)
(if (fneq (maxamp) .493)
- (snd-display ";spectral-polynomial 0 mx: ~A" (maxamp)))
+ (snd-display #__line__ ";spectral-polynomial 0 mx: ~A" (maxamp)))
(if (not (= (frames ind 0) 41623))
- (snd-display ";spectral-polynomial 0 len: ~A" (frames)))
+ (snd-display #__line__ ";spectral-polynomial 0 len: ~A" (frames)))
(undo)
(spectral-polynomial (vct 0.0 0.5 0.5) ind 0)
(if (fneq (maxamp) .493)
- (snd-display ";spectral-polynomial 1: ~A" (maxamp)))
+ (snd-display #__line__ ";spectral-polynomial 1: ~A" (maxamp)))
(if (not (= (frames ind 0) (* 2 41623)))
- (snd-display ";spectral-polynomial 1 len: ~A" (frames)))
+ (snd-display #__line__ ";spectral-polynomial 1 len: ~A" (frames)))
(undo)
(spectral-polynomial (vct 0.0 0.0 0.0 1.0) ind 0)
(if (fneq (maxamp) .493)
- (snd-display ";spectral-polynomial 2: ~A" (maxamp)))
+ (snd-display #__line__ ";spectral-polynomial 2: ~A" (maxamp)))
(if (not (= (frames ind 0) (* 3 41623)))
- (snd-display ";spectral-polynomial 1 len: ~A" (frames)))
+ (snd-display #__line__ ";spectral-polynomial 1 len: ~A" (frames)))
(close-sound ind))
(let ((vals (scentroid "oboe.snd")))
(if (or (fneq (vct-ref vals 0) 1876.085) (fneq (vct-ref vals 1) 1447.004))
- (snd-display ";scentroid: ~A" vals)))
+ (snd-display #__line__ ";scentroid: ~A" vals)))
(let ((flt (make-fir-filter 3 (vct 0.5 0.25 0.125)))
(data (make-vct 10))
@@ -43662,7 +43729,7 @@ EDITS: 1
((= i 10))
(vct-set! undata i (fir-filter flt (vct-ref undata i))))
(if (not (vequal undata data))
- (snd-display ";invert-filter: ~A" undata))))
+ (snd-display #__line__ ";invert-filter: ~A" undata))))
(let ((coeffs (make-vct 6)))
(do ((i 0 (+ 1 i))
@@ -43682,7 +43749,7 @@ EDITS: 1
((= i 20))
(vct-set! undata i (fir-filter flt (vct-ref undata i))))
(if (not (vequal undata data))
- (snd-display ";invert-filter (6): ~A" undata)))))
+ (snd-display #__line__ ";invert-filter (6): ~A" undata)))))
(let ((flt (make-volterra-filter (vct 1.0 .4) (vct .3 .2 .1)))
(data (make-vct 10))
@@ -43692,7 +43759,7 @@ EDITS: 1
(vct-set! data i (volterra-filter flt x))
(if (= i 0) (set! x 0.5) (set! x 0.0)))
(if (not (vequal data (vct 0.000 0.575 0.250 0.025 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";volterra-filter: ~A" data)))
+ (snd-display #__line__ ";volterra-filter: ~A" data)))
(let ((flt (make-volterra-filter (vct 1.0) (vct 1.0)))
(data (make-vct 10)))
@@ -43701,7 +43768,7 @@ EDITS: 1
((= i 10))
(vct-set! data i (volterra-filter flt x)))
(if (not (vequal data (vct 2.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";volterra-filter x + x^2: ~A" data)))
+ (snd-display #__line__ ";volterra-filter x + x^2: ~A" data)))
(let ((flt (make-volterra-filter (vct 1.0) (vct 1.0)))
(data (make-vct 10)))
@@ -43710,7 +43777,7 @@ EDITS: 1
((= i 10))
(vct-set! data i (volterra-filter flt x)))
(if (not (vequal data (vct 2.000 1.710 1.440 1.190 0.960 0.750 0.560 0.390 0.240 0.110)))
- (snd-display ";volterra-filter x + x^2 by -0.1: ~A" data)))
+ (snd-display #__line__ ";volterra-filter x + x^2 by -0.1: ~A" data)))
(let ((flt (make-volterra-filter (vct 1.0 0.5) (vct 1.0)))
(data (make-vct 10)))
@@ -43719,7 +43786,7 @@ EDITS: 1
((= i 10))
(vct-set! data i (volterra-filter flt x)))
(if (not (vequal data (vct 2.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";volterra-filter x + .5x(n-1) + x^2: ~A" data)))
+ (snd-display #__line__ ";volterra-filter x + .5x(n-1) + x^2: ~A" data)))
(let ((flt (make-volterra-filter (vct 1.0 0.5) (vct 1.0 0.6)))
(data (make-vct 10)))
@@ -43728,14 +43795,14 @@ EDITS: 1
((= i 10))
(vct-set! data i (volterra-filter flt x)))
(if (not (vequal data (vct 1.710 0.936 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";volterra-filter x + .5x(n-1) + x^2 + 0.6: ~A" data)))
+ (snd-display #__line__ ";volterra-filter x + .5x(n-1) + x^2 + 0.6: ~A" data)))
(let ((ind (new-sound "test.snd" :size 100))
(gen (make-oscil 440.0)))
(map-chan (lambda (y) (oscil gen)))
(down-oct 2)
- (if (not (= (frames) 200)) (snd-display ";down-oct new len: ~A" (frames)))
+ (if (not (= (frames) 200)) (snd-display #__line__ ";down-oct new len: ~A" (frames)))
(let ((r1 (make-sampler 0 ind 0 1 1))
(r2 (make-sampler 0 ind 0 1 2)))
(do ((i 0 (+ i 2)))
@@ -43745,10 +43812,10 @@ EDITS: 1
(val3 (r2)))
(if (and (fneq val1 val2)
(fneq val1 val3))
- (snd-display ";down-oct: ~A ~A ~A ~A" i val1 val2 val3)))))
-
+ (snd-display #__line__ ";down-oct: ~A ~A ~A ~A" i val1 val2 val3)))))
+
(kalman-filter-channel) ; just make sure it runs
-
+
(close-sound ind))
(let* ((d0 (make-vct 8))
@@ -43757,7 +43824,7 @@ EDITS: 1
(let ((vals (fractional-fourier-transform d0 d1 8 1.0)))
(if (or (not (vequal (car vals) (vct 1.000 0.000 -1.000 -0.000 1.000 0.000 -1.000 -0.000)))
(not (vequal (cadr vals) (vct 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
- (snd-display ";fractional-fft: ~A?" vals))))
+ (snd-display #__line__ ";fractional-fft: ~A?" vals))))
(let* ((d0 (make-vct 8))
(d1 (make-vct 8)))
@@ -43769,40 +43836,40 @@ EDITS: 1
(vct-set! d1 i (imag-part (vector-ref val i))))
(if (or (not (vequal d0 (vct 1.000 0.000 -1.000 -0.000 1.000 0.000 -1.000 -0.000)))
(not (vequal d1 (vct 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
- (snd-display ";z-transform: ~A ~A?" d0 d1))))
+ (snd-display #__line__ ";z-transform: ~A ~A?" d0 d1))))
(let ((v1 (make-vct 16)))
(vct-set! v1 0 1.0)
(let ((res (vector->vct (z-transform v1 16 0.5))))
(if (not (vequal res (make-vct 16 1.0)))
- (snd-display ";z 0.5 0=1: ~A" res)))
+ (snd-display #__line__ ";z 0.5 0=1: ~A" res)))
(let ((res (vector->vct (z-transform v1 16 -1.0))))
(if (not (vequal res (make-vct 16 1.0)))
- (snd-display ";z -1.0 0=1: ~A" res)))
+ (snd-display #__line__ ";z -1.0 0=1: ~A" res)))
(vct-set! v1 0 0.0)
(vct-set! v1 1 1.0)
(let ((res (vector->vct (z-transform v1 16 0.5))))
(if (not (vequal res (vct 1.000 0.500 0.250 0.125 0.062 0.031 0.016 0.008 0.004 0.002 0.001 0.0 0.0 0.0 0.0 0.0)))
- (snd-display ";z 0.5 1=1: ~A" res)))
+ (snd-display #__line__ ";z 0.5 1=1: ~A" res)))
(let ((res (vector->vct (z-transform v1 16 2.0))))
(if (not (vequal res (vct 1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0 1024.0
2048.0 4096.0 8192.0 16384.0 32768.0)))
- (snd-display ";z 2.0 1=1: ~A" res)))
+ (snd-display #__line__ ";z 2.0 1=1: ~A" res)))
(vct-set! v1 2 1.0)
(let ((res (vector->vct (z-transform v1 16 0.5))))
(if (not (vequal res (vct 2.0 0.75 0.3125 0.140 0.0664 0.0322 0.0158 0.00787 0.0039 0.0019 0 0 0 0 0 0)))
- (snd-display ";z 0.5 1=1 2=1: ~A" res)))
+ (snd-display #__line__ ";z 0.5 1=1 2=1: ~A" res)))
(let ((res (vector->vct (z-transform v1 16 2.0))))
(if (not (vequal res (vct 2.0 6.0 20.0 72.0 272.0 1056.0 4160.0 16512.0 65792.0
262656.0 1049600.0 4196352.0 16781312.0 67117056.0 268451840.0 1073774592.0)))
- (snd-display ";z 2.0 1=1 2=1: ~A" res)))
+ (snd-display #__line__ ";z 2.0 1=1 2=1: ~A" res)))
(do ((i 0 (+ 1 i))
(j 1.0 (* j 0.4)))
((= i 16))
(vct-set! v1 i j))
(let ((res (vector->vct (z-transform v1 16 1.0))))
(if (not (vequal res (make-vct 16 (/ 1.0 (- 1.0 0.4))))) ; this is confusing
- (snd-display ";z 1 0.4g: ~A" res))))
+ (snd-display #__line__ ";z 1 0.4g: ~A" res))))
(let ((ind (open-sound "oboe.snd")))
(automorph 0.0+1.0i 0 0 1)
@@ -43817,14 +43884,14 @@ EDITS: 1
(if (> diff mxdiff)
(set! mxdiff diff))
#f)))
- (if (> mxdiff .003) (snd-display ";automorph rotation: ~A" mxdiff)))
+ (if (> mxdiff .003) (snd-display #__line__ ";automorph rotation: ~A" mxdiff)))
(revert-sound ind)
(periodogram 256)
- (if (not (lisp-graph? ind)) (snd-display ";periodogram not graphed?"))
+ (if (not (lisp-graph? ind)) (snd-display #__line__ ";periodogram not graphed?"))
(close-sound ind))
))
-
+
(do ((i 0 (+ i 1)))
((= i 10))
(let* ((len (expt 2 (+ 2 (random 8))))
@@ -43850,11 +43917,11 @@ EDITS: 1
(if (or (> mx 1e-6)
(> sum 1e-6))
(format #t ";cfft! ~A: ~A ~A~%" len mx sum)))))
-
+
(let ((val (cfft! (cfft! (cfft! (cfft! (vector 0.0 1+i 0.0 0.0)))))))
(if (not (equal? val '#(0.0 16+16i 0.0 0.0)))
- (snd-display ";cfft! 4x: ~A" val)))
-
+ (snd-display #__line__ ";cfft! 4x: ~A" val)))
+
(do ((i 0 (+ i 1)))
((= i 10))
(let* ((len (expt 2 (+ 2 (random 8))))
@@ -43948,9 +44015,9 @@ EDITS: 1
(size (vct-length low-data))
(samps (- right left))
(left-offset (max 0 (- 1000 left)))
- (left-bin (inexact->exact (round (/ (* size left-offset) samps))))
+ (left-bin (round (/ (* size left-offset) samps)))
(right-offset (- (min 2000 right) left))
- (right-bin (inexact->exact (round (/ (* size right-offset) samps))))
+ (right-bin (round (/ (* size right-offset) samps)))
(new-low-data (vct-subseq low-data left-bin right-bin))
(new-high-data (vct-subseq high-data left-bin right-bin)))
(set! (foreground-color snd chn) red)
@@ -43978,35 +44045,35 @@ EDITS: 1
(do ((test-ctr 0 (+ 1 test-ctr))) ((= test-ctr tests))
(log-mem test-ctr)
- (if (not (sound-file? "oboe.snd")) (snd-display ";oboe.snd not a sound file?"))
- (if (not (sound-file? "4.aiff")) (snd-display ";4.aiff not a sound file?"))
- (if (sound-file? "snd.h") (snd-display ";snd.h is a sound-file?"))
+ (if (not (sound-file? "oboe.snd")) (snd-display #__line__ ";oboe.snd not a sound file?"))
+ (if (not (sound-file? "4.aiff")) (snd-display #__line__ ";4.aiff not a sound file?"))
+ (if (sound-file? "snd.h") (snd-display #__line__ ";snd.h is a sound-file?"))
(let ((ind1 (open-sound "oboe.snd")))
(save-sound-as "test.snd" ind1)
(let ((ind2 (open-sound "test.snd")))
(if (not (channels-equal? ind1 0 ind2 0))
- (snd-display ";channels-equal? of copy"))
+ (snd-display #__line__ ";channels-equal? of copy"))
(if (not (channels=? ind1 0 ind2 0))
- (snd-display ";channels=? of copy"))
+ (snd-display #__line__ ";channels=? of copy"))
(pad-channel (frames ind2 0) 100)
(if (channels-equal? ind1 0 ind2 0)
- (snd-display ";channels-equal? of pad"))
+ (snd-display #__line__ ";channels-equal? of pad"))
(if (not (channels=? ind1 0 ind2 0))
- (snd-display ";channels=? of pad"))
+ (snd-display #__line__ ";channels=? of pad"))
(set! (sample 50900 ind2 0) .1)
(if (channels-equal? ind1 0 ind2 0)
- (snd-display ";channels-equal? of pad+set"))
+ (snd-display #__line__ ";channels-equal? of pad+set"))
(if (channels=? ind1 0 ind2 0)
- (snd-display ";channels=? of pad+set 0 err"))
+ (snd-display #__line__ ";channels=? of pad+set 0 err"))
(if (not (channels=? ind1 0 ind2 0 .2))
- (snd-display ";channels=? of pad+set .2 err"))
+ (snd-display #__line__ ";channels=? of pad+set .2 err"))
(if with-gui
(begin
(add-comment 1234 "sample 1234" ind1 0)
(let ((comments (show-comments ind1 0)))
(update-time-graph)
- (if (null? comments) (snd-display ";add-comment failed?")))
+ (if (null? comments) (snd-display #__line__ ";add-comment failed?")))
(display-db ind1 0)
(display-samps-in-red ind1 0)
(update-time-graph)
@@ -44021,13 +44088,13 @@ EDITS: 1
(revert-sound ind1)
(make-selection 10000 20000 ind1 0)
(if (not (selection?))
- (snd-display ";make-selection for show failed?")
+ (snd-display #__line__ ";make-selection for show failed?")
(begin
(show-selection)
(let ((vals (x-bounds ind1 0)))
(if (or (fneq (car vals) (/ 10000.0 (srate ind1)))
(fneq (cadr vals) (/ 20000.0 (srate ind1))))
- (snd-display ";show-selection: ~A (~A)" vals (list (/ 10000.0 (srate ind1)) (/ 20000.0 (srate ind1))))))))
+ (snd-display #__line__ ";show-selection: ~A (~A)" vals (list (/ 10000.0 (srate ind1)) (/ 20000.0 (srate ind1))))))))
(add-hook! graph-hook zoom-spectrum)
(set! (transform-graph? ind1 0) #t)
(let ((ind3 (open-sound "pistol.snd")))
@@ -44053,7 +44120,7 @@ EDITS: 1
(vct 0.000 0.008 0.019 0.032 0.049 0.070 0.097 0.130 0.173 0.226 0.293
0.377 0.484 0.618 0.787 1.000 0.992 0.981 0.968 0.951 0.930 0.903
0.870 0.828 0.774 0.707 0.623 0.516 0.382 0.213 0.000 0.000 0.000))))
- (snd-display ";power-env: ~A" (channel->vct))))
+ (snd-display #__line__ ";power-env: ~A" (channel->vct))))
(map-channel (lambda (y) 1.0))
(let ((pe (make-power-env '(0 0 1.0 1 1 0.0 2 0 1 3 0 1) :duration (/ 34.0 22050.0))))
(map-channel (lambda (y) (* y (power-env pe))))
@@ -44061,7 +44128,7 @@ EDITS: 1
(vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000
1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";power-env 0 and 1: ~A" (channel->vct))))
+ (snd-display #__line__ ";power-env 0 and 1: ~A" (channel->vct))))
(map-channel (lambda (y) 1.0))
(let ((pe (make-power-env '(0 0 .01 1 1 1) :duration (/ 34.0 22050.0))))
(map-channel (lambda (y) (* y (power-env pe))))
@@ -44073,7 +44140,7 @@ EDITS: 1
(vct 0.000 0.135 0.253 0.354 0.442 0.518 0.584 0.641 0.691 0.733 0.771
0.803 0.830 0.855 0.875 0.893 0.909 0.923 0.934 0.945 0.953 0.961
0.968 0.973 0.978 0.982 0.986 0.987 0.990 0.992 0.995 0.997 0.998))))
- (snd-display ";power-env .01: ~A" (channel->vct))))
+ (snd-display #__line__ ";power-env .01: ~A" (channel->vct))))
(let ((name (file-name ind)))
(close-sound ind)
(if (file-exists? name) (delete-file name))))
@@ -44084,22 +44151,22 @@ EDITS: 1
(filter-channel (vct .5 1.0 .5) 3)
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display ";filter (sym 3): ~A" data)))
+ (snd-display #__line__ ";filter (sym 3): ~A" data)))
(undo)
(filter-channel (vct .5 1.0 .25) 3)
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 0.250 0.000 0.000 0.000 0.000)))
- (snd-display ";filter (3): ~A" data)))
+ (snd-display #__line__ ";filter (3): ~A" data)))
(undo)
(filter-channel (vct .5 1.0 1.0 .5) 4)
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 1.000 0.500 0.000 0.000 0.000)))
- (snd-display ";filter (sym 4): ~A" data)))
+ (snd-display #__line__ ";filter (sym 4): ~A" data)))
(undo)
(filter-channel (vct .5 1.0 1.0 .25) 4)
(let ((data (channel->vct 0 10)))
(if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 1.000 0.250 0.000 0.000 0.000)))
- (snd-display ";filter (4): ~A" data)))
+ (snd-display #__line__ ";filter (4): ~A" data)))
(undo)
(close-sound ind))
@@ -44107,11 +44174,11 @@ EDITS: 1
(set! (sample 10) 0.5)
(filter-sound (vct 1.0 0.0 1.0) 3)
(if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display ";filter-sound 1 0 1: ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";filter-sound 1 0 1: ~A" (channel->vct 5 10)))
(undo)
(filter-channel (vct 1.0 0.0 1.0) 3)
(if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display ";filter-channel (v) 1 0 1: ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";filter-channel (v) 1 0 1: ~A" (channel->vct 5 10)))
(undo)
(filter-sound '(0 1 1 1) 100)
(let ((coeffs (make-fir-coeffs 100 (make-vct 100 0.5)))
@@ -44121,57 +44188,57 @@ EDITS: 1
((or (not happy) (= i 100)))
(if (fneq (vct-ref data i) (vct-ref coeffs i))
(begin
- (snd-display ";coeffs '(0 1 1 1): ~A ~A ~A" i (vct-ref coeffs i) (vct-ref data i))
+ (snd-display #__line__ ";coeffs '(0 1 1 1): ~A ~A ~A" i (vct-ref coeffs i) (vct-ref data i))
(set! happy #f)))))
(undo)
(filter-sound '(0 1 1 1) 1000)
(if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display ";filter-sound 1 (1000): ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";filter-sound 1 (1000): ~A" (channel->vct 5 10)))
(undo)
(make-selection 5 15)
(filter-selection '(0 1 1 1) 100)
(if (and (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 11)))
(not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 111))))
- (snd-display ";filter-selection truncated: ~S" (edit-fragment 2)))
+ (snd-display #__line__ ";filter-selection truncated: ~S" (edit-fragment 2)))
(undo)
(filter-selection '(0 1 1 1) 100 #f)
(if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 111)))
- (snd-display ";filter-selection not truncated: ~S" (edit-fragment 2)))
+ (snd-display #__line__ ";filter-selection not truncated: ~S" (edit-fragment 2)))
(if (not (vequal (channel->vct 50 10) (vct -0.016 0.018 -0.021 0.024 -0.029 0.035 -0.045 0.064 -0.106 0.318)))
- (snd-display ";filter-selection no trunc: ~A" (channel->vct 50 10)))
+ (snd-display #__line__ ";filter-selection no trunc: ~A" (channel->vct 50 10)))
(undo)
(filter-selection '(0 1 1 1) 1000 #t)
(if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 1000" "set" 5 11)))
- (snd-display ";filter-selection truncated (1000): ~S" (edit-fragment 2)))
- (if (fneq (maxamp) 0.0) (snd-display ";filter-selection 1000 untrunc? ~A" (maxamp)))
+ (snd-display #__line__ ";filter-selection truncated (1000): ~S" (edit-fragment 2)))
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";filter-selection 1000 untrunc? ~A" (maxamp)))
(undo)
(filter-selection '(0 1 1 1) 1000 #f)
(if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 1000" "set" 5 1011)))
- (snd-display ";filter-selection not truncated (1000): ~S" (edit-fragment 2)))
- (if (fneq (maxamp) 0.318) (snd-display ";filter-selection 1000 no trunc? ~A" (maxamp)))
+ (snd-display #__line__ ";filter-selection not truncated (1000): ~S" (edit-fragment 2)))
+ (if (fneq (maxamp) 0.318) (snd-display #__line__ ";filter-selection 1000 no trunc? ~A" (maxamp)))
(if (not (vequal (channel->vct 505 10) (vct 0.035 -0.045 0.064 -0.106 0.318 0.318 -0.106 0.064 -0.045 0.035)))
- (snd-display ";filter-selection 1000 no trunc: ~A" (channel->vct 505 10)))
+ (snd-display #__line__ ";filter-selection 1000 no trunc: ~A" (channel->vct 505 10)))
(undo)
(filter-channel '(0 1 1 1) 10)
(if (not (vequal (channel->vct 10 10) (vct 0.008 -0.025 0.050 -0.098 0.316 0.316 -0.098 0.050 -0.025 0.008)))
- (snd-display ";filter-channel 10: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";filter-channel 10: ~A" (channel->vct 10 10)))
(undo)
(filter-channel '(0 1 1 1) 1000)
(if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display ";filter-channel 1 (1000): ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";filter-channel 1 (1000): ~A" (channel->vct 5 10)))
(undo)
(filter-channel '(0 1 1 0) 10)
(if (not (vequal (channel->vct 0 30) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";filter-channel lp: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
+ (snd-display #__line__ ";filter-channel lp: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
(undo)
(filter-channel '(0 1 1 0) 10 0 20 #f #f #f #f)
(if (not (vequal (channel->vct 0 30) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display ";filter-channel lp no trunc: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
+ (snd-display #__line__ ";filter-channel lp no trunc: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
(undo)
(close-sound))
@@ -44181,45 +44248,45 @@ EDITS: 1
(set! (sync ind) 1)
(filter-sound (vct 1.0 0.0 1.0) 3)
(if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display ";(2) filter-sound 1 0 1: ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 1: ~A" (channel->vct 5 10)))
(if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
- (snd-display ";(2) filter-sound 1 0 2: ~A" (channel->vct 0 10 ind 1)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 2: ~A" (channel->vct 0 10 ind 1)))
(undo)
(filter-sound '(0 1 1 1) 1000)
(if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display ";(2) filter-sound 1 (1000): ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";(2) filter-sound 1 (1000): ~A" (channel->vct 5 10)))
(if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 0.000 0.000 0.000)))
- (snd-display ";(2) filter-sound 2 (1000): ~A" (channel->vct 0 10)))
+ (snd-display #__line__ ";(2) filter-sound 2 (1000): ~A" (channel->vct 0 10)))
(undo)
(make-selection 0 20)
(filter-selection (vct 1.0 0.0 1.0) 3)
(if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display ";(2) filter-selection 1 0 1: ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 1: ~A" (channel->vct 5 10)))
(if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
- (snd-display ";(2) filter-selection 1 0 2: ~A" (channel->vct 0 10 ind 1)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 2: ~A" (channel->vct 0 10 ind 1)))
(undo)
(set! (sync ind) 0)
(filter-selection (vct 1.0 0.0 1.0) 3)
(if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display ";(2) filter-selection 1 0 1 (no sync): ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 1 (no sync): ~A" (channel->vct 5 10)))
(if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
- (snd-display ";(2) filter-selection 1 0 2 (no sync): ~A" (channel->vct 0 10 ind 1)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 2 (no sync): ~A" (channel->vct 0 10 ind 1)))
(undo 1 ind 0)
(undo 1 ind 1)
- (if (not (= (edit-position ind 0) 1)) (snd-display ";edpos filter-sel undo: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind 1) 1)) (snd-display ";edpos filter-sel undo 1: ~A" (edit-position ind 1)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";edpos filter-sel undo: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 1) 1)) (snd-display #__line__ ";edpos filter-sel undo 1: ~A" (edit-position ind 1)))
(filter-sound (vct 1.0 0.0 1.0) 3)
(if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display ";(2) filter-sound 1 0 1 no sync: ~A" (channel->vct 5 10)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 1 no sync: ~A" (channel->vct 5 10)))
(if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 0.000 0.000 0.000)))
- (snd-display ";(2) filter-sound 1 0 2 no sync: ~A" (channel->vct 0 10 ind 1)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 2 no sync: ~A" (channel->vct 0 10 ind 1)))
(undo 1 ind 0)
(filter-channel '(0 1 1 0) 10 #f #f ind 1)
(if (not (vequal (channel->vct 0 30 ind 1) (vct 0.000 0.000 0.000 0.000 0.000; 0.000 0.000 0.000 0.000 0.000
-0.005 -0.010 -0.006 -0.038 -0.192 -0.192 -0.038 -0.006 -0.010 -0.005
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0 0 0 0 0)))
- (snd-display ";filter-channel lp: ~A ~A ~A" (channel->vct 0 10 ind 1) (channel->vct 10 10 ind 1) (channel->vct 20 10 ind 1)))
+ (snd-display #__line__ ";filter-channel lp: ~A ~A ~A" (channel->vct 0 10 ind 1) (channel->vct 10 10 ind 1) (channel->vct 20 10 ind 1)))
(undo 1 ind 1)
(close-sound ind))
@@ -44227,15 +44294,15 @@ EDITS: 1
(set! (sample 10) 0.5)
(set! (sample 20) -0.5)
(scale-to 1.0)
- (if (fneq (sample 10) .999) (snd-display ";scale-to 1.0 short (10): ~A" (sample 10)))
- (if (fneq (sample 20) -.999) (snd-display ";scale-to 1.0 short (20): ~A" (sample 10)))
+ (if (fneq (sample 10) .999) (snd-display #__line__ ";scale-to 1.0 short (10): ~A" (sample 10)))
+ (if (fneq (sample 20) -.999) (snd-display #__line__ ";scale-to 1.0 short (20): ~A" (sample 10)))
(close-sound ind))
(let ((ind (new-sound "tmp.snd" mus-next mus-byte 22050 1 :size 100)))
(set! (sample 10) 0.5)
(set! (sample 20) -0.5)
(scale-to 1.0)
- (if (fneq (sample 10) .992) (snd-display ";scale-to 1.0 byte (10): ~A" (sample 10)))
- (if (fneq (sample 20) -.992) (snd-display ";scale-to 1.0 byte (20): ~A" (sample 10)))
+ (if (fneq (sample 10) .992) (snd-display #__line__ ";scale-to 1.0 byte (10): ~A" (sample 10)))
+ (if (fneq (sample 20) -.992) (snd-display #__line__ ";scale-to 1.0 byte (20): ~A" (sample 10)))
(close-sound ind))
(set! (transform-graph-type) graph-once)
@@ -44269,46 +44336,46 @@ EDITS: 1
(unsel-snd (if (equal? sel-snd ind-1) ind-2 ind-1))
(caller (if channel "channel" "sound")))
(if (not (eq-func old-val old-default))
- (snd-display ";~A sound-func: no arg: ~A, #f: ~A" name old-val old-default))
+ (snd-display #__line__ ";~A sound-func: no arg: ~A, #f: ~A" name old-val old-default))
(if (not (or (leq-func old-vals (list old-1 old-2))
(leq-func old-vals (list old-2 old-1))))
- (snd-display ";~A sound-func #t: ~A, sep: ~A" name old-vals (list old-1 old-2)))
+ (snd-display #__line__ ";~A sound-func #t: ~A, sep: ~A" name old-vals (list old-1 old-2)))
(if settable
(begin
(set! (func) new-val)
(if (not (eq-func (func) new-val))
- (snd-display ";~A set no arg: ~A ~A" name (func) new-val))
+ (snd-display #__line__ ";~A set no arg: ~A ~A" name (func) new-val))
(if (not (eq-func (func) (func sel-snd)))
- (snd-display ";~A set no arg sel: ~A ~A" name (func) (func sel-snd)))
+ (snd-display #__line__ ";~A set no arg sel: ~A ~A" name (func) (func sel-snd)))
(if (or (and global (not (eq-func (func) (func unsel-snd))))
(and (not global) (eq-func (func) (func unsel-snd))))
- (snd-display ";~A set no arg unsel: ~A ~A (sel: ~A)" name (func) (func unsel-snd) (func sel-snd)))
+ (snd-display #__line__ ";~A set no arg unsel: ~A ~A (sel: ~A)" name (func) (func unsel-snd) (func sel-snd)))
(if (not (or (leq-func (func #t) (list (func sel-snd) (func unsel-snd)))
(leq-func (func #t) (list (func unsel-snd) (func sel-snd)))))
- (snd-display ";~A ~A-func #t set: ~A, sep: ~A" name caller (func #t) (list (func sel-snd) (func unsel-snd))))
+ (snd-display #__line__ ";~A ~A-func #t set: ~A, sep: ~A" name caller (func #t) (list (func sel-snd) (func unsel-snd))))
(set! (func) old-val)
(set! (func ind-1) new-val)
(if (not (eq-func (func ind-1) new-val))
- (snd-display ";~A set arg: ~A ~A" name (func ind-1) new-val))
+ (snd-display #__line__ ";~A set arg: ~A ~A" name (func ind-1) new-val))
(if (eq-func (func ind-2) new-val)
- (snd-display ";~A set arg (2): ~A ~A" name (func ind-2) new-val))
+ (snd-display #__line__ ";~A set arg (2): ~A ~A" name (func ind-2) new-val))
(if (not (or (leq-func (func #t) (list (func ind-1) (func ind-2)))
(leq-func (func #t) (list (func ind-2) (func ind-1)))))
- (snd-display ";~A ~A-func arg set: ~A, sep: ~A" name caller (func #t) (list (func ind-1) (func ind-2))))
+ (snd-display #__line__ ";~A ~A-func arg set: ~A, sep: ~A" name caller (func #t) (list (func ind-1) (func ind-2))))
(set! (func ind-1) old-1)
(set! (func #t) new-val)
(if (not (leq-func (func #t) (list new-val new-val)))
- (snd-display ";~A ~A-func arg set #t: ~A, sep: ~A" name caller (func #t) (list new-val new-val)))
+ (snd-display #__line__ ";~A ~A-func arg set #t: ~A, sep: ~A" name caller (func #t) (list new-val new-val)))
(if (not (eq-func (func ind-1) new-val))
- (snd-display ";~A set arg #t: ~A ~A" name (func ind-1) new-val))
+ (snd-display #__line__ ";~A set arg #t: ~A ~A" name (func ind-1) new-val))
(if (not (eq-func (func ind-2) new-val))
- (snd-display ";~A set arg #t (2): ~A ~A" name (func ind-2) new-val))
+ (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) new-val))
(set! (func ind-1) old-1)
(set! (func ind-2) old-2)
(if (not (eq-func (func ind-1) old-1))
- (snd-display ";~A set arg #t old: ~A ~A" name (func ind-1) old-1))
+ (snd-display #__line__ ";~A set arg #t old: ~A ~A" name (func ind-1) old-1))
(if (not (eq-func (func ind-2) old-2))
- (snd-display ";~A set arg #t (2): ~A ~A" name (func ind-2) old-2)))))))
+ (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) old-2)))))))
(test-sound-func (lambda (func name ind-1 ind-2 new-val eq-func leq-func settable)
(test-sound-func-1 func name ind-1 ind-2 new-val eq-func leq-func settable #f #f))))
@@ -44351,7 +44418,7 @@ EDITS: 1
(restore-controls #t)
(reset-controls #t)
(close-sound #t)
- (if (not (equal? (sounds) '())) (snd-display ";sounds after close-sound #t: ~A" (sounds)))
+ (if (not (equal? (sounds) '())) (snd-display #__line__ ";sounds after close-sound #t: ~A" (sounds)))
;; snd chn cases
(letrec ((test-channel-func-1
@@ -44363,30 +44430,30 @@ EDITS: 1
(old-2-all (func ind-2 #t))
(old-all-0 (func #t 0))
(old-all-all (func #t #t)))
- (if (not (eq-func old-1-0 (car old-1-all))) (snd-display ";~A channel-func old 1/#t: ~A ~A" name old-1-0 old-1-all))
- (if (not (eq-func old-2-0 (car old-2-all))) (snd-display ";~A channel-func old 2/#t: ~A ~A" name old-2-0 old-2-all))
- (if (not (eq-func old-2-1 (cadr old-2-all))) (snd-display ";~A channel-func old 2-2/#t: ~A ~A" name old-2-1 old-2-all))
- (if (not (leq-func old-1-all (list old-1-0))) (snd-display ";~A channel-func #t list: ~A ~A" name old-1-all old-1-0))
+ (if (not (eq-func old-1-0 (car old-1-all))) (snd-display #__line__ ";~A channel-func old 1/#t: ~A ~A" name old-1-0 old-1-all))
+ (if (not (eq-func old-2-0 (car old-2-all))) (snd-display #__line__ ";~A channel-func old 2/#t: ~A ~A" name old-2-0 old-2-all))
+ (if (not (eq-func old-2-1 (cadr old-2-all))) (snd-display #__line__ ";~A channel-func old 2-2/#t: ~A ~A" name old-2-1 old-2-all))
+ (if (not (leq-func old-1-all (list old-1-0))) (snd-display #__line__ ";~A channel-func #t list: ~A ~A" name old-1-all old-1-0))
(if (not (leq-func old-2-all (list old-2-0 old-2-1)))
- (snd-display ";~A channel-func (2) #t list: ~A ~A ~A" name old-2-all old-2-0 old-2-1))
+ (snd-display #__line__ ";~A channel-func (2) #t list: ~A ~A ~A" name old-2-all old-2-0 old-2-1))
(if (not (and (or (leq-func (car old-all-all) old-1-all)
(leq-func (car old-all-all) old-2-all))
(or (leq-func (cadr old-all-all) old-1-all)
(leq-func (cadr old-all-all) old-2-all))))
- (snd-display ";~A channel-func #t #t: ~A ~A ~A" name old-all-all old-1-all old-2-all))
+ (snd-display #__line__ ";~A channel-func #t #t: ~A ~A ~A" name old-all-all old-1-all old-2-all))
(if settable
(begin
(set! (func ind-1 0) new-val)
- (if (not (eq-func (func ind-1 0) new-val)) (snd-display ";~A set channel-func: ~A ~A" name (func ind-1 0) new-val))
- (if (eq-func (func ind-2 0) new-val) (snd-display ";~A set 2 channel-func: ~A ~A" name (func ind-2 0) new-val))
+ (if (not (eq-func (func ind-1 0) new-val)) (snd-display #__line__ ";~A set channel-func: ~A ~A" name (func ind-1 0) new-val))
+ (if (eq-func (func ind-2 0) new-val) (snd-display #__line__ ";~A set 2 channel-func: ~A ~A" name (func ind-2 0) new-val))
(set! (func ind-1 0) old-1-0)
(set! (func ind-2 1) new-val)
- (if (eq-func (func ind-1 0) new-val) (snd-display ";~A set (2) channel-func: ~A ~A" name (func ind-1 0) new-val))
- (if (not (eq-func (func ind-2 1) new-val)) (snd-display ";~A set (2) 2 channel-func: ~A ~A" name (func ind-2 0) new-val))
+ (if (eq-func (func ind-1 0) new-val) (snd-display #__line__ ";~A set (2) channel-func: ~A ~A" name (func ind-1 0) new-val))
+ (if (not (eq-func (func ind-2 1) new-val)) (snd-display #__line__ ";~A set (2) 2 channel-func: ~A ~A" name (func ind-2 0) new-val))
(set! (func ind-2 0) new-val)
(set! (func ind-2 #t) old-2-0)
- (if (not (eq-func (func ind-2 0) old-2-0)) (snd-display ";~A set (#t 0) 2 channel-func: ~A ~A" name (func ind-2 0) old-2-0))
- (if (not (eq-func (func ind-2 1) old-2-0)) (snd-display ";~A set (#t 1) 2 channel-func: ~A ~A" name (func ind-2 1) old-2-0))
+ (if (not (eq-func (func ind-2 0) old-2-0)) (snd-display #__line__ ";~A set (#t 0) 2 channel-func: ~A ~A" name (func ind-2 0) old-2-0))
+ (if (not (eq-func (func ind-2 1) old-2-0)) (snd-display #__line__ ";~A set (#t 1) 2 channel-func: ~A ~A" name (func ind-2 1) old-2-0))
(set! (func ind-2 0) old-2-0)
(set! (func ind-2 1) old-2-1)))
)))
@@ -44465,7 +44532,7 @@ EDITS: 1
(close-sound #f)
(close-sound #f)
- (if (not (equal? (sounds) '())) (snd-display ";sounds after close-sound #t: ~A" (sounds))))))
+ (if (not (equal? (sounds) '())) (snd-display #__line__ ";sounds after close-sound #t: ~A" (sounds))))))
(letrec ((test-sound-func-2
(lambda (func name ind-1 ind-2 new-val eq-func leq-func)
@@ -44477,42 +44544,42 @@ EDITS: 1
(unsel-snd (if (equal? sel-snd ind-1) ind-2 ind-1)))
(if (not (or (leq-func old-vals (list old-1 old-2))
(leq-func old-vals (list old-2 old-1))))
- (snd-display ";~A sound-func #t: ~A, sep: ~A" name old-vals (list old-1 old-2)))
+ (snd-display #__line__ ";~A sound-func #t: ~A, sep: ~A" name old-vals (list old-1 old-2)))
(set! (func) new-val)
(if (not (eq-func (func) new-val))
- (snd-display ";~A global set no arg: ~A ~A" name (func) new-val))
+ (snd-display #__line__ ";~A global set no arg: ~A ~A" name (func) new-val))
(if (not (eq-func (func) (func sel-snd)))
- (snd-display ";~A global set no arg sel: ~A ~A" name (func) (func sel-snd)))
+ (snd-display #__line__ ";~A global set no arg sel: ~A ~A" name (func) (func sel-snd)))
(if (not (eq-func (func) (func unsel-snd)))
- (snd-display ";~A set global no arg unsel: ~A ~A (sel: ~A)" name (func) (func unsel-snd) (func sel-snd)))
+ (snd-display #__line__ ";~A set global no arg unsel: ~A ~A (sel: ~A)" name (func) (func unsel-snd) (func sel-snd)))
(if (not (or (leq-func (func #t) (list (func sel-snd) (func unsel-snd)))
(leq-func (func #t) (list (func unsel-snd) (func sel-snd)))))
- (snd-display ";~A func #t set: ~A, sep: ~A" name (func #t) (list (func sel-snd) (func unsel-snd))))
+ (snd-display #__line__ ";~A func #t set: ~A, sep: ~A" name (func #t) (list (func sel-snd) (func unsel-snd))))
(set! (func) old-global-val)
(set! (func ind-1) new-val)
(if (not (eq-func (func ind-1) new-val))
- (snd-display ";~A set arg: ~A ~A" name (func ind-1) new-val))
+ (snd-display #__line__ ";~A set arg: ~A ~A" name (func ind-1) new-val))
(if (eq-func (func ind-2) new-val)
- (snd-display ";~A set arg (2): ~A ~A" name (func ind-2) new-val))
+ (snd-display #__line__ ";~A set arg (2): ~A ~A" name (func ind-2) new-val))
(if (not (or (leq-func (func #t) (list (func ind-1) (func ind-2)))
(leq-func (func #t) (list (func ind-2) (func ind-1)))))
- (snd-display ";~A func arg set: ~A, sep: ~A" name (func #t) (list (func ind-1) (func ind-2))))
+ (snd-display #__line__ ";~A func arg set: ~A, sep: ~A" name (func #t) (list (func ind-1) (func ind-2))))
(set! (func ind-1) old-1)
(set! (func #t) new-val)
(if (not (leq-func (func #t) (list new-val new-val)))
- (snd-display ";~A func arg set #t: ~A, sep: ~A" name (func #t) (list new-val new-val)))
+ (snd-display #__line__ ";~A func arg set #t: ~A, sep: ~A" name (func #t) (list new-val new-val)))
(if (not (eq-func (func ind-1) new-val))
- (snd-display ";~A set arg #t: ~A ~A" name (func ind-1) new-val))
+ (snd-display #__line__ ";~A set arg #t: ~A ~A" name (func ind-1) new-val))
(if (not (eq-func (func ind-2) new-val))
- (snd-display ";~A set arg #t (2): ~A ~A" name (func ind-2) new-val))
+ (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) new-val))
(if (eq-func (func) new-val)
- (snd-display ";~A overwrote global: ~A ~A" name (func) new-val))
+ (snd-display #__line__ ";~A overwrote global: ~A ~A" name (func) new-val))
(set! (func ind-1) old-1)
(set! (func ind-2) old-2)
(if (not (eq-func (func ind-1) old-1))
- (snd-display ";~A set arg #t old: ~A ~A" name (func ind-1) old-1))
+ (snd-display #__line__ ";~A set arg #t old: ~A ~A" name (func ind-1) old-1))
(if (not (eq-func (func ind-2) old-2))
- (snd-display ";~A set arg #t (2): ~A ~A" name (func ind-2) old-2))))))
+ (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) old-2))))))
(let ((ind-1 (new-sound "test-1.snd" mus-next mus-bfloat 22050 1 "mono testing" 100))
(ind-2 (new-sound "test-2.snd" mus-aifc mus-bshort 44100 2 "stereo testing" 300)))
@@ -44594,7 +44661,7 @@ EDITS: 1
(if (or (not (transform-graph? ind 0))
(not (show-transform-peaks ind 0))
(not (show-y-zero ind 0)))
- (snd-display ";remember-sound-state: ~A ~A ~A" (transform-graph? ind 0) (show-transform-peaks ind 0) (show-y-zero ind 0)))
+ (snd-display #__line__ ";remember-sound-state: ~A ~A ~A" (transform-graph? ind 0) (show-transform-peaks ind 0) (show-y-zero ind 0)))
(close-sound ind))
(reset-almost-all-hooks)
@@ -44604,18 +44671,18 @@ EDITS: 1
(help1 (snd-apropos 'close-sound)))
(if (or (not (string? help))
(not (string? help1)))
- (snd-display ";snd-apropos: ~%~A~% ~A~%" help help1))))
+ (snd-display #__line__ ";snd-apropos: ~%~A~% ~A~%" help help1))))
(lambda args
- (snd-display ";snd-apropos trouble: ~A" args)))
+ (snd-display #__line__ ";snd-apropos trouble: ~A" args)))
- (map-sound-files (lambda (n) (if (> (mus-sound-duration n) 1000.0) (snd-display ";~A is pretty long! ~A" n (mus-sound-duration n)))))
+ (map-sound-files (lambda (n) (if (> (mus-sound-duration n) 1000.0) (snd-display #__line__ ";~A is pretty long! ~A" n (mus-sound-duration n)))))
(if (string? sf-dir)
(map-sound-files
(lambda (n)
(catch #t
(lambda ()
(if (> (mus-sound-duration (string-append sf-dir n)) 1000.0)
- (snd-display ";~A is pretty long! ~A"
+ (snd-display #__line__ ";~A is pretty long! ~A"
n
(mus-sound-duration (string-append sf-dir n)))))
(lambda args #f))
@@ -44628,77 +44695,77 @@ EDITS: 1
(env-channel-with-base '(0 0 1 1) 1.0)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 0.0 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95)))
- (snd-display ";env-chan 1.0: ~A" data)))
+ (snd-display #__line__ ";env-chan 1.0: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";env-chan 0.0: ~A" data)))
+ (snd-display #__line__ ";env-chan 0.0: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 100.0)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 0.0 0.003 0.006 0.010 0.015 0.022 0.030 0.041 0.054 0.070 0.091 0.117 0.150 0.191 0.244 0.309 0.392 0.496 0.627 0.792)))
- (snd-display ";env-chan 100.0: ~A" data)))
+ (snd-display #__line__ ";env-chan 100.0: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 0.01)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 0.0 0.208 0.373 0.504 0.608 0.691 0.756 0.809 0.850 0.883 0.909 0.930 0.946 0.959 0.970 0.978 0.985 0.990 0.994 0.997)))
- (snd-display ";env-chan 0.01: ~A" data)))
+ (snd-display #__line__ ";env-chan 0.01: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 1.0 5 10)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";env-chan 1.0 seg: ~A" data)))
+ (snd-display #__line__ ";env-chan 1.0 seg: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0 5 10)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";env-chan 0.0 seg: ~A" data)))
+ (snd-display #__line__ ";env-chan 0.0 seg: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 100.0 5 10)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.007 0.018 0.037 0.068 0.120 0.208 0.353 0.595 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";env-chan 100.0 seg: ~A" data)))
+ (snd-display #__line__ ";env-chan 100.0 seg: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 0.01 5 10)
(let ((data (channel->vct 0 20)))
(if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.405 0.647 0.792 0.880 0.932 0.963 0.982 0.993 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";env-chan 0.01 seg: ~A" data)))
+ (snd-display #__line__ ";env-chan 0.01 seg: ~A" data)))
(undo)
(close-sound snd))
-
+
(let ((ind1 (open-sound "now.snd"))
(ind2 (open-sound "oboe.snd")))
(let ((val (channel-mean ind1 0)))
- (if (fneq val 5.02560673308833e-5) (snd-display ";channel-mean: ~A" val)))
+ (if (fneq val 5.02560673308833e-5) (snd-display #__line__ ";channel-mean: ~A" val)))
(let ((val (channel-total-energy ind1 0)))
- (if (fneq val 50.7153476262465) (snd-display ";channel-total-energy: ~A" val)))
+ (if (fneq val 50.7153476262465) (snd-display #__line__ ";channel-total-energy: ~A" val)))
(let ((val (channel-average-power ind1 0)))
- (if (fneq val 0.00155078578803922) (snd-display ";channel-average-power: ~A" val)))
+ (if (fneq val 0.00155078578803922) (snd-display #__line__ ";channel-average-power: ~A" val)))
(let ((val (channel-rms ind1 0)))
- (if (fneq val 0.039380017623653) (snd-display ";channel-rms: ~A" val)))
+ (if (fneq val 0.039380017623653) (snd-display #__line__ ";channel-rms: ~A" val)))
(let ((val (channel-norm ind1 0)))
- (if (fneq val 7.12147088923675) (snd-display ";channel-norm: ~A" val)))
+ (if (fneq val 7.12147088923675) (snd-display #__line__ ";channel-norm: ~A" val)))
(let ((val (channel-variance ind1 0)))
- (if (fneq val 50.7153476237207) (snd-display ";channel-variance: ~A" val)))
+ (if (fneq val 50.7153476237207) (snd-display #__line__ ";channel-variance: ~A" val)))
(let ((val (channel-lp 2 ind1 0)))
- (if (fneq val 7.12147088923675) (snd-display ";channel-lp 2: ~A" val)))
+ (if (fneq val 7.12147088923675) (snd-display #__line__ ";channel-lp 2: ~A" val)))
(let ((val (channel-lp 1 ind1 0)))
- (if (fneq val 775.966033935547) (snd-display ";channel-lp 1: ~A" val)))
+ (if (fneq val 775.966033935547) (snd-display #__line__ ";channel-lp 1: ~A" val)))
(let ((val (channel2-inner-product ind1 0 ind2 0)))
- (if (fneq val 1.52892031334341) (snd-display ";channel2-inner-product: ~A" val)))
+ (if (fneq val 1.52892031334341) (snd-display #__line__ ";channel2-inner-product: ~A" val)))
(let ((val (channel2-angle ind1 0 ind2 0)))
- (if (fneq val 1.55485084385627) (snd-display ";channel2-angle: ~A" val)))
+ (if (fneq val 1.55485084385627) (snd-display #__line__ ";channel2-angle: ~A" val)))
(let ((val (channel2-orthogonal? ind1 0 ind2 0)))
- (if val (snd-display ";channel2-orthogonal: ~A" val)))
+ (if val (snd-display #__line__ ";channel2-orthogonal: ~A" val)))
(let ((val (channel2-coefficient-of-projection ind1 0 ind2 0)))
- (if (fneq val 0.0301470932351876) (snd-display ";channel2-coefficient-of-projection: ~A" val)))
+ (if (fneq val 0.0301470932351876) (snd-display #__line__ ";channel2-coefficient-of-projection: ~A" val)))
(close-sound ind1)
(set! ind1 (open-sound "oboe.snd"))
(scale-by .99 ind1 0)
(let ((dist (channel-distance ind1 0 ind2 0)))
- (if (fneq dist .1346) (snd-display ";channel-distance: ~A" dist)))
+ (if (fneq dist .1346) (snd-display #__line__ ";channel-distance: ~A" dist)))
(close-sound ind1)
(close-sound ind2))
@@ -44715,7 +44782,7 @@ EDITS: 1
(if (or (not (= (chans ind) (mus-sound-chans loboe)))
(not (= (srate ind) (mus-sound-srate loboe)))
(not (= (frames ind) (mus-sound-frames loboe))))
- (snd-display ";copy oboe -> test seems to have failed? ~A ~A ~A"
+ (snd-display #__line__ ";copy oboe -> test seems to have failed? ~A ~A ~A"
(chans ind) (srate ind) (frames ind))
(with-local-hook
update-hook
@@ -44727,15 +44794,15 @@ EDITS: 1
((= i 10))
(let ((v (channel->vct)))
(if (not (vct? v))
- (snd-display ";channel->vct of oboe copy is null??")
+ (snd-display #__line__ ";channel->vct of oboe copy is null??")
(array->file ltest v fr sr chns))
(update-sound ind)
(let ((mx1 (maxamp ind 0)))
(if (fneq mx mx1)
- (snd-display ";update-sound looped maxamp: ~A ~A ~A ~A ~A (~A)" i ind (frames ind) mx1 mx (/ mx1 mx))))
- (if (not (= (chans ind) chns)) (snd-display ";update-sound looped chans: ~A ~A" chns (chans ind)))
- (if (not (= (srate ind) sr)) (snd-display ";update-sound looped srate: ~A ~A" sr (srate ind)))
- (if (not (= (frames ind) fr)) (snd-display ";update-sound looped frames: ~A ~A" fr (frames ind 0)))))
+ (snd-display #__line__ ";update-sound looped maxamp: ~A ~A ~A ~A ~A (~A)" i ind (frames ind) mx1 mx (/ mx1 mx))))
+ (if (not (= (chans ind) chns)) (snd-display #__line__ ";update-sound looped chans: ~A ~A" chns (chans ind)))
+ (if (not (= (srate ind) sr)) (snd-display #__line__ ";update-sound looped srate: ~A ~A" sr (srate ind)))
+ (if (not (= (frames ind) fr)) (snd-display #__line__ ";update-sound looped frames: ~A ~A" fr (frames ind 0)))))
(let* ((old-ind (open-sound "oboe.snd"))
(diff 0.0)
(rd (make-sampler 0 ind 0))
@@ -44746,7 +44813,7 @@ EDITS: 1
#f))
0 fr old-ind 0)
(if (fneq diff 0.0)
- (snd-display ";update-sound looped overall max diff: ~A, sounds: ~A, ind: ~A, old-ind: ~A, rd: ~A" diff (sounds) ind old-ind home))
+ (snd-display #__line__ ";update-sound looped overall max diff: ~A, sounds: ~A, ind: ~A, old-ind: ~A, rd: ~A" diff (sounds) ind old-ind home))
(close-sound old-ind)))))
(close-sound ind)))
@@ -44764,7 +44831,7 @@ EDITS: 1
(if (> cd diff) (set! diff cd))
(set! ctr (+ 1 ctr))
#f)))
- (if (fneq diff 0.0) (snd-display ";arr->file->array overall max diff: ~A" diff))))
+ (if (fneq diff 0.0) (snd-display #__line__ ";arr->file->array overall max diff: ~A" diff))))
;; now clear sono bins if possible
(set! (colormap-size) 16)
@@ -44778,10 +44845,10 @@ EDITS: 1
(set! (zoom-focus-style) (lambda (s c z x0 x1 range)
0))
(if (not (procedure? (zoom-focus-style)))
- (snd-display ";zoom-focus-style as func: ~A" (zoom-focus-style)))
+ (snd-display #__line__ ";zoom-focus-style as func: ~A" (zoom-focus-style)))
(set! (zoom-focus-style) zoom-focus-right)
(if (not (= (zoom-focus-style) zoom-focus-right))
- (snd-display ";unset zoom-focus-style as func: ~A" (zoom-focus-style)))
+ (snd-display #__line__ ";unset zoom-focus-style as func: ~A" (zoom-focus-style)))
(close-sound ind))
(if (file-exists? "test.snd") (delete-file "test.snd"))
@@ -44814,7 +44881,7 @@ EDITS: 1
(if (> cd diff) (begin (set! diff cd) (display (format #f ";~A: ~A ~A ~A" ctr diff y yy))))
(set! ctr (+ 1 ctr))
#f)))
- (if (fneq diff 0.0) (snd-display ";file->sample->file overall max diff: ~A" diff))
+ (if (fneq diff 0.0) (snd-display #__line__ ";file->sample->file overall max diff: ~A" diff))
(close-sound ind1)))
(let* ((ind (open-sound "1a.snd"))
@@ -44827,7 +44894,7 @@ EDITS: 1
(if (fneq (/ (maxamp) mx) 2.0)
(if (and (not (eq? name 'set-samples))
(not (eq? name 'coroutines)))
- (snd-display ";silly scalers: ~A ~A" name (/ (maxamp) mx))))
+ (snd-display #__line__ ";silly scalers: ~A ~A" name (/ (maxamp) mx))))
(revert-sound)))
(list
(list 'scale-by (lambda () (scale-by 2.0)))
@@ -44859,7 +44926,7 @@ EDITS: 1
(read-sample sf)))))))))
(list 'fft (lambda ()
(let* ((len (frames))
- (fsize (expt 2 (inexact->exact (ceiling (/ (log len) (log 2))))))
+ (fsize (expt 2 (ceiling (/ (log len) (log 2)))))
(rl (channel->vct 0 fsize))
(im (make-vct fsize)))
(mus-fft rl im fsize)
@@ -44894,54 +44961,54 @@ EDITS: 1
;; frame.scm functions
(let ((tag (catch #t (lambda () (frame-reverse! 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";frame-reverse! bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame-reverse! bad arg: ~A" tag)))
(let ((tag (catch #t (lambda () (frame-copy 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";frame-copy bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame-copy bad arg: ~A" tag)))
(let ((fr1 (make-frame 3 .1 .2 .3)))
(let ((val (frame-copy fr1)))
(if (or (fneq (frame-ref val 0) 0.1)
(fneq (frame-ref val 1) 0.2)
(fneq (frame-ref val 2) 0.3))
- (snd-display ";frame-copy: ~A" val))
- (if (not (equal? val fr1)) (snd-display ";frames not equal after copy?"))
+ (snd-display #__line__ ";frame-copy: ~A" val))
+ (if (not (equal? val fr1)) (snd-display #__line__ ";frames not equal after copy?"))
(frame-set! val 0 0.0)
(if (or (fneq (frame-ref val 0) 0.0)
(fneq (frame-ref fr1 0) 0.1))
- (snd-display ";set of copied frame: ~A ~A" fr1 val))
+ (snd-display #__line__ ";set of copied frame: ~A ~A" fr1 val))
(frame-reverse! val)
(if (or (fneq (frame-ref val 0) 0.3)
(fneq (frame-ref val 1) 0.2)
(fneq (frame-ref val 2) 0.0))
- (snd-display ";frame-reverse: ~A" val))
- (if (equal? fr1 val) (snd-display ";these frames are equal??: ~A ~A" fr1 val))))
+ (snd-display #__line__ ";frame-reverse: ~A" val))
+ (if (equal? fr1 val) (snd-display #__line__ ";these frames are equal??: ~A ~A" fr1 val))))
(let ((tag (catch #t (lambda () (vct->frame 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";vct->frame bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";vct->frame bad arg: ~A" tag)))
(let ((tag (catch #t (lambda () (frame->vct 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";frame->vct bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame->vct bad arg: ~A" tag)))
(let ((fr1 (make-frame 4 .1 .2 .3 .4))
(vc1 (vct .1 .2 .3 .4)))
(let ((fr2 (vct->frame vc1))
(vc2 (frame->vct fr1)))
- (if (not (equal? vc1 vc2)) (snd-display ";frame->vct: ~A ~A" vc1 vc2))
- (if (not (equal? fr1 fr2)) (snd-display ";vct->frame: ~A ~A" fr1 fr2))
+ (if (not (equal? vc1 vc2)) (snd-display #__line__ ";frame->vct: ~A ~A" vc1 vc2))
+ (if (not (equal? fr1 fr2)) (snd-display #__line__ ";vct->frame: ~A ~A" fr1 fr2))
(vct-set! vc2 0 0.0)
(frame-set! fr2 0 0.0)
- (if (equal? vc1 vc2) (snd-display ";frame->vct + change: ~A ~A" vc1 vc2))
- (if (equal? fr1 fr2) (snd-display ";vct->frame + change: ~A ~A" fr1 fr2))
+ (if (equal? vc1 vc2) (snd-display #__line__ ";frame->vct + change: ~A ~A" vc1 vc2))
+ (if (equal? fr1 fr2) (snd-display #__line__ ";vct->frame + change: ~A ~A" fr1 fr2))
(let ((vc3 (make-vct 10))
(fr3 (make-frame 10)))
(let ((vc4 (frame->vct fr1 vc3))
(fr4 (vct->frame vc1 fr3)))
- (if (not (equal? vc3 vc4)) (snd-display ";frame->vct + v: ~A ~A" vc3 vc4))
- (if (not (equal? fr3 fr4)) (snd-display ";vct->frame + fr: ~A ~A" fr3 fr4))
+ (if (not (equal? vc3 vc4)) (snd-display #__line__ ";frame->vct + v: ~A ~A" vc3 vc4))
+ (if (not (equal? fr3 fr4)) (snd-display #__line__ ";vct->frame + fr: ~A ~A" fr3 fr4))
(if (not (vequal vc3 (vct .1 .2 .3 .4 0 0 0 0 0 0)))
- (snd-display ";frame->vct results: ~A -> ~A" fr1 vc3))
+ (snd-display #__line__ ";frame->vct results: ~A -> ~A" fr1 vc3))
(if (not (equal? fr3 (make-frame 10 .1 .2 .3 .4 0 0 0 0 0 0)))
- (snd-display ";vct->frame results: ~A -> ~A" vc1 fr3))))))
+ (snd-display #__line__ ";vct->frame results: ~A -> ~A" vc1 fr3))))))
(let ((fr1 (make-frame 2 .1 .2))
(sd1 (make-sound-data 2 5)))
@@ -44950,19 +45017,19 @@ EDITS: 1
(vc2 (sound-data->vct sd1 1)))
(if (or (not (vequal vc1 (vct 0 0 0 .1 0)))
(not (vequal vc2 (vct 0 0 0 .2 0))))
- (snd-display ";frame->sound-data: ~A ~A ~A)" sd1 vc1 vc2)))
+ (snd-display #__line__ ";frame->sound-data: ~A ~A ~A)" sd1 vc1 vc2)))
(let ((fr2 (make-frame 2)))
(sound-data->frame sd1 3 fr2)
- (if (not (equal? fr1 fr2)) (snd-display ";sound-data->frame: ~A ~A" fr1 fr2))
+ (if (not (equal? fr1 fr2)) (snd-display #__line__ ";sound-data->frame: ~A ~A" fr1 fr2))
(let ((tag (catch #t (lambda () (sound-data->frame sd1 0 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";sound-data->frame bad frame arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->frame bad frame arg: ~A" tag)))
(let ((tag (catch #t (lambda () (sound-data->frame 32 0 fr1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";sound-data->frame bad sound-data arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->frame bad sound-data arg: ~A" tag)))
(let ((tag (catch #t (lambda () (frame->sound-data fr1 32 0)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";frame->sound-data bad sound-data arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame->sound-data bad sound-data arg: ~A" tag)))
(let ((tag (catch #t (lambda () (frame->sound-data 32 sd1 0)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";frame->sound-data bad frame arg: ~A" tag)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame->sound-data bad frame arg: ~A" tag)))))
(let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 2 "frame->sound test" 100)))
(set! (sample 4 index 0) 0.5)
@@ -44971,18 +45038,18 @@ EDITS: 1
(let ((fr1 (sound->frame 1))
(fr4 (sound->frame 4 index))
(fr6 (sound->frame 6 index)))
- (if (not (equal? fr1 (make-frame 2 0.0 0.0))) (snd-display ";sound->frame 1: ~A" fr1))
- (if (not (equal? fr4 (make-frame 2 0.5 0.25))) (snd-display ";sound->frame 4: ~A" fr4))
- (if (not (equal? fr6 (make-frame 2 0.0 1.0))) (snd-display ";sound->frame 6: ~A" fr6))
+ (if (not (equal? fr1 (make-frame 2 0.0 0.0))) (snd-display #__line__ ";sound->frame 1: ~A" fr1))
+ (if (not (equal? fr4 (make-frame 2 0.5 0.25))) (snd-display #__line__ ";sound->frame 4: ~A" fr4))
+ (if (not (equal? fr6 (make-frame 2 0.0 1.0))) (snd-display #__line__ ";sound->frame 6: ~A" fr6))
(frame->sound fr4 8 index)
(frame->sound fr1 4)
(frame->sound fr6 0 index)
(let ((fr0 (sound->frame 0))
(fr41 (sound->frame 4 index))
(fr8 (sound->frame 8 index)))
- (if (not (equal? fr0 fr6)) (snd-display ";sound->frame 0: ~A" fr0))
- (if (not (equal? fr41 fr1)) (snd-display ";sound->frame 41: ~A" fr41))
- (if (not (equal? fr8 fr4)) (snd-display ";sound->frame 8: ~A" fr8))))
+ (if (not (equal? fr0 fr6)) (snd-display #__line__ ";sound->frame 0: ~A" fr0))
+ (if (not (equal? fr41 fr1)) (snd-display #__line__ ";sound->frame 41: ~A" fr41))
+ (if (not (equal? fr8 fr4)) (snd-display #__line__ ";sound->frame 8: ~A" fr8))))
(set! (sample 40 index 0) 0.5)
(set! (sample 40 index 1) 0.3)
(set! (sample 41 index 0) 0.7)
@@ -44990,37 +45057,37 @@ EDITS: 1
(let ((fr0 (region->frame reg 0))
(fr1 (region->frame reg 1))
(fr4 (region->frame reg 4)))
- (if (not (equal? fr0 (make-frame 2 0.5 0.3))) (snd-display ";region->frame 0: ~A" fr0))
- (if (not (equal? fr1 (make-frame 2 0.7 0.0))) (snd-display ";region->frame 1: ~A" fr1))
- (if (not (equal? fr4 (make-frame 2 0.0 0.0))) (snd-display ";region->frame 4: ~A" fr4))))
+ (if (not (equal? fr0 (make-frame 2 0.5 0.3))) (snd-display #__line__ ";region->frame 0: ~A" fr0))
+ (if (not (equal? fr1 (make-frame 2 0.7 0.0))) (snd-display #__line__ ";region->frame 1: ~A" fr1))
+ (if (not (equal? fr4 (make-frame 2 0.0 0.0))) (snd-display #__line__ ";region->frame 4: ~A" fr4))))
(close-sound index))
(let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 1 "frame->sound test" 100)))
(set! (sample 4 index 0) 0.5)
(let ((fr1 (sound->frame 1))
(fr4 (sound->frame 4 index)))
- (if (not (equal? fr1 (make-frame 1 0.0))) (snd-display ";sound->frame 1 1: ~A" fr1))
- (if (not (equal? fr4 (make-frame 1 0.5))) (snd-display ";sound->frame 1 4: ~A" fr4))
+ (if (not (equal? fr1 (make-frame 1 0.0))) (snd-display #__line__ ";sound->frame 1 1: ~A" fr1))
+ (if (not (equal? fr4 (make-frame 1 0.5))) (snd-display #__line__ ";sound->frame 1 4: ~A" fr4))
(frame->sound (make-frame 4 .1 .2 .3 .4) 8 index)
(let ((fr8 (sound->frame 8 index)))
- (if (not (equal? fr8 (make-frame 1 .1))) (snd-display ";sound->frame 1 8: ~A" fr8))))
+ (if (not (equal? fr8 (make-frame 1 .1))) (snd-display #__line__ ";sound->frame 1 8: ~A" fr8))))
(close-sound index))
(let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 1 "frame->sound test" 10)))
(set! (sample 4 index 0) 0.5)
(let ((sd1 (sound->sound-data 0 10 index))
(sd2 (sound->sound-data 10 2)))
- (if (not (equal? sd2 (make-sound-data 1 2))) (snd-display ";sound->sound-data 2: ~A" sd2))
+ (if (not (equal? sd2 (make-sound-data 1 2))) (snd-display #__line__ ";sound->sound-data 2: ~A" sd2))
(if (not (vequal (sound-data->vct sd1 0) (vct 0 0 0 0 0.5 0 0 0 0 0)))
- (snd-display ";sound->sound-data 10: ~A" sd1))
+ (snd-display #__line__ ";sound->sound-data 10: ~A" sd1))
(sound-data-set! sd1 0 0 0.7)
(sound-data->sound sd1 0 10 index)
(if (not (vequal (channel->vct 0 10 index 0) (vct 0.7 0 0 0 0.5 0 0 0 0 0)))
- (snd-display ";sound-data->sound 1: ~A" sd1))
+ (snd-display #__line__ ";sound-data->sound 1: ~A" sd1))
(let ((tag (catch #t (lambda () (sound-data->sound 32 0)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";sound-data->sound bad sound-data arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->sound bad sound-data arg: ~A" tag)))
(let ((tag (catch #t (lambda () (sound-data->sound sd1 0 10 -1)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sound)) (snd-display ";sound-data->sound bad sound arg: ~A" tag)))
+ (if (not (eq? tag 'no-such-sound)) (snd-display #__line__ ";sound-data->sound bad sound arg: ~A" tag)))
(close-sound index)))
(let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 4 "frame->sound test" 10)))
@@ -45030,57 +45097,57 @@ EDITS: 1
(set! (sample 4 index 3) 0.2)
(let ((sd1 (sound->sound-data 0 10 index))
(sd2 (sound->sound-data 10 2)))
- (if (not (equal? sd2 (make-sound-data 4 2))) (snd-display ";sound->sound-data 4 2: ~A" sd2))
+ (if (not (equal? sd2 (make-sound-data 4 2))) (snd-display #__line__ ";sound->sound-data 4 2: ~A" sd2))
(if (not (vequal (sound-data->vct sd1 0) (vct 0 0 0 0 0.5 0 0 0 0 0)))
- (snd-display ";sound->sound-data 4a 10: ~A" (sound-data->vct sd1 0)))
+ (snd-display #__line__ ";sound->sound-data 4a 10: ~A" (sound-data->vct sd1 0)))
(if (not (vequal (sound-data->vct sd1 1) (vct 0 0 0 0 0.4 0 0 0 0 0)))
- (snd-display ";sound->sound-data 4b 10: ~A" (sound-data->vct sd1 1)))
+ (snd-display #__line__ ";sound->sound-data 4b 10: ~A" (sound-data->vct sd1 1)))
(if (not (vequal (sound-data->vct sd1 2) (vct 0 0 0 0 0.3 0 0 0 0 0)))
- (snd-display ";sound->sound-data 4c 10: ~A" (sound-data->vct sd1 2)))
+ (snd-display #__line__ ";sound->sound-data 4c 10: ~A" (sound-data->vct sd1 2)))
(if (not (vequal (sound-data->vct sd1 3) (vct 0 0 0 0 0.2 0 0 0 0 0)))
- (snd-display ";sound->sound-data 4d 10: ~A" (sound-data->vct sd1 3)))
+ (snd-display #__line__ ";sound->sound-data 4d 10: ~A" (sound-data->vct sd1 3)))
(sound-data-set! sd1 0 0 0.7)
(sound-data-set! sd1 1 0 0.8)
(sound-data-set! sd1 2 0 0.9)
(sound-data-set! sd1 3 0 0.6)
(sound-data->sound sd1 0)
(if (not (vequal (channel->vct 0 10 index 0) (vct 0.7 0 0 0 0.5 0 0 0 0 0)))
- (snd-display ";sound-data->sound 1 4a: ~A" (sound-data->vct sd1 0)))
+ (snd-display #__line__ ";sound-data->sound 1 4a: ~A" (sound-data->vct sd1 0)))
(if (not (vequal (channel->vct 0 10 index 1) (vct 0.8 0 0 0 0.4 0 0 0 0 0)))
- (snd-display ";sound-data->sound 1 4b: ~A" (sound-data->vct sd1 1)))
+ (snd-display #__line__ ";sound-data->sound 1 4b: ~A" (sound-data->vct sd1 1)))
(if (not (vequal (channel->vct 0 10 index 2) (vct 0.9 0 0 0 0.3 0 0 0 0 0)))
- (snd-display ";sound-data->sound 1 4c: ~A" (sound-data->vct sd1 2)))
+ (snd-display #__line__ ";sound-data->sound 1 4c: ~A" (sound-data->vct sd1 2)))
(if (not (vequal (channel->vct 0 10 index 3) (vct 0.6 0 0 0 0.2 0 0 0 0 0)))
- (snd-display ";sound-data->sound 1 4d: ~A" (sound-data->vct sd1 3)))
+ (snd-display #__line__ ";sound-data->sound 1 4d: ~A" (sound-data->vct sd1 3)))
(close-sound index)))
(for-each
(lambda (file)
(let ((index (open-sound file)))
(let ((fd (make-frame-reader 10000)))
- (if (not (frame-reader? fd)) (snd-display ";~A: frame-reader?: ~A" file fd))
+ (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: frame-reader?: ~A" file fd))
(if (> (frames index) 10000)
(begin
- (if (frame-reader-at-end? fd) (snd-display ";~A: frame-reader-at-end?: ~A" file fd))
+ (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: frame-reader-at-end?: ~A" file fd))
(if (not (= (frame-reader-position fd) 10000))
- (snd-display ";~A: frame-reader: position: ~A ~A" fd (frame-reader-position fd) file)))
+ (snd-display #__line__ ";~A: frame-reader: position: ~A ~A" fd (frame-reader-position fd) file)))
(begin
- (if (not (frame-reader-at-end? fd)) (snd-display ";~A: not frame-reader-at-end?: ~A" file fd))
+ (if (not (frame-reader-at-end? fd)) (snd-display #__line__ ";~A: not frame-reader-at-end?: ~A" file fd))
(if (= (frame-reader-position fd) 10000)
- (snd-display ";~A: frame-reader: position but frames: ~A ~A ~A" file fd (frame-reader-position fd) (frames index)))))
+ (snd-display #__line__ ";~A: frame-reader: position but frames: ~A ~A ~A" file fd (frame-reader-position fd) (frames index)))))
(if (not (equal? (frame-reader-home fd) index))
- (snd-display ";~A: frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
+ (snd-display #__line__ ";~A: frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
(if (not (= (frame-reader-chans fd) (chans index)))
- (snd-display ";frame-reader-chans: ~A ~A" (frame-reader-chans fd) (chans index)))
+ (snd-display #__line__ ";frame-reader-chans: ~A ~A" (frame-reader-chans fd) (chans index)))
(let ((fr0 (frame-copy (read-frame fd)))
(fr1 (frame-copy (next-frame fd)))
(fr2 (frame-copy (previous-frame fd))))
(if (not (equal? fr0 (sound->frame 10000 index)))
- (snd-display ";~A: frame reader 10000: ~A ~A" file fr0 (sound->frame 10000 index)))
+ (snd-display #__line__ ";~A: frame reader 10000: ~A ~A" file fr0 (sound->frame 10000 index)))
(if (not (equal? fr1 (sound->frame 10001 index)))
- (snd-display ";~A: frame reader 10001: ~A ~A" file fr1 (sound->frame 10001 index)))
+ (snd-display #__line__ ";~A: frame reader 10001: ~A ~A" file fr1 (sound->frame 10001 index)))
(if (not (equal? fr2 (sound->frame 10001 index)))
- (snd-display ";~A: frame reader 10001 prev: ~A ~A" file fr2 (sound->frame 10001 index))))
+ (snd-display #__line__ ";~A: frame reader 10001 prev: ~A ~A" file fr2 (sound->frame 10001 index))))
(free-frame-reader fd))
(close-sound index)))
(list "oboe.snd" "4.aiff" "2.snd" "2a.snd")) ; 2a=eof
@@ -45089,27 +45156,27 @@ EDITS: 1
(lambda (file)
(let ((index (open-sound file)))
(let ((fd (make-sampler 10000)))
- (if (not (sampler? fd)) (snd-display ";~A: sampler?: ~A" file fd))
+ (if (not (sampler? fd)) (snd-display #__line__ ";~A: sampler?: ~A" file fd))
(if (> (frames index) 10000)
(begin
- (if (sampler-at-end? fd) (snd-display ";~A: sampler-at-end?: ~A" file fd))
+ (if (sampler-at-end? fd) (snd-display #__line__ ";~A: sampler-at-end?: ~A" file fd))
(if (not (= (sampler-position fd) 10000))
- (snd-display ";~A: sampler: position: ~A ~A" fd (sampler-position file fd))))
+ (snd-display #__line__ ";~A: sampler: position: ~A ~A" fd (sampler-position file fd))))
(begin
- (if (not (sampler-at-end? fd)) (snd-display ";~A: not sampler-at-end?: ~A" file fd))
+ (if (not (sampler-at-end? fd)) (snd-display #__line__ ";~A: not sampler-at-end?: ~A" file fd))
(if (= (sampler-position fd) 10000)
- (snd-display ";~A: sampler: position but samples: ~A ~A ~A" file fd (sampler-position fd) (frames index)))))
+ (snd-display #__line__ ";~A: sampler: position but samples: ~A ~A ~A" file fd (sampler-position fd) (frames index)))))
(if (not (equal? (sampler-home fd) (list index 0)))
- (snd-display ";~A: sampler: home: ~A ~A ~A" file fd (sampler-home fd) index))
+ (snd-display #__line__ ";~A: sampler: home: ~A ~A ~A" file fd (sampler-home fd) index))
(let ((fr0 (read-sample fd))
(fr1 (next-sample fd))
(fr2 (previous-sample fd)))
(if (fneq fr0 (sample 10000 index))
- (snd-display ";~A: sample reader 10000: ~A ~A" file fr0 (sample 10000 index)))
+ (snd-display #__line__ ";~A: sample reader 10000: ~A ~A" file fr0 (sample 10000 index)))
(if (fneq fr1 (sample 10001 index))
- (snd-display ";~A: sample reader 10001: ~A ~A" file fr1 (sample 10001 index)))
+ (snd-display #__line__ ";~A: sample reader 10001: ~A ~A" file fr1 (sample 10001 index)))
(if (fneq fr2 (sample 10001 index))
- (snd-display ";~A: sample reader 10001 prev: ~A ~A" file fr2 (sample 10001 index))))
+ (snd-display #__line__ ";~A: sample reader 10001 prev: ~A ~A" file fr2 (sample 10001 index))))
(free-sampler fd))
(close-sound index)))
(list "oboe.snd" "4.aiff" "2.snd" "2a.snd" "z.snd")) ; 2a=eof
@@ -45123,29 +45190,29 @@ EDITS: 1
(set! (sync index) 1) ; select-all follows sync field
(let* ((reg (select-all))
(fd (make-region-frame-reader reg 10000)))
- (if (not (frame-reader? fd)) (snd-display ";~A: region frame-reader?: ~A" file fd))
+ (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: region frame-reader?: ~A" file fd))
(if (> (frames index) 10000)
(begin
- (if (frame-reader-at-end? fd) (snd-display ";~A: region frame-reader-at-end?: ~A" file fd))
+ (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: region frame-reader-at-end?: ~A" file fd))
(if (not (= (frame-reader-position fd) 10000))
- (snd-display ";~A: region frame-reader: position: ~A ~A" fd (frame-reader-position fd) file)))
+ (snd-display #__line__ ";~A: region frame-reader: position: ~A ~A" fd (frame-reader-position fd) file)))
(begin
- (if (not (frame-reader-at-end? fd)) (snd-display ";~A: not region frame-reader-at-end?: ~A" file fd))
+ (if (not (frame-reader-at-end? fd)) (snd-display #__line__ ";~A: not region frame-reader-at-end?: ~A" file fd))
(if (= (frame-reader-position fd) 10000)
- (snd-display ";~A: region frame-reader: position but frames: ~A ~A ~A" file fd (frame-reader-position fd) (frames index)))))
+ (snd-display #__line__ ";~A: region frame-reader: position but frames: ~A ~A ~A" file fd (frame-reader-position fd) (frames index)))))
(if (not (equal? (frame-reader-home fd) reg))
- (snd-display ";~A: region frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) reg))
+ (snd-display #__line__ ";~A: region frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) reg))
(if (not (= (frame-reader-chans fd) (region-chans reg)))
- (snd-display ";region frame-reader-chans: ~A ~A" (frame-reader-chans fd) (region-chans reg)))
+ (snd-display #__line__ ";region frame-reader-chans: ~A ~A" (frame-reader-chans fd) (region-chans reg)))
(let ((fr0 (frame-copy (read-frame fd)))
(fr1 (frame-copy (next-frame fd)))
(fr2 (frame-copy (previous-frame fd))))
(if (not (equal? fr0 (sound->frame 10000 index)))
- (snd-display ";~A: region frame reader 10000: ~A ~A" file fr0 (sound->frame 10000 index)))
+ (snd-display #__line__ ";~A: region frame reader 10000: ~A ~A" file fr0 (sound->frame 10000 index)))
(if (not (equal? fr1 (sound->frame 10001 index)))
- (snd-display ";~A: region frame reader 10001: ~A ~A" file fr1 (sound->frame 10001 index)))
+ (snd-display #__line__ ";~A: region frame reader 10001: ~A ~A" file fr1 (sound->frame 10001 index)))
(if (not (equal? fr2 (sound->frame 10001 index)))
- (snd-display ";~A: region frame reader 10001 prev: ~A ~A" file fr2 (sound->frame 10001 index))))
+ (snd-display #__line__ ";~A: region frame reader 10001 prev: ~A ~A" file fr2 (sound->frame 10001 index))))
(free-frame-reader fd))
(close-sound index)))
(list "oboe.snd" "4.aiff" "2.snd" "2a.snd")) ; 2a=eof
@@ -45156,48 +45223,48 @@ EDITS: 1
(ind2 (open-sound "2a.snd"))
(data2 (file->vct "2a.snd")))
(if (not (equal? data1 (channel->vct 0 #f ind1 0)))
- (snd-display ";file->vct 1a.snd"))
+ (snd-display #__line__ ";file->vct 1a.snd"))
(if (not (equal? data2 (channel->vct 0 #f ind2 0)))
- (snd-display ";file->vct 2a.snd"))
+ (snd-display #__line__ ";file->vct 2a.snd"))
(vct->file data1 "tmp.snd")
(let ((ind3 (open-sound "tmp.snd")))
(if (not (equal? data1 (channel->vct 0 #f ind3 0)))
- (snd-display ";vct->file 1a"))
+ (snd-display #__line__ ";vct->file 1a"))
(close-sound ind3))
(mus-sound-forget "tmp.snd")
(vct->file data2 "tmp.snd" 44100 "this is a comment")
(let ((ind3 (open-sound "tmp.snd")))
(if (not (string=? (comment ind3) "this is a comment"))
- (snd-display ";vct->file comment: ~A" (comment ind3)))
+ (snd-display #__line__ ";vct->file comment: ~A" (comment ind3)))
(if (not (= (srate ind3) 44100))
- (snd-display ";vct->file srate: ~A" (srate ind3)))
+ (snd-display #__line__ ";vct->file srate: ~A" (srate ind3)))
(close-sound ind3))
(mus-sound-forget "tmp.snd")
(let ((tag (catch #t (lambda () (vct->file 32 "tmp.snd")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";vct->file bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";vct->file bad arg: ~A" tag)))
(let ((sdata1 (file->sound-data "1a.snd"))
(sdata2 (file->sound-data "2a.snd")))
(if (not (equal? sdata1 (sound->sound-data 0 #f ind1)))
- (snd-display ";sfile->sound-data 1a.snd"))
+ (snd-display #__line__ ";sfile->sound-data 1a.snd"))
(if (not (equal? sdata2 (sound->sound-data 0 #f ind2)))
- (snd-display ";file->sound-data 2a.snd"))
+ (snd-display #__line__ ";file->sound-data 2a.snd"))
(sound-data->file sdata1 "tmp.snd")
(let ((ind3 (open-sound "tmp.snd")))
(if (not (equal? sdata1 (sound->sound-data 0 #f ind3)))
- (snd-display ";sound-data->file 1a"))
+ (snd-display #__line__ ";sound-data->file 1a"))
(close-sound ind3))
(mus-sound-forget "tmp.snd")
(sound-data->file sdata2 "tmp.snd" 44100 "another comment")
(let ((ind3 (open-sound "tmp.snd")))
(if (not (string=? (comment ind3) "another comment"))
- (snd-display ";sound-data->file comment: ~A" (comment ind3)))
+ (snd-display #__line__ ";sound-data->file comment: ~A" (comment ind3)))
(if (not (= (srate ind3) 44100))
- (snd-display ";sound-data->file srate: ~A" (srate ind3)))
+ (snd-display #__line__ ";sound-data->file srate: ~A" (srate ind3)))
(close-sound ind3))
(mus-sound-forget "tmp.snd")
(let ((tag (catch #t (lambda () (sound-data->file 32 "tmp.snd")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";sound-data->file bad arg: ~A" tag))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->file bad arg: ~A" tag))))
(close-sound ind1)
(close-sound ind2))
@@ -45213,16 +45280,16 @@ EDITS: 1
(len (region-frames reg))
(reg-v (region->vct reg 0 len 0)))
(if (not (vequal reg-v (sound-data->vct reg-sd 0)))
- (snd-display ";region->sound-data ~A 0 differs" file))
+ (snd-display #__line__ ";region->sound-data ~A 0 differs" file))
(if (not (vequal reg-v (channel->vct 0 len index 0)))
- (snd-display ";region->sound-data ~A original 0 differs" file))
+ (snd-display #__line__ ";region->sound-data ~A original 0 differs" file))
(if (> (chans index) 1)
(begin
(set! reg-v (region->vct reg 0 len 1 reg-v))
(if (not (vequal reg-v (sound-data->vct reg-sd 1)))
- (snd-display ";region->sound-data ~A 1 differs" file))
+ (snd-display #__line__ ";region->sound-data ~A 1 differs" file))
(if (not (vequal reg-v (channel->vct 0 len index 1)))
- (snd-display ";region->sound-data ~A original 1 differs" file)))))
+ (snd-display #__line__ ";region->sound-data ~A original 1 differs" file)))))
(close-sound index)))
(list "oboe.snd" "1a.snd" "2a.snd"))
(set! (selection-creates-region) old-create))
@@ -45233,30 +45300,30 @@ EDITS: 1
(lambda (file)
(let ((index (open-sound file)))
(set! (selected-sound) index)
- (if (not (= (sync index) 0)) (snd-display ";~A sync before sync-all: ~A" file (sync index)))
+ (if (not (= (sync index) 0)) (snd-display #__line__ ";~A sync before sync-all: ~A" file (sync index)))
(sync-all)
(for-each
(lambda (snd)
(if (not (sync snd))
- (snd-display ";sync-all did not set ~A's sync" file)
+ (snd-display #__line__ ";sync-all did not set ~A's sync" file)
(if (member (sync index) previous-syncs)
- (snd-display ";sync-all not new? ~A ~A" (sync index) previous-syncs))))
+ (snd-display #__line__ ";sync-all not new? ~A ~A" (sync index) previous-syncs))))
(sounds))
(let ((current-syncs (map sync (sounds))))
(if (and (> (length current-syncs) 1)
(not (apply = current-syncs)))
- (snd-display ";sync-all not the same? ~A" current-syncs))
+ (snd-display #__line__ ";sync-all not the same? ~A" current-syncs))
(set! previous-syncs (cons (sync index) previous-syncs)))
(set! total-chans (+ total-chans (chans index)))
(let* ((fd (make-sync-frame-reader 10000)))
- (if (not (frame-reader? fd)) (snd-display ";~A: sync frame-reader?: ~A" file fd))
- (if (frame-reader-at-end? fd) (snd-display ";~A: sync frame-reader-at-end?: ~A" file fd))
+ (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: sync frame-reader?: ~A" file fd))
+ (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: sync frame-reader-at-end?: ~A" file fd))
(if (not (= (frame-reader-position fd) 10000))
- (snd-display ";~A: sync frame-reader: position: ~A ~A" fd (frame-reader-position fd) file))
+ (snd-display #__line__ ";~A: sync frame-reader: position: ~A ~A" fd (frame-reader-position fd) file))
(if (not (equal? (frame-reader-home fd) index))
- (snd-display ";~A: sync frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
+ (snd-display #__line__ ";~A: sync frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
(if (not (= (frame-reader-chans fd) total-chans))
- (snd-display ";sync frame-reader-chans: ~A ~A" (frame-reader-chans fd) total-chans))
+ (snd-display #__line__ ";sync frame-reader-chans: ~A ~A" (frame-reader-chans fd) total-chans))
(let ((fr0 (frame-copy (read-frame fd)))
(fr1 (frame-copy (next-frame fd)))
(fr2 (frame-copy (previous-frame fd))))
@@ -45276,7 +45343,7 @@ EDITS: 1
(begin
(frame-set! fr0 j -100.0)
(set! got0 #t))))
- (if (not got0) (snd-display ";sync fr0 missed for ~A (~A) ~A" snd (short-file-name snd) i))
+ (if (not got0) (snd-display #__line__ ";sync fr0 missed for ~A (~A) ~A" snd (short-file-name snd) i))
(do ((j 0 (+ 1 j)))
((or got1
(= j (mus-length fr1))))
@@ -45284,7 +45351,7 @@ EDITS: 1
(begin
(frame-set! fr1 j -100.0)
(set! got1 #t))))
- (if (not got1) (snd-display ";sync fr1 missed for ~A (~A) ~A" snd (short-file-name snd) i))
+ (if (not got1) (snd-display #__line__ ";sync fr1 missed for ~A (~A) ~A" snd (short-file-name snd) i))
(do ((j 0 (+ 1 j)))
((or got2
(= j (mus-length fr2))))
@@ -45292,20 +45359,20 @@ EDITS: 1
(begin
(frame-set! fr2 j -100.0)
(set! got2 #t))))
- (if (not got2) (snd-display ";sync fr2 missed for ~A (~A) ~A" snd (short-file-name snd) i)))))
+ (if (not got2) (snd-display #__line__ ";sync fr2 missed for ~A (~A) ~A" snd (short-file-name snd) i)))))
(sounds)))
(free-frame-reader fd))
(select-all)
-
+
(let* ((fd (make-selection-frame-reader 10000)))
- (if (not (frame-reader? fd)) (snd-display ";~A: selection frame-reader?: ~A" file fd))
- (if (frame-reader-at-end? fd) (snd-display ";~A: selection frame-reader-at-end?: ~A" file fd))
+ (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: selection frame-reader?: ~A" file fd))
+ (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: selection frame-reader-at-end?: ~A" file fd))
(if (not (= (frame-reader-position fd) 10000))
- (snd-display ";~A: selection frame-reader: position: ~A ~A" fd (frame-reader-position fd) file))
+ (snd-display #__line__ ";~A: selection frame-reader: position: ~A ~A" fd (frame-reader-position fd) file))
(if (not (= (frame-reader-home fd) -1))
- (snd-display ";~A: selection frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
+ (snd-display #__line__ ";~A: selection frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
(if (not (= (frame-reader-chans fd) total-chans))
- (snd-display ";selection frame-reader-chans: ~A ~A" (frame-reader-chans fd) total-chans))
+ (snd-display #__line__ ";selection frame-reader-chans: ~A ~A" (frame-reader-chans fd) total-chans))
(let ((fr0 (frame-copy (read-frame fd)))
(fr1 (frame-copy (next-frame fd)))
(fr2 (frame-copy (previous-frame fd))))
@@ -45325,7 +45392,7 @@ EDITS: 1
(begin
(frame-set! fr0 j -100.0)
(set! got0 #t))))
- (if (not got0) (snd-display ";selection fr0 missed for ~A (~A) ~A" snd (short-file-name snd) i))
+ (if (not got0) (snd-display #__line__ ";selection fr0 missed for ~A (~A) ~A" snd (short-file-name snd) i))
(do ((j 0 (+ 1 j)))
((or got1
(= j (mus-length fr1))))
@@ -45333,7 +45400,7 @@ EDITS: 1
(begin
(frame-set! fr1 j -100.0)
(set! got1 #t))))
- (if (not got1) (snd-display ";selection fr1 missed for ~A (~A) ~A" snd (short-file-name snd) i))
+ (if (not got1) (snd-display #__line__ ";selection fr1 missed for ~A (~A) ~A" snd (short-file-name snd) i))
(do ((j 0 (+ 1 j)))
((or got2
(= j (mus-length fr2))))
@@ -45341,7 +45408,7 @@ EDITS: 1
(begin
(frame-set! fr2 j -100.0)
(set! got2 #t))))
- (if (not got2) (snd-display ";selection fr2 missed for ~A (~A) ~A" snd (short-file-name snd) i)))))
+ (if (not got2) (snd-display #__line__ ";selection fr2 missed for ~A (~A) ~A" snd (short-file-name snd) i)))))
(sounds)))
(free-frame-reader fd))))
(list "oboe.snd" "4.aiff" "2.snd"))
@@ -45352,20 +45419,20 @@ EDITS: 1
(sync-all)
(make-selection 10000 (+ 10000 9))
(if (not (selection?))
- (snd-display ";make-selection failed?")
+ (snd-display #__line__ ";make-selection failed?")
(begin
(if (not (= (selection-frames) 10))
- (snd-display ";sync-all + make-selection length: ~A" (selection-frames)))
+ (snd-display #__line__ ";sync-all + make-selection length: ~A" (selection-frames)))
(if (not (= (selection-chans) 3))
- (snd-display ";sync-all + make-selection chans: ~A" (selection-chans)))
+ (snd-display #__line__ ";sync-all + make-selection chans: ~A" (selection-chans)))
(let ((val0 (selection->sound-data)))
(if (not (sound-data? val0))
- (snd-display ";selection->sound-data 0 result: ~A" val0)
+ (snd-display #__line__ ";selection->sound-data 0 result: ~A" val0)
(begin
(if (not (= (sound-data-chans val0) 3))
- (snd-display ";selection->sound-data 0 chans: ~A" (sound-data-chans val0)))
+ (snd-display #__line__ ";selection->sound-data 0 chans: ~A" (sound-data-chans val0)))
(if (not (= (sound-data-length val0) 10))
- (snd-display ";selection->sound-data 0 length: ~A" (sound-data-length val0)))
+ (snd-display #__line__ ";selection->sound-data 0 length: ~A" (sound-data-length val0)))
(let ((o0 (channel->vct 10000 10 index0))
(t0 (channel->vct 10000 10 index1 0))
(t1 (channel->vct 10000 10 index1 1))
@@ -45373,19 +45440,19 @@ EDITS: 1
(s1 (sound-data->vct val0 1))
(s2 (sound-data->vct val0 2)))
(if (and (not (vequal o0 s0)) (not (vequal o0 s1)) (not (vequal o0 s2)))
- (snd-display ";selection->sound-data lost oboe: ~A ~A" o0 val0))
+ (snd-display #__line__ ";selection->sound-data lost oboe: ~A ~A" o0 val0))
(if (and (not (vequal t0 s0)) (not (vequal t0 s1)) (not (vequal t0 s2)))
- (snd-display ";selection->sound-data lost 2 0: ~A ~A" t0 val0))
+ (snd-display #__line__ ";selection->sound-data lost 2 0: ~A ~A" t0 val0))
(if (and (not (vequal t1 s0)) (not (vequal t1 s1)) (not (vequal t1 s2)))
- (snd-display ";selection->sound-data lost 2 1: ~A ~A" t1 val0))))))
+ (snd-display #__line__ ";selection->sound-data lost 2 1: ~A ~A" t1 val0))))))
(let ((val1 (selection->sound-data 5)))
(if (not (sound-data? val1))
- (snd-display ";selection->sound-data 1 result: ~A" val1)
+ (snd-display #__line__ ";selection->sound-data 1 result: ~A" val1)
(begin
(if (not (= (sound-data-chans val1) 3))
- (snd-display ";selection->sound-data 1 chans: ~A" (sound-data-chans val1)))
+ (snd-display #__line__ ";selection->sound-data 1 chans: ~A" (sound-data-chans val1)))
(if (not (= (sound-data-length val1) 5))
- (snd-display ";selection->sound-data 1 length: ~A" (sound-data-length val1)))
+ (snd-display #__line__ ";selection->sound-data 1 length: ~A" (sound-data-length val1)))
(let ((o0 (channel->vct 10005 5 index0))
(t0 (channel->vct 10005 5 index1 0))
(t1 (channel->vct 10005 5 index1 1))
@@ -45393,83 +45460,83 @@ EDITS: 1
(s1 (sound-data->vct val1 1))
(s2 (sound-data->vct val1 2)))
(if (and (not (vequal o0 s0)) (not (vequal o0 s1)) (not (vequal o0 s2)))
- (snd-display ";selection->sound-data 1 lost oboe: ~A ~A" o0 val1))
+ (snd-display #__line__ ";selection->sound-data 1 lost oboe: ~A ~A" o0 val1))
(if (and (not (vequal t0 s0)) (not (vequal t0 s1)) (not (vequal t0 s2)))
- (snd-display ";selection->sound-data 1 lost 2 0: ~A ~A" t0 val1))
+ (snd-display #__line__ ";selection->sound-data 1 lost 2 0: ~A ~A" t0 val1))
(if (and (not (vequal t1 s0)) (not (vequal t1 s1)) (not (vequal t1 s2)))
- (snd-display ";selection->sound-data 1 lost 2 1: ~A ~A" t1 val1))))))))
+ (snd-display #__line__ ";selection->sound-data 1 lost 2 1: ~A ~A" t1 val1))))))))
(let ((val (scan-sound
(lambda (fr)
- (if (not (= (mus-length fr) 3)) (snd-display ";with-sync scan-sound chans: ~A" (mus-length fr)))
+ (if (not (= (mus-length fr) 3)) (snd-display #__line__ ";with-sync scan-sound chans: ~A" (mus-length fr)))
(and (> (frame-ref fr 0) .01) (> (frame-ref fr 1) .01) (> (frame-ref fr 2) .01)))
0 #f #f #t)))
(if (not (equal? val (list #t 960)))
- (snd-display ";scan-sound with-sync; ~A" val)))
+ (snd-display #__line__ ";scan-sound with-sync; ~A" val)))
(close-sound index0)
(close-sound index1))
(let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "insert-* tests" 10)))
(map-channel (lambda (y) 1.0) 0 10 ind 0)
(insert-vct (make-vct 5 .1) 2)
- (if (not (= (frames ind) 15)) (snd-display ";insert-vct len: ~A" (frames ind)))
+ (if (not (= (frames ind) 15)) (snd-display #__line__ ";insert-vct len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
- (snd-display ";insert-vct vals: ~A" vals)))
+ (snd-display #__line__ ";insert-vct vals: ~A" vals)))
(let ((tag (catch #t (lambda () (insert-vct 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";insert-vct bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";insert-vct bad arg: ~A" tag)))
(insert-vct (make-vct 1 1.5) 0 1 ind 0)
- (if (not (= (frames ind) 16)) (snd-display ";insert-vct 1 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 16)) (snd-display #__line__ ";insert-vct 1 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
- (snd-display ";insert-vct 1 vals: ~A" vals)))
+ (snd-display #__line__ ";insert-vct 1 vals: ~A" vals)))
(let ((tag (catch #t (lambda () (insert-frame 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";insert-frame bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";insert-frame bad arg: ~A" tag)))
(insert-frame (make-frame 1 .3))
- (if (not (= (frames ind) 17)) (snd-display ";insert-frame len: ~A" (frames ind)))
+ (if (not (= (frames ind) 17)) (snd-display #__line__ ";insert-frame len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
- (snd-display ";insert-frame vals: ~A" vals)))
+ (snd-display #__line__ ";insert-frame vals: ~A" vals)))
(insert-frame (make-frame 1 .4) 20 ind)
- (if (not (= (frames ind) 21)) (snd-display ";insert-frame 1 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 21)) (snd-display #__line__ ";insert-frame 1 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display ";insert-frame 1 vals: ~A" vals)))
+ (snd-display #__line__ ";insert-frame 1 vals: ~A" vals)))
(insert-frame (make-frame 1 .2) 10)
- (if (not (= (frames ind) 22)) (snd-display ";insert-frame 2 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 22)) (snd-display #__line__ ";insert-frame 2 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 .2 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display ";insert-frame 2 vals: ~A" vals)))
+ (snd-display #__line__ ";insert-frame 2 vals: ~A" vals)))
(let ((tag (catch #t (lambda () (insert-sound-data 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";insert-sound-data bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";insert-sound-data bad arg: ~A" tag)))
(let ((sd (make-sound-data 1 3)))
(sound-data-set! sd 0 0 .23)
(sound-data-set! sd 0 1 .24)
(sound-data-set! sd 0 2 .25)
(insert-sound-data sd 10)
- (if (not (= (frames ind) 25)) (snd-display ";insert-sound-data len: ~A" (frames ind)))
+ (if (not (= (frames ind) 25)) (snd-display #__line__ ";insert-sound-data len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 .23 .24 .25 .2 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display ";insert-sound-data vals: ~A" vals)))
+ (snd-display #__line__ ";insert-sound-data vals: ~A" vals)))
(insert-sound-data sd)
- (if (not (= (frames ind) 28)) (snd-display ";insert-sound-data 1 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 28)) (snd-display #__line__ ";insert-sound-data 1 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct .23 .24 .25 .3 1.5 1 1 .1 .1 .1 .1 .1 1 .23 .24 .25 .2 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display ";insert-sound-data 1 vals: ~A" vals)))
+ (snd-display #__line__ ";insert-sound-data 1 vals: ~A" vals)))
(insert-sound-data sd 30 2 ind)
- (if (not (= (frames ind) 32)) (snd-display ";insert-sound-data 2 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 32)) (snd-display #__line__ ";insert-sound-data 2 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct .23 .24 .25 .3 1.5 1 1 .1 .1 .1 .1 .1 1 .23 .24 .25 .2 1 1 1 1 1 1 1 0 0 0 .4 0 0 .23 .24)))
- (snd-display ";insert-sound-data 2 vals: ~A" vals))))
+ (snd-display #__line__ ";insert-sound-data 2 vals: ~A" vals))))
(close-sound ind))
(let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 4 "insert-* tests" 5)))
@@ -45479,55 +45546,55 @@ EDITS: 1
(map-channel (lambda (y) 0.7) 0 5 ind 3)
(insert-vct (make-vct 20 .1) 2 2 ind 2)
- (if (not (= (frames ind 0) 5)) (snd-display ";4chn insert-vct (0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 2) 7)) (snd-display ";4chn insert-vct (2) len: ~A" (frames ind 2)))
+ (if (not (= (frames ind 0) 5)) (snd-display #__line__ ";4chn insert-vct (0) len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 2) 7)) (snd-display #__line__ ";4chn insert-vct (2) len: ~A" (frames ind 2)))
(if (not (vequal (channel->vct 0 7 ind 0) (vct .4 .4 .4 .4 .4 0 0)))
- (snd-display ";4chn insert-vct 0: ~A" (channel->vct 0 7 ind 0)))
+ (snd-display #__line__ ";4chn insert-vct 0: ~A" (channel->vct 0 7 ind 0)))
(if (not (vequal (channel->vct 0 7 ind 1) (vct .5 .5 .5 .5 .5 0 0)))
- (snd-display ";4chn insert-vct 1: ~A" (channel->vct 0 7 ind 1)))
+ (snd-display #__line__ ";4chn insert-vct 1: ~A" (channel->vct 0 7 ind 1)))
(if (not (vequal (channel->vct 0 7 ind 2) (vct .6 .6 .1 .1 .6 .6 .6)))
- (snd-display ";4chn insert-vct 2: ~A" (channel->vct 0 7 ind 2)))
+ (snd-display #__line__ ";4chn insert-vct 2: ~A" (channel->vct 0 7 ind 2)))
(if (not (vequal (channel->vct 0 7 ind 3) (vct .7 .7 .7 .7 .7 0 0)))
- (snd-display ";4chn insert-vct 3: ~A" (channel->vct 0 7 ind 3)))
+ (snd-display #__line__ ";4chn insert-vct 3: ~A" (channel->vct 0 7 ind 3)))
(insert-vct (make-vct 20 .2) 0 2 ind 0)
- (if (not (= (frames ind 0) 7)) (snd-display ";4chn insert-vct (0 0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 1) 5)) (snd-display ";4chn insert-vct (0 1) len: ~A" (frames ind 1)))
- (if (not (= (frames ind 2) 7)) (snd-display ";4chn insert-vct (2 2) len: ~A" (frames ind 2)))
+ (if (not (= (frames ind 0) 7)) (snd-display #__line__ ";4chn insert-vct (0 0) len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 1) 5)) (snd-display #__line__ ";4chn insert-vct (0 1) len: ~A" (frames ind 1)))
+ (if (not (= (frames ind 2) 7)) (snd-display #__line__ ";4chn insert-vct (2 2) len: ~A" (frames ind 2)))
(if (not (vequal (channel->vct 0 7 ind 0) (vct .2 .2 .4 .4 .4 .4 .4)))
- (snd-display ";4chn insert-vct 1 0: ~A" (channel->vct 0 7 ind 0)))
+ (snd-display #__line__ ";4chn insert-vct 1 0: ~A" (channel->vct 0 7 ind 0)))
(if (not (vequal (channel->vct 0 7 ind 1) (vct .5 .5 .5 .5 .5 0 0)))
- (snd-display ";4chn insert-vct 1 1: ~A" (channel->vct 0 7 ind 1)))
+ (snd-display #__line__ ";4chn insert-vct 1 1: ~A" (channel->vct 0 7 ind 1)))
(if (not (vequal (channel->vct 0 7 ind 2) (vct .6 .6 .1 .1 .6 .6 .6)))
- (snd-display ";4chn insert-vct 1 2: ~A" (channel->vct 0 7 ind 2)))
+ (snd-display #__line__ ";4chn insert-vct 1 2: ~A" (channel->vct 0 7 ind 2)))
(if (not (vequal (channel->vct 0 7 ind 3) (vct .7 .7 .7 .7 .7 0 0)))
- (snd-display ";4chn insert-vct 1 3: ~A" (channel->vct 0 7 ind 3)))
+ (snd-display #__line__ ";4chn insert-vct 1 3: ~A" (channel->vct 0 7 ind 3)))
(insert-frame (make-frame 4 1.5 1.6 1.7 1.8))
- (if (not (= (frames ind 0) 8)) (snd-display ";4chn insert-frame (0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 1) 6)) (snd-display ";4chn insert-frame (1) len: ~A" (frames ind 1)))
- (if (not (= (frames ind 2) 8)) (snd-display ";4chn insert-frame (2) len: ~A" (frames ind 2)))
+ (if (not (= (frames ind 0) 8)) (snd-display #__line__ ";4chn insert-frame (0) len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 1) 6)) (snd-display #__line__ ";4chn insert-frame (1) len: ~A" (frames ind 1)))
+ (if (not (= (frames ind 2) 8)) (snd-display #__line__ ";4chn insert-frame (2) len: ~A" (frames ind 2)))
(if (not (vequal (channel->vct 0 8 ind 0) (vct 1.5 .2 .2 .4 .4 .4 .4 .4)))
- (snd-display ";4chn insert-frame 0: ~A" (channel->vct 0 8 ind 0)))
+ (snd-display #__line__ ";4chn insert-frame 0: ~A" (channel->vct 0 8 ind 0)))
(if (not (vequal (channel->vct 0 8 ind 1) (vct 1.6 .5 .5 .5 .5 .5 0 0)))
- (snd-display ";4chn insert-frame 1: ~A" (channel->vct 0 8 ind 1)))
+ (snd-display #__line__ ";4chn insert-frame 1: ~A" (channel->vct 0 8 ind 1)))
(if (not (vequal (channel->vct 0 8 ind 2) (vct 1.7 .6 .6 .1 .1 .6 .6 .6)))
- (snd-display ";4chn insert-frame 2: ~A" (channel->vct 0 8 ind 2)))
+ (snd-display #__line__ ";4chn insert-frame 2: ~A" (channel->vct 0 8 ind 2)))
(if (not (vequal (channel->vct 0 8 ind 3) (vct 1.8 .7 .7 .7 .7 .7 0 0)))
- (snd-display ";4chn insert-frame 3: ~A" (channel->vct 0 8 ind 3)))
+ (snd-display #__line__ ";4chn insert-frame 3: ~A" (channel->vct 0 8 ind 3)))
(insert-frame (make-frame 4 1.5 1.6 1.7 1.8) 10 ind)
- (if (not (= (frames ind 0) 11)) (snd-display ";4chn insert-frame (0 0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 1) 11)) (snd-display ";4chn insert-frame (0 1) len: ~A" (frames ind 1)))
- (if (not (= (frames ind 2) 11)) (snd-display ";4chn insert-frame (0 2) len: ~A" (frames ind 2)))
+ (if (not (= (frames ind 0) 11)) (snd-display #__line__ ";4chn insert-frame (0 0) len: ~A" (frames ind 0)))
+ (if (not (= (frames ind 1) 11)) (snd-display #__line__ ";4chn insert-frame (0 1) len: ~A" (frames ind 1)))
+ (if (not (= (frames ind 2) 11)) (snd-display #__line__ ";4chn insert-frame (0 2) len: ~A" (frames ind 2)))
(if (not (vequal (channel->vct 0 11 ind 0) (vct 1.5 .2 .2 .4 .4 .4 .4 .4 0 0 1.5)))
- (snd-display ";4chn insert-frame 0 0: ~A" (channel->vct 0 11 ind 0)))
+ (snd-display #__line__ ";4chn insert-frame 0 0: ~A" (channel->vct 0 11 ind 0)))
(if (not (vequal (channel->vct 0 11 ind 1) (vct 1.6 .5 .5 .5 .5 .5 0 0 0 0 1.6)))
- (snd-display ";4chn insert-frame 0 1: ~A" (channel->vct 0 11 ind 1)))
+ (snd-display #__line__ ";4chn insert-frame 0 1: ~A" (channel->vct 0 11 ind 1)))
(if (not (vequal (channel->vct 0 11 ind 2) (vct 1.7 .6 .6 .1 .1 .6 .6 .6 0 0 1.7)))
- (snd-display ";4chn insert-frame 0 2: ~A" (channel->vct 0 11 ind 2)))
+ (snd-display #__line__ ";4chn insert-frame 0 2: ~A" (channel->vct 0 11 ind 2)))
(if (not (vequal (channel->vct 0 11 ind 3) (vct 1.8 .7 .7 .7 .7 .7 0 0 0 0 1.8)))
- (snd-display ";4chn insert-frame 0 3: ~A" (channel->vct 0 11 ind 3)))
+ (snd-display #__line__ ";4chn insert-frame 0 3: ~A" (channel->vct 0 11 ind 3)))
(revert-sound ind)
(map-channel (lambda (y) 0.4) 0 5 ind 0)
@@ -45544,58 +45611,58 @@ EDITS: 1
(insert-sound-data sd 1 2)
(do ((chn 0 (+ 1 chn)))
((= chn 4))
- (if (not (= (frames ind chn) 7)) (snd-display ";4chn ~A insert-sound-data len: ~A" chn (frames ind chn)))
+ (if (not (= (frames ind chn) 7)) (snd-display #__line__ ";4chn ~A insert-sound-data len: ~A" chn (frames ind chn)))
(let ((vals (channel->vct 0 #f ind chn))
(base-val (list-ref (list .4 .5 .6 .7) chn)))
(if (not (vequal vals (vct base-val
(+ 0 (* chn 10)) (+ 1 (* chn 10)) ; insert starts at 0 in sd
base-val base-val base-val base-val)))
- (snd-display ";4chn ~A insert-sound-data vals: ~A" chn vals)))))
+ (snd-display #__line__ ";4chn ~A insert-sound-data vals: ~A" chn vals)))))
(close-sound ind))
(let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "mix-frame tests" 5)))
(map-channel (lambda (y) 1.0) 0 5 ind 0)
(let ((tag (catch #t (lambda () (mix-frame 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";mix-frame bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mix-frame bad arg: ~A" tag)))
(mix-frame (make-frame 1 .3))
- (if (not (= (frames ind) 5)) (snd-display ";mix-frame len: ~A" (frames ind)))
+ (if (not (= (frames ind) 5)) (snd-display #__line__ ";mix-frame len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct 1.3 1 1 1 1)))
- (snd-display ";mix-frame vals: ~A" vals)))
+ (snd-display #__line__ ";mix-frame vals: ~A" vals)))
(mix-frame (make-frame 1 .4) 8 ind)
- (if (not (= (frames ind) 9)) (snd-display ";mix-frame 1 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 9)) (snd-display #__line__ ";mix-frame 1 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct 1.3 1 1 1 1 0 0 0 .4)))
- (snd-display ";mix-frame 1 vals: ~A" vals)))
+ (snd-display #__line__ ";mix-frame 1 vals: ~A" vals)))
(let ((tag (catch #t (lambda () (mix-sound-data 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";mix-sound-data bad arg: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mix-sound-data bad arg: ~A" tag)))
(let ((sd (make-sound-data 1 3)))
(sound-data-set! sd 0 0 .23)
(sound-data-set! sd 0 1 .24)
(sound-data-set! sd 0 2 .25)
(mix-sound-data sd)
- (if (not (= (frames ind) 9)) (snd-display ";mix-sound-data len: ~A" (frames ind)))
+ (if (not (= (frames ind) 9)) (snd-display #__line__ ";mix-sound-data len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct 1.53 1.24 1.25 1 1 0 0 0 .4)))
- (snd-display ";mix-sound-data vals: ~A" vals)))
+ (snd-display #__line__ ";mix-sound-data vals: ~A" vals)))
(mix-sound-data sd 7 3)
- (if (not (= (frames ind) 10)) (snd-display ";mix-sound-data 1 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 10)) (snd-display #__line__ ";mix-sound-data 1 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct 1.53 1.24 1.25 1 1 0 0 .23 .64 .25)))
- (snd-display ";mix-sound-data 1 vals: ~A" vals)))
+ (snd-display #__line__ ";mix-sound-data 1 vals: ~A" vals)))
(let ((mix-id (mix-sound-data sd 0 #f ind #t)))
- (if (not (= (frames ind) 10)) (snd-display ";mix-sound-data 2 len: ~A" (frames ind)))
+ (if (not (= (frames ind) 10)) (snd-display #__line__ ";mix-sound-data 2 len: ~A" (frames ind)))
(let ((vals (channel->vct 0 #f ind 0)))
(if (not (vequal vals (vct (+ .23 1.53) (+ .24 1.24) (+ .25 1.25) 1 1 0 0 .23 .64 .25)))
- (snd-display ";mix-sound-data 2 vals: ~A" vals)))
- (if (not (mix? mix-id)) (snd-display ";mix-sound-data tagged: ~A" mix-id)))
+ (snd-display #__line__ ";mix-sound-data 2 vals: ~A" vals)))
+ (if (not (mix? mix-id)) (snd-display #__line__ ";mix-sound-data tagged: ~A" mix-id)))
)
(close-sound ind))
@@ -45608,24 +45675,24 @@ EDITS: 1
(mix-frame (make-frame 4 1 2 3 4))
(if (not (vequal (channel->vct 0 #f ind 0) (vct 1.4 .4 .4 .4 .4)))
- (snd-display ";4chn mix-frame 0: ~A" (channel->vct 0 #f ind 0)))
+ (snd-display #__line__ ";4chn mix-frame 0: ~A" (channel->vct 0 #f ind 0)))
(if (not (vequal (channel->vct 0 #f ind 1) (vct 2.5 .5 .5 .5 .5)))
- (snd-display ";4chn mix-frame 1: ~A" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";4chn mix-frame 1: ~A" (channel->vct 0 #f ind 1)))
(if (not (vequal (channel->vct 0 #f ind 2) (vct 3.6 .6 .6 .6 .6)))
- (snd-display ";4chn mix-frame 2: ~A" (channel->vct 0 #f ind 2)))
+ (snd-display #__line__ ";4chn mix-frame 2: ~A" (channel->vct 0 #f ind 2)))
(if (not (vequal (channel->vct 0 #f ind 3) (vct 4.7 .7 .7 .7 .7)))
- (snd-display ";4chn mix-frame 3: ~A" (channel->vct 0 #f ind 3)))
+ (snd-display #__line__ ";4chn mix-frame 3: ~A" (channel->vct 0 #f ind 3)))
(mix-frame (make-frame 4 1 2 3 4) 8)
(if (not (vequal (channel->vct 0 #f ind 0) (vct 1.4 .4 .4 .4 .4 0 0 0 1)))
- (snd-display ";4chn mix-frame 0 0: ~A" (channel->vct 0 #f ind 0)))
+ (snd-display #__line__ ";4chn mix-frame 0 0: ~A" (channel->vct 0 #f ind 0)))
(if (not (vequal (channel->vct 0 #f ind 1) (vct 2.5 .5 .5 .5 .5 0 0 0 2)))
- (snd-display ";4chn mix-frame 0 1: ~A" (channel->vct 0 #f ind 1)))
+ (snd-display #__line__ ";4chn mix-frame 0 1: ~A" (channel->vct 0 #f ind 1)))
(if (not (vequal (channel->vct 0 #f ind 2) (vct 3.6 .6 .6 .6 .6 0 0 0 3)))
- (snd-display ";4chn mix-frame 0 2: ~A" (channel->vct 0 #f ind 2)))
+ (snd-display #__line__ ";4chn mix-frame 0 2: ~A" (channel->vct 0 #f ind 2)))
(if (not (vequal (channel->vct 0 #f ind 3) (vct 4.7 .7 .7 .7 .7 0 0 0 4)))
- (snd-display ";4chn mix-frame 0 3: ~A" (channel->vct 0 #f ind 3)))
+ (snd-display #__line__ ";4chn mix-frame 0 3: ~A" (channel->vct 0 #f ind 3)))
(revert-sound ind)
(map-channel (lambda (y) 0.4) 0 5 ind 0)
@@ -45647,11 +45714,11 @@ EDITS: 1
(if (not (vequal vals (vct base-val
(+ base-val (* chn 10)) (+ 1 base-val (* chn 10))
base-val base-val)))
- (snd-display ";4chn ~A mix-sound-data vals: ~A" chn vals))))
+ (snd-display #__line__ ";4chn ~A mix-sound-data vals: ~A" chn vals))))
(let ((mix-id (mix-sound-data sd 8 2 ind #t)))
- (if (not (mix? mix-id)) (snd-display ";4chn mix-sound-data 2nd mix: ~A" mix-id))
- (if (not (mix? (integer->mix (+ 1 (mix->integer mix-id))))) (snd-display ";4chn mix-sound-data 2nd mix 1: ~A" mix-id))
+ (if (not (mix? mix-id)) (snd-display #__line__ ";4chn mix-sound-data 2nd mix: ~A" mix-id))
+ (if (not (mix? (integer->mix (+ 1 (mix->integer mix-id))))) (snd-display #__line__ ";4chn mix-sound-data 2nd mix 1: ~A" mix-id))
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(let ((vals (channel->vct 0 #f ind chn))
@@ -45660,7 +45727,7 @@ EDITS: 1
(+ base-val (* chn 10)) (+ 1 base-val (* chn 10))
base-val base-val 0 0 0
(+ 0 (* chn 10)) (+ 1 (* chn 10)))))
- (snd-display ";4chn ~A mix-sound-data 8 vals: ~A" chn vals))))))
+ (snd-display #__line__ ";4chn ~A mix-sound-data 8 vals: ~A" chn vals))))))
(close-sound ind))
@@ -45672,8 +45739,8 @@ EDITS: 1
(set! len (mus-length fr))
(> (frame-ref fr 0) .1)))))
(if (not (equal? val (list #t 4423)))
- (snd-display ";scan-sound oboe: ~A" val))
- (if (not (= len 1)) (snd-display ";scan-sound frame len: ~A" len)))
+ (snd-display #__line__ ";scan-sound oboe: ~A" val))
+ (if (not (= len 1)) (snd-display #__line__ ";scan-sound frame len: ~A" len)))
(set! len 0)
(let ((mx (maxamp)))
@@ -45681,22 +45748,22 @@ EDITS: 1
(lambda (fr)
(set! len (mus-length fr))
(frame* fr 2.0)))
- (if (fneq (maxamp) (* 2 mx)) (snd-display ";map-sound max: ~A ~A" mx (maxamp)))
- (if (not (= (edit-position ind 0) 1)) (snd-display ";map-sound edpos: ~A" (edit-position ind 0)))
- (if (not (= len 1)) (snd-display ";map-sound frame len: ~A" len)))
+ (if (fneq (maxamp) (* 2 mx)) (snd-display #__line__ ";map-sound max: ~A ~A" mx (maxamp)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";map-sound edpos: ~A" (edit-position ind 0)))
+ (if (not (= len 1)) (snd-display #__line__ ";map-sound frame len: ~A" len)))
(close-sound ind))
(mus-sound-forget "4.aiff")
(let ((ind (open-sound "4.aiff"))
(len 0))
- (if (not (= (chans ind) 4)) (snd-display ";chans 4.aiff: ~A" (chans ind)))
+ (if (not (= (chans ind) 4)) (snd-display #__line__ ";chans 4.aiff: ~A" (chans ind)))
(let ((val (scan-sound
(lambda (fr)
(set! len (mus-length fr))
(> (frame-ref fr 3) .1)))))
(if (not (equal? val (list #t 21244)))
- (snd-display ";4 scan-sound: ~A" val))
- (if (not (= len 4)) (snd-display ";4 scan-sound frame len: ~A" len)))
+ (snd-display #__line__ ";4 scan-sound: ~A" val))
+ (if (not (= len 4)) (snd-display #__line__ ";4 scan-sound frame len: ~A" len)))
(set! len 0)
(let ((mx (maxamp ind #t)))
@@ -45708,10 +45775,10 @@ EDITS: 1
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(if (fneq (maxamp ind chn) (* 2 (list-ref mx chn)))
- (snd-display ";4:~D map-sound max: ~A ~A" chn mx (maxamp ind chn)))
+ (snd-display #__line__ ";4:~D map-sound max: ~A ~A" chn mx (maxamp ind chn)))
(if (not (= (edit-position ind chn) 1))
- (snd-display ";4:~D map-sound edpos: ~A" chn (edit-position ind chn))))
- (if (not (= len 4)) (snd-display ";4 map-sound frame len: ~A" len)))
+ (snd-display #__line__ ";4:~D map-sound edpos: ~A" chn (edit-position ind chn))))
+ (if (not (= len 4)) (snd-display #__line__ ";4 map-sound frame len: ~A" len)))
(close-sound ind))
(let ((sd (make-sound-data 4 10)))
@@ -45722,7 +45789,7 @@ EDITS: 1
(sound-data-set! sd chn i (+ i (* chn 10)))))
(let ((sd1 (sound-data-copy sd)))
(if (not (equal? sd sd1))
- (snd-display ";sound-data-copy not equal? ~A ~A" sd sd1))
+ (snd-display #__line__ ";sound-data-copy not equal? ~A ~A" sd sd1))
(sound-data-scale! sd1 2.0)
(let ((sd2 (make-sound-data 4 10)))
(do ((chn 0 (+ 1 chn)))
@@ -45730,8 +45797,8 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (* 2 (+ i (* chn 10))))))
- (if (not (equal? sd2 sd1)) (snd-display ";sound-data-scale! not equal? ~% ~A~% ~A" sd1 sd2))
- (if (equal? sd2 sd) (snd-display ";sound-data-scale! crosstalk??")))
+ (if (not (equal? sd2 sd1)) (snd-display #__line__ ";sound-data-scale! not equal? ~% ~A~% ~A" sd1 sd2))
+ (if (equal? sd2 sd) (snd-display #__line__ ";sound-data-scale! crosstalk??")))
(sound-data-multiply! sd sd)
(let ((sd2 (make-sound-data 4 10)))
(do ((chn 0 (+ 1 chn)))
@@ -45739,7 +45806,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (* (+ i (* chn 10)) (+ i (* chn 10))))))
- (if (not (equal? sd2 sd)) (snd-display ";sound-data-multiply! not equal? ~% ~A~% ~A" sd sd2)))
+ (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-multiply! not equal? ~% ~A~% ~A" sd sd2)))
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(do ((i 0 (+ 1 i)))
@@ -45752,7 +45819,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (+ 1 i (* chn 10)))))
- (if (not (equal? sd2 sd)) (snd-display ";sound-data-offset! not equal? ~% ~A~% ~A" sd sd2)))
+ (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-offset! not equal? ~% ~A~% ~A" sd sd2)))
(let ((sd3 (sound-data-reverse! (sound-data-copy sd))))
(let ((sd2 (make-sound-data 4 10)))
(do ((chn 0 (+ 1 chn)))
@@ -45760,14 +45827,14 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (+ 1 (- 9 i) (* chn 10)))))
- (if (not (equal? sd2 sd3)) (snd-display ";sound-data-reverse! not equal? ~% ~A~% ~A" sd3 sd2)))
+ (if (not (equal? sd2 sd3)) (snd-display #__line__ ";sound-data-reverse! not equal? ~% ~A~% ~A" sd3 sd2)))
(sound-data-add! sd sd3)
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd1 chn i (+ 1 10 (* chn 20)))))
- (if (not (equal? sd1 sd)) (snd-display ";sound-data-add! not equal? ~% ~A~% ~A" sd sd1)))
+ (if (not (equal? sd1 sd)) (snd-display #__line__ ";sound-data-add! not equal? ~% ~A~% ~A" sd sd1)))
(do ((chn 0 (+ 1 chn)))
((= chn 4))
@@ -45778,13 +45845,13 @@ EDITS: 1
(let ((sd2 (sound-data-copy sd)))
(sound-data+ sd 1)
(sound-data-add! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display ";sound-data+ sd 1: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd 1: ~% ~A~% ~A" sd sd2))
(sound-data+ 1 sd)
(sound-data-add! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display ";sound-data+ 1 sd: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ 1 sd: ~% ~A~% ~A" sd sd2))
(sound-data+ sd sd1)
(sound-data-add! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display ";sound-data+ sd sd: ~% ~A~% ~A" sd sd2)))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd sd: ~% ~A~% ~A" sd sd2)))
(do ((chn 0 (+ 1 chn)))
((= chn 4))
@@ -45794,55 +45861,55 @@ EDITS: 1
(sound-data-set! sd1 chn i 2)))
(let ((sd2 (sound-data-copy sd)))
(if (fneq (sound-data-peak sd) (apply max (sound-data-maxamp sd)))
- (snd-display ";sound-data-peak: ~A ~A" (sound-data-peak sd) (apply max (sound-data-maxamp sd))))
+ (snd-display #__line__ ";sound-data-peak: ~A ~A" (sound-data-peak sd) (apply max (sound-data-maxamp sd))))
(sound-data* sd 2)
(sound-data-multiply! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display ";sound-data* sd 1: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd 1: ~% ~A~% ~A" sd sd2))
(sound-data* 2 sd)
(sound-data-multiply! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display ";sound-data* 1 sd: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* 1 sd: ~% ~A~% ~A" sd sd2))
(sound-data* sd sd1)
(sound-data-add! sd2 sd2)
- (if (not (equal? sd sd2)) (snd-display ";sound-data* sd sd: ~% ~A~% ~A" sd sd2)))))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd sd: ~% ~A~% ~A" sd sd2)))))
;; tests from clean.scm
(test-remove-single-clicks)
(test-remove-pops)
(test-notch-hum)
(test-remove-DC)
-
- ;; check 0 cases
+
+ ;; check 0 cases
(let ((ind (open-sound "oboe.snd")))
(scale-by 0.0)
- (if (fneq (maxamp) 0.0) (snd-display ";scale-by 0 amp: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";scale-by 0 amp: ~A" (maxamp)))
(scale-by 3.0)
- (if (not (= (edit-position) 1)) (snd-display ";scale-by over 0: ~A" (edit-position)))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";scale-by over 0: ~A" (edit-position)))
(scale-to 1.0)
- (if (not (= (edit-position) 1)) (snd-display ";scale-to 1.0 over 0: ~A" (edit-position)))
- (if (fneq (maxamp) 0.0) (snd-display ";scale-to 1.0 over 0 amp: ~A" (maxamp)))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";scale-to 1.0 over 0: ~A" (edit-position)))
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";scale-to 1.0 over 0 amp: ~A" (maxamp)))
(ramp-channel 0 1)
- (if (not (= (edit-position) 1)) (snd-display ";ramp over 0: ~A" (edit-position)))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
(env-channel '(0 0 1 1 2 0))
- (if (not (= (edit-position) 1)) (snd-display ";ramp over 0: ~A" (edit-position)))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
(if (not (string=? (car (edit-fragment 1)) "scale-channel 0.000 0 #f"))
- (snd-display ";ramp over 0 clobbered origin: ~A" (edit-fragment 1)))
+ (snd-display #__line__ ";ramp over 0 clobbered origin: ~A" (edit-fragment 1)))
(xramp-channel 0 1 32.0)
- (if (not (= (edit-position) 1)) (snd-display ";ramp over 0: ~A" (edit-position)))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
(env-channel-with-base '(0 0 1 1 2 0 3 1) 0.0)
- (if (not (= (edit-position) 1)) (snd-display ";ramp over 0: ~A" (edit-position)))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
(close-sound ind))
-
+
;; snddiff.scm
(let ((ind0 (open-sound "oboe.snd"))
(ind1 (open-sound "oboe.snd")))
(let ((diff (snddiff ind0 0 ind1 0)))
(if (not (equal? diff 'no-difference))
- (snd-display ";snddiff of same sound: ~A" diff)))
+ (snd-display #__line__ ";snddiff of same sound: ~A" diff)))
(scale-channel 2.0 0 #f ind1)
(let ((diff (snddiff ind0 0 ind1 0)))
(if (or (not (eq? (car diff) 'scale))
(fneq (cadr diff) 2.0))
- (snd-display ";snddiff scale by 2: ~A" diff)))
+ (snd-display #__line__ ";snddiff scale by 2: ~A" diff)))
(revert-sound ind1)
(set! (sample 100 ind0 0) 1.0)
(let* ((diff (snddiff ind0 0 ind1 0))
@@ -45852,7 +45919,7 @@ EDITS: 1
(not (= (car info) 100))
(fneq (cadr info) 1.0)
(fneq (caddr info) -3.051e-4))
- (snd-display ";snddiff change sample 100: ~A" diff)))
+ (snd-display #__line__ ";snddiff change sample 100: ~A" diff)))
(revert-sound ind0)
(pad-channel 0 100 ind0 0)
(let ((diff (snddiff ind0 0 ind1 0)))
@@ -45863,7 +45930,7 @@ EDITS: 1
(not (eq? (list-ref diff 4) #f))
(not (eq? (list-ref diff 5) #f))
(not (eq? (list-ref diff 6) #f)))
- (snd-display ";snddiff + lag: ~A" diff)))
+ (snd-display #__line__ ";snddiff + lag: ~A" diff)))
(revert-sound ind0)
(filter-channel (vct 1.0 0.5 0.25) 3 0 #f ind1 0)
(let* ((diff (snddiff ind0 0 ind1 0))
@@ -45877,16 +45944,16 @@ EDITS: 1
(not (= (cadr (car info)) 0))
(not (= (cadr (cadr info)) 1))
(not (= (cadr (caddr info)) 1)))
- (snd-display ";snddiff filter: ~A" diff)))
+ (snd-display #__line__ ";snddiff filter: ~A" diff)))
(revert-sound ind1)
(close-sound ind0)
(close-sound ind1))
-
+
(let ((ind (open-sound "oboe.snd")))
(let ((g550 (goertzel-channel 550.0))
(g1700 (goertzel-channel 1700.0)))
- (if (> (* 1000 g1700) g550) (snd-display ";goertzel-channel oboe: ~A ~A" g550 g1700))
+ (if (> (* 1000 g1700) g550) (snd-display #__line__ ";goertzel-channel oboe: ~A ~A" g550 g1700))
(close-sound ind)))
)))
@@ -45897,17 +45964,17 @@ EDITS: 1
(defmacro fxtst (form result)
`(let ((val ,form))
(if (fneq val ,result)
- (snd-display ";~A -> ~A (~A)" ',form val ,result))))
+ (snd-display #__line__ ";~A -> ~A (~A)" ',form val ,result))))
(defmacro ixtst (form result)
`(let ((val ,form))
(if (not (= val ,result))
- (snd-display ";~A -> ~A (~A)" ',form val ,result))))
+ (snd-display #__line__ ";~A -> ~A (~A)" ',form val ,result))))
(defmacro bxtst (form result)
`(let ((val ,form))
(if (not (eq? val ,result))
- (snd-display ";~A -> ~A (~A)" ',form val ,result))))
+ (snd-display #__line__ ";~A -> ~A (~A)" ',form val ,result))))
(defmacro time-it (a)
`(let ((start (real-time)))
@@ -45987,11 +46054,11 @@ EDITS: 1
(set! (hi308-freq hi308-gen) (* 3.5 (hi308-freq hi308-gen))))
(def-clm-struct hiho309 (i 0 :type int) (x 0.0 :type float) (v #f :type vct))
-
+
(def-clm-struct hiho310 (v #f :type string))
-
+
(def-clm-struct hiho311 (v #f :type sound-data))
-
+
(def-clm-struct abc232 (x 0.0))
(def-clm-struct abd232 (x 1.0))
@@ -46015,11 +46082,11 @@ EDITS: 1
(define (make-osc frq)
(run
- (make-oscil frq)))
+ (make-oscil frq)))
(define (make-fc scl size)
(run
- (make-filtered-comb scl size :filter (make-one-zero .4 .6))))
+ (make-filtered-comb scl size :filter (make-one-zero .4 .6))))
(definstrument (test-set-gens)
(let ((cs (make-ncos 440.0 5))
@@ -46035,44 +46102,44 @@ EDITS: 1
(sb (make-ssb-am 440.0))
)
(run
- (set! (mus-length cs) 3)
- (if (not (= (mus-length cs) 3)) (display ";cosines messed up"))
- (set! (mus-length cs) 32)
- (if (not (= (mus-length cs) 32)) (display ";length messed up"))
- (set! (mus-frequency cs) 100.0)
- (if (fneq (mus-frequency cs) 100.0) (display ";frequency messed up"))
- (set! (mus-phase cs) 2.0)
- (if (fneq (mus-phase cs) 2.0) (display ";phase messed up"))
- (set! (mus-scaler cs) .5)
- (if (fneq (mus-scaler cs) .5) (display ";scaler messed up"))
- (set! (mus-width sq) .123)
- (if (fneq (mus-width sq) .123) (display ";width messed up"))
- (set! (mus-location en) 3)
- (if (not (= (mus-location en) 3)) (display ";location messed up"))
- (set! (mus-length dl) 24)
- (if (not (= (mus-length dl) 24)) (display ";dl length messed up"))
- (set! (mus-feedback ap) .5)
- (if (fneq (mus-feedback ap) .5) (display ";feedback messed up"))
- (set! (mus-feedforward ap) .5)
- (if (fneq (mus-feedforward ap) .5) (display ";feedforward messed up"))
- (set! (mus-increment sr) .3)
- (if (fneq (mus-increment sr) .3) (display ";sr increment messed up"))
- (set! (mus-frequency gr) .05)
- (if (fneq (mus-frequency gr) .05) (display ";gr frequency messed up"))
- (set! (mus-scaler gr) .05)
- (if (fneq (mus-scaler gr) .05) (display ";gr scaler messed up"))
- (set! (mus-increment gr) .5)
- (if (fneq (mus-increment gr) .5) (display ";gr increment messed up"))
- (set! (mus-ramp gr) 1234)
- (if (not (= (mus-ramp gr) 1234)) (display ";gr ramp messed up"))
- (set! (mus-hop gr) 1234)
- (if (not (= (mus-hop gr) 1234)) (display ";gr hop messed up"))
- (set! (mus-length gr) 1234)
- (if (not (= (mus-length gr) 1234)) (display ";gr length messed up"))
- (if (fneq (mus-frequency sb) 440.0) (display ";sb freq?"))
- (set! (mus-frequency sb) 220.0)
- (if (fneq (mus-frequency sb) 220.0) (display ";sb freq messed up"))
- )))
+ (set! (mus-length cs) 3)
+ (if (not (= (mus-length cs) 3)) (display ";cosines messed up"))
+ (set! (mus-length cs) 32)
+ (if (not (= (mus-length cs) 32)) (display ";length messed up"))
+ (set! (mus-frequency cs) 100.0)
+ (if (fneq (mus-frequency cs) 100.0) (display ";frequency messed up"))
+ (set! (mus-phase cs) 2.0)
+ (if (fneq (mus-phase cs) 2.0) (display ";phase messed up"))
+ (set! (mus-scaler cs) .5)
+ (if (fneq (mus-scaler cs) .5) (display ";scaler messed up"))
+ (set! (mus-width sq) .123)
+ (if (fneq (mus-width sq) .123) (display ";width messed up"))
+ (set! (mus-location en) 3)
+ (if (not (= (mus-location en) 3)) (display ";location messed up"))
+ (set! (mus-length dl) 24)
+ (if (not (= (mus-length dl) 24)) (display ";dl length messed up"))
+ (set! (mus-feedback ap) .5)
+ (if (fneq (mus-feedback ap) .5) (display ";feedback messed up"))
+ (set! (mus-feedforward ap) .5)
+ (if (fneq (mus-feedforward ap) .5) (display ";feedforward messed up"))
+ (set! (mus-increment sr) .3)
+ (if (fneq (mus-increment sr) .3) (display ";sr increment messed up"))
+ (set! (mus-frequency gr) .05)
+ (if (fneq (mus-frequency gr) .05) (display ";gr frequency messed up"))
+ (set! (mus-scaler gr) .05)
+ (if (fneq (mus-scaler gr) .05) (display ";gr scaler messed up"))
+ (set! (mus-increment gr) .5)
+ (if (fneq (mus-increment gr) .5) (display ";gr increment messed up"))
+ (set! (mus-ramp gr) 1234)
+ (if (not (= (mus-ramp gr) 1234)) (display ";gr ramp messed up"))
+ (set! (mus-hop gr) 1234)
+ (if (not (= (mus-hop gr) 1234)) (display ";gr hop messed up"))
+ (set! (mus-length gr) 1234)
+ (if (not (= (mus-length gr) 1234)) (display ";gr length messed up"))
+ (if (fneq (mus-frequency sb) 440.0) (display ";sb freq?"))
+ (set! (mus-frequency sb) 220.0)
+ (if (fneq (mus-frequency sb) 220.0) (display ";sb freq messed up"))
+ )))
(define (make-linear-src sr)
(vct 0.0 sr 0.0 0.0)) ; position sr last next
@@ -46086,7 +46153,7 @@ EDITS: 1
(vct-set! gen 2 (vct-ref gen 3))
(vct-set! gen 3 (input))
(set! pos (- 1.0 (vct-ref gen 0))))
- (let ((num (inexact->exact (floor pos))))
+ (let ((num (floor pos)))
(do ((i 0 (+ 1 i)))
((= i num))
(vct-set! gen 2 (vct-ref gen 3))
@@ -46100,56 +46167,56 @@ EDITS: 1
(define (itst form result)
(let ((val (run-eval form)))
- (if (not (eqv? val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (eqv? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (itsta form arg result)
(let ((val (run-eval form arg)))
- (if (not (eqv? val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (eqv? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (fitst form result)
(let ((val (run-eval form)))
- (if (not (= val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (= val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (fitsta form arg result)
(let ((val (run-eval form arg)))
- (if (not (= val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (= val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (btst form result)
(let ((val (run-eval form)))
- (if (not (eq? val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (eq? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (btsta form arg result)
(let ((val (run-eval form arg)))
- (if (not (eq? val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (eq? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (ftst form result)
(let ((val (run-eval form)))
- (if (fneq val result) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (fneq val result) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (ftsta form arg result)
(let ((val (run-eval form arg)))
- (if (fneq val result) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (fneq val result) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (etst form)
(let ((tag (catch #t (lambda () (run-eval form)) (lambda args args))))
(if (or (not (list-p tag))
(not (eq? (car tag) 'cannot-parse)))
- (snd-display ";~A -> ~A?" form tag))))
+ (snd-display #__line__ ";~A -> ~A?" form tag))))
(define (etsta form arg)
(let ((tag (catch #t (lambda () (run-eval form arg)) (lambda args args))))
(if (or (not (list-p tag))
(and (not (eq? (car tag) 'cannot-parse))
(not (eq? (car tag) 'wrong-type-arg))))
- (snd-display ";~A -> ~A?" form tag))))
+ (snd-display #__line__ ";~A -> ~A?" form tag))))
(define (ctst form result)
(let ((val (run-eval form)))
- (if (not (char=? val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (char=? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (ctsta form arg result)
(let ((val (run-eval form arg)))
- (if (not (char=? val result)) (snd-display ";~A -> ~A (~A)" form val result))))
+ (if (not (char=? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(define (stst form result)
(catch 'cannot-parse
@@ -46157,16 +46224,16 @@ EDITS: 1
(let ((val (run-eval form)))
(if (or (not (string? val))
(not (string=? val result)))
- (snd-display ";~A -> ~A (~A)" form val result))))
+ (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
(lambda args
- (snd-display ";stst ~A: unparsable" form))))
+ (snd-display #__line__ ";stst ~A: unparsable" form))))
(define (ststa form arg result)
(let ((val (run-eval form arg)))
(if (or (not (string? val))
(not (string=? val result)))
- (snd-display ";~A -> ~A (~A)" form val result))))
-
+ (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
+
(define (t22-i->i arg) (+ arg 32))
(define (t22-i->b arg) (= arg 3))
(define (t22-i->f arg) (* arg 2.0))
@@ -46235,19 +46302,19 @@ EDITS: 1
(ftsta '(lambda (y) (set! dbl-var 32.0) dbl-var) 0.0 32.0)
- (if (fneq dbl-var 32.0) (snd-display ";set! 1 dbl-var: ~A" dbl-var))
+ (if (fneq dbl-var 32.0) (snd-display #__line__ ";set! 1 dbl-var: ~A" dbl-var))
(ftsta '(lambda (y) (set! dbl-var y) dbl-var) 0.5 0.5)
- (if (fneq dbl-var 0.5) (snd-display ";set! 2 dbl-var: ~A" dbl-var))
+ (if (fneq dbl-var 0.5) (snd-display #__line__ ";set! 2 dbl-var: ~A" dbl-var))
(itsta '(lambda (y) (set! int-var 3) int-var) 0 3)
- (if (not (= int-var 3)) (snd-display ";set! 1 int-var: ~A" int-var))
+ (if (not (= int-var 3)) (snd-display #__line__ ";set! 1 int-var: ~A" int-var))
(itsta '(lambda (y) (set! int-var (inexact->exact y)) int-var) -2 -2)
- (if (not (= int-var -2)) (snd-display ";set! 2 int-var: ~A" int-var))
+ (if (not (= int-var -2)) (snd-display #__line__ ";set! 2 int-var: ~A" int-var))
(btsta '(lambda (y) (set! bool-var #f) bool-var) 0.0 #f)
- (if (not (eq? bool-var #f)) (snd-display ";set! 1 bool-var: ~A" bool-var))
+ (if (not (eq? bool-var #f)) (snd-display #__line__ ";set! 1 bool-var: ~A" bool-var))
(btsta '(lambda (y) (set! bool-var (odd? y)) bool-var) 1 #t)
- (if (not (eq? bool-var #t)) (snd-display ";set! 2 bool-var: ~A" bool-var))
+ (if (not (eq? bool-var #t)) (snd-display #__line__ ";set! 2 bool-var: ~A" bool-var))
(set! int-var 32)
(set! dbl-var 3.14)
@@ -46743,24 +46810,24 @@ EDITS: 1
(let* ((g0 (make-oscil 440)) (g1 g0) (v (make-vct 1)))
(vct-map! v (lambda () (if (eq? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display ";run clm eq?: ~A" v)))
+ (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run clm eq?: ~A" v)))
(let* ((g0 (make-oscil 440)) (g1 (make-oscil 330.0)) (v (make-vct 1)))
(vct-map! v (lambda () (if (eq? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display ";run clm neq?: ~A" v)))
+ (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";run clm neq?: ~A" v)))
(let* ((g0 (make-oscil 440)) (g1 g0) (v (make-vct 1)))
(vct-map! v (lambda () (if (eqv? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display ";run clm eqv?: ~A" v)))
+ (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run clm eqv?: ~A" v)))
(let* ((g0 (make-oscil 440)) (g1 (make-oscil 330.0)) (v (make-vct 1)))
(vct-map! v (lambda () (if (eqv? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display ";run clm neqv?: ~A" v)))
+ (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";run clm neqv?: ~A" v)))
(let* ((g0 (make-oscil 440)) (g1 g0) (v (make-vct 1)))
(vct-map! v (lambda () (if (equal? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display ";run clm equal?: ~A" v)))
+ (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run clm equal?: ~A" v)))
(let* ((g0 (make-oscil 440)) (g1 (make-oscil 330.0)) (v (make-vct 1)))
(vct-map! v (lambda () (if (equal? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display ";run clm nequal?: ~A" v)))
+ (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";run clm nequal?: ~A" v)))
(fitst '(floor -4.3) -5.0)
(fitst '(floor 3.5) 3.0)
@@ -47198,7 +47265,7 @@ EDITS: 1
(btsta '(lambda (y) (or (odd? 3) #f)) 0.0 #t)
(btsta '(lambda (y) (or #f (odd? 4))) 0.0 #f)
(btsta '(lambda (y) (or (odd? y) (begin (set! int-var 123) #f))) 3 #t)
- (if (= int-var 123) (snd-display ";or not short-circuited"))
+ (if (= int-var 123) (snd-display #__line__ ";or not short-circuited"))
(etst '(or (hiho 3)))
(btsta '(lambda (y) (and)) 0 #t)
@@ -47209,9 +47276,9 @@ EDITS: 1
(btsta '(lambda (y) (and (odd? 3) #f)) 0.0 #f)
(btsta '(lambda (y) (and #f (odd? 4))) 0.0 #f)
(btsta '(lambda (y) (and (odd? y) (begin (set! int-var 123) #t))) 3 #t)
- (if (not (= int-var 123)) (snd-display ";and quit early?"))
+ (if (not (= int-var 123)) (snd-display #__line__ ";and quit early?"))
(btsta '(lambda (y) (and (odd? y) (begin (set! int-var 321) #t))) 2 #f)
- (if (= int-var 321) (snd-display ";and not short-circuited"))
+ (if (= int-var 321) (snd-display #__line__ ";and not short-circuited"))
(etst '(and (hiho 3)))
(btst '(eq? 1 1) #t)
@@ -47427,16 +47494,16 @@ EDITS: 1
(itst '(let ((a 1)) a) 1)
(itst '(let ((a 1) (b 2)) (+ a b)) 3)
- (itst '(let ((int-var 2)) int-var) 2) (if (not (= int-var 32)) (snd-display ";let local trouble: ~A" int-var))
+ (itst '(let ((int-var 2)) int-var) 2) (if (not (= int-var 32)) (snd-display #__line__ ";let local trouble: ~A" int-var))
(itst '(let ((a 1) (b (let ((a 32)) a))) (+ a b)) 33)
(ftst '(let ((a 1.0)) a) 1.0)
(ftst '(let ((a 1.5) (b 2.5)) (+ a b)) 4.0)
- (ftst '(let ((dbl-var 2.5)) (+ int-var dbl-var)) 34.5) (if (not (= dbl-var 32.0)) (snd-display ";let flt local trouble: ~A" dbl-var))
+ (ftst '(let ((dbl-var 2.5)) (+ int-var dbl-var)) 34.5) (if (not (= dbl-var 32.0)) (snd-display #__line__ ";let flt local trouble: ~A" dbl-var))
(ftst '(let ((a 1.0) (b (let ((a 32.5)) (set! a 3.5) (+ a 1.0)))) (if (< a 2.0) (+ a b) 0.0)) 5.5)
- (ftst '(let ((dbl-var 2.5)) (set! dbl-var 1.5) dbl-var) 1.5) (if (not (= dbl-var 32.0)) (snd-display ";let flt local trouble: ~A" dbl-var))
+ (ftst '(let ((dbl-var 2.5)) (set! dbl-var 1.5) dbl-var) 1.5) (if (not (= dbl-var 32.0)) (snd-display #__line__ ";let flt local trouble: ~A" dbl-var))
(btst '(let ((a #f)) (not a)) #t)
(btst '(let ((a #f) (b #t)) (and a b)) #f)
- (btst '(let ((bool-var (not bool-var))) bool-var) #f) (if (not bool-var) (snd-display ";let b local trouble: ~A" bool-var))
+ (btst '(let ((bool-var (not bool-var))) bool-var) #f) (if (not bool-var) (snd-display #__line__ ";let b local trouble: ~A" bool-var))
(btst '(let ((a bool-var) (bool-var (let ((a (not bool-var))) a))) bool-var) #f)
(itst '(let ((a ( + int-var 1))) a) (+ int-var 1))
(ftsta '(let ((a 1)) (lambda (y) (+ y a))) 2.5 3.5)
@@ -47444,11 +47511,11 @@ EDITS: 1
(itst '(let* ((a 1)) a) 1)
(itst '(let* ((a 1) (b (* 2 a))) (+ a b)) 3)
- (itst '(let* ((int-var 2)) int-var) 2) (if (not (= int-var 32)) (snd-display ";let* local trouble: ~A" int-var))
+ (itst '(let* ((int-var 2)) int-var) 2) (if (not (= int-var 32)) (snd-display #__line__ ";let* local trouble: ~A" int-var))
(itst '(let* ((a 1) (b (let* ((xx 32) (a xx)) a))) (+ a b)) 33)
(ftst '(let* ((a 1.0)) a) 1.0)
(ftst '(let* ((a 1.5) (b (* a 2))) (+ a b)) 4.5)
- (ftst '(let* ((dbl-var 2.5)) (+ int-var dbl-var)) 34.5) (if (not (= dbl-var 32.0)) (snd-display ";let* flt local trouble: ~A" dbl-var))
+ (ftst '(let* ((dbl-var 2.5)) (+ int-var dbl-var)) 34.5) (if (not (= dbl-var 32.0)) (snd-display #__line__ ";let* flt local trouble: ~A" dbl-var))
(ftst '(let* ((a 1.0) (b (let* ((a 32.5)) (set! a 3.5) (+ a 1.0)))) (if (< a 2.0) (+ a b) 0.0)) 5.5)
(btst '(let* ((a #f) (b (not a))) (or b a)) #t)
(btst '(let* ((a #f) (b #t)) (and a b)) #f)
@@ -47525,7 +47592,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 3))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 1 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 1 j=~A" j)))
(let ((j 1))
(run
@@ -47533,42 +47600,42 @@ EDITS: 1
(k 1 (+ k 2)))
((= i 3))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 2 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 2 j=~A" j)))
(let ((j 1))
(run
(do ((i 0 (+ i 1)))
((= 3 i))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 2 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 2 j=~A" j)))
(let ((j 1))
(run
(do ((i 0 (+ 1 i)))
((= 3 i))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 3 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 3 j=~A" j)))
(let ((j 1))
(run
(do ((i 0 (+ 1 i)))
((>= i 3))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 4 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 4 j=~A" j)))
(let ((j 1))
(run
(do ((i 0 (+ 1 i)))
((= j 2))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 5 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 5 j=~A" j)))
(let ((j 1))
(run
(do ((i 0 (+ i 2)))
((= i 4))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 6 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 6 j=~A" j)))
(let ((j 1))
(run
@@ -47576,7 +47643,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 3))
(set! j i)))
- (if (not (= j 2)) (snd-display ";loop 7 j=~A" j)))
+ (if (not (= j 2)) (snd-display #__line__ ";loop 7 j=~A" j)))
(let ((j 1))
(run
@@ -47584,16 +47651,16 @@ EDITS: 1
(i 6 (- i 1)))
((= i 3))
(set! j k)))
- (if (not (= j 2)) (snd-display ";loop 8 j=~A" j)))
-
+ (if (not (= j 2)) (snd-display #__line__ ";loop 8 j=~A" j)))
+
(let ((j 1))
(run
(do ((i 0 (+ i 1)))
((= i 3))
(set! j i))
(set! j (+ j 1)))
- (if (not (= j 3)) (snd-display ";loop 9 j=~A" j)))
-
+ (if (not (= j 3)) (snd-display #__line__ ";loop 9 j=~A" j)))
+
(let ((j 1))
(run
(do ((i 0 (+ i 1)))
@@ -47602,7 +47669,7 @@ EDITS: 1
((= k 3))
(set! j (+ i k)))))
(if (not (= j 4)) (format #t ";loop 10 j=~A" j)))
-
+
(etst '(do ((i 0 (+ i 0.5)) (j 0 (+ 1 j))) ((>= j 3)) (display i)))
@@ -47622,7 +47689,7 @@ EDITS: 1
(set! int-var 12)
12)))
1)
- (if (not (= int-var 32)) (snd-display ";call/cc didn't exit? ~A" int-var))
+ (if (not (= int-var 32)) (snd-display #__line__ ";call/cc didn't exit? ~A" int-var))
(itst '(call-with-current-continuation
(lambda (return)
(let ((a 1))
@@ -47630,7 +47697,7 @@ EDITS: 1
(set! int-var 12)
12)))
1)
- (if (not (= int-var 32)) (snd-display ";call/cc 1 didn't exit? ~A" int-var))
+ (if (not (= int-var 32)) (snd-display #__line__ ";call/cc 1 didn't exit? ~A" int-var))
(set! dbl-var 32.0)
(ftst '(call-with-current-continuation
@@ -47646,7 +47713,7 @@ EDITS: 1
(set! dbl-var 12.0)
12.0)))
1.0)
- (if (not (= dbl-var 32.0)) (snd-display ";call/cc dbl didn't exit? ~A" dbl-var))
+ (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl didn't exit? ~A" dbl-var))
(ftst '(call-with-current-continuation
(lambda (return)
(let ((a 1.0))
@@ -47654,7 +47721,7 @@ EDITS: 1
(set! dbl-var 12.0)
12.0)))
1.0)
- (if (not (= dbl-var 32.0)) (snd-display ";call/cc dbl 1 didn't exit? ~A" dbl-var))
+ (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl 1 didn't exit? ~A" dbl-var))
(ftsta '(lambda (y)
(if (> y 0.0)
(call-with-current-continuation
@@ -47668,7 +47735,7 @@ EDITS: 1
12.0)))))))
1.0
2.0)
- (if (not (= dbl-var 32.0)) (snd-display ";call/cc dbl 1 didn't exit? ~A" dbl-var))
+ (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl 1 didn't exit? ~A" dbl-var))
(ftsta '(lambda (y)
(call-with-current-continuation
(lambda (return)
@@ -47681,7 +47748,7 @@ EDITS: 1
12.0))))))
-1.0
1.0)
- (if (not (= dbl-var 32.0)) (snd-display ";call/cc dbl 1 didn't exit? ~A" dbl-var))
+ (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl 1 didn't exit? ~A" dbl-var))
(set! str-var "")
(btst '(let ((a 1)
@@ -47704,7 +47771,7 @@ EDITS: 1
(set! str-var (string-append str-var "!"))
(if (< b 6) (cont1) #f)))))
#f)
- (if (not (string=? str-var "ab!a!")) (snd-display ";two continuations: ~A" str-var))
+ (if (not (string=? str-var "ab!a!")) (snd-display #__line__ ";two continuations: ~A" str-var))
(set! str-var "")
(run-eval
@@ -47726,12 +47793,12 @@ EDITS: 1
(if (and cont1
(< b 6))
(cont1)))))
- (if (not (string=? str-var "1 23 35 47 59 6")) (snd-display ";cont2 trouble: ~A" str-var))
+ (if (not (string=? str-var "1 23 35 47 59 6")) (snd-display #__line__ ";cont2 trouble: ~A" str-var))
(set! str-var "hi")
(if (not (keyword? (run-eval '(if (even? 2) :hi :ho))))
- (snd-display ";run -> key: ~A" (run-eval '(if (even? 2) :hi :ho))))
+ (snd-display #__line__ ";run -> key: ~A" (run-eval '(if (even? 2) :hi :ho))))
(if (not (vct? (run-eval '(if (odd? 2) (make-vct 3) (make-vct 2)))))
- (snd-display ";run -> vct ~A" (run-eval '(if (odd? 2) (make-vct 3) (make-vct 2)))))
+ (snd-display #__line__ ";run -> vct ~A" (run-eval '(if (odd? 2) (make-vct 3) (make-vct 2)))))
(itst '(* 1 1 1) 1)
(itst '(+ 0 0 0) 0)
@@ -47763,11 +47830,11 @@ EDITS: 1
(btst '(equal? global-v global-v1) #f)
(let ((val (run-eval '(let ((a (make-vct 3))) (vct-set! a 0 (/ .3 .2)) (vct-ref a 0)))))
- (if (fneq val 1.5) (snd-display ";run-eval of trailing non-int in vct-set! (1): ~A" val)))
+ (if (fneq val 1.5) (snd-display #__line__ ";run-eval of trailing non-int in vct-set! (1): ~A" val)))
(let ((val (run-eval '(let ((a (make-vct 3)) (b .3)) (vct-set! a 0 (/ b 2)) (vct-ref a 0)))))
- (if (fneq val .15) (snd-display ";run-eval of trailing non-int in vct-set! (2): ~A" val)))
+ (if (fneq val .15) (snd-display #__line__ ";run-eval of trailing non-int in vct-set! (2): ~A" val)))
(let ((val (run-eval '(let ((a (make-frame 3)) (b .3)) (frame-set! a 0 (/ b .2)) (frame-ref a 0)))))
- (if (fneq val 1.5) (snd-display ";run-eval of trailing non-int in frame-set! (1): ~A" val)))
+ (if (fneq val 1.5) (snd-display #__line__ ";run-eval of trailing non-int in frame-set! (1): ~A" val)))
(btst '(char? #\a) #t)
(btst '(char? 3) #f)
@@ -47933,10 +48000,10 @@ EDITS: 1
(ctst '(let ((cv #\a)) (set! cv #\b) cv) #\b)
(ctst '(let ((cv #\a)) (set! c-var #\b) cv) #\a)
- (if (not (char=? c-var #\b)) (snd-display ";set c-var: ~A" c-var))
+ (if (not (char=? c-var #\b)) (snd-display #__line__ ";set c-var: ~A" c-var))
(ctsta '(lambda (y) (let ((cv (integer->char (inexact->exact y)))) (set! cv #\b) cv)) 97 #\b)
(ctsta '(lambda (y) (let ((cv (integer->char (inexact->exact y)))) (set! c-var cv) cv)) 97 #\a)
- (if (not (char=? c-var #\a)) (snd-display ";set c-var: ~A" c-var))
+ (if (not (char=? c-var #\a)) (snd-display #__line__ ";set c-var: ~A" c-var))
(btst '(string? "hi") #t)
(btst '(string? 3) #f)
@@ -48109,9 +48176,9 @@ EDITS: 1
(stst '(let ((str "asdfg")) (string-fill! str #\x) str) "xxxxx")
(stst '(begin (set! str-var "ho") str-var) "ho")
- (if (not (string=? str-var "ho")) (snd-display ";global str not reset upon exit? ~A" str-var))
+ (if (not (string=? str-var "ho")) (snd-display #__line__ ";global str not reset upon exit? ~A" str-var))
(ststa '(lambda (y) (begin (set! str-var (string #\c #\b #\a)) str-var)) 0 "cba")
- (if (not (string=? str-var "cba")) (snd-display ";global str not reset upon lambda exit? ~A" str-var))
+ (if (not (string=? str-var "cba")) (snd-display #__line__ ";global str not reset upon lambda exit? ~A" str-var))
(stst '(let ((str (make-string 4 #\a))) str) "aaaa")
(stst '(let ((str (make-string 4 #\a))) (string-set! str 0 #\b) str) "baaa")
(itst '(let ((str (make-string 4 #\a))) (string-set! str 0 #\b) (string-length str)) 4)
@@ -48208,7 +48275,7 @@ EDITS: 1
(let ((x 0.0))
(run (set! x (vct-ref (vct 0 1 2 3) 2)))
- (if (fneq x 2.0) (snd-display ";vct with ints in run: ~A" x)))
+ (if (fneq x 2.0) (snd-display #__line__ ";vct with ints in run: ~A" x)))
(let ((v1 (make-vct 32 1.0)))
(run
@@ -48220,19 +48287,19 @@ EDITS: 1
(lambda ()
(if (square-wave? g1)
g1))))
-
+
(let ((v (vct 1.0 2.0 3.0)))
(let ((val (run (v 1))))
- (if (fneq val 2.0) (snd-display ";run (v 1): ~A" val))))
+ (if (fneq val 2.0) (snd-display #__line__ ";run (v 1): ~A" val))))
(let ((v (vector 1.0 2.0 3.0)))
(let ((val (run (v 1))))
- (if (fneq val 2.0) (snd-display ";run (v 1) as vector: ~A" val))))
+ (if (fneq val 2.0) (snd-display #__line__ ";run (v 1) as vector: ~A" val))))
(let ((v (vct 1.0 2.0 3.0)))
(run (set! (v 1) 0.5))
- (if (fneq (vct-ref v 1) 0.5) (snd-display ";run set (v 1): ~A" (vct-ref v 1))))
+ (if (fneq (vct-ref v 1) 0.5) (snd-display #__line__ ";run set (v 1): ~A" (vct-ref v 1))))
(let ((v (vector 1.0 2.0 3.0)))
(let ((val (run (set! (v 1) 0.5) (vector-ref v 1))))
- (if (fneq val 0.5) (snd-display ";run vector-set (v 1): ~A" val))))
+ (if (fneq val 0.5) (snd-display #__line__ ";run vector-set (v 1): ~A" val))))
(btst '(let ((sd (make-sound-data 2 2))) (sound-data? sd)) #t)
(btst '(sound-data? "hi") #f)
@@ -48265,9 +48332,9 @@ EDITS: 1
(set! our-val (+ our-val (vct-ref v 0) (sound-data-ref sd 0 1))))))))))
(if (or (not (number? val))
(fneq val 9.6))
- (snd-display ";make-all val: ~A" val))))
+ (snd-display #__line__ ";make-all val: ~A" val))))
(lambda args
- (snd-display ";can't parse sound-data example (format)")))
+ (snd-display #__line__ ";can't parse sound-data example (format)")))
(itst '(case 1 ((1) 4) ((2 3) 5)) 4)
(stst '(case 2 ((1) "hi") ((2 3) "ho")) "ho")
@@ -48311,7 +48378,7 @@ EDITS: 1
(+ y (* dbl-var 2))
(- y 100.0)))))
1.0 6.0)
- (if (fneq dbl-var 0.0) (snd-display ";cond mid dbl (0.0): ~A" dbl-var))
+ (if (fneq dbl-var 0.0) (snd-display #__line__ ";cond mid dbl (0.0): ~A" dbl-var))
(ftsta '(lambda (y) (cond ((> y 0.0) (let ((a (+ y 2))) (* a 2)))
((< y 0.0) (abs y))
(else (set! dbl-var 1.0)
@@ -48319,7 +48386,7 @@ EDITS: 1
(+ y (* dbl-var 2))
(- y 100.0)))))
-1.0 1.0)
- (if (fneq dbl-var 0.0) (snd-display ";cond dbl (0.0): ~A" dbl-var))
+ (if (fneq dbl-var 0.0) (snd-display #__line__ ";cond dbl (0.0): ~A" dbl-var))
(ftsta '(lambda (y) (cond ((> y 0.0) (let ((a (+ y 2))) (* a 2)))
((< y 0.0) (abs y))
(else (set! dbl-var 1.0)
@@ -48327,20 +48394,20 @@ EDITS: 1
(+ y (* dbl-var 2))
(- y 100.0)))))
0.0 2.0)
- (if (fneq dbl-var 1.0) (snd-display ";cond dbl (1.0): ~A" dbl-var))
+ (if (fneq dbl-var 1.0) (snd-display #__line__ ";cond dbl (1.0): ~A" dbl-var))
(ststa '(lambda (y) (cond ((> y 0.0) "hi") ((< y 0.0) "ho") (else "ha"))) 1.0 "hi")
(ststa '(lambda (y) (cond ((> y 0.0) "hi") ((< y 0.0) "ho") (else "ha"))) 0.0 "ha")
(ststa '(lambda (y) (cond ((> y 0.0) "hi") ((< y 0.0) "ho") (else "ha"))) -1.0 "ho")
(let ((pv (list 123 321))) (run (set! int-var (car pv))))
- (if (not (= int-var 123)) (snd-display ";car local pv: ~A" int-var))
+ (if (not (= int-var 123)) (snd-display #__line__ ";car local pv: ~A" int-var))
(btst '(list? list-var) #t)
(btst '(list? int-var) #f)
(btsta '(lambda (y) (list? list-var)) 0.0 #t)
(btsta '(lambda (y) (list? dbl-var)) 0.0 #f)
(run (set! int-var (car list-var)))
- (if (not (= int-var 2)) (snd-display ";car run lst: ~A" int-var))
+ (if (not (= int-var 2)) (snd-display #__line__ ";car run lst: ~A" int-var))
(itsta '(lambda (y) (car list-var)) 0.0 2)
(itsta '(lambda (y) (cadr list-var)) 0.0 3)
(itsta '(lambda (y) (caddr list-var)) 0.0 4)
@@ -48351,17 +48418,17 @@ EDITS: 1
(itst '(cadddr list-var) 5)
(itst '(list-ref list-var 1) 3)
(let ((lv (list 321 123))) (run (set! int-var (car lv))))
- (if (not (= int-var 321)) (snd-display ";car run local lst: ~A" int-var))
+ (if (not (= int-var 321)) (snd-display #__line__ ";car run local lst: ~A" int-var))
(let ((lv (list 321 123))) (run (set! int-var (cadr lv))))
- (if (not (= int-var 123)) (snd-display ";cadr run local lst: ~A" int-var))
+ (if (not (= int-var 123)) (snd-display #__line__ ";cadr run local lst: ~A" int-var))
(let ((lv (list 321 123))) (run (set! int-var (list-ref lv 0))))
- (if (not (= int-var 321)) (snd-display ";list-ref 0 run local lst: ~A" int-var))
+ (if (not (= int-var 321)) (snd-display #__line__ ";list-ref 0 run local lst: ~A" int-var))
(btst '(null? list-var) #f)
(let ((lv '())) (run (set! int-var (if (null? lv) 1 0))))
- (if (not (= int-var 1)) (snd-display ";null? run local lst: ~A" int-var))
+ (if (not (= int-var 1)) (snd-display #__line__ ";null? run local lst: ~A" int-var))
(itst '(length list-var) 4)
(let ((lv (list 321 123))) (run (set! int-var (length lv))))
- (if (not (= int-var 2)) (snd-display ";length run local lst: ~A" int-var))
+ (if (not (= int-var 2)) (snd-display #__line__ ";length run local lst: ~A" int-var))
(itst '(cadr '(3 4)) 4)
(btst '(null? '()) #t)
@@ -48370,35 +48437,35 @@ EDITS: 1
(ftst '(vector-ref '#(0.1 1.1 2.1) 1) 1.1)
(let ((val (run-eval '(lambda (v) (declare (v char)) (char->integer v)) #\b)))
- (if (not (= val 98)) (snd-display ";char as arg to run: ~A" val)))
+ (if (not (= val 98)) (snd-display #__line__ ";char as arg to run: ~A" val)))
(let ((val (run-eval '(lambda (v) (declare (v integer)) (+ 1 v)) 32)))
- (if (not (= val 33)) (snd-display ";integer as arg to run: ~A" val)))
+ (if (not (= val 33)) (snd-display #__line__ ";integer as arg to run: ~A" val)))
(let ((val (run-eval '(lambda (v) (declare (v real)) (* v 2)) 1.3)))
- (if (fneq val 2.6) (snd-display ";real as arg to run: ~A" val)))
+ (if (fneq val 2.6) (snd-display #__line__ ";real as arg to run: ~A" val)))
(let ((val (run-eval '(lambda (v) (declare (v string)) (string-length v)) "hiho")))
- (if (not (= val 4)) (snd-display ";string as arg to run: ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";string as arg to run: ~A" val)))
(let ((val (run-eval '(lambda (v) (declare (v boolean)) (not v)) #t)))
- (if val (snd-display ";boolean as arg to run: ~A" val)))
+ (if val (snd-display #__line__ ";boolean as arg to run: ~A" val)))
(let ((val (run-eval '(lambda (gen) (declare (gen clm)) (mus-frequency gen)) (make-oscil 440))))
- (if (fneq val 440.0) (snd-display ";clm gen as arg to run: ~A" val)))
+ (if (fneq val 440.0) (snd-display #__line__ ";clm gen as arg to run: ~A" val)))
(let ((val (run-eval '(lambda (v) (declare (v vct)) (vct-ref v 0)) (make-vct 3 1.5))))
- (if (fneq val 1.5) (snd-display ";vct as arg to run: ~A" val)))
+ (if (fneq val 1.5) (snd-display #__line__ ";vct as arg to run: ~A" val)))
(let* ((gen (make-oscil))
(val (run (lambda () (mus-generator? gen)))))
- (if (not val) (snd-display ";run mus-generator? oscil")))
+ (if (not val) (snd-display #__line__ ";run mus-generator? oscil")))
(let* ((gen (make-nssb))
(val (run (mus-generator? gen))))
- (if (not val) (snd-display ";run mus-generator? nssb")))
+ (if (not val) (snd-display #__line__ ";run mus-generator? nssb")))
(let* ((gen 123)
(val (run (lambda () (mus-generator? gen)))))
- (if val (snd-display ";run mus-generator? 123")))
+ (if val (snd-display #__line__ ";run mus-generator? 123")))
(let ((val (run-eval '(lambda (y) (let ((ge (make-env '(0 1 1 1) :length 11))) (env ge))) 0.0)))
- (if (fneq val 1.0) (snd-display ";make-env in run: ~A" val)))
+ (if (fneq val 1.0) (snd-display #__line__ ";make-env in run: ~A" val)))
(let ((val (run-eval '(lambda (y) (let ((ge (make-env l0111 :length 11))) (env ge))) 0.0)))
- (if (fneq val 1.0) (snd-display ";make-env in run with var list: ~A" val)))
+ (if (fneq val 1.0) (snd-display #__line__ ";make-env in run with var list: ~A" val)))
(let ((x 0.0))
(run
@@ -48407,7 +48474,7 @@ EDITS: 1
(env e)
(set! x (env e))
x)))
- (if (fneq x .1) (snd-display ";make-env in run 0: ~A" x)))
+ (if (fneq x .1) (snd-display #__line__ ";make-env in run 0: ~A" x)))
(let ((x 0.0)
(samps 11)
@@ -48418,7 +48485,7 @@ EDITS: 1
(env e)
(set! x (env e))
x)))
- (if (fneq x .1) (snd-display ";make-env in run 1: ~A" x)))
+ (if (fneq x .1) (snd-display #__line__ ";make-env in run 1: ~A" x)))
(let ((x 0.0))
(run
@@ -48429,7 +48496,7 @@ EDITS: 1
(env e)
(set! x (env e))
x)))
- (if (fneq x .1) (snd-display ";make-env in run 2: ~A" x)))
+ (if (fneq x .1) (snd-display #__line__ ";make-env in run 2: ~A" x)))
(let ((x 0.0))
(run
@@ -48440,7 +48507,7 @@ EDITS: 1
(env e)
(set! x (env e))
x)))
- (if (fneq x .1) (snd-display ";make-env in run 3: ~A" x)))
+ (if (fneq x .1) (snd-display #__line__ ";make-env in run 3: ~A" x)))
(let ((x 0.0))
(run
@@ -48450,7 +48517,7 @@ EDITS: 1
(env e)
(set! x (env e))
x)))
- (if (fneq x .1) (snd-display ";make-env in run 4: ~A" x)))
+ (if (fneq x .1) (snd-display #__line__ ";make-env in run 4: ~A" x)))
(btst '(let ((gen (make-all-pass))) (all-pass? gen)) #t)
(btst '(let ((gen (make-all-pass))) (if gen #t #f)) #t)
@@ -48610,17 +48677,17 @@ EDITS: 1
(let ((tst 0.0))
(run (set! tst (st3-one svar)))
- (if (not (= tst 1)) (snd-display ";run st3-one: ~A ~A" tst (st3-one svar)))
+ (if (not (= tst 1)) (snd-display #__line__ ";run st3-one: ~A ~A" tst (st3-one svar)))
(run (set! bst3 (st3? svar)))
- (if (not bst3) (snd-display ";st3? ~A" (st3? svar))))
+ (if (not bst3) (snd-display #__line__ ";st3? ~A" (st3? svar))))
(set! svar (make-st4))
(let ((tst 0))
(run (set! tst (st4-one svar)))
- (if (not (= tst 1)) (snd-display ";run st4-one: ~A ~A" tst (st4-one svar)))
+ (if (not (= tst 1)) (snd-display #__line__ ";run st4-one: ~A ~A" tst (st4-one svar)))
(ftst '(st4-two svar) 2.0)
(run (set! bst4 (st4? svar)))
- (if (not bst4) (snd-display ";st4? ~A ~A" svar (st4? svar))))
+ (if (not bst4) (snd-display #__line__ ";st4? ~A ~A" svar (st4? svar))))
(set! svar (make-st3 :one 1.0 :two 2.0))
(set! svar1 (make-st3 :one 2.0 :two 3.0))
@@ -48629,65 +48696,65 @@ EDITS: 1
(tst2 0.0)
(tst3 0.0))
(run
- (if (not (c-g?)) (set! tst (st3-two svar))) ;2
- (set! tst1 (st3-two svar1)) ;3
- (set! (st3-two svar) (st3-two svar1))
- (set! tst2 (st3-two svar)) ;3
- (set! (st3-one svar1) 123.0)
- (set! tst3 (st3-one svar1))) ;123
- (if (fneq tst 2) (snd-display ";run st3-two (2): ~A ~A" tst (st3-two svar)))
- (if (fneq tst1 3) (snd-display ";run st3-two (3): ~A ~A" tst (st3-two svar1)))
- (if (fneq tst2 3) (snd-display ";run st3-two (2->3): ~A ~A" tst (st3-two svar)))
- (if (fneq tst3 123) (snd-display ";run st3-one (123): ~A ~A" tst (st3-one svar1))))
+ (if (not (c-g?)) (set! tst (st3-two svar))) ;2
+ (set! tst1 (st3-two svar1)) ;3
+ (set! (st3-two svar) (st3-two svar1))
+ (set! tst2 (st3-two svar)) ;3
+ (set! (st3-one svar1) 123.0)
+ (set! tst3 (st3-one svar1))) ;123
+ (if (fneq tst 2) (snd-display #__line__ ";run st3-two (2): ~A ~A" tst (st3-two svar)))
+ (if (fneq tst1 3) (snd-display #__line__ ";run st3-two (3): ~A ~A" tst (st3-two svar1)))
+ (if (fneq tst2 3) (snd-display #__line__ ";run st3-two (2->3): ~A ~A" tst (st3-two svar)))
+ (if (fneq tst3 123) (snd-display #__line__ ";run st3-one (123): ~A ~A" tst (st3-one svar1))))
;; restore tests
- (if (fneq (st3-one svar) 1.0) (snd-display ";restore st3-one (1): ~A" (st3-one svar)))
- (if (fneq (st3-one svar1) 123.0) (snd-display ";restore st3-one (123): ~A" (st3-one svar1)))
- (if (fneq (st3-two svar) 3.0) (snd-display ";restore st3-two (2->3): ~A" (st3-two svar)))
- (if (fneq (st3-two svar1) 3.0) (snd-display ";restore st3-two (3): ~A" (st3-two svar1)))
+ (if (fneq (st3-one svar) 1.0) (snd-display #__line__ ";restore st3-one (1): ~A" (st3-one svar)))
+ (if (fneq (st3-one svar1) 123.0) (snd-display #__line__ ";restore st3-one (123): ~A" (st3-one svar1)))
+ (if (fneq (st3-two svar) 3.0) (snd-display #__line__ ";restore st3-two (2->3): ~A" (st3-two svar)))
+ (if (fneq (st3-two svar1) 3.0) (snd-display #__line__ ";restore st3-two (3): ~A" (st3-two svar1)))
(let ((val (run-eval '(lambda (y) (declare (y hiho1)) (hiho1-ii y)) hi1)))
- (if (not (= val 3)) (snd-display ";typed hiho1-ii: ~A" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";typed hiho1-ii: ~A" val)))
(let ((val (run-eval '(lambda (y) (declare (y hiho1)) (hiho1-xx y)) hif2)))
- (if (or (not (number? val)) (fneq val 3.14)) (snd-display ";typed hiho1-xx: ~A" val)))
+ (if (or (not (number? val)) (fneq val 3.14)) (snd-display #__line__ ";typed hiho1-xx: ~A" val)))
(let ((val (run-eval '(lambda (x y) (declare (x hiho1) (y hiho1)) (+ (hiho1-xx y) (hiho1-xx x))) hi1 hif2)))
- (if (or (not (number? val)) (fneq val 4.14)) (snd-display ";typed hiho1-xx+xx: ~A" val)))
+ (if (or (not (number? val)) (fneq val 4.14)) (snd-display #__line__ ";typed hiho1-xx+xx: ~A" val)))
(let ((val (run-eval '(lambda (y) (declare (y hiho1)) y) hi1)))
- (if (not (hiho1? val)) (snd-display ";clm-struct return: ~A" val)))
+ (if (not (hiho1? val)) (snd-display #__line__ ";clm-struct return: ~A" val)))
(let ((tag (catch 'cannot-parse
(lambda () (run-eval '(set! (hiho1-ii hi1) "ho")))
(lambda args (car args)))))
(if (not (eq? tag 'cannot-parse))
- (snd-display ";set def-clm-struct type check? ~A" tag)))
+ (snd-display #__line__ ";set def-clm-struct type check? ~A" tag)))
(let ((tag (catch 'cannot-parse
(lambda () (run-eval '(let ((r (make-sampler))) (format #f "~A" r))))
(lambda args (car args)))))
(if (not (eq? tag 'cannot-parse))
- (snd-display ";format arg type check? ~A" tag)))
+ (snd-display #__line__ ";format arg type check? ~A" tag)))
;; this is testing a missing quote??
(let ((tag (catch #t (lambda () (run-eval (lambda () (eq? .3 .2)))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";cannot parse case: ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";cannot parse case: ~A" tag)))
(let ((val (run-eval '(lambda (y) (declare (y hiho2)) (vct-ref (hiho2-v y) 1)) hi2)))
- (if (fneq val .1) (snd-display ";typed hiho2-v: ~A" val))
+ (if (fneq val .1) (snd-display #__line__ ";typed hiho2-v: ~A" val))
(run-eval '(lambda (y) (declare (y hiho2)) (vct-set! (hiho2-v y) 2 3.14)) hi2)
(if (fneq (vct-ref (hiho2-v hi2) 2) 3.14)
- (snd-display ";vct-set hiho2-v: ~A" (vct-ref (hiho2-v hi2) 2))))
+ (snd-display #__line__ ";vct-set hiho2-v: ~A" (vct-ref (hiho2-v hi2) 2))))
(let ((val (run-eval '(lambda (y) (declare (y hiho2)) (hiho2-i y)) hi2)))
- (if (not (= val 0)) (snd-display ";typed hiho2-i: ~A" val))
+ (if (not (= val 0)) (snd-display #__line__ ";typed hiho2-i: ~A" val))
(set! val (run-eval '(lambda (y) (declare (y hiho2)) (set! (hiho2-i y) 2) (hiho2-i y)) hi2))
- (if (not (= val 2)) (snd-display ";inner set hiho2-i: ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";inner set hiho2-i: ~A" val)))
(let ((val (run-eval '(lambda (y) (declare (y hiho2)) (hiho2-x y)) hi2)))
- (if (fneq val 0.0) (snd-display ";hiho2-x: ~A" val))
+ (if (fneq val 0.0) (snd-display #__line__ ";hiho2-x: ~A" val))
(set! val (run-eval '(lambda (y) (declare (y hiho2)) (set! (hiho2-x y) 3.14) (hiho2-x y)) hi2))
- (if (fneq val 3.14) (snd-display ";inner set hiho2-x: ~A" val)))
+ (if (fneq val 3.14) (snd-display #__line__ ";inner set hiho2-x: ~A" val)))
;; this tests the fallback process
(let ((lst (list 1 2 (vct-fill! (make-vct 4) 3.14) 3))
(k 123.0))
(run (set! k (vct-ref (list-ref lst 2) 1)))
- (if (fneq k 3.14) (snd-display ";list-ref ->vct: ~A" k)))
+ (if (fneq k 3.14) (snd-display #__line__ ";list-ref ->vct: ~A" k)))
(itst '(mus-sound-samples "oboe.snd") 50828)
(itst '(mus-sound-length "oboe.snd") 101684)
@@ -48747,7 +48814,7 @@ EDITS: 1
(ftst '(contrast-enhancement 0.1 0.75) (sin (+ (* 0.1 (/ pi 2)) (* .75 (sin (* 0.1 2.0 pi))))))
(itst '(seconds->samples 1.0) 22050)
(itst '(seconds->samples 1) 22050)
-
+
(etst '(mus-sound-samples 1))
(etst '(mus-sound-length 3.14))
(etst '(mus-sound-frames #\c))
@@ -48782,10 +48849,10 @@ EDITS: 1
(etst '(oscil g-gen 1.0 2.0 3.0))
(ftst '(mus-srate) 22050.0)
- ;(ftst '(set! (mus-srate) 44100.0) 44100.0)
- ;(ftst '(set! (mus-srate) 22050) 22050.0)
- ;(etst '(mus-srate 0.0))
- ;(etst '(set! (mus-srate) "hi"))
+ ;(ftst '(set! (mus-srate) 44100.0) 44100.0)
+ ;(ftst '(set! (mus-srate) 22050) 22050.0)
+ ;(etst '(mus-srate 0.0))
+ ;(etst '(set! (mus-srate) "hi"))
(btst '(< (mus-random 1.0) 2.0) #t)
(btst '(>= (mus-random 1.0) -1.0) #t)
(set! (mus-srate) old-srate))
@@ -48793,30 +48860,30 @@ EDITS: 1
(let ((mx 0.0)
(mn 0.0))
(run
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (let ((val (mus-random 1.0)))
- (if (or (= i 0) (< val mn)) (set! mn val))
- (if (or (= i 0) (> val mx)) (set! mx val)))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 100))
+ (let ((val (mus-random 1.0)))
+ (if (or (= i 0) (< val mn)) (set! mn val))
+ (if (or (= i 0) (> val mx)) (set! mx val)))))
(if (= mx mn)
- (snd-display ";optimized mus-random is a constant: ~A" mx)
+ (snd-display #__line__ ";optimized mus-random is a constant: ~A" mx)
(begin
- (if (< (- mx mn) 1.0) (snd-display ";optimized mus-random range: ~A ~A" mn mx))
- (if (or (>= mn 0.0) (<= mx 0.0)) (snd-display ";optimized mus-random range odd: ~A ~A" mn mx)))))
+ (if (< (- mx mn) 1.0) (snd-display #__line__ ";optimized mus-random range: ~A ~A" mn mx))
+ (if (or (>= mn 0.0) (<= mx 0.0)) (snd-display #__line__ ";optimized mus-random range odd: ~A ~A" mn mx)))))
(let ((mx 0.0)
(mn 0.0))
(run
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (let ((val (random 1.0)))
- (if (or (= i 0) (< val mn)) (set! mn val))
- (if (or (= i 0) (> val mx)) (set! mx val)))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 100))
+ (let ((val (random 1.0)))
+ (if (or (= i 0) (< val mn)) (set! mn val))
+ (if (or (= i 0) (> val mx)) (set! mx val)))))
(if (= mx mn)
- (snd-display ";optimized random is a constant: ~A" mx)
+ (snd-display #__line__ ";optimized random is a constant: ~A" mx)
(begin
- (if (< (- mx mn) 0.5) (snd-display ";optimized random range: ~A ~A" mn mx))
- (if (or (< mn 0.0) (> mx 1.0)) (snd-display ";optimized random range odd: ~A ~A" mn mx)))))
+ (if (< (- mx mn) 0.5) (snd-display #__line__ ";optimized random range: ~A ~A" mn mx))
+ (if (or (< mn 0.0) (> mx 1.0)) (snd-display #__line__ ";optimized random range odd: ~A ~A" mn mx)))))
(if with-gui
(let* ((ind (sound->integer (open-sound "oboe.snd")))
@@ -48829,32 +48896,32 @@ EDITS: 1
(btst '(let ((a (make-sampler)) (b (make-sampler))) (or (eq? a b) (eqv? a b) (equal? a b))) #f)
(let ((ok #f))
(run (set! ok (sound? ind)))
- (if (not ok) (snd-display ";run sound?")))
+ (if (not ok) (snd-display #__line__ ";run sound?")))
(let ((ok #f))
(run (set! ok (sound? (+ 1 ind))))
- (if ok (snd-display ";run not sound?")))
+ (if ok (snd-display #__line__ ";run not sound?")))
(let ((val (run (sample 1000))))
- (if (fneq val .0328) (snd-display ";run 1 sample 1000: ~A" val)))
+ (if (fneq val .0328) (snd-display #__line__ ";run 1 sample 1000: ~A" val)))
(let ((val (run (sample 1000 ind 0))))
- (if (fneq val .0328) (snd-display ";run 2 sample 1000: ~A" val)))
+ (if (fneq val .0328) (snd-display #__line__ ";run 2 sample 1000: ~A" val)))
(let ((val (run (sample 1000 ind 0 -1))))
- (if (fneq val .0328) (snd-display ";run 3 sample 1000: ~A" val)))
+ (if (fneq val .0328) (snd-display #__line__ ";run 3 sample 1000: ~A" val)))
(let ((val (run (sample 1000 ind 0 0))))
- (if (fneq val .0328) (snd-display ";run 4 sample 1000: ~A" val)))
+ (if (fneq val .0328) (snd-display #__line__ ";run 4 sample 1000: ~A" val)))
(if (string? (temp-dir))
(let ((str "hiho")
(str1 (temp-dir)))
(run (set! str (temp-dir)))
- (if (not (string=? str str1)) (snd-display ";run temp-dir: ~A ~A" str str1))))
+ (if (not (string=? str str1)) (snd-display #__line__ ";run temp-dir: ~A ~A" str str1))))
(if (string? (save-dir))
(let ((str "hiho")
(str1 (save-dir)))
(run (set! str (save-dir)))
- (if (not (string=? str str1)) (snd-display ";run save-dir: ~A ~A" str str1))))
+ (if (not (string=? str str1)) (snd-display #__line__ ";run save-dir: ~A ~A" str str1))))
(let ((mx (selection-chans))
(mx1 -1))
(run (set! mx1 (selection-chans)))
- (if (not (= mx mx1)) (snd-display ";run selection-chans: ~A ~A" mx mx1)))
+ (if (not (= mx mx1)) (snd-display #__line__ ";run selection-chans: ~A ~A" mx mx1)))
(close-sound ind)))
(let* ((ind (open-sound "oboe.snd"))
@@ -48862,23 +48929,23 @@ EDITS: 1
(v0 (make-vct 10))
(v1 (channel->vct 1490 10 ind 0)))
(run
- (if (snd->sample? gen)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v0 i (snd->sample gen (+ 1490 i))))))
+ (if (snd->sample? gen)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! v0 i (snd->sample gen (+ 1490 i))))))
(if (not (vequal v0 v1))
- (snd-display ";snd->sample: ~A ~A" v0 v1))
+ (snd-display #__line__ ";snd->sample: ~A ~A" v0 v1))
(close-sound ind)
(set! ind (open-sound "2.snd"))
(set! v1 (channel->vct 10 10 ind 1))
(set! gen (make-snd->sample ind))
(run
- (if (snd->sample? gen)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v0 i (snd->sample gen (+ 10 i) 1)))))
+ (if (snd->sample? gen)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (vct-set! v0 i (snd->sample gen (+ 10 i) 1)))))
(if (not (vequal v0 v1))
- (snd-display ";snd->sample chn 1: ~A ~A" v0 v1))
+ (snd-display #__line__ ";snd->sample chn 1: ~A ~A" v0 v1))
(close-sound ind))
(ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-ref v 1)) 1.0)
@@ -48895,30 +48962,30 @@ EDITS: 1
(let ((a 0) (v (make-vct 1)))
(vct-map! v (lambda () (do ((i 0 (+ 1 i))) ((= i 3) a) (set! a (+ 1 a)))))
- (if (not (= a 3)) (snd-display ";i a: ~A" a)))
+ (if (not (= a 3)) (snd-display #__line__ ";i a: ~A" a)))
(let ((a 0.0) (v (make-vct 1)))
(vct-map! v (lambda () (do ((i 0 (+ 1 i))) ((= i 3) a) (set! a (+ a 0.5)))))
- (if (not (= a 1.5)) (snd-display ";f a: ~A" a)))
+ (if (not (= a 1.5)) (snd-display #__line__ ";f a: ~A" a)))
(let ((a "hi") (v (make-vct 1)))
(vct-map! v (lambda () (do ((i 0 (+ 1 i))) ((= i 3) 0.0) (set! a "ho"))))
- (if (not (string=? a "ho")) (snd-display ";s a: ~A" a)))
+ (if (not (string=? a "ho")) (snd-display #__line__ ";s a: ~A" a)))
(itst '(do ((i 0 (+ 1 i))) ((= i 3) 0) (vct-scale! (make-vct 3) 1.0)) 0)
(let ((v (make-vct 8)))
(vct-set! v 4 1.0)
(run (vct-move! v 0 1))
(if (not (vequal v (vct 0 0 0 1 0 0 0 0)))
- (snd-display ";vct-move! in run: ~A" v)))
+ (snd-display #__line__ ";vct-move! in run: ~A" v)))
(let ((vect (make-vector 2 1.5))
(v (make-vct 2)))
(vct-map! v (lambda () (vector-ref vect 0)))
- (if (fneq (vct-ref v 0) 1.5) (snd-display ";f1.5 vector-ref: ~A" v)))
+ (if (fneq (vct-ref v 0) 1.5) (snd-display #__line__ ";f1.5 vector-ref: ~A" v)))
(let ((vect (make-vector 2 1))
(v (make-vct 2))
(i 0))
(vct-map! v (lambda () (set! i (vector-ref vect 0)) 0.0))
- (if (not (= i 1)) (snd-display ";i1 vector-ref: ~A" i)))
+ (if (not (= i 1)) (snd-display #__line__ ";i1 vector-ref: ~A" i)))
(let ((vect (make-vector 2))
(v (make-vct 2))
@@ -48926,29 +48993,29 @@ EDITS: 1
(vector-set! vect 0 (make-vct 2 3.0))
(vector-set! vect 1 (make-vct 2 4.0))
(vct-map! v (lambda () (vct-ref (vector-ref vect 0) 0)))
- (if (fneq (vct-ref v 0) 3.0) (snd-display ";v3.0 vector-ref: ~A" v)))
+ (if (fneq (vct-ref v 0) 3.0) (snd-display #__line__ ";v3.0 vector-ref: ~A" v)))
(let ((vect (make-vector 2 1.5))
(v (make-vct 2)))
(vct-map! v (lambda () (vector-fill! vect 2.0) (vector-ref vect 0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display ";f2.0 vector-fill: ~A" v)))
+ (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";f2.0 vector-fill: ~A" v)))
(let ((vect (make-vector 2 1))
(v (make-vct 2))
(i 0))
(vct-map! v (lambda () (vector-fill! vect 32) (set! i (vector-ref vect 0)) 0.0))
- (if (not (= i 32)) (snd-display ";i32 vector-fill: ~A" i)))
+ (if (not (= i 32)) (snd-display #__line__ ";i32 vector-fill: ~A" i)))
(let ((vect (make-vector 2 1.5))
(v (make-vct 2)))
(vct-map! v (lambda () (exact->inexact (vector-length vect))))
- (if (fneq (vct-ref v 0) 2.0) (snd-display ";f2.0 vector-length: ~A" v)))
+ (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";f2.0 vector-length: ~A" v)))
(let ((vect (make-vector 2 1))
(v (make-vct 2))
(i 0))
(vct-map! v (lambda () (set! i (vector-length vect)) 0.0))
- (if (not (= i 2)) (snd-display ";i2 vector-length: ~A" i)))
+ (if (not (= i 2)) (snd-display #__line__ ";i2 vector-length: ~A" i)))
(let ((vect (make-vector 2))
(v (make-vct 2))
@@ -48956,28 +49023,28 @@ EDITS: 1
(vector-set! vect 0 (make-vct 2 3.0))
(vector-set! vect 1 (make-vct 2 4.0))
(vct-map! v (lambda () (inexact->exact (vector-length vect))))
- (if (fneq (vct-ref v 0) 2.0) (snd-display ";v2.0 vector-length: ~A" v)))
+ (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";v2.0 vector-length: ~A" v)))
(let ((vect (make-vector 2 1.5))
(v (make-vct 2)))
(vct-map! v (lambda () (vector-set! vect 0 32.0) (vector-ref vect 0)))
- (if (fneq (vct-ref v 0) 32.0) (snd-display ";f32.0 vector-set: ~A" v)))
+ (if (fneq (vct-ref v 0) 32.0) (snd-display #__line__ ";f32.0 vector-set: ~A" v)))
(let ((vect (make-vector 2 1))
(v (make-vct 2))
(i 0))
(vct-map! v (lambda () (vector-set! vect 0 123) (set! i (vector-ref vect 0)) 0.0))
- (if (not (= i 123)) (snd-display ";i123 vector-set: ~A" i)))
+ (if (not (= i 123)) (snd-display #__line__ ";i123 vector-set: ~A" i)))
(let ((vect (make-vector 3 32))
(v (make-vct 3)))
(vct-map! v (lambda () (vector-set! vect 0 123) 0.0))
- (if (not (= (vector-ref vect 0) 123)) (snd-display ";i vect set: ~A" vect)))
+ (if (not (= (vector-ref vect 0) 123)) (snd-display #__line__ ";i vect set: ~A" vect)))
(let ((vect (make-vector 3 32.0))
(v (make-vct 3)))
(vct-map! v (lambda () (vector-set! vect 0 123.0) 0.0))
- (if (fneq (vector-ref vect 0) 123.0) (snd-display ";f vect set: ~A" vect)))
+ (if (fneq (vector-ref vect 0) 123.0) (snd-display #__line__ ";f vect set: ~A" vect)))
(let ((vect (make-vector 3))
(v (make-vct 3))
@@ -48991,13 +49058,13 @@ EDITS: 1
(oscil val 0.0))))
(if (and (not (vequal v (vct 0.0 0.125 0.248)))
(not (vequal v (vct 0.0 0.063 0.125))))
- (snd-display ";vect gen vct-map 1.0: ~A" v))
+ (snd-display #__line__ ";vect gen vct-map 1.0: ~A" v))
(vct-map! v (lambda ()
(let ((val (vector-ref vect 0)))
(oscil val zero))))
(if (and (not (vequal v (vct 0.367 0.481 0.587)))
(not (vequal v (vct 0.187 0.248 0.308))))
- (snd-display ";vect gen vct-map 1.0 (phase): ~A" v)))
+ (snd-display #__line__ ";vect gen vct-map 1.0 (phase): ~A" v)))
(vector-set! clm_vector 0 (make-oscil))
(vector-set! clm_vector 1 (make-two-pole .1 .1))
@@ -49014,7 +49081,7 @@ EDITS: 1
(lambda ()
(run-eval '(lambda (y) (declare (y vct)) (vct-ref y 1))))
(lambda args (car args)))))
- (if (not (eq? tag 'wrong-number-of-args)) (snd-display ";wrong num args to run-eval: ~A" tag)))
+ (if (not (eq? tag 'wrong-number-of-args)) (snd-display #__line__ ";wrong num args to run-eval: ~A" tag)))
(let ((vect (make-vector 3))
(v (make-vct 3))
@@ -49029,7 +49096,7 @@ EDITS: 1
(oscil val 0.0))))
(if (and (not (vequal v (vct 0.0 0.0 0.125)))
(not (vequal v (vct 0.000 0.000 0.063))))
- (snd-display ";vect gen set vct-map 1.0: ~A" v)))
+ (snd-display #__line__ ";vect gen set vct-map 1.0: ~A" v)))
(let ((vect (make-vector 1))
(v (make-vct 3))
@@ -49039,7 +49106,7 @@ EDITS: 1
(oscil (vector-ref vect 0) 0.0)))
(if (and (not (vequal v (vct 0.0 0.125 0.248)))
(not (vequal v (vct 0.000 0.063 0.125))))
- (snd-display ";vect[0] gen set vct-map 1.0: ~A" v)))
+ (snd-display #__line__ ";vect[0] gen set vct-map 1.0: ~A" v)))
(let ((vect (make-vector 1))
(v (make-vct 3))
@@ -49049,7 +49116,7 @@ EDITS: 1
((vector-ref vect 0) 0.0)))
(if (and (not (vequal v (vct 0.0 0.125 0.248)))
(not (vequal v (vct 0.000 0.063 0.125))))
- (snd-display ";[vect] gen set vct-map 1.0: ~A" v)))
+ (snd-display #__line__ ";[vect] gen set vct-map 1.0: ~A" v)))
(let ((vect (make-vector 3))
(v (make-vct 3))
@@ -49060,7 +49127,7 @@ EDITS: 1
(vct-map! v (lambda ()
(let ((val (vector-ref vect 0)))
(vct-ref val 0))))
- (if (not (vequal v (vct 0.25 0.25 0.25))) (snd-display ";vect vct vct-map 1.0: ~A" v)))
+ (if (not (vequal v (vct 0.25 0.25 0.25))) (snd-display #__line__ ";vect vct vct-map 1.0: ~A" v)))
(let ((vect (make-vector 3))
(v (make-vct 3))
@@ -49073,9 +49140,9 @@ EDITS: 1
(vector-set! vect 0 v1)
(vector-fill! vect v1)
(vct-ref val 0))))
- (if (not (vequal v (vct 0.25 2.0 2.0))) (snd-display ";vect vct set vct-map 1.0: ~A" v)))
+ (if (not (vequal v (vct 0.25 2.0 2.0))) (snd-display #__line__ ";vect vct set vct-map 1.0: ~A" v)))
- (if (not (string=? (mus-describe (make-frame)) "frame[1]: [0.000]")) (snd-display ";make-frame 0 args: ~A" (mus-describe (make-frame))))
+ (if (not (string=? (mus-describe (make-frame)) "frame[1]: [0.000]")) (snd-display #__line__ ";make-frame 0 args: ~A" (mus-describe (make-frame))))
(let ((v1 (make-vector 3 1.5))
(v2 (make-vector 3 32))
@@ -49093,7 +49160,34 @@ EDITS: 1
(fneq (vector-ref v1 0) 3.14)
(fneq (vector-ref v1 1) 1.5)
(not vp))
- (snd-display ";run vector-set: ~A ~A ~A ~A" v1 v2 v3 vp)))
+ (snd-display #__line__ ";run vector-set: ~A ~A ~A ~A" v1 v2 v3 vp)))
+
+ (let ((oscs (vector (make-oscil 440.))))
+ (let ((val (run (outa 0 (oscil (oscs 0)))
+ (outa 0 (oscil (oscs 0))))))
+ (if (fneq val 0.06265)
+ (snd-display #__line__ ";run clm vector: ~A" val))))
+
+ (let ((v (vector 1 2 3 4)))
+ (let ((val (run (outa 0 (* .1 (v 1))))))
+ (if (fneq val 0.2)
+ (snd-display #__line__ ";run int vector: ~A" val))))
+
+ (let ((v (vector (vct .1 .2 .3))))
+ (let ((val (run (outa 0 (* .1 ((v 0) 1))))))
+ (if (fneq val 0.02)
+ (snd-display #__line__ ";run vct vector: ~A" val))))
+
+ (let ((v (vector 1 2 3)))
+ (let ((val (run (set! (v 1) 32) (v 1))))
+ (if (not (= val 32))
+ (snd-display #__line__ ";run set int vector: ~A" val))))
+
+ (let ((v1 (vector (vct 1 2 3))))
+ (let ((val (run ((v1 0) 1))))
+ (if (fneq val 2.0)
+ (snd-display #__line__ ";run vct + vector: ~A" val))))
+
(let ((rdat (make-vct 16))
(idat (make-vct 16))
@@ -49109,7 +49203,7 @@ EDITS: 1
0.0))
(if (or (fneq (vct-ref rdat 3) 16.0)
(fneq (vct-ref rdat 4) 0.0))
- (snd-display ";run vct fft real[3 or 4]: ~A ~A?" (vct-ref rdat 3) (vct-ref rdat 4)))
+ (snd-display #__line__ ";run vct fft real[3 or 4]: ~A ~A?" (vct-ref rdat 3) (vct-ref rdat 4)))
(vct-fill! rdat 0.0)
(vct-fill! idat 0.0)
(vct-set! rdat 3 1.0)
@@ -49119,7 +49213,7 @@ EDITS: 1
0.0))
(if (or (fneq (vct-ref rdat 3) 16.0)
(fneq (vct-ref rdat 4) 0.0))
- (snd-display ";run vct fft (2) real[3 or 4]: ~A ~A?" (vct-ref rdat 3) (vct-ref rdat 4)))
+ (snd-display #__line__ ";run vct fft (2) real[3 or 4]: ~A ~A?" (vct-ref rdat 3) (vct-ref rdat 4)))
(catch #t (lambda () (vct-map! v (lambda () (mus-fft rdat idat 16 1.5)))) (lambda args args)))
(etst '(let ((v0 (make-vct 3))) (polynomial v0 0.0 123)))
@@ -49134,7 +49228,7 @@ EDITS: 1
(multiply-arrays v0 v1 1)
0.0))
(if (not (vequal v0 (vct 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display ";run multiply-arrays[0]: ~A?" v0)))
+ (snd-display #__line__ ";run multiply-arrays[0]: ~A?" v0)))
(let ((v (make-vct 3 1.5))
(v1 (make-vct 1)))
@@ -49142,7 +49236,7 @@ EDITS: 1
(clear-array v)
1.0))
(if (not (vequal v (vct 0.0 0.0 0.0)))
- (snd-display ";run clear-array: ~A" v)))
+ (snd-display #__line__ ";run clear-array: ~A" v)))
(let ((osc (make-oscil 440.0))
(v (make-vct 1))
@@ -49157,11 +49251,11 @@ EDITS: 1
(set! (mus-frequency osc) 123.0)
(set! (mus-phase osc) 1.0)
0.0))
- (if (fneq frq 440.0) (snd-display ";run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display ";run phs: ~A" phs))
- (if (not (= cs 1)) (snd-display ";run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display ";run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display ";run mus-phase: ~A" (mus-phase osc))))
+ (if (fneq frq 440.0) (snd-display #__line__ ";run frq: ~A" frq))
+ (if (fneq phs 0.0) (snd-display #__line__ ";run phs: ~A" phs))
+ (if (not (= cs 1)) (snd-display #__line__ ";run cs: ~A" cs))
+ (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";run mus-frequency: ~A" (mus-frequency osc)))
+ (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";run mus-phase: ~A" (mus-phase osc))))
(let ((v (make-vct 10))
(gen1 (make-oscil 440))
@@ -49169,13 +49263,13 @@ EDITS: 1
(vct-map! v (lambda () (+ (gen1) (gen2))))
(if (and (not (vequal v (vct 0.000 0.250 0.496 0.735 0.962 1.173 1.367 1.538 1.686 1.807)))
(not (vequal v (vct 0.000 0.125 0.250 0.374 0.496 0.617 0.735 0.850 0.962 1.069))))
- (snd-display ";gen+gen vct-map: ~A" v)))
+ (snd-display #__line__ ";gen+gen vct-map: ~A" v)))
(let ((v (make-vct 10))
(gen1 (make-oscil 440))
(gen2 (make-oscil 440 :initial-phase pi)))
(vct-map! v (lambda () (+ (gen1) (gen2))))
- (if (fneq (vct-peak v) 0.0) (snd-display ";gen+gen-pi vct-map: ~A" v)))
+ (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi vct-map: ~A" v)))
(let ((v (make-vct 10))
(gen1 (make-oscil 440))
@@ -49184,19 +49278,19 @@ EDITS: 1
(vct-map! v (lambda () (+ (gen1) (gen2) (gen3))))
(if (and (not (vequal v (vct 0.000 0.375 0.744 1.102 1.442 1.760 2.050 2.308 2.529 2.711)))
(not (vequal v (vct 0.000 0.188 0.375 0.561 0.744 0.925 1.102 1.275 1.442 1.604))))
- (snd-display ";gen+gen+gen vct-map: ~A" v)))
+ (snd-display #__line__ ";gen+gen+gen vct-map: ~A" v)))
(let ((v (make-vct 1000))
(gen1 (make-oscil 1.0))
(gen2 (make-oscil 1.0 :initial-phase pi)))
(vct-map! v (lambda () (+ (gen1) (gen2))))
- (if (fneq (vct-peak v) 0.0) (snd-display ";gen+gen-pi 1.0: ~A" v)))
+ (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi 1.0: ~A" v)))
(let ((v (make-vct 1000))
(gen1 (make-oscil 1.0))
(gen2 (make-oscil 1.0 :initial-phase (* 1023 pi))))
(vct-map! v (lambda () (+ (gen1) (gen2))))
- (if (fneq (vct-peak v) 0.0) (snd-display ";gen+gen-pi 1.0: ~A ~A" (vct-peak v) v)))
+ (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi 1.0: ~A ~A" (vct-peak v) v)))
(let ((v (make-vct 1000))
(gen1 (make-oscil 1.0))
@@ -49205,13 +49299,13 @@ EDITS: 1
;; assume initial offset because phase is truncated to float in clm2xen
(let ((off (vct-ref v 0)))
(vct-offset! v (- off))
- (if (> (vct-peak v) 0.002) (snd-display ";gen+gen-pi 1.0(2): ~A ~A" (vct-peak v) v))))
+ (if (> (vct-peak v) 0.002) (snd-display #__line__ ";gen+gen-pi 1.0(2): ~A ~A" (vct-peak v) v))))
(let ((v (make-vct 1000))
(gen1 (make-oscil 1.0))
(gen2 (make-oscil 1.0 :initial-phase pi)))
(vct-map! v (lambda () (+ (gen1 0.0) (gen2 0.0 0.0))))
- (if (fneq (vct-peak v) 0.0) (snd-display ";gen+gen-pi+args 1.0: ~A" v)))
+ (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi+args 1.0: ~A" v)))
(let ((v1 (make-vct 10))
(v2 (make-vct 10))
@@ -49225,7 +49319,7 @@ EDITS: 1
(vct-map! v1 (lambda () (let ((val (+ (gen1 (vct-ref vr i)) (gen2 (vct-ref vr i) (vct-ref vr i))))) (set! i (+ 1 i)) val))))
(let ((i 0))
(vct-map! v2 (lambda () (let ((val (+ (oscil gen3 (vct-ref vr i)) (oscil gen4 (vct-ref vr i) (vct-ref vr i))))) (set! i (+ 1 i)) val))))
- (if (not (vequal v1 v2)) (snd-display ";gen+gen+vr args: ~A ~A" v1 v2)))
+ (if (not (vequal v1 v2)) (snd-display #__line__ ";gen+gen+vr args: ~A ~A" v1 v2)))
(let ((osc (make-ncos 440.0 3))
(v (make-vct 1))
@@ -49241,12 +49335,12 @@ EDITS: 1
(set! (mus-phase osc) 1.0)
(set! (mus-length osc) 10)
0.0))
- (if (fneq frq 440.0) (snd-display ";cs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display ";cs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display ";cs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display ";cs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display ";cs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display ";cs run set cs: ~A" (mus-length osc))))
+ (if (fneq frq 440.0) (snd-display #__line__ ";cs run frq: ~A" frq))
+ (if (fneq phs 0.0) (snd-display #__line__ ";cs run phs: ~A" phs))
+ (if (not (= cs 3)) (snd-display #__line__ ";cs run cs: ~A" cs))
+ (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";cs run mus-frequency: ~A" (mus-frequency osc)))
+ (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";cs run mus-phase: ~A" (mus-phase osc)))
+ (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";cs run set cs: ~A" (mus-length osc))))
(let ((osc (make-nsin 440.0 3))
(v (make-vct 1))
@@ -49262,12 +49356,12 @@ EDITS: 1
(set! (mus-phase osc) 1.0)
(set! (mus-length osc) 10)
0.0))
- (if (fneq frq 440.0) (snd-display ";scs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display ";scs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display ";scs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display ";scs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display ";scs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display ";scs run set cs: ~A" (mus-length osc))))
+ (if (fneq frq 440.0) (snd-display #__line__ ";scs run frq: ~A" frq))
+ (if (fneq phs 0.0) (snd-display #__line__ ";scs run phs: ~A" phs))
+ (if (not (= cs 3)) (snd-display #__line__ ";scs run cs: ~A" cs))
+ (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";scs run mus-frequency: ~A" (mus-frequency osc)))
+ (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";scs run mus-phase: ~A" (mus-phase osc)))
+ (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";scs run set cs: ~A" (mus-length osc))))
(let ((osc (make-ncos 440.0 3))
(v (make-vct 1))
@@ -49283,12 +49377,12 @@ EDITS: 1
(set! (mus-phase osc) 1.0)
(set! (mus-length osc) 10)
0.0))
- (if (fneq frq 440.0) (snd-display ";cs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display ";cs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display ";cs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display ";cs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display ";cs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display ";cs run set cs: ~A" (mus-length osc))))
+ (if (fneq frq 440.0) (snd-display #__line__ ";cs run frq: ~A" frq))
+ (if (fneq phs 0.0) (snd-display #__line__ ";cs run phs: ~A" phs))
+ (if (not (= cs 3)) (snd-display #__line__ ";cs run cs: ~A" cs))
+ (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";cs run mus-frequency: ~A" (mus-frequency osc)))
+ (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";cs run mus-phase: ~A" (mus-phase osc)))
+ (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";cs run set cs: ~A" (mus-length osc))))
(let ((osc (make-nsin 440.0 3))
(v (make-vct 1))
@@ -49304,12 +49398,12 @@ EDITS: 1
(set! (mus-phase osc) 1.0)
(set! (mus-length osc) 10)
0.0))
- (if (fneq frq 440.0) (snd-display ";scs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display ";scs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display ";scs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display ";scs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display ";scs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display ";scs run set cs: ~A" (mus-length osc))))
+ (if (fneq frq 440.0) (snd-display #__line__ ";scs run frq: ~A" frq))
+ (if (fneq phs 0.0) (snd-display #__line__ ";scs run phs: ~A" phs))
+ (if (not (= cs 3)) (snd-display #__line__ ";scs run cs: ~A" cs))
+ (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";scs run mus-frequency: ~A" (mus-frequency osc)))
+ (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";scs run mus-phase: ~A" (mus-phase osc)))
+ (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";scs run set cs: ~A" (mus-length osc))))
(let ((zf (make-two-zero .4 .7 .3))
(pf (make-two-pole .4 .7 .3))
@@ -49325,12 +49419,12 @@ EDITS: 1
(set! p2 (two-pole pf 0.5))
(set! p3 (two-pole pf 1.0))
0.0))
- (if (fneq z1 .4) (snd-display ";run 2zero->0.4: ~A" z1))
- (if (fneq z2 .9) (snd-display ";run 2zero->0.9: ~A" z2))
- (if (fneq z3 1.05) (snd-display ";run 2zero->1.05: ~A" z3))
- (if (fneq p1 .4) (snd-display ";run a0->out 2pole: ~A" p1))
- (if (fneq p2 -.08) (snd-display ";run a0->out 2pole (-0.08): ~A" p2))
- (if (fneq p3 0.336) (snd-display ";run a0->out 2pole (0.336): ~A" p3)))
+ (if (fneq z1 .4) (snd-display #__line__ ";run 2zero->0.4: ~A" z1))
+ (if (fneq z2 .9) (snd-display #__line__ ";run 2zero->0.9: ~A" z2))
+ (if (fneq z3 1.05) (snd-display #__line__ ";run 2zero->1.05: ~A" z3))
+ (if (fneq p1 .4) (snd-display #__line__ ";run a0->out 2pole: ~A" p1))
+ (if (fneq p2 -.08) (snd-display #__line__ ";run a0->out 2pole (-0.08): ~A" p2))
+ (if (fneq p3 0.336) (snd-display #__line__ ";run a0->out 2pole (0.336): ~A" p3)))
(let ((ind (open-sound "oboe.snd")))
;; ycoeff is after old end, so there's some small hope this could catch incomplete class declarations
@@ -49341,7 +49435,7 @@ EDITS: 1
(mus-ycoeff (n) 0))
(lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";~A ~A" n tag))))
+ (snd-display #__line__ ";~A ~A" n tag))))
(list make-all-pass make-asymmetric-fm make-snd->sample make-moving-average make-comb make-filtered-comb make-delay make-frame make-granulate
make-locsig make-mixer make-notch make-oscil make-pulse-train make-rand make-rand-interp make-sawtooth-wave
make-nrxysin make-nrxycos make-square-wave make-src make-ncos
@@ -49353,8 +49447,8 @@ EDITS: 1
(v (make-vct 3)))
(vct-map! v (lambda ()
(mus-set-formant-radius-and-frequency frm 2.0 100.0)))
- (if (fneq (mus-scaler frm) 2.0) (snd-display ";run set-radius-etc: ~A" (mus-scaler frm)))
- (if (fneq (mus-frequency frm) 100.0) (snd-display ";run set-radius-etc (frq): ~A" (mus-frequency frm))))
+ (if (fneq (mus-scaler frm) 2.0) (snd-display #__line__ ";run set-radius-etc: ~A" (mus-scaler frm)))
+ (if (fneq (mus-frequency frm) 100.0) (snd-display #__line__ ";run set-radius-etc (frq): ~A" (mus-frequency frm))))
(let ((v (make-vct 3)))
(vct-map! v (let ((i 0))
@@ -49364,7 +49458,7 @@ EDITS: 1
(let ((res (vct-ref v0 i)))
(set! i (+ 1 i))
res)))))
- (if (not (vequal v (vct .1 2.0 .1))) (snd-display ";run make-vct: ~A" v)))
+ (if (not (vequal v (vct .1 2.0 .1))) (snd-display #__line__ ";run make-vct: ~A" v)))
(let ((val (run-eval '(let ((fr (make-frame 2 0.0 0.0)))
(frame-set! fr 0 1)
@@ -49372,93 +49466,93 @@ EDITS: 1
fr))))
(if (or (fneq (frame-ref val 0) 1.0)
(fneq (frame-ref val 1) 2.0))
- (snd-display ";frame-set int opt: ~A" val)))
+ (snd-display #__line__ ";frame-set int opt: ~A" val)))
(let ((val (run-eval '(let ((fr (make-frame 2 0.0 0.0)))
- (frame-set! fr 0 (inexact->exact (floor 1.4)))
+ (frame-set! fr 0 (floor 1.4))
(frame-set! fr 1 3/4)
fr))))
(if (or (fneq (frame-ref val 0) 1.0)
(fneq (frame-ref val 1) 0.75))
- (snd-display ";frame-set int opt 1: ~A" val)))
+ (snd-display #__line__ ";frame-set int opt 1: ~A" val)))
(let ((val (run-eval '(let ((mx (make-mixer 2 1 0 0 1)))
(mixer-set! mx 0 0 2)
(mixer-set! mx 1 0 3/4)
- (mixer-set! mx 1 1 (inexact->exact (floor 3.14)))
+ (mixer-set! mx 1 1 (floor 3.14))
(mixer-set! mx 0 1 (+ 32 1))
mx))))
(if (or (fneq (mixer-ref val 0 0) 2.0)
(fneq (mixer-ref val 1 0) 0.75)
(fneq (mixer-ref val 0 1) 33.0)
(fneq (mixer-ref val 1 1) 3))
- (snd-display ";mixer-set int opt: ~A" val)))
+ (snd-display #__line__ ";mixer-set int opt: ~A" val)))
(let ((fr1 (run (frame .1 .2)))
(fr2 (make-frame 2 .1 .2)))
(if (not (equal? fr1 fr2))
- (snd-display ";frame...: ~A ~A" fr1 fr2)))
+ (snd-display #__line__ ";frame...: ~A ~A" fr1 fr2)))
(let ((fr1 (frame .1)))
- (if (fneq (run (fr1 0)) .1) (snd-display ";frame gen ref (.1): ~A" (fr1 0)))
+ (if (fneq (run (fr1 0)) .1) (snd-display #__line__ ";frame gen ref (.1): ~A" (fr1 0)))
(run (set! (fr1 0) .2))
- (if (fneq (fr1 0) .2) (snd-display ";frame gen ref (.2): ~A" (fr1 0)))
+ (if (fneq (fr1 0) .2) (snd-display #__line__ ";frame gen ref (.2): ~A" (fr1 0)))
(if (not (equal? fr1 (frame .2)))
- (snd-display ";frame gen set! (.2): ~A" fr1)))
+ (snd-display #__line__ ";frame gen set! (.2): ~A" fr1)))
(let ((fr1 (frame .1 .2 .3 .4)))
(run (set! (fr1 2) (+ (fr1 1) (fr1 2))))
- (if (fneq (fr1 2) .5) (snd-display ";frame gen ref/set (.5): ~A" (fr1 2))))
+ (if (fneq (fr1 2) .5) (snd-display #__line__ ";frame gen ref/set (.5): ~A" (fr1 2))))
(let ((mx (run (lambda () (mixer .1 .2 .3 .4)))))
- (if (fneq (mx 0 0) .1) (snd-display ";mixer gen ref (.1): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 .4))) (snd-display ";mixer...: ~A" mx))
+ (if (fneq (mx 0 0) .1) (snd-display #__line__ ";mixer gen ref (.1): ~A" (mx 0 0)))
+ (if (not (equal? mx (make-mixer 2 .1 .2 .3 .4))) (snd-display #__line__ ";mixer...: ~A" mx))
(run (lambda () (set! (mx 0 0) .5)))
- (if (fneq (mx 0 0) .5) (snd-display ";mixer gen set (.5): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .5 .2 .3 .4))) (snd-display ";mixer... (after set): ~A" mx))
- (if (fneq (mx 1 0) .3) (snd-display ";mixer gen ref (.3): ~A" (mx 1 0)))
+ (if (fneq (mx 0 0) .5) (snd-display #__line__ ";mixer gen set (.5): ~A" (mx 0 0)))
+ (if (not (equal? mx (make-mixer 2 .5 .2 .3 .4))) (snd-display #__line__ ";mixer... (after set): ~A" mx))
+ (if (fneq (mx 1 0) .3) (snd-display #__line__ ";mixer gen ref (.3): ~A" (mx 1 0)))
(run (lambda () (set! (mx 0 1) .5)))
- (if (fneq (mx 0 1) .5) (snd-display ";mixer (0 1) gen set (.5): ~A" (mx 0 1)))
- (if (not (equal? mx (make-mixer 2 .5 .5 .3 .4))) (snd-display ";mixer... (after set 1): ~A" mx)))
+ (if (fneq (mx 0 1) .5) (snd-display #__line__ ";mixer (0 1) gen set (.5): ~A" (mx 0 1)))
+ (if (not (equal? mx (make-mixer 2 .5 .5 .3 .4))) (snd-display #__line__ ";mixer... (after set 1): ~A" mx)))
(let ((mx (mixer .1)))
- (if (not (equal? mx (make-mixer 1 .1))) (snd-display ";mixer .1: ~A" mx))
- (if (fneq (run (lambda () (mx 0 0))) .1) (snd-display ";mixer (1) gen ref (.1): ~A" (mx 0 0)))
+ (if (not (equal? mx (make-mixer 1 .1))) (snd-display #__line__ ";mixer .1: ~A" mx))
+ (if (fneq (run (lambda () (mx 0 0))) .1) (snd-display #__line__ ";mixer (1) gen ref (.1): ~A" (mx 0 0)))
(run (lambda () (set! (mx 0 0) .5)))
- (if (fneq (run (lambda () (mx 0 0))) .5) (snd-display ";mixer (1) gen set (.5): ~A" (mx 0 0))))
+ (if (fneq (run (lambda () (mx 0 0))) .5) (snd-display #__line__ ";mixer (1) gen set (.5): ~A" (mx 0 0))))
(let ((mx (run (lambda () (mixer .1 .2 .3)))))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 0.0))) (snd-display ";mixer .1 .2 .3: ~A" mx))
+ (if (not (equal? mx (make-mixer 2 .1 .2 .3 0.0))) (snd-display #__line__ ";mixer .1 .2 .3: ~A" mx))
(run (lambda () (set! (mx 1 1) .5)))
- (if (fneq (run (lambda () (mx 1 1))) .5) (snd-display ";mixer (1 1) gen set (.5): ~A" (mx 1 1))))
+ (if (fneq (run (lambda () (mx 1 1))) .5) (snd-display #__line__ ";mixer (1 1) gen set (.5): ~A" (mx 1 1))))
(let ((sd (make-sound-data 1 1)))
- (if (fneq (run (lambda () (sd 0 0))) 0.0) (snd-display ";sound-data ref: ~A" (sd 0 0)))
+ (if (fneq (run (lambda () (sd 0 0))) 0.0) (snd-display #__line__ ";sound-data ref: ~A" (sd 0 0)))
(run (lambda () (set! (sd 0 0) 1.0)))
- (if (fneq (sd 0 0) 1.0) (snd-display ";sound-data set: ~A" (sd 0 0)))
+ (if (fneq (sd 0 0) 1.0) (snd-display #__line__ ";sound-data set: ~A" (sd 0 0)))
(if (not (equal? sd (let ((sd1 (make-sound-data 1 1))) (sound-data-set! sd1 0 0 1.0) sd1)))
- (snd-display ";sound-data set not equal: ~A" sd)))
+ (snd-display #__line__ ";sound-data set not equal: ~A" sd)))
(let ((sd (make-sound-data 2 3)))
- (if (fneq (sd 0 0) 0.0) (snd-display ";sound-data ref (1): ~A" (sd 0 0)))
+ (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";sound-data ref (1): ~A" (sd 0 0)))
(run (lambda () (set! (sd 1 0) 1.0)))
- (if (fneq (run (lambda () (sd 1 0))) 1.0) (snd-display ";sound-data set (1 0): ~A" (sd 1 0)))
+ (if (fneq (run (lambda () (sd 1 0))) 1.0) (snd-display #__line__ ";sound-data set (1 0): ~A" (sd 1 0)))
(run (lambda () (set! (sd 1 2) 2.0)))
- (if (fneq (run (lambda () (sd 1 2))) 2.0) (snd-display ";sound-data set (1 2): ~A" (sd 1 2)))
+ (if (fneq (run (lambda () (sd 1 2))) 2.0) (snd-display #__line__ ";sound-data set (1 2): ~A" (sd 1 2)))
(if (not (equal? sd (let ((sd1 (make-sound-data 2 3)))
(sound-data-set! sd1 1 0 1.0)
(sound-data-set! sd1 1 2 2.0)
sd1)))
- (snd-display ";sound-data set (3) not equal: ~A" sd)))
+ (snd-display #__line__ ";sound-data set (3) not equal: ~A" sd)))
(let ((val (run-eval '(let ((loc (make-locsig :channels 2)))
(locsig-set! loc 0 32)
(locsig-set! loc 1 3/4)
(+ (locsig-ref loc 0)
(locsig-ref loc 1))))))
- (if (fneq val 32.75) (snd-display ";locsig-set int opt: ~A" val)))
+ (if (fneq val 32.75) (snd-display #__line__ ";locsig-set int opt: ~A" val)))
(set! (locsig-type) mus-interp-linear)
(let* ((rev (make-frame->file "fmv4.reverb" 1 mus-bshort mus-next))
@@ -49487,116 +49581,116 @@ EDITS: 1
(locsig-reverb-set! loc 0 .23)
(set! (locsig-reverb-ref loc 0) .123)
0.0))
- (if (fneq d0 .667) (snd-display ";run locsig ref 0: ~A" d0))
- (if (fneq d1 .333) (snd-display ";run locsig ref 1: ~A" d1))
- (if (fneq dr .1) (snd-display ";run locsig reverb ref 0: ~A" dr))
- (if (not (= cs 2)) (snd-display ";run mus-channels: ~A" cs))
- (if (fneq d01 .167) (snd-display ";run locsig ref 01: ~A" d01))
- (if (fneq d11 .333) (snd-display ";run locsig ref 11: ~A" d11))
- (if (fneq dr1 .0707) (snd-display ";run locsig reverb ref 01: ~A" dr1))
- (if (fneq (locsig-ref loc 0) .123) (snd-display ";run set loc 0: ~A" (locsig-ref loc 0)))
- (if (fneq (locsig-ref loc 1) .23) (snd-display ";run set loc 1: ~A" (locsig-ref loc 1)))
- (if (fneq (locsig-reverb-ref loc 0) .123) (snd-display ";run set loc rev 0: ~A" (locsig-reverb-ref loc 0)))
+ (if (fneq d0 .667) (snd-display #__line__ ";run locsig ref 0: ~A" d0))
+ (if (fneq d1 .333) (snd-display #__line__ ";run locsig ref 1: ~A" d1))
+ (if (fneq dr .1) (snd-display #__line__ ";run locsig reverb ref 0: ~A" dr))
+ (if (not (= cs 2)) (snd-display #__line__ ";run mus-channels: ~A" cs))
+ (if (fneq d01 .167) (snd-display #__line__ ";run locsig ref 01: ~A" d01))
+ (if (fneq d11 .333) (snd-display #__line__ ";run locsig ref 11: ~A" d11))
+ (if (fneq dr1 .0707) (snd-display #__line__ ";run locsig reverb ref 01: ~A" dr1))
+ (if (fneq (locsig-ref loc 0) .123) (snd-display #__line__ ";run set loc 0: ~A" (locsig-ref loc 0)))
+ (if (fneq (locsig-ref loc 1) .23) (snd-display #__line__ ";run set loc 1: ~A" (locsig-ref loc 1)))
+ (if (fneq (locsig-reverb-ref loc 0) .123) (snd-display #__line__ ";run set loc rev 0: ~A" (locsig-reverb-ref loc 0)))
(mus-close rev))
(let* ((outp (make-sound-data 1 10))
(gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 1)) (snd-display ";(opt)make-locsig->sd chans (1): ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";(opt)make-locsig->sd chans (1): ~A" (mus-channels gen)))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display ";(opt)locsig->sd chan 0: ~A" (sound-data->vct outp 0))))
+ (snd-display #__line__ ";(opt)locsig->sd chan 0: ~A" (sound-data->vct outp 0))))
(let* ((outp (make-sound-data 2 10))
(gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display ";(opt)make-locsig->sd chans: ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";(opt)make-locsig->sd chans: ~A" (mus-channels gen)))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display ";(opt)locsig->sd chan 0: ~A" (sound-data->vct outp 0)))
+ (snd-display #__line__ ";(opt)locsig->sd chan 0: ~A" (sound-data->vct outp 0)))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.0)))
- (snd-display ";(opt)locsig->sd chan 1: ~A" (sound-data->vct outp 1))))
+ (snd-display #__line__ ";(opt)locsig->sd chan 1: ~A" (sound-data->vct outp 1))))
(let* ((outp (make-sound-data 2 10))
(gen (make-locsig 45.0 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display ";(opt)make-locsig->sd chans: ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";(opt)make-locsig->sd chans: ~A" (mus-channels gen)))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.5)))
- (snd-display ";(opt)locsig->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
+ (snd-display #__line__ ";(opt)locsig->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display ";(opt)locsig->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
+ (snd-display #__line__ ";(opt)locsig->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 0.5))))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.75)))
- (snd-display ";(opt)locsig->sd chan 0 (0.75): ~A" (sound-data->vct outp 0)))
+ (snd-display #__line__ ";(opt)locsig->sd chan 0 (0.75): ~A" (sound-data->vct outp 0)))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.75)))
- (snd-display ";(opt)locsig->sd chan 1 (0.75): ~A" (sound-data->vct outp 1))))
+ (snd-display #__line__ ";(opt)locsig->sd chan 1 (0.75): ~A" (sound-data->vct outp 1))))
(let* ((outp (make-vct 10))
(gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 1)) (snd-display ";(opt)make-locsig->vct chans: ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";(opt)make-locsig->vct chans: ~A" (mus-channels gen)))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))))
(if (not (vequal outp (make-vct 10 1.0)))
- (snd-display ";(opt)locsig->vct chan 0: ~A" outp))
+ (snd-display #__line__ ";(opt)locsig->vct chan 0: ~A" outp))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 0.5))))
(if (not (vequal outp (make-vct 10 1.5)))
- (snd-display ";(opt)locsig->vct chan 0: ~A" outp)))
+ (snd-display #__line__ ";(opt)locsig->vct chan 0: ~A" outp)))
(let* ((outp (make-vct 10))
(gen (make-locsig 45.0 :channels 2 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display ";(opt)make-locsig->vct chans (2): ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";(opt)make-locsig->vct chans (2): ~A" (mus-channels gen)))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))))
(if (not (vequal outp (make-vct 10 0.5)))
- (snd-display ";(opt)locsig(2)->vct chan 0: ~A" outp))
+ (snd-display #__line__ ";(opt)locsig(2)->vct chan 0: ~A" outp))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 0.5))))
(if (not (vequal outp (make-vct 10 0.75)))
- (snd-display ";(opt)locsig(2)->vct chan 0: ~A" outp)))
+ (snd-display #__line__ ";(opt)locsig(2)->vct chan 0: ~A" outp)))
(let* ((outp (make-sound-data 4 10))
(gen (make-locsig 135.0 :output outp)))
- (if (not (= (mus-channels gen) 4)) (snd-display ";(opt)make-locsig->sd chans (4): ~A" (mus-channels gen)))
+ (if (not (= (mus-channels gen) 4)) (snd-display #__line__ ";(opt)make-locsig->sd chans (4): ~A" (mus-channels gen)))
(run
(lambda ()
(do ((i 0 (+ 1 i)))
((= i 10))
(locsig gen i 1.0))))
(if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.0)))
- (snd-display ";(opt)locsig(4)->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
+ (snd-display #__line__ ";(opt)locsig(4)->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
(if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display ";(opt)locsig(4)->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
+ (snd-display #__line__ ";(opt)locsig(4)->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
(if (not (vequal (sound-data->vct outp 2) (make-vct 10 0.5)))
- (snd-display ";(opt)locsig(4)->sd chan 2 (0.5): ~A" (sound-data->vct outp 2)))
+ (snd-display #__line__ ";(opt)locsig(4)->sd chan 2 (0.5): ~A" (sound-data->vct outp 2)))
(if (not (vequal (sound-data->vct outp 3) (make-vct 10 0.0)))
- (snd-display ";(opt)locsig(4)->sd chan 3 (0.5): ~A" (sound-data->vct outp 3))))
+ (snd-display #__line__ ";(opt)locsig(4)->sd chan 3 (0.5): ~A" (sound-data->vct outp 3))))
(let ((fr (make-frame 2 1.5 0.5))
@@ -49617,11 +49711,11 @@ EDITS: 1
(set! fq (frame? fr))
(set! mq (mixer? mx))
0.0))
- (if (not (vequal vs (vct 1.5 0.5 0.1 0.2 0.3 0.4))) (snd-display ";run frame-set: ~A" vs))
- (if (not fq) (snd-display ";run frame?"))
- (if (not mq) (snd-display ";run mixer?"))
- (if (fneq (frame-ref fr 0) .123) (snd-display ";run frame-ref: ~A" (frame-ref fr 0)))
- (if (fneq (mixer-ref mx 0 1) .123) (snd-display ";run mixer-ref: ~A" (mixer-ref mx 0 1))))
+ (if (not (vequal vs (vct 1.5 0.5 0.1 0.2 0.3 0.4))) (snd-display #__line__ ";run frame-set: ~A" vs))
+ (if (not fq) (snd-display #__line__ ";run frame?"))
+ (if (not mq) (snd-display #__line__ ";run mixer?"))
+ (if (fneq (frame-ref fr 0) .123) (snd-display #__line__ ";run frame-ref: ~A" (frame-ref fr 0)))
+ (if (fneq (mixer-ref mx 0 1) .123) (snd-display #__line__ ";run mixer-ref: ~A" (mixer-ref mx 0 1))))
(let ((cmb (make-comb .1 12))
(fb .123)
@@ -49632,9 +49726,9 @@ EDITS: 1
(set! len (mus-length cmb))
(set! (mus-feedback cmb) .123)
0.0))
- (if (fneq fb .1) (snd-display ";run feedback: ~A" fb))
- (if (not (= len 12)) (snd-display ";run mus-length: ~A" len))
- (if (fneq (mus-feedback cmb) .123) (snd-display ";run set feedback: ~A" (mus-feedback cmb))))
+ (if (fneq fb .1) (snd-display #__line__ ";run feedback: ~A" fb))
+ (if (not (= len 12)) (snd-display #__line__ ";run mus-length: ~A" len))
+ (if (fneq (mus-feedback cmb) .123) (snd-display #__line__ ";run set feedback: ~A" (mus-feedback cmb))))
(let ((cmb (make-filtered-comb .1 12 :filter (make-one-zero .5 .5)))
(fb .123)
@@ -49645,9 +49739,9 @@ EDITS: 1
(set! len (mus-length cmb))
(set! (mus-feedback cmb) .123)
0.0))
- (if (fneq fb .1) (snd-display ";run feedback: ~A" fb))
- (if (not (= len 12)) (snd-display ";run mus-length: ~A" len))
- (if (fneq (mus-feedback cmb) .123) (snd-display ";run set feedback: ~A" (mus-feedback cmb))))
+ (if (fneq fb .1) (snd-display #__line__ ";run feedback: ~A" fb))
+ (if (not (= len 12)) (snd-display #__line__ ";run mus-length: ~A" len))
+ (if (fneq (mus-feedback cmb) .123) (snd-display #__line__ ";run set feedback: ~A" (mus-feedback cmb))))
(let ((cmb (make-notch .1 12))
(ff .123)
@@ -49656,8 +49750,8 @@ EDITS: 1
(set! ff (mus-feedforward cmb))
(set! (mus-feedforward cmb) .321)
0.0))
- (if (fneq ff .1) (snd-display ";run feedforward: ~A" ff))
- (if (fneq (mus-feedforward cmb) .321) (snd-display ";run set feedforward: ~A" (mus-feedforward cmb))))
+ (if (fneq ff .1) (snd-display #__line__ ";run feedforward: ~A" ff))
+ (if (fneq (mus-feedforward cmb) .321) (snd-display #__line__ ";run set feedforward: ~A" (mus-feedforward cmb))))
(let ((gen (make-oscil 440))
(res 0)
@@ -49666,7 +49760,7 @@ EDITS: 1
(if (not (string=? (mus-name gen) "oscil")) (set! res 1))
(if (not (string=? (mus-describe gen) "oscil freq: 440.000Hz, phase: 0.000")) (set! res (+ res 10)))
0.0))
- (if (not (= res 0)) (snd-display ";run mus-name etc: ~A" res)))
+ (if (not (= res 0)) (snd-display #__line__ ";run mus-name etc: ~A" res)))
(let ((r1 (make-rand 100))
(r2 (make-rand-interp 100 .1))
@@ -49680,9 +49774,9 @@ EDITS: 1
(= (rand-interp r2) (rand-interp r2)))
1.0
0.0)))
- (if (fneq (vct-ref v 0) 0.0) (snd-display ";run rand/interp?"))
- (if (not r1q) (snd-display ";run rand?"))
- (if (not r2q) (snd-display ";run rand-interp?"))
+ (if (fneq (vct-ref v 0) 0.0) (snd-display #__line__ ";run rand/interp?"))
+ (if (not r1q) (snd-display #__line__ ";run rand?"))
+ (if (not r2q) (snd-display #__line__ ";run rand-interp?"))
(catch #t (lambda () (vct-map! v (lambda () (rand r1 0.0 1.0 2.0)))) (lambda args args))
(catch #t (lambda () (vct-map! v (lambda () (rand-interp r2 1.0 2.0 3.0)))) (lambda args args)))
@@ -49691,24 +49785,24 @@ EDITS: 1
(do ((i 0 (+ 1 i))) ((= i 10))
(vct-set! v0 i i))
(vct-map! v (lambda () (array-interp v0 3.5)))
- (if (fneq (vct-ref v 0) 3.5) (snd-display ";run array-interp: ~F?" (vct-ref v 0)))
+ (if (fneq (vct-ref v 0) 3.5) (snd-display #__line__ ";run array-interp: ~F?" (vct-ref v 0)))
(vct-map! v (lambda () (array-interp v0 3.5 10)))
- (if (fneq (vct-ref v 0) 3.5) (snd-display ";run array-interp sized: ~F?" (vct-ref v 0)))
+ (if (fneq (vct-ref v 0) 3.5) (snd-display #__line__ ";run array-interp sized: ~F?" (vct-ref v 0)))
(catch #t (lambda () (vct-map! v (lambda () (array-interp v0)))) (lambda args args))
(catch #t (lambda () (vct-map! v (lambda () (array-interp v0 3.5 10 123)))) (lambda args args))
(do ((i 0 (+ 1 i))) ((= i 10))
(vct-set! v0 i i))
(let ((val (run (lambda () (mus-interpolate mus-interp-linear 1.5 v0)))))
- (if (fneq val 1.5) (snd-display ";opt mus-interpolate linear: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate linear: ~A" val))
(set! val (run (mus-interpolate mus-interp-all-pass 1.5 v0 10)))
- (if (fneq val 1.5) (snd-display ";opt mus-interpolate all-pass: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate all-pass: ~A" val))
(set! val (run (lambda () (mus-interpolate mus-interp-none 1.5 v0 10 0.0))))
- (if (fneq val 1.0) (snd-display ";opt mus-interpolate none: ~A" val))
+ (if (fneq val 1.0) (snd-display #__line__ ";opt mus-interpolate none: ~A" val))
(set! val (run (lambda () (mus-interpolate mus-interp-hermite 1.5 v0))))
- (if (fneq val 1.5) (snd-display ";opt mus-interpolate hermite: ~A" val))
+ (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate hermite: ~A" val))
(set! val (run (lambda () (mus-interpolate mus-interp-lagrange 1.5 v0))))
- (if (fneq val 1.5) (snd-display ";opt mus-interpolate lagrange: ~A" val))))
+ (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate lagrange: ~A" val))))
(let ((e (make-env '(0 0 1 1) :length 11))
(v (make-vct 1))
@@ -49729,13 +49823,13 @@ EDITS: 1
(mus-reset e)
(set! val0 (env e))
(env-interp .5 e)))
- (if (not enq) (snd-display ";run env?"))
- (if (not (= cs 2)) (snd-display ";run mus-location: ~A" cs))
- (if (not (= ep 0)) (snd-display ";run mus-channels: ~A" ep))
- (if (fneq b 1.0) (snd-display ";run mus-increment: ~A" b))
- (if (fneq val8 0.8) (snd-display ";run set location: ~A" val8))
- (if (fneq val0 0.0) (snd-display ";run mus-reset: ~A" val0))
- (if (fneq (vct-ref v 0) .5) (snd-display ";run env-interp: ~A" (vct-ref v 0)))
+ (if (not enq) (snd-display #__line__ ";run env?"))
+ (if (not (= cs 2)) (snd-display #__line__ ";run mus-location: ~A" cs))
+ (if (not (= ep 0)) (snd-display #__line__ ";run mus-channels: ~A" ep))
+ (if (fneq b 1.0) (snd-display #__line__ ";run mus-increment: ~A" b))
+ (if (fneq val8 0.8) (snd-display #__line__ ";run set location: ~A" val8))
+ (if (fneq val0 0.0) (snd-display #__line__ ";run mus-reset: ~A" val0))
+ (if (fneq (vct-ref v 0) .5) (snd-display #__line__ ";run env-interp: ~A" (vct-ref v 0)))
(catch #t (lambda () (vct-map! v (lambda () (env e 1.0)))) (lambda args args))
(catch #t (lambda () (vct-map! v (lambda () (env-interp e)))) (lambda args args)))
@@ -49752,9 +49846,9 @@ EDITS: 1
(set! x1 (vct-ref (mus-xcoeffs flt) 1))
(set! y1 (vct-ref (mus-ycoeffs flt) 1))
0.0))
- (if (fneq d1 1.0) (snd-display ";run mus-data: ~A ~A" d1 (mus-data flt)))
- (if (fneq x1 .2) (snd-display ";run mus-xcoeffs: ~A ~A" x1 (mus-xcoeffs flt)))
- (if (fneq y1 .5) (snd-display ";run mus-ycoeffs: ~A ~A" y1 (mus-ycoeffs flt))))
+ (if (fneq d1 1.0) (snd-display #__line__ ";run mus-data: ~A ~A" d1 (mus-data flt)))
+ (if (fneq x1 .2) (snd-display #__line__ ";run mus-xcoeffs: ~A ~A" x1 (mus-xcoeffs flt)))
+ (if (fneq y1 .5) (snd-display #__line__ ";run mus-ycoeffs: ~A ~A" y1 (mus-ycoeffs flt))))
(let ((grn (make-granulate :expansion 2.0))
(v (make-vct 1))
@@ -49771,13 +49865,13 @@ EDITS: 1
(set! (mus-scaler grn) .321)
(set! (mus-hop grn) 1234)
0.0))
- (if (and (not (= gr 1323)) (not (= gr 2646))) (snd-display ";run ramp: ~A" gr))
- (if (and (not (= gh 1102)) (not (= gh 2205))) (snd-display ";run hop: ~A" gh))
- (if (fneq gs 0.6) (snd-display ";run scaler: ~A" gs))
- (if (fneq ge 2.0) (snd-display ";run gran exp: ~A" ge))
- (if (fneq (mus-scaler grn) .321) (snd-display ";run set scl: ~A" (mus-scaler grn)))
- (if (not (= (mus-hop grn) 1234)) (snd-display ";run set hop: ~A" (mus-hop grn)))
- (if (not (= (mus-ramp grn) 321)) (snd-display ";run set ramp: ~A" (mus-ramp grn))))
+ (if (and (not (= gr 1323)) (not (= gr 2646))) (snd-display #__line__ ";run ramp: ~A" gr))
+ (if (and (not (= gh 1102)) (not (= gh 2205))) (snd-display #__line__ ";run hop: ~A" gh))
+ (if (fneq gs 0.6) (snd-display #__line__ ";run scaler: ~A" gs))
+ (if (fneq ge 2.0) (snd-display #__line__ ";run gran exp: ~A" ge))
+ (if (fneq (mus-scaler grn) .321) (snd-display #__line__ ";run set scl: ~A" (mus-scaler grn)))
+ (if (not (= (mus-hop grn) 1234)) (snd-display #__line__ ";run set hop: ~A" (mus-hop grn)))
+ (if (not (= (mus-ramp grn) 321)) (snd-display #__line__ ";run set ramp: ~A" (mus-ramp grn))))
(let ((v0 (make-vct 1))
(v1 (make-vct 1))
@@ -49790,22 +49884,22 @@ EDITS: 1
(set! val (vct-ref v0 0))
(polar->rectangular v0 v1)
(vct-ref v1 0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display ";run r->p not inverted: ~A" v))
- (if (fneq val (sqrt 2.0)) (snd-display ";r->p: ~A" val)))
+ (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run r->p not inverted: ~A" v))
+ (if (fneq val (sqrt 2.0)) (snd-display #__line__ ";r->p: ~A" val)))
(let ((v (make-vct 1))
(v0 (vct 1.0 2.0))
(v1 (vct 0.5 1.0)))
(vct-map! v (lambda ()
(dot-product v0 v1)))
- (if (fneq (vct-ref v 0) 2.5) (snd-display ";run dot-product: ~A" (vct-ref v 0))))
+ (if (fneq (vct-ref v 0) 2.5) (snd-display #__line__ ";run dot-product: ~A" (vct-ref v 0))))
(let ((v (make-vct 1))
(v0 (vct 1.0 2.0))
(v1 (vct 0.5 1.0)))
(vct-map! v (lambda ()
(dot-product v0 v1 2)))
- (if (fneq (vct-ref v 0) 2.5) (snd-display ";run dot-product (2): ~A" (vct-ref v 0))))
+ (if (fneq (vct-ref v 0) 2.5) (snd-display #__line__ ";run dot-product (2): ~A" (vct-ref v 0))))
(let ((fr1 (make-frame 2 .1 .2))
(fr2 (make-frame 2 .3 .4))
@@ -49816,27 +49910,27 @@ EDITS: 1
(frame* fr1 fr2 fr3)
(frame+ fr1 fr2 fr4)
(frame->sample fr1 fr2)))
- (if (fneq (frame-ref fr3 0) .03) (snd-display ";run frame* 0: ~A" (frame-ref fr3 0)))
- (if (fneq (frame-ref fr3 1) .08) (snd-display ";run frame* 1: ~A" (frame-ref fr3 1)))
- (if (fneq (frame-ref fr4 0) .4) (snd-display ";run frame+ 0: ~A" (frame-ref fr4 0)))
- (if (fneq (frame-ref fr4 1) .6) (snd-display ";run frame+ 1: ~A" (frame-ref fr4 1)))
- (if (fneq (vct-ref v 0) .11) (snd-display ";run frame->sample: ~A" (vct-ref v 0)))
+ (if (fneq (frame-ref fr3 0) .03) (snd-display #__line__ ";run frame* 0: ~A" (frame-ref fr3 0)))
+ (if (fneq (frame-ref fr3 1) .08) (snd-display #__line__ ";run frame* 1: ~A" (frame-ref fr3 1)))
+ (if (fneq (frame-ref fr4 0) .4) (snd-display #__line__ ";run frame+ 0: ~A" (frame-ref fr4 0)))
+ (if (fneq (frame-ref fr4 1) .6) (snd-display #__line__ ";run frame+ 1: ~A" (frame-ref fr4 1)))
+ (if (fneq (vct-ref v 0) .11) (snd-display #__line__ ";run frame->sample: ~A" (vct-ref v 0)))
(let ((val (run (lambda () (frame+ fr1 1.0)))))
(if (or (fneq (frame-ref val 0) 1.1)
(fneq (frame-ref val 1) 1.2))
- (snd-display ";frame-offset: ~A" val)))
+ (snd-display #__line__ ";frame-offset: ~A" val)))
(let ((val (run (lambda () (frame+ 1.0 fr1)))))
(if (or (fneq (frame-ref val 0) 1.1)
(fneq (frame-ref val 1) 1.2))
- (snd-display ";frame-offset a: ~A" val)))
+ (snd-display #__line__ ";frame-offset a: ~A" val)))
(let ((val (run (lambda () (frame* fr1 2.0)))))
(if (or (fneq (frame-ref val 0) 0.2)
(fneq (frame-ref val 1) 0.4))
- (snd-display ";frame-scale: ~A" val)))
+ (snd-display #__line__ ";frame-scale: ~A" val)))
(let ((val (run (lambda () (frame* 2.0 fr1)))))
(if (or (fneq (frame-ref val 0) 0.2)
(fneq (frame-ref val 1) 0.4))
- (snd-display ";frame-scale a: ~A" val))))
+ (snd-display #__line__ ";frame-scale a: ~A" val))))
(let ((v0 (make-vct 4))
(v1 (make-vct 4))
(v (make-vct 1)))
@@ -49845,7 +49939,7 @@ EDITS: 1
(vct-map! v (lambda () (convolution v0 v1) 0.0))
(if (or (not (vequal v0 (vct 0.0 0.0 1.0 0.0)))
(not (vequal v1 (vct 0.0 0.0 0.0 0.0))))
- (snd-display ";run convolution: ~A ~A" v0 v1)))
+ (snd-display #__line__ ";run convolution: ~A ~A" v0 v1)))
(let ((v0 (make-vct 4))
(v1 (make-vct 4))
@@ -49855,34 +49949,34 @@ EDITS: 1
(vct-map! v (lambda () (vct-convolve! v0 v1) 0.0))
(if (or (not (vequal v0 (vct 0.0 0.0 1.0 0.0)))
(not (vequal v1 (vct 0.0 0.0 0.0 0.0))))
- (snd-display ";run vct-convolve!: ~A ~A" v0 v1)))
+ (snd-display #__line__ ";run vct-convolve!: ~A ~A" v0 v1)))
(if all-args
(let ((v (make-vct 1))
(amps (list->vct '(0.5 0.25 1.0)))
(phases (list->vct '(1.0 0.5 2.0))))
(vct-map! v (lambda () (sine-bank amps phases)))
- (if (fneq (vct-ref v 0) 1.44989) (snd-display ";run sine-bank: ~A?" (vct-ref v 0)))))
+ (if (fneq (vct-ref v 0) 1.44989) (snd-display #__line__ ";run sine-bank: ~A?" (vct-ref v 0)))))
(if all-args
(let ((v (make-vct 1))
(amps (list->vct '(0.5 0.25 1.0)))
(phases (list->vct '(1.0 0.5 2.0))))
(vct-map! v (lambda () (sine-bank amps phases 3)))
- (if (fneq (vct-ref v 0) 1.44989) (snd-display ";run sine-bank (1): ~A?" (vct-ref v 0)))))
+ (if (fneq (vct-ref v 0) 1.44989) (snd-display #__line__ ";run sine-bank (1): ~A?" (vct-ref v 0)))))
(let ((fr0 (make-frame 2 1.0 1.0))
(fr1 (make-frame 2 0.0 0.0))
(gen (make-mixer 2 .5 .25 .125 1.0))
(v (make-vct 1)))
(vct-map! v (lambda () (frame->frame fr0 gen fr1) (frame-ref fr1 1)))
- (if (fneq (frame-ref fr1 1) 1.25) (snd-display ";run frame->frame right: ~A" fr1)))
+ (if (fneq (frame-ref fr1 1) 1.25) (snd-display #__line__ ";run frame->frame right: ~A" fr1)))
(let ((fr0 (make-frame 2 1.0 1.0))
(fr1 (make-frame 2 0.0 0.0))
(gen (make-mixer 2 .5 .25 .125 1.0))
(v (make-vct 1)))
(vct-map! v (lambda () (frame->frame gen fr0 fr1) (frame-ref fr1 1)))
- (if (fneq (frame-ref fr1 1) 1.125) (snd-display ";run frame->frame left: ~A" fr1)))
+ (if (fneq (frame-ref fr1 1) 1.125) (snd-display #__line__ ";run frame->frame left: ~A" fr1)))
(let ((rdat (make-vct 16))
(idat (make-vct 16))
@@ -49895,7 +49989,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 8))
(if (fneq (vct-ref rdat i) 1.0)
- (snd-display ";run impulse->flat? ~A" rdat)))
+ (snd-display #__line__ ";run impulse->flat? ~A" rdat)))
(catch #t (lambda () (vct-map! v (lambda () (spectrum rdat idat win 17.3)))) (lambda args args)))
(let ((rdat (make-vct 16))
@@ -49909,7 +50003,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 8))
(if (fneq (vct-ref rdat i) 1.0)
- (snd-display ";run impulse->flat (1)? ~A" rdat))))
+ (snd-display #__line__ ";run impulse->flat (1)? ~A" rdat))))
(let ((rdat (make-vct 16))
(idat (make-vct 16))
@@ -49922,7 +50016,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 8))
(if (fneq (vct-ref rdat i) 1.0)
- (snd-display ";run impulse->flat (2)? ~A" rdat))))
+ (snd-display #__line__ ";run impulse->flat (2)? ~A" rdat))))
(let ((mx1 (make-mixer 2))
(mx2 (make-mixer 2))
@@ -49931,27 +50025,27 @@ EDITS: 1
(mixer-set! mx1 0 0 .1)
(mixer* mx1 mx1 mx2)
0.0))
- (if (fneq (mixer-ref mx2 0 0) .01) (snd-display ";run mixer* res: ~A" mx2)))
+ (if (fneq (mixer-ref mx2 0 0) .01) (snd-display #__line__ ";run mixer* res: ~A" mx2)))
(let ((mx1 (make-mixer 2 1 2 3 4))
(mx2 (make-mixer 2 0 0 0 0)))
(run (lambda () (mixer* mx1 2.0 mx2)))
(if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display ";run mixer-scale 1: ~A" mx2)))
+ (snd-display #__line__ ";run mixer-scale 1: ~A" mx2)))
(let* ((mx1 (make-mixer 2 1 2 3 4))
(mx2 (run (lambda () (mixer* mx1 2.0)))))
(if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display ";run mixer-scale 2: ~A" mx2))
+ (snd-display #__line__ ";run mixer-scale 2: ~A" mx2))
(set! mx2 (run (lambda () (mixer* 2.0 mx1))))
(if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display ";run mixer-scale 2a: ~A" mx2))
+ (snd-display #__line__ ";run mixer-scale 2a: ~A" mx2))
(set! mx2 (run (lambda () (mixer+ 2.0 mx1))))
(if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display ";run mixer-offset 2: ~A" mx2))
+ (snd-display #__line__ ";run mixer-offset 2: ~A" mx2))
(set! mx2 (run (lambda () (mixer+ mx1 2.0))))
(if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display ";run mixer-offset 2a: ~A" mx2)))
+ (snd-display #__line__ ";run mixer-offset 2a: ~A" mx2)))
(let ((mx1 (make-mixer 2))
(mx2 (make-mixer 2))
@@ -49960,7 +50054,7 @@ EDITS: 1
(set! (mixer-ref mx1 0 0) .1)
(mixer* mx1 mx1 mx2)
0.0))
- (if (fneq (mixer-ref mx2 0 0) .01) (snd-display ";run mixer* res (set): ~A" mx2)))
+ (if (fneq (mixer-ref mx2 0 0) .01) (snd-display #__line__ ";run mixer* res (set): ~A" mx2)))
(let ((gen (make-sample->file "fmv.snd" 2 mus-lshort mus-riff))
(v (make-vct 1))
@@ -49979,8 +50073,8 @@ EDITS: 1
(out-any 60 .15 1 gen)
0.0))
(mus-close gen)
- (if (not oq) (snd-display ";run mus-output?"))
- (if (not sq) (snd-display ";run mus-output?"))
+ (if (not oq) (snd-display #__line__ ";run mus-output?"))
+ (if (not sq) (snd-display #__line__ ";run mus-output?"))
(catch #t (lambda () (vct-map! v (lambda () (sample->file gen)))) (lambda args args))
(catch #t (lambda () (vct-map! v (lambda () (sample->file gen 0 0 .1 .2)))) (lambda args args)))
@@ -49994,8 +50088,8 @@ EDITS: 1
((= i 10))
(outa i x gen))))
(if (not (vequal gen (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))
- (snd-display ";outa->vct opt ramp: ~A" gen))
- (if (not (= chans 1)) (snd-display ";mus-channels vct opt: ~A" chans))
+ (snd-display #__line__ ";outa->vct opt ramp: ~A" gen))
+ (if (not (= chans 1)) (snd-display #__line__ ";mus-channels vct opt: ~A" chans))
(run
(lambda ()
(do ((i 0 (+ 1 i))
@@ -50003,7 +50097,7 @@ EDITS: 1
((= i 10))
(outa i x gen))))
(if (not (vequal gen (vct-scale! (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9) 2.0)))
- (snd-display ";outa->vct opt ramp 2: ~A" gen)))
+ (snd-display #__line__ ";outa->vct opt ramp 2: ~A" gen)))
(let ((gen (make-sound-data 4 100))
(chans 0))
@@ -50029,8 +50123,8 @@ EDITS: 1
(fneq (inb i gen) .22)
(fneq (in-any i 2 gen) .33)
(fneq (in-any i 3 gen) .44))
- (snd-display ";4-chan sd opt out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen))))
- (if (not (= chans 4)) (snd-display ";mus-channels sd 4 opt: ~A" chans)))
+ (snd-display #__line__ ";4-chan sd opt out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen))))
+ (if (not (= chans 4)) (snd-display #__line__ ";mus-channels sd 4 opt: ~A" chans)))
(let ((gen (make-sound-data 4 100)))
(run
@@ -50053,7 +50147,7 @@ EDITS: 1
(fneq (in-any i 1 gen) .22)
(fneq (in-any i 2 gen) .33)
(fneq (in-any i 3 gen) .44))
- (snd-display ";4-chan sd out/in-any[~A]: ~A ~A ~A ~A?" i (in-any i 0 gen) (in-any i 1 gen) (in-any i 2 gen) (in-any i 3 gen)))))
+ (snd-display #__line__ ";4-chan sd out/in-any[~A]: ~A ~A ~A ~A?" i (in-any i 0 gen) (in-any i 1 gen) (in-any i 2 gen) (in-any i 3 gen)))))
(let* ((gen (make-file->sample "fmv.snd"))
(vals (make-vct 10))
@@ -50074,9 +50168,9 @@ EDITS: 1
(set! iq (mus-input? gen))
(set! fq (file->sample? gen))
0.0))
- (if (not iq) (snd-display ";run mus-input?"))
- (if (not fq) (snd-display ";run file->sample?"))
- (if (not (vequal vals (vct .02 .2 .03 .3 .04 .4 .065 .65 .075 .75))) (snd-display ";run i/o: ~A" vals)))
+ (if (not iq) (snd-display #__line__ ";run mus-input?"))
+ (if (not fq) (snd-display #__line__ ";run file->sample?"))
+ (if (not (vequal vals (vct .02 .2 .03 .3 .04 .4 .065 .65 .075 .75))) (snd-display #__line__ ";run i/o: ~A" vals)))
(delete-file "fmv.snd")
(let ((gen (make-frame->file "fmv.snd" 2 mus-bshort mus-next))
@@ -50092,7 +50186,7 @@ EDITS: 1
(frame->file gen i fr0))
0.0))
(mus-close gen)
- (if (not fq) (snd-display ";run frame->file?")))
+ (if (not fq) (snd-display #__line__ ";run frame->file?")))
(let* ((gen (make-file->frame "fmv.snd"))
(frout (make-frame 2))
@@ -50102,8 +50196,8 @@ EDITS: 1
(file->frame gen 4 frout)
(set! fq (file->frame? gen))
(frame-ref frout 0)))
- (if (not fq) (snd-display ";run file->frame?"))
- (if (fneq (vct-ref v 0) .004) (snd-display ";run frame i/o: ~A" frout)))
+ (if (not fq) (snd-display #__line__ ";run file->frame?"))
+ (if (fneq (vct-ref v 0) .004) (snd-display #__line__ ";run frame i/o: ~A" frout)))
(delete-file "fmv.snd")
(let ((hi (make-power-env '(0 0 32.0 1 1 .0312 2 0 1) :duration 1.0)))
@@ -50118,21 +50212,21 @@ EDITS: 1
(itst '(channels) 1)
(itst '(frames) 50828)
(if (not (= (run (lambda () (srate ind))) 22050))
- (snd-display ";run srate ind: ~A" (run (lambda () (srate ind)))))
+ (snd-display #__line__ ";run srate ind: ~A" (run (lambda () (srate ind)))))
(if (not (= (run (lambda () (channels ind))) 1))
- (snd-display ";run channels ind: ~A" (run (lambda () (channels ind)))))
+ (snd-display #__line__ ";run channels ind: ~A" (run (lambda () (channels ind)))))
(if (not (= (run (lambda () (frames ind 0))) 50828))
- (snd-display ";run frames ind: ~A" (run (lambda () (frames ind 0)))))
+ (snd-display #__line__ ";run frames ind: ~A" (run (lambda () (frames ind 0)))))
(vct-map! v (lambda () (next-sample r)))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample ftst: ~A" v))
(vct-map! v (lambda () (previous-sample r)))
- (if (or (fneq (vct-ref v 0) .0551) (fneq (vct-ref v 1) .0662)) (snd-display ";previous-sample ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0551) (fneq (vct-ref v 1) .0662)) (snd-display #__line__ ";previous-sample ftst: ~A" v))
(previous-sample r)
(next-sample r)
(vct-map! v (lambda () (read-sample r)))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";read-sample ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";read-sample ftst: ~A" v))
(vct-map! v (lambda () (r)))
- (if (or (fneq (vct-ref v 0) .039) (fneq (vct-ref v 1) .024)) (snd-display ";read-sample apply ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .039) (fneq (vct-ref v 1) .024)) (snd-display #__line__ ";read-sample apply ftst: ~A" v))
(etst '(set! (sample 100) 0.0))
)
(close-sound ind))
@@ -50140,27 +50234,27 @@ EDITS: 1
(let ((ind (open-sound "oboe.snd")))
(let ((val (run (lambda () (let ((ho (make-sampler 12345.0))) (read-sample ho))))))
(if (fneq val 0.0549)
- (snd-display ";run make-sampler with float sample arg: ~A" val)))
+ (snd-display #__line__ ";run make-sampler with float sample arg: ~A" val)))
(let ((v (make-vct 2)))
(ftst '(let ((r (make-sampler 1200.0))) (next-sample r)) 0.04898)
(vct-map! v (let ((r (make-sampler 2000)))
(lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample let ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst: ~A" v))
(vct-map! v (let ((r (make-sampler 2000 #f)))
(lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample let ftst #f: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst #f: ~A" v))
(vct-map! v (let ((r (make-sampler 2000 #f #f)))
(lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample let ftst #f #f: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst #f #f: ~A" v))
(vct-map! v (let ((r (make-sampler 2000 #f #f 1 current-edit-position)))
(lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample let ftst #f #f 1 -1: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst #f #f 1 -1: ~A" v))
(vct-map! v (let ((r (make-sampler 2000 ind)))
(lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample let snd ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let snd ftst: ~A" v))
(vct-map! v (let ((r (make-sampler 2000 ind 0)))
(lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample let chn ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let chn ftst: ~A" v))
(vct-map! v (let ((r (make-sampler 2000 ind 0 1 (edit-position ind 0))))
(lambda ()
(if (or (not (= (edit-position ind 0) 0))
@@ -50171,7 +50265,7 @@ EDITS: 1
(report-in-minibuffer "oops again" ind)
-123.0)
(next-sample r)))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display ";next-sample let edit ftst: ~A" v))
+ (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let edit ftst: ~A" v))
(itst '(frames) 50828)
(itst (list 'frames ind) 50828)
(itst (list 'frames ind 0) 50828)
@@ -50207,36 +50301,36 @@ EDITS: 1
(set! (optimization) max-optimization)
(set! t1 (time-it (map-channel (lambda (y) (* y 2)) 0 1000000 ind1)))
(if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display ";y * 2 run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "*2 " (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (snd-display #__line__ ";y * 2 run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
+ (set! ts (cons (list "*2 " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(set! (optimization) 0)
(set! t0 (time-it (map-channel (lambda (y) (- y 1.0)) 0 1000000 ind0)))
(set! (optimization) max-optimization)
(set! t1 (time-it (map-channel (lambda (y) (- y 1.0)) 0 1000000 ind1)))
(if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display ";y - 1 run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "-1 " (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (snd-display #__line__ ";y - 1 run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
+ (set! ts (cons (list "-1 " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(set! (optimization) 0)
(set! t0 (time-it (map-channel (lambda (y) (abs (sin y))) 0 1000000 ind0)))
(set! (optimization) max-optimization)
(set! t1 (time-it (map-channel (lambda (y) (abs (sin y))) 0 1000000 ind1)))
(if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display ";abs sin run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "abs sin" (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (snd-display #__line__ ";abs sin run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
+ (set! ts (cons (list "abs sin" (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(set! (optimization) 0)
(set! t0 (time-it (map-channel (lambda (y) (let ((a (* y 2))) (if (> y 1.0) 1.0 y))) 0 1000000 ind0)))
(set! (optimization) max-optimization)
(set! t1 (time-it (map-channel (lambda (y) (let ((a (* y 2))) (if (> y 1.0) 1.0 y))) 0 1000000 ind1)))
(if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "let if " (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (snd-display #__line__ ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
+ (set! ts (cons (list "let if " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(set! (optimization) 0)
(set! t0 (time-it (map-channel (let ((v (make-vct 3))) (lambda (y) (vct-set! v 1 .5) (* y (vct-ref v 1)))) 0 1000000 ind0)))
(set! (optimization) max-optimization)
(set! t1 (time-it (map-channel (let ((v (make-vct 3))) (lambda (y) (vct-set! v 1 .5) (* y (vct-ref v 1)))) 0 1000000 ind1)))
(if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "vct-ref" (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (snd-display #__line__ ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
+ (set! ts (cons (list "vct-ref" (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(set! (optimization) 0)
(set! t0 (time-it (let ((osc (make-oscil :frequency 440))
@@ -50247,51 +50341,51 @@ EDITS: 1
(e1 (make-env '(0 0 1 1 2 0) :length 1000000)))
(map-channel (lambda (y) (* (env e1) (oscil osc y))) 0 1000000 ind1))))
(if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "osc+env" (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (snd-display #__line__ ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
+ (set! ts (cons (list "osc+env" (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(close-sound ind0)
(close-sound ind1)
- (snd-display ";timings:~{~% ~A~}" ts))
+ (snd-display #__line__ ";timings:~{~%~20T~A~}" ts))
(let ((v0 (make-vct 10))
(v1 (make-vct 10)))
(set! (optimization) 0) (vct-map! v0 (lambda () .1))
(set! (optimization) max-optimization) (vct-map! v1 (lambda () .1))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .1)) (snd-display ";vct-map .1: ~A ~A" v0 v1))
+ (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .1)) (snd-display #__line__ ";vct-map .1: ~A ~A" v0 v1))
(set! dbl-var .1)
(set! (optimization) 0) (vct-map! v0 (lambda () dbl-var))
(set! (optimization) max-optimization) (vct-map! v1 (lambda () dbl-var))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .1)) (snd-display ";vct-map dbl-var .1: ~A ~A" v0 v1))
+ (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .1)) (snd-display #__line__ ";vct-map dbl-var .1: ~A ~A" v0 v1))
(let ((dbl-var .3))
(set! (optimization) 0) (vct-map! v0 (lambda () dbl-var))
(set! (optimization) max-optimization) (vct-map! v1 (lambda () dbl-var))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .3)) (snd-display ";vct-map dbl-var .3: ~A ~A" v0 v1)))
+ (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .3)) (snd-display #__line__ ";vct-map dbl-var .3: ~A ~A" v0 v1)))
(let ((dbl-var .3))
(let ((dbl-var .5))
(set! (optimization) 0) (vct-map! v0 (lambda () dbl-var))
(set! (optimization) max-optimization) (vct-map! v1 (lambda () dbl-var))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .5)) (snd-display ";vct-map dbl-var .5: ~A ~A" v0 v1))))
+ (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .5)) (snd-display #__line__ ";vct-map dbl-var .5: ~A ~A" v0 v1))))
(let ((dbl-var .3))
(let ((dbl-var .5))
(set! (optimization) 0) (vct-map! v0 (let ((dbl-var .9)) (lambda () dbl-var)))
(set! (optimization) max-optimization) (vct-map! v1 (let ((dbl-var .9)) (lambda () dbl-var)))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .9)) (snd-display ";vct-map dbl-var .9: ~A ~A" v0 v1))))
+ (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .9)) (snd-display #__line__ ";vct-map dbl-var .9: ~A ~A" v0 v1))))
(let ((dbl-var .3))
(let ((dbl-var .5))
(set! (optimization) 0) (vct-map! v0 (let ((dbl-var .9)) (lambda () (let ((dbl-var .01)) dbl-var))))
(set! (optimization) max-optimization) (vct-map! v1 (let ((dbl-var .9)) (lambda () (let ((dbl-var .01)) dbl-var))))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .01)) (snd-display ";vct-map dbl-var .01: ~A ~A" v0 v1))))
+ (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .01)) (snd-display #__line__ ";vct-map dbl-var .01: ~A ~A" v0 v1))))
)
(let ((t0 0)
(t1 0)
(ts '()))
(set! (optimization) 0)
- (set! t0 (time-it (with-temp-sound (:srate 44100 :output (make-vct (inexact->exact (round (* 5 (mus-srate)))))) (fm-violin 0 5 440 .1))))
+ (set! t0 (time-it (with-temp-sound (:srate 44100 :output (make-vct (round (* 5 (mus-srate))))) (fm-violin 0 5 440 .1))))
(set! (optimization) max-optimization)
- (set! t1 (time-it (with-temp-sound (:srate 44100 :output (make-vct (inexact->exact (round (* 5 (mus-srate)))))) (fm-violin 0 5 440 .1))))
- (set! ts (cons (list "fm vln " (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (set! t1 (time-it (with-temp-sound (:srate 44100 :output (make-vct (round (* 5 (mus-srate))))) (fm-violin 0 5 440 .1))))
+ (set! ts (cons (list "fm vln " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(let ((ind (open-sound "1.snd"))
(v0 #f)
@@ -50303,8 +50397,8 @@ EDITS: 1
(set! (optimization) max-optimization)
(set! t1 (time-it (expsnd '(0 1 2 .4))))
(set! v1 (channel->vct 1000 100))
- (if (not (vequal v0 v1)) (snd-display ";expsnd: opt: ~A ~A" v0 v1))
- (set! ts (cons (list "expsnd " (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";expsnd: opt: ~A ~A" v0 v1))
+ (set! ts (cons (list "expsnd " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(undo 1 ind)
(set! (optimization) 0)
(set! t0 (time-it (snd-test-jc-reverb 1.0 #f 1.0 #f)))
@@ -50313,10 +50407,10 @@ EDITS: 1
(set! (optimization) max-optimization)
(set! t1 (time-it (snd-test-jc-reverb 1.0 #f 1.0 #f)))
(set! v1 (channel->vct 1000 100))
- (if (not (vequal v0 v1)) (snd-display ";jcrev: opt: ~A ~A" v0 v1))
- (set! ts (cons (list "jcrev " (hundred t0) (hundred t1) (inexact->exact (round (safe-divide t0 t1)))) ts))
+ (if (not (vequal v0 v1)) (snd-display #__line__ ";jcrev: opt: ~A ~A" v0 v1))
+ (set! ts (cons (list "jcrev " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
(close-sound ind))
- (snd-display "~{ ~A~%~}~%" ts))
+ (snd-display #__line__ "~{~%~20T~A~}~%" ts))
(if with-gui
(let* ((osc (make-oscil 440))
(vi (make-vector 2 1))
@@ -50351,139 +50445,144 @@ EDITS: 1
(close-sound ind)))
(let ((val (run-eval '(lambda () (fneq .1 .1)))))
- (if val (snd-display ";embedded func 0: ~A" val)))
+ (if val (snd-display #__line__ ";embedded func 0: ~A" val)))
(let ((val (run-eval '(lambda () (fneq .1 .2)))))
- (if (not val) (snd-display ";embedded func 1: ~A" val)))
+ (if (not val) (snd-display #__line__ ";embedded func 1: ~A" val)))
(let ((val (run-eval '(lambda () (fneq .1 .1001)))))
- (if val (snd-display ";embedded func 2: ~A" val)))
+ (if val (snd-display #__line__ ";embedded func 2: ~A" val)))
(let ((val (run-eval '(fneq .1 .1))))
- (if val (snd-display ";embedded func 3: ~A" val)))
+ (if val (snd-display #__line__ ";embedded func 3: ~A" val)))
(let ((val (run-eval '(fneq .1 .2))))
- (if (not val) (snd-display ";embedded func 4: ~A" val)))
+ (if (not val) (snd-display #__line__ ";embedded func 4: ~A" val)))
(let ((val (run-eval '(fneq .1 .1001))))
- (if val (snd-display ";embedded func 5: ~A" val)))
+ (if val (snd-display #__line__ ";embedded func 5: ~A" val)))
(let ((val (run-eval '(efunc-1 1.5))))
- (if (fneq val 2.5) (snd-display ";embedded func 6: ~A" val)))
+ (if (fneq val 2.5) (snd-display #__line__ ";embedded func 6: ~A" val)))
(let ((val (run-eval '(+ 1.0 (efunc-1 1.5)))))
- (if (fneq val 3.5) (snd-display ";embedded func 7: ~A" val)))
+ (if (fneq val 3.5) (snd-display #__line__ ";embedded func 7: ~A" val)))
(let ((val (run-eval '(efunc-1 1))))
- (if (not (= val 2)) (snd-display ";embedded func 8: ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";embedded func 8: ~A" val)))
(let ((val (run-eval '(* 2 (efunc-1 1)))))
- (if (not (= val 4)) (snd-display ";embedded func 9: ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";embedded func 9: ~A" val)))
(let ((val (run-eval '(if (fneq .1 .2) (* 2 (efunc-1 1)) -1))))
- (if (not (= val 4)) (snd-display ";embedded func 10: ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";embedded func 10: ~A" val)))
(let ((val (run-eval '(efunc-2 #f))))
- (if (not val) (snd-display ";embedded func 11: ~A" val)))
+ (if (not val) (snd-display #__line__ ";embedded func 11: ~A" val)))
(let ((val (run-eval '(if (efunc-2 (fneq .1 .1)) 0 1))))
- (if (not (= val 0)) (snd-display ";embedded func 12: ~A" val)))
+ (if (not (= val 0)) (snd-display #__line__ ";embedded func 12: ~A" val)))
(let ((val (run-eval '(if (efunc-2 (fneq .1 (efunc-1 .2))) 0 1))))
- (if (not (= val 1)) (snd-display ";embedded func 13: ~A" val)))
+ (if (not (= val 1)) (snd-display #__line__ ";embedded func 13: ~A" val)))
(let ((val (run-eval '(efunc-3 (fneq .1 .2) 32 12))))
- (if (not (= val 44)) (snd-display ";embedded func 14: ~A" val)))
+ (if (not (= val 44)) (snd-display #__line__ ";embedded func 14: ~A" val)))
(let ((val (run-eval '(efunc-4 "hi"))))
- (if (not (string=? val "hi!")) (snd-display ";embedded func 15: ~A" val)))
+ (if (not (string=? val "hi!")) (snd-display #__line__ ";embedded func 15: ~A" val)))
(let ((val (run-eval '(efunc-5 "hi"))))
- (if (not (= val 3)) (snd-display ";embedded func 16: ~A" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";embedded func 16: ~A" val)))
(oscil efunc-gen)
(let ((val (run-eval '(efunc-6 efunc-gen))))
(if (and (fneq val .125) (fneq val .0626))
- (snd-display ";embedded func 17: ~A" val)))
+ (snd-display #__line__ ";embedded func 17: ~A" val)))
(let ((val (run-eval '(oscil (efunc-7 efunc-gen)))))
(if (and (fneq val .248)
(fneq val .125))
- (snd-display ";embedded func 18: ~A" val)))
+ (snd-display #__line__ ";embedded func 18: ~A" val)))
(mus-reset efunc-gen)
+ (let ((v (vct 1.0 2.0)))
+ (run (set! (v 1) 32))
+ (if (fneq (v 1) 32.0)
+ (snd-display #__line__ ";vct set i 32: ~A" v)))
+
(let* ((arg 3)
(val (run (lambda () (t22-i->i arg)))))
- (if (not (equal? val 35)) (snd-display ";run func i->i: ~A (35)" val)))
+ (if (not (equal? val 35)) (snd-display #__line__ ";run func i->i: ~A (35)" val)))
(let* ((arg 3)
(val (run (lambda () (t22-i2->i arg)))))
- (if (not (equal? val 38)) (snd-display ";run func i2->i: ~A (38)" val)))
+ (if (not (equal? val 38)) (snd-display #__line__ ";run func i2->i: ~A (38)" val)))
(let* ((arg1 3)
(val (run (lambda () (t22-i->i (t22-i->i arg1))))))
- (if (not (equal? val 67)) (snd-display ";run func i->i (2): ~A (67)" val)))
+ (if (not (equal? val 67)) (snd-display #__line__ ";run func i->i (2): ~A (67)" val)))
(let* ((arg1 3)
(arg2 2)
(val (run (lambda () (t22-i->i (* arg2 (t22-i->i arg1)))))))
- (if (not (equal? val 102)) (snd-display ";run func i->i (3): ~A (102)" val)))
+ (if (not (equal? val 102)) (snd-display #__line__ ";run func i->i (3): ~A (102)" val)))
(let* ((arg 3)
(val (run (lambda () (t22-i->f arg)))))
- (if (not (equal? val 6.0)) (snd-display ";run func i->f: ~A (6.0)" val)))
+ (if (not (equal? val 6.0)) (snd-display #__line__ ";run func i->f: ~A (6.0)" val)))
(let* ((arg 3)
(val (run (lambda () (t22-i->s arg)))))
- (if (not (equal? val "yes")) (snd-display ";run func i->s: ~A (\"yes\")" val)))
+ (if (not (equal? val "yes")) (snd-display #__line__ ";run func i->s: ~A (\"yes\")" val)))
(let* ((arg 3)
(val (run (lambda () (t22-i->b arg)))))
- (if (not (equal? val #t)) (snd-display ";run func i->b: ~A (#t)" val)))
+ (if (not (equal? val #t)) (snd-display #__line__ ";run func i->b: ~A (#t)" val)))
(let* ((arg 3)
(val (run (lambda () (t22-i->c arg)))))
- (if (not (equal? val #\I)) (snd-display ";run func i->c: ~A (#\\I)" val)))
+ (if (not (equal? val #\I)) (snd-display #__line__ ";run func i->c: ~A (#\\I)" val)))
(let* ((arg 3)
(val (run (lambda () (t22-i->k arg)))))
- (if (not (equal? val :yes)) (snd-display ";run func i->k: ~A (:yes)" val)))
+ (if (not (equal? val :yes)) (snd-display #__line__ ";run func i->k: ~A (:yes)" val)))
(let* ((arg 3)
(val (run (lambda () (t22-i->sym arg)))))
- (if (not (equal? val 'yes)) (snd-display ";run func i->sym: ~A ('yes)" val)))
+ (if (not (equal? val 'yes)) (snd-display #__line__ ";run func i->sym: ~A ('yes)" val)))
(let* ((arg 440)
(val (run (lambda () (t22-i->clm arg)))))
- (if (not (equal? val (make-oscil 440))) (snd-display ";run func i->clm: ~A (oscil at 440)" val)))
+ (if (not (equal? val (make-oscil 440))) (snd-display #__line__ ";run func i->clm: ~A (oscil at 440)" val)))
(let* ((arg1 11)
(arg2 44.0)
(val (run (lambda () (t22-i-f->f arg1 arg2)))))
- (if (not (equal? val 55.0)) (snd-display ";run func i-f->f: ~A (55.0)" val)))
+ (if (not (equal? val 55.0)) (snd-display #__line__ ";run func i-f->f: ~A (55.0)" val)))
(let* ((arg2 1)
(arg3 44)
(arg1 (make-vector 3 0))
(val (run (lambda () (t22-iv-i-i->iv arg1 arg2 arg3)))))
- (if (not (equal? val '#(0 44 0))) (snd-display ";run func iv-i-i->iv: ~A (#(0 44 0))" val)))
+ (if (not (equal? val '#(0 44 0))) (snd-display #__line__ ";run func iv-i-i->iv: ~A (#(0 44 0))" val)))
(let* ((arg2 1)
(arg3 44.0)
(arg1 (make-vector 3 0.0))
(val (run (lambda () (t22-fv-i-f->fv arg1 arg2 arg3)))))
- (if (not (vequal val (vct 0.0 44.0 0.0))) (snd-display ";run func iv-i-f->iv: ~A (#(0.0 44.0 0.0))" val)))
+ (if (not (vequal val (vct 0.0 44.0 0.0))) (snd-display #__line__ ";run func iv-i-f->iv: ~A (#(0.0 44.0 0.0))" val)))
(let ((val (run (lambda () (t22-s->c "abcdef")))))
- (if (not (equal? val #\b)) (snd-display ";run func s->c: ~A (#\\b)" val)))
+ (if (not (equal? val #\b)) (snd-display #__line__ ";run func s->c: ~A (#\\b)" val)))
(let ((sd (make-sound-data 2 2)))
(sound-data-set! sd 1 1 3.0)
(let ((val (t22-sd->f sd)))
- (if (fneq val 3.0) (snd-display ";run func sd->f: ~A (3.0)" val))))
+ (if (fneq val 3.0) (snd-display #__line__ ";run func sd->f: ~A (3.0)" val))))
(let ((sd (make-sound-data 2 2)))
(sound-data-set! sd 1 1 3.0)
(let ((val (t22-sd->sd sd)))
- (if (fneq (sound-data-ref val 1 1) 44.0) (snd-display ";run func sd->sd: ~A (44.0)" val))))
+ (if (fneq (sound-data-ref val 1 1) 44.0) (snd-display #__line__ ";run func sd->sd: ~A (44.0)" val))))
(let ((gen (make-fir-filter 12 (make-vct 12 .1))))
(let ((val (t22-clm->i gen)))
- (if (not (equal? val 12)) (snd-display ";run func clm->i: ~A (12)" val))))
+ (if (not (equal? val 12)) (snd-display #__line__ ";run func clm->i: ~A (12)" val))))
(let* ((arg (vct 1.0 2.0 3.0 4.0))
(val (t22-vct->vct arg)))
- (if (not (vequal val (vct 1.0 44.0 3.0 4.0))) (snd-display ";run func vct->vct: ~A (<1 2 3 4>)" val)))
+ (if (not (vequal val (vct 1.0 44.0 3.0 4.0))) (snd-display #__line__ ";run func vct->vct: ~A (<1 2 3 4>)" val)))
(let* ((arg (vector (make-oscil 330.0) (make-oscil 440.0) (make-oscil 550.0)))
(val (t22-cv->f arg)))
- (if (fneq val 440.0) (snd-display ";run func clm-vect->f: ~A (440.0)" val)))
+ (if (fneq val 440.0) (snd-display #__line__ ";run func clm-vect->f: ~A (440.0)" val)))
(let* ((arg1 3.0)
(val (run (lambda () (+ 1.0 (* arg1 2))))))
- (if (fneq val 7.0) (snd-display ";mfa run opt: ~A (7.0)" val)))
+ (if (fneq val 7.0) (snd-display #__line__ ";mfa run opt: ~A (7.0)" val)))
(let* ((arg1 3.0)
(arg2 5)
(arg3 4)
(val (run (lambda () (+ (* arg2 arg1) (* arg1 arg3))))))
- (if (fneq val 27.0) (snd-display ";mfi run opt: ~A (27.0)" val)))
+ (if (fneq val 27.0) (snd-display #__line__ ";mfi run opt: ~A (27.0)" val)))
(let* ((arg1 2.0)
(val (run (lambda () (* (sin (/ pi 2)) arg1)))))
- (if (fneq val 2.0) (snd-display ";sin and pi run opt: ~A (2.0)" val)))
+ (if (fneq val 2.0) (snd-display #__line__ ";sin and pi run opt: ~A (2.0)" val)))
(let* ((arg1 2.0)
(arg2 pi)
(val (run (lambda () (* (sin (/ arg2 2)) arg1)))))
- (if (fneq val 2.0) (snd-display ";sin run opt: ~A (2.0)" val)))
+ (if (fneq val 2.0) (snd-display #__line__ ";sin run opt: ~A (2.0)" val)))
(let ((val
(let ((xx 3)
@@ -50495,7 +50594,7 @@ EDITS: 1
((= i 10))
(set! yy x)))))
yy)))
- (if (not (= val 4)) (snd-display ";run do: ~A (4)" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";run do: ~A (4)" val)))
(let ((val
(let ((xx 3)
@@ -50507,7 +50606,7 @@ EDITS: 1
(set! i 10)
(set! yy x)))))
yy)))
- (if (not (= val 4)) (snd-display ";run do 1: ~A (4)" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";run do 1: ~A (4)" val)))
(let ((val
(let ((x 0))
@@ -50517,7 +50616,7 @@ EDITS: 1
(do ((i 0 (x+ i)))
((= i 4)))))
x)))
- (if (not (= val 3)) (snd-display ";run do 2: ~A (3)" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";run do 2: ~A (3)" val)))
(let ((val
(let ((x 0))
@@ -50525,7 +50624,7 @@ EDITS: 1
(do ((i 0 (x+ i)))
((= i 4)))
x)))
- (if (not (= val 3)) (snd-display ";run do 3: ~A (3)" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";run do 3: ~A (3)" val)))
(let ((val
(run
@@ -50534,7 +50633,7 @@ EDITS: 1
(do ((i xx (+ i 1)))
((= i 4) xx)
(set! xx i)))))))
- (if (not (= val 3)) (snd-display ";run do 4: ~A (3)" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";run do 4: ~A (3)" val)))
(let ((val
(let ((xx 0))
@@ -50543,7 +50642,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 3) xx)
(set! xx i)))))))
- (if (not (= val 2)) (snd-display ";run do 5: ~A (2)" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";run do 5: ~A (2)" val)))
(let ((val
(let ((k 2)
@@ -50551,7 +50650,7 @@ EDITS: 1
(run
(lambda ()
(* k x))))))
- (if (fneq val 6.2) (snd-display ";run do 6: ~A (6.2)" val)))
+ (if (fneq val 6.2) (snd-display #__line__ ";run do 6: ~A (6.2)" val)))
(let ((val
(let ((k 2)
@@ -50559,7 +50658,7 @@ EDITS: 1
(run
(lambda ()
(* x k))))))
- (if (fneq val 6.2) (snd-display ";run do 7: ~A (6.2)" val)))
+ (if (fneq val 6.2) (snd-display #__line__ ";run do 7: ~A (6.2)" val)))
(let ((val
(let ((k 2)
@@ -50567,7 +50666,7 @@ EDITS: 1
(run
(lambda ()
(+ k x))))))
- (if (fneq val 5.1) (snd-display ";run do 8: ~A (5.1)" val)))
+ (if (fneq val 5.1) (snd-display #__line__ ";run do 8: ~A (5.1)" val)))
(let ((val
(let ((k 2)
@@ -50575,7 +50674,7 @@ EDITS: 1
(run
(lambda ()
(+ x k))))))
- (if (fneq val 5.1) (snd-display ";run do 9: ~A (5.1)" val)))
+ (if (fneq val 5.1) (snd-display #__line__ ";run do 9: ~A (5.1)" val)))
(let ((val
(let ((k 2)
@@ -50583,7 +50682,7 @@ EDITS: 1
(run
(lambda ()
(- k x))))))
- (if (fneq val -1.1) (snd-display ";run do 10: ~A (-1.1)" val)))
+ (if (fneq val -1.1) (snd-display #__line__ ";run do 10: ~A (-1.1)" val)))
(let ((val
(let ((k 2)
@@ -50591,7 +50690,7 @@ EDITS: 1
(run
(lambda ()
(- x k))))))
- (if (fneq val 1.1) (snd-display ";run do 11: ~A (1.1)" val)))
+ (if (fneq val 1.1) (snd-display #__line__ ";run do 11: ~A (1.1)" val)))
(let ((val
(let ((k 2)
@@ -50599,7 +50698,7 @@ EDITS: 1
(run
(lambda ()
(/ k x))))))
- (if (fneq val 0.64516129) (snd-display ";run do 12: ~A (0.64516129)" val)))
+ (if (fneq val 0.64516129) (snd-display #__line__ ";run do 12: ~A (0.64516129)" val)))
(let ((val
(let ((k 2)
@@ -50607,21 +50706,21 @@ EDITS: 1
(run
(lambda ()
(/ x k))))))
- (if (fneq val 1.55) (snd-display ";run do 12: ~A (1.55)" val)))
+ (if (fneq val 1.55) (snd-display #__line__ ";run do 12: ~A (1.55)" val)))
(let ((val
(let ((v (vct 1 2 3 4 5)))
(run
(lambda ()
(vct-ref v 3))))))
- (if (fneq val 4.0) (snd-display ";run do 13: ~A (4.0)" val)))
+ (if (fneq val 4.0) (snd-display #__line__ ";run do 13: ~A (4.0)" val)))
(let ((val
(let ((v (vct 1 2 3 4 5)))
(run
(lambda ()
(vct-ref v 4))))))
- (if (fneq val 5.0) (snd-display ";run do 14: ~A (5.0)" val)))
+ (if (fneq val 5.0) (snd-display #__line__ ";run do 14: ~A (5.0)" val)))
(let ((val
(let ((v (vct 1 2 3 4 5)))
@@ -50629,7 +50728,7 @@ EDITS: 1
(lambda ()
(vct-set! v 3 32.0)
(vct-ref v 3))))))
- (if (fneq val 32.0) (snd-display ";run do 15: ~A (21.0)" val)))
+ (if (fneq val 32.0) (snd-display #__line__ ";run do 15: ~A (21.0)" val)))
(let ((val
(let ((v (vct 1 2 3 4 5)))
@@ -50637,8 +50736,8 @@ EDITS: 1
(lambda ()
(set! (vct-ref v 3) 32.0) ; bug here!
(vct-ref v 3))))))
- (if (fneq val 32.0) (snd-display ";run do 16: ~A (21.0)" val)))
-
+ (if (fneq val 32.0) (snd-display #__line__ ";run do 16: ~A (21.0)" val)))
+
(let ((data1 (make-vct 10))
(data2 (make-vct 10))
(gen1 (make-oscil 100.0))
@@ -50657,7 +50756,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 10))
(vct-set! data2 i (* (env e2) (oscil gen2 (+ x2 y2)))))))
- (if (not (vequal data1 data2)) (snd-display ";run opt oscil_1f_2_env: ~A ~A" data1 data2)))
+ (if (not (vequal data1 data2)) (snd-display #__line__ ";run opt oscil_1f_2_env: ~A ~A" data1 data2)))
(let ((data1 (make-vct 10))
(data2 (make-vct 10))
@@ -50675,8 +50774,8 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 10))
(vct-set! data2 i (* (env e2) (polyshape gen2 1.0 x2))))))
- (if (not (vequal data1 data2)) (snd-display ";run opt polyshape_1fn_env: ~A ~A" data1 data2)))
-
+ (if (not (vequal data1 data2)) (snd-display #__line__ ";run opt polyshape_1fn_env: ~A ~A" data1 data2)))
+
(let ((val (catch 'oops
(lambda ()
(run (lambda ()
@@ -50687,7 +50786,7 @@ EDITS: 1
(throw 'oops))
(set! inner i))))))
(lambda args (car args)))))
- (if (not (eq? val 'oops)) (snd-display ";run throw: ~A" val)))
+ (if (not (eq? val 'oops)) (snd-display #__line__ ";run throw: ~A" val)))
(let ((outer 0))
(let ((val (catch 'oops
@@ -50701,28 +50800,28 @@ EDITS: 1
(throw 'oops))
(set! inner i))))))
(lambda args (car args)))))
- (if (not (eq? val 'oops)) (snd-display ";run throw: ~A" val))
- (if (not (= outer 4)) (snd-display ";run throw reset outer: ~A" outer))))
+ (if (not (eq? val 'oops)) (snd-display #__line__ ";run throw: ~A" val))
+ (if (not (= outer 4)) (snd-display #__line__ ";run throw reset outer: ~A" outer))))
(let ((val (run (lambda () (let ((v (make-vct 2 .1))) (define (ho xv) (declare (xv vct)) (vct-ref xv 1)) (ho v))))))
- (if (fneq val 0.1) (snd-display ";run embedded lambda arg vct: ~A" val)))
+ (if (fneq val 0.1) (snd-display #__line__ ";run embedded lambda arg vct: ~A" val)))
(let ((val (run (lambda () (let ((v (make-vct 2 .1))) (define (ho) (make-vct 3 .5)) (vct-ref (ho) 0))))))
- (if (fneq val 0.5) (snd-display ";run embedded lambda rtn vct: ~A" val)))
+ (if (fneq val 0.5) (snd-display #__line__ ";run embedded lambda rtn vct: ~A" val)))
(let ((val (run (lambda () (let ((v (make-sound-data 2 3))) (define (ho xv) (declare (xv sound-data)) (sound-data-chans xv)) (ho v))))))
- (if (not (= val 2)) (snd-display ";run embedded lambda arg sound-data: ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";run embedded lambda arg sound-data: ~A" val)))
(let ((val (run (lambda () (let ((v (make-sound-data 2 3))) (define (ho) (make-sound-data 3 5)) (sound-data-length (ho)))))))
- (if (not (= val 5)) (snd-display ";run embedded lambda rtn sound-data: ~A" val)))
+ (if (not (= val 5)) (snd-display #__line__ ";run embedded lambda rtn sound-data: ~A" val)))
(if with-gui
(let ((ind (open-sound "oboe.snd")))
(let ((val (run (lambda ()
(let ((r (make-sampler 1000 ind 0)))
(define (ho rd) (declare (rd sampler)) (next-sample rd))
(ho r))))))
- (if (fneq val (sample 1000)) (snd-display ";run embedded lambda arg sampler: ~A ~A" (sample 1000) val)))
+ (if (fneq val (sample 1000)) (snd-display #__line__ ";run embedded lambda arg sampler: ~A ~A" (sample 1000) val)))
(let ((val (run (lambda ()
(define (ho) (make-sampler 1000 ind 0))
(read-sample (ho))))))
- (if (fneq val (sample 1000)) (snd-display ";run embedded lambda rtn sampler: ~A ~A" (sample 1000) val)))
+ (if (fneq val (sample 1000)) (snd-display #__line__ ";run embedded lambda rtn sampler: ~A ~A" (sample 1000) val)))
(close-sound ind)))
(let ((ind (open-sound "oboe.snd")))
@@ -50739,44 +50838,44 @@ EDITS: 1
(let ((v (autocorrelate lrla)))
(set! lvok (vct? v)))
lrla))))
- (if (not lvok) (snd-display ";run autocorrelate vct return?"))
- (if (not (vct? lrla)) (snd-display ";run lambda vct return: ~A?" lrla))
- (if (fneq (vct-ref val 0) 2.0) (snd-display ";run autocorrelate 0: ~A" (vct-ref lrla 0)))
- (if (fneq (vct-ref val 4) 1.0) (snd-display ";run autocorrelate 4: ~A" (vct-ref lrla 4)))))
+ (if (not lvok) (snd-display #__line__ ";run autocorrelate vct return?"))
+ (if (not (vct? lrla)) (snd-display #__line__ ";run lambda vct return: ~A?" lrla))
+ (if (fneq (vct-ref val 0) 2.0) (snd-display #__line__ ";run autocorrelate 0: ~A" (vct-ref lrla 0)))
+ (if (fneq (vct-ref val 4) 1.0) (snd-display #__line__ ";run autocorrelate 4: ~A" (vct-ref lrla 4)))))
(if (not (vequal (vct -0.5 1 1)
(run (lambda () (partials->polynomial (vct 1 1 2 .5))))))
- (snd-display ";run partials->polynomial no kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5))))))
+ (snd-display #__line__ ";run partials->polynomial no kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5))))))
(if (not (vequal (vct -0.5 1 1)
(run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-first-kind)))))
- (snd-display ";run partials->polynomial 1st kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-first-kind)))))
+ (snd-display #__line__ ";run partials->polynomial 1st kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-first-kind)))))
(if (not (vequal (vct 1 1 0)
(run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-second-kind)))))
- (snd-display ";run partials->polynomial 2nd kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-second-kind)))))
+ (snd-display #__line__ ";run partials->polynomial 2nd kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-second-kind)))))
(let ((vals (vct 1 1 3 1)))
(let ((nvals (run (lambda () (normalize-partials vals)))))
(if (not (vequal nvals (vct 1.000 0.500 3.000 0.500)))
- (snd-display ";run normalize-partials: ~A" nvals))))
+ (snd-display #__line__ ";run normalize-partials: ~A" nvals))))
(let ((ho 123))
(let ((val (run-eval '(lambda () (lfunc)))))
- (if (not (= val 3)) (snd-display ";opt 6 case broken!: ~A" val))))
+ (if (not (= val 3)) (snd-display #__line__ ";opt 6 case broken!: ~A" val))))
(let ((old-opt (optimization)))
(set! (optimization) 4) ; below global-set level
(run-eval '(set! int-var 4321))
- (if (not (= int-var 4321)) (snd-display ";no global set, int: ~A" int-var))
+ (if (not (= int-var 4321)) (snd-display #__line__ ";no global set, int: ~A" int-var))
(run-eval '(set! dbl-var 4321.5))
- (if (fneq dbl-var 4321.5) (snd-display ";no global set, dbl: ~A" dbl-var))
+ (if (fneq dbl-var 4321.5) (snd-display #__line__ ";no global set, dbl: ~A" dbl-var))
(run-eval '(set! c-var #\f))
- (if (not (char=? c-var #\f)) (snd-display ";no global set, char: ~A" c-var))
+ (if (not (char=? c-var #\f)) (snd-display #__line__ ";no global set, char: ~A" c-var))
(run-eval '(set! bool-var #t))
- (if (not bool-var) (snd-display ";no global set, bool: ~A" bool-var))
+ (if (not bool-var) (snd-display #__line__ ";no global set, bool: ~A" bool-var))
(run-eval '(set! str-var "hiha"))
- (if (not (string=? str-var "hiha")) (snd-display ";no global set, str: ~A" str-var))
+ (if (not (string=? str-var "hiha")) (snd-display #__line__ ";no global set, str: ~A" str-var))
(run-eval '(vector-set! ivect 1 2))
- (if (not (= (vector-ref ivect 1) 2)) (snd-display ";no global set, ivect: ~A" (vector-ref ivect 1)))
+ (if (not (= (vector-ref ivect 1) 2)) (snd-display #__line__ ";no global set, ivect: ~A" (vector-ref ivect 1)))
(set! (optimization) old-opt))
(let ((old-opt (optimization)))
@@ -50791,13 +50890,13 @@ EDITS: 1
(set! unique-boolean #f)
(vector-set! unique-float-vector 1 3.0)
(vector-set! unique-int-vector 1 6)))
- (if (not (= unique-int 5)) (snd-display ";unique-int (~A): ~A" n unique-int))
- (if (fneq unique-float 1.5) (snd-display ";unique-float (~A): ~A" n unique-float))
- (if (not (char=? unique-char #\z)) (snd-display ";unique-char (~A): ~A" n unique-char))
- (if (not (string=? unique-string "a new string")) (snd-display ";unique-string (~A): ~A" n unique-string))
- (if (not (= (vector-ref unique-int-vector 1) 6)) (snd-display ";unique-int-vector (~A): ~A" n unique-int-vector))
- (if (fneq (vector-ref unique-float-vector 1) 3.0) (snd-display ";unique-float-vector (~A): ~A" n unique-float-vector))
- (if unique-boolean (snd-display ";unique-boolean?"))
+ (if (not (= unique-int 5)) (snd-display #__line__ ";unique-int (~A): ~A" n unique-int))
+ (if (fneq unique-float 1.5) (snd-display #__line__ ";unique-float (~A): ~A" n unique-float))
+ (if (not (char=? unique-char #\z)) (snd-display #__line__ ";unique-char (~A): ~A" n unique-char))
+ (if (not (string=? unique-string "a new string")) (snd-display #__line__ ";unique-string (~A): ~A" n unique-string))
+ (if (not (= (vector-ref unique-int-vector 1) 6)) (snd-display #__line__ ";unique-int-vector (~A): ~A" n unique-int-vector))
+ (if (fneq (vector-ref unique-float-vector 1) 3.0) (snd-display #__line__ ";unique-float-vector (~A): ~A" n unique-float-vector))
+ (if unique-boolean (snd-display #__line__ ";unique-boolean?"))
(set! unique-float 3.0)
(set! unique-int 3)
(set! unique-char #\c)
@@ -50811,12 +50910,12 @@ EDITS: 1
(let ((val (run-eval '(format #f "~A" 'hiho))))
(if (or (not (string? val))
(not (string=? val "hiho")))
- (snd-display ";run format 'hiho: ~A" val)))
+ (snd-display #__line__ ";run format 'hiho: ~A" val)))
(let ((val (run (lambda () (oscil (make-oscil :frequency 100 :initial-phase 0.0))))))
- (if (fneq val 0.0) (snd-display ";run oscil make-oscil: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";run oscil make-oscil: ~A" val)))
(let ((val (run-eval '(format #f "~A ~A ~A ~A ~A" 'a 'b 'c 'd 'e))))
(if (not (string=? val "a b c d e"))
- (snd-display ";run format abcde: ~A" val)))
+ (snd-display #__line__ ";run format abcde: ~A" val)))
(let ((val (run-eval '(let ((str1 (format #f "~A~A" 'a 'a))
(str2 (format #f "~A" 'a))
@@ -50826,10 +50925,10 @@ EDITS: 1
(str6 (format #f "~A" 'b)))
(string-append str1 str2 str3 str4 str5 str6)))))
(if (not (string=? val "aaaaaaaab"))
- (snd-display ";run format aaaaaaaab: ~A" val)))
+ (snd-display #__line__ ";run format aaaaaaaab: ~A" val)))
(let ((tag (catch #t (lambda () (mus-close 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";mus-close 1: ~A" tag)))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mus-close 1: ~A" tag)))
(if (file-exists? "test.snd")
(delete-file "test.snd"))
@@ -50838,13 +50937,13 @@ EDITS: 1
(sample->file v 0 0 0.7)
(mus-close v))))
(if (not (file-exists? "test.snd"))
- (snd-display ";run sample->file no file")
+ (snd-display #__line__ ";run sample->file no file")
(let ((ind (open-sound "test.snd")))
- (if (not (= (data-format ind) mus-lshort)) (snd-display ";run sample->file data format: ~A" (mus-data-format-name (data-format ind))))
- (if (not (= (header-type ind) mus-riff)) (snd-display ";run sample->file header type: ~A" (mus-header-type-name (header-type ind))))
- (if (not (= (frames ind) 1)) (snd-display ";run sample->file frames: ~A" (frames ind)))
- (if (not (= (channels ind) 2)) (snd-display ";run sample->file chans: ~A" (channels ind)))
- (if (fneq (sample 0 ind) 0.7) (snd-display ";run sample->file sample: ~A" (sample 0 ind)))
+ (if (not (= (data-format ind) mus-lshort)) (snd-display #__line__ ";run sample->file data format: ~A" (mus-data-format-name (data-format ind))))
+ (if (not (= (header-type ind) mus-riff)) (snd-display #__line__ ";run sample->file header type: ~A" (mus-header-type-name (header-type ind))))
+ (if (not (= (frames ind) 1)) (snd-display #__line__ ";run sample->file frames: ~A" (frames ind)))
+ (if (not (= (channels ind) 2)) (snd-display #__line__ ";run sample->file chans: ~A" (channels ind)))
+ (if (fneq (sample 0 ind) 0.7) (snd-display #__line__ ";run sample->file sample: ~A" (sample 0 ind)))
(close-sound ind)))
(if (file-exists? "test.snd")
@@ -50854,25 +50953,25 @@ EDITS: 1
(frame->file v 0 (make-frame 4 0.7 0.3 0.1 0.2))
(mus-close v))))
(if (not (file-exists? "test.snd"))
- (snd-display ";run frame->file no file")
+ (snd-display #__line__ ";run frame->file no file")
(let ((ind (open-sound "test.snd")))
- (if (not (= (data-format ind) mus-bfloat)) (snd-display ";run frame->file data format: ~A" (mus-data-format-name (data-format ind))))
- (if (not (= (header-type ind) mus-aifc)) (snd-display ";run frame->file header type: ~A" (mus-header-type-name (header-type ind))))
- (if (not (= (frames ind) 1)) (snd-display ";run frame->file frames: ~A" (frames ind)))
- (if (not (= (channels ind) 4)) (snd-display ";run frame->file chans: ~A" (channels ind)))
- (if (fneq (sample 0 ind 0) 0.7) (snd-display ";run frame->file sample 0: ~A" (sample 0 ind 0)))
- (if (fneq (sample 0 ind 1) 0.3) (snd-display ";run frame->file sample 1: ~A" (sample 0 ind 1)))
- (if (fneq (sample 0 ind 2) 0.1) (snd-display ";run frame->file sample 2: ~A" (sample 0 ind 2)))
- (if (fneq (sample 0 ind 3) 0.2) (snd-display ";run frame->file sample 3: ~A" (sample 0 ind 3)))
+ (if (not (= (data-format ind) mus-bfloat)) (snd-display #__line__ ";run frame->file data format: ~A" (mus-data-format-name (data-format ind))))
+ (if (not (= (header-type ind) mus-aifc)) (snd-display #__line__ ";run frame->file header type: ~A" (mus-header-type-name (header-type ind))))
+ (if (not (= (frames ind) 1)) (snd-display #__line__ ";run frame->file frames: ~A" (frames ind)))
+ (if (not (= (channels ind) 4)) (snd-display #__line__ ";run frame->file chans: ~A" (channels ind)))
+ (if (fneq (sample 0 ind 0) 0.7) (snd-display #__line__ ";run frame->file sample 0: ~A" (sample 0 ind 0)))
+ (if (fneq (sample 0 ind 1) 0.3) (snd-display #__line__ ";run frame->file sample 1: ~A" (sample 0 ind 1)))
+ (if (fneq (sample 0 ind 2) 0.1) (snd-display #__line__ ";run frame->file sample 2: ~A" (sample 0 ind 2)))
+ (if (fneq (sample 0 ind 3) 0.2) (snd-display #__line__ ";run frame->file sample 3: ~A" (sample 0 ind 3)))
(close-sound ind)))
(let ((tag (catch #t (lambda () (make-frame 2 .1 .2 .3)) (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";frame too many args: ~A" tag)))
+ (snd-display #__line__ ";frame too many args: ~A" tag)))
(let ((val (run-eval '(lambda (a) (declare (a sound-data)) (sound-data-ref a 0 0)) (make-sound-data 1 1))))
- (if (fneq val 0.0) (snd-display ";run sound-data arg: ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";run sound-data arg: ~A" val)))
(let ((rdat (make-vct 16))
(idat (make-vct 16))
@@ -50884,10 +50983,10 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 8))
(if (fneq (vct-ref rdat i) 1.0)
- (snd-display ";run impulse->flat? ~A" rdat))))
+ (snd-display #__line__ ";run impulse->flat? ~A" rdat))))
(let ((val (run-eval '(frame-ref (sample->frame (make-mixer 1 1.0) .5) 0))))
- (if (fneq val 0.5) (snd-display ";run sample->frame no frame: ~A" val)))
+ (if (fneq val 0.5) (snd-display #__line__ ";run sample->frame no frame: ~A" val)))
(run (lambda () (oscil unique-generator))) ; needed below
@@ -50895,45 +50994,45 @@ EDITS: 1
(run-eval '(lambda (a) (declare (sound-data a)) (sound-data-ref a 0 0))
(make-sound-data 1 1)))
(lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run declare backwards sound-data: ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run declare backwards sound-data: ~A" tag)))
(let ((val (run-eval '(format #f "~A ~A" (+ 1 2) (* 3 4)))))
- (if (not (string=? val "3 12")) (snd-display ";run format 3 12: ~A" val)))
+ (if (not (string=? val "3 12")) (snd-display #__line__ ";run format 3 12: ~A" val)))
(let ((val (run-eval '(format #f "~A ~A" (make-vct 3 1.0) (make-vector 3 2.0)))))
(if (not (string=? val "#<vct[len=3]: 1.000 1.000 1.000> #<vct[len=3]: 2.000 2.000 2.000>"))
- (snd-display ";run format vcts: ~A" val)))
+ (snd-display #__line__ ";run format vcts: ~A" val)))
(let ((val (run-eval '(format #f "~A ~A" (string-append "a" "b") (number? "c")))))
- (if (not (string=? val "ab #f")) (snd-display ";run format ab #f: ~A" val)))
+ (if (not (string=? val "ab #f")) (snd-display #__line__ ";run format ab #f: ~A" val)))
(let ((old-opt (optimization)))
(set! (optimization) 6)
(let ((val (run (lambda () (format #f "~A ~A" (make-vct 3 1.0) (make-vector 3 2.0))))))
(if (not (string=? val "#<vct[len=3]: 1.000 1.000 1.000> #<vct[len=3]: 2.000 2.000 2.000>"))
(if (string=? val "#<vct[len=3]: 1.000 1.000 1.000> #(2.0 2.0 2.0)")
- (snd-display ";run format vector instead of vct: ~A (opt: ~A, max: ~A)" val (optimization) max-optimization)
- (snd-display ";run format vcts l: ~A" val))))
+ (snd-display #__line__ ";run format vector instead of vct: ~A (opt: ~A, max: ~A)" val (optimization) max-optimization)
+ (snd-display #__line__ ";run format vcts l: ~A" val))))
(let ((val (run (lambda () (format #f "~A ~A" (string-append "a" "b") (number? "c"))))))
- (if (not (string=? val "ab #f")) (snd-display ";run format ab #f l: ~A" val)))
+ (if (not (string=? val "ab #f")) (snd-display #__line__ ";run format ab #f l: ~A" val)))
(let ((val (run (lambda () (format #f "~A ~A" (make-sound-data 1 1) (make-oscil))))))
(if (and (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)> #<oscil freq: 0.000Hz, phase: 0.000>"))
(not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)> oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display ";run format sd osc: ~A" val)))
+ (snd-display #__line__ ";run format sd osc: ~A" val)))
(let ((val (run (lambda () (format #f "~A ~A" (+ 1 2) (* 3 4))))))
- (if (not (string=? val "3 12")) (snd-display ";run format 3 12 l: ~A" val)))
+ (if (not (string=? val "3 12")) (snd-display #__line__ ";run format 3 12 l: ~A" val)))
(set! (optimization) old-opt))
(let ((hi (vector 1 2 3)))
(let ((ho (run (lambda () (vector-set! hi 2 4) hi))))
(if (not (vector? ho))
- (snd-display ";run rtns int vect: ~A" ho)
+ (snd-display #__line__ ";run rtns int vect: ~A" ho)
(if (not (= (vector-ref ho 2) 4))
- (snd-display ";run sets int vect: ~A" (vector-ref ho 2))))))
+ (snd-display #__line__ ";run sets int vect: ~A" (vector-ref ho 2))))))
(let ((hi (run (lambda () (let ((v (make-vector 3 0))) (vector-set! v 1 2) v)))))
(if (not (vector? hi))
- (snd-display ";run rtns make int vect: ~A" hi)
+ (snd-display #__line__ ";run rtns make int vect: ~A" hi)
(if (not (= (vector-ref hi 1) 2))
- (snd-display ";run sets make int vect: ~A" (vector-ref hi 1)))))
+ (snd-display #__line__ ";run sets make int vect: ~A" (vector-ref hi 1)))))
(let ((tag (catch #t (lambda ()
(run-eval '(lambda (x)
@@ -50942,7 +51041,7 @@ EDITS: 1
val))
#t))
(lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run branches ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run branches ~A" tag)))
(let ((tag (catch #t (lambda ()
(run-eval '(lambda (x)
(declare (x float))
@@ -50950,7 +51049,7 @@ EDITS: 1
val))
#t))
(lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run selector ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run selector ~A" tag)))
(let ((tag (catch #t (lambda ()
(run-eval '(lambda (x)
(declare (x int))
@@ -50958,38 +51057,38 @@ EDITS: 1
val))
0))
(lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run case key ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run case key ~A" tag)))
(let ((val (run (lambda () (let ((val (if (> 3 2) 123 "hi"))) val)))))
- (if (not (= val 123)) (snd-display ";run opt-if 123: ~A" val)))
+ (if (not (= val 123)) (snd-display #__line__ ";run opt-if 123: ~A" val)))
(let ((val (run-eval '(if (< 3 2) 123 "hi"))))
- (if (not (string=? val "hi")) (snd-display ";run opt-if-not 123: ~A" val)))
+ (if (not (string=? val "hi")) (snd-display #__line__ ";run opt-if-not 123: ~A" val)))
(let ((sd (make-sound-data 1 1)))
(let ((val (run (lambda () (format #f "~A" sd)))))
(if (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)>"))
- (snd-display ";run format sound-data 0: ~A" val))))
+ (snd-display #__line__ ";run format sound-data 0: ~A" val))))
(let ((val (run-eval '(format #f "~A" (make-sound-data 1 1)))))
(if (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)>"))
- (snd-display ";run format sound-data 1: ~A" val)))
+ (snd-display #__line__ ";run format sound-data 1: ~A" val)))
(let ((val (run-eval '(lambda (arg)
(declare (arg sound-data))
(format #f "~A" arg))
(make-sound-data 1 1))))
(if (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)>"))
- (snd-display ";run format sound-data 2: ~A" val)))
+ (snd-display #__line__ ";run format sound-data 2: ~A" val)))
(let ((val (run-eval '(format #f "~A" (make-oscil)))))
(if (and (not (string=? val "#<oscil freq: 0.000Hz, phase: 0.000>"))
(not (string=? val "oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display ";run format gen 0: ~A" val)))
+ (snd-display #__line__ ";run format gen 0: ~A" val)))
(let ((val (run (lambda () (format #f "~A" unique-generator)))))
(if (and (not (string=? val "#<oscil freq: 0.000Hz, phase: 0.000>"))
(not (string=? val "oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display ";run format gen phase 1: ~A" val)))
+ (snd-display #__line__ ";run format gen phase 1: ~A" val)))
(let ((val (run-eval '(format #f "~A" unique-generator))))
(if (and (not (string=? val "#<oscil freq: 0.000Hz, phase: 0.000>"))
(not (string=? val "oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display ";run format gen phase 2: ~A" val)))
+ (snd-display #__line__ ";run format gen phase 2: ~A" val)))
(let ((make-procs (list
make-all-pass make-asymmetric-fm make-moving-average
@@ -51012,7 +51111,7 @@ EDITS: 1
(val2 (run (lambda () (format #f "~A" gen)))))
(if (not (string=? val1 val2))
- (snd-display ";run format gen: format: ~A, run format: ~A (~A)" val1 val2 gen))))
+ (snd-display #__line__ ";run format gen: format: ~A, run format: ~A (~A)" val1 val2 gen))))
make-procs))
(let ((val1 (run-eval '(format #f "~A" (make-all-pass))))
@@ -51021,7 +51120,7 @@ EDITS: 1
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-asymmetric-fm ))))
@@ -51030,217 +51129,217 @@ EDITS: 1
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-moving-average))))
(val2 (run (lambda () (let ((gen (make-moving-average))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-moving-average))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-comb ))))
(val2 (run (lambda () (let ((gen (make-comb ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-comb ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-filtered-comb :filter (make-one-zero .5 .5)))))
(val2 (run (lambda () (let ((gen (make-filtered-comb :filter (make-one-zero .5 .5)))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-filtered-comb :filter (make-one-zero .5 .5)))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-delay ))))
(val2 (run (lambda () (let ((gen (make-delay ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-delay ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-firmant ))))
(val2 (run (lambda () (let ((gen (make-firmant ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-firmant ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-formant ))))
(val2 (run (lambda () (let ((gen (make-formant ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-formant ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-granulate))))
(val2 (run (lambda () (let ((gen (make-granulate))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-granulate))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-locsig ))))
(val2 (run (lambda () (let ((gen (make-locsig ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-locsig ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-notch ))))
(val2 (run (lambda () (let ((gen (make-notch ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-notch ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-one-pole ))))
(val2 (run (lambda () (let ((gen (make-one-pole ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-one-pole ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-one-zero ))))
(val2 (run (lambda () (let ((gen (make-one-zero ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-one-zero ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-oscil ))))
(val2 (run (lambda () (let ((gen (make-oscil ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-oscil ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-pulse-train ))))
(val2 (run (lambda () (let ((gen (make-pulse-train ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-pulse-train ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-rand ))))
(val2 (run (lambda () (let ((gen (make-rand ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-rand ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-sawtooth-wave))))
(val2 (run (lambda () (let ((gen (make-sawtooth-wave))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-sawtooth-wave))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-nrxysin ))))
(val2 (run (lambda () (let ((gen (make-nrxysin ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-nrxysin ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-nrxycos ))))
(val2 (run (lambda () (let ((gen (make-nrxycos ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-nrxycos ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-square-wave ))))
(val2 (run (lambda () (let ((gen (make-square-wave ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-square-wave ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-src ))))
(val2 (run (lambda () (let ((gen (make-src ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-src ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-ncos ))))
(val2 (run (lambda () (let ((gen (make-ncos ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-ncos ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-nsin ))))
(val2 (run (lambda () (let ((gen (make-nsin ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-nsin ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-table-lookup ))))
(val2 (run (lambda () (let ((gen (make-table-lookup ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-table-lookup ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-triangle-wave))))
(val2 (run (lambda () (let ((gen (make-triangle-wave))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-triangle-wave))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-two-pole ))))
(val2 (run (lambda () (let ((gen (make-two-pole ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-two-pole ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-two-zero ))))
(val2 (run (lambda () (let ((gen (make-two-zero ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-two-zero ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-wave-train ))))
(val2 (run (lambda () (let ((gen (make-wave-train ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-wave-train ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-polyshape ))))
(val2 (run (lambda () (let ((gen (make-polyshape ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-polyshape ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-polywave ))))
(val2 (run (lambda () (let ((gen (make-polywave ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-polywave ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-phase-vocoder ))))
(val2 (run (lambda () (let ((gen (make-phase-vocoder ))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-phase-vocoder ))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((val1 (run-eval '(format #f "~A" (make-ssb-am))))
(val2 (run (lambda () (let ((gen (make-ssb-am))) (format #f "~A" gen)))))
(val3 (format #f "~A" (make-ssb-am))))
(if (or (not (string=? val1 val2))
(not (string=? val2 val3)))
- (snd-display ";run-eval format: ~A ~A ~A" val1 val2 val3)))
+ (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
(let ((v (run
(lambda ()
@@ -51248,7 +51347,7 @@ EDITS: 1
(y 3.0))
(let ((p (make-polyshape 440 :partials (vct 1 x 2 y))))
(mus-data p)))))))
- (if (not (vequal v (vct -3 2 6))) (snd-display ";run make-polyshape vct x y: ~A" v)))
+ (if (not (vequal v (vct -3 2 6))) (snd-display #__line__ ";run make-polyshape vct x y: ~A" v)))
(let ((v (run
(lambda ()
@@ -51256,228 +51355,228 @@ EDITS: 1
(y 3.0))
(let ((p (make-polyshape 440 :partials (vct 1 (+ x y) 2 (- y x)))))
(mus-data p)))))))
- (if (not (vequal v (vct -1 5 2))) (snd-display ";run make-polyshape vct x+y: ~A" v)))
+ (if (not (vequal v (vct -1 5 2))) (snd-display #__line__ ";run make-polyshape vct x+y: ~A" v)))
(let ((val (run-eval '(format #f "~A" unique-symbol))))
- (if (not (string=? val "hiho")) (snd-display ";run format symbol: ~A" val)))
+ (if (not (string=? val "hiho")) (snd-display #__line__ ";run format symbol: ~A" val)))
(let ((val (run-eval '(symbol? unique-symbol))))
- (if (not val) (snd-display ";run-eval symbol? global?")))
+ (if (not val) (snd-display #__line__ ";run-eval symbol? global?")))
(let ((val (run (lambda () (symbol? unique-symbol)))))
- (if (not val) (snd-display ";run symbol? global?")))
+ (if (not val) (snd-display #__line__ ";run symbol? global?")))
(let ((val (run (lambda () (eq? unique-symbol :hiho)))))
- (if val (snd-display ";run :hiho is a symbol?")))
+ (if val (snd-display #__line__ ";run :hiho is a symbol?")))
(let ((val (run (lambda () (eq? unique-symbol 'hiho)))))
- (if (not val) (snd-display ";run eq? symbol 'hiho?")))
+ (if (not val) (snd-display #__line__ ";run eq? symbol 'hiho?")))
(let ((val (run-eval '(symbol? unique-keyword))))
- (if val (snd-display ";run symbol? of keyword")))
+ (if val (snd-display #__line__ ";run symbol? of keyword")))
(let ((val (run-eval '(keyword? unique-keyword))))
- (if (not val) (snd-display ";run keyword? of keyword?")))
+ (if (not val) (snd-display #__line__ ";run keyword? of keyword?")))
(let ((val (run (lambda () (eq? unique-keyword :hiho)))))
- (if (not val) (snd-display ";run eq? of :hiho?")))
+ (if (not val) (snd-display #__line__ ";run eq? of :hiho?")))
(let ((val (run (lambda () (eq? unique-keyword 0)))))
- (if val (snd-display ";run eq? key 0?")))
+ (if val (snd-display #__line__ ";run eq? key 0?")))
(let ((val (run-eval '(cond ((= 1 2) 3) ((+ 2 3) 4)))))
- (if (not (= val 4)) (snd-display ";run bad cond: ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";run bad cond: ~A" val)))
(let ((tag (catch #t (lambda () (run-eval '(let ((a 3)) (set! a (current-environment))))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run bad set!: ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad set!: ~A" tag)))
(let ((tag (catch #t (lambda () (run-eval '(let ((a 2)) (define "hi" 3) a))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run bad define: ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad define: ~A" tag)))
(vector-set! unique-float-vector 1 "hi")
(let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-float-vector 1)))) (lambda args (car args)))))
- (if (not (equal? tag "hi")) (snd-display ";run bad float vector: ~A" tag)))
+ (if (not (equal? tag "hi")) (snd-display #__line__ ";run bad float vector: ~A" tag)))
(vector-set! unique-float-vector 1 1.0)
(vector-set! unique-int-vector 2 "hi")
(let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-int-vector 1)))) (lambda args (car args)))))
- (if (not (equal? tag 1)) (snd-display ";run bad int vector: ~A" tag)))
+ (if (not (equal? tag 1)) (snd-display #__line__ ";run bad int vector: ~A" tag)))
(vector-set! unique-int-vector 2 2)
(do ((i 0 (+ 1 i))) ((= i 2)) (vector-set! unique-clm-vector i (make-oscil)))
(vector-set! unique-clm-vector 2 "hi")
(let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-clm-vector 1)))) (lambda args (car args)))))
- (if (not (oscil? tag)) (snd-display ";run bad clm vector: ~A" tag)))
+ (if (not (oscil? tag)) (snd-display #__line__ ";run bad clm vector: ~A" tag)))
(vector-set! unique-clm-vector 2 (make-oscil))
(let ((tag (catch #t (lambda () (run-eval '(let ((a 1)) (set! c a)))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run bad set var: ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad set var: ~A" tag)))
(do ((i 0 (+ 1 i))) ((= i 2)) (vector-set! unique-vct-vector i (make-vct 3)))
(vector-set! unique-vct-vector 2 "hi")
(let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-vct-vector 1)))) (lambda args (car args)))))
- (if (not (vct? tag)) (snd-display ";run bad vct vector: ~A" tag)))
+ (if (not (vct? tag)) (snd-display #__line__ ";run bad vct vector: ~A" tag)))
(vector-set! unique-vct-vector 2 (make-vct 3))
(let ((val (run-eval '(let* ((a 1) (b (if (odd? a) :hi :ho))) (keyword? b)))))
- (if (not val) (snd-display ";run local return key")))
+ (if (not val) (snd-display #__line__ ";run local return key")))
(let ((val (run-eval '(let* ((a 1) (b (if (odd? a) :hi :ho))) b))))
- (if (not (equal? val :hi)) (snd-display ";run local return key: ~A" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run local return key: ~A" val)))
(let ((val (run-eval '(let* ((a 1) (b (if (even? a) 'hi 'ho))) (symbol? b)))))
- (if (not val) (snd-display ";run local return symbol")))
+ (if (not val) (snd-display #__line__ ";run local return symbol")))
(let ((val (run-eval '(let* ((a 1) (b (if (even? a) 'hi 'ho))) b))))
- (if (not (equal? val 'ho)) (snd-display ";run local return symbol: ~A" val)))
+ (if (not (equal? val 'ho)) (snd-display #__line__ ";run local return symbol: ~A" val)))
(let ((val (run (lambda () (let* ((a 1) (b (if (odd? a) :hi :ho))) (equal? b :hi))))))
- (if (not (equal? val #t)) (snd-display ";run b2 ~A:" val)))
+ (if (not (equal? val #t)) (snd-display #__line__ ";run b2 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1) (b :hi)) (equal? b :hi))))))
- (if (not (equal? val #t)) (snd-display ";run b3 ~A:" val)))
+ (if (not (equal? val #t)) (snd-display #__line__ ";run b3 ~A:" val)))
(let ((val (run-eval '(let* ((a 1) (b :hi)) b))))
- (if (not (equal? val :hi)) (snd-display ";run b4 ~A:" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run b4 ~A:" val)))
(let ((val (run-eval '(let* ((a 1) (b 'ho)) b))))
- (if (not (equal? val 'ho)) (snd-display ";run b5 ~A:" val)))
+ (if (not (equal? val 'ho)) (snd-display #__line__ ";run b5 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (if (odd? a) :hi :ho))))))
- (if (not (equal? val :hi)) (snd-display ";run b6 ~A:" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run b6 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (if (odd? a) 'hi 'ho))))))
- (if (not (equal? val 'hi)) (snd-display ";run b7 ~A:" val)))
+ (if (not (equal? val 'hi)) (snd-display #__line__ ";run b7 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (case a ((0) :hi) ((1) :ho) (else :ha)))))))
- (if (not (equal? val :ho)) (snd-display ";run b8 ~A:" val)))
+ (if (not (equal? val :ho)) (snd-display #__line__ ";run b8 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (begin :hi))))))
- (if (not (equal? val :hi)) (snd-display ";run b9 ~A:" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run b9 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) :hi) ((= a 1) :ho) (else :ha)))))))
- (if (not (equal? val :ho)) (snd-display ";run b10 ~A:" val)))
+ (if (not (equal? val :ho)) (snd-display #__line__ ";run b10 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) :hi) ((= a 1) :ho)))))))
- (if (not (equal? val :ho)) (snd-display ";run b11 ~A:" val)))
+ (if (not (equal? val :ho)) (snd-display #__line__ ";run b11 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (or (= a 0) :hi))))))
- (if (not val) (snd-display ";run b12 ~A:" val)))
+ (if (not val) (snd-display #__line__ ";run b12 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (and (= a 1) 'hi))))))
- (if (not val) (snd-display ";run b13 ~A:" val)))
+ (if (not val) (snd-display #__line__ ";run b13 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) 1) ((= a 1) 2) (else 3)))))))
- (if (not (equal? val 2)) (snd-display ";run b14 ~A:" val)))
+ (if (not (equal? val 2)) (snd-display #__line__ ";run b14 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) "hi") ((= a 1) "ho") (else "ha")))))))
- (if (not (equal? val "ho")) (snd-display ";run b15 ~A:" val)))
+ (if (not (equal? val "ho")) (snd-display #__line__ ";run b15 ~A:" val)))
(let ((val (run-eval '(if #t :hi))))
- (if (not (equal? val :hi)) (snd-display ";run b16 ~A:" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run b16 ~A:" val)))
(let ((val (run-eval '(if #f :hi :ho))))
- (if (not (equal? val :ho)) (snd-display ";run b17 ~A:" val)))
+ (if (not (equal? val :ho)) (snd-display #__line__ ";run b17 ~A:" val)))
(let ((val (run-eval '(let ((a (let ((b :hi)) b))) a))))
- (if (not (equal? val :hi)) (snd-display ";run b18 ~A:" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run b18 ~A:" val)))
(let ((val (run-eval '(let ((a 1) (b :hi)) (if (odd? a) b :ho)))))
- (if (not (equal? val :hi)) (snd-display ";run b19 ~A:" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run b19 ~A:" val)))
(let ((val (run-eval '(let ((a 1) (b :hi)) (if #t b :ho)))))
- (if (not (equal? val :hi)) (snd-display ";run b20 ~A:" val)))
+ (if (not (equal? val :hi)) (snd-display #__line__ ";run b20 ~A:" val)))
(let ((val (run-eval '(let ((a #\a)) (if (char? a) a)))))
- (if (not (equal? val #\a)) (snd-display ";run b21 ~A:" val)))
+ (if (not (equal? val #\a)) (snd-display #__line__ ";run b21 ~A:" val)))
(let ((val (run-eval '(let ((a #\a)) (if (number? a) a)))))
- (if (not (equal? val #f)) (snd-display ";run b22 ~A:" val)))
+ (if (not (equal? val #f)) (snd-display #__line__ ";run b22 ~A:" val)))
(let ((val (run-eval '(let ((a #\a)) (if (char? a) '(1 2))))))
- (if (not (equal? val '(1 2))) (snd-display ";run b24 ~A:" val)))
+ (if (not (equal? val '(1 2))) (snd-display #__line__ ";run b24 ~A:" val)))
(let ((val (run (lambda () (let* ((a 1) (b :hi)) (if (odd? a) (set! b :ho)) b)))))
- (if (not (equal? val :ho)) (snd-display ";run b25 ~A" val)))
+ (if (not (equal? val :ho)) (snd-display #__line__ ";run b25 ~A" val)))
(let ((tag (catch #t (lambda () (run-eval '(let* ((a 1) (b (case (a) ((0) -1) ((1) a) else -2)))))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run bad case selector: ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad case selector: ~A" tag)))
(let ((tag (catch #t (lambda () (run-eval '(let* ((a 1) (b (case a ((0) -1) ((1) a) else -2))) b))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display ";run bad case else: ~A" tag)))
+ (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad case else: ~A" tag)))
(let ((val (run-eval '(let* ((a 1) (b (case 0 ((0) -1) ((1) a)))) b))))
- (if (not (= val -1)) (snd-display ";run b26 ~A" val)))
+ (if (not (= val -1)) (snd-display #__line__ ";run b26 ~A" val)))
(let ((val (run-eval '(let* ((a 1) (b (case a ((0) -1) ((1) a)))) b))))
- (if (not (= val 1)) (snd-display ";run b27 ~A" val)))
+ (if (not (= val 1)) (snd-display #__line__ ";run b27 ~A" val)))
(let ((val (run-eval '(let* ((a 1) (b (case 0 ((0) -1) ((1) a) (else -2)))) b))))
- (if (not (= val -1)) (snd-display ";ru b28 ~A" val)))
+ (if (not (= val -1)) (snd-display #__line__ ";ru b28 ~A" val)))
(let ((val (run-eval '(let* ((a 1) (b (case 3 ((0) -1) ((1) a) (else -2)))) b))))
- (if (not (= val -2)) (snd-display ";run b29 ~A" val)))
+ (if (not (= val -2)) (snd-display #__line__ ";run b29 ~A" val)))
(let ((val (run-eval '(let* ((a 1) (b (case a ((0) -1) ((1) a) (else -2)))) b))))
- (if (not (= val 1)) (snd-display ";run b30 ~A" val)))
+ (if (not (= val 1)) (snd-display #__line__ ";run b30 ~A" val)))
(let ((val (run-eval '(begin (case 0 ((0) -1) ((1) 0) (else -2)) 2))))
- (if (not (= val 2)) (snd-display ";run b31 ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";run b31 ~A" val)))
(let ((val (run (lambda () (let ((a :ho)) (define (hi b) (declare (b keyword)) b) (hi a))))))
- (if (not (equal? val :ho)) (snd-display ";run b32 ~A" val)))
+ (if (not (equal? val :ho)) (snd-display #__line__ ";run b32 ~A" val)))
(let ((val (run (lambda () (let ((a 'ho)) (define (hi b) (declare (b symbol)) b) (hi a))))))
- (if (not (equal? val 'ho)) (snd-display ";run b33 ~A" val)))
+ (if (not (equal? val 'ho)) (snd-display #__line__ ";run b33 ~A" val)))
(let ((val (run (lambda () (let ((a "ho")) (define (hi b) (declare (b string)) b) (hi a))))))
- (if (not (equal? val "ho")) (snd-display ";run b34 ~A" val)))
+ (if (not (equal? val "ho")) (snd-display #__line__ ";run b34 ~A" val)))
(let ((val (run (lambda () (let ((a unique-int-vector)) (define (hi b) (declare (b int-vector)) b) (vector-ref (hi a) 0))))))
- (if (not (= val 1)) (snd-display ";run b35 ~A" val)))
+ (if (not (= val 1)) (snd-display #__line__ ";run b35 ~A" val)))
(set! unique-generator (make-delay 3))
(let ((val (run-eval '(vct-ref (mus-data unique-generator) 0)))) ; if oscil here, segfault
- (if (fneq val 0.0) (snd-display ";run b36 ~A" val)))
+ (if (fneq val 0.0) (snd-display #__line__ ";run b36 ~A" val)))
(let ((val (run-eval '(make-oscil 440.0))))
- (if (not (oscil? val)) (snd-display ";run -> gen: ~A" val)))
+ (if (not (oscil? val)) (snd-display #__line__ ";run -> gen: ~A" val)))
(let ((val (run-eval '(let ((a 1)) (if (odd? a) (make-oscil))))))
- (if (not (oscil? val)) (snd-display ";run if -> gen: ~A" val)))
+ (if (not (oscil? val)) (snd-display #__line__ ";run if -> gen: ~A" val)))
(let ((val (run-eval '(let ((a :hoi) (b :ha)) (do ((i 0 (+ 1 i))) ((= i 3) a) (set! b a))))))
- (if (not (equal? val :hoi)) (snd-display ";run b37 ~A" val)))
+ (if (not (equal? val :hoi)) (snd-display #__line__ ";run b37 ~A" val)))
(let ((val (run-eval '(let ((a "hio") (b "ha")) (do ((i 0 (+ 1 i))) ((= i 3) a) (set! b a))))))
- (if (not (equal? val "hio")) (snd-display ";run b38 ~A" val)))
+ (if (not (equal? val "hio")) (snd-display #__line__ ";run b38 ~A" val)))
(let ((val (run-eval '(let ((a (make-oscil)) (b 0)) (do ((i 0 (+ 1 i))) ((= i 3) a) (set! b i))))))
- (if (not (oscil? val)) (snd-display ";run b39 ~A" val)))
+ (if (not (oscil? val)) (snd-display #__line__ ";run b39 ~A" val)))
(let ((osc (make-oscil)))
(let ((val (run (lambda () (oscil osc) (mus-reset osc) (oscil osc)))))
- (if (fneq val 0.0) (snd-display ";run reset oscil: ~A ~A" val osc))))
+ (if (fneq val 0.0) (snd-display #__line__ ";run reset oscil: ~A ~A" val osc))))
(let ((gen (make-oscil 440.0)))
(let ((val (run (lambda () (let ((g1 gen)) (oscil g1) (oscil g1))))))
(if (and (fneq val 0.1250)
(fneq val 0.0626))
- (snd-display ";let osc g1: ~A" val))))
+ (snd-display #__line__ ";let osc g1: ~A" val))))
(let ((gen (make-oscil 440.0)))
(let ((val (run (lambda () (let ((g1 gen)) (oscil g1 1.0) (oscil g1 0.5))))))
(if (and (fneq val 0.9024)
(fneq val 0.8736))
- (snd-display ";let osc g1 1: ~A" val))))
+ (snd-display #__line__ ";let osc g1 1: ~A" val))))
(let ((gen (make-oscil 440.0)))
(let ((val (run (lambda () (let ((g1 gen)) (oscil g1 0.0 1.0) (oscil g1 0.0 0.5))))))
(if (and (fneq val 0.585)
(fneq val 0.5334))
- (snd-display ";let osc g1 0 1: ~A" val))))
+ (snd-display #__line__ ";let osc g1 0 1: ~A" val))))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 2) 2 3)) a))))
- (if (not (= val 2)) (snd-display ";set let: ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";set let: ~A" val)))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 123) 2 3)) a))))
- (if (not (= val 3)) (snd-display ";set let 2: ~A" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";set let 2: ~A" val)))
(let ((val (run-eval '(let ((a 0)) (set! a (do ((i 0 (+ 1 i))) ((= i 3) (+ i 1)) (set! a (* i 3))))))))
- (if (not (= val 4)) (snd-display ";set do ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";set do ~A" val)))
(let ((val (run-eval '(let ((a 0)) (set! a (cond ((= a 0) 1) ((= a 1) 2))) a))))
- (if (not (= val 1)) (snd-display ";set cond ~A" val)))
+ (if (not (= val 1)) (snd-display #__line__ ";set cond ~A" val)))
(let ((val (run-eval '(let ((a 1)) (set! a (cond ((= a 0) 1) ((= a 1) 2))) a))))
- (if (not (= val 2)) (snd-display ";set cond 2 ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";set cond 2 ~A" val)))
(let ((val (run-eval '(let ((a 1)) (set! a (case a ((0) 1) ((1) 2))) a))))
- (if (not (= val 2)) (snd-display ";set case ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";set case ~A" val)))
(let ((val (run-eval '(let ((a 1)) (set! a (begin (set! a 2) (+ a 1)))))))
- (if (not (= val 3)) (snd-display ";set begin ~A" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";set begin ~A" val)))
(let ((val (run-eval '(let ((a 1)) (set! a (let ((b 2)) (set! b (* b 2)) b))))))
- (if (not (= val 4)) (snd-display ";set let 3 ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";set let 3 ~A" val)))
(let ((val (run-eval '(let* ((a 3) (b a)) (set! a (let ((c 2)) (set! c (* b c 2)) c))))))
- (if (not (= val 12)) (snd-display ";set let 4 ~A" val)))
+ (if (not (= val 12)) (snd-display #__line__ ";set let 4 ~A" val)))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 2) (if (> a 1) 2 3) 4)) a))))
- (if (not (= val 3)) (snd-display ";set let 6: ~A" val)))
+ (if (not (= val 3)) (snd-display #__line__ ";set let 6: ~A" val)))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (> a 1) 2 3) 4)) a))))
- (if (not (= val 4)) (snd-display ";set let 7: ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";set let 7: ~A" val)))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (< a 1) 2 3) 4)) a))))
- (if (not (= val 4)) (snd-display ";set let 8: ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";set let 8: ~A" val)))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 2) (if (< a 1) 2 3) 4)) a))))
- (if (not (= val 2)) (snd-display ";set let 9: ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";set let 9: ~A" val)))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (< a 1) 2 3) (if (> a 1) 4 5))) a))))
- (if (not (= val 5)) (snd-display ";set let 10: ~A" val)))
+ (if (not (= val 5)) (snd-display #__line__ ";set let 10: ~A" val)))
(let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (< a 1) 2 3) (if (< a 1) 4 5))) a))))
- (if (not (= val 4)) (snd-display ";set let 10: ~A" val)))
+ (if (not (= val 4)) (snd-display #__line__ ";set let 10: ~A" val)))
(let ((val (run-eval '(or 1 2))))
- (if (not (= val 1)) (snd-display ";or 1 2: ~A" val)))
+ (if (not (= val 1)) (snd-display #__line__ ";or 1 2: ~A" val)))
(let ((val (run-eval '(or #f 2))))
- (if (not val) (snd-display ";or #f 2: ~A" val)))
+ (if (not val) (snd-display #__line__ ";or #f 2: ~A" val)))
(let ((val (run-eval '(and #f 2))))
- (if (not (eq? val #f)) (snd-display ";and #f 2: ~A" val)))
+ (if (not (eq? val #f)) (snd-display #__line__ ";and #f 2: ~A" val)))
(let ((a 0))
(let ((val (run (lambda () (and (let ((b 32)) (if (< a 0) (set! a b) (set! a (+ 1 b))) #t) #f)))))
- (if val (snd-display ";run side-effect and result: ~A" val))
- (if (not (= a 33)) (snd-display ";run side-effect and a: ~A" a))))
+ (if val (snd-display #__line__ ";run side-effect and result: ~A" val))
+ (if (not (= a 33)) (snd-display #__line__ ";run side-effect and a: ~A" a))))
(let ((a 0))
(let ((val (run (lambda () (or (let ((b 32)) (if (< a 0) (set! a b) (set! a (+ 1 b))) #f) #t)))))
- (if (not val) (snd-display ";run side-effect or result: ~A" val))
- (if (not (= a 33)) (snd-display ";run side-effect or a: ~A" a))))
+ (if (not val) (snd-display #__line__ ";run side-effect or result: ~A" val))
+ (if (not (= a 33)) (snd-display #__line__ ";run side-effect or a: ~A" a))))
(let ((tag (catch #t (lambda () (run-eval '(let ((a 0)) (set! a (and 1 3)) a))) (lambda args (car args)))))
- (if (not (equal? tag 'cannot-parse)) (snd-display ";set and not bool: ~A" tag)))
+ (if (not (equal? tag 'cannot-parse)) (snd-display #__line__ ";set and not bool: ~A" tag)))
(let ((val (run-eval '(if 1 2 3))))
- (if (not (= val 2)) (snd-display ";if not bool: ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";if not bool: ~A" val)))
(let ((val (run-eval '(let* ((sine (make-vct 32 1.0))
(sr (make-table-lookup :wave sine)))
(let ((b (mus-data sr)))
(vct-ref b 2))))))
- (if (fneq val 1.0) (snd-display ";mus-data -> vct opt: ~A" val)))
+ (if (fneq val 1.0) (snd-display #__line__ ";mus-data -> vct opt: ~A" val)))
(let ((diff
(run (lambda ()
@@ -51553,43 +51652,43 @@ EDITS: 1
(let ((val (run-eval '(let ((osc (make-oscil 440.0)))
(or (not osc)
(not (oscil? osc)))))))
- (if val (snd-display ";not osc: ~A" val)))
+ (if val (snd-display #__line__ ";not osc: ~A" val)))
(let ((val (run-eval '(let ((osc1 (make-oscil 440.0))
(osc2 (make-oscil 880.0)))
(not (or osc1 osc2))))))
- (if val (snd-display ";not osc1: ~A" val)))
+ (if val (snd-display #__line__ ";not osc1: ~A" val)))
(let ((val (run-eval '(let ((osc1 (make-oscil 440.0))
(osc2 #f))
(declare (osc2 clm))
(and osc1 (not osc2))))))
- (if (not val) (snd-display ";not osc2: ~A" val)))
+ (if (not val) (snd-display #__line__ ";not osc2: ~A" val)))
(let ((val (run-eval '(let ((v1 (make-vct 3))
(v2 (make-vct 3)))
(or (not v1)
(and v1 v2))))))
- (if (not val) (snd-display ";not v1: ~A" val)))
+ (if (not val) (snd-display #__line__ ";not v1: ~A" val)))
(let ((v1 (make-vector 3 1))
(v2 (make-vector 3 2)))
(let ((val (run (lambda ()
(and v1 v2
(vector? v1))))))
- (if (not val) (snd-display ";outer not vi1: ~A" val))))
+ (if (not val) (snd-display #__line__ ";outer not vi1: ~A" val))))
(let ((val (run-eval '(let ((v1 (make-vector 3))
(v2 (make-vector 3)))
(and v1 v2
(vector? v1))))))
- (if (not val) (snd-display ";not vi1: ~A" val)))
+ (if (not val) (snd-display #__line__ ";not vi1: ~A" val)))
(let ((val (run-eval '(let ((v1 (make-vector 3 1.0))
(v2 (make-vector 3 2.0)))
(and v1 v2
(vector? v1))))))
- (if (not val) (snd-display ";not vect1: ~A" val)))
+ (if (not val) (snd-display #__line__ ";not vect1: ~A" val)))
(let ((snd (open-sound "oboe.snd")))
(let ((r1 (make-sampler 0))
@@ -51598,26 +51697,26 @@ EDITS: 1
(and r1 r2
(or r1 r2)
(sampler? r1))))))
- (if (not val) (snd-display ";outer or rd: ~A" val))))
+ (if (not val) (snd-display #__line__ ";outer or rd: ~A" val))))
(close-sound snd))
(let ((val (run-eval '(let ((str1 "hiho")
(str2 "ho"))
(and str1 str2)))))
- (if (not val) (snd-display ";or str: ~A" val)))
+ (if (not val) (snd-display #__line__ ";or str: ~A" val)))
(let ((osc #f))
(let ((val (run (lambda ()
(declare (osc vct))
(not osc)))))
- (if (not val) (snd-display ";not v osc: ~A" val))))
+ (if (not val) (snd-display #__line__ ";not v osc: ~A" val))))
(let ((osc #f))
(let ((val (run (lambda ()
(declare (osc vct))
osc))))
- (if val (snd-display ";v osc: ~A" val))))
+ (if val (snd-display #__line__ ";v osc: ~A" val))))
(let ((ind (open-sound "oboe.snd")))
(let ((s "hi")
@@ -51628,7 +51727,7 @@ EDITS: 1
(g (make-oscil 440.0))
(rd (make-sampler 0))
(lst (list 1 2))
-; (pr (cons 1 2)) ; dotted lists aren't currently supported in any way in run
+ ; (pr (cons 1 2)) ; dotted lists aren't currently supported in any way in run
(ch #\c)
(ch2 #\null)
(i 0)
@@ -51655,7 +51754,7 @@ EDITS: 1
(if rd (set! ok (+ 1 ok)) (clm-print ";if direct rd"))
(if rd1 (set! ok (+ 1 ok)) (clm-print ";if direct rd1"))
(if lst (set! ok (+ 1 ok)) (clm-print ";if direct lst"))
-; (if pr (set! ok (+ 1 ok)) (clm-print ";if direct pr"))
+ ; (if pr (set! ok (+ 1 ok)) (clm-print ";if direct pr"))
(if ch (set! ok (+ 1 ok)) (clm-print ";if direct ch"))
(if 0 (set! ok (+ 1 ok)) (clm-print ";if direct 0"))
(if i (set! ok (+ 1 ok)) (clm-print ";if direct i"))
@@ -51682,7 +51781,7 @@ EDITS: 1
((not rd) (clm-print ";cond direct rd"))
((not rd1) (clm-print ";cond direct rd1"))
((not lst) (clm-print ";cond direct lst"))
-; ((not pr) (clm-print ";cond direct pr"))
+ ; ((not pr) (clm-print ";cond direct pr"))
((not ch) (clm-print ";cond direct ch"))
((not i) (clm-print ";cond direct i"))
((not i1) (clm-print ";cond direct i1"))
@@ -51733,18 +51832,18 @@ EDITS: 1
(lambda ()
(sound-data-scale! sd 2.0)))
(if (not (vequal (sound-data->vct sd 0) (make-vct 10 .5)))
- (snd-display ";opt sound-data-scale! chan 0: ~A" (sound-data->vct sd 0)))
+ (snd-display #__line__ ";opt sound-data-scale! chan 0: ~A" (sound-data->vct sd 0)))
(if (not (vequal (sound-data->vct sd 1) (make-vct 10 1.0)))
- (snd-display ";opt sound-data-scale! chan 1: ~A" (sound-data->vct sd 1))))
+ (snd-display #__line__ ";opt sound-data-scale! chan 1: ~A" (sound-data->vct sd 1))))
(let ((sd (make-sound-data 2 10)))
(run
(lambda ()
(sound-data-fill! sd 2.0)))
(if (not (vequal (sound-data->vct sd 0) (make-vct 10 2.0)))
- (snd-display ";opt sound-data-fill! chan 0: ~A" (sound-data->vct sd 0)))
+ (snd-display #__line__ ";opt sound-data-fill! chan 0: ~A" (sound-data->vct sd 0)))
(if (not (vequal (sound-data->vct sd 1) (make-vct 10 2.0)))
- (snd-display ";opt sound-data-fill! chan 1: ~A" (sound-data->vct sd 1))))
+ (snd-display #__line__ ";opt sound-data-fill! chan 1: ~A" (sound-data->vct sd 1))))
(run (lambda ()
(do ((i 0 (+ 1 i)))
@@ -51752,11 +51851,11 @@ EDITS: 1
(test-run-protection-release))))
(let ((o (make-osc 440)))
-
+
(oscil o))
(let ((o (make-fc .8 128)))
-
+
(filtered-comb o (random 1.0)))
(let ((sd (make-sound-data 4 10)))
@@ -51768,7 +51867,7 @@ EDITS: 1
(sound-data-set! sd chn i (+ i (* chn 10)))))))
(let ((sd1 (run (lambda () (sound-data-copy sd)))))
(if (not (equal? sd sd1))
- (snd-display ";sound-data-copy not equal? ~A ~A" sd sd1))
+ (snd-display #__line__ ";sound-data-copy not equal? ~A ~A" sd sd1))
(run (lambda () (sound-data-scale! sd1 2.0)))
(let ((sd2 (make-sound-data 4 10)))
(do ((chn 0 (+ 1 chn)))
@@ -51776,8 +51875,8 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (* 2 (+ i (* chn 10))))))
- (if (not (equal? sd2 sd1)) (snd-display ";sound-data-scale! not equal? ~% ~A~% ~A" sd1 sd2))
- (if (equal? sd2 sd) (snd-display ";sound-data-scale! crosstalk??")))
+ (if (not (equal? sd2 sd1)) (snd-display #__line__ ";sound-data-scale! not equal? ~% ~A~% ~A" sd1 sd2))
+ (if (equal? sd2 sd) (snd-display #__line__ ";sound-data-scale! crosstalk??")))
(run (lambda () (sound-data-multiply! sd sd)))
(let ((sd2 (make-sound-data 4 10)))
(do ((chn 0 (+ 1 chn)))
@@ -51785,7 +51884,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (* (+ i (* chn 10)) (+ i (* chn 10))))))
- (if (not (equal? sd2 sd)) (snd-display ";sound-data-multiply! not equal? ~% ~A~% ~A" sd sd2)))
+ (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-multiply! not equal? ~% ~A~% ~A" sd sd2)))
(run (lambda ()
(do ((chn 0 (+ 1 chn)))
((= chn 4))
@@ -51799,7 +51898,7 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (+ 1 i (* chn 10)))))
- (if (not (equal? sd2 sd)) (snd-display ";sound-data-offset! not equal? ~% ~A~% ~A" sd sd2)))
+ (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-offset! not equal? ~% ~A~% ~A" sd sd2)))
(let ((sd3 (run (lambda () (sound-data-reverse! (sound-data-copy sd))))))
(let ((sd2 (make-sound-data 4 10)))
(do ((chn 0 (+ 1 chn)))
@@ -51807,14 +51906,14 @@ EDITS: 1
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd2 chn i (+ 1 (- 9 i) (* chn 10)))))
- (if (not (equal? sd2 sd3)) (snd-display ";sound-data-reverse! not equal? ~% ~A~% ~A" sd3 sd2)))
+ (if (not (equal? sd2 sd3)) (snd-display #__line__ ";sound-data-reverse! not equal? ~% ~A~% ~A" sd3 sd2)))
(run (lambda () (sound-data-add! sd sd3)))
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(do ((i 0 (+ 1 i)))
((= i 10))
(sound-data-set! sd1 chn i (+ 1 10 (* chn 20)))))
- (if (not (equal? sd1 sd)) (snd-display ";sound-data-add! not equal? ~% ~A~% ~A" sd sd1)))
+ (if (not (equal? sd1 sd)) (snd-display #__line__ ";sound-data-add! not equal? ~% ~A~% ~A" sd sd1)))
(run (lambda ()
(do ((chn 0 (+ 1 chn)))
@@ -51827,15 +51926,15 @@ EDITS: 1
(run (lambda ()
(sound-data+ sd 1)
(sound-data-add! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display ";sound-data+ sd 1: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd 1: ~% ~A~% ~A" sd sd2))
(run (lambda ()
(sound-data+ 1 sd)
(sound-data-add! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display ";sound-data+ 1 sd: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ 1 sd: ~% ~A~% ~A" sd sd2))
(run (lambda ()
(sound-data+ sd sd1)
(sound-data-add! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display ";sound-data+ sd sd: ~% ~A~% ~A" sd sd2)))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd sd: ~% ~A~% ~A" sd sd2)))
(run (lambda ()
(do ((chn 0 (+ 1 chn)))
@@ -51848,63 +51947,63 @@ EDITS: 1
(run (lambda ()
(sound-data* sd 2)
(sound-data-multiply! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display ";sound-data* sd 1: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd 1: ~% ~A~% ~A" sd sd2))
(run (lambda ()
(sound-data* 2 sd)
(sound-data-multiply! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display ";sound-data* 1 sd: ~% ~A~% ~A" sd sd2))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* 1 sd: ~% ~A~% ~A" sd sd2))
(run (lambda ()
(sound-data* sd sd1)
(sound-data-add! sd2 sd2)))
- (if (not (equal? sd sd2)) (snd-display ";sound-data* sd sd: ~% ~A~% ~A" sd sd2)))))
+ (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd sd: ~% ~A~% ~A" sd sd2)))))
(let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 4 "*-sound tests" 10)))
(offset-sound 1.0)
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(if (not (vequal (channel->vct 0 10 index chn) (make-vct 10 1.0)))
- (snd-display ";offset-sound chan ~A: ~A" chn (channel->vct 0 10 index chn))))
+ (snd-display #__line__ ";offset-sound chan ~A: ~A" chn (channel->vct 0 10 index chn))))
(scale-sound 0.5)
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(if (not (vequal (channel->vct 0 10 index chn) (make-vct 10 0.5)))
- (snd-display ";scale-sound chan ~A: ~A" chn (channel->vct 0 10 index chn))))
+ (snd-display #__line__ ";scale-sound chan ~A: ~A" chn (channel->vct 0 10 index chn))))
(offset-sound 0.5 2 4)
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(if (not (vequal (channel->vct 0 10 index chn) (vct 0.5 0.5 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5)))
- (snd-display ";offset-sound chan [2:4] ~A: ~A" chn (channel->vct 0 10 index chn))))
+ (snd-display #__line__ ";offset-sound chan [2:4] ~A: ~A" chn (channel->vct 0 10 index chn))))
(scale-sound 0.5 1 7)
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(if (not (vequal (channel->vct 0 10 index chn) (vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5)))
- (snd-display ";scale-sound chan [1:7] ~A: ~A" chn (channel->vct 0 10 index chn))))
+ (snd-display #__line__ ";scale-sound chan [1:7] ~A: ~A" chn (channel->vct 0 10 index chn))))
(scale-channel 2.0 0 10 index 2)
(scale-channel 4.0 0 10 index 3)
(normalize-sound 1.0) ; should be across full sound, so only chan 4 hits 1
(if (not (vequal (channel->vct 0 10 index 3)
(vct-scale! (vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5) 2.0)))
- (snd-display ";normalize-sound 3: ~A" (channel->vct 0 10 index 3)))
+ (snd-display #__line__ ";normalize-sound 3: ~A" (channel->vct 0 10 index 3)))
(if (not (vequal (channel->vct 0 10 index 2)
(vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5)))
- (snd-display ";normalize-sound 2: ~A" (channel->vct 0 10 index 2)))
+ (snd-display #__line__ ";normalize-sound 2: ~A" (channel->vct 0 10 index 2)))
(if (not (vequal (channel->vct 0 10 index 1)
(vct-scale! (vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5) 0.5)))
- (snd-display ";normalize-sound 1: ~A" (channel->vct 0 10 index 1)))
+ (snd-display #__line__ ";normalize-sound 1: ~A" (channel->vct 0 10 index 1)))
(normalize-sound 2.0 2 4 index)
(if (not (vequal (channel->vct 0 10 index 3)
(vct-scale! (vct 0.5 0.25 1.0 1.0 1.0 1.0 0.25 0.25 0.5 0.5) 2.0)))
- (snd-display ";normalize-sound 3 [2:4]: ~A" (channel->vct 0 10 index 3)))
+ (snd-display #__line__ ";normalize-sound 3 [2:4]: ~A" (channel->vct 0 10 index 3)))
(if (not (vequal (channel->vct 0 10 index 2)
(vct 0.5 0.25 1.0 1.0 1.0 1.0 0.25 0.25 0.5 0.5)))
- (snd-display ";normalize-sound 2 [2:4]: ~A" (channel->vct 0 10 index 2)))
+ (snd-display #__line__ ";normalize-sound 2 [2:4]: ~A" (channel->vct 0 10 index 2)))
(revert-sound index)
(offset-sound 1.0)
(pad-sound 2 4)
(do ((chn 0 (+ 1 chn)))
((= chn 4))
(if (not (vequal (channel->vct 0 14 index chn) (vct 1 1 0 0 0 0 1 1 1 1 1 1 1 1)))
- (snd-display ";pad-sound chan ~A: ~A" chn (channel->vct 0 14 index chn))))
+ (snd-display #__line__ ";pad-sound chan ~A: ~A" chn (channel->vct 0 14 index chn))))
(revert-sound)
(do ((i 0 (+ 1 i)))
((= i 10))
@@ -51912,7 +52011,7 @@ EDITS: 1
(compand-sound)
(if (not (vequal (channel->vct 0 10 index 2)
(vct -1.000 -0.924 -0.800 -0.624 -0.370 0.000 0.370 0.624 0.800 0.924)))
- (snd-display ";compand-sound 2: ~A" (channel->vct 0 10 index 2)))
+ (snd-display #__line__ ";compand-sound 2: ~A" (channel->vct 0 10 index 2)))
(revert-sound index)
(offset-sound 0.5)
(dither-sound 0.1)
@@ -51921,9 +52020,9 @@ EDITS: 1
(let ((ind (open-sound "2.snd")))
(let ((val (simultaneous-zero-crossing)))
- (if (not (equal? val (list #t 6))) (snd-display ";simultaneous-zero-crossing 0: ~A" val))
+ (if (not (equal? val (list #t 6))) (snd-display #__line__ ";simultaneous-zero-crossing 0: ~A" val))
(set! val (simultaneous-zero-crossing 9))
- (if (not (equal? val (list #t 17))) (snd-display ";simultaneous-zero-crossing 2: ~A" val)))
+ (if (not (equal? val (list #t 17))) (snd-display #__line__ ";simultaneous-zero-crossing 2: ~A" val)))
(close-sound ind))
(let ((v (make-vct 10 .1))
@@ -51937,405 +52036,405 @@ EDITS: 1
(vct->sound-data v sd 1)
(sound-data->vct sd 0 v0)
(sound-data->vct sd 1 v1)))
- (if (not (equal? v0 (make-vct 10 .1))) (snd-display ";vct<->sound-data 0: ~A" v0))
- (if (not (equal? v1 (make-vct 10 .2))) (snd-display ";vct<->sound-data 1: ~A" v1)))
+ (if (not (equal? v0 (make-vct 10 .1))) (snd-display #__line__ ";vct<->sound-data 0: ~A" v0))
+ (if (not (equal? v1 (make-vct 10 .2))) (snd-display #__line__ ";vct<->sound-data 1: ~A" v1)))
(let ((val (list 1 2 3)))
(if (not (= (run (lambda () (list-ref val 1))) 2))
- (snd-display ";list-ref 2: ~A" (run (lambda () (list-ref val 1))))))
+ (snd-display #__line__ ";list-ref 2: ~A" (run (lambda () (list-ref val 1))))))
(let ((val (list 1.0 2.0 3.0)))
(if (fneq (run (lambda () (list-ref val 1))) 2.0)
- (snd-display ";list-ref 2.0: ~A" (run (lambda () (list-ref val 1))))))
+ (snd-display #__line__ ";list-ref 2.0: ~A" (run (lambda () (list-ref val 1))))))
(let ((val (list 1 2 3)))
(if (not (run (lambda () (list? val))))
- (snd-display ";list? -> ~A" (run (lambda () (list? val))))))
+ (snd-display #__line__ ";list? -> ~A" (run (lambda () (list? val))))))
(let ((val (list 1 2 3 4)))
(if (not (= (run (lambda () (car val))) 1))
- (snd-display ";car 1: ~A" (run (lambda () (car val))))))
+ (snd-display #__line__ ";car 1: ~A" (run (lambda () (car val))))))
(let ((val (list 1 2 3 4)))
(if (not (= (run (lambda () (cadr val))) 2))
- (snd-display ";cadr 2: ~A" (run (lambda () (cadr val))))))
+ (snd-display #__line__ ";cadr 2: ~A" (run (lambda () (cadr val))))))
(let ((val (list 1 2 3 4)))
(if (not (= (run (lambda () (caddr val))) 3))
- (snd-display ";caddr 3: ~A" (run (lambda () (caddr val))))))
+ (snd-display #__line__ ";caddr 3: ~A" (run (lambda () (caddr val))))))
(let ((val (list 1 2 3 4)))
(if (not (= (run (lambda () (cadddr val))) 4))
- (snd-display ";cadddr 4: ~A" (run (lambda () (cadddr val))))))
+ (snd-display #__line__ ";cadddr 4: ~A" (run (lambda () (cadddr val))))))
(let ((val (list 1 2 3 4)))
(if (not (= (run (lambda () (+ (car val) (cadddr val)))) 5))
- (snd-display ";car + cadddr 5: ~A" (run (lambda () (+ (car val) (cadddr val)))))))
+ (snd-display #__line__ ";car + cadddr 5: ~A" (run (lambda () (+ (car val) (cadddr val)))))))
(let ((val (list 1 2 3)))
(run (lambda () (list-set! val 1 123)))
(if (not (= (list-ref val 1) 123))
- (snd-display ";list-set 123: ~A" val)))
+ (snd-display #__line__ ";list-set 123: ~A" val)))
(let ((val (list 1 2 3)))
(run (lambda () (set-car! val 123)))
(if (not (= (car val) 123))
- (snd-display ";set-car 123: ~A" val)))
+ (snd-display #__line__ ";set-car 123: ~A" val)))
(let ((val (list 1.0 2.0 3.0 4.0)))
(if (fneq (run (lambda () (car val))) 1.0)
- (snd-display ";car 1.0: ~A" (run (lambda () (car val))))))
+ (snd-display #__line__ ";car 1.0: ~A" (run (lambda () (car val))))))
(let ((val (list 1.0 2.0 3.0)))
(run (lambda () (list-set! val 1 123.0)))
(if (fneq (list-ref val 1) 123.0)
- (snd-display ";list-set 123.0: ~A" val)))
+ (snd-display #__line__ ";list-set 123.0: ~A" val)))
(let ((val (list 1.0 2.0 3.0)))
(run (lambda () (set-car! val 123.0)))
(if (fneq (car val) 123.0)
- (snd-display ";set-car 123.0: ~A" val)))
+ (snd-display #__line__ ";set-car 123.0: ~A" val)))
(let* ((val (list 1.0 2.0 3.0))
(locs (list 1 2 3))
(lv (run (lambda () (list-ref val (list-ref locs 1))))))
(if (fneq lv 3.0)
- (snd-display ";list-ref(list-ref) 3.0: ~A" lv)))
+ (snd-display #__line__ ";list-ref(list-ref) 3.0: ~A" lv)))
(let* ((val (list 1.0 2.0 3.0))
(locs (list 1 2 3))
(lv (run (lambda () (list-ref val (list-ref locs (car locs)))))))
(if (fneq lv 3.0)
- (snd-display ";list-ref(list-ref(car)) 3.0: ~A" lv)))
+ (snd-display #__line__ ";list-ref(list-ref(car)) 3.0: ~A" lv)))
(let ((val (list "hi" "ho" "ha")))
(if (not (string=? (run (lambda () (list-ref val 1))) "ho"))
- (snd-display ";list-ref strings: ~A" (run (lambda () (list-ref val 1))))))
+ (snd-display #__line__ ";list-ref strings: ~A" (run (lambda () (list-ref val 1))))))
(let ((val (list "hi" "ho" "ha")))
(run (lambda () (list-set! val 1 "hiho")))
(if (not (string=? (list-ref val 1) "hiho"))
- (snd-display ";list-set string: ~A" val)))
+ (snd-display #__line__ ";list-set string: ~A" val)))
(let ((val (list (make-oscil 100) (make-oscil 200) (make-oscil 300))))
(let ((clm (run (lambda () (list-ref val 1)))))
(if (or (not (oscil? clm))
(fneq (mus-frequency clm) 200))
- (snd-display ";list-ref clm: ~A" clm))))
+ (snd-display #__line__ ";list-ref clm: ~A" clm))))
(let ((val (list (make-vct 10) (make-vct 20) (make-vct 30))))
(let ((v (run (lambda () (list-ref val 2)))))
(if (or (not (vct? v))
(not (= (vct-length v) 30)))
- (snd-display ";list-ref vct: ~A" v))))
+ (snd-display #__line__ ";list-ref vct: ~A" v))))
(let ((val (list 1 2 3)))
(if (not (= (run (lambda () (length val))) 3))
- (snd-display ";length 3: ~A" (run (lambda () (length val))))))
+ (snd-display #__line__ ";length 3: ~A" (run (lambda () (length val))))))
(let ((val '()))
(if (not (= (run (lambda () (length val))) 0))
- (snd-display ";length 0: ~A" (run (lambda () (length val))))))
-
+ (snd-display #__line__ ";length 0: ~A" (run (lambda () (length val))))))
+
(let ((gen (make-polyoid 100.0 (vct 1 1 0.0))))
(let ((val (run (lambda () (mus-ycoeffs gen)))))
(if (not (vct? val))
- (snd-display ";run mus-ycoeffs: ~A" val))))
+ (snd-display #__line__ ";run mus-ycoeffs: ~A" val))))
(let ((val (list 1 2 3)))
(if (run (lambda () (null? val)))
- (snd-display ";null? : ~A" (run (lambda () (null? val))))))
+ (snd-display #__line__ ";null? : ~A" (run (lambda () (null? val))))))
(let ((val '()))
(if (run (lambda () (not (null? val))))
- (snd-display ";not null? : ~A" (run (lambda () (not (null? val)))))))
+ (snd-display #__line__ ";not null? : ~A" (run (lambda () (not (null? val)))))))
(let ((val (list #f #t #t)))
(if (run (lambda () (not (list-ref val 1))))
- (snd-display ";list-ref bools (not #t): ~A" (run (lambda () (not (list-ref val 1)))))))
+ (snd-display #__line__ ";list-ref bools (not #t): ~A" (run (lambda () (not (list-ref val 1)))))))
(let ((val (list #f #t #t)))
(run (lambda () (list-set! val 1 #f)))
(if (list-ref val 1)
- (snd-display ";list-set bools (not #t): ~A" val)))
+ (snd-display #__line__ ";list-set bools (not #t): ~A" val)))
(let ((val (list #\f #\t #\c)))
(if (not (char=? (run (lambda () (list-ref val 1))) #\t))
- (snd-display ";list-ref chars #\\t): ~A" (run (lambda () (list-ref val 1))))))
+ (snd-display #__line__ ";list-ref chars #\\t): ~A" (run (lambda () (list-ref val 1))))))
(let ((val (list #\f #\t #\c)))
(run (lambda () (list-set! val 2 #\d)))
(if (not (char=? (list-ref val 2) #\d))
- (snd-display ";list-set char: ~A" val)))
+ (snd-display #__line__ ";list-set char: ~A" val)))
(let ((val (list (vector .1 .2 .3) (vector 1.0 2.0 3.0))))
(let ((x (run (lambda () (vector-ref (list-ref val 1) 1)))))
- (if (fneq x 2.0) (snd-display ";list-ref -> float vector: ~A" x))))
+ (if (fneq x 2.0) (snd-display #__line__ ";list-ref -> float vector: ~A" x))))
(let ((val (list (vector 1 2 3) (vector 3 4 5))))
(let ((x (run (lambda () (vector-ref (list-ref val 1) 1)))))
- (if (not (= x 4)) (snd-display ";list-ref -> int vector: ~A" x))))
+ (if (not (= x 4)) (snd-display #__line__ ";list-ref -> int vector: ~A" x))))
(let ((val (list (vector (make-oscil 100) (make-oscil 200)) (vector (make-oscil 300) (make-oscil 400)))))
(let ((x (run (lambda () (vector-ref (list-ref val 1) 1)))))
(if (or (not (oscil? x))
(fneq (mus-frequency x) 400.0))
- (snd-display ";list-ref clm-vector: ~A" x))))
+ (snd-display #__line__ ";list-ref clm-vector: ~A" x))))
(let ((val (list (vector (make-vct 1) (make-vct 2)) (vector (make-vct 3) (make-vct 4)))))
(let ((x (run (lambda () (vector-ref (list-ref val 0) 1)))))
(if (or (not (vct? x))
(not (= (vct-length x) 2)))
- (snd-display ";list-ref vct-vector: ~A" x))))
+ (snd-display #__line__ ";list-ref vct-vector: ~A" x))))
(let ((val (list (make-sound-data 1 1) (make-sound-data 2 2))))
(let ((x (run (lambda () (list-ref val 1)))))
(if (or (not (sound-data? x))
(not (= (sound-data-chans x) 2)))
- (snd-display ";list-ref sound-data: ~A" x))))
+ (snd-display #__line__ ";list-ref sound-data: ~A" x))))
(let ((val (list 'a 'b 'c)))
(let ((sym (run (lambda () (list-ref val 0)))))
(if (or (not (symbol? sym))
(not (eq? sym 'a)))
- (snd-display ";list-ref sym: ~A" x))))
+ (snd-display #__line__ ";list-ref sym: ~A" x))))
(let ((val (list 'a 'b 'c)))
(run (lambda () (list-set! val 1 'd)))
(if (not (eq? (list-ref val 1) 'd))
- (snd-display ";list-set sym: ~A" val)))
+ (snd-display #__line__ ";list-set sym: ~A" val)))
(let ((val (list :a :b :c)))
(let ((sym (run (lambda () (list-ref val 0)))))
(if (or (not (keyword? sym))
(not (eq? sym :a)))
- (snd-display ";list-ref key: ~A" x))))
+ (snd-display #__line__ ";list-ref key: ~A" x))))
(let ((val (list :a :b :c)))
(run (lambda () (list-set! val 1 :d)))
(if (not (eq? (list-ref val 1) :d))
- (snd-display ";list-set key: ~A" val)))
+ (snd-display #__line__ ";list-set key: ~A" val)))
(let ((val (list (make-sampler 0 "oboe.snd"))))
(let ((x (run (lambda () (read-sample (list-ref val 0))))))
(if (fneq x 0.0)
- (snd-display ";list-ref sampler: ~A" x))
+ (snd-display #__line__ ";list-ref sampler: ~A" x))
(free-sampler (list-ref val 0))))
(let ((val (run (lambda () (+ '3 '4)))))
- (if (not (= val 7)) (snd-display ";quote '3+'4: ~A" val)))
+ (if (not (= val 7)) (snd-display #__line__ ";quote '3+'4: ~A" val)))
(let ((val (run (lambda () (+ '3.5 '4.5)))))
- (if (fneq val 8.0) (snd-display ";quote '3.5+'4.5: ~A" val)))
+ (if (fneq val 8.0) (snd-display #__line__ ";quote '3.5+'4.5: ~A" val)))
(let ((val (run (lambda () (list-ref '(1 2 3) 1)))))
- (if (not (= val 2)) (snd-display ";quote: '(1 2 3): ~A" val)))
+ (if (not (= val 2)) (snd-display #__line__ ";quote: '(1 2 3): ~A" val)))
(let ((val (run (lambda () (list? '(0 1 2))))))
- (if (not val) (snd-display ";(list? '()) #f?")))
+ (if (not val) (snd-display #__line__ ";(list? '()) #f?")))
(let ((ho (make-hi308 1.0 2.0)))
(if (not (run (lambda () (hi308? ho))))
- (snd-display ";hi308? ho: ~A" (run (lambda () (hi308? ho))))))
+ (snd-display #__line__ ";hi308? ho: ~A" (run (lambda () (hi308? ho))))))
(let ((ho (make-hi308 1.0 2.0)))
(if (fneq (run (lambda () (hi308-freq ho))) 1.0)
- (snd-display ";hi308-freq 1.0: ~A" (run (lambda () (hi308-freq ho))) 1.0)))
+ (snd-display #__line__ ";hi308-freq 1.0: ~A" (run (lambda () (hi308-freq ho))) 1.0)))
(let ((ho (make-hi308 1.0 2.0)))
(run (lambda () (set! (hi308-phase ho) 123.0)))
(if (fneq (hi308-phase ho) 123.0)
- (snd-display ";set hi308-phase 123.0: ~A" ho)))
+ (snd-display #__line__ ";set hi308-phase 123.0: ~A" ho)))
(let ((ho (make-hi308 1.0 2.0)))
(if (fneq (run (lambda () (set! (hi308-phase ho) 123.0) (hi308-phase ho))) 123.0)
- (snd-display ";set hi308-phase and rtn 123.0: ~A ~A" ho (run (lambda () (set! (hi308-phase ho) 123.0) (hi308-phase ho))) 123.0)))
+ (snd-display #__line__ ";set hi308-phase and rtn 123.0: ~A ~A" ho (run (lambda () (set! (hi308-phase ho) 123.0) (hi308-phase ho))) 123.0)))
(let ((ho (make-hi308 :freq 1.0 :phase 2.0)))
(if (fneq (run (lambda () (call-hi308 ho))) 1.0)
- (snd-display ";funcall gen 1.0: ~A" (run (lambda () (call-hi308 ho))))))
+ (snd-display #__line__ ";funcall gen 1.0: ~A" (run (lambda () (call-hi308 ho))))))
(let ((ho (make-hi308 :freq 1.0 :phase 2.0)))
(run (lambda () (set-hi308 ho)))
- (if (fneq (hi308-freq ho) 3.5) (snd-display ";set in outer func: ~A" ho)))
+ (if (fneq (hi308-freq ho) 3.5) (snd-display #__line__ ";set in outer func: ~A" ho)))
(let ((ho (make-hi308 1.0 2.0)))
(let ((ha (run (lambda () ho))))
(if (not (hi308? ha))
- (snd-display ";run hi308: ~A" ha))))
+ (snd-display #__line__ ";run hi308: ~A" ha))))
(let* ((ho (make-hi308 3.0 2.0))
(val (run-eval '(lambda (y) (declare (y hi308)) y) ho)))
(if (not (hi308? val))
- (snd-display ";run clm-struct prog arg: ~A" val)))
+ (snd-display #__line__ ";run clm-struct prog arg: ~A" val)))
(let ((val (run-eval '(lambda (y) (declare (y hi308)) y) (make-hi308 3.0 2.0))))
(if (or (not (hi308? val))
(fneq (hi308-freq val) 3.0))
- (snd-display ";run clm-struct prog arg with make: ~A" val)))
+ (snd-display #__line__ ";run clm-struct prog arg with make: ~A" val)))
(let ((val (run-eval '(lambda (y) (declare (y list)) y) (list 1.0 2.0 3.0))))
(if (or (not (list? val))
(fneq (list-ref val 1) 2.0))
- (snd-display ";run list as arg: ~A" val)))
+ (snd-display #__line__ ";run list as arg: ~A" val)))
(let ((val (run (lambda () (make-oscil 200)))))
(if (or (not (oscil? val))
(fneq (mus-frequency val) 200))
- (snd-display ";run make-oscil: ~A" val)))
+ (snd-display #__line__ ";run make-oscil: ~A" val)))
(let ((val (run (lambda () (make-oscil :frequency 200)))))
(if (or (not (oscil? val))
(fneq (mus-frequency val) 200))
- (snd-display ";run make-oscil: ~A" val)))
+ (snd-display #__line__ ";run make-oscil: ~A" val)))
(let ((val (run (lambda () (let ((gen (make-oscil 200))) (mus-frequency gen))))))
- (if (fneq val 200.0) (snd-display ";run make-oscil freq: ~A" val)))
+ (if (fneq val 200.0) (snd-display #__line__ ";run make-oscil freq: ~A" val)))
(let ((ex (list 0.0 0.0 1.0 1.0)))
(let ((val (run (lambda () (make-env ex :length 101)))))
- (if (not (env? val)) (snd-display ";make-env run: ~A" val))))
+ (if (not (env? val)) (snd-display #__line__ ";make-env run: ~A" val))))
(let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
(let ((x (run (lambda () (vector-ref val 1)))))
(if (or (not (hi308? x))
(fneq (hi308-phase x) 4.0))
- (snd-display ";run pass list vector as arg: ~A" x))))
+ (snd-display #__line__ ";run pass list vector as arg: ~A" x))))
;; 309
(let ((val (list 1 2 3)) (val1 (list 1 2 3)))
(let ((x (run (lambda () (eq? val val1)))))
- (if x (snd-display ";run list eq 1: ~A" x))))
+ (if x (snd-display #__line__ ";run list eq 1: ~A" x))))
(let ((val (list 1 2 3)) (val1 (list 1 2 3)))
(let ((x (run (lambda () (eq? val val)))))
- (if (not x) (snd-display ";run list eq 2: ~A" x))))
+ (if (not x) (snd-display #__line__ ";run list eq 2: ~A" x))))
(let ((val (list 1 2 3)) (val1 (list 1 2 3)))
(let ((x (run (lambda () (equal? val val)))))
- (if (not x) (snd-display ";run list equal 3: ~A" x))))
+ (if (not x) (snd-display #__line__ ";run list equal 3: ~A" x))))
(let ((val (list 1 2 3)) (val1 (list 1 2 3)))
(let ((x (run (lambda () (equal? val1 val))))) ; this one doesn't work in run
- (if (not x) (snd-display ";run list equal 4: ~A" x))))
+ (if (not x) (snd-display #__line__ ";run list equal 4: ~A" x))))
(let ((val (list 1 2 3)) (val1 (list 1.0 2.0 3.0)))
(let ((x (run (lambda () (equal? val1 val)))))
- (if x (snd-display ";run list equal 5: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal 5: ~A" x))))
(let ((val1 (list "hi" "hi"))
(val2 (list "hi" "hi")))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display ";run list equal? strs: ~A" x))))
+ (if (not x) (snd-display #__line__ ";run list equal? strs: ~A" x))))
(let ((val1 (list "hi" "hi"))
(val2 (list "hi" "hi" "hi")))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? strs 1: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? strs 1: ~A" x))))
(let ((val1 (list "hi" "hi"))
(val2 (list "hi" "ho")))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? strs 2: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? strs 2: ~A" x))))
(let ((val1 (list 'hi 'hi))
(val2 (list 'hi 'hi)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display ";run list equal? syms: ~A" x))))
+ (if (not x) (snd-display #__line__ ";run list equal? syms: ~A" x))))
(let ((val1 (list 'hi 'hi))
(val2 (list 'hi 'hi 'hi)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? syms 1: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? syms 1: ~A" x))))
(let ((val1 (list 'hi 'hi))
(val2 (list 'hi 'ho)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? syms 2: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? syms 2: ~A" x))))
(let ((val1 (list :hi :hi))
(val2 (list :hi :hi)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display ";run list equal? keys: ~A" x))))
+ (if (not x) (snd-display #__line__ ";run list equal? keys: ~A" x))))
(let ((val1 (list :hi :hi))
(val2 (list :hi :hi :hi)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? keys 1: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? keys 1: ~A" x))))
(let ((val1 (list :hi :hi))
(val2 (list :hi :ho)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? keys 2: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? keys 2: ~A" x))))
(let ((val1 (list 1))
(val2 (list)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? nil 2: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? nil 2: ~A" x))))
(let ((val1 (list)) ; (equal? (list) (list)) -> #t in Scheme
(val2 (list)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display ";run list equal? nil both: ~A" x))))
+ (if (not x) (snd-display #__line__ ";run list equal? nil both: ~A" x))))
(let ((val1 (list 1))
(val2 (list 1.0)))
(let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display ";run list equal? int/dbl 2: ~A" x))))
+ (if x (snd-display #__line__ ";run list equal? int/dbl 2: ~A" x))))
(let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
(let ((x (run (lambda () (vector-ref val 1)))))
(if (or (not (hi308? x))
(fneq (hi308-phase x) 4.0))
- (snd-display ";run pass list vector as arg: ~A" x))))
+ (snd-display #__line__ ";run pass list vector as arg: ~A" x))))
(let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
(let ((x (run (lambda () (call-hi308 (vector-ref val 1))))))
- (if (fneq x 3.0) (snd-display ";run list-vector call-hi: ~A" x))))
+ (if (fneq x 3.0) (snd-display #__line__ ";run list-vector call-hi: ~A" x))))
(let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
(let ((x (run (lambda () (set-hi308 (vector-ref val 1)) (call-hi308 (vector-ref val 1))))))
- (if (fneq x (* 3.5 3.0)) (snd-display ";run list-vector set-hi+call-hi: ~A" val))))
+ (if (fneq x (* 3.5 3.0)) (snd-display #__line__ ";run list-vector set-hi+call-hi: ~A" val))))
(let ((val (make-hiho309)))
(run (lambda () (set! (hiho309-i val) 321)))
- (if (not (= (hiho309-i val) 321)) (snd-display ";set hiho309-i: ~A" val)))
+ (if (not (= (hiho309-i val) 321)) (snd-display #__line__ ";set hiho309-i: ~A" val)))
(let ((val (make-hiho309)))
(let ((x (run (lambda () (set! (hiho309-v val) (make-vct 32 .1)) (vct-ref (hiho309-v val) 2)))))
(if (or (fneq x .1)
(not (vct? (hiho309-v val)))
(fneq (vct-ref (hiho309-v val) 2) .1))
- (snd-display ";set hiho309 vct: ~A" val))))
+ (snd-display #__line__ ";set hiho309 vct: ~A" val))))
(let ((val (make-hiho310)))
(let ((x (run (lambda () (set! (hiho310-v val) "hiho") (hiho310-v val)))))
(if (or (not (string? (hiho310-v val)))
(not (string=? (hiho310-v val) "hiho")))
- (snd-display ";set hiho310 string: ~A" val))
+ (snd-display #__line__ ";set hiho310 string: ~A" val))
(if (or (not (string? x))
(not (string=? x "hiho")))
- (snd-display ";set hiho310 string and return: ~A ~A" x val))))
+ (snd-display #__line__ ";set hiho310 string and return: ~A ~A" x val))))
(let ((val (make-hiho311)))
(run (lambda () (set! (hiho311-v val) (make-sound-data 2 3))))
(if (or (not (sound-data? (hiho311-v val)))
(not (= (sound-data-chans (hiho311-v val)) 2)))
- (snd-display ";set hiho311 sound-data: ~A" val)))
+ (snd-display #__line__ ";set hiho311 sound-data: ~A" val)))
(let ((val (make-hiho311)))
(run (lambda () (set! (hiho311-v val) (make-sound-data 2 3)) (sound-data-set! (hiho311-v val) 1 1 1.0)))
@@ -52343,7 +52442,7 @@ EDITS: 1
(not (= (sound-data-chans (hiho311-v val)) 2))
(fneq (sound-data-ref (hiho311-v val) 1 1) 1.0)
(fneq (sound-data-ref (hiho311-v val) 0 0) 0.0))
- (snd-display ";set hiho311 sound-data and return: ~A" val)))
+ (snd-display #__line__ ";set hiho311 sound-data and return: ~A" val)))
(let ((abc232g (make-abc232))
(abd232g (make-abd232)))
@@ -52351,7 +52450,7 @@ EDITS: 1
(lambda ()
(+ (abc232-x abc232g)
(abd232-x abd232g))))))
- (if (fneq result 1.0) (snd-display ";two structs: ~A" result))))
+ (if (fneq result 1.0) (snd-display #__line__ ";two structs: ~A" result))))
(let ((abc232g (make-abc232))
(abd232g (make-abd232)))
@@ -52359,7 +52458,7 @@ EDITS: 1
(lambda ()
(+ (abc232-func abc232g)
(abd232-func abd232g))))))
- (if (fneq result 1.0) (snd-display ";two structs via func: ~A" result))))
+ (if (fneq result 1.0) (snd-display #__line__ ";two structs via func: ~A" result))))
(with-sound (:output "test.snd" :channels 4)
(let* ((dur 100)
@@ -52390,20 +52489,20 @@ EDITS: 1
(if (sound? ind)
(close-sound ind)))
- (let ((hie (lambda* ((a 0.0)) (declare (a float)) (+ a 1.0))))
- (if (fneq (run (lambda () (hie 1.0))) 2.0) (snd-display ";run opt args 0"))
- (if (fneq (run (lambda () (hie))) 1.0) (snd-display ";run opt args 1"))
- (if (fneq (run (lambda () (+ (hie) (hie 1.0)))) 3.0) (snd-display ";run opt args 2")))
-
- (let ((hi (lambda* ((a 0.0) (b 0.0)) (declare (a float) (b float)) (+ a b))))
- (if (fneq (run (lambda () (hi 1.0))) 1.0) (snd-display ";run opt args 3"))
- (if (fneq (run (lambda () (hi 1.0 2.0))) 3.0) (snd-display ";run opt args 4"))
- (if (fneq (run (lambda () (hi))) 0.0) (snd-display ";run opt args 5"))
- (if (fneq (run (lambda () (+ (hi) (hi 1.0) (hi 1.0 2.0)))) 4.0) (snd-display ";run opt args 6"))
- (if (fneq (run (lambda () (+ (hi 1.0) (hi) (hi 1.0 2.0)))) 4.0) (snd-display ";run opt args 7"))
- (if (fneq (run (lambda () (+ (hi 1.0) (hi 1.0 2.0) (hi)))) 4.0) (snd-display ";run opt args 8"))
- (if (fneq (run (lambda () (+ (hi 1.0 2.0) (hi) (hi 1.0)))) 4.0) (snd-display ";run opt args 9")))
-
+ (let ((hie (lambda* ((a 0.0)) (declare (a float)) (+ a 1.0))))
+ (if (fneq (run (lambda () (hie 1.0))) 2.0) (snd-display #__line__ ";run opt args 0"))
+ (if (fneq (run (lambda () (hie))) 1.0) (snd-display #__line__ ";run opt args 1"))
+ (if (fneq (run (lambda () (+ (hie) (hie 1.0)))) 3.0) (snd-display #__line__ ";run opt args 2")))
+
+ (let ((hi (lambda* ((a 0.0) (b 0.0)) (declare (a float) (b float)) (+ a b))))
+ (if (fneq (run (lambda () (hi 1.0))) 1.0) (snd-display #__line__ ";run opt args 3"))
+ (if (fneq (run (lambda () (hi 1.0 2.0))) 3.0) (snd-display #__line__ ";run opt args 4"))
+ (if (fneq (run (lambda () (hi))) 0.0) (snd-display #__line__ ";run opt args 5"))
+ (if (fneq (run (lambda () (+ (hi) (hi 1.0) (hi 1.0 2.0)))) 4.0) (snd-display #__line__ ";run opt args 6"))
+ (if (fneq (run (lambda () (+ (hi 1.0) (hi) (hi 1.0 2.0)))) 4.0) (snd-display #__line__ ";run opt args 7"))
+ (if (fneq (run (lambda () (+ (hi 1.0) (hi 1.0 2.0) (hi)))) 4.0) (snd-display #__line__ ";run opt args 8"))
+ (if (fneq (run (lambda () (+ (hi 1.0 2.0) (hi) (hi 1.0)))) 4.0) (snd-display #__line__ ";run opt args 9")))
+
;; optimizer tests
(ixtst (let ((x 1) (y 2)) (run (lambda () (if (= x y) (+ x y) (- x y))))) -1)
(ixtst (let ((x 1) (y 2)) (run (lambda () (if (not (= x y 1)) 3 2)))) 3)
@@ -52616,23 +52715,23 @@ EDITS: 1
(bxtst (run (lambda () (equal? "asd" "dsa"))) #f)
(let ((len (let ((v (make-vct 32))) (run (lambda () (length v))))))
- (if (not (= len 32)) (snd-display ";run length vct: ~A" len)))
+ (if (not (= len 32)) (snd-display #__line__ ";run length vct: ~A" len)))
(let ((len (let ((v (make-vector 32 1.0))) (run (lambda () (length v))))))
- (if (not (= len 32)) (snd-display ";run length vector 1.0: ~A" len)))
+ (if (not (= len 32)) (snd-display #__line__ ";run length vector 1.0: ~A" len)))
(let ((len (let ((v (make-vector 32 1))) (run (lambda () (length v))))))
- (if (not (= len 32)) (snd-display ";run length vector 1: ~A" len)))
+ (if (not (= len 32)) (snd-display #__line__ ";run length vector 1: ~A" len)))
(let ((len (let ((s (string #\h #\i))) (run (lambda () (length s))))))
- (if (not (= len 2)) (snd-display ";run length string: ~A" len)))
+ (if (not (= len 2)) (snd-display #__line__ ";run length string: ~A" len)))
(let ((len (let ((l (list 1 2 3))) (run (lambda () (length l))))))
- (if (not (= len 3)) (snd-display ";run length list: ~A" len)))
+ (if (not (= len 3)) (snd-display #__line__ ";run length list: ~A" len)))
(let ((len (let ((f (make-frame 3))) (run (lambda () (length f))))))
- (if (not (= len 3)) (snd-display ";run length frame: ~A" len)))
+ (if (not (= len 3)) (snd-display #__line__ ";run length frame: ~A" len)))
(let ((len (let ((f (make-mixer 3))) (run (lambda () (length f))))))
- (if (not (= len 3)) (snd-display ";run length mixer: ~A" len)))
+ (if (not (= len 3)) (snd-display #__line__ ";run length mixer: ~A" len)))
(let ((len (let ((f (make-delay 32))) (run (lambda () (length f))))))
- (if (not (= len 32)) (snd-display ";run length delay: ~A" len)))
-
-
+ (if (not (= len 32)) (snd-display #__line__ ";run length delay: ~A" len)))
+
+
;; length as generic function:
;; string-length vector-length hash-table-size vct-length
;; frames mus-length sound-data-length mix-length region-frames
@@ -52649,17 +52748,17 @@ EDITS: 1
(reg (make-region 0 100))
(dly (make-delay 32))
)
- (if (not (= (run (lambda () (length snd))) 50828)) (snd-display ";length of sound: ~A" (length snd)))
- (if (not (= (run (lambda () (length v))) 3)) (snd-display ";length of vct: ~A" (length v)))
- (if (not (= (run (lambda () (length vc))) 4)) (snd-display ";length of vector: ~A" (length vc)))
- (if (not (= (run (lambda () (length lst))) 5)) (snd-display ";length of list: ~A" (length lst)))
- (if (not (= (run (lambda () (length str))) 6)) (snd-display ";length of string: ~A" (length str)))
- (if (not (= (run (lambda () (length sd))) 10)) (snd-display ";length of sound-data: ~A" (length sd)))
- (if (not (= (run (lambda () (length fr))) 2)) (snd-display ";length of frame: ~A" (length fr)))
- (if (not (= (run (lambda () (length mx))) 2)) (snd-display ";length of mixer: ~A" (length mx)))
- (if (and (mix? mxv) (not (= (run (lambda () (length mxv))) 3))) (snd-display ";length of mix: ~A" (length mxv)))
- (if (not (= (run (lambda () (length reg))) 101)) (snd-display ";length of region: ~A" (length reg)))
- (if (not (= (run (lambda () (length dly))) 32)) (snd-display ";length of delay: ~A" (length dly)))
+ (if (not (= (run (lambda () (length snd))) 50828)) (snd-display #__line__ ";length of sound: ~A" (length snd)))
+ (if (not (= (run (lambda () (length v))) 3)) (snd-display #__line__ ";length of vct: ~A" (length v)))
+ (if (not (= (run (lambda () (length vc))) 4)) (snd-display #__line__ ";length of vector: ~A" (length vc)))
+ (if (not (= (run (lambda () (length lst))) 5)) (snd-display #__line__ ";length of list: ~A" (length lst)))
+ (if (not (= (run (lambda () (length str))) 6)) (snd-display #__line__ ";length of string: ~A" (length str)))
+ (if (not (= (run (lambda () (length sd))) 10)) (snd-display #__line__ ";length of sound-data: ~A" (length sd)))
+ (if (not (= (run (lambda () (length fr))) 2)) (snd-display #__line__ ";length of frame: ~A" (length fr)))
+ (if (not (= (run (lambda () (length mx))) 2)) (snd-display #__line__ ";length of mixer: ~A" (length mx)))
+ (if (and (mix? mxv) (not (= (run (lambda () (length mxv))) 3))) (snd-display #__line__ ";length of mix: ~A" (length mxv)))
+ (if (not (= (run (lambda () (length reg))) 101)) (snd-display #__line__ ";length of region: ~A" (length reg)))
+ (if (not (= (run (lambda () (length dly))) 32)) (snd-display #__line__ ";length of delay: ~A" (length dly)))
)
(close-sound snd))
@@ -52669,9 +52768,9 @@ EDITS: 1
(str "oboe.snd"))
(let ((reg (make-region 0 100))
)
- (if (not (= (run (lambda () (srate snd))) 22050)) (snd-display ";srate of sound: ~A" (srate snd)))
- (if (not (= (run (lambda () (srate str))) 22050)) (snd-display ";srate of string: ~A" (srate str)))
- (if (not (= (run (lambda () (srate reg))) 22050)) (snd-display ";srate of region: ~A" (srate reg)))
+ (if (not (= (run (lambda () (srate snd))) 22050)) (snd-display #__line__ ";srate of sound: ~A" (srate snd)))
+ (if (not (= (run (lambda () (srate str))) 22050)) (snd-display #__line__ ";srate of string: ~A" (srate str)))
+ (if (not (= (run (lambda () (srate reg))) 22050)) (snd-display #__line__ ";srate of region: ~A" (srate reg)))
)
(close-sound snd))
@@ -52686,14 +52785,14 @@ EDITS: 1
(let ((mxv (mix-vct v 1000))
(reg (make-region 0 100))
)
- (if (not (= (run (lambda () (channels snd))) 1)) (snd-display ";channels of sound: ~A" (channels snd)))
- (if (not (= (run (lambda () (channels v))) 1)) (snd-display ";channels of vct: ~A" (channels v)))
- (if (not (= (run (lambda () (channels str))) 1)) (snd-display ";channels of string: ~A" (channels str)))
- (if (not (= (run (lambda () (channels sd))) 2)) (snd-display ";channels of sound-data: ~A" (channels sd)))
- (if (not (= (run (lambda () (channels fr))) 2)) (snd-display ";channels of frame: ~A" (channels fr)))
- (if (not (= (run (lambda () (channels mx))) 2)) (snd-display ";channels of mixer: ~A" (channels mx)))
- (if (not (= (run (lambda () (channels mxv))) 1)) (snd-display ";channels of mix: ~A" (channels mxv)))
- (if (not (= (run (lambda () (channels reg))) 1)) (snd-display ";channels of region: ~A" (channels reg)))
+ (if (not (= (run (lambda () (channels snd))) 1)) (snd-display #__line__ ";channels of sound: ~A" (channels snd)))
+ (if (not (= (run (lambda () (channels v))) 1)) (snd-display #__line__ ";channels of vct: ~A" (channels v)))
+ (if (not (= (run (lambda () (channels str))) 1)) (snd-display #__line__ ";channels of string: ~A" (channels str)))
+ (if (not (= (run (lambda () (channels sd))) 2)) (snd-display #__line__ ";channels of sound-data: ~A" (channels sd)))
+ (if (not (= (run (lambda () (channels fr))) 2)) (snd-display #__line__ ";channels of frame: ~A" (channels fr)))
+ (if (not (= (run (lambda () (channels mx))) 2)) (snd-display #__line__ ";channels of mixer: ~A" (channels mx)))
+ (if (not (= (run (lambda () (channels mxv))) 1)) (snd-display #__line__ ";channels of mix: ~A" (channels mxv)))
+ (if (not (= (run (lambda () (channels reg))) 1)) (snd-display #__line__ ";channels of region: ~A" (channels reg)))
)
(close-sound snd))
@@ -52709,18 +52808,18 @@ EDITS: 1
(reg (make-region 0 100))
(dly (make-delay 32))
)
- (if (not (= (run (lambda () (frames snd))) 50828)) (snd-display ";frames of sound: ~A" (frames snd)))
- (if (not (= (run (lambda () (frames v))) 3)) (snd-display ";frames of vct: ~A" (frames v)))
- (if (not (= (run (lambda () (frames str))) 50828)) (snd-display ";frames of string: ~A" (frames str)))
- (if (not (= (run (lambda () (frames sd))) 10)) (snd-display ";frames of sound-data: ~A" (frames sd)))
- (if (not (= (run (lambda () (frames fr))) 2)) (snd-display ";frames of frame: ~A" (frames fr)))
- (if (not (= (run (lambda () (frames mx))) 2)) (snd-display ";frames of mixer: ~A" (frames mx)))
- (if (not (= (run (lambda () (frames mxv))) 3)) (snd-display ";frames of mix: ~A" (frames mxv)))
- (if (not (= (run (lambda () (frames reg))) 101)) (snd-display ";frames of region: ~A" (frames reg)))
- (if (not (= (run (lambda () (frames dly))) 32)) (snd-display ";frames of delay: ~A" (frames dly)))
+ (if (not (= (run (lambda () (frames snd))) 50828)) (snd-display #__line__ ";frames of sound: ~A" (frames snd)))
+ (if (not (= (run (lambda () (frames v))) 3)) (snd-display #__line__ ";frames of vct: ~A" (frames v)))
+ (if (not (= (run (lambda () (frames str))) 50828)) (snd-display #__line__ ";frames of string: ~A" (frames str)))
+ (if (not (= (run (lambda () (frames sd))) 10)) (snd-display #__line__ ";frames of sound-data: ~A" (frames sd)))
+ (if (not (= (run (lambda () (frames fr))) 2)) (snd-display #__line__ ";frames of frame: ~A" (frames fr)))
+ (if (not (= (run (lambda () (frames mx))) 2)) (snd-display #__line__ ";frames of mixer: ~A" (frames mx)))
+ (if (not (= (run (lambda () (frames mxv))) 3)) (snd-display #__line__ ";frames of mix: ~A" (frames mxv)))
+ (if (not (= (run (lambda () (frames reg))) 101)) (snd-display #__line__ ";frames of region: ~A" (frames reg)))
+ (if (not (= (run (lambda () (frames dly))) 32)) (snd-display #__line__ ";frames of delay: ~A" (frames dly)))
)
(close-sound snd))
-
+
;; file-name as generic
(let ((snd (open-sound "oboe.snd"))
@@ -52729,11 +52828,11 @@ EDITS: 1
(let ((mxv (car (mix "pistol.snd" 1000)))
(reg (make-region 0 100))
)
- (if (not (string=? (run (lambda () (file-name snd))) (string-append (getcwd) "/oboe.snd"))) (snd-display ";file-name of sound: ~A" (file-name snd)))
- (if (not (string=? (run (lambda () (file-name str))) (string-append (getcwd) "/oboe.snd"))) (snd-display ";file-name of string: ~A" (file-name str)))
- (if (not (string=? (run (lambda () (file-name frm))) "oboe.snd")) (snd-display ";file-name of file->sample: ~A" (file-name frm)))
- (if (not (string=? (run (lambda () (file-name mxv))) (string-append (getcwd) "/pistol.snd"))) (snd-display ";file-name of mix: ~A" (file-name mxv)))
- (if (not (string=? (run (lambda () (file-name reg))) "oboe.snd")) (snd-display ";file-name of region: ~A" (file-name reg)))
+ (if (not (string=? (run (lambda () (file-name snd))) (string-append (getcwd) "/oboe.snd"))) (snd-display #__line__ ";file-name of sound: ~A" (file-name snd)))
+ (if (not (string=? (run (lambda () (file-name str))) (string-append (getcwd) "/oboe.snd"))) (snd-display #__line__ ";file-name of string: ~A" (file-name str)))
+ (if (not (string=? (run (lambda () (file-name frm))) "oboe.snd")) (snd-display #__line__ ";file-name of file->sample: ~A" (file-name frm)))
+ (if (not (string=? (run (lambda () (file-name mxv))) (string-append (getcwd) "/pistol.snd"))) (snd-display #__line__ ";file-name of mix: ~A" (file-name mxv)))
+ (if (not (string=? (run (lambda () (file-name reg))) "oboe.snd")) (snd-display #__line__ ";file-name of region: ~A" (file-name reg)))
)
(mus-close frm)
(close-sound snd))
@@ -52746,21 +52845,24 @@ EDITS: 1
(let ((mxv (mix-vct v 1000))
(reg (make-region 0 900))
)
- (if (fneq (run (lambda () (maxamp snd))) .334) (snd-display ";maxamp of sound: ~A" (maxamp snd)))
- (if (fneq (run (lambda () (maxamp snd 0))) .334) (snd-display ";maxamp of sound (0): ~A" (maxamp snd)))
- (if (fneq (run (lambda () (maxamp snd 0 0))) .14724) (snd-display ";maxamp of sound (0 0): ~A" (maxamp snd)))
- (if (fneq (run (lambda () (maxamp v))) .3) (snd-display ";maxamp of vct: ~A" (maxamp v)))
- (if (fneq (run (lambda () (maxamp vc))) .4) (snd-display ";maxamp of vector: ~A" (run (lambda () (maxamp vc)))))
- (if (fneq (run (lambda () (maxamp mxv))) .3) (snd-display ";maxamp of mix: ~A" (maxamp mxv)))
- (if (fneq (run (lambda () (maxamp reg))) .02139) (snd-display ";maxamp of region: ~A" (maxamp reg)))
+ (if (fneq (run (lambda () (maxamp snd))) .334) (snd-display #__line__ ";maxamp of sound: ~A" (maxamp snd)))
+ (if (fneq (run (lambda () (maxamp snd 0))) .334) (snd-display #__line__ ";maxamp of sound (0): ~A" (maxamp snd)))
+ (if (fneq (run (lambda () (maxamp snd 0 0))) .14724) (snd-display #__line__ ";maxamp of sound (0 0): ~A" (maxamp snd)))
+ (if (fneq (run (lambda () (maxamp v))) .3) (snd-display #__line__ ";maxamp of vct: ~A" (maxamp v)))
+ (if (fneq (run (lambda () (maxamp vc))) .4) (snd-display #__line__ ";maxamp of vector: ~A" (run (lambda () (maxamp vc)))))
+ (if (fneq (run (lambda () (maxamp mxv))) .3) (snd-display #__line__ ";maxamp of mix: ~A" (maxamp mxv)))
+ (if (fneq (run (lambda () (maxamp reg))) .02139) (snd-display #__line__ ";maxamp of region: ~A" (maxamp reg)))
)
(close-sound snd))
-
+
))
;; (set! *clm-notehook* (lambda args (display (format #f "~A~%" args))))
+
+
+
;;; ---------------- test 23: with-sound ----------------
(if (not (provided? 'snd-prc95.scm)) (load "prc95.scm"))
@@ -52778,9 +52880,7 @@ EDITS: 1
(if (not (provided? 'snd-freeverb.scm)) (load "freeverb.scm"))
(if (not (provided? 'snd-grani.scm)) (load "grani.scm"))
(if (not (provided? 'snd-animals.scm)) (load "animals.scm"))
-(if (and (provided? 'multidimensional-vectors)
- (not (provided? 'snd-gib-gens.scm)))
- (load "big-gens.scm"))
+(if (not (provided? 'snd-big-gens.scm)) (load "big-gens.scm"))
(if (not (provided? 'snd-dlocsig.scm)) (load "dlocsig.scm"))
(if (not (provided? 'snd-sndwarp.scm)) (load "sndwarp.scm"))
@@ -52861,8 +52961,8 @@ EDITS: 1
(let* ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
(osc (make-oscil freq))
(e (make-env amp-env :scaler amp :duration dur))
- (beg (inexact->exact (floor (* start (mus-srate)))))
- (end (+ beg (inexact->exact (floor (* dur (mus-srate)))))))
+ (beg (floor (* start (mus-srate))))
+ (end (+ beg (floor (* dur (mus-srate))))))
(run
(lambda ()
(do ((i beg (+ 1 i)))
@@ -52878,8 +52978,8 @@ EDITS: 1
(let* ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
(osc (make-oscil freq))
(e (make-env freq-env :scaler gliss :duration dur))
- (beg (inexact->exact (floor (* start (mus-srate)))))
- (end (+ beg (inexact->exact (floor (* dur (mus-srate)))))))
+ (beg (floor (* start (mus-srate))))
+ (end (+ beg (floor (* dur (mus-srate))))))
(run
(lambda ()
(do ((i beg (+ 1 i)))
@@ -52890,9 +52990,9 @@ EDITS: 1
(define (ws-sine freq)
(let ((o (make-oscil freq)))
(run
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (outa i (oscil o))))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 100))
+ (outa i (oscil o))))))
(define (step-src)
(let* ((rd (make-sampler 0))
@@ -52901,41 +53001,41 @@ EDITS: 1
(incr (+ 2.0 (oscil o)))
(tempfile (with-sound (:output (snd-tempnam) :srate (srate) :to-snd #f :comment "step-src")
(run
- (do ((samp 0 (+ 1 samp)))
- ((or (c-g?)
- (sampler-at-end? rd)))
- (out-any samp
- (src s incr (lambda (dir) (read-sample rd)))
- 0)
- (if (= (modulo samp 2205) 0)
- (set! incr (+ 2.0 (oscil o))))))))
+ (do ((samp 0 (+ 1 samp)))
+ ((or (c-g?)
+ (sampler-at-end? rd)))
+ (out-any samp
+ (src s incr (lambda (dir) (read-sample rd)))
+ 0)
+ (if (= (modulo samp 2205) 0)
+ (set! incr (+ 2.0 (oscil o))))))))
(len (mus-sound-frames tempfile)))
(set-samples 0 (- len 1) tempfile #f #f #t "step-src" 0 #f #t)))
(define (check-with-mix num dur total-dur amp opts calls old-date chkmx)
(let ((ind (find-sound "test.snd")))
- (if (not (sound? ind)) (snd-display ";with-mix (~A) init: no test.snd?" num))
- (if (and chkmx (fneq (maxamp ind) amp)) (snd-display ";with-mix (~A) maxamp: ~A (~A)" num (maxamp ind) amp))
- (if (not (file-exists? "with-mix.snd")) (snd-display ";with-mix (~A) output doesn't exist" num))
+ (if (not (sound? ind)) (snd-display #__line__ ";with-mix (~A) init: no test.snd?" num))
+ (if (and chkmx (fneq (maxamp ind) amp)) (snd-display #__line__ ";with-mix (~A) maxamp: ~A (~A)" num (maxamp ind) amp))
+ (if (not (file-exists? "with-mix.snd")) (snd-display #__line__ ";with-mix (~A) output doesn't exist" num))
(let ((mx (mus-sound-maxamp "with-mix.snd"))
(date (mus-sound-write-date "with-mix.snd"))
(duration (mus-sound-duration "with-mix.snd")))
- (if (fneq duration dur) (snd-display ";with-mix (~A) dur: ~A ~A" num dur duration))
+ (if (fneq duration dur) (snd-display #__line__ ";with-mix (~A) dur: ~A ~A" num dur duration))
(if (fneq total-dur (/ (frames ind) (srate ind)))
- (snd-display ";with-mix (~A) total dur: ~A ~A" num total-dur (/ (frames ind) (srate ind))))
+ (snd-display #__line__ ";with-mix (~A) total dur: ~A ~A" num total-dur (/ (frames ind) (srate ind))))
(if (and old-date
(> (- date old-date) 1)) ; these can be off by some amount in Linux
- (snd-display ";with-mix (~A) rewrote output?: ~A ~A ~A" num (- date old-date)
+ (snd-display #__line__ ";with-mix (~A) rewrote output?: ~A ~A ~A" num (- date old-date)
(strftime "%d-%b-%g %H:%M:%S" (localtime old-date))
(strftime "%d-%b-%g %H:%M:%S" (localtime date))))
- (if (and chkmx (or (not mx) (fneq (cadr mx) amp))) (snd-display ";with-mix sndf (~A) maxamp: ~A (~A)" num mx amp))
+ (if (and chkmx (or (not mx) (fneq (cadr mx) amp))) (snd-display #__line__ ";with-mix sndf (~A) maxamp: ~A (~A)" num mx amp))
(let ((header-str (mus-sound-comment "with-mix.snd")))
- (if (not (string? header-str)) (snd-display ";with-mix (~A) comment unwritten?: ~A" num (mus-sound-comment "with-mix.snd")))
+ (if (not (string? header-str)) (snd-display #__line__ ";with-mix (~A) comment unwritten?: ~A" num (mus-sound-comment "with-mix.snd")))
(let ((header (eval-string header-str)))
- (if (not (list? header)) (snd-display ";with-mix (~A) comment: ~A -> ~A" num header-str header))
+ (if (not (list? header)) (snd-display #__line__ ";with-mix (~A) comment: ~A -> ~A" num header-str header))
(if (or (not (string=? (car header) opts))
(not (string=? (cadr header) calls)))
- (snd-display ";with-mix (~A) header values: ~A" num header))))
+ (snd-display #__line__ ";with-mix (~A) header values: ~A" num header))))
(close-sound ind)
date)))
@@ -52970,15 +53070,15 @@ EDITS: 1
(define* (optkey-4 (a 1) (b 2) (c 3) d) (list a b c d))
(define (fir+comb beg dur freq amp size)
- (let* ((start (inexact->exact (floor (* (mus-srate) beg))))
- (end (+ start (inexact->exact (floor (* (mus-srate) dur)))))
+ (let* ((start (floor (* (mus-srate) beg)))
+ (end (+ start (floor (* (mus-srate) dur))))
(dly (make-comb :scaler .9 :size size))
(flt (make-fir-filter :order size :xcoeffs (mus-data dly)))
(r (make-rand freq)))
(run
- (do ((i start (+ 1 i)))
- ((= i end))
- (outa i (* amp (fir-filter flt (comb dly (rand r)))))))))
+ (do ((i start (+ 1 i)))
+ ((= i end))
+ (outa i (* amp (fir-filter flt (comb dly (rand r)))))))))
(definstrument (dloc-sinewave start-time duration freq amp
(amp-env '(0 1 1 1))
@@ -53021,7 +53121,7 @@ EDITS: 1
(define (mix-move-sound start-time file path)
(let* ((duration (mus-sound-duration file))
(rd (make-sampler 0 file))
- (start (inexact->exact (round (* (mus-srate) start-time))))
+ (start (round (* (mus-srate) start-time)))
(tmp-sound (with-temp-sound (:channels 4 :srate (mus-sound-srate file))
(let* ((vals (make-dlocsig :start-time 0
:duration duration
@@ -53039,7 +53139,7 @@ EDITS: 1
(define (check-segments vals snd chn name)
(let* ((rd (make-sampler 0 snd chn))
(len (frames snd chn))
- (seglen (inexact->exact (round (/ len 50))))
+ (seglen (round (/ len 50)))
(segctr 0)
(segmax 0.0)
(valctr 0)
@@ -53074,8 +53174,8 @@ EDITS: 1
(definstrument (defopt-simp beg dur (frequency 440.0) (amplitude 0.1))
(let* ((os (make-oscil frequency)))
(run
- (do ((i 0 (+ 1 i))) ((= i dur))
- (outa (+ i beg) (* amplitude (oscil os)))))))
+ (do ((i 0 (+ 1 i))) ((= i dur))
+ (outa (+ i beg) (* amplitude (oscil os)))))))
(definstrument (jcrev2)
@@ -53143,7 +53243,7 @@ EDITS: 1
((= i end))
(flocsig floc i (* amp (pulse-train os))))))))
-
+
(define (test-ws-errors)
;; since we only catch 'mus-error and 'with-sound-interrupt above, any other error
;; closes *output* and returns to the top-level -- are there languishing threads?
@@ -53160,7 +53260,7 @@ EDITS: 1
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error start: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error start: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
@@ -53178,24 +53278,24 @@ EDITS: 1
(if (or (not (list? tag))
(not (eq? (car tag) 'wrong-type-arg)))
- (snd-display ";ws-error -220: ~A" tag))
+ (snd-display #__line__ ";ws-error -220: ~A" tag))
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error -220: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error -220: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(let ((prev (find-sound "test.snd")))
(if (sound? prev)
(begin
- (snd-display ";ws error -220 opened test.snd?")
+ (snd-display #__line__ ";ws error -220 opened test.snd?")
(close-sound prev))))
(if *ws-finish*
- (snd-display ";ws error -220 caught interrupt? ~A" *ws-finish*)))
+ (snd-display #__line__ ";ws error -220 caught interrupt? ~A" *ws-finish*)))
(if (defined? 'all-threads)
(let ((current-threads (all-threads)))
(if (not (equal? current-threads (list (current-thread))))
- (snd-display ";ws error threaded start threads: ~A, current:~A" current-threads (current-thread)))
+ (snd-display #__line__ ";ws error threaded start threads: ~A, current:~A" current-threads (current-thread)))
(let ((tag (catch #t
(lambda ()
@@ -53208,22 +53308,22 @@ EDITS: 1
(if (or (not (list? tag))
(not (eq? (car tag) 'wrong-type-arg)))
- (snd-display ";ws-error threaded -220: ~A" tag))
+ (snd-display #__line__ ";ws-error threaded -220: ~A" tag))
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error threaded -220: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error threaded -220: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(let ((prev (find-sound "test.snd")))
(if (sound? prev)
(begin
- (snd-display ";ws error threaded -220 opened test.snd?")
+ (snd-display #__line__ ";ws error threaded -220 opened test.snd?")
(close-sound prev))))
(if *ws-finish*
- (snd-display ";ws error threaded -220 caught interrupt? ~A" *ws-finish*))
+ (snd-display #__line__ ";ws error threaded -220 caught interrupt? ~A" *ws-finish*))
(if (not (equal? current-threads (all-threads)))
- (snd-display ";ws error threaded -220 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
+ (snd-display #__line__ ";ws error threaded -220 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
(let ((tag (catch #t
(lambda ()
@@ -53233,22 +53333,22 @@ EDITS: 1
(if (or (not (list? tag))
(not (eq? (car tag) 'out-of-range)))
- (snd-display ";ws-error threaded -220 1: ~A" tag))
+ (snd-display #__line__ ";ws-error threaded -220 1: ~A" tag))
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error threaded -220 1: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error threaded -220 1: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(let ((prev (find-sound "test.snd")))
(if (sound? prev)
(begin
- (snd-display ";ws error threaded -220 1 opened test.snd?")
+ (snd-display #__line__ ";ws error threaded -220 1 opened test.snd?")
(close-sound prev))))
(if *ws-finish*
- (snd-display ";ws error threaded -220 1 caught interrupt? ~A" *ws-finish*))
+ (snd-display #__line__ ";ws error threaded -220 1 caught interrupt? ~A" *ws-finish*))
(if (not (equal? current-threads (all-threads)))
- (snd-display ";ws error threaded -220 1 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
+ (snd-display #__line__ ";ws error threaded -220 1 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
(let ((tag (catch #t
(lambda ()
@@ -53262,33 +53362,33 @@ EDITS: 1
(if (or (not (list? tag))
(not (eq? (car tag) 'out-of-range)))
- (snd-display ";ws-error threaded -220 2: ~A" tag))
+ (snd-display #__line__ ";ws-error threaded -220 2: ~A" tag))
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error threaded -220 2: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error threaded -220 2: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(if (mus-output? *reverb*)
(begin
- (snd-display ";ws-error threaded -220 2: *reverb*: ~A" *reverb*)
+ (snd-display #__line__ ";ws-error threaded -220 2: *reverb*: ~A" *reverb*)
(mus-close *reverb*)
(set! *reverb* #f)))
(let ((prev (find-sound "test.snd")))
(if (sound? prev)
(begin
- (snd-display ";ws error threaded -220 2 opened test.snd?")
+ (snd-display #__line__ ";ws error threaded -220 2 opened test.snd?")
(close-sound prev))))
(if *ws-finish*
- (snd-display ";ws error threaded -220 2 caught interrupt? ~A" *ws-finish*))
+ (snd-display #__line__ ";ws error threaded -220 2 caught interrupt? ~A" *ws-finish*))
(if (not (equal? current-threads (all-threads)))
- (snd-display ";ws error threaded -220 2 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
+ (snd-display #__line__ ";ws error threaded -220 2 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
))
;; ---------------- catch 'mus-error (handled by with-sound, but no continuation -- appears to exit after cleaning up) ----------------
- (snd-display ";error printout expected.....")
+ (snd-display #__line__ ";error printout expected.....")
(let ((tag (catch #t
(lambda ()
@@ -53301,23 +53401,23 @@ EDITS: 1
(if (or (not (string? tag))
(not (string=? tag "test.snd")))
- (snd-display ";ws-error bad env: ~A" tag))
+ (snd-display #__line__ ";ws-error bad env: ~A" tag))
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error bad env: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error bad env: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(let ((prev (find-sound "test.snd")))
(if (not (sound? prev))
- (snd-display ";ws error bad env did not open test.snd?")
+ (snd-display #__line__ ";ws error bad env did not open test.snd?")
(close-sound prev)))
(if *ws-finish*
- (snd-display ";ws error bad env caught interrupt? ~A" *ws-finish*)))
+ (snd-display #__line__ ";ws error bad env caught interrupt? ~A" *ws-finish*)))
(if (defined? 'all-threads)
(let ((current-threads (all-threads)))
(if (not (equal? current-threads (list (current-thread))))
- (snd-display ";ws error threaded start 1 threads: ~A, current:~A" current-threads (current-thread)))
+ (snd-display #__line__ ";ws error threaded start 1 threads: ~A, current:~A" current-threads (current-thread)))
(let ((tag (catch #t
(lambda ()
@@ -53330,21 +53430,21 @@ EDITS: 1
(if (or (not (string? tag))
(not (string=? tag "test.snd")))
- (snd-display ";ws-error threaded bad env: ~A" tag))
+ (snd-display #__line__ ";ws-error threaded bad env: ~A" tag))
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error threaded bad env: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error threaded bad env: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(let ((prev (find-sound "test.snd")))
(if (not (sound? prev))
- (snd-display ";ws error threaded bad env did not open test.snd?")
+ (snd-display #__line__ ";ws error threaded bad env did not open test.snd?")
(close-sound prev)))
(if *ws-finish*
- (snd-display ";ws error threaded bad env caught interrupt? ~A" *ws-finish*)))
+ (snd-display #__line__ ";ws error threaded bad env caught interrupt? ~A" *ws-finish*)))
(if (not (equal? current-threads (all-threads)))
- (snd-display ";ws error threaded bad env threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads)))))
+ (snd-display #__line__ ";ws error threaded bad env threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads)))))
;; ---------------- interrupt with-sound ----------------
@@ -53360,15 +53460,15 @@ EDITS: 1
(ws-quit!)
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error interrupt quit: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error interrupt quit: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(let ((prev (find-sound "test.snd")))
(if (not (sound? prev))
- (snd-display ";ws error interrupt quit did not open test.snd?")
+ (snd-display #__line__ ";ws error interrupt quit did not open test.snd?")
(close-sound prev)))
(if *ws-finish*
- (snd-display ";ws error interrupt not complete? ~A" *ws-finish*)))
+ (snd-display #__line__ ";ws error interrupt not complete? ~A" *ws-finish*)))
(let ((tag (catch #t
(lambda ()
@@ -53381,37 +53481,37 @@ EDITS: 1
(ws-quit!)
(if (mus-output? *output*)
(begin
- (snd-display ";ws-error threaded interrupt quit: *output*: ~A" *output*)
+ (snd-display #__line__ ";ws-error threaded interrupt quit: *output*: ~A" *output*)
(mus-close *output*)
(set! *output* #f)))
(let ((prev (find-sound "test.snd")))
(if (not (sound? prev))
- (snd-display ";ws error threaded interrupt quit did not open test.snd?")
+ (snd-display #__line__ ";ws error threaded interrupt quit did not open test.snd?")
(close-sound prev)))
(if *ws-finish*
- (snd-display ";ws error threaded interrupt not complete? ~A" *ws-finish*)))
+ (snd-display #__line__ ";ws error threaded interrupt not complete? ~A" *ws-finish*)))
- (snd-display ";end error printout.")
+ (snd-display #__line__ ";end error printout.")
(let ((tag (with-sound (:output "test.snd" :srate 44100) (fm-violin 0 1 440 .1))))
(if (or (not (string? tag))
(not (string=? tag "test.snd")))
- (snd-display ";ws-error all done: ~A" tag))
+ (snd-display #__line__ ";ws-error all done: ~A" tag))
(if (not (= (mus-sound-frames "test.snd") 44100))
- (snd-display ";ws-error all done frames: ~A" (mus-sound-frames "test.snd"))))
+ (snd-display #__line__ ";ws-error all done frames: ~A" (mus-sound-frames "test.snd"))))
(let ((tag (with-threaded-sound (:output "test.snd" :srate 44100) (fm-violin 0 1 440 .1))))
(if (or (not (string? tag))
(not (string=? tag "test.snd")))
- (snd-display ";ws-error threaded all done: ~A" tag))
+ (snd-display #__line__ ";ws-error threaded all done: ~A" tag))
(if (not (= (mus-sound-frames "test.snd") 44100))
- (snd-display ";ws-error threaded all done frames: ~A" (mus-sound-frames "test.snd"))))
+ (snd-display #__line__ ";ws-error threaded all done frames: ~A" (mus-sound-frames "test.snd"))))
(close-sound (find-sound "test.snd"))
(delete-file "test.snd")
)
-
+
(catch #t
(lambda ()
(vector-synthesis (let ((ctr 0) (file 0))
@@ -53426,7 +53526,7 @@ EDITS: 1
file))
(list "oboe.snd" "pistol.snd") #t))
(lambda args (display args)))
-
+
(if (provided? 'snd-threads)
(begin
@@ -53435,35 +53535,35 @@ EDITS: 1
(len (frames snd)))
(with-threaded-channels snd (lambda (snd chn) (src-channel 2.0 0 #f snd chn)))
(if (> (abs (- (* 2 (frames snd)) len)) 5)
- (snd-display ";with-threaded-sound oboe src: ~A ~A" (frames) len))
+ (snd-display #__line__ ";with-threaded-sound oboe src: ~A ~A" (frames) len))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (filter-channel '(0 1 .1 0 1 0) 120 0 #f snd chn)))
(if (> (maxamp snd 0) .1)
- (snd-display ";with-threaded-channels oboe filter: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
+ (snd-display #__line__ ";with-threaded-channels oboe filter: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (map-channel (lambda (y) (* y 2)) 0 #f snd chn)))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels oboe map: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
+ (snd-display #__line__ ";with-threaded-channels oboe map: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn)))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels oboe ptree: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
+ (snd-display #__line__ ";with-threaded-channels oboe ptree: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn #f #t)))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels oboe ptree peak: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
+ (snd-display #__line__ ";with-threaded-channels oboe ptree peak: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y data forward) (* y (vct-ref data 0))) 0 #f snd chn #f #f (lambda (beg dur) (vct 2.0)))))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels oboe ptree vct: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
+ (snd-display #__line__ ";with-threaded-channels oboe ptree vct: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (reverse-channel 0 #f snd chn)))
(if (not (= (frames snd 0) (frames snd 0 0)))
- (snd-display ";with-threaded-channels oboe reverse: ~A ~A" (frames snd 0) (frames snd 0 0)))
+ (snd-display #__line__ ";with-threaded-channels oboe reverse: ~A ~A" (frames snd 0) (frames snd 0 0)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (src-channel 0.5 0 #f snd chn)))
(if (> (abs (- (* .5 (frames snd)) len)) 5)
- (snd-display ";with-threaded-sound oboe src 5: ~A ~A" (frames) len))
+ (snd-display #__line__ ";with-threaded-sound oboe src 5: ~A ~A" (frames) len))
(revert-sound snd)
(close-sound snd))
@@ -53474,2469 +53574,2466 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 4))
(if (> (abs (- (* 2 (frames snd i)) len)) 5)
- (snd-display ";with-threaded-sound 4 src ~D: ~A ~A" i (frames) len)))
+ (snd-display #__line__ ";with-threaded-sound 4 src ~D: ~A ~A" i (frames) len)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (filter-channel '(0 1 .1 0 1 0) 120 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 4))
(if (> (maxamp snd 0) .1)
- (snd-display ";with-threaded-channels 4.aiff filter ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 4.aiff filter ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (map-channel (lambda (y) (* y 2)) 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 4))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 4.aiff map~D : ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 4.aiff map~D : ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 4))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 4.aiff ptree ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 4.aiff ptree ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn #f #t)))
(do ((i 0 (+ i 1)))
((= i 4))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 4.aiff ptree peak ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 4.aiff ptree peak ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y data forward) (* y (vct-ref data 0))) 0 #f snd chn #f #f (lambda (beg dur) (vct 2.0)))))
(do ((i 0 (+ i 1)))
((= i 4))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 4.aiff ptree vct ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 4.aiff ptree vct ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (reverse-channel 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 4))
(if (not (= (frames snd 0) (frames snd 0 0)))
- (snd-display ";with-threaded-channels 4.aiff reverse ~D: ~A ~A" i (frames snd 0) (frames snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 4.aiff reverse ~D: ~A ~A" i (frames snd 0) (frames snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (src-channel 0.5 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 4))
(if (> (abs (- (* .5 (frames snd)) len)) 5)
- (snd-display ";with-threaded-sound 4.aiff src 5 ~D: ~A ~A" i (frames) len)))
+ (snd-display #__line__ ";with-threaded-sound 4.aiff src 5 ~D: ~A ~A" i (frames) len)))
(revert-sound snd)
(close-sound snd))
;; 8-chans
(let* ((snd (find-sound (with-sound (:channels 8)
- (do ((i 0 (1+ i)))
+ (do ((i 0 (+ 1 i)))
((= i 8))
- (fm-violin 0 1 (* (1+ i) 100.0) .3 :degree (* i (/ 360 8)))))))
+ (fm-violin 0 1 (* (+ 1 i) 100.0) .3 :degree (* i (/ 360 8)))))))
(len (frames snd)))
(with-threaded-channels snd (lambda (snd chn) (src-channel 2.0 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 8))
(if (> (abs (- (* 2 (frames snd i)) len)) 5)
- (snd-display ";with-threaded-sound 4 src ~D: ~A ~A" i (frames) len)))
+ (snd-display #__line__ ";with-threaded-sound 4 src ~D: ~A ~A" i (frames) len)))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (filter-channel '(0 1 .1 0 1 0) 120 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 8))
(if (or (> (maxamp snd 0) .35) ; the other two cases involve higher sounds
(< (maxamp snd 0) .25))
- (snd-display ";with-threaded-channels 8 chan filter ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 8 chan filter ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (map-channel (lambda (y) (* y 2)) 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 8))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 8 chan map ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 8 chan map ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 8))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 8 chan ptree ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 8 chan ptree ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn #f #t)))
(do ((i 0 (+ i 1)))
((= i 8))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 8 chan ptree peak ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 8 chan ptree peak ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y data forward) (* y (vct-ref data 0))) 0 #f snd chn #f #f (lambda (beg dur) (vct 2.0)))))
(do ((i 0 (+ i 1)))
((= i 8))
(if (< (maxamp snd 0) .25)
- (snd-display ";with-threaded-channels 8 chan ptree vct ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 8 chan ptree vct ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (reverse-channel 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 8))
(if (not (= (frames snd 0) (frames snd 0 0)))
- (snd-display ";with-threaded-channels 8 chan reverse ~D: ~A ~A" i (frames snd 0) (frames snd 0 0))))
+ (snd-display #__line__ ";with-threaded-channels 8 chan reverse ~D: ~A ~A" i (frames snd 0) (frames snd 0 0))))
(revert-sound snd)
(with-threaded-channels snd (lambda (snd chn) (src-channel 0.5 0 #f snd chn)))
(do ((i 0 (+ i 1)))
((= i 8))
(if (> (abs (- (* .5 (frames snd)) len)) 5)
- (snd-display ";with-threaded-sound 8 chan src 5 ~D: ~A ~A" i (frames) len)))
+ (snd-display #__line__ ";with-threaded-sound 8 chan src 5 ~D: ~A ~A" i (frames) len)))
(revert-sound snd)
(close-sound snd))
))
- (if (provided? 'run)
+ (set! (optimization) max-optimization)
+ (dismiss-all-dialogs)
+
+ (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
+ (log-mem clmtest)
+
+ (set! (mus-srate) 22050)
+ (set! (default-output-srate) 22050)
+
+ ;; check clm output for bad zero case
+ (for-each
+ (lambda (type)
+ (let ((ind (find-sound
+ (with-sound (:data-format type)
+ (fm-violin 0 .1 440 .1)
+ (fm-violin 10 .1 440 .1)
+ (fm-violin 100 .1 440 .1)
+ (fm-violin 1000 .1 440 .1)))))
+ (let ((mx (maxamp ind)))
+ (if (ffneq mx .1) ; mus-byte -> 0.093
+ (snd-display #__line__ ";max: ~A, format: ~A" mx (mus-data-format->string type))))))
+ (list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
+ mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
+ mus-ubshort mus-ulshort mus-ubyte mus-bfloat mus-bdouble
+ mus-ldouble))
+
+ (let ((old-opt (optimization)))
+ (do ((opt 0 (+ 1 opt)))
+ ((> opt max-optimization))
+ (set! (optimization) opt)
+ (with-sound (:srate 22050) (fm-violin 0 .1 (* 110 (+ 1 opt)) .1))
+ (let ((ind (find-sound "test.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
+ (let ((mx (maxamp)))
+ (if (fneq mx .1) (snd-display #__line__ ";with-sound max: ~A" (maxamp)))
+ (if (not (= (srate ind) 22050)) (snd-display #__line__ ";with-sound srate: ~A (~A, ~A)"
+ (srate ind) (mus-srate) (mus-sound-srate "test.snd")))
+ (if (not (= (frames ind) 2205)) (snd-display #__line__ ";with-sound frames: ~A" (frames ind))))
+ (play ind :wait #t)))
+ (set! (optimization) old-opt))
+
+ (with-sound (:continue-old-file #t) (fm-violin .2 .1 440 .25))
+ (let ((ind (find-sound "test.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound continued: ~A" (map file-name (sounds))))
+ (if (not (= (length (sounds)) 1)) (snd-display #__line__ ";with-sound continued: ~{~A ~}" (map short-file-name (sounds))))
+ (let ((mx (maxamp)))
+ (if (fneq mx .25) (snd-display #__line__ ";with-sound continued max: ~A" (maxamp)))
+ (if (not (= (srate ind) 22050)) (snd-display #__line__ ";with-sound continued srate: ~A (~A, ~A)"
+ (srate ind) (mus-srate) (mus-sound-srate "test.snd")))
+ (if (not (= (frames ind) (* 3 2205))) (snd-display #__line__ ";with-sound continued frames: ~A (~A)" (frames ind) (srate ind))))
+ (close-sound ind))
+
+ (with-sound () (fm-violin 0 .1 440 .1))
+ (with-sound (:continue-old-file #t) (fm-violin .2 .1 660 .04))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp ind 0) .1) (snd-display #__line__ ";maxamp after continued sound: ~A" (maxamp ind 0)))
+ (if (fneq (/ (frames ind) (srate ind)) .3) (snd-display #__line__ ";duration after continued sound: ~A" (/ (frames ind) (srate ind))))
+ (close-sound ind))
+
+ (with-sound (:srate 22050 :channels 2 :output "test1.snd") (fm-violin 0 .1 440 .1 :degree 45.0))
+ (let ((ind (find-sound "test1.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound (1): ~A" (map file-name (sounds))))
+ (let ((mx (maxamp)))
+ (if (fneq mx .05) (snd-display #__line__ ";with-sound max (1): ~A" (maxamp)))
+ (if (or (not (= (srate ind) 22050))
+ (not (= (mus-sound-srate "test1.snd") 22050)))
+ (snd-display #__line__ ";with-sound srate (1): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (if (not (= (frames ind) 2205)) (snd-display #__line__ ";with-sound frames (1): ~A" (frames ind)))
+ (if (or (not (= (chans ind) 2))
+ (not (= (mus-sound-chans "test1.snd") 2)))
+ (snd-display #__line__ ";with-sound chans (1): ~A" (chans ind))))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 48000 :channels 2 :header-type mus-riff :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (or (not (= (srate ind) 48000))
+ (not (= (mus-sound-srate "test1.snd") 48000)))
+ (snd-display #__line__ ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (if (not (= (header-type ind) mus-riff)) (snd-display #__line__ ";with-sound type (~A, r): ~A" mus-riff (header-type ind)))
+ (if (not (= (chans ind) 2)) (snd-display #__line__ ";with-sound chans (2, r): ~A" (chans ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 48000 :channels 2 :header-type mus-rf64 :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (or (not (= (srate ind) 48000))
+ (not (= (mus-sound-srate "test1.snd") 48000)))
+ (snd-display #__line__ ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (if (not (= (header-type ind) mus-rf64)) (snd-display #__line__ ";with-sound type (~A, r): ~A" mus-rf64 (header-type ind)))
+ (if (not (= (chans ind) 2)) (snd-display #__line__ ";with-sound chans (2, r): ~A" (chans ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 48000 :channels 2 :header-type mus-caff :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (or (not (= (srate ind) 48000))
+ (not (= (mus-sound-srate "test1.snd") 48000)))
+ (snd-display #__line__ ";with-sound mus-caff srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (if (not (= (header-type ind) mus-caff)) (snd-display #__line__ ";with-sound type (~A, r): ~A" mus-caff (header-type ind)))
+ (if (not (= (chans ind) 2)) (snd-display #__line__ ";with-sound mus-caff chans (2, r): ~A" (chans ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 8000 :channels 3 :header-type mus-next :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (not (= (srate ind) 8000)) (snd-display #__line__ ";with-sound srate (8000, s): ~A (~A, ~A)"
+ (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (if (not (= (header-type ind) mus-next)) (snd-display #__line__ ";with-sound type (~A, s): ~A" mus-next (header-type ind)))
+ (if (not (= (chans ind) 3)) (snd-display #__line__ ";with-sound chans (3, s): ~A" (chans ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 96000 :channels 4 :header-type mus-aifc :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (not (= (srate ind) 96000)) (snd-display #__line__ ";with-sound srate (96000, t): ~A (~A, ~A)"
+ (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (if (not (= (header-type ind) mus-aifc)) (snd-display #__line__ ";with-sound type (~A, t): ~A" mus-aifc (header-type ind)))
+ (if (not (= (chans ind) 4)) (snd-display #__line__ ";with-sound chans (4, t): ~A" (chans ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 22050 :channels 1 :header-type mus-raw :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (not (= (srate ind) 22050)) (snd-display #__line__ ";with-sound srate (22050, u): ~A (~A, ~A)"
+ (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (if (not (= (header-type ind) mus-raw)) (snd-display #__line__ ";with-sound type (~A, u): ~A" mus-raw (header-type ind)))
+ (if (not (= (chans ind) 1)) (snd-display #__line__ ";with-sound chans (1, u): ~A" (chans ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 22050 :channels 2 :output "test1.snd" :reverb jc-reverb)
+ (if (not (= (mus-sound-srate (mus-file-name *output*)) 22050))
+ (snd-display #__line__ ";srate file *output*: ~A" (mus-sound-srate (mus-file-name *output*))))
+ (if (not (= (mus-sound-srate (mus-file-name *reverb*)) 22050))
+ (snd-display #__line__ ";srate file *reverb*: ~A" (mus-sound-srate (mus-file-name *reverb*))))
+ (fm-violin 0 .1 440 .1 :degree 45.0))
+ (let ((ind (find-sound "test1.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound (2): ~A" (map file-name (sounds))))
+ (if (not (= (frames ind) (+ 22050 2205))) (snd-display #__line__ ";with-sound reverbed frames (2): ~A" (frames ind)))
+ (close-sound ind))
+
+ (let ((old-opt (optimization)))
+ (do ((opt 0 (+ 1 opt)))
+ ((> opt max-optimization))
+ (set! (optimization) opt)
+ (with-sound (:srate 22050 :output "test1.snd" :reverb jc-reverb) (fm-violin 0 .1 440 .1))
+ (set! (optimization) old-opt)))
+
+ (let ((ind (find-sound "test1.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound (3): ~A" (map file-name (sounds))))
+ (if (not (= (frames ind) (+ 22050 2205))) (snd-display #__line__ ";with-sound reverbed frames (3): ~A" (frames ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:srate 22050 :comment "Snd+Run!" :scaled-to .5) (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
+ (let ((mx (maxamp)))
+ (if (fneq mx .5) (snd-display #__line__ ";with-sound scaled-to: ~A" (maxamp)))
+ (if (not (string=? (comment ind) "Snd+Run!")) (snd-display #__line__ ";with-sound comment: ~A (~A)" (comment ind) (mus-sound-comment "test.snd"))))
+ (close-sound ind))
+
+ (with-sound (:srate 22050 :scaled-by .5 :header-type mus-aifc :data-format mus-bfloat) (fm-violin 0 .1 440 .1))
+ (let ((ind (find-sound "test.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
+ (let ((mx (maxamp)))
+ (if (fneq mx .05) (snd-display #__line__ ";with-sound scaled-by: ~A" (maxamp)))
+ (if (not (= (header-type ind) mus-aifc)) (snd-display #__line__ ";with-sound type: ~A (~A)" (header-type ind) (mus-header-type-name (header-type ind))))
+ (if (not (= (data-format ind) mus-bfloat)) (snd-display #__line__ ";with-sound format: ~A (~A)" (data-format ind) (mus-data-format-name (data-format ind)))))
+ (close-sound ind))
+
+ (add-hook! open-raw-sound-hook (lambda (file choice) (list 1 22050 mus-bshort)))
+ (with-sound (:header-type mus-raw) (fm-violin 0 1 440 .1))
+ (reset-hook! open-raw-sound-hook)
+ (let ((ind (find-sound "test.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound (raw out): ~A" (map file-name (sounds))))
+ (if (not (= (header-type ind) mus-raw))
+ (snd-display #__line__ ";with-sound type raw: ~A (~A)" (header-type ind) (mus-header-type-name (header-type ind))))
+ (if (and (not (= (data-format ind) mus-bshort))
+ (not (= (data-format ind) mus-bfloat))
+ (not (= (data-format ind) mus-lfloat)))
+ (snd-display #__line__ ";with-sound format raw: ~A (~A)" (data-format ind) (mus-data-format-name (data-format ind))))
+ (close-sound ind))
+
+ (with-sound (:srate 44100 :statistics #t) (ws-sine 1000))
+ (let ((ind (find-sound "test.snd")))
+ (let ((i -1))
+ (scan-channel (lambda (y)
+ (set! i (+ 1 i))
+ (if (fneq y (sin (* 2 pi i (/ 1000.0 44100.0))))
+ (begin
+ (display (format #f "~%;with-sound sine: ~D ~A ~A" i y (sin (* 2 pi i (/ 1000.0 44100.0)))))
+ #t)
+ #f))))
+ (close-sound ind))
+
+ (set! *opt* #t)
+ (with-sound ()
+ (run
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (let ((gen (make-oscil 440.0))
+ (e (make-env (vct 0.0 0.0 1.0 1.0 2.0 0.0) 0.1 1.0)))
+ (do ((k 0 (+ k 1)))
+ ((= k 44100))
+ (outa (+ k (* i 50000)) (* (env e) (oscil gen))))))))
+ (if (not *opt*)
+ (snd-display #__line__ ";with-sound make-oscil in run loop optimization failed?"))
+ (let ((ind (find-sound "test.snd")))
+ (if (not (= (frames ind) 144100))
+ (snd-display #__line__ ";with-sound make-oscil in run frames: ~A" (frames)))
+ (if (fneq (maxamp ind) .1)
+ (snd-display #__line__ ";with-sound make-oscil in run maxamp: ~A" (maxamp ind)))
+ (close-sound ind))
+
+
+ (if (file-exists? "ii.scm")
+ (begin
+ (time (load "ii.scm"))
+ (for-each close-sound (sounds))
+ (delete-file "test.snd")
+ (delete-file "test.rev")))
+
+ (let ((var (make-st1 :one 1 :two 2)))
+ (if (not (= (st1-one var) 1)) (snd-display #__line__ ";st1-one: ~A" (st1-one var)))
+ (if (not (= (st1-two var) 2)) (snd-display #__line__ ";st1-two: ~A" (st1-two var)))
+ (if (not (st1? var)) (snd-display #__line__ ";st1? ~A (~A)" (st1? var) var))
+ (set! (st1-one var) 321)
+ (set! (st1-two var) "hiho")
+ (if (not (= (st1-one var) 321)) (snd-display #__line__ ";st1-one (321): ~A" (st1-one var)))
+ (if (not (string=? (st1-two var) "hiho")) (snd-display #__line__ ";st1-two (hiho): ~A" (st1-two var)))
+ (set! var (make-st1))
+ (if (fneq (st1-one var) 0.0) (snd-display #__line__ ";st1-one #f: ~A" (st1-one var)))
+ (if (fneq (st1-two var) 0.0) (snd-display #__line__ ";st1-two #f: ~A" (st1-two var)))
+ (set! var (make-st1 :two 3))
+ (if (fneq (st1-one var) 0.0) (snd-display #__line__ ";st1-one #f (def): ~A" (st1-one var)))
+ (if (not (= (st1-two var) 3)) (snd-display #__line__ ";st1-two (3): ~A" (st1-two var))))
+
+ (let ((var (make-st2 :one 1 :two 2)))
+ (if (not (= (st2-one var) 1)) (snd-display #__line__ ";st2-one: ~A" (st2-one var)))
+ (if (not (= (st2-two var) 2)) (snd-display #__line__ ";st2-two: ~A" (st2-two var)))
+ (if (not (st2? var)) (snd-display #__line__ ";st2? ~A (~A)" (st1? var) var))
+ (if (st1? var) (snd-display #__line__ ";st1? (not ~A): ~A" (st1? var) var))
+ (set! (st2-one var) 321)
+ (set! (st2-two var) "hiho")
+ (if (not (= (st2-one var) 321)) (snd-display #__line__ ";st2-one (321): ~A" (st2-one var)))
+ (if (not (string=? (st2-two var) "hiho")) (snd-display #__line__ ";st2-two (hiho): ~A" (st2-two var)))
+ (set! var (make-st2))
+ (if (not (= (st2-one var) 11)) (snd-display #__line__ ";st2-one 11: ~A" (st2-one var)))
+ (if (not (= (st2-two var) 22)) (snd-display #__line__ ";st2-two 22: ~A" (st2-two var)))
+ (set! var (make-st2 :two 3))
+ (if (not (= (st2-one var) 11)) (snd-display #__line__ ";st2-one 11 (def): ~A" (st2-one var)))
+ (if (not (= (st2-two var) 3)) (snd-display #__line__ ";st2-two (3): ~A" (st2-two var))))
+
+ (let ((gad (make-grab-bag)))
+ (if (not (= (grab-bag-i gad) 0))
+ (snd-display #__line__ ";grab-bag-i: ~A" (grab-bag-i gad)))
+ (set! (grab-bag-flt gad) 123.0)
+ (set! (grab-bag-v gad) (vct .1 .2 .3))
+ (set! (grab-bag-fvect gad) (vector .1 .2 .3))
+ (set! (grab-bag-ivect gad) (make-vector 3 1))
+ (set! (grab-bag-cvect gad) (make-vector 3 #f))
+ (do ((i 0 (+ 1 i)))
+ ((= i 3))
+ (vector-set! (grab-bag-cvect gad) i (make-oscil 440.0)))
+ (set! (grab-bag-gen gad) (make-oscil 440.0))
+ (let ((val 0.0))
+ (run
+ (lambda ()
+ (set! val (grab-bag-flt gad))))
+ (if (fneq val 123.0) (snd-display #__line__ ";def-clm-struct flt: ~A ~A" val (grab-bag-flt gad))))
+ (if (fneq (grab-bag-flt1 gad) 1.0) (snd-display #__line__ ";def-clm-struct flt1: ~A" (grab-bag-flt1 gad)))
+ (if (not (= (grab-bag-i gad) 0)) (snd-display #__line__ ";def-clm-struct i: ~A" (grab-bag-i gad)))
+ (if (not (= (grab-bag-i1 gad) 123)) (snd-display #__line__ ";def-clm-struct i1: ~A" (grab-bag-i1 gad))))
+
+ (if (file-exists? "test.snd") (delete-file "test.snd"))
+ (set! (mus-srate) 22050)
+ (set! *clm-srate* 22050)
+ (set! (default-output-srate) 22050)
+ (let ((outer (with-sound ()
+ (sound-let ((a () (fm-violin 0 .1 440 .1)))
+ (mus-mix *output* a)))))
+ (if (not (string=? outer "test.snd"))
+ (snd-display #__line__ ";with-sound returns: ~A" outer))
+ (let ((ind (find-sound outer)))
+ (if (or (not (sound? ind))
+ (not (= (frames ind) (floor (* (mus-srate) .1)))))
+ (snd-display #__line__ ";sound-let: ~A ~A" (frames ind) (floor (* (mus-srate) .1))))
+ (close-sound ind)))
+
+ (if (file-exists? "test.snd") (delete-file "test.snd"))
+ (let ((outer (with-sound ()
+ (sound-let ((a () (fm-violin 0 .1 440 .1))
+ (b 100))
+ (mus-mix *output* a b)
+ (sound-let ((c (:channels 1 :output "temp.snd") (fm-violin 0 .1 110.0 .1)))
+ (mus-mix *output* c))))))
+ (if (not (string=? outer "test.snd"))
+ (snd-display #__line__ ";with-sound (2) returns: ~A" outer))
+ (let ((ind (find-sound outer)))
+ (if (or (not (sound? ind))
+ (not (= (frames ind) (+ 100 (floor (* (mus-srate) .1))))))
+ (snd-display #__line__ ";sound-let (2): ~A ~A" (frames ind) (+ 100 (floor (* (mus-srate) .1)))))
+ (if (file-exists? "temp.snd")
+ (snd-display #__line__ ";sound-let explicit output exists?"))
+ (close-sound ind)))
+
+ (let ((w (init-with-sound)))
+ (fm-violin 0 1 440 .1)
+ (let ((outer (finish-with-sound w)))
+ (if (not (string=? outer "test.snd"))
+ (snd-display #__line__ ";finish-with-sound returns: ~A" outer))
+ (let ((ind (find-sound outer)))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";init-with-sound: ~A" (map short-file-name (sounds)))
+ (begin
+ (if (fneq (maxamp ind 0) .1)
+ (snd-display #__line__ ";init-with-sound max: ~A" (maxamp ind 0)))
+ (close-sound ind))))))
+
+ (let ((w (init-with-sound :output "test.aiff" :header-type mus-aifc :scaled-to .5)))
+ (fm-violin 0 1 440 .1)
+ (let ((outer (finish-with-sound w)))
+ (if (not (string=? outer "test.aiff"))
+ (snd-display #__line__ ";finish-with-sound (2) returns: ~A ~A" outer w))
+ (let ((ind (find-sound outer)))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";init-with-sound (2): ~A" (map short-file-name (sounds)))
+ (begin
+ (if (fneq (maxamp ind 0) .5)
+ (snd-display #__line__ ";init-with-sound scaled-to: ~A ~A" (maxamp ind 0) w))
+ (if (not (= (header-type ind) mus-aifc))
+ (snd-display #__line__ ";init-with-sound type: ~A ~A" (header-type ind) w))
+ (close-sound ind))))))
+
+ (with-sound (:output "test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound (freeverb): ~A" (map file-name (sounds))))
+ (if (not (> (maxamp ind) .1)) (snd-display #__line__ ";freeverb 3.0: ~A" (maxamp ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (with-sound (:output "test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0 :global 0.5)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+ (let ((ind (find-sound "test1.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound (freeverb): ~A" (map file-name (sounds))))
+ (if (not (> (maxamp ind) .16)) (snd-display #__line__ ";freeverb 3.0 global 0.5: ~A" (maxamp ind)))
+ (close-sound ind)
+ (delete-file "test1.snd"))
+
+ (set! (mus-srate) 22050)
+ (set! (default-output-srate) 22050)
+
+ (let ((fmt1 '(0 1200 100 1000))
+ (fmt2 '(0 2250 100 1800))
+ (fmt3 '(0 4500 100 4500))
+ (fmt4 '(0 6750 100 8100))
+ (amp1 '(0 .67 100 .7))
+ (amp2 '(0 .95 100 .95))
+ (amp3 '(0 .28 100 .33))
+ (amp4 '(0 .14 100 .15))
+ (ind1 '(0 .75 100 .65))
+ (ind2 '(0 .75 100 .75))
+ (ind3 '(0 1 100 1))
+ (ind4 '(0 1 100 1))
+ (skwf '(0 0 100 0))
+ (ampf '(0 0 25 1 75 1 100 0))
+ (ranf '(0 .5 100 .5))
+ (index '(0 1 100 1))
+ (zero_fun '(0 0 100 0))
+ (atskew '(0 -1 15 .3 22 -.1 25 0 75 0 100 -.2))
+ (vibfun '(0 0 .3 .3 15 .6 25 1 100 1))
+ (slopefun '(0 1 75 1 100 0))
+ (trap '(0 0 25 1 75 1 100 0))
+ (ramp '(0 0 25 0 75 1 100 1))
+ (solid '(0 0 5 1 95 1 100 0))
+ (sfz '(0 0 25 1 30 .6 50 .5 75 .2 100 0))
+ (mound '(0 0 10 .4 25 .8 40 1 60 1 75 .8 90 .4 100 0))
+ (vio '(0 0 7 .2 25 .5 40 .6 60 .6 75 .5 90 .2 100 0))
+ (bassdr2 '(.5 .06 1 .62 1.5 .07 2.0 .6 2.5 .08 3.0 .56 4.0 .24
+ 5 .98 6 .53 7 .16 8 .33 9 .62 10 .12 12 .14 14 .86
+ 16 .12 23 .14 24 .17))
+ (bassdrstr '(.5 .06 1.0 .63 1.5 .07 2.01 .6 2.5 .08 3.02 .56
+ 4.04 .24 5.05 .98 6.06 .53 7.07 .16 8.08 .33 9.09 .62
+ 10.1 .12 12.12 .14 13.13 .37 14.14 .86 16.16 .12 23.23 .14 24.24 .17))
+ (tenordr '(.3 .04 1 .81 2 .27 3 .2 4 .21 5 .18 6 .35 7 .03 8 .07 9 .02 10 .025 11 .035))
+ (tenordrstr '(.3 .04 1.03 .81 2.03 .27 3.03 .20 4.03 .21 5.03 .18
+ 6.03 .35 7.03 .03 8.03 .07 9.03 .02 10.03 .03 11.03 .04)))
+ (with-sound (:reverb nrev)
+ (drone .000 4.000 115.000 (* .25 .500) solid bassdr2 .100 .500
+ .030 45.000 1 .010 10)
+ (drone .000 4.000 229.000 (* .25 .500) solid tenordr .100 .500
+ .030 45.000 1 .010 11)
+ (drone .000 4.000 229.500 (* .25 .500) solid tenordr .100 .500
+ .030 45.000 1 .010 9)
+ (canter .000 2.100 918 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 2.100 .300 688.5 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 2.400 .040 826.2 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 2.440 .560 459 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.000 .040 408 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.040 .040 619.65 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.080 .040 408 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.120 .040 688.5 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.160 .290 459 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.450 .150 516.375 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.600 .040 826.2 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.640 .040 573.75 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.680 .040 619.65 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.720 .180 573.75 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.900 .040 688.5 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
+ (canter 3.940 .260 459 (* .25 .700) 45.000 1 .050 ampf ranf skwf
+ .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
+ ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )))
+
+ (let ((ind (find-sound "test.snd")))
+ (play ind :wait #t)
+ (close-sound ind))
+
+ (with-sound (:srate 22050)
+ (fm-violin 0 .01 440 .1 :noise-amount 0.0)
+ (pluck 0.05 .01 330 .1 .95 .95)
+ (maraca .1 .1)
+ (big-maraca .2 .5 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01)
+ (fm-bell 0.3 1.0 220.0 .5
+ '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0 )
+ '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 )
+ 1.0)
+ (singer .4 .1 (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01) (list .6 oo.shp test.glt 523.0 .7 .1 .01)))
+ (stereo-flute .6 .2 440 .55 :flow-envelope '(0 0 1 1 2 1 3 0))
+ (fofins 1 .3 270 .4 .001 730 .6 1090 .3 2440 .1)
+ (bow 1.2 .3 400 0.5 :vb 0.15 :fb 0.1 :inharm 0.25)
+ (pqw-vox 1.5 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 0) 0 '(0 L 100 L) '(.33 .33 .33) '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5)))
+ (fm-noise 2 0.5 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1 1000 '(0 0 100 1) 0.1 0.1 10 1000 '(0 0 100 1) 0 0 100 500 '(0 0 100 1) 0 0)
+ (bes-fm 2.5 .5 440 5.0 1.0 8.0)
+ (chain-dsps 3 0.5 '(0 0 1 .1 2 0) (make-oscil 440))
+ (chain-dsps 3.5 1.0 '(0 0 1 1 2 0) (make-one-zero .5) (make-readin "oboe.snd"))
+ (vox 4 2 170 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 E 25 AE 35 ER 65 ER 75 I 100 UH)
+ '(.8 .15 .05) '(.005 .0125 .025) .05 .1)
+ (p 5.0 :duration .5 :keyNum 36 :strike-velocity .5 :amp .4 :DryPedalResonanceFactor .25)
+ ;(bobwhite 5.5)
+ (scissor 2.0)
+ (plucky 3.25 .3 440 .2 1.0)
+ (bowstr 3.75 .3 220 .2 1.0)
+ (brass 4.2 .3 440 .2 1.0)
+ (clarinet 5.75 .3 440 .2 1.0)
+ (flute 6 .3 440 .2 1.0)
+ (fm-trumpet 6.5 .25)
+ (touch-tone 6.75 '(7 2 3 4 9 7 1))
+ (pins 7.0 1.0 "now.snd" 1.0 :time-scaler 2.0)
+
+ (let ((locust '(0 0 40 1 95 1 100 .5))
+ (bug_hi '(0 1 25 .7 75 .78 100 1))
+ (amp '(0 0 25 1 75 .7 100 0)))
+ (fm-insect 7 1.699 4142.627 .015 amp 60 -16.707 locust 500.866 bug_hi .346 .500)
+ (fm-insect 7.195 .233 4126.284 .030 amp 60 -12.142 locust 649.490 bug_hi .407 .500)
+ (fm-insect 7.217 2.057 3930.258 .045 amp 60 -3.011 locust 562.087 bug_hi .591 .500)
+ (fm-insect 9.100 1.500 900.627 .06 amp 40 -16.707 locust 300.866 bug_hi .346 .500)
+ (fm-insect 10.000 1.500 900.627 .06 amp 40 -16.707 locust 300.866 bug_hi .046 .500)
+ (fm-insect 10.450 1.500 900.627 .09 amp 40 -16.707 locust 300.866 bug_hi .006 .500)
+ (fm-insect 10.950 1.500 900.627 .12 amp 40 -10.707 locust 300.866 bug_hi .346 .500)
+ (fm-insect 11.300 1.500 900.627 .09 amp 40 -20.707 locust 300.866 bug_hi .246 .500))
+
+ (fm-drum 7.5 1.5 55 .3 5 #f)
+ (fm-drum 8 1.5 66 .3 4 #t)
+ (gong 9 3 261.61 .6)
+ (attract 10 .25 .5 2.0)
+ (pqw 11 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5))
+
+ (zn 10 1 100 .1 20 100 .995)
+ (zn 11.5 1 100 .1 100 20 .995)
+ (zc 11 1 100 .1 20 100 .95)
+ (zc 12.5 1 100 .1 100 20 .95)
+ (za 13 1 100 .1 20 100 .95 .95)
+ (za 14.5 1 100 .1 100 20 .95 .95)
+
+ (tubebell 12 2 440 .2)
+ (wurley 12.5 .25 440 .2)
+ (rhodey 12.75 .25 440 .2)
+ (hammondoid 13 .25 440 .2)
+ (metal 13.5 .25 440 .2)
+ (reson 14.0 1.0 440 .1 2 '(0 0 100 1) '(0 0 100 1) .1 .1 .1 5 .01 5 .01 0 1.0 0.01
+ '(((0 0 100 1) 1200 .5 .1 .1 0 1.0 .1 .1)
+ ((0 1 100 0) 2400 .5 .1 .1 0 1.0 .1 .1)))
+ (cellon 14.5 1 220 .1
+ '(0 0 25 1 75 1 100 0)
+ '(0 0 25 1 75 1 100 0) .75 1.0 0 0 0 0 1 0 0 220
+ '(0 0 25 1 75 1 100 0) 0 0 0 0
+ '(0 0 100 0) 0 0 0 0 '(0 0 100 0))
+ (clm-expsrc 14.75 4 "oboe.snd" 2.0 1.0 1.0)
+ (scratch 15.0 "now.snd" 1.5 '(0.0 .5 .25 1.0))
+ (two-tab 15 1 440 .1)
+ (exp-snd "fyow.snd" 15 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05)
+ (exp-snd "oboe.snd" 16 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2)
+ (gran-synth 15.5 1 300 .0189 .03 .4)
+ (spectra 16 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1) '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0))
+ (lbj-piano 16.5 1 440.0 .2)
+ (resflt 17 1.0 0 0 0 #f .1 200 230 10 '(0 0 50 1 100 0) '(0 0 100 1) 500 .995 .1 1000 .995 .1 2000 .995 .1)
+ (resflt 17.5 1.0 1 10000 .01 '(0 0 50 1 100 0) 0 0 0 0 #f #f 500 .995 .1 1000 .995 .1 2000 .995 .1)
+ (bes-fm 18 1 440 10.0 1.0 4.0)
+
+ (green3 19 2.0 440 .5 '(0 0 1 1 2 1 3 0) 100 .2 .02)
+ (green4 21 2.0 440 .5 '(0 0 1 1 2 1 3 0) 440 100 100 10)
+
+ (fir+comb 20 2 10000 .001 200)
+ (fir+comb 22 2 1000 .0005 400)
+ (fir+comb 24 2 3000 .001 300)
+ (fir+comb 26 2 3000 .0005 1000)
+
+ (sndwarp 28 1.0 "pistol.snd")
+ (expandn 29 .5 "oboe.snd" .2)
+ (let ((ampf '(0 0 1 1 2 1 3 0)))
+ (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 1 .01 0 ampf .01))
+ (graphEq "oboe.snd")
+ )
+ (let ((ind (find-sound "test.snd")))
+ (play ind :wait #t)
+ (close-sound ind))
+
+ (with-sound (:play #f) (defopt-simp 0 10000) (defopt-simp 10000 10000 550.0 0.1) (defopt-simp 20000 10000 :amplitude .2))
+ (with-sound (:channels 2 :reverb-channels 2 :reverb jcrev2 :play #f) (floc-simp 0 1))
+
+
+ (with-sound (:channels 2 :statistics #t)
+ (fullmix "pistol.snd")
+ (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5)))))
+ (let ((ind (find-sound "test.snd")))
+ (if (sound? ind) (close-sound ind)))
+
+ (with-sound (:channels 2)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp) 0.664947509765625) (snd-display #__line__ ";4->2(0) fullmix: ~A" (maxamp)))
+ (close-sound ind))
+
+ (with-sound (:channels 1)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((1.0) (0.0) (0.0) (0.0))))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp) 0.221649169921875) (snd-display #__line__ ";4->1(0) fullmix: ~A" (maxamp)))
+ (close-sound ind))
+
+ (with-sound (:channels 1)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0) (1.0) (0.0) (0.0))))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp) 0.44329833984375) (snd-display #__line__ ";4->1(1) fullmix: ~A" (maxamp)))
+ (close-sound ind))
+
+ (with-sound (:channels 1)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0) (0.0) (1.0) (0.0))))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp) 0.664947509765625) (snd-display #__line__ ";4->1(2) fullmix: ~A" (maxamp)))
+ (close-sound ind))
+
+ (with-sound (:channels 1)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0) (0.0) (0.0) (1.0))))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp) 0.8865966796875) (snd-display #__line__ ";4->1(3) fullmix: ~A" (maxamp)))
+ (close-sound ind))
+
+ (with-sound (:channels 2)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
+ (let* ((ind (find-sound "test.snd"))
+ (mxs (maxamp ind #t)))
+ (if (or (fneq (car mxs) 0.664947509765625)
+ (fneq (cadr mxs) 0.8865966796875))
+ (snd-display #__line__ ";4->2(1) fullmix: ~A" mxs))
+ (close-sound ind))
+
+ (with-sound (:channels 2)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (0.0 1.0) (1.0 0.0))))
+ (let* ((ind (find-sound "test.snd"))
+ (mxs (maxamp ind #t)))
+ (if (or (fneq (car mxs) 0.8865966796875)
+ (fneq (cadr mxs) 0.664947509765625))
+ (snd-display #__line__ ";4->2(2) fullmix: ~A" mxs))
+ (close-sound ind))
+
+ (with-sound (:channels 2 :reverb nrev)
+ (fullmix "pistol.snd" 0.0 2.0 0.25 #f 2.0 0.1)
+ (fullmix "pistol.snd" 1.0 2.0 0.25 0.2 2.0 0.1)
+ (fullmix "2a.snd" #f #f #f '((0.5 0.0) (0.0 0.75)))
+ (fullmix "oboe.snd" #f #f #f (list (list (list 0 0 1 1 2 0) 0.5)))
+ (fullmix "oboe.snd" 3 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5)))))
+
+
+ (load "fullmix.scm") ; this is also in clm-ins.scm so we need a separate set of tests
+
+ (with-sound (:channels 2 :statistics #t)
+ (fullmix "pistol.snd")
+ (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5)))))
+ (let ((ind (find-sound "test.snd")))
+ (if (sound? ind) (close-sound ind) (snd-display #__line__ ";fullmix.scm no output?")))
+
+ (with-sound (:channels 2)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp) 0.664947509765625) (snd-display #__line__ ";4->2(0) fullmix.scm: ~A" (maxamp)))
+ (close-sound ind))
+
+ (with-sound (:channels 1)
+ (fullmix "4.aiff" 0.0 0.1 36.4 '((1.0) (0.0) (0.0) (0.0))))
+ (let ((ind (find-sound "test.snd")))
+ (if (fneq (maxamp) 0.221649169921875) (snd-display #__line__ ";4->1(0) fullmix.scm: ~A" (maxamp)))
+ (close-sound ind))
+
+ (with-sound (:statistics #t :scaled-to .5 :srate 44100 :channels 1)
+ (cnvrev "oboe.snd" "fyow.snd"))
+ (let ((ind (find-sound "test.snd")))
+ (if (sound? ind) (close-sound ind) (snd-display #__line__ ";cnvrev no output?")))
+
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
+ (let ((old-date (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
+ (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
+ (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
+ (let ((old-date (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
+ (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
+ (let ((old-date (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" #f #t)))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
+ (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" old-date #t))
+
+ (with-sound ()
+ (sound-let ((temp-1 () (fm-violin 0 1 440 .1))
+ (temp-2 () (fm-violin 0 2 660 .1 :base 32.0)
+ (fm-violin .125 .5 880 .1)))
+ (mus-mix *output* temp-1 0)
+ (mus-mix *output* temp-2 22050)))
+ (let ((ind (find-sound "test.snd")))
+ (if (not (sound? ind)) (snd-display #__line__ ";with-sound+sound-lets init: no test.snd?"))
+ (if (or (> (maxamp ind) .2) (< (maxamp ind) .15)) (snd-display #__line__ ";with-mix+sound-lets maxamp: ~A" (maxamp ind)))
+ (if (fneq 3.0 (/ (frames ind) (srate ind))) (snd-display #__line__ ";with-sound+sound-lets dur: ~A" (/ (frames ind) (srate ind))))
+ (close-sound ind))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound ()
+ (with-mix () "with-mix" 0
+ (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-mix *output* tmp 0))))
+ (let ((old-date (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-mix *output* tmp 0)))" #f #t)))
+ (with-sound ()
+ (with-mix () "with-mix" 0
+ (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-mix *output* tmp 0))))
+ (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-mix *output* tmp 0)))" old-date #t))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
+ (let ((ind (find-sound "test.snd")))
+ (if (or (fneq (maxamp ind 0) .1)
+ (fneq (maxamp ind 1) .3))
+ (snd-display #__line__ ";with-mix stereo: ~A" (maxamp ind #t)))
+ (if (not (= (mus-sound-chans "with-mix.snd") 2)) (snd-display #__line__ ";with-mix stereo out: ~A" (mus-sound-chans "with-mix.snd"))))
+ (let ((old-date (mus-sound-write-date "with-mix.snd")))
+ (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
+ (if (not (= (mus-sound-write-date "with-mix.snd") old-date))
+ (snd-display #__line__ ";stereo with-mix dates: ~A ~A" old-date (mus-sound-write-date "with-mix.snd"))))
+ (let ((ind (find-sound "test.snd")))
+ (close-sound ind))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
+ (let ((old-date (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" #f #f)))
+ (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
+ (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" old-date #f))
+
+ (with-sound (:srate 44100 :play #f) (bigbird 0 2 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
+ (let ((ind (or (find-sound "test.snd") (open-sound "oboe.snd"))))
+ (let ((mx (maxamp)))
+ (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)))
+ (if (or (fneq mx .5)
+ (ffneq (maxamp) .027))
+ (snd-display #__line__ ";notch 60 Hz: ~A to ~A" mx (maxamp)))
+ (undo)
+ (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
+ (if (ffneq (maxamp) .004)
+ (snd-display #__line__ ";notch-sound 60 hz 2: ~A" (maxamp)))
+ (undo)
+ (notch-channel (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f #f #f ind 0 #f #f 10)
+ (if (ffneq (maxamp) .004)
+ (snd-display #__line__ ";notch-channel 60 hz 2: ~A" (maxamp)))
+ (undo)
+
+ ; (select-all)
+ (make-selection 10000 11000)
+ (notch-selection (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f)
+ ; (if (ffneq (maxamp) .066)
+ ; (snd-display #__line__ ";notch-selection 60 hz 2: ~A" (maxamp)))
+ (play-sound
+ (lambda (data)
+ (let ((len (sound-data-length data)))
+ (run
+ (lambda ()
+ (do ((i 0 (+ 1 i)))
+ ((= i len))
+ (sound-data-set! data 0 i (* 2.0 (sound-data-ref data 0 i)))))))))
+
+ (close-sound ind)))
+
+ (with-sound (:srate 44100 :play #f) (bigbird 0 60 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
+ (let ((ind (find-sound "test.snd")))
+ (let ((mx (maxamp)))
+ (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
+ (if (ffneq (maxamp) .036)
+ (snd-display #__line__ ";notch-sound 60 hz 2 60: ~A" (maxamp))))
+ (close-sound ind))
+
+ (play-sine 440 .1)
+ (play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
+
+ (with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1 :statistics #t)
+ (grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))
+ (grani 0 4 1 "oboe.snd")
+ (if (> (optimization) 4)
+ (begin
+ (grani 0 4 1 "oboe.snd" :grains 10)
+ (grani 0 4 1 "oboe.snd"
+ :grain-start 0.11
+ :amp-envelope '(0 1 1 1) :grain-density 8
+ :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)
+ :grain-envelope-end '(0 0 0.01 1 0.99 1 1 0)
+ :grain-envelope-transition '(0 0 0.4 1 0.8 0 1 0))
+ (grani 0 3 1 "oboe.snd"
+ :grain-start 0.1
+ :amp-envelope '(0 1 1 1) :grain-density 20
+ :grain-duration '(0 0.003 0.2 0.01 1 0.3))
+ (grani 0 3 1 "oboe.snd"
+ :grain-start 0.1
+ :amp-envelope '(0 1 1 1) :grain-density 20
+ :grain-duration '(0 0.003 0.2 0.01 1 0.3)
+ :grain-duration-limit 0.02)
+ (grani 0 2 1 "oboe.snd"
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-start '(0 0.1 0.3 0.1 1 0.6))
+ (grani 0 2 1 "oboe.snd"
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-start '(0 0.1 0.3 0.1 1 0.6)
+ :grain-start-spread 0.01)
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate '(0 0 0.2 0 0.6 5 1 5))
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate-base 2
+ :srate '(0 0 0.2 0 0.6 -1 1 -1))
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate-linear #t
+ :srate (list 0 1 0.2 1 0.6 (expt 2 (/ 5 12)) 1 (expt 2 (/ 5 12))))
+ (grani 0 2 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-duration '(0 0.02 1 0.1)
+ :grain-duration-spread '(0 0 0.5 0.1 1 0)
+ :where-to grani-to-grain-duration
+ :where-bins (vct 0 0.05 1))
+ (grani 0 2 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-degree '(0 0 1 90)
+ :grain-degree-spread 10)
+ )))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (with-sound (:output "test1.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (set-samples 0 2205 "test1.snd" ind 0 #f "set-samples auto-delete test" 0 #f #t)
+ (if (not (file-exists? "test1.snd")) (snd-display #__line__ ";oops: auto-delete test1.snd?"))
+ (undo 1 ind)
+ (with-sound (:output "test2.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (insert-sound "test2.snd" 0 0 ind 0 #f #t)
+ (if (file-exists? "test1.snd") (snd-display #__line__ ";auto-delete set-samples?"))
+ (undo 1 ind)
+ (with-sound (:output "test3.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (insert-samples 0 2205 "test3.snd" ind 0 #f #t)
+ (if (file-exists? "test2.snd") (snd-display #__line__ ";auto-delete insert-sound?"))
+ (undo 1 ind)
+ (with-sound (:output "test4.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (mix "test4.snd" 0 0 ind 0 #f #t)
+ (if (file-exists? "test3.snd") (snd-display #__line__ ";auto-delete insert-samples?"))
+ (undo 1 ind)
+ (delete-sample 100)
+ (if (file-exists? "test4.snd") (snd-display #__line__ ";auto-delete mix?"))
+ (with-sound (:output "test5.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (mix "test5.snd" 0 0 ind 0 #t #t)
+ (revert-sound ind)
+ (close-sound ind)
+ (if (file-exists? "test5.snd") (snd-display #__line__ ";auto-delete mix (with-tag)?")))
+ )
+
+ (let ((o2 (optkey-1 1)))
+ (if (not (equal? o2 1)) (snd-display #__line__ ";optkey-1: ~A" o2)))
+ (let ((o2 (optkey-1 :a 1)))
+ (if (not (equal? o2 1)) (snd-display #__line__ ";optkey-1 1: ~A" o2)))
+ (let ((o2 (optkey-1)))
+ (if (not (equal? o2 #f)) (snd-display #__line__ ";optkey-1 2: ~A" o2)))
+ (let ((o2 (optkey-2 1 2)))
+ (if (not (equal? o2 (list 1 2))) (snd-display #__line__ ";optkey-2: ~A" o2)))
+ (let ((o2 (optkey-2 :a 1 :b 2)))
+ (if (not (equal? o2 (list 1 2))) (snd-display #__line__ ";optkey-2 1: ~A" o2)))
+ (let ((o2 (optkey-2)))
+ (if (not (equal? o2 (list 3 #f))) (snd-display #__line__ ";optkey-2 2: ~A" o2)))
+ (let ((o2 (optkey-2 1 :b 2)))
+ (if (not (equal? o2 (list 1 2))) (snd-display #__line__ ";optkey-2 3: ~A" o2)))
+ (let ((o2 (optkey-3 1 2 3)))
+ (if (not (equal? o2 (list 1 2 3))) (snd-display #__line__ ";optkey-3: ~A" o2)))
+ (let ((o2 (optkey-3 1 :b 2 :c 3)))
+ (if (not (equal? o2 (list 1 2 3))) (snd-display #__line__ ";optkey-3 1: ~A" o2)))
+ (let ((o2 (optkey-3 1 2 :c 3)))
+ (if (not (equal? o2 (list 1 2 3))) (snd-display #__line__ ";optkey-3 2: ~A" o2)))
+ (let ((o2 (optkey-4)))
+ (if (not (equal? o2 (list 1 2 3 #f))) (snd-display #__line__ ";optkey-4: ~A" o2)))
+ (let ((o2 (optkey-4 1 :b 3 :c 4 :d 5)))
+ (if (not (equal? o2 (list 1 3 4 5))) (snd-display #__line__ ";optkey-4 1: ~A 1" o2)))
+ (let ((o2 (optkey-4 1 :d 5 :c 4 :b 3)))
+ (if (not (equal? o2 (list 1 3 4 5))) (snd-display #__line__ ";optkey-4 2: ~A 1" o2)))
+ (let ((o2 (optkey-4 1 3 4 5)))
+ (if (not (equal? o2 (list 1 3 4 5))) (snd-display #__line__ ";optkey-4 3: ~A 2" o2)))
+
+ (if (and (or (provided? 'snd-motif)
+ (provided? 'snd-gtk))
+ (defined? 'variable-display))
+ (let ((wid1 (make-variable-display "do-loop" "i*1" 'text))
+ (wid2 (make-variable-display "do-loop" "i*2" 'scale '(-1.0 1.0)))
+ (wid3 (make-variable-display "do-loop" "i3" 'spectrum))
+ (wid4 (make-variable-display "do-loop" "i4" 'graph)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (variable-display (variable-display (* (variable-display (sin (* (variable-display i wid1) .1)) wid3) .5) wid2) wid4))
+ (let ((tag (catch #t (lambda () (set! (sample 0 (car wid3) 0) .5)) (lambda args (car args)))))
+ (if (> (edit-position (car wid3) 0) 0) (snd-display #__line__ ";edited variable graph? ~A ~A" tag (edit-position (car wid3) 0))))
+ (if (provided? 'snd-motif)
+ (XtUnmanageChild variables-dialog)
+ (gtk_widget_hide variables-dialog))
+ (close-sound (car wid3))
+ (close-sound (car wid4))
+ ))
+
+ (if (not (= *clm-srate* (default-output-srate))) (snd-display #__line__ ";*clm-srate*: ~A ~A" *clm-srate* (default-output-srate)))
+ (if (not (= *clm-channels* (default-output-chans))) (snd-display #__line__ ";*clm-channels*: ~A ~A" *clm-channels* (default-output-chans)))
+ (if (not (= *clm-header-type* (default-output-header-type))) (snd-display #__line__ ";*clm-header-type*: ~A ~A" *clm-header-type* (default-output-header-type)))
+ ; (if (not (= *clm-data-format* (default-output-data-format))) (snd-display #__line__ ";*clm-data-format*: ~A ~A" *clm-data-format* (default-output-data-format)))
+ (if (not (= *clm-reverb-channels* 1)) (snd-display #__line__ ";*clm-reverb-channels*: ~A ~A" *clm-reverb-channels*))
+ (if (not (string=? *clm-file-name* "test.snd")) (snd-display #__line__ ";*clm-file-name*: ~A" *clm-file-name*))
+ (if *clm-play* (snd-display #__line__ ";*clm-play*: ~A" *clm-play*))
+ (if *clm-verbose* (snd-display #__line__ ";*clm-verbose*: ~A" *clm-verbose*))
+ (if *clm-statistics* (snd-display #__line__ ";*clm-statistics*: ~A" *clm-statistics*))
+ (if *clm-reverb* (snd-display #__line__ ";*clm-reverb*: ~A" *clm-reverb*))
+ (if (not (null? *clm-reverb-data*)) (snd-display #__line__ ";*clm-reverb-data*: ~A?" *clm-reverb-data*))
+ (if *clm-delete-reverb* (snd-display #__line__ ";*clm-delete-reverb*: ~A" *clm-delete-reverb*))
+
+ (set! *clm-channels* 2)
+ (set! *clm-srate* 44100)
+ (set! *clm-file-name* "test.wav")
+ (set! *clm-verbose* #t)
+ (set! *clm-statistics* #t)
+ (set! *clm-play* #t)
+ (set! *clm-data-format* mus-mulaw)
+ (set! *clm-header-type* mus-riff)
+ (set! *clm-delete-reverb* #t)
+ (set! *clm-reverb* jc-reverb)
+ (set! *clm-reverb-data* (list #t 2.0 (list 0 1 3.0 1 4.0 0)))
+
+ (with-sound () (fm-violin 0 1 440 .1 :reverb-amount .1))
+
+ (let ((ind (find-sound "test.wav")))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";default output in ws: ~A" (map file-name (sounds)))
+ (begin
+ (if (not (= (srate ind) 44100)) (snd-display #__line__ ";default srate in ws: ~A ~A" (srate ind) *clm-srate*))
+ (if (not (= (channels ind) 2)) (snd-display #__line__ ";default chans in ws: ~A ~A" (channels ind) *clm-channels*))
+ (if (not (= (data-format ind) mus-mulaw)) (snd-display #__line__ ";default format in ws: ~A ~A" (data-format ind) *clm-data-format*))
+ (if (not (= (header-type ind) mus-riff)) (snd-display #__line__ ";default type in ws: ~A ~A" (header-type ind) *clm-header-type*))
+ (if (not (= (frames ind) 88200)) (snd-display #__line__ ";reverb+1 sec out in ws: ~A" (frames ind)))
+ (if (file-exists? "test.rev") (snd-display #__line__ ";perhaps reverb not deleted in ws?"))
+ (close-sound ind))))
+
+ (let ((val 0)
+ (old-hook *clm-notehook*))
+ (set! *clm-notehook* (lambda args (set! val 1)))
+ (with-sound () (fm-violin 0 .1 440 .1))
+ (if (not (= val 1)) (snd-display #__line__ ";*clm-notehook*: ~A ~A" val *clm-notehook*))
+ (with-sound (:notehook (lambda args (set! val 2))) (fm-violin 0 .1 440 .1))
+ (if (not (= val 2)) (snd-display #__line__ ";:notehook: ~A" val))
+ (with-sound () (fm-violin 0 .1 440 .1))
+ (if (not (= val 1)) (snd-display #__line__ ";*clm-notehook* (1): ~A ~A" val *clm-notehook*))
+ (set! *clm-notehook* old-hook))
+
+ (set! *clm-channels* 1)
+ (set! *clm-srate* 22050)
+ (set! *clm-file-name* "test.snd")
+ (set! *clm-verbose* #f)
+ (set! *clm-statistics* #f)
+ (set! *clm-play* #f)
+ (set! *clm-data-format* mus-bshort)
+ (set! *clm-header-type* mus-next)
+ (set! *clm-delete-reverb* #f)
+ (set! *clm-reverb* #f)
+ (set! *clm-reverb-data* '())
+
+ (with-sound (:reverb jl-reverb)
+ (attract 0 1 0.1 2.0)
+ (expfil 0 2 .2 .01 .1 "oboe.snd" "fyow.snd")
+ (fm-violin 0 .1 660 .1 :reverb-amount .1)
+ (anoi "oboe.snd" 1 1)
+ (let* ((ind (open-sound "oboe.snd"))
+ (ind1 (open-sound "now.snd"))
+ (zp (make-zipper (make-env '(0 0 1 1) :length 22050)
+ 0.05
+ (make-env (list 0 (* (mus-srate) 0.05)) :length 22050)))
+ (reader0 (make-sampler 0 ind 0))
+ (reader1 (make-sampler 0 ind1 0)))
+ (run (lambda () (do ((i 0 (+ 1 i))) ((= i 22050)) (outa i (zipper zp reader0 reader1)))))
+ (close-sound ind)
+ (close-sound ind1)))
+
+ (zip-sound 1 1 "fyow.snd" "now.snd" '(0 0 1 1) .05)
+ (zip-sound 2 3 "mb.snd" "fyow.snd" '(0 0 1.0 0 1.5 1.0 3.0 1.0) .025)
+
+ (if all-args
+ (let* ((ind (open-sound "oboe.snd"))
+ (pv (make-pvocoder 256 4 64))
+ (rd (make-sampler 0)))
+ (map-channel (lambda (y) (pvocoder pv rd)))
+ (clm-reverb-sound .1 jc-reverb)
+ (close-sound ind)))
+
+ (let ((old-play *clm-play*))
+ (set! *clm-play* #f)
+ (make-birds)
+ (set! *clm-play* old-play))
+
+ (for-each close-sound (sounds))
+
+ (with-sound ()
+ (simple-ssb 0 .2 440 .1)
+ (simple-osc 0.75 .2 440 .1)
+ (simple-asy 1.25 .2 .1)
+ (simple-saw 1.5 .2 .1)
+ (simple-tri 1.75 .2 .1)
+ (simple-pul 2.0 .2 .1)
+ (simple-sqr 2.25 .2 .1)
+ (if all-args (simple-sib 2.5 .2 440.0 .1))
+ (simple-oz 2.75 .2 440.0 .1)
+ (simple-op 3.0 .2 440.0 .1)
+ (simple-tz 3.25 .2 440.0 .1)
+ (simple-tp 3.5 .2 440.0 .1)
+ (simple-frm 3.75 .2 440.0 .1)
+ (simple-firm 3.875 .2 440.0 .1)
+ (simple-firm2 4.0 .2 440.0 .1)
+ (simple-poly 4.25 .2 440.0 .1)
+ (simple-polyw 4.5 .2 440.0 .1)
+ (simple-dly 4.75 .2 440.0 .1)
+ (simple-cmb 5.0 .2 440.0 .1)
+ (simple-filtered-cmb 5.125 .2 440.0 .1)
+ (simple-not 5.25 .2 440.0 .1)
+ (simple-alp 5.5 .2 440.0 .1)
+ (simple-ave 5.75 .2 440.0 .1)
+ (simple-tab 6.0 .2 440.0 .1)
+ (simple-flt 6.25 .2 440.0 .1)
+ (simple-fir 6.5 .2 440.0 .1)
+ (simple-iir 6.5 .2 440.0 .3)
+ (simple-f 6.75 .2 440.0 .1)
+ (simple-ran 7.0 .2 440.0 .1)
+ (simple-ri 7.25 .2 440.0 .1)
+ (simple-env 7.5 .2 440.0 .1)
+ (simple-amb 7.75 .2 440.0 .1)
+ (simple-fof 8 1 270 .1 .001 730 .6 1090 .3 2440 .1) ;"Ahh"
+ (simple-fof 9 4 270 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
+ (simple-fof 9 4 (* 6/5 540) .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
+ (simple-fof 9 4 135 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0))
+
+ (simple-src-f 13 .45 1.0 2.0 "oboe.snd")
+ (simple-rd 13.5 .45 .75 "oboe.snd")
+ (simple-rd-start 13.65 .25 .75 "oboe.snd" 0 0)
+ (simple-rd-start 13.8 .25 .75 "oboe.snd" 0 12345)
+ (simple-rd-start 13.9 .25 .75 "oboe.snd" 0 12345678)
+ (simple-cnv 14.0 .45 .75 "oboe.snd")
+ (simple-cnf 14.5 .45 .75 "oboe.snd")
+ (simple-lrg 15.0 .45 .75 "oboe.snd")
+ (simple-cn2 15.5 .45 .4 "oboe.snd")
+ (simple-src 16 .45 1.0 2.0 "oboe.snd")
+ (simple-sr2 16.5 .45 1.0 2.0 "oboe.snd")
+ (simple-sr2a 16.75 .45 1.0 2.0 "oboe.snd")
+ (simple-rndist 17.0 .2 440.0 .1)
+ (simple-ridist 17.25 .2 440.0 .1)
+ (simple-sro 17.5 .45 .1 .5 440)
+ (simple-grn 18 .2 .1 1.0 440)
+ (simple-pvoc 18.25 .2 .4 256 "oboe.snd")
+ (simple-ina 18.5 .45 1 "oboe.snd")
+ (simple-rdf 19 .45 1 "oboe.snd")
+ (simple-f2s 19.5 .45 1 "oboe.snd")
+ (simple-loc 20 .2 440 .1)
+ (simple-dloc 20.1 .2 440 .1)
+ (simple-out 20.25 .2 440 .1)
+ (simple-fm 20 1 440 .1 2 1.0)
+ (simple-dup 20.5 .2 440 .1)
+ (simple-du1 20.75 .2 440 .1)
+ (simple-grn-f1 21 .45 .1 2 440)
+ (simple-grn-f2 21.5 .45 1 2 "oboe.snd")
+ (simple-grn-f3 22 .45 1 2 "oboe.snd")
+ (simple-grn-f4 22.5 .45 1 2 "oboe.snd")
+ (simple-grn-f5 23 .45 1 2 "oboe.snd")
+ (simple-multiarr 23.5 .5 440 .1))
+
+
+ (with-sound (:channels 4) (simple-dloc-4 0 2 440 .5))
+
+ (with-sound ()
+ (or1) (or2) (or3) (or4)
+ (sample-desc 0 .2 440 .1)
+ (sample-mdat .25 .2 440 .1)
+ (sample-xtab .5 .2 440 .1)
+ (sample-xts .75 .2 440 .1)
+ (sample-srl2 1 .2 .2 .5 (* 440 2))
+ (sample-srll 1.25 .2 .1 .5 (* 440 4))
+ (sample-srl3 1.5 .2 .1 .5 880)
+ (sample-grn2 1.75 .2 .1 .5 880)
+ (sample-grn3 2 .45 1 1 "oboe.snd")
+
+ (sample-cnv 2.5 .45 1 1 "oboe.snd")
+ (sample-cnv1 3.0 .45 1 1 "oboe.snd")
+ (sample-pvoc1 3.5 .45 1 512 "oboe.snd")
+ (sample-pvoc2 4.0 .45 1 512 "oboe.snd")
+ (sample-pvoc3 4.5 .001 1 512 "oboe.snd")
+ (sample-mxf 5 .2 440 .1)
+ (sample-osc 5.25 .2 440 .1)
+ (if all-args (sample-ardcl 5.5 .2 440 .1))
+ (sample-strs 5.75 .2 440 .1)
+ (sample-flt 6 .2 440 .1)
+ (sample-arrintp 6.25 .2 440 .1)
+ (sample-if 6.5 .2 440 .1)
+ (sample-arrfile 6.75 .2 440 .15)
+ (sample-pvoc5 7.25 .2 .1 256 "oboe.snd" 440.0)
+ )
+
+ (if all-args
+ (let* ((outfile (with-sound () (pvoc-a 0 2.3 1 256 "oboe.snd") (pvoc-e 0 2.3 -1 256 "oboe.snd")))
+ (mx (mus-sound-maxamp outfile)))
+ (if (fneq (cadr mx) 0.0)
+ (snd-display #__line__ ";pvoc a-e: ~A" mx))))
+
+ (let* ((file (with-sound (:clipped #f :data-format mus-bfloat :header-type mus-next)
+ (fm-violin 0 .1 440 pi)))
+ (ind (find-sound file))
+ (mx (maxamp ind)))
+ (if (fneq mx pi) (snd-display #__line__ ";clipped #f: ~A" mx))
+ (close-sound ind)
+ (set! file (with-sound (:clipped #t :data-format mus-bfloat :header-type mus-next)
+ (fm-violin 0 .1 440 pi)))
+ (set! ind (find-sound file))
+ (set! mx (maxamp ind))
+ (if (fneq mx 1.0) (snd-display #__line__ ";clipped #t: ~A" mx))
+
+ (close-sound ind)
+ (set! file (with-sound (:data-format mus-bfloat :header-type mus-next :scaled-by .1 :clipped #f)
+ (fm-violin 0 .1 440 pi)))
+ (set! ind (find-sound file))
+ (set! mx (maxamp ind))
+ (if (fneq mx .314159) (snd-display #__line__ ";scaled-by ~A" mx))
+
+ (close-sound ind)
+ (set! file (with-sound (:data-format mus-bfloat :header-type mus-next :scaled-to .1 :clipped #f)
+ (fm-violin 0 .1 440 pi)))
+ (set! ind (find-sound file))
+ (set! mx (maxamp ind))
+ (if (fneq mx .1) (snd-display #__line__ ";scaled-to ~A" mx))
+
+ (close-sound ind)
+ (let ((old-bufsize *clm-file-buffer-size*)
+ (old-tsize *clm-table-size*)
+ (old-arrp *clm-array-print-length*))
+ (set! *clm-file-buffer-size* (* 1024 1024))
+ (set! *clm-table-size* 256)
+ (set! *clm-array-print-length* 123)
+ (let ((tsize 0)
+ (arrp 0))
+ (set! file (with-sound (:data-format mus-bfloat :header-type mus-next)
+ (set! mx (mus-file-buffer-size))
+ (set! tsize (clm-table-size))
+ (set! arrp (mus-array-print-length))
+ (fm-violin 0 .1 440 .1)))
+ (set! ind (find-sound file))
+ (if (not (= mx (* 1024 1024))) (snd-display #__line__ ";*clm-file-buffer-size*: ~A" mx))
+ (if (not (= tsize 256)) (snd-display #__line__ ";*clm-table-size*: ~A" tsize))
+ (if (not (= arrp 123)) (snd-display #__line__ ";*clm-array-print-length*: ~A" arrp))
+ (set! *clm-file-buffer-size* old-bufsize)
+ (set! *clm-table-size* old-tsize)
+ (set! *clm-array-print-length* old-arrp)
+ (close-sound ind)))
+
+ (set! file (with-sound () (fm-violin 0 3.0 440 .1)))
+ (set! ind (find-sound file))
+ (set! (amp-control ind) .5)
+ (set! (x-bounds ind 0) (list 1.0 2.0))
+ (set! file (with-sound () (fm-violin 0 4.0 440 .1)))
+ (set! ind (find-sound file))
+ (if (fneq (amp-control ind) .5) (snd-display #__line__ ";update ws amp: ~A" (amp-control ind)))
+ (if (or (fneq (car (x-bounds ind 0)) 1.0)
+ (fneq (cadr (x-bounds ind 0)) 2.0))
+ (snd-display #__line__ ";update ws bounds: ~A" (x-bounds ind)))
+
+ (if (not (= (->sample 1.0) (srate))) (snd-display #__line__ ";1.0->sample: ~A" (->sample 1.0)))
+ (close-sound ind)
+
+ (set! file (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .1)))
+ (set! ind (find-sound file))
+ (set! mx (maxamp ind))
+ (set! file (with-sound (:reverb jc-reverb :reverb-data '(#f 12.0 (0 0 1 1 20 1 21 0))) (fm-violin 0 .1 440 .1 :reverb-amount .1)))
+ (set! ind (find-sound file))
+ (if (not (> (maxamp ind) mx)) (snd-display #__line__ ";reverb-data: ~A ~A" mx (maxamp ind)))
+ (close-sound ind))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (step-src)
+ (if (> (abs (- (frames) 24602)) 100) (snd-display #__line__ ";step-src frames: ~A (~A)" (frames) (edits)))
+ (close-sound ind))
+
+ (let ((file (with-sound (:channels 3)
+ (let ((rg (make-rmsgain))
+ (rg1 (make-rmsgain 40))
+ (rg2 (make-rmsgain 2))
+ (e (make-env '(0 0 1 1 2 0) :length 10000))
+ (e1 (make-env '(0 0 1 1) :length 10000))
+ (e2 (make-env '(0 0 1 1 2 0 10 0) :length 10000))
+ (o (make-oscil 440.0)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (let ((sig (env e)))
+ (outa i (balance rg sig (env e2)))
+ (outb i (balance rg1 sig (env e1)))
+ (outc i (balance rg2 (* .1 (oscil o)) (env e2)))))
+ (if (fneq (gain-avg rg) 0.98402) (snd-display #__line__ ";rmsgain gain-avg: ~A" (gain-avg rg)))
+ (if (not (= (rmsg-avgc rg2) 10000)) (snd-display #__line__ ";rmsgain count: ~A" (rmsg-avgc rg2)))))))
+ (let ((ind (find-sound file)))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";with-sound balance?")
+ (close-sound ind))))
+
+ (let* ((mg (make-oscil 100.0))
+ (gen (make-ssb-fm 1000))
+ (ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1)))
+ (pad-channel 0 1000 ind 0)
+ (catch #t (lambda () (map-channel (lambda (y) (ssb-fm gen (* .02 (oscil mg)))))) (lambda arg (display arg) arg))
+ (close-sound ind))
+
+ (let ((file (with-sound ()
+ (let ((rd (make-sampler 0 "oboe.snd"))
+ (m (make-mfilter :decay .99 :frequency 1000))
+ (e (make-env '(0 100 1 2000) :length 10000)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (mfilter-1 m (* .1 (rd)) 0.0))
+ (set! (mflt-eps m) (* 2.0 (sin (/ (* pi (env e)) (mus-srate)))))))))))
+ (let ((ind (find-sound file)))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";with-sound mfilter?")
+ (close-sound ind))))
+
+ (let ((m1 (make-mfilter .9 1000.0))
+ (m2 (make-firmant 1000.0 .9))
+ (gain (- 1.0 (* .9 .9))))
+ (firmant m2 1.0)
+ (mfilter-1 m1 1.0 0.0)
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (let ((v1 (* gain (mfilter-1 m1 0.0 0.0)))
+ (v2 (firmant m2 0.0)))
+ (if (fneq v1 v2)
+ (snd-display #__line__ ";~D mfilter/firmant: ~A ~A" i v1 v2)))))
+
+ (let ((m1 (make-mfilter .9 1000.0))
+ (m2 (make-firmant 1000.0 .9))
+ (gain (- 1.0 (* .9 .9))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 10))
+ (let* ((y (- (random 2.0 )1.0))
+ (v1 (* gain (mfilter-1 m1 y 0.0)))
+ (v2 (firmant m2 y)))
+ (if (fneq v1 v2)
+ (snd-display #__line__ ";rand case mfilter/firmant: ~A ~A" i v1 v2)))))
+
+
+ ;; dlocsig tests
+ (if (not (provided? 'snd-dlocsig.scm))
+ (catch #t
+ (lambda () (load "dlocsig.scm"))
+ (lambda args (snd-display #__line__ ";load dlocsig: ~A" args))))
+ (if (not (defined? 'make-spiral-path))
+ (snd-display #__line__ ";make-spiral-path is not defined, dlocsig is ~Aloaded"
+ (if (provided? 'snd-dlocsig.scm) "" "not "))
(begin
- (set! (optimization) max-optimization)
- (dismiss-all-dialogs)
+ (let ((file (new-sound "tmp.snd" mus-next mus-bfloat 22050 4)))
+ (mix-move-sound 0 "oboe.snd" (make-spiral-path :turns 3))
+ (close-sound file))
- (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
- (log-mem clmtest)
-
- (set! (mus-srate) 22050)
- (set! (default-output-srate) 22050)
+ (let ((ind 0))
+ (with-sound (:channels 2) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
+ (set! ind (find-sound "test.snd"))
- ;; check clm output for bad zero case
- (for-each
- (lambda (type)
- (let ((ind (find-sound
- (with-sound (:data-format type)
- (fm-violin 0 .1 440 .1)
- (fm-violin 10 .1 440 .1)
- (fm-violin 100 .1 440 .1)
- (fm-violin 1000 .1 440 .1)))))
- (let ((mx (maxamp ind)))
- (if (ffneq mx .1) ; mus-byte -> 0.093
- (snd-display ";max: ~A, format: ~A" mx (mus-data-format->string type))))))
- (list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
- mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
- mus-ubshort mus-ulshort mus-ubyte mus-bfloat mus-bdouble
- mus-ldouble))
-
- (let ((old-opt (optimization)))
- (do ((opt 0 (+ 1 opt)))
- ((> opt max-optimization))
- (set! (optimization) opt)
- (with-sound (:srate 22050) (fm-violin 0 .1 (* 110 (+ 1 opt)) .1))
- (let ((ind (find-sound "test.snd")))
- (if (not ind) (snd-display ";with-sound: ~A" (map file-name (sounds))))
- (let ((mx (maxamp)))
- (if (fneq mx .1) (snd-display ";with-sound max: ~A" (maxamp)))
- (if (not (= (srate ind) 22050)) (snd-display ";with-sound srate: ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test.snd")))
- (if (not (= (frames ind) 2205)) (snd-display ";with-sound frames: ~A" (frames ind))))
- (play-and-wait 0 ind)))
- (set! (optimization) old-opt))
-
- (with-sound (:continue-old-file #t) (fm-violin .2 .1 440 .25))
- (let ((ind (find-sound "test.snd")))
- (if (not ind) (snd-display ";with-sound continued: ~A" (map file-name (sounds))))
- (if (not (= (length (sounds)) 1)) (snd-display ";with-sound continued: ~{~A ~}" (map short-file-name (sounds))))
- (let ((mx (maxamp)))
- (if (fneq mx .25) (snd-display ";with-sound continued max: ~A" (maxamp)))
- (if (not (= (srate ind) 22050)) (snd-display ";with-sound continued srate: ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test.snd")))
- (if (not (= (frames ind) (* 3 2205))) (snd-display ";with-sound continued frames: ~A (~A)" (frames ind) (srate ind))))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .010 .011 .012 .013 .014 .015 .017 .018
+ .020 .023 .025 .029 .033 .039 .046 .055 .068 .088 .122
+ .182 .301 .486 .477 .402 .160 .000 .000 .000 .000 .000
+ .000 .000 .000 .001 .001 .002 .002 .002 .002 .002 .003
+ .003 .003 .003 .003 .003)
+ ind 0 "dlocsig 0 0")
- (with-sound () (fm-violin 0 .1 440 .1))
- (with-sound (:continue-old-file #t) (fm-violin .2 .1 660 .04))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp ind 0) .1) (snd-display ";maxamp after continued sound: ~A" (maxamp ind 0)))
- (if (fneq (/ (frames ind) (srate ind)) .3) (snd-display ";duration after continued sound: ~A" (/ (frames ind) (srate ind))))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .003 .003 .003 .003 .003 .003 .003 .003
+ .003 .003 .003 .003 .003 .003 .003 .003 .002 .002 .002
+ .007 .036 .168 .386 .487 .497 .000 .000 .000 .000 .000
+ .000 .000 .015 .033 .031 .027 .024 .021 .019 .018 .016
+ .015 .014 .013 .012 .011)
+ ind 1 "dlocsig 0 1")
- (with-sound (:srate 22050 :channels 2 :output "test1.snd") (fm-violin 0 .1 440 .1 :degree 45.0))
- (let ((ind (find-sound "test1.snd")))
- (if (not ind) (snd-display ";with-sound (1): ~A" (map file-name (sounds))))
- (let ((mx (maxamp)))
- (if (fneq mx .05) (snd-display ";with-sound max (1): ~A" (maxamp)))
- (if (or (not (= (srate ind) 22050))
- (not (= (mus-sound-srate "test1.snd") 22050)))
- (snd-display ";with-sound srate (1): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (frames ind) 2205)) (snd-display ";with-sound frames (1): ~A" (frames ind)))
- (if (or (not (= (chans ind) 2))
- (not (= (mus-sound-chans "test1.snd") 2)))
- (snd-display ";with-sound chans (1): ~A" (chans ind))))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (with-sound (:srate 48000 :channels 2 :header-type mus-riff :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test1.snd")))
- (if (or (not (= (srate ind) 48000))
- (not (= (mus-sound-srate "test1.snd") 48000)))
- (snd-display ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (header-type ind) mus-riff)) (snd-display ";with-sound type (~A, r): ~A" mus-riff (header-type ind)))
- (if (not (= (chans ind) 2)) (snd-display ";with-sound chans (2, r): ~A" (chans ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (with-sound (:srate 48000 :channels 2 :header-type mus-rf64 :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test1.snd")))
- (if (or (not (= (srate ind) 48000))
- (not (= (mus-sound-srate "test1.snd") 48000)))
- (snd-display ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (header-type ind) mus-rf64)) (snd-display ";with-sound type (~A, r): ~A" mus-rf64 (header-type ind)))
- (if (not (= (chans ind) 2)) (snd-display ";with-sound chans (2, r): ~A" (chans ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (with-sound (:srate 48000 :channels 2 :header-type mus-caff :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test1.snd")))
- (if (or (not (= (srate ind) 48000))
- (not (= (mus-sound-srate "test1.snd") 48000)))
- (snd-display ";with-sound mus-caff srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (header-type ind) mus-caff)) (snd-display ";with-sound type (~A, r): ~A" mus-caff (header-type ind)))
- (if (not (= (chans ind) 2)) (snd-display ";with-sound mus-caff chans (2, r): ~A" (chans ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (with-sound (:srate 8000 :channels 3 :header-type mus-next :output "test1.snd") (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test1.snd")))
- (if (not (= (srate ind) 8000)) (snd-display ";with-sound srate (8000, s): ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (header-type ind) mus-next)) (snd-display ";with-sound type (~A, s): ~A" mus-next (header-type ind)))
- (if (not (= (chans ind) 3)) (snd-display ";with-sound chans (3, s): ~A" (chans ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (with-sound (:srate 96000 :channels 4 :header-type mus-aifc :output "test1.snd") (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test1.snd")))
- (if (not (= (srate ind) 96000)) (snd-display ";with-sound srate (96000, t): ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (header-type ind) mus-aifc)) (snd-display ";with-sound type (~A, t): ~A" mus-aifc (header-type ind)))
- (if (not (= (chans ind) 4)) (snd-display ";with-sound chans (4, t): ~A" (chans ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (with-sound (:srate 22050 :channels 1 :header-type mus-raw :output "test1.snd") (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test1.snd")))
- (if (not (= (srate ind) 22050)) (snd-display ";with-sound srate (22050, u): ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (header-type ind) mus-raw)) (snd-display ";with-sound type (~A, u): ~A" mus-raw (header-type ind)))
- (if (not (= (chans ind) 1)) (snd-display ";with-sound chans (1, u): ~A" (chans ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (with-sound (:srate 22050 :channels 2 :output "test1.snd" :reverb jc-reverb)
- (if (not (= (mus-sound-srate (mus-file-name *output*)) 22050))
- (snd-display ";srate file *output*: ~A" (mus-sound-srate (mus-file-name *output*))))
- (if (not (= (mus-sound-srate (mus-file-name *reverb*)) 22050))
- (snd-display ";srate file *reverb*: ~A" (mus-sound-srate (mus-file-name *reverb*))))
- (fm-violin 0 .1 440 .1 :degree 45.0))
- (let ((ind (find-sound "test1.snd")))
- (if (not ind) (snd-display ";with-sound (2): ~A" (map file-name (sounds))))
- (if (not (= (frames ind) (+ 22050 2205))) (snd-display ";with-sound reverbed frames (2): ~A" (frames ind)))
- (close-sound ind))
+ (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
+ (set! ind (find-sound "test.snd"))
- (let ((old-opt (optimization)))
- (do ((opt 0 (+ 1 opt)))
- ((> opt max-optimization))
- (set! (optimization) opt)
- (with-sound (:srate 22050 :output "test1.snd" :reverb jc-reverb) (fm-violin 0 .1 440 .1))
- (set! (optimization) old-opt)))
+ (check-segments (vector .000 .000 .000 .011 .011 .012 .013 .014 .015 .017 .018
+ .020 .023 .025 .029 .033 .038 .045 .054 .066 .086 .118
+ .178 .300 .499 .497 .399 .079 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000)
+ ind 0 "dlocsig 1 0")
- (let ((ind (find-sound "test1.snd")))
- (if (not ind) (snd-display ";with-sound (3): ~A" (map file-name (sounds))))
- (if (not (= (frames ind) (+ 22050 2205))) (snd-display ";with-sound reverbed frames (3): ~A" (frames ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .052 .376 .499 .496 .339 .184 .122 .087 .068
+ .055 .046 .039 .034 .030 .026 .023 .021 .019 .018 .016
+ .015 .014 .013 .012 .011)
+ ind 1 "dlocsig 1 1")
- (with-sound (:srate 22050 :comment "Snd+Run!" :scaled-to .5) (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test.snd")))
- (if (not ind) (snd-display ";with-sound: ~A" (map file-name (sounds))))
- (let ((mx (maxamp)))
- (if (fneq mx .5) (snd-display ";with-sound scaled-to: ~A" (maxamp)))
- (if (not (string=? (comment ind) "Snd+Run!")) (snd-display ";with-sound comment: ~A (~A)" (comment ind) (mus-sound-comment "test.snd"))))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .036 .160 .166 .122 .111 .078 .054 .037 .027
+ .020 .015 .012 .009 .007 .006 .005 .004 .003 .002 .002
+ .001 .001 .001 .001 .000)
+ ind 2 "dlocsig 1 2")
- (with-sound (:srate 22050 :scaled-by .5 :header-type mus-aifc :data-format mus-bfloat) (fm-violin 0 .1 440 .1))
- (let ((ind (find-sound "test.snd")))
- (if (not ind) (snd-display ";with-sound: ~A" (map file-name (sounds))))
- (let ((mx (maxamp)))
- (if (fneq mx .05) (snd-display ";with-sound scaled-by: ~A" (maxamp)))
- (if (not (= (header-type ind) mus-aifc)) (snd-display ";with-sound type: ~A (~A)" (header-type ind) (mus-header-type-name (header-type ind))))
- (if (not (= (data-format ind) mus-bfloat)) (snd-display ";with-sound format: ~A (~A)" (data-format ind) (mus-data-format-name (data-format ind)))))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .001 .001 .001 .001 .002 .002
+ .002 .003 .004 .005 .006 .007 .009 .012 .016 .022 .030
+ .041 .048 .045 .160 .166 .079 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 1 3")
- (add-hook! open-raw-sound-hook (lambda (file choice) (list 1 22050 mus-bshort)))
- (with-sound (:header-type mus-raw) (fm-violin 0 1 440 .1))
- (reset-hook! open-raw-sound-hook)
- (let ((ind (find-sound "test.snd")))
- (if (not ind) (snd-display ";with-sound (raw out): ~A" (map file-name (sounds))))
- (if (not (= (header-type ind) mus-raw))
- (snd-display ";with-sound type raw: ~A (~A)" (header-type ind) (mus-header-type-name (header-type ind))))
- (if (and (not (= (data-format ind) mus-bshort))
- (not (= (data-format ind) mus-bfloat))
- (not (= (data-format ind) mus-lfloat)))
- (snd-display ";with-sound format raw: ~A (~A)" (data-format ind) (mus-data-format-name (data-format ind))))
- (close-sound ind))
- (with-sound (:srate 44100 :statistics #t) (ws-sine 1000))
- (let ((ind (find-sound "test.snd")))
- (let ((i -1))
- (scan-channel (lambda (y)
- (set! i (+ 1 i))
- (if (fneq y (sin (* 2 pi i (/ 1000.0 44100.0))))
- (begin
- (display (format #f "~%;with-sound sine: ~D ~A ~A" i y (sin (* 2 pi i (/ 1000.0 44100.0)))))
- #t)
- #f))))
- (close-sound ind))
+ (with-sound (:channels 8) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
+ (set! ind (find-sound "test.snd"))
- (set! *opt* #t)
- (with-sound ()
- (run
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (let ((gen (make-oscil 440.0))
- (e (make-env (vct 0.0 0.0 1.0 1.0 2.0 0.0) 0.1 1.0)))
- (do ((k 0 (+ k 1)))
- ((= k 44100))
- (outa (+ k (* i 50000)) (* (env e) (oscil gen))))))))
- (if (not *opt*)
- (snd-display ";with-sound make-oscil in run loop optimization failed?"))
- (let ((ind (find-sound "test.snd")))
- (if (not (= (frames ind) 144100))
- (snd-display ";with-sound make-oscil in run frames: ~A" (frames)))
- (if (fneq (maxamp ind) .1)
- (snd-display ";with-sound make-oscil in run maxamp: ~A" (maxamp ind)))
- (close-sound ind))
-
+ (check-segments (vector .000 .000 .000 .007 .007 .008 .008 .008 .009 .009
+ .010 .010 .011 .011 .012 .012 .013 .014 .015 .017
+ .021 .028 .050 .128 .382 .495 .389 .078 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 0 "dlocsig 2 0")
- (if (file-exists? "ii.scm")
- (begin
- (time (load "ii.scm"))
- (for-each close-sound (sounds))
- (delete-file "test.snd")
- (delete-file "test.rev")))
-
- (let ((var (make-st1 :one 1 :two 2)))
- (if (not (= (st1-one var) 1)) (snd-display ";st1-one: ~A" (st1-one var)))
- (if (not (= (st1-two var) 2)) (snd-display ";st1-two: ~A" (st1-two var)))
- (if (not (st1? var)) (snd-display ";st1? ~A (~A)" (st1? var) var))
- (set! (st1-one var) 321)
- (set! (st1-two var) "hiho")
- (if (not (= (st1-one var) 321)) (snd-display ";st1-one (321): ~A" (st1-one var)))
- (if (not (string=? (st1-two var) "hiho")) (snd-display ";st1-two (hiho): ~A" (st1-two var)))
- (set! var (make-st1))
- (if (fneq (st1-one var) 0.0) (snd-display ";st1-one #f: ~A" (st1-one var)))
- (if (fneq (st1-two var) 0.0) (snd-display ";st1-two #f: ~A" (st1-two var)))
- (set! var (make-st1 :two 3))
- (if (fneq (st1-one var) 0.0) (snd-display ";st1-one #f (def): ~A" (st1-one var)))
- (if (not (= (st1-two var) 3)) (snd-display ";st1-two (3): ~A" (st1-two var))))
-
- (let ((var (make-st2 :one 1 :two 2)))
- (if (not (= (st2-one var) 1)) (snd-display ";st2-one: ~A" (st2-one var)))
- (if (not (= (st2-two var) 2)) (snd-display ";st2-two: ~A" (st2-two var)))
- (if (not (st2? var)) (snd-display ";st2? ~A (~A)" (st1? var) var))
- (if (st1? var) (snd-display ";st1? (not ~A): ~A" (st1? var) var))
- (set! (st2-one var) 321)
- (set! (st2-two var) "hiho")
- (if (not (= (st2-one var) 321)) (snd-display ";st2-one (321): ~A" (st2-one var)))
- (if (not (string=? (st2-two var) "hiho")) (snd-display ";st2-two (hiho): ~A" (st2-two var)))
- (set! var (make-st2))
- (if (not (= (st2-one var) 11)) (snd-display ";st2-one 11: ~A" (st2-one var)))
- (if (not (= (st2-two var) 22)) (snd-display ";st2-two 22: ~A" (st2-two var)))
- (set! var (make-st2 :two 3))
- (if (not (= (st2-one var) 11)) (snd-display ";st2-one 11 (def): ~A" (st2-one var)))
- (if (not (= (st2-two var) 3)) (snd-display ";st2-two (3): ~A" (st2-two var))))
-
- (let ((gad (make-grab-bag)))
- (if (not (= (grab-bag-i gad) 0))
- (snd-display ";grab-bag-i: ~A" (grab-bag-i gad)))
- (set! (grab-bag-flt gad) 123.0)
- (set! (grab-bag-v gad) (vct .1 .2 .3))
- (set! (grab-bag-fvect gad) (vector .1 .2 .3))
- (set! (grab-bag-ivect gad) (make-vector 3 1))
- (set! (grab-bag-cvect gad) (make-vector 3 #f))
- (do ((i 0 (+ 1 i)))
- ((= i 3))
- (vector-set! (grab-bag-cvect gad) i (make-oscil 440.0)))
- (set! (grab-bag-gen gad) (make-oscil 440.0))
- (let ((val 0.0))
- (run
- (lambda ()
- (set! val (grab-bag-flt gad))))
- (if (fneq val 123.0) (snd-display ";def-clm-struct flt: ~A ~A" val (grab-bag-flt gad))))
- (if (fneq (grab-bag-flt1 gad) 1.0) (snd-display ";def-clm-struct flt1: ~A" (grab-bag-flt1 gad)))
- (if (not (= (grab-bag-i gad) 0)) (snd-display ";def-clm-struct i: ~A" (grab-bag-i gad)))
- (if (not (= (grab-bag-i1 gad) 123)) (snd-display ";def-clm-struct i1: ~A" (grab-bag-i1 gad))))
-
- (if (file-exists? "test.snd") (delete-file "test.snd"))
- (set! (mus-srate) 22050)
- (set! *clm-srate* 22050)
- (set! (default-output-srate) 22050)
- (let ((outer (with-sound ()
- (sound-let ((a () (fm-violin 0 .1 440 .1)))
- (mus-mix *output* a)))))
- (if (not (string=? outer "test.snd"))
- (snd-display ";with-sound returns: ~A" outer))
- (let ((ind (find-sound outer)))
- (if (or (not (sound? ind))
- (not (= (frames ind) (inexact->exact (floor (* (mus-srate) .1))))))
- (snd-display ";sound-let: ~A ~A" (frames ind) (inexact->exact (floor (* (mus-srate) .1)))))
- (close-sound ind)))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .036 .356 .497 .322 .042 .000
+ .000 .001 .003 .005 .006 .007 .007 .008 .008 .008
+ .008 .008 .008 .008 .008 .008 .007 .007 .007)
+ ind 1 "dlocsig 2 1")
- (if (file-exists? "test.snd") (delete-file "test.snd"))
- (let ((outer (with-sound ()
- (sound-let ((a () (fm-violin 0 .1 440 .1))
- (b 100))
- (mus-mix *output* a b)
- (sound-let ((c (:channels 1 :output "temp.snd") (fm-violin 0 .1 110.0 .1)))
- (mus-mix *output* c))))))
- (if (not (string=? outer "test.snd"))
- (snd-display ";with-sound (2) returns: ~A" outer))
- (let ((ind (find-sound outer)))
- (if (or (not (sound? ind))
- (not (= (frames ind) (+ 100 (inexact->exact (floor (* (mus-srate) .1)))))))
- (snd-display ";sound-let (2): ~A ~A" (frames ind) (+ 100 (floor (inexact->exact (* (mus-srate) .1))))))
- (if (file-exists? "temp.snd")
- (snd-display ";sound-let explicit output exists?"))
- (close-sound ind)))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .036 .163 .397 .480 .353 .197
+ .133 .095 .073 .058 .048 .040 .034 .030 .026 .023
+ .020 .018 .016 .014 .013 .011 .010 .009 .009)
+ ind 2 "dlocsig 2 2")
- (let ((w (init-with-sound)))
- (fm-violin 0 1 440 .1)
- (let ((outer (finish-with-sound w)))
- (if (not (string=? outer "test.snd"))
- (snd-display ";finish-with-sound returns: ~A" outer))
- (let ((ind (find-sound outer)))
- (if (not (sound? ind))
- (snd-display ";init-with-sound: ~A" (map short-file-name (sounds)))
- (begin
- (if (fneq (maxamp ind 0) .1)
- (snd-display ";init-with-sound max: ~A" (maxamp ind 0)))
- (close-sound ind))))))
-
- (let ((w (init-with-sound :output "test.aiff" :header-type mus-aifc :scaled-to .5)))
- (fm-violin 0 1 440 .1)
- (let ((outer (finish-with-sound w)))
- (if (not (string=? outer "test.aiff"))
- (snd-display ";finish-with-sound (2) returns: ~A ~A" outer w))
- (let ((ind (find-sound outer)))
- (if (not (sound? ind))
- (snd-display ";init-with-sound (2): ~A" (map short-file-name (sounds)))
- (begin
- (if (fneq (maxamp ind 0) .5)
- (snd-display ";init-with-sound scaled-to: ~A ~A" (maxamp ind 0) w))
- (if (not (= (header-type ind) mus-aifc))
- (snd-display ";init-with-sound type: ~A ~A" (header-type ind) w))
- (close-sound ind))))))
-
- (with-sound (:output "test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
- (let ((ind (find-sound "test1.snd")))
- (if (not ind) (snd-display ";with-sound (freeverb): ~A" (map file-name (sounds))))
- (if (not (> (maxamp ind) .1)) (snd-display ";freeverb 3.0: ~A" (maxamp ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .036 .163 .169 .078 .003 .005
+ .004 .001 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 2 3")
- (with-sound (:output "test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0 :global 0.5)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
- (let ((ind (find-sound "test1.snd")))
- (if (not ind) (snd-display ";with-sound (freeverb): ~A" (map file-name (sounds))))
- (if (not (> (maxamp ind) .16)) (snd-display ";freeverb 3.0 global 0.5: ~A" (maxamp ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
- (set! (mus-srate) 22050)
- (set! (default-output-srate) 22050)
-
- (let ((fmt1 '(0 1200 100 1000))
- (fmt2 '(0 2250 100 1800))
- (fmt3 '(0 4500 100 4500))
- (fmt4 '(0 6750 100 8100))
- (amp1 '(0 .67 100 .7))
- (amp2 '(0 .95 100 .95))
- (amp3 '(0 .28 100 .33))
- (amp4 '(0 .14 100 .15))
- (ind1 '(0 .75 100 .65))
- (ind2 '(0 .75 100 .75))
- (ind3 '(0 1 100 1))
- (ind4 '(0 1 100 1))
- (skwf '(0 0 100 0))
- (ampf '(0 0 25 1 75 1 100 0))
- (ranf '(0 .5 100 .5))
- (index '(0 1 100 1))
- (zero_fun '(0 0 100 0))
- (atskew '(0 -1 15 .3 22 -.1 25 0 75 0 100 -.2))
- (vibfun '(0 0 .3 .3 15 .6 25 1 100 1))
- (slopefun '(0 1 75 1 100 0))
- (trap '(0 0 25 1 75 1 100 0))
- (ramp '(0 0 25 0 75 1 100 1))
- (solid '(0 0 5 1 95 1 100 0))
- (sfz '(0 0 25 1 30 .6 50 .5 75 .2 100 0))
- (mound '(0 0 10 .4 25 .8 40 1 60 1 75 .8 90 .4 100 0))
- (vio '(0 0 7 .2 25 .5 40 .6 60 .6 75 .5 90 .2 100 0))
- (bassdr2 '(.5 .06 1 .62 1.5 .07 2.0 .6 2.5 .08 3.0 .56 4.0 .24
- 5 .98 6 .53 7 .16 8 .33 9 .62 10 .12 12 .14 14 .86
- 16 .12 23 .14 24 .17))
- (bassdrstr '(.5 .06 1.0 .63 1.5 .07 2.01 .6 2.5 .08 3.02 .56
- 4.04 .24 5.05 .98 6.06 .53 7.07 .16 8.08 .33 9.09 .62
- 10.1 .12 12.12 .14 13.13 .37 14.14 .86 16.16 .12 23.23 .14 24.24 .17))
- (tenordr '(.3 .04 1 .81 2 .27 3 .2 4 .21 5 .18 6 .35 7 .03 8 .07 9 .02 10 .025 11 .035))
- (tenordrstr '(.3 .04 1.03 .81 2.03 .27 3.03 .20 4.03 .21 5.03 .18
- 6.03 .35 7.03 .03 8.03 .07 9.03 .02 10.03 .03 11.03 .04)))
- (with-sound (:reverb nrev)
- (drone .000 4.000 115.000 (* .25 .500) solid bassdr2 .100 .500
- .030 45.000 1 .010 10)
- (drone .000 4.000 229.000 (* .25 .500) solid tenordr .100 .500
- .030 45.000 1 .010 11)
- (drone .000 4.000 229.500 (* .25 .500) solid tenordr .100 .500
- .030 45.000 1 .010 9)
- (canter .000 2.100 918 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 2.100 .300 688.5 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 2.400 .040 826.2 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 2.440 .560 459 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.000 .040 408 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.040 .040 619.65 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.080 .040 408 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.120 .040 688.5 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.160 .290 459 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.450 .150 516.375 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.600 .040 826.2 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.640 .040 573.75 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.680 .040 619.65 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.720 .180 573.75 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.900 .040 688.5 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )
- (canter 3.940 .260 459 (* .25 .700) 45.000 1 .050 ampf ranf skwf
- .050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
- ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )))
-
- (let ((ind (find-sound "test.snd")))
- (play-and-wait 0 ind)
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 4 "dlocsig 2 4")
- (with-sound (:srate 22050)
- (fm-violin 0 .01 440 .1 :noise-amount 0.0)
- (pluck 0.05 .01 330 .1 .95 .95)
- (maraca .1 .1)
- (big-maraca .2 .5 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01)
- (fm-bell 0.3 1.0 220.0 .5
- '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0 )
- '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 )
- 1.0)
- (singer .4 .1 (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01) (list .6 oo.shp test.glt 523.0 .7 .1 .01)))
- (stereo-flute .6 .2 440 .55 :flow-envelope '(0 0 1 1 2 1 3 0))
- (fofins 1 .3 270 .4 .001 730 .6 1090 .3 2440 .1)
- (bow 1.2 .3 400 0.5 :vb 0.15 :fb 0.1 :inharm 0.25)
- (pqw-vox 1.5 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 0) 0 '(0 L 100 L) '(.33 .33 .33) '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5)))
- (fm-noise 2 0.5 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1 1000 '(0 0 100 1) 0.1 0.1 10 1000 '(0 0 100 1) 0 0 100 500 '(0 0 100 1) 0 0)
- (bes-fm 2.5 .5 440 5.0 1.0 8.0)
- (chain-dsps 3 0.5 '(0 0 1 .1 2 0) (make-oscil 440))
- (chain-dsps 3.5 1.0 '(0 0 1 1 2 0) (make-one-zero .5) (make-readin "oboe.snd"))
- (vox 4 2 170 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 E 25 AE 35 ER 65 ER 75 I 100 UH)
- '(.8 .15 .05) '(.005 .0125 .025) .05 .1)
- (p 5.0 :duration .5 :keyNum 36 :strike-velocity .5 :amp .4 :DryPedalResonanceFactor .25)
- ;(bobwhite 5.5)
- (scissor 2.0)
- (plucky 3.25 .3 440 .2 1.0)
- (bowstr 3.75 .3 220 .2 1.0)
- (brass 4.2 .3 440 .2 1.0)
- (clarinet 5.75 .3 440 .2 1.0)
- (flute 6 .3 440 .2 1.0)
- (fm-trumpet 6.5 .25)
- (touch-tone 6.75 '(7 2 3 4 9 7 1))
- (pins 7.0 1.0 "now.snd" 1.0 :time-scaler 2.0)
-
- (let ((locust '(0 0 40 1 95 1 100 .5))
- (bug_hi '(0 1 25 .7 75 .78 100 1))
- (amp '(0 0 25 1 75 .7 100 0)))
- (fm-insect 7 1.699 4142.627 .015 amp 60 -16.707 locust 500.866 bug_hi .346 .500)
- (fm-insect 7.195 .233 4126.284 .030 amp 60 -12.142 locust 649.490 bug_hi .407 .500)
- (fm-insect 7.217 2.057 3930.258 .045 amp 60 -3.011 locust 562.087 bug_hi .591 .500)
- (fm-insect 9.100 1.500 900.627 .06 amp 40 -16.707 locust 300.866 bug_hi .346 .500)
- (fm-insect 10.000 1.500 900.627 .06 amp 40 -16.707 locust 300.866 bug_hi .046 .500)
- (fm-insect 10.450 1.500 900.627 .09 amp 40 -16.707 locust 300.866 bug_hi .006 .500)
- (fm-insect 10.950 1.500 900.627 .12 amp 40 -10.707 locust 300.866 bug_hi .346 .500)
- (fm-insect 11.300 1.500 900.627 .09 amp 40 -20.707 locust 300.866 bug_hi .246 .500))
-
- (fm-drum 7.5 1.5 55 .3 5 #f)
- (fm-drum 8 1.5 66 .3 4 #t)
- (gong 9 3 261.61 .6)
- (attract 10 .25 .5 2.0)
- (pqw 11 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5))
-
- (zn 10 1 100 .1 20 100 .995)
- (zn 11.5 1 100 .1 100 20 .995)
- (zc 11 1 100 .1 20 100 .95)
- (zc 12.5 1 100 .1 100 20 .95)
- (za 13 1 100 .1 20 100 .95 .95)
- (za 14.5 1 100 .1 100 20 .95 .95)
-
- (tubebell 12 2 440 .2)
- (wurley 12.5 .25 440 .2)
- (rhodey 12.75 .25 440 .2)
- (hammondoid 13 .25 440 .2)
- (metal 13.5 .25 440 .2)
- (reson 14.0 1.0 440 .1 2 '(0 0 100 1) '(0 0 100 1) .1 .1 .1 5 .01 5 .01 0 1.0 0.01
- '(((0 0 100 1) 1200 .5 .1 .1 0 1.0 .1 .1)
- ((0 1 100 0) 2400 .5 .1 .1 0 1.0 .1 .1)))
- (cellon 14.5 1 220 .1
- '(0 0 25 1 75 1 100 0)
- '(0 0 25 1 75 1 100 0) .75 1.0 0 0 0 0 1 0 0 220
- '(0 0 25 1 75 1 100 0) 0 0 0 0
- '(0 0 100 0) 0 0 0 0 '(0 0 100 0))
- (clm-expsrc 14.75 4 "oboe.snd" 2.0 1.0 1.0)
- (scratch 15.0 "now.snd" 1.5 '(0.0 .5 .25 1.0))
- (two-tab 15 1 440 .1)
- (exp-snd "fyow.snd" 15 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05)
- (exp-snd "oboe.snd" 16 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2)
- (gran-synth 15.5 1 300 .0189 .03 .4)
- (spectra 16 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1) '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0))
- (lbj-piano 16.5 1 440.0 .2)
- (resflt 17 1.0 0 0 0 #f .1 200 230 10 '(0 0 50 1 100 0) '(0 0 100 1) 500 .995 .1 1000 .995 .1 2000 .995 .1)
- (resflt 17.5 1.0 1 10000 .01 '(0 0 50 1 100 0) 0 0 0 0 #f #f 500 .995 .1 1000 .995 .1 2000 .995 .1)
- (bes-fm 18 1 440 10.0 1.0 4.0)
-
- (green3 19 2.0 440 .5 '(0 0 1 1 2 1 3 0) 100 .2 .02)
- (green4 21 2.0 440 .5 '(0 0 1 1 2 1 3 0) 440 100 100 10)
-
- (fir+comb 20 2 10000 .001 200)
- (fir+comb 22 2 1000 .0005 400)
- (fir+comb 24 2 3000 .001 300)
- (fir+comb 26 2 3000 .0005 1000)
-
- (sndwarp 28 1.0 "pistol.snd")
- (expandn 29 .5 "oboe.snd" .2)
- (let ((ampf '(0 0 1 1 2 1 3 0)))
- (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 1 .01 0 ampf .01))
- (graphEq "oboe.snd")
- )
- (let ((ind (find-sound "test.snd")))
- (play-and-wait 0 ind)
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 5 "dlocsig 2 5")
- (with-sound (:play #f) (defopt-simp 0 10000) (defopt-simp 10000 10000 550.0 0.1) (defopt-simp 20000 10000 :amplitude .2))
- (with-sound (:channels 2 :reverb-channels 2 :reverb jcrev2 :play #f) (floc-simp 0 1))
-
-
- (with-sound (:channels 2 :statistics #t)
- (fullmix "pistol.snd")
- (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5)))))
- (let ((ind (find-sound "test.snd")))
- (if (sound? ind) (close-sound ind)))
-
- (with-sound (:channels 2)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.664947509765625) (snd-display ";4->2(0) fullmix: ~A" (maxamp)))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 6 "dlocsig 2 6")
- (with-sound (:channels 1)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((1.0) (0.0) (0.0) (0.0))))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.221649169921875) (snd-display ";4->1(0) fullmix: ~A" (maxamp)))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .008 .009 .010 .010 .012 .013 .014
+ .016 .018 .020 .023 .027 .031 .036 .044 .053 .066
+ .086 .118 .175 .273 .377 .315 .169 .078 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 7 "dlocsig 2 7")
- (with-sound (:channels 1)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0) (1.0) (0.0) (0.0))))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.44329833984375) (snd-display ";4->1(1) fullmix: ~A" (maxamp)))
- (close-sound ind))
- (with-sound (:channels 1)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0) (0.0) (1.0) (0.0))))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.664947509765625) (snd-display ";4->1(2) fullmix: ~A" (maxamp)))
- (close-sound ind))
+ (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #t)))
+ (set! ind (find-sound "test.snd"))
- (with-sound (:channels 1)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0) (0.0) (0.0) (1.0))))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.8865966796875) (snd-display ";4->1(3) fullmix: ~A" (maxamp)))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .011 .011 .012 .013 .014 .015 .017
+ .018 .020 .023 .025 .029 .033 .038 .045 .054 .066
+ .086 .118 .178 .300 .499 .497 .399 .079 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 0 "dlocsig 3 0")
- (with-sound (:channels 2)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
- (let* ((ind (find-sound "test.snd"))
- (mxs (maxamp ind #t)))
- (if (or (fneq (car mxs) 0.664947509765625)
- (fneq (cadr mxs) 0.8865966796875))
- (snd-display ";4->2(1) fullmix: ~A" mxs))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .052 .376 .499 .496 .339 .184
+ .122 .087 .068 .055 .046 .039 .034 .030 .026 .023
+ .021 .019 .018 .016 .015 .014 .013 .012 .011)
+ ind 1 "dlocsig 3 1")
- (with-sound (:channels 2)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (0.0 1.0) (1.0 0.0))))
- (let* ((ind (find-sound "test.snd"))
- (mxs (maxamp ind #t)))
- (if (or (fneq (car mxs) 0.8865966796875)
- (fneq (cadr mxs) 0.664947509765625))
- (snd-display ";4->2(2) fullmix: ~A" mxs))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .036 .160 .166 .122 .111 .078
+ .054 .037 .027 .020 .015 .012 .009 .007 .006 .005
+ .004 .003 .002 .002 .001 .001 .001 .001 .000)
+ ind 2 "dlocsig 3 2")
- (with-sound (:channels 2 :reverb nrev)
- (fullmix "pistol.snd" 0.0 2.0 0.25 #f 2.0 0.1)
- (fullmix "pistol.snd" 1.0 2.0 0.25 0.2 2.0 0.1)
- (fullmix "2a.snd" #f #f #f '((0.5 0.0) (0.0 0.75)))
- (fullmix "oboe.snd" #f #f #f (list (list (list 0 0 1 1 2 0) 0.5)))
- (fullmix "oboe.snd" 3 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5)))))
-
-
- (load "fullmix.scm") ; this is also in clm-ins.scm so we need a separate set of tests
-
- (with-sound (:channels 2 :statistics #t)
- (fullmix "pistol.snd")
- (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5)))))
- (let ((ind (find-sound "test.snd")))
- (if (sound? ind) (close-sound ind) (snd-display ";fullmix.scm no output?")))
-
- (with-sound (:channels 2)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.664947509765625) (snd-display ";4->2(0) fullmix.scm: ~A" (maxamp)))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .001 .001 .001 .001 .002
+ .002 .002 .003 .004 .005 .006 .007 .009 .012 .016
+ .022 .030 .041 .048 .045 .160 .166 .079 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 3 3")
- (with-sound (:channels 1)
- (fullmix "4.aiff" 0.0 0.1 36.4 '((1.0) (0.0) (0.0) (0.0))))
- (let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.221649169921875) (snd-display ";4->1(0) fullmix.scm: ~A" (maxamp)))
- (close-sound ind))
-
- (with-sound (:statistics #t :scaled-to .5 :srate 44100 :channels 1)
- (cnvrev "oboe.snd" "fyow.snd"))
- (let ((ind (find-sound "test.snd")))
- (if (sound? ind) (close-sound ind) (snd-display ";cnvrev no output?")))
-
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
- (let ((old-date (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
- (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
- (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
- (let ((old-date (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
- (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
- (let ((old-date (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" #f #t)))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
- (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" old-date #t))
-
- (with-sound ()
- (sound-let ((temp-1 () (fm-violin 0 1 440 .1))
- (temp-2 () (fm-violin 0 2 660 .1 :base 32.0)
- (fm-violin .125 .5 880 .1)))
- (mus-mix *output* temp-1 0)
- (mus-mix *output* temp-2 22050)))
- (let ((ind (find-sound "test.snd")))
- (if (not (sound? ind)) (snd-display ";with-sound+sound-lets init: no test.snd?"))
- (if (or (> (maxamp ind) .2) (< (maxamp ind) .15)) (snd-display ";with-mix+sound-lets maxamp: ~A" (maxamp ind)))
- (if (fneq 3.0 (/ (frames ind) (srate ind))) (snd-display ";with-sound+sound-lets dur: ~A" (/ (frames ind) (srate ind))))
- (close-sound ind))
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound ()
- (with-mix () "with-mix" 0
- (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-mix *output* tmp 0))))
- (let ((old-date (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-mix *output* tmp 0)))" #f #t)))
- (with-sound ()
- (with-mix () "with-mix" 0
- (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-mix *output* tmp 0))))
- (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-mix *output* tmp 0)))" old-date #t))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
- (let ((ind (find-sound "test.snd")))
- (if (or (fneq (maxamp ind 0) .1)
- (fneq (maxamp ind 1) .3))
- (snd-display ";with-mix stereo: ~A" (maxamp ind #t)))
- (if (not (= (mus-sound-chans "with-mix.snd") 2)) (snd-display ";with-mix stereo out: ~A" (mus-sound-chans "with-mix.snd"))))
- (let ((old-date (mus-sound-write-date "with-mix.snd")))
- (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
- (if (not (= (mus-sound-write-date "with-mix.snd") old-date))
- (snd-display ";stereo with-mix dates: ~A ~A" old-date (mus-sound-write-date "with-mix.snd"))))
- (let ((ind (find-sound "test.snd")))
- (close-sound ind))
+ (with-sound (:channels 4 :reverb jc-reverb) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :error .001 :3d #f)))
+ (set! ind (find-sound "test.snd"))
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
- (let ((old-date (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" #f #f)))
- (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
- (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" old-date #f))
+ (check-segments (vector .000 .011 .012 .014 .017 .020 .025 .036 .046 .070
+ .114 .261 .505 .453 .006 .006 .008 .007 .012 .034
+ .035 .027 .022 .022 .018 .040 .041 .032 .050 .044
+ .049 .037 .037 .040 .040 .033 .027 .028 .032 .029
+ .017 .020 .018 .015 .013 .011 .011 .017 .018 .015)
+ ind 0 "dlocsig 4 0")
- (with-sound (:srate 44100 :play #f) (bigbird 0 2 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
- (let ((ind (or (find-sound "test.snd") (open-sound "oboe.snd"))))
- (let ((mx (maxamp)))
- (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)))
- (if (or (fneq mx .5)
- (ffneq (maxamp) .027))
- (snd-display ";notch 60 Hz: ~A to ~A" mx (maxamp)))
- (undo)
- (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
- (if (ffneq (maxamp) .004)
- (snd-display ";notch-sound 60 hz 2: ~A" (maxamp)))
- (undo)
- (notch-channel (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f #f #f ind 0 #f #f 10)
- (if (ffneq (maxamp) .004)
- (snd-display ";notch-channel 60 hz 2: ~A" (maxamp)))
- (undo)
-
- ; (select-all)
- (make-selection 10000 11000)
- (notch-selection (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f)
- ; (if (ffneq (maxamp) .066)
- ; (snd-display ";notch-selection 60 hz 2: ~A" (maxamp)))
- (play-sound
- (lambda (data)
- (let ((len (sound-data-length data)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (sound-data-set! data 0 i (* 2.0 (sound-data-ref data 0 i)))))))))
-
- (close-sound ind)))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .004 .006 .008
+ .008 .007 .316 .503 .373 .130 .073 .052 .040 .050
+ .034 .026 .023 .022 .030 .040 .041 .032 .050 .044
+ .049 .037 .037 .040 .040 .033 .027 .028 .032 .029
+ .017 .020 .018 .015 .013 .011 .011 .017 .018 .015)
+ ind 1 "dlocsig 4 1")
- (with-sound (:srate 44100 :play #f) (bigbird 0 60 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
- (let ((ind (find-sound "test.snd")))
- (let ((mx (maxamp)))
- (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
- (if (ffneq (maxamp) .036)
- (snd-display ";notch-sound 60 hz 2 60: ~A" (maxamp))))
- (close-sound ind))
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .150 .173 .120 .058 .029 .017 .010 .006
+ .004 .003 .002 .001 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 4 2")
- (play-sine 440 .1)
- (play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
+ (check-segments (vector .000 .000 .000 .001 .001 .002 .004 .006 .009 .015
+ .028 .049 .150 .173 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 4 3")
- (with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1 :statistics #t)
- (grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))
- (grani 0 4 1 "oboe.snd")
- (if (> (optimization) 4)
- (begin
- (grani 0 4 1 "oboe.snd" :grains 10)
- (grani 0 4 1 "oboe.snd"
- :grain-start 0.11
- :amp-envelope '(0 1 1 1) :grain-density 8
- :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)
- :grain-envelope-end '(0 0 0.01 1 0.99 1 1 0)
- :grain-envelope-transition '(0 0 0.4 1 0.8 0 1 0))
- (grani 0 3 1 "oboe.snd"
- :grain-start 0.1
- :amp-envelope '(0 1 1 1) :grain-density 20
- :grain-duration '(0 0.003 0.2 0.01 1 0.3))
- (grani 0 3 1 "oboe.snd"
- :grain-start 0.1
- :amp-envelope '(0 1 1 1) :grain-density 20
- :grain-duration '(0 0.003 0.2 0.01 1 0.3)
- :grain-duration-limit 0.02)
- (grani 0 2 1 "oboe.snd"
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-start '(0 0.1 0.3 0.1 1 0.6))
- (grani 0 2 1 "oboe.snd"
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-start '(0 0.1 0.3 0.1 1 0.6)
- :grain-start-spread 0.01)
- (grani 0 2.6 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :srate '(0 0 0.2 0 0.6 5 1 5))
- (grani 0 2.6 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :srate-base 2
- :srate '(0 0 0.2 0 0.6 -1 1 -1))
- (grani 0 2.6 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :srate-linear #t
- :srate (list 0 1 0.2 1 0.6 (expt 2 (/ 5 12)) 1 (expt 2 (/ 5 12))))
- (grani 0 2 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-duration '(0 0.02 1 0.1)
- :grain-duration-spread '(0 0 0.5 0.1 1 0)
- :where-to grani-to-grain-duration
- :where-bins (vct 0 0.05 1))
- (grani 0 2 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-degree '(0 0 1 90)
- :grain-degree-spread 10)
- )))
- (let ((ind (open-sound "oboe.snd")))
- (with-sound (:output "test1.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
- (set-samples 0 2205 "test1.snd" ind 0 #f "set-samples auto-delete test" 0 #f #t)
- (if (not (file-exists? "test1.snd")) (snd-display ";oops: auto-delete test1.snd?"))
- (undo 1 ind)
- (with-sound (:output "test2.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
- (insert-sound "test2.snd" 0 0 ind 0 #f #t)
- (if (file-exists? "test1.snd") (snd-display ";auto-delete set-samples?"))
- (undo 1 ind)
- (with-sound (:output "test3.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
- (insert-samples 0 2205 "test3.snd" ind 0 #f #t)
- (if (file-exists? "test2.snd") (snd-display ";auto-delete insert-sound?"))
- (undo 1 ind)
- (with-sound (:output "test4.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
- (mix "test4.snd" 0 0 ind 0 #f #t)
- (if (file-exists? "test3.snd") (snd-display ";auto-delete insert-samples?"))
- (undo 1 ind)
- (delete-sample 100)
- (if (file-exists? "test4.snd") (snd-display ";auto-delete mix?"))
- (with-sound (:output "test5.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
- (mix "test5.snd" 0 0 ind 0 #t #t)
- (revert-sound ind)
- (close-sound ind)
- (if (file-exists? "test5.snd") (snd-display ";auto-delete mix (with-tag)?")))
- )
-
- (let ((o2 (optkey-1 1)))
- (if (not (equal? o2 1)) (snd-display ";optkey-1: ~A" o2)))
- (let ((o2 (optkey-1 :a 1)))
- (if (not (equal? o2 1)) (snd-display ";optkey-1 1: ~A" o2)))
- (let ((o2 (optkey-1)))
- (if (not (equal? o2 #f)) (snd-display ";optkey-1 2: ~A" o2)))
- (let ((o2 (optkey-2 1 2)))
- (if (not (equal? o2 (list 1 2))) (snd-display ";optkey-2: ~A" o2)))
- (let ((o2 (optkey-2 :a 1 :b 2)))
- (if (not (equal? o2 (list 1 2))) (snd-display ";optkey-2 1: ~A" o2)))
- (let ((o2 (optkey-2)))
- (if (not (equal? o2 (list 3 #f))) (snd-display ";optkey-2 2: ~A" o2)))
- (let ((o2 (optkey-2 1 :b 2)))
- (if (not (equal? o2 (list 1 2))) (snd-display ";optkey-2 3: ~A" o2)))
- (let ((o2 (optkey-3 1 2 3)))
- (if (not (equal? o2 (list 1 2 3))) (snd-display ";optkey-3: ~A" o2)))
- (let ((o2 (optkey-3 1 :b 2 :c 3)))
- (if (not (equal? o2 (list 1 2 3))) (snd-display ";optkey-3 1: ~A" o2)))
- (let ((o2 (optkey-3 1 2 :c 3)))
- (if (not (equal? o2 (list 1 2 3))) (snd-display ";optkey-3 2: ~A" o2)))
- (let ((o2 (optkey-4)))
- (if (not (equal? o2 (list 1 2 3 #f))) (snd-display ";optkey-4: ~A" o2)))
- (let ((o2 (optkey-4 1 :b 3 :c 4 :d 5)))
- (if (not (equal? o2 (list 1 3 4 5))) (snd-display ";optkey-4 1: ~A 1" o2)))
- (let ((o2 (optkey-4 1 :d 5 :c 4 :b 3)))
- (if (not (equal? o2 (list 1 3 4 5))) (snd-display ";optkey-4 2: ~A 1" o2)))
- (let ((o2 (optkey-4 1 3 4 5)))
- (if (not (equal? o2 (list 1 3 4 5))) (snd-display ";optkey-4 3: ~A 2" o2)))
-
- (if (and (or (provided? 'snd-motif)
- (provided? 'snd-gtk))
- (defined? 'variable-display))
- (let ((wid1 (make-variable-display "do-loop" "i*1" 'text))
- (wid2 (make-variable-display "do-loop" "i*2" 'scale '(-1.0 1.0)))
- (wid3 (make-variable-display "do-loop" "i3" 'spectrum))
- (wid4 (make-variable-display "do-loop" "i4" 'graph)))
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (variable-display (variable-display (* (variable-display (sin (* (variable-display i wid1) .1)) wid3) .5) wid2) wid4))
- (let ((tag (catch #t (lambda () (set! (sample 0 (car wid3) 0) .5)) (lambda args (car args)))))
- (if (> (edit-position (car wid3) 0) 0) (snd-display ";edited variable graph? ~A ~A" tag (edit-position (car wid3) 0))))
- (if (provided? 'snd-motif)
- (XtUnmanageChild variables-dialog)
- (gtk_widget_hide variables-dialog))
- (close-sound (car wid3))
- (close-sound (car wid4))
- ))
-
- (if (not (= *clm-srate* (default-output-srate))) (snd-display ";*clm-srate*: ~A ~A" *clm-srate* (default-output-srate)))
- (if (not (= *clm-channels* (default-output-chans))) (snd-display ";*clm-channels*: ~A ~A" *clm-channels* (default-output-chans)))
- (if (not (= *clm-header-type* (default-output-header-type))) (snd-display ";*clm-header-type*: ~A ~A" *clm-header-type* (default-output-header-type)))
- ; (if (not (= *clm-data-format* (default-output-data-format))) (snd-display ";*clm-data-format*: ~A ~A" *clm-data-format* (default-output-data-format)))
- (if (not (= *clm-reverb-channels* 1)) (snd-display ";*clm-reverb-channels*: ~A ~A" *clm-reverb-channels*))
- (if (not (string=? *clm-file-name* "test.snd")) (snd-display ";*clm-file-name*: ~A" *clm-file-name*))
- (if *clm-play* (snd-display ";*clm-play*: ~A" *clm-play*))
- (if *clm-verbose* (snd-display ";*clm-verbose*: ~A" *clm-verbose*))
- (if *clm-statistics* (snd-display ";*clm-statistics*: ~A" *clm-statistics*))
- (if *clm-reverb* (snd-display ";*clm-reverb*: ~A" *clm-reverb*))
- (if (not (null? *clm-reverb-data*)) (snd-display ";*clm-reverb-data*: ~A?" *clm-reverb-data*))
- (if *clm-delete-reverb* (snd-display ";*clm-delete-reverb*: ~A" *clm-delete-reverb*))
-
- (set! *clm-channels* 2)
- (set! *clm-srate* 44100)
- (set! *clm-file-name* "test.wav")
- (set! *clm-verbose* #t)
- (set! *clm-statistics* #t)
- (set! *clm-play* #t)
- (set! *clm-data-format* mus-mulaw)
- (set! *clm-header-type* mus-riff)
- (set! *clm-delete-reverb* #t)
- (set! *clm-reverb* jc-reverb)
- (set! *clm-reverb-data* (list #t 2.0 (list 0 1 3.0 1 4.0 0)))
-
- (with-sound () (fm-violin 0 1 440 .1 :reverb-amount .1))
-
- (let ((ind (find-sound "test.wav")))
- (if (not (sound? ind))
- (snd-display ";default output in ws: ~A" (map file-name (sounds)))
- (begin
- (if (not (= (srate ind) 44100)) (snd-display ";default srate in ws: ~A ~A" (srate ind) *clm-srate*))
- (if (not (= (channels ind) 2)) (snd-display ";default chans in ws: ~A ~A" (channels ind) *clm-channels*))
- (if (not (= (data-format ind) mus-mulaw)) (snd-display ";default format in ws: ~A ~A" (data-format ind) *clm-data-format*))
- (if (not (= (header-type ind) mus-riff)) (snd-display ";default type in ws: ~A ~A" (header-type ind) *clm-header-type*))
- (if (not (= (frames ind) 88200)) (snd-display ";reverb+1 sec out in ws: ~A" (frames ind)))
- (if (file-exists? "test.rev") (snd-display ";perhaps reverb not deleted in ws?"))
- (close-sound ind))))
-
- (let ((val 0)
- (old-hook *clm-notehook*))
- (set! *clm-notehook* (lambda args (set! val 1)))
- (with-sound () (fm-violin 0 .1 440 .1))
- (if (not (= val 1)) (snd-display ";*clm-notehook*: ~A ~A" val *clm-notehook*))
- (with-sound (:notehook (lambda args (set! val 2))) (fm-violin 0 .1 440 .1))
- (if (not (= val 2)) (snd-display ";:notehook: ~A" val))
- (with-sound () (fm-violin 0 .1 440 .1))
- (if (not (= val 1)) (snd-display ";*clm-notehook* (1): ~A ~A" val *clm-notehook*))
- (set! *clm-notehook* old-hook))
-
- (set! *clm-channels* 1)
- (set! *clm-srate* 22050)
- (set! *clm-file-name* "test.snd")
- (set! *clm-verbose* #f)
- (set! *clm-statistics* #f)
- (set! *clm-play* #f)
- (set! *clm-data-format* mus-bshort)
- (set! *clm-header-type* mus-next)
- (set! *clm-delete-reverb* #f)
- (set! *clm-reverb* #f)
- (set! *clm-reverb-data* '())
-
- (with-sound (:reverb jl-reverb)
- (attract 0 1 0.1 2.0)
- (expfil 0 2 .2 .01 .1 "oboe.snd" "fyow.snd")
- (fm-violin 0 .1 660 .1 :reverb-amount .1)
- (anoi "oboe.snd" 1 1)
- (let* ((ind (open-sound "oboe.snd"))
- (ind1 (open-sound "now.snd"))
- (zp (make-zipper (make-env '(0 0 1 1) :length 22050)
- 0.05
- (make-env (list 0 (* (mus-srate) 0.05)) :length 22050)))
- (reader0 (make-sampler 0 ind 0))
- (reader1 (make-sampler 0 ind1 0)))
- (run (lambda () (do ((i 0 (+ 1 i))) ((= i 22050)) (outa i (zipper zp reader0 reader1)))))
- (close-sound ind)
- (close-sound ind1)))
-
- (zip-sound 1 1 "fyow.snd" "now.snd" '(0 0 1 1) .05)
- (zip-sound 2 3 "mb.snd" "fyow.snd" '(0 0 1.0 0 1.5 1.0 3.0 1.0) .025)
-
- (if all-args
- (let* ((ind (open-sound "oboe.snd"))
- (pv (make-pvocoder 256 4 64))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (pvocoder pv rd)))
- (clm-reverb-sound .1 jc-reverb)
- (close-sound ind)))
-
- (let ((old-play *clm-play*))
- (set! *clm-play* #f)
- (make-birds)
- (set! *clm-play* old-play))
-
- (for-each close-sound (sounds))
-
- (with-sound ()
- (simple-ssb 0 .2 440 .1)
- (simple-osc 0.75 .2 440 .1)
- (simple-asy 1.25 .2 .1)
- (simple-saw 1.5 .2 .1)
- (simple-tri 1.75 .2 .1)
- (simple-pul 2.0 .2 .1)
- (simple-sqr 2.25 .2 .1)
- (if all-args (simple-sib 2.5 .2 440.0 .1))
- (simple-oz 2.75 .2 440.0 .1)
- (simple-op 3.0 .2 440.0 .1)
- (simple-tz 3.25 .2 440.0 .1)
- (simple-tp 3.5 .2 440.0 .1)
- (simple-frm 3.75 .2 440.0 .1)
- (simple-firm 3.875 .2 440.0 .1)
- (simple-firm2 4.0 .2 440.0 .1)
- (simple-poly 4.25 .2 440.0 .1)
- (simple-polyw 4.5 .2 440.0 .1)
- (simple-dly 4.75 .2 440.0 .1)
- (simple-cmb 5.0 .2 440.0 .1)
- (simple-filtered-cmb 5.125 .2 440.0 .1)
- (simple-not 5.25 .2 440.0 .1)
- (simple-alp 5.5 .2 440.0 .1)
- (simple-ave 5.75 .2 440.0 .1)
- (simple-tab 6.0 .2 440.0 .1)
- (simple-flt 6.25 .2 440.0 .1)
- (simple-fir 6.5 .2 440.0 .1)
- (simple-iir 6.5 .2 440.0 .3)
- (simple-f 6.75 .2 440.0 .1)
- (simple-ran 7.0 .2 440.0 .1)
- (simple-ri 7.25 .2 440.0 .1)
- (simple-env 7.5 .2 440.0 .1)
- (simple-amb 7.75 .2 440.0 .1)
- (simple-fof 8 1 270 .1 .001 730 .6 1090 .3 2440 .1) ;"Ahh"
- (simple-fof 9 4 270 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
- (simple-fof 9 4 (* 6/5 540) .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
- (simple-fof 9 4 135 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0))
-
- (simple-src-f 13 .45 1.0 2.0 "oboe.snd")
- (simple-rd 13.5 .45 .75 "oboe.snd")
- (simple-rd-start 13.65 .25 .75 "oboe.snd" 0 0)
- (simple-rd-start 13.8 .25 .75 "oboe.snd" 0 12345)
- (simple-rd-start 13.9 .25 .75 "oboe.snd" 0 12345678)
- (simple-cnv 14.0 .45 .75 "oboe.snd")
- (simple-cnf 14.5 .45 .75 "oboe.snd")
- (simple-lrg 15.0 .45 .75 "oboe.snd")
- (simple-cn2 15.5 .45 .4 "oboe.snd")
- (simple-src 16 .45 1.0 2.0 "oboe.snd")
- (simple-sr2 16.5 .45 1.0 2.0 "oboe.snd")
- (simple-sr2a 16.75 .45 1.0 2.0 "oboe.snd")
- (simple-rndist 17.0 .2 440.0 .1)
- (simple-ridist 17.25 .2 440.0 .1)
- (simple-sro 17.5 .45 .1 .5 440)
- (simple-grn 18 .2 .1 1.0 440)
- (simple-pvoc 18.25 .2 .4 256 "oboe.snd")
- (simple-ina 18.5 .45 1 "oboe.snd")
- (simple-rdf 19 .45 1 "oboe.snd")
- (simple-f2s 19.5 .45 1 "oboe.snd")
- (simple-loc 20 .2 440 .1)
- (simple-dloc 20.1 .2 440 .1)
- (simple-out 20.25 .2 440 .1)
- (simple-fm 20 1 440 .1 2 1.0)
- (simple-dup 20.5 .2 440 .1)
- (simple-du1 20.75 .2 440 .1)
- (simple-grn-f1 21 .45 .1 2 440)
- (simple-grn-f2 21.5 .45 1 2 "oboe.snd")
- (simple-grn-f3 22 .45 1 2 "oboe.snd")
- (simple-grn-f4 22.5 .45 1 2 "oboe.snd")
- (simple-grn-f5 23 .45 1 2 "oboe.snd")
- (simple-multiarr 23.5 .5 440 .1))
-
-
- (with-sound (:channels 4) (simple-dloc-4 0 2 440 .5))
-
- (with-sound ()
- (or1) (or2) (or3) (or4)
- (sample-desc 0 .2 440 .1)
- (sample-mdat .25 .2 440 .1)
- (sample-xtab .5 .2 440 .1)
- (sample-xts .75 .2 440 .1)
- (sample-srl2 1 .2 .2 .5 (* 440 2))
- (sample-srll 1.25 .2 .1 .5 (* 440 4))
- (sample-srl3 1.5 .2 .1 .5 880)
- (sample-grn2 1.75 .2 .1 .5 880)
- (sample-grn3 2 .45 1 1 "oboe.snd")
-
- (sample-cnv 2.5 .45 1 1 "oboe.snd")
- (sample-cnv1 3.0 .45 1 1 "oboe.snd")
- (sample-pvoc1 3.5 .45 1 512 "oboe.snd")
- (sample-pvoc2 4.0 .45 1 512 "oboe.snd")
- (if all-args (sample-pvoc3 4.5 .001 1 512 "oboe.snd"))
- (sample-mxf 5 .2 440 .1)
- (sample-osc 5.25 .2 440 .1)
- (if all-args (sample-ardcl 5.5 .2 440 .1))
- (sample-strs 5.75 .2 440 .1)
- (sample-flt 6 .2 440 .1)
- (sample-arrintp 6.25 .2 440 .1)
- (sample-if 6.5 .2 440 .1)
- (sample-arrfile 6.75 .2 440 .15)
- (sample-pvoc5 7.25 .2 .1 256 "oboe.snd" 440.0)
- )
-
- (if all-args
- (let* ((outfile (with-sound () (pvoc-a 0 2.3 1 256 "oboe.snd") (pvoc-e 0 2.3 -1 256 "oboe.snd")))
- (mx (mus-sound-maxamp outfile)))
- (if (fneq (cadr mx) 0.0)
- (snd-display ";pvoc a-e: ~A" mx))))
-
- (let* ((file (with-sound (:clipped #f :data-format mus-bfloat :header-type mus-next)
- (fm-violin 0 .1 440 pi)))
- (ind (find-sound file))
- (mx (maxamp ind)))
- (if (fneq mx pi) (snd-display ";clipped #f: ~A" mx))
- (close-sound ind)
- (set! file (with-sound (:clipped #t :data-format mus-bfloat :header-type mus-next)
- (fm-violin 0 .1 440 pi)))
- (set! ind (find-sound file))
- (set! mx (maxamp ind))
- (if (fneq mx 1.0) (snd-display ";clipped #t: ~A" mx))
+ (with-sound (:channels 2) (dloc-sinewave 0 1.0 440 .5 :path (make-path :path '((-10 10 0 1) (0 5 0 0) (10 10 10 1)) :3d #t)))
+ (set! ind (find-sound "test.snd"))
- (close-sound ind)
- (set! file (with-sound (:data-format mus-bfloat :header-type mus-next :scaled-by .1 :clipped #f)
- (fm-violin 0 .1 440 pi)))
- (set! ind (find-sound file))
- (set! mx (maxamp ind))
- (if (fneq mx .314159) (snd-display ";scaled-by ~A" mx))
+ (check-segments (vector .000 .000 .116 .125 .136 .148 .161 .175 .190 .206
+ .223 .241 .260 .278 .296 .313 .329 .342 .353 .361
+ .367 .370 .371 .370 .368 .367 .365 .362 .360 .358
+ .353 .354 .333 .288 .240 .196 .158 .127 .104 .085
+ .071 .060 .051 .045 .039 .035 .031 .028 .025)
+ ind 0 "dlocsig 5 0")
- (close-sound ind)
- (set! file (with-sound (:data-format mus-bfloat :header-type mus-next :scaled-to .1 :clipped #f)
- (fm-violin 0 .1 440 pi)))
- (set! ind (find-sound file))
- (set! mx (maxamp ind))
- (if (fneq mx .1) (snd-display ";scaled-to ~A" mx))
+ (check-segments (vector .000 .000 .031 .035 .039 .044 .049 .056 .064 .074
+ .085 .097 .113 .129 .148 .168 .190 .212 .233 .254
+ .272 .290 .304 .316 .328 .333 .336 .340 .344 .346
+ .350 .363 .370 .367 .352 .326 .295 .265 .237 .212
+ .191 .171 .155 .141 .128 .117 .108 .100 .092)
+ ind 1 "dlocsig 5 1")
- (close-sound ind)
- (let ((old-bufsize *clm-file-buffer-size*)
- (old-tsize *clm-table-size*)
- (old-arrp *clm-array-print-length*))
- (set! *clm-file-buffer-size* (* 1024 1024))
- (set! *clm-table-size* 256)
- (set! *clm-array-print-length* 123)
- (let ((tsize 0)
- (arrp 0))
- (set! file (with-sound (:data-format mus-bfloat :header-type mus-next)
- (set! mx (mus-file-buffer-size))
- (set! tsize (clm-table-size))
- (set! arrp (mus-array-print-length))
- (fm-violin 0 .1 440 .1)))
- (set! ind (find-sound file))
- (if (not (= mx (* 1024 1024))) (snd-display ";*clm-file-buffer-size*: ~A" mx))
- (if (not (= tsize 256)) (snd-display ";*clm-table-size*: ~A" tsize))
- (if (not (= arrp 123)) (snd-display ";*clm-array-print-length*: ~A" arrp))
- (set! *clm-file-buffer-size* old-bufsize)
- (set! *clm-table-size* old-tsize)
- (set! *clm-array-print-length* old-arrp)
- (close-sound ind)))
- (set! file (with-sound () (fm-violin 0 3.0 440 .1)))
- (set! ind (find-sound file))
- (set! (amp-control ind) .5)
- (set! (x-bounds ind 0) (list 1.0 2.0))
- (set! file (with-sound () (fm-violin 0 4.0 440 .1)))
- (set! ind (find-sound file))
- (if (fneq (amp-control ind) .5) (snd-display ";update ws amp: ~A" (amp-control ind)))
- (if (or (fneq (car (x-bounds ind 0)) 1.0)
- (fneq (cadr (x-bounds ind 0)) 2.0))
- (snd-display ";update ws bounds: ~A" (x-bounds ind)))
-
- (if (not (= (->sample 1.0) (srate))) (snd-display ";1.0->sample: ~A" (->sample 1.0)))
- (close-sound ind)
+ (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :total-angle 360)))
+ (set! ind (find-sound "test.snd"))
- (set! file (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .1)))
- (set! ind (find-sound file))
- (set! mx (maxamp ind))
- (set! file (with-sound (:reverb jc-reverb :reverb-data '(#f 12.0 (0 0 1 1 20 1 21 0))) (fm-violin 0 .1 440 .1 :reverb-amount .1)))
- (set! ind (find-sound file))
- (if (not (> (maxamp ind) mx)) (snd-display ";reverb-data: ~A ~A" mx (maxamp ind)))
- (close-sound ind))
-
- (let ((ind (open-sound "oboe.snd")))
- (step-src)
- (if (> (abs (- (frames) 24602)) 100) (snd-display ";step-src frames: ~A (~A)" (frames) (edits)))
- (close-sound ind))
-
- (let ((file (with-sound (:channels 3)
- (let ((rg (make-rmsgain))
- (rg1 (make-rmsgain 40))
- (rg2 (make-rmsgain 2))
- (e (make-env '(0 0 1 1 2 0) :length 10000))
- (e1 (make-env '(0 0 1 1) :length 10000))
- (e2 (make-env '(0 0 1 1 2 0 10 0) :length 10000))
- (o (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (let ((sig (env e)))
- (outa i (balance rg sig (env e2)))
- (outb i (balance rg1 sig (env e1)))
- (outc i (balance rg2 (* .1 (oscil o)) (env e2)))))
- (if (fneq (gain-avg rg) 0.98402) (snd-display ";rmsgain gain-avg: ~A" (gain-avg rg)))
- (if (not (= (rmsg-avgc rg2) 10000)) (snd-display ";rmsgain count: ~A" (rmsg-avgc rg2)))))))
- (let ((ind (find-sound file)))
- (if (not (sound? ind))
- (snd-display ";with-sound balance?")
- (close-sound ind))))
-
- (let* ((mg (make-oscil 100.0))
- (gen (make-ssb-fm 1000))
- (ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1)))
- (pad-channel 0 1000 ind 0)
- (catch #t (lambda () (map-channel (lambda (y) (ssb-fm gen (* .02 (oscil mg)))))) (lambda arg (display arg) arg))
- (close-sound ind))
-
- (let ((file (with-sound ()
- (let ((rd (make-sampler 0 "oboe.snd"))
- (m (make-mfilter :decay .99 :frequency 1000))
- (e (make-env '(0 100 1 2000) :length 10000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (mfilter-1 m (* .1 (rd)) 0.0))
- (set! (mflt-eps m) (* 2.0 (sin (/ (* pi (env e)) (mus-srate)))))))))))
- (let ((ind (find-sound file)))
- (if (not (sound? ind))
- (snd-display ";with-sound mfilter?")
- (close-sound ind))))
-
- (let ((m1 (make-mfilter .9 1000.0))
- (m2 (make-firmant 1000.0 .9))
- (gain (- 1.0 (* .9 .9))))
- (firmant m2 1.0)
- (mfilter-1 m1 1.0 0.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (let ((v1 (* gain (mfilter-1 m1 0.0 0.0)))
- (v2 (firmant m2 0.0)))
- (if (fneq v1 v2)
- (snd-display ";~D mfilter/firmant: ~A ~A" i v1 v2)))))
-
- (let ((m1 (make-mfilter .9 1000.0))
- (m2 (make-firmant 1000.0 .9))
- (gain (- 1.0 (* .9 .9))))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (let* ((y (- (random 2.0 )1.0))
- (v1 (* gain (mfilter-1 m1 y 0.0)))
- (v2 (firmant m2 y)))
- (if (fneq v1 v2)
- (snd-display ";rand case mfilter/firmant: ~A ~A" i v1 v2)))))
-
-
- ;; dlocsig tests
- (if (not (provided? 'snd-dlocsig.scm))
- (catch #t
- (lambda () (load "dlocsig.scm"))
- (lambda args (snd-display ";load dlocsig: ~A" args))))
- (if (not (defined? 'make-spiral-path))
- (snd-display ";make-spiral-path is not defined, dlocsig is ~Aloaded"
- (if (provided? 'snd-dlocsig.scm) "" "not "))
- (begin
-
- (let ((file (new-sound "tmp.snd" mus-next mus-bfloat 22050 4)))
- (mix-move-sound 0 "oboe.snd" (make-spiral-path :turns 3))
- (close-sound file))
-
- (let ((ind 0))
- (with-sound (:channels 2) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .010 .011 .012 .013 .014 .015 .017 .018
- .020 .023 .025 .029 .033 .039 .046 .055 .068 .088 .122
- .182 .301 .486 .477 .402 .160 .000 .000 .000 .000 .000
- .000 .000 .000 .001 .001 .002 .002 .002 .002 .002 .003
- .003 .003 .003 .003 .003)
- ind 0 "dlocsig 0 0")
-
- (check-segments (vector .000 .000 .000 .003 .003 .003 .003 .003 .003 .003 .003
- .003 .003 .003 .003 .003 .003 .003 .003 .002 .002 .002
- .007 .036 .168 .386 .487 .497 .000 .000 .000 .000 .000
- .000 .000 .015 .033 .031 .027 .024 .021 .019 .018 .016
- .015 .014 .013 .012 .011)
- ind 1 "dlocsig 0 1")
-
- (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .011 .011 .012 .013 .014 .015 .017 .018
- .020 .023 .025 .029 .033 .038 .045 .054 .066 .086 .118
- .178 .300 .499 .497 .399 .079 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000)
- ind 0 "dlocsig 1 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .052 .376 .499 .496 .339 .184 .122 .087 .068
- .055 .046 .039 .034 .030 .026 .023 .021 .019 .018 .016
- .015 .014 .013 .012 .011)
- ind 1 "dlocsig 1 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .036 .160 .166 .122 .111 .078 .054 .037 .027
- .020 .015 .012 .009 .007 .006 .005 .004 .003 .002 .002
- .001 .001 .001 .001 .000)
- ind 2 "dlocsig 1 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .001 .001 .001 .001 .002 .002
- .002 .003 .004 .005 .006 .007 .009 .012 .016 .022 .030
- .041 .048 .045 .160 .166 .079 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000)
- ind 3 "dlocsig 1 3")
-
-
- (with-sound (:channels 8) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .007 .007 .008 .008 .008 .009 .009
- .010 .010 .011 .011 .012 .012 .013 .014 .015 .017
- .021 .028 .050 .128 .382 .495 .389 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 0 "dlocsig 2 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .356 .497 .322 .042 .000
- .000 .001 .003 .005 .006 .007 .007 .008 .008 .008
- .008 .008 .008 .008 .008 .008 .007 .007 .007)
- ind 1 "dlocsig 2 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .397 .480 .353 .197
- .133 .095 .073 .058 .048 .040 .034 .030 .026 .023
- .020 .018 .016 .014 .013 .011 .010 .009 .009)
- ind 2 "dlocsig 2 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .003 .005
- .004 .001 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 2 3")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 4 "dlocsig 2 4")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 5 "dlocsig 2 5")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 6 "dlocsig 2 6")
-
- (check-segments (vector .000 .000 .000 .008 .009 .010 .010 .012 .013 .014
- .016 .018 .020 .023 .027 .031 .036 .044 .053 .066
- .086 .118 .175 .273 .377 .315 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 7 "dlocsig 2 7")
-
-
- (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #t)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .011 .011 .012 .013 .014 .015 .017
- .018 .020 .023 .025 .029 .033 .038 .045 .054 .066
- .086 .118 .178 .300 .499 .497 .399 .079 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 0 "dlocsig 3 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .052 .376 .499 .496 .339 .184
- .122 .087 .068 .055 .046 .039 .034 .030 .026 .023
- .021 .019 .018 .016 .015 .014 .013 .012 .011)
- ind 1 "dlocsig 3 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .160 .166 .122 .111 .078
- .054 .037 .027 .020 .015 .012 .009 .007 .006 .005
- .004 .003 .002 .002 .001 .001 .001 .001 .000)
- ind 2 "dlocsig 3 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .001 .001 .001 .001 .002
- .002 .002 .003 .004 .005 .006 .007 .009 .012 .016
- .022 .030 .041 .048 .045 .160 .166 .079 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 3 3")
-
-
- (with-sound (:channels 4 :reverb jc-reverb) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :error .001 :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .011 .012 .014 .017 .020 .025 .036 .046 .070
- .114 .261 .505 .453 .006 .006 .008 .007 .012 .034
- .035 .027 .022 .022 .018 .040 .041 .032 .050 .044
- .049 .037 .037 .040 .040 .033 .027 .028 .032 .029
- .017 .020 .018 .015 .013 .011 .011 .017 .018 .015)
- ind 0 "dlocsig 4 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .004 .006 .008
- .008 .007 .316 .503 .373 .130 .073 .052 .040 .050
- .034 .026 .023 .022 .030 .040 .041 .032 .050 .044
- .049 .037 .037 .040 .040 .033 .027 .028 .032 .029
- .017 .020 .018 .015 .013 .011 .011 .017 .018 .015)
- ind 1 "dlocsig 4 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .150 .173 .120 .058 .029 .017 .010 .006
- .004 .003 .002 .001 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 4 2")
-
- (check-segments (vector .000 .000 .000 .001 .001 .002 .004 .006 .009 .015
- .028 .049 .150 .173 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 4 3")
-
-
- (with-sound (:channels 2) (dloc-sinewave 0 1.0 440 .5 :path (make-path :path '((-10 10 0 1) (0 5 0 0) (10 10 10 1)) :3d #t)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .116 .125 .136 .148 .161 .175 .190 .206
- .223 .241 .260 .278 .296 .313 .329 .342 .353 .361
- .367 .370 .371 .370 .368 .367 .365 .362 .360 .358
- .353 .354 .333 .288 .240 .196 .158 .127 .104 .085
- .071 .060 .051 .045 .039 .035 .031 .028 .025)
- ind 0 "dlocsig 5 0")
-
- (check-segments (vector .000 .000 .031 .035 .039 .044 .049 .056 .064 .074
- .085 .097 .113 .129 .148 .168 .190 .212 .233 .254
- .272 .290 .304 .316 .328 .333 .336 .340 .344 .346
- .350 .363 .370 .367 .352 .326 .295 .265 .237 .212
- .191 .171 .155 .141 .128 .117 .108 .100 .092)
- ind 1 "dlocsig 5 1")
-
-
- (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :total-angle 360)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .351 .304 .256 .200 .145 .084 .024 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .057 .115 .174 .232 .282 .331 .373 .411
- .443 .467 .485 .496 .499 .499 .494 .482 .462 .436)
- ind 0 "dlocsig 6 0")
-
- (check-segments (vector .393 .426 .455 .476 .491 .498 .500 .497 .489 .474
- .451 .421 .386 .343 .298 .246 .189 .134 .073 .014
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .006 .068 .126 .185 .239 .292)
- ind 1 "dlocsig 6 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .034 .096 .153 .211
- .266 .314 .360 .398 .432 .460 .480 .493 .499 .500
- .496 .486 .470 .445 .416 .378 .335 .289 .236 .182
- .123 .061 .002 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 6 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .045
- .107 .164 .221 .272 .323 .368 .405 .438 .463 .483
- .495 .499 .499 .495 .485 .466 .440 .409 .371 .328
- .279 .225 .171 .111 .053 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 6 3")
-
-
- (with-sound (:channels 8) (dloc-sinewave 0 3.0 440 .5 :path (make-spiral-path :turns 3)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .350 .010 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .099 .429 .500 .493 .280 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .168 .465 .500 .480 .214 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .235 .486 .499)
- ind 0 "dlocsig 7 0")
-
- (check-segments (vector .499 .500 .378 .042 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .069 .408 .500 .497 .320
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .129 .447 .499 .488 .248 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .201)
- ind 1 "dlocsig 7 1")
-
- (check-segments (vector .000 .319 .497 .500 .408 .070 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .036 .377 .500
- .499 .351 .015 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .097 .429 .500 .493 .289 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 7 2")
-
- (check-segments (vector .000 .000 .000 .279 .493 .500 .430 .101 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .009
- .348 .498 .500 .385 .043 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .068 .402 .500 .497
- .321 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 7 3")
-
- (check-segments (vector .000 .000 .000 .000 .000 .245 .487 .499 .452 .138
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .311 .496 .500 .409 .071 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .034 .376
- .500 .499 .352 .018 .000 .000 .000 .000 .000 .000)
- ind 4 "dlocsig 7 4")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .204 .478 .500
- .467 .171 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .278 .493 .500 .431 .108 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .008 .347 .498 .500 .386 .044 .000 .000 .000 .000)
- ind 5 "dlocsig 7 5")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .170
- .466 .500 .478 .212 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .243 .486 .499 .453
- .139 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .309 .496 .500 .411 .074 .000 .000)
- ind 6 "dlocsig 7 6")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .137 .448 .499 .488 .246 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .202 .477
- .500 .467 .173 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .276 .493 .500 .436 .109)
- ind 7 "dlocsig 7 7")
-
-
- (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-literal-path '((-10 10) (10 10)) :polar #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .308 .318 .327 .336 .344 .354 .362 .370 .378
- .386 .392 .398 .403 .408 .410 .412 .412 .412 .411
- .408 .403 .396 .388 .378 .346 .352 .328 .324 .307
- .289 .272 .253 .235 .216 .199 .180 .163 .146 .131
- .116 .101 .087 .075 .064 .052 .042 .033 .025)
- ind 0 "dlocsig 8 0")
-
- (check-segments (vector .000 .009 .016 .023 .032 .041 .050 .062 .073 .085
- .099 .113 .128 .143 .161 .178 .195 .213 .232 .250
- .268 .286 .304 .321 .329 .344 .353 .375 .386 .394
- .402 .407 .410 .412 .413 .412 .411 .409 .404 .399
- .394 .387 .380 .372 .363 .355 .346 .337 .329)
- ind 1 "dlocsig 8 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 8 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 8 3")
-
-
- (with-sound (:channels 3) (dloc-sinewave 0 1.0 440 .5 :path (make-literal-path '((-10 10) (10 10)) :polar #t)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .004 .004 .004 .004 .005 .005 .006 .006
- .007 .007 .008 .009 .011 .012 .014 .017 .020 .025
- .033 .044 .066 .102 .215 .406 .490 .443 .345 .281
- .180 .121 .090 .069 .056 .046 .039 .034 .029 .026
- .023 .021 .019 .017 .015 .014 .013 .012 .011 .011)
- ind 0 "dlocsig 9 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .002 .141 .383 .495 .475 .434 .401
- .257 .173 .129 .098 .080 .066 .055 .048 .042 .037
- .033 .029 .027 .024 .022 .020 .019 .017 .016 .015)
- ind 1 "dlocsig 9 1")
-
- (check-segments (vector .000 .000 .017 .018 .019 .021 .023 .024 .026 .029
- .032 .035 .039 .044 .050 .058 .066 .079 .096 .118
- .155 .208 .310 .482 .491 .497 .499 .372 .137 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 9 2")
-
-
- (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :total-angle 360 :distance '(0 10 1 30 2 10))))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .348 .227 .134 .065 .013 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .010 .024 .041 .058 .077 .097
- .120 .144 .168 .195 .222 .251 .280 .306 .331)
- ind 0 "dlocsig 10 0")
-
- (check-segments (vector .353 .347 .329 .306 .280 .253 .226 .198 .174 .148
- .126 .104 .083 .064 .046 .031 .016 .003 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .013 .067 .141)
- ind 1 "dlocsig 10 1")
-
- (check-segments (vector .000 .000 .000 .000 .025 .056 .082 .100 .114 .124
- .131 .135 .137 .137 .136 .135 .131 .127 .122 .116
- .110 .104 .097 .089 .082 .074 .067 .063 .057 .051
- .044 .035 .025 .015 .003 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 10 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .009 .020 .030
- .039 .046 .053 .059 .064 .069 .077 .084 .092 .099
- .106 .113 .119 .125 .130 .133 .136 .137 .137 .136
- .132 .126 .116 .103 .085 .060 .026 .000 .000)
- ind 3 "dlocsig 10 3")
-
-
- (set-speaker-configuration (arrange-speakers :speakers '(-45 45 90 135 225)
- :delays '(.010 .020 .030 .040 .050)
- :channel-map '(0 1 3 2 4)))
-
- (with-sound (:channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .350 .297 .187 .058 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .056 .178 .296 .387 .457
- .493 .499 .496 .465 .400 .313 .198 .077 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .036
- .167 .280 .379 .449 .491 .500 .498 .469 .411 .000)
- ind 0 "dlocsig 11 0")
-
- (check-segments (vector .355 .432 .483 .499 .499 .434 .220 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .115 .240 .342 .426 .478 .499 .500 .454
- .245 .017 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .103 .223 .289 .000)
- ind 1 "dlocsig 11 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .011 .237 .450
- .500 .500 .479 .428 .350 .243 .126 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .212 .429 .499 .499 .484 .438 .358 .260
- .137 .013 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 11 2")
-
- (check-segments (vector .000 .000 .000 .000 .111 .359 .489 .500 .486 .339
- .097 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .088 .330
- .480 .500 .490 .371 .119 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 11 3")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .072 .194 .309 .398 .464 .496 .500 .494 .459
- .391 .299 .189 .060 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .053 .183 .294 .390 .456
- .494 .500 .496 .464 .402 .314 .200 .079 .000 .000)
- ind 4 "dlocsig 11 4")
-
-
- (with-sound (:channels 5 :reverb freeverb :reverb-channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .350 .194 .013 .028 .020 .011 .012 .006 .246 .427
- .502 .504 .450 .281 .064 .041 .021 .011 .012 .009
- .169 .377 .489 .502 .480 .052 .058 .043 .015 .015
- .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
- .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
- ind 0 "dlocsig 12 0")
-
- (check-segments (vector .428 .499 .500 .244 .015 .018 .018 .007 .009 .007
- .012 .151 .355 .479 .499 .417 .044 .046 .042 .025
- .012 .012 .016 .071 .273 .036 .030 .035 .051 .049
- .031 .020 .014 .011 .011 .010 .009 .005 .002 .003
- .003 .002 .002 .001 .001 .001 .001 .001 .000 .000)
- ind 1 "dlocsig 12 1")
-
- (check-segments (vector .000 .009 .013 .028 .411 .502 .484 .374 .175 .007
- .006 .023 .043 .050 .049 .041 .252 .488 .488 .421
- .252 .015 .003 .012 .031 .052 .058 .043 .015 .015
- .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
- .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
- ind 2 "dlocsig 12 2")
-
- (check-segments (vector .000 .011 .331 .493 .487 .149 .018 .007 .009 .007
- .012 .026 .036 .036 .137 .473 .480 .315 .042 .025
- .012 .012 .016 .024 .034 .036 .030 .035 .051 .049
- .031 .020 .014 .011 .011 .010 .009 .005 .002 .003
- .003 .002 .002 .001 .001 .001 .001 .001 .000 .000)
- ind 3 "dlocsig 12 3")
-
- (check-segments (vector .000 .009 .013 .028 .020 .032 .277 .443 .502 .502
- .430 .244 .043 .050 .049 .041 .021 .011 .198 .397
- .492 .496 .464 .318 .082 .052 .058 .043 .015 .015
- .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
- .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
- ind 4 "dlocsig 12 4")
-
-
- (set-speaker-configuration (arrange-speakers :speakers '(-45 45 90 135 225)
- :delays '(.010 .020 .030 .040 .050)
- :channel-map '(4 3 2 1 0)))
-
- (with-sound (:channels 5 :reverb freeverb :reverb-channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .000 .000 .035 .279 .442 .483 .480
- .393 .207 .040 .018 .012 .012 .009 .003 .187 .393
- .482 .484 .441 .284 .061 .029 .011 .012 .011 .005
- .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
- .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
- ind 0 "dlocsig 13 0")
-
- (check-segments (vector .000 .000 .000 .000 .409 .500 .490 .380 .173 .035
- .035 .025 .030 .045 .046 .041 .243 .497 .497 .440
- .264 .035 .036 .031 .024 .039 .045 .043 .030 .014
- .008 .011 .011 .010 .007 .003 .002 .003 .003 .002
- .002 .001 .001 .001 .001 .001 .000 .000 .000 .000)
- ind 1 "dlocsig 13 1")
-
- (check-segments (vector .000 .000 .327 .500 .494 .148 .004 .005 .022 .043
- .051 .050 .041 .018 .164 .501 .505 .323 .004 .002
- .013 .033 .048 .048 .045 .029 .011 .012 .011 .005
- .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
- .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 13 2")
-
- (check-segments (vector .428 .499 .499 .249 .000 .000 .004 .011 .024 .035
- .035 .181 .406 .525 .534 .439 .023 .011 .012 .016
- .025 .035 .036 .088 .311 .039 .045 .043 .030 .014
- .008 .011 .011 .010 .007 .003 .002 .003 .003 .002
- .002 .001 .001 .001 .001 .001 .000 .000 .000 .000)
- ind 3 "dlocsig 13 3")
-
- (check-segments (vector .350 .194 .000 .000 .000 .000 .004 .008 .256 .436
- .511 .511 .453 .277 .035 .012 .009 .003 .004 .002
- .171 .380 .497 .511 .489 .029 .011 .012 .011 .005
- .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
- .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
- ind 4 "dlocsig 13 4")
-
-
- (with-sound (:channels 4)
- (dlocsig-sinewave-1 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f) :decode b-format-ambisonics))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .008 .008 .009 .009 .010 .011 .012
- .013 .014 .016 .018 .020 .023 .027 .032 .039 .048
- .063 .086 .129 .215 .374 .437 .440 .398 .252 .141
- .094 .067 .052 .041 .034 .029 .025 .022 .019 .017
- .015 .014 .013 .011 .011 .010 .009 .008 .008)
- ind 0 "dlocsig 14 0")
-
- (check-segments (vector .000 .000 .000 .007 .008 .008 .009 .009 .010 .011
- .012 .013 .014 .015 .017 .019 .022 .025 .029 .036
- .045 .062 .097 .180 .342 .337 .326 .275 .160 .075
- .048 .035 .029 .025 .021 .019 .017 .016 .014 .013
- .012 .011 .011 .010 .009 .009 .008 .008 .008)
- ind 1 "dlocsig 14 1")
-
- (check-segments (vector .000 .000 .000 .008 .008 .009 .010 .011 .012 .013
- .014 .016 .018 .021 .023 .027 .032 .038 .047 .058
- .076 .105 .155 .244 .362 .301 .301 .424 .317 .185
- .124 .088 .067 .053 .043 .036 .030 .026 .023 .020
- .018 .016 .014 .013 .012 .010 .010 .009 .008)
- ind 2 "dlocsig 14 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 14 3")
-
-
- (with-sound (:channels 4)
- (dlocsig-sinewave-1 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f) :decode decoded-ambisonics))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .011 .012 .013 .014 .015 .016 .018 .020
- .022 .024 .027 .030 .035 .041 .048 .058 .071 .092 .126
- .190 .319 .529 .509 .385 .179 .047 .015 .009 .007 .007
- .006 .006 .006 .006 .006 .005 .005 .005 .005 .005 .004
- .004 .004 .004 .004 .004)
- ind 0 "dlocsig 15 0")
-
- (check-segments (vector .000 .000 .000 .004 .004 .004 .004 .004 .005 .005 .005
- .006 .006 .006 .007 .008 .008 .009 .011 .013 .016 .022
- .036 .075 .199 .372 .491 .516 .365 .200 .133 .095 .074
- .059 .049 .042 .036 .032 .028 .025 .022 .021 .019 .017
- .016 .015 .014 .013 .012)
- ind 1 "dlocsig 15 1")
-
- (check-segments (vector .000 .000 .000 .004 .004 .004 .005 .005 .005 .006 .006
- .007 .008 .009 .010 .011 .013 .015 .019 .023 .029 .040
- .061 .105 .175 .130 .214 .258 .204 .126 .085 .060 .045
- .035 .028 .023 .019 .016 .014 .012 .010 .009 .008 .007
- .006 .006 .005 .005 .004)
- ind 2 "dlocsig 15 2")
-
- (check-segments (vector .000 .000 .000 .004 .004 .005 .005 .006 .006 .007 .008
- .009 .010 .012 .013 .016 .019 .023 .028 .036 .047 .064
- .093 .139 .187 .172 .087 .165 .113 .059 .039 .028 .022
- .018 .015 .013 .011 .010 .009 .008 .007 .007 .006 .006
- .005 .005 .004 .004 .004)
- ind 3 "dlocsig 15 3")
- ))); end dlocsig tests
-
- (let ((a4 (->frequency 'a4))
- (a440 (->frequency 440.0))
- (cs5 (->frequency 'cs5))
- (df3 (->frequency 'df3))
- (c1 (->frequency 'cn1))
- (b8 (->frequency 'b8)))
- (if (fneq a4 440.0) (snd-display ";a4->frequency: ~A" a4))
- (if (fneq a440 440.0) (snd-display ";a440->frequency: ~A" a440))
- (if (fneq cs5 554.365) (snd-display ";cs5->frequency: ~A" cs5))
- (if (fneq df3 138.591) (snd-display ";df3->frequency: ~A" df3))
- (if (fneq c1 32.703) (snd-display ";c1->frequency: ~A" c1))
- (if (fneq b8 7902.132) (snd-display ";b8->frequency: ~A" b8)))
-
- (let ((violins (make-sample->file "violins.snd" 1 mus-lfloat mus-next))
- (cellos (make-sample->file "cellos.snd" 1 mus-lfloat mus-next)))
-
- (define (violin beg dur freq amp)
- (with-temp-sound (:continue-old-file #t :output "violins.snd")
- (fm-violin beg dur (->frequency freq #t) amp)))
-
- (define (cello beg dur freq amp)
- (with-temp-sound (:continue-old-file #t :output "cellos.snd")
- (fm-violin beg dur (->frequency freq #t) amp :fm-index 1.5)))
-
- (violin 0 1 'e4 .2) (violin 1 1.5 'g4 .2) (violin 2.5 .5 'g3 .2)
- (cello 0 1 'c3 .2) (cello 1 1.5 'e3 .2) (cello 2.5 .5 'g2 .2)
-
- (let* ((index (new-sound "test.snd" :channels 1)) ; our overall output file
- (vs1 (mix "violins.snd"))
- (cs1 (mix "cellos.snd"))
- (vs (and (pair? vs1) (car vs1)))
- (cs (and (pair? cs1) (car cs1))))
-
- (mus-close violins)
- (mus-close cellos)
+ (check-segments (vector .351 .304 .256 .200 .145 .084 .024 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .057 .115 .174 .232 .282 .331 .373 .411
+ .443 .467 .485 .496 .499 .499 .494 .482 .462 .436)
+ ind 0 "dlocsig 6 0")
+
+ (check-segments (vector .393 .426 .455 .476 .491 .498 .500 .497 .489 .474
+ .451 .421 .386 .343 .298 .246 .189 .134 .073 .014
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .006 .068 .126 .185 .239 .292)
+ ind 1 "dlocsig 6 1")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .034 .096 .153 .211
+ .266 .314 .360 .398 .432 .460 .480 .493 .499 .500
+ .496 .486 .470 .445 .416 .378 .335 .289 .236 .182
+ .123 .061 .002 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 6 2")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .045
+ .107 .164 .221 .272 .323 .368 .405 .438 .463 .483
+ .495 .499 .499 .495 .485 .466 .440 .409 .371 .328
+ .279 .225 .171 .111 .053 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 6 3")
+
+
+ (with-sound (:channels 8) (dloc-sinewave 0 3.0 440 .5 :path (make-spiral-path :turns 3)))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .350 .010 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .099 .429 .500 .493 .280 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .168 .465 .500 .480 .214 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .235 .486 .499)
+ ind 0 "dlocsig 7 0")
+
+ (check-segments (vector .499 .500 .378 .042 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .069 .408 .500 .497 .320
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .129 .447 .499 .488 .248 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .201)
+ ind 1 "dlocsig 7 1")
+
+ (check-segments (vector .000 .319 .497 .500 .408 .070 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .036 .377 .500
+ .499 .351 .015 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .097 .429 .500 .493 .289 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 7 2")
+
+ (check-segments (vector .000 .000 .000 .279 .493 .500 .430 .101 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .009
+ .348 .498 .500 .385 .043 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .068 .402 .500 .497
+ .321 .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 7 3")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .245 .487 .499 .452 .138
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .311 .496 .500 .409 .071 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .034 .376
+ .500 .499 .352 .018 .000 .000 .000 .000 .000 .000)
+ ind 4 "dlocsig 7 4")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .204 .478 .500
+ .467 .171 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .278 .493 .500 .431 .108 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .008 .347 .498 .500 .386 .044 .000 .000 .000 .000)
+ ind 5 "dlocsig 7 5")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .170
+ .466 .500 .478 .212 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .243 .486 .499 .453
+ .139 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .309 .496 .500 .411 .074 .000 .000)
+ ind 6 "dlocsig 7 6")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .137 .448 .499 .488 .246 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .202 .477
+ .500 .467 .173 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .276 .493 .500 .436 .109)
+ ind 7 "dlocsig 7 7")
+
+
+ (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-literal-path '((-10 10) (10 10)) :polar #f)))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .000 .308 .318 .327 .336 .344 .354 .362 .370 .378
+ .386 .392 .398 .403 .408 .410 .412 .412 .412 .411
+ .408 .403 .396 .388 .378 .346 .352 .328 .324 .307
+ .289 .272 .253 .235 .216 .199 .180 .163 .146 .131
+ .116 .101 .087 .075 .064 .052 .042 .033 .025)
+ ind 0 "dlocsig 8 0")
+
+ (check-segments (vector .000 .009 .016 .023 .032 .041 .050 .062 .073 .085
+ .099 .113 .128 .143 .161 .178 .195 .213 .232 .250
+ .268 .286 .304 .321 .329 .344 .353 .375 .386 .394
+ .402 .407 .410 .412 .413 .412 .411 .409 .404 .399
+ .394 .387 .380 .372 .363 .355 .346 .337 .329)
+ ind 1 "dlocsig 8 1")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 8 2")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 8 3")
+
+
+ (with-sound (:channels 3) (dloc-sinewave 0 1.0 440 .5 :path (make-literal-path '((-10 10) (10 10)) :polar #t)))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .000 .000 .004 .004 .004 .004 .005 .005 .006 .006
+ .007 .007 .008 .009 .011 .012 .014 .017 .020 .025
+ .033 .044 .066 .102 .215 .406 .490 .443 .345 .281
+ .180 .121 .090 .069 .056 .046 .039 .034 .029 .026
+ .023 .021 .019 .017 .015 .014 .013 .012 .011 .011)
+ ind 0 "dlocsig 9 0")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .002 .141 .383 .495 .475 .434 .401
+ .257 .173 .129 .098 .080 .066 .055 .048 .042 .037
+ .033 .029 .027 .024 .022 .020 .019 .017 .016 .015)
+ ind 1 "dlocsig 9 1")
+
+ (check-segments (vector .000 .000 .017 .018 .019 .021 .023 .024 .026 .029
+ .032 .035 .039 .044 .050 .058 .066 .079 .096 .118
+ .155 .208 .310 .482 .491 .497 .499 .372 .137 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 9 2")
+
+
+ (with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :total-angle 360 :distance '(0 10 1 30 2 10))))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .348 .227 .134 .065 .013 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .010 .024 .041 .058 .077 .097
+ .120 .144 .168 .195 .222 .251 .280 .306 .331)
+ ind 0 "dlocsig 10 0")
+
+ (check-segments (vector .353 .347 .329 .306 .280 .253 .226 .198 .174 .148
+ .126 .104 .083 .064 .046 .031 .016 .003 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .013 .067 .141)
+ ind 1 "dlocsig 10 1")
+
+ (check-segments (vector .000 .000 .000 .000 .025 .056 .082 .100 .114 .124
+ .131 .135 .137 .137 .136 .135 .131 .127 .122 .116
+ .110 .104 .097 .089 .082 .074 .067 .063 .057 .051
+ .044 .035 .025 .015 .003 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 10 2")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .009 .020 .030
+ .039 .046 .053 .059 .064 .069 .077 .084 .092 .099
+ .106 .113 .119 .125 .130 .133 .136 .137 .137 .136
+ .132 .126 .116 .103 .085 .060 .026 .000 .000)
+ ind 3 "dlocsig 10 3")
+
+
+ (set-speaker-configuration (arrange-speakers :speakers '(-45 45 90 135 225)
+ :delays '(.010 .020 .030 .040 .050)
+ :channel-map '(0 1 3 2 4)))
+
+ (with-sound (:channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .350 .297 .187 .058 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .056 .178 .296 .387 .457
+ .493 .499 .496 .465 .400 .313 .198 .077 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .036
+ .167 .280 .379 .449 .491 .500 .498 .469 .411 .000)
+ ind 0 "dlocsig 11 0")
+
+ (check-segments (vector .355 .432 .483 .499 .499 .434 .220 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .115 .240 .342 .426 .478 .499 .500 .454
+ .245 .017 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .103 .223 .289 .000)
+ ind 1 "dlocsig 11 1")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .011 .237 .450
+ .500 .500 .479 .428 .350 .243 .126 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .212 .429 .499 .499 .484 .438 .358 .260
+ .137 .013 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 11 2")
+
+ (check-segments (vector .000 .000 .000 .000 .111 .359 .489 .500 .486 .339
+ .097 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .088 .330
+ .480 .500 .490 .371 .119 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 11 3")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .072 .194 .309 .398 .464 .496 .500 .494 .459
+ .391 .299 .189 .060 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .053 .183 .294 .390 .456
+ .494 .500 .496 .464 .402 .314 .200 .079 .000 .000)
+ ind 4 "dlocsig 11 4")
+
+
+ (with-sound (:channels 5 :reverb freeverb :reverb-channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .350 .194 .013 .028 .020 .011 .012 .006 .246 .427
+ .502 .504 .450 .281 .064 .041 .021 .011 .012 .009
+ .169 .377 .489 .502 .480 .052 .058 .043 .015 .015
+ .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
+ .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
+ ind 0 "dlocsig 12 0")
+
+ (check-segments (vector .428 .499 .500 .244 .015 .018 .018 .007 .009 .007
+ .012 .151 .355 .479 .499 .417 .044 .046 .042 .025
+ .012 .012 .016 .071 .273 .036 .030 .035 .051 .049
+ .031 .020 .014 .011 .011 .010 .009 .005 .002 .003
+ .003 .002 .002 .001 .001 .001 .001 .001 .000 .000)
+ ind 1 "dlocsig 12 1")
+
+ (check-segments (vector .000 .009 .013 .028 .411 .502 .484 .374 .175 .007
+ .006 .023 .043 .050 .049 .041 .252 .488 .488 .421
+ .252 .015 .003 .012 .031 .052 .058 .043 .015 .015
+ .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
+ .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
+ ind 2 "dlocsig 12 2")
+
+ (check-segments (vector .000 .011 .331 .493 .487 .149 .018 .007 .009 .007
+ .012 .026 .036 .036 .137 .473 .480 .315 .042 .025
+ .012 .012 .016 .024 .034 .036 .030 .035 .051 .049
+ .031 .020 .014 .011 .011 .010 .009 .005 .002 .003
+ .003 .002 .002 .001 .001 .001 .001 .001 .000 .000)
+ ind 3 "dlocsig 12 3")
+
+ (check-segments (vector .000 .009 .013 .028 .020 .032 .277 .443 .502 .502
+ .430 .244 .043 .050 .049 .041 .021 .011 .198 .397
+ .492 .496 .464 .318 .082 .052 .058 .043 .015 .015
+ .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
+ .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
+ ind 4 "dlocsig 12 4")
+
+
+ (set-speaker-configuration (arrange-speakers :speakers '(-45 45 90 135 225)
+ :delays '(.010 .020 .030 .040 .050)
+ :channel-map '(4 3 2 1 0)))
+
+ (with-sound (:channels 5 :reverb freeverb :reverb-channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .000 .000 .000 .000 .000 .035 .279 .442 .483 .480
+ .393 .207 .040 .018 .012 .012 .009 .003 .187 .393
+ .482 .484 .441 .284 .061 .029 .011 .012 .011 .005
+ .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
+ .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
+ ind 0 "dlocsig 13 0")
+
+ (check-segments (vector .000 .000 .000 .000 .409 .500 .490 .380 .173 .035
+ .035 .025 .030 .045 .046 .041 .243 .497 .497 .440
+ .264 .035 .036 .031 .024 .039 .045 .043 .030 .014
+ .008 .011 .011 .010 .007 .003 .002 .003 .003 .002
+ .002 .001 .001 .001 .001 .001 .000 .000 .000 .000)
+ ind 1 "dlocsig 13 1")
+
+ (check-segments (vector .000 .000 .327 .500 .494 .148 .004 .005 .022 .043
+ .051 .050 .041 .018 .164 .501 .505 .323 .004 .002
+ .013 .033 .048 .048 .045 .029 .011 .012 .011 .005
+ .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
+ .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
+ ind 2 "dlocsig 13 2")
+
+ (check-segments (vector .428 .499 .499 .249 .000 .000 .004 .011 .024 .035
+ .035 .181 .406 .525 .534 .439 .023 .011 .012 .016
+ .025 .035 .036 .088 .311 .039 .045 .043 .030 .014
+ .008 .011 .011 .010 .007 .003 .002 .003 .003 .002
+ .002 .001 .001 .001 .001 .001 .000 .000 .000 .000)
+ ind 3 "dlocsig 13 3")
+
+ (check-segments (vector .350 .194 .000 .000 .000 .000 .004 .008 .256 .436
+ .511 .511 .453 .277 .035 .012 .009 .003 .004 .002
+ .171 .380 .497 .511 .489 .029 .011 .012 .011 .005
+ .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
+ .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
+ ind 4 "dlocsig 13 4")
+
+
+ (with-sound (:channels 4)
+ (dlocsig-sinewave-1 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f) :decode b-format-ambisonics))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .000 .000 .000 .008 .008 .009 .009 .010 .011 .012
+ .013 .014 .016 .018 .020 .023 .027 .032 .039 .048
+ .063 .086 .129 .215 .374 .437 .440 .398 .252 .141
+ .094 .067 .052 .041 .034 .029 .025 .022 .019 .017
+ .015 .014 .013 .011 .011 .010 .009 .008 .008)
+ ind 0 "dlocsig 14 0")
+
+ (check-segments (vector .000 .000 .000 .007 .008 .008 .009 .009 .010 .011
+ .012 .013 .014 .015 .017 .019 .022 .025 .029 .036
+ .045 .062 .097 .180 .342 .337 .326 .275 .160 .075
+ .048 .035 .029 .025 .021 .019 .017 .016 .014 .013
+ .012 .011 .011 .010 .009 .009 .008 .008 .008)
+ ind 1 "dlocsig 14 1")
+
+ (check-segments (vector .000 .000 .000 .008 .008 .009 .010 .011 .012 .013
+ .014 .016 .018 .021 .023 .027 .032 .038 .047 .058
+ .076 .105 .155 .244 .362 .301 .301 .424 .317 .185
+ .124 .088 .067 .053 .043 .036 .030 .026 .023 .020
+ .018 .016 .014 .013 .012 .010 .010 .009 .008)
+ ind 2 "dlocsig 14 2")
+
+ (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
+ .000 .000 .000 .000 .000 .000 .000 .000 .000)
+ ind 3 "dlocsig 14 3")
+
+
+ (with-sound (:channels 4)
+ (dlocsig-sinewave-1 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f) :decode decoded-ambisonics))
+ (set! ind (find-sound "test.snd"))
+
+ (check-segments (vector .000 .000 .000 .011 .012 .013 .014 .015 .016 .018 .020
+ .022 .024 .027 .030 .035 .041 .048 .058 .071 .092 .126
+ .190 .319 .529 .509 .385 .179 .047 .015 .009 .007 .007
+ .006 .006 .006 .006 .006 .005 .005 .005 .005 .005 .004
+ .004 .004 .004 .004 .004)
+ ind 0 "dlocsig 15 0")
+
+ (check-segments (vector .000 .000 .000 .004 .004 .004 .004 .004 .005 .005 .005
+ .006 .006 .006 .007 .008 .008 .009 .011 .013 .016 .022
+ .036 .075 .199 .372 .491 .516 .365 .200 .133 .095 .074
+ .059 .049 .042 .036 .032 .028 .025 .022 .021 .019 .017
+ .016 .015 .014 .013 .012)
+ ind 1 "dlocsig 15 1")
+
+ (check-segments (vector .000 .000 .000 .004 .004 .004 .005 .005 .005 .006 .006
+ .007 .008 .009 .010 .011 .013 .015 .019 .023 .029 .040
+ .061 .105 .175 .130 .214 .258 .204 .126 .085 .060 .045
+ .035 .028 .023 .019 .016 .014 .012 .010 .009 .008 .007
+ .006 .006 .005 .005 .004)
+ ind 2 "dlocsig 15 2")
+
+ (check-segments (vector .000 .000 .000 .004 .004 .005 .005 .006 .006 .007 .008
+ .009 .010 .012 .013 .016 .019 .023 .028 .036 .047 .064
+ .093 .139 .187 .172 .087 .165 .113 .059 .039 .028 .022
+ .018 .015 .013 .011 .010 .009 .008 .007 .007 .006 .006
+ .005 .005 .004 .004 .004)
+ ind 3 "dlocsig 15 3")
+ ))); end dlocsig tests
+
+ (let ((a4 (->frequency 'a4))
+ (a440 (->frequency 440.0))
+ (cs5 (->frequency 'cs5))
+ (df3 (->frequency 'df3))
+ (c1 (->frequency 'cn1))
+ (b8 (->frequency 'b8)))
+ (if (fneq a4 440.0) (snd-display #__line__ ";a4->frequency: ~A" a4))
+ (if (fneq a440 440.0) (snd-display #__line__ ";a440->frequency: ~A" a440))
+ (if (fneq cs5 554.365) (snd-display #__line__ ";cs5->frequency: ~A" cs5))
+ (if (fneq df3 138.591) (snd-display #__line__ ";df3->frequency: ~A" df3))
+ (if (fneq c1 32.703) (snd-display #__line__ ";c1->frequency: ~A" c1))
+ (if (fneq b8 7902.132) (snd-display #__line__ ";b8->frequency: ~A" b8)))
+
+ (let ((violins (make-sample->file "violins.snd" 1 mus-lfloat mus-next))
+ (cellos (make-sample->file "cellos.snd" 1 mus-lfloat mus-next)))
+
+ (define (violin beg dur freq amp)
+ (with-temp-sound (:continue-old-file #t :output "violins.snd")
+ (fm-violin beg dur (->frequency freq #t) amp)))
+
+ (define (cello beg dur freq amp)
+ (with-temp-sound (:continue-old-file #t :output "cellos.snd")
+ (fm-violin beg dur (->frequency freq #t) amp :fm-index 1.5)))
+
+ (violin 0 1 'e4 .2) (violin 1 1.5 'g4 .2) (violin 2.5 .5 'g3 .2)
+ (cello 0 1 'c3 .2) (cello 1 1.5 'e3 .2) (cello 2.5 .5 'g2 .2)
+
+ (let* ((index (new-sound "test.snd" :channels 1)) ; our overall output file
+ (vs1 (mix "violins.snd"))
+ (cs1 (mix "cellos.snd"))
+ (vs (and (pair? vs1) (car vs1)))
+ (cs (and (pair? cs1) (car cs1))))
+
+ (mus-close violins)
+ (mus-close cellos)
+
+ (if (mix? vs)
+ (let ((vsr (make-mix-sampler vs))
+ (csr (make-mix-sampler cs))
+ (fsr (make-sampler 0 index)))
- (if (mix? vs)
- (let ((vsr (make-mix-sampler vs))
- (csr (make-mix-sampler cs))
- (fsr (make-sampler 0 index)))
-
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (let ((v (vsr))
- (c (csr))
- (f (fsr)))
- (if (fneq f (+ c v))
- (snd-display ";multi temp output: ~A != ~A + ~A" f v c))))
-
- (free-sampler vsr)
- (free-sampler csr)
- (free-sampler fsr)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (let ((v (vsr))
+ (c (csr))
+ (f (fsr)))
+ (if (fneq f (+ c v))
+ (snd-display #__line__ ";multi temp output: ~A != ~A + ~A" f v c))))
- (close-sound index)
- (if (file-exists? "violins.snd") (delete-file "violins.snd"))
- (if (file-exists? "cellos.snd") (delete-file "cellos.snd"))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v1) .1) (snd-display ";with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v2) .1) (snd-display ";with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
- (if (not (vequal v1 v2)) (snd-display ";with-sound -> vct v1 v2 not equal?"))
- (set! (optimization) 6)
- (sound-let ((tmp () (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)))
- (let ((v3 (make-vct 2210)))
- (file->array tmp 0 0 2205 v3)
- (if (not (vequal v1 v3)) (snd-display ";with-sound -> vct v1 v3 not equal?"))))
- (with-sound (:output v1)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (vct-peak v1) .2) (snd-display ";with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v1)) .1) (snd-display ";with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v2)) .1) (snd-display ";with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (if (not (sd-equal v1 v2)) (snd-display ";with-sound -> sound-data v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (car (sound-data-maxamp v1)) .2) (snd-display ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
- (let ((oldopt (optimization)))
- (set! (locsig-type) mus-interp-linear)
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 2 2210))
- (if (not (= (mus-channels *output*) 2)) (snd-display ";with-sound *output* chans: ~A" (mus-channels *output*)))
- (fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v1)) .05) (snd-display ";with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
- (if (fneq (cadr (sound-data-maxamp v1)) .05) (snd-display ";with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 2 2210))
- (fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v2)) .05) (snd-display ";with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
- (if (fneq (cadr (sound-data-maxamp v2)) .05) (snd-display ";with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
- (if (not (sd-equal v1 v2)) (snd-display ";with-sound (2 chans) -> sound-data v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1)
- (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0))
- (if (fneq (car (sound-data-maxamp v1)) .2) (snd-display ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v1) .3)
- (snd-display ";with-sound -> vct fm-violin maxamp (opt, scaled-to): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v2) .3)
- (snd-display ";with-sound -> vct fm-violin maxamp scaled-to: ~A" (vct-peak v2)))
- (if (not (vequal v1 v2)) (snd-display ";with-sound (scaled-to) -> vct v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1 :scaled-by 2.0)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (vct-peak v1) .4) (snd-display ";with-sound -> vct fm-violin maxamp (opt 2 scaled-by): ~A" (vct-peak v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v1)) .5)
- (snd-display ";with-sound -> sound-data fm-violin maxamp (opt, scaled-to): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v2)) .5)
- (snd-display ";with-sound -> sound-data fm-violin maxamp scaled-to: ~A" (sound-data-maxamp v2)))
- (if (not (sd-equal v1 v2)) (snd-display ";with-sound scaled-to -> sound-data v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1 :scaled-by 0.5)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (car (sound-data-maxamp v1)) .1)
- (snd-display ";with-sound -> sound-data fm-violin maxamp (opt 2 scaled-by): ~A" (sound-data-maxamp v1))))))
-
- (let ((stats-string ""))
- (let ((v1 (with-sound (:output (make-vct 2210) :statistics (lambda (str) (set! stats-string str)))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (and (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.000\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.001\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.002\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.010\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.180\n")))
- (snd-display ";with-sound to vct stats: [~A]" stats-string)))
- (let ((v1 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5 :statistics (lambda (str) (set! stats-string str)))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (and (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.000\n"))
- (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.001\n"))
- (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.002\n"))
- (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.010\n")))
- (snd-display ";with-sound to sound-data stats: [~A]" stats-string)))
-
- (with-sound (:output (make-sound-data 4 2210) :channels 4 :statistics (lambda (str) (set! stats-string str)))
- (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))
- )
-
- (for-each
- (lambda (n)
- (set! (optimization) n)
-
- ;; testing overwrites here -- just hope we don't crash...
- (let ((v1 (with-sound (:output (make-vct 20) :channels 1)
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-ref v1 0) 0.0) (snd-display ";overwrite vct with-sound: ~A (~A)" (vct-ref v1 0) (vct-peak v1))))
-
- (let ((v1 (with-sound (:output (make-vct 20) :channels 4)
- (fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-ref v1 0) 0.0) (snd-display ";overwrite vct with-sound (4): ~A (~A)" (vct-ref v1 0) (vct-peak v1))))
-
- (let ((v1 (with-sound (:output (make-sound-data 4 20) :channels 4)
- (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i))) ((= i 4))
- (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display ";overwrite sd ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
-
- (let ((v1 (with-sound (:output (make-sound-data 2 20) :channels 4)
- (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i))) ((= i 2))
- (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display ";overwrite sd (2) ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
-
- (let ((v1 (with-sound (:output (make-sound-data 4 20) :channels 1)
- (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
- (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i))) ((= i 4))
- (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display ";overwrite sd (4) ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
- )
- (list 0 3 6))
-
- ;; reverb cases parallel to above
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 44100) :reverb jc-reverb)
- (if (not (= (mus-length *output*) 44100)) (snd-display ";ws mus-length vct: ~A" (mus-length *output*)))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0 :reverb-amount 0.9)))
- (v4 (with-sound (:output (make-vct 44100))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (vequal v1 v4) (snd-display ";reverb output not written to vct?"))
- (if (< (vct-peak v1) .29)
- (snd-display ";rev with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (vct-peak v2) .29)
- (snd-display ";rev with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :channels 1 :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (vct-peak v1) .29)
- (snd-display ";rev with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 44100) :reverb jc-reverb)
- (if (not (= (mus-length *output*) 44100)) (snd-display ";ws mus-length sd: ~A" (mus-length *output*)))
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
- (v4 (with-sound (:output (make-sound-data 1 44100))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (sd-equal v1 v4) (snd-display ";reverb output not written to sd?"))
- (if (< (car (sound-data-maxamp v1)) .23)
- (snd-display ";rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .23)
- (snd-display ";rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .55)
- (snd-display ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
- (let ((oldopt (optimization)))
- (set! (locsig-type) mus-interp-linear)
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 2 44100) :reverb jc-reverb)
- (if (not (= (mus-channels *output*) 2))
- (snd-display ";rev with-sound *output* chans: ~A" (mus-channels *output*)))
- (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v1)) .23)
- (snd-display ";rev with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
- (if (< (cadr (sound-data-maxamp v1)) .23)
- (snd-display ";rev with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 2 44100) :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .23)
- (snd-display ";rev with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
- (if (< (cadr (sound-data-maxamp v2)) .23)
- (snd-display ";rev with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
- (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .56)
- (snd-display ";rev with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 44100) :revfile (make-vct 44100) :reverb jc-reverb)
- (if (not (= (mus-length *output*) 44100)) (snd-display ";1 ws mus-length vct: ~A" (mus-length *output*)))
- (if (not (= (mus-length *reverb*) 44100)) (snd-display ";1 ws mus-length vct rev: ~A" (mus-length *reverb*)))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0 :reverb-amount 0.9)))
- (v4 (with-sound (:output (make-vct 44100))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (vequal v1 v4) (snd-display ";1 reverb output not written to vct?"))
- (if (< (vct-peak v1) .28)
- (snd-display ";1 rev with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 44100) :revfile (make-vct 44100) :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (vct-peak v2) .28)
- (snd-display ";1 rev with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :channels 1 :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (vct-peak v1) .28)
- (snd-display ";1 rev with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
- (if (not (= (mus-length *output*) 44100)) (snd-display ";ws mus-length sd: ~A" (mus-length *output*)))
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
- (v4 (with-sound (:output (make-sound-data 1 44100))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (sd-equal v1 v4) (snd-display ";2 reverb output not written to sd?"))
- (if (< (car (sound-data-maxamp v1)) .28)
- (snd-display ";2 rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .28)
- (snd-display ";2 rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .54)
- (snd-display ";2 with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 0)
- (let ((v1 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
- (if (not (= (mus-length *output*) 44100)) (snd-display ";ws mus-length sd: ~A" (mus-length *output*)))
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
- (v4 (with-sound (:output (make-sound-data 1 44100))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (sd-equal v1 v4) (snd-display ";2 reverb output not written to sd?"))
- (if (< (car (sound-data-maxamp v1)) .28)
- (snd-display ";2 rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .28)
- (snd-display ";2 rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
- (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .5)
- (snd-display ";2 with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
- (let ((oldopt (optimization)))
- (set! (locsig-type) mus-interp-linear)
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 2 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
- (if (not (= (mus-channels *output*) 2))
- (snd-display ";3 rev with-sound *output* chans: ~A" (mus-channels *output*)))
- (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v1)) .23)
- (snd-display ";3 rev with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
- (if (< (cadr (sound-data-maxamp v1)) .23)
- (snd-display ";3 rev with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 2 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .23)
- (snd-display ";3 rev with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
- (if (< (cadr (sound-data-maxamp v2)) .23)
- (snd-display ";3 rev with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
- (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
- (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .56)
- (snd-display ";3 rev with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
-
- (let ((oldopt (optimization)))
- (for-each
- (lambda (n)
- (set! (optimization) n)
- (let ((v1 (with-sound (:output (make-vct 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (v2 (with-sound (:output (make-vct 400))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (v3 (with-sound (:output (make-vct 400))
- (simple-outn 0 .1 440 0.0 .5 0.0 0.0 0.0 0.0)))
- (v4 (with-sound (:output (make-vct 44100) :reverb jc-reverb)
- (simple-outn 0 .1 440 0.2 0.0 0.0 0.0 0.05 0.0)))
- (v5 (with-sound (:output (make-vct 44100) :reverb simple-in-rev :reverb-data '(0.0 1.0 1.0 0.0))
- (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.0)))
- (v6 (with-sound (:output (make-vct 400))
- (simple-outn 0 .1 440 0.5 0.0 0.0 0.0 0.0 0.0)
- (simple-outn 0 .1 440 0.2 0.0 0.0 0.0 0.0 0.0)))
- (sd1 (with-sound (:output (make-sound-data 1 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (sd2 (with-sound (:output (make-sound-data 4 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (sd3 (with-sound (:output (make-sound-data 2 44100))
- (simple-outn 0 .1 440 0.0 0.0 .3 .4 0.0 0.0)))
- (sd4 (with-sound (:output (make-sound-data 4 44100) :reverb simple-in-rev :reverb-channels 2 :reverb-data '(0.0 1.0 1.0 1.0))
- (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.25)))
- (sd5 (with-sound (:output (make-sound-data 4 44100) :reverb simple-in-rev :reverb-channels 1 :reverb-data '(0.0 1.0 1.0 1.0))
- (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.25)))
- (sd6 (with-sound (:output (make-sound-data 4 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))))
- (if (fneq (vct-peak v1) 0.1) (snd-display ";outa tests 1 ~A: ~A" n (vct-peak v1)))
- (if (fneq (vct-peak v2) 0.1) (snd-display ";outa tests 2 ~A: ~A" n (vct-peak v2)))
- (if (fneq (vct-peak v3) 0.0) (snd-display ";outa tests 3 ~A: ~A" n (vct-peak v3)))
- (if (< (vct-peak v4) 0.2) (snd-display ";outa tests 4 ~A: ~A" n (vct-peak v4)))
- (if (fneq (vct-peak v5) 0.5) (snd-display ";outa tests 5 ~A: ~A" n (vct-peak v5)))
- (if (fneq (vct-peak v6) 0.7) (snd-display ";outa tests 11 ~A: ~A" n (vct-peak v6)))
-
- (let ((mx1 (sound-data-maxamp sd1)))
- (if (not (feql mx1 (list .1))) (snd-display ";outa tests 6 ~A: ~A" n mx1)))
- (let ((mx2 (sound-data-maxamp sd2)))
- (if (not (feql mx2 (list .1 .2 .3 .4))) (snd-display ";outa tests 7 ~A: ~A" n mx2)))
- (let ((mx3 (sound-data-maxamp sd3)))
- (if (not (feql mx3 (list 0.0 0.0))) (snd-display ";outa tests 8 ~A: ~A" n mx3)))
- (let ((mx4 (sound-data-maxamp sd4)))
- (if (not (feql mx4 (list 0.5 0.25 0.0 0.0))) (snd-display ";outa tests 9 ~A: ~A" n mx4)))
- (let ((mx5 (sound-data-maxamp sd5)))
- (if (not (feql mx5 (list 0.5 0.0 0.0 0.0))) (snd-display ";outa tests 10 ~A: ~A" n mx5)))
- (let ((mx6 (sound-data-maxamp sd6)))
- (if (not (feql mx6 (list .2 .4 .6 .8))) (snd-display ";outa tests 12 ~A: ~A" n mx6)))
-
- (with-sound (:output v1 :continue-old-file #t)
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))
- (if (fneq (vct-peak v1) 0.2) (snd-display ";outa tests 13 ~A: ~A" n (vct-peak v1)))
-
- (with-sound (:output sd2 :continue-old-file #t)
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))
- (let ((mx7 (sound-data-maxamp sd2)))
- (if (not (feql mx7 (list .2 .4 .6 .8))) (snd-display ";outa tests 14 ~A: ~A" n mx7)))))
- (list 0 6))
- (set! (optimization) oldopt))
-
- (let* ((file (with-sound ()
- (fm-violin 0 .1 880 .1 :random-vibrato-amplitude 0.0)
- (let ((v1 (with-temp-sound (:output (make-vct 2210))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)))
- (sd1 (with-temp-sound (:output (make-sound-data 1 2210))
- (fm-violin 0 .1 660 .1 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i)))
- ((= i 2205))
- (outa i (+ (vct-ref v1 i) (sound-data-ref sd1 0 i)))))
- (fm-violin 0 .1 220.0 .1 :random-vibrato-amplitude 0.0)))
- (ind (find-sound file)))
- (if (not (sound? ind))
- (snd-display ";can't find mixed with-sound output")
- (let ((mx (maxamp ind 0)))
- (if (< mx .35) (snd-display ";mixed with-sound max: ~A" mx))
- (if (not (vequal (channel->vct 1000 10) (vct 0.255 0.275 0.316 0.364 0.391 0.379 0.337 0.283 0.228 0.170)))
- (snd-display ";mixed with-sound: ~A" (channel->vct 1000 10)))
- (close-sound ind))))
-
- (let* ((file (with-sound ()
- (fm-violin 0 .1 880 .1 :random-vibrato-amplitude 0.0)
- (sound-let ((v1 (:output (make-vct 2210))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (sd1 (:output (make-sound-data 1 2210))
- (fm-violin 0 .1 660 .1 :random-vibrato-amplitude 0.0))
- (fs1 ()
- (fm-violin 0 .1 110 .1 :random-vibrato-amplitude 0.0)))
- (mus-mix *output* fs1)
- (do ((i 0 (+ 1 i)))
- ((= i 2205))
- (outa i (+ (vct-ref v1 i) (sound-data-ref sd1 0 i)))))
- (fm-violin 0 .1 220.0 .1 :random-vibrato-amplitude 0.0)))
- (ind (find-sound file)))
- (if (not (sound? ind))
- (snd-display ";can't find mixed with-sound sound-let output")
- (let ((mx (maxamp ind 0)))
- (if (< mx .375) (snd-display ";mixed with-sound max: ~A" mx))
- (if (not (vequal (channel->vct 1000 10) (vct 0.349 0.370 0.412 0.461 0.489 0.478 0.436 0.383 0.328 0.270)))
- (snd-display ";mixed with-sound via sound-let: ~A" (channel->vct 1000 10)))
- (close-sound ind))))
-
-
- (let* ((res (with-mixed-sound () (fm-violin 0 .1 440 .1)))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";with-mixed-sound (1): ~A?" res))
- (let ((mxs (mixes snd 0))
- (info (sound-property 'with-mixed-sound-info snd)))
- (if (not (list? mxs))
- (snd-display ";with-mixed-sound (1) mixes: ~A" mxs))
- (if (or (not (equal? (car (list-ref info 0)) (car mxs)))
- (not (= (cadr (list-ref info 0)) 0))
- (not (= (caddr (list-ref info 0)) 1)))
- (snd-display ";with-mixed-sound info (1) 0: ~A" (list-ref info 0)))
- (if (ffneq (maxamp snd) .1)
- (snd-display ";with-mixed-sound (1) 0: ~A" (maxamp snd)))
- (close-sound snd)))
-
- (let* ((res (with-mixed-sound (:srate 44100)
- (fm-violin 0 .1 440 .1)
- (fm-violin 1 .1 660 .1)))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";with-mixed-sound (2): ~A?" res))
- (let ((mxs (mixes snd 0))
- (info (sound-property 'with-mixed-sound-info snd)))
- (if (or (not (list? mxs))
- (not (= (length mxs) 2)))
- (snd-display ";with-mixed-sound mixes (2): ~A" mxs))
- (if (or (not (equal? (car (list-ref info 0)) (car mxs)))
- (not (= (cadr (list-ref info 0)) 0))
- (not (= (caddr (list-ref info 0)) 1)))
- (snd-display ";with-mixed-sound info (2) 0: ~A" (list-ref info 0)))
- (if (or (not (equal? (car (list-ref info 1)) (cadr mxs)))
- (not (= (cadr (list-ref info 1)) 44100))
- (not (= (caddr (list-ref info 1)) 1)))
- (snd-display ";with-mixed-sound info (2) 1: ~A" (list-ref info 1)))
- (if (or (not (= (frames snd) 48510))
- (fneq (maxamp snd) .1))
- (snd-display ";with-mixed-sound 0 (2): ~A ~A" (frames snd) (maxamp snd)))
- (close-sound snd)))
-
- (let* ((res (with-mixed-sound (:channels 2 :srate 44100)
- (fm-violin 0 .1 440 .1 :degree 0)
- (fm-violin 1 .1 660 .1 :degree 45)))
- (snd (find-sound res))
- (mxs (mixes snd))
- (info (sound-property 'with-mixed-sound-info snd)))
- (if (or (not (= (length mxs) 2))
- (not (= (length (car mxs)) 2))
- (not (= (length info) 2))
- (not (equal? (caar info) (caar mxs))))
- (snd-display ";with-mixed-sound (3) 1: ~A ~A" mxs info))
- (close-sound snd))
-
- (let* ((res (with-marked-sound ()
- (fm-violin 0 .1 440 .1)
- (fm-violin 1 .1 660 .1)))
- (snd (find-sound res))
- (mxs (marks snd 0)))
- (if (not (= (length mxs) 2))
- (snd-display ";with-marked-sound marks: ~A " mxs))
- (if (not (string=? (mark-name (car mxs)) "fm-violin 0 0.1"))
- (snd-display ";with-marked-sound name: ~A" (mark-name (car mxs))))
- (if (fneq (maxamp snd) .1)
- (snd-display ";with-marked-sound maxamp: ~A" (maxamp snd)))
- (close-sound snd))
-
- (reset-hook! mark-click-hook)
- (reset-hook! mix-click-hook)
- (reset-hook! mix-drag-hook)
-
-
- ;; generators.scm
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-ercos 100 :r 1.0)))
- (run
+ (free-sampler vsr)
+ (free-sampler csr)
+ (free-sampler fsr)))
+
+ (close-sound index)
+ (if (file-exists? "violins.snd") (delete-file "violins.snd"))
+ (if (file-exists? "cellos.snd") (delete-file "cellos.snd"))))
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-vct 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (vct-peak v1) .1) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-vct 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (vct-peak v2) .1) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
+ (if (not (vequal v1 v2)) (snd-display #__line__ ";with-sound -> vct v1 v2 not equal?"))
+ (set! (optimization) 6)
+ (sound-let ((tmp () (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)))
+ (let ((v3 (make-vct 2210)))
+ (file->array tmp 0 0 2205 v3)
+ (if (not (vequal v1 v3)) (snd-display #__line__ ";with-sound -> vct v1 v3 not equal?"))))
+ (with-sound (:output v1)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
+ (if (fneq (vct-peak v1) .2) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-sound-data 1 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (car (sound-data-maxamp v1)) .1) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 1 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (car (sound-data-maxamp v2)) .1) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
+ (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound -> sound-data v1 v2 not equal?"))
+ (set! (optimization) 6)
+ (with-sound (:output v1)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
+ (if (fneq (car (sound-data-maxamp v1)) .2) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (locsig-type) mus-interp-linear)
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-sound-data 2 2210))
+ (if (not (= (mus-channels *output*) 2)) (snd-display #__line__ ";with-sound *output* chans: ~A" (mus-channels *output*)))
+ (fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
+ (if (fneq (car (sound-data-maxamp v1)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
+ (if (fneq (cadr (sound-data-maxamp v1)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 2 2210))
+ (fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
+ (if (fneq (car (sound-data-maxamp v2)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
+ (if (fneq (cadr (sound-data-maxamp v2)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
+ (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound (2 chans) -> sound-data v1 v2 not equal?"))
+ (set! (optimization) 6)
+ (with-sound (:output v1)
+ (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0))
+ (if (fneq (car (sound-data-maxamp v1)) .2) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-vct 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (vct-peak v1) .3)
+ (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt, scaled-to): ~A" (vct-peak v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-vct 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (vct-peak v2) .3)
+ (snd-display #__line__ ";with-sound -> vct fm-violin maxamp scaled-to: ~A" (vct-peak v2)))
+ (if (not (vequal v1 v2)) (snd-display #__line__ ";with-sound (scaled-to) -> vct v1 v2 not equal?"))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :scaled-by 2.0)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
+ (if (fneq (vct-peak v1) .4) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt 2 scaled-by): ~A" (vct-peak v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (car (sound-data-maxamp v1)) .5)
+ (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt, scaled-to): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (car (sound-data-maxamp v2)) .5)
+ (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp scaled-to: ~A" (sound-data-maxamp v2)))
+ (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound scaled-to -> sound-data v1 v2 not equal?"))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :scaled-by 0.5)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
+ (if (fneq (car (sound-data-maxamp v1)) .1)
+ (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2 scaled-by): ~A" (sound-data-maxamp v1))))))
+
+ (let ((stats-string ""))
+ (let ((v1 (with-sound (:output (make-vct 2210) :statistics (lambda (str) (set! stats-string str)))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (and (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.000\n"))
+ (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.001\n"))
+ (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.002\n"))
+ (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.010\n"))
+ (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.180\n")))
+ (snd-display #__line__ ";with-sound to vct stats: [~A]" stats-string)))
+ (let ((v1 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5 :statistics (lambda (str) (set! stats-string str)))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (and (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.000\n"))
+ (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.001\n"))
+ (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.002\n"))
+ (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.010\n")))
+ (snd-display #__line__ ";with-sound to sound-data stats: [~A]" stats-string)))
+
+ (with-sound (:output (make-sound-data 4 2210) :channels 4 :statistics (lambda (str) (set! stats-string str)))
+ (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))
+ )
+
+ (for-each
+ (lambda (n)
+ (set! (optimization) n)
+
+ ;; testing overwrites here -- just hope we don't crash...
+ (let ((v1 (with-sound (:output (make-vct 20) :channels 1)
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (vct-ref v1 0) 0.0) (snd-display #__line__ ";overwrite vct with-sound: ~A (~A)" (vct-ref v1 0) (vct-peak v1))))
+
+ (let ((v1 (with-sound (:output (make-vct 20) :channels 4)
+ (fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
+ (if (fneq (vct-ref v1 0) 0.0) (snd-display #__line__ ";overwrite vct with-sound (4): ~A (~A)" (vct-ref v1 0) (vct-peak v1))))
+
+ (let ((v1 (with-sound (:output (make-sound-data 4 20) :channels 4)
+ (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
+ (do ((i 0 (+ 1 i))) ((= i 4))
+ (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
+
+ (let ((v1 (with-sound (:output (make-sound-data 2 20) :channels 4)
+ (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
+ (do ((i 0 (+ 1 i))) ((= i 2))
+ (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd (2) ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
+
+ (let ((v1 (with-sound (:output (make-sound-data 4 20) :channels 1)
+ (fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
+ (fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
+ (do ((i 0 (+ 1 i))) ((= i 4))
+ (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd (4) ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
+ )
+ (list 0 3 6))
+
+ ;; reverb cases parallel to above
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-vct 44100) :reverb jc-reverb)
+ (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length vct: ~A" (mus-length *output*)))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0 :reverb-amount 0.9)))
+ (v4 (with-sound (:output (make-vct 44100))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (vequal v1 v4) (snd-display #__line__ ";reverb output not written to vct?"))
+ (if (< (vct-peak v1) .29)
+ (snd-display #__line__ ";rev with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-vct 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
+ (if (< (vct-peak v2) .29)
+ (snd-display #__line__ ";rev with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :channels 1 :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
+ (if (< (vct-peak v1) .29)
+ (snd-display #__line__ ";rev with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length sd: ~A" (mus-length *output*)))
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
+ (v4 (with-sound (:output (make-sound-data 1 44100))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (sd-equal v1 v4) (snd-display #__line__ ";reverb output not written to sd?"))
+ (if (< (car (sound-data-maxamp v1)) .23)
+ (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 1 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
+ (if (< (car (sound-data-maxamp v2)) .23)
+ (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
+ (if (< (car (sound-data-maxamp v1)) .55)
+ (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (locsig-type) mus-interp-linear)
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-sound-data 2 44100) :reverb jc-reverb)
+ (if (not (= (mus-channels *output*) 2))
+ (snd-display #__line__ ";rev with-sound *output* chans: ~A" (mus-channels *output*)))
+ (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
+ (if (< (car (sound-data-maxamp v1)) .23)
+ (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
+ (if (< (cadr (sound-data-maxamp v1)) .23)
+ (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 2 44100) :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
+ (if (< (car (sound-data-maxamp v2)) .23)
+ (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
+ (if (< (cadr (sound-data-maxamp v2)) .23)
+ (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
+ (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
+ (if (< (car (sound-data-maxamp v1)) .56)
+ (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-vct 44100) :revfile (make-vct 44100) :reverb jc-reverb)
+ (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";1 ws mus-length vct: ~A" (mus-length *output*)))
+ (if (not (= (mus-length *reverb*) 44100)) (snd-display #__line__ ";1 ws mus-length vct rev: ~A" (mus-length *reverb*)))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0 :reverb-amount 0.9)))
+ (v4 (with-sound (:output (make-vct 44100))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (vequal v1 v4) (snd-display #__line__ ";1 reverb output not written to vct?"))
+ (if (< (vct-peak v1) .28)
+ (snd-display #__line__ ";1 rev with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-vct 44100) :revfile (make-vct 44100) :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
+ (if (< (vct-peak v2) .28)
+ (snd-display #__line__ ";1 rev with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :revfile v2 :channels 1 :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
+ (if (< (vct-peak v1) .28)
+ (snd-display #__line__ ";1 rev with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length sd: ~A" (mus-length *output*)))
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
+ (v4 (with-sound (:output (make-sound-data 1 44100))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (sd-equal v1 v4) (snd-display #__line__ ";2 reverb output not written to sd?"))
+ (if (< (car (sound-data-maxamp v1)) .28)
+ (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
+ (if (< (car (sound-data-maxamp v2)) .28)
+ (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
+ (if (< (car (sound-data-maxamp v1)) .54)
+ (snd-display #__line__ ";2 with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (optimization) 0)
+ (let ((v1 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length sd: ~A" (mus-length *output*)))
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
+ (v4 (with-sound (:output (make-sound-data 1 44100))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (sd-equal v1 v4) (snd-display #__line__ ";2 reverb output not written to sd?"))
+ (if (< (car (sound-data-maxamp v1)) .28)
+ (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
+ (if (< (car (sound-data-maxamp v2)) .28)
+ (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9)
+ (fm-violin 0 .1 440 .1 :reverb-amount 0.9))
+ (if (< (car (sound-data-maxamp v1)) .5)
+ (snd-display #__line__ ";2 with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+
+ (let ((oldopt (optimization)))
+ (set! (locsig-type) mus-interp-linear)
+ (set! (optimization) 6)
+ (let ((v1 (with-sound (:output (make-sound-data 2 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (not (= (mus-channels *output*) 2))
+ (snd-display #__line__ ";3 rev with-sound *output* chans: ~A" (mus-channels *output*)))
+ (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
+ (if (< (car (sound-data-maxamp v1)) .23)
+ (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
+ (if (< (cadr (sound-data-maxamp v1)) .23)
+ (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
+ (set! (optimization) 0)
+ (let ((v2 (with-sound (:output (make-sound-data 2 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
+ (if (< (car (sound-data-maxamp v2)) .23)
+ (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
+ (if (< (cadr (sound-data-maxamp v2)) .23)
+ (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
+ (set! (optimization) 6)
+ (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
+ (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
+ (fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
+ (if (< (car (sound-data-maxamp v1)) .56)
+ (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+
+
+ (let ((oldopt (optimization)))
+ (for-each
+ (lambda (n)
+ (set! (optimization) n)
+ (let ((v1 (with-sound (:output (make-vct 44100))
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
+ (v2 (with-sound (:output (make-vct 400))
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
+ (v3 (with-sound (:output (make-vct 400))
+ (simple-outn 0 .1 440 0.0 .5 0.0 0.0 0.0 0.0)))
+ (v4 (with-sound (:output (make-vct 44100) :reverb jc-reverb)
+ (simple-outn 0 .1 440 0.2 0.0 0.0 0.0 0.05 0.0)))
+ (v5 (with-sound (:output (make-vct 44100) :reverb simple-in-rev :reverb-data '(0.0 1.0 1.0 0.0))
+ (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.0)))
+ (v6 (with-sound (:output (make-vct 400))
+ (simple-outn 0 .1 440 0.5 0.0 0.0 0.0 0.0 0.0)
+ (simple-outn 0 .1 440 0.2 0.0 0.0 0.0 0.0 0.0)))
+ (sd1 (with-sound (:output (make-sound-data 1 44100))
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
+ (sd2 (with-sound (:output (make-sound-data 4 44100))
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
+ (sd3 (with-sound (:output (make-sound-data 2 44100))
+ (simple-outn 0 .1 440 0.0 0.0 .3 .4 0.0 0.0)))
+ (sd4 (with-sound (:output (make-sound-data 4 44100) :reverb simple-in-rev :reverb-channels 2 :reverb-data '(0.0 1.0 1.0 1.0))
+ (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.25)))
+ (sd5 (with-sound (:output (make-sound-data 4 44100) :reverb simple-in-rev :reverb-channels 1 :reverb-data '(0.0 1.0 1.0 1.0))
+ (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.25)))
+ (sd6 (with-sound (:output (make-sound-data 4 44100))
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))))
+ (if (fneq (vct-peak v1) 0.1) (snd-display #__line__ ";outa tests 1 ~A: ~A" n (vct-peak v1)))
+ (if (fneq (vct-peak v2) 0.1) (snd-display #__line__ ";outa tests 2 ~A: ~A" n (vct-peak v2)))
+ (if (fneq (vct-peak v3) 0.0) (snd-display #__line__ ";outa tests 3 ~A: ~A" n (vct-peak v3)))
+ (if (< (vct-peak v4) 0.2) (snd-display #__line__ ";outa tests 4 ~A: ~A" n (vct-peak v4)))
+ (if (fneq (vct-peak v5) 0.5) (snd-display #__line__ ";outa tests 5 ~A: ~A" n (vct-peak v5)))
+ (if (fneq (vct-peak v6) 0.7) (snd-display #__line__ ";outa tests 11 ~A: ~A" n (vct-peak v6)))
+
+ (let ((mx1 (sound-data-maxamp sd1)))
+ (if (not (feql mx1 (list .1))) (snd-display #__line__ ";outa tests 6 ~A: ~A" n mx1)))
+ (let ((mx2 (sound-data-maxamp sd2)))
+ (if (not (feql mx2 (list .1 .2 .3 .4))) (snd-display #__line__ ";outa tests 7 ~A: ~A" n mx2)))
+ (let ((mx3 (sound-data-maxamp sd3)))
+ (if (not (feql mx3 (list 0.0 0.0))) (snd-display #__line__ ";outa tests 8 ~A: ~A" n mx3)))
+ (let ((mx4 (sound-data-maxamp sd4)))
+ (if (not (feql mx4 (list 0.5 0.25 0.0 0.0))) (snd-display #__line__ ";outa tests 9 ~A: ~A" n mx4)))
+ (let ((mx5 (sound-data-maxamp sd5)))
+ (if (not (feql mx5 (list 0.5 0.0 0.0 0.0))) (snd-display #__line__ ";outa tests 10 ~A: ~A" n mx5)))
+ (let ((mx6 (sound-data-maxamp sd6)))
+ (if (not (feql mx6 (list .2 .4 .6 .8))) (snd-display #__line__ ";outa tests 12 ~A: ~A" n mx6)))
+
+ (with-sound (:output v1 :continue-old-file #t)
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))
+ (if (fneq (vct-peak v1) 0.2) (snd-display #__line__ ";outa tests 13 ~A: ~A" n (vct-peak v1)))
+
+ (with-sound (:output sd2 :continue-old-file #t)
+ (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))
+ (let ((mx7 (sound-data-maxamp sd2)))
+ (if (not (feql mx7 (list .2 .4 .6 .8))) (snd-display #__line__ ";outa tests 14 ~A: ~A" n mx7)))))
+ (list 0 6))
+ (set! (optimization) oldopt))
+
+ (let* ((file (with-sound ()
+ (fm-violin 0 .1 880 .1 :random-vibrato-amplitude 0.0)
+ (let ((v1 (with-temp-sound (:output (make-vct 2210))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)))
+ (sd1 (with-temp-sound (:output (make-sound-data 1 2210))
+ (fm-violin 0 .1 660 .1 :random-vibrato-amplitude 0.0))))
+ (do ((i 0 (+ 1 i)))
+ ((= i 2205))
+ (outa i (+ (vct-ref v1 i) (sound-data-ref sd1 0 i)))))
+ (fm-violin 0 .1 220.0 .1 :random-vibrato-amplitude 0.0)))
+ (ind (find-sound file)))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";can't find mixed with-sound output")
+ (let ((mx (maxamp ind 0)))
+ (if (< mx .35) (snd-display #__line__ ";mixed with-sound max: ~A" mx))
+ (if (not (vequal (channel->vct 1000 10) (vct 0.255 0.275 0.316 0.364 0.391 0.379 0.337 0.283 0.228 0.170)))
+ (snd-display #__line__ ";mixed with-sound: ~A" (channel->vct 1000 10)))
+ (close-sound ind))))
+
+ (let* ((file (with-sound ()
+ (fm-violin 0 .1 880 .1 :random-vibrato-amplitude 0.0)
+ (sound-let ((v1 (:output (make-vct 2210))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
+ (sd1 (:output (make-sound-data 1 2210))
+ (fm-violin 0 .1 660 .1 :random-vibrato-amplitude 0.0))
+ (fs1 ()
+ (fm-violin 0 .1 110 .1 :random-vibrato-amplitude 0.0)))
+ (mus-mix *output* fs1)
+ (do ((i 0 (+ 1 i)))
+ ((= i 2205))
+ (outa i (+ (vct-ref v1 i) (sound-data-ref sd1 0 i)))))
+ (fm-violin 0 .1 220.0 .1 :random-vibrato-amplitude 0.0)))
+ (ind (find-sound file)))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";can't find mixed with-sound sound-let output")
+ (let ((mx (maxamp ind 0)))
+ (if (< mx .375) (snd-display #__line__ ";mixed with-sound max: ~A" mx))
+ (if (not (vequal (channel->vct 1000 10) (vct 0.349 0.370 0.412 0.461 0.489 0.478 0.436 0.383 0.328 0.270)))
+ (snd-display #__line__ ";mixed with-sound via sound-let: ~A" (channel->vct 1000 10)))
+ (close-sound ind))))
+
+
+ (let* ((res (with-mixed-sound () (fm-violin 0 .1 440 .1)))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";with-mixed-sound (1): ~A?" res))
+ (let ((mxs (mixes snd 0))
+ (info (sound-property 'with-mixed-sound-info snd)))
+ (if (not (list? mxs))
+ (snd-display #__line__ ";with-mixed-sound (1) mixes: ~A" mxs))
+ (if (or (not (equal? (car (list-ref info 0)) (car mxs)))
+ (not (= (cadr (list-ref info 0)) 0))
+ (not (= (caddr (list-ref info 0)) 1)))
+ (snd-display #__line__ ";with-mixed-sound info (1) 0: ~A" (list-ref info 0)))
+ (if (ffneq (maxamp snd) .1)
+ (snd-display #__line__ ";with-mixed-sound (1) 0: ~A" (maxamp snd)))
+ (close-sound snd)))
+
+ (let* ((res (with-mixed-sound (:srate 44100)
+ (fm-violin 0 .1 440 .1)
+ (fm-violin 1 .1 660 .1)))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";with-mixed-sound (2): ~A?" res))
+ (let ((mxs (mixes snd 0))
+ (info (sound-property 'with-mixed-sound-info snd)))
+ (if (or (not (list? mxs))
+ (not (= (length mxs) 2)))
+ (snd-display #__line__ ";with-mixed-sound mixes (2): ~A" mxs))
+ (if (or (not (equal? (car (list-ref info 0)) (car mxs)))
+ (not (= (cadr (list-ref info 0)) 0))
+ (not (= (caddr (list-ref info 0)) 1)))
+ (snd-display #__line__ ";with-mixed-sound info (2) 0: ~A" (list-ref info 0)))
+ (if (or (not (equal? (car (list-ref info 1)) (cadr mxs)))
+ (not (= (cadr (list-ref info 1)) 44100))
+ (not (= (caddr (list-ref info 1)) 1)))
+ (snd-display #__line__ ";with-mixed-sound info (2) 1: ~A" (list-ref info 1)))
+ (if (or (not (= (frames snd) 48510))
+ (fneq (maxamp snd) .1))
+ (snd-display #__line__ ";with-mixed-sound 0 (2): ~A ~A" (frames snd) (maxamp snd)))
+ (close-sound snd)))
+
+ (let* ((res (with-mixed-sound (:channels 2 :srate 44100)
+ (fm-violin 0 .1 440 .1 :degree 0)
+ (fm-violin 1 .1 660 .1 :degree 45)))
+ (snd (find-sound res))
+ (mxs (mixes snd))
+ (info (sound-property 'with-mixed-sound-info snd)))
+ (if (or (not (= (length mxs) 2))
+ (not (= (length (car mxs)) 2))
+ (not (= (length info) 2))
+ (not (equal? (caar info) (caar mxs))))
+ (snd-display #__line__ ";with-mixed-sound (3) 1: ~A ~A" mxs info))
+ (close-sound snd))
+
+ (let* ((res (with-marked-sound ()
+ (fm-violin 0 .1 440 .1)
+ (fm-violin 1 .1 660 .1)))
+ (snd (find-sound res))
+ (mxs (marks snd 0)))
+ (if (not (= (length mxs) 2))
+ (snd-display #__line__ ";with-marked-sound marks: ~A " mxs))
+ (if (not (string=? (mark-name (car mxs)) "fm-violin 0 0.1"))
+ (snd-display #__line__ ";with-marked-sound name: ~A" (mark-name (car mxs))))
+ (if (fneq (maxamp snd) .1)
+ (snd-display #__line__ ";with-marked-sound maxamp: ~A" (maxamp snd)))
+ (close-sound snd))
+
+ (reset-hook! mark-click-hook)
+ (reset-hook! mix-click-hook)
+ (reset-hook! mix-drag-hook)
+
+
+ ;; generators.scm
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-ercos 100 :r 1.0)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(outa i (ercos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";ercos: ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";ercos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-ercos 100 :r 0.1))
- (t-env (make-env '(0 .1 1 2) :length 20000)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";ercos: ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ercos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-ercos 100 :r 0.1))
+ (t-env (make-env '(0 .1 1 2) :length 20000)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 20000))
(set! (ercos-r gen) (env t-env))
@@ -55945,1399 +56042,1399 @@ EDITS: 1
(set! (ercos-offset gen) (/ (- 1.0 exp-t) (* 2.0 exp-t)))
(set! (ercos-scaler gen) (* (sinh (ercos-r gen)) (ercos-offset gen))))
(outa i (ercos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";ercos 1: ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";ercos 1 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-erssb 1000.0 0.1 1.0)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";ercos 1: ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ercos 1 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-erssb 1000.0 0.1 1.0)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 20000))
(outa i (erssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";erssb: ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";erssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-noddsin 100 :n 10)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";erssb: ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";erssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-noddsin 100 :n 10)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(outa i (noddsin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";noddsin: ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";noddsin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-noddcos 100 :n 10)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";noddsin: ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";noddsin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-noddcos 100 :n 10)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(outa i (noddcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";noddcos: ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";noddcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-noddssb 1000.0 0.1 5)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";noddcos: ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";noddcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-noddssb 1000.0 0.1 5)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(outa i (noddssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";noddssb: ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";noddssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-asyfm 2000.0 :ratio .1)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (outa i (asyfm-J gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";asyfm-J ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";asyfm-J max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-asyfm 2000.0 :ratio .1 :index 1))
- (r-env (make-env '(0 -4 1 -1) :length 20000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (set! (asyfm-r gen) (env r-env))
- (outa i (asyfm-J gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";asyfm-J1 ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";asyfm-J1 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-asyfm 2000.0 :ratio .1)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (outa i (asyfm-I gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";asyfm-I ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";asyfm-I max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-nrcos 400.0 :n 5 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (nrcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nrcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nrcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((samps 44100)
- (gen (make-noid 100.0 3 'min-peak)))
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (outa i (noid gen))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";noid ~A" snd))
- (if (ffneq (maxamp snd) 0.6599) (snd-display ";noid min-peak max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((samps 44100)
- (gen (make-noid 100.0 3 'max-peak)))
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (outa i (noid gen))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";noid ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";noid max-peak max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nrcos 100 :n 15 :r 0.5))
- (indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 40000))
- (set! (mus-scaler gen) (env indr))
- (outa i (nrcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nrcos with scaler ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nrcos with scaler max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-ncos2 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (outa i (ncos2 gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";ncos2 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";ncos2 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-ncos4 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (outa i (ncos4 gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";ncos4 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";ncos4 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-npcos 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (outa i (npcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";npcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";npcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-n1cos 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (outa i (n1cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";n1cos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";n1cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rcos 100.0 :r 0.5)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";noddssb: ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";noddssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-asyfm 2000.0 :ratio .1)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (outa i (asyfm-J gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";asyfm-J ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";asyfm-J max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-asyfm 2000.0 :ratio .1 :index 1))
+ (r-env (make-env '(0 -4 1 -1) :length 20000)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 20000))
+ (set! (asyfm-r gen) (env r-env))
+ (outa i (asyfm-J gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";asyfm-J1 ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";asyfm-J1 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-asyfm 2000.0 :ratio .1)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (outa i (asyfm-I gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";asyfm-I ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";asyfm-I max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f :statistics #t)
+ (let ((gen (make-nrcos 400.0 :n 5 :r 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (nrcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nrcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((samps 44100)
+ (gen (make-noid 100.0 3 'min-peak)))
+ (do ((i 0 (+ 1 i)))
+ ((= i samps))
+ (outa i (noid gen))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";noid ~A" snd))
+ (if (ffneq (maxamp snd) 0.6599) (snd-display #__line__ ";noid min-peak max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((samps 44100)
+ (gen (make-noid 100.0 3 'max-peak)))
+ (do ((i 0 (+ 1 i)))
+ ((= i samps))
+ (outa i (noid gen))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";noid ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";noid max-peak max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nrcos 100 :n 15 :r 0.5))
+ (indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 40000))
+ (set! (mus-scaler gen) (env indr))
+ (outa i (nrcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nrcos with scaler ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrcos with scaler max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-ncos2 100.0 :n 10)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 20000))
+ (outa i (ncos2 gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";ncos2 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ncos2 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-ncos4 100.0 :n 10)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 20000))
+ (outa i (ncos4 gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";ncos4 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ncos4 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-npcos 100.0 :n 10)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 20000))
+ (outa i (npcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";npcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";npcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-n1cos 100.0 :n 10)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 20000))
+ (outa i (n1cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";n1cos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";n1cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rcos 100.0 :r 0.5)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 20000))
(outa i (rcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-bess 100.0 :n 0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (outa i (bess gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";bess ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";bess max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen1 (make-bess 400.0 :n 1))
- (gen2 (make-bess 400.0 :n 1))
- (vol (make-env '(0 0 1 1 9 1 10 0) :scaler 2.0 :length 20000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (outa i (bess gen1 (* (env vol) (bess gen2 0.0)))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";bess 1 ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";bess 1 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen1 (make-bess 400.0 :n 1))
- (gen2 (make-oscil 400.0))
- (vol (make-env '(0 1 1 0) :scaler 1.0 :length 20000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (outa i (bess gen1 (* (env vol) (oscil gen2 0.0)))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";bess 2 ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";bess 2 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-eoddcos 400.0 :r 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (eoddcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";eoddcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";eoddcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-eoddcos 400.0 :r 0.0))
- (a-env (make-env '(0 0 1 1) :length 10000)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-bess 100.0 :n 0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (outa i (bess gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";bess ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";bess max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen1 (make-bess 400.0 :n 1))
+ (gen2 (make-bess 400.0 :n 1))
+ (vol (make-env '(0 0 1 1 9 1 10 0) :scaler 2.0 :length 20000)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 20000))
+ (outa i (bess gen1 (* (env vol) (bess gen2 0.0)))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";bess 1 ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";bess 1 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen1 (make-bess 400.0 :n 1))
+ (gen2 (make-oscil 400.0))
+ (vol (make-env '(0 1 1 0) :scaler 1.0 :length 20000)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 20000))
+ (outa i (bess gen1 (* (env vol) (oscil gen2 0.0)))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";bess 2 ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";bess 2 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-eoddcos 400.0 :r 1.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (eoddcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";eoddcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";eoddcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-eoddcos 400.0 :r 0.0))
+ (a-env (make-env '(0 0 1 1) :length 10000)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(set! (eoddcos-r gen) (env a-env))
(outa i (eoddcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";eoddcos 1 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";eoddcos 1 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen1 (make-eoddcos 400.0 :r 0.0))
- (gen2 (make-oscil 400.0))
- (a-env (make-env '(0 0 1 1) :length 10000)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";eoddcos 1 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";eoddcos 1 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen1 (make-eoddcos 400.0 :r 0.0))
+ (gen2 (make-oscil 400.0))
+ (a-env (make-env '(0 0 1 1) :length 10000)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(set! (eoddcos-r gen1) (env a-env))
(outa i (eoddcos gen1 (* .1 (oscil gen2)))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";eoddcos 2 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";eoddcos 2 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nssb 2000.0 0.05 3)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (* .3 (nssb gen))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nssb ~A" snd))
- (if (fneq (maxamp snd) 0.3) (snd-display ";nssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nrssb 2000.0 0.05 3 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (nrssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nrssb ~A" snd))
- (if (fneq (maxamp snd) 0.777) (snd-display ";nrssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rkcos 440.0 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rkcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rkcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rkcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rk!cos 440.0 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rk!cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rk!cos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rk!cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-r2k!cos 440.0 :r 0.5 :k 3.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (r2k!cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";r2k!cos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";r2k!cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-k2sin 440.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (k2sin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";k2sin ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";k2sin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-k2cos 440.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (k2cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";k2cos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";k2cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-k2ssb 1000.0 0.1)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (k2ssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";k2ssb ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";k2ssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rssb 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rssb ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-dblsum 100 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (dblsum gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";dblsum ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";dblsum max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nkssb 1000.0 0.1 5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (nkssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nkssb ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nkssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nkssb 1000.0 0.1 5))
- (vib (make-oscil 5.0))
- (vibamp (hz->radians 50.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 30000))
- (outa i (nkssb gen (* vibamp (oscil vib)))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nkssb 1 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nkssb 1 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nkssb 1000.0 0.1 5))
- (move (make-env '(0 1 1 -1) :length 30000))
- (vib (make-oscil 5.0))
- (vibamp (hz->radians 50.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 30000))
- (outa i (nkssb-interp gen (* vibamp (oscil vib)) (env move))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nkssb 2 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nkssb 2 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rkoddssb 1000.0 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rkoddssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rkoddssb ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rkoddssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-krksin 440.0 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (krksin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";krksin ~A" snd)))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-abcos 100.0 0.5 0.25)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (abcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";abcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";abcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-absin 100.0 0.5 0.25)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (absin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";absin ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";absin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-r2k2cos 100.0 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (r2k2cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";r2k2cos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";r2k2cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (jjcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";jjcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";jjcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-j0evencos 100.0 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (j0evencos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";j0evencos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";j0evencos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rksin 100.0 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rksin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rksin ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rksin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rkssb 1000.0 0.1 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rkssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rkssb ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rkssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rk!ssb 1000.0 0.1 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rk!ssb gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rk!ssb ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rk!ssb max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-jpcos 100.0 :a 1.0 :r 0.99 :k 1)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 210000))
- (outa i (jpcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";jpcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";jpcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-j2cos 100.0 :r 1.0 :n 0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (j2cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";j2cos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";j2cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nxysin 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (nxysin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nxysin ~A" snd)))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nxycos 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (nxycos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nxycos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nxycos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nxy1cos 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (nxy1cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nxy1cos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nxy1cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nxy1sin 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (nxy1sin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nxy1sin ~A" snd))
- (if (fneq (maxamp snd) 0.951) (snd-display ";nxy1sin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-nrxysin 1000 0.1 5 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 2000))
- (outa i (nrxysin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nrxysin ~A" snd))
- (if (fneq (maxamp snd) 0.985) (snd-display ";nrxysin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nrxycos 1000 0.1 5 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 2000))
- (outa i (nrxycos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nrxycos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nrxycos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-nrxycos 1000 0.1 15 0.5))
- (indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 40000))
- (set! (mus-scaler gen) (env indr))
- (outa i (nrxycos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nrxycos with scaler ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nrxycos with scaler max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((black4 (make-blackman 440.0)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";eoddcos 2 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";eoddcos 2 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nssb 2000.0 0.05 3)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (* .3 (nssb gen))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nssb ~A" snd))
+ (if (fneq (maxamp snd) 0.3) (snd-display #__line__ ";nssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nrssb 2000.0 0.05 3 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (nrssb gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nrssb ~A" snd))
+ (if (fneq (maxamp snd) 0.777) (snd-display #__line__ ";nrssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rkcos 440.0 :r 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rkcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rkcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rkcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rk!cos 440.0 :r 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rk!cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rk!cos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rk!cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-r2k!cos 440.0 :r 0.5 :k 3.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (r2k!cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";r2k!cos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";r2k!cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-k2sin 440.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (k2sin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";k2sin ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";k2sin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-k2cos 440.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (k2cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";k2cos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";k2cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-k2ssb 1000.0 0.1)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (k2ssb gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";k2ssb ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";k2ssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rssb 1000 0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rssb gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rssb ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-dblsum 100 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (dblsum gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";dblsum ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";dblsum max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nkssb 1000.0 0.1 5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (nkssb gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nkssb ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nkssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nkssb 1000.0 0.1 5))
+ (vib (make-oscil 5.0))
+ (vibamp (hz->radians 50.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 30000))
+ (outa i (nkssb gen (* vibamp (oscil vib)))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nkssb 1 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nkssb 1 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nkssb 1000.0 0.1 5))
+ (move (make-env '(0 1 1 -1) :length 30000))
+ (vib (make-oscil 5.0))
+ (vibamp (hz->radians 50.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 30000))
+ (outa i (nkssb-interp gen (* vibamp (oscil vib)) (env move))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nkssb 2 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nkssb 2 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rkoddssb 1000.0 0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rkoddssb gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rkoddssb ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rkoddssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-krksin 440.0 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (krksin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";krksin ~A" snd)))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-abcos 100.0 0.5 0.25)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (abcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";abcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";abcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f :statistics #t)
+ (let ((gen (make-absin 100.0 0.5 0.25)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (absin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";absin ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";absin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-r2k2cos 100.0 1.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (r2k2cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";r2k2cos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";r2k2cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (jjcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";jjcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";jjcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-j0evencos 100.0 1.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (j0evencos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";j0evencos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";j0evencos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rksin 100.0 :r 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rksin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rksin ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rksin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rkssb 1000.0 0.1 :r 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rkssb gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rkssb ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rkssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rk!ssb 1000.0 0.1 :r 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rk!ssb gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rk!ssb ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rk!ssb max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-jpcos 100.0 :a 1.0 :r 0.99 :k 1)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 210000))
+ (outa i (jpcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";jpcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";jpcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-j2cos 100.0 :r 1.0 :n 0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (j2cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";j2cos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";j2cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nxysin 300 1/3 3)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (nxysin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nxysin ~A" snd)))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nxycos 300 1/3 3)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (nxycos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nxycos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nxycos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nxy1cos 300 1/3 3)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (nxy1cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nxy1cos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nxy1cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nxy1sin 300 1/3 3)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (nxy1sin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nxy1sin ~A" snd))
+ (if (fneq (maxamp snd) 0.951) (snd-display #__line__ ";nxy1sin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f :statistics #t)
+ (let ((gen (make-nrxysin 1000 0.1 5 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 2000))
+ (outa i (nrxysin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nrxysin ~A" snd))
+ (if (fneq (maxamp snd) 0.985) (snd-display #__line__ ";nrxysin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nrxycos 1000 0.1 5 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 2000))
+ (outa i (nrxycos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nrxycos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrxycos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-nrxycos 1000 0.1 15 0.5))
+ (indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 40000))
+ (set! (mus-scaler gen) (env indr))
+ (outa i (nrxycos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nrxycos with scaler ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrxycos with scaler max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((black4 (make-blackman 440.0)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(outa i (blackman black4 0.0)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";blackman ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";blackman max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((black4 (make-sinc-train 440.0 10)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";blackman ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";blackman max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((black4 (make-sinc-train 440.0 10)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 10000))
(outa i (sinc-train black4 0.0)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";sinc-train ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";sinc-train max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-k3sin 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (k3sin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";k3sin ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";k3sin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f :statistics #t)
- (let ((gen (make-izcos 100.0 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 30000))
- (outa i (izcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";izcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";izcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rxysin 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rxysin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rxysin ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rxysin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rxycos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rxycos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rxycos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rxycos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f :srate 44100)
- (let ((gen (make-safe-rxycos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (safe-rxycos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";safe-rxycos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";safe-rxycos max: ~A" (maxamp snd))))
-
- (let* ((base-r 0.0)
- (end-r 0.0)
- (res (with-sound (:clipped #f :channels 2 :srate 44100)
- (let ((gen1 (make-safe-rxycos 1000 1 0.99))
- (gen2 (make-safe-rxycos 1000 1 0.99))
- (frqf (make-env '(0 0 1 1) :length 10000 :scaler (hz->radians 1000))))
- (set! base-r (safe-rxycos-r gen1))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (let ((fm (env frqf)))
- (set! (mus-frequency gen2) (+ 1000 (radians->hz fm)))
- (outa i (safe-rxycos gen1 fm))
- (outb i (safe-rxycos gen2 0.0))
- (set! end-r (clamp-rxycos-r gen2 0.0))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";safe-rxycos 1 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";safe-rxycos 1 max: ~A" (maxamp snd)))
- (if (fneq base-r .588) (snd-display ";safe-rxycos-r 1 base: ~A" base-r))
- (if (fneq end-r .316) (snd-display ";safe-rxycos-r 1 end: ~A" end-r)))
-
- (let* ((base-r 0.0)
- (end-r 0.0)
- (res (with-sound (:clipped #f :channels 2 :srate 44100)
- (let ((gen1 (make-safe-rxycos 1000 .1 0.99))
- (gen2 (make-safe-rxycos 1000 .1 0.99))
- (frqf (make-env '(0 0 1 1) :length 10000 :scaler (hz->radians 1000))))
- (set! base-r (safe-rxycos-r gen1))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (let ((fm (env frqf)))
- (set! (mus-frequency gen2) (+ 1000 (radians->hz fm)))
- (outa i (safe-rxycos gen1 fm))
- (outb i (safe-rxycos gen2 0.0))
- (set! end-r (clamp-rxycos-r gen2 0.0))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";safe-rxycos 2 ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";safe-rxycos 2 max: ~A" (maxamp snd)))
- (if (fneq base-r .951) (snd-display ";safe-rxycos-r 2 base: ~A" base-r))
- (if (fneq end-r .896) (snd-display ";safe-rxycos-r 2 end: ~A" end-r)))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rxyk!sin 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rxyk!sin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rxyk!sin ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";rxyk!sin max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-rxyk!cos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (rxyk!cos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";rxyk!cos ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";rxyk!cos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f :statistics #t :play #f)
- (let ((gen (make-nsincos 100.0 3)))
- (run
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";sinc-train ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";sinc-train max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-k3sin 100.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (k3sin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";k3sin ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";k3sin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f :statistics #t)
+ (let ((gen (make-izcos 100.0 1.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 30000))
+ (outa i (izcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";izcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";izcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rxysin 1000 0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rxysin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rxysin ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rxysin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rxycos 1000 0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rxycos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rxycos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rxycos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f :srate 44100)
+ (let ((gen (make-safe-rxycos 1000 0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (safe-rxycos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";safe-rxycos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";safe-rxycos max: ~A" (maxamp snd))))
+
+ (let* ((base-r 0.0)
+ (end-r 0.0)
+ (res (with-sound (:clipped #f :channels 2 :srate 44100)
+ (let ((gen1 (make-safe-rxycos 1000 1 0.99))
+ (gen2 (make-safe-rxycos 1000 1 0.99))
+ (frqf (make-env '(0 0 1 1) :length 10000 :scaler (hz->radians 1000))))
+ (set! base-r (safe-rxycos-r gen1))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (let ((fm (env frqf)))
+ (set! (mus-frequency gen2) (+ 1000 (radians->hz fm)))
+ (outa i (safe-rxycos gen1 fm))
+ (outb i (safe-rxycos gen2 0.0))
+ (set! end-r (clamp-rxycos-r gen2 0.0))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";safe-rxycos 1 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";safe-rxycos 1 max: ~A" (maxamp snd)))
+ (if (fneq base-r .588) (snd-display #__line__ ";safe-rxycos-r 1 base: ~A" base-r))
+ (if (fneq end-r .316) (snd-display #__line__ ";safe-rxycos-r 1 end: ~A" end-r)))
+
+ (let* ((base-r 0.0)
+ (end-r 0.0)
+ (res (with-sound (:clipped #f :channels 2 :srate 44100)
+ (let ((gen1 (make-safe-rxycos 1000 .1 0.99))
+ (gen2 (make-safe-rxycos 1000 .1 0.99))
+ (frqf (make-env '(0 0 1 1) :length 10000 :scaler (hz->radians 1000))))
+ (set! base-r (safe-rxycos-r gen1))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (let ((fm (env frqf)))
+ (set! (mus-frequency gen2) (+ 1000 (radians->hz fm)))
+ (outa i (safe-rxycos gen1 fm))
+ (outb i (safe-rxycos gen2 0.0))
+ (set! end-r (clamp-rxycos-r gen2 0.0))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";safe-rxycos 2 ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";safe-rxycos 2 max: ~A" (maxamp snd)))
+ (if (fneq base-r .951) (snd-display #__line__ ";safe-rxycos-r 2 base: ~A" base-r))
+ (if (fneq end-r .896) (snd-display #__line__ ";safe-rxycos-r 2 end: ~A" end-r)))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rxyk!sin 1000 0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rxyk!sin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rxyk!sin ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rxyk!sin max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-rxyk!cos 1000 0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (rxyk!cos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";rxyk!cos ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";rxyk!cos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f :statistics #t :play #f)
+ (let ((gen (make-nsincos 100.0 3)))
+ (run
(do ((i 0 (+ 1 i)))
((= i 20000))
(outa i (nsincos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nsincos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";nsincos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f :play #f)
- (let ((gen (make-nchoosekcos 2000.0 0.05 10)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 30000))
- (outa i (nchoosekcos gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";nchoosekcos ~A" snd))
- (if (ffneq (maxamp snd) 1.0) (snd-display ";nchoosekcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound ()
- (let ((gen (make-adjustable-square-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 200))
- (outa i (adjustable-square-wave gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";adj sq ~A" snd))
- (if (fneq (maxamp snd) 0.5) (snd-display ";adj sq max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound ()
- (let ((gen (make-adjustable-triangle-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 22050))
- (outa i (adjustable-triangle-wave gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";adj tri ~A" snd))
- (if (ffneq (maxamp snd) 0.5) (snd-display ";adj tri max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound ()
- (let ((gen (make-adjustable-sawtooth-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 22050))
- (outa i (adjustable-sawtooth-wave gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";adj saw ~A" snd))
- (if (ffneq (maxamp snd) 0.5) (snd-display ";adj saw max: ~A" (maxamp snd))))
-
- (with-sound (:clipped #f) ; at least run the thing -- not sure how to test this automatically
- (let* ((gen (make-pink-noise 12)))
- (run (lambda ()
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nsincos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nsincos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f :play #f)
+ (let ((gen (make-nchoosekcos 2000.0 0.05 10)))
+ (run
(do ((i 0 (+ 1 i)))
- ((= i 44100))
- (outa i (pink-noise gen)))))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-brown-noise 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (brown-noise gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";brown-noise ~A" snd))
- (if (< (maxamp snd) 0.01) (snd-display ";brown-noise max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-green-noise 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (green-noise gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";green-noise ~A" snd))
- (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 1.0)) (snd-display ";green-noise max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-green-noise 100.0 0.1 -0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (green-noise gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";green-noise .5 ~A" snd))
- (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 0.5)) (snd-display ";green-noise .5 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-green-noise-interp 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (green-noise-interp gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";green-noise-interp ~A" snd))
- (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 1.0)) (snd-display ";green-noise-interp max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-green-noise-interp 100.0 0.1 -0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (green-noise-interp gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";green-noise-interp .5 ~A" snd))
- (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 0.5)) (snd-display ";green-noise-interp .5 max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen (make-tanhsin 440.0 2.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (tanhsin gen)))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";tanhsin ~A" snd))
- (if (> (abs (- 1.0 (maxamp snd))) 0.1) (snd-display ";tanhsin max: ~A" (maxamp snd))))
-
- (if (not (provided? 'snd-nogui))
- (let* ((snd (new-sound))
- (rd (make-readin "oboe.snd"))
- (ft (make-moving-fft rd))
- (data (make-vct 256)))
- (set! (lisp-graph?) #t)
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (moving-fft ft)
- (vct-subseq (mus-xcoeffs ft) 0 255 data)
- (graph data "fft" 0.0 11025.0 0.0 0.1 snd 0 #t))
- (close-sound snd)))
-
- (test-sv)
-
- (let* ((rd (make-readin "1a.snd"))
- (cur-srate (mus-sound-srate "1a.snd"))
- (old-srate (mus-srate)))
- (set! (mus-srate) cur-srate)
- (let* ((scn (make-moving-pitch rd))
- (pitch (moving-pitch scn)))
- (if (or (> pitch 443.0)
- (< pitch 439.0))
- (snd-display ";moving-pitch 1a: ~A" pitch)))
- (set! (mus-srate) old-srate))
-
- (let ((val (make-vector 3))
- (frq 0.0))
- (vector-set! val 0 (make-nrcos 100))
- (vector-set! val 1 (make-nrcos 200))
- (vector-set! val 2 (make-nrcos 300))
- (run
- (lambda ()
- (set! frq (mus-frequency (vector-ref val 1)))))
- (if (fneq frq 200.0) (snd-display ";defgen vect freq: ~A" frq)))
-
- (let ((val (make-vector 3))
- (frq 0.0))
- (vector-set! val 0 (make-nrcos 100))
- (vector-set! val 1 (make-nrcos 200))
- (vector-set! val 2 (make-nrcos 300))
- (run
- (lambda ()
- (set! frq (+ (mus-frequency (vector-ref val 0))
- (mus-frequency (vector-ref val 1))
- (mus-frequency (vector-ref val 2))))))
- (if (fneq frq 600.0) (snd-display ";defgen vect freq 1: ~A" frq)))
-
- (let ((val (make-vector 3))
- (frq 0.0))
- (vector-set! val 0 (make-nrcos 100))
- (vector-set! val 1 (make-nrcos 200))
- (vector-set! val 2 (make-nrcos 300))
- (run
- (lambda ()
- (set! (mus-frequency (vector-ref val 1)) 500.0)
- (set! frq (mus-frequency (vector-ref val 1)))))
- (if (fneq frq 500.0) (snd-display ";defgen set freq: ~A ~A" frq (mus-frequency (vector-ref val 1)))))
-
-
- (let* ((res (with-sound (:clipped #f)
- (let ((v (make-vector 2 #f)))
- (vector-set! v 0 (make-nrcos 440 10 .5))
- (vector-set! v 1 (make-nrcos 440 10 .5))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (outa i (nrcos (vector-ref v 0) 0.0))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";vect nrcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";vect nrcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((val (make-vector 2))
- (frq 0.0))
- (vector-set! val 0 (make-nrcos 100 1 .1))
- (vector-set! val 1 (make-nrcos 200 1 .1))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 2000))
- (outa i (* .5 (+ (nrcos (vector-ref val 0) 0.0)
- (nrcos (vector-ref val 1) 0.0))))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";vect 2 nrcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";vect 2 nrcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((gen1 (make-nrcos 100 1 .1))
- (gen2 (make-nrcos 200 1 .1))
- (frq 0.0))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 2000))
- (outa i (* .5 (+ (nrcos gen1 0.0)
- (nrcos gen2 0.0))))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";no vect 2 nrcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";no vect 2 nrcos max: ~A" (maxamp snd))))
-
- (let* ((res (with-sound (:clipped #f)
- (let ((v (make-vector 2 #f)))
- (vector-set! v 0 (make-nrcos 440 10 .5))
- (vector-set! v 1 (make-nrcos 440 10 .5))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 2000))
- (let ((gen (vector-ref v 0)))
- (outa i (nrcos gen)))))))))
- (snd (find-sound res)))
- (if (not (sound? snd)) (snd-display ";vect let nrcos ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display ";vect let nrcos max: ~A" (maxamp snd))))
-
- (with-sound (:play #t)
- (let* ((exp-amt 8.0)
- (gran (make-granulate :expansion exp-amt))
- (dur 2.0)
- (samps (seconds->samples dur))
- (ampf (make-env '(0.000 0.000 0.011 0.147 0.023 0.131 0.028 0.034 0.059 0.000 0.063 0.153 0.067 0.113
- 0.072 0.391 0.081 0.095 0.088 0.052 0.102 0.025 0.124 0.000 0.131 0.452 0.139 0.327
- 0.144 0.099 0.156 0.097 0.160 0.048 0.186 0.000 0.194 0.438 0.200 0.366 0.201 0.156
- 0.211 0.063 0.247 0.000 0.256 0.628 0.268 0.154 0.274 0.190 0.285 0.027 0.296 0.059
- 0.309 0.031 0.312 0.481 0.322 0.939 0.331 0.314 0.351 0.061 0.363 0.099 0.374 0.056
- 0.377 0.438 0.389 0.858 0.394 0.467 0.403 0.241 0.414 0.197 0.415 0.127 0.425 0.075
- 0.436 0.090 0.441 0.526 0.454 0.869 0.471 0.239 0.490 0.029 0.503 0.117 0.505 0.485
- 0.514 0.811 0.528 0.415 0.538 0.088 0.552 0.056 0.561 0.106 0.580 0.075 0.597 0.000
- 0.776 0.000 0.777 0.573 0.786 0.145 0.801 0.054 0.826 0.000 0.827 0.632 0.844 1.000
- 0.856 0.524 0.866 0.031 0.883 0.074 0.891 0.136 0.896 0.745 0.907 0.424 0.915 0.765
- 0.934 0.059 0.951 0.048 0.962 0.079 0.970 0.436 0.986 0.266 1.000 0.000)
- :duration 0.25 :scaler 0.5))
- (frqf (make-env '(0.000 0.220 0.074 0.249 0.133 0.249 0.194 0.240 0.258 0.252 0.324 0.264 0.389 0.267
- 0.456 0.270 0.520 0.264 0.847 0.270 0.920 0.273 1.000 0.279)
- :duration 0.25 :scaler (hz->radians (* 0.5 0.205 22050.0))))
- (gen1 (make-polywave :partials (list 2 .35 3 .1 4 .8 5 .01 6 .03 8 .005)))
- (rnd (make-rand-interp 600 (hz->radians 50))))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (outa i (granulate gran
- (lambda (dir)
- (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd))))))))))))
-
- (let ((g (make-osc329 440.0)) (f 10.0))
- (run (lambda () (set! f (osc329 g 0.0))))
- (if (fneq f 0.0) (snd-display ";run osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f #t))
- (run (lambda () (set! f (oscil? g))))
- (if f (snd-display ";oscil? osc329: ~A" f)))
- (let ((g (+ 3 2)) (f #t))
- (run (lambda () (set! f (oscil? g))))
- (if f (snd-display ";oscil? 5: ~A" f)))
- (let ((g (make-osc329 440.0)) (f #t))
- (run (lambda () (set! f (osc329? g))))
- (if (not f) (snd-display ";osc329? osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 0.0))
- (run (lambda () (set! f (mus-frequency g))))
- (if (fneq f 440.0) (snd-display ";mus-frequency osc329: ~A" f)))
- (let ((g123 (make-osc329 440.0)) (f 0.0))
- (run (lambda () (set! f (mus-frequency g123))))
- (if (or (not (number? f)) (fneq f 440.0)) (snd-display ";(name) mus-frequency osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32)) (set! f (mus-length g))
- (if (not (= f 1)) (snd-display ";osc329 (no run) mus-length: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! f (mus-length g))))
- (if (not (= f 1)) (snd-display ";osc329 mus-length: ~A" f)))
- (let ((g (make-osc329 440.0)) (f "hiho"))
- (run (lambda () (set! f (mus-name g))))
- (if (not (string=? f "osc329")) (snd-display ";osc329 mus-name: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 1.0))
- (run (lambda () (set! f (mus-phase g))))
- (if (fneq f 0.0) (snd-display ";mus-phase osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 1.0))
- (run (lambda () (set! (mus-phase g) f)))
- (if (fneq (mus-phase g) 1.0) (snd-display ";set mus-phase osc329: ~A" (mus-phase g))))
- (let ((g (make-osc329 440.0)) (f "hiho"))
- (run (lambda () (set! f (mus-describe g))))
- (if (not (string? f)) (snd-display ";osc329 mus-describe: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 0.0))
- (run (lambda () (set! f (mus-increment g))))
- (if (fneq f 1.0) (snd-display ";mus-increment osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! (mus-length g) f)))
- (if (not (= (mus-length g) 32)) (snd-display ";osc329 set mus-length: ~A" (mus-length g))))
- (let ((g (make-osc329 440.0)) (f 440.0))
- (run (lambda () (set! (mus-frequency g) 100.0) (set! f (mus-frequency g))))
- (if (fneq f 100.0) (snd-display ";osc329 set mus-frequency: ~A" (mus-frequency g))))
- (let ((g (make-osc329 440.0)) (f 440.0))
- (run (lambda () (set! (mus-increment g) 100.0) (set! f (mus-increment g))))
- (if (fneq f 100.0) (snd-display ";osc329 set mus-increment: ~A" (mus-increment g))))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! f (mus-hop g))))
- (if (not (= f 1)) (snd-display ";osc329 mus-hop: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! (mus-hop g) f)))
- (if (not (= (mus-hop g) 32)) (snd-display ";osc329 set mus-hop: ~A" (mus-hop g))))
-
- (if (not (provided? 'gmp))
- (set! nearly-zero 1.0e-8)) ; in case floats
- (let ((test-zero-stability
- (lambda (make-func run-func zero)
- (let ((gen (make-func)))
- (set! (mus-phase gen) zero)
- (let ((zero-val (run-func gen zero)))
- (for-each
- (lambda (val)
- (set! gen (make-func)) ; remake else carrier drifts away in ssb cases
- (set! (mus-phase gen) (+ zero val))
- (let ((new-val (run-func gen 0.0)))
- (if (> (abs (- new-val zero-val)) .01)
- (snd-display ";~A:~%; zero check at (+ ~A ~A): ~A ~A~%" gen zero val zero-val new-val))))
- (list 1.0e-11 1.0e-10 1.0e-9 1.0e-8 1.0e-7 1.0e-6
- -1.0e-11 -1.0e-10 -1.0e-9 -1.0e-8 -1.0e-7 -1.0e-6)))))))
+ ((= i 30000))
+ (outa i (nchoosekcos gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";nchoosekcos ~A" snd))
+ (if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";nchoosekcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound ()
+ (let ((gen (make-adjustable-square-wave 100 .2 .5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 200))
+ (outa i (adjustable-square-wave gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";adj sq ~A" snd))
+ (if (fneq (maxamp snd) 0.5) (snd-display #__line__ ";adj sq max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound ()
+ (let ((gen (make-adjustable-triangle-wave 100 .2 .5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 22050))
+ (outa i (adjustable-triangle-wave gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";adj tri ~A" snd))
+ (if (ffneq (maxamp snd) 0.5) (snd-display #__line__ ";adj tri max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound ()
+ (let ((gen (make-adjustable-sawtooth-wave 100 .2 .5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 22050))
+ (outa i (adjustable-sawtooth-wave gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";adj saw ~A" snd))
+ (if (ffneq (maxamp snd) 0.5) (snd-display #__line__ ";adj saw max: ~A" (maxamp snd))))
+
+ (with-sound (:clipped #f) ; at least run the thing -- not sure how to test this automatically
+ (let* ((gen (make-pink-noise 12)))
+ (run (lambda ()
+ (do ((i 0 (+ 1 i)))
+ ((= i 44100))
+ (outa i (pink-noise gen)))))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-brown-noise 100.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (brown-noise gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";brown-noise ~A" snd))
+ (if (< (maxamp snd) 0.01) (snd-display #__line__ ";brown-noise max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-green-noise 100.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (green-noise gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";green-noise ~A" snd))
+ (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 1.0)) (snd-display #__line__ ";green-noise max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-green-noise 100.0 0.1 -0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (green-noise gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";green-noise .5 ~A" snd))
+ (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 0.5)) (snd-display #__line__ ";green-noise .5 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-green-noise-interp 100.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (green-noise-interp gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";green-noise-interp ~A" snd))
+ (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 1.0)) (snd-display #__line__ ";green-noise-interp max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-green-noise-interp 100.0 0.1 -0.1 0.5)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (green-noise-interp gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";green-noise-interp .5 ~A" snd))
+ (if (or (< (maxamp snd) 0.01) (> (maxamp snd) 0.5)) (snd-display #__line__ ";green-noise-interp .5 max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen (make-tanhsin 440.0 2.0)))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((= i 10000))
+ (outa i (tanhsin gen)))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";tanhsin ~A" snd))
+ (if (> (abs (- 1.0 (maxamp snd))) 0.1) (snd-display #__line__ ";tanhsin max: ~A" (maxamp snd))))
+
+ (if (not (provided? 'snd-nogui))
+ (let* ((snd (new-sound))
+ (rd (make-readin "oboe.snd"))
+ (ft (make-moving-fft rd))
+ (data (make-vct 256)))
+ (set! (lisp-graph?) #t)
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (moving-fft ft)
+ (vct-subseq (mus-xcoeffs ft) 0 255 data)
+ (graph data "fft" 0.0 11025.0 0.0 0.1 snd 0 #t))
+ (close-sound snd)))
+
+ (test-sv)
+
+ (let* ((rd (make-readin "1a.snd"))
+ (cur-srate (mus-sound-srate "1a.snd"))
+ (old-srate (mus-srate)))
+ (set! (mus-srate) cur-srate)
+ (let* ((scn (make-moving-pitch rd))
+ (pitch (moving-pitch scn)))
+ (if (or (> pitch 443.0)
+ (< pitch 439.0))
+ (snd-display #__line__ ";moving-pitch 1a: ~A" pitch)))
+ (set! (mus-srate) old-srate))
+
+ (let ((val (make-vector 3))
+ (frq 0.0))
+ (vector-set! val 0 (make-nrcos 100))
+ (vector-set! val 1 (make-nrcos 200))
+ (vector-set! val 2 (make-nrcos 300))
+ (run
+ (lambda ()
+ (set! frq (mus-frequency (vector-ref val 1)))))
+ (if (fneq frq 200.0) (snd-display #__line__ ";defgen vect freq: ~A" frq)))
+
+ (let ((val (make-vector 3))
+ (frq 0.0))
+ (vector-set! val 0 (make-nrcos 100))
+ (vector-set! val 1 (make-nrcos 200))
+ (vector-set! val 2 (make-nrcos 300))
+ (run
+ (lambda ()
+ (set! frq (+ (mus-frequency (vector-ref val 0))
+ (mus-frequency (vector-ref val 1))
+ (mus-frequency (vector-ref val 2))))))
+ (if (fneq frq 600.0) (snd-display #__line__ ";defgen vect freq 1: ~A" frq)))
+
+ (let ((val (make-vector 3))
+ (frq 0.0))
+ (vector-set! val 0 (make-nrcos 100))
+ (vector-set! val 1 (make-nrcos 200))
+ (vector-set! val 2 (make-nrcos 300))
+ (run
+ (lambda ()
+ (set! (mus-frequency (vector-ref val 1)) 500.0)
+ (set! frq (mus-frequency (vector-ref val 1)))))
+ (if (fneq frq 500.0) (snd-display #__line__ ";defgen set freq: ~A ~A" frq (mus-frequency (vector-ref val 1)))))
+
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((v (make-vector 2 #f)))
+ (vector-set! v 0 (make-nrcos 440 10 .5))
+ (vector-set! v 1 (make-nrcos 440 10 .5))
+ (run
+ (lambda ()
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (outa i (nrcos (vector-ref v 0) 0.0))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";vect nrcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";vect nrcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((val (make-vector 2))
+ (frq 0.0))
+ (vector-set! val 0 (make-nrcos 100 1 .1))
+ (vector-set! val 1 (make-nrcos 200 1 .1))
+ (run
+ (lambda ()
+ (do ((i 0 (+ 1 i)))
+ ((= i 2000))
+ (outa i (* .5 (+ (nrcos (vector-ref val 0) 0.0)
+ (nrcos (vector-ref val 1) 0.0))))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";vect 2 nrcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";vect 2 nrcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((gen1 (make-nrcos 100 1 .1))
+ (gen2 (make-nrcos 200 1 .1))
+ (frq 0.0))
+ (run
+ (lambda ()
+ (do ((i 0 (+ 1 i)))
+ ((= i 2000))
+ (outa i (* .5 (+ (nrcos gen1 0.0)
+ (nrcos gen2 0.0))))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";no vect 2 nrcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";no vect 2 nrcos max: ~A" (maxamp snd))))
+
+ (let* ((res (with-sound (:clipped #f)
+ (let ((v (make-vector 2 #f)))
+ (vector-set! v 0 (make-nrcos 440 10 .5))
+ (vector-set! v 1 (make-nrcos 440 10 .5))
+ (run
+ (lambda ()
+ (do ((i 0 (+ 1 i)))
+ ((= i 2000))
+ (let ((gen (vector-ref v 0)))
+ (outa i (nrcos gen)))))))))
+ (snd (find-sound res)))
+ (if (not (sound? snd)) (snd-display #__line__ ";vect let nrcos ~A" snd))
+ (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";vect let nrcos max: ~A" (maxamp snd))))
+
+ (with-sound (:play #t)
+ (let* ((exp-amt 8.0)
+ (gran (make-granulate :expansion exp-amt))
+ (dur 2.0)
+ (samps (seconds->samples dur))
+ (ampf (make-env '(0.000 0.000 0.011 0.147 0.023 0.131 0.028 0.034 0.059 0.000 0.063 0.153 0.067 0.113
+ 0.072 0.391 0.081 0.095 0.088 0.052 0.102 0.025 0.124 0.000 0.131 0.452 0.139 0.327
+ 0.144 0.099 0.156 0.097 0.160 0.048 0.186 0.000 0.194 0.438 0.200 0.366 0.201 0.156
+ 0.211 0.063 0.247 0.000 0.256 0.628 0.268 0.154 0.274 0.190 0.285 0.027 0.296 0.059
+ 0.309 0.031 0.312 0.481 0.322 0.939 0.331 0.314 0.351 0.061 0.363 0.099 0.374 0.056
+ 0.377 0.438 0.389 0.858 0.394 0.467 0.403 0.241 0.414 0.197 0.415 0.127 0.425 0.075
+ 0.436 0.090 0.441 0.526 0.454 0.869 0.471 0.239 0.490 0.029 0.503 0.117 0.505 0.485
+ 0.514 0.811 0.528 0.415 0.538 0.088 0.552 0.056 0.561 0.106 0.580 0.075 0.597 0.000
+ 0.776 0.000 0.777 0.573 0.786 0.145 0.801 0.054 0.826 0.000 0.827 0.632 0.844 1.000
+ 0.856 0.524 0.866 0.031 0.883 0.074 0.891 0.136 0.896 0.745 0.907 0.424 0.915 0.765
+ 0.934 0.059 0.951 0.048 0.962 0.079 0.970 0.436 0.986 0.266 1.000 0.000)
+ :duration 0.25 :scaler 0.5))
+ (frqf (make-env '(0.000 0.220 0.074 0.249 0.133 0.249 0.194 0.240 0.258 0.252 0.324 0.264 0.389 0.267
+ 0.456 0.270 0.520 0.264 0.847 0.270 0.920 0.273 1.000 0.279)
+ :duration 0.25 :scaler (hz->radians (* 0.5 0.205 22050.0))))
+ (gen1 (make-polywave :partials (list 2 .35 3 .1 4 .8 5 .01 6 .03 8 .005)))
+ (rnd (make-rand-interp 600 (hz->radians 50))))
+ (run
+ (lambda ()
+ (do ((i 0 (+ 1 i)))
+ ((= i samps))
+ (outa i (granulate gran
+ (lambda (dir)
+ (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd))))))))))))
+
+ (let ((g (make-osc329 440.0)) (f 10.0))
+ (run (lambda () (set! f (osc329 g 0.0))))
+ (if (fneq f 0.0) (snd-display #__line__ ";run osc329: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f #t))
+ (run (lambda () (set! f (oscil? g))))
+ (if f (snd-display #__line__ ";oscil? osc329: ~A" f)))
+ (let ((g (+ 3 2)) (f #t))
+ (run (lambda () (set! f (oscil? g))))
+ (if f (snd-display #__line__ ";oscil? 5: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f #t))
+ (run (lambda () (set! f (osc329? g))))
+ (if (not f) (snd-display #__line__ ";osc329? osc329: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 0.0))
+ (run (lambda () (set! f (mus-frequency g))))
+ (if (fneq f 440.0) (snd-display #__line__ ";mus-frequency osc329: ~A" f)))
+ (let ((g123 (make-osc329 440.0)) (f 0.0))
+ (run (lambda () (set! f (mus-frequency g123))))
+ (if (or (not (number? f)) (fneq f 440.0)) (snd-display #__line__ ";(name) mus-frequency osc329: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 32)) (set! f (mus-length g))
+ (if (not (= f 1)) (snd-display #__line__ ";osc329 (no run) mus-length: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 32))
+ (run (lambda () (set! f (mus-length g))))
+ (if (not (= f 1)) (snd-display #__line__ ";osc329 mus-length: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f "hiho"))
+ (run (lambda () (set! f (mus-name g))))
+ (if (not (string=? f "osc329")) (snd-display #__line__ ";osc329 mus-name: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 1.0))
+ (run (lambda () (set! f (mus-phase g))))
+ (if (fneq f 0.0) (snd-display #__line__ ";mus-phase osc329: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 1.0))
+ (run (lambda () (set! (mus-phase g) f)))
+ (if (fneq (mus-phase g) 1.0) (snd-display #__line__ ";set mus-phase osc329: ~A" (mus-phase g))))
+ (let ((g (make-osc329 440.0)) (f "hiho"))
+ (run (lambda () (set! f (mus-describe g))))
+ (if (not (string? f)) (snd-display #__line__ ";osc329 mus-describe: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 0.0))
+ (run (lambda () (set! f (mus-increment g))))
+ (if (fneq f 1.0) (snd-display #__line__ ";mus-increment osc329: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 32))
+ (run (lambda () (set! (mus-length g) f)))
+ (if (not (= (mus-length g) 32)) (snd-display #__line__ ";osc329 set mus-length: ~A" (mus-length g))))
+ (let ((g (make-osc329 440.0)) (f 440.0))
+ (run (lambda () (set! (mus-frequency g) 100.0) (set! f (mus-frequency g))))
+ (if (fneq f 100.0) (snd-display #__line__ ";osc329 set mus-frequency: ~A" (mus-frequency g))))
+ (let ((g (make-osc329 440.0)) (f 440.0))
+ (run (lambda () (set! (mus-increment g) 100.0) (set! f (mus-increment g))))
+ (if (fneq f 100.0) (snd-display #__line__ ";osc329 set mus-increment: ~A" (mus-increment g))))
+ (let ((g (make-osc329 440.0)) (f 32))
+ (run (lambda () (set! f (mus-hop g))))
+ (if (not (= f 1)) (snd-display #__line__ ";osc329 mus-hop: ~A" f)))
+ (let ((g (make-osc329 440.0)) (f 32))
+ (run (lambda () (set! (mus-hop g) f)))
+ (if (not (= (mus-hop g) 32)) (snd-display #__line__ ";osc329 set mus-hop: ~A" (mus-hop g))))
+
+ (if (not (provided? 'gmp))
+ (set! nearly-zero 1.0e-8)) ; in case floats
+ (let ((test-zero-stability
+ (lambda (make-func run-func zero)
+ (let ((gen (make-func)))
+ (set! (mus-phase gen) zero)
+ (let ((zero-val (run-func gen zero)))
+ (for-each
+ (lambda (val)
+ (set! gen (make-func)) ; remake else carrier drifts away in ssb cases
+ (set! (mus-phase gen) (+ zero val))
+ (let ((new-val (run-func gen 0.0)))
+ (if (> (abs (- new-val zero-val)) .01)
+ (snd-display #__line__ ";~A:~%; zero check at (+ ~A ~A): ~A ~A~%" gen zero val zero-val new-val))))
+ (list 1.0e-11 1.0e-10 1.0e-9 1.0e-8 1.0e-7 1.0e-6
+ -1.0e-11 -1.0e-10 -1.0e-9 -1.0e-8 -1.0e-7 -1.0e-6)))))))
+
+ (for-each
+ (lambda (zero)
+ (test-zero-stability (lambda () (make-oscil 0.0)) oscil zero)
+
+ (for-each
+ (lambda (n)
+ (test-zero-stability (lambda () (make-nsin 0.0 n)) nsin zero)
+ (test-zero-stability (lambda () (make-ncos 0.0 n)) ncos zero)
- (for-each
- (lambda (zero)
- (test-zero-stability (lambda () (make-oscil 0.0)) oscil zero)
-
- (for-each
- (lambda (n)
- (test-zero-stability (lambda () (make-nsin 0.0 n)) nsin zero)
- (test-zero-stability (lambda () (make-ncos 0.0 n)) ncos zero)
-
- (test-zero-stability (lambda () (make-nrxysin :n n)) nrxysin zero)
- (test-zero-stability (lambda () (make-nrxycos :n n)) nrxycos zero)
- (test-zero-stability (lambda () (make-nrxysin :n n :r .999999)) nrxysin zero)
- (test-zero-stability (lambda () (make-nrxycos :n n :r .999999)) nrxycos zero)
-
- (test-zero-stability (lambda () (make-nssb 0.0 1.0 n)) nssb zero)
- (test-zero-stability (lambda () (make-noddssb 0.0 1.0 n)) noddssb zero)
- (test-zero-stability (lambda () (make-nrssb 0.0 1.0 n)) nrssb zero)
- (test-zero-stability (lambda () (make-nxycos 0.0 1.0 :n n)) nxycos zero)
- (test-zero-stability (lambda () (make-nxy1cos 0.0 1.0 :n n)) nxy1cos zero)
- (test-zero-stability (lambda () (make-nxysin 0.0 1.0 :n n)) nxysin zero)
-
- (test-zero-stability (lambda () (make-nssb 0.0 1.0 n)) nssb zero)
- (test-zero-stability (lambda () (make-noddssb 0.0 1.0 n)) noddssb zero)
- (test-zero-stability (lambda () (make-nrssb 0.0 1.0 n)) nrssb zero)
- (test-zero-stability (lambda () (make-nxycos 0.0 1.0 :n n)) nxycos zero)
- (test-zero-stability (lambda () (make-nxy1cos 0.0 1.0 :n n)) nxy1cos zero)
- (test-zero-stability (lambda () (make-nxysin 0.0 1.0 :n n)) nxysin zero)
-
- (test-zero-stability (lambda () (make-nkssb 0.0 1.0 n)) nkssb zero)
- (test-zero-stability (lambda () (make-nkssb 0.0 1.0 n)) nkssb zero)
-
- (test-zero-stability (lambda () (make-noddsin :n n)) noddsin zero)
- (test-zero-stability (lambda () (make-noddcos :n n)) noddcos zero)
- (test-zero-stability (lambda () (make-ncos2 :n n)) ncos2 zero)
- (test-zero-stability (lambda () (make-npcos :n n)) npcos zero)
- (test-zero-stability (lambda () (make-n1cos :n n)) n1cos zero)
- (test-zero-stability (lambda () (make-nrcos :n n)) nrcos zero))
- (list 1 10 3 30))
-
- (test-zero-stability (lambda () (make-krksin :r 0.1)) krksin zero)
- (test-zero-stability (lambda () (make-k2sin)) k2sin zero)
- (test-zero-stability (lambda () (make-k2cos)) k2cos zero)
- (test-zero-stability (lambda () (make-k2ssb 0.0 1.0)) k2ssb zero)
- (test-zero-stability (lambda () (make-abcos :a 1.0 :b 0.5)) abcos zero)
- (test-zero-stability (lambda () (make-absin :a 1.0 :b 0.5)) absin zero)
-
- (for-each
- (lambda (r)
- (test-zero-stability (lambda () (make-rcos :r r)) rcos zero)
- (test-zero-stability (lambda () (make-ercos :r r)) ercos zero)
+ (test-zero-stability (lambda () (make-nrxysin :n n)) nrxysin zero)
+ (test-zero-stability (lambda () (make-nrxycos :n n)) nrxycos zero)
+ (test-zero-stability (lambda () (make-nrxysin :n n :r .999999)) nrxysin zero)
+ (test-zero-stability (lambda () (make-nrxycos :n n :r .999999)) nrxycos zero)
+
+ (test-zero-stability (lambda () (make-nssb 0.0 1.0 n)) nssb zero)
+ (test-zero-stability (lambda () (make-noddssb 0.0 1.0 n)) noddssb zero)
+ (test-zero-stability (lambda () (make-nrssb 0.0 1.0 n)) nrssb zero)
+ (test-zero-stability (lambda () (make-nxycos 0.0 1.0 :n n)) nxycos zero)
+ (test-zero-stability (lambda () (make-nxy1cos 0.0 1.0 :n n)) nxy1cos zero)
+ (test-zero-stability (lambda () (make-nxysin 0.0 1.0 :n n)) nxysin zero)
+
+ (test-zero-stability (lambda () (make-nssb 0.0 1.0 n)) nssb zero)
+ (test-zero-stability (lambda () (make-noddssb 0.0 1.0 n)) noddssb zero)
+ (test-zero-stability (lambda () (make-nrssb 0.0 1.0 n)) nrssb zero)
+ (test-zero-stability (lambda () (make-nxycos 0.0 1.0 :n n)) nxycos zero)
+ (test-zero-stability (lambda () (make-nxy1cos 0.0 1.0 :n n)) nxy1cos zero)
+ (test-zero-stability (lambda () (make-nxysin 0.0 1.0 :n n)) nxysin zero)
+
+ (test-zero-stability (lambda () (make-nkssb 0.0 1.0 n)) nkssb zero)
+ (test-zero-stability (lambda () (make-nkssb 0.0 1.0 n)) nkssb zero)
+
+ (test-zero-stability (lambda () (make-noddsin :n n)) noddsin zero)
+ (test-zero-stability (lambda () (make-noddcos :n n)) noddcos zero)
+ (test-zero-stability (lambda () (make-ncos2 :n n)) ncos2 zero)
+ (test-zero-stability (lambda () (make-npcos :n n)) npcos zero)
+ (test-zero-stability (lambda () (make-n1cos :n n)) n1cos zero)
+ (test-zero-stability (lambda () (make-nrcos :n n)) nrcos zero))
+ (list 1 10 3 30))
+
+ (test-zero-stability (lambda () (make-krksin :r 0.1)) krksin zero)
+ (test-zero-stability (lambda () (make-k2sin)) k2sin zero)
+ (test-zero-stability (lambda () (make-k2cos)) k2cos zero)
+ (test-zero-stability (lambda () (make-k2ssb 0.0 1.0)) k2ssb zero)
+ (test-zero-stability (lambda () (make-abcos :a 1.0 :b 0.5)) abcos zero)
+ (test-zero-stability (lambda () (make-absin :a 1.0 :b 0.5)) absin zero)
+
+ (for-each
+ (lambda (r)
+ (test-zero-stability (lambda () (make-rcos :r r)) rcos zero)
+ (test-zero-stability (lambda () (make-ercos :r r)) ercos zero)
;(test-zero-stability (lambda () (make-r2sin :r r)) r2sin zero)
;(test-zero-stability (lambda () (make-r2cos :r r)) r2cos zero)
- (test-zero-stability (lambda () (make-eoddcos :r r)) eoddcos zero)
- (test-zero-stability (lambda () (make-rkcos :r r)) rkcos zero)
- (test-zero-stability (lambda () (make-rksin :r r)) rksin zero)
- (test-zero-stability (lambda () (make-rk!cos :r r)) rk!cos zero)
- (test-zero-stability (lambda () (make-r2k!cos :r r)) r2k!cos zero)
- (test-zero-stability (lambda () (make-r2k2cos :r r)) r2k2cos zero)
-
- (test-zero-stability (lambda () (make-nrxysin :n 3 :r r)) nrxysin zero)
- (test-zero-stability (lambda () (make-nrxycos :n 3 :r r)) nrxycos zero)
-
- (test-zero-stability (lambda () (make-rssb 0.0 1.0 :r r)) rssb zero)
- (test-zero-stability (lambda () (make-erssb 0.0 1.0 :r r)) erssb zero)
- (test-zero-stability (lambda () (make-rkssb 0.0 1.0 :r r)) rkssb zero)
- (test-zero-stability (lambda () (make-rk!ssb 0.0 1.0 :r r)) rk!ssb zero)
- (test-zero-stability (lambda () (make-rkoddssb 0.0 1.0 :r r)) rkoddssb zero)
- ;(test-zero-stability (lambda () (make-r2ssb 0.0 1.0 :r r)) r2ssb zero)
-
- (test-zero-stability (lambda () (make-rssb 0.0 1.0 :r r)) rssb zero)
- (test-zero-stability (lambda () (make-erssb 0.0 1.0 :r r)) erssb zero)
- (test-zero-stability (lambda () (make-rkssb 0.0 1.0 :r r)) rkssb zero)
- (test-zero-stability (lambda () (make-rk!ssb 0.0 1.0 :r r)) rk!ssb zero)
- (test-zero-stability (lambda () (make-rkoddssb 0.0 1.0 :r r)) rkoddssb zero)
- ;(test-zero-stability (lambda () (make-r2ssb 0.0 1.0 :r r)) r2ssb zero)
- )
- (list 0.1 0.5 .99 .999)))
- (list 0.0 (* 0.5 pi) pi (* 2.0 pi) (* -0.5 pi) (- pi) (* -2.0 pi) (* 1.5 pi) (* -1.5 pi))))
-
- (calling-all-animals)
- (calling-all-generators)
-
- (let ((funcs (list nssb nxysin nxycos nxy1cos nxy1sin noddsin noddcos noddssb ncos2 npcos
- nrsin nrcos nrssb nkssb nsincos rcos rssb rxysin rxycos
- rxyk!sin rxyk!cos ercos erssb eoddcos rkcos rksin rkssb
- rk!cos rk!ssb r2k!cos k2sin k2cos k2ssb dblsum rkoddssb krksin
- abcos absin r2k2cos bess jjcos j0evencos j2cos jpcos jncos
- j0j1cos jycos blackman fmssb k3sin izcos
- adjustable-square-wave adjustable-triangle-wave adjustable-sawtooth-wave adjustable-oscil
- round-interp))
- (make-funcs (list make-nssb make-nxysin make-nxycos make-nxy1cos make-nxy1sin make-noddsin make-noddcos make-noddssb make-ncos2 make-npcos
- make-nrsin make-nrcos make-nrssb make-nkssb make-nsincos make-rcos make-rssb make-rxysin make-rxycos
- make-rxyk!sin make-rxyk!cos make-ercos make-erssb make-eoddcos make-rkcos make-rksin make-rkssb
- make-rk!cos make-rk!ssb make-r2k!cos make-k2sin make-k2cos make-k2ssb make-dblsum make-rkoddssb make-krksin
- make-abcos make-absin make-r2k2cos make-bess make-jjcos make-j0evencos make-j2cos make-jpcos make-jncos
- make-j0j1cos make-jycos make-blackman make-fmssb make-k3sin make-izcos
- make-adjustable-square-wave make-adjustable-triangle-wave make-adjustable-sawtooth-wave make-adjustable-oscil
- make-round-interp))
- (pfuncs (list nssb? nxysin? nxycos? nxy1cos? nxy1sin? noddsin? noddcos? noddssb? ncos2? npcos?
- nrsin? nrcos? nrssb? nkssb? nsincos? rcos? rssb? rxysin? rxycos?
- rxyk!sin? rxyk!cos? ercos? erssb? eoddcos? rkcos? rksin? rkssb?
- rk!cos? rk!ssb? r2k!cos? k2sin? k2cos? k2ssb? dblsum? rkoddssb? krksin?
- abcos? absin? r2k2cos? bess? jjcos? j0evencos? j2cos? jpcos? jncos?
- j0j1cos? jycos? blackman? fmssb? k3sin? izcos?
- adjustable-square-wave? adjustable-triangle-wave? adjustable-sawtooth-wave? adjustable-oscil?
- round-interp?))
- (names (list 'nssb 'nxysin 'nxycos 'nxy1cos 'nxy1sin 'noddsin 'noddcos 'noddssb 'ncos2 'npcos
- 'nrsin 'nrcos 'nrssb 'nkssb 'nsincos 'rcos 'rssb 'rxysin 'rxycos
- 'rxyk!sin 'rxyk!cos 'ercos 'erssb 'eoddcos 'rkcos 'rksin 'rkssb
- 'rk!cos 'rk!ssb 'r2k!cos 'k2sin 'k2cos 'k2ssb 'dblsum 'rkoddssb 'krksin
- 'abcos 'absin 'r2k2cos 'bess 'jjcos 'j0evencos 'j2cos 'jpcos 'jncos
- 'j0j1cos 'jycos 'blackman 'fmssb 'k3sin 'izcos
- 'adjustable-square-wave 'adjustable-triangle-wave 'adjustable-sawtooth-wave 'adjustable-oscil
- 'round-interp))
- (methods (list nssb-methods nxysin-methods nxycos-methods nxy1cos-methods nxy1sin-methods
- noddsin-methods noddcos-methods noddssb-methods ncos2-methods npcos-methods
- nrsin-methods nrcos-methods nrssb-methods nkssb-methods nsincos-methods
- rcos-methods rssb-methods rxysin-methods rxycos-methods
- rxyk!sin-methods rxyk!cos-methods ercos-methods erssb-methods
- eoddcos-methods rkcos-methods rksin-methods rkssb-methods
- rk!cos-methods rk!ssb-methods r2k!cos-methods k2sin-methods k2cos-methods k2ssb-methods
- dblsum-methods rkoddssb-methods krksin-methods
- abcos-methods absin-methods r2k2cos-methods bess-methods
- jjcos-methods j0evencos-methods j2cos-methods jpcos-methods jncos-methods
- j0j1cos-methods jycos-methods blackman-methods fmssb-methods k3sin-methods izcos-methods
- adjustable-square-wave-methods adjustable-triangle-wave-methods
- adjustable-sawtooth-wave-methods adjustable-oscil-methods
- round-interp-methods))
- )
+ (test-zero-stability (lambda () (make-eoddcos :r r)) eoddcos zero)
+ (test-zero-stability (lambda () (make-rkcos :r r)) rkcos zero)
+ (test-zero-stability (lambda () (make-rksin :r r)) rksin zero)
+ (test-zero-stability (lambda () (make-rk!cos :r r)) rk!cos zero)
+ (test-zero-stability (lambda () (make-r2k!cos :r r)) r2k!cos zero)
+ (test-zero-stability (lambda () (make-r2k2cos :r r)) r2k2cos zero)
+ (test-zero-stability (lambda () (make-nrxysin :n 3 :r r)) nrxysin zero)
+ (test-zero-stability (lambda () (make-nrxycos :n 3 :r r)) nrxycos zero)
- (for-each
- (lambda (mf rf pf name mth)
- (let ((gen (mf)))
- (if (not (pf gen))
- (snd-display ";make-* generators ~A: ~A" name gen))
- (if (not (mus-generator? gen))
- (snd-display ";make-* generators mus-generator? ~A" gen))
- (rf gen 0.0)
- (mus-run gen 0.0 0.0)
- (mus-reset gen)
- (if (not (string=? (mus-name gen) (symbol->string name)))
- (snd-display ";mus-name generators: ~A ~A" (mus-name gen) (symbol->string name)))
- (let* ((has-freq (assoc 'mus-frequency (mth)))
- (has-n (and (assoc 'mus-order (mth))
- (pf (catch #t (lambda () (mf :n 3)) (lambda args (car args))))))
- (has-r (and (assoc 'mus-scaler (mth))
- (pf (catch #t (lambda () (mf :r 0.75)) (lambda args (car args)))))))
- (if has-freq
- (begin
- (set! gen (mf :frequency 440.0))
- (if (fneq (mus-frequency gen) 440.0)
- (snd-display ";mus-frequency from make-~A: ~A" name (mus-frequency gen)))))
- (if has-n
- (begin
- (set! gen (mf :n 3))
- (if (not (= (mus-order gen) 3))
- (snd-display ";mus-order from make-~A: ~A" name (mus-order gen)))))
- (if has-r
- (begin
- (set! gen (mf :r 0.75))
- (if (fneq (mus-scaler gen) 0.75)
- (snd-display ";mus-scaler from make-~A: ~A" name (mus-scaler gen))))))))
-
- make-funcs funcs pfuncs names methods))
-
-
+ (test-zero-stability (lambda () (make-rssb 0.0 1.0 :r r)) rssb zero)
+ (test-zero-stability (lambda () (make-erssb 0.0 1.0 :r r)) erssb zero)
+ (test-zero-stability (lambda () (make-rkssb 0.0 1.0 :r r)) rkssb zero)
+ (test-zero-stability (lambda () (make-rk!ssb 0.0 1.0 :r r)) rk!ssb zero)
+ (test-zero-stability (lambda () (make-rkoddssb 0.0 1.0 :r r)) rkoddssb zero)
+ ;(test-zero-stability (lambda () (make-r2ssb 0.0 1.0 :r r)) r2ssb zero)
+
+ (test-zero-stability (lambda () (make-rssb 0.0 1.0 :r r)) rssb zero)
+ (test-zero-stability (lambda () (make-erssb 0.0 1.0 :r r)) erssb zero)
+ (test-zero-stability (lambda () (make-rkssb 0.0 1.0 :r r)) rkssb zero)
+ (test-zero-stability (lambda () (make-rk!ssb 0.0 1.0 :r r)) rk!ssb zero)
+ (test-zero-stability (lambda () (make-rkoddssb 0.0 1.0 :r r)) rkoddssb zero)
+ ;(test-zero-stability (lambda () (make-r2ssb 0.0 1.0 :r r)) r2ssb zero)
+ )
+ (list 0.1 0.5 .99 .999)))
+ (list 0.0 (* 0.5 pi) pi (* 2.0 pi) (* -0.5 pi) (- pi) (* -2.0 pi) (* 1.5 pi) (* -1.5 pi))))
+
+ (calling-all-animals)
+ (calling-all-generators)
+
+ (let ((funcs (list nssb nxysin nxycos nxy1cos nxy1sin noddsin noddcos noddssb ncos2 npcos
+ nrsin nrcos nrssb nkssb nsincos rcos rssb rxysin rxycos
+ rxyk!sin rxyk!cos ercos erssb eoddcos rkcos rksin rkssb
+ rk!cos rk!ssb r2k!cos k2sin k2cos k2ssb dblsum rkoddssb krksin
+ abcos absin r2k2cos bess jjcos j0evencos j2cos jpcos jncos
+ j0j1cos jycos blackman fmssb k3sin izcos
+ adjustable-square-wave adjustable-triangle-wave adjustable-sawtooth-wave adjustable-oscil
+ round-interp))
+ (make-funcs (list make-nssb make-nxysin make-nxycos make-nxy1cos make-nxy1sin make-noddsin make-noddcos make-noddssb make-ncos2 make-npcos
+ make-nrsin make-nrcos make-nrssb make-nkssb make-nsincos make-rcos make-rssb make-rxysin make-rxycos
+ make-rxyk!sin make-rxyk!cos make-ercos make-erssb make-eoddcos make-rkcos make-rksin make-rkssb
+ make-rk!cos make-rk!ssb make-r2k!cos make-k2sin make-k2cos make-k2ssb make-dblsum make-rkoddssb make-krksin
+ make-abcos make-absin make-r2k2cos make-bess make-jjcos make-j0evencos make-j2cos make-jpcos make-jncos
+ make-j0j1cos make-jycos make-blackman make-fmssb make-k3sin make-izcos
+ make-adjustable-square-wave make-adjustable-triangle-wave make-adjustable-sawtooth-wave make-adjustable-oscil
+ make-round-interp))
+ (pfuncs (list nssb? nxysin? nxycos? nxy1cos? nxy1sin? noddsin? noddcos? noddssb? ncos2? npcos?
+ nrsin? nrcos? nrssb? nkssb? nsincos? rcos? rssb? rxysin? rxycos?
+ rxyk!sin? rxyk!cos? ercos? erssb? eoddcos? rkcos? rksin? rkssb?
+ rk!cos? rk!ssb? r2k!cos? k2sin? k2cos? k2ssb? dblsum? rkoddssb? krksin?
+ abcos? absin? r2k2cos? bess? jjcos? j0evencos? j2cos? jpcos? jncos?
+ j0j1cos? jycos? blackman? fmssb? k3sin? izcos?
+ adjustable-square-wave? adjustable-triangle-wave? adjustable-sawtooth-wave? adjustable-oscil?
+ round-interp?))
+ (names (list 'nssb 'nxysin 'nxycos 'nxy1cos 'nxy1sin 'noddsin 'noddcos 'noddssb 'ncos2 'npcos
+ 'nrsin 'nrcos 'nrssb 'nkssb 'nsincos 'rcos 'rssb 'rxysin 'rxycos
+ 'rxyk!sin 'rxyk!cos 'ercos 'erssb 'eoddcos 'rkcos 'rksin 'rkssb
+ 'rk!cos 'rk!ssb 'r2k!cos 'k2sin 'k2cos 'k2ssb 'dblsum 'rkoddssb 'krksin
+ 'abcos 'absin 'r2k2cos 'bess 'jjcos 'j0evencos 'j2cos 'jpcos 'jncos
+ 'j0j1cos 'jycos 'blackman 'fmssb 'k3sin 'izcos
+ 'adjustable-square-wave 'adjustable-triangle-wave 'adjustable-sawtooth-wave 'adjustable-oscil
+ 'round-interp))
+ (methods (list nssb-methods nxysin-methods nxycos-methods nxy1cos-methods nxy1sin-methods
+ noddsin-methods noddcos-methods noddssb-methods ncos2-methods npcos-methods
+ nrsin-methods nrcos-methods nrssb-methods nkssb-methods nsincos-methods
+ rcos-methods rssb-methods rxysin-methods rxycos-methods
+ rxyk!sin-methods rxyk!cos-methods ercos-methods erssb-methods
+ eoddcos-methods rkcos-methods rksin-methods rkssb-methods
+ rk!cos-methods rk!ssb-methods r2k!cos-methods k2sin-methods k2cos-methods k2ssb-methods
+ dblsum-methods rkoddssb-methods krksin-methods
+ abcos-methods absin-methods r2k2cos-methods bess-methods
+ jjcos-methods j0evencos-methods j2cos-methods jpcos-methods jncos-methods
+ j0j1cos-methods jycos-methods blackman-methods fmssb-methods k3sin-methods izcos-methods
+ adjustable-square-wave-methods adjustable-triangle-wave-methods
+ adjustable-sawtooth-wave-methods adjustable-oscil-methods
+ round-interp-methods))
+ )
+
+
+ (for-each
+ (lambda (mf rf pf name mth)
+ (let ((gen (mf)))
+ (if (not (pf gen))
+ (snd-display #__line__ ";make-* generators ~A: ~A" name gen))
+ (if (not (mus-generator? gen))
+ (snd-display #__line__ ";make-* generators mus-generator? ~A" gen))
+ (rf gen 0.0)
+ (mus-run gen 0.0 0.0)
+ (mus-reset gen)
+ (if (not (string=? (mus-name gen) (symbol->string name)))
+ (snd-display #__line__ ";mus-name generators: ~A ~A" (mus-name gen) (symbol->string name)))
+ (let* ((has-freq (assoc 'mus-frequency (mth)))
+ (has-n (and (assoc 'mus-order (mth))
+ (pf (catch #t (lambda () (mf :n 3)) (lambda args (car args))))))
+ (has-r (and (assoc 'mus-scaler (mth))
+ (pf (catch #t (lambda () (mf :r 0.75)) (lambda args (car args)))))))
+ (if has-freq
+ (begin
+ (set! gen (mf :frequency 440.0))
+ (if (fneq (mus-frequency gen) 440.0)
+ (snd-display #__line__ ";mus-frequency from make-~A: ~A" name (mus-frequency gen)))))
+ (if has-n
+ (begin
+ (set! gen (mf :n 3))
+ (if (not (= (mus-order gen) 3))
+ (snd-display #__line__ ";mus-order from make-~A: ~A" name (mus-order gen)))))
+ (if has-r
+ (begin
+ (set! gen (mf :r 0.75))
+ (if (fneq (mus-scaler gen) 0.75)
+ (snd-display #__line__ ";mus-scaler from make-~A: ~A" name (mus-scaler gen))))))))
+
+ make-funcs funcs pfuncs names methods))
+
+
+ (for-each
+ (lambda (name maker methods isit)
+ (let ((gen (maker)))
+ (if (not (isit gen))
+ (format #t "~A is not a ~A?" gen name)
+ (let* ((funcs (methods)))
+ (if (null? funcs)
+ (format #t "A has no methods?" name)
+ (for-each
+ (lambda (method)
+ (let ((method-name (car method)))
+ (catch #t
+ (lambda ()
+ (let ((curval (if (not (eq? method-name 'mus-run)) ((cadr method) gen) #f)))
+ (if (not (null? (cddr method)))
+ (begin
+ (if (eq? method-name 'mus-name)
+ (set! (mus-name gen) "hiho")
+ (if (eq? method-name 'mus-n)
+ (set! (mus-n gen) 1)
+ ((caddr method) gen 10.0)))))))
+ (lambda args
+ (format #t "error in ~A~%" (car method))
+ #f))))
+ funcs))))))
+
+ (list 'nssb 'nxysin 'nxycos 'nxy1cos 'nxy1sin 'noddsin 'noddcos 'noddssb 'ncos2 'npcos
+ nrsin 'nrcos 'nrssb 'nkssb 'nsincos 'rcos 'rssb 'rxysin 'rxycos
+ rxyk!sin 'rxyk!cos 'ercos 'erssb 'eoddcos 'rkcos 'rksin 'rkssb
+ rk!cos 'rk!ssb 'r2k!cos 'k2sin 'k2cos 'k2ssb 'dblsum 'rkoddssb 'krksin
+ abcos 'absin 'r2k2cos 'bess 'jjcos 'j0evencos 'j2cos 'jpcos 'jncos
+ j0j1cos 'jycos 'blackman 'fmssb 'k3sin 'izcos 'nchoosekcos 'n1cos
+ adjustable-square-wave 'adjustable-triangle-wave 'adjustable-sawtooth-wave 'adjustable-oscil
+ round-interp 'sinc-train 'pink-noise 'green-noise 'brown-noise 'green-noise-interp
+ moving-max 'moving-sum 'moving-rms 'moving-length 'weighted-moving-average 'exponentially-weighted-moving-average
+ tanhsin 'moving-fft 'moving-scentroid 'moving-autocorrelation 'moving-pitch)
+
+ (list make-nssb make-nxysin make-nxycos make-nxy1cos make-nxy1sin make-noddsin make-noddcos make-noddssb make-ncos2 make-npcos
+ make-nrsin make-nrcos make-nrssb make-nkssb make-nsincos make-rcos make-rssb make-rxysin make-rxycos
+ make-rxyk!sin make-rxyk!cos make-ercos make-erssb make-eoddcos make-rkcos make-rksin make-rkssb
+ make-rk!cos make-rk!ssb make-r2k!cos make-k2sin make-k2cos make-k2ssb make-dblsum make-rkoddssb make-krksin
+ make-abcos make-absin make-r2k2cos make-bess make-jjcos make-j0evencos make-j2cos make-jpcos make-jncos
+ make-j0j1cos make-jycos make-blackman make-fmssb make-k3sin make-izcos make-nchoosekcos make-n1cos
+ make-adjustable-square-wave make-adjustable-triangle-wave make-adjustable-sawtooth-wave make-adjustable-oscil
+ make-round-interp make-sinc-train make-pink-noise make-green-noise make-brown-noise make-green-noise-interp
+ make-moving-max make-moving-sum make-moving-rms make-moving-length make-weighted-moving-average make-exponentially-weighted-moving-average
+ make-tanhsin make-moving-fft make-moving-scentroid make-moving-autocorrelation make-moving-pitch)
+
+ (list nssb-methods nxysin-methods nxycos-methods nxy1cos-methods nxy1sin-methods noddsin-methods noddcos-methods noddssb-methods ncos2-methods npcos-methods
+ nrsin-methods nrcos-methods nrssb-methods nkssb-methods nsincos-methods rcos-methods rssb-methods rxysin-methods rxycos-methods
+ rxyk!sin-methods rxyk!cos-methods ercos-methods erssb-methods eoddcos-methods rkcos-methods rksin-methods rkssb-methods
+ rk!cos-methods rk!ssb-methods r2k!cos-methods k2sin-methods k2cos-methods k2ssb-methods dblsum-methods rkoddssb-methods krksin-methods
+ abcos-methods absin-methods r2k2cos-methods bess-methods jjcos-methods j0evencos-methods j2cos-methods jpcos-methods jncos-methods
+ j0j1cos-methods jycos-methods blackman-methods fmssb-methods k3sin-methods izcos-methods nchoosekcos-methods n1cos-methods
+ adjustable-square-wave-methods adjustable-triangle-wave-methods adjustable-sawtooth-wave-methods adjustable-oscil-methods
+ round-interp-methods sinc-train-methods pink-noise-methods green-noise-methods brown-noise-methods green-noise-interp-methods
+ moving-max-methods moving-sum-methods moving-rms-methods moving-length-methods weighted-moving-average-methods exponentially-weighted-moving-average-methods
+ tanhsin-methods moving-fft-methods moving-scentroid-methods moving-autocorrelation-methods moving-pitch-methods)
+
+ (list nssb? nxysin? nxycos? nxy1cos? nxy1sin? noddsin? noddcos? noddssb? ncos2? npcos?
+ nrsin? nrcos? nrssb? nkssb? nsincos? rcos? rssb? rxysin? rxycos?
+ rxyk!sin? rxyk!cos? ercos? erssb? eoddcos? rkcos? rksin? rkssb?
+ rk!cos? rk!ssb? r2k!cos? k2sin? k2cos? k2ssb? dblsum? rkoddssb? krksin?
+ abcos? absin? r2k2cos? bess? jjcos? j0evencos? j2cos? jpcos? jncos?
+ j0j1cos? jycos? blackman? fmssb? k3sin? izcos? nchoosekcos? n1cos?
+ adjustable-square-wave? adjustable-triangle-wave? adjustable-sawtooth-wave? adjustable-oscil?
+ round-interp? sinc-train? pink-noise? green-noise? brown-noise? green-noise-interp?
+ moving-max? moving-sum? moving-rms? moving-length? weighted-moving-average? exponentially-weighted-moving-average?
+ tanhsin? moving-fft? moving-scentroid? moving-autocorrelation? moving-pitch? )
+ )
+
+
+ (let ((gen1 (make-oscil 440.0))
+ (gen2 (make-oscil 440.0)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 1000))
+ (let* ((pm (- 1.0 (random 2.0)))
+ (val1 (oscil gen1 0.0 pm))
+ (val2 (run-with-fm-and-pm gen2 0.0 pm)))
+ (if (fneq val1 val2)
+ (snd-display #__line__ ";run-with-fm-and-pm: ~A ~A" val1 val2)))))
+
+ (let ((gen1 (make-oscil 440.0))
+ (gen2 (make-oscil 440.0))
+ (happy #t))
+ (run
+ (do ((i 0 (+ 1 i)))
+ ((or (not happy)
+ (= i 1000)))
+ (let* ((pm (- 1.0 (random 2.0)))
+ (val1 (oscil gen1 0.0 pm))
+ (val2 (run-with-fm-and-pm gen2 0.0 pm)))
+ (if (fneq val1 val2)
+ (set! happy #f)))))
+ (if (not happy)
+ (snd-display #__line__ ";run-with-fm-and-pm unhappy")))
+
+ (set! (mus-srate) 44100)
+ (let ((gen (make-nssb 440.0 :n 3))
+ (order 0)
+ (frequency 0.0)
+ (val 0.0)
+ (name "hiho"))
+ (run
+ (lambda ()
+ (set! order (mus-order gen))
+ (set! frequency (mus-frequency gen))
+ (nssb gen 1.0)
+ (set! val (mus-run gen 0.0 0.0))
+ (set! name (mus-name gen))
+ ))
+ (if (not (string=? name "nssb")) (snd-display #__line__ ";run mus-name nssb: ~A" name))
+ (if (not (= order 3)) (snd-display #__line__ ";run mus-order nssb: ~A" order))
+ (if (fneq frequency 440.0) (snd-display #__line__ ";run mus-frequency nssb: ~A" frequency))
+ (if (fneq val 0.371) (snd-display #__line__ ";run mus-run nssb: ~A" val)))
+
+ ;; mus-reset and mus-describe in this case have an embedded for-each, so not optimizable
+
+ (let ((gen (make-oscil 123.0)))
+ (set! (mus-name gen) "oscil123")
+ (if (not (string=? (mus-name gen) "oscil123")) (snd-display #__line__ ";set mus-name oscil123: ~A" (mus-name gen)))
+ (set! (mus-name gen) "another-name")
+ (if (not (string=? (mus-name gen) "another-name")) (snd-display #__line__ ";set mus-name again: ~A" (mus-name gen)))
+ (let ((descr (mus-describe gen)))
+ (if (not (string=? descr "another-name freq: 123.000Hz, phase: 0.000"))
+ (snd-display #__line__ ";set mus-name describe: ~A" descr))))
+
+ (let ((gen (make-nssb 123.0)))
+ (set! (mus-name gen) "nssb123")
+ (if (not (string=? (mus-name gen) "nssb123")) (snd-display #__line__ ";set mus-name nssb123: ~A" (mus-name gen)))
+ (set! (mus-name gen) "another-name")
+ (if (not (string=? (mus-name gen) "another-name")) (snd-display #__line__ ";set mus-name nssb again: ~A" (mus-name gen)))
+ (set! (mus-frequency gen) 0.0)
+ (let ((descr (mus-describe gen)))
+ (if (not (string=? descr "another-name frequency: 0.0, ratio: 1.0, n: 1, angle: 0.0"))
+ (snd-display #__line__ ";set mus-name nssb describe: ~A" descr))))
+
+ (let ((gen (make-oscil 123.0))
+ (gen1 (make-oscil 440.0)))
+ (set! (mus-name gen) "oscil123")
+ (set! (mus-name gen1) "440")
+ (if (not (string=? (mus-name gen) "oscil123")) (snd-display #__line__ ";set mus-name oscil123 1: ~A" (mus-name gen)))
+ (if (not (string=? (mus-name gen1) "440")) (snd-display #__line__ ";set mus-name oscil 440 1: ~A" (mus-name gen)))
+ (set! (mus-name gen1) "another-name")
+ (if (not (string=? (mus-name gen1) "another-name")) (snd-display #__line__ ";set mus-name again 1: ~A" (mus-name gen)))
+ (if (not (string=? (mus-name gen) "oscil123")) (snd-display #__line__ ";set mus-name oscil123 2: ~A" (mus-name gen)))
+ (let ((descr (mus-describe gen1)))
+ (if (not (string=? descr "another-name freq: 440.000Hz, phase: 0.000"))
+ (snd-display #__line__ ";set mus-name describe 1: ~A" descr))))
+
+ (let ((gen (make-nssb 123.0))
+ (gen1 (make-nssb 440.0)))
+ (set! (mus-name gen) "nssb123")
+ (set! (mus-name gen1) "440")
+ (if (not (string=? (mus-name gen) "nssb123")) (snd-display #__line__ ";set mus-name nssb123 1: ~A" (mus-name gen)))
+ (if (not (string=? (mus-name gen1) "440")) (snd-display #__line__ ";set mus-name nssb 440 1: ~A" (mus-name gen)))
+ (set! (mus-name gen) "another-name")
+ (if (not (string=? (mus-name gen) "another-name")) (snd-display #__line__ ";set mus-name nssb again 1: ~A" (mus-name gen)))
+ (set! (mus-frequency gen) 0.0)
+ (let ((descr (mus-describe gen)))
+ (if (not (string=? descr "another-name frequency: 0.0, ratio: 1.0, n: 1, angle: 0.0"))
+ (snd-display #__line__ ";set mus-name nssb describe 1: ~A" descr))))
+
+
+ (if (not (null? (sounds))) (for-each close-sound (sounds)))
+ (set! (optimization) old-opt-23)
+
+ (test-documentation-instruments) ; clm23.scm
+
+ (if #f
+ (let ((outfile "/home/bil/test/sound/big3.snd"))
+ (if (file-exists? outfile)
+ (delete-file outfile))
(for-each
- (lambda (name maker methods isit)
- (let ((gen (maker)))
- (if (not (isit gen))
- (format #t "~A is not a ~A?" gen name)
- (let* ((funcs (methods)))
- (if (null? funcs)
- (format #t "A has no methods?" name)
- (for-each
- (lambda (method)
- (let ((method-name (car method)))
- (catch #t
- (lambda ()
- (let ((curval (if (not (eq? method-name 'mus-run)) ((cadr method) gen) #f)))
- (if (not (null? (cddr method)))
- (begin
- (if (eq? method-name 'mus-name)
- (set! (mus-name gen) "hiho")
- (if (eq? method-name 'mus-n)
- (set! (mus-n gen) 1)
- ((caddr method) gen 10.0)))))))
- (lambda args
- (format #t "error in ~A~%" (car method))
- #f))))
- funcs))))))
-
- (list 'nssb 'nxysin 'nxycos 'nxy1cos 'nxy1sin 'noddsin 'noddcos 'noddssb 'ncos2 'npcos
- nrsin 'nrcos 'nrssb 'nkssb 'nsincos 'rcos 'rssb 'rxysin 'rxycos
- rxyk!sin 'rxyk!cos 'ercos 'erssb 'eoddcos 'rkcos 'rksin 'rkssb
- rk!cos 'rk!ssb 'r2k!cos 'k2sin 'k2cos 'k2ssb 'dblsum 'rkoddssb 'krksin
- abcos 'absin 'r2k2cos 'bess 'jjcos 'j0evencos 'j2cos 'jpcos 'jncos
- j0j1cos 'jycos 'blackman 'fmssb 'k3sin 'izcos 'nchoosekcos 'n1cos
- adjustable-square-wave 'adjustable-triangle-wave 'adjustable-sawtooth-wave 'adjustable-oscil
- round-interp 'sinc-train 'pink-noise 'green-noise 'brown-noise 'green-noise-interp
- moving-max 'moving-sum 'moving-rms 'moving-length 'weighted-moving-average 'exponentially-weighted-moving-average
- tanhsin 'moving-fft 'moving-scentroid 'moving-autocorrelation 'moving-pitch)
-
- (list make-nssb make-nxysin make-nxycos make-nxy1cos make-nxy1sin make-noddsin make-noddcos make-noddssb make-ncos2 make-npcos
- make-nrsin make-nrcos make-nrssb make-nkssb make-nsincos make-rcos make-rssb make-rxysin make-rxycos
- make-rxyk!sin make-rxyk!cos make-ercos make-erssb make-eoddcos make-rkcos make-rksin make-rkssb
- make-rk!cos make-rk!ssb make-r2k!cos make-k2sin make-k2cos make-k2ssb make-dblsum make-rkoddssb make-krksin
- make-abcos make-absin make-r2k2cos make-bess make-jjcos make-j0evencos make-j2cos make-jpcos make-jncos
- make-j0j1cos make-jycos make-blackman make-fmssb make-k3sin make-izcos make-nchoosekcos make-n1cos
- make-adjustable-square-wave make-adjustable-triangle-wave make-adjustable-sawtooth-wave make-adjustable-oscil
- make-round-interp make-sinc-train make-pink-noise make-green-noise make-brown-noise make-green-noise-interp
- make-moving-max make-moving-sum make-moving-rms make-moving-length make-weighted-moving-average make-exponentially-weighted-moving-average
- make-tanhsin make-moving-fft make-moving-scentroid make-moving-autocorrelation make-moving-pitch)
-
- (list nssb-methods nxysin-methods nxycos-methods nxy1cos-methods nxy1sin-methods noddsin-methods noddcos-methods noddssb-methods ncos2-methods npcos-methods
- nrsin-methods nrcos-methods nrssb-methods nkssb-methods nsincos-methods rcos-methods rssb-methods rxysin-methods rxycos-methods
- rxyk!sin-methods rxyk!cos-methods ercos-methods erssb-methods eoddcos-methods rkcos-methods rksin-methods rkssb-methods
- rk!cos-methods rk!ssb-methods r2k!cos-methods k2sin-methods k2cos-methods k2ssb-methods dblsum-methods rkoddssb-methods krksin-methods
- abcos-methods absin-methods r2k2cos-methods bess-methods jjcos-methods j0evencos-methods j2cos-methods jpcos-methods jncos-methods
- j0j1cos-methods jycos-methods blackman-methods fmssb-methods k3sin-methods izcos-methods nchoosekcos-methods n1cos-methods
- adjustable-square-wave-methods adjustable-triangle-wave-methods adjustable-sawtooth-wave-methods adjustable-oscil-methods
- round-interp-methods sinc-train-methods pink-noise-methods green-noise-methods brown-noise-methods green-noise-interp-methods
- moving-max-methods moving-sum-methods moving-rms-methods moving-length-methods weighted-moving-average-methods exponentially-weighted-moving-average-methods
- tanhsin-methods moving-fft-methods moving-scentroid-methods moving-autocorrelation-methods moving-pitch-methods)
-
- (list nssb? nxysin? nxycos? nxy1cos? nxy1sin? noddsin? noddcos? noddssb? ncos2? npcos?
- nrsin? nrcos? nrssb? nkssb? nsincos? rcos? rssb? rxysin? rxycos?
- rxyk!sin? rxyk!cos? ercos? erssb? eoddcos? rkcos? rksin? rkssb?
- rk!cos? rk!ssb? r2k!cos? k2sin? k2cos? k2ssb? dblsum? rkoddssb? krksin?
- abcos? absin? r2k2cos? bess? jjcos? j0evencos? j2cos? jpcos? jncos?
- j0j1cos? jycos? blackman? fmssb? k3sin? izcos? nchoosekcos? n1cos?
- adjustable-square-wave? adjustable-triangle-wave? adjustable-sawtooth-wave? adjustable-oscil?
- round-interp? sinc-train? pink-noise? green-noise? brown-noise? green-noise-interp?
- moving-max? moving-sum? moving-rms? moving-length? weighted-moving-average? exponentially-weighted-moving-average?
- tanhsin? moving-fft? moving-scentroid? moving-autocorrelation? moving-pitch? )
- )
-
-
- (let ((gen1 (make-oscil 440.0))
- (gen2 (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (let* ((pm (- 1.0 (random 2.0)))
- (val1 (oscil gen1 0.0 pm))
- (val2 (run-with-fm-and-pm gen2 0.0 pm)))
- (if (fneq val1 val2)
- (snd-display ";run-with-fm-and-pm: ~A ~A" val1 val2)))))
-
- (let ((gen1 (make-oscil 440.0))
- (gen2 (make-oscil 440.0))
- (happy #t))
- (run
- (do ((i 0 (+ 1 i)))
- ((or (not happy)
- (= i 1000)))
- (let* ((pm (- 1.0 (random 2.0)))
- (val1 (oscil gen1 0.0 pm))
- (val2 (run-with-fm-and-pm gen2 0.0 pm)))
- (if (fneq val1 val2)
- (set! happy #f)))))
- (if (not happy)
- (snd-display ";run-with-fm-and-pm unhappy")))
-
- (set! (mus-srate) 44100)
- (let ((gen (make-nssb 440.0 :n 3))
- (order 0)
- (frequency 0.0)
- (val 0.0)
- (name "hiho"))
- (run
- (lambda ()
- (set! order (mus-order gen))
- (set! frequency (mus-frequency gen))
- (nssb gen 1.0)
- (set! val (mus-run gen 0.0 0.0))
- (set! name (mus-name gen))
- ))
- (if (not (string=? name "nssb")) (snd-display ";run mus-name nssb: ~A" name))
- (if (not (= order 3)) (snd-display ";run mus-order nssb: ~A" order))
- (if (fneq frequency 440.0) (snd-display ";run mus-frequency nssb: ~A" frequency))
- (if (fneq val 0.371) (snd-display ";run mus-run nssb: ~A" val)))
-
- ;; mus-reset and mus-describe in this case have an embedded for-each, so not optimizable
-
- (let ((gen (make-oscil 123.0)))
- (set! (mus-name gen) "oscil123")
- (if (not (string=? (mus-name gen) "oscil123")) (snd-display ";set mus-name oscil123: ~A" (mus-name gen)))
- (set! (mus-name gen) "another-name")
- (if (not (string=? (mus-name gen) "another-name")) (snd-display ";set mus-name again: ~A" (mus-name gen)))
- (let ((descr (mus-describe gen)))
- (if (not (string=? descr "another-name freq: 123.000Hz, phase: 0.000"))
- (snd-display ";set mus-name describe: ~A" descr))))
-
- (let ((gen (make-nssb 123.0)))
- (set! (mus-name gen) "nssb123")
- (if (not (string=? (mus-name gen) "nssb123")) (snd-display ";set mus-name nssb123: ~A" (mus-name gen)))
- (set! (mus-name gen) "another-name")
- (if (not (string=? (mus-name gen) "another-name")) (snd-display ";set mus-name nssb again: ~A" (mus-name gen)))
- (set! (mus-frequency gen) 0.0)
- (let ((descr (mus-describe gen)))
- (if (not (string=? descr "another-name frequency: 0.0, ratio: 1.0, n: 1, angle: 0.0"))
- (snd-display ";set mus-name nssb describe: ~A" descr))))
-
- (let ((gen (make-oscil 123.0))
- (gen1 (make-oscil 440.0)))
- (set! (mus-name gen) "oscil123")
- (set! (mus-name gen1) "440")
- (if (not (string=? (mus-name gen) "oscil123")) (snd-display ";set mus-name oscil123 1: ~A" (mus-name gen)))
- (if (not (string=? (mus-name gen1) "440")) (snd-display ";set mus-name oscil 440 1: ~A" (mus-name gen)))
- (set! (mus-name gen1) "another-name")
- (if (not (string=? (mus-name gen1) "another-name")) (snd-display ";set mus-name again 1: ~A" (mus-name gen)))
- (if (not (string=? (mus-name gen) "oscil123")) (snd-display ";set mus-name oscil123 2: ~A" (mus-name gen)))
- (let ((descr (mus-describe gen1)))
- (if (not (string=? descr "another-name freq: 440.000Hz, phase: 0.000"))
- (snd-display ";set mus-name describe 1: ~A" descr))))
-
- (let ((gen (make-nssb 123.0))
- (gen1 (make-nssb 440.0)))
- (set! (mus-name gen) "nssb123")
- (set! (mus-name gen1) "440")
- (if (not (string=? (mus-name gen) "nssb123")) (snd-display ";set mus-name nssb123 1: ~A" (mus-name gen)))
- (if (not (string=? (mus-name gen1) "440")) (snd-display ";set mus-name nssb 440 1: ~A" (mus-name gen)))
- (set! (mus-name gen) "another-name")
- (if (not (string=? (mus-name gen) "another-name")) (snd-display ";set mus-name nssb again 1: ~A" (mus-name gen)))
- (set! (mus-frequency gen) 0.0)
- (let ((descr (mus-describe gen)))
- (if (not (string=? descr "another-name frequency: 0.0, ratio: 1.0, n: 1, angle: 0.0"))
- (snd-display ";set mus-name nssb describe 1: ~A" descr))))
-
-
- (if (not (null? (sounds))) (for-each close-sound (sounds)))
- (set! (optimization) old-opt-23)
-
- (test-documentation-instruments) ; clm23.scm
-
- (if #f
- (let ((outfile "/home/bil/test/sound/big3.snd"))
- (if (file-exists? outfile)
- (delete-file outfile))
- (for-each
- (lambda (ht)
- (with-sound (:output outfile :srate 44100 :channels 2 :header-type ht)
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (fm-violin i .1 440 (+ .1 (* (/ i 30000.0) .9)))))
- (if (not (file-exists? outfile))
- (snd-display ";big3 ~A not written?" (mus-header-type-to-string ht))
- (let ((snd (find-sound outfile)))
- (if (> (abs (- (frames snd 0) (* 30000 44100))) 44100)
- (snd-display ";big3 frames: ~A, should be ~A (~A)" (frames snd 0) (* 30000 44100) (- (frames snd 0) (* 30000 44100))))
- (if (< (maxamp snd ) .97)
- (snd-display ";big3 max: ~A" (maxamp snd)))
- (if (and (= ht mus-riff)
- (not (= (header-type snd) mus-rf64)))
- (snd-display ";big3 auto convert? ~A -> ~A" (mus-header-type-to-string ht) (mus-header-type-to-string (header-type snd))))
- (close-sound snd))))
- (list mus-next mus-caff))
-
- (if (file-exists? outfile)
- (delete-file outfile))))
-
- )))
+ (lambda (ht)
+ (with-sound (:output outfile :srate 44100 :channels 2 :header-type ht)
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (fm-violin i .1 440 (+ .1 (* (/ i 30000.0) .9)))))
+ (if (not (file-exists? outfile))
+ (snd-display #__line__ ";big3 ~A not written?" (mus-header-type-to-string ht))
+ (let ((snd (find-sound outfile)))
+ (if (> (abs (- (frames snd 0) (* 30000 44100))) 44100)
+ (snd-display #__line__ ";big3 frames: ~A, should be ~A (~A)" (frames snd 0) (* 30000 44100) (- (frames snd 0) (* 30000 44100))))
+ (if (< (maxamp snd ) .97)
+ (snd-display #__line__ ";big3 max: ~A" (maxamp snd)))
+ (if (and (= ht mus-riff)
+ (not (= (header-type snd) mus-rf64)))
+ (snd-display #__line__ ";big3 auto convert? ~A -> ~A" (mus-header-type-to-string ht) (mus-header-type-to-string (header-type snd))))
+ (close-sound snd))))
+ (list mus-next mus-caff))
+
+ (if (file-exists? outfile)
+ (delete-file outfile))))
+
+ )
(define (snd_test_24)
@@ -57358,7 +57455,7 @@ EDITS: 1
(make-color-with-catch (/ (.red col) 65535.0)
(/ (.green col) 65535.0)
(/ (.blue col) 65535.0)))))
-
+
(define (snd-test-clean-string str)
;; full file name should be unique, so I think we need only fix it up to look like a flat name
(let* ((len (string-length str))
@@ -57424,3642 +57521,3642 @@ EDITS: 1
(define (XM_PARSE_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (if (and (provided? 'snd-motif)
- (provided? 'xm))
- (begin
-
- (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest (min 2 tests)))
- (log-mem clmtest)
-
- ;; check some resource stuff first
- (let ((hgt (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNheight 0))))
- (wid (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNwidth 0)))))
- (if (or (<= wid 0) (<= hgt 0) (> wid 65535) (> hgt 65535))
- (snd-display ";Dimension miscast: ~A ~A" wid hgt)))
-
- ;; ---------------- X tests ----------------
- (let ((scr (current-screen))
- (dpy (XtDisplay (cadr (main-widgets)))))
- (if (and (not (= (.height scr) 1200))
- (not (= (.height scr) 1600)))
- (snd-display ";screen height: ~A" (.height scr)))
- (if (and (not (= (.width scr) 1600))
- (not (= (.width scr) 2560)))
- (snd-display ";screen width: ~A" (.width scr)))
- (if (not (= (.ndepths scr) 7))
- (snd-display ";screen ndepths: ~A" (.ndepths scr)))
- (let ((dps (.depths scr)))
- (if (or (not (= (length dps) (.ndepths scr)))
- (not (Depth? (car dps))))
- (snd-display ";depths: ~A" (.depths scr)))
- (if (not (= (.depth (car dps)) 24)) (snd-display ";.depths val: ~A" (map .depth dps)))
- (if (not (null? (.visuals (car dps))))
- (if (not (Visual? (car (.visuals (car dps)))))
- (snd-display ";visuals: ~A" (map .visuals dps))
- (if (not (= (.bits_per_rgb (car (.visuals (car dps)))) 8))
- (snd-display ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (car dps))))))
- (if (and (cadr dps)
- (not (null? (.visuals (cadr dps)))))
- (if (not (Visual? (car (.visuals (cadr dps)))))
- (snd-display ";visuals: ~A" (map .visuals dps))
- (if (not (= (.bits_per_rgb (car (.visuals (cadr dps)))) 8))
- (snd-display ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (cadr dps)))))))))
- (if (not (= (cadr (.white_pixel scr)) 16777215))
- (snd-display ";screen white_pixel: ~A" (.white_pixel scr)))
- (if (not (= (cadr (.black_pixel scr)) 0))
- (snd-display ";screen black_pixel: ~A" (.black_pixel scr)))
- (if (not (eq? (.backing_store scr) #f))
- (snd-display ";screen backing_store: ~A" (.backing_store scr)))
- (if (not (= (.min_maps scr) 1))
- (snd-display ";screen min_maps: ~A" (.min_maps scr)))
- (if (not (= (.max_maps scr) 1))
- (snd-display ";screen max_maps: ~A" (.max_maps scr)))
- (if (not (eq? (.save_unders scr) #f))
- (snd-display ";screen save_unders: ~A" (.save_unders scr)))
- (if (not (GC? (.default_gc scr)))
- (snd-display ";screen default_gc: ~A" (.default_gc scr)))
- (if (not (Window? (.root scr)))
- (snd-display ";screen root: ~A" (.root scr)))
- (if (not (Colormap? (.cmap scr)))
- (snd-display ";screen colormap: ~A" (.cmap scr)))
-
- (if (not (equal? (DisplayOfScreen scr) (.display scr)))
- (snd-display ";DisplayOfScreen: ~A ~A" (DisplayOfScreen scr) (.display scr)))
- (if (not (equal? (RootWindowOfScreen scr) (.root scr)))
- (snd-display ";RootWindowOfScreen: ~A ~A" (RootWindowOfScreen scr) (.root scr)))
- (if (not (equal? (BlackPixelOfScreen scr) (.black_pixel scr)))
- (snd-display ";BlackPixelOfScreen: ~A ~A" (BlackPixelOfScreen scr) (.black_pixel scr)))
- (if (not (equal? (WhitePixelOfScreen scr) (.white_pixel scr)))
- (snd-display ";WhitePixelOfScreen: ~A ~A" (WhitePixelOfScreen scr) (.white_pixel scr)))
- (if (not (equal? (DefaultColormapOfScreen scr) (.cmap scr)))
- (snd-display ";DefaultColormapOfScreen: ~A ~A" (DefaultColormapOfScreen scr) (.cmap scr)))
- (if (not (equal? (DefaultDepthOfScreen scr) (.root_depth scr)))
- (snd-display ";DefaultDepthOfScreen: ~A ~A" (DefaultDepthOfScreen scr) (.root_depth scr)))
- (if (not (equal? (DefaultGCOfScreen scr) (.default_gc scr)))
- (snd-display ";DefaultGCOfScreen: ~A ~A" (DefaultGCOfScreen scr) (.default_gc scr)))
- (if (not (equal? (DefaultVisualOfScreen scr) (.root_visual scr)))
- (snd-display ";DefaultVisualOfScreen: ~A ~A" (DefaultVisualOfScreen scr) (.root_visual scr)))
- (if (not (equal? (WidthOfScreen scr) (.width scr)))
- (snd-display ";WidthOfScreen: ~A ~A" (WidthOfScreen scr) (.width scr)))
- (if (not (equal? (HeightOfScreen scr) (.height scr)))
- (snd-display ";HeightOfScreen: ~A ~A" (HeightOfScreen scr) (.height scr)))
- (if (not (equal? (WidthMMOfScreen scr) (.mwidth scr)))
- (snd-display ";WidthMMOfScreen: ~A ~A" (WidthMMOfScreen scr) (.mwidth scr)))
- (if (not (equal? (HeightMMOfScreen scr) (.mheight scr)))
- (snd-display ";HeightMMOfScreen: ~A ~A" (HeightMMOfScreen scr) (.mheight scr)))
- (if (not (equal? (PlanesOfScreen scr) (.root_depth scr)))
- (snd-display ";PlanesOfScreen: ~A ~A" (PlanesOfScreen scr) (.root_depth scr)))
- (if (not (equal? (MinCmapsOfScreen scr) (.min_maps scr)))
- (snd-display ";MinCmapsOfScreen: ~A ~A" (MinCmapsOfScreen scr) (.min_maps scr)))
- (if (not (equal? (MaxCmapsOfScreen scr) (.max_maps scr)))
- (snd-display ";MaxCmapsOfScreen: ~A ~A" (MaxCmapsOfScreen scr) (.max_maps scr)))
- (if (not (equal? (DoesSaveUnders scr) (.save_unders scr)))
- (snd-display ";DoesSaveUnders: ~A ~A" (DoesSaveUnders scr) (.save_unders scr)))
- (if (not (equal? (DoesBackingStore scr) (.backing_store scr)))
- (snd-display ";DoesBackingStore: ~A ~A" (DoesBackingStore scr) (.backing_store scr)))
- (if (not (equal? (EventMaskOfScreen scr) (.root_input_mask scr)))
- (snd-display ";EventMaskOfScreen: ~A ~A" (EventMaskOfScreen scr) (.root_input_mask scr)))
-
- (if (not (equal? (XDisplayOfScreen scr) (.display scr)))
- (snd-display ";XDisplayOfScreen: ~A ~A" (XDisplayOfScreen scr) (.display scr)))
- (if (not (equal? (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
- (snd-display ";XScreenOfDisplay ~A ~A" (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
- (if (not (equal? (XDefaultScreenOfDisplay dpy) scr))
- (snd-display ";XDefaultScreenOfDisplay ~A ~A" (XDefaultScreenOfDisplay dpy) scr))
- (if (not (equal? (XRootWindowOfScreen scr) (.root scr)))
- (snd-display ";XRootWindowOfScreen: ~A ~A" (XRootWindowOfScreen scr) (.root scr)))
- (if (not (equal? (XBlackPixelOfScreen scr) (.black_pixel scr)))
- (snd-display ";XBlackPixelOfScreen: ~A ~A" (XBlackPixelOfScreen scr) (.black_pixel scr)))
- (if (not (equal? (XWhitePixelOfScreen scr) (.white_pixel scr)))
- (snd-display ";XWhitePixelOfScreen: ~A ~A" (XWhitePixelOfScreen scr) (.white_pixel scr)))
- (if (not (equal? (XDefaultColormapOfScreen scr) (.cmap scr)))
- (snd-display ";XDefaultColormapOfScreen: ~A ~A" (XDefaultColormapOfScreen scr) (.cmap scr)))
- (if (not (equal? (XDefaultDepthOfScreen scr) (.root_depth scr)))
- (snd-display ";XDefaultDepthOfScreen: ~A ~A" (XDefaultDepthOfScreen scr) (.root_depth scr)))
- (if (not (equal? (XDefaultGCOfScreen scr) (.default_gc scr)))
- (snd-display ";XDefaultGCOfScreen: ~A ~A" (XDefaultGCOfScreen scr) (.default_gc scr)))
- (if (not (equal? (XDefaultVisualOfScreen scr) (.root_visual scr)))
- (snd-display ";XDefaultVisualOfScreen: ~A ~A" (XDefaultVisualOfScreen scr) (.root_visual scr)))
- (if (not (equal? (XWidthOfScreen scr) (.width scr)))
- (snd-display ";XWidthOfScreen: ~A ~A" (XWidthOfScreen scr) (.width scr)))
- (if (not (equal? (XHeightOfScreen scr) (.height scr)))
- (snd-display ";XHeightOfScreen: ~A ~A" (XHeightOfScreen scr) (.height scr)))
- (if (not (equal? (XWidthMMOfScreen scr) (.mwidth scr)))
- (snd-display ";XWidthMMOfScreen: ~A ~A" (XWidthMMOfScreen scr) (.mwidth scr)))
- (if (not (equal? (XHeightMMOfScreen scr) (.mheight scr)))
- (snd-display ";XHeightMMOfScreen: ~A ~A" (XHeightMMOfScreen scr) (.mheight scr)))
- (if (not (equal? (XPlanesOfScreen scr) (.root_depth scr)))
- (snd-display ";XPlanesOfScreen: ~A ~A" (XPlanesOfScreen scr) (.root_depth scr)))
- (if (not (equal? (XMinCmapsOfScreen scr) (.min_maps scr)))
- (snd-display ";XMinCmapsOfScreen: ~A ~A" (XMinCmapsOfScreen scr) (.min_maps scr)))
- (if (not (equal? (XMaxCmapsOfScreen scr) (.max_maps scr)))
- (snd-display ";XMaxCmapsOfScreen: ~A ~A" (XMaxCmapsOfScreen scr) (.max_maps scr)))
- (if (not (equal? (XDoesSaveUnders scr) (.save_unders scr)))
- (snd-display ";XDoesSaveUnders: ~A ~A" (XDoesSaveUnders scr) (.save_unders scr)))
- (if (not (equal? (XDoesBackingStore scr) (.backing_store scr)))
- (snd-display ";XDoesBackingStore: ~A ~A" (XDoesBackingStore scr) (.backing_store scr)))
- (if (not (equal? (XEventMaskOfScreen scr) (.root_input_mask scr)))
- (snd-display ";XEventMaskOfScreen: ~A ~A" (XEventMaskOfScreen scr) (.root_input_mask scr)))
- )
-
- (let* ((scr (current-screen))
- (scrn (XScreenNumberOfScreen scr))
- (dpy (XtDisplay (cadr (main-widgets))))
- (vis (DefaultVisual dpy scrn))
- (win (XtWindow (cadr (main-widgets)))))
-
- (if (not (equal? (RootWindow dpy scrn) (.root scr)))
- (snd-display ";RootWindow: ~A ~A" (RootWindow dpy scrn) (.root scr)))
- (if (not (equal? (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (snd-display ";DefaultRootWindow: ~A ~A" (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (if (not (equal? (DefaultVisual dpy scrn) (.root_visual scr)))
- (snd-display ";DefaultVisual: ~A ~A" (DefaultVisual dpy scrn) (.root_visual scr)))
- (if (not (equal? (DefaultGC dpy scrn) (.default_gc scr)))
- (snd-display ";DefaultGC: ~A ~A" (DefaultGC dpy scrn) (.default_gc scr)))
- (if (not (equal? (BlackPixel dpy scrn) (.black_pixel scr)))
- (snd-display ";BlackPixel: ~A ~A" (BlackPixel dpy scrn) (.black_pixel scr)))
- (if (not (equal? (WhitePixel dpy scrn) (.white_pixel scr)))
- (snd-display ";WhitePixel ~A ~A" (WhitePixel dpy scrn) (.white_pixel scr)))
- (if (not (equal? (DisplayWidth dpy scrn) (.width scr)))
- (snd-display ";DisplayWidth: ~A ~A" (DisplayWidth dpy scrn) (.width scr)))
- (if (not (equal? (DisplayHeight dpy scrn) (.height scr)))
- (snd-display ";DisplayHeight: ~A ~A" (DisplayHeight dpy scrn) (.height scr)))
- (if (not (equal? (DisplayWidthMM dpy scrn) (.mwidth scr)))
- (snd-display ";DisplayWidthMM: ~A ~A" (DisplayWidthMM dpy scrn) (.mwidth scr)))
- (if (not (equal? (DisplayHeightMM dpy scrn) (.mheight scr)))
- (snd-display ";DisplayHeightMM: ~A ~A" (DisplayHeightMM dpy scrn) (.mheight scr)))
- (if (not (equal? (DisplayPlanes dpy scrn) (.root_depth scr)))
- (snd-display ";DisplayPlanes: ~A ~A" (DisplayPlanes dpy scrn) (.root_depth scr)))
- (if (not (equal? (DefaultDepth dpy scrn) (.root_depth scr)))
- (snd-display ";DefaultDepth: ~A ~A" (DefaultDepth dpy scrn) (.root_depth scr)))
- (if (not (equal? (DefaultColormap dpy scrn) (.cmap scr)))
- (snd-display ";DefaultColormap: ~A ~A" (DefaultColormap dpy scrn) (.cmap scr)))
-
- (if (not (equal? (XRootWindow dpy scrn) (.root scr)))
- (snd-display ";XRootWindow: ~A ~A" (XRootWindow dpy scrn) (.root scr)))
- (if (not (equal? (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (snd-display ";XDefaultRootWindow: ~A ~A" (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (if (not (equal? (XDefaultVisual dpy scrn) (.root_visual scr)))
- (snd-display ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) (.root_visual scr)))
- (if (not (equal? (XDefaultGC dpy scrn) (.default_gc scr)))
- (snd-display ";XDefaultGC: ~A ~A" (XDefaultGC dpy scrn) (.default_gc scr)))
- (if (not (equal? (XBlackPixel dpy scrn) (.black_pixel scr)))
- (snd-display ";XBlackPixel: ~A ~A" (XBlackPixel dpy scrn) (.black_pixel scr)))
- (if (not (equal? (XWhitePixel dpy scrn) (.white_pixel scr)))
- (snd-display ";XWhitePixel ~A ~A" (XWhitePixel dpy scrn) (.white_pixel scr)))
- (if (not (equal? (XDisplayWidth dpy scrn) (.width scr)))
- (snd-display ";XDisplayWidth: ~A ~A" (XDisplayWidth dpy scrn) (.width scr)))
- (if (not (equal? (XDisplayHeight dpy scrn) (.height scr)))
- (snd-display ";XDisplayHeight: ~A ~A" (XDisplayHeight dpy scrn) (.height scr)))
- (if (not (equal? (XDisplayWidthMM dpy scrn) (.mwidth scr)))
- (snd-display ";XDisplayWidthMM: ~A ~A" (XDisplayWidthMM dpy scrn) (.mwidth scr)))
- (if (not (equal? (XDisplayHeightMM dpy scrn) (.mheight scr)))
- (snd-display ";XDisplayHeightMM: ~A ~A" (XDisplayHeightMM dpy scrn) (.mheight scr)))
- (if (not (equal? (XDisplayPlanes dpy scrn) (.root_depth scr)))
- (snd-display ";XDisplayPlanes: ~A ~A" (XDisplayPlanes dpy scrn) (.root_depth scr)))
- (if (not (equal? (XDefaultDepth dpy scrn) (.root_depth scr)))
- (snd-display ";XDefaultDepth: ~A ~A" (XDefaultDepth dpy scrn) (.root_depth scr)))
- (if (not (equal? (XDefaultColormap dpy scrn) (.cmap scr)))
- (snd-display ";XDefaultColormap: ~A ~A" (XDefaultColormap dpy scrn) (.cmap scr)))
-
- (if (not (equal? (XDefaultVisual dpy scrn) vis))
- (snd-display ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) vis))
- (if (not (equal? (DisplayCells dpy scrn) (.map_entries vis)))
- (snd-display ";DisplayCells: ~A ~A" (DisplayCells dpy scrn) (.map_entries vis)))
- (if (not (equal? (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (snd-display ";CellsOfScreen: ~A ~A" (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (if (not (equal? (XDisplayCells dpy scrn) (.map_entries vis)))
- (snd-display ";XDisplayCells: ~A ~A" (XDisplayCells dpy scrn) (.map_entries vis)))
- (if (not (equal? (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (snd-display ";XCellsOfScreen: ~A ~A" (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (if (< (XNextRequest dpy) (XLastKnownRequestProcessed dpy))
- (snd-display ";XRequests: ~A ~A" (XNextRequest dpy) (XLastKnownRequestProcessed dpy)))
- (if (< (NextRequest dpy) (LastKnownRequestProcessed dpy))
- (snd-display ";Requests: ~A ~A" (NextRequest dpy) (LastKnownRequestProcessed dpy)))
- (if (not (= (XDisplayMotionBufferSize dpy) 256))
- (snd-display ";XDisplayMotionBufferSize: ~A" (XDisplayMotionBufferSize dpy)))
- (XGetMotionEvents dpy win (list 'Time 100) (list 'Time CurrentTime))
-
- (let ((lmapk (XNewModifiermap 2))
- (kcd (list 'KeyCode 50)))
- (if (not (XModifierKeymap? lmapk))
- (snd-display ";xNewModifiermap: ~A" lmapk)
- (begin
- (set! lmapk (XInsertModifiermapEntry lmapk kcd ShiftMapIndex))
- (set! lmapk (XDeleteModifiermapEntry lmapk kcd ShiftMapIndex))
+ (if (and (provided? 'snd-motif)
+ (provided? 'xm))
+ (begin
+
+ (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest (min 2 tests)))
+ (log-mem clmtest)
+
+ ;; check some resource stuff first
+ (let ((hgt (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNheight 0))))
+ (wid (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNwidth 0)))))
+ (if (or (<= wid 0) (<= hgt 0) (> wid 65535) (> hgt 65535))
+ (snd-display #__line__ ";Dimension miscast: ~A ~A" wid hgt)))
+
+ ;; ---------------- X tests ----------------
+ (let ((scr (current-screen))
+ (dpy (XtDisplay (cadr (main-widgets)))))
+ (if (and (not (= (.height scr) 1200))
+ (not (= (.height scr) 1600)))
+ (snd-display #__line__ ";screen height: ~A" (.height scr)))
+ (if (and (not (= (.width scr) 1600))
+ (not (= (.width scr) 2560)))
+ (snd-display #__line__ ";screen width: ~A" (.width scr)))
+ (if (not (= (.ndepths scr) 7))
+ (snd-display #__line__ ";screen ndepths: ~A" (.ndepths scr)))
+ (let ((dps (.depths scr)))
+ (if (or (not (= (length dps) (.ndepths scr)))
+ (not (Depth? (car dps))))
+ (snd-display #__line__ ";depths: ~A" (.depths scr)))
+ (if (not (= (.depth (car dps)) 24)) (snd-display #__line__ ";.depths val: ~A" (map .depth dps)))
+ (if (not (null? (.visuals (car dps))))
+ (if (not (Visual? (car (.visuals (car dps)))))
+ (snd-display #__line__ ";visuals: ~A" (map .visuals dps))
+ (if (not (= (.bits_per_rgb (car (.visuals (car dps)))) 8))
+ (snd-display #__line__ ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (car dps))))))
+ (if (and (cadr dps)
+ (not (null? (.visuals (cadr dps)))))
+ (if (not (Visual? (car (.visuals (cadr dps)))))
+ (snd-display #__line__ ";visuals: ~A" (map .visuals dps))
+ (if (not (= (.bits_per_rgb (car (.visuals (cadr dps)))) 8))
+ (snd-display #__line__ ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (cadr dps)))))))))
+ (if (not (= (cadr (.white_pixel scr)) 16777215))
+ (snd-display #__line__ ";screen white_pixel: ~A" (.white_pixel scr)))
+ (if (not (= (cadr (.black_pixel scr)) 0))
+ (snd-display #__line__ ";screen black_pixel: ~A" (.black_pixel scr)))
+ (if (not (eq? (.backing_store scr) #f))
+ (snd-display #__line__ ";screen backing_store: ~A" (.backing_store scr)))
+ (if (not (= (.min_maps scr) 1))
+ (snd-display #__line__ ";screen min_maps: ~A" (.min_maps scr)))
+ (if (not (= (.max_maps scr) 1))
+ (snd-display #__line__ ";screen max_maps: ~A" (.max_maps scr)))
+ (if (not (eq? (.save_unders scr) #f))
+ (snd-display #__line__ ";screen save_unders: ~A" (.save_unders scr)))
+ (if (not (GC? (.default_gc scr)))
+ (snd-display #__line__ ";screen default_gc: ~A" (.default_gc scr)))
+ (if (not (Window? (.root scr)))
+ (snd-display #__line__ ";screen root: ~A" (.root scr)))
+ (if (not (Colormap? (.cmap scr)))
+ (snd-display #__line__ ";screen colormap: ~A" (.cmap scr)))
+
+ (if (not (equal? (DisplayOfScreen scr) (.display scr)))
+ (snd-display #__line__ ";DisplayOfScreen: ~A ~A" (DisplayOfScreen scr) (.display scr)))
+ (if (not (equal? (RootWindowOfScreen scr) (.root scr)))
+ (snd-display #__line__ ";RootWindowOfScreen: ~A ~A" (RootWindowOfScreen scr) (.root scr)))
+ (if (not (equal? (BlackPixelOfScreen scr) (.black_pixel scr)))
+ (snd-display #__line__ ";BlackPixelOfScreen: ~A ~A" (BlackPixelOfScreen scr) (.black_pixel scr)))
+ (if (not (equal? (WhitePixelOfScreen scr) (.white_pixel scr)))
+ (snd-display #__line__ ";WhitePixelOfScreen: ~A ~A" (WhitePixelOfScreen scr) (.white_pixel scr)))
+ (if (not (equal? (DefaultColormapOfScreen scr) (.cmap scr)))
+ (snd-display #__line__ ";DefaultColormapOfScreen: ~A ~A" (DefaultColormapOfScreen scr) (.cmap scr)))
+ (if (not (equal? (DefaultDepthOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";DefaultDepthOfScreen: ~A ~A" (DefaultDepthOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (DefaultGCOfScreen scr) (.default_gc scr)))
+ (snd-display #__line__ ";DefaultGCOfScreen: ~A ~A" (DefaultGCOfScreen scr) (.default_gc scr)))
+ (if (not (equal? (DefaultVisualOfScreen scr) (.root_visual scr)))
+ (snd-display #__line__ ";DefaultVisualOfScreen: ~A ~A" (DefaultVisualOfScreen scr) (.root_visual scr)))
+ (if (not (equal? (WidthOfScreen scr) (.width scr)))
+ (snd-display #__line__ ";WidthOfScreen: ~A ~A" (WidthOfScreen scr) (.width scr)))
+ (if (not (equal? (HeightOfScreen scr) (.height scr)))
+ (snd-display #__line__ ";HeightOfScreen: ~A ~A" (HeightOfScreen scr) (.height scr)))
+ (if (not (equal? (WidthMMOfScreen scr) (.mwidth scr)))
+ (snd-display #__line__ ";WidthMMOfScreen: ~A ~A" (WidthMMOfScreen scr) (.mwidth scr)))
+ (if (not (equal? (HeightMMOfScreen scr) (.mheight scr)))
+ (snd-display #__line__ ";HeightMMOfScreen: ~A ~A" (HeightMMOfScreen scr) (.mheight scr)))
+ (if (not (equal? (PlanesOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";PlanesOfScreen: ~A ~A" (PlanesOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (MinCmapsOfScreen scr) (.min_maps scr)))
+ (snd-display #__line__ ";MinCmapsOfScreen: ~A ~A" (MinCmapsOfScreen scr) (.min_maps scr)))
+ (if (not (equal? (MaxCmapsOfScreen scr) (.max_maps scr)))
+ (snd-display #__line__ ";MaxCmapsOfScreen: ~A ~A" (MaxCmapsOfScreen scr) (.max_maps scr)))
+ (if (not (equal? (DoesSaveUnders scr) (.save_unders scr)))
+ (snd-display #__line__ ";DoesSaveUnders: ~A ~A" (DoesSaveUnders scr) (.save_unders scr)))
+ (if (not (equal? (DoesBackingStore scr) (.backing_store scr)))
+ (snd-display #__line__ ";DoesBackingStore: ~A ~A" (DoesBackingStore scr) (.backing_store scr)))
+ (if (not (equal? (EventMaskOfScreen scr) (.root_input_mask scr)))
+ (snd-display #__line__ ";EventMaskOfScreen: ~A ~A" (EventMaskOfScreen scr) (.root_input_mask scr)))
+
+ (if (not (equal? (XDisplayOfScreen scr) (.display scr)))
+ (snd-display #__line__ ";XDisplayOfScreen: ~A ~A" (XDisplayOfScreen scr) (.display scr)))
+ (if (not (equal? (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
+ (snd-display #__line__ ";XScreenOfDisplay ~A ~A" (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
+ (if (not (equal? (XDefaultScreenOfDisplay dpy) scr))
+ (snd-display #__line__ ";XDefaultScreenOfDisplay ~A ~A" (XDefaultScreenOfDisplay dpy) scr))
+ (if (not (equal? (XRootWindowOfScreen scr) (.root scr)))
+ (snd-display #__line__ ";XRootWindowOfScreen: ~A ~A" (XRootWindowOfScreen scr) (.root scr)))
+ (if (not (equal? (XBlackPixelOfScreen scr) (.black_pixel scr)))
+ (snd-display #__line__ ";XBlackPixelOfScreen: ~A ~A" (XBlackPixelOfScreen scr) (.black_pixel scr)))
+ (if (not (equal? (XWhitePixelOfScreen scr) (.white_pixel scr)))
+ (snd-display #__line__ ";XWhitePixelOfScreen: ~A ~A" (XWhitePixelOfScreen scr) (.white_pixel scr)))
+ (if (not (equal? (XDefaultColormapOfScreen scr) (.cmap scr)))
+ (snd-display #__line__ ";XDefaultColormapOfScreen: ~A ~A" (XDefaultColormapOfScreen scr) (.cmap scr)))
+ (if (not (equal? (XDefaultDepthOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";XDefaultDepthOfScreen: ~A ~A" (XDefaultDepthOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (XDefaultGCOfScreen scr) (.default_gc scr)))
+ (snd-display #__line__ ";XDefaultGCOfScreen: ~A ~A" (XDefaultGCOfScreen scr) (.default_gc scr)))
+ (if (not (equal? (XDefaultVisualOfScreen scr) (.root_visual scr)))
+ (snd-display #__line__ ";XDefaultVisualOfScreen: ~A ~A" (XDefaultVisualOfScreen scr) (.root_visual scr)))
+ (if (not (equal? (XWidthOfScreen scr) (.width scr)))
+ (snd-display #__line__ ";XWidthOfScreen: ~A ~A" (XWidthOfScreen scr) (.width scr)))
+ (if (not (equal? (XHeightOfScreen scr) (.height scr)))
+ (snd-display #__line__ ";XHeightOfScreen: ~A ~A" (XHeightOfScreen scr) (.height scr)))
+ (if (not (equal? (XWidthMMOfScreen scr) (.mwidth scr)))
+ (snd-display #__line__ ";XWidthMMOfScreen: ~A ~A" (XWidthMMOfScreen scr) (.mwidth scr)))
+ (if (not (equal? (XHeightMMOfScreen scr) (.mheight scr)))
+ (snd-display #__line__ ";XHeightMMOfScreen: ~A ~A" (XHeightMMOfScreen scr) (.mheight scr)))
+ (if (not (equal? (XPlanesOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";XPlanesOfScreen: ~A ~A" (XPlanesOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (XMinCmapsOfScreen scr) (.min_maps scr)))
+ (snd-display #__line__ ";XMinCmapsOfScreen: ~A ~A" (XMinCmapsOfScreen scr) (.min_maps scr)))
+ (if (not (equal? (XMaxCmapsOfScreen scr) (.max_maps scr)))
+ (snd-display #__line__ ";XMaxCmapsOfScreen: ~A ~A" (XMaxCmapsOfScreen scr) (.max_maps scr)))
+ (if (not (equal? (XDoesSaveUnders scr) (.save_unders scr)))
+ (snd-display #__line__ ";XDoesSaveUnders: ~A ~A" (XDoesSaveUnders scr) (.save_unders scr)))
+ (if (not (equal? (XDoesBackingStore scr) (.backing_store scr)))
+ (snd-display #__line__ ";XDoesBackingStore: ~A ~A" (XDoesBackingStore scr) (.backing_store scr)))
+ (if (not (equal? (XEventMaskOfScreen scr) (.root_input_mask scr)))
+ (snd-display #__line__ ";XEventMaskOfScreen: ~A ~A" (XEventMaskOfScreen scr) (.root_input_mask scr)))
+ )
+
+ (let* ((scr (current-screen))
+ (scrn (XScreenNumberOfScreen scr))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (vis (DefaultVisual dpy scrn))
+ (win (XtWindow (cadr (main-widgets)))))
+
+ (if (not (equal? (RootWindow dpy scrn) (.root scr)))
+ (snd-display #__line__ ";RootWindow: ~A ~A" (RootWindow dpy scrn) (.root scr)))
+ (if (not (equal? (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (snd-display #__line__ ";DefaultRootWindow: ~A ~A" (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (if (not (equal? (DefaultVisual dpy scrn) (.root_visual scr)))
+ (snd-display #__line__ ";DefaultVisual: ~A ~A" (DefaultVisual dpy scrn) (.root_visual scr)))
+ (if (not (equal? (DefaultGC dpy scrn) (.default_gc scr)))
+ (snd-display #__line__ ";DefaultGC: ~A ~A" (DefaultGC dpy scrn) (.default_gc scr)))
+ (if (not (equal? (BlackPixel dpy scrn) (.black_pixel scr)))
+ (snd-display #__line__ ";BlackPixel: ~A ~A" (BlackPixel dpy scrn) (.black_pixel scr)))
+ (if (not (equal? (WhitePixel dpy scrn) (.white_pixel scr)))
+ (snd-display #__line__ ";WhitePixel ~A ~A" (WhitePixel dpy scrn) (.white_pixel scr)))
+ (if (not (equal? (DisplayWidth dpy scrn) (.width scr)))
+ (snd-display #__line__ ";DisplayWidth: ~A ~A" (DisplayWidth dpy scrn) (.width scr)))
+ (if (not (equal? (DisplayHeight dpy scrn) (.height scr)))
+ (snd-display #__line__ ";DisplayHeight: ~A ~A" (DisplayHeight dpy scrn) (.height scr)))
+ (if (not (equal? (DisplayWidthMM dpy scrn) (.mwidth scr)))
+ (snd-display #__line__ ";DisplayWidthMM: ~A ~A" (DisplayWidthMM dpy scrn) (.mwidth scr)))
+ (if (not (equal? (DisplayHeightMM dpy scrn) (.mheight scr)))
+ (snd-display #__line__ ";DisplayHeightMM: ~A ~A" (DisplayHeightMM dpy scrn) (.mheight scr)))
+ (if (not (equal? (DisplayPlanes dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";DisplayPlanes: ~A ~A" (DisplayPlanes dpy scrn) (.root_depth scr)))
+ (if (not (equal? (DefaultDepth dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";DefaultDepth: ~A ~A" (DefaultDepth dpy scrn) (.root_depth scr)))
+ (if (not (equal? (DefaultColormap dpy scrn) (.cmap scr)))
+ (snd-display #__line__ ";DefaultColormap: ~A ~A" (DefaultColormap dpy scrn) (.cmap scr)))
+
+ (if (not (equal? (XRootWindow dpy scrn) (.root scr)))
+ (snd-display #__line__ ";XRootWindow: ~A ~A" (XRootWindow dpy scrn) (.root scr)))
+ (if (not (equal? (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (snd-display #__line__ ";XDefaultRootWindow: ~A ~A" (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (if (not (equal? (XDefaultVisual dpy scrn) (.root_visual scr)))
+ (snd-display #__line__ ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) (.root_visual scr)))
+ (if (not (equal? (XDefaultGC dpy scrn) (.default_gc scr)))
+ (snd-display #__line__ ";XDefaultGC: ~A ~A" (XDefaultGC dpy scrn) (.default_gc scr)))
+ (if (not (equal? (XBlackPixel dpy scrn) (.black_pixel scr)))
+ (snd-display #__line__ ";XBlackPixel: ~A ~A" (XBlackPixel dpy scrn) (.black_pixel scr)))
+ (if (not (equal? (XWhitePixel dpy scrn) (.white_pixel scr)))
+ (snd-display #__line__ ";XWhitePixel ~A ~A" (XWhitePixel dpy scrn) (.white_pixel scr)))
+ (if (not (equal? (XDisplayWidth dpy scrn) (.width scr)))
+ (snd-display #__line__ ";XDisplayWidth: ~A ~A" (XDisplayWidth dpy scrn) (.width scr)))
+ (if (not (equal? (XDisplayHeight dpy scrn) (.height scr)))
+ (snd-display #__line__ ";XDisplayHeight: ~A ~A" (XDisplayHeight dpy scrn) (.height scr)))
+ (if (not (equal? (XDisplayWidthMM dpy scrn) (.mwidth scr)))
+ (snd-display #__line__ ";XDisplayWidthMM: ~A ~A" (XDisplayWidthMM dpy scrn) (.mwidth scr)))
+ (if (not (equal? (XDisplayHeightMM dpy scrn) (.mheight scr)))
+ (snd-display #__line__ ";XDisplayHeightMM: ~A ~A" (XDisplayHeightMM dpy scrn) (.mheight scr)))
+ (if (not (equal? (XDisplayPlanes dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";XDisplayPlanes: ~A ~A" (XDisplayPlanes dpy scrn) (.root_depth scr)))
+ (if (not (equal? (XDefaultDepth dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";XDefaultDepth: ~A ~A" (XDefaultDepth dpy scrn) (.root_depth scr)))
+ (if (not (equal? (XDefaultColormap dpy scrn) (.cmap scr)))
+ (snd-display #__line__ ";XDefaultColormap: ~A ~A" (XDefaultColormap dpy scrn) (.cmap scr)))
+
+ (if (not (equal? (XDefaultVisual dpy scrn) vis))
+ (snd-display #__line__ ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) vis))
+ (if (not (equal? (DisplayCells dpy scrn) (.map_entries vis)))
+ (snd-display #__line__ ";DisplayCells: ~A ~A" (DisplayCells dpy scrn) (.map_entries vis)))
+ (if (not (equal? (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (snd-display #__line__ ";CellsOfScreen: ~A ~A" (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (if (not (equal? (XDisplayCells dpy scrn) (.map_entries vis)))
+ (snd-display #__line__ ";XDisplayCells: ~A ~A" (XDisplayCells dpy scrn) (.map_entries vis)))
+ (if (not (equal? (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (snd-display #__line__ ";XCellsOfScreen: ~A ~A" (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (if (< (XNextRequest dpy) (XLastKnownRequestProcessed dpy))
+ (snd-display #__line__ ";XRequests: ~A ~A" (XNextRequest dpy) (XLastKnownRequestProcessed dpy)))
+ (if (< (NextRequest dpy) (LastKnownRequestProcessed dpy))
+ (snd-display #__line__ ";Requests: ~A ~A" (NextRequest dpy) (LastKnownRequestProcessed dpy)))
+ (if (not (= (XDisplayMotionBufferSize dpy) 256))
+ (snd-display #__line__ ";XDisplayMotionBufferSize: ~A" (XDisplayMotionBufferSize dpy)))
+ (XGetMotionEvents dpy win (list 'Time 100) (list 'Time CurrentTime))
+
+ (let ((lmapk (XNewModifiermap 2))
+ (kcd (list 'KeyCode 50)))
+ (if (not (XModifierKeymap? lmapk))
+ (snd-display #__line__ ";xNewModifiermap: ~A" lmapk)
+ (begin
+ (set! lmapk (XInsertModifiermapEntry lmapk kcd ShiftMapIndex))
+ (set! lmapk (XDeleteModifiermapEntry lmapk kcd ShiftMapIndex))
; (XFreeModifiermap lmapk) ;prone to segfault in X
- )))
-
- (if (not (= (XExtendedMaxRequestSize dpy) 4194303))
- (snd-display ";XExtendedMaxRequestSize ~A" (XExtendedMaxRequestSize dpy)))
- (if (not (= (XMaxRequestSize dpy) 65535))
- (snd-display ";XMaxRequestSize ~A" (XMaxRequestSize dpy)))
- (if (not (member (list 'Atom 40) (XListProperties dpy win)))
- (snd-display ";XListProperties: ~A" (XListProperties dpy win)))
- (if (not (member "SHAPE" (XListExtensions dpy)))
- (snd-display ";XListExtensions: ~A" (XListExtensions dpy)))
- (let ((val (XListInstalledColormaps dpy win)))
- (if (or (not val)
- (null? val)
- (not (Colormap? (car val))))
- (snd-display ";XListInstalledColormaps: ~A" (XListInstalledColormaps dpy win))))
- (if (not (string=? (XKeysymToString (list 'KeySym 80)) "P"))
- (snd-display ";XKeysymToString: ~A" (XKeysymToString (list 'KeySym 80))))
- (if (not (string=? (XGetAtomName dpy (list 'Atom 40)) "WM_NORMAL_HINTS"))
- (snd-display ";XGetAtomName: ~A" (XGetAtomName dpy (list 'Atom 40))))
-
- (if (not (= (.bits_per_rgb vis) 8)) (snd-display ";bits_per_rgb: ~A" (.bits_per_rgb vis)))
- (if (not (= (.blue_mask vis) 255)) (snd-display ";blue_mask: ~A" (.blue_mask vis)))
- (if (not (= (.green_mask vis) 65280)) (snd-display ";green_mask: ~A" (.green_mask vis)))
- (if (not (= (.red_mask vis) 16711680)) (snd-display ";red_mask: ~A" (.red_mask vis)))
- (if (not (= AllPlanes 4294967295)) (snd-display ";AllPlanes: ~A" AllPlanes))
-
- (if (< (QLength dpy) 0) (snd-display ";QLength: ~A" (QLength dpy)))
- (if (not (= (ScreenCount dpy) 1)) (snd-display ";ScreenCount: ~A" (ScreenCount dpy)))
- (if (not (string=? (ServerVendor dpy) "The X.Org Foundation")) (snd-display ";ServerVendor: ~A" (ServerVendor dpy)))
- (if (not (= (ProtocolRevision dpy) 0)) (snd-display ";ProtocolRevision: ~A" (ProtocolRevision dpy)))
- (if (not (= (ProtocolVersion dpy) 11)) (snd-display ";ProtocolVersion: ~A" (ProtocolVersion dpy)))
- (if (not (number? (VendorRelease dpy))) (snd-display ";VendorRelease: ~A" (VendorRelease dpy)))
- (if (not (string=? (DisplayString dpy) ":0.0")) (snd-display ";DisplayString: ~A" (DisplayString dpy)))
- (if (not (= (BitmapUnit dpy) 32)) (snd-display ";BitmapUnit: ~A" (BitmapUnit dpy)))
- (if (not (= (BitmapPad dpy) 32)) (snd-display ";BitmapPad: ~A" (BitmapPad dpy)))
- (if (not (= (BitmapBitOrder dpy) 0)) (snd-display ";BitmapBitOrder: ~A" (BitmapBitOrder dpy)))
- (if (not (= (ImageByteOrder dpy) 0)) (snd-display ";ImageByteOrder: ~A" (ImageByteOrder dpy)))
- (if (not (= (DefaultScreen dpy) 0)) (snd-display ";DefaultScreen: ~A" (DefaultScreen dpy)))
-
- (let* ((col (XColor))
- (col1 (XColor))
- (dpy (XtDisplay (cadr (main-widgets))))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr)))
- (if (= (XAllocNamedColor dpy cmap "blue" col col) 0) (snd-display ";XAllocNamedColor blue ~A?" col))
- (if (not (= (.red col) 0)) (snd-display ";XAllocNamedColor: ~A" (.red col)))
- (if (= (XAllocColor dpy cmap col) 0) (snd-display ";XAllocColor?"))
- (if (not (= (.red col) 0)) (snd-display ";XAllocColor: ~A" (.red col)))
- (if (= (XParseColor dpy cmap "blue" col) 0) (snd-display ";XParseColor?"))
- (if (not (= (.red col) 0)) (snd-display ";XParseColor: ~A" (.red col)))
- (if (= (XAllocNamedColor dpy cmap "green" col1 col1) 0) (snd-display ";XAllocNamedColor green ~A?" col1))
- (XQueryColor dpy cmap col)
- (XQueryColors dpy cmap (list col col1)))
-
- (XSetAfterFunction dpy (lambda (n) 0))
- (XSetAfterFunction dpy #f)
- (if (not (equal? (XDisplayKeycodes dpy) (list 1 8 255)))
- (snd-display ";XDisplayKeycodes: ~A" (XDisplayKeycodes dpy)))
- (let ((str (XFetchName dpy win)))
- (if (not (string=? (substring str 0 3) "snd"))
- (snd-display ";XFetchName: ~A" str)))
- (XStoreName dpy win "hiho")
- (let ((str (XFetchName dpy win)))
- (if (not (string=? str "hiho"))
- (snd-display ";XStoreName: ~A" str)))
- (XStoreName dpy win "snd")
- (let ((str (XGetIconName dpy win)))
- (if (not (string=? str "snd"))
- (snd-display ";XGetIconName: ~A" str)))
- (XSetIconName dpy win "hiho")
- (let ((str (XGetIconName dpy win)))
- (if (not (string=? str "hiho"))
- (snd-display ";XSetIconName: ~A" str)))
- (let ((geo (XGetGeometry dpy win)))
- (if (or (not (= (window-width) (list-ref geo 4)))
- (not (= (window-height) (list-ref geo 5))))
- (snd-display ";XGetGeometry: ~A (~A ~A)" geo (window-width) (window-height))))
- (let ((focus (XGetInputFocus dpy)))
- (if (or (not (= (car focus) 1))
- (not (Window? (cadr focus))))
- (snd-display ";XGetInputFocus: ~A" focus)))
- (let ((vals (XGetPointerControl dpy)))
- (if (not (equal? vals (list 1 2 1 4))) (snd-display ";pointer state: ~A" vals))
- (XChangePointerControl dpy #f #t 2 1 8)
- (set! vals (XGetPointerControl dpy))
- (if (not (equal? vals (list 1 2 1 8))) (snd-display ";set pointer state: ~A" vals))
- (XChangePointerControl dpy #f #t 2 1 4))
- (XAutoRepeatOff dpy)
- (if (not (= (list-ref (XGetKeyboardControl dpy) 5) 0)) (snd-display ";AutoRepeatOff?"))
- (XAutoRepeatOn dpy)
- (if (not (= (list-ref (XGetKeyboardControl dpy) 5) 1)) (snd-display ";AutoRepeatOn?"))
- (let ((vals (XGetPointerMapping dpy 0 3)))
- (if (not (equal? vals (list 1 2 3))) (snd-display ";XGetPointerMapping: ~A" vals)))
- (XGetScreenSaver dpy)
- (XMoveWindow dpy win 100 10)
- (XSync dpy #f)
- (XResizeWindow dpy win 400 400)
- (XSync dpy #f)
- (XMoveResizeWindow dpy win 120 20 500 500)
- (XSync dpy #f)
- (let ((attr (XGetWindowAttributes dpy win)))
- (if (> (abs (- (.x attr) 120)) 200) (snd-display ";XMoveWindow x etc: ~A" (.x attr)))
- (if (> (abs (- (.y attr) 20)) 200) (snd-display ";XMoveWindow y etc: ~A" (.y attr)))
- (if (> (abs (- (.width attr) 500)) 20) (snd-display ";XMoveWindow width etc: ~A" (.width attr)))
- (if (> (abs (- (.height attr) 500)) 20) (snd-display ";XMoveWindow height etc: ~A" (.height attr)))
- (if (not (= (.border_width attr) 0)) (snd-display ";XGetWindowAttributes border_width: ~A" (.border_width attr)))
- (if (not (= (.depth attr) 24)) (snd-display ";XGetWindowAttributes depth: ~A" (.depth attr)))
- (if (not (= (.bit_gravity attr) 0)) (snd-display ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
- (if (not (= (.win_gravity attr) 1)) (snd-display ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
- (if (.backing_store attr) (snd-display ";XGetWindowAttributes backing_store: ~A" (.backing_store attr)))
- (if (.override_redirect attr) (snd-display ";XGetWindowAttributes override_redirect: ~A" (.override_redirect attr)))
- (if (.save_under attr) (snd-display ";XGetWindowAttributes save_under: ~A" (.save_under attr)))
- ; (if (.map_installed attr) (snd-display ";XGetWindowAttributes map_installed: ~A" (.map_installed attr)))
- (if (not (equal? (.backing_pixel attr) (list 'Pixel 0))) (snd-display ";XGetWindowAttributes backing_pixel: ~A" (.backing_pixel attr)))
- (if (not (= (.map_state attr) 2)) (snd-display ";XGetWindowAttributes map_state: ~A" (.map_state attr)))
- (if (not (= (.your_event_mask attr) #x628033)) (snd-display ";your_event_mask: ~X" (.your_event_mask attr)))
- (if (and (not (= (.all_event_masks attr) #x628033))
- (not (= (.all_event_masks attr) #xe28033))
- (not (= (.all_event_masks attr) #xea8033)))
- (snd-display ";all_event_masks: ~X" (.all_event_masks attr)))
- (if (not (Screen? (.screen attr))) (snd-display ";XGetWindowAttributes screen: ~A" (.screen attr)))
- (if (and (not (= (.do_not_propagate_mask attr) 0))
- (not (= (.do_not_propagate_mask attr) 8204)))
- (snd-display ";XGetWindowAttributes do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
- (if (not (= (.backing_planes attr) AllPlanes)) (snd-display ";XGetWindowAttributes backing_planes: ~A" (.backing_planes attr)))
- (if (not (= (.win_gravity attr) 1)) (snd-display ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
- (if (not (= (.bit_gravity attr) 0)) (snd-display ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
+ )))
+
+ (if (not (= (XExtendedMaxRequestSize dpy) 4194303))
+ (snd-display #__line__ ";XExtendedMaxRequestSize ~A" (XExtendedMaxRequestSize dpy)))
+ (if (not (= (XMaxRequestSize dpy) 65535))
+ (snd-display #__line__ ";XMaxRequestSize ~A" (XMaxRequestSize dpy)))
+ (if (not (member (list 'Atom 40) (XListProperties dpy win)))
+ (snd-display #__line__ ";XListProperties: ~A" (XListProperties dpy win)))
+ (if (not (member "SHAPE" (XListExtensions dpy)))
+ (snd-display #__line__ ";XListExtensions: ~A" (XListExtensions dpy)))
+ (let ((val (XListInstalledColormaps dpy win)))
+ (if (or (not val)
+ (null? val)
+ (not (Colormap? (car val))))
+ (snd-display #__line__ ";XListInstalledColormaps: ~A" (XListInstalledColormaps dpy win))))
+ (if (not (string=? (XKeysymToString (list 'KeySym 80)) "P"))
+ (snd-display #__line__ ";XKeysymToString: ~A" (XKeysymToString (list 'KeySym 80))))
+ (if (not (string=? (XGetAtomName dpy (list 'Atom 40)) "WM_NORMAL_HINTS"))
+ (snd-display #__line__ ";XGetAtomName: ~A" (XGetAtomName dpy (list 'Atom 40))))
+
+ (if (not (= (.bits_per_rgb vis) 8)) (snd-display #__line__ ";bits_per_rgb: ~A" (.bits_per_rgb vis)))
+ (if (not (= (.blue_mask vis) 255)) (snd-display #__line__ ";blue_mask: ~A" (.blue_mask vis)))
+ (if (not (= (.green_mask vis) 65280)) (snd-display #__line__ ";green_mask: ~A" (.green_mask vis)))
+ (if (not (= (.red_mask vis) 16711680)) (snd-display #__line__ ";red_mask: ~A" (.red_mask vis)))
+ (if (not (= AllPlanes 4294967295)) (snd-display #__line__ ";AllPlanes: ~A" AllPlanes))
+
+ (if (< (QLength dpy) 0) (snd-display #__line__ ";QLength: ~A" (QLength dpy)))
+ (if (not (= (ScreenCount dpy) 1)) (snd-display #__line__ ";ScreenCount: ~A" (ScreenCount dpy)))
+ (if (not (string=? (ServerVendor dpy) "The X.Org Foundation")) (snd-display #__line__ ";ServerVendor: ~A" (ServerVendor dpy)))
+ (if (not (= (ProtocolRevision dpy) 0)) (snd-display #__line__ ";ProtocolRevision: ~A" (ProtocolRevision dpy)))
+ (if (not (= (ProtocolVersion dpy) 11)) (snd-display #__line__ ";ProtocolVersion: ~A" (ProtocolVersion dpy)))
+ (if (not (number? (VendorRelease dpy))) (snd-display #__line__ ";VendorRelease: ~A" (VendorRelease dpy)))
+ (if (not (string=? (DisplayString dpy) ":0.0")) (snd-display #__line__ ";DisplayString: ~A" (DisplayString dpy)))
+ (if (not (= (BitmapUnit dpy) 32)) (snd-display #__line__ ";BitmapUnit: ~A" (BitmapUnit dpy)))
+ (if (not (= (BitmapPad dpy) 32)) (snd-display #__line__ ";BitmapPad: ~A" (BitmapPad dpy)))
+ (if (not (= (BitmapBitOrder dpy) 0)) (snd-display #__line__ ";BitmapBitOrder: ~A" (BitmapBitOrder dpy)))
+ (if (not (= (ImageByteOrder dpy) 0)) (snd-display #__line__ ";ImageByteOrder: ~A" (ImageByteOrder dpy)))
+ (if (not (= (DefaultScreen dpy) 0)) (snd-display #__line__ ";DefaultScreen: ~A" (DefaultScreen dpy)))
+
+ (let* ((col (XColor))
+ (col1 (XColor))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr)))
+ (if (= (XAllocNamedColor dpy cmap "blue" col col) 0) (snd-display #__line__ ";XAllocNamedColor blue ~A?" col))
+ (if (not (= (.red col) 0)) (snd-display #__line__ ";XAllocNamedColor: ~A" (.red col)))
+ (if (= (XAllocColor dpy cmap col) 0) (snd-display #__line__ ";XAllocColor?"))
+ (if (not (= (.red col) 0)) (snd-display #__line__ ";XAllocColor: ~A" (.red col)))
+ (if (= (XParseColor dpy cmap "blue" col) 0) (snd-display #__line__ ";XParseColor?"))
+ (if (not (= (.red col) 0)) (snd-display #__line__ ";XParseColor: ~A" (.red col)))
+ (if (= (XAllocNamedColor dpy cmap "green" col1 col1) 0) (snd-display #__line__ ";XAllocNamedColor green ~A?" col1))
+ (XQueryColor dpy cmap col)
+ (XQueryColors dpy cmap (list col col1)))
+
+ (XSetAfterFunction dpy (lambda (n) 0))
+ (XSetAfterFunction dpy #f)
+ (if (not (equal? (XDisplayKeycodes dpy) (list 1 8 255)))
+ (snd-display #__line__ ";XDisplayKeycodes: ~A" (XDisplayKeycodes dpy)))
+ (let ((str (XFetchName dpy win)))
+ (if (not (string=? (substring str 0 3) "snd"))
+ (snd-display #__line__ ";XFetchName: ~A" str)))
+ (XStoreName dpy win "hiho")
+ (let ((str (XFetchName dpy win)))
+ (if (not (string=? str "hiho"))
+ (snd-display #__line__ ";XStoreName: ~A" str)))
+ (XStoreName dpy win "snd")
+ (let ((str (XGetIconName dpy win)))
+ (if (not (string=? str "snd"))
+ (snd-display #__line__ ";XGetIconName: ~A" str)))
+ (XSetIconName dpy win "hiho")
+ (let ((str (XGetIconName dpy win)))
+ (if (not (string=? str "hiho"))
+ (snd-display #__line__ ";XSetIconName: ~A" str)))
+ (let ((geo (XGetGeometry dpy win)))
+ (if (or (not (= (window-width) (list-ref geo 4)))
+ (not (= (window-height) (list-ref geo 5))))
+ (snd-display #__line__ ";XGetGeometry: ~A (~A ~A)" geo (window-width) (window-height))))
+ (let ((focus (XGetInputFocus dpy)))
+ (if (or (not (= (car focus) 1))
+ (not (Window? (cadr focus))))
+ (snd-display #__line__ ";XGetInputFocus: ~A" focus)))
+ (let ((vals (XGetPointerControl dpy)))
+ (if (not (equal? vals (list 1 2 1 4))) (snd-display #__line__ ";pointer state: ~A" vals))
+ (XChangePointerControl dpy #f #t 2 1 8)
+ (set! vals (XGetPointerControl dpy))
+ (if (not (equal? vals (list 1 2 1 8))) (snd-display #__line__ ";set pointer state: ~A" vals))
+ (XChangePointerControl dpy #f #t 2 1 4))
+ (XAutoRepeatOff dpy)
+ (if (not (= (list-ref (XGetKeyboardControl dpy) 5) 0)) (snd-display #__line__ ";AutoRepeatOff?"))
+ (XAutoRepeatOn dpy)
+ (if (not (= (list-ref (XGetKeyboardControl dpy) 5) 1)) (snd-display #__line__ ";AutoRepeatOn?"))
+ (let ((vals (XGetPointerMapping dpy 0 3)))
+ (if (not (equal? vals (list 1 2 3))) (snd-display #__line__ ";XGetPointerMapping: ~A" vals)))
+ (XGetScreenSaver dpy)
+ (XMoveWindow dpy win 100 10)
+ (XSync dpy #f)
+ (XResizeWindow dpy win 400 400)
+ (XSync dpy #f)
+ (XMoveResizeWindow dpy win 120 20 500 500)
+ (XSync dpy #f)
+ (let ((attr (XGetWindowAttributes dpy win)))
+ (if (> (abs (- (.x attr) 120)) 200) (snd-display #__line__ ";XMoveWindow x etc: ~A" (.x attr)))
+ (if (> (abs (- (.y attr) 20)) 200) (snd-display #__line__ ";XMoveWindow y etc: ~A" (.y attr)))
+ (if (> (abs (- (.width attr) 500)) 20) (snd-display #__line__ ";XMoveWindow width etc: ~A" (.width attr)))
+ (if (> (abs (- (.height attr) 500)) 20) (snd-display #__line__ ";XMoveWindow height etc: ~A" (.height attr)))
+ (if (not (= (.border_width attr) 0)) (snd-display #__line__ ";XGetWindowAttributes border_width: ~A" (.border_width attr)))
+ (if (not (= (.depth attr) 24)) (snd-display #__line__ ";XGetWindowAttributes depth: ~A" (.depth attr)))
+ (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
+ (if (not (= (.win_gravity attr) 1)) (snd-display #__line__ ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
+ (if (.backing_store attr) (snd-display #__line__ ";XGetWindowAttributes backing_store: ~A" (.backing_store attr)))
+ (if (.override_redirect attr) (snd-display #__line__ ";XGetWindowAttributes override_redirect: ~A" (.override_redirect attr)))
+ (if (.save_under attr) (snd-display #__line__ ";XGetWindowAttributes save_under: ~A" (.save_under attr)))
+ ; (if (.map_installed attr) (snd-display #__line__ ";XGetWindowAttributes map_installed: ~A" (.map_installed attr)))
+ (if (not (equal? (.backing_pixel attr) (list 'Pixel 0))) (snd-display #__line__ ";XGetWindowAttributes backing_pixel: ~A" (.backing_pixel attr)))
+ (if (not (= (.map_state attr) 2)) (snd-display #__line__ ";XGetWindowAttributes map_state: ~A" (.map_state attr)))
+ (if (not (= (.your_event_mask attr) #x628033)) (snd-display #__line__ ";your_event_mask: ~X" (.your_event_mask attr)))
+ (if (and (not (= (.all_event_masks attr) #x628033))
+ (not (= (.all_event_masks attr) #xe28033))
+ (not (= (.all_event_masks attr) #xea8033)))
+ (snd-display #__line__ ";all_event_masks: ~X" (.all_event_masks attr)))
+ (if (not (Screen? (.screen attr))) (snd-display #__line__ ";XGetWindowAttributes screen: ~A" (.screen attr)))
+ (if (and (not (= (.do_not_propagate_mask attr) 0))
+ (not (= (.do_not_propagate_mask attr) 8204)))
+ (snd-display #__line__ ";XGetWindowAttributes do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
+ (if (not (= (.backing_planes attr) AllPlanes)) (snd-display #__line__ ";XGetWindowAttributes backing_planes: ~A" (.backing_planes attr)))
+ (if (not (= (.win_gravity attr) 1)) (snd-display #__line__ ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
+ (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
;(segfault) (XFree (cadr attr))
- )
- (XResetScreenSaver dpy)
- (if (< (XPending dpy) 0) (snd-display ";XPending: ~A" (XPending dpy)))
- (XNoOp dpy)
- (XQueryBestStipple dpy win 100 100)
- (XQueryBestTile dpy win 100 100)
- (XQueryBestSize dpy 0 win 100 100)
- (let ((ext (XQueryExtension dpy "SHAPE")))
- (if (not (eq? (car ext) #t))
- (snd-display ";XQueryExtension: ~A" ext)))
- (XQueryKeymap dpy)
- (let ((tree (XQueryTree dpy win)))
- (if (or (not (= (car tree) 1))
- (not (equal? (XRootWindow dpy 0) (cadr tree))))
- (snd-display ";XQueryTree: ~A (~A)" tree (XRootWindow dpy 0))))
-
- (if (< (XQLength dpy) 0) (snd-display ";XQLength: ~A" (XQLength dpy)))
- (if (not (= (XScreenCount dpy) 1)) (snd-display ";XScreenCount: ~A" (XScreenCount dpy)))
- (if (not (string=? (XServerVendor dpy) "The X.Org Foundation")) (snd-display ";XServerVendor: ~A" (XServerVendor dpy)))
- (if (not (= (XProtocolRevision dpy) 0)) (snd-display ";XProtocolRevision: ~A" (XProtocolRevision dpy)))
- (if (not (= (XProtocolVersion dpy) 11)) (snd-display ";XProtocolVersion: ~A" (XProtocolVersion dpy)))
- (if (not (number? (XVendorRelease dpy))) (snd-display ";XVendorRelease: ~A" (XVendorRelease dpy)))
- (if (not (string=? (XDisplayString dpy) ":0.0")) (snd-display ";XDisplayString: ~A" (XDisplayString dpy)))
- (if (not (= (XBitmapUnit dpy) 32)) (snd-display ";XBitmapUnit: ~A" (XBitmapUnit dpy)))
- (if (not (= (XBitmapPad dpy) 32)) (snd-display ";XBitmapPad: ~A" (XBitmapPad dpy)))
- (if (not (= (XBitmapBitOrder dpy) 0)) (snd-display ";XBitmapBitOrder: ~A" (XBitmapBitOrder dpy)))
- (if (not (= (XImageByteOrder dpy) 0)) (snd-display ";XImageByteOrder: ~A" (XImageByteOrder dpy)))
- (if (not (= (XDefaultScreen dpy) 0)) (snd-display ";XDefaultScreen: ~A" (XDefaultScreen dpy)))
- (if (XGetIconSizes dpy win) (snd-display ";XGetIconSizes: ~A" (XGetIconSizes dpy win)))
- (if (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)
- (snd-display ";XGetRGBColormaps: ~A!" (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)))
- (let ((cmap (XAllocStandardColormap)))
- (for-each
- (lambda (func name)
- (if (not (= (func cmap) 0)) (snd-display ";standardcolormap ~A: ~A" name (func cmap))))
- (list .visualid .red_max .red_mult .green_max .green_mult .blue_max .blue_mult)
- (list 'visualid 'red_max 'red_mult 'green_max 'green_mult 'blue_max 'blue_mult))
- (if (.colormap cmap) (snd-display ";colormap: ~A" (.colormap cmap)))
- (XtFree (cadr cmap))
- )
- (let ((icon (XAllocIconSize)))
- (for-each
- (lambda (func name)
- (if (not (= (func icon) 0)) (snd-display ";iconsize ~A: ~A" name (func icon))))
- (list .min_width .min_height .max_width .max_height .width_inc .height_inc)
- (list 'min_width 'min_height 'max_width 'max_height 'width_inc 'height_inc))
- (XFree icon))
-
- (let ((fs (XCreateFontSet dpy "*-*-*-*-Normal-*-*-*-*-*-*")))
- (if (or (not (XFontSet? fs))
- (= (cadr fs) 0))
- (snd-display ";XCreateFontSet: ~A" fs)
- (let* ((fnts (XFontsOfFontSet fs))
- (fnt (caar fnts)))
- (if (not (XFontStruct? fnt))
- (snd-display ";XFontsOfFontSet: ~A" fnts))
- (if (XContextualDrawing fs)
- (snd-display ";XContextualDrawing: ~A" (XContextualDrawing fs)))
- (if (XContextDependentDrawing fs)
- (snd-display ";XContextDependentDrawing: ~A" (XContextDependentDrawing fs)))
- (if (XDirectionalDependentDrawing fs)
- (snd-display ";XDirectionalDependentDrawing: ~A" (XDirectionalDependentDrawing fs)))
- (if (not (string=? (XLocaleOfFontSet fs) "en_US"))
- (snd-display ";XLocaleOfFontSet: ~A" (XLocaleOfFontSet fs)))
- (if (not (string=? (XBaseFontNameListOfFontSet fs) "*-*-*-*-Normal-*-*-*-*-*-*"))
- (snd-display ";XBaseFontNameListOfFontSet: ~A" (XBaseFontNameListOfFontSet fs)))
- (if fnt
- (let ((wgt (XGetFontProperty fnt XA_WEIGHT))
- (siz (XGetFontProperty fnt XA_POINT_SIZE)))
- (if (or (not (= (cadr wgt) 10))
- (not (= (cadr siz) 120)))
- (snd-display ";XGetFontProperty: ~A ~A" wgt siz))
- (if (not (= (.descent fnt) 2)) (snd-display ";descent: ~A" (.descent fnt)))
- (if (not (= (.ascent fnt) 11)) (snd-display ";ascent: ~A" (.ascent fnt)))
- (if (not (XCharStruct? (.per_char fnt))) (snd-display ";per_char: ~A" (.per_char fnt)))
- (if (not (XCharStruct? (.max_bounds fnt))) (snd-display ";max_bounds: ~A" (.max_bounds fnt)))
- (if (not (XCharStruct? (.min_bounds fnt))) (snd-display ";min_bounds: ~A" (.min_bounds fnt)))
- (if (not (XFontProp? (car (.properties fnt)))) (snd-display ";properties ~A" (.properties fnt)))
- (if (not (= (.card32 (car (.properties fnt))) 7)) (snd-display ";card32: ~A" (.card32 (car (.properties fnt)))))))
- (XFreeFontSet dpy fs))))
- (XBell dpy 10)
- (let ((cmd (XGetCommand dpy win)))
- (if (or (not (> (length cmd) 0))
- (not (string=? (my-substring (car cmd) (- (string-length (car cmd)) 3)) "snd")))
- (snd-display ";XGetCommand: ~A" cmd)))
- (XSetCommand dpy win (list "hiho" "away") 2)
- (if (not (equal? (XGetCommand dpy win) (list "hiho" "away")))
- (snd-display ";XSetCommand: ~A" (XGetCommand dpy win)))
- (let ((wmp (map (lambda (w) (XGetAtomName dpy w)) (XGetWMProtocols dpy win))))
- (if (not (equal? wmp (list "_MOTIF_WM_MESSAGES" "WM_DELETE_WINDOW")))
- (snd-display ";XGetWMProtocols: ~A" wmp)))
- (if (not (equal? (XListDepths dpy 0) (list 24 1 4 8 15 16 32)))
- (snd-display ";XListDepths: ~A" (XListDepths dpy 0)))
- (if (not (equal? (XListPixmapFormats dpy) '((1 1 32) (4 8 32) (8 8 32) (15 16 32) (16 16 32) (24 32 32) (32 32 32))))
- (snd-display ";XListPixmapFormats: ~A" (XListPixmapFormats dpy)))
-
- (XWarpPointer dpy (list 'Window None) (list 'Window None) 0 0 10 10 100 100)
- (let ((cs (XQueryBestCursor dpy win 10 10)))
- (if (not (equal? cs (list 1 10 10))) (snd-display ";XQueryBestCursor: ~A" cs)))
- (let ((pt (XQueryPointer dpy win)))
- (if (not (Window? (cadr pt))) (snd-display ";XQueryPointer: ~A" pt)))
- (XRaiseWindow dpy win)
- (XRotateBuffers dpy 1)
- (XSetWindowBorderWidth dpy win 10)
- (XSetWindowBorder dpy win (black-pixel))
- (XSetWindowBackground dpy win (basic-color))
- (let* ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0)))
- (depth (.depth (car vis))))
- (XSetWindowBorderPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
- (XSetWindowBackgroundPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
- (XSetWindowBorderPixmap dpy win CopyFromParent)
- (XSetWindowBackgroundPixmap dpy win ParentRelative)
+ )
+ (XResetScreenSaver dpy)
+ (if (< (XPending dpy) 0) (snd-display #__line__ ";XPending: ~A" (XPending dpy)))
+ (XNoOp dpy)
+ (XQueryBestStipple dpy win 100 100)
+ (XQueryBestTile dpy win 100 100)
+ (XQueryBestSize dpy 0 win 100 100)
+ (let ((ext (XQueryExtension dpy "SHAPE")))
+ (if (not (eq? (car ext) #t))
+ (snd-display #__line__ ";XQueryExtension: ~A" ext)))
+ (XQueryKeymap dpy)
+ (let ((tree (XQueryTree dpy win)))
+ (if (or (not (= (car tree) 1))
+ (not (equal? (XRootWindow dpy 0) (cadr tree))))
+ (snd-display #__line__ ";XQueryTree: ~A (~A)" tree (XRootWindow dpy 0))))
+
+ (if (< (XQLength dpy) 0) (snd-display #__line__ ";XQLength: ~A" (XQLength dpy)))
+ (if (not (= (XScreenCount dpy) 1)) (snd-display #__line__ ";XScreenCount: ~A" (XScreenCount dpy)))
+ (if (not (string=? (XServerVendor dpy) "The X.Org Foundation")) (snd-display #__line__ ";XServerVendor: ~A" (XServerVendor dpy)))
+ (if (not (= (XProtocolRevision dpy) 0)) (snd-display #__line__ ";XProtocolRevision: ~A" (XProtocolRevision dpy)))
+ (if (not (= (XProtocolVersion dpy) 11)) (snd-display #__line__ ";XProtocolVersion: ~A" (XProtocolVersion dpy)))
+ (if (not (number? (XVendorRelease dpy))) (snd-display #__line__ ";XVendorRelease: ~A" (XVendorRelease dpy)))
+ (if (not (string=? (XDisplayString dpy) ":0.0")) (snd-display #__line__ ";XDisplayString: ~A" (XDisplayString dpy)))
+ (if (not (= (XBitmapUnit dpy) 32)) (snd-display #__line__ ";XBitmapUnit: ~A" (XBitmapUnit dpy)))
+ (if (not (= (XBitmapPad dpy) 32)) (snd-display #__line__ ";XBitmapPad: ~A" (XBitmapPad dpy)))
+ (if (not (= (XBitmapBitOrder dpy) 0)) (snd-display #__line__ ";XBitmapBitOrder: ~A" (XBitmapBitOrder dpy)))
+ (if (not (= (XImageByteOrder dpy) 0)) (snd-display #__line__ ";XImageByteOrder: ~A" (XImageByteOrder dpy)))
+ (if (not (= (XDefaultScreen dpy) 0)) (snd-display #__line__ ";XDefaultScreen: ~A" (XDefaultScreen dpy)))
+ (if (XGetIconSizes dpy win) (snd-display #__line__ ";XGetIconSizes: ~A" (XGetIconSizes dpy win)))
+ (if (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)
+ (snd-display #__line__ ";XGetRGBColormaps: ~A!" (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)))
+ (let ((cmap (XAllocStandardColormap)))
+ (for-each
+ (lambda (func name)
+ (if (not (= (func cmap) 0)) (snd-display #__line__ ";standardcolormap ~A: ~A" name (func cmap))))
+ (list .visualid .red_max .red_mult .green_max .green_mult .blue_max .blue_mult)
+ (list 'visualid 'red_max 'red_mult 'green_max 'green_mult 'blue_max 'blue_mult))
+ (if (.colormap cmap) (snd-display #__line__ ";colormap: ~A" (.colormap cmap)))
+ (XtFree (cadr cmap))
+ )
+ (let ((icon (XAllocIconSize)))
+ (for-each
+ (lambda (func name)
+ (if (not (= (func icon) 0)) (snd-display #__line__ ";iconsize ~A: ~A" name (func icon))))
+ (list .min_width .min_height .max_width .max_height .width_inc .height_inc)
+ (list 'min_width 'min_height 'max_width 'max_height 'width_inc 'height_inc))
+ (XFree icon))
+
+ (let ((fs (XCreateFontSet dpy "*-*-*-*-Normal-*-*-*-*-*-*")))
+ (if (or (not (XFontSet? fs))
+ (= (cadr fs) 0))
+ (snd-display #__line__ ";XCreateFontSet: ~A" fs)
+ (let* ((fnts (XFontsOfFontSet fs))
+ (fnt (caar fnts)))
+ (if (not (XFontStruct? fnt))
+ (snd-display #__line__ ";XFontsOfFontSet: ~A" fnts))
+ (if (XContextualDrawing fs)
+ (snd-display #__line__ ";XContextualDrawing: ~A" (XContextualDrawing fs)))
+ (if (XContextDependentDrawing fs)
+ (snd-display #__line__ ";XContextDependentDrawing: ~A" (XContextDependentDrawing fs)))
+ (if (XDirectionalDependentDrawing fs)
+ (snd-display #__line__ ";XDirectionalDependentDrawing: ~A" (XDirectionalDependentDrawing fs)))
+ (if (not (string=? (XLocaleOfFontSet fs) "en_US"))
+ (snd-display #__line__ ";XLocaleOfFontSet: ~A" (XLocaleOfFontSet fs)))
+ (if (not (string=? (XBaseFontNameListOfFontSet fs) "*-*-*-*-Normal-*-*-*-*-*-*"))
+ (snd-display #__line__ ";XBaseFontNameListOfFontSet: ~A" (XBaseFontNameListOfFontSet fs)))
+ (if fnt
+ (let ((wgt (XGetFontProperty fnt XA_WEIGHT))
+ (siz (XGetFontProperty fnt XA_POINT_SIZE)))
+ (if (or (not (= (cadr wgt) 10))
+ (not (= (cadr siz) 120)))
+ (snd-display #__line__ ";XGetFontProperty: ~A ~A" wgt siz))
+ (if (not (= (.descent fnt) 2)) (snd-display #__line__ ";descent: ~A" (.descent fnt)))
+ (if (not (= (.ascent fnt) 11)) (snd-display #__line__ ";ascent: ~A" (.ascent fnt)))
+ (if (not (XCharStruct? (.per_char fnt))) (snd-display #__line__ ";per_char: ~A" (.per_char fnt)))
+ (if (not (XCharStruct? (.max_bounds fnt))) (snd-display #__line__ ";max_bounds: ~A" (.max_bounds fnt)))
+ (if (not (XCharStruct? (.min_bounds fnt))) (snd-display #__line__ ";min_bounds: ~A" (.min_bounds fnt)))
+ (if (not (XFontProp? (car (.properties fnt)))) (snd-display #__line__ ";properties ~A" (.properties fnt)))
+ (if (not (= (.card32 (car (.properties fnt))) 7)) (snd-display #__line__ ";card32: ~A" (.card32 (car (.properties fnt)))))))
+ (XFreeFontSet dpy fs))))
+ (XBell dpy 10)
+ (let ((cmd (XGetCommand dpy win)))
+ (if (or (not (> (length cmd) 0))
+ (not (string=? (my-substring (car cmd) (- (string-length (car cmd)) 3)) "snd")))
+ (snd-display #__line__ ";XGetCommand: ~A" cmd)))
+ (XSetCommand dpy win (list "hiho" "away") 2)
+ (if (not (equal? (XGetCommand dpy win) (list "hiho" "away")))
+ (snd-display #__line__ ";XSetCommand: ~A" (XGetCommand dpy win)))
+ (let ((wmp (map (lambda (w) (XGetAtomName dpy w)) (XGetWMProtocols dpy win))))
+ (if (not (equal? wmp (list "_MOTIF_WM_MESSAGES" "WM_DELETE_WINDOW")))
+ (snd-display #__line__ ";XGetWMProtocols: ~A" wmp)))
+ (if (not (equal? (XListDepths dpy 0) (list 24 1 4 8 15 16 32)))
+ (snd-display #__line__ ";XListDepths: ~A" (XListDepths dpy 0)))
+ (if (not (equal? (XListPixmapFormats dpy) '((1 1 32) (4 8 32) (8 8 32) (15 16 32) (16 16 32) (24 32 32) (32 32 32))))
+ (snd-display #__line__ ";XListPixmapFormats: ~A" (XListPixmapFormats dpy)))
+
+ (XWarpPointer dpy (list 'Window None) (list 'Window None) 0 0 10 10 100 100)
+ (let ((cs (XQueryBestCursor dpy win 10 10)))
+ (if (not (equal? cs (list 1 10 10))) (snd-display #__line__ ";XQueryBestCursor: ~A" cs)))
+ (let ((pt (XQueryPointer dpy win)))
+ (if (not (Window? (cadr pt))) (snd-display #__line__ ";XQueryPointer: ~A" pt)))
+ (XRaiseWindow dpy win)
+ (XRotateBuffers dpy 1)
+ (XSetWindowBorderWidth dpy win 10)
+ (XSetWindowBorder dpy win (black-pixel))
+ (XSetWindowBackground dpy win (basic-color))
+ (let* ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0)))
+ (depth (.depth (car vis))))
+ (XSetWindowBorderPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
+ (XSetWindowBackgroundPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
+ (XSetWindowBorderPixmap dpy win CopyFromParent)
+ (XSetWindowBackgroundPixmap dpy win ParentRelative)
;(segfault) (XFree (cadr vis))
- )
- (let ((hints (XGetWMHints dpy win)))
- (if (or (not hints) (not (XWMHints? hints))) (snd-display ";XGetWMHints?"))
- (if (not (= (.flags hints) 7)) (snd-display ";flags wmhints: ~A" (.flags hints)))
- (if (not (= (.initial_state hints) 1)) (snd-display ";initial_state wmhints: ~A" (.initial_state hints)))
- (if (not (.input hints)) (snd-display ";input wmhints: ~A" (.input hints)))
- (if (not (Pixmap? (.icon_pixmap hints))) (snd-display ";icon_pixmap wmhints: ~A" (.icon_pixmap hints)))
- (if (.icon_window hints) (snd-display ";icon_window: ~A" (.icon_window hints)))
- (if (not (equal? (.icon_mask hints) (list 'Pixmap 0))) (snd-display ";icon_mask: ~A" (.icon_mask hints)))
- (if (not (number? (.window_group hints))) (snd-display ";window_group: ~A" (.window_group hints)))
- (XtFree (cadr hints))
- (let ((st (XAllocWMHints)))
- (if (not (XWMHints? st)) (snd-display ";XAllocWMHints: ~A" st))
- (XFree st))))
-
- (if (not (IsKeypadKey (list 'KeySym XK_KP_Space))) (snd-display ";IsKeypadKey kp-space"))
- (if (IsKeypadKey (list 'KeySym XK_A)) (snd-display ";IsKeypadKey A"))
- (if (IsPrivateKeypadKey (list 'KeySym XK_A)) (snd-display ";IsPrivateKeypadKey A"))
- (if (not (IsCursorKey (list 'KeySym XK_Home))) (snd-display ";IsCursorKey Home"))
- (if (IsCursorKey (list 'KeySym XK_S)) (snd-display ";IsCursorKey S"))
- (if (not (IsPFKey (list 'KeySym XK_KP_F1))) (snd-display ";IsPFKey F1"))
- (if (IsPFKey (list 'KeySym XK_S)) (snd-display ";IsPFKey S"))
- (if (not (IsFunctionKey (list 'KeySym XK_F1))) (snd-display ";IsFunctionKey F1"))
- (if (IsFunctionKey (list 'KeySym XK_S)) (snd-display ";IsFunctionKey S"))
- (if (not (IsMiscFunctionKey (list 'KeySym XK_Select))) (snd-display ";IsMiscFunctionKey Select"))
- (if (IsMiscFunctionKey (list 'KeySym XK_S)) (snd-display ";IsMiscFunctionKey S"))
- (if (not (IsModifierKey (list 'KeySym XK_Shift_L))) (snd-display ";IsModifierKey Shift"))
- (if (IsModifierKey (list 'KeySym XK_S)) (snd-display ";IsModifierKey S"))
-
- (let* ((scr (current-screen))
- (scrn (XScreenNumberOfScreen scr))
- (dpy (XtDisplay (cadr (main-widgets))))
- (val (XGCValues))
- (wn (XtWindow (cadr (main-widgets)))))
- (set! (.function val) GXclear)
- (if (not (equal? (.function val) GXclear))
- (snd-display ";function: ~A ~A" (.function val) GXclear))
- (set! (.line_width val) 10)
- (if (not (equal? (.line_width val) 10))
- (snd-display ";line_width: ~A ~A" (.line_width val) 10))
- (set! (.line_style val) LineSolid)
- (if (not (equal? (.line_style val) LineSolid))
- (snd-display ";line_style: ~A ~A" (.line_style val) LineSolid))
- (set! (.background val) (WhitePixelOfScreen (current-screen)))
- (if (not (equal? (.background val) (WhitePixelOfScreen (current-screen))))
- (snd-display ";background: ~A ~A" (.background val) (WhitePixelOfScreen (current-screen))))
- (set! (.foreground val) (BlackPixelOfScreen (current-screen)))
- (if (not (equal? (.foreground val) (BlackPixelOfScreen (current-screen))))
- (snd-display ";foreground: ~A ~A" (.foreground val) (BlackPixelOfScreen (current-screen))))
- ;; plane_mask?
- (set! (.cap_style val) CapRound)
- (if (not (equal? (.cap_style val) CapRound))
- (snd-display ";cap_style: ~A ~A" (.cap_style val) CapRound))
- (set! (.join_style val) JoinMiter)
- (if (not (equal? (.join_style val) JoinMiter))
- (snd-display ";join_style: ~A ~A" (.join_style val) JoinMiter))
- (set! (.fill_style val) FillSolid)
- (if (not (equal? (.fill_style val) FillSolid))
- (snd-display ";fill_style: ~A ~A" (.fill_style val) FillSolid))
- (set! (.fill_rule val) EvenOddRule)
- (if (not (equal? (.fill_rule val) EvenOddRule))
- (snd-display ";fill_rule: ~A ~A" (.fill_rule val) EvenOddRule))
- (set! (.arc_mode val) ArcChord)
- (if (not (equal? (.arc_mode val) ArcChord))
- (snd-display ";arc_mode: ~A ~A" (.arc_mode val) ArcChord))
- ;; tile stipple clip_mask are Pixmaps
- (set! (.ts_x_origin val) 1)
- (if (not (equal? (.ts_x_origin val) 1))
- (snd-display ";ts_x_origin: ~A ~A" (.ts_x_origin val) 1))
- (set! (.ts_y_origin val) 1)
- (if (not (equal? (.ts_y_origin val) 1))
- (snd-display ";ts_y_origin: ~A ~A" (.ts_y_origin val) 1))
- ;; font is Font
- (set! (.subwindow_mode val) ClipByChildren)
- (if (not (equal? (.subwindow_mode val) ClipByChildren))
- (snd-display ";subwindow_mode: ~A ~A" (.subwindow_mode val) ClipByChildren))
- (set! (.graphics_exposures val) #f)
- (if (not (equal? (.graphics_exposures val) #f))
- (snd-display ";graphics_exposures: ~A ~A" (.graphics_exposures val) #f))
- (set! (.clip_x_origin val) 0)
- (if (not (equal? (.clip_x_origin val) 0))
- (snd-display ";clip_x_origin: ~A ~A" (.clip_x_origin val) 0))
- (set! (.clip_y_origin val) 0)
- (if (not (equal? (.clip_y_origin val) 0))
- (snd-display ";clip_y_origin: ~A ~A" (.clip_y_origin val) 0))
- (set! (.dash_offset val) 1)
- (if (not (equal? (.dash_offset val) 1))
- (snd-display ";dash_offset: ~A ~A" (.dash_offset val) 1))
- (if (not (number? (XConnectionNumber dpy)))
- (snd-display ";XConnectionNumber: ~A" (XConnectionNumber dpy)))
-
- (let ((sgc (XCreateGC dpy wn (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
- GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
- GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
- GCClipYOrigin GCDashOffset GCArcMode)
- val)))
-
- (if (not (GC? sgc)) (snd-display ";XCreateGC returned ~A" sgc))
- (XSetArcMode dpy sgc ArcPieSlice)
- (XSetFunction dpy sgc GXcopy)
- (XSetLineAttributes dpy sgc 3 LineDoubleDash CapButt JoinMiter)
- (XSetClipOrigin dpy sgc 1 1)
- (XSetTSOrigin dpy sgc 0 0)
- (XSetFillRule dpy sgc WindingRule)
- (XSetFillStyle dpy sgc FillStippled)
- (XSetForeground dpy sgc (WhitePixelOfScreen (current-screen)))
- (XSetBackground dpy sgc (BlackPixelOfScreen (current-screen)))
- (XSetGraphicsExposures dpy sgc #t)
- (XSetSubwindowMode dpy sgc IncludeInferiors)
- (let ((owner (XGetSelectionOwner dpy XA_PRIMARY)))
- (if (and owner (not (Window? owner)))
- (snd-display ";XGetSelectionOwner: ~A" owner)))
- (let ((mods (XGetModifierMapping dpy)))
- (if (not (XModifierKeymap? mods))
- (snd-display ";XGetModifierMapping: ~A" mods)))
- (let ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0))))
- (if (or (not vis)
- (not (XVisualInfo? (car vis))))
- (snd-display ";XGetVisualInfo: ~A" vis))
- (if (not (= (.depth (car vis)) 24)) (snd-display ";depth vis: ~A" (.depth (car vis))))
- (if (not (= (.screen (car vis)) 0)) (snd-display ";screen vis: ~A" (.screen (car vis))))
- (catch #t ; in c++ no class field
- (lambda ()
- (if (not (= (.class (car vis)) TrueColor)) (snd-display ";class vis: ~A (~A)" (.class (car vis)) TrueColor)))
- (lambda args args))
- (if (not (= (.colormap_size (car vis)) 256)) (snd-display ";colormap_size vis: ~A" (.colormap_size (car vis))))
- (if (and (not (XVisualInfo? (XMatchVisualInfo dpy 0 24 TrueColor)))
- (not (XVisualInfo? (XMatchVisualInfo dpy 0 16 TrueColor))))
- (snd-display ";XMatchVisualInfo: ~A" (XMatchVisualInfo dpy 0 24 TrueColor))))
- (XCheckMaskEvent dpy KeyPressMask)
-
- (let* ((vals (XGetGCValues dpy sgc (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
- GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
- GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
- GCClipYOrigin GCDashOffset GCArcMode)))
- (val1 (cadr vals)))
- (if (= (car vals) 0)
- (snd-display ";XGetGCValues failed"))
-
- (if (not (equal? (.function val1) GXcopy))
- (snd-display ";function: ~A ~A" (.function val1) GXcopy))
- (if (not (equal? (.line_width val1) 3))
- (snd-display ";line_width: ~A ~A" (.line_width val1) 3))
- (if (not (equal? (.line_style val1) LineDoubleDash))
- (snd-display ";line_style: ~A ~A" (.line_style val1) LineDoubleDash))
- (if (not (equal? (.background val1) (BlackPixelOfScreen (current-screen))))
- (snd-display ";background: ~A ~A" (.background val1) (BlackPixelOfScreen (current-screen))))
- (if (not (equal? (.foreground val1) (WhitePixelOfScreen (current-screen))))
- (snd-display ";foreground: ~A ~A" (.foreground val1) (WhitePixelOfScreen (current-screen))))
- (if (not (equal? (.cap_style val1) CapButt))
- (snd-display ";cap_style: ~A ~A" (.cap_style val1) CapButt))
- (if (not (equal? (.join_style val1) JoinMiter))
- (snd-display ";join_style: ~A ~A" (.join_style val1) JoinMiter))
- (if (not (equal? (.fill_style val1) FillStippled))
- (snd-display ";fill_style: ~A ~A" (.fill_style val1) FillStippled))
- (if (not (equal? (.fill_rule val1) WindingRule))
- (snd-display ";fill_rule: ~A ~A" (.fill_rule val1) WindingRule))
- (if (not (equal? (.arc_mode val1) ArcPieSlice))
- (snd-display ";arc_mode: ~A ~A" (.arc_mode val1) ArcPieSlice))
- (if (not (equal? (.ts_x_origin val1) 0))
- (snd-display ";ts_x_origin: ~A ~A" (.ts_x_origin val1) 0))
- (if (not (equal? (.ts_y_origin val1) 0))
- (snd-display ";ts_y_origin: ~A ~A" (.ts_y_origin val1) 0))
- (if (not (equal? (.subwindow_mode val1) IncludeInferiors))
- (snd-display ";subwindow_mode: ~A ~A" (.subwindow_mode val1) IncludeInferiors))
- (if (not (equal? (.graphics_exposures val1) #t))
- (snd-display ";graphics_exposures: ~A ~A" (.graphics_exposures val1) #t))
- (if (not (equal? (.clip_x_origin val1) 1))
- (snd-display ";clip_x_origin: ~A ~A" (.clip_x_origin val1) 1))
- (if (not (equal? (.clip_y_origin val1) 1))
- (snd-display ";clip_y_origin: ~A ~A" (.clip_y_origin val1) 1))
- (if (not (equal? (.dash_offset val1) 1))
- (snd-display ";dash_offset: ~A ~A" (.dash_offset val1) 1))
-
- (set! (.plane_mask val) 0)
- (if (not (equal? (.plane_mask val) 0))
- (snd-display ";plane_mask: ~A ~A" (.plane_mask val) 0))
- (set! (.tile val) (list 'Pixmap 0))
- (if (not (equal? (.tile val) (list 'Pixmap 0)))
- (snd-display ";tile: ~A" (.tile val)))
- (set! (.stipple val) (list 'Pixmap 0))
- (if (not (equal? (.stipple val) (list 'Pixmap 0)))
- (snd-display ";stipple: ~A" (.stipple val)))
-
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets))))
- (attr (XSetWindowAttributes #f (basic-color) #f (highlight-color)))
- (newwin (XCreateWindow dpy win 10 10 100 100 3
- CopyFromParent InputOutput (list 'Visual CopyFromParent)
- (logior CWBackPixel CWBorderPixel)
- attr)))
- (if (not (= (.do_not_propagate_mask attr) 0)) (snd-display ";do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
- (if (not (= (.event_mask attr) 0)) (snd-display ";event_mask: ~A" (.event_mask attr)))
- (if (not (Pixel? (.backing_pixel attr))) (snd-display ";backing_pixel: ~A" (.backing_pixel attr)))
- (if (not (Pixel? (.border_pixel attr))) (snd-display ";border_pixel: ~A" (.border_pixel attr)))
- (if (not (= (cadr (.border_pixmap attr)) 0)) (snd-display ";border_pixmap: ~A" (.border_pixmap attr)))
- (if (not (Pixel? (.background_pixel attr))) (snd-display ";background_pixel: ~A" (.background_pixel attr)))
- (if (not (= (cadr (.background_pixmap attr)) 0)) (snd-display ";background_pixmap: ~A" (.background_pixmap attr)))
- (if (not (= (.backing_planes attr) 0)) (snd-display ";backing_planes: ~A" (.backing_planes attr)))
- (if (.save_under attr) (snd-display ";save_under: ~A" (.save_under attr)))
- (if (not (= (cadr (.cursor attr)) 0)) (snd-display ";cursor: ~A" (.cursor attr)))
- (if (not (Window? newwin)) (snd-display ";XCreateWindow: ~A" newwin))
- (if (not (= (.bit_gravity attr) 0)) (snd-display ";bit_gravity: ~A" (.bit_gravity attr)))
- (XChangeWindowAttributes dpy newwin CWBackPixel (XSetWindowAttributes #f (basic-color)))
- (XDestroyWindow dpy newwin)
- (set! newwin (XCreateSimpleWindow dpy win 10 10 100 100 3 (basic-color) (highlight-color)))
- (XDestroyWindow dpy newwin))
-
- (XSetRegion dpy sgc (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule))
- (let ((pix (make-pixmap (cadr (main-widgets)) arrow-strs)))
- (if (not (Pixmap? pix))
- (snd-display ";make-pixmap?")
- (begin
- (XSetTile dpy sgc pix)
- (XSetStipple dpy sgc (XCreateBitmapFromData dpy wn right-arrow 16 12))
- (XSetClipMask dpy sgc None)
- (XSetState dpy sgc (basic-color) (mark-color) GXcopy 0)
- (XSetPlaneMask dpy sgc 0)
- (XSetDashes dpy sgc 0 '(3 4 3 1))
- (XSetClipRectangles dpy sgc 0 0 (list (XRectangle 0 0 10 10) (XRectangle 10 10 100 100)) 2 Unsorted)
- (let ((err (XWriteBitmapFile dpy "testx.data" pix 16 12 -1 -1)))
- (if (not (= BitmapSuccess err)) (snd-display ";XWriteBitmapFile: ~A" err)))
+ )
+ (let ((hints (XGetWMHints dpy win)))
+ (if (or (not hints) (not (XWMHints? hints))) (snd-display #__line__ ";XGetWMHints?"))
+ (if (not (= (.flags hints) 7)) (snd-display #__line__ ";flags wmhints: ~A" (.flags hints)))
+ (if (not (= (.initial_state hints) 1)) (snd-display #__line__ ";initial_state wmhints: ~A" (.initial_state hints)))
+ (if (not (.input hints)) (snd-display #__line__ ";input wmhints: ~A" (.input hints)))
+ (if (not (Pixmap? (.icon_pixmap hints))) (snd-display #__line__ ";icon_pixmap wmhints: ~A" (.icon_pixmap hints)))
+ (if (.icon_window hints) (snd-display #__line__ ";icon_window: ~A" (.icon_window hints)))
+ (if (not (equal? (.icon_mask hints) (list 'Pixmap 0))) (snd-display #__line__ ";icon_mask: ~A" (.icon_mask hints)))
+ (if (not (number? (.window_group hints))) (snd-display #__line__ ";window_group: ~A" (.window_group hints)))
+ (XtFree (cadr hints))
+ (let ((st (XAllocWMHints)))
+ (if (not (XWMHints? st)) (snd-display #__line__ ";XAllocWMHints: ~A" st))
+ (XFree st))))
+
+ (if (not (IsKeypadKey (list 'KeySym XK_KP_Space))) (snd-display #__line__ ";IsKeypadKey kp-space"))
+ (if (IsKeypadKey (list 'KeySym XK_A)) (snd-display #__line__ ";IsKeypadKey A"))
+ (if (IsPrivateKeypadKey (list 'KeySym XK_A)) (snd-display #__line__ ";IsPrivateKeypadKey A"))
+ (if (not (IsCursorKey (list 'KeySym XK_Home))) (snd-display #__line__ ";IsCursorKey Home"))
+ (if (IsCursorKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsCursorKey S"))
+ (if (not (IsPFKey (list 'KeySym XK_KP_F1))) (snd-display #__line__ ";IsPFKey F1"))
+ (if (IsPFKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsPFKey S"))
+ (if (not (IsFunctionKey (list 'KeySym XK_F1))) (snd-display #__line__ ";IsFunctionKey F1"))
+ (if (IsFunctionKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsFunctionKey S"))
+ (if (not (IsMiscFunctionKey (list 'KeySym XK_Select))) (snd-display #__line__ ";IsMiscFunctionKey Select"))
+ (if (IsMiscFunctionKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsMiscFunctionKey S"))
+ (if (not (IsModifierKey (list 'KeySym XK_Shift_L))) (snd-display #__line__ ";IsModifierKey Shift"))
+ (if (IsModifierKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsModifierKey S"))
+
+ (let* ((scr (current-screen))
+ (scrn (XScreenNumberOfScreen scr))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (val (XGCValues))
+ (wn (XtWindow (cadr (main-widgets)))))
+ (set! (.function val) GXclear)
+ (if (not (equal? (.function val) GXclear))
+ (snd-display #__line__ ";function: ~A ~A" (.function val) GXclear))
+ (set! (.line_width val) 10)
+ (if (not (equal? (.line_width val) 10))
+ (snd-display #__line__ ";line_width: ~A ~A" (.line_width val) 10))
+ (set! (.line_style val) LineSolid)
+ (if (not (equal? (.line_style val) LineSolid))
+ (snd-display #__line__ ";line_style: ~A ~A" (.line_style val) LineSolid))
+ (set! (.background val) (WhitePixelOfScreen (current-screen)))
+ (if (not (equal? (.background val) (WhitePixelOfScreen (current-screen))))
+ (snd-display #__line__ ";background: ~A ~A" (.background val) (WhitePixelOfScreen (current-screen))))
+ (set! (.foreground val) (BlackPixelOfScreen (current-screen)))
+ (if (not (equal? (.foreground val) (BlackPixelOfScreen (current-screen))))
+ (snd-display #__line__ ";foreground: ~A ~A" (.foreground val) (BlackPixelOfScreen (current-screen))))
+ ;; plane_mask?
+ (set! (.cap_style val) CapRound)
+ (if (not (equal? (.cap_style val) CapRound))
+ (snd-display #__line__ ";cap_style: ~A ~A" (.cap_style val) CapRound))
+ (set! (.join_style val) JoinMiter)
+ (if (not (equal? (.join_style val) JoinMiter))
+ (snd-display #__line__ ";join_style: ~A ~A" (.join_style val) JoinMiter))
+ (set! (.fill_style val) FillSolid)
+ (if (not (equal? (.fill_style val) FillSolid))
+ (snd-display #__line__ ";fill_style: ~A ~A" (.fill_style val) FillSolid))
+ (set! (.fill_rule val) EvenOddRule)
+ (if (not (equal? (.fill_rule val) EvenOddRule))
+ (snd-display #__line__ ";fill_rule: ~A ~A" (.fill_rule val) EvenOddRule))
+ (set! (.arc_mode val) ArcChord)
+ (if (not (equal? (.arc_mode val) ArcChord))
+ (snd-display #__line__ ";arc_mode: ~A ~A" (.arc_mode val) ArcChord))
+ ;; tile stipple clip_mask are Pixmaps
+ (set! (.ts_x_origin val) 1)
+ (if (not (equal? (.ts_x_origin val) 1))
+ (snd-display #__line__ ";ts_x_origin: ~A ~A" (.ts_x_origin val) 1))
+ (set! (.ts_y_origin val) 1)
+ (if (not (equal? (.ts_y_origin val) 1))
+ (snd-display #__line__ ";ts_y_origin: ~A ~A" (.ts_y_origin val) 1))
+ ;; font is Font
+ (set! (.subwindow_mode val) ClipByChildren)
+ (if (not (equal? (.subwindow_mode val) ClipByChildren))
+ (snd-display #__line__ ";subwindow_mode: ~A ~A" (.subwindow_mode val) ClipByChildren))
+ (set! (.graphics_exposures val) #f)
+ (if (not (equal? (.graphics_exposures val) #f))
+ (snd-display #__line__ ";graphics_exposures: ~A ~A" (.graphics_exposures val) #f))
+ (set! (.clip_x_origin val) 0)
+ (if (not (equal? (.clip_x_origin val) 0))
+ (snd-display #__line__ ";clip_x_origin: ~A ~A" (.clip_x_origin val) 0))
+ (set! (.clip_y_origin val) 0)
+ (if (not (equal? (.clip_y_origin val) 0))
+ (snd-display #__line__ ";clip_y_origin: ~A ~A" (.clip_y_origin val) 0))
+ (set! (.dash_offset val) 1)
+ (if (not (equal? (.dash_offset val) 1))
+ (snd-display #__line__ ";dash_offset: ~A ~A" (.dash_offset val) 1))
+ (if (not (number? (XConnectionNumber dpy)))
+ (snd-display #__line__ ";XConnectionNumber: ~A" (XConnectionNumber dpy)))
+
+ (let ((sgc (XCreateGC dpy wn (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
+ GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
+ GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
+ GCClipYOrigin GCDashOffset GCArcMode)
+ val)))
+
+ (if (not (GC? sgc)) (snd-display #__line__ ";XCreateGC returned ~A" sgc))
+ (XSetArcMode dpy sgc ArcPieSlice)
+ (XSetFunction dpy sgc GXcopy)
+ (XSetLineAttributes dpy sgc 3 LineDoubleDash CapButt JoinMiter)
+ (XSetClipOrigin dpy sgc 1 1)
+ (XSetTSOrigin dpy sgc 0 0)
+ (XSetFillRule dpy sgc WindingRule)
+ (XSetFillStyle dpy sgc FillStippled)
+ (XSetForeground dpy sgc (WhitePixelOfScreen (current-screen)))
+ (XSetBackground dpy sgc (BlackPixelOfScreen (current-screen)))
+ (XSetGraphicsExposures dpy sgc #t)
+ (XSetSubwindowMode dpy sgc IncludeInferiors)
+ (let ((owner (XGetSelectionOwner dpy XA_PRIMARY)))
+ (if (and owner (not (Window? owner)))
+ (snd-display #__line__ ";XGetSelectionOwner: ~A" owner)))
+ (let ((mods (XGetModifierMapping dpy)))
+ (if (not (XModifierKeymap? mods))
+ (snd-display #__line__ ";XGetModifierMapping: ~A" mods)))
+ (let ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0))))
+ (if (or (not vis)
+ (not (XVisualInfo? (car vis))))
+ (snd-display #__line__ ";XGetVisualInfo: ~A" vis))
+ (if (not (= (.depth (car vis)) 24)) (snd-display #__line__ ";depth vis: ~A" (.depth (car vis))))
+ (if (not (= (.screen (car vis)) 0)) (snd-display #__line__ ";screen vis: ~A" (.screen (car vis))))
+ (catch #t ; in c++ no class field
+ (lambda ()
+ (if (not (= (.class (car vis)) TrueColor)) (snd-display #__line__ ";class vis: ~A (~A)" (.class (car vis)) TrueColor)))
+ (lambda args args))
+ (if (not (= (.colormap_size (car vis)) 256)) (snd-display #__line__ ";colormap_size vis: ~A" (.colormap_size (car vis))))
+ (if (and (not (XVisualInfo? (XMatchVisualInfo dpy 0 24 TrueColor)))
+ (not (XVisualInfo? (XMatchVisualInfo dpy 0 16 TrueColor))))
+ (snd-display #__line__ ";XMatchVisualInfo: ~A" (XMatchVisualInfo dpy 0 24 TrueColor))))
+ (XCheckMaskEvent dpy KeyPressMask)
+
+ (let* ((vals (XGetGCValues dpy sgc (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
+ GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
+ GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
+ GCClipYOrigin GCDashOffset GCArcMode)))
+ (val1 (cadr vals)))
+ (if (= (car vals) 0)
+ (snd-display #__line__ ";XGetGCValues failed"))
+
+ (if (not (equal? (.function val1) GXcopy))
+ (snd-display #__line__ ";function: ~A ~A" (.function val1) GXcopy))
+ (if (not (equal? (.line_width val1) 3))
+ (snd-display #__line__ ";line_width: ~A ~A" (.line_width val1) 3))
+ (if (not (equal? (.line_style val1) LineDoubleDash))
+ (snd-display #__line__ ";line_style: ~A ~A" (.line_style val1) LineDoubleDash))
+ (if (not (equal? (.background val1) (BlackPixelOfScreen (current-screen))))
+ (snd-display #__line__ ";background: ~A ~A" (.background val1) (BlackPixelOfScreen (current-screen))))
+ (if (not (equal? (.foreground val1) (WhitePixelOfScreen (current-screen))))
+ (snd-display #__line__ ";foreground: ~A ~A" (.foreground val1) (WhitePixelOfScreen (current-screen))))
+ (if (not (equal? (.cap_style val1) CapButt))
+ (snd-display #__line__ ";cap_style: ~A ~A" (.cap_style val1) CapButt))
+ (if (not (equal? (.join_style val1) JoinMiter))
+ (snd-display #__line__ ";join_style: ~A ~A" (.join_style val1) JoinMiter))
+ (if (not (equal? (.fill_style val1) FillStippled))
+ (snd-display #__line__ ";fill_style: ~A ~A" (.fill_style val1) FillStippled))
+ (if (not (equal? (.fill_rule val1) WindingRule))
+ (snd-display #__line__ ";fill_rule: ~A ~A" (.fill_rule val1) WindingRule))
+ (if (not (equal? (.arc_mode val1) ArcPieSlice))
+ (snd-display #__line__ ";arc_mode: ~A ~A" (.arc_mode val1) ArcPieSlice))
+ (if (not (equal? (.ts_x_origin val1) 0))
+ (snd-display #__line__ ";ts_x_origin: ~A ~A" (.ts_x_origin val1) 0))
+ (if (not (equal? (.ts_y_origin val1) 0))
+ (snd-display #__line__ ";ts_y_origin: ~A ~A" (.ts_y_origin val1) 0))
+ (if (not (equal? (.subwindow_mode val1) IncludeInferiors))
+ (snd-display #__line__ ";subwindow_mode: ~A ~A" (.subwindow_mode val1) IncludeInferiors))
+ (if (not (equal? (.graphics_exposures val1) #t))
+ (snd-display #__line__ ";graphics_exposures: ~A ~A" (.graphics_exposures val1) #t))
+ (if (not (equal? (.clip_x_origin val1) 1))
+ (snd-display #__line__ ";clip_x_origin: ~A ~A" (.clip_x_origin val1) 1))
+ (if (not (equal? (.clip_y_origin val1) 1))
+ (snd-display #__line__ ";clip_y_origin: ~A ~A" (.clip_y_origin val1) 1))
+ (if (not (equal? (.dash_offset val1) 1))
+ (snd-display #__line__ ";dash_offset: ~A ~A" (.dash_offset val1) 1))
+
+ (set! (.plane_mask val) 0)
+ (if (not (equal? (.plane_mask val) 0))
+ (snd-display #__line__ ";plane_mask: ~A ~A" (.plane_mask val) 0))
+ (set! (.tile val) (list 'Pixmap 0))
+ (if (not (equal? (.tile val) (list 'Pixmap 0)))
+ (snd-display #__line__ ";tile: ~A" (.tile val)))
+ (set! (.stipple val) (list 'Pixmap 0))
+ (if (not (equal? (.stipple val) (list 'Pixmap 0)))
+ (snd-display #__line__ ";stipple: ~A" (.stipple val)))
+
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets))))
+ (attr (XSetWindowAttributes #f (basic-color) #f (highlight-color)))
+ (newwin (XCreateWindow dpy win 10 10 100 100 3
+ CopyFromParent InputOutput (list 'Visual CopyFromParent)
+ (logior CWBackPixel CWBorderPixel)
+ attr)))
+ (if (not (= (.do_not_propagate_mask attr) 0)) (snd-display #__line__ ";do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
+ (if (not (= (.event_mask attr) 0)) (snd-display #__line__ ";event_mask: ~A" (.event_mask attr)))
+ (if (not (Pixel? (.backing_pixel attr))) (snd-display #__line__ ";backing_pixel: ~A" (.backing_pixel attr)))
+ (if (not (Pixel? (.border_pixel attr))) (snd-display #__line__ ";border_pixel: ~A" (.border_pixel attr)))
+ (if (not (= (cadr (.border_pixmap attr)) 0)) (snd-display #__line__ ";border_pixmap: ~A" (.border_pixmap attr)))
+ (if (not (Pixel? (.background_pixel attr))) (snd-display #__line__ ";background_pixel: ~A" (.background_pixel attr)))
+ (if (not (= (cadr (.background_pixmap attr)) 0)) (snd-display #__line__ ";background_pixmap: ~A" (.background_pixmap attr)))
+ (if (not (= (.backing_planes attr) 0)) (snd-display #__line__ ";backing_planes: ~A" (.backing_planes attr)))
+ (if (.save_under attr) (snd-display #__line__ ";save_under: ~A" (.save_under attr)))
+ (if (not (= (cadr (.cursor attr)) 0)) (snd-display #__line__ ";cursor: ~A" (.cursor attr)))
+ (if (not (Window? newwin)) (snd-display #__line__ ";XCreateWindow: ~A" newwin))
+ (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";bit_gravity: ~A" (.bit_gravity attr)))
+ (XChangeWindowAttributes dpy newwin CWBackPixel (XSetWindowAttributes #f (basic-color)))
+ (XDestroyWindow dpy newwin)
+ (set! newwin (XCreateSimpleWindow dpy win 10 10 100 100 3 (basic-color) (highlight-color)))
+ (XDestroyWindow dpy newwin))
+
+ (XSetRegion dpy sgc (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule))
+ (let ((pix (make-pixmap (cadr (main-widgets)) arrow-strs)))
+ (if (not (Pixmap? pix))
+ (snd-display #__line__ ";make-pixmap?")
+ (begin
+ (XSetTile dpy sgc pix)
+ (XSetStipple dpy sgc (XCreateBitmapFromData dpy wn right-arrow 16 12))
+ (XSetClipMask dpy sgc None)
+ (XSetState dpy sgc (basic-color) (mark-color) GXcopy 0)
+ (XSetPlaneMask dpy sgc 0)
+ (XSetDashes dpy sgc 0 '(3 4 3 1))
+ (XSetClipRectangles dpy sgc 0 0 (list (XRectangle 0 0 10 10) (XRectangle 10 10 100 100)) 2 Unsorted)
+ (let ((err (XWriteBitmapFile dpy "testx.data" pix 16 12 -1 -1)))
+ (if (not (= BitmapSuccess err)) (snd-display #__line__ ";XWriteBitmapFile: ~A" err)))
;(let ((vals (XReadBitmapFile dpy (XtWindow (cadr (main-widgets))) "testx.data")))
- ; (if (not (= (car vals BitmapSuccess))) (snd-display ";XReadBitmapFile: ~A" vals)))
+ ; (if (not (= (car vals BitmapSuccess))) (snd-display #__line__ ";XReadBitmapFile: ~A" vals)))
;(let ((vals (XReadBitmapFileData "testx.data")))
- ; (if (not (= (car vals BitmapSuccess))) (snd-display ";XReadBitmapFileData: ~A" vals)))
-
- (let* ((fid (XLoadFont dpy "cursor"))
- (col (XColor))
- (col1 (XColor))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr)))
- (XAllocNamedColor dpy cmap "blue" col col)
- (XAllocNamedColor dpy cmap "green" col1 col1)
- (let ((vals (XCreateGlyphCursor dpy fid None XC_dot 0 col col1)))
- (if (not (Cursor? vals)) (snd-display ";XCreateGlyphCursor: ~A" vals)))
- (let ((vals (XCreatePixmapCursor dpy pix None col col1 5 5)))
- (if (not (Cursor? vals)) (snd-display ";XCreatePixmapCursor: ~A" vals))
- (XRecolorCursor dpy vals col1 col))
- (XAllocColorPlanes dpy cmap #f 2 1 1 1)
- (XAllocColorCells dpy cmap #f 1 1))
-
-
- )))
- (let* ((fid (XLoadFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
- (fnt (XLoadQueryFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
- (chs (XQueryTextExtents dpy fid "hiho"))
- (struct (list-ref chs 4))
- (fnt1 (XQueryFont dpy fid)))
- (if (not (Font? fid)) (snd-display ";XLoadFont: ~A" fid))
- (if (not (XFontStruct? fnt)) (snd-display ";XLoadQueryFont: ~A" fnt))
- (if (not (XFontStruct? fnt1)) (snd-display ";XQueryFont: ~A" fnt1))
- (if (not (XCharStruct? struct)) (snd-display ";XQueryTextExtents: ~A" chs))
- (if (not (= (list-ref chs 2) 12)) (snd-display ";XQueryTextExtents max ascent: ~A" (list-ref chs 2)))
- (if (not (= (list-ref chs 3) 3)) (snd-display ";XQueryTextExtents max descent: ~A" (list-ref chs 3)))
- (if (not (= (.lbearing struct) 0)) (snd-display ";lbearing: ~A" (.lbearing struct)))
- (if (not (= (.rbearing struct) 23)) (snd-display ";rbearing: ~A" (.rbearing struct)))
- (if (not (= (.width struct) 24)) (snd-display ";width: ~A" (.width struct)))
- (if (not (= (.ascent struct) 10)) (snd-display ";ascent: ~A" (.ascent struct)))
- (if (not (= (.descent struct) 0)) (snd-display ";descent: ~A" (.descent struct)))
- (if (not (= (.attributes struct) 0)) (snd-display ";attributes: ~A" (.attributes struct)))
- (let ((fid (load-font "-*-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*")))
- (if (not (Font? fid)) (snd-display ";load-font -> ~A" fid)))
- )
- (XFreeGC (XtDisplay (cadr (main-widgets))) sgc)
- )))
-
- (let ((atoms (list XA_PRIMARY XA_SECONDARY XA_ARC XA_ATOM XA_BITMAP XA_CARDINAL XA_COLORMAP XA_CURSOR XA_CUT_BUFFER0
- XA_CUT_BUFFER1 XA_CUT_BUFFER2 XA_CUT_BUFFER3 XA_CUT_BUFFER4 XA_CUT_BUFFER5 XA_CUT_BUFFER6
- XA_CUT_BUFFER7 XA_DRAWABLE XA_FONT XA_INTEGER XA_PIXMAP XA_POINT XA_RECTANGLE XA_RESOURCE_MANAGER
- XA_RGB_COLOR_MAP XA_RGB_BEST_MAP XA_RGB_BLUE_MAP XA_RGB_DEFAULT_MAP XA_RGB_GRAY_MAP XA_RGB_GREEN_MAP
- XA_RGB_RED_MAP XA_STRING XA_VISUALID XA_WINDOW XA_WM_COMMAND XA_WM_HINTS XA_WM_CLIENT_MACHINE
- XA_WM_ICON_NAME XA_WM_ICON_SIZE XA_WM_NAME XA_WM_NORMAL_HINTS XA_WM_SIZE_HINTS XA_WM_ZOOM_HINTS
- XA_MIN_SPACE XA_NORM_SPACE XA_MAX_SPACE XA_END_SPACE XA_SUPERSCRIPT_X XA_SUPERSCRIPT_Y
- XA_SUBSCRIPT_X XA_SUBSCRIPT_Y XA_UNDERLINE_POSITION XA_UNDERLINE_THICKNESS XA_STRIKEOUT_ASCENT
- XA_STRIKEOUT_DESCENT XA_ITALIC_ANGLE XA_X_HEIGHT XA_QUAD_WIDTH XA_WEIGHT XA_POINT_SIZE
- XA_RESOLUTION XA_COPYRIGHT XA_NOTICE XA_FONT_NAME XA_FAMILY_NAME XA_FULL_NAME XA_CAP_HEIGHT
- XA_WM_CLASS XA_WM_TRANSIENT_FOR))
- (atom-names (list 'XA_PRIMARY 'XA_SECONDARY 'XA_ARC 'XA_ATOM 'XA_BITMAP 'XA_CARDINAL 'XA_COLORMAP 'XA_CURSOR 'XA_CUT_BUFFER0
- 'XA_CUT_BUFFER1 'XA_CUT_BUFFER2 'XA_CUT_BUFFER3 'XA_CUT_BUFFER4 'XA_CUT_BUFFER5 'XA_CUT_BUFFER6
- 'XA_CUT_BUFFER7 'XA_DRAWABLE 'XA_FONT 'XA_INTEGER 'XA_PIXMAP 'XA_POINT 'XA_RECTANGLE 'XA_RESOURCE_MANAGER
- 'XA_RGB_COLOR_MAP 'XA_RGB_BEST_MAP 'XA_RGB_BLUE_MAP 'XA_RGB_DEFAULT_MAP 'XA_RGB_GRAY_MAP 'XA_RGB_GREEN_MAP
- 'XA_RGB_RED_MAP 'XA_STRING 'XA_VISUALID 'XA_WINDOW 'XA_WM_COMMAND 'XA_WM_HINTS 'XA_WM_CLIENT_MACHINE
- 'XA_WM_ICON_NAME 'XA_WM_ICON_SIZE 'XA_WM_NAME 'XA_WM_NORMAL_HINTS 'XA_WM_SIZE_HINTS 'XA_WM_ZOOM_HINTS
- 'XA_MIN_SPACE 'XA_NORM_SPACE 'XA_MAX_SPACE 'XA_END_SPACE 'XA_SUPERSCRIPT_X 'XA_SUPERSCRIPT_Y
- 'XA_SUBSCRIPT_X 'XA_SUBSCRIPT_Y 'XA_UNDERLINE_POSITION 'XA_UNDERLINE_THICKNESS 'XA_STRIKEOUT_ASCENT
- 'XA_STRIKEOUT_DESCENT 'XA_ITALIC_ANGLE 'XA_X_HEIGHT 'XA_QUAD_WIDTH 'XA_WEIGHT 'XA_POINT_SIZE
- 'XA_RESOLUTION 'XA_COPYRIGHT 'XA_NOTICE 'XA_FONT_NAME 'XA_FAMILY_NAME 'XA_FULL_NAME 'XA_CAP_HEIGHT
- 'XA_WM_CLASS 'XA_WM_TRANSIENT_FOR)))
- (for-each
- (lambda (n name)
- (if (not (Atom? n))
- (snd-display ";Atom: ~A -> ~A" name (Atom? n))))
- atoms
- atom-names))
-
- (let ((r (XRectangle 10 20 100 110)))
- (if (not (= (.width r) 100))
- (snd-display ";XRectangle width: ~A" (.width r)))
- (if (not (= (.height r) 110))
- (snd-display ";XRectangle height: ~A" (.height r)))
- (if (not (= (.x r) 10))
- (snd-display ";XRectangle x: ~A" (.x r)))
- (if (not (= (.y r) 20))
- (snd-display ";XRectangle y: ~A" (.y r)))
- (set! (.width r) 10)
- (if (not (= (.width r) 10))
- (snd-display ";set XRectangle width: ~A" (.width r)))
- (set! (.height r) 11)
- (if (not (= (.height r) 11))
- (snd-display ";set XRectangle height: ~A" (.height r)))
- (set! (.x r) 1)
- (if (not (= (.x r) 1))
- (snd-display ";set XRectangle x: ~A" (.x r)))
- (set! (.y r) 2)
- (if (not (= (.y r) 2))
- (snd-display ";XRectangle y: ~A" (.y r))))
-
- (let ((r (XArc 10 20 100 110 0 235)))
- (if (not (= (.width r) 100))
- (snd-display ";XArc width: ~A" (.width r)))
- (if (not (= (.height r) 110))
- (snd-display ";XArc height: ~A" (.height r)))
- (if (not (= (.x r) 10))
- (snd-display ";XArc x: ~A" (.x r)))
- (if (not (= (.y r) 20))
- (snd-display ";XArc y: ~A" (.y r)))
- (if (not (= (.angle1 r) 0))
- (snd-display ";XArc angle1: ~A" (.angle1 r)))
- (if (not (= (.angle2 r) 235))
- (snd-display ";XArc angle2: ~A" (.angle2 r)))
- (set! (.width r) 10)
- (if (not (= (.width r) 10))
- (snd-display ";set XArc width: ~A" (.width r)))
- (set! (.height r) 11)
- (if (not (= (.height r) 11))
- (snd-display ";set XArc height: ~A" (.height r)))
- (set! (.x r) 1)
- (if (not (= (.x r) 1))
- (snd-display ";set XArc x: ~A" (.x r)))
- (set! (.y r) 2)
- (if (not (= (.y r) 2))
- (snd-display ";set XArc y: ~A" (.y r)))
- (set! (.angle1 r) 123)
- (if (not (= (.angle1 r) 123))
- (snd-display ";set XArc angle1: ~A" (.angle1 r)))
- (set! (.angle2 r) 321)
- (if (not (= (.angle2 r) 321))
- (snd-display ";set XArc angle2: ~A" (.angle2 r))))
-
- (let ((r (XPoint 10 20)))
- (if (not (= (.x r) 10))
- (snd-display ";XPoint x: ~A" (.x r)))
- (if (not (= (.y r) 20))
- (snd-display ";XPoint y: ~A" (.y r)))
- (set! (.x r) 1)
- (if (not (= (.x r) 1))
- (snd-display ";set XPoint x: ~A" (.x r)))
- (set! (.y r) 2)
- (if (not (= (.y r) 2))
- (snd-display ";set XPoint y: ~A" (.y r))))
-
- (let ((r (XSegment 10 20 100 110)))
- (if (not (= (.x1 r) 10))
- (snd-display ";XSegment x1: ~A" (.x1 r)))
- (if (not (= (.y1 r) 20))
- (snd-display ";XSegment y1: ~A" (.y1 r)))
- (if (not (= (.x2 r) 100))
- (snd-display ";XSegment x2: ~A" (.x2 r)))
- (if (not (= (.y2 r) 110))
- (snd-display ";XSegment y2: ~A" (.y2 r)))
- (set! (.x1 r) 1)
- (if (not (= (.x1 r) 1))
- (snd-display ";set XSegment x1: ~A" (.x1 r)))
- (set! (.y1 r) 2)
- (if (not (= (.y1 r) 2))
- (snd-display ";set XSegment y1: ~A" (.y1 r)))
- (set! (.x2 r) 10)
- (if (not (= (.x2 r) 10))
- (snd-display ";set XSegment x2: ~A" (.x2 r)))
- (set! (.y2 r) 11)
- (if (not (= (.y2 r) 11))
- (snd-display ";set XSegment y2: ~A" (.y2 r))))
-
- (let ((c (XColor)))
- (set! (.red c) 1)
- (if (not (= (.red c) 1)) (snd-display ";Xcolor red: ~A" (.red c)))
- (set! (.green c) 1)
- (if (not (= (.green c) 1)) (snd-display ";Xcolor green: ~A" (.green c)))
- (set! (.blue c) 1)
- (if (not (= (.blue c) 1)) (snd-display ";Xcolor blue: ~A" (.blue c)))
- (set! (.flags c) DoRed)
- (if (not (= (.flags c) DoRed)) (snd-display ";Xcolor flags: ~A" (.flags c)))
- (if (not (= (.pad c) 0)) (snd-display ";pad: ~A" (.pad c)))
- (set! (.pixel c) (basic-color))
- (if (not (equal? (.pixel c) (basic-color))) (snd-display ";Xcolor pixel: ~A" (.pixel c))))
-
- (let ((obj (XTextItem "hiho" 4 3 (list 'Font 1))))
- (if (not (XTextItem? obj)) (snd-display ";XTextItem -> ~A" obj))
- (if (not (equal? (.font obj) (list 'Font 1))) (snd-display ";font ~A" (.font obj)))
- (set! (.font obj) (list 'Font 2))
- (if (not (equal? (.font obj) (list 'Font 2))) (snd-display ";set font ~A" (.font obj)))
- (if (not (string=? (.chars obj) "hiho")) (snd-display ";chars: ~A" (.chars obj)))
- (if (not (= (.nchars obj) 4)) (snd-display ";chars: ~A" (.nchars obj)))
- (set! (.chars obj) "away!")
- (set! (.nchars obj) 5)
- (if (not (string=? (.chars obj) "away!")) (snd-display ";set chars: ~A" (.chars obj)))
- (if (not (= (.nchars obj) 5)) (snd-display ";set chars: ~A" (.nchars obj)))
- (if (not (= (.delta obj) 3)) (snd-display ";delta ~A" (.delta obj)))
- (set! (.delta obj) 4)
- (if (not (= (.delta obj) 4)) (snd-display ";set delta ~A" (.delta obj)))
- )
-
- (let ((reg (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule)))
- (if (not (XPointInRegion reg 4 4)) (snd-display ";XPointInRegion"))
- (XShrinkRegion reg 1 2)
- (if (not (XPointInRegion reg 4 7)) (snd-display ";t XShrinkRegion"))
- (if (XPointInRegion reg 4 9) (snd-display ";f XShrinkRegion"))
- (XOffsetRegion reg 1 2)
- (if (not (XPointInRegion reg 4 9)) (snd-display ";t XOffsetRegion"))
- (if (XPointInRegion reg 1 9) (snd-display ";f XOffsetRegion"))
- (let ((reg2 (XCreateRegion))
- (reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
- (if (XEqualRegion reg reg1) (snd-display ";f XEqualRegion"))
- (if (XEmptyRegion reg) (snd-display ";f XEmptyRegion"))
- (XXorRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 2)))
- (snd-display ";XXorRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XUnionRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 8)))
- (snd-display ";XUnionRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XSubtractRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 0))
- (not (= (.y (cadr box)) 0))
- (not (= (.width (cadr box)) 0))
- (not (= (.height (cadr box)) 0)))
- (snd-display ";XSubtractRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XIntersectRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 4))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 6)))
- (snd-display ";XIntersectRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XUnionRectWithRegion (XRectangle 1 3 100 100) reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 1))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 100))
- (not (= (.height (cadr box)) 101)))
- (snd-display ";XUnionRectWithRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XRectInRegion reg 0 0 100 100)
- (let ((box (XClipBox reg1)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 8)))
- (snd-display ";XClipBox: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XDestroyRegion reg1)
- ))
-
- (let ((xid (XUniqueContext))
- (dpy (XtDisplay (cadr (main-widgets)))))
- (if (not (eq? (car xid) 'XContext))
- (snd-display ";XUniqueContext: ~A" xid))
- (XSaveContext dpy 123 xid "hiho")
- (let ((val (XFindContext dpy 123 xid)))
- (if (or (not (= 0 (car val)))
- (not (string=? (cadr val) "hiho")))
- (snd-display ";XFindContext: ~A" val)))
- (XDeleteContext dpy 123 xid)
- (XStoreBytes dpy "hiho" 4)
- (if (not (string=? (XFetchBytes dpy) "hiho")) (snd-display ";XStoreBytes: ~A" (XFetchBytes dpy)))
- (XStoreBuffer dpy "hiho" 4 1)
- (if (not (string=? (XFetchBuffer dpy 1) "hiho")) (snd-display ";XStoreBuffer: ~A" (XFetchBuffer dpy)))
- )
-
-
- ;; ---------------- Xt tests ----------------
- (let ((name (XtGetApplicationNameAndClass (XtDisplay (cadr (main-widgets))))))
- (if (not (equal? name (list "snd" "Snd")))
- (snd-display ";XtGetApplicationNameAndClass: ~A?" name)))
- (let ((dpys (XtGetDisplays (car (main-widgets)))))
- (if (not (Display? (car dpys)))
- (snd-display ";XtGetDisplays: ~A?" dpys)))
- (let ((app (XtDisplayToApplicationContext (XtDisplay (cadr (main-widgets)))))
- (orig (car (main-widgets)))
- (wid (XtWidgetToApplicationContext (cadr (main-widgets)))))
- (if (not (equal? app orig))
- (snd-display ";XtDisplayToApplicationContext: ~A ~A?" app orig))
- (if (not (equal? app wid))
- (snd-display ";XtWidgetToApplicationContext: ~A ~A?" app wid)))
- (if (not (string=? (XtName (caddr (main-widgets))) "mainpane"))
- (snd-display ";XtName main pane: ~A" (XtName (caddr (main-widgets)))))
- (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 200))
- (snd-display ";XtGetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
- (XtSetMultiClickTime (XtDisplay (cadr (main-widgets))) 250)
- (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 250))
- (snd-display ";XtSetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
- (XtGetResourceList xmListWidgetClass)
- (let ((wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass (cadr (main-widgets)) '())))
- (XtDestroyWidget wid1))
-
- (let ((hook-id (XtAppAddActionHook
- (car (main-widgets))
- (lambda (w data name e p)
- (display (format #f "~A ~A ~A ~A ~A~%" w data name e p)))
- #f)))
- (XtRemoveActionHook hook-id))
-
- (let* ((shell (cadr (main-widgets)))
- (wid (XtCreateWidget "wid" xmFormWidgetClass shell '()))
- (wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass wid '()))
- (wid2 (XtVaCreateWidget "wid" xmFormWidgetClass shell '())))
- (if (XtIsApplicationShell wid) (snd-display ";XtIsApplicationShell"))
- (if (not (XtIsApplicationShell shell)) (snd-display ";XtIsApplicationShell of appshell"))
- (if (not (XtIsComposite wid)) (snd-display ";XtIsComposite"))
- (if (not (XtIsConstraint wid)) (snd-display ";XtIsConstraint"))
- (if (XtIsManaged wid) (snd-display ";XtIsManaged"))
- (if (not (XtIsObject wid)) (snd-display ";XtIsObject"))
- (if (XtIsOverrideShell wid) (snd-display ";XtIsOverrideShell"))
- (if (XtIsRealized wid) (snd-display ";XtIsRealized"))
- (if (not (XtIsRealized shell)) (snd-display ";XtIsRealized main shell"))
- (if (not (XtIsRectObj wid)) (snd-display ";XtIsRectObj"))
- (if (not (XtIsSensitive wid)) (snd-display ";XtIsSensitive"))
- (if (not (XtIsSensitive shell)) (snd-display ";XtIsSensitive of main shell"))
- (XtSetSensitive wid1 #t)
- (if (not (XtIsSensitive wid1)) (snd-display ";XtIsSensitive of button"))
- (if (XtIsSessionShell wid) (snd-display ";XtIsSessionShell"))
- (if (XtIsShell wid) (snd-display ";XtIsShell"))
- (if (not (XtIsShell shell)) (snd-display ";XtIsShell of main shell"))
- (if (XtIsTopLevelShell wid) (snd-display ";XtIsTopLevelShell"))
- (if (not (XtIsTopLevelShell shell)) (snd-display ";XtIsTopLevelShell of main shell"))
- (if (XtIsTransientShell wid) (snd-display ";XtIsTransientShell"))
- (if (XtIsVendorShell wid) (snd-display ";XtIsVendorShell"))
- (if (not (XtIsVendorShell shell)) (snd-display ";XtIsVendorShell of main shell"))
- (if (XtIsWMShell wid) (snd-display ";XtIsWMShell"))
- (if (not (XtIsWidget wid)) (snd-display ";XtIsWidget"))
- (XtRealizeWidget wid)
- (if (not (XtIsRealized wid)) (snd-display ";XtRealizeWidget?"))
- (XtAddGrab shell #f #f)
- (XtRemoveGrab shell)
- (XtMakeResizeRequest wid 200 200)
- (XtMapWidget wid)
- (XtUnmapWidget wid)
- (XtUnrealizeWidget wid)
+ ; (if (not (= (car vals BitmapSuccess))) (snd-display #__line__ ";XReadBitmapFileData: ~A" vals)))
+
+ (let* ((fid (XLoadFont dpy "cursor"))
+ (col (XColor))
+ (col1 (XColor))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr)))
+ (XAllocNamedColor dpy cmap "blue" col col)
+ (XAllocNamedColor dpy cmap "green" col1 col1)
+ (let ((vals (XCreateGlyphCursor dpy fid None XC_dot 0 col col1)))
+ (if (not (Cursor? vals)) (snd-display #__line__ ";XCreateGlyphCursor: ~A" vals)))
+ (let ((vals (XCreatePixmapCursor dpy pix None col col1 5 5)))
+ (if (not (Cursor? vals)) (snd-display #__line__ ";XCreatePixmapCursor: ~A" vals))
+ (XRecolorCursor dpy vals col1 col))
+ (XAllocColorPlanes dpy cmap #f 2 1 1 1)
+ (XAllocColorCells dpy cmap #f 1 1))
+
+
+ )))
+ (let* ((fid (XLoadFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
+ (fnt (XLoadQueryFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
+ (chs (XQueryTextExtents dpy fid "hiho"))
+ (struct (list-ref chs 4))
+ (fnt1 (XQueryFont dpy fid)))
+ (if (not (Font? fid)) (snd-display #__line__ ";XLoadFont: ~A" fid))
+ (if (not (XFontStruct? fnt)) (snd-display #__line__ ";XLoadQueryFont: ~A" fnt))
+ (if (not (XFontStruct? fnt1)) (snd-display #__line__ ";XQueryFont: ~A" fnt1))
+ (if (not (XCharStruct? struct)) (snd-display #__line__ ";XQueryTextExtents: ~A" chs))
+ (if (not (= (list-ref chs 2) 12)) (snd-display #__line__ ";XQueryTextExtents max ascent: ~A" (list-ref chs 2)))
+ (if (not (= (list-ref chs 3) 3)) (snd-display #__line__ ";XQueryTextExtents max descent: ~A" (list-ref chs 3)))
+ (if (not (= (.lbearing struct) 0)) (snd-display #__line__ ";lbearing: ~A" (.lbearing struct)))
+ (if (not (= (.rbearing struct) 23)) (snd-display #__line__ ";rbearing: ~A" (.rbearing struct)))
+ (if (not (= (.width struct) 24)) (snd-display #__line__ ";width: ~A" (.width struct)))
+ (if (not (= (.ascent struct) 10)) (snd-display #__line__ ";ascent: ~A" (.ascent struct)))
+ (if (not (= (.descent struct) 0)) (snd-display #__line__ ";descent: ~A" (.descent struct)))
+ (if (not (= (.attributes struct) 0)) (snd-display #__line__ ";attributes: ~A" (.attributes struct)))
+ (let ((fid (load-font "-*-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*")))
+ (if (not (Font? fid)) (snd-display #__line__ ";load-font -> ~A" fid)))
+ )
+ (XFreeGC (XtDisplay (cadr (main-widgets))) sgc)
+ )))
+
+ (let ((atoms (list XA_PRIMARY XA_SECONDARY XA_ARC XA_ATOM XA_BITMAP XA_CARDINAL XA_COLORMAP XA_CURSOR XA_CUT_BUFFER0
+ XA_CUT_BUFFER1 XA_CUT_BUFFER2 XA_CUT_BUFFER3 XA_CUT_BUFFER4 XA_CUT_BUFFER5 XA_CUT_BUFFER6
+ XA_CUT_BUFFER7 XA_DRAWABLE XA_FONT XA_INTEGER XA_PIXMAP XA_POINT XA_RECTANGLE XA_RESOURCE_MANAGER
+ XA_RGB_COLOR_MAP XA_RGB_BEST_MAP XA_RGB_BLUE_MAP XA_RGB_DEFAULT_MAP XA_RGB_GRAY_MAP XA_RGB_GREEN_MAP
+ XA_RGB_RED_MAP XA_STRING XA_VISUALID XA_WINDOW XA_WM_COMMAND XA_WM_HINTS XA_WM_CLIENT_MACHINE
+ XA_WM_ICON_NAME XA_WM_ICON_SIZE XA_WM_NAME XA_WM_NORMAL_HINTS XA_WM_SIZE_HINTS XA_WM_ZOOM_HINTS
+ XA_MIN_SPACE XA_NORM_SPACE XA_MAX_SPACE XA_END_SPACE XA_SUPERSCRIPT_X XA_SUPERSCRIPT_Y
+ XA_SUBSCRIPT_X XA_SUBSCRIPT_Y XA_UNDERLINE_POSITION XA_UNDERLINE_THICKNESS XA_STRIKEOUT_ASCENT
+ XA_STRIKEOUT_DESCENT XA_ITALIC_ANGLE XA_X_HEIGHT XA_QUAD_WIDTH XA_WEIGHT XA_POINT_SIZE
+ XA_RESOLUTION XA_COPYRIGHT XA_NOTICE XA_FONT_NAME XA_FAMILY_NAME XA_FULL_NAME XA_CAP_HEIGHT
+ XA_WM_CLASS XA_WM_TRANSIENT_FOR))
+ (atom-names (list 'XA_PRIMARY 'XA_SECONDARY 'XA_ARC 'XA_ATOM 'XA_BITMAP 'XA_CARDINAL 'XA_COLORMAP 'XA_CURSOR 'XA_CUT_BUFFER0
+ 'XA_CUT_BUFFER1 'XA_CUT_BUFFER2 'XA_CUT_BUFFER3 'XA_CUT_BUFFER4 'XA_CUT_BUFFER5 'XA_CUT_BUFFER6
+ 'XA_CUT_BUFFER7 'XA_DRAWABLE 'XA_FONT 'XA_INTEGER 'XA_PIXMAP 'XA_POINT 'XA_RECTANGLE 'XA_RESOURCE_MANAGER
+ 'XA_RGB_COLOR_MAP 'XA_RGB_BEST_MAP 'XA_RGB_BLUE_MAP 'XA_RGB_DEFAULT_MAP 'XA_RGB_GRAY_MAP 'XA_RGB_GREEN_MAP
+ 'XA_RGB_RED_MAP 'XA_STRING 'XA_VISUALID 'XA_WINDOW 'XA_WM_COMMAND 'XA_WM_HINTS 'XA_WM_CLIENT_MACHINE
+ 'XA_WM_ICON_NAME 'XA_WM_ICON_SIZE 'XA_WM_NAME 'XA_WM_NORMAL_HINTS 'XA_WM_SIZE_HINTS 'XA_WM_ZOOM_HINTS
+ 'XA_MIN_SPACE 'XA_NORM_SPACE 'XA_MAX_SPACE 'XA_END_SPACE 'XA_SUPERSCRIPT_X 'XA_SUPERSCRIPT_Y
+ 'XA_SUBSCRIPT_X 'XA_SUBSCRIPT_Y 'XA_UNDERLINE_POSITION 'XA_UNDERLINE_THICKNESS 'XA_STRIKEOUT_ASCENT
+ 'XA_STRIKEOUT_DESCENT 'XA_ITALIC_ANGLE 'XA_X_HEIGHT 'XA_QUAD_WIDTH 'XA_WEIGHT 'XA_POINT_SIZE
+ 'XA_RESOLUTION 'XA_COPYRIGHT 'XA_NOTICE 'XA_FONT_NAME 'XA_FAMILY_NAME 'XA_FULL_NAME 'XA_CAP_HEIGHT
+ 'XA_WM_CLASS 'XA_WM_TRANSIENT_FOR)))
+ (for-each
+ (lambda (n name)
+ (if (not (Atom? n))
+ (snd-display #__line__ ";Atom: ~A -> ~A" name (Atom? n))))
+ atoms
+ atom-names))
+
+ (let ((r (XRectangle 10 20 100 110)))
+ (if (not (= (.width r) 100))
+ (snd-display #__line__ ";XRectangle width: ~A" (.width r)))
+ (if (not (= (.height r) 110))
+ (snd-display #__line__ ";XRectangle height: ~A" (.height r)))
+ (if (not (= (.x r) 10))
+ (snd-display #__line__ ";XRectangle x: ~A" (.x r)))
+ (if (not (= (.y r) 20))
+ (snd-display #__line__ ";XRectangle y: ~A" (.y r)))
+ (set! (.width r) 10)
+ (if (not (= (.width r) 10))
+ (snd-display #__line__ ";set XRectangle width: ~A" (.width r)))
+ (set! (.height r) 11)
+ (if (not (= (.height r) 11))
+ (snd-display #__line__ ";set XRectangle height: ~A" (.height r)))
+ (set! (.x r) 1)
+ (if (not (= (.x r) 1))
+ (snd-display #__line__ ";set XRectangle x: ~A" (.x r)))
+ (set! (.y r) 2)
+ (if (not (= (.y r) 2))
+ (snd-display #__line__ ";XRectangle y: ~A" (.y r))))
+
+ (let ((r (XArc 10 20 100 110 0 235)))
+ (if (not (= (.width r) 100))
+ (snd-display #__line__ ";XArc width: ~A" (.width r)))
+ (if (not (= (.height r) 110))
+ (snd-display #__line__ ";XArc height: ~A" (.height r)))
+ (if (not (= (.x r) 10))
+ (snd-display #__line__ ";XArc x: ~A" (.x r)))
+ (if (not (= (.y r) 20))
+ (snd-display #__line__ ";XArc y: ~A" (.y r)))
+ (if (not (= (.angle1 r) 0))
+ (snd-display #__line__ ";XArc angle1: ~A" (.angle1 r)))
+ (if (not (= (.angle2 r) 235))
+ (snd-display #__line__ ";XArc angle2: ~A" (.angle2 r)))
+ (set! (.width r) 10)
+ (if (not (= (.width r) 10))
+ (snd-display #__line__ ";set XArc width: ~A" (.width r)))
+ (set! (.height r) 11)
+ (if (not (= (.height r) 11))
+ (snd-display #__line__ ";set XArc height: ~A" (.height r)))
+ (set! (.x r) 1)
+ (if (not (= (.x r) 1))
+ (snd-display #__line__ ";set XArc x: ~A" (.x r)))
+ (set! (.y r) 2)
+ (if (not (= (.y r) 2))
+ (snd-display #__line__ ";set XArc y: ~A" (.y r)))
+ (set! (.angle1 r) 123)
+ (if (not (= (.angle1 r) 123))
+ (snd-display #__line__ ";set XArc angle1: ~A" (.angle1 r)))
+ (set! (.angle2 r) 321)
+ (if (not (= (.angle2 r) 321))
+ (snd-display #__line__ ";set XArc angle2: ~A" (.angle2 r))))
+
+ (let ((r (XPoint 10 20)))
+ (if (not (= (.x r) 10))
+ (snd-display #__line__ ";XPoint x: ~A" (.x r)))
+ (if (not (= (.y r) 20))
+ (snd-display #__line__ ";XPoint y: ~A" (.y r)))
+ (set! (.x r) 1)
+ (if (not (= (.x r) 1))
+ (snd-display #__line__ ";set XPoint x: ~A" (.x r)))
+ (set! (.y r) 2)
+ (if (not (= (.y r) 2))
+ (snd-display #__line__ ";set XPoint y: ~A" (.y r))))
+
+ (let ((r (XSegment 10 20 100 110)))
+ (if (not (= (.x1 r) 10))
+ (snd-display #__line__ ";XSegment x1: ~A" (.x1 r)))
+ (if (not (= (.y1 r) 20))
+ (snd-display #__line__ ";XSegment y1: ~A" (.y1 r)))
+ (if (not (= (.x2 r) 100))
+ (snd-display #__line__ ";XSegment x2: ~A" (.x2 r)))
+ (if (not (= (.y2 r) 110))
+ (snd-display #__line__ ";XSegment y2: ~A" (.y2 r)))
+ (set! (.x1 r) 1)
+ (if (not (= (.x1 r) 1))
+ (snd-display #__line__ ";set XSegment x1: ~A" (.x1 r)))
+ (set! (.y1 r) 2)
+ (if (not (= (.y1 r) 2))
+ (snd-display #__line__ ";set XSegment y1: ~A" (.y1 r)))
+ (set! (.x2 r) 10)
+ (if (not (= (.x2 r) 10))
+ (snd-display #__line__ ";set XSegment x2: ~A" (.x2 r)))
+ (set! (.y2 r) 11)
+ (if (not (= (.y2 r) 11))
+ (snd-display #__line__ ";set XSegment y2: ~A" (.y2 r))))
+
+ (let ((c (XColor)))
+ (set! (.red c) 1)
+ (if (not (= (.red c) 1)) (snd-display #__line__ ";Xcolor red: ~A" (.red c)))
+ (set! (.green c) 1)
+ (if (not (= (.green c) 1)) (snd-display #__line__ ";Xcolor green: ~A" (.green c)))
+ (set! (.blue c) 1)
+ (if (not (= (.blue c) 1)) (snd-display #__line__ ";Xcolor blue: ~A" (.blue c)))
+ (set! (.flags c) DoRed)
+ (if (not (= (.flags c) DoRed)) (snd-display #__line__ ";Xcolor flags: ~A" (.flags c)))
+ (if (not (= (.pad c) 0)) (snd-display #__line__ ";pad: ~A" (.pad c)))
+ (set! (.pixel c) (basic-color))
+ (if (not (equal? (.pixel c) (basic-color))) (snd-display #__line__ ";Xcolor pixel: ~A" (.pixel c))))
+
+ (let ((obj (XTextItem "hiho" 4 3 (list 'Font 1))))
+ (if (not (XTextItem? obj)) (snd-display #__line__ ";XTextItem -> ~A" obj))
+ (if (not (equal? (.font obj) (list 'Font 1))) (snd-display #__line__ ";font ~A" (.font obj)))
+ (set! (.font obj) (list 'Font 2))
+ (if (not (equal? (.font obj) (list 'Font 2))) (snd-display #__line__ ";set font ~A" (.font obj)))
+ (if (not (string=? (.chars obj) "hiho")) (snd-display #__line__ ";chars: ~A" (.chars obj)))
+ (if (not (= (.nchars obj) 4)) (snd-display #__line__ ";chars: ~A" (.nchars obj)))
+ (set! (.chars obj) "away!")
+ (set! (.nchars obj) 5)
+ (if (not (string=? (.chars obj) "away!")) (snd-display #__line__ ";set chars: ~A" (.chars obj)))
+ (if (not (= (.nchars obj) 5)) (snd-display #__line__ ";set chars: ~A" (.nchars obj)))
+ (if (not (= (.delta obj) 3)) (snd-display #__line__ ";delta ~A" (.delta obj)))
+ (set! (.delta obj) 4)
+ (if (not (= (.delta obj) 4)) (snd-display #__line__ ";set delta ~A" (.delta obj)))
+ )
+
+ (let ((reg (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule)))
+ (if (not (XPointInRegion reg 4 4)) (snd-display #__line__ ";XPointInRegion"))
+ (XShrinkRegion reg 1 2)
+ (if (not (XPointInRegion reg 4 7)) (snd-display #__line__ ";t XShrinkRegion"))
+ (if (XPointInRegion reg 4 9) (snd-display #__line__ ";f XShrinkRegion"))
+ (XOffsetRegion reg 1 2)
+ (if (not (XPointInRegion reg 4 9)) (snd-display #__line__ ";t XOffsetRegion"))
+ (if (XPointInRegion reg 1 9) (snd-display #__line__ ";f XOffsetRegion"))
+ (let ((reg2 (XCreateRegion))
+ (reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
+ (if (XEqualRegion reg reg1) (snd-display #__line__ ";f XEqualRegion"))
+ (if (XEmptyRegion reg) (snd-display #__line__ ";f XEmptyRegion"))
+ (XXorRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 2)))
+ (snd-display #__line__ ";XXorRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XUnionRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 8)))
+ (snd-display #__line__ ";XUnionRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XSubtractRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 0))
+ (not (= (.y (cadr box)) 0))
+ (not (= (.width (cadr box)) 0))
+ (not (= (.height (cadr box)) 0)))
+ (snd-display #__line__ ";XSubtractRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XIntersectRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 4))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 6)))
+ (snd-display #__line__ ";XIntersectRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XUnionRectWithRegion (XRectangle 1 3 100 100) reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 1))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 100))
+ (not (= (.height (cadr box)) 101)))
+ (snd-display #__line__ ";XUnionRectWithRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XRectInRegion reg 0 0 100 100)
+ (let ((box (XClipBox reg1)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 8)))
+ (snd-display #__line__ ";XClipBox: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XDestroyRegion reg1)
+ ))
+
+ (let ((xid (XUniqueContext))
+ (dpy (XtDisplay (cadr (main-widgets)))))
+ (if (not (eq? (car xid) 'XContext))
+ (snd-display #__line__ ";XUniqueContext: ~A" xid))
+ (XSaveContext dpy 123 xid "hiho")
+ (let ((val (XFindContext dpy 123 xid)))
+ (if (or (not (= 0 (car val)))
+ (not (string=? (cadr val) "hiho")))
+ (snd-display #__line__ ";XFindContext: ~A" val)))
+ (XDeleteContext dpy 123 xid)
+ (XStoreBytes dpy "hiho" 4)
+ (if (not (string=? (XFetchBytes dpy) "hiho")) (snd-display #__line__ ";XStoreBytes: ~A" (XFetchBytes dpy)))
+ (XStoreBuffer dpy "hiho" 4 1)
+ (if (not (string=? (XFetchBuffer dpy 1) "hiho")) (snd-display #__line__ ";XStoreBuffer: ~A" (XFetchBuffer dpy)))
+ )
+
+
+ ;; ---------------- Xt tests ----------------
+ (let ((name (XtGetApplicationNameAndClass (XtDisplay (cadr (main-widgets))))))
+ (if (not (equal? name (list "snd" "Snd")))
+ (snd-display #__line__ ";XtGetApplicationNameAndClass: ~A?" name)))
+ (let ((dpys (XtGetDisplays (car (main-widgets)))))
+ (if (not (Display? (car dpys)))
+ (snd-display #__line__ ";XtGetDisplays: ~A?" dpys)))
+ (let ((app (XtDisplayToApplicationContext (XtDisplay (cadr (main-widgets)))))
+ (orig (car (main-widgets)))
+ (wid (XtWidgetToApplicationContext (cadr (main-widgets)))))
+ (if (not (equal? app orig))
+ (snd-display #__line__ ";XtDisplayToApplicationContext: ~A ~A?" app orig))
+ (if (not (equal? app wid))
+ (snd-display #__line__ ";XtWidgetToApplicationContext: ~A ~A?" app wid)))
+ (if (not (string=? (XtName (caddr (main-widgets))) "mainpane"))
+ (snd-display #__line__ ";XtName main pane: ~A" (XtName (caddr (main-widgets)))))
+ (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 200))
+ (snd-display #__line__ ";XtGetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
+ (XtSetMultiClickTime (XtDisplay (cadr (main-widgets))) 250)
+ (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 250))
+ (snd-display #__line__ ";XtSetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
+ (XtGetResourceList xmListWidgetClass)
+ (let ((wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass (cadr (main-widgets)) '())))
+ (XtDestroyWidget wid1))
+
+ (let ((hook-id (XtAppAddActionHook
+ (car (main-widgets))
+ (lambda (w data name e p)
+ (display (format #f "~A ~A ~A ~A ~A~%" w data name e p)))
+ #f)))
+ (XtRemoveActionHook hook-id))
+
+ (let* ((shell (cadr (main-widgets)))
+ (wid (XtCreateWidget "wid" xmFormWidgetClass shell '()))
+ (wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass wid '()))
+ (wid2 (XtVaCreateWidget "wid" xmFormWidgetClass shell '())))
+ (if (XtIsApplicationShell wid) (snd-display #__line__ ";XtIsApplicationShell"))
+ (if (not (XtIsApplicationShell shell)) (snd-display #__line__ ";XtIsApplicationShell of appshell"))
+ (if (not (XtIsComposite wid)) (snd-display #__line__ ";XtIsComposite"))
+ (if (not (XtIsConstraint wid)) (snd-display #__line__ ";XtIsConstraint"))
+ (if (XtIsManaged wid) (snd-display #__line__ ";XtIsManaged"))
+ (if (not (XtIsObject wid)) (snd-display #__line__ ";XtIsObject"))
+ (if (XtIsOverrideShell wid) (snd-display #__line__ ";XtIsOverrideShell"))
+ (if (XtIsRealized wid) (snd-display #__line__ ";XtIsRealized"))
+ (if (not (XtIsRealized shell)) (snd-display #__line__ ";XtIsRealized main shell"))
+ (if (not (XtIsRectObj wid)) (snd-display #__line__ ";XtIsRectObj"))
+ (if (not (XtIsSensitive wid)) (snd-display #__line__ ";XtIsSensitive"))
+ (if (not (XtIsSensitive shell)) (snd-display #__line__ ";XtIsSensitive of main shell"))
+ (XtSetSensitive wid1 #t)
+ (if (not (XtIsSensitive wid1)) (snd-display #__line__ ";XtIsSensitive of button"))
+ (if (XtIsSessionShell wid) (snd-display #__line__ ";XtIsSessionShell"))
+ (if (XtIsShell wid) (snd-display #__line__ ";XtIsShell"))
+ (if (not (XtIsShell shell)) (snd-display #__line__ ";XtIsShell of main shell"))
+ (if (XtIsTopLevelShell wid) (snd-display #__line__ ";XtIsTopLevelShell"))
+ (if (not (XtIsTopLevelShell shell)) (snd-display #__line__ ";XtIsTopLevelShell of main shell"))
+ (if (XtIsTransientShell wid) (snd-display #__line__ ";XtIsTransientShell"))
+ (if (XtIsVendorShell wid) (snd-display #__line__ ";XtIsVendorShell"))
+ (if (not (XtIsVendorShell shell)) (snd-display #__line__ ";XtIsVendorShell of main shell"))
+ (if (XtIsWMShell wid) (snd-display #__line__ ";XtIsWMShell"))
+ (if (not (XtIsWidget wid)) (snd-display #__line__ ";XtIsWidget"))
+ (XtRealizeWidget wid)
+ (if (not (XtIsRealized wid)) (snd-display #__line__ ";XtRealizeWidget?"))
+ (XtAddGrab shell #f #f)
+ (XtRemoveGrab shell)
+ (XtMakeResizeRequest wid 200 200)
+ (XtMapWidget wid)
+ (XtUnmapWidget wid)
+ (XtUnrealizeWidget wid)
;(XtDestroyWidget wid1)
- )
-; (XtFree 0) (XtCalloc 0 0) (XtMalloc 0) (XtRealloc 0 0)
- (XtSetLanguageProc
- (car (main-widgets))
- (lambda (dpy str data)
- (snd-display ";YOW: language proc: got ~A ~A" str data))
- "who called us?")
- (XtSetLanguageProc (car (main-widgets)) #f "oops")
- (XtSetLanguageProc #f #f "oops")
- (XtMergeArgLists (list 1 2) 2 (list 1) 1)
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell)))
- (if (not (equal? (XtClass shell) applicationShellWidgetClass))
- (snd-display ";XtClass shell: ~A" (XtClass shell)))
- (if (not (equal? (XtSuperclass shell) topLevelShellWidgetClass))
- (snd-display ";XtSuperclass shell: ~A" (XtClass shell)))
- (if (not (string=? (XtName shell) "snd"))
- (snd-display ";XtName: ~A" (XtName shell)))
- (if (not (equal? (XtWindow shell) (XtWindowOfObject shell)))
- (snd-display ";XtWindow: ~A ~A" (XtWindow shell) (XtWindowOfObject shell)))
- (if (not (equal? (XtScreen shell) (XtScreenOfObject shell)))
- (snd-display ";XtScreen: ~A ~A" (XtScreen shell) (XtScreenOfObject shell)))
- (if (not (equal? (XtDisplay shell) (XtDisplayOfObject shell)))
- (snd-display ";XtDisplay: ~A ~A" (XtDisplay shell) (XtDisplayOfObject shell)))
- (if (not (Time? (XtLastTimestampProcessed dpy)))
- (snd-display ";XtLastTimestampProcessed: ~A" (XtLastTimestampProcessed dpy)))
- (if (not (XEvent? (XtLastEventProcessed dpy)))
- (snd-display ";XtLastEventProcessed: ~A" (XtLastEventProcessed dpy)))
- (XtBuildEventMask shell)
- (let ((k (XtConvertCase dpy (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0)))
- (x (XConvertCase (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0))))
- (if (not (KeySym? (car k)))
- (snd-display ";XtConvertCase: ~A" k))
- (if (not (equal? k x))
- (snd-display ";X(t)ConvertCase: ~A ~A" k x)))
- (let ((val 0))
- (XtRegisterCaseConverter
- dpy
- (lambda (dp key)
- (set! val 123)
- (list (list 'KeySym 65)
- (list 'KeySym 97)))
- (list 'KeySym 65)
- (list 'KeySym 65))
- (XtConvertCase dpy (list 'KeySym 65))
- (if (not (= val 123)) (snd-display ";XtRegisterCaseConverter: ~A" val)))
- (XtRegisterGrabAction (lambda (a b c) #f) #f ColormapChangeMask GrabModeSync GrabModeAsync)
- (let ((vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (if (or (not (= (car vals) 0))
- (not (KeySym? (cadr vals))))
- (snd-display ";XtTranslateKeycode: ~A" vals))
- (if (not (equal? vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
- (snd-display ";XtTranslateKey: ~A ~A" vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
- (XtSetKeyTranslator dpy #f)
- (if (not (equal? vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (snd-display ";XtSetKeyTranslator #f: ~A ~A" vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (XtSetKeyTranslator dpy (lambda (d k m)
- (if (not (equal? d dpy)) (snd-display ";d in keyproc: ~A ~A" d dpy))
- (XtTranslateKey d k m)))
- (let ((newvals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (if (not (equal? vals newvals)) (snd-display ";XtSetKeyTranslator: ~A ~A" vals newvals)))
- (XtSetKeyTranslator dpy #f))
- (if (not (KeySym? (cadr (XmTranslateKey dpy (list 'KeyCode XK_B) 0))))
- (snd-display ";XmTranslateKey: ~A" (XmTranslateKey dpy XK_B 0)))
- (let ((kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509))))
- (if (not (equal? (car kv) (list 'KeyCode 66)))
- (snd-display ";XtKeysymToKeycodeList: ~A ~A" kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509)))))
- (XtInstallAllAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
- (XtInstallAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
- (if (not (equal? (list 0 1 2) (XtSetArg 0 1 2))) (snd-display ";XtSetArg: ~A" (XtSetArg 0 1 2)))
- (if (not (Widget? (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
- (snd-display ";XtGetKeyboardFocusWidget: ~A" (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
- (let ((id (XtAppAddInput (car (main-widgets)) 1 XtInputReadMask (lambda (a b c) #f) #f)))
- (XtRemoveInput id))
-
- (let ((id (XtAppAddWorkProc (car (main-widgets)) (lambda (me) #f) #f)))
- (XtRemoveWorkProc id))
- (if (not (equal? (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
- (snd-display ";XtNameToWidget: ~A ~A" (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
- (XtVaCreatePopupShell "hiho" vendorShellWidgetClass (cadr (main-widgets)) '())
- (XtResolvePathname (XtDisplay (cadr (main-widgets))) "app-defaults" #f #f #f #f 0 #f)
- (XtFindFile ".snd" #f 0 #f)
-
- (XtAppLock (car (main-widgets)))
- (XtAppUnlock (car (main-widgets)))
- (let ((acts (XtGetActionList xmLabelWidgetClass)))
- (if (or (not (= (length acts) 4))
- (not (string=? (caar acts) "Enter")))
- (snd-display ";XtGetActionList: ~A" acts)))
- )
-
- (let ((pop (XtCreatePopupShell "hiho" xmGrabShellWidgetClass (cadr (main-widgets))
- (list XmNiconNameEncoding XA_STRING))))
- (XtPopup pop XtGrabNone)
- (XtPopdown pop))
- (XtAppSetWarningHandler (car (main-widgets))
- (lambda (n)
- (if (not (string=? n "hiho"))
- (snd-display ";XtWarning: ~A" n))))
- (XtAppSetWarningMsgHandler (car (main-widgets))
- (lambda (name type klass def pars num)
- (snd-print (format #f ";ignore: ~A ~A ~A~%" name def pars))))
-
- (let ((listener (list-ref (main-widgets) 4)))
- (XtCallActionProc listener "text-transpose" (XEvent) #f 0)
- (XtCallActionProc listener "begin-of-line" (XEvent) #f 0)
- (XtCallActionProc listener "kill-line" (XEvent) #f 0)
- (XtCallActionProc listener "yank" (XEvent) #f 0)
- (XtCallActionProc listener "name-completion" (XEvent) #f 0)
- (XtCallActionProc listener "listener-completion" (XEvent) #f 0)
- (XtCallActionProc listener "no-op" (XEvent) #f 0)
- (XtCallActionProc listener "delete-region" (XEvent) #f 0)
- (XtCallActionProc listener "listener-g" (XEvent) #f 0)
- (XtCallActionProc listener "listener-clear" (XEvent) #f 0)
- (XtCallActionProc listener "b1-press" (XEvent) #f 0)
- (XtCallActionProc listener "delete-to-previous-command" (XEvent) #f 0)
- (let ((BEvent (XEvent ButtonPress)))
- (set! (.x BEvent) 10)
- (set! (.y BEvent) 10)
- (XtCallActionProc listener "b1-press" BEvent #f 0)
- (XtCallActionProc listener "b1-release" BEvent #f 0))
- (XtCallActionProc listener "word-upper" (XEvent) (list "u") 1))
-
- (let ((ind (open-sound "oboe.snd")))
- (set! (show-controls ind) #t)
- (let* ((swids (sound-widgets ind))
- (spane (car swids))
- (sctrls (list-ref swids 2))
- (cmain (find-child spane "chn-main-window"))
- (wh (widget-size sctrls)))
- (XtUnmanageChild sctrls)
- (set! (widget-size sctrls) (list (car wh) (* (cadr wh) 3)))
- (XtManageChild sctrls)
-
- (let ((tag (catch #t (lambda () (XtVaGetValues (car (sound-widgets)) (list "XmNpaneMaximum" 0)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-resource))
- (snd-display ";XtVaGetValues of incorrectly quoted resource name: ~A" tag)))
- )
-
- (close-sound ind))
-
-
- ;; ---------------- XM tests ----------------
- (let* ((label-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNlabelRenderTable 0))))
- (renditions (and label-render-table
- (XmRenderTableGetRenditions label-render-table (XmRenderTableGetTags label-render-table))))
- (default-font-name (and renditions
- (cadr (XmRenditionRetrieve (car renditions) (list XmNfontName 0)))))
- (default-font-info (and renditions
- (XmRenditionRetrieve (car renditions) (list XmNfont 0 XmNfontType 0)))))
- (if (not (string=? default-font-name "fixed")) (snd-display ";XmRenderTableGetRenditions name: ~A" default-font-name))
- (if (not (XFontStruct? (list-ref default-font-info 1))) (snd-display ";XmRenderTableGetRenditions font struct: ~A" default-font-info))
- (if (not (= (list-ref default-font-info 3) XmFONT_IS_FONT)) (snd-display ";XmRenderTableGetRenditions font type: ~A" default-font-info)))
-
-
- (let* ((button-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNbuttonRenderTable 0))))
- (default-rendition (and button-render-table
- (XmRenderTableGetRendition button-render-table XmFONTLIST_DEFAULT_TAG)))
- (default-font-info (and default-rendition
- (XmRenditionRetrieve default-rendition (list XmNfont 0 XmNfontType 0)))))
- (if (and default-font-info
- (= (list-ref default-font-info 3) XmFONT_IS_FONT))
- (let* ((font (cadr default-font-info))
- (dpy (XtDisplay (cadr (main-widgets))))
- (data '()))
- (for-each (lambda (name atom?)
- (let ((val (XGetFontProperty font name)))
- (if (car val)
- (set! data (cons (list (XGetAtomName (XtDisplay (cadr (main-widgets))) name)
- (if atom?
- (XGetAtomName (XtDisplay (cadr (main-widgets))) (list 'Atom (cadr val)))
- (cadr val)))
- data)))))
- (list XA_POINT_SIZE XA_FONT XA_FULL_NAME
- (XInternAtom dpy "XA_SLANT" #f)
- (XInternAtom dpy "XA_WEIGHT_NAME" #f)
- XA_FAMILY_NAME
- (XInternAtom dpy "XA_FOUNDRY" #f)
- XA_CAP_HEIGHT)
- (list #f #t #t #t #t #t #t #f))
- (if (not (string=? "Fixed" (cadr (list-ref data 1)))) (snd-display ";XmRenderTableGetRendition: ~A" data)))))
-
- (let ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets)))))
- (let ((version (list-ref (XGetWindowProperty dpy win
- (XInternAtom (XtDisplay (cadr (main-widgets)))
- "SND_VERSION"
- #f)
- 0 32 #f XA_STRING)
- 5)))
- (XDeleteProperty dpy win (XInternAtom dpy "AN_ATOM" #f))
- (if (not (string=? version (snd-version)))
- (snd-display ";SND_VERSION: ~A, ~A?" version (snd-version)))))
-
- (let* ((tabs (let ((ctr 0))
- (map
- (lambda (n)
- (set! ctr (+ ctr 1))
- (XmTabCreate n XmINCHES (if (= ctr 1) XmABSOLUTE XmRELATIVE) XmALIGNMENT_BEGINNING "."))
- (list 1.5 1.5 1.5 1.5))))
- (tablist (XmTabListInsertTabs #f tabs (length tabs) 0)))
- (if (not (= (XmTabListTabCount tablist) (length tabs)))
- (snd-display ";tablist len: ~A ~A~%" (XmTabListTabCount tablist) (length tabs)))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 0)) (list 1.5 5 0 0 ".")))
- (snd-display ";XmTabs 0: ~A" (XmTabGetValues (XmTabListGetTab tablist 0))))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 2)) (list 1.5 5 1 0 ".")))
- (snd-display ";XmTabs 2: ~A" (XmTabGetValues (XmTabListGetTab tablist 2))))
- (let ((copytab (XmTabListCopy tablist 0 0)))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab copytab 0)) (list 1.5 5 0 0 ".")))
- (snd-display ";XmTabListCopy 0: ~A" (XmTabGetValues (XmTabListGetTab copytab 0))))
- (let ((another (XmTabListRemoveTabs copytab (list 0 1)))
- (atab (XmTabCreate 3.0 XmINCHES XmABSOLUTE XmALIGNMENT_BEGINNING ".")))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab another 0)) (list 1.5 5 1 0 ".")))
- (snd-display ";XmTabListRemoveTabs: ~A" (XmTabGetValues (XmTabListGetTab another 0))))
- (XmTabListReplacePositions (XmTabListCopy tablist 0 0) (list 1) (list atab))
- ;; this (replacepositions) is very prone to segfaults -- *very* poorly implemented!
- (XmTabSetValue atab 6.0)
- (XmTabFree atab)
- (XmTabListFree another))
- (let ((tabl (XmStringTableProposeTablist
- (list (XmStringCreateLocalized "a-string") (XmStringCreateLocalized "another")) 2
- (cadr (main-widgets))
- 1.0
- XmABSOLUTE)))
- (if (not (XmTabList? tabl)) (snd-display ";XmStringTableProposeTabList: ~A" tabl))
- (XmTabListFree tabl)))
-
- (let ((hname (host-name))) ; from snd-motif.scm
- (if (not (equal? hname (getenv "HOSTNAME")))
- (snd-display ";host name appears to be ~A or maybe ~A" hname (getenv "HOSTNAME"))))
- (let ((blu (x->snd-color "blue")))
- (if (not (Pixel? blu)) (snd-display ";x->snd-color can't find blue! ~A" blu))
- (if (not (equal? (color->list blu) (list 0.0 0.0 1.0)))
- (snd-display ";x->snd-color blue: ~A" (color->list blu))))
-
- (let* ((tmp (XmStringCreateLocalized "h"))
- (pm (XmParseMappingCreate (list XmNincludeStatus XmINSERT
- XmNsubstitute tmp
- XmNpattern "i"
- XmNpatternType XmCHARSET_TEXT))))
- (XmStringFree tmp)
- (XmParseMappingFree pm)
- (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
- (lambda (txt end type tag entry pattern str call)
- #f))))
- (XmParseMappingFree pm)
- (let ((tag (catch #t (lambda ()
- (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
- (lambda (txt end type tag entry pattern)
- #f)))))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmNinvokeParseProc wrong arity: ~A" tag))))
-
- (let* ((fonts (list "fixed"
- "-*-times-bold-r-*-*-14-*-*-*-*-*-*-*"
- "-*-*-medium-i-*-*-18-*-*-*-*-*-*-*"
- "-*-helvetica-*-*-*-*-18-*-*-*-*-*-*-*"))
- (tags (list "one" "two" "three" "four"))
- (colors (list "red" "green" "blue" "orange"))
- (pixels
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr)))
- (let ((col (XColor)))
- (XParseColor dpy cmap "blue" col)
- (if (or (not (= (.red col) 0))
- (not (= (.green col) 0))
- (not (= (.blue col) 65535)))
- (snd-display ";XParseColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col)))
- (XLookupColor dpy cmap "red" col (XColor))
- (if (or (not (= (.red col) 65535))
- (not (= (.green col) 0))
- (not (= (.blue col) 0)))
- (snd-display ";XLookupColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col))))
+ )
+ ; (XtFree 0) (XtCalloc 0 0) (XtMalloc 0) (XtRealloc 0 0)
+ (XtSetLanguageProc
+ (car (main-widgets))
+ (lambda (dpy str data)
+ (snd-display #__line__ ";YOW: language proc: got ~A ~A" str data))
+ "who called us?")
+ (XtSetLanguageProc (car (main-widgets)) #f "oops")
+ (XtSetLanguageProc #f #f "oops")
+ (XtMergeArgLists (list 1 2) 2 (list 1) 1)
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell)))
+ (if (not (equal? (XtClass shell) applicationShellWidgetClass))
+ (snd-display #__line__ ";XtClass shell: ~A" (XtClass shell)))
+ (if (not (equal? (XtSuperclass shell) topLevelShellWidgetClass))
+ (snd-display #__line__ ";XtSuperclass shell: ~A" (XtClass shell)))
+ (if (not (string=? (XtName shell) "snd"))
+ (snd-display #__line__ ";XtName: ~A" (XtName shell)))
+ (if (not (equal? (XtWindow shell) (XtWindowOfObject shell)))
+ (snd-display #__line__ ";XtWindow: ~A ~A" (XtWindow shell) (XtWindowOfObject shell)))
+ (if (not (equal? (XtScreen shell) (XtScreenOfObject shell)))
+ (snd-display #__line__ ";XtScreen: ~A ~A" (XtScreen shell) (XtScreenOfObject shell)))
+ (if (not (equal? (XtDisplay shell) (XtDisplayOfObject shell)))
+ (snd-display #__line__ ";XtDisplay: ~A ~A" (XtDisplay shell) (XtDisplayOfObject shell)))
+ (if (not (Time? (XtLastTimestampProcessed dpy)))
+ (snd-display #__line__ ";XtLastTimestampProcessed: ~A" (XtLastTimestampProcessed dpy)))
+ (if (not (XEvent? (XtLastEventProcessed dpy)))
+ (snd-display #__line__ ";XtLastEventProcessed: ~A" (XtLastEventProcessed dpy)))
+ (XtBuildEventMask shell)
+ (let ((k (XtConvertCase dpy (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0)))
+ (x (XConvertCase (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0))))
+ (if (not (KeySym? (car k)))
+ (snd-display #__line__ ";XtConvertCase: ~A" k))
+ (if (not (equal? k x))
+ (snd-display #__line__ ";X(t)ConvertCase: ~A ~A" k x)))
+ (let ((val 0))
+ (XtRegisterCaseConverter
+ dpy
+ (lambda (dp key)
+ (set! val 123)
+ (list (list 'KeySym 65)
+ (list 'KeySym 97)))
+ (list 'KeySym 65)
+ (list 'KeySym 65))
+ (XtConvertCase dpy (list 'KeySym 65))
+ (if (not (= val 123)) (snd-display #__line__ ";XtRegisterCaseConverter: ~A" val)))
+ (XtRegisterGrabAction (lambda (a b c) #f) #f ColormapChangeMask GrabModeSync GrabModeAsync)
+ (let ((vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (if (or (not (= (car vals) 0))
+ (not (KeySym? (cadr vals))))
+ (snd-display #__line__ ";XtTranslateKeycode: ~A" vals))
+ (if (not (equal? vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
+ (snd-display #__line__ ";XtTranslateKey: ~A ~A" vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
+ (XtSetKeyTranslator dpy #f)
+ (if (not (equal? vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (snd-display #__line__ ";XtSetKeyTranslator #f: ~A ~A" vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (XtSetKeyTranslator dpy (lambda (d k m)
+ (if (not (equal? d dpy)) (snd-display #__line__ ";d in keyproc: ~A ~A" d dpy))
+ (XtTranslateKey d k m)))
+ (let ((newvals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (if (not (equal? vals newvals)) (snd-display #__line__ ";XtSetKeyTranslator: ~A ~A" vals newvals)))
+ (XtSetKeyTranslator dpy #f))
+ (if (not (KeySym? (cadr (XmTranslateKey dpy (list 'KeyCode XK_B) 0))))
+ (snd-display #__line__ ";XmTranslateKey: ~A" (XmTranslateKey dpy XK_B 0)))
+ (let ((kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509))))
+ (if (not (equal? (car kv) (list 'KeyCode 66)))
+ (snd-display #__line__ ";XtKeysymToKeycodeList: ~A ~A" kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509)))))
+ (XtInstallAllAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
+ (XtInstallAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
+ (if (not (equal? (list 0 1 2) (XtSetArg 0 1 2))) (snd-display #__line__ ";XtSetArg: ~A" (XtSetArg 0 1 2)))
+ (if (not (Widget? (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
+ (snd-display #__line__ ";XtGetKeyboardFocusWidget: ~A" (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
+ (let ((id (XtAppAddInput (car (main-widgets)) 1 XtInputReadMask (lambda (a b c) #f) #f)))
+ (XtRemoveInput id))
+
+ (let ((id (XtAppAddWorkProc (car (main-widgets)) (lambda (me) #f) #f)))
+ (XtRemoveWorkProc id))
+ (if (not (equal? (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
+ (snd-display #__line__ ";XtNameToWidget: ~A ~A" (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
+ (XtVaCreatePopupShell "hiho" vendorShellWidgetClass (cadr (main-widgets)) '())
+ (XtResolvePathname (XtDisplay (cadr (main-widgets))) "app-defaults" #f #f #f #f 0 #f)
+ (XtFindFile ".snd" #f 0 #f)
+
+ (XtAppLock (car (main-widgets)))
+ (XtAppUnlock (car (main-widgets)))
+ (let ((acts (XtGetActionList xmLabelWidgetClass)))
+ (if (or (not (= (length acts) 4))
+ (not (string=? (caar acts) "Enter")))
+ (snd-display #__line__ ";XtGetActionList: ~A" acts)))
+ )
+
+ (let ((pop (XtCreatePopupShell "hiho" xmGrabShellWidgetClass (cadr (main-widgets))
+ (list XmNiconNameEncoding XA_STRING))))
+ (XtPopup pop XtGrabNone)
+ (XtPopdown pop))
+ (XtAppSetWarningHandler (car (main-widgets))
+ (lambda (n)
+ (if (not (string=? n "hiho"))
+ (snd-display #__line__ ";XtWarning: ~A" n))))
+ (XtAppSetWarningMsgHandler (car (main-widgets))
+ (lambda (name type klass def pars num)
+ (snd-print (format #f ";ignore: ~A ~A ~A~%" name def pars))))
+
+ (let ((listener (list-ref (main-widgets) 4)))
+ (XtCallActionProc listener "text-transpose" (XEvent) #f 0)
+ (XtCallActionProc listener "begin-of-line" (XEvent) #f 0)
+ (XtCallActionProc listener "kill-line" (XEvent) #f 0)
+ (XtCallActionProc listener "yank" (XEvent) #f 0)
+ (XtCallActionProc listener "name-completion" (XEvent) #f 0)
+ (XtCallActionProc listener "listener-completion" (XEvent) #f 0)
+ (XtCallActionProc listener "no-op" (XEvent) #f 0)
+ (XtCallActionProc listener "delete-region" (XEvent) #f 0)
+ (XtCallActionProc listener "listener-g" (XEvent) #f 0)
+ (XtCallActionProc listener "listener-clear" (XEvent) #f 0)
+ (XtCallActionProc listener "b1-press" (XEvent) #f 0)
+ (XtCallActionProc listener "delete-to-previous-command" (XEvent) #f 0)
+ (let ((BEvent (XEvent ButtonPress)))
+ (set! (.x BEvent) 10)
+ (set! (.y BEvent) 10)
+ (XtCallActionProc listener "b1-press" BEvent #f 0)
+ (XtCallActionProc listener "b1-release" BEvent #f 0))
+ (XtCallActionProc listener "word-upper" (XEvent) (list "u") 1))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (set! (show-controls ind) #t)
+ (let* ((swids (sound-widgets ind))
+ (spane (car swids))
+ (sctrls (list-ref swids 2))
+ (cmain (find-child spane "chn-main-window"))
+ (wh (widget-size sctrls)))
+ (XtUnmanageChild sctrls)
+ (set! (widget-size sctrls) (list (car wh) (* (cadr wh) 3)))
+ (XtManageChild sctrls)
+
+ (let ((tag (catch #t (lambda () (XtVaGetValues (car (sound-widgets)) (list "XmNpaneMaximum" 0)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-resource))
+ (snd-display #__line__ ";XtVaGetValues of incorrectly quoted resource name: ~A" tag)))
+ )
+
+ (close-sound ind))
+
+
+ ;; ---------------- XM tests ----------------
+ (let* ((label-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNlabelRenderTable 0))))
+ (renditions (and label-render-table
+ (XmRenderTableGetRenditions label-render-table (XmRenderTableGetTags label-render-table))))
+ (default-font-name (and renditions
+ (cadr (XmRenditionRetrieve (car renditions) (list XmNfontName 0)))))
+ (default-font-info (and renditions
+ (XmRenditionRetrieve (car renditions) (list XmNfont 0 XmNfontType 0)))))
+ (if (not (string=? default-font-name "fixed")) (snd-display #__line__ ";XmRenderTableGetRenditions name: ~A" default-font-name))
+ (if (not (XFontStruct? (list-ref default-font-info 1))) (snd-display #__line__ ";XmRenderTableGetRenditions font struct: ~A" default-font-info))
+ (if (not (= (list-ref default-font-info 3) XmFONT_IS_FONT)) (snd-display #__line__ ";XmRenderTableGetRenditions font type: ~A" default-font-info)))
+
+
+ (let* ((button-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNbuttonRenderTable 0))))
+ (default-rendition (and button-render-table
+ (XmRenderTableGetRendition button-render-table XmFONTLIST_DEFAULT_TAG)))
+ (default-font-info (and default-rendition
+ (XmRenditionRetrieve default-rendition (list XmNfont 0 XmNfontType 0)))))
+ (if (and default-font-info
+ (= (list-ref default-font-info 3) XmFONT_IS_FONT))
+ (let* ((font (cadr default-font-info))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (data '()))
+ (for-each (lambda (name atom?)
+ (let ((val (XGetFontProperty font name)))
+ (if (car val)
+ (set! data (cons (list (XGetAtomName (XtDisplay (cadr (main-widgets))) name)
+ (if atom?
+ (XGetAtomName (XtDisplay (cadr (main-widgets))) (list 'Atom (cadr val)))
+ (cadr val)))
+ data)))))
+ (list XA_POINT_SIZE XA_FONT XA_FULL_NAME
+ (XInternAtom dpy "XA_SLANT" #f)
+ (XInternAtom dpy "XA_WEIGHT_NAME" #f)
+ XA_FAMILY_NAME
+ (XInternAtom dpy "XA_FOUNDRY" #f)
+ XA_CAP_HEIGHT)
+ (list #f #t #t #t #t #t #t #f))
+ (if (not (string=? "Fixed" (cadr (list-ref data 1)))) (snd-display #__line__ ";XmRenderTableGetRendition: ~A" data)))))
+
+ (let ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets)))))
+ (let ((version (list-ref (XGetWindowProperty dpy win
+ (XInternAtom (XtDisplay (cadr (main-widgets)))
+ "SND_VERSION"
+ #f)
+ 0 32 #f XA_STRING)
+ 5)))
+ (XDeleteProperty dpy win (XInternAtom dpy "AN_ATOM" #f))
+ (if (not (string=? version (snd-version)))
+ (snd-display #__line__ ";SND_VERSION: ~A, ~A?" version (snd-version)))))
+
+ (let* ((tabs (let ((ctr 0))
(map
- (lambda (color)
- (let ((col (XColor)))
- (if (= (XAllocNamedColor dpy cmap color col col) 0)
- (snd-error (format #f "can't allocate ~A" color))
- (.pixel col))))
- colors)))
- (rendertable (XmRenderTableAddRenditions #f
- (let ((ctr 0))
- (map (lambda (r)
- (set! ctr (+ ctr 1))
- (XmRenditionCreate (cadr (main-widgets))
- r
- (append
- (if (= ctr 1)
- (list XmNtabList tablist)
- '())
- (list XmNrenditionForeground (list-ref pixels (- ctr 1))
- XmNfontName (list-ref fonts (- ctr 1))
- XmNfontType XmFONT_IS_FONT))))
- tags))
- (length tags)
- XmMERGE_NEW)))
-
- (if (file-exists? "hiho") (delete-file "hiho"))
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (scr (DefaultScreenOfDisplay dpy))
- (p1 (XmGetPixmap scr "hiho" (car pixels) (cadr pixels))))
- (if (not (Pixmap? p1)) (snd-display ";XmGetPixmap: ~A" p1))
- (set! p1 (XmGetPixmapByDepth scr "hoho" (car pixels) (cadr pixels) (XDefaultDepth dpy (XScreenNumberOfScreen scr))))
- (if (not (Pixmap? p1)) (snd-display ";XmGetPixmapByDepth: ~A" p1))
- (XmDestroyPixmap scr p1))
-
- (let ((tabl (XmStringTableParseStringArray (list "hi" "ho") 2 "hiho" XmCHARSET_TEXT #f 0 #f)))
- (if (not (XmString? (car tabl))) (snd-display ";XmStringTableParseStringArray: ~A" tabl))
- (let ((strs (XmStringTableUnparse tabl 2 "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
- (if (not (equal? strs (list "hi" "ho"))) (snd-display ";XmStringTableUnparse: ~A" strs)))
- (let ((str (XmStringTableToXmString tabl 2 #f)))
- (if (not (XmString? str)) (snd-display ";XmStringTableToXmString: ~A" str))
- (XmStringToXmStringTable str #f)
- (let ((val (XmStringUnparse str "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
- (if (not (string=? val "hiho")) (snd-display ";XmStringUnparse: ~A" val))
- (set! val (XmStringUnparse (XmStringCreateLocalized "hi") #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
- (if (not (string=? val "hi")) (snd-display ";XmStringUnparse null tag: ~A" val)))
- ;; XmCvtXmStringToByteStream test deleted because it seems to be buggy in memory handling
- (let* ((ind (open-sound "oboe.snd"))
- (grf1 (car (channel-widgets)))
- (dpy (XtDisplay grf1))
- (win (XtWindow grf1))
- (scr (DefaultScreenOfDisplay dpy))
- (scrn (XScreenNumberOfScreen scr))
- (gv (XGCValues)))
- (if (not (Font? (current-font ind))) (snd-display ";current-font: ~A" (current-font ind)))
- (let ((old-font (current-font))
- (a-font (load-font "6x12")))
- (set! (current-font) a-font)
- (if (not (equal? a-font (current-font)))
- (snd-display ";set current-font: ~A ~A" a-font (current-font)))
- (set! (current-font ind) old-font)
- (if (not (equal? old-font (current-font ind)))
- (snd-display ";set current-font with ind: ~A ~A" old-font (current-font ind)))
- (set! (current-font) a-font)
- (set! (current-font ind 0) old-font)
- (if (not (equal? old-font (current-font ind 0)))
- (snd-display ";set current-font with ind/0: ~A ~A" old-font (current-font ind 0)))
- (set! (current-font) old-font))
-
- (set! (.foreground gv) (data-color))
- (set! (.background gv) (basic-color))
- (set! (.function gv) GXcopy)
- (let* ((sgc (XtAllocateGC grf1
- (XDefaultDepth dpy scrn)
- (logior GCForeground GCBackground GCFunction)
- gv
- (logior GCFont GCDashList)
- 0))
- (str2 (XmStringCreateLocalized "hiho")))
- (XmStringDraw dpy win rendertable str2 sgc 10 10 100
- XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
- (XmStringDrawImage dpy win rendertable str2 sgc 10 10 100
- XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
- (XmStringDrawUnderline dpy win rendertable str2 sgc 10 10 100
- XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100) str2)
- (XtGetGC (cadr (main-widgets)) GCForeground gv)
- (XCopyGC dpy sgc GCFunction sgc)
- (XCopyArea dpy win win sgc 0 0 100 100 0 0)
- (XCopyPlane dpy win win sgc 0 0 100 100 0 0 1)
- (XtReleaseGC grf1 sgc))
- (close-sound ind))
- (let ((lc (XmStringLineCount (XmStringCreateLocalized "hiho"))))
- (if (not (= lc 1)) (snd-display ";XmStringLineCount: ~A" lc)))
- (if (not (XmStringHasSubstring str (XmStringCreateLocalized "hi"))) (snd-display ";XmStringHasSubstring?"))))
-
-
- (if (not (equal? (XmRenderTableGetTags rendertable) (list "one" "two" "three" "four")))
- (snd-display ";tags: ~A~%" (XmRenderTableGetTags rendertable)))
- (let* ((rend (XmRenderTableGetRendition rendertable "one"))
- (r (and rend (XmRenditionRetrieve rend
- (list XmNrenditionForeground 0
- XmNfontName 0
- XmNfontType 0
- XmNtag 0)))))
- (if (and rend r)
- (begin
- (if (or (not (string=? (list-ref r 7) "one"))
- (not (string=? (list-ref r 3) "fixed")))
- (snd-display ";rendertable: ~A" r))
- (XmRenditionUpdate rend (list XmNstrikethruType XmSINGLE_LINE))
- (if (not (= (cadr (XmRenditionRetrieve rend (list XmNstrikethruType 0))) XmSINGLE_LINE))
- (snd-display ";XmRenditionUpdate: ~A ~A" (cadr (XtGetValues rend (list XmNstrikethruType 0))) XmSINGLE_LINE)))
- (snd-display ";r and rend: ~A ~A~%" r rend)))
- (let ((r1 (XmRenditionCreate (cadr (main-widgets)) "r1" (list XmNfontName "fixed"))))
- (XmRenditionFree r1))
-
- (if (not (equal? (XmDropSiteQueryStackingOrder (list-ref (main-widgets) 4)) (list #f)))
- (snd-display ";XmDropSiteQueryStackingOrder: ~A" (XmDropSiteQueryStackingOrder (list-ref (main-widgets) 4)) (list #f)))
- (let ((tab (XmStringComponentCreate XmSTRING_COMPONENT_TAB 0 #f))
- (row #f)
- (table '())
- (our-tags tags))
- (for-each
- (lambda (word)
- (let ((entry (XmStringGenerate word
- #f
- XmCHARSET_TEXT
- (car our-tags))))
- (if (XmStringIsVoid entry) (snd-display ";~A is void?" entry))
- (if (XmStringEmpty entry) (snd-display ";~A is empty?" entry))
-
- (if row
- (let ((tmp (XmStringConcat row tab)))
- (XmStringFree row)
- (set! row (XmStringConcatAndFree tmp entry)))
- (set! row entry))
- (set! our-tags (cdr our-tags))
- (if (null? our-tags)
- (begin
- (set! our-tags tags)
- (set! table (cons row table))
- (set! row #f)))))
- (list "this" "is" "a" "test" "of" "the" "renditions" "and" "rendertables"
- "perhaps" "all" "will" "go" "well" "and" "then" "again" "perhaps" "not"))
- (let* ((n (car table))
- (c (XmStringInitContext n))
- (ctr 0)
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((not happy))
- (let ((type (XmStringGetNextTriple (cadr c))))
- (if (= (car type) XmSTRING_COMPONENT_TEXT)
- (if (or (not (= (cadr type) (list-ref (list 0 0 2 0 0 0 4 0 0 0 3 0 0 0 4) i)))
- (not (string=? (caddr type)
- (list-ref (list "o" "o" "go" "o" "o" "o" "well" "o" "o" "o" "and" "o" "o" "o" "then") i))))
- (snd-display ";component ~A -> ~A" i (cdr type)))
- (if (not (= (car type) XmSTRING_COMPONENT_TAB))
- (if (= (car type) XmSTRING_COMPONENT_END)
- (set! happy #f))))))
- (XmStringFreeContext (cadr c))))))
-
- (XtAppAddActions (car (main-widgets))
- (list (list "try1" (lambda (w e strs)
- (snd-display ";try1: ~A~%" strs)))
- (list "try2" (lambda (w e strs)
- (snd-display ";try2: ~A~%" strs)))))
- (let* ((tab (XtParseTranslationTable
- (format #f "Ctrl <Key>osfLeft: try1()~%Ctrl <Key>osfRight: try2()~%Ctrl <Key>osfUp: try1(hiho)~%Ctrl <Key>osfDown: try2(down, up)~%")))
- (pane (add-main-pane "hiho" xmTextWidgetClass '())))
- (XtOverrideTranslations pane tab))
- (if (defined? 'XtAddActions)
- (XtAddActions (list (list "try3" (lambda (w e strs)
- (snd-display ";try3: ~A~%" strs)))
- (list "try4" (lambda (w e strs)
- (snd-display ";try4: ~A~%" strs))))))
-
- (let ((XmNhiho (add-resource "hiho" 0)))
- (if (not (string=? XmNhiho "hiho")) (snd-display ";add-resource XmNhiho: ~A" XmNhiho)))
-
- (open-sound "cardinal.snd")
- (let* ((mouse_width 32)
- (mouse_height 32)
- (mouse_bits (list
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x80 #xff #xff #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
- #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
- #x80 #x00 #x01 #x01 #x80 #xff #xff #x01 #x80 #x00 #x00 #x01
- #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
- #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
- #x80 #x00 #x00 #x01 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00
- #x00 #x06 #x60 #x00 #x00 #xf8 #x1f #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00))
- (rb (list
- #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
- #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
- (iconw (list-ref (sound-widgets) 8))
- (dpy (XtDisplay iconw))
- (win (XtWindow iconw)))
- (XCreateBitmapFromData dpy win rb 16 12)
- (XCreateBitmapFromData dpy win mouse_bits mouse_width mouse_height)
- (XCreatePixmapFromBitmapData dpy win mouse_bits 32 32 (white-pixel) (black-pixel) 8))
-
- (let* ((grf1 (car (channel-widgets)))
- (dpy (XtDisplay grf1))
- (win (XtWindow grf1))
- (sgc (car (snd-gcs)))
- (shell (cadr (main-widgets)))
- (scr (DefaultScreen dpy))
- (vis (DefaultVisual dpy scr))
- (depth (cadr (XtGetValues grf1 (list XmNdepth 0))))
- (pix (XCreatePixmap dpy win 10 10 depth))
- (rotpix (XCreatePixmap dpy win 10 10 depth)))
-
- (XDrawText dpy win sgc 50 50 (list (XTextItem "hi" 2 2 '(Font 0))
- (XTextItem "ho" 2 3 '(Font 0))))
-
- (let ((cmap (XCreateColormap dpy win vis AllocNone)))
- (set! cmap (XCopyColormapAndFree dpy cmap))
- (XFreeColormap dpy cmap)
- (if (XCheckTypedWindowEvent dpy win ExposureMask)
- (snd-display ";XCheckTypedWindowEvent: ~A" (XCheckTypedWindowEvent dpy win ExposureMask)))
- (if (XCheckTypedEvent dpy ExposureMask)
- (snd-display ";XCheckTypedEvent: ~A" (XCheckTypedEvent dpy ExposureMask)))
- (XCheckWindowEvent dpy win ExposureMask)
+ (lambda (n)
+ (set! ctr (+ ctr 1))
+ (XmTabCreate n XmINCHES (if (= ctr 1) XmABSOLUTE XmRELATIVE) XmALIGNMENT_BEGINNING "."))
+ (list 1.5 1.5 1.5 1.5))))
+ (tablist (XmTabListInsertTabs #f tabs (length tabs) 0)))
+ (if (not (= (XmTabListTabCount tablist) (length tabs)))
+ (snd-display #__line__ ";tablist len: ~A ~A~%" (XmTabListTabCount tablist) (length tabs)))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 0)) (list 1.5 5 0 0 ".")))
+ (snd-display #__line__ ";XmTabs 0: ~A" (XmTabGetValues (XmTabListGetTab tablist 0))))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 2)) (list 1.5 5 1 0 ".")))
+ (snd-display #__line__ ";XmTabs 2: ~A" (XmTabGetValues (XmTabListGetTab tablist 2))))
+ (let ((copytab (XmTabListCopy tablist 0 0)))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab copytab 0)) (list 1.5 5 0 0 ".")))
+ (snd-display #__line__ ";XmTabListCopy 0: ~A" (XmTabGetValues (XmTabListGetTab copytab 0))))
+ (let ((another (XmTabListRemoveTabs copytab (list 0 1)))
+ (atab (XmTabCreate 3.0 XmINCHES XmABSOLUTE XmALIGNMENT_BEGINNING ".")))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab another 0)) (list 1.5 5 1 0 ".")))
+ (snd-display #__line__ ";XmTabListRemoveTabs: ~A" (XmTabGetValues (XmTabListGetTab another 0))))
+ (XmTabListReplacePositions (XmTabListCopy tablist 0 0) (list 1) (list atab))
+ ;; this (replacepositions) is very prone to segfaults -- *very* poorly implemented!
+ (XmTabSetValue atab 6.0)
+ (XmTabFree atab)
+ (XmTabListFree another))
+ (let ((tabl (XmStringTableProposeTablist
+ (list (XmStringCreateLocalized "a-string") (XmStringCreateLocalized "another")) 2
+ (cadr (main-widgets))
+ 1.0
+ XmABSOLUTE)))
+ (if (not (XmTabList? tabl)) (snd-display #__line__ ";XmStringTableProposeTabList: ~A" tabl))
+ (XmTabListFree tabl)))
+
+ (let ((hname (host-name))) ; from snd-motif.scm
+ (if (not (equal? hname (getenv "HOSTNAME")))
+ (snd-display #__line__ ";host name appears to be ~A or maybe ~A" hname (getenv "HOSTNAME"))))
+ (let ((blu (x->snd-color "blue")))
+ (if (not (Pixel? blu)) (snd-display #__line__ ";x->snd-color can't find blue! ~A" blu))
+ (if (not (equal? (color->list blu) (list 0.0 0.0 1.0)))
+ (snd-display #__line__ ";x->snd-color blue: ~A" (color->list blu))))
+
+ (let* ((tmp (XmStringCreateLocalized "h"))
+ (pm (XmParseMappingCreate (list XmNincludeStatus XmINSERT
+ XmNsubstitute tmp
+ XmNpattern "i"
+ XmNpatternType XmCHARSET_TEXT))))
+ (XmStringFree tmp)
+ (XmParseMappingFree pm)
+ (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
+ (lambda (txt end type tag entry pattern str call)
+ #f))))
+ (XmParseMappingFree pm)
+ (let ((tag (catch #t (lambda ()
+ (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
+ (lambda (txt end type tag entry pattern)
+ #f)))))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmNinvokeParseProc wrong arity: ~A" tag))))
+
+ (let* ((fonts (list "fixed"
+ "-*-times-bold-r-*-*-14-*-*-*-*-*-*-*"
+ "-*-*-medium-i-*-*-18-*-*-*-*-*-*-*"
+ "-*-helvetica-*-*-*-*-18-*-*-*-*-*-*-*"))
+ (tags (list "one" "two" "three" "four"))
+ (colors (list "red" "green" "blue" "orange"))
+ (pixels
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr)))
+ (let ((col (XColor)))
+ (XParseColor dpy cmap "blue" col)
+ (if (or (not (= (.red col) 0))
+ (not (= (.green col) 0))
+ (not (= (.blue col) 65535)))
+ (snd-display #__line__ ";XParseColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col)))
+ (XLookupColor dpy cmap "red" col (XColor))
+ (if (or (not (= (.red col) 65535))
+ (not (= (.green col) 0))
+ (not (= (.blue col) 0)))
+ (snd-display #__line__ ";XLookupColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col))))
+ (map
+ (lambda (color)
+ (let ((col (XColor)))
+ (if (= (XAllocNamedColor dpy cmap color col col) 0)
+ (snd-error (format #f "can't allocate ~A" color))
+ (.pixel col))))
+ colors)))
+ (rendertable (XmRenderTableAddRenditions #f
+ (let ((ctr 0))
+ (map (lambda (r)
+ (set! ctr (+ ctr 1))
+ (XmRenditionCreate (cadr (main-widgets))
+ r
+ (append
+ (if (= ctr 1)
+ (list XmNtabList tablist)
+ '())
+ (list XmNrenditionForeground (list-ref pixels (- ctr 1))
+ XmNfontName (list-ref fonts (- ctr 1))
+ XmNfontType XmFONT_IS_FONT))))
+ tags))
+ (length tags)
+ XmMERGE_NEW)))
+
+ (if (file-exists? "hiho") (delete-file "hiho"))
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (scr (DefaultScreenOfDisplay dpy))
+ (p1 (XmGetPixmap scr "hiho" (car pixels) (cadr pixels))))
+ (if (not (Pixmap? p1)) (snd-display #__line__ ";XmGetPixmap: ~A" p1))
+ (set! p1 (XmGetPixmapByDepth scr "hoho" (car pixels) (cadr pixels) (XDefaultDepth dpy (XScreenNumberOfScreen scr))))
+ (if (not (Pixmap? p1)) (snd-display #__line__ ";XmGetPixmapByDepth: ~A" p1))
+ (XmDestroyPixmap scr p1))
+
+ (let ((tabl (XmStringTableParseStringArray (list "hi" "ho") 2 "hiho" XmCHARSET_TEXT #f 0 #f)))
+ (if (not (XmString? (car tabl))) (snd-display #__line__ ";XmStringTableParseStringArray: ~A" tabl))
+ (let ((strs (XmStringTableUnparse tabl 2 "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
+ (if (not (equal? strs (list "hi" "ho"))) (snd-display #__line__ ";XmStringTableUnparse: ~A" strs)))
+ (let ((str (XmStringTableToXmString tabl 2 #f)))
+ (if (not (XmString? str)) (snd-display #__line__ ";XmStringTableToXmString: ~A" str))
+ (XmStringToXmStringTable str #f)
+ (let ((val (XmStringUnparse str "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
+ (if (not (string=? val "hiho")) (snd-display #__line__ ";XmStringUnparse: ~A" val))
+ (set! val (XmStringUnparse (XmStringCreateLocalized "hi") #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
+ (if (not (string=? val "hi")) (snd-display #__line__ ";XmStringUnparse null tag: ~A" val)))
+ ;; XmCvtXmStringToByteStream test deleted because it seems to be buggy in memory handling
+ (let* ((ind (open-sound "oboe.snd"))
+ (grf1 (car (channel-widgets)))
+ (dpy (XtDisplay grf1))
+ (win (XtWindow grf1))
+ (scr (DefaultScreenOfDisplay dpy))
+ (scrn (XScreenNumberOfScreen scr))
+ (gv (XGCValues)))
+ (if (not (Font? (current-font ind))) (snd-display #__line__ ";current-font: ~A" (current-font ind)))
+ (let ((old-font (current-font))
+ (a-font (load-font "6x12")))
+ (set! (current-font) a-font)
+ (if (not (equal? a-font (current-font)))
+ (snd-display #__line__ ";set current-font: ~A ~A" a-font (current-font)))
+ (set! (current-font ind) old-font)
+ (if (not (equal? old-font (current-font ind)))
+ (snd-display #__line__ ";set current-font with ind: ~A ~A" old-font (current-font ind)))
+ (set! (current-font) a-font)
+ (set! (current-font ind 0) old-font)
+ (if (not (equal? old-font (current-font ind 0)))
+ (snd-display #__line__ ";set current-font with ind/0: ~A ~A" old-font (current-font ind 0)))
+ (set! (current-font) old-font))
+
+ (set! (.foreground gv) (data-color))
+ (set! (.background gv) (basic-color))
+ (set! (.function gv) GXcopy)
+ (let* ((sgc (XtAllocateGC grf1
+ (XDefaultDepth dpy scrn)
+ (logior GCForeground GCBackground GCFunction)
+ gv
+ (logior GCFont GCDashList)
+ 0))
+ (str2 (XmStringCreateLocalized "hiho")))
+ (XmStringDraw dpy win rendertable str2 sgc 10 10 100
+ XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
+ (XmStringDrawImage dpy win rendertable str2 sgc 10 10 100
+ XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
+ (XmStringDrawUnderline dpy win rendertable str2 sgc 10 10 100
+ XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100) str2)
+ (XtGetGC (cadr (main-widgets)) GCForeground gv)
+ (XCopyGC dpy sgc GCFunction sgc)
+ (XCopyArea dpy win win sgc 0 0 100 100 0 0)
+ (XCopyPlane dpy win win sgc 0 0 100 100 0 0 1)
+ (XtReleaseGC grf1 sgc))
+ (close-sound ind))
+ (let ((lc (XmStringLineCount (XmStringCreateLocalized "hiho"))))
+ (if (not (= lc 1)) (snd-display #__line__ ";XmStringLineCount: ~A" lc)))
+ (if (not (XmStringHasSubstring str (XmStringCreateLocalized "hi"))) (snd-display #__line__ ";XmStringHasSubstring?"))))
+
+
+ (if (not (equal? (XmRenderTableGetTags rendertable) (list "one" "two" "three" "four")))
+ (snd-display #__line__ ";tags: ~A~%" (XmRenderTableGetTags rendertable)))
+ (let* ((rend (XmRenderTableGetRendition rendertable "one"))
+ (r (and rend (XmRenditionRetrieve rend
+ (list XmNrenditionForeground 0
+ XmNfontName 0
+ XmNfontType 0
+ XmNtag 0)))))
+ (if (and rend r)
+ (begin
+ (if (or (not (string=? (list-ref r 7) "one"))
+ (not (string=? (list-ref r 3) "fixed")))
+ (snd-display #__line__ ";rendertable: ~A" r))
+ (XmRenditionUpdate rend (list XmNstrikethruType XmSINGLE_LINE))
+ (if (not (= (cadr (XmRenditionRetrieve rend (list XmNstrikethruType 0))) XmSINGLE_LINE))
+ (snd-display #__line__ ";XmRenditionUpdate: ~A ~A" (cadr (XtGetValues rend (list XmNstrikethruType 0))) XmSINGLE_LINE)))
+ (snd-display #__line__ ";r and rend: ~A ~A~%" r rend)))
+ (let ((r1 (XmRenditionCreate (cadr (main-widgets)) "r1" (list XmNfontName "fixed"))))
+ (XmRenditionFree r1))
+
+ (if (not (equal? (XmDropSiteQueryStackingOrder (list-ref (main-widgets) 4)) (list #f)))
+ (snd-display #__line__ ";XmDropSiteQueryStackingOrder: ~A" (XmDropSiteQueryStackingOrder (list-ref (main-widgets) 4)) (list #f)))
+ (let ((tab (XmStringComponentCreate XmSTRING_COMPONENT_TAB 0 #f))
+ (row #f)
+ (table '())
+ (our-tags tags))
+ (for-each
+ (lambda (word)
+ (let ((entry (XmStringGenerate word
+ #f
+ XmCHARSET_TEXT
+ (car our-tags))))
+ (if (XmStringIsVoid entry) (snd-display #__line__ ";~A is void?" entry))
+ (if (XmStringEmpty entry) (snd-display #__line__ ";~A is empty?" entry))
+
+ (if row
+ (let ((tmp (XmStringConcat row tab)))
+ (XmStringFree row)
+ (set! row (XmStringConcatAndFree tmp entry)))
+ (set! row entry))
+ (set! our-tags (cdr our-tags))
+ (if (null? our-tags)
+ (begin
+ (set! our-tags tags)
+ (set! table (cons row table))
+ (set! row #f)))))
+ (list "this" "is" "a" "test" "of" "the" "renditions" "and" "rendertables"
+ "perhaps" "all" "will" "go" "well" "and" "then" "again" "perhaps" "not"))
+ (let* ((n (car table))
+ (c (XmStringInitContext n))
+ (ctr 0)
+ (happy #t))
+ (do ((i 0 (+ 1 i)))
+ ((not happy))
+ (let ((type (XmStringGetNextTriple (cadr c))))
+ (if (= (car type) XmSTRING_COMPONENT_TEXT)
+ (if (or (not (= (cadr type) (list-ref (list 0 0 2 0 0 0 4 0 0 0 3 0 0 0 4) i)))
+ (not (string=? (caddr type)
+ (list-ref (list "o" "o" "go" "o" "o" "o" "well" "o" "o" "o" "and" "o" "o" "o" "then") i))))
+ (snd-display #__line__ ";component ~A -> ~A" i (cdr type)))
+ (if (not (= (car type) XmSTRING_COMPONENT_TAB))
+ (if (= (car type) XmSTRING_COMPONENT_END)
+ (set! happy #f))))))
+ (XmStringFreeContext (cadr c))))))
+
+ (XtAppAddActions (car (main-widgets))
+ (list (list "try1" (lambda (w e strs)
+ (snd-display #__line__ ";try1: ~A~%" strs)))
+ (list "try2" (lambda (w e strs)
+ (snd-display #__line__ ";try2: ~A~%" strs)))))
+ (let* ((tab (XtParseTranslationTable
+ (format #f "Ctrl <Key>osfLeft: try1()~%Ctrl <Key>osfRight: try2()~%Ctrl <Key>osfUp: try1(hiho)~%Ctrl <Key>osfDown: try2(down, up)~%")))
+ (pane (add-main-pane "hiho" xmTextWidgetClass '())))
+ (XtOverrideTranslations pane tab))
+ (if (defined? 'XtAddActions)
+ (XtAddActions (list (list "try3" (lambda (w e strs)
+ (snd-display #__line__ ";try3: ~A~%" strs)))
+ (list "try4" (lambda (w e strs)
+ (snd-display #__line__ ";try4: ~A~%" strs))))))
+
+ (let ((XmNhiho (add-resource "hiho" 0)))
+ (if (not (string=? XmNhiho "hiho")) (snd-display #__line__ ";add-resource XmNhiho: ~A" XmNhiho)))
+
+ (open-sound "cardinal.snd")
+ (let* ((mouse_width 32)
+ (mouse_height 32)
+ (mouse_bits (list
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
+ #x80 #xff #xff #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
+ #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
+ #x80 #x00 #x01 #x01 #x80 #xff #xff #x01 #x80 #x00 #x00 #x01
+ #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
+ #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
+ #x80 #x00 #x00 #x01 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00
+ #x00 #x06 #x60 #x00 #x00 #xf8 #x1f #x00 #x00 #x00 #x00 #x00
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00))
+ (rb (list
+ #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
+ #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
+ (iconw (list-ref (sound-widgets) 8))
+ (dpy (XtDisplay iconw))
+ (win (XtWindow iconw)))
+ (XCreateBitmapFromData dpy win rb 16 12)
+ (XCreateBitmapFromData dpy win mouse_bits mouse_width mouse_height)
+ (XCreatePixmapFromBitmapData dpy win mouse_bits 32 32 (white-pixel) (black-pixel) 8))
+
+ (let* ((grf1 (car (channel-widgets)))
+ (dpy (XtDisplay grf1))
+ (win (XtWindow grf1))
+ (sgc (car (snd-gcs)))
+ (shell (cadr (main-widgets)))
+ (scr (DefaultScreen dpy))
+ (vis (DefaultVisual dpy scr))
+ (depth (cadr (XtGetValues grf1 (list XmNdepth 0))))
+ (pix (XCreatePixmap dpy win 10 10 depth))
+ (rotpix (XCreatePixmap dpy win 10 10 depth)))
+
+ (XDrawText dpy win sgc 50 50 (list (XTextItem "hi" 2 2 '(Font 0))
+ (XTextItem "ho" 2 3 '(Font 0))))
+
+ (let ((cmap (XCreateColormap dpy win vis AllocNone)))
+ (set! cmap (XCopyColormapAndFree dpy cmap))
+ (XFreeColormap dpy cmap)
+ (if (XCheckTypedWindowEvent dpy win ExposureMask)
+ (snd-display #__line__ ";XCheckTypedWindowEvent: ~A" (XCheckTypedWindowEvent dpy win ExposureMask)))
+ (if (XCheckTypedEvent dpy ExposureMask)
+ (snd-display #__line__ ";XCheckTypedEvent: ~A" (XCheckTypedEvent dpy ExposureMask)))
+ (XCheckWindowEvent dpy win ExposureMask)
; (if (XCheckIfEvent dpy (lambda (d e data) #f) #f)
- ; (snd-display ";XCheckIfEvent: ~A" (XCheckIfEvent dpy (lambda (d e data) #f) #f)))
- (XCirculateSubwindows dpy win RaiseLowest)
- (XCirculateSubwindowsUp dpy win)
- (XCirculateSubwindowsDown dpy win)
- (let ((wc (XWindowChanges 10 10 100 100 10 win 0)))
- (if (not (= (.stack_mode wc) 0)) (snd-display ";stack_mode wc: ~A" (.stack_mode wc)))
- (if (not (equal? (.sibling wc) win)) (snd-display ";sibling wc: ~A" (.sibling wc)))
- (if (not (= (.x wc) 10)) (snd-display ";x wc: ~A" (.x wc)))
- (if (not (= (.y wc) 10)) (snd-display ";y wc: ~A" (.y wc)))
- (if (not (= (.width wc) 100)) (snd-display ";width wc: ~A" (.width wc)))
- (if (not (= (.height wc) 100)) (snd-display ";height wc: ~A" (.height wc)))
- (if (not (= (.border_width wc) 10)) (snd-display ";border_width wc: ~A" (.border_width wc))))
- (if (defined? 'XpmImage)
- (let ((xp (XpmImage 10 10 0 1 0)))
- (if (not (= (.cpp xp) 0)) (snd-display ";cpp xp: ~A" (.cpp xp)))
- (if (not (= (.ncolors xp) 1)) (snd-display ";ncolors xp: ~A" (.ncolors xp)))))
- )
- (XmObjectAtPoint shell 100 100)
- (if (not (string=? (XmGetAtomName dpy XA_STRING) "STRING")) (snd-display ";XmGetAtomName: ~A" (XmGetAtomName dpy XA_STRING)))
- (if (not (XmTargetsAreCompatible dpy (list XA_STRING) 1 (list XA_STRING) 1)) (snd-display ";XmTargetsAreCompatible"))
- (XmUpdateDisplay grf1)
- (let ((lines (XmWidgetGetBaselines (list-ref (main-widgets) 4))))
- (if (not lines) (snd-display ";XmWidgetGetBaselines?"))
- (if (< (length lines) 4) (snd-display ";no listener text?? ~A" lines)))
- (let ((r (XmWidgetGetDisplayRect (list-ref (sound-widgets) 8))))
- (if (not (XRectangle? r)) (snd-display ";XmWidgetGetDisplayRect: ~A" r)))
- (XDrawImageString dpy (list 'Window (cadr pix)) sgc 0 10 "hiho" 4)
- (let* ((data (XtCalloc (* 11 11 depth) 1))
- (before (XCreateImage dpy vis depth XYPixmap 0 data 10 10 8 0))
- (newimage (XGetSubImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap before 0 0)))
- (XSubImage newimage 0 0 3 3)
- (if (not (= (.bytes_per_line newimage) 2)) (snd-display ";bytes_per_line: ~A" (.bytes_per_line newimage)))
- (if (not (= (.byte_order newimage) 0)) (snd-display ";byte_order: ~A" (.byte_order newimage)))
- (if (not (= (.bitmap_pad newimage) 8)) (snd-display ";bitmap_pad: ~A" (.bitmap_pad newimage)))
- (if (not (= (.bitmap_bit_order newimage) 0)) (snd-display ";bitmap_bit_order: ~A" (.bitmap_bit_order newimage)))
- (if (not (= (.bitmap_unit newimage) 32)) (snd-display ";bitmap_unit: ~A" (.bitmap_unit newimage)))
-; (if (not (= (.obdata newimage) 0)) (snd-display ";obdata: ~A" (.obdata newimage)))
- (if (not (= (.xoffset newimage) 0)) (snd-display ";xoffset: ~A" (.xoffset newimage)))
- (XPutPixel before 1 1 (basic-color))
- (XGetPixel before 1 1)
- (XPutImage dpy (list 'Window (cadr rotpix)) sgc before 0 0 0 0 10 10)
- (XAddPixel before 1)
- (if (> (.bits_per_pixel before) 123) (snd-display ";bits_per_pixel: ~A" (.bits_per_pixel before)))
- (XmInstallImage before "before_image")
- (XmUninstallImage before)
- (if (defined? 'XpmAttributes)
- (let ((i11 (XGetImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap))
- (attr (XpmAttributes))
- (vals (XtGetValues (cadr (main-widgets)) (list XmNcolormap 0 XmNdepth 0)))
- (sym (XpmColorSymbol "basiccolor" #f (basic-color))))
- (if (not (string=? (.name sym) "basiccolor")) (snd-display ";.name colorsymbol: ~A" (.name sym)))
- (set! (.name sym) "hiho")
- (if (not (string=? (.name sym) "hiho")) (snd-display ";set .name colorsymbol: ~A" (.name sym)))
- (set! (.visual attr) vis)
- (if (not (equal? vis (.visual attr))) (snd-display ";visual xpm attr: ~A" (.visual attr)))
- (if (not (list? (.colorsymbols attr))) (snd-display ";.colorsymbols attr: ~A" (.colorsymbols attr)))
- (set! (.colorsymbols attr) (list sym))
- (set! (.pixel sym) (basic-color))
- (set! (.numsymbols attr) 1)
- (if (not (equal? 1 (.numsymbols attr))) (snd-display ";numsymbols xpm attr: ~A" (.numsymbols attr)))
- (set! (.depth attr) (list-ref vals 3))
- (if (not (equal? (list-ref vals 3) (.depth attr))) (snd-display ";depth xpm attr: ~A" (.depth attr)))
- (set! (.colormap attr) (list-ref vals 1))
- (if (not (equal? (list-ref vals 1) (.colormap attr))) (snd-display ";colormap xpm attr: ~A" (.colormap attr)))
- (set! (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual))
- (if (not (= (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual)))
- (snd-display ";valuemask: ~A" (.valuemask attr)))
- (if (not (= (.x_hotspot attr) 0)) (snd-display ";x_hotspot: ~A" (.x_hotspot attr)))
- (if (not (= (.y_hotspot attr) 0)) (snd-display ";y_hotspot: ~A" (.y_hotspot attr)))
- (if (not (= (.npixels attr) 0)) (snd-display ";npixels: ~A" (.npixels attr)))
- (let ((err (XpmCreatePixmapFromData dpy win
- (list "16 14 6 1"
- " c None s None"
- ". c gray50"
- "X c black"
- "o c white"
- "O c yellow"
- "- c ivory2 s basiccolor"
- "------.XXX.-----"
- "-----X.ooo.X----"
- "----..oXXXo..---"
- "----XoX...XoX---"
- "----XoX.--XoX.--"
- "----XoX.--XoX.--"
- "---XXXXXXXXXXX--"
- "---XOOOOOOOOOX.-"
- "---XO.......OX.-"
- "---XOOOOOOOOOX.-"
- "---XO.......OX.-"
- "---XOOOOOOOOOX.-"
- "---XXXXXXXXXXX.-"
- "----...........-")
- attr)))
- (if (or (not (= (car err) XpmSuccess))
- (not (Pixmap? (cadr err))))
- (snd-display ";XpmCreatePixmapFromData: ~A" err)))
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (button (XmCreatePushButton shell "button" '()))
- (status-and-whatnot (XpmReadFileToPixmap dpy (XRootWindowOfScreen (XtScreen shell)) "bullet.xpm" #f))
- (status (car status-and-whatnot))
- (pixmap (cadr status-and-whatnot))
- (pixmap1 (caddr status-and-whatnot)))
- (if (not (string=? (XpmGetErrorString XpmSuccess) "XpmSuccess"))
- (snd-display ";XpmGetErrorString: ~A" (XpmGetErrorString XpmSuccess)))
- (if (not (= status XpmSuccess))
- (snd-display "; XpmError ReadFileToPixmap: ~A" (XpmGetErrorString status)))
- (XtVaSetValues button (list XmNlabelType XmPIXMAP
- XmNlabelPixmap pixmap))
- (XpmWriteFileFromPixmap dpy "test.xpm" pixmap pixmap1 #f)
- (XpmCreateDataFromPixmap dpy pixmap pixmap1 #f)
- (let* ((status (XpmReadFileToXpmImage "bullet.xpm"))
- (symb (XpmColorSymbol "Foreground" "green" (basic-color)))
- (attr (XpmAttributes)))
- (if (not (XpmImage? status))
- (snd-display "; XpmError ReadFileToXpmImage: ~A" (XpmGetErrorString status)))
- (set! (.valuemask attr) XpmColorSymbols)
- (XpmCreatePixmapFromXpmImage dpy (XRootWindowOfScreen (XtScreen shell)) status attr)
- (XpmCreateXpmImageFromPixmap dpy pixmap pixmap1 attr)
- (for-each
- (lambda (func val name)
- (set! (func attr) val)
- (if (not (equal? (func attr) val)) (snd-display ";attr ~A ~A" name (func attr))))
- (list .valuemask .depth .width .x_hotspot .y_hotspot .cpp .npixels .ncolors)
- (list 0 0 0 0 0 0 0 0)
- (list 'valuemask 'depth 'width 'x_hotspot 'y_hotspot 'cpp 'npixels 'ncolors)))
- )
- (XDestroyImage i11)))
-
- (XDestroyImage before)
- (XFreePixmap dpy pix)
- (XVisualIDFromVisual vis)
- (XGrabServer dpy)
- (XUngrabServer dpy)
- (XGrabPointer dpy win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
- (XUngrabPointer dpy (list 'Time CurrentTime))
- (XGrabKeyboard dpy win #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
- (XUngrabKeyboard dpy (list 'Time CurrentTime))
- (XGrabKey dpy AnyKey AnyModifier win #t GrabModeSync GrabModeSync)
- (XUngrabKey dpy AnyKey AnyModifier win)
- (XGrabButton dpy AnyButton AnyModifier win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
- (XUngrabButton dpy AnyButton AnyModifier win)
- (XtGrabPointer shell #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
- (XtUngrabPointer shell (list 'Time CurrentTime))
- (XtGrabKeyboard shell #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
- (XtUngrabKeyboard shell (list 'Time CurrentTime))
- (XtGrabKey shell (list 'KeyCode AnyKey) AnyModifier #t GrabModeSync GrabModeSync)
- (XtUngrabKey shell (list 'KeyCode AnyKey) AnyModifier)
- (XtGrabButton shell AnyButton AnyModifier #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
- (XtUngrabButton shell AnyButton AnyModifier)
- ))
-
- (let* ((sgc (car (snd-gcs)))
- (grf1 (car (channel-widgets)))
- (dpy (XtDisplay grf1))
- (win (XtWindow grf1))
- (shl (cadr (main-widgets))))
- (let ((wid (XtWindowToWidget dpy win)))
- (if (not (equal? wid grf1))
- (snd-display ";XtWindowToWidget: ~A ~A" grf1 win)))
-; these are causing: X Error of failed request: BadAccess (attempt to access private resource denied)
-; (if (not (equal? (XGetTransientForHint dpy win) (list 0 #f)))
-; (snd-display ";XGetTransientForHint: ~A" (XGetTransientForHint dpy win)))
- (if (not (equal? (XGetErrorText dpy BadColor #f 9) (list 0 "BadColor")))
- (snd-display ";XGetErrorText: ~A" (XGetErrorText dpy BadColor #f 9)))
- (if (not (equal? (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2) (list 12 10 10 500 400)))
- (snd-display ";XGeometry: ~A" (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2)))
- (if (< (XEventsQueued dpy QueuedAlready) 0)
- (snd-display ";XEventsQueued: ~A" (XEventsQueued dpy QueuedAlready)))
-; (let ((coords (XTranslateCoordinates dpy (XtWindow shl) win 10 10)))
-; (if (not (car coords))
-; (snd-display ";XTranslateCoordinates: ~A" coords)))
- (let ((coords (XtTranslateCoords shl 10 10)))
- (if (not (number? (car coords)))
- (snd-display ";XtTranslateCoords: ~A" coords)))
- (if (not (XmIsVendorShell shl)) (snd-display ";XmIsVendorShell?"))
- (if (XmIsPrimitive shl) (snd-display ";XmIsPrimitive?"))
- (if (XmIsManager shl) (snd-display ";XmIsManager?"))
- (if (XmIsIconGadget shl) (snd-display ";XmIsIconGadget?"))
- (if (XmIsGadget shl) (snd-display ";XmIsGadget?"))
- (if (XmIsIconHeader shl) (snd-display ";XmIsHeader?"))
- (if (XmIsDropTransfer shl) (snd-display ";XmIsDropTransfer?"))
- (if (XmIsDropSiteManager shl) (snd-display ";XmIsDropSiteManager?"))
- (if (XmIsDragContext shl) (snd-display ";XmIsDragContext?"))
- (if (XmIsDragIconObjectClass shl) (snd-display ";XmIsDragIconObjectClass?"))
- (if (XmIsMessageBox shl) (snd-display ";XmIsMessageBox?"))
- (if (XmIsScreen shl) (snd-display ";XmIsScreen?"))
- (if (XmIsDisplay shl) (snd-display ";XmIsDisplay?"))
-
- (let ((val 0))
- (XSetErrorHandler (lambda (dpy e)
- (set! val (.error_code e))))
- (XGetAtomName dpy '(Atom 0))
- (if (not (= val 5)) (snd-display ";XSetErrorHandler: ~A" val)))
-
- (XDrawImageString dpy win sgc 10 10 "hiho" 4)
- (XDrawRectangle dpy win sgc 0 0 10 10)
- (XDrawString dpy win sgc 10 10 "hi" 2)
- (XDrawSegments dpy win sgc (list (XSegment 1 1 2 20) (XSegment 3 3 40 4)) 2)
- (XDrawRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
- (XFillRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
- (XDrawRectangle dpy win sgc 10 10 10 10)
- (XFillRectangle dpy win sgc 10 10 10 10)
- (XDrawPoints dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
- (XDrawPoint dpy win sgc 10 10)
- (XDrawLines dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
- (XDrawLine dpy win sgc 10 10 20 20)
- (XDrawArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
- (XFillArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
- (XDrawArc dpy win sgc 0 0 10 10 45 90)
- (XFillArc dpy win sgc 0 0 10 10 45 90)
- (XFillPolygon dpy win sgc (list (XPoint 0 0) (XPoint 0 10) (XPoint 10 10) (XPoint 10 0) (XPoint 0 0)) 5 Convex CoordModeOrigin)
- (XClearArea dpy win 10 10 20 20 #f)
- (XClearWindow dpy win))
-
- (close-sound)
-
- (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
- (val1 0))
- (define (call1 w c i)
- (set! val1 (+ 1 val1)))
- (let ((descr (XtAddCallback button XmNactivateCallback call1 #f)))
- (XtCallCallbacks button XmNactivateCallback #f)
- (if (not (= val1 1))
- (snd-display ";XtCallCallbacks val1: ~A" val1))
- (XtRemoveCallback button XmNactivateCallback descr)
- (let ((calls (XtHasCallbacks button XmNactivateCallback)))
- (if (not (= calls XtCallbackHasNone))
- (snd-display ";XtRemoveCallbacks: ~A" calls))))
- (XtUnmanageChild button)
+ ; (snd-display #__line__ ";XCheckIfEvent: ~A" (XCheckIfEvent dpy (lambda (d e data) #f) #f)))
+ (XCirculateSubwindows dpy win RaiseLowest)
+ (XCirculateSubwindowsUp dpy win)
+ (XCirculateSubwindowsDown dpy win)
+ (let ((wc (XWindowChanges 10 10 100 100 10 win 0)))
+ (if (not (= (.stack_mode wc) 0)) (snd-display #__line__ ";stack_mode wc: ~A" (.stack_mode wc)))
+ (if (not (equal? (.sibling wc) win)) (snd-display #__line__ ";sibling wc: ~A" (.sibling wc)))
+ (if (not (= (.x wc) 10)) (snd-display #__line__ ";x wc: ~A" (.x wc)))
+ (if (not (= (.y wc) 10)) (snd-display #__line__ ";y wc: ~A" (.y wc)))
+ (if (not (= (.width wc) 100)) (snd-display #__line__ ";width wc: ~A" (.width wc)))
+ (if (not (= (.height wc) 100)) (snd-display #__line__ ";height wc: ~A" (.height wc)))
+ (if (not (= (.border_width wc) 10)) (snd-display #__line__ ";border_width wc: ~A" (.border_width wc))))
+ (if (defined? 'XpmImage)
+ (let ((xp (XpmImage 10 10 0 1 0)))
+ (if (not (= (.cpp xp) 0)) (snd-display #__line__ ";cpp xp: ~A" (.cpp xp)))
+ (if (not (= (.ncolors xp) 1)) (snd-display #__line__ ";ncolors xp: ~A" (.ncolors xp)))))
+ )
+ (XmObjectAtPoint shell 100 100)
+ (if (not (string=? (XmGetAtomName dpy XA_STRING) "STRING")) (snd-display #__line__ ";XmGetAtomName: ~A" (XmGetAtomName dpy XA_STRING)))
+ (if (not (XmTargetsAreCompatible dpy (list XA_STRING) 1 (list XA_STRING) 1)) (snd-display #__line__ ";XmTargetsAreCompatible"))
+ (XmUpdateDisplay grf1)
+ (let ((lines (XmWidgetGetBaselines (list-ref (main-widgets) 4))))
+ (if (not lines) (snd-display #__line__ ";XmWidgetGetBaselines?"))
+ (if (< (length lines) 4) (snd-display #__line__ ";no listener text?? ~A" lines)))
+ (let ((r (XmWidgetGetDisplayRect (list-ref (sound-widgets) 8))))
+ (if (not (XRectangle? r)) (snd-display #__line__ ";XmWidgetGetDisplayRect: ~A" r)))
+ (XDrawImageString dpy (list 'Window (cadr pix)) sgc 0 10 "hiho" 4)
+ (let* ((data (XtCalloc (* 11 11 depth) 1))
+ (before (XCreateImage dpy vis depth XYPixmap 0 data 10 10 8 0))
+ (newimage (XGetSubImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap before 0 0)))
+ (XSubImage newimage 0 0 3 3)
+ (if (not (= (.bytes_per_line newimage) 2)) (snd-display #__line__ ";bytes_per_line: ~A" (.bytes_per_line newimage)))
+ (if (not (= (.byte_order newimage) 0)) (snd-display #__line__ ";byte_order: ~A" (.byte_order newimage)))
+ (if (not (= (.bitmap_pad newimage) 8)) (snd-display #__line__ ";bitmap_pad: ~A" (.bitmap_pad newimage)))
+ (if (not (= (.bitmap_bit_order newimage) 0)) (snd-display #__line__ ";bitmap_bit_order: ~A" (.bitmap_bit_order newimage)))
+ (if (not (= (.bitmap_unit newimage) 32)) (snd-display #__line__ ";bitmap_unit: ~A" (.bitmap_unit newimage)))
+ ; (if (not (= (.obdata newimage) 0)) (snd-display #__line__ ";obdata: ~A" (.obdata newimage)))
+ (if (not (= (.xoffset newimage) 0)) (snd-display #__line__ ";xoffset: ~A" (.xoffset newimage)))
+ (XPutPixel before 1 1 (basic-color))
+ (XGetPixel before 1 1)
+ (XPutImage dpy (list 'Window (cadr rotpix)) sgc before 0 0 0 0 10 10)
+ (XAddPixel before 1)
+ (if (> (.bits_per_pixel before) 123) (snd-display #__line__ ";bits_per_pixel: ~A" (.bits_per_pixel before)))
+ (XmInstallImage before "before_image")
+ (XmUninstallImage before)
+ (if (defined? 'XpmAttributes)
+ (let ((i11 (XGetImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap))
+ (attr (XpmAttributes))
+ (vals (XtGetValues (cadr (main-widgets)) (list XmNcolormap 0 XmNdepth 0)))
+ (sym (XpmColorSymbol "basiccolor" #f (basic-color))))
+ (if (not (string=? (.name sym) "basiccolor")) (snd-display #__line__ ";.name colorsymbol: ~A" (.name sym)))
+ (set! (.name sym) "hiho")
+ (if (not (string=? (.name sym) "hiho")) (snd-display #__line__ ";set .name colorsymbol: ~A" (.name sym)))
+ (set! (.visual attr) vis)
+ (if (not (equal? vis (.visual attr))) (snd-display #__line__ ";visual xpm attr: ~A" (.visual attr)))
+ (if (not (list? (.colorsymbols attr))) (snd-display #__line__ ";.colorsymbols attr: ~A" (.colorsymbols attr)))
+ (set! (.colorsymbols attr) (list sym))
+ (set! (.pixel sym) (basic-color))
+ (set! (.numsymbols attr) 1)
+ (if (not (equal? 1 (.numsymbols attr))) (snd-display #__line__ ";numsymbols xpm attr: ~A" (.numsymbols attr)))
+ (set! (.depth attr) (list-ref vals 3))
+ (if (not (equal? (list-ref vals 3) (.depth attr))) (snd-display #__line__ ";depth xpm attr: ~A" (.depth attr)))
+ (set! (.colormap attr) (list-ref vals 1))
+ (if (not (equal? (list-ref vals 1) (.colormap attr))) (snd-display #__line__ ";colormap xpm attr: ~A" (.colormap attr)))
+ (set! (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual))
+ (if (not (= (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual)))
+ (snd-display #__line__ ";valuemask: ~A" (.valuemask attr)))
+ (if (not (= (.x_hotspot attr) 0)) (snd-display #__line__ ";x_hotspot: ~A" (.x_hotspot attr)))
+ (if (not (= (.y_hotspot attr) 0)) (snd-display #__line__ ";y_hotspot: ~A" (.y_hotspot attr)))
+ (if (not (= (.npixels attr) 0)) (snd-display #__line__ ";npixels: ~A" (.npixels attr)))
+ (let ((err (XpmCreatePixmapFromData dpy win
+ (list "16 14 6 1"
+ " c None s None"
+ ". c gray50"
+ "X c black"
+ "o c white"
+ "O c yellow"
+ "- c ivory2 s basiccolor"
+ "------.XXX.-----"
+ "-----X.ooo.X----"
+ "----..oXXXo..---"
+ "----XoX...XoX---"
+ "----XoX.--XoX.--"
+ "----XoX.--XoX.--"
+ "---XXXXXXXXXXX--"
+ "---XOOOOOOOOOX.-"
+ "---XO.......OX.-"
+ "---XOOOOOOOOOX.-"
+ "---XO.......OX.-"
+ "---XOOOOOOOOOX.-"
+ "---XXXXXXXXXXX.-"
+ "----...........-")
+ attr)))
+ (if (or (not (= (car err) XpmSuccess))
+ (not (Pixmap? (cadr err))))
+ (snd-display #__line__ ";XpmCreatePixmapFromData: ~A" err)))
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (button (XmCreatePushButton shell "button" '()))
+ (status-and-whatnot (XpmReadFileToPixmap dpy (XRootWindowOfScreen (XtScreen shell)) "bullet.xpm" #f))
+ (status (car status-and-whatnot))
+ (pixmap (cadr status-and-whatnot))
+ (pixmap1 (caddr status-and-whatnot)))
+ (if (not (string=? (XpmGetErrorString XpmSuccess) "XpmSuccess"))
+ (snd-display #__line__ ";XpmGetErrorString: ~A" (XpmGetErrorString XpmSuccess)))
+ (if (not (= status XpmSuccess))
+ (snd-display #__line__ "; XpmError ReadFileToPixmap: ~A" (XpmGetErrorString status)))
+ (XtVaSetValues button (list XmNlabelType XmPIXMAP
+ XmNlabelPixmap pixmap))
+ (XpmWriteFileFromPixmap dpy "test.xpm" pixmap pixmap1 #f)
+ (XpmCreateDataFromPixmap dpy pixmap pixmap1 #f)
+ (let* ((status (XpmReadFileToXpmImage "bullet.xpm"))
+ (symb (XpmColorSymbol "Foreground" "green" (basic-color)))
+ (attr (XpmAttributes)))
+ (if (not (XpmImage? status))
+ (snd-display #__line__ "; XpmError ReadFileToXpmImage: ~A" (XpmGetErrorString status)))
+ (set! (.valuemask attr) XpmColorSymbols)
+ (XpmCreatePixmapFromXpmImage dpy (XRootWindowOfScreen (XtScreen shell)) status attr)
+ (XpmCreateXpmImageFromPixmap dpy pixmap pixmap1 attr)
+ (for-each
+ (lambda (func val name)
+ (set! (func attr) val)
+ (if (not (equal? (func attr) val)) (snd-display #__line__ ";attr ~A ~A" name (func attr))))
+ (list .valuemask .depth .width .x_hotspot .y_hotspot .cpp .npixels .ncolors)
+ (list 0 0 0 0 0 0 0 0)
+ (list 'valuemask 'depth 'width 'x_hotspot 'y_hotspot 'cpp 'npixels 'ncolors)))
+ )
+ (XDestroyImage i11)))
+
+ (XDestroyImage before)
+ (XFreePixmap dpy pix)
+ (XVisualIDFromVisual vis)
+ (XGrabServer dpy)
+ (XUngrabServer dpy)
+ (XGrabPointer dpy win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
+ (XUngrabPointer dpy (list 'Time CurrentTime))
+ (XGrabKeyboard dpy win #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
+ (XUngrabKeyboard dpy (list 'Time CurrentTime))
+ (XGrabKey dpy AnyKey AnyModifier win #t GrabModeSync GrabModeSync)
+ (XUngrabKey dpy AnyKey AnyModifier win)
+ (XGrabButton dpy AnyButton AnyModifier win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
+ (XUngrabButton dpy AnyButton AnyModifier win)
+ (XtGrabPointer shell #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
+ (XtUngrabPointer shell (list 'Time CurrentTime))
+ (XtGrabKeyboard shell #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
+ (XtUngrabKeyboard shell (list 'Time CurrentTime))
+ (XtGrabKey shell (list 'KeyCode AnyKey) AnyModifier #t GrabModeSync GrabModeSync)
+ (XtUngrabKey shell (list 'KeyCode AnyKey) AnyModifier)
+ (XtGrabButton shell AnyButton AnyModifier #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
+ (XtUngrabButton shell AnyButton AnyModifier)
+ ))
+
+ (let* ((sgc (car (snd-gcs)))
+ (grf1 (car (channel-widgets)))
+ (dpy (XtDisplay grf1))
+ (win (XtWindow grf1))
+ (shl (cadr (main-widgets))))
+ (let ((wid (XtWindowToWidget dpy win)))
+ (if (not (equal? wid grf1))
+ (snd-display #__line__ ";XtWindowToWidget: ~A ~A" grf1 win)))
+ ; these are causing: X Error of failed request: BadAccess (attempt to access private resource denied)
+ ; (if (not (equal? (XGetTransientForHint dpy win) (list 0 #f)))
+ ; (snd-display #__line__ ";XGetTransientForHint: ~A" (XGetTransientForHint dpy win)))
+ (if (not (equal? (XGetErrorText dpy BadColor #f 9) (list 0 "BadColor")))
+ (snd-display #__line__ ";XGetErrorText: ~A" (XGetErrorText dpy BadColor #f 9)))
+ (if (not (equal? (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2) (list 12 10 10 500 400)))
+ (snd-display #__line__ ";XGeometry: ~A" (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2)))
+ (if (< (XEventsQueued dpy QueuedAlready) 0)
+ (snd-display #__line__ ";XEventsQueued: ~A" (XEventsQueued dpy QueuedAlready)))
+ ; (let ((coords (XTranslateCoordinates dpy (XtWindow shl) win 10 10)))
+ ; (if (not (car coords))
+ ; (snd-display #__line__ ";XTranslateCoordinates: ~A" coords)))
+ (let ((coords (XtTranslateCoords shl 10 10)))
+ (if (not (number? (car coords)))
+ (snd-display #__line__ ";XtTranslateCoords: ~A" coords)))
+ (if (not (XmIsVendorShell shl)) (snd-display #__line__ ";XmIsVendorShell?"))
+ (if (XmIsPrimitive shl) (snd-display #__line__ ";XmIsPrimitive?"))
+ (if (XmIsManager shl) (snd-display #__line__ ";XmIsManager?"))
+ (if (XmIsIconGadget shl) (snd-display #__line__ ";XmIsIconGadget?"))
+ (if (XmIsGadget shl) (snd-display #__line__ ";XmIsGadget?"))
+ (if (XmIsIconHeader shl) (snd-display #__line__ ";XmIsHeader?"))
+ (if (XmIsDropTransfer shl) (snd-display #__line__ ";XmIsDropTransfer?"))
+ (if (XmIsDropSiteManager shl) (snd-display #__line__ ";XmIsDropSiteManager?"))
+ (if (XmIsDragContext shl) (snd-display #__line__ ";XmIsDragContext?"))
+ (if (XmIsDragIconObjectClass shl) (snd-display #__line__ ";XmIsDragIconObjectClass?"))
+ (if (XmIsMessageBox shl) (snd-display #__line__ ";XmIsMessageBox?"))
+ (if (XmIsScreen shl) (snd-display #__line__ ";XmIsScreen?"))
+ (if (XmIsDisplay shl) (snd-display #__line__ ";XmIsDisplay?"))
+
+ (let ((val 0))
+ (XSetErrorHandler (lambda (dpy e)
+ (set! val (.error_code e))))
+ (XGetAtomName dpy '(Atom 0))
+ (if (not (= val 5)) (snd-display #__line__ ";XSetErrorHandler: ~A" val)))
+
+ (XDrawImageString dpy win sgc 10 10 "hiho" 4)
+ (XDrawRectangle dpy win sgc 0 0 10 10)
+ (XDrawString dpy win sgc 10 10 "hi" 2)
+ (XDrawSegments dpy win sgc (list (XSegment 1 1 2 20) (XSegment 3 3 40 4)) 2)
+ (XDrawRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
+ (XFillRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
+ (XDrawRectangle dpy win sgc 10 10 10 10)
+ (XFillRectangle dpy win sgc 10 10 10 10)
+ (XDrawPoints dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
+ (XDrawPoint dpy win sgc 10 10)
+ (XDrawLines dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
+ (XDrawLine dpy win sgc 10 10 20 20)
+ (XDrawArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
+ (XFillArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
+ (XDrawArc dpy win sgc 0 0 10 10 45 90)
+ (XFillArc dpy win sgc 0 0 10 10 45 90)
+ (XFillPolygon dpy win sgc (list (XPoint 0 0) (XPoint 0 10) (XPoint 10 10) (XPoint 10 0) (XPoint 0 0)) 5 Convex CoordModeOrigin)
+ (XClearArea dpy win 10 10 20 20 #f)
+ (XClearWindow dpy win))
+
+ (close-sound)
+
+ (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
+ (val1 0))
+ (define (call1 w c i)
+ (set! val1 (+ 1 val1)))
+ (let ((descr (XtAddCallback button XmNactivateCallback call1 #f)))
+ (XtCallCallbacks button XmNactivateCallback #f)
+ (if (not (= val1 1))
+ (snd-display #__line__ ";XtCallCallbacks val1: ~A" val1))
+ (XtRemoveCallback button XmNactivateCallback descr)
+ (let ((calls (XtHasCallbacks button XmNactivateCallback)))
+ (if (not (= calls XtCallbackHasNone))
+ (snd-display #__line__ ";XtRemoveCallbacks: ~A" calls))))
+ (XtUnmanageChild button)
;(XtDestroyWidget button)
- )
-
- (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
- (val1 0)
- (val2 0))
- (define (call1 w c i)
- (set! val1 (+ 1 val1)))
- (define (call2 w c i)
- (set! val2 (+ 1 val2)))
- (let ((descr1 (XtAddCallback button XmNactivateCallback call1 #f))
- (descr2 (XtAddCallback button XmNactivateCallback call2 #f)))
- (XtCallCallbacks button XmNactivateCallback #f)
- (if (and (not (= val1 1)) (not (= val2 1)))
- (snd-display ";XtCallCallbacks val12: ~A ~A" val1 val2))
- (XtRemoveCallbacks button XmNactivateCallback (list descr1 descr2))
- (let ((calls (XtHasCallbacks button XmNactivateCallback)))
- (if (not (= calls XtCallbackHasNone))
- (snd-display ";XtRemoveCallbacks: ~A" calls))))
- (XtUnmanageChild button)
+ )
+
+ (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
+ (val1 0)
+ (val2 0))
+ (define (call1 w c i)
+ (set! val1 (+ 1 val1)))
+ (define (call2 w c i)
+ (set! val2 (+ 1 val2)))
+ (let ((descr1 (XtAddCallback button XmNactivateCallback call1 #f))
+ (descr2 (XtAddCallback button XmNactivateCallback call2 #f)))
+ (XtCallCallbacks button XmNactivateCallback #f)
+ (if (and (not (= val1 1)) (not (= val2 1)))
+ (snd-display #__line__ ";XtCallCallbacks val12: ~A ~A" val1 val2))
+ (XtRemoveCallbacks button XmNactivateCallback (list descr1 descr2))
+ (let ((calls (XtHasCallbacks button XmNactivateCallback)))
+ (if (not (= calls XtCallbackHasNone))
+ (snd-display #__line__ ";XtRemoveCallbacks: ~A" calls))))
+ (XtUnmanageChild button)
;(XtDestroyWidget button)
- )
-
- (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
- (val1 0)
- (val2 0))
- (define (call1 w c i)
- (set! val1 (+ 1 val1)))
- (define (call2 w c i)
- (set! val2 (+ 1 val2)))
- (let ((descrs (XtAddCallbacks button XmNactivateCallback (list (list call1 #f) (list call2 #f)))))
- (XtCallCallbacks button XmNactivateCallback #f)
- (if (and (not (= val1 1)) (not (= val2 1)))
- (snd-display ";XtCallCallbacks add val12: ~A ~A" val1 val2))
- (XtRemoveCallbacks button XmNactivateCallback descrs)
- (let ((calls (XtHasCallbacks button XmNactivateCallback)))
- (if (not (= calls XtCallbackHasNone))
- (snd-display ";XtRemoveCallbacks (add): ~A" calls))))
- (XtUnmanageChild button)
+ )
+
+ (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
+ (val1 0)
+ (val2 0))
+ (define (call1 w c i)
+ (set! val1 (+ 1 val1)))
+ (define (call2 w c i)
+ (set! val2 (+ 1 val2)))
+ (let ((descrs (XtAddCallbacks button XmNactivateCallback (list (list call1 #f) (list call2 #f)))))
+ (XtCallCallbacks button XmNactivateCallback #f)
+ (if (and (not (= val1 1)) (not (= val2 1)))
+ (snd-display #__line__ ";XtCallCallbacks add val12: ~A ~A" val1 val2))
+ (XtRemoveCallbacks button XmNactivateCallback descrs)
+ (let ((calls (XtHasCallbacks button XmNactivateCallback)))
+ (if (not (= calls XtCallbackHasNone))
+ (snd-display #__line__ ";XtRemoveCallbacks (add): ~A" calls))))
+ (XtUnmanageChild button)
;(XtDestroyWidget button)
- )
-
- (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
- (browsed 0)
- (lst (XtCreateManagedWidget "lst" xmListWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNautomaticSelection XmNO_AUTO_SELECT
- XmNdoubleClickInterval 100
- XmNitemCount 3
- XmNitems (list (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG)
- (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG)
- (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
- XmNlistMarginHeight 4
- XmNlistMarginWidth 1
- XmNlistSizePolicy XmVARIABLE
- XmNlistSpacing 2
- XmNmatchBehavior XmQUICK_NAVIGATE
- XmNprimaryOwnership XmOWN_NEVER
- XmNscrollBarDisplayPolicy XmAS_NEEDED
- XmNselectColor (basic-color)
- XmNselectedPositions (list 0 1)
- XmNselectionMode XmNORMAL_MODE
- XmNselectionPolicy XmBROWSE_SELECT))))
- (XtAddCallback lst XmNbrowseSelectionCallback (lambda (w c i) (set! browsed 123)))
- (let ((vals (XtVaGetValues lst
- (list XmNautomaticSelection 0 XmNdoubleClickInterval 0 XmNitemCount 0 XmNitems 0 XmNlistMarginHeight 0
- XmNlistMarginWidth 0 XmNlistSizePolicy 0 XmNlistSpacing 0 XmNmatchBehavior 0
- XmNprimaryOwnership 0 XmNscrollBarDisplayPolicy 0 XmNselectColor 0 XmNselectionMode 0
- XmNselectionPolicy 0 XmNhorizontalScrollBar 0 XmNselectedItemCount 0 XmNtopItemPosition 0))))
- (if (not (= (list-ref vals 1) XmNO_AUTO_SELECT)) (snd-display ";XmNautomaticSelection: ~A" (list-ref vals 1)))
- (if (not (= (list-ref vals 3) 100)) (snd-display ";XmNdoubleClickInterval: ~A" (list-ref vals 3)))
- (if (not (= (list-ref vals 5) 3)) (snd-display ";XmNitemCount: ~A" (list-ref vals 5)))
- (if (or (null? (list-ref vals 7)) (not (XmString? (car (list-ref vals 7))))) (snd-display ";XmNitems: ~A" (list-ref vals 7)))
- (if (not (= (list-ref vals 9) 4)) (snd-display ";XmNlistMarginHeight: ~A" (list-ref vals 9)))
- (if (not (= (list-ref vals 11) 1)) (snd-display ";XmNlistMarginWidth: ~A" (list-ref vals 11)))
- (if (not (= (list-ref vals 13) XmVARIABLE)) (snd-display ";XmNlistSizePolicy: ~A" (list-ref vals 13)))
- (if (not (= (list-ref vals 15) 2)) (snd-display ";XmNlistSpacing: ~A" (list-ref vals 15)))
- (if (not (= (list-ref vals 17) XmQUICK_NAVIGATE)) (snd-display ";XmNmatchBehavior: ~A" (list-ref vals 17)))
- (if (not (= (list-ref vals 19) XmOWN_NEVER)) (snd-display ";XmNprimaryOwnership : ~A" (list-ref vals 19)))
- (if (not (= (list-ref vals 21) XmAS_NEEDED)) (snd-display ";XmNscrollBarDisplayPolicy: ~A" (list-ref vals 21)))
- (if (not (Pixel? (list-ref vals 23))) (snd-display ";XmNselectColor: ~A" (list-ref vals 23)))
- (if (not (= (list-ref vals 25) XmNORMAL_MODE)) (snd-display ";XmNselectionMode: ~A" (list-ref vals 25)))
- (if (not (= (list-ref vals 27) XmBROWSE_SELECT)) (snd-display ";XmNselectionPolicy: ~A" (list-ref vals 27)))
- (if (list-ref vals 29) (snd-display ";XmNhorizontalScrollBar: ~A" (list-ref vals 29)))
- (if (not (= (list-ref vals 31) 0)) (snd-display ";XmNselectedItemCount : ~A" (list-ref vals 31)))
- (if (not (= (list-ref vals 33) 1)) (snd-display ";XmNtopItemPosition: ~A" (list-ref vals 33)))
-
- (let ((tag (catch #t
- (lambda ()
- (XmListAddItem frm (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";list type check: ~A" tag)))
-
- (XmListAddItem lst (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 4)) (snd-display ";XmAddItem len: ~A" (list-ref vals 1)))
- (XmListAddItems lst (list (XmStringCreateLocalized "five") (XmStringCreateLocalized "six")) 2 0)
- (let ((tag (catch #t
- (lambda () (XmListAddItems lst (list (XmStringCreateLocalized "seven") 123) 2 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";xstrings->list add: ~A" tag)))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 6)) (snd-display ";XmAddItems len: ~A" (list-ref vals 1)))
-
- (XmListDeletePos lst 1)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 5)) (snd-display ";XmListDeletePos len: ~A" (list-ref vals 1)))
- (XmListDeletePositions lst (list 2 4))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 3)) (snd-display ";XmListDeletePositions len: ~A" (list-ref vals 1)))
-
- (XmListAddItemUnselected lst (XmStringCreate "seven" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 4)) (snd-display ";XmListAddItemUnselected len: ~A" (list-ref vals 1)))
- (XmListAddItemsUnselected lst (list (XmStringCreateLocalized "eight") (XmStringCreateLocalized "nine")) 2 0)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 6)) (snd-display ";XmListAddItemsUnselected len: ~A" (list-ref vals 1)))
-
- (XmListDeleteAllItems lst)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 0)) (snd-display ";XmListDeleteAllItems len: ~A" (list-ref vals 1)))
- (if (not (null? (list-ref vals 3)))
- (snd-display ";deleted all items: ~A" (list-ref vals 3)))
-
- (let ((item1 (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG))
- (item2 (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG))
- (item3 (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
- (item4 (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG))
- (item5 (XmStringCreate "five" XmFONTLIST_DEFAULT_TAG)))
- (XtVaSetValues lst
- (list XmNitemCount 5
- XmNitems (list item1 item2 item3 item4 item5)))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 5)) (snd-display ";Xt set items len: ~A" (list-ref vals 1)))
-
- (XmListSelectItem lst item3 #t)
- (if (not (= browsed 123)) (snd-display ";XmListSelectItem callback: ~A" browsed))
- (if (XmListPosSelected lst 1) (snd-display ";XmList selected pos 1?"))
- (if (not (XmListPosSelected lst 3)) (snd-display ";XmList didn't select pos 3?"))
- (set! vals (XtVaGetValues lst (list XmNselectedItemCount 0 XmNselectedItems 0)))
- (if (not (= (list-ref vals 1) 1)) (snd-display ";selected count: ~A" (list-ref vals 1)))
- (set! vals (XmListGetSelectedPos lst))
- (if (not (= (length vals) 1)) (snd-display ";XmListGetSelectedPos: ~A" vals))
- (if (not (= (car vals) 3)) (snd-display ";XmListGetSelectedPos: ~A" vals))
- (set! browsed 0)
- (XmListSelectPos lst 1 #f)
- (if (not (= browsed 0)) (snd-display ";XmListSelectPos callback: ~A" browsed))
- (if (not (XmListPosSelected lst 1)) (snd-display ";XmList select pos?"))
- (if (not (= (XmListItemPos lst item3) 3)) (snd-display ";XmListItemPos: ~A" (XmListItemPos lst item3)))
- (if (not (= (car (XmListGetMatchPos lst item3)) 3)) (snd-display ";XmListGetMatchPos: ~A" (XmListGetMatchPos lst item3)))
- (if (not (XmListItemExists lst item3)) (snd-display ";XmListItemExists?"))
-
- (if (not (= (XmListYToPos lst 40) 2)) (snd-display ";XmListYToPos: ~A" (XmListYToPos lst 40)))
- (let ((box (XmListPosToBounds lst 2)))
- (if (and (not (= (cadr box) 3))
- (not (= (cadr box) 2)))
- (snd-display ";XmListPosToBounds: ~A" box)))
- (XmListDeselectPos lst 1)
- (if (XmListPosSelected lst 1) (snd-display ";XmList deselected pos?"))
- (XmListSelectItem lst item3 #t)
- (XmListDeselectAllItems lst)
- (if (XmListPosSelected lst 3) (snd-display ";XmList deselect all pos?"))
- (XmListSelectItem lst item3 #f)
- (XmListDeselectItem lst item3)
- (if (XmListPosSelected lst 3) (snd-display ";XmList deselect item?"))
-
- (XmListDeleteItem lst item2)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 4)) (snd-display ";XmDeleteItem len: ~A" (list-ref vals 1)))
- (XmListDeleteItems lst (list item1 item4))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 2)) (snd-display ";XmDeleteItems len: ~A" (list-ref vals 1)))
- (XmListDeleteAllItems lst)
- (XtVaSetValues lst
- (list XmNitemCount 5
- XmNitems (list item1 item2 item3 item4 item5)))
-
- (XtUnmanageChild frm))))
-
- (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
- (current-time (list 'Time CurrentTime))
- (calls (make-vector 10 "none"))
- (txt (XtCreateManagedWidget "text" xmTextWidgetClass frm
- (list XmNeditable #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNdestinationCallback
- (list (lambda (w c i)
- (vector-set! calls c "dest")
- (if (< (.location_data i) 0) (snd-display ";location_data: A~" (.location_data i))))
- 1)
- XmNactivateCallback (list (lambda (w c i) (vector-set! calls c "act")) 2)
- XmNfocusCallback (list (lambda (w c i) (vector-set! calls c "focus")) 3)
- XmNlosingFocusCallback (list (lambda (w c i) (vector-set! calls c "losingfocus")) 4)
- XmNgainPrimaryCallback (list (lambda (w c i) (vector-set! calls c "gain")) 5)
- XmNlosePrimaryCallback (list (lambda (w c i) (vector-set! calls c "lose")) 6)
- XmNmodifyVerifyCallback
- (list (lambda (w c i)
- (vector-set! calls c "modify")
- (if (< (.currInsert i) 0) (snd-display ";currInsert: A~" (.currInsert i)))
- (if (< (.newInsert i) 0) (snd-display ";newInsert: A~" (.newInsert i)))
- (if (string? (.doit i)) (snd-display ";doit: A~" (.doit i)))
- (if (< (.startPos i) 0) (snd-display ";startPos: A~" (.startPos i)))
- (if (< (.endPos i) 0) (snd-display ";endPos: A~" (.endPos i))))
- 7)
- XmNmotionVerifyCallback (list (lambda (w c i) (vector-set! calls c "motion")) 8)
- XmNvalueChangedCallback (list (lambda (w c i) (vector-set! calls c "value")) 9)))))
- (letrec ((transfer-proc
- (lambda (w c info)
- (let* ((dpy (XtDisplay w))
- (TARGETS (XmInternAtom dpy "TARGETS" #f))
- (CB_TARGETS (XmInternAtom dpy "_MOTIF_CLIPBOARD_TARGETS" #f)))
- (if (equal? (.target info) XA_STRING)
- (begin
+ )
+
+ (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
+ (browsed 0)
+ (lst (XtCreateManagedWidget "lst" xmListWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNautomaticSelection XmNO_AUTO_SELECT
+ XmNdoubleClickInterval 100
+ XmNitemCount 3
+ XmNitems (list (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG)
+ (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG)
+ (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
+ XmNlistMarginHeight 4
+ XmNlistMarginWidth 1
+ XmNlistSizePolicy XmVARIABLE
+ XmNlistSpacing 2
+ XmNmatchBehavior XmQUICK_NAVIGATE
+ XmNprimaryOwnership XmOWN_NEVER
+ XmNscrollBarDisplayPolicy XmAS_NEEDED
+ XmNselectColor (basic-color)
+ XmNselectedPositions (list 0 1)
+ XmNselectionMode XmNORMAL_MODE
+ XmNselectionPolicy XmBROWSE_SELECT))))
+ (XtAddCallback lst XmNbrowseSelectionCallback (lambda (w c i) (set! browsed 123)))
+ (let ((vals (XtVaGetValues lst
+ (list XmNautomaticSelection 0 XmNdoubleClickInterval 0 XmNitemCount 0 XmNitems 0 XmNlistMarginHeight 0
+ XmNlistMarginWidth 0 XmNlistSizePolicy 0 XmNlistSpacing 0 XmNmatchBehavior 0
+ XmNprimaryOwnership 0 XmNscrollBarDisplayPolicy 0 XmNselectColor 0 XmNselectionMode 0
+ XmNselectionPolicy 0 XmNhorizontalScrollBar 0 XmNselectedItemCount 0 XmNtopItemPosition 0))))
+ (if (not (= (list-ref vals 1) XmNO_AUTO_SELECT)) (snd-display #__line__ ";XmNautomaticSelection: ~A" (list-ref vals 1)))
+ (if (not (= (list-ref vals 3) 100)) (snd-display #__line__ ";XmNdoubleClickInterval: ~A" (list-ref vals 3)))
+ (if (not (= (list-ref vals 5) 3)) (snd-display #__line__ ";XmNitemCount: ~A" (list-ref vals 5)))
+ (if (or (null? (list-ref vals 7)) (not (XmString? (car (list-ref vals 7))))) (snd-display #__line__ ";XmNitems: ~A" (list-ref vals 7)))
+ (if (not (= (list-ref vals 9) 4)) (snd-display #__line__ ";XmNlistMarginHeight: ~A" (list-ref vals 9)))
+ (if (not (= (list-ref vals 11) 1)) (snd-display #__line__ ";XmNlistMarginWidth: ~A" (list-ref vals 11)))
+ (if (not (= (list-ref vals 13) XmVARIABLE)) (snd-display #__line__ ";XmNlistSizePolicy: ~A" (list-ref vals 13)))
+ (if (not (= (list-ref vals 15) 2)) (snd-display #__line__ ";XmNlistSpacing: ~A" (list-ref vals 15)))
+ (if (not (= (list-ref vals 17) XmQUICK_NAVIGATE)) (snd-display #__line__ ";XmNmatchBehavior: ~A" (list-ref vals 17)))
+ (if (not (= (list-ref vals 19) XmOWN_NEVER)) (snd-display #__line__ ";XmNprimaryOwnership : ~A" (list-ref vals 19)))
+ (if (not (= (list-ref vals 21) XmAS_NEEDED)) (snd-display #__line__ ";XmNscrollBarDisplayPolicy: ~A" (list-ref vals 21)))
+ (if (not (Pixel? (list-ref vals 23))) (snd-display #__line__ ";XmNselectColor: ~A" (list-ref vals 23)))
+ (if (not (= (list-ref vals 25) XmNORMAL_MODE)) (snd-display #__line__ ";XmNselectionMode: ~A" (list-ref vals 25)))
+ (if (not (= (list-ref vals 27) XmBROWSE_SELECT)) (snd-display #__line__ ";XmNselectionPolicy: ~A" (list-ref vals 27)))
+ (if (list-ref vals 29) (snd-display #__line__ ";XmNhorizontalScrollBar: ~A" (list-ref vals 29)))
+ (if (not (= (list-ref vals 31) 0)) (snd-display #__line__ ";XmNselectedItemCount : ~A" (list-ref vals 31)))
+ (if (not (= (list-ref vals 33) 1)) (snd-display #__line__ ";XmNtopItemPosition: ~A" (list-ref vals 33)))
+
+ (let ((tag (catch #t
+ (lambda ()
+ (XmListAddItem frm (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";list type check: ~A" tag)))
+
+ (XmListAddItem lst (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 4)) (snd-display #__line__ ";XmAddItem len: ~A" (list-ref vals 1)))
+ (XmListAddItems lst (list (XmStringCreateLocalized "five") (XmStringCreateLocalized "six")) 2 0)
+ (let ((tag (catch #t
+ (lambda () (XmListAddItems lst (list (XmStringCreateLocalized "seven") 123) 2 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";xstrings->list add: ~A" tag)))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 6)) (snd-display #__line__ ";XmAddItems len: ~A" (list-ref vals 1)))
+
+ (XmListDeletePos lst 1)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 5)) (snd-display #__line__ ";XmListDeletePos len: ~A" (list-ref vals 1)))
+ (XmListDeletePositions lst (list 2 4))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 3)) (snd-display #__line__ ";XmListDeletePositions len: ~A" (list-ref vals 1)))
+
+ (XmListAddItemUnselected lst (XmStringCreate "seven" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 4)) (snd-display #__line__ ";XmListAddItemUnselected len: ~A" (list-ref vals 1)))
+ (XmListAddItemsUnselected lst (list (XmStringCreateLocalized "eight") (XmStringCreateLocalized "nine")) 2 0)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 6)) (snd-display #__line__ ";XmListAddItemsUnselected len: ~A" (list-ref vals 1)))
+
+ (XmListDeleteAllItems lst)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 0)) (snd-display #__line__ ";XmListDeleteAllItems len: ~A" (list-ref vals 1)))
+ (if (not (null? (list-ref vals 3)))
+ (snd-display #__line__ ";deleted all items: ~A" (list-ref vals 3)))
+
+ (let ((item1 (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG))
+ (item2 (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG))
+ (item3 (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
+ (item4 (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG))
+ (item5 (XmStringCreate "five" XmFONTLIST_DEFAULT_TAG)))
+ (XtVaSetValues lst
+ (list XmNitemCount 5
+ XmNitems (list item1 item2 item3 item4 item5)))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 5)) (snd-display #__line__ ";Xt set items len: ~A" (list-ref vals 1)))
+
+ (XmListSelectItem lst item3 #t)
+ (if (not (= browsed 123)) (snd-display #__line__ ";XmListSelectItem callback: ~A" browsed))
+ (if (XmListPosSelected lst 1) (snd-display #__line__ ";XmList selected pos 1?"))
+ (if (not (XmListPosSelected lst 3)) (snd-display #__line__ ";XmList didn't select pos 3?"))
+ (set! vals (XtVaGetValues lst (list XmNselectedItemCount 0 XmNselectedItems 0)))
+ (if (not (= (list-ref vals 1) 1)) (snd-display #__line__ ";selected count: ~A" (list-ref vals 1)))
+ (set! vals (XmListGetSelectedPos lst))
+ (if (not (= (length vals) 1)) (snd-display #__line__ ";XmListGetSelectedPos: ~A" vals))
+ (if (not (= (car vals) 3)) (snd-display #__line__ ";XmListGetSelectedPos: ~A" vals))
+ (set! browsed 0)
+ (XmListSelectPos lst 1 #f)
+ (if (not (= browsed 0)) (snd-display #__line__ ";XmListSelectPos callback: ~A" browsed))
+ (if (not (XmListPosSelected lst 1)) (snd-display #__line__ ";XmList select pos?"))
+ (if (not (= (XmListItemPos lst item3) 3)) (snd-display #__line__ ";XmListItemPos: ~A" (XmListItemPos lst item3)))
+ (if (not (= (car (XmListGetMatchPos lst item3)) 3)) (snd-display #__line__ ";XmListGetMatchPos: ~A" (XmListGetMatchPos lst item3)))
+ (if (not (XmListItemExists lst item3)) (snd-display #__line__ ";XmListItemExists?"))
+
+ (if (not (= (XmListYToPos lst 40) 2)) (snd-display #__line__ ";XmListYToPos: ~A" (XmListYToPos lst 40)))
+ (let ((box (XmListPosToBounds lst 2)))
+ (if (and (not (= (cadr box) 3))
+ (not (= (cadr box) 2)))
+ (snd-display #__line__ ";XmListPosToBounds: ~A" box)))
+ (XmListDeselectPos lst 1)
+ (if (XmListPosSelected lst 1) (snd-display #__line__ ";XmList deselected pos?"))
+ (XmListSelectItem lst item3 #t)
+ (XmListDeselectAllItems lst)
+ (if (XmListPosSelected lst 3) (snd-display #__line__ ";XmList deselect all pos?"))
+ (XmListSelectItem lst item3 #f)
+ (XmListDeselectItem lst item3)
+ (if (XmListPosSelected lst 3) (snd-display #__line__ ";XmList deselect item?"))
+
+ (XmListDeleteItem lst item2)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 4)) (snd-display #__line__ ";XmDeleteItem len: ~A" (list-ref vals 1)))
+ (XmListDeleteItems lst (list item1 item4))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (list-ref vals 1) 2)) (snd-display #__line__ ";XmDeleteItems len: ~A" (list-ref vals 1)))
+ (XmListDeleteAllItems lst)
+ (XtVaSetValues lst
+ (list XmNitemCount 5
+ XmNitems (list item1 item2 item3 item4 item5)))
+
+ (XtUnmanageChild frm))))
+
+ (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
+ (current-time (list 'Time CurrentTime))
+ (calls (make-vector 10 "none"))
+ (txt (XtCreateManagedWidget "text" xmTextWidgetClass frm
+ (list XmNeditable #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNdestinationCallback
+ (list (lambda (w c i)
+ (vector-set! calls c "dest")
+ (if (< (.location_data i) 0) (snd-display #__line__ ";location_data: A~" (.location_data i))))
+ 1)
+ XmNactivateCallback (list (lambda (w c i) (vector-set! calls c "act")) 2)
+ XmNfocusCallback (list (lambda (w c i) (vector-set! calls c "focus")) 3)
+ XmNlosingFocusCallback (list (lambda (w c i) (vector-set! calls c "losingfocus")) 4)
+ XmNgainPrimaryCallback (list (lambda (w c i) (vector-set! calls c "gain")) 5)
+ XmNlosePrimaryCallback (list (lambda (w c i) (vector-set! calls c "lose")) 6)
+ XmNmodifyVerifyCallback
+ (list (lambda (w c i)
+ (vector-set! calls c "modify")
+ (if (< (.currInsert i) 0) (snd-display #__line__ ";currInsert: A~" (.currInsert i)))
+ (if (< (.newInsert i) 0) (snd-display #__line__ ";newInsert: A~" (.newInsert i)))
+ (if (string? (.doit i)) (snd-display #__line__ ";doit: A~" (.doit i)))
+ (if (< (.startPos i) 0) (snd-display #__line__ ";startPos: A~" (.startPos i)))
+ (if (< (.endPos i) 0) (snd-display #__line__ ";endPos: A~" (.endPos i))))
+ 7)
+ XmNmotionVerifyCallback (list (lambda (w c i) (vector-set! calls c "motion")) 8)
+ XmNvalueChangedCallback (list (lambda (w c i) (vector-set! calls c "value")) 9)))))
+ (letrec ((transfer-proc
+ (lambda (w c info)
+ (let* ((dpy (XtDisplay w))
+ (TARGETS (XmInternAtom dpy "TARGETS" #f))
+ (CB_TARGETS (XmInternAtom dpy "_MOTIF_CLIPBOARD_TARGETS" #f)))
+ (if (equal? (.target info) XA_STRING)
+ (begin
;(XmTextInsert w (XmTextGetInsertionPosition w) (->string (.value info)))
;I think the .value field here is an XmString
- (XmTransferDone (.transfer_id info) XmTRANSFER_DONE_SUCCEED))
- (if (and (or (equal? (.target info) TARGETS)
- (equal? (.target info) CB_TARGETS))
- (equal? (.type info) XA_ATOM))
- (let ((targets (->Atoms (.value info) (.length info)))
- (happy #f))
- (for-each
- (lambda (targ)
- (if (equal? targ XA_STRING)
- (set! happy #t)))
- targets)
- (if happy
- (XmTransferValue (.transfer_id info)
- XA_STRING
- transfer-proc
- #f
- (XtLastTimestampProcessed dpy)))))))))
- (txtf (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
- (list XmNeditable #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget txt
- XmNbottomAttachment XmATTACH_FORM))))
-
- (let ((vals (XtVaGetValues txt (list XmNrenderTable 0 XmNselectionArray 0))))
- (if (not (XmRenderTable? (list-ref vals 1))) (snd-display ";XmNrenderTable: ~A" (list-ref vals 1)))
- (if (not (list-p (list-ref vals 3))) (snd-display ";XmNselectionArray: ~A" (list-ref vals 3))))
- (if (not (XmTextGetEditable txt)) (snd-display ";XmTextGetEditable?"))
- (if (not (XmTextFieldGetEditable txtf)) (snd-display ";XmTextFieldGetEditable?"))
- (XmTextSetEditable txt #f)
- (XmTextFieldSetEditable txtf #f)
- (if (XmTextGetEditable txt) (snd-display ";XmTextSetEditable?"))
- (if (XmTextFieldGetEditable txtf) (snd-display ";XmTextFieldSetEditable?"))
- (XmTextSetEditable txt #t)
- (XmTextFieldSetEditable txtf #t)
- (XmTextSetString txt "0123456789")
- (XmTextFieldSetString txtf "0123456789")
- (XmTextFieldCopyLink txtf (list 'Time CurrentTime))
- (let ((val (XmTextGetString txt))
- (valf (XmTextFieldGetString txtf))
- (val1 (cadr (XtVaGetValues txt (list XmNvalue 0))))
- (val1f (cadr (XtVaGetValues txtf (list XmNvalue 0)))))
- (if (not (string=? val "0123456789")) (snd-display ";XmTextSetString: ~A" val))
- (if (not (string=? valf "0123456789")) (snd-display ";XmTextFieldSetString: ~A" valf))
- (if (not (string=? val1 "0123456789")) (snd-display ";text value: ~A" val1))
- (if (not (string=? val1f "0123456789")) (snd-display ";text field value: ~A" val)))
- (let ((untext (XtCreateWidget "untext" xmTextWidgetClass frm '()))
- (source (XmTextGetSource txt)))
- (XmTextSetSource untext source 0 3)
- (if (not (XmTextSource? source))
- (snd-display ";XmTextSource? ~A" source))
- (if (not (equal? (XmTextGetSource untext) source))
- (snd-display ";XmTextSetSource: ~A ~A" source (XmTextGetSource untext)))
- (if (XtIsSubclass untext xmFormWidgetClass)
- (snd-display ";XtIsSubclass thinks untext is a form?"))
- (if (not (XtIsSubclass untext coreWidgetClass))
- (snd-display ";XtIsSubclass thinks untext is not a core widget"))
- (XmTextCopyLink untext (list 'Time CurrentTime))
- (XmTextPasteLink untext))
- (let ((val (XmTextGetSubstring txt 2 3))
- (valf (XmTextFieldGetSubstring txtf 2 3)))
- (if (or (not (string? val)) (not (string=? val "234"))) (snd-display ";XmTextGetSubstring: ~A" val))
- (if (or (not (string? valf)) (not (string=? valf "234"))) (snd-display ";XmTextFieldGetSubstring: ~A" valf)))
- (XmTextSetSelection txt 2 5 current-time)
- (let ((val (XmTextGetSelection txt)))
- (if (or (not (string? val)) (not (string=? val "234"))) (snd-display ";XmTextGetSelection: ~A" val)))
- (XmTextClearSelection txt current-time)
- (let ((val (XmTextGetSelection txt)))
- (if val (snd-display ";XmTextClearSelection: ~A" val)))
- (XmTextFieldSetSelection txtf 2 5 current-time)
- (let ((tag (catch #t
- (lambda ()
- (XmTextFieldSetSelection txt 2 3 current-time))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";text field type check: ~A" tag)))
- (let ((tag (catch #t
- (lambda ()
- (XmTextSetSelection frm 2 3 current-time))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";text type check: ~A" tag)))
- (let ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets))))
- (app (car (main-widgets))))
- (let ((tag (catch #t (lambda () (XmTransferSetParameters 123 123 123 123 "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmTransferSetParameters type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmDropSiteConfigureStackingOrder txtf txtf "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmDropSiteConfigureStackingOrder type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmScrollVisible txtf txtf 5 "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmScrollVisible type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmDragStart txtf (XEvent KeyPress) (list 0 1) "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmDragStart type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardStartRetrieve dpy win 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmClipboardStartRetrieve type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardCopyByName dpy win 1 "hi" "hi" 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmClipboardCopyByName type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardBeginCopy dpy win "hi" txtf #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmClipboardBeginCopy type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmRemoveProtocolCallback txtf XA_STRING XA_STRING #f 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmRemoveProtocolCallback type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetRGBColormaps dpy win (list 'XStandardColormap 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetRGBColormap type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWMHints dpy win 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetWMHints type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XWindowEvent dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XWindowEvent type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XStoreNamedColor dpy (list 'Colormap 0) "hi" 0 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XStoreNamedColor type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XStoreColors dpy (list 'Colormap 0) (list 1 2) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XStoreColors type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XStoreColor dpy (list 'Colormap 0) (list 1 2))) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XStoreColor type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtDisplayInitialize app dpy "hi" "ho" 1 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtDisplayInitialize type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtOwnSelectionIncremental txtf '(Atom 0) '(Time 0) #f #f #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtOwnSelectionIncremental type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtOwnSelection txtf '(Atom 0) '(Time 0) #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtOwnSelection type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValue txtf '(Atom 0) '(Atom 0) #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtGetSelectionValue type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValues txtf '(Atom 0) (list (list 'Atom 0)) #f #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtGetSelectionValues type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtDisownSelection txtf '(Atom 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtDisownSelection type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtGetSelectionRequest type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValueIncremental txtf '(Atom 0) (list (list 'Atom 0)) 1 #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtGetSelectionValueIncremental type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValuesIncremental txtf '(Atom 0) '(Atom 0) 1 #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtGetSelectionValuesIncremental type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtSendSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XtSendSelectionRequest type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XReconfigureWMWindow dpy win 1 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XReconfigureWMWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWMProtocols dpy win 1 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetWMProtocols type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XIconifyWindow dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XIconifyWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XWithdrawWindow dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XWithdrawWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWMColormapWindows dpy win #f 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetWMColormapWindows type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetTransientForHint dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetTransientForHint type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XAllowEvents dpy 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XAllowEvents type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XChangeActivePointerGrab dpy 1 '(Cursor 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XChangeActivePointerGrab type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XChangeGC dpy '(GC 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XChangeGC type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XChangeKeyboardMapping dpy 1 1 (list 1 1) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XChangeKeyboardMapping type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XConfigureWindow dpy win 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XConfigureWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XConvertSelection dpy '(Atom 0) '(Atom 0) '(Atom 0) win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XConvertSelection type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XReparentWindow dpy win win 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XReparentWindow type check: ~A" tag)))
-
- (let ((tag (catch #t (lambda () (XFreeColors dpy '(Colormap 0) (list 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XFreeColors type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XReadBitmapFile dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XReadBitmapFile type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XRebindKeysym dpy '(KeySym 0) (list 0) 1 "hi" #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XRebindKeysym type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XRestackWindows dpy (list 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XRestackWindows type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XRotateWindowProperties dpy win (list 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XRotateWindowProperties type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSelectInput dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSelectInput type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetFontPath dpy (list 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetFontPath type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetInputFocus dpy win 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetInputFocus type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetSelectionOwner dpy '(Atom 0) win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetSelectionOwner type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWindowColormap dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XSetWindowColormap type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardCancelCopy dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display ";XmClipboardCancelCopy type check: ~A" tag)))
-
- )
-
- (let ((valf (XmTextFieldGetSelection txtf)))
- (if (not (string=? valf "234")) (snd-display ";XmTextFieldGetSelection: ~A" valf)))
- (XmTextFieldClearSelection txtf current-time)
- (let ((valf (XmTextFieldGetSelection txtf)))
- (if valf (snd-display ";XmTextFieldClearSelection: ~A" valf)))
- (let ((val (XmTextGetInsertionPosition txt))
- (valf (XmTextFieldGetInsertionPosition txtf)))
- (if (not (= val 5)) (snd-display ";XmTextGetInsertionPosition: ~A" val))
- (if (not (= valf 5)) (snd-display ";XmTextFieldGetInsertionPosition: ~A" val)))
-
- (XmTextScroll txt 1)
- (XmTextScroll txt -1)
- (let ((pos (XmTextGetTopCharacter txt)))
- (if (not (= pos 0)) (snd-display ";XmTextGetTopCharacter after scroll: ~A" pos)))
- (XmTextShowPosition txt 0)
- (XmTextFieldShowPosition txtf 0)
- (XmTextSetTopCharacter txt 0)
- (XmTextXYToPos txt 10 10)
- (XmTextFieldXYToPos txtf 10 10)
-
- (XmTextSetHighlight txt 3 6 XmHIGHLIGHT_SELECTED)
- (XmTextFieldSetHighlight txtf 3 6 XmHIGHLIGHT_SELECTED)
- (XmTextFieldGetBaseline txtf)
- (XmTextSetAddMode txt #t)
- (if (not (XmTextGetAddMode txt)) (snd-display ";XmTextSetAddMode?"))
- (XmTextFieldSetAddMode txtf #t)
- (if (not (XmTextFieldGetAddMode txtf)) (snd-display ";XmTextFieldSetAddMode?"))
-
- (if (not (string=? (vector-ref calls 5) "gain")) (snd-display ";gain callback: ~A" (vector-ref calls 5)))
- (if (not (string=? (vector-ref calls 7) "modify")) (snd-display ";modify callback: ~A" (vector-ref calls 7)))
- (if (not (string=? (vector-ref calls 8) "motion")) (snd-display ";motion callback: ~A" (vector-ref calls 8)))
- (if (not (string=? (vector-ref calls 9) "value")) (snd-display ";value callback: ~A" (vector-ref calls 9)))
+ (XmTransferDone (.transfer_id info) XmTRANSFER_DONE_SUCCEED))
+ (if (and (or (equal? (.target info) TARGETS)
+ (equal? (.target info) CB_TARGETS))
+ (equal? (.type info) XA_ATOM))
+ (let ((targets (->Atoms (.value info) (.length info)))
+ (happy #f))
+ (for-each
+ (lambda (targ)
+ (if (equal? targ XA_STRING)
+ (set! happy #t)))
+ targets)
+ (if happy
+ (XmTransferValue (.transfer_id info)
+ XA_STRING
+ transfer-proc
+ #f
+ (XtLastTimestampProcessed dpy)))))))))
+ (txtf (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
+ (list XmNeditable #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget txt
+ XmNbottomAttachment XmATTACH_FORM))))
+
+ (let ((vals (XtVaGetValues txt (list XmNrenderTable 0 XmNselectionArray 0))))
+ (if (not (XmRenderTable? (list-ref vals 1))) (snd-display #__line__ ";XmNrenderTable: ~A" (list-ref vals 1)))
+ (if (not (list-p (list-ref vals 3))) (snd-display #__line__ ";XmNselectionArray: ~A" (list-ref vals 3))))
+ (if (not (XmTextGetEditable txt)) (snd-display #__line__ ";XmTextGetEditable?"))
+ (if (not (XmTextFieldGetEditable txtf)) (snd-display #__line__ ";XmTextFieldGetEditable?"))
+ (XmTextSetEditable txt #f)
+ (XmTextFieldSetEditable txtf #f)
+ (if (XmTextGetEditable txt) (snd-display #__line__ ";XmTextSetEditable?"))
+ (if (XmTextFieldGetEditable txtf) (snd-display #__line__ ";XmTextFieldSetEditable?"))
+ (XmTextSetEditable txt #t)
+ (XmTextFieldSetEditable txtf #t)
+ (XmTextSetString txt "0123456789")
+ (XmTextFieldSetString txtf "0123456789")
+ (XmTextFieldCopyLink txtf (list 'Time CurrentTime))
+ (let ((val (XmTextGetString txt))
+ (valf (XmTextFieldGetString txtf))
+ (val1 (cadr (XtVaGetValues txt (list XmNvalue 0))))
+ (val1f (cadr (XtVaGetValues txtf (list XmNvalue 0)))))
+ (if (not (string=? val "0123456789")) (snd-display #__line__ ";XmTextSetString: ~A" val))
+ (if (not (string=? valf "0123456789")) (snd-display #__line__ ";XmTextFieldSetString: ~A" valf))
+ (if (not (string=? val1 "0123456789")) (snd-display #__line__ ";text value: ~A" val1))
+ (if (not (string=? val1f "0123456789")) (snd-display #__line__ ";text field value: ~A" val)))
+ (let ((untext (XtCreateWidget "untext" xmTextWidgetClass frm '()))
+ (source (XmTextGetSource txt)))
+ (XmTextSetSource untext source 0 3)
+ (if (not (XmTextSource? source))
+ (snd-display #__line__ ";XmTextSource? ~A" source))
+ (if (not (equal? (XmTextGetSource untext) source))
+ (snd-display #__line__ ";XmTextSetSource: ~A ~A" source (XmTextGetSource untext)))
+ (if (XtIsSubclass untext xmFormWidgetClass)
+ (snd-display #__line__ ";XtIsSubclass thinks untext is a form?"))
+ (if (not (XtIsSubclass untext coreWidgetClass))
+ (snd-display #__line__ ";XtIsSubclass thinks untext is not a core widget"))
+ (XmTextCopyLink untext (list 'Time CurrentTime))
+ (XmTextPasteLink untext))
+ (let ((val (XmTextGetSubstring txt 2 3))
+ (valf (XmTextFieldGetSubstring txtf 2 3)))
+ (if (or (not (string? val)) (not (string=? val "234"))) (snd-display #__line__ ";XmTextGetSubstring: ~A" val))
+ (if (or (not (string? valf)) (not (string=? valf "234"))) (snd-display #__line__ ";XmTextFieldGetSubstring: ~A" valf)))
+ (XmTextSetSelection txt 2 5 current-time)
+ (let ((val (XmTextGetSelection txt)))
+ (if (or (not (string? val)) (not (string=? val "234"))) (snd-display #__line__ ";XmTextGetSelection: ~A" val)))
+ (XmTextClearSelection txt current-time)
+ (let ((val (XmTextGetSelection txt)))
+ (if val (snd-display #__line__ ";XmTextClearSelection: ~A" val)))
+ (XmTextFieldSetSelection txtf 2 5 current-time)
+ (let ((tag (catch #t
+ (lambda ()
+ (XmTextFieldSetSelection txt 2 3 current-time))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";text field type check: ~A" tag)))
+ (let ((tag (catch #t
+ (lambda ()
+ (XmTextSetSelection frm 2 3 current-time))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";text type check: ~A" tag)))
+ (let ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets))))
+ (app (car (main-widgets))))
+ (let ((tag (catch #t (lambda () (XmTransferSetParameters 123 123 123 123 "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmTransferSetParameters type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmDropSiteConfigureStackingOrder txtf txtf "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmDropSiteConfigureStackingOrder type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmScrollVisible txtf txtf 5 "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmScrollVisible type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmDragStart txtf (XEvent KeyPress) (list 0 1) "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmDragStart type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardStartRetrieve dpy win 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardStartRetrieve type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardCopyByName dpy win 1 "hi" "hi" 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardCopyByName type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardBeginCopy dpy win "hi" txtf #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardBeginCopy type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmRemoveProtocolCallback txtf XA_STRING XA_STRING #f 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmRemoveProtocolCallback type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetRGBColormaps dpy win (list 'XStandardColormap 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetRGBColormap type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWMHints dpy win 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMHints type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XWindowEvent dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XWindowEvent type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XStoreNamedColor dpy (list 'Colormap 0) "hi" 0 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreNamedColor type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XStoreColors dpy (list 'Colormap 0) (list 1 2) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreColors type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XStoreColor dpy (list 'Colormap 0) (list 1 2))) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreColor type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtDisplayInitialize app dpy "hi" "ho" 1 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtDisplayInitialize type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtOwnSelectionIncremental txtf '(Atom 0) '(Time 0) #f #f #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtOwnSelectionIncremental type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtOwnSelection txtf '(Atom 0) '(Time 0) #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtOwnSelection type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValue txtf '(Atom 0) '(Atom 0) #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValue type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValues txtf '(Atom 0) (list (list 'Atom 0)) #f #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValues type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtDisownSelection txtf '(Atom 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtDisownSelection type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionRequest type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValueIncremental txtf '(Atom 0) (list (list 'Atom 0)) 1 #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValueIncremental type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValuesIncremental txtf '(Atom 0) '(Atom 0) 1 #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValuesIncremental type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtSendSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtSendSelectionRequest type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XReconfigureWMWindow dpy win 1 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReconfigureWMWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWMProtocols dpy win 1 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMProtocols type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XIconifyWindow dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XIconifyWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XWithdrawWindow dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XWithdrawWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWMColormapWindows dpy win #f 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMColormapWindows type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetTransientForHint dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetTransientForHint type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XAllowEvents dpy 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XAllowEvents type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XChangeActivePointerGrab dpy 1 '(Cursor 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeActivePointerGrab type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XChangeGC dpy '(GC 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeGC type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XChangeKeyboardMapping dpy 1 1 (list 1 1) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeKeyboardMapping type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XConfigureWindow dpy win 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XConfigureWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XConvertSelection dpy '(Atom 0) '(Atom 0) '(Atom 0) win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XConvertSelection type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XReparentWindow dpy win win 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReparentWindow type check: ~A" tag)))
+
+ (let ((tag (catch #t (lambda () (XFreeColors dpy '(Colormap 0) (list 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XFreeColors type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XReadBitmapFile dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReadBitmapFile type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XRebindKeysym dpy '(KeySym 0) (list 0) 1 "hi" #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRebindKeysym type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XRestackWindows dpy (list 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRestackWindows type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XRotateWindowProperties dpy win (list 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRotateWindowProperties type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSelectInput dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSelectInput type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetFontPath dpy (list 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetFontPath type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetInputFocus dpy win 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetInputFocus type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetSelectionOwner dpy '(Atom 0) win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetSelectionOwner type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWindowColormap dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWindowColormap type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardCancelCopy dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardCancelCopy type check: ~A" tag)))
+
+ )
+
+ (let ((valf (XmTextFieldGetSelection txtf)))
+ (if (not (string=? valf "234")) (snd-display #__line__ ";XmTextFieldGetSelection: ~A" valf)))
+ (XmTextFieldClearSelection txtf current-time)
+ (let ((valf (XmTextFieldGetSelection txtf)))
+ (if valf (snd-display #__line__ ";XmTextFieldClearSelection: ~A" valf)))
+ (let ((val (XmTextGetInsertionPosition txt))
+ (valf (XmTextFieldGetInsertionPosition txtf)))
+ (if (not (= val 5)) (snd-display #__line__ ";XmTextGetInsertionPosition: ~A" val))
+ (if (not (= valf 5)) (snd-display #__line__ ";XmTextFieldGetInsertionPosition: ~A" val)))
+
+ (XmTextScroll txt 1)
+ (XmTextScroll txt -1)
+ (let ((pos (XmTextGetTopCharacter txt)))
+ (if (not (= pos 0)) (snd-display #__line__ ";XmTextGetTopCharacter after scroll: ~A" pos)))
+ (XmTextShowPosition txt 0)
+ (XmTextFieldShowPosition txtf 0)
+ (XmTextSetTopCharacter txt 0)
+ (XmTextXYToPos txt 10 10)
+ (XmTextFieldXYToPos txtf 10 10)
+
+ (XmTextSetHighlight txt 3 6 XmHIGHLIGHT_SELECTED)
+ (XmTextFieldSetHighlight txtf 3 6 XmHIGHLIGHT_SELECTED)
+ (XmTextFieldGetBaseline txtf)
+ (XmTextSetAddMode txt #t)
+ (if (not (XmTextGetAddMode txt)) (snd-display #__line__ ";XmTextSetAddMode?"))
+ (XmTextFieldSetAddMode txtf #t)
+ (if (not (XmTextFieldGetAddMode txtf)) (snd-display #__line__ ";XmTextFieldSetAddMode?"))
+
+ (if (not (string=? (vector-ref calls 5) "gain")) (snd-display #__line__ ";gain callback: ~A" (vector-ref calls 5)))
+ (if (not (string=? (vector-ref calls 7) "modify")) (snd-display #__line__ ";modify callback: ~A" (vector-ref calls 7)))
+ (if (not (string=? (vector-ref calls 8) "motion")) (snd-display #__line__ ";motion callback: ~A" (vector-ref calls 8)))
+ (if (not (string=? (vector-ref calls 9) "value")) (snd-display #__line__ ";value callback: ~A" (vector-ref calls 9)))
+
+ (let ((txtf1 (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
+ (list XmNeditable #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget txt
+ XmNbottomAttachment XmATTACH_FORM
+ XmNdestinationCallback
+ (list (lambda (w c info)
+ (let* ((dpy (XtDisplay w))
+ (TARGETS (XmInternAtom dpy "TARGETS" #f)))
+ (XmTransferValue (.transfer_id info)
+ TARGETS
+ transfer-proc
+ #f
+ (XtLastTimestampProcessed dpy))))
+ #f)))))
+ (focus-widget txtf1)
+ (XmTextFieldPaste txtf1)
+ (XmTextFieldPasteLink txtf1)
+ (if (not (Widget? (XmGetTabGroup txtf1))) (snd-display #__line__ ";XmGetTabGroup: ~A " (XmGetTabGroup txtf1)))
+ (let ((fw (XmGetFocusWidget (cadr (main-widgets)))))
+ (if (not (equal? fw txtf1))
+ (snd-display #__line__ ";XmGetFocusWidget: ~A" fw)))
+ (let ((callback (lambda (w context ev flag)
+ (XtSetValues w (list XmNbackground (white-pixel))))))
+ (XtAddEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtAddRawEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtInsertEventHandler txtf1 EnterWindowMask #f callback #f XtListHead)
+ (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtInsertRawEventHandler txtf1 EnterWindowMask #f callback #f XtListTail)
+ (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f))
+ (XtRemoveAllCallbacks txtf1 XmNdestinationCallback))
+ (XtAppAddActions (car (main-widgets)) (list (list "hiho" (lambda args (snd-print "hiho")))))
+ (XtAugmentTranslations txt (XtParseTranslationTable "Ctrl <Key>i: hiho()\n"))
+ (XtCallActionProc txt "hiho" (XEvent) #f 0)
+ (XtUninstallTranslations txt)
+ (XtUnmanageChild frm)))
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (win (XtWindow shell))
+ (err (XmClipboardRegisterFormat dpy "SND_DATA" 8)))
+ (if (not (= err ClipboardSuccess))
+ (snd-display #__line__ ";XmClipboardRegisterFormat: ~A" err)
+ (let ((vals (XmClipboardStartCopy dpy win
+ (XmStringCreateLocalized "SND_DATA")
+ (list 'Time CurrentTime)
+ shell
+ (lambda (w id pid reason)
+ (let ((status (XmClipboardCopyByName dpy win id "copy this" 10 123))))))))
+ (if (not (= (car vals) ClipboardSuccess))
+ (snd-display #__line__ ";XmClipboardStartCopy: ~A" vals)
+ (let ((data-id (cadr vals)))
+ (set! err (XmClipboardCopy dpy win data-id "SND_DATA" "copy this" 10 0))
+ (if (not (= (car err) ClipboardSuccess)) (snd-display #__line__ ";XmClipboardCopy: ~A" err))
+ (let ((item-id (cadr err)))
+ (set! err (XmClipboardEndCopy dpy win data-id))
+ (if (not (= err ClipboardSuccess)) (snd-display #__line__ ";copy ~A" err))
+ (if (not (= (cadr (XmClipboardInquireLength dpy win "SND_DATA")) 10))
+ (snd-display #__line__ ";clip len: ~A" (XmClipboardInquireLength dpy win "SND_DATA")))
+ (let ((pend (XmClipboardInquirePendingItems dpy win "SND_DATA")))
+ (if (not (= (car pend) ClipboardSuccess)) (snd-display #__line__ ";XmClipboardInquirePendingItems: ~A" pend)))
+ (let ((formats1 (XmClipboardInquireCount dpy win)))
+ (if (= (cadr formats1) 0) (snd-display #__line__ ";XmClipboardInquireCount: ~A" formats1))
+ (let ((data (XmClipboardInquireFormat dpy win 1 10)))
+ (let ((clip (XmClipboardRetrieve dpy win "SND_DATA" 10)))
+ (if (not (string=? (cadr clip) "copy this")) (snd-display #__line__ ";XmClipboardRetrieve: ~A" clip))
+ (XmClipboardWithdrawFormat dpy win item-id)))))))))
+ (let ((val (XmClipboardLock dpy win)))
+ (if (not (= val ClipboardLocked))
+ (XmClipboardUnlock dpy win #t)))
+ (let ((selbox (XmCreateSelectionBox shell "selbox" '() 0)))
+ (XmSelectionBoxGetChild selbox XmDIALOG_APPLY_BUTTON)))
+
+ (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
+ (current-time (list 'Time CurrentTime))
+ (box (XtCreateManagedWidget "box" xmContainerWidgetClass frm '()))
+ (tgl (XtCreateManagedWidget "tgl" xmToggleButtonWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE)))
+ (tgg (XtCreateManagedWidget "tgg" xmToggleButtonGadgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget tgl
+ XmNbottomAttachment XmATTACH_NONE)))
+ (spn (XtCreateManagedWidget "spn" xmSimpleSpinBoxWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget tgg
+ XmNbottomAttachment XmATTACH_NONE)))
+ (cmd (XtCreateManagedWidget "cmd" xmCommandWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget spn
+ XmNbottomAttachment XmATTACH_NONE)))
+ (scl (XtCreateManagedWidget "scl" xmScaleWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget cmd
+ XmNbottomAttachment XmATTACH_NONE)))
+ (notes (XtCreateManagedWidget "notes" xmNotebookWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget scl
+ XmNbottomAttachment XmATTACH_NONE)))
- (let ((txtf1 (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
- (list XmNeditable #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget txt
- XmNbottomAttachment XmATTACH_FORM
- XmNdestinationCallback
- (list (lambda (w c info)
- (let* ((dpy (XtDisplay w))
- (TARGETS (XmInternAtom dpy "TARGETS" #f)))
- (XmTransferValue (.transfer_id info)
- TARGETS
- transfer-proc
- #f
- (XtLastTimestampProcessed dpy))))
- #f)))))
- (focus-widget txtf1)
- (XmTextFieldPaste txtf1)
- (XmTextFieldPasteLink txtf1)
- (if (not (Widget? (XmGetTabGroup txtf1))) (snd-display ";XmGetTabGroup: ~A " (XmGetTabGroup txtf1)))
- (let ((fw (XmGetFocusWidget (cadr (main-widgets)))))
- (if (not (equal? fw txtf1))
- (snd-display ";XmGetFocusWidget: ~A" fw)))
- (let ((callback (lambda (w context ev flag)
- (XtSetValues w (list XmNbackground (white-pixel))))))
- (XtAddEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtAddRawEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtInsertEventHandler txtf1 EnterWindowMask #f callback #f XtListHead)
- (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtInsertRawEventHandler txtf1 EnterWindowMask #f callback #f XtListTail)
- (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f))
- (XtRemoveAllCallbacks txtf1 XmNdestinationCallback))
- (XtAppAddActions (car (main-widgets)) (list (list "hiho" (lambda args (snd-print "hiho")))))
- (XtAugmentTranslations txt (XtParseTranslationTable "Ctrl <Key>i: hiho()\n"))
- (XtCallActionProc txt "hiho" (XEvent) #f 0)
- (XtUninstallTranslations txt)
- (XtUnmanageChild frm)))
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (win (XtWindow shell))
- (err (XmClipboardRegisterFormat dpy "SND_DATA" 8)))
- (if (not (= err ClipboardSuccess))
- (snd-display ";XmClipboardRegisterFormat: ~A" err)
- (let ((vals (XmClipboardStartCopy dpy win
- (XmStringCreateLocalized "SND_DATA")
- (list 'Time CurrentTime)
- shell
- (lambda (w id pid reason)
- (let ((status (XmClipboardCopyByName dpy win id "copy this" 10 123))))))))
- (if (not (= (car vals) ClipboardSuccess))
- (snd-display ";XmClipboardStartCopy: ~A" vals)
- (let ((data-id (cadr vals)))
- (set! err (XmClipboardCopy dpy win data-id "SND_DATA" "copy this" 10 0))
- (if (not (= (car err) ClipboardSuccess)) (snd-display ";XmClipboardCopy: ~A" err))
- (let ((item-id (cadr err)))
- (set! err (XmClipboardEndCopy dpy win data-id))
- (if (not (= err ClipboardSuccess)) (snd-display ";copy ~A" err))
- (if (not (= (cadr (XmClipboardInquireLength dpy win "SND_DATA")) 10))
- (snd-display ";clip len: ~A" (XmClipboardInquireLength dpy win "SND_DATA")))
- (let ((pend (XmClipboardInquirePendingItems dpy win "SND_DATA")))
- (if (not (= (car pend) ClipboardSuccess)) (snd-display ";XmClipboardInquirePendingItems: ~A" pend)))
- (let ((formats1 (XmClipboardInquireCount dpy win)))
- (if (= (cadr formats1) 0) (snd-display ";XmClipboardInquireCount: ~A" formats1))
- (let ((data (XmClipboardInquireFormat dpy win 1 10)))
- (let ((clip (XmClipboardRetrieve dpy win "SND_DATA" 10)))
- (if (not (string=? (cadr clip) "copy this")) (snd-display ";XmClipboardRetrieve: ~A" clip))
- (XmClipboardWithdrawFormat dpy win item-id)))))))))
- (let ((val (XmClipboardLock dpy win)))
- (if (not (= val ClipboardLocked))
- (XmClipboardUnlock dpy win #t)))
- (let ((selbox (XmCreateSelectionBox shell "selbox" '() 0)))
- (XmSelectionBoxGetChild selbox XmDIALOG_APPLY_BUTTON)))
-
- (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
- (current-time (list 'Time CurrentTime))
- (box (XtCreateManagedWidget "box" xmContainerWidgetClass frm '()))
- (tgl (XtCreateManagedWidget "tgl" xmToggleButtonWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE)))
- (tgg (XtCreateManagedWidget "tgg" xmToggleButtonGadgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget tgl
- XmNbottomAttachment XmATTACH_NONE)))
- (spn (XtCreateManagedWidget "spn" xmSimpleSpinBoxWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget tgg
- XmNbottomAttachment XmATTACH_NONE)))
- (cmd (XtCreateManagedWidget "cmd" xmCommandWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget spn
- XmNbottomAttachment XmATTACH_NONE)))
- (scl (XtCreateManagedWidget "scl" xmScaleWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget cmd
- XmNbottomAttachment XmATTACH_NONE)))
- (notes (XtCreateManagedWidget "notes" xmNotebookWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget scl
- XmNbottomAttachment XmATTACH_NONE)))
-
- (cmb (XtCreateManagedWidget "cmb" xmComboBoxWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget notes
- XmNbottomAttachment XmATTACH_FORM)))
- (toggled 0))
- (XtCreateManagedWidget "one" xmPushButtonWidgetClass notes '())
- (XtCreateManagedWidget "two" xmPushButtonWidgetClass notes '())
- (let ((info (cadr (XmNotebookGetPageInfo notes 1))))
- (if (not (= (.page_number info) 1)) (snd-display ";page_number: ~A" (.page_number info)))
- (if (.page_widget info) (snd-display ";page_widget: ~A" (.page_widget info)))
- (if (.status_area_widget info) (snd-display ";status_area_widget: ~A" (.status_area_widget info)))
- (if (not (Widget? (.major_tab_widget info))) (snd-display ";major_tab_widget: ~A" (.major_tab_widget info)))
- (if (.minor_tab_widget info) (snd-display ";minor_tab_widget: ~A" (.minor_tab_widget info)))
+ (cmb (XtCreateManagedWidget "cmb" xmComboBoxWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget notes
+ XmNbottomAttachment XmATTACH_FORM)))
+ (toggled 0))
+ (XtCreateManagedWidget "one" xmPushButtonWidgetClass notes '())
+ (XtCreateManagedWidget "two" xmPushButtonWidgetClass notes '())
+ (let ((info (cadr (XmNotebookGetPageInfo notes 1))))
+ (if (not (= (.page_number info) 1)) (snd-display #__line__ ";page_number: ~A" (.page_number info)))
+ (if (.page_widget info) (snd-display #__line__ ";page_widget: ~A" (.page_widget info)))
+ (if (.status_area_widget info) (snd-display #__line__ ";status_area_widget: ~A" (.status_area_widget info)))
+ (if (not (Widget? (.major_tab_widget info))) (snd-display #__line__ ";major_tab_widget: ~A" (.major_tab_widget info)))
+ (if (.minor_tab_widget info) (snd-display #__line__ ";minor_tab_widget: ~A" (.minor_tab_widget info)))
;(segfault) (XtFree (cadr info))
- )
-
- (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "hiho") 0)
- (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "away") 0)
- (XmSimpleSpinBoxDeletePos spn 0)
- (let ((vals (XtVaGetValues spn (list XmNvalues 0))))
- (XmSimpleSpinBoxSetItem spn (car (cadr vals))))
- (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "another") 0)
- (let ((vals (XtGetValues spn (list XmNeditable 0 XmNtextField 0))))
- (if (not (list-ref vals 1)) (snd-display ";XmNeditable spin box"))
- (if (not (Widget? (list-ref vals 3))) (snd-display ";XmNtextField: ~A" (list-ref vals 3))))
-
- (XtAddCallback tgl XmNvalueChangedCallback (lambda (w c i) (set! toggled 123)) #f)
- (XmToggleButtonSetState tgl #f #f)
- (XmToggleButtonGadgetSetState tgg #f #f)
- (if (not (= toggled 0)) (snd-display ";toggle calledback: ~A?" toggled))
- (if (XmToggleButtonGetState tgl) (snd-display ";XmToggleButtonSetState #f"))
- (if (XmToggleButtonGadgetGetState tgg) (snd-display ";XmToggleButtonGadgetSetState #f"))
- (XtVaSetValues tgl (list XmNtoggleMode XmTOGGLE_INDETERMINATE))
- (XmToggleButtonSetValue tgl XmINDETERMINATE #t)
- (XmToggleButtonGadgetSetValue tgg XmINDETERMINATE #t)
- (if (not (= toggled 123)) (snd-display ";toggle not calledback: ~A?" toggled))
-
- (XmCommandAppendValue cmd (XmStringCreateLocalized "hiho"))
- (XmCommandError cmd (XmStringCreateLocalized "hiho"))
- (if (not (Widget? (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
- (snd-display ";XmCommandGetChild: ~A" (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
- (XmCommandSetValue cmd (XmStringCreateLocalized "hiho"))
-
- (let ((one1 (XmStringCreateLocalized "one"))
- (two1 (XmStringCreateLocalized "two"))
- (three1 (XmStringCreateLocalized "three")))
- (XmComboBoxAddItem cmb one1 0 #f)
- (XmComboBoxAddItem cmb two1 0 #f)
- (XmComboBoxAddItem cmb three1 0 #f)
- (XmComboBoxDeletePos cmb 1)
- (XmComboBoxSelectItem cmb three1)
- (XmComboBoxSetItem cmb three1) ; hunh??
- (XmComboBoxUpdate cmb)
- (let ((vals (cadr (XtGetValues cmb (list XmNitems 0)))))
- (if (not (equal? vals (list two1 three1))) (snd-display ";XmComboBox: ~A" vals))))
-
- (XmContainerCut box current-time)
- (XmContainerCopy box current-time)
- (XmContainerPaste box)
- (XmContainerCopyLink box (list 'Time CurrentTime))
- (XmContainerPasteLink box)
- (let ((vals (XtVaGetValues box (list XmNlargeIconX 0 XmNlargeIconY 0))))
- (if (or (null? (cdr vals))
- (not (real? (cadr vals)))
- (fneq (cadr vals) 0.0)
- (null? (cdddr vals))
- (not (real? (cadddr vals)))
- (fneq (cadddr vals) 0.0))
- (snd-display ";xm-float resource vals: ~A" vals)))
-
- (XtAddCallback scl XmNvalueChangedCallback (lambda (w c i) #f))
- (XmScaleSetValue scl 25)
- (if (not (= (XmScaleGetValue scl) 25)) (snd-display ";XmScaleSetValue: ~A" (XmScaleGetValue scl)))
- (if (XmGetTearOffControl (car (menu-widgets))) (snd-display ";XmGetTearOffControl: ~A" (XmGetTearOffControl (car (menu-widgets)))))
- (let ((children (cadr (XtGetValues scl (list XmNchildren 0)))))
- (for-each
- (lambda (w)
- (let ((name (XtName w)))
- (if (and (XmIsSeparatorGadget w)
- (or (string=? name "BigTic")
- (string=? name "MedTic")
- (string=? name "SmallTic")))
- (XtDestroyWidget w))))
- children))
- (XmScaleSetTicks scl 5 2 0 10 5 0)
- )
-
- (XmSetColorCalculation #f)
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (scr1 (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr1))
- (screen (XDefaultScreenOfDisplay dpy))
- (scr (XmGetXmScreen (XDefaultScreenOfDisplay dpy)))
- (old-h (cadr (XtVaGetValues scr (list XmNhorizontalFontUnit 0))))
- (old-v (cadr (XtVaGetValues scr (list XmNverticalFontUnit 0)))))
- (if (not (XmIsScreen scr)) (snd-display ";XmIsScreen: ~A" scr))
- (let ((colors (XmGetColors screen cmap (basic-color))))
- (if (not (Pixel? (car colors)))
- (snd-display ";colors: ~A " colors))
- (let ((color-proc (lambda (bg)
- (list (white-pixel) (black-pixel) (white-pixel) (black-pixel)))))
- (XmSetColorCalculation color-proc)
- (if (not (equal? (XmGetColorCalculation) color-proc))
- (snd-display ";XmSetColorcalulcation ~A" (XmGetColorCalculation)))))
- (let ((vals (XtVaGetValues scr
- (list XmNbitmapConversionModel 0 XmNdarkThreshold 0 XmNfont 0 XmNunpostBehavior 0))))
- (if (not (= (list-ref vals 1) XmMATCH_DEPTH)) (snd-display ";XmNbitmapConversionModel: ~A" (list-ref vals 1)))
- (if (not (= (list-ref vals 3) 0)) (snd-display ";XmNdarkThreshold: ~A" (list-ref vals 3)))
- (if (not (XFontStruct? (list-ref vals 5))) (snd-display ";XmNfont: ~A" (list-ref vals 5)))
- (if (not (= (list-ref vals 7) XmUNPOST_AND_REPLAY)) (snd-display ";XmNunpostBehavior: ~A" (list-ref vals 7)))
- (XSetScreenSaver dpy -1 5 DefaultBlanking DefaultExposures)
- ))
- (let ((dpy (XtDisplay (cadr (main-widgets)))))
- (let* ((dp (XmGetXmDisplay dpy))
- (vals (XtVaGetValues dp
- (list XmNdragInitiatorProtocolStyle 0 XmNenableThinThickness 0 XmNmotifVersion 0))))
- (if (not (XmIsDisplay dp)) (snd-display ";XmIsDisplay: ~A" dp))
- (if (not (= (list-ref vals 1) XmDRAG_PREFER_RECEIVER)) (snd-display ";XmNdragInitiatorProtocolStyle: ~A" (list-ref vals 1)))
- (if (not (list-ref vals 3)) (snd-display ";XmNenableThinThickness?"))
- (if (not (= (list-ref vals 5) 2002)) (snd-display ";XmGetXmDisplay motif version: ~A" (list-ref vals 5)))
- (XtAddCallback dp XmNdragStartCallback (lambda (w c i) #f)))
-
- (if (not (string=? (XmCvtXmStringToCT (XmStringCreateLocalized "hiho")) "hiho"))
- (snd-display ";XmCvtXmStringToCT: ~A" (XmCvtXmStringToCT (XmStringCreateLocalized "hiho"))))
- (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmINCHES)))
- (if (not (= val 3)) (snd-display ";XmConvertStringToUnits in->in ~A" val)))
- (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmPOINTS)))
- (if (not (= val 225)) (snd-display ";XmConvertStringToUnits in->pts ~A" val)))
- (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmCENTIMETERS)))
- (if (not (= val 7)) (snd-display ";XmConvertStringToUnits in->cm ~A" val)))
- (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmMILLIMETERS)))
- (if (not (= val 70)) (snd-display ";XmConvertUnits cm->mm ~A" val)))
- (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmPIXELS)))
- (if (and (not (= val 278)) (not (= val 273))) (snd-display ";XmConvertUnits cm->pix ~A" val)))
- (XmVaCreateSimpleRadioBox (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) '())
- (XmVaCreateSimpleCheckBox (caddr (main-widgets)) "hiho" (lambda (w c i) #f) '())
- (XmVaCreateSimplePulldownMenu (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) '())
- (XmVaCreateSimplePopupMenu (caddr (main-widgets)) "hiho" (lambda (w c i) #f) '())
- (XmVaCreateSimpleMenuBar (caddr (main-widgets)) "hiho" '())
- (XmVaCreateSimpleOptionMenu (caddr (main-widgets)) "hiho"
- (XmStringCreateLocalized "away")
- (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0)
- 0 (lambda (w c i) #f) '())
-
-; (if (not (XmIsMotifWMRunning (cadr (main-widgets)))) (snd-display ";not XmIsMotifWMRunning?"))
- (install-searcher (lambda (file) (= (mus-sound-srate file) 44100)))
- (zync)
- (make-hidden-controls-dialog)
- (make-pixmap (cadr (main-widgets)) arrow-strs)
- (display-scanned-synthesis)
- (add-mark-pane)
- (let ((ind (open-sound "oboe.snd")))
- (snd-clock-icon ind 6)
- (add-tooltip (cadr (channel-widgets)) "the w button")
- (with-minmax-button ind)
- (make-channel-drop-site ind 0)
- (set-channel-drop (lambda (file s c) (snd-print file)) ind 0)
- (let ((drop-site (find-child (XtParent (XtParent (list-ref (channel-widgets ind 0) 7))) "drop here")))
- (if drop-site
- (begin
- (XtVaGetValues drop-site (list XmNdropRectangles 0))
- (let ((val (XmDropSiteRetrieve drop-site (list XmNnumImportTargets 0))))
- (if (not (= (cadr val) 1)) (snd-display ";XmDropSiteRetrieve num: ~A" val)))
- (XmDropSiteRetrieve drop-site (list XmNimportTargets 0))
- (if (not (XmDropSiteRegistered drop-site))
- (snd-display ";XmDropSiteRegistered?"))
- (XmDropSiteUnregister drop-site))
- (snd-display ";no drop site?"))))
-
- (add-mark 123)
- (add-popups)
- (let ((container
- (make-sound-box "sounds"
- (list-ref (main-widgets) 3)
- (lambda (file)
- (mix file))
- (lambda (file chn)
- (define (without-directories filename)
- (call-with-exit
- (lambda (return)
- (do ((i (- (string-length filename) 1) (- i 1)))
- ((= 0 i) filename)
- (if (char=? (string-ref filename i) #\/)
- (return (my-substring filename (+ i 1))))))))
- (format #f "~~/peaks/~A-peaks-~D"
- (snd-test-clean-string (mus-expand-filename file))
- chn))
- (list "oboe.snd" "pistol.snd" "cardinal.snd" "storm.snd")
- '())))
- (XmContainerRelayout container)
- (let ((vals (XtVaGetValues container
- (list XmNlargeCellHeight 0 XmNcollapsedStatePixmap 0 XmNdetailOrder 0 XmNdetailTabList 0
- XmNselectedObjects 0 XmNconvertCallback 0 XmNdestinationCallback 0 XmNselectionCallback 0))))
- (if (not (= (list-ref vals 1) 0)) (snd-display ";XmNlargeCellHeight: ~A" (list-ref vals 1)))
- (if (not (Pixmap? (list-ref vals 3))) (snd-display ";XmNcollapsedStatePixmap: ~A" (list-ref vals 3)))
- (let ((children '()))
- (for-each-child container
- (lambda (w)
- (if (XmIsIconGadget w)
- (set! children (cons w children)))))
- (XmContainerReorder container children (length children)))
- (let ((func (lambda (w) 0)))
- (XtSetValues container (list XmNinsertPosition func))
- (let ((func1 (cadr (XtGetValues container (list XmNinsertPosition 0)))))
- (if (not (equal? func func1)) (snd-display ";XmNinsertPosition: ~A ~A" func func1))))))
-
- (show-smpte-label)
- (with-level-meters 4)
- (play)
- (close-sound))
-
- ;; qualify proc is causing a segfault somehow
+ )
+
+ (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "hiho") 0)
+ (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "away") 0)
+ (XmSimpleSpinBoxDeletePos spn 0)
+ (let ((vals (XtVaGetValues spn (list XmNvalues 0))))
+ (XmSimpleSpinBoxSetItem spn (car (cadr vals))))
+ (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "another") 0)
+ (let ((vals (XtGetValues spn (list XmNeditable 0 XmNtextField 0))))
+ (if (not (list-ref vals 1)) (snd-display #__line__ ";XmNeditable spin box"))
+ (if (not (Widget? (list-ref vals 3))) (snd-display #__line__ ";XmNtextField: ~A" (list-ref vals 3))))
+
+ (XtAddCallback tgl XmNvalueChangedCallback (lambda (w c i) (set! toggled 123)) #f)
+ (XmToggleButtonSetState tgl #f #f)
+ (XmToggleButtonGadgetSetState tgg #f #f)
+ (if (not (= toggled 0)) (snd-display #__line__ ";toggle calledback: ~A?" toggled))
+ (if (XmToggleButtonGetState tgl) (snd-display #__line__ ";XmToggleButtonSetState #f"))
+ (if (XmToggleButtonGadgetGetState tgg) (snd-display #__line__ ";XmToggleButtonGadgetSetState #f"))
+ (XtVaSetValues tgl (list XmNtoggleMode XmTOGGLE_INDETERMINATE))
+ (XmToggleButtonSetValue tgl XmINDETERMINATE #t)
+ (XmToggleButtonGadgetSetValue tgg XmINDETERMINATE #t)
+ (if (not (= toggled 123)) (snd-display #__line__ ";toggle not calledback: ~A?" toggled))
+
+ (XmCommandAppendValue cmd (XmStringCreateLocalized "hiho"))
+ (XmCommandError cmd (XmStringCreateLocalized "hiho"))
+ (if (not (Widget? (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
+ (snd-display #__line__ ";XmCommandGetChild: ~A" (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
+ (XmCommandSetValue cmd (XmStringCreateLocalized "hiho"))
+
+ (let ((one1 (XmStringCreateLocalized "one"))
+ (two1 (XmStringCreateLocalized "two"))
+ (three1 (XmStringCreateLocalized "three")))
+ (XmComboBoxAddItem cmb one1 0 #f)
+ (XmComboBoxAddItem cmb two1 0 #f)
+ (XmComboBoxAddItem cmb three1 0 #f)
+ (XmComboBoxDeletePos cmb 1)
+ (XmComboBoxSelectItem cmb three1)
+ (XmComboBoxSetItem cmb three1) ; hunh??
+ (XmComboBoxUpdate cmb)
+ (let ((vals (cadr (XtGetValues cmb (list XmNitems 0)))))
+ (if (not (equal? vals (list two1 three1))) (snd-display #__line__ ";XmComboBox: ~A" vals))))
+
+ (XmContainerCut box current-time)
+ (XmContainerCopy box current-time)
+ (XmContainerPaste box)
+ (XmContainerCopyLink box (list 'Time CurrentTime))
+ (XmContainerPasteLink box)
+ (let ((vals (XtVaGetValues box (list XmNlargeIconX 0 XmNlargeIconY 0))))
+ (if (or (null? (cdr vals))
+ (not (real? (cadr vals)))
+ (fneq (cadr vals) 0.0)
+ (null? (cdddr vals))
+ (not (real? (cadddr vals)))
+ (fneq (cadddr vals) 0.0))
+ (snd-display #__line__ ";xm-float resource vals: ~A" vals)))
+
+ (XtAddCallback scl XmNvalueChangedCallback (lambda (w c i) #f))
+ (XmScaleSetValue scl 25)
+ (if (not (= (XmScaleGetValue scl) 25)) (snd-display #__line__ ";XmScaleSetValue: ~A" (XmScaleGetValue scl)))
+ (if (XmGetTearOffControl (car (menu-widgets))) (snd-display #__line__ ";XmGetTearOffControl: ~A" (XmGetTearOffControl (car (menu-widgets)))))
+ (let ((children (cadr (XtGetValues scl (list XmNchildren 0)))))
+ (for-each
+ (lambda (w)
+ (let ((name (XtName w)))
+ (if (and (XmIsSeparatorGadget w)
+ (or (string=? name "BigTic")
+ (string=? name "MedTic")
+ (string=? name "SmallTic")))
+ (XtDestroyWidget w))))
+ children))
+ (XmScaleSetTicks scl 5 2 0 10 5 0)
+ )
+
+ (XmSetColorCalculation #f)
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (scr1 (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr1))
+ (screen (XDefaultScreenOfDisplay dpy))
+ (scr (XmGetXmScreen (XDefaultScreenOfDisplay dpy)))
+ (old-h (cadr (XtVaGetValues scr (list XmNhorizontalFontUnit 0))))
+ (old-v (cadr (XtVaGetValues scr (list XmNverticalFontUnit 0)))))
+ (if (not (XmIsScreen scr)) (snd-display #__line__ ";XmIsScreen: ~A" scr))
+ (let ((colors (XmGetColors screen cmap (basic-color))))
+ (if (not (Pixel? (car colors)))
+ (snd-display #__line__ ";colors: ~A " colors))
+ (let ((color-proc (lambda (bg)
+ (list (white-pixel) (black-pixel) (white-pixel) (black-pixel)))))
+ (XmSetColorCalculation color-proc)
+ (if (not (equal? (XmGetColorCalculation) color-proc))
+ (snd-display #__line__ ";XmSetColorcalulcation ~A" (XmGetColorCalculation)))))
+ (let ((vals (XtVaGetValues scr
+ (list XmNbitmapConversionModel 0 XmNdarkThreshold 0 XmNfont 0 XmNunpostBehavior 0))))
+ (if (not (= (list-ref vals 1) XmMATCH_DEPTH)) (snd-display #__line__ ";XmNbitmapConversionModel: ~A" (list-ref vals 1)))
+ (if (not (= (list-ref vals 3) 0)) (snd-display #__line__ ";XmNdarkThreshold: ~A" (list-ref vals 3)))
+ (if (not (XFontStruct? (list-ref vals 5))) (snd-display #__line__ ";XmNfont: ~A" (list-ref vals 5)))
+ (if (not (= (list-ref vals 7) XmUNPOST_AND_REPLAY)) (snd-display #__line__ ";XmNunpostBehavior: ~A" (list-ref vals 7)))
+ (XSetScreenSaver dpy -1 5 DefaultBlanking DefaultExposures)
+ ))
+ (let ((dpy (XtDisplay (cadr (main-widgets)))))
+ (let* ((dp (XmGetXmDisplay dpy))
+ (vals (XtVaGetValues dp
+ (list XmNdragInitiatorProtocolStyle 0 XmNenableThinThickness 0 XmNmotifVersion 0))))
+ (if (not (XmIsDisplay dp)) (snd-display #__line__ ";XmIsDisplay: ~A" dp))
+ (if (not (= (list-ref vals 1) XmDRAG_PREFER_RECEIVER)) (snd-display #__line__ ";XmNdragInitiatorProtocolStyle: ~A" (list-ref vals 1)))
+ (if (not (list-ref vals 3)) (snd-display #__line__ ";XmNenableThinThickness?"))
+ (if (not (= (list-ref vals 5) 2002)) (snd-display #__line__ ";XmGetXmDisplay motif version: ~A" (list-ref vals 5)))
+ (XtAddCallback dp XmNdragStartCallback (lambda (w c i) #f)))
+
+ (if (not (string=? (XmCvtXmStringToCT (XmStringCreateLocalized "hiho")) "hiho"))
+ (snd-display #__line__ ";XmCvtXmStringToCT: ~A" (XmCvtXmStringToCT (XmStringCreateLocalized "hiho"))))
+ (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmINCHES)))
+ (if (not (= val 3)) (snd-display #__line__ ";XmConvertStringToUnits in->in ~A" val)))
+ (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmPOINTS)))
+ (if (not (= val 225)) (snd-display #__line__ ";XmConvertStringToUnits in->pts ~A" val)))
+ (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmCENTIMETERS)))
+ (if (not (= val 7)) (snd-display #__line__ ";XmConvertStringToUnits in->cm ~A" val)))
+ (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmMILLIMETERS)))
+ (if (not (= val 70)) (snd-display #__line__ ";XmConvertUnits cm->mm ~A" val)))
+ (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmPIXELS)))
+ (if (and (not (= val 278)) (not (= val 273))) (snd-display #__line__ ";XmConvertUnits cm->pix ~A" val)))
+ (XmVaCreateSimpleRadioBox (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) '())
+ (XmVaCreateSimpleCheckBox (caddr (main-widgets)) "hiho" (lambda (w c i) #f) '())
+ (XmVaCreateSimplePulldownMenu (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) '())
+ (XmVaCreateSimplePopupMenu (caddr (main-widgets)) "hiho" (lambda (w c i) #f) '())
+ (XmVaCreateSimpleMenuBar (caddr (main-widgets)) "hiho" '())
+ (XmVaCreateSimpleOptionMenu (caddr (main-widgets)) "hiho"
+ (XmStringCreateLocalized "away")
+ (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0)
+ 0 (lambda (w c i) #f) '())
+
+ ; (if (not (XmIsMotifWMRunning (cadr (main-widgets)))) (snd-display #__line__ ";not XmIsMotifWMRunning?"))
+ (install-searcher (lambda (file) (= (mus-sound-srate file) 44100)))
+ (zync)
+ (make-hidden-controls-dialog)
+ (make-pixmap (cadr (main-widgets)) arrow-strs)
+ (display-scanned-synthesis)
+ (add-mark-pane)
+ (let ((ind (open-sound "oboe.snd")))
+ (snd-clock-icon ind 6)
+ (add-tooltip (cadr (channel-widgets)) "the w button")
+ (with-minmax-button ind)
+ (make-channel-drop-site ind 0)
+ (set-channel-drop (lambda (file s c) (snd-print file)) ind 0)
+ (let ((drop-site (find-child (XtParent (XtParent (list-ref (channel-widgets ind 0) 7))) "drop here")))
+ (if drop-site
+ (begin
+ (XtVaGetValues drop-site (list XmNdropRectangles 0))
+ (let ((val (XmDropSiteRetrieve drop-site (list XmNnumImportTargets 0))))
+ (if (not (= (cadr val) 1)) (snd-display #__line__ ";XmDropSiteRetrieve num: ~A" val)))
+ (XmDropSiteRetrieve drop-site (list XmNimportTargets 0))
+ (if (not (XmDropSiteRegistered drop-site))
+ (snd-display #__line__ ";XmDropSiteRegistered?"))
+ (XmDropSiteUnregister drop-site))
+ (snd-display #__line__ ";no drop site?"))))
+
+ (add-mark 123)
+ (add-popups)
+ (let ((container
+ (make-sound-box "sounds"
+ (list-ref (main-widgets) 3)
+ (lambda (file)
+ (mix file))
+ (lambda (file chn)
+ (define (without-directories filename)
+ (call-with-exit
+ (lambda (return)
+ (do ((i (- (string-length filename) 1) (- i 1)))
+ ((= 0 i) filename)
+ (if (char=? (string-ref filename i) #\/)
+ (return (my-substring filename (+ i 1))))))))
+ (format #f "~~/peaks/~A-peaks-~D"
+ (snd-test-clean-string (mus-expand-filename file))
+ chn))
+ (list "oboe.snd" "pistol.snd" "cardinal.snd" "storm.snd")
+ '())))
+ (XmContainerRelayout container)
+ (let ((vals (XtVaGetValues container
+ (list XmNlargeCellHeight 0 XmNcollapsedStatePixmap 0 XmNdetailOrder 0 XmNdetailTabList 0
+ XmNselectedObjects 0 XmNconvertCallback 0 XmNdestinationCallback 0 XmNselectionCallback 0))))
+ (if (not (= (list-ref vals 1) 0)) (snd-display #__line__ ";XmNlargeCellHeight: ~A" (list-ref vals 1)))
+ (if (not (Pixmap? (list-ref vals 3))) (snd-display #__line__ ";XmNcollapsedStatePixmap: ~A" (list-ref vals 3)))
+ (let ((children '()))
+ (for-each-child container
+ (lambda (w)
+ (if (XmIsIconGadget w)
+ (set! children (cons w children)))))
+ (XmContainerReorder container children (length children)))
+ (let ((func (lambda (w) 0)))
+ (XtSetValues container (list XmNinsertPosition func))
+ (let ((func1 (cadr (XtGetValues container (list XmNinsertPosition 0)))))
+ (if (not (equal? func func1)) (snd-display #__line__ ";XmNinsertPosition: ~A ~A" func func1))))))
+
+ (show-smpte-label)
+ (with-level-meters 4)
+ (play)
+ (close-sound))
+
+ ;; qualify proc is causing a segfault somehow
; (let ((box (XmCreateFileSelectionBox (cadr (main-widgets)) "box"
; (list XmNfileSearchProc (lambda (w c) #f)
; XmNqualifySearchDataProc (lambda (w c i)
; (display "qualifier was called!")
; )))))
; (XtUnmanageChild box))
- (let ((hi (XtCreateManagedWidget "hi" xmTextWidgetClass (cadr (main-widgets))
- (list XmNqualifySearchDataProc (lambda (w c i) "hi")
- XmNtransferProc (lambda (a b c d e f g) "ho")
- XmNcolorAllocationProc (lambda (a b c) #f)
- XmNcolorCalculationProc (lambda (a b) #f)
- XmNcreatePopupChildProc (lambda (a) #f)
- XmNlargeIconX 0.5
- ))))
- (XtVaSetValues hi (list XmNqualifySearchDataProc (lambda (w c i) "hi")
- XmNtransferProc (lambda (a b c d e f g) "ho")
- XmNcolorAllocationProc (lambda (a b c) #f)
- XmNcolorCalculationProc (lambda (a b) #f)
- XmNcreatePopupChildProc (lambda (a) #f)))
- (XtVaSetValues hi (list XmNqualifySearchDataProc #f
- XmNcolorAllocationProc #f
- XmNcolorCalculationProc #f
- XmNcreatePopupChildProc #f
- XmNx 10
- XmNsource (XmTextGetSource hi)
- ))
- (XtUnmanageChild hi))
-
- (if (and (defined? 'XmCreateFontSelector)
- (defined? 'XmCreateColorSelector))
- (let ((fonts-dialog #f)
- (colors-dialog #f))
- (for-each
- (lambda (make-dialog)
- (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
- (new-dialog (XmCreateTemplateDialog
- (cadr (main-widgets)) "Fonts"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNokLabelString xok
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNtransient #f))))
- (for-each
- (lambda (button color)
- (XtVaSetValues
- (XmMessageBoxGetChild new-dialog button)
- (list XmNarmColor (pushed-button-color)
- XmNbackground color)))
- (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
- (list (help-button-color) (quit-button-color) (doit-button-color)))
- (XtAddCallback new-dialog XmNcancelCallback (lambda (w c i) (XtUnmanageChild w)))
- (XtAddCallback new-dialog XmNhelpCallback (lambda (w c i) (help-dialog "Fonts" "no help yet")))
- (XtAddCallback new-dialog XmNokCallback (lambda (w c i) (XtUnmanageChild w)))
- (XmStringFree xhelp)
- (XmStringFree xok)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (if (not fonts-dialog)
- (set! fonts-dialog new-dialog)
- (set! colors-dialog new-dialog))
- (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color))))
- (fnts (make-dialog mainform)))
- (XtManageChild fnts)
- (if (not colors-dialog)
- (XtManageChild fonts-dialog)
- (XtManageChild colors-dialog)))))
- (list
- (lambda (mainform)
- (XmCreateFontSelector mainform "Fonts"
- (list XmNbackground (basic-color)
- XmNcurrentFont "-*-times-bold-r-*-*-14-140-*-*-*-*-*-*"
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE)))
-
- (lambda (mainform)
- (XmCreateColorSelector mainform "Colors"
- (list XmNbackground (basic-color)
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE)))))
- (XtUnmanageChild fonts-dialog)
- (XtUnmanageChild colors-dialog)))
-
- (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
- (new-dialog (XmCreateTemplateDialog
- (cadr (main-widgets)) "Fonts"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNokLabelString xok
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNtransient #f))))
- (XmStringFree xhelp)
- (XmStringFree xok)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color))))
- (fnts
- (if (defined? 'XmIsColumn)
- (let* ((w1 (XmCreateColumn mainform "column" '()))
- (w1-child (XtCreateManagedWidget "hihi" xmLabelWidgetClass w1 '() 0))
- (w2 (XtCreateManagedWidget "column1" xmColumnWidgetClass mainform '() 0)))
- (if (or (not (XmIsColumn w1))
- (not (XmIsColumn w2))
- (not (XmColumn? w1)))
- (snd-display ";XmIsColumn: ~A ~A" w1 w2))
- (if (defined? 'XmColumnGetChildLabel)
- (let ((child (XmColumnGetChildLabel w1)))
- (if (or (not (child)) (not (equal? child w1-child)))
- (snd-display ";XmColumn child: ~A ~A" child w1-child))))
- (XtManageChild w1)
- w1)
- #f))
- (fntt
- (if (defined? 'XmIsButtonBox)
- (let ((w1 (XmCreateButtonBox mainform "box" (list XmNfillOption XmFillMajor))))
- (if (or (not (XmIsButtonBox w1))
- (not (XmButtonBox? w1)))
- (snd-display ";XmIsButtonBox: ~A ~A ~A" w1 (XmIsButtonBox w1) (XmButtonBox? w1)))
- (XtManageChild w1)
- w1)
- #f))
- (fntd
- (if (defined? 'XmIsDropDown)
- (let ((w1 (XmCreateDropDown mainform "drop" '())))
- (if (or (not (XmIsDropDown w1))
- (not (XmDropDown? w1)))
- (snd-display ";XmIsDropDown: ~A ~A ~A" w1 (XmIsDropDown w1) (XmDropDown? w1)))
- (XtManageChild w1)
- (let ((text (XmDropDownGetText w1))
- (label (XmDropDownGetLabel w1))
- (arrow (XmDropDownGetArrow w1))
- (lst (XmDropDownGetList w1))
- (str (XmDropDownGetValue w1)))
- (if (not (XmTextField? text)) (snd-display ";dropdown text: ~A" text))
- (if (not (XmLabel? label)) (snd-display ";dropdown label: ~A" label))
- (if (not (XmArrowButton? arrow)) (snd-display ";dropdown arrow: ~A" arrow))
- (if (not (XmList? lst)) (snd-display ";dropdown lst: ~A" text))
- w1))
- #f))
- (fntda
- (if (defined? 'XmIsDataField)
- (let ((w1 (XmCreateDataField mainform "data" '())))
- (if (or (not (XmIsDataField w1))
- (not (XmDataField? w1)))
- (snd-display ";XmIsDataField: ~A ~A ~A" w1 (XmIsDataField w1) (XmDataField? w1)))
- (let ((str (XmDataFieldGetString w1))
- (sel (XmDataFieldGetSelection w1)))
- (XmDataFieldSetString w1 "hiho")
- (XmDataFieldSetEditable w1 #t)
- (XmDataFieldSetAddMode w1 #f)
- (XmDataFieldShowPosition w1 0)
- (XmDataFieldXYToPos w1 0 0)
- (XmDataFieldSetHighlight w1 0 0 0)
- (let ((sel1 (XmDataFieldGetSelectionPosition w1)))
- (XmDataFieldSetSelection w1 0 0 '(Time 0)))
- (XmDataFieldCopy w1 '(Time 0))
+ (let ((hi (XtCreateManagedWidget "hi" xmTextWidgetClass (cadr (main-widgets))
+ (list XmNqualifySearchDataProc (lambda (w c i) "hi")
+ XmNtransferProc (lambda (a b c d e f g) "ho")
+ XmNcolorAllocationProc (lambda (a b c) #f)
+ XmNcolorCalculationProc (lambda (a b) #f)
+ XmNcreatePopupChildProc (lambda (a) #f)
+ XmNlargeIconX 0.5
+ ))))
+ (XtVaSetValues hi (list XmNqualifySearchDataProc (lambda (w c i) "hi")
+ XmNtransferProc (lambda (a b c d e f g) "ho")
+ XmNcolorAllocationProc (lambda (a b c) #f)
+ XmNcolorCalculationProc (lambda (a b) #f)
+ XmNcreatePopupChildProc (lambda (a) #f)))
+ (XtVaSetValues hi (list XmNqualifySearchDataProc #f
+ XmNcolorAllocationProc #f
+ XmNcolorCalculationProc #f
+ XmNcreatePopupChildProc #f
+ XmNx 10
+ XmNsource (XmTextGetSource hi)
+ ))
+ (XtUnmanageChild hi))
+
+ (if (and (defined? 'XmCreateFontSelector)
+ (defined? 'XmCreateColorSelector))
+ (let ((fonts-dialog #f)
+ (colors-dialog #f))
+ (for-each
+ (lambda (make-dialog)
+ (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
+ (new-dialog (XmCreateTemplateDialog
+ (cadr (main-widgets)) "Fonts"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNokLabelString xok
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground (basic-color)
+ XmNtransient #f))))
+ (for-each
+ (lambda (button color)
+ (XtVaSetValues
+ (XmMessageBoxGetChild new-dialog button)
+ (list XmNarmColor (pushed-button-color)
+ XmNbackground color)))
+ (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
+ (list (help-button-color) (quit-button-color) (doit-button-color)))
+ (XtAddCallback new-dialog XmNcancelCallback (lambda (w c i) (XtUnmanageChild w)))
+ (XtAddCallback new-dialog XmNhelpCallback (lambda (w c i) (help-dialog "Fonts" "no help yet")))
+ (XtAddCallback new-dialog XmNokCallback (lambda (w c i) (XtUnmanageChild w)))
+ (XmStringFree xhelp)
+ (XmStringFree xok)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+ (if (not fonts-dialog)
+ (set! fonts-dialog new-dialog)
+ (set! colors-dialog new-dialog))
+ (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
+ XmNbackground (basic-color))))
+ (fnts (make-dialog mainform)))
+ (XtManageChild fnts)
+ (if (not colors-dialog)
+ (XtManageChild fonts-dialog)
+ (XtManageChild colors-dialog)))))
+ (list
+ (lambda (mainform)
+ (XmCreateFontSelector mainform "Fonts"
+ (list XmNbackground (basic-color)
+ XmNcurrentFont "-*-times-bold-r-*-*-14-140-*-*-*-*-*-*"
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE)))
+
+ (lambda (mainform)
+ (XmCreateColorSelector mainform "Colors"
+ (list XmNbackground (basic-color)
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE)))))
+ (XtUnmanageChild fonts-dialog)
+ (XtUnmanageChild colors-dialog)))
+
+ (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
+ (new-dialog (XmCreateTemplateDialog
+ (cadr (main-widgets)) "Fonts"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNokLabelString xok
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground (basic-color)
+ XmNtransient #f))))
+ (XmStringFree xhelp)
+ (XmStringFree xok)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+ (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
+ XmNbackground (basic-color))))
+ (fnts
+ (if (defined? 'XmIsColumn)
+ (let* ((w1 (XmCreateColumn mainform "column" '()))
+ (w1-child (XtCreateManagedWidget "hihi" xmLabelWidgetClass w1 '() 0))
+ (w2 (XtCreateManagedWidget "column1" xmColumnWidgetClass mainform '() 0)))
+ (if (or (not (XmIsColumn w1))
+ (not (XmIsColumn w2))
+ (not (XmColumn? w1)))
+ (snd-display #__line__ ";XmIsColumn: ~A ~A" w1 w2))
+ (if (defined? 'XmColumnGetChildLabel)
+ (let ((child (XmColumnGetChildLabel w1)))
+ (if (or (not (child)) (not (equal? child w1-child)))
+ (snd-display #__line__ ";XmColumn child: ~A ~A" child w1-child))))
+ (XtManageChild w1)
+ w1)
+ #f))
+ (fntt
+ (if (defined? 'XmIsButtonBox)
+ (let ((w1 (XmCreateButtonBox mainform "box" (list XmNfillOption XmFillMajor))))
+ (if (or (not (XmIsButtonBox w1))
+ (not (XmButtonBox? w1)))
+ (snd-display #__line__ ";XmIsButtonBox: ~A ~A ~A" w1 (XmIsButtonBox w1) (XmButtonBox? w1)))
+ (XtManageChild w1)
+ w1)
+ #f))
+ (fntd
+ (if (defined? 'XmIsDropDown)
+ (let ((w1 (XmCreateDropDown mainform "drop" '())))
+ (if (or (not (XmIsDropDown w1))
+ (not (XmDropDown? w1)))
+ (snd-display #__line__ ";XmIsDropDown: ~A ~A ~A" w1 (XmIsDropDown w1) (XmDropDown? w1)))
+ (XtManageChild w1)
+ (let ((text (XmDropDownGetText w1))
+ (label (XmDropDownGetLabel w1))
+ (arrow (XmDropDownGetArrow w1))
+ (lst (XmDropDownGetList w1))
+ (str (XmDropDownGetValue w1)))
+ (if (not (XmTextField? text)) (snd-display #__line__ ";dropdown text: ~A" text))
+ (if (not (XmLabel? label)) (snd-display #__line__ ";dropdown label: ~A" label))
+ (if (not (XmArrowButton? arrow)) (snd-display #__line__ ";dropdown arrow: ~A" arrow))
+ (if (not (XmList? lst)) (snd-display #__line__ ";dropdown lst: ~A" text))
+ w1))
+ #f))
+ (fntda
+ (if (defined? 'XmIsDataField)
+ (let ((w1 (XmCreateDataField mainform "data" '())))
+ (if (or (not (XmIsDataField w1))
+ (not (XmDataField? w1)))
+ (snd-display #__line__ ";XmIsDataField: ~A ~A ~A" w1 (XmIsDataField w1) (XmDataField? w1)))
+ (let ((str (XmDataFieldGetString w1))
+ (sel (XmDataFieldGetSelection w1)))
+ (XmDataFieldSetString w1 "hiho")
+ (XmDataFieldSetEditable w1 #t)
+ (XmDataFieldSetAddMode w1 #f)
+ (XmDataFieldShowPosition w1 0)
+ (XmDataFieldXYToPos w1 0 0)
+ (XmDataFieldSetHighlight w1 0 0 0)
+ (let ((sel1 (XmDataFieldGetSelectionPosition w1)))
+ (XmDataFieldSetSelection w1 0 0 '(Time 0)))
+ (XmDataFieldCopy w1 '(Time 0))
;(XmDataFieldPaste w1) ; x error
- (XmDataFieldCut w1 '(Time 0))
- w1))
- #f))
- (fnttab
- (if (defined? 'XmIsTabStack)
- (let ((w1 (XmCreateTabStack mainform "hi" '())))
- (if (or (not (XmIsTabStack w1))
- (not (XmTabStack? w1)))
- (snd-display ";XmIsTabStack: ~A ~A ~A" w1 (XmIsTabStack w1) (XmTabStack? w1)))
- (let ((tab (XmTabStackGetSelectedTab w1)))
- (XmTabStackSelectTab w1 #f)
- w1))
- #f)))
-
- (if (and (defined? 'XmToolTipGetLabel)
- (defined? 'XmNtoolTipString))
- (let ((wid1 (XtCreateManagedWidget "wid1" xmPushButtonWidgetClass mainform
- (list XmNtoolTipString (XmStringCreateLocalized "tooltip")
- XmNtoolTipPostDelay 100
- XmNtoolTipPostDuration 500
- XmNtoolTipEnable #t
- XmNanimate #f))))
- (let ((tip (XmToolTipGetLabel wid1)))
- (if (not (Widget? tip)) (snd-display ";tooltip label: ~A" tip)))))
-
- (XtManageChild new-dialog)
- (XtUnmanageChild new-dialog)))
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (prop (XmInternAtom dpy "TESTING" #f))
- (proto1 (XmInternAtom dpy "TEST1" #f))
- (proto2 (XmInternAtom dpy "TEST2" #f))
- (val 0))
- (if (not (Atom? prop)) (snd-display ";XmInternAtom: ~A" prop))
- (if (not (string=? (XmGetAtomName dpy prop) "TESTING")) (snd-display ";XmGetAtomName: ~A" (XmGetAtomName dpy prop)))
- (XmAddProtocols shell prop (list proto1 proto2))
- (XmSetProtocolHooks shell
- (XmInternAtom dpy "WM_PROTOCOLS" #f)
- prop
- (lambda (w c i)
- (snd-display ";prehook: ~A ~A ~A" w c i))
- 12345
- (lambda (w c i)
- (snd-display ";posthook: ~A ~A ~A" w c i))
- 54321)
- (XmDeactivateProtocol shell prop proto2)
- (XmRemoveProtocols shell prop (list proto2))
- (XmAddProtocolCallback shell prop proto1 (lambda (w c i) (set! val c)) 123)
- (XmActivateProtocol shell prop proto1)
- (let ((e (XEvent ClientMessage))
- (window (XtWindow shell)))
- (set! (.window e) window)
- (set! (.display e) dpy)
- (set! (.format e) 8)
- (set! (.message_type e) XA_STRING)
- (set! (.data e) "hiho")
- (XSendEvent dpy window #f 0 e))
- (XmRemoveProtocols shell prop (list proto1)))
- (XmCascadeButtonHighlight (XmCreateCascadeButton (cadr (main-widgets)) "cascade" '()) #f)
+ (XmDataFieldCut w1 '(Time 0))
+ w1))
+ #f))
+ (fnttab
+ (if (defined? 'XmIsTabStack)
+ (let ((w1 (XmCreateTabStack mainform "hi" '())))
+ (if (or (not (XmIsTabStack w1))
+ (not (XmTabStack? w1)))
+ (snd-display #__line__ ";XmIsTabStack: ~A ~A ~A" w1 (XmIsTabStack w1) (XmTabStack? w1)))
+ (let ((tab (XmTabStackGetSelectedTab w1)))
+ (XmTabStackSelectTab w1 #f)
+ w1))
+ #f)))
+
+ (if (and (defined? 'XmToolTipGetLabel)
+ (defined? 'XmNtoolTipString))
+ (let ((wid1 (XtCreateManagedWidget "wid1" xmPushButtonWidgetClass mainform
+ (list XmNtoolTipString (XmStringCreateLocalized "tooltip")
+ XmNtoolTipPostDelay 100
+ XmNtoolTipPostDuration 500
+ XmNtoolTipEnable #t
+ XmNanimate #f))))
+ (let ((tip (XmToolTipGetLabel wid1)))
+ (if (not (Widget? tip)) (snd-display #__line__ ";tooltip label: ~A" tip)))))
+
+ (XtManageChild new-dialog)
+ (XtUnmanageChild new-dialog)))
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (prop (XmInternAtom dpy "TESTING" #f))
+ (proto1 (XmInternAtom dpy "TEST1" #f))
+ (proto2 (XmInternAtom dpy "TEST2" #f))
+ (val 0))
+ (if (not (Atom? prop)) (snd-display #__line__ ";XmInternAtom: ~A" prop))
+ (if (not (string=? (XmGetAtomName dpy prop) "TESTING")) (snd-display #__line__ ";XmGetAtomName: ~A" (XmGetAtomName dpy prop)))
+ (XmAddProtocols shell prop (list proto1 proto2))
+ (XmSetProtocolHooks shell
+ (XmInternAtom dpy "WM_PROTOCOLS" #f)
+ prop
+ (lambda (w c i)
+ (snd-display #__line__ ";prehook: ~A ~A ~A" w c i))
+ 12345
+ (lambda (w c i)
+ (snd-display #__line__ ";posthook: ~A ~A ~A" w c i))
+ 54321)
+ (XmDeactivateProtocol shell prop proto2)
+ (XmRemoveProtocols shell prop (list proto2))
+ (XmAddProtocolCallback shell prop proto1 (lambda (w c i) (set! val c)) 123)
+ (XmActivateProtocol shell prop proto1)
+ (let ((e (XEvent ClientMessage))
+ (window (XtWindow shell)))
+ (set! (.window e) window)
+ (set! (.display e) dpy)
+ (set! (.format e) 8)
+ (set! (.message_type e) XA_STRING)
+ (set! (.data e) "hiho")
+ (XSendEvent dpy window #f 0 e))
+ (XmRemoveProtocols shell prop (list proto1)))
+ (XmCascadeButtonHighlight (XmCreateCascadeButton (cadr (main-widgets)) "cascade" '()) #f)
;(XmCascadeButtonGadgetHighlight (XmCreateCascadeButtonGadget (cadr (main-widgets)) "gadget" '()) #f)
-
- (let ((callbacks
- (list
- (list XmAnyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event))
- (list XmArrowButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
- (list XmCommandCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'XmString '.value) (list .length 'int '.length #f))
- (list XmDragDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp))
- (list XmDragMotionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f))
- (list XmDragProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .animate 'Boolean '.animate #f))
- (list XmDrawingAreaCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .window 'Window '.window))
- (list XmDrawnButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .window 'Window '.window) (list .click_count 'int '.click_count))
- (list XmDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .dropAction 'uchar '.dropAction #f) (list .completionStatus 'uchar '.completionStatus #f))
- (list XmDropProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .dropAction 'uchar '.dropAction #f))
- (list XmDropSiteEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f))
- (list XmDropSiteLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp))
- (list XmDropStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .dropAction 'uchar '.dropAction #f))
- (list XmFileSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'XmString '.value) (list .length 'int '.length #f) (list .mask 'XmString '.mask #f)
- (list .mask_length 'int '.mask_length #f) (list .dir 'XmString '.dir #f) (list .dir_length 'int '.dir_length #f)
- (list .pattern 'XmString '.pattern #f) (list .pattern_length 'int '.pattern_length #f))
- (list XmListCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .item 'XmString '.item #f) (list .item_length 'int '.item_length #f) (list .item_position 'int '.item_position #f)
- (list .selected_items 'XmString* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
- (list .selected_item_positions 'int* '.selected_item_positions) (list .selection_type 'char '.selection_type #f)
- (list .auto_selection_type 'char '.auto_selection_type #f))
- (list XmOperationChangedCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f)
- (list .dropSiteStatus 'uchar '.dropSiteStatus))
- (list XmPushButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
- (list XmRowColumnCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .widget 'Widget '.widget #f) (list .data 'char* '.data #f) (list .callbackstruct 'char* '.callbackstruct #f))
- (list XmScaleCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .value 'int '.value))
- (list XmScrollBarCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'int '.value) (list .pixel 'int '.pixel #f))
- (list XmSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'XmString '.value) (list .length 'int '.length #f))
- (list XmTextVerifyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .doit 'Boolean '.doit) (list .currInsert 'int '.currInsert #f) (list .newInsert 'int '.newInsert #f)
- (list .startPos 'int '.startPos #f) (list .endPos 'int '.endPos #f)
- (list .text 'XmTextBlock '.text #f))
- (list XmToggleButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .set 'int '.set))
- (list XmDestinationCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selection 'Atom '.selection #f) (list .operation 'uchar '.operation) (list .flags 'int '.flags #f)
- (list .transfer_id 'XtPointer '.transfer_id #f) (list .destination_data 'XtPointer '.destination_data #f)
- (list .location_data 'XtPointer '.location_data #f) (list .time 'Time '.time))
- (list XmConvertCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .selection 'Atom '.selection #f)
- (list .target 'Atom '.target #f) (list .source_data 'XtPointer '.source_data #f)
- (list .location_data 'XtPointer '.location_data #f) (list .flags 'int '.flags #f) (list .parm 'XtPointer '.parm #f)
- (list .parm_format 'int '.parm_format #f) (list .parm_length 'int '.parm_length #f)
- (list .parm_type 'Atom '.parm_type #f) (list .status 'int '.status #f) (list .value 'XtPointer '.value #f)
- (list .type 'Atom '.type #f) (list .format 'int '.format #f) (list .length 'int '.length #f))
- (list XmComboBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .item_or_text 'XmString '.item_or_text #f) (list .item_position 'int '.item_position #f))
- (list XmContainerOutlineCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .item 'Widget '.item #f) (list .new_outline_state 'uchar '.new_outline_state #f))
- (list XmContainerSelectCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selected_items 'Widget* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
- (list .auto_selection_type 'uchar '.auto_selection_type #f))
- (list XmNotebookCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .page_number 'int '.page_number #f) (list .page_widget 'Widget '.page_widget #f)
- (list .prev_page_number 'int '.prev_page_number #f) (list .prev_page_widget 'Widget '.prev_page_widget #f))
- (list XmSpinBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit) (list .position 'int '.position #f)
- (list .value 'XmString '.value #f) (list .crossed_boundary 'Boolean '.crossed-boundary #f))
- (list XmTraverseObscuredCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .traversal_destination 'Widget '.traversal_destination #f))
- (list XmTopLevelLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window))
- (list XmTopLevelEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dragProtocolStyle 'uchar '.dragProtocolStyle #f))
- (list XmPopupHandlerCallbackStruct (list .reason 'int '.reason)
- (list .event 'XEvent '.event) (list .menuToPost 'Widget '.menuToPost) (list .postIt 'Boolean '.postIt)
- (list .target 'Widget '.target #f))
- (list XmSelectionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selection 'Atom '.selection #f) (list .target 'Atom '.target #f) (list .type 'Atom '.type #f)
- (list .transfer_id 'XtPointer '.transfer_id #f) (list .flags 'int '.flags #f) (list .remaining 'int '.remaining #f)
- (list .value 'XtPointer '.value #f) (list .length 'int '.length #f) (list .format 'int '.format #f))
- (list XmTransferDoneCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selection 'Atom '.selection #f) (list .transfer_id 'XtPointer '.transfer_id #f) (list .status 'int '.status #f)
- (list .client_data 'XtPointer '.client_data #f))
- (list XmDisplayCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .font_name 'char* '.font_name #f) (list .tag 'int '.tag #f)
- (list .render_table 'XmRenderTable '.render_table #f)
- (list .rendition 'XmRendition '.rendition #f))
- (list XmDragStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit))
- )))
-
-
- (for-each
- (lambda (call)
- (let ((struct ((car call)))
- (val #f))
- (set! (.event struct) (XEvent))
- (for-each
- (lambda (field)
- (if (not (list-p field)) (snd-display ";~A: ~A" struct field))
- (set! val ((car field) struct))
- (if (< (length field) 4)
- (case (cadr field)
- ((int) (set! ((car field) struct) 0))
- ((Atom) (set! ((car field) struct) XA_STRING))
- ((uchar) (set! ((car field) struct) 0))
- ((Position) (set! ((car field) struct) 0))
- ((Widget) (set! ((car field) struct) (list 'Widget 0)))
- ((XmString) (set! ((car field) struct) (list 'XmString 0)))
- ((XtPointer) (set! ((car field) struct) 0))
- ((char*) (set! ((car field) struct) "hi"))
- ((Boolean) (set! ((car field) struct) #f))
- ((XEvent) #f) ; already being set
- ((XmString* int* Time Window Widget* Screen) #f)
- ((char) (set! ((car field) struct) 0))
- )))
- (cdr call))))
- callbacks)
- )
-
- (let ((shell (cadr (main-widgets)))
- (resource-list
- (list
- (list XmNaccelerator XM_STRING) (list XmNacceleratorText XM_XMSTRING) (list XmNaccelerators XM_ULONG)
- (list XmNactivateCallback XM_CALLBACK) (list XmNadjustLast XM_BOOLEAN) (list XmNadjustMargin XM_BOOLEAN)
- (list XmNalignment XM_UCHAR) (list XmNallowOverlap XM_BOOLEAN) (list XmNallowResize XM_BOOLEAN)
- (list XmNallowShellResize XM_BOOLEAN) (list XmNancestorSensitive XM_BOOLEAN) (list XmNanimationMask XM_PIXMAP)
- (list XmNanimationPixmap XM_PIXMAP) (list XmNanimationPixmapDepth XM_INT) (list XmNanimationStyle XM_UCHAR)
- (list XmNapplyCallback XM_CALLBACK) (list XmNapplyLabelString XM_XMSTRING) (list XmNargc XM_INT)
- (list XmNargv XM_STRING_LIST) (list XmNarmCallback XM_CALLBACK) (list XmNarmColor XM_PIXEL)
- (list XmNarmPixmap XM_PIXMAP) (list XmNarrowDirection XM_UCHAR) (list XmNattachment XM_UCHAR)
- (list XmNaudibleWarning XM_UCHAR) (list XmNautoShowCursorPosition XM_BOOLEAN) (list XmNautoUnmanage XM_BOOLEAN)
- (list XmNautomaticSelection XM_UCHAR) (list XmNbackground XM_PIXEL) (list XmNbackgroundPixmap XM_PIXMAP)
- (list XmNbaseHeight XM_INT) (list XmNbaseWidth XM_INT) (list XmNbitmap XM_PIXMAP)
- (list XmNblendModel XM_ULONG) (list XmNblinkRate XM_INT) (list XmNborderColor XM_PIXEL)
- (list XmNborderPixmap XM_PIXMAP) (list XmNborderWidth XM_DIMENSION) (list XmNbottomAttachment XM_UCHAR)
- (list XmNbottomOffset XM_INT) (list XmNbottomPosition XM_INT) (list XmNbottomShadowColor XM_PIXEL)
- (list XmNbottomShadowPixmap XM_PIXMAP) (list XmNbottomWidget XM_WIDGET) (list XmNbrowseSelectionCallback XM_CALLBACK)
- (list XmNbuttonAcceleratorText XM_STRING_TABLE) (list XmNbuttonAccelerators XM_STRING_TABLE) (list XmNbuttonCount XM_INT)
- (list XmNbuttonMnemonicCharSets XM_CHARSET_TABLE) (list XmNbuttonMnemonics XM_KEYSYM_TABLE) (list XmNbuttonSet XM_INT)
- (list XmNbuttonType XM_ULONG) (list XmNbuttons XM_STRING_TABLE) (list XmNcancelButton XM_WIDGET)
- (list XmNcancelCallback XM_CALLBACK) (list XmNcancelLabelString XM_XMSTRING) (list XmNcascadePixmap XM_PIXMAP)
- (list XmNcascadingCallback XM_CALLBACK) (list XmNchildHorizontalAlignment XM_UCHAR) (list XmNchildHorizontalSpacing XM_DIMENSION)
- (list XmNchildPlacement XM_UCHAR) (list XmNchildVerticalAlignment XM_UCHAR) (list XmNchildren XM_WIDGET_LIST)
- (list XmNclientData XM_ULONG) (list XmNclipWindow XM_WIDGET) (list XmNcolormap XM_COLORMAP)
- (list XmNcolumns XM_SHORT) (list XmNcommand XM_XMSTRING) (list XmNcommandChangedCallback XM_CALLBACK)
- (list XmNcommandEnteredCallback XM_CALLBACK) (list XmNcommandWindow XM_WIDGET) (list XmNcommandWindowLocation XM_UCHAR)
- (list XmNconvertProc XM_CONVERT_CALLBACK) (list XmNcreatePopupChildProc XM_POPUP_CALLBACK) (list XmNcursorBackground XM_PIXEL)
- (list XmNcursorForeground XM_PIXEL) (list XmNcursorPosition XM_INT) (list XmNcursorPositionVisible XM_BOOLEAN)
- (list XmNdarkThreshold XM_INT) (list XmNdecimalPoints XM_SHORT) (list XmNdecrementCallback XM_CALLBACK)
- (list XmNdefaultActionCallback XM_CALLBACK) (list XmNdefaultButton XM_WIDGET) (list XmNdefaultButtonShadowThickness XM_DIMENSION)
- (list XmNdefaultButtonType XM_UCHAR) (list XmNdefaultCopyCursorIcon XM_WIDGET) (list XmNdefaultInvalidCursorIcon XM_WIDGET)
- (list XmNdefaultLinkCursorIcon XM_WIDGET) (list XmNdefaultMoveCursorIcon XM_WIDGET) (list XmNdefaultNoneCursorIcon XM_WIDGET)
- (list XmNdefaultPosition XM_BOOLEAN) (list XmNdefaultSourceCursorIcon XM_WIDGET) (list XmNdefaultValidCursorIcon XM_WIDGET)
- (list XmNdeleteResponse XM_UCHAR) (list XmNdepth XM_INT) (list XmNdestroyCallback XM_CALLBACK)
- (list XmNdialogStyle XM_UCHAR) (list XmNdialogTitle XM_XMSTRING) (list XmNdialogType XM_UCHAR)
- (list XmNdirListItemCount XM_INT) (list XmNdirListItems XM_STRING_TABLE) (list XmNdirListLabelString XM_XMSTRING)
- (list XmNdirMask XM_XMSTRING) (list XmNdirSearchProc XM_SEARCH_CALLBACK) (list XmNdirSpec XM_XMSTRING)
- (list XmNdirectory XM_XMSTRING) (list XmNdirectoryValid XM_BOOLEAN) (list XmNdisarmCallback XM_CALLBACK)
- (list XmNdoubleClickInterval XM_INT) (list XmNdragDropFinishCallback XM_CALLBACK) (list XmNdragInitiatorProtocolStyle XM_UCHAR)
- (list XmNdragMotionCallback XM_CALLBACK) (list XmNdragOperations XM_UCHAR) (list XmNdragReceiverProtocolStyle XM_UCHAR)
- (list XmNdropFinishCallback XM_CALLBACK) (list XmNdropProc XM_DROP_CALLBACK) (list XmNdropRectangles XM_RECTANGLE_LIST)
- (list XmNdropSiteActivity XM_UCHAR) (list XmNdropSiteEnterCallback XM_CALLBACK) (list XmNdropSiteLeaveCallback XM_CALLBACK)
- (list XmNdropSiteOperations XM_UCHAR) (list XmNdropSiteType XM_UCHAR) (list XmNdropStartCallback XM_CALLBACK)
- (list XmNdropTransfers XM_TRANSFER_ENTRY_LIST) (list XmNeditMode XM_INT) (list XmNeditable XM_BOOLEAN)
- (list XmNentryAlignment XM_UCHAR) (list XmNentryBorder XM_DIMENSION) (list XmNentryCallback XM_CALLBACK)
- (list XmNentryClass XM_WIDGET_CLASS) (list XmNentryVerticalAlignment XM_UCHAR) (list XmNexportTargets XM_ATOM_LIST)
- (list XmNexposeCallback XM_CALLBACK) (list XmNextendedSelectionCallback XM_CALLBACK) (list XmNfileListItemCount XM_INT)
- (list XmNfileListItems XM_STRING_TABLE) (list XmNfileListLabelString XM_XMSTRING) (list XmNfileSearchProc XM_SEARCH_CALLBACK)
- (list XmNfileTypeMask XM_UCHAR) (list XmNfillOnArm XM_BOOLEAN) (list XmNfillOnSelect XM_BOOLEAN)
- (list XmNfilterLabelString XM_XMSTRING) (list XmNfocusCallback XM_CALLBACK) (list XmNfont XM_XFONTSTRUCT)
- (list XmNforeground XM_PIXEL) (list XmNforegroundThreshold XM_INT) (list XmNfractionBase XM_INT)
- (list XmNgainPrimaryCallback XM_CALLBACK) (list XmNgeometry XM_STRING) (list XmNheight XM_DIMENSION)
- (list XmNheightInc XM_INT) (list XmNhelpCallback XM_CALLBACK) (list XmNhelpLabelString XM_XMSTRING)
- (list XmNhighlightColor XM_PIXEL) (list XmNhighlightOnEnter XM_BOOLEAN) (list XmNhighlightPixmap XM_PIXMAP)
- (list XmNhighlightThickness XM_DIMENSION) (list XmNhistoryItemCount XM_INT) (list XmNhistoryItems XM_STRING_TABLE)
- (list XmNhistoryMaxItems XM_INT) (list XmNhistoryVisibleItemCount XM_INT) (list XmNhorizontalFontUnit XM_INT)
- (list XmNhorizontalScrollBar XM_WIDGET) (list XmNhorizontalSpacing XM_DIMENSION) (list XmNhotX XM_POSITION)
- (list XmNhotY XM_POSITION) (list XmNiconMask XM_PIXMAP) (list XmNiconName XM_STRING)
- (list XmNiconNameEncoding XM_ATOM) (list XmNiconPixmap XM_PIXMAP) (list XmNiconWindow XM_WIDGET)
- (list XmNiconX XM_INT) (list XmNiconY XM_INT) (list XmNiconic XM_BOOLEAN)
- (list XmNimportTargets XM_ATOM_LIST) (list XmNincrement XM_INT) (list XmNincrementCallback XM_CALLBACK)
- (list XmNincremental XM_BOOLEAN) (list XmNindicatorOn XM_INT) (list XmNindicatorSize XM_DIMENSION)
- (list XmNindicatorType XM_UCHAR) (list XmNinitialDelay XM_INT) (list XmNinitialFocus XM_WIDGET)
- (list XmNinitialResourcesPersistent XM_BOOLEAN) (list XmNinitialState XM_INT) (list XmNinput XM_BOOLEAN)
- (list XmNinputCallback XM_CALLBACK) (list XmNinputMethod XM_STRING) (list XmNinsertPosition XM_ORDER_CALLBACK)
- (list XmNinvalidCursorForeground XM_PIXEL) (list XmNisAligned XM_BOOLEAN) (list XmNisHomogeneous XM_BOOLEAN)
- (list XmNitemCount XM_INT) (list XmNitems XM_STRING_TABLE) (list XmNkeyboardFocusPolicy XM_UCHAR)
- (list XmNlabelInsensitivePixmap XM_PIXMAP) (list XmNlabelPixmap XM_PIXMAP) (list XmNlabelString XM_XMSTRING)
- (list XmNlabelType XM_UCHAR) (list XmNleftAttachment XM_UCHAR) (list XmNleftOffset XM_INT)
- (list XmNleftPosition XM_INT) (list XmNleftWidget XM_WIDGET) (list XmNlightThreshold XM_INT)
- (list XmNlistItemCount XM_INT) (list XmNlistItems XM_STRING_TABLE) (list XmNlistLabelString XM_XMSTRING)
- (list XmNlistMarginHeight XM_DIMENSION) (list XmNlistMarginWidth XM_DIMENSION) (list XmNlistSizePolicy XM_UCHAR)
- (list XmNlistSpacing XM_DIMENSION) (list XmNlistUpdated XM_BOOLEAN) (list XmNlistVisibleItemCount XM_INT)
- (list XmNlosePrimaryCallback XM_CALLBACK) (list XmNlosingFocusCallback XM_CALLBACK) (list XmNmainWindowMarginHeight XM_DIMENSION)
- (list XmNmainWindowMarginWidth XM_DIMENSION) (list XmNmapCallback XM_CALLBACK) (list XmNmappedWhenManaged XM_BOOLEAN)
- (list XmNmappingDelay XM_INT) (list XmNmargin XM_DIMENSION) (list XmNmarginBottom XM_DIMENSION)
- (list XmNmarginHeight XM_DIMENSION) (list XmNmarginLeft XM_DIMENSION) (list XmNmarginRight XM_DIMENSION)
- (list XmNmarginTop XM_DIMENSION) (list XmNmarginWidth XM_DIMENSION) (list XmNmask XM_PIXMAP)
- (list XmNmaxAspectX XM_INT) (list XmNmaxAspectY XM_INT) (list XmNmaxHeight XM_INT)
- (list XmNmaxLength XM_INT) (list XmNmaxWidth XM_INT) (list XmNmaximum XM_INT)
- (list XmNmenuAccelerator XM_STRING) (list XmNmenuBar XM_WIDGET) (list XmNmenuCursor XM_STRING)
- (list XmNmenuHelpWidget XM_WIDGET) (list XmNmenuHistory XM_WIDGET) (list XmNmenuPost XM_STRING)
- (list XmNmessageAlignment XM_UCHAR) (list XmNmessageString XM_XMSTRING) (list XmNmessageWindow XM_WIDGET)
- (list XmNminAspectX XM_INT) (list XmNminAspectY XM_INT) (list XmNminHeight XM_INT)
- (list XmNminWidth XM_INT) (list XmNminimizeButtons XM_BOOLEAN) (list XmNminimum XM_INT)
- (list XmNmnemonic XM_KEYSYM) (list XmNmnemonicCharSet XM_STRING) (list XmNmodifyVerifyCallback XM_CALLBACK)
- (list XmNmotionVerifyCallback XM_CALLBACK) (list XmNmoveOpaque XM_BOOLEAN) (list XmNmultiClick XM_UCHAR)
- (list XmNmultipleSelectionCallback XM_CALLBACK) (list XmNmustMatch XM_BOOLEAN) (list XmNmwmDecorations XM_INT)
- (list XmNmwmFunctions XM_INT) (list XmNmwmInputMode XM_INT) (list XmNmwmMenu XM_STRING)
- (list XmNnavigationType XM_UCHAR) (list XmNnoMatchCallback XM_CALLBACK) (list XmNnoMatchString XM_XMSTRING)
- (list XmNnoResize XM_BOOLEAN) (list XmNnoneCursorForeground XM_PIXEL) (list XmNnumChildren XM_INT)
- (list XmNnumColumns XM_SHORT) (list XmNnumDropRectangles XM_INT) (list XmNnumDropTransfers XM_INT)
- (list XmNnumExportTargets XM_INT) (list XmNnumImportTargets XM_INT) (list XmNoffsetX XM_POSITION)
- (list XmNoffsetY XM_POSITION) (list XmNokCallback XM_CALLBACK) (list XmNokLabelString XM_XMSTRING)
- (list XmNoperationChangedCallback XM_CALLBACK) (list XmNoperationCursorIcon XM_WIDGET) (list XmNoptionLabel XM_XMSTRING)
- (list XmNoptionMnemonic XM_KEYSYM) (list XmNorientation XM_UCHAR) (list XmNoverrideRedirect XM_BOOLEAN)
- (list XmNpacking XM_UCHAR) (list XmNpageDecrementCallback XM_CALLBACK) (list XmNpageIncrement XM_INT)
- (list XmNpageIncrementCallback XM_CALLBACK) (list XmNpaneMaximum XM_DIMENSION) (list XmNpaneMinimum XM_DIMENSION)
- (list XmNpattern XM_STRING_OR_XMSTRING) (list XmNpendingDelete XM_BOOLEAN) (list XmNpixmap XM_PIXMAP)
- (list XmNpopdownCallback XM_CALLBACK) (list XmNpopupCallback XM_CALLBACK) (list XmNpopupEnabled XM_INT)
- (list XmNpositionIndex XM_SHORT) (list XmNpostFromButton XM_INT) (list XmNpreeditType XM_STRING)
- (list XmNprocessingDirection XM_UCHAR) (list XmNpromptString XM_XMSTRING) (list XmNpushButtonEnabled XM_BOOLEAN)
- (list XmNqualifySearchDataProc XM_QUALIFY_CALLBACK) (list XmNradioAlwaysOne XM_BOOLEAN) (list XmNradioBehavior XM_BOOLEAN)
- (list XmNrecomputeSize XM_BOOLEAN) (list XmNrefigureMode XM_BOOLEAN) (list XmNrepeatDelay XM_INT)
- (list XmNresizable XM_BOOLEAN) (list XmNresizeCallback XM_CALLBACK) (list XmNresizeHeight XM_BOOLEAN)
- (list XmNresizePolicy XM_UCHAR) (list XmNresizeWidth XM_BOOLEAN) (list XmNrightAttachment XM_UCHAR)
- (list XmNrightOffset XM_INT) (list XmNrightPosition XM_INT) (list XmNrightWidget XM_WIDGET)
- (list XmNrowColumnType XM_UCHAR) (list XmNrows XM_SHORT) (list XmNrubberPositioning XM_BOOLEAN)
- (list XmNsashHeight XM_DIMENSION) (list XmNsashIndent XM_POSITION) (list XmNsashShadowThickness XM_DIMENSION)
- (list XmNsashWidth XM_DIMENSION) (list XmNsaveUnder XM_BOOLEAN) (list XmNscaleHeight XM_DIMENSION)
- (list XmNscaleMultiple XM_INT) (list XmNscaleWidth XM_DIMENSION) (list XmNscreen XM_SCREEN)
- (list XmNscrollBarDisplayPolicy XM_UCHAR) (list XmNscrollBarPlacement XM_UCHAR) (list XmNscrollHorizontal XM_BOOLEAN)
- (list XmNscrollLeftSide XM_BOOLEAN) (list XmNscrollTopSide XM_BOOLEAN) (list XmNscrollVertical XM_BOOLEAN)
- (list XmNscrolledWindowMarginHeight XM_DIMENSION) (list XmNscrolledWindowMarginWidth XM_DIMENSION) (list XmNscrollingPolicy XM_UCHAR)
- (list XmNselectColor XM_PIXEL) (list XmNselectInsensitivePixmap XM_PIXMAP) (list XmNselectPixmap XM_PIXMAP)
- (list XmNselectThreshold XM_INT) (list XmNselectedItemCount XM_INT) (list XmNselectedItems XM_STRING_TABLE)
- (list XmNselectionArray XM_INT_TABLE) (list XmNselectionArrayCount XM_INT) (list XmNselectionLabelString XM_XMSTRING)
- (list XmNselectionPolicy XM_UCHAR) (list XmNsensitive XM_BOOLEAN) (list XmNseparatorOn XM_BOOLEAN)
- (list XmNseparatorType XM_UCHAR) (list XmNset XM_UCHAR) (list XmNshadowThickness XM_DIMENSION)
- (list XmNshadowType XM_UCHAR) (list XmNshowArrows XM_BOOLEAN) (list XmNshowAsDefault XM_DIMENSION)
- (list XmNshowSeparator XM_BOOLEAN) (list XmNsimpleCallback XM_CALLBACK) (list XmNsingleSelectionCallback XM_CALLBACK)
- (list XmNskipAdjust XM_BOOLEAN) (list XmNsliderSize XM_INT) (list XmNsliderVisual XM_INT)
- (list XmNslidingMode XM_INT) (list XmNsource XM_TEXT_SOURCE) (list XmNsourceCursorIcon XM_WIDGET)
- (list XmNsourcePixmapIcon XM_WIDGET) (list XmNspacing XM_DIMENSION) (list XmNspotLocation XM_INT)
- (list XmNstateCursorIcon XM_WIDGET) (list XmNsubMenuId XM_WIDGET) (list XmNsymbolPixmap XM_PIXMAP)
- (list XmNtearOffMenuActivateCallback XM_CALLBACK) (list XmNtearOffMenuDeactivateCallback XM_CALLBACK) (list XmNtearOffModel XM_UCHAR)
- (list XmNtextAccelerators XM_ULONG) (list XmNtextColumns XM_SHORT) (list XmNtextString XM_XMSTRING)
- (list XmNtextTranslations XM_CALLBACK) (list XmNtitle XM_STRING) (list XmNtitleEncoding XM_ATOM)
- (list XmNtitleString XM_XMSTRING) (list XmNtoBottomCallback XM_CALLBACK) (list XmNtoTopCallback XM_CALLBACK)
- (list XmNtopAttachment XM_UCHAR) (list XmNtopCharacter XM_INT) (list XmNtopItemPosition XM_INT)
- (list XmNtopLevelEnterCallback XM_CALLBACK) (list XmNtopLevelLeaveCallback XM_CALLBACK) (list XmNtopOffset XM_INT)
- (list XmNtopPosition XM_INT) (list XmNtopShadowColor XM_PIXEL) (list XmNtopShadowPixmap XM_PIXMAP)
- (list XmNtopWidget XM_WIDGET) (list XmNtransferProc XM_TRANSFER_CALLBACK) (list XmNtransferStatus XM_UCHAR)
- (list XmNtransient XM_BOOLEAN) (list XmNtransientFor XM_WIDGET) (list XmNtranslations XM_CALLBACK)
- (list XmNtraversalOn XM_BOOLEAN) (list XmNtraverseObscuredCallback XM_CALLBACK) (list XmNtroughColor XM_PIXEL)
- (list XmNunitType XM_UCHAR) (list XmNunmapCallback XM_CALLBACK) (list XmNunpostBehavior XM_UCHAR)
- (list XmNuseAsyncGeometry XM_BOOLEAN) (list XmNuserData XM_ULONG) (list XmNvalidCursorForeground XM_PIXEL)
- (list XmNvalue XM_STRING_OR_INT) (list XmNvalueChangedCallback XM_CALLBACK) (list XmNverifyBell XM_BOOLEAN)
- (list XmNverticalFontUnit XM_INT) (list XmNverticalScrollBar XM_WIDGET) (list XmNverticalSpacing XM_DIMENSION)
- (list XmNvisibleItemCount XM_INT) (list XmNvisibleWhenOff XM_BOOLEAN) (list XmNvisual XM_VISUAL)
- (list XmNvisualPolicy XM_UCHAR) (list XmNwidth XM_DIMENSION) (list XmNwidthInc XM_INT)
- (list XmNwinGravity XM_INT) (list XmNwindow XM_WIDGET) (list XmNwindowGroup XM_WINDOW)
- (list XmNwmTimeout XM_INT) (list XmNwordWrap XM_BOOLEAN) (list XmNworkWindow XM_WIDGET)
- (list XmNx XM_POSITION) (list XmNy XM_POSITION) (list XmNarrowLayout XM_UCHAR)
- (list XmNarrowOrientation XM_UCHAR) (list XmNarrowSensitivity XM_UCHAR) (list XmNarrowSize XM_INT)
- (list XmNarrowSpacing XM_INT) (list XmNautoDragModel XM_INT) (list XmNbackPageBackground XM_PIXEL)
- (list XmNbackPageForeground XM_PIXEL) (list XmNbackPageNumber XM_INT) (list XmNbackPagePlacement XM_UCHAR)
- (list XmNbackPageSize XM_DIMENSION) (list XmNbindingPixmap XM_PIXMAP) (list XmNbindingType XM_UCHAR)
- (list XmNbindingWidth XM_INT) (list XmNbitmapConversionModel XM_INT) (list XmNbuttonRenderTable XM_RENDER_TABLE)
- (list XmNcollapsedStatePixmap XM_PIXMAP) (list XmNcolorAllocationProc XM_ALLOC_COLOR_CALLBACK)
- (list XmNcolorCalculationProc XM_SCREEN_COLOR_CALLBACK)
- (list XmNcomboBoxType XM_UCHAR) (list XmNconvertCallback XM_CALLBACK) (list XmNcurrentPageNumber XM_INT)
- (list XmNdecimal XM_STRING) (list XmNdefaultArrowSensitivity XM_UCHAR) (list XmNdefaultButtonEmphasis XM_INT)
- (list XmNdefaultVirtualBindings XM_STRING) (list XmNdestinationCallback XM_CALLBACK) (list XmNdetail XM_STRING_TABLE)
- (list XmNdetailColumnHeading XM_INT) (list XmNdetailColumnHeadingCount XM_INT) (list XmNdetailCount XM_INT)
- (list XmNdetailOrder XM_INT_TABLE) (list XmNdetailOrderCount XM_INT) (list XmNdetailShadowThickness XM_INT)
- (list XmNdetailTabList XM_TAB_LIST) (list XmNdirTextLabelString XM_XMSTRING) (list XmNdragStartCallback XM_CALLBACK)
- (list XmNenableBtn1Transfer XM_INT) (list XmNenableButtonTab XM_BOOLEAN) (list XmNenableDragIcon XM_BOOLEAN)
- (list XmNenableEtchedInMenu XM_BOOLEAN) (list XmNenableMultiKeyBindings XM_BOOLEAN) (list XmNenableThinThickness XM_BOOLEAN)
- (list XmNenableToggleColor XM_BOOLEAN) (list XmNenableToggleVisual XM_BOOLEAN) (list XmNenableUnselectableDrag XM_BOOLEAN)
- (list XmNenableWarp XM_INT) (list XmNentryParent XM_WIDGET) (list XmNentryViewType XM_UCHAR)
- (list XmNexpandedStatePixmap XM_PIXMAP) (list XmNfileFilterStyle XM_INT) (list XmNfirstPageNumber XM_INT)
- (list XmNfontName XM_STRING) (list XmNfontType XM_UCHAR) (list XmNframeBackground XM_PIXEL)
- (list XmNframeChildType XM_UCHAR) (list XmNframeShadowThickness XM_DIMENSION) (list XmNgrabStyle XM_INT)
- (list XmNincludeStatus XM_INT) (list XmNincrementValue XM_INT) (list XmNindeterminateInsensitivePixmap XM_PIXMAP)
- (list XmNindeterminatePixmap XM_PIXMAP) (list XmNinnerMarginHeight XM_DIMENSION) (list XmNinnerMarginWidth XM_DIMENSION)
- (list XmNinputPolicy XM_ULONG) (list XmNinsensitiveStippleBitmap XM_PIXMAP) (list XmNinvokeParseProc XM_PARSE_CALLBACK)
- (list XmNlabelRenderTable XM_RENDER_TABLE) (list XmNlargeCellHeight XM_DIMENSION) (list XmNlargeCellWidth XM_DIMENSION)
- (list XmNlargeIconMask XM_PIXMAP) (list XmNlargeIconPixmap XM_PIXMAP) (list XmNlargeIconX XM_FLOAT)
- (list XmNlargeIconY XM_FLOAT) (list XmNlastPageNumber XM_INT) (list XmNlayoutDirection XM_UCHAR)
- (list XmNlayoutType XM_UCHAR) (list XmNlist XM_WIDGET) (list XmNloadModel XM_UCHAR)
- (list XmNmajorTabSpacing XM_DIMENSION) (list XmNmatchBehavior XM_UCHAR) (list XmNmaximumValue XM_INT)
- (list XmNminimumValue XM_INT) (list XmNminorTabSpacing XM_DIMENSION) (list XmNmotifVersion XM_INT)
- (list XmNnoFontCallback XM_CALLBACK) (list XmNnoRenditionCallback XM_CALLBACK) (list XmNnotebookChildType XM_UCHAR)
- (list XmNnumValues XM_INT) (list XmNoutlineButtonPolicy XM_UCHAR) (list XmNoutlineChangedCallback XM_CALLBACK)
- (list XmNoutlineColumnWidth XM_DIMENSION) (list XmNoutlineIndentation XM_DIMENSION) (list XmNoutlineLineStyle XM_UCHAR)
- (list XmNoutlineState XM_UCHAR) (list XmNpageChangedCallback XM_CALLBACK) (list XmNpageNumber XM_INT)
- (list XmNpathMode XM_INT) (list XmNpatternType XM_UCHAR) (list XmNpopupHandlerCallback XM_CALLBACK)
- (list XmNposition XM_INT) (list XmNpositionMode XM_INT) (list XmNpositionType XM_UCHAR)
- (list XmNprimaryOwnership XM_UCHAR) (list XmNrenderTable XM_RENDER_TABLE) (list XmNrenditionBackground XM_PIXEL)
- (list XmNrenditionForeground XM_PIXEL) (list XmNscrolledWindowChildType XM_UCHAR) (list XmNselectedItem XM_XMSTRING)
- (list XmNselectedObjectCount XM_INT) (list XmNselectedObjects XM_WIDGET_LIST) (list XmNselectedPosition XM_INT)
- (list XmNselectedPositionCount XM_INT) (list XmNselectedPositions XM_INT_TABLE) (list XmNselectionCallback XM_CALLBACK)
- (list XmNselectionMode XM_UCHAR) (list XmNselectionTechnique XM_UCHAR) (list XmNsliderMark XM_INT)
- (list XmNsmallCellHeight XM_DIMENSION) (list XmNsmallCellWidth XM_DIMENSION) (list XmNsmallIconMask XM_PIXMAP)
- (list XmNsmallIconPixmap XM_PIXMAP) (list XmNsmallIconX XM_FLOAT) (list XmNsmallIconY XM_FLOAT)
- (list XmNsnapBackMultiple XM_SHORT) (list XmNspatialIncludeModel XM_UCHAR) (list XmNspatialResizeModel XM_UCHAR)
- (list XmNspatialSnapModel XM_UCHAR) (list XmNspatialStyle XM_UCHAR) (list XmNspinBoxChildType XM_UCHAR)
- (list XmNstrikethruType XM_UCHAR) (list XmNsubstitute XM_XMSTRING) (list XmNtabList XM_TAB_LIST)
- (list XmNtag XM_STRING) (list XmNtearOffTitle XM_XMSTRING) (list XmNtextField XM_WIDGET)
- (list XmNtextRenderTable XM_RENDER_TABLE) (list XmNtoggleMode XM_UCHAR) (list XmNunderlineType XM_UCHAR)
- (list XmNunselectColor XM_PIXEL) (list XmNtabValue XM_FLOAT) (list XmNoffsetModel XM_INT)
- (list XmNcallback XM_CALLBACK) (list XmNwaitForWm XM_BOOLEAN) (list XmNuseColorObj XM_BOOLEAN)
- (list XmNvalues XM_STRING_TABLE) (list XmNviewType XM_UCHAR) (list XmNvisualEmphasis XM_UCHAR)
- (list XmNwrap XM_BOOLEAN)
- )))
-
- (for-each
- (lambda (n)
- (if (not (string? (car n))) (snd-display ";resource ~A is not a string?" (car n)))
- (XtVaGetValues shell (list (car n) 0)))
- resource-list)
- )
-
- (if (not (XEvent? (XEvent)))
- (snd-display ";xevent type trouble! ~A -> ~A" (XEvent) (XEvent? (XEvent))))
- (if (not (XGCValues? (XGCValues)))
- (snd-display ";xgcvalues type trouble! ~A -> ~A" (XGCValues) (XGCValues? (XGCValues))))
- (if (not (= (.direction (XmTraverseObscuredCallbackStruct)) 0))
- (snd-display ";.direction: ~A" (.direction (XmTraverseObscuredCallbackStruct))))
- (if (.ptr (XmTextBlock))
- (snd-display ";.ptr block: ~A" (.ptr (XmTextBlock))))
- (let ((hi (XmTextBlock)))
- (set! (.ptr hi) "hi")
- (if (not (string=? (.ptr hi) "hi"))
- (snd-display ";.ptr set block: ~A" (.ptr hi)))
- (if (not (= (.length hi) 0)) (snd-display ";.length block: ~A" (.length hi)))
- (set! (.length hi) 3)
- (if (not (= (.length hi) 3)) (snd-display ";set .length block: ~A" (.length hi))))
- (if (not (= (.dashes (XGCValues)) 0)) (snd-display ";dashes: ~A" (.dashes (XGCValues))))
- (set! (.dashes (XGCValues)) 1)
- (set! (.clip_mask (XGCValues)) (list 'Pixmap 0))
- (set! (.resourceid (XEvent -1)) 0)
- (set! (.error_code (XEvent -1)) 0)
- (set! (.request_code (XEvent -1)) 0)
- (if (not (= (.resourceid (XEvent -1)) 0)) (snd-display ";error resourceid: ~A" (.resourceid (XEvent -1))))
- (if (not (= (.request_code (XEvent -1)) 0)) (snd-display ";error request_code: ~A" (.request_code (XEvent -1))))
- (set! (.pad (XColor)) 1)
- )
-
- (if (defined? 'XShapeQueryExtents)
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets))))
- (vals (XShapeQueryExtents dpy win)))
- (if (not (= (car vals) 1))
- (snd-display ";XShapeQueryExtents: ~A" vals))
- (set! vals (XShapeGetRectangles dpy win 0))
- (if (not (list? vals)) (snd-display ";XShapeGetRectangles: ~A" vals))
+
+ (let ((callbacks
+ (list
+ (list XmAnyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event))
+ (list XmArrowButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
+ (list XmCommandCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'XmString '.value) (list .length 'int '.length #f))
+ (list XmDragDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp))
+ (list XmDragMotionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f))
+ (list XmDragProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .animate 'Boolean '.animate #f))
+ (list XmDrawingAreaCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .window 'Window '.window))
+ (list XmDrawnButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .window 'Window '.window) (list .click_count 'int '.click_count))
+ (list XmDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .dropAction 'uchar '.dropAction #f) (list .completionStatus 'uchar '.completionStatus #f))
+ (list XmDropProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .dropAction 'uchar '.dropAction #f))
+ (list XmDropSiteEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f))
+ (list XmDropSiteLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp))
+ (list XmDropStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .dropAction 'uchar '.dropAction #f))
+ (list XmFileSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'XmString '.value) (list .length 'int '.length #f) (list .mask 'XmString '.mask #f)
+ (list .mask_length 'int '.mask_length #f) (list .dir 'XmString '.dir #f) (list .dir_length 'int '.dir_length #f)
+ (list .pattern 'XmString '.pattern #f) (list .pattern_length 'int '.pattern_length #f))
+ (list XmListCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .item 'XmString '.item #f) (list .item_length 'int '.item_length #f) (list .item_position 'int '.item_position #f)
+ (list .selected_items 'XmString* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
+ (list .selected_item_positions 'int* '.selected_item_positions) (list .selection_type 'char '.selection_type #f)
+ (list .auto_selection_type 'char '.auto_selection_type #f))
+ (list XmOperationChangedCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f)
+ (list .dropSiteStatus 'uchar '.dropSiteStatus))
+ (list XmPushButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
+ (list XmRowColumnCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .widget 'Widget '.widget #f) (list .data 'char* '.data #f) (list .callbackstruct 'char* '.callbackstruct #f))
+ (list XmScaleCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .value 'int '.value))
+ (list XmScrollBarCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'int '.value) (list .pixel 'int '.pixel #f))
+ (list XmSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'XmString '.value) (list .length 'int '.length #f))
+ (list XmTextVerifyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .doit 'Boolean '.doit) (list .currInsert 'int '.currInsert #f) (list .newInsert 'int '.newInsert #f)
+ (list .startPos 'int '.startPos #f) (list .endPos 'int '.endPos #f)
+ (list .text 'XmTextBlock '.text #f))
+ (list XmToggleButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .set 'int '.set))
+ (list XmDestinationCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selection 'Atom '.selection #f) (list .operation 'uchar '.operation) (list .flags 'int '.flags #f)
+ (list .transfer_id 'XtPointer '.transfer_id #f) (list .destination_data 'XtPointer '.destination_data #f)
+ (list .location_data 'XtPointer '.location_data #f) (list .time 'Time '.time))
+ (list XmConvertCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .selection 'Atom '.selection #f)
+ (list .target 'Atom '.target #f) (list .source_data 'XtPointer '.source_data #f)
+ (list .location_data 'XtPointer '.location_data #f) (list .flags 'int '.flags #f) (list .parm 'XtPointer '.parm #f)
+ (list .parm_format 'int '.parm_format #f) (list .parm_length 'int '.parm_length #f)
+ (list .parm_type 'Atom '.parm_type #f) (list .status 'int '.status #f) (list .value 'XtPointer '.value #f)
+ (list .type 'Atom '.type #f) (list .format 'int '.format #f) (list .length 'int '.length #f))
+ (list XmComboBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .item_or_text 'XmString '.item_or_text #f) (list .item_position 'int '.item_position #f))
+ (list XmContainerOutlineCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .item 'Widget '.item #f) (list .new_outline_state 'uchar '.new_outline_state #f))
+ (list XmContainerSelectCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selected_items 'Widget* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
+ (list .auto_selection_type 'uchar '.auto_selection_type #f))
+ (list XmNotebookCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .page_number 'int '.page_number #f) (list .page_widget 'Widget '.page_widget #f)
+ (list .prev_page_number 'int '.prev_page_number #f) (list .prev_page_widget 'Widget '.prev_page_widget #f))
+ (list XmSpinBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit) (list .position 'int '.position #f)
+ (list .value 'XmString '.value #f) (list .crossed_boundary 'Boolean '.crossed-boundary #f))
+ (list XmTraverseObscuredCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .traversal_destination 'Widget '.traversal_destination #f))
+ (list XmTopLevelLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window))
+ (list XmTopLevelEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dragProtocolStyle 'uchar '.dragProtocolStyle #f))
+ (list XmPopupHandlerCallbackStruct (list .reason 'int '.reason)
+ (list .event 'XEvent '.event) (list .menuToPost 'Widget '.menuToPost) (list .postIt 'Boolean '.postIt)
+ (list .target 'Widget '.target #f))
+ (list XmSelectionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selection 'Atom '.selection #f) (list .target 'Atom '.target #f) (list .type 'Atom '.type #f)
+ (list .transfer_id 'XtPointer '.transfer_id #f) (list .flags 'int '.flags #f) (list .remaining 'int '.remaining #f)
+ (list .value 'XtPointer '.value #f) (list .length 'int '.length #f) (list .format 'int '.format #f))
+ (list XmTransferDoneCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selection 'Atom '.selection #f) (list .transfer_id 'XtPointer '.transfer_id #f) (list .status 'int '.status #f)
+ (list .client_data 'XtPointer '.client_data #f))
+ (list XmDisplayCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .font_name 'char* '.font_name #f) (list .tag 'int '.tag #f)
+ (list .render_table 'XmRenderTable '.render_table #f)
+ (list .rendition 'XmRendition '.rendition #f))
+ (list XmDragStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit))
+ )))
+
+
+ (for-each
+ (lambda (call)
+ (let ((struct ((car call)))
+ (val #f))
+ (set! (.event struct) (XEvent))
+ (for-each
+ (lambda (field)
+ (if (not (list-p field)) (snd-display #__line__ ";~A: ~A" struct field))
+ (set! val ((car field) struct))
+ (if (< (length field) 4)
+ (case (cadr field)
+ ((int) (set! ((car field) struct) 0))
+ ((Atom) (set! ((car field) struct) XA_STRING))
+ ((uchar) (set! ((car field) struct) 0))
+ ((Position) (set! ((car field) struct) 0))
+ ((Widget) (set! ((car field) struct) (list 'Widget 0)))
+ ((XmString) (set! ((car field) struct) (list 'XmString 0)))
+ ((XtPointer) (set! ((car field) struct) 0))
+ ((char*) (set! ((car field) struct) "hi"))
+ ((Boolean) (set! ((car field) struct) #f))
+ ((XEvent) #f) ; already being set
+ ((XmString* int* Time Window Widget* Screen) #f)
+ ((char) (set! ((car field) struct) 0))
+ )))
+ (cdr call))))
+ callbacks)
+ )
+
+ (let ((shell (cadr (main-widgets)))
+ (resource-list
+ (list
+ (list XmNaccelerator XM_STRING) (list XmNacceleratorText XM_XMSTRING) (list XmNaccelerators XM_ULONG)
+ (list XmNactivateCallback XM_CALLBACK) (list XmNadjustLast XM_BOOLEAN) (list XmNadjustMargin XM_BOOLEAN)
+ (list XmNalignment XM_UCHAR) (list XmNallowOverlap XM_BOOLEAN) (list XmNallowResize XM_BOOLEAN)
+ (list XmNallowShellResize XM_BOOLEAN) (list XmNancestorSensitive XM_BOOLEAN) (list XmNanimationMask XM_PIXMAP)
+ (list XmNanimationPixmap XM_PIXMAP) (list XmNanimationPixmapDepth XM_INT) (list XmNanimationStyle XM_UCHAR)
+ (list XmNapplyCallback XM_CALLBACK) (list XmNapplyLabelString XM_XMSTRING) (list XmNargc XM_INT)
+ (list XmNargv XM_STRING_LIST) (list XmNarmCallback XM_CALLBACK) (list XmNarmColor XM_PIXEL)
+ (list XmNarmPixmap XM_PIXMAP) (list XmNarrowDirection XM_UCHAR) (list XmNattachment XM_UCHAR)
+ (list XmNaudibleWarning XM_UCHAR) (list XmNautoShowCursorPosition XM_BOOLEAN) (list XmNautoUnmanage XM_BOOLEAN)
+ (list XmNautomaticSelection XM_UCHAR) (list XmNbackground XM_PIXEL) (list XmNbackgroundPixmap XM_PIXMAP)
+ (list XmNbaseHeight XM_INT) (list XmNbaseWidth XM_INT) (list XmNbitmap XM_PIXMAP)
+ (list XmNblendModel XM_ULONG) (list XmNblinkRate XM_INT) (list XmNborderColor XM_PIXEL)
+ (list XmNborderPixmap XM_PIXMAP) (list XmNborderWidth XM_DIMENSION) (list XmNbottomAttachment XM_UCHAR)
+ (list XmNbottomOffset XM_INT) (list XmNbottomPosition XM_INT) (list XmNbottomShadowColor XM_PIXEL)
+ (list XmNbottomShadowPixmap XM_PIXMAP) (list XmNbottomWidget XM_WIDGET) (list XmNbrowseSelectionCallback XM_CALLBACK)
+ (list XmNbuttonAcceleratorText XM_STRING_TABLE) (list XmNbuttonAccelerators XM_STRING_TABLE) (list XmNbuttonCount XM_INT)
+ (list XmNbuttonMnemonicCharSets XM_CHARSET_TABLE) (list XmNbuttonMnemonics XM_KEYSYM_TABLE) (list XmNbuttonSet XM_INT)
+ (list XmNbuttonType XM_ULONG) (list XmNbuttons XM_STRING_TABLE) (list XmNcancelButton XM_WIDGET)
+ (list XmNcancelCallback XM_CALLBACK) (list XmNcancelLabelString XM_XMSTRING) (list XmNcascadePixmap XM_PIXMAP)
+ (list XmNcascadingCallback XM_CALLBACK) (list XmNchildHorizontalAlignment XM_UCHAR) (list XmNchildHorizontalSpacing XM_DIMENSION)
+ (list XmNchildPlacement XM_UCHAR) (list XmNchildVerticalAlignment XM_UCHAR) (list XmNchildren XM_WIDGET_LIST)
+ (list XmNclientData XM_ULONG) (list XmNclipWindow XM_WIDGET) (list XmNcolormap XM_COLORMAP)
+ (list XmNcolumns XM_SHORT) (list XmNcommand XM_XMSTRING) (list XmNcommandChangedCallback XM_CALLBACK)
+ (list XmNcommandEnteredCallback XM_CALLBACK) (list XmNcommandWindow XM_WIDGET) (list XmNcommandWindowLocation XM_UCHAR)
+ (list XmNconvertProc XM_CONVERT_CALLBACK) (list XmNcreatePopupChildProc XM_POPUP_CALLBACK) (list XmNcursorBackground XM_PIXEL)
+ (list XmNcursorForeground XM_PIXEL) (list XmNcursorPosition XM_INT) (list XmNcursorPositionVisible XM_BOOLEAN)
+ (list XmNdarkThreshold XM_INT) (list XmNdecimalPoints XM_SHORT) (list XmNdecrementCallback XM_CALLBACK)
+ (list XmNdefaultActionCallback XM_CALLBACK) (list XmNdefaultButton XM_WIDGET) (list XmNdefaultButtonShadowThickness XM_DIMENSION)
+ (list XmNdefaultButtonType XM_UCHAR) (list XmNdefaultCopyCursorIcon XM_WIDGET) (list XmNdefaultInvalidCursorIcon XM_WIDGET)
+ (list XmNdefaultLinkCursorIcon XM_WIDGET) (list XmNdefaultMoveCursorIcon XM_WIDGET) (list XmNdefaultNoneCursorIcon XM_WIDGET)
+ (list XmNdefaultPosition XM_BOOLEAN) (list XmNdefaultSourceCursorIcon XM_WIDGET) (list XmNdefaultValidCursorIcon XM_WIDGET)
+ (list XmNdeleteResponse XM_UCHAR) (list XmNdepth XM_INT) (list XmNdestroyCallback XM_CALLBACK)
+ (list XmNdialogStyle XM_UCHAR) (list XmNdialogTitle XM_XMSTRING) (list XmNdialogType XM_UCHAR)
+ (list XmNdirListItemCount XM_INT) (list XmNdirListItems XM_STRING_TABLE) (list XmNdirListLabelString XM_XMSTRING)
+ (list XmNdirMask XM_XMSTRING) (list XmNdirSearchProc XM_SEARCH_CALLBACK) (list XmNdirSpec XM_XMSTRING)
+ (list XmNdirectory XM_XMSTRING) (list XmNdirectoryValid XM_BOOLEAN) (list XmNdisarmCallback XM_CALLBACK)
+ (list XmNdoubleClickInterval XM_INT) (list XmNdragDropFinishCallback XM_CALLBACK) (list XmNdragInitiatorProtocolStyle XM_UCHAR)
+ (list XmNdragMotionCallback XM_CALLBACK) (list XmNdragOperations XM_UCHAR) (list XmNdragReceiverProtocolStyle XM_UCHAR)
+ (list XmNdropFinishCallback XM_CALLBACK) (list XmNdropProc XM_DROP_CALLBACK) (list XmNdropRectangles XM_RECTANGLE_LIST)
+ (list XmNdropSiteActivity XM_UCHAR) (list XmNdropSiteEnterCallback XM_CALLBACK) (list XmNdropSiteLeaveCallback XM_CALLBACK)
+ (list XmNdropSiteOperations XM_UCHAR) (list XmNdropSiteType XM_UCHAR) (list XmNdropStartCallback XM_CALLBACK)
+ (list XmNdropTransfers XM_TRANSFER_ENTRY_LIST) (list XmNeditMode XM_INT) (list XmNeditable XM_BOOLEAN)
+ (list XmNentryAlignment XM_UCHAR) (list XmNentryBorder XM_DIMENSION) (list XmNentryCallback XM_CALLBACK)
+ (list XmNentryClass XM_WIDGET_CLASS) (list XmNentryVerticalAlignment XM_UCHAR) (list XmNexportTargets XM_ATOM_LIST)
+ (list XmNexposeCallback XM_CALLBACK) (list XmNextendedSelectionCallback XM_CALLBACK) (list XmNfileListItemCount XM_INT)
+ (list XmNfileListItems XM_STRING_TABLE) (list XmNfileListLabelString XM_XMSTRING) (list XmNfileSearchProc XM_SEARCH_CALLBACK)
+ (list XmNfileTypeMask XM_UCHAR) (list XmNfillOnArm XM_BOOLEAN) (list XmNfillOnSelect XM_BOOLEAN)
+ (list XmNfilterLabelString XM_XMSTRING) (list XmNfocusCallback XM_CALLBACK) (list XmNfont XM_XFONTSTRUCT)
+ (list XmNforeground XM_PIXEL) (list XmNforegroundThreshold XM_INT) (list XmNfractionBase XM_INT)
+ (list XmNgainPrimaryCallback XM_CALLBACK) (list XmNgeometry XM_STRING) (list XmNheight XM_DIMENSION)
+ (list XmNheightInc XM_INT) (list XmNhelpCallback XM_CALLBACK) (list XmNhelpLabelString XM_XMSTRING)
+ (list XmNhighlightColor XM_PIXEL) (list XmNhighlightOnEnter XM_BOOLEAN) (list XmNhighlightPixmap XM_PIXMAP)
+ (list XmNhighlightThickness XM_DIMENSION) (list XmNhistoryItemCount XM_INT) (list XmNhistoryItems XM_STRING_TABLE)
+ (list XmNhistoryMaxItems XM_INT) (list XmNhistoryVisibleItemCount XM_INT) (list XmNhorizontalFontUnit XM_INT)
+ (list XmNhorizontalScrollBar XM_WIDGET) (list XmNhorizontalSpacing XM_DIMENSION) (list XmNhotX XM_POSITION)
+ (list XmNhotY XM_POSITION) (list XmNiconMask XM_PIXMAP) (list XmNiconName XM_STRING)
+ (list XmNiconNameEncoding XM_ATOM) (list XmNiconPixmap XM_PIXMAP) (list XmNiconWindow XM_WIDGET)
+ (list XmNiconX XM_INT) (list XmNiconY XM_INT) (list XmNiconic XM_BOOLEAN)
+ (list XmNimportTargets XM_ATOM_LIST) (list XmNincrement XM_INT) (list XmNincrementCallback XM_CALLBACK)
+ (list XmNincremental XM_BOOLEAN) (list XmNindicatorOn XM_INT) (list XmNindicatorSize XM_DIMENSION)
+ (list XmNindicatorType XM_UCHAR) (list XmNinitialDelay XM_INT) (list XmNinitialFocus XM_WIDGET)
+ (list XmNinitialResourcesPersistent XM_BOOLEAN) (list XmNinitialState XM_INT) (list XmNinput XM_BOOLEAN)
+ (list XmNinputCallback XM_CALLBACK) (list XmNinputMethod XM_STRING) (list XmNinsertPosition XM_ORDER_CALLBACK)
+ (list XmNinvalidCursorForeground XM_PIXEL) (list XmNisAligned XM_BOOLEAN) (list XmNisHomogeneous XM_BOOLEAN)
+ (list XmNitemCount XM_INT) (list XmNitems XM_STRING_TABLE) (list XmNkeyboardFocusPolicy XM_UCHAR)
+ (list XmNlabelInsensitivePixmap XM_PIXMAP) (list XmNlabelPixmap XM_PIXMAP) (list XmNlabelString XM_XMSTRING)
+ (list XmNlabelType XM_UCHAR) (list XmNleftAttachment XM_UCHAR) (list XmNleftOffset XM_INT)
+ (list XmNleftPosition XM_INT) (list XmNleftWidget XM_WIDGET) (list XmNlightThreshold XM_INT)
+ (list XmNlistItemCount XM_INT) (list XmNlistItems XM_STRING_TABLE) (list XmNlistLabelString XM_XMSTRING)
+ (list XmNlistMarginHeight XM_DIMENSION) (list XmNlistMarginWidth XM_DIMENSION) (list XmNlistSizePolicy XM_UCHAR)
+ (list XmNlistSpacing XM_DIMENSION) (list XmNlistUpdated XM_BOOLEAN) (list XmNlistVisibleItemCount XM_INT)
+ (list XmNlosePrimaryCallback XM_CALLBACK) (list XmNlosingFocusCallback XM_CALLBACK) (list XmNmainWindowMarginHeight XM_DIMENSION)
+ (list XmNmainWindowMarginWidth XM_DIMENSION) (list XmNmapCallback XM_CALLBACK) (list XmNmappedWhenManaged XM_BOOLEAN)
+ (list XmNmappingDelay XM_INT) (list XmNmargin XM_DIMENSION) (list XmNmarginBottom XM_DIMENSION)
+ (list XmNmarginHeight XM_DIMENSION) (list XmNmarginLeft XM_DIMENSION) (list XmNmarginRight XM_DIMENSION)
+ (list XmNmarginTop XM_DIMENSION) (list XmNmarginWidth XM_DIMENSION) (list XmNmask XM_PIXMAP)
+ (list XmNmaxAspectX XM_INT) (list XmNmaxAspectY XM_INT) (list XmNmaxHeight XM_INT)
+ (list XmNmaxLength XM_INT) (list XmNmaxWidth XM_INT) (list XmNmaximum XM_INT)
+ (list XmNmenuAccelerator XM_STRING) (list XmNmenuBar XM_WIDGET) (list XmNmenuCursor XM_STRING)
+ (list XmNmenuHelpWidget XM_WIDGET) (list XmNmenuHistory XM_WIDGET) (list XmNmenuPost XM_STRING)
+ (list XmNmessageAlignment XM_UCHAR) (list XmNmessageString XM_XMSTRING) (list XmNmessageWindow XM_WIDGET)
+ (list XmNminAspectX XM_INT) (list XmNminAspectY XM_INT) (list XmNminHeight XM_INT)
+ (list XmNminWidth XM_INT) (list XmNminimizeButtons XM_BOOLEAN) (list XmNminimum XM_INT)
+ (list XmNmnemonic XM_KEYSYM) (list XmNmnemonicCharSet XM_STRING) (list XmNmodifyVerifyCallback XM_CALLBACK)
+ (list XmNmotionVerifyCallback XM_CALLBACK) (list XmNmoveOpaque XM_BOOLEAN) (list XmNmultiClick XM_UCHAR)
+ (list XmNmultipleSelectionCallback XM_CALLBACK) (list XmNmustMatch XM_BOOLEAN) (list XmNmwmDecorations XM_INT)
+ (list XmNmwmFunctions XM_INT) (list XmNmwmInputMode XM_INT) (list XmNmwmMenu XM_STRING)
+ (list XmNnavigationType XM_UCHAR) (list XmNnoMatchCallback XM_CALLBACK) (list XmNnoMatchString XM_XMSTRING)
+ (list XmNnoResize XM_BOOLEAN) (list XmNnoneCursorForeground XM_PIXEL) (list XmNnumChildren XM_INT)
+ (list XmNnumColumns XM_SHORT) (list XmNnumDropRectangles XM_INT) (list XmNnumDropTransfers XM_INT)
+ (list XmNnumExportTargets XM_INT) (list XmNnumImportTargets XM_INT) (list XmNoffsetX XM_POSITION)
+ (list XmNoffsetY XM_POSITION) (list XmNokCallback XM_CALLBACK) (list XmNokLabelString XM_XMSTRING)
+ (list XmNoperationChangedCallback XM_CALLBACK) (list XmNoperationCursorIcon XM_WIDGET) (list XmNoptionLabel XM_XMSTRING)
+ (list XmNoptionMnemonic XM_KEYSYM) (list XmNorientation XM_UCHAR) (list XmNoverrideRedirect XM_BOOLEAN)
+ (list XmNpacking XM_UCHAR) (list XmNpageDecrementCallback XM_CALLBACK) (list XmNpageIncrement XM_INT)
+ (list XmNpageIncrementCallback XM_CALLBACK) (list XmNpaneMaximum XM_DIMENSION) (list XmNpaneMinimum XM_DIMENSION)
+ (list XmNpattern XM_STRING_OR_XMSTRING) (list XmNpendingDelete XM_BOOLEAN) (list XmNpixmap XM_PIXMAP)
+ (list XmNpopdownCallback XM_CALLBACK) (list XmNpopupCallback XM_CALLBACK) (list XmNpopupEnabled XM_INT)
+ (list XmNpositionIndex XM_SHORT) (list XmNpostFromButton XM_INT) (list XmNpreeditType XM_STRING)
+ (list XmNprocessingDirection XM_UCHAR) (list XmNpromptString XM_XMSTRING) (list XmNpushButtonEnabled XM_BOOLEAN)
+ (list XmNqualifySearchDataProc XM_QUALIFY_CALLBACK) (list XmNradioAlwaysOne XM_BOOLEAN) (list XmNradioBehavior XM_BOOLEAN)
+ (list XmNrecomputeSize XM_BOOLEAN) (list XmNrefigureMode XM_BOOLEAN) (list XmNrepeatDelay XM_INT)
+ (list XmNresizable XM_BOOLEAN) (list XmNresizeCallback XM_CALLBACK) (list XmNresizeHeight XM_BOOLEAN)
+ (list XmNresizePolicy XM_UCHAR) (list XmNresizeWidth XM_BOOLEAN) (list XmNrightAttachment XM_UCHAR)
+ (list XmNrightOffset XM_INT) (list XmNrightPosition XM_INT) (list XmNrightWidget XM_WIDGET)
+ (list XmNrowColumnType XM_UCHAR) (list XmNrows XM_SHORT) (list XmNrubberPositioning XM_BOOLEAN)
+ (list XmNsashHeight XM_DIMENSION) (list XmNsashIndent XM_POSITION) (list XmNsashShadowThickness XM_DIMENSION)
+ (list XmNsashWidth XM_DIMENSION) (list XmNsaveUnder XM_BOOLEAN) (list XmNscaleHeight XM_DIMENSION)
+ (list XmNscaleMultiple XM_INT) (list XmNscaleWidth XM_DIMENSION) (list XmNscreen XM_SCREEN)
+ (list XmNscrollBarDisplayPolicy XM_UCHAR) (list XmNscrollBarPlacement XM_UCHAR) (list XmNscrollHorizontal XM_BOOLEAN)
+ (list XmNscrollLeftSide XM_BOOLEAN) (list XmNscrollTopSide XM_BOOLEAN) (list XmNscrollVertical XM_BOOLEAN)
+ (list XmNscrolledWindowMarginHeight XM_DIMENSION) (list XmNscrolledWindowMarginWidth XM_DIMENSION) (list XmNscrollingPolicy XM_UCHAR)
+ (list XmNselectColor XM_PIXEL) (list XmNselectInsensitivePixmap XM_PIXMAP) (list XmNselectPixmap XM_PIXMAP)
+ (list XmNselectThreshold XM_INT) (list XmNselectedItemCount XM_INT) (list XmNselectedItems XM_STRING_TABLE)
+ (list XmNselectionArray XM_INT_TABLE) (list XmNselectionArrayCount XM_INT) (list XmNselectionLabelString XM_XMSTRING)
+ (list XmNselectionPolicy XM_UCHAR) (list XmNsensitive XM_BOOLEAN) (list XmNseparatorOn XM_BOOLEAN)
+ (list XmNseparatorType XM_UCHAR) (list XmNset XM_UCHAR) (list XmNshadowThickness XM_DIMENSION)
+ (list XmNshadowType XM_UCHAR) (list XmNshowArrows XM_BOOLEAN) (list XmNshowAsDefault XM_DIMENSION)
+ (list XmNshowSeparator XM_BOOLEAN) (list XmNsimpleCallback XM_CALLBACK) (list XmNsingleSelectionCallback XM_CALLBACK)
+ (list XmNskipAdjust XM_BOOLEAN) (list XmNsliderSize XM_INT) (list XmNsliderVisual XM_INT)
+ (list XmNslidingMode XM_INT) (list XmNsource XM_TEXT_SOURCE) (list XmNsourceCursorIcon XM_WIDGET)
+ (list XmNsourcePixmapIcon XM_WIDGET) (list XmNspacing XM_DIMENSION) (list XmNspotLocation XM_INT)
+ (list XmNstateCursorIcon XM_WIDGET) (list XmNsubMenuId XM_WIDGET) (list XmNsymbolPixmap XM_PIXMAP)
+ (list XmNtearOffMenuActivateCallback XM_CALLBACK) (list XmNtearOffMenuDeactivateCallback XM_CALLBACK) (list XmNtearOffModel XM_UCHAR)
+ (list XmNtextAccelerators XM_ULONG) (list XmNtextColumns XM_SHORT) (list XmNtextString XM_XMSTRING)
+ (list XmNtextTranslations XM_CALLBACK) (list XmNtitle XM_STRING) (list XmNtitleEncoding XM_ATOM)
+ (list XmNtitleString XM_XMSTRING) (list XmNtoBottomCallback XM_CALLBACK) (list XmNtoTopCallback XM_CALLBACK)
+ (list XmNtopAttachment XM_UCHAR) (list XmNtopCharacter XM_INT) (list XmNtopItemPosition XM_INT)
+ (list XmNtopLevelEnterCallback XM_CALLBACK) (list XmNtopLevelLeaveCallback XM_CALLBACK) (list XmNtopOffset XM_INT)
+ (list XmNtopPosition XM_INT) (list XmNtopShadowColor XM_PIXEL) (list XmNtopShadowPixmap XM_PIXMAP)
+ (list XmNtopWidget XM_WIDGET) (list XmNtransferProc XM_TRANSFER_CALLBACK) (list XmNtransferStatus XM_UCHAR)
+ (list XmNtransient XM_BOOLEAN) (list XmNtransientFor XM_WIDGET) (list XmNtranslations XM_CALLBACK)
+ (list XmNtraversalOn XM_BOOLEAN) (list XmNtraverseObscuredCallback XM_CALLBACK) (list XmNtroughColor XM_PIXEL)
+ (list XmNunitType XM_UCHAR) (list XmNunmapCallback XM_CALLBACK) (list XmNunpostBehavior XM_UCHAR)
+ (list XmNuseAsyncGeometry XM_BOOLEAN) (list XmNuserData XM_ULONG) (list XmNvalidCursorForeground XM_PIXEL)
+ (list XmNvalue XM_STRING_OR_INT) (list XmNvalueChangedCallback XM_CALLBACK) (list XmNverifyBell XM_BOOLEAN)
+ (list XmNverticalFontUnit XM_INT) (list XmNverticalScrollBar XM_WIDGET) (list XmNverticalSpacing XM_DIMENSION)
+ (list XmNvisibleItemCount XM_INT) (list XmNvisibleWhenOff XM_BOOLEAN) (list XmNvisual XM_VISUAL)
+ (list XmNvisualPolicy XM_UCHAR) (list XmNwidth XM_DIMENSION) (list XmNwidthInc XM_INT)
+ (list XmNwinGravity XM_INT) (list XmNwindow XM_WIDGET) (list XmNwindowGroup XM_WINDOW)
+ (list XmNwmTimeout XM_INT) (list XmNwordWrap XM_BOOLEAN) (list XmNworkWindow XM_WIDGET)
+ (list XmNx XM_POSITION) (list XmNy XM_POSITION) (list XmNarrowLayout XM_UCHAR)
+ (list XmNarrowOrientation XM_UCHAR) (list XmNarrowSensitivity XM_UCHAR) (list XmNarrowSize XM_INT)
+ (list XmNarrowSpacing XM_INT) (list XmNautoDragModel XM_INT) (list XmNbackPageBackground XM_PIXEL)
+ (list XmNbackPageForeground XM_PIXEL) (list XmNbackPageNumber XM_INT) (list XmNbackPagePlacement XM_UCHAR)
+ (list XmNbackPageSize XM_DIMENSION) (list XmNbindingPixmap XM_PIXMAP) (list XmNbindingType XM_UCHAR)
+ (list XmNbindingWidth XM_INT) (list XmNbitmapConversionModel XM_INT) (list XmNbuttonRenderTable XM_RENDER_TABLE)
+ (list XmNcollapsedStatePixmap XM_PIXMAP) (list XmNcolorAllocationProc XM_ALLOC_COLOR_CALLBACK)
+ (list XmNcolorCalculationProc XM_SCREEN_COLOR_CALLBACK)
+ (list XmNcomboBoxType XM_UCHAR) (list XmNconvertCallback XM_CALLBACK) (list XmNcurrentPageNumber XM_INT)
+ (list XmNdecimal XM_STRING) (list XmNdefaultArrowSensitivity XM_UCHAR) (list XmNdefaultButtonEmphasis XM_INT)
+ (list XmNdefaultVirtualBindings XM_STRING) (list XmNdestinationCallback XM_CALLBACK) (list XmNdetail XM_STRING_TABLE)
+ (list XmNdetailColumnHeading XM_INT) (list XmNdetailColumnHeadingCount XM_INT) (list XmNdetailCount XM_INT)
+ (list XmNdetailOrder XM_INT_TABLE) (list XmNdetailOrderCount XM_INT) (list XmNdetailShadowThickness XM_INT)
+ (list XmNdetailTabList XM_TAB_LIST) (list XmNdirTextLabelString XM_XMSTRING) (list XmNdragStartCallback XM_CALLBACK)
+ (list XmNenableBtn1Transfer XM_INT) (list XmNenableButtonTab XM_BOOLEAN) (list XmNenableDragIcon XM_BOOLEAN)
+ (list XmNenableEtchedInMenu XM_BOOLEAN) (list XmNenableMultiKeyBindings XM_BOOLEAN) (list XmNenableThinThickness XM_BOOLEAN)
+ (list XmNenableToggleColor XM_BOOLEAN) (list XmNenableToggleVisual XM_BOOLEAN) (list XmNenableUnselectableDrag XM_BOOLEAN)
+ (list XmNenableWarp XM_INT) (list XmNentryParent XM_WIDGET) (list XmNentryViewType XM_UCHAR)
+ (list XmNexpandedStatePixmap XM_PIXMAP) (list XmNfileFilterStyle XM_INT) (list XmNfirstPageNumber XM_INT)
+ (list XmNfontName XM_STRING) (list XmNfontType XM_UCHAR) (list XmNframeBackground XM_PIXEL)
+ (list XmNframeChildType XM_UCHAR) (list XmNframeShadowThickness XM_DIMENSION) (list XmNgrabStyle XM_INT)
+ (list XmNincludeStatus XM_INT) (list XmNincrementValue XM_INT) (list XmNindeterminateInsensitivePixmap XM_PIXMAP)
+ (list XmNindeterminatePixmap XM_PIXMAP) (list XmNinnerMarginHeight XM_DIMENSION) (list XmNinnerMarginWidth XM_DIMENSION)
+ (list XmNinputPolicy XM_ULONG) (list XmNinsensitiveStippleBitmap XM_PIXMAP) (list XmNinvokeParseProc XM_PARSE_CALLBACK)
+ (list XmNlabelRenderTable XM_RENDER_TABLE) (list XmNlargeCellHeight XM_DIMENSION) (list XmNlargeCellWidth XM_DIMENSION)
+ (list XmNlargeIconMask XM_PIXMAP) (list XmNlargeIconPixmap XM_PIXMAP) (list XmNlargeIconX XM_FLOAT)
+ (list XmNlargeIconY XM_FLOAT) (list XmNlastPageNumber XM_INT) (list XmNlayoutDirection XM_UCHAR)
+ (list XmNlayoutType XM_UCHAR) (list XmNlist XM_WIDGET) (list XmNloadModel XM_UCHAR)
+ (list XmNmajorTabSpacing XM_DIMENSION) (list XmNmatchBehavior XM_UCHAR) (list XmNmaximumValue XM_INT)
+ (list XmNminimumValue XM_INT) (list XmNminorTabSpacing XM_DIMENSION) (list XmNmotifVersion XM_INT)
+ (list XmNnoFontCallback XM_CALLBACK) (list XmNnoRenditionCallback XM_CALLBACK) (list XmNnotebookChildType XM_UCHAR)
+ (list XmNnumValues XM_INT) (list XmNoutlineButtonPolicy XM_UCHAR) (list XmNoutlineChangedCallback XM_CALLBACK)
+ (list XmNoutlineColumnWidth XM_DIMENSION) (list XmNoutlineIndentation XM_DIMENSION) (list XmNoutlineLineStyle XM_UCHAR)
+ (list XmNoutlineState XM_UCHAR) (list XmNpageChangedCallback XM_CALLBACK) (list XmNpageNumber XM_INT)
+ (list XmNpathMode XM_INT) (list XmNpatternType XM_UCHAR) (list XmNpopupHandlerCallback XM_CALLBACK)
+ (list XmNposition XM_INT) (list XmNpositionMode XM_INT) (list XmNpositionType XM_UCHAR)
+ (list XmNprimaryOwnership XM_UCHAR) (list XmNrenderTable XM_RENDER_TABLE) (list XmNrenditionBackground XM_PIXEL)
+ (list XmNrenditionForeground XM_PIXEL) (list XmNscrolledWindowChildType XM_UCHAR) (list XmNselectedItem XM_XMSTRING)
+ (list XmNselectedObjectCount XM_INT) (list XmNselectedObjects XM_WIDGET_LIST) (list XmNselectedPosition XM_INT)
+ (list XmNselectedPositionCount XM_INT) (list XmNselectedPositions XM_INT_TABLE) (list XmNselectionCallback XM_CALLBACK)
+ (list XmNselectionMode XM_UCHAR) (list XmNselectionTechnique XM_UCHAR) (list XmNsliderMark XM_INT)
+ (list XmNsmallCellHeight XM_DIMENSION) (list XmNsmallCellWidth XM_DIMENSION) (list XmNsmallIconMask XM_PIXMAP)
+ (list XmNsmallIconPixmap XM_PIXMAP) (list XmNsmallIconX XM_FLOAT) (list XmNsmallIconY XM_FLOAT)
+ (list XmNsnapBackMultiple XM_SHORT) (list XmNspatialIncludeModel XM_UCHAR) (list XmNspatialResizeModel XM_UCHAR)
+ (list XmNspatialSnapModel XM_UCHAR) (list XmNspatialStyle XM_UCHAR) (list XmNspinBoxChildType XM_UCHAR)
+ (list XmNstrikethruType XM_UCHAR) (list XmNsubstitute XM_XMSTRING) (list XmNtabList XM_TAB_LIST)
+ (list XmNtag XM_STRING) (list XmNtearOffTitle XM_XMSTRING) (list XmNtextField XM_WIDGET)
+ (list XmNtextRenderTable XM_RENDER_TABLE) (list XmNtoggleMode XM_UCHAR) (list XmNunderlineType XM_UCHAR)
+ (list XmNunselectColor XM_PIXEL) (list XmNtabValue XM_FLOAT) (list XmNoffsetModel XM_INT)
+ (list XmNcallback XM_CALLBACK) (list XmNwaitForWm XM_BOOLEAN) (list XmNuseColorObj XM_BOOLEAN)
+ (list XmNvalues XM_STRING_TABLE) (list XmNviewType XM_UCHAR) (list XmNvisualEmphasis XM_UCHAR)
+ (list XmNwrap XM_BOOLEAN)
+ )))
+
+ (for-each
+ (lambda (n)
+ (if (not (string? (car n))) (snd-display #__line__ ";resource ~A is not a string?" (car n)))
+ (XtVaGetValues shell (list (car n) 0)))
+ resource-list)
+ )
+
+ (if (not (XEvent? (XEvent)))
+ (snd-display #__line__ ";xevent type trouble! ~A -> ~A" (XEvent) (XEvent? (XEvent))))
+ (if (not (XGCValues? (XGCValues)))
+ (snd-display #__line__ ";xgcvalues type trouble! ~A -> ~A" (XGCValues) (XGCValues? (XGCValues))))
+ (if (not (= (.direction (XmTraverseObscuredCallbackStruct)) 0))
+ (snd-display #__line__ ";.direction: ~A" (.direction (XmTraverseObscuredCallbackStruct))))
+ (if (.ptr (XmTextBlock))
+ (snd-display #__line__ ";.ptr block: ~A" (.ptr (XmTextBlock))))
+ (let ((hi (XmTextBlock)))
+ (set! (.ptr hi) "hi")
+ (if (not (string=? (.ptr hi) "hi"))
+ (snd-display #__line__ ";.ptr set block: ~A" (.ptr hi)))
+ (if (not (= (.length hi) 0)) (snd-display #__line__ ";.length block: ~A" (.length hi)))
+ (set! (.length hi) 3)
+ (if (not (= (.length hi) 3)) (snd-display #__line__ ";set .length block: ~A" (.length hi))))
+ (if (not (= (.dashes (XGCValues)) 0)) (snd-display #__line__ ";dashes: ~A" (.dashes (XGCValues))))
+ (set! (.dashes (XGCValues)) 1)
+ (set! (.clip_mask (XGCValues)) (list 'Pixmap 0))
+ (set! (.resourceid (XEvent -1)) 0)
+ (set! (.error_code (XEvent -1)) 0)
+ (set! (.request_code (XEvent -1)) 0)
+ (if (not (= (.resourceid (XEvent -1)) 0)) (snd-display #__line__ ";error resourceid: ~A" (.resourceid (XEvent -1))))
+ (if (not (= (.request_code (XEvent -1)) 0)) (snd-display #__line__ ";error request_code: ~A" (.request_code (XEvent -1))))
+ (set! (.pad (XColor)) 1)
+ )
+
+ (if (defined? 'XShapeQueryExtents)
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets))))
+ (vals (XShapeQueryExtents dpy win)))
+ (if (not (= (car vals) 1))
+ (snd-display #__line__ ";XShapeQueryExtents: ~A" vals))
+ (set! vals (XShapeGetRectangles dpy win 0))
+ (if (not (list? vals)) (snd-display #__line__ ";XShapeGetRectangles: ~A" vals))
;(segfault) (XtFree (cadr vals))
- (set! vals (XShapeQueryExtension dpy))
- (if (not (equal? vals (list #t 64 0))) (snd-display ";XShapeQueryExtension: ~A" vals))
- (set! vals (XShapeQueryVersion dpy))
- (if (and (not (equal? vals (list #t 1 0)))
- (not (equal? vals (list #t 1 1))))
- (snd-display ";XShapeQueryVersion: ~A" vals))
- (if (XShapeOffsetShape dpy win 0 0 0) (snd-display ";XShapeOffsetShape?"))
-
- (let* ((attr (XSetWindowAttributes #f (basic-color) #f (highlight-color)))
- (newwin (XCreateWindow dpy win 10 10 100 100 3
+ (set! vals (XShapeQueryExtension dpy))
+ (if (not (equal? vals (list #t 64 0))) (snd-display #__line__ ";XShapeQueryExtension: ~A" vals))
+ (set! vals (XShapeQueryVersion dpy))
+ (if (and (not (equal? vals (list #t 1 0)))
+ (not (equal? vals (list #t 1 1))))
+ (snd-display #__line__ ";XShapeQueryVersion: ~A" vals))
+ (if (XShapeOffsetShape dpy win 0 0 0) (snd-display #__line__ ";XShapeOffsetShape?"))
+
+ (let* ((attr (XSetWindowAttributes #f (basic-color) #f (highlight-color)))
+ (newwin (XCreateWindow dpy win 10 10 100 100 3
+ CopyFromParent InputOutput (list 'Visual CopyFromParent)
+ (logior CWBackPixel CWBorderPixel)
+ attr))
+ (bitmap (XCreateBitmapFromData dpy win right-arrow 16 12))) ; right-arrow is in snd-motif.scm
+ (XShapeCombineMask dpy newwin ShapeClip 0 0 bitmap ShapeSet)
+ (XShapeCombineRectangles dpy newwin ShapeUnion 0 0
+ (list (XRectangle 0 0 10 10) (XRectangle 0 0 10 30)) 2
+ ShapeSet ShapeBounding)
+ (let ((newerwin (XCreateWindow dpy win 10 10 100 100 3
CopyFromParent InputOutput (list 'Visual CopyFromParent)
(logior CWBackPixel CWBorderPixel)
- attr))
- (bitmap (XCreateBitmapFromData dpy win right-arrow 16 12))) ; right-arrow is in snd-motif.scm
- (XShapeCombineMask dpy newwin ShapeClip 0 0 bitmap ShapeSet)
- (XShapeCombineRectangles dpy newwin ShapeUnion 0 0
- (list (XRectangle 0 0 10 10) (XRectangle 0 0 10 30)) 2
- ShapeSet ShapeBounding)
- (let ((newerwin (XCreateWindow dpy win 10 10 100 100 3
- CopyFromParent InputOutput (list 'Visual CopyFromParent)
- (logior CWBackPixel CWBorderPixel)
- attr)))
- (XShapeCombineShape dpy newerwin ShapeIntersect 0 0 newwin ShapeSet ShapeClip))
- (let* ((reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
- (XShapeCombineRegion dpy newwin ShapeUnion 0 0 reg1 ShapeSet)))))
-
- (let ((classes (list xmArrowButtonWidgetClass xmBulletinBoardWidgetClass xmCascadeButtonWidgetClass xmCommandWidgetClass
- xmDrawingAreaWidgetClass xmDrawnButtonWidgetClass xmFileSelectionBoxWidgetClass xmFormWidgetClass
- xmFrameWidgetClass xmLabelWidgetClass xmListWidgetClass xmMainWindowWidgetClass xmManagerWidgetClass
- xmMessageBoxWidgetClass xmPanedWindowWidgetClass xmPrimitiveWidgetClass xmPushButtonWidgetClass
- xmRowColumnWidgetClass xmScaleWidgetClass xmScrollBarWidgetClass xmScrolledWindowWidgetClass
- xmSelectionBoxWidgetClass xmSeparatorWidgetClass xmTextFieldWidgetClass xmTextWidgetClass
- xmToggleButtonWidgetClass xmContainerWidgetClass xmComboBoxWidgetClass xmNotebookWidgetClass))
- (wids '()))
- (for-each
- (lambda (class)
- (let* ((shell (cadr (main-widgets)))
- (wid (XtCreateWidget "hiho" class shell '())))
- (set! wids (cons wid wids))
- (XtAddCallback wid XmNhelpCallback (lambda (w c i) "help!"))))
- classes)
- (for-each
- (lambda (w)
- (XtCallCallbacks w XmNhelpCallback #f))
- wids))
-
- (let ((key (XStringToKeysym "Cancel")))
- (if (not (= (cadr key) XK_Cancel))
- (snd-display ";XStringToKeysym ~A ~A" key XK_Cancel)))
-
- (let* ((win (XtWindow (cadr (main-widgets))))
- (xm-procs-1
- (list
- XPutBackEvent XNextEvent
- XtAppProcessEvent XtAppMainLoop XtAppAddActions XtAppNextEvent XtAppPeekEvent
-
- XtSetArg XtManageChildren XtManageChild XtUnmanageChildren XtUnmanageChild
- XtDispatchEvent XtCallAcceptFocus XtIsSubclass XtIsObject XtIsManaged XtIsRealized
- XtIsSensitive XtOwnSelection XtOwnSelectionIncremental XtMakeResizeRequest XtTranslateCoords
- XtKeysymToKeycodeList XtParseTranslationTable XtParseAcceleratorTable XtOverrideTranslations XtAugmentTranslations
- XtInstallAccelerators XtInstallAllAccelerators XtUninstallTranslations XtAppAddActionHook
- XtRemoveActionHook XtGetActionList XtCallActionProc XtRegisterGrabAction XtSetMultiClickTime
- XtGetMultiClickTime XtGetActionKeysym XtTranslateKeycode XtTranslateKey XtSetKeyTranslator
- XtRegisterCaseConverter XtConvertCase XtAddEventHandler XtRemoveEventHandler XtAddRawEventHandler
- XtRemoveRawEventHandler XtInsertEventHandler XtInsertRawEventHandler XtDispatchEventToWidget
- XtBuildEventMask XtAddGrab XtRemoveGrab XtAddExposureToRegion XtSetKeyboardFocus
- XtGetKeyboardFocusWidget XtLastEventProcessed XtLastTimestampProcessed
- XtAppAddTimeOut XtRemoveTimeOut XtAppAddInput XtRemoveInput XtAppPending
- XtRealizeWidget XtUnrealizeWidget XtSetSensitive XtNameToWidget XtWindowToWidget
- XtMergeArgLists XtVaCreateArgsList XtDisplay XtDisplayOfObject XtScreen XtScreenOfObject
- XtWindow XtWindowOfObject XtName XtSuperclass XtClass XtParent XtAddCallback XtRemoveCallback
- XtAddCallbacks XtRemoveCallbacks XtRemoveAllCallbacks XtCallCallbacks
- XtHasCallbacks XtCreatePopupShell XtVaCreatePopupShell XtPopup XtPopupSpringLoaded
- XtCallbackNone XtCallbackNonexclusive XtCallbackExclusive XtPopdown XtCallbackPopdown
- XtCreateWidget XtCreateManagedWidget XtVaCreateWidget XtVaCreateManagedWidget
- XtAppCreateShell XtVaAppCreateShell
- XtDisplayToApplicationContext
- XtSetValues XtVaSetValues XtGetValues XtVaGetValues
- XtAppSetErrorMsgHandler XtAppSetWarningMsgHandler
- XtAppErrorMsg XtAppWarningMsg XtAppSetErrorHandler
- XtAppSetWarningHandler XtAppError
- XtAppAddWorkProc XtGetGC XtAllocateGC XtDestroyGC XtReleaseGC
- XtFindFile XtResolvePathname XtDisownSelection XtGetSelectionValue
- XtGetSelectionValues XtAppSetSelectionTimeout XtAppGetSelectionTimeout
- XtGetSelectionRequest XtGetSelectionValueIncremental
- XtGetSelectionValuesIncremental XtCreateSelectionRequest XtSendSelectionRequest
- XtCancelSelectionRequest XtGrabKey XtUngrabKey
- XtGrabKeyboard XtUngrabKeyboard XtGrabButton XtUngrabButton XtGrabPointer XtUngrabPointer
- XtGetApplicationNameAndClass XtGetDisplays XtToolkitThreadInitialize XtAppLock XtAppUnlock XtIsRectObj XtIsWidget
- XtIsComposite XtIsConstraint XtIsShell XtIsOverrideShell XtIsWMShell XtIsVendorShell
- XtIsTransientShell XtIsTopLevelShell XtIsApplicationShell XtIsSessionShell XtMapWidget
- XtUnmapWidget XLoadQueryFont XQueryFont XGetMotionEvents XDeleteModifiermapEntry
- XGetModifierMapping XInsertModifiermapEntry XNewModifiermap XCreateImage XGetImage
- XGetSubImage XOpenDisplay XFetchBytes XFetchBuffer XGetAtomName XDisplayName XUniqueContext
- XKeysymToString XSynchronize XSetAfterFunction XInternAtom XCopyColormapAndFree XCreateColormap
- XCreatePixmapCursor XCreateGlyphCursor XCreateFontCursor XLoadFont XCreateGC XFlushGC
- XCreatePixmap XCreateBitmapFromData XCreatePixmapFromBitmapData XCreateSimpleWindow
- XGetSelectionOwner XCreateWindow XListInstalledColormaps XListFonts XListFontsWithInfo
- XListExtensions XListProperties XKeycodeToKeysym XLookupKeysym
- XGetKeyboardMapping ;XStringToKeysym
- XDisplayMotionBufferSize XVisualIDFromVisual XMaxRequestSize XExtendedMaxRequestSize
- XRootWindow XDefaultRootWindow XRootWindowOfScreen
- XDefaultVisual XDefaultVisualOfScreen XDefaultGC XDefaultGCOfScreen XBlackPixel XWhitePixel
- XAllPlanes XBlackPixelOfScreen XWhitePixelOfScreen XNextRequest XLastKnownRequestProcessed
- XServerVendor XDisplayString XDefaultColormap XDefaultColormapOfScreen XDisplayOfScreen
- XScreenOfDisplay XDefaultScreenOfDisplay XEventMaskOfScreen XScreenNumberOfScreen
- XSetErrorHandler XSetIOErrorHandler XListPixmapFormats XListDepths XReconfigureWMWindow
- XGetWMProtocols XSetWMProtocols XIconifyWindow XWithdrawWindow XGetCommand XGetWMColormapWindows
- XSetTransientForHint XActivateScreenSaver
- XAllocColor XAllocColorCells XAllocColorPlanes XAllocNamedColor
- XAllowEvents XAutoRepeatOff XAutoRepeatOn XBell XBitmapBitOrder XBitmapPad XBitmapUnit
- XCellsOfScreen XChangeActivePointerGrab XChangeGC XChangeKeyboardControl XChangeKeyboardMapping
- XChangePointerControl XChangeProperty XChangeWindowAttributes ; XCheckIfEvent
- XCheckMaskEvent XCheckTypedEvent XCheckTypedWindowEvent XCheckWindowEvent XCirculateSubwindows
- XCirculateSubwindowsDown XCirculateSubwindowsUp XClearArea XClearWindow XCloseDisplay
- XConfigureWindow XConnectionNumber XConvertSelection XCopyArea XCopyGC XCopyPlane XDefaultDepth
- XDefaultDepthOfScreen XDefaultScreen XDefineCursor XDeleteProperty XDestroyWindow
- XDestroySubwindows XDoesBackingStore XDoesSaveUnders XDisableAccessControl XDisplayCells
- XDisplayHeight XDisplayHeightMM XDisplayKeycodes XDisplayPlanes XDisplayWidth XDisplayWidthMM
- XDrawArc XDrawArcs XDrawImageString XDrawLine XDrawLines XDrawLinesDirect XDrawPoint
- XDrawPoints XDrawRectangle XDrawRectangles XDrawSegments XDrawString XDrawText
- XEnableAccessControl XEventsQueued XFetchName XFillArc XFillArcs XFillPolygon XFillRectangle
- XFillRectangles XFlush XForceScreenSaver XFreeColormap XFreeColors XFreeCursor
- XFreeExtensionList XFreeFont XFreeFontInfo XFreeFontNames XFreeFontPath XFreeGC
- XFreeModifiermap XFreePixmap XGeometry XGetErrorText XGetFontProperty
- XGetGCValues XGCValues XEvent XGetGeometry XGetIconName XGetInputFocus XGetKeyboardControl
- XGetPointerControl XGetPointerMapping XGetScreenSaver XGetTransientForHint XGetWindowProperty
- XGetWindowAttributes XGrabButton XGrabKey XGrabKeyboard XGrabPointer XGrabServer
- XHeightMMOfScreen XHeightOfScreen XIfEvent XImageByteOrder XInstallColormap XKeysymToKeycode
- XKillClient XLookupColor XLowerWindow XMapRaised XMapSubwindows XMapWindow XMaskEvent
- XMaxCmapsOfScreen XMinCmapsOfScreen XMoveResizeWindow XMoveWindow XNoOp XParseColor
- XParseGeometry XPeekEvent XPeekIfEvent XPending XPlanesOfScreen XProtocolRevision
- XProtocolVersion XPutImage XQLength XQueryBestCursor XQueryBestSize XQueryBestStipple
- XQueryBestTile XQueryColor XQueryColors XQueryExtension XQueryKeymap XQueryPointer
- XQueryTextExtents XQueryTree XRaiseWindow XRebindKeysym XRecolorCursor XRefreshKeyboardMapping
- XReparentWindow XResetScreenSaver XResizeWindow
- XRestackWindows XRotateBuffers XRotateWindowProperties XScreenCount XSelectInput XSendEvent
- XSetAccessControl XSetArcMode XSetBackground XSetClipMask XSetClipOrigin XSetClipRectangles
- XSetCloseDownMode XSetCommand XSetDashes XSetFillRule XSetFillStyle XSetFont XSetFontPath
- XSetForeground XSetFunction XSetGraphicsExposures XSetIconName XSetInputFocus XSetLineAttributes
- XSetModifierMapping XSetPlaneMask XSetPointerMapping XSetScreenSaver XSetSelectionOwner
- XSetState XSetStipple XSetSubwindowMode XSetTSOrigin XSetTile XSetWindowBackground
- XSetWindowBackgroundPixmap XSetWindowBorder XSetWindowBorderPixmap XSetWindowBorderWidth
- XSetWindowColormap XStoreBuffer XStoreBytes XStoreColor XStoreColors XStoreName
- XStoreNamedColor XSync XTextExtents XTextWidth XTranslateCoordinates XUndefineCursor
- XUngrabButton XUngrabKey XUngrabKeyboard XUngrabPointer XUngrabServer XUninstallColormap
- XUnloadFont XUnmapSubwindows XUnmapWindow XVendorRelease XWarpPointer XWidthMMOfScreen
- XWidthOfScreen XWindowEvent XWriteBitmapFile XSupportsLocale XSetLocaleModifiers XCreateFontSet
- XFreeFontSet XFontsOfFontSet XBaseFontNameListOfFontSet XLocaleOfFontSet XContextDependentDrawing
- XDirectionalDependentDrawing XContextualDrawing XFilterEvent XAllocIconSize
- XAllocStandardColormap XAllocWMHints XClipBox XCreateRegion XDefaultString XDeleteContext
- XDestroyRegion XEmptyRegion XEqualRegion ;XFindContext
- XGetIconSizes XGetRGBColormaps
- XGetVisualInfo XGetWMHints XIntersectRegion XConvertCase XLookupString
- XMatchVisualInfo XOffsetRegion XPointInRegion XPolygonRegion XRectInRegion XSaveContext
- XSetRGBColormaps XSetWMHints XSetRegion XShrinkRegion XSubtractRegion
- XUnionRectWithRegion XUnionRegion XXorRegion DefaultScreen DefaultRootWindow QLength
- ScreenCount ServerVendor ProtocolVersion ProtocolRevision VendorRelease DisplayString
- BitmapUnit BitmapBitOrder BitmapPad ImageByteOrder NextRequest LastKnownRequestProcessed
- DefaultScreenOfDisplay DisplayOfScreen RootWindowOfScreen BlackPixelOfScreen WhitePixelOfScreen
- DefaultColormapOfScreen DefaultDepthOfScreen DefaultGCOfScreen DefaultVisualOfScreen
- WidthOfScreen HeightOfScreen WidthMMOfScreen HeightMMOfScreen PlanesOfScreen CellsOfScreen
- MinCmapsOfScreen MaxCmapsOfScreen DoesSaveUnders DoesBackingStore EventMaskOfScreen RootWindow
- DefaultVisual DefaultGC BlackPixel WhitePixel DisplayWidth DisplayHeight DisplayWidthMM
- DisplayHeightMM DisplayPlanes DisplayCells DefaultColormap ScreenOfDisplay DefaultDepth
- IsKeypadKey IsPrivateKeypadKey IsCursorKey IsPFKey IsFunctionKey IsMiscFunctionKey
- IsModifierKey XmCreateMessageBox XmCreateMessageDialog XmCreateErrorDialog
- XmCreateInformationDialog XmCreateQuestionDialog XmCreateWarningDialog XmCreateWorkingDialog
- XmCreateTemplateDialog XmMessageBoxGetChild XmCreateArrowButtonGadget XmCreateArrowButton
- XmCreateNotebook XmNotebookGetPageInfo
- XmTransferSetParameters XmTransferValue XmCreateComboBox
- XmCreateDropDownComboBox XmCreateDropDownList XmComboBoxAddItem XmComboBoxDeletePos
- XmComboBoxSelectItem XmComboBoxSetItem XmComboBoxUpdate XmCreateContainer
- XmContainerGetItemChildren XmContainerRelayout XmContainerReorder XmContainerCut XmContainerCopy
- XmContainerPaste XmContainerCopyLink XmContainerPasteLink XmCreateSpinBox
- XmSpinBoxValidatePosition XmCreateSimpleSpinBox XmSimpleSpinBoxAddItem XmSimpleSpinBoxDeletePos
- XmSimpleSpinBoxSetItem XmDropSiteRegistered XmTextFieldCopyLink XmTextFieldPasteLink
- XmTextGetCenterline XmToggleButtonGadgetSetValue XmCreateIconGadget
- XmCreateIconHeader XmObjectAtPoint XmConvertStringToUnits XmCreateGrabShell
- XmToggleButtonSetValue XmTextPasteLink XmTextCopyLink XmScaleSetTicks XmInternAtom XmGetAtomName
- XmCreatePanedWindow XmCreateBulletinBoard XmCreateBulletinBoardDialog XmCreateCascadeButtonGadget
- XmCascadeButtonGadgetHighlight XmAddProtocols XmRemoveProtocols XmAddProtocolCallback
- XmRemoveProtocolCallback XmActivateProtocol XmDeactivateProtocol XmSetProtocolHooks
- XmCreateCascadeButton XmCascadeButtonHighlight XmCreatePushButtonGadget XmCreatePushButton
- XmCreateCommand XmCommandGetChild XmCommandSetValue XmCommandAppendValue XmCommandError
- XmCreateCommandDialog XmMenuPosition XmCreateRowColumn XmCreateWorkArea XmCreateRadioBox
- XmCreateOptionMenu XmOptionLabelGadget XmOptionButtonGadget XmCreateMenuBar XmCreatePopupMenu
- XmCreatePulldownMenu XmGetPostedFromWidget XmGetTearOffControl
- XmScaleSetValue XmScaleGetValue XmCreateScale
- XmClipboardStartCopy XmClipboardCopy XmClipboardEndCopy XmClipboardCancelCopy
- XmClipboardWithdrawFormat XmClipboardCopyByName XmClipboardUndoCopy XmClipboardLock
- XmClipboardUnlock XmClipboardStartRetrieve XmClipboardEndRetrieve XmClipboardRetrieve
- XmClipboardInquireCount XmClipboardInquireFormat XmClipboardInquireLength
- XmClipboardInquirePendingItems XmClipboardRegisterFormat XmGetXmScreen XmCreateScrollBar
- XmScrollBarGetValues XmScrollBarSetValues XmCreateDialogShell
- XmCreateScrolledWindow XmScrollVisible XmGetDragContext XmGetXmDisplay XmSelectionBoxGetChild
- XmCreateSelectionBox XmCreateSelectionDialog XmCreatePromptDialog XmDragStart XmDragCancel
- XmTargetsAreCompatible XmCreateSeparatorGadget XmCreateDragIcon XmCreateSeparator
- XmCreateDrawingArea XmCreateDrawnButton XmDropSiteRegister XmDropSiteUnregister
- XmDropSiteStartUpdate XmDropSiteUpdate XmDropSiteEndUpdate XmDropSiteRetrieve
- XmDropSiteQueryStackingOrder XmDropSiteConfigureStackingOrder XmDropTransferStart
- XmDropTransferAdd XmTextFieldGetString XmTextFieldGetSubstring XmTextFieldGetLastPosition
- XmTextFieldSetString XmTextFieldReplace XmTextFieldInsert XmTextFieldSetAddMode
- XmTextFieldGetAddMode XmTextFieldGetEditable XmTextFieldSetEditable XmTextFieldGetMaxLength
- XmTextFieldSetMaxLength XmTextFieldGetCursorPosition XmTextFieldGetInsertionPosition
- XmTextFieldSetCursorPosition XmTextFieldSetInsertionPosition XmTextFieldGetSelectionPosition
- XmTextFieldGetSelection XmTextFieldRemove XmTextFieldCopy XmTextFieldCut XmTextFieldPaste
- XmTextFieldClearSelection XmTextFieldSetSelection XmTextFieldXYToPos XmTextFieldPosToXY
- XmTextFieldShowPosition XmTextFieldSetHighlight XmTextFieldGetBaseline XmCreateTextField
- XmFileSelectionBoxGetChild XmFileSelectionDoSearch XmCreateFileSelectionBox
- XmCreateFileSelectionDialog XmTextSetHighlight XmCreateScrolledText XmCreateText
- XmTextGetSubstring XmTextGetString XmTextGetLastPosition XmTextSetString XmTextReplace
- XmTextInsert XmTextSetAddMode XmTextGetAddMode XmTextGetEditable XmTextSetEditable
- XmTextGetMaxLength XmTextSetMaxLength XmTextGetTopCharacter XmTextSetTopCharacter
- XmTextGetCursorPosition XmTextGetInsertionPosition XmTextSetInsertionPosition
- XmTextSetCursorPosition XmTextRemove XmTextCopy XmTextCut XmTextPaste XmTextGetSelection
- XmTextSetSelection XmTextClearSelection XmTextGetSelectionPosition XmTextXYToPos XmTextPosToXY
- XmTextGetSource XmTextSetSource XmTextShowPosition XmTextScroll XmTextGetBaseline
- XmTextDisableRedisplay XmTextEnableRedisplay XmTextFindString XmCreateForm XmCreateFormDialog
- XmCreateFrame XmToggleButtonGadgetGetState XmToggleButtonGadgetSetState XmCreateToggleButtonGadget
- XmToggleButtonGetState XmToggleButtonSetState XmCreateToggleButton XmCreateLabelGadget
- XmCreateLabel XmIsMotifWMRunning XmListAddItem XmListAddItems XmListAddItemsUnselected
- XmListAddItemUnselected XmListDeleteItem XmListDeleteItems XmListDeletePositions XmListDeletePos
- XmListDeleteItemsPos XmListDeleteAllItems XmListReplaceItems XmListReplaceItemsPos
- XmListReplaceItemsUnselected XmListReplaceItemsPosUnselected XmListReplacePositions
- XmListSelectItem XmListSelectPos XmListDeselectItem XmListDeselectPos XmListDeselectAllItems
- XmListSetPos XmListSetBottomPos XmListSetItem XmListSetBottomItem XmListSetAddMode
- XmListItemExists XmListItemPos XmListGetKbdItemPos XmListSetKbdItemPos XmListYToPos
- XmListPosToBounds XmListGetMatchPos XmListGetSelectedPos XmListSetHorizPos
- XmListUpdateSelectedList XmListPosSelected XmCreateList XmCreateScrolledList XmTranslateKey
- XmInstallImage XmUninstallImage XmGetPixmap XmGetPixmapByDepth XmDestroyPixmap XmUpdateDisplay
- XmWidgetGetBaselines XmRegisterSegmentEncoding XmMapSegmentEncoding
- XmCvtCTToXmString XmCvtXmStringToCT XmConvertUnits
- XmCreateSimpleMenuBar XmCreateSimplePopupMenu XmCreateSimplePulldownMenu
- XmCreateSimpleOptionMenu XmCreateSimpleRadioBox XmCreateSimpleCheckBox XmVaCreateSimpleMenuBar
- XmVaCreateSimplePopupMenu XmVaCreateSimplePulldownMenu XmVaCreateSimpleOptionMenu
- XmVaCreateSimpleRadioBox XmVaCreateSimpleCheckBox XmTrackingEvent
- XmSetColorCalculation XmGetColorCalculation XmGetColors XmChangeColor XmStringCreate
- XmStringCreateLocalized XmStringDirectionCreate XmStringSeparatorCreate
- XmStringInitContext
- XmStringFreeContext
- XmStringConcatAndFree XmStringIsVoid XmStringPeekNextTriple XmStringGetNextTriple
- XmStringComponentCreate XmStringUnparse XmStringParseText XmStringToXmStringTable
- XmStringTableToXmString XmStringTableUnparse XmStringTableParseStringArray
- XmDirectionToStringDirection XmStringDirectionToDirection XmStringGenerate XmStringPutRendition
- XmParseMappingGetValues XmParseMappingFree XmParseTableFree XmStringTableProposeTablist
- XmTabSetValue XmTabGetValues XmTabFree XmTabCreate XmTabListTabCount XmTabListRemoveTabs
- XmTabListReplacePositions XmTabListGetTab XmTabListCopy XmTabListInsertTabs
- ; XmRenderTableCvtFromProp XmRenderTableCvtToProp XmRenditionUpdate XmRenditionRetrieve
- XmRenditionFree XmRenditionCreate XmRenderTableGetRenditions XmRenderTableGetRendition
- XmRenderTableGetTags XmRenderTableFree XmRenderTableCopy XmRenderTableRemoveRenditions
- XmRenderTableAddRenditions
- XmStringEmpty XmStringHasSubstring XmStringFree XmStringBaseline XmStringWidth XmStringHeight
- XmStringExtent XmStringLineCount XmStringDraw XmStringDrawImage XmStringDrawUnderline
- XmGetDestination XmIsTraversable XmGetVisibility XmGetTabGroup XmGetFocusWidget
- XmProcessTraversal XmCreateMenuShell XmIsMessageBox
- XmIsArrowButtonGadget XmIsArrowButton XmIsNotebook XmIsComboBox XmIsContainer
- XmIsGrabShell XmIsIconGadget XmIsIconHeader XmIsPanedWindow XmIsBulletinBoard XmIsPrimitive
- XmIsCascadeButtonGadget XmIsCascadeButton XmIsPushButtonGadget XmIsPushButton XmIsCommand
- XmIsRowColumn XmIsScale XmIsScreen XmIsScrollBar XmIsDialogShell XmIsScrolledWindow XmIsDisplay
- XmIsSelectionBox XmIsDragContext XmIsSeparatorGadget XmIsDragIconObjectClass
- XmIsSeparator XmIsDrawingArea XmIsDrawnButton XmIsDropSiteManager XmIsDropTransfer XmIsTextField
- XmIsFileSelectionBox XmIsText XmIsForm XmIsFrame XmIsGadget XmIsToggleButtonGadget
- XmIsToggleButton XmIsLabelGadget XmIsLabel XmIsVendorShell XmIsList XmIsManager
- XmIsMenuShell XGetPixel XDestroyImage XPutPixel XSubImage XAddPixel
- XtAppContext? XtRequestId? XtWorkProcId? XtInputId? XtIntervalId? Screen? XEvent?
- XRectangle? XArc? XPoint? XSegment? XColor? Atom? Colormap?
- XModifierKeymap? Depth? Display? Drawable? Font? GC? KeySym? Pixel? Pixmap? Region?
- Time? Visual? Window? XFontProp? XFontSet? XFontStruct? XGCValues? XImage? XVisualInfo?
- XWMHints? XWindowAttributes? XWindowChanges? KeyCode? XContext? XCharStruct? XTextItem?
- Widget? XmStringContext? WidgetClass? XmString?
- XmToggleButton? XmDrawingArea? XmPushButton? XmTextField? XmFileSelectionBox? XmText?
- XmFrame? XmLabel? XmList? XmArrowButton? XmScrollBar? XmCommand? XmScale? XmRowColumn?
- XmTab? XmNotebook? XmComboBox? XmContainer? XmIconHeader?
- XmGrabShell? XmRendition? XmRenderTable? XmIconGadget? XmTabList? XmParseMapping?
- XmPanedWindow? XmScrolledWindow? XmCascadeButton? XmForm? XmBulletinBoard? XmScreen?
- XmDialogShell? XmDisplay? XmSelectionBox? XmDragContext? XmDragIconObjectClass? XmSeparator?
- XmDropSiteManager? XmDropTransfer? XmVendorShell? XmMessageBox? XmManager?
- XmMenuShell? XmLabelGadget? XmPushButtonGadget? XmSeparatorGadget? XmArrowButtonGadget?
- XmCascadeButtonGadget? XmToggleButtonGadget? XmDrawnButton? XmPrimitive?
- XmTextSource?
- ))
- (xm-procs (if (defined? 'XpmImage?)
- (append xm-procs-1
- (list
- XpmCreatePixmapFromData XpmCreateDataFromPixmap XpmReadFileToPixmap
- XpmReadPixmapFile XpmWriteFileFromPixmap XpmWritePixmapFile XpmCreatePixmapFromXpmImage
- XpmCreateXpmImageFromPixmap XpmAttributes? XpmImage? XpmColorSymbol?))
- xm-procs-1))
- (xm-procs0 (remove-if (lambda (n) (not (arity-ok n 0))) xm-procs))
- (xm-procs1 (remove-if (lambda (n) (not (arity-ok n 1))) xm-procs))
- (xm-procs2 (remove-if (lambda (n) (not (arity-ok n 2))) xm-procs))
- (xm-procs3 (remove-if (lambda (n) (not (arity-ok n 3))) xm-procs))
- (xm-procs4 (remove-if (lambda (n) (not (arity-ok n 4))) xm-procs))
- )
-
- ;; ---------------- 0 Args
+ attr)))
+ (XShapeCombineShape dpy newerwin ShapeIntersect 0 0 newwin ShapeSet ShapeClip))
+ (let* ((reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
+ (XShapeCombineRegion dpy newwin ShapeUnion 0 0 reg1 ShapeSet)))))
+
+ (let ((classes (list xmArrowButtonWidgetClass xmBulletinBoardWidgetClass xmCascadeButtonWidgetClass xmCommandWidgetClass
+ xmDrawingAreaWidgetClass xmDrawnButtonWidgetClass xmFileSelectionBoxWidgetClass xmFormWidgetClass
+ xmFrameWidgetClass xmLabelWidgetClass xmListWidgetClass xmMainWindowWidgetClass xmManagerWidgetClass
+ xmMessageBoxWidgetClass xmPanedWindowWidgetClass xmPrimitiveWidgetClass xmPushButtonWidgetClass
+ xmRowColumnWidgetClass xmScaleWidgetClass xmScrollBarWidgetClass xmScrolledWindowWidgetClass
+ xmSelectionBoxWidgetClass xmSeparatorWidgetClass xmTextFieldWidgetClass xmTextWidgetClass
+ xmToggleButtonWidgetClass xmContainerWidgetClass xmComboBoxWidgetClass xmNotebookWidgetClass))
+ (wids '()))
+ (for-each
+ (lambda (class)
+ (let* ((shell (cadr (main-widgets)))
+ (wid (XtCreateWidget "hiho" class shell '())))
+ (set! wids (cons wid wids))
+ (XtAddCallback wid XmNhelpCallback (lambda (w c i) "help!"))))
+ classes)
+ (for-each
+ (lambda (w)
+ (XtCallCallbacks w XmNhelpCallback #f))
+ wids))
+
+ (let ((key (XStringToKeysym "Cancel")))
+ (if (not (= (cadr key) XK_Cancel))
+ (snd-display #__line__ ";XStringToKeysym ~A ~A" key XK_Cancel)))
+
+ (let* ((win (XtWindow (cadr (main-widgets))))
+ (xm-procs-1
+ (list
+ XPutBackEvent XNextEvent
+ XtAppProcessEvent XtAppMainLoop XtAppAddActions XtAppNextEvent XtAppPeekEvent
+
+ XtSetArg XtManageChildren XtManageChild XtUnmanageChildren XtUnmanageChild
+ XtDispatchEvent XtCallAcceptFocus XtIsSubclass XtIsObject XtIsManaged XtIsRealized
+ XtIsSensitive XtOwnSelection XtOwnSelectionIncremental XtMakeResizeRequest XtTranslateCoords
+ XtKeysymToKeycodeList XtParseTranslationTable XtParseAcceleratorTable XtOverrideTranslations XtAugmentTranslations
+ XtInstallAccelerators XtInstallAllAccelerators XtUninstallTranslations XtAppAddActionHook
+ XtRemoveActionHook XtGetActionList XtCallActionProc XtRegisterGrabAction XtSetMultiClickTime
+ XtGetMultiClickTime XtGetActionKeysym XtTranslateKeycode XtTranslateKey XtSetKeyTranslator
+ XtRegisterCaseConverter XtConvertCase XtAddEventHandler XtRemoveEventHandler XtAddRawEventHandler
+ XtRemoveRawEventHandler XtInsertEventHandler XtInsertRawEventHandler XtDispatchEventToWidget
+ XtBuildEventMask XtAddGrab XtRemoveGrab XtAddExposureToRegion XtSetKeyboardFocus
+ XtGetKeyboardFocusWidget XtLastEventProcessed XtLastTimestampProcessed
+ XtAppAddTimeOut XtRemoveTimeOut XtAppAddInput XtRemoveInput XtAppPending
+ XtRealizeWidget XtUnrealizeWidget XtSetSensitive XtNameToWidget XtWindowToWidget
+ XtMergeArgLists XtVaCreateArgsList XtDisplay XtDisplayOfObject XtScreen XtScreenOfObject
+ XtWindow XtWindowOfObject XtName XtSuperclass XtClass XtParent XtAddCallback XtRemoveCallback
+ XtAddCallbacks XtRemoveCallbacks XtRemoveAllCallbacks XtCallCallbacks
+ XtHasCallbacks XtCreatePopupShell XtVaCreatePopupShell XtPopup XtPopupSpringLoaded
+ XtCallbackNone XtCallbackNonexclusive XtCallbackExclusive XtPopdown XtCallbackPopdown
+ XtCreateWidget XtCreateManagedWidget XtVaCreateWidget XtVaCreateManagedWidget
+ XtAppCreateShell XtVaAppCreateShell
+ XtDisplayToApplicationContext
+ XtSetValues XtVaSetValues XtGetValues XtVaGetValues
+ XtAppSetErrorMsgHandler XtAppSetWarningMsgHandler
+ XtAppErrorMsg XtAppWarningMsg XtAppSetErrorHandler
+ XtAppSetWarningHandler XtAppError
+ XtAppAddWorkProc XtGetGC XtAllocateGC XtDestroyGC XtReleaseGC
+ XtFindFile XtResolvePathname XtDisownSelection XtGetSelectionValue
+ XtGetSelectionValues XtAppSetSelectionTimeout XtAppGetSelectionTimeout
+ XtGetSelectionRequest XtGetSelectionValueIncremental
+ XtGetSelectionValuesIncremental XtCreateSelectionRequest XtSendSelectionRequest
+ XtCancelSelectionRequest XtGrabKey XtUngrabKey
+ XtGrabKeyboard XtUngrabKeyboard XtGrabButton XtUngrabButton XtGrabPointer XtUngrabPointer
+ XtGetApplicationNameAndClass XtGetDisplays XtToolkitThreadInitialize XtAppLock XtAppUnlock XtIsRectObj XtIsWidget
+ XtIsComposite XtIsConstraint XtIsShell XtIsOverrideShell XtIsWMShell XtIsVendorShell
+ XtIsTransientShell XtIsTopLevelShell XtIsApplicationShell XtIsSessionShell XtMapWidget
+ XtUnmapWidget XLoadQueryFont XQueryFont XGetMotionEvents XDeleteModifiermapEntry
+ XGetModifierMapping XInsertModifiermapEntry XNewModifiermap XCreateImage XGetImage
+ XGetSubImage XOpenDisplay XFetchBytes XFetchBuffer XGetAtomName XDisplayName XUniqueContext
+ XKeysymToString XSynchronize XSetAfterFunction XInternAtom XCopyColormapAndFree XCreateColormap
+ XCreatePixmapCursor XCreateGlyphCursor XCreateFontCursor XLoadFont XCreateGC XFlushGC
+ XCreatePixmap XCreateBitmapFromData XCreatePixmapFromBitmapData XCreateSimpleWindow
+ XGetSelectionOwner XCreateWindow XListInstalledColormaps XListFonts XListFontsWithInfo
+ XListExtensions XListProperties XKeycodeToKeysym XLookupKeysym
+ XGetKeyboardMapping ;XStringToKeysym
+ XDisplayMotionBufferSize XVisualIDFromVisual XMaxRequestSize XExtendedMaxRequestSize
+ XRootWindow XDefaultRootWindow XRootWindowOfScreen
+ XDefaultVisual XDefaultVisualOfScreen XDefaultGC XDefaultGCOfScreen XBlackPixel XWhitePixel
+ XAllPlanes XBlackPixelOfScreen XWhitePixelOfScreen XNextRequest XLastKnownRequestProcessed
+ XServerVendor XDisplayString XDefaultColormap XDefaultColormapOfScreen XDisplayOfScreen
+ XScreenOfDisplay XDefaultScreenOfDisplay XEventMaskOfScreen XScreenNumberOfScreen
+ XSetErrorHandler XSetIOErrorHandler XListPixmapFormats XListDepths XReconfigureWMWindow
+ XGetWMProtocols XSetWMProtocols XIconifyWindow XWithdrawWindow XGetCommand XGetWMColormapWindows
+ XSetTransientForHint XActivateScreenSaver
+ XAllocColor XAllocColorCells XAllocColorPlanes XAllocNamedColor
+ XAllowEvents XAutoRepeatOff XAutoRepeatOn XBell XBitmapBitOrder XBitmapPad XBitmapUnit
+ XCellsOfScreen XChangeActivePointerGrab XChangeGC XChangeKeyboardControl XChangeKeyboardMapping
+ XChangePointerControl XChangeProperty XChangeWindowAttributes ; XCheckIfEvent
+ XCheckMaskEvent XCheckTypedEvent XCheckTypedWindowEvent XCheckWindowEvent XCirculateSubwindows
+ XCirculateSubwindowsDown XCirculateSubwindowsUp XClearArea XClearWindow XCloseDisplay
+ XConfigureWindow XConnectionNumber XConvertSelection XCopyArea XCopyGC XCopyPlane XDefaultDepth
+ XDefaultDepthOfScreen XDefaultScreen XDefineCursor XDeleteProperty XDestroyWindow
+ XDestroySubwindows XDoesBackingStore XDoesSaveUnders XDisableAccessControl XDisplayCells
+ XDisplayHeight XDisplayHeightMM XDisplayKeycodes XDisplayPlanes XDisplayWidth XDisplayWidthMM
+ XDrawArc XDrawArcs XDrawImageString XDrawLine XDrawLines XDrawLinesDirect XDrawPoint
+ XDrawPoints XDrawRectangle XDrawRectangles XDrawSegments XDrawString XDrawText
+ XEnableAccessControl XEventsQueued XFetchName XFillArc XFillArcs XFillPolygon XFillRectangle
+ XFillRectangles XFlush XForceScreenSaver XFreeColormap XFreeColors XFreeCursor
+ XFreeExtensionList XFreeFont XFreeFontInfo XFreeFontNames XFreeFontPath XFreeGC
+ XFreeModifiermap XFreePixmap XGeometry XGetErrorText XGetFontProperty
+ XGetGCValues XGCValues XEvent XGetGeometry XGetIconName XGetInputFocus XGetKeyboardControl
+ XGetPointerControl XGetPointerMapping XGetScreenSaver XGetTransientForHint XGetWindowProperty
+ XGetWindowAttributes XGrabButton XGrabKey XGrabKeyboard XGrabPointer XGrabServer
+ XHeightMMOfScreen XHeightOfScreen XIfEvent XImageByteOrder XInstallColormap XKeysymToKeycode
+ XKillClient XLookupColor XLowerWindow XMapRaised XMapSubwindows XMapWindow XMaskEvent
+ XMaxCmapsOfScreen XMinCmapsOfScreen XMoveResizeWindow XMoveWindow XNoOp XParseColor
+ XParseGeometry XPeekEvent XPeekIfEvent XPending XPlanesOfScreen XProtocolRevision
+ XProtocolVersion XPutImage XQLength XQueryBestCursor XQueryBestSize XQueryBestStipple
+ XQueryBestTile XQueryColor XQueryColors XQueryExtension XQueryKeymap XQueryPointer
+ XQueryTextExtents XQueryTree XRaiseWindow XRebindKeysym XRecolorCursor XRefreshKeyboardMapping
+ XReparentWindow XResetScreenSaver XResizeWindow
+ XRestackWindows XRotateBuffers XRotateWindowProperties XScreenCount XSelectInput XSendEvent
+ XSetAccessControl XSetArcMode XSetBackground XSetClipMask XSetClipOrigin XSetClipRectangles
+ XSetCloseDownMode XSetCommand XSetDashes XSetFillRule XSetFillStyle XSetFont XSetFontPath
+ XSetForeground XSetFunction XSetGraphicsExposures XSetIconName XSetInputFocus XSetLineAttributes
+ XSetModifierMapping XSetPlaneMask XSetPointerMapping XSetScreenSaver XSetSelectionOwner
+ XSetState XSetStipple XSetSubwindowMode XSetTSOrigin XSetTile XSetWindowBackground
+ XSetWindowBackgroundPixmap XSetWindowBorder XSetWindowBorderPixmap XSetWindowBorderWidth
+ XSetWindowColormap XStoreBuffer XStoreBytes XStoreColor XStoreColors XStoreName
+ XStoreNamedColor XSync XTextExtents XTextWidth XTranslateCoordinates XUndefineCursor
+ XUngrabButton XUngrabKey XUngrabKeyboard XUngrabPointer XUngrabServer XUninstallColormap
+ XUnloadFont XUnmapSubwindows XUnmapWindow XVendorRelease XWarpPointer XWidthMMOfScreen
+ XWidthOfScreen XWindowEvent XWriteBitmapFile XSupportsLocale XSetLocaleModifiers XCreateFontSet
+ XFreeFontSet XFontsOfFontSet XBaseFontNameListOfFontSet XLocaleOfFontSet XContextDependentDrawing
+ XDirectionalDependentDrawing XContextualDrawing XFilterEvent XAllocIconSize
+ XAllocStandardColormap XAllocWMHints XClipBox XCreateRegion XDefaultString XDeleteContext
+ XDestroyRegion XEmptyRegion XEqualRegion ;XFindContext
+ XGetIconSizes XGetRGBColormaps
+ XGetVisualInfo XGetWMHints XIntersectRegion XConvertCase XLookupString
+ XMatchVisualInfo XOffsetRegion XPointInRegion XPolygonRegion XRectInRegion XSaveContext
+ XSetRGBColormaps XSetWMHints XSetRegion XShrinkRegion XSubtractRegion
+ XUnionRectWithRegion XUnionRegion XXorRegion DefaultScreen DefaultRootWindow QLength
+ ScreenCount ServerVendor ProtocolVersion ProtocolRevision VendorRelease DisplayString
+ BitmapUnit BitmapBitOrder BitmapPad ImageByteOrder NextRequest LastKnownRequestProcessed
+ DefaultScreenOfDisplay DisplayOfScreen RootWindowOfScreen BlackPixelOfScreen WhitePixelOfScreen
+ DefaultColormapOfScreen DefaultDepthOfScreen DefaultGCOfScreen DefaultVisualOfScreen
+ WidthOfScreen HeightOfScreen WidthMMOfScreen HeightMMOfScreen PlanesOfScreen CellsOfScreen
+ MinCmapsOfScreen MaxCmapsOfScreen DoesSaveUnders DoesBackingStore EventMaskOfScreen RootWindow
+ DefaultVisual DefaultGC BlackPixel WhitePixel DisplayWidth DisplayHeight DisplayWidthMM
+ DisplayHeightMM DisplayPlanes DisplayCells DefaultColormap ScreenOfDisplay DefaultDepth
+ IsKeypadKey IsPrivateKeypadKey IsCursorKey IsPFKey IsFunctionKey IsMiscFunctionKey
+ IsModifierKey XmCreateMessageBox XmCreateMessageDialog XmCreateErrorDialog
+ XmCreateInformationDialog XmCreateQuestionDialog XmCreateWarningDialog XmCreateWorkingDialog
+ XmCreateTemplateDialog XmMessageBoxGetChild XmCreateArrowButtonGadget XmCreateArrowButton
+ XmCreateNotebook XmNotebookGetPageInfo
+ XmTransferSetParameters XmTransferValue XmCreateComboBox
+ XmCreateDropDownComboBox XmCreateDropDownList XmComboBoxAddItem XmComboBoxDeletePos
+ XmComboBoxSelectItem XmComboBoxSetItem XmComboBoxUpdate XmCreateContainer
+ XmContainerGetItemChildren XmContainerRelayout XmContainerReorder XmContainerCut XmContainerCopy
+ XmContainerPaste XmContainerCopyLink XmContainerPasteLink XmCreateSpinBox
+ XmSpinBoxValidatePosition XmCreateSimpleSpinBox XmSimpleSpinBoxAddItem XmSimpleSpinBoxDeletePos
+ XmSimpleSpinBoxSetItem XmDropSiteRegistered XmTextFieldCopyLink XmTextFieldPasteLink
+ XmTextGetCenterline XmToggleButtonGadgetSetValue XmCreateIconGadget
+ XmCreateIconHeader XmObjectAtPoint XmConvertStringToUnits XmCreateGrabShell
+ XmToggleButtonSetValue XmTextPasteLink XmTextCopyLink XmScaleSetTicks XmInternAtom XmGetAtomName
+ XmCreatePanedWindow XmCreateBulletinBoard XmCreateBulletinBoardDialog XmCreateCascadeButtonGadget
+ XmCascadeButtonGadgetHighlight XmAddProtocols XmRemoveProtocols XmAddProtocolCallback
+ XmRemoveProtocolCallback XmActivateProtocol XmDeactivateProtocol XmSetProtocolHooks
+ XmCreateCascadeButton XmCascadeButtonHighlight XmCreatePushButtonGadget XmCreatePushButton
+ XmCreateCommand XmCommandGetChild XmCommandSetValue XmCommandAppendValue XmCommandError
+ XmCreateCommandDialog XmMenuPosition XmCreateRowColumn XmCreateWorkArea XmCreateRadioBox
+ XmCreateOptionMenu XmOptionLabelGadget XmOptionButtonGadget XmCreateMenuBar XmCreatePopupMenu
+ XmCreatePulldownMenu XmGetPostedFromWidget XmGetTearOffControl
+ XmScaleSetValue XmScaleGetValue XmCreateScale
+ XmClipboardStartCopy XmClipboardCopy XmClipboardEndCopy XmClipboardCancelCopy
+ XmClipboardWithdrawFormat XmClipboardCopyByName XmClipboardUndoCopy XmClipboardLock
+ XmClipboardUnlock XmClipboardStartRetrieve XmClipboardEndRetrieve XmClipboardRetrieve
+ XmClipboardInquireCount XmClipboardInquireFormat XmClipboardInquireLength
+ XmClipboardInquirePendingItems XmClipboardRegisterFormat XmGetXmScreen XmCreateScrollBar
+ XmScrollBarGetValues XmScrollBarSetValues XmCreateDialogShell
+ XmCreateScrolledWindow XmScrollVisible XmGetDragContext XmGetXmDisplay XmSelectionBoxGetChild
+ XmCreateSelectionBox XmCreateSelectionDialog XmCreatePromptDialog XmDragStart XmDragCancel
+ XmTargetsAreCompatible XmCreateSeparatorGadget XmCreateDragIcon XmCreateSeparator
+ XmCreateDrawingArea XmCreateDrawnButton XmDropSiteRegister XmDropSiteUnregister
+ XmDropSiteStartUpdate XmDropSiteUpdate XmDropSiteEndUpdate XmDropSiteRetrieve
+ XmDropSiteQueryStackingOrder XmDropSiteConfigureStackingOrder XmDropTransferStart
+ XmDropTransferAdd XmTextFieldGetString XmTextFieldGetSubstring XmTextFieldGetLastPosition
+ XmTextFieldSetString XmTextFieldReplace XmTextFieldInsert XmTextFieldSetAddMode
+ XmTextFieldGetAddMode XmTextFieldGetEditable XmTextFieldSetEditable XmTextFieldGetMaxLength
+ XmTextFieldSetMaxLength XmTextFieldGetCursorPosition XmTextFieldGetInsertionPosition
+ XmTextFieldSetCursorPosition XmTextFieldSetInsertionPosition XmTextFieldGetSelectionPosition
+ XmTextFieldGetSelection XmTextFieldRemove XmTextFieldCopy XmTextFieldCut XmTextFieldPaste
+ XmTextFieldClearSelection XmTextFieldSetSelection XmTextFieldXYToPos XmTextFieldPosToXY
+ XmTextFieldShowPosition XmTextFieldSetHighlight XmTextFieldGetBaseline XmCreateTextField
+ XmFileSelectionBoxGetChild XmFileSelectionDoSearch XmCreateFileSelectionBox
+ XmCreateFileSelectionDialog XmTextSetHighlight XmCreateScrolledText XmCreateText
+ XmTextGetSubstring XmTextGetString XmTextGetLastPosition XmTextSetString XmTextReplace
+ XmTextInsert XmTextSetAddMode XmTextGetAddMode XmTextGetEditable XmTextSetEditable
+ XmTextGetMaxLength XmTextSetMaxLength XmTextGetTopCharacter XmTextSetTopCharacter
+ XmTextGetCursorPosition XmTextGetInsertionPosition XmTextSetInsertionPosition
+ XmTextSetCursorPosition XmTextRemove XmTextCopy XmTextCut XmTextPaste XmTextGetSelection
+ XmTextSetSelection XmTextClearSelection XmTextGetSelectionPosition XmTextXYToPos XmTextPosToXY
+ XmTextGetSource XmTextSetSource XmTextShowPosition XmTextScroll XmTextGetBaseline
+ XmTextDisableRedisplay XmTextEnableRedisplay XmTextFindString XmCreateForm XmCreateFormDialog
+ XmCreateFrame XmToggleButtonGadgetGetState XmToggleButtonGadgetSetState XmCreateToggleButtonGadget
+ XmToggleButtonGetState XmToggleButtonSetState XmCreateToggleButton XmCreateLabelGadget
+ XmCreateLabel XmIsMotifWMRunning XmListAddItem XmListAddItems XmListAddItemsUnselected
+ XmListAddItemUnselected XmListDeleteItem XmListDeleteItems XmListDeletePositions XmListDeletePos
+ XmListDeleteItemsPos XmListDeleteAllItems XmListReplaceItems XmListReplaceItemsPos
+ XmListReplaceItemsUnselected XmListReplaceItemsPosUnselected XmListReplacePositions
+ XmListSelectItem XmListSelectPos XmListDeselectItem XmListDeselectPos XmListDeselectAllItems
+ XmListSetPos XmListSetBottomPos XmListSetItem XmListSetBottomItem XmListSetAddMode
+ XmListItemExists XmListItemPos XmListGetKbdItemPos XmListSetKbdItemPos XmListYToPos
+ XmListPosToBounds XmListGetMatchPos XmListGetSelectedPos XmListSetHorizPos
+ XmListUpdateSelectedList XmListPosSelected XmCreateList XmCreateScrolledList XmTranslateKey
+ XmInstallImage XmUninstallImage XmGetPixmap XmGetPixmapByDepth XmDestroyPixmap XmUpdateDisplay
+ XmWidgetGetBaselines XmRegisterSegmentEncoding XmMapSegmentEncoding
+ XmCvtCTToXmString XmCvtXmStringToCT XmConvertUnits
+ XmCreateSimpleMenuBar XmCreateSimplePopupMenu XmCreateSimplePulldownMenu
+ XmCreateSimpleOptionMenu XmCreateSimpleRadioBox XmCreateSimpleCheckBox XmVaCreateSimpleMenuBar
+ XmVaCreateSimplePopupMenu XmVaCreateSimplePulldownMenu XmVaCreateSimpleOptionMenu
+ XmVaCreateSimpleRadioBox XmVaCreateSimpleCheckBox XmTrackingEvent
+ XmSetColorCalculation XmGetColorCalculation XmGetColors XmChangeColor XmStringCreate
+ XmStringCreateLocalized XmStringDirectionCreate XmStringSeparatorCreate
+ XmStringInitContext
+ XmStringFreeContext
+ XmStringConcatAndFree XmStringIsVoid XmStringPeekNextTriple XmStringGetNextTriple
+ XmStringComponentCreate XmStringUnparse XmStringParseText XmStringToXmStringTable
+ XmStringTableToXmString XmStringTableUnparse XmStringTableParseStringArray
+ XmDirectionToStringDirection XmStringDirectionToDirection XmStringGenerate XmStringPutRendition
+ XmParseMappingGetValues XmParseMappingFree XmParseTableFree XmStringTableProposeTablist
+ XmTabSetValue XmTabGetValues XmTabFree XmTabCreate XmTabListTabCount XmTabListRemoveTabs
+ XmTabListReplacePositions XmTabListGetTab XmTabListCopy XmTabListInsertTabs
+ ; XmRenderTableCvtFromProp XmRenderTableCvtToProp XmRenditionUpdate XmRenditionRetrieve
+ XmRenditionFree XmRenditionCreate XmRenderTableGetRenditions XmRenderTableGetRendition
+ XmRenderTableGetTags XmRenderTableFree XmRenderTableCopy XmRenderTableRemoveRenditions
+ XmRenderTableAddRenditions
+ XmStringEmpty XmStringHasSubstring XmStringFree XmStringBaseline XmStringWidth XmStringHeight
+ XmStringExtent XmStringLineCount XmStringDraw XmStringDrawImage XmStringDrawUnderline
+ XmGetDestination XmIsTraversable XmGetVisibility XmGetTabGroup XmGetFocusWidget
+ XmProcessTraversal XmCreateMenuShell XmIsMessageBox
+ XmIsArrowButtonGadget XmIsArrowButton XmIsNotebook XmIsComboBox XmIsContainer
+ XmIsGrabShell XmIsIconGadget XmIsIconHeader XmIsPanedWindow XmIsBulletinBoard XmIsPrimitive
+ XmIsCascadeButtonGadget XmIsCascadeButton XmIsPushButtonGadget XmIsPushButton XmIsCommand
+ XmIsRowColumn XmIsScale XmIsScreen XmIsScrollBar XmIsDialogShell XmIsScrolledWindow XmIsDisplay
+ XmIsSelectionBox XmIsDragContext XmIsSeparatorGadget XmIsDragIconObjectClass
+ XmIsSeparator XmIsDrawingArea XmIsDrawnButton XmIsDropSiteManager XmIsDropTransfer XmIsTextField
+ XmIsFileSelectionBox XmIsText XmIsForm XmIsFrame XmIsGadget XmIsToggleButtonGadget
+ XmIsToggleButton XmIsLabelGadget XmIsLabel XmIsVendorShell XmIsList XmIsManager
+ XmIsMenuShell XGetPixel XDestroyImage XPutPixel XSubImage XAddPixel
+ XtAppContext? XtRequestId? XtWorkProcId? XtInputId? XtIntervalId? Screen? XEvent?
+ XRectangle? XArc? XPoint? XSegment? XColor? Atom? Colormap?
+ XModifierKeymap? Depth? Display? Drawable? Font? GC? KeySym? Pixel? Pixmap? Region?
+ Time? Visual? Window? XFontProp? XFontSet? XFontStruct? XGCValues? XImage? XVisualInfo?
+ XWMHints? XWindowAttributes? XWindowChanges? KeyCode? XContext? XCharStruct? XTextItem?
+ Widget? XmStringContext? WidgetClass? XmString?
+ XmToggleButton? XmDrawingArea? XmPushButton? XmTextField? XmFileSelectionBox? XmText?
+ XmFrame? XmLabel? XmList? XmArrowButton? XmScrollBar? XmCommand? XmScale? XmRowColumn?
+ XmTab? XmNotebook? XmComboBox? XmContainer? XmIconHeader?
+ XmGrabShell? XmRendition? XmRenderTable? XmIconGadget? XmTabList? XmParseMapping?
+ XmPanedWindow? XmScrolledWindow? XmCascadeButton? XmForm? XmBulletinBoard? XmScreen?
+ XmDialogShell? XmDisplay? XmSelectionBox? XmDragContext? XmDragIconObjectClass? XmSeparator?
+ XmDropSiteManager? XmDropTransfer? XmVendorShell? XmMessageBox? XmManager?
+ XmMenuShell? XmLabelGadget? XmPushButtonGadget? XmSeparatorGadget? XmArrowButtonGadget?
+ XmCascadeButtonGadget? XmToggleButtonGadget? XmDrawnButton? XmPrimitive?
+ XmTextSource?
+ ))
+ (xm-procs (if (defined? 'XpmImage?)
+ (append xm-procs-1
+ (list
+ XpmCreatePixmapFromData XpmCreateDataFromPixmap XpmReadFileToPixmap
+ XpmReadPixmapFile XpmWriteFileFromPixmap XpmWritePixmapFile XpmCreatePixmapFromXpmImage
+ XpmCreateXpmImageFromPixmap XpmAttributes? XpmImage? XpmColorSymbol?))
+ xm-procs-1))
+ (xm-procs0 (remove-if (lambda (n) (not (arity-ok n 0))) xm-procs))
+ (xm-procs1 (remove-if (lambda (n) (not (arity-ok n 1))) xm-procs))
+ (xm-procs2 (remove-if (lambda (n) (not (arity-ok n 2))) xm-procs))
+ (xm-procs3 (remove-if (lambda (n) (not (arity-ok n 3))) xm-procs))
+ (xm-procs4 (remove-if (lambda (n) (not (arity-ok n 4))) xm-procs))
+ )
+
+ ;; ---------------- 0 Args
+ (for-each
+ (lambda (n)
+ (catch #t
+ (lambda ()
+ (n))
+ (lambda args (car args))))
+ xm-procs0)
+
+ ;; ---------------- 1 Arg
+ (for-each
+ (lambda (arg)
(for-each
(lambda (n)
(catch #t
- (lambda ()
- (n))
+ (lambda () (n arg))
(lambda args (car args))))
- xm-procs0)
-
- ;; ---------------- 1 Arg
+ xm-procs1))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4 'mus-error (sqrt -1.0) (make-delay 32)
+ (lambda () #t) (current-environment) (make-sound-data 2 3) :order 0 1 -1 (make-hook 2) #f #t '() (make-vector 0)))
+
+ ;; ---------------- 2 Args
+ (for-each
+ (lambda (arg1)
(for-each
- (lambda (arg)
+ (lambda (arg2)
(for-each
(lambda (n)
(catch #t
- (lambda () (n arg))
+ (lambda () (n arg1 arg2))
(lambda args (car args))))
- xm-procs1))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4 'mus-error (sqrt -1.0) (make-delay 32)
- (lambda () #t) (current-environment) (make-sound-data 2 3) :order 0 1 -1 (make-hook 2) #f #t '() (make-vector 0)))
-
- ;; ---------------- 2 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (n)
- (catch #t
- (lambda () (n arg1 arg2))
- (lambda args (car args))))
- xm-procs2))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4
- (sqrt -1.0) (make-delay 32) :feedback -1 0 #f #t '() (make-vector 0))))
+ xm-procs2))
(list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4
- (sqrt -1.0) (make-delay 32) :frequency -1 0 #f #t '() (make-vector 0)))
-
- (if all-args
- (begin
-
- ;; ---------------- 3 Args
+ (sqrt -1.0) (make-delay 32) :feedback -1 0 #f #t '() (make-vector 0))))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4
+ (sqrt -1.0) (make-delay 32) :frequency -1 0 #f #t '() (make-vector 0)))
+
+ (if all-args
+ (begin
+
+ ;; ---------------- 3 Args
+ (for-each
+ (lambda (arg1)
(for-each
- (lambda (arg1)
+ (lambda (arg2)
(for-each
- (lambda (arg2)
+ (lambda (arg3)
(for-each
- (lambda (arg3)
- (for-each
- (lambda (n)
- (catch #t
- (lambda () (n arg1 arg2 arg3))
- (lambda args (car args))))
- xm-procs3))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) (sqrt -1.0) (make-delay 32)
- :start -1 0 #f #t '() (make-vector 0))))
+ (lambda (n)
+ (catch #t
+ (lambda () (n arg1 arg2 arg3))
+ (lambda args (car args))))
+ xm-procs3))
(list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) (sqrt -1.0) (make-delay 32)
- :phase -1 0 #f #t '() (make-vector 0))))
+ :start -1 0 #f #t '() (make-vector 0))))
(list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) (sqrt -1.0) (make-delay 32)
- :channels -1 0 #f #t '() (make-vector 0)))
- ))
-
- (let* ((struct-accessors-1
- (list .pixel .red .green .blue .flags .pad .x .y .width .height .angle1 .angle2 .ptr
- .x1 .y1 .x2 .y2 .dashes .dash_offset .clip_mask .clip_y_origin .clip_x_origin .graphics_exposures
- .subwindow_mode .font .ts_y_origin .ts_x_origin .stipple .tile .arc_mode .fill_rule .fill_style
- .join_style .cap_style .line_style .line_width .background .foreground .plane_mask .function .delta
- .nchars .chars .name .depth .visual .mwidth .mheight .ndepths .depths .root_depth .root_visual
- .default_gc .cmap .white_pixel .black_pixel .max_maps .min_maps .backing_store .save_unders .root_input_mask
- .lbearing .rbearing .ascent .descent .attributes .card32 .fid .properties .min_bounds .max_bounds .per_char
- .input .initial_state .icon_pixmap .icon_window .icon_x .icon_y .icon_mask .window_group .visualid
- .class .red_mask .green_mask .blue_mask .bits_per_rgb .map_entries .nvisuals .visuals .bits_per_pixel
- .background_pixmap .background_pixel .border_pixmap .border_pixel .bit_gravity .win_gravity .backing_planes
- .backing_pixel .save_under .event_mask .do_not_propagate_mask .cursor .map_installed .map_state .all_event_masks
- .your_event_mask .screen .xoffset .byte_order .bitmap_unit .bitmap_bit_order .bitmap_pad .bytes_per_line
- .obdata .sibling .stack_mode .red_max .red_mult .green_max .green_mult .blue_max .blue_mult .base_pixel
- .killid .data .min_height .max_height .min_width .max_width .height_inc .width_inc .page_number
- .page_widget .status_area_widget .major_tab_widget .minor_tab_widget .source_data .location_data .parm
- .parm_format .parm_length .parm_type .transfer_id .destination_data .remaining .item_or_text .auto_selection_type
- .new_outline_state .prev_page_number .prev_page_widget .rendition .render_table
+ :phase -1 0 #f #t '() (make-vector 0))))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) (sqrt -1.0) (make-delay 32)
+ :channels -1 0 #f #t '() (make-vector 0)))
+ ))
+
+ (let* ((struct-accessors-1
+ (list .pixel .red .green .blue .flags .pad .x .y .width .height .angle1 .angle2 .ptr
+ .x1 .y1 .x2 .y2 .dashes .dash_offset .clip_mask .clip_y_origin .clip_x_origin .graphics_exposures
+ .subwindow_mode .font .ts_y_origin .ts_x_origin .stipple .tile .arc_mode .fill_rule .fill_style
+ .join_style .cap_style .line_style .line_width .background .foreground .plane_mask .function .delta
+ .nchars .chars .name .depth .visual .mwidth .mheight .ndepths .depths .root_depth .root_visual
+ .default_gc .cmap .white_pixel .black_pixel .max_maps .min_maps .backing_store .save_unders .root_input_mask
+ .lbearing .rbearing .ascent .descent .attributes .card32 .fid .properties .min_bounds .max_bounds .per_char
+ .input .initial_state .icon_pixmap .icon_window .icon_x .icon_y .icon_mask .window_group .visualid
+ .class .red_mask .green_mask .blue_mask .bits_per_rgb .map_entries .nvisuals .visuals .bits_per_pixel
+ .background_pixmap .background_pixel .border_pixmap .border_pixel .bit_gravity .win_gravity .backing_planes
+ .backing_pixel .save_under .event_mask .do_not_propagate_mask .cursor .map_installed .map_state .all_event_masks
+ .your_event_mask .screen .xoffset .byte_order .bitmap_unit .bitmap_bit_order .bitmap_pad .bytes_per_line
+ .obdata .sibling .stack_mode .red_max .red_mult .green_max .green_mult .blue_max .blue_mult .base_pixel
+ .killid .data .min_height .max_height .min_width .max_width .height_inc .width_inc .page_number
+ .page_widget .status_area_widget .major_tab_widget .minor_tab_widget .source_data .location_data .parm
+ .parm_format .parm_length .parm_type .transfer_id .destination_data .remaining .item_or_text .auto_selection_type
+ .new_outline_state .prev_page_number .prev_page_widget .rendition .render_table
; .last_page
- .crossed_boundary
- .client_data .status .font_name .tag .traversal_destination .dragProtocolStyle .direction .reason
- .timeStamp .operation .operations .dropSiteStatus .dropAction .iccHandle .completionStatus .dragContext
- .animate .length .click_count .widget .item_position .callbackstruct
- .set .item .item_length .selected_items .selected_item_count .selected_item_positions .selection_type
- .mask .mask_length .dir .dir_length .pattern .pattern_length .position .currInsert .newInsert .startPos
- .endPos .text .request_code .error_code .first_keycode .request .resourceid .format .message_type .new
- .property .display .target .requestor .owner .selection .atom .place .value_mask .above .from_configure
- .event .override_redirect .border_width .parent .minor_code .major_code .drawable .count .key_vector .focus
- .detail .mode .is_hint .button .same_screen .keycode .state .y_root .x_root .root .time .subwindow .window
- .send_event .serial .type .value .doit .colormap .menuToPost .postIt))
- (struct-accessors (if (defined? 'XpmImage?)
- (append struct-accessors-1
- (list .valuemask .ncolors .cpp .numsymbols .colorsymbols .npixels
- .y_hotspot .x_hotspot .colormap_size))
- struct-accessors-1))
-
- (struct-accessor-names-1
- (list '.pixel '.red '.green '.blue '.flags '.pad '.x '.y '.width '.height '.angle1 '.angle2 '.ptr
- '.x1 '.y1 '.x2 '.y2 '.dashes '.dash_offset '.clip_mask '.clip_y_origin '.clip_x_origin '.graphics_exposures
- '.subwindow_mode '.font '.ts_y_origin '.ts_x_origin '.stipple '.tile '.arc_mode '.fill_rule '.fill_style
- '.join_style '.cap_style '.line_style '.line_width '.background '.foreground '.plane_mask '.function '.delta
- '.nchars '.chars '.name '.depth '.visual '.mwidth '.mheight '.ndepths '.depths '.root_depth '.root_visual
- '.default_gc '.cmap '.white_pixel '.black_pixel '.max_maps '.min_maps '.backing_store '.save_unders '.root_input_mask
- '.lbearing '.rbearing '.ascent '.descent '.attributes '.card32 '.fid '.properties '.min_bounds '.max_bounds '.per_char
- '.input '.initial_state '.icon_pixmap '.icon_window '.icon_x '.icon_y '.icon_mask '.window_group '.visualid
- '.class '.red_mask '.green_mask '.blue_mask '.bits_per_rgb '.map_entries '.nvisuals '.visuals '.bits_per_pixel
- '.background_pixmap '.background_pixel '.border_pixmap '.border_pixel '.bit_gravity '.win_gravity '.backing_planes
- '.backing_pixel '.save_under '.event_mask '.do_not_propagate_mask '.cursor '.map_installed '.map_state '.all_event_masks
- '.your_event_mask '.screen '.xoffset '.byte_order '.bitmap_unit '.bitmap_bit_order '.bitmap_pad '.bytes_per_line
- '.obdata '.sibling '.stack_mode '.red_max '.red_mult '.green_max '.green_mult '.blue_max '.blue_mult '.base_pixel
- '.killid '.data '.min_height '.max_height '.min_width '.max_width '.height_inc '.width_inc '.page_number
- '.page_widget '.status_area_widget '.major_tab_widget '.minor_tab_widget '.source_data '.location_data '.parm
- '.parm_format '.parm_length '.parm_type '.transfer_id '.destination_data '.remaining '.item_or_text '.auto_selection_type
- '.new_outline_state '.prev_page_number '.prev_page_widget '.rendition '.render_table
+ .crossed_boundary
+ .client_data .status .font_name .tag .traversal_destination .dragProtocolStyle .direction .reason
+ .timeStamp .operation .operations .dropSiteStatus .dropAction .iccHandle .completionStatus .dragContext
+ .animate .length .click_count .widget .item_position .callbackstruct
+ .set .item .item_length .selected_items .selected_item_count .selected_item_positions .selection_type
+ .mask .mask_length .dir .dir_length .pattern .pattern_length .position .currInsert .newInsert .startPos
+ .endPos .text .request_code .error_code .first_keycode .request .resourceid .format .message_type .new
+ .property .display .target .requestor .owner .selection .atom .place .value_mask .above .from_configure
+ .event .override_redirect .border_width .parent .minor_code .major_code .drawable .count .key_vector .focus
+ .detail .mode .is_hint .button .same_screen .keycode .state .y_root .x_root .root .time .subwindow .window
+ .send_event .serial .type .value .doit .colormap .menuToPost .postIt))
+ (struct-accessors (if (defined? 'XpmImage?)
+ (append struct-accessors-1
+ (list .valuemask .ncolors .cpp .numsymbols .colorsymbols .npixels
+ .y_hotspot .x_hotspot .colormap_size))
+ struct-accessors-1))
+
+ (struct-accessor-names-1
+ (list '.pixel '.red '.green '.blue '.flags '.pad '.x '.y '.width '.height '.angle1 '.angle2 '.ptr
+ '.x1 '.y1 '.x2 '.y2 '.dashes '.dash_offset '.clip_mask '.clip_y_origin '.clip_x_origin '.graphics_exposures
+ '.subwindow_mode '.font '.ts_y_origin '.ts_x_origin '.stipple '.tile '.arc_mode '.fill_rule '.fill_style
+ '.join_style '.cap_style '.line_style '.line_width '.background '.foreground '.plane_mask '.function '.delta
+ '.nchars '.chars '.name '.depth '.visual '.mwidth '.mheight '.ndepths '.depths '.root_depth '.root_visual
+ '.default_gc '.cmap '.white_pixel '.black_pixel '.max_maps '.min_maps '.backing_store '.save_unders '.root_input_mask
+ '.lbearing '.rbearing '.ascent '.descent '.attributes '.card32 '.fid '.properties '.min_bounds '.max_bounds '.per_char
+ '.input '.initial_state '.icon_pixmap '.icon_window '.icon_x '.icon_y '.icon_mask '.window_group '.visualid
+ '.class '.red_mask '.green_mask '.blue_mask '.bits_per_rgb '.map_entries '.nvisuals '.visuals '.bits_per_pixel
+ '.background_pixmap '.background_pixel '.border_pixmap '.border_pixel '.bit_gravity '.win_gravity '.backing_planes
+ '.backing_pixel '.save_under '.event_mask '.do_not_propagate_mask '.cursor '.map_installed '.map_state '.all_event_masks
+ '.your_event_mask '.screen '.xoffset '.byte_order '.bitmap_unit '.bitmap_bit_order '.bitmap_pad '.bytes_per_line
+ '.obdata '.sibling '.stack_mode '.red_max '.red_mult '.green_max '.green_mult '.blue_max '.blue_mult '.base_pixel
+ '.killid '.data '.min_height '.max_height '.min_width '.max_width '.height_inc '.width_inc '.page_number
+ '.page_widget '.status_area_widget '.major_tab_widget '.minor_tab_widget '.source_data '.location_data '.parm
+ '.parm_format '.parm_length '.parm_type '.transfer_id '.destination_data '.remaining '.item_or_text '.auto_selection_type
+ '.new_outline_state '.prev_page_number '.prev_page_widget '.rendition '.render_table
; '.last_page
- '.crossed_boundary
- '.client_data '.status '.font_name '.tag '.traversal_destination '.dragProtocolStyle '.direction '.reason
- '.timeStamp '.operation '.operations '.dropSiteStatus '.dropAction '.iccHandle '.completionStatus '.dragContext
- '.animate '.length '.click_count '.widget '.item_position '.callbackstruct
- '.set '.item '.item_length '.selected_items '.selected_item_count '.selected_item_positions '.selection_type
- '.mask '.mask_length '.dir '.dir_length '.pattern '.pattern_length '.position '.currInsert '.newInsert '.startPos
- '.endPos '.text '.request_code '.error_code '.first_keycode '.request '.resourceid '.format '.message_type '.new
- '.property '.display '.target '.requestor '.owner '.selection '.atom '.place '.value_mask '.above '.from_configure
- '.event '.override_redirect '.border_width '.parent '.minor_code '.major_code '.drawable '.count '.key_vector '.focus
- '.detail '.mode '.is_hint '.button '.same_screen '.keycode '.state '.y_root '.x_root '.root '.time '.subwindow '.window
- '.send_event '.serial '.type '.value '.doit '.colormap '.menuToPost '.postIt))
- (struct-accessor-names (if (defined? 'XpmImage?)
- (append struct-accessor-names-1
- (list '.valuemask '.ncolors '.cpp
- '.numsymbols '.colorsymbols '.npixels '.y_hotspot '.x_hotspot '.colormap_size))
- struct-accessor-names-1))
- (dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets)))))
-
- ;; ---------------- 0 Args
+ '.crossed_boundary
+ '.client_data '.status '.font_name '.tag '.traversal_destination '.dragProtocolStyle '.direction '.reason
+ '.timeStamp '.operation '.operations '.dropSiteStatus '.dropAction '.iccHandle '.completionStatus '.dragContext
+ '.animate '.length '.click_count '.widget '.item_position '.callbackstruct
+ '.set '.item '.item_length '.selected_items '.selected_item_count '.selected_item_positions '.selection_type
+ '.mask '.mask_length '.dir '.dir_length '.pattern '.pattern_length '.position '.currInsert '.newInsert '.startPos
+ '.endPos '.text '.request_code '.error_code '.first_keycode '.request '.resourceid '.format '.message_type '.new
+ '.property '.display '.target '.requestor '.owner '.selection '.atom '.place '.value_mask '.above '.from_configure
+ '.event '.override_redirect '.border_width '.parent '.minor_code '.major_code '.drawable '.count '.key_vector '.focus
+ '.detail '.mode '.is_hint '.button '.same_screen '.keycode '.state '.y_root '.x_root '.root '.time '.subwindow '.window
+ '.send_event '.serial '.type '.value '.doit '.colormap '.menuToPost '.postIt))
+ (struct-accessor-names (if (defined? 'XpmImage?)
+ (append struct-accessor-names-1
+ (list '.valuemask '.ncolors '.cpp
+ '.numsymbols '.colorsymbols '.npixels '.y_hotspot '.x_hotspot '.colormap_size))
+ struct-accessor-names-1))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets)))))
+
+ ;; ---------------- 0 Args
+ (for-each
+ (lambda (n name)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-number-of-args))
+ (snd-display #__line__ ";(~A) -> ~A" name tag)))
+ (if (procedure-with-setter? n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (set! (n) 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-number-of-args))
+ (snd-display #__line__ ";(~A) -> ~A" name tag)))))
+ struct-accessors
+ struct-accessor-names)
+
+ ;; ---------------- 1 Arg
+ (for-each
+ (lambda (arg)
(for-each
(lambda (n name)
- (let ((tag
+ (let ((tag
(catch #t
- (lambda ()
- (n))
+ (lambda () (n arg))
(lambda args (car args)))))
- (if (not (eq? tag 'wrong-number-of-args))
- (snd-display ";(~A) -> ~A" name tag)))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";(~A ~A) -> ~A" name arg tag)))
(if (procedure-with-setter? n)
- (let ((tag
- (catch #t
- (lambda ()
- (set! (n) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-number-of-args))
- (snd-display ";(~A) -> ~A" name tag)))))
+ (begin
+ (let ((tag
+ (catch #t
+ (lambda () (set! (n arg) 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";(~A ~A) -> ~A" name arg tag)))
+ (let ((tag
+ (catch #t
+ (lambda () (set! (n 0) arg))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";(set ~A ~A) -> ~A" name arg tag))))))
struct-accessors
- struct-accessor-names)
-
- ;; ---------------- 1 Arg
- (for-each
- (lambda (arg)
- (for-each
- (lambda (n name)
- (let ((tag
- (catch #t
- (lambda () (n arg))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";(~A ~A) -> ~A" name arg tag)))
- (if (procedure-with-setter? n)
- (begin
- (let ((tag
- (catch #t
- (lambda () (set! (n arg) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";(~A ~A) -> ~A" name arg tag)))
- (let ((tag
- (catch #t
- (lambda () (set! (n 0) arg))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display ";(set ~A ~A) -> ~A" name arg tag))))))
- struct-accessors
- struct-accessor-names))
- (list dpy win '(Atom 0) '(Colormap 0) 1.5 "/hiho" 1234 #f #\c '(Time 0) '(Font 0) (make-vector 0) '(Cursor 1))))
- )
- (show-sounds-in-directory)
+ struct-accessor-names))
+ (list dpy win '(Atom 0) '(Colormap 0) 1.5 "/hiho" 1234 #f #\c '(Time 0) '(Font 0) (make-vector 0) '(Cursor 1))))
+ )
+ (show-sounds-in-directory)
;(show-all-atoms)
- )))
+ )))
@@ -61102,18 +61199,18 @@ EDITS: 1
(if (and (provided? 'snd-gtk)
(provided? 'xg))
(let ((ind (open-sound "oboe.snd")))
- (if (not (GTK_IS_WIDGET (cadr (main-widgets)))) (snd-display ";GTK_IS_WIDGET?"))
+ (if (not (GTK_IS_WIDGET (cadr (main-widgets)))) (snd-display #__line__ ";GTK_IS_WIDGET?"))
;; all gtk proc names are in gtk-procs.scm
- (if (not (GTK_IS_ENTRY (list-ref (sound-widgets) 3))) (snd-display ";GTK_IS_ENTRY?"))
+ (if (not (GTK_IS_ENTRY (list-ref (sound-widgets) 3))) (snd-display #__line__ ";GTK_IS_ENTRY?"))
(let* ((win (car (main-widgets)))
(vals (gdk_property_get win (gdk_atom_intern "SND_VERSION" #f) GDK_TARGET_STRING 0 1024 0))
(str (list-ref vals 4)))
(if (or (not str)
(not (string=? (snd-version) str)))
- (snd-display ";SND_VERSION: ~A ~A" str (snd-version))))
+ (snd-display #__line__ ";SND_VERSION: ~A ~A" str (snd-version))))
(if (not (string=? "STRING" (gdk_atom_name GDK_TARGET_STRING)))
- (snd-display ";gdk_atom_name: ~A" (gdk_atom_name GDK_TARGET_STRING)))
+ (snd-display #__line__ ";gdk_atom_name: ~A" (gdk_atom_name GDK_TARGET_STRING)))
(close-sound ind)
@@ -61123,7 +61220,7 @@ EDITS: 1
(checker (cadr data))
(name (caddr data))
(w (creator)))
- (if (not (checker w)) (snd-display ";~A: ~A?" name w))))
+ (if (not (checker w)) (snd-display #__line__ ";~A: ~A?" name w))))
(list
(list (lambda () (gtk_vbox_new #t 0)) GTK_IS_VBOX 'GTK_IS_VBOX)
(list gtk_accel_group_new GTK_IS_ACCEL_GROUP 'GTK_IS_ACCEL_GROUP)
@@ -61186,41 +61283,41 @@ EDITS: 1
(let ((_gchar_ (gdk_set_locale)))
(let ((_gchar1_ (gtk_set_locale)))
(if (not (string=? _gchar_ _gchar1_))
- (snd-display ";*-set-locale: ~A ~A" _gchar_ _gchar1_))))
+ (snd-display #__line__ ";*-set-locale: ~A ~A" _gchar_ _gchar1_))))
(let ((_char_ (gdk_get_program_class)))
(if (or (not (string? _char_))
(not (string=? _char_ "Snd")))
- (snd-display ";get program class: ~A" _char_))
+ (snd-display #__line__ ";get program class: ~A" _char_))
(gdk_set_program_class "Hiho")
- (if (not (string=? (gdk_get_program_class) "Hiho")) (snd-display ";set program class: ~A" (gdk_get_program_class)))
+ (if (not (string=? (gdk_get_program_class) "Hiho")) (snd-display #__line__ ";set program class: ~A" (gdk_get_program_class)))
(gdk_set_program_class "Snd"))
- (if (not (string=? (gdk_get_display) ":0.0")) (snd-display ";gdk_get_display: ~A" (gdk_get_display)))
- (if (not (= (gdk_screen_width) 2560)) (snd-display ";gdk_screen_width: ~A" (gdk_screen_width)))
- (if (not (= (gdk_screen_width_mm) 644)) (snd-display ";gdk_screen_width_mm: ~A" (gdk_screen_width_mm)))
- (if (not (= (gdk_screen_height) 1600)) (snd-display ";gdk_screen_height: ~A" (gdk_screen_height)))
- (if (not (= (gdk_screen_height_mm) 402)) (snd-display ";gdk_screen_height_mm: ~A" (gdk_screen_height_mm)))
+ (if (not (string=? (gdk_get_display) ":0.0")) (snd-display #__line__ ";gdk_get_display: ~A" (gdk_get_display)))
+ (if (not (= (gdk_screen_width) 2560)) (snd-display #__line__ ";gdk_screen_width: ~A" (gdk_screen_width)))
+ (if (not (= (gdk_screen_width_mm) 644)) (snd-display #__line__ ";gdk_screen_width_mm: ~A" (gdk_screen_width_mm)))
+ (if (not (= (gdk_screen_height) 1600)) (snd-display #__line__ ";gdk_screen_height: ~A" (gdk_screen_height)))
+ (if (not (= (gdk_screen_height_mm) 402)) (snd-display #__line__ ";gdk_screen_height_mm: ~A" (gdk_screen_height_mm)))
(gdk_beep)
- (if (not (gtk_true)) (snd-display ";gtk_true: ~A" (gtk_true)))
- (if (gtk_false) (snd-display ";gtk_false: ~A" (gtk_false)))
- (if (gdk_pointer_is_grabbed) (snd-display ";gdk_pointer_is_grabbed?"))
- (if (not (gdk_list_visuals)) (snd-display ";gdk_list_visuals?"))
- (if (not (gtk_window_list_toplevels)) (snd-display ";gtk_window_list_toplevels?"))
+ (if (not (gtk_true)) (snd-display #__line__ ";gtk_true: ~A" (gtk_true)))
+ (if (gtk_false) (snd-display #__line__ ";gtk_false: ~A" (gtk_false)))
+ (if (gdk_pointer_is_grabbed) (snd-display #__line__ ";gdk_pointer_is_grabbed?"))
+ (if (not (gdk_list_visuals)) (snd-display #__line__ ";gdk_list_visuals?"))
+ (if (not (gtk_window_list_toplevels)) (snd-display #__line__ ";gtk_window_list_toplevels?"))
(gtk_window_set_default_icon_list (gtk_window_get_default_icon_list))
- (if (gdk_rgb_ditherable) (snd-display ";rgb ditherable?"))
- (if (not (= (gdk_visual_get_best_depth) 32)) (snd-display ";best depth: ~A" (gdk_visual_get_best_depth)))
- (if (not (string=? (gtk_rc_get_theme_dir) "/usr/local/share/themes")) (snd-display ";theme dir: ~A" (gtk_rc_get_theme_dir)))
+ (if (gdk_rgb_ditherable) (snd-display #__line__ ";rgb ditherable?"))
+ (if (not (= (gdk_visual_get_best_depth) 32)) (snd-display #__line__ ";best depth: ~A" (gdk_visual_get_best_depth)))
+ (if (not (string=? (gtk_rc_get_theme_dir) "/usr/local/share/themes")) (snd-display #__line__ ";theme dir: ~A" (gtk_rc_get_theme_dir)))
(if (and (not (string=? (gtk_rc_get_module_dir) "/usr/local/lib/gtk-2.0/2.4.0/engines"))
(not (string=? (gtk_rc_get_module_dir) "/usr/local/lib/gtk-2.0/2.10.0/engines")))
- (snd-display ";module dir: ~A" (gtk_rc_get_module_dir)))
- (if (not (string? (gtk_rc_get_im_module_path))) (snd-display ";module path: ~A" (gtk_rc_get_im_module_path)))
+ (snd-display #__line__ ";module dir: ~A" (gtk_rc_get_module_dir)))
+ (if (not (string? (gtk_rc_get_im_module_path))) (snd-display #__line__ ";module path: ~A" (gtk_rc_get_im_module_path)))
(if (not (string=? (gtk_rc_get_im_module_file) "/usr/local/etc/gtk-2.0/gtk.immodules"))
- (snd-display ";module file: ~A" (gtk_rc_get_im_module_path)))
+ (snd-display #__line__ ";module file: ~A" (gtk_rc_get_im_module_path)))
(let* ((_gchar__ (gtk_rc_get_default_files))
(files (c-array->list _gchar__ #f)))
(if (or (not (= (length files) 2))
(not (string? (car files))))
- (snd-display ";gtk rc def files: ~A" files)))
- (if (not (gtk_get_default_language)) (snd-display ";def lang: ~A" (gtk_get_default_language)))
+ (snd-display #__line__ ";gtk rc def files: ~A" files)))
+ (if (not (gtk_get_default_language)) (snd-display #__line__ ";def lang: ~A" (gtk_get_default_language)))
(let* ((_GdkColormap_ (gdk_colormap_get_system))
(_GdkVisual_ (gdk_colormap_get_visual _GdkColormap_))
@@ -61259,7 +61356,7 @@ EDITS: 1
(_GList1_ (gdk_screen_get_toplevel_windows _GdkScreen_))
(_gchar1_ (gdk_screen_make_display_name _GdkScreen_))
(_int6 (gdk_screen_get_n_monitors _GdkScreen_))
- (_GList2_ (gdk_display_list_devices _GdkDisplay_))
+; (_GList2_ (gdk_display_list_devices _GdkDisplay_))
(_guint (gdk_display_get_default_cursor_size _GdkDisplay_))
(_GtkWidget_ (gtk_check_button_new))
(_GdkColormap7_ (gtk_widget_get_colormap _GtkWidget_))
@@ -61274,40 +61371,40 @@ EDITS: 1
(if (or (not (equal? _GdkColormap_ _GdkColormap1_)) (not (equal? _GdkColormap_ _GdkColormap2_)) (not (equal? _GdkColormap_ _GdkColormap3_))
(not (equal? _GdkColormap_ _GdkColormap4_)) (not (equal? _GdkColormap_ _GdkColormap5_)) (not (equal? _GdkColormap_ _GdkColormap7_))
(not (equal? _GdkColormap_ _GdkColormap8_)) (not (equal? _GdkColormap_ _GdkColormap9_)))
- (snd-display ";colormaps not equal"))
+ (snd-display #__line__ ";colormaps not equal"))
(if (or (not (equal? _GdkVisual_ _GdkVisual1_)) (not (equal? _GdkVisual_ _GdkVisual3_)) (not (equal? _GdkVisual_ _GdkVisual9_))
(not (equal? _GdkVisual_ _GdkVisual6_)) (not (equal? _GdkVisual_ _GdkVisual7_)))
- (snd-display ";visuals not equal"))
- (if (not (= _GdkVisualType 5)) (snd-display ";visual type: ~A" _GdkVisualType))
- (if (not (equal? _GdkScreen_ _GdkScreen1_)) (snd-display ";screens not equal"))
- (if (not (equal? _GdkDisplay_ _GdkDisplay1_)) (snd-display ";displays not equal"))
- (if (not (= _gint 24)) (snd-display ";_gint: ~A" _gint))
- (if (not (= _int 1)) (snd-display ";_int: ~A" _int))
- (if (not (= _int1 0)) (snd-display ";_int1: ~A" _int1))
- (if (not (= _int2 2560)) (snd-display ";_int2: ~A" _int2))
- (if (not (= _int3 1600)) (snd-display ";_int3: ~A" _int3))
- (if (not (= _int4 644)) (snd-display ";_int4: ~A" _int4))
- (if (not (= _int5 402)) (snd-display ";_int5: ~A" _int5))
- (if (not (= _int6 1)) (snd-display ";_int6: ~A" _int6))
- (if (or (not (equal? _GdkWindow_ _GdkWindow2_)) (not (equal? _GdkWindow1_ _GdkWindow2_))) (snd-display ";windows not equal"))
- (if (not (string=? _gchar_ ":0.0")) (snd-display ";_gchar: ~A" _gchar_))
- (if _gboolean (snd-display ";_gboolean: ~A" _gboolean))
- (if _gboolean1 (snd-display ";_gboolean1: ~A" _gboolean1))
- (if (not (= _guint 18)) (snd-display ";_giunt: ~A" _guint))
- (if (not (GDK_IS_COLORMAP _GdkColormap6_)) (snd-display ";not colormap6: ~A" _GdkColormap6_))
- (if (not (GTK_IS_WIDGET _GtkWidget_)) (snd-display ";not widget: ~A" _GtkWidget_))
- (if (not (GDK_IS_DRAWABLE _GdkDrawable_)) (snd-display ";not drawable: ~A" _GdkDrawable_))
- (if (not (GDK_IS_GC _GdkGC_)) (snd-display ";not gc: ~A" _GdkGC_))
- (if (not (GDK_IS_VISUAL _GdkVisual_)) (snd-display ";not visual: ~A" _GdkVisual_))
- (if (not (GDK_IS_SCREEN _GdkScreen_)) (snd-display ";not screen: ~A" _GdkScreen_))
- (if (not (GDK_IS_DISPLAY _GdkDisplay_)) (snd-display ";not display: ~A" _GdkDisplay_))
- (if (not (GDK_IS_WINDOW _GdkWindow_)) (snd-display ";not window: ~A" _GdkWindow_))
+ (snd-display #__line__ ";visuals not equal"))
+ (if (not (= _GdkVisualType 5)) (snd-display #__line__ ";visual type: ~A" _GdkVisualType))
+ (if (not (equal? _GdkScreen_ _GdkScreen1_)) (snd-display #__line__ ";screens not equal"))
+ (if (not (equal? _GdkDisplay_ _GdkDisplay1_)) (snd-display #__line__ ";displays not equal"))
+ (if (not (= _gint 24)) (snd-display #__line__ ";_gint: ~A" _gint))
+ (if (not (= _int 1)) (snd-display #__line__ ";_int: ~A" _int))
+ (if (not (= _int1 0)) (snd-display #__line__ ";_int1: ~A" _int1))
+ (if (not (= _int2 2560)) (snd-display #__line__ ";_int2: ~A" _int2))
+ (if (not (= _int3 1600)) (snd-display #__line__ ";_int3: ~A" _int3))
+ (if (not (= _int4 644)) (snd-display #__line__ ";_int4: ~A" _int4))
+ (if (not (= _int5 402)) (snd-display #__line__ ";_int5: ~A" _int5))
+ (if (not (= _int6 1)) (snd-display #__line__ ";_int6: ~A" _int6))
+ (if (or (not (equal? _GdkWindow_ _GdkWindow2_)) (not (equal? _GdkWindow1_ _GdkWindow2_))) (snd-display #__line__ ";windows not equal"))
+ (if (not (string=? _gchar_ ":0.0")) (snd-display #__line__ ";_gchar: ~A" _gchar_))
+ (if _gboolean (snd-display #__line__ ";_gboolean: ~A" _gboolean))
+ (if _gboolean1 (snd-display #__line__ ";_gboolean1: ~A" _gboolean1))
+ (if (not (= _guint 18)) (snd-display #__line__ ";_giunt: ~A" _guint))
+ (if (not (GDK_IS_COLORMAP _GdkColormap6_)) (snd-display #__line__ ";not colormap6: ~A" _GdkColormap6_))
+ (if (not (GTK_IS_WIDGET _GtkWidget_)) (snd-display #__line__ ";not widget: ~A" _GtkWidget_))
+ (if (not (GDK_IS_DRAWABLE _GdkDrawable_)) (snd-display #__line__ ";not drawable: ~A" _GdkDrawable_))
+ (if (not (GDK_IS_GC _GdkGC_)) (snd-display #__line__ ";not gc: ~A" _GdkGC_))
+ (if (not (GDK_IS_VISUAL _GdkVisual_)) (snd-display #__line__ ";not visual: ~A" _GdkVisual_))
+ (if (not (GDK_IS_SCREEN _GdkScreen_)) (snd-display #__line__ ";not screen: ~A" _GdkScreen_))
+ (if (not (GDK_IS_DISPLAY _GdkDisplay_)) (snd-display #__line__ ";not display: ~A" _GdkDisplay_))
+ (if (not (GDK_IS_WINDOW _GdkWindow_)) (snd-display #__line__ ";not window: ~A" _GdkWindow_))
(let ((types (gdk_query_visual_types)))
(if (not (member _GdkVisualType (c-array->list (car types) (cadr types))))
- (snd-display ";visuals: ~A and ~A" _GdkVisualType types)))
+ (snd-display #__line__ ";visuals: ~A and ~A" _GdkVisualType types)))
(let ((depths (gdk_query_depths)))
(if (not (member _gint (c-array->list (car depths) (cadr depths))))
- (snd-display ";depths: ~A and ~A" _gint depths)))
+ (snd-display #__line__ ";depths: ~A and ~A" _gint depths)))
)
(let* ((_GtkButton_ (GTK_BUTTON (gtk_button_new)))
@@ -61324,13 +61421,13 @@ EDITS: 1
(_GtkWidget5_ (gtk_check_button_new_with_label "a label"))
(_GtkWidget6_ (gtk_check_button_new_with_mnemonic "A")))
(gtk_widget_show (GTK_WIDGET _GtkButton_))
- (if (not (string=? _gchar1_ "hiho")) (snd-display ";gtk button label: ~A" _gchar1_))
- (if _gboolean (snd-display ";button underline"))
- (if _gboolean1 (snd-display ";button use stock"))
- (if (not _gboolean2) (snd-display ";button focus on click"))
- (if (not (= _GtkReliefStyle GTK_RELIEF_NORMAL)) (snd-display ";button relief: ~A" _GtkReliefStyle))
+ (if (not (string=? _gchar1_ "hiho")) (snd-display #__line__ ";gtk button label: ~A" _gchar1_))
+ (if _gboolean (snd-display #__line__ ";button underline"))
+ (if _gboolean1 (snd-display #__line__ ";button use stock"))
+ (if (not _gboolean2) (snd-display #__line__ ";button focus on click"))
+ (if (not (= _GtkReliefStyle GTK_RELIEF_NORMAL)) (snd-display #__line__ ";button relief: ~A" _GtkReliefStyle))
(let ((align (gtk_button_get_alignment _GtkButton_)))
- (if (or (fneq (car align) 0.5) (fneq (cadr align) 0.5)) (snd-display ";button align: ~A" align)))
+ (if (or (fneq (car align) 0.5) (fneq (cadr align) 0.5)) (snd-display #__line__ ";button align: ~A" align)))
;; presumably these are explicit callbacks (out 2.19)
;; (gtk_button_pressed _GtkButton_)
;; (gtk_button_released _GtkButton_)
@@ -61343,13 +61440,13 @@ EDITS: 1
(gtk_button_set_use_stock _GtkButton_ #t)
(gtk_button_set_focus_on_click _GtkButton_ #f)
(gtk_button_set_alignment _GtkButton_ 0.2 0.75)
- (if (not (string=? (gtk_button_get_label _GtkButton_) "label")) (snd-display ";set gtk button label: ~A" _gchar1_))
- (if (not (gtk_button_get_use_underline _GtkButton_)) (snd-display ";set button underline"))
- (if (not (gtk_button_get_use_stock _GtkButton_)) (snd-display ";set button use stock"))
- (if (gtk_button_get_focus_on_click _GtkButton_) (snd-display ";set button focus on click"))
- (if (not (= (gtk_button_get_relief _GtkButton_) GTK_RELIEF_NONE)) (snd-display ";button relief: ~A" (gtk_button_get_relief _GtkButton_)))
+ (if (not (string=? (gtk_button_get_label _GtkButton_) "label")) (snd-display #__line__ ";set gtk button label: ~A" _gchar1_))
+ (if (not (gtk_button_get_use_underline _GtkButton_)) (snd-display #__line__ ";set button underline"))
+ (if (not (gtk_button_get_use_stock _GtkButton_)) (snd-display #__line__ ";set button use stock"))
+ (if (gtk_button_get_focus_on_click _GtkButton_) (snd-display #__line__ ";set button focus on click"))
+ (if (not (= (gtk_button_get_relief _GtkButton_) GTK_RELIEF_NONE)) (snd-display #__line__ ";button relief: ~A" (gtk_button_get_relief _GtkButton_)))
(let ((align (gtk_button_get_alignment _GtkButton_)))
- (if (or (fneq (car align) 0.2) (fneq (cadr align) 0.75)) (snd-display ";set button align: ~A" align)))
+ (if (or (fneq (car align) 0.2) (fneq (cadr align) 0.75)) (snd-display #__line__ ";set button align: ~A" align)))
(gtk_widget_hide (GTK_WIDGET _GtkButton_))
(gtk_widget_destroy (GTK_WIDGET _GtkButton_)))
@@ -61359,16 +61456,16 @@ EDITS: 1
(_gboolean (gtk_toggle_button_get_mode _GtkToggleButton_))
(_gboolean1 (gtk_toggle_button_get_active _GtkToggleButton_))
(_gboolean2 (gtk_toggle_button_get_inconsistent _GtkToggleButton_)))
- (if _gboolean (snd-display ";toggle mode"))
- (if _gboolean1 (snd-display ";toggle active"))
- (if _gboolean2 (snd-display ";toggle inconsistent"))
+ (if _gboolean (snd-display #__line__ ";toggle mode"))
+ (if _gboolean1 (snd-display #__line__ ";toggle active"))
+ (if _gboolean2 (snd-display #__line__ ";toggle inconsistent"))
(gtk_toggle_button_toggled _GtkToggleButton_)
(gtk_toggle_button_set_mode _GtkToggleButton_ #t)
(gtk_toggle_button_set_active _GtkToggleButton_ #t)
(gtk_toggle_button_set_inconsistent _GtkToggleButton_ #t)
- (if (not (gtk_toggle_button_get_mode _GtkToggleButton_)) (snd-display ";set toggle mode"))
- (if (not (gtk_toggle_button_get_mode _GtkToggleButton_)) (snd-display ";set toggle active"))
- (if (not (gtk_toggle_button_get_mode _GtkToggleButton_)) (snd-display ";set toggle inconsistent")))
+ (if (not (gtk_toggle_button_get_mode _GtkToggleButton_)) (snd-display #__line__ ";set toggle mode"))
+ (if (not (gtk_toggle_button_get_mode _GtkToggleButton_)) (snd-display #__line__ ";set toggle active"))
+ (if (not (gtk_toggle_button_get_mode _GtkToggleButton_)) (snd-display #__line__ ";set toggle inconsistent")))
(let* ((_GtkLabel_ (GTK_LABEL (gtk_label_new "hiho")))
(_GtkWidget_ (gtk_label_new_with_mnemonic "A"))
@@ -61387,35 +61484,35 @@ EDITS: 1
(_list (gtk_label_get_selection_bounds _GtkLabel_))
(_list1 (gtk_label_get_layout_offsets _GtkLabel_))
)
-
- (if (not (string=? _gchar_ "hiho")) (snd-display ";label text: ~A" _gchar_))
- (if (not (string=? _gchar1_ "hiho")) (snd-display ";label label: ~A" _gchar1_))
- (if (not (= _GtkJustification GTK_JUSTIFY_LEFT)) (snd-display ";label justification: ~A ~A" _GtkJustification GTK_JUSTIFY_LEFT))
- (if (not (equal? (list #f 0 0) _list)) (snd-display ";label selection bounds: ~A" _list))
+
+ (if (not (string=? _gchar_ "hiho")) (snd-display #__line__ ";label text: ~A" _gchar_))
+ (if (not (string=? _gchar1_ "hiho")) (snd-display #__line__ ";label label: ~A" _gchar1_))
+ (if (not (= _GtkJustification GTK_JUSTIFY_LEFT)) (snd-display #__line__ ";label justification: ~A ~A" _GtkJustification GTK_JUSTIFY_LEFT))
+ (if (not (equal? (list #f 0 0) _list)) (snd-display #__line__ ";label selection bounds: ~A" _list))
(if (and (not (equal? (list 0 0) _list1))
(not (equal? (list -1 -1) _list1)))
- (snd-display ";label layout offsets: ~A" _list1))
- (if _GtkWidget1_ (snd-display ";mnemnoinic widget: ~A" _GtkWidget1_))
- (if _gboolean (snd-display ";label use markup"))
- (if _gboolean1 (snd-display ";label underline"))
- (if _gboolean2 (snd-display ";label line wrap"))
- (if _gboolean3 (snd-display ";label selectable"))
-
+ (snd-display #__line__ ";label layout offsets: ~A" _list1))
+ (if _GtkWidget1_ (snd-display #__line__ ";mnemnoinic widget: ~A" _GtkWidget1_))
+ (if _gboolean (snd-display #__line__ ";label use markup"))
+ (if _gboolean1 (snd-display #__line__ ";label underline"))
+ (if _gboolean2 (snd-display #__line__ ";label line wrap"))
+ (if _gboolean3 (snd-display #__line__ ";label selectable"))
+
(gtk_label_set_text _GtkLabel_ "another label")
- (if (not (string=? (gtk_label_get_text _GtkLabel_) "another label")) (snd-display ";set label text: ~A" (gtk_label_get_text _GtkLabel_)))
+ (if (not (string=? (gtk_label_get_text _GtkLabel_) "another label")) (snd-display #__line__ ";set label text: ~A" (gtk_label_get_text _GtkLabel_)))
(gtk_label_set_attributes _GtkLabel_ _PangoAttrList_)
(gtk_label_set_label _GtkLabel_ "not text")
- (if (not (string=? (gtk_label_get_label _GtkLabel_) "not text")) (snd-display ";set label label: ~A" (gtk_label_get_label _GtkLabel_)))
+ (if (not (string=? (gtk_label_get_label _GtkLabel_) "not text")) (snd-display #__line__ ";set label label: ~A" (gtk_label_get_label _GtkLabel_)))
(gtk_label_set_use_markup _GtkLabel_ #f)
- (if (gtk_label_get_use_markup _GtkLabel_) (snd-display ";set label use markup: ~A" (gtk_label_get_use_markup _GtkLabel_)))
+ (if (gtk_label_get_use_markup _GtkLabel_) (snd-display #__line__ ";set label use markup: ~A" (gtk_label_get_use_markup _GtkLabel_)))
(gtk_label_set_use_underline _GtkLabel_ #f)
- (if (gtk_label_get_use_underline _GtkLabel_) (snd-display ";set label use underline: ~A" (gtk_label_get_use_underline _GtkLabel_)))
+ (if (gtk_label_get_use_underline _GtkLabel_) (snd-display #__line__ ";set label use underline: ~A" (gtk_label_get_use_underline _GtkLabel_)))
(gtk_label_set_text_with_mnemonic _GtkLabel_ "A")
(gtk_label_set_justify _GtkLabel_ GTK_JUSTIFY_FILL)
- (if (not (= (gtk_label_get_justify _GtkLabel_) GTK_JUSTIFY_FILL)) (snd-display ";set label justify: ~A" (gtk_label_get_justify _GtkLabel_)))
+ (if (not (= (gtk_label_get_justify _GtkLabel_) GTK_JUSTIFY_FILL)) (snd-display #__line__ ";set label justify: ~A" (gtk_label_get_justify _GtkLabel_)))
(gtk_label_set_pattern _GtkLabel_ "a pattern")
(gtk_label_set_line_wrap _GtkLabel_ #t)
- (if (not (gtk_label_get_line_wrap _GtkLabel_)) (snd-display ";set label line wrap: ~A" (gtk_label_get_line_wrap _GtkLabel_)))
+ (if (not (gtk_label_get_line_wrap _GtkLabel_)) (snd-display #__line__ ";set label line wrap: ~A" (gtk_label_get_line_wrap _GtkLabel_)))
(gtk_widget_queue_draw _GtkWidget_)
(gtk_widget_queue_resize _GtkWidget_)
(gtk_widget_show_now _GtkWidget_)
@@ -61430,20 +61527,20 @@ EDITS: 1
(let* ((arr (list->c-array '(1 2 3) type))
(lst (c-array->list arr 3)))
(if (not (equal? lst '(1 2 3)))
- (snd-display ";~A c-array->list not invertible?: ~A ~A" type arr lst))))
+ (snd-display #__line__ ";~A c-array->list not invertible?: ~A ~A" type arr lst))))
(list "gint*" "guint*" "guint32*" "guint16*" "int*" "guchar*"))
(let* ((arr (list->c-array '(#f #t #t) "gboolean*"))
(lst (c-array->list arr 3)))
(if (not (equal? lst '(#f #t #t)))
- (snd-display ";gboolean* c-array->list not invertible?: ~A ~A" arr lst)))
+ (snd-display #__line__ ";gboolean* c-array->list not invertible?: ~A ~A" arr lst)))
(for-each
(lambda (type)
(let* ((arr (list->c-array '("hi" "ho" "hiho") type))
(lst (c-array->list arr 3)))
(if (not (equal? lst '("hi" "ho" "hiho")))
- (snd-display ";~A c-array->list not invertible?: ~A ~A" type arr lst))))
+ (snd-display #__line__ ";~A c-array->list not invertible?: ~A ~A" type arr lst))))
(list "char**" "gchar**"))
(let* ((_GdkRegion_ (gdk_region_new))
@@ -61457,11 +61554,11 @@ EDITS: 1
(_gboolean3 (gdk_rectangle_intersect _GdkRectangle_ (GdkRectangle 3 3 10 10) (GdkRectangle 0 0 4 4)))
(pts (vector->GdkPoints (vct->vector (vct 0.0 0.0 1.0 1.0))))
(_GdkRegion3_ (gdk_region_polygon (list 'GdkPoint_ pts) 2 GDK_WINDING_RULE)))
- (if (equal? _GdkRegion_ _GdkRegion1_) (snd-display ";regions equal?"))
- (if (not _gboolean) (snd-display ";region not empty"))
- (if (not _gboolean1) (snd-display ";region not copied equal"))
- (if (not _gboolean2) (snd-display ";region no point"))
- (if (not _gboolean3) (snd-display ";region no intersect"))
+ (if (equal? _GdkRegion_ _GdkRegion1_) (snd-display #__line__ ";regions equal?"))
+ (if (not _gboolean) (snd-display #__line__ ";region not empty"))
+ (if (not _gboolean1) (snd-display #__line__ ";region not copied equal"))
+ (if (not _gboolean2) (snd-display #__line__ ";region no point"))
+ (if (not _gboolean3) (snd-display #__line__ ";region no intersect"))
(gdk_region_get_clipbox _GdkRegion_ _GdkRectangle1_)
(gdk_region_union_with_rect _GdkRegion_ _GdkRectangle_)
(gdk_region_intersect _GdkRegion2_ _GdkRegion1_)
@@ -61469,7 +61566,7 @@ EDITS: 1
(gdk_region_subtract _GdkRegion_ _GdkRegion_)
(gdk_region_xor _GdkRegion_ _GdkRegion_)
(let ((val (gdk_region_get_rectangles _GdkRegion_)))
- (if (not (equal? val (list #f 0))) (snd-display ";region rects: ~A" val)))
+ (if (not (equal? val (list #f 0))) (snd-display #__line__ ";region rects: ~A" val)))
(gdk_region_offset _GdkRegion_ 10 10)
(gdk_region_shrink _GdkRegion_ 2 2)
(gdk_rectangle_union _GdkRectangle_ _GdkRectangle1_ _GdkRectangle_)
@@ -61485,15 +61582,15 @@ EDITS: 1
(_guint32 (gdk_keyval_to_unicode 65)) ;65
(_guint3 (gdk_unicode_to_keyval 65)) ;65
(vals (gdk_keyval_convert_case 120))) ;(120 88)
- (if (not (string=? "less" _gchar_)) (snd-display ";key name: ~A" _gchar_))
- (if (not (= _guint 60)) (snd-display ";key from less: ~A" _guint))
- (if (not (= _guint1 88)) (snd-display ";key to upper: ~A" _guint1))
- (if (not (= _guint2 97)) (snd-display ";key to lower: ~A" _guint2))
- (if (not (= _guint32 65)) (snd-display ";key to unicode: ~A" _guint32))
- (if (not (= _guint3 65)) (snd-display ";key from unicode: ~A" _guint3))
- (if (not (equal? vals (list 120 88))) (snd-display ";key convert: ~A" vals))
- (if _gboolean (snd-display ";is upper"))
- (if _gboolean1 (snd-display ";is lower")))
+ (if (not (string=? "less" _gchar_)) (snd-display #__line__ ";key name: ~A" _gchar_))
+ (if (not (= _guint 60)) (snd-display #__line__ ";key from less: ~A" _guint))
+ (if (not (= _guint1 88)) (snd-display #__line__ ";key to upper: ~A" _guint1))
+ (if (not (= _guint2 97)) (snd-display #__line__ ";key to lower: ~A" _guint2))
+ (if (not (= _guint32 65)) (snd-display #__line__ ";key to unicode: ~A" _guint32))
+ (if (not (= _guint3 65)) (snd-display #__line__ ";key from unicode: ~A" _guint3))
+ (if (not (equal? vals (list 120 88))) (snd-display #__line__ ";key convert: ~A" vals))
+ (if _gboolean (snd-display #__line__ ";is upper"))
+ (if _gboolean1 (snd-display #__line__ ";is lower")))
(let* ((_GtkEntry_ (GTK_ENTRY (gtk_entry_new)))
(_GtkEntryCompletion_ (gtk_entry_completion_new))
@@ -61509,37 +61606,38 @@ EDITS: 1
(_GtkEntryCompletion1_ (gtk_entry_get_completion _GtkEntry_))
(_GtkWidget_ (gtk_entry_completion_get_entry _GtkEntryCompletion_))
(_gint2 (gtk_entry_completion_get_minimum_key_length _GtkEntryCompletion_))
- (_list (gtk_entry_get_layout_offsets _GtkEntry_)))
- (if (not _gboolean) (snd-display ";entry not visible"))
- (if (not _gboolean1) (snd-display ";entry no frame"))
- (if _gboolean2 (snd-display ";entry activates default"))
- (if (not (= _gint 0)) (snd-display ";max length: ~A" _gint))
- (if (not (= _gint1 -1)) (snd-display ";width chars: ~A" _gint1))
- (if (not (= (string-length _gchar_) 0)) (snd-display ";entry text: ~A" _gchar_))
- (if (fneq _gfloat 0.0) (snd-display ";entry alignment: ~A" _gfloat))
- (if (not (= _gint2 1)) (snd-display ";completion min key: ~A" _gint2))
- (if _GtkWidget_ (snd-display ";completion get entry: ~A" _GtkWidget_))
- (if _GtkEntryCompletion1_ (snd-display ";entry get completion: ~A" _GtkEntryCompletion1_))
+; (_list (gtk_entry_get_layout_offsets _GtkEntry_))
+ )
+ (if (not _gboolean) (snd-display #__line__ ";entry not visible"))
+ (if (not _gboolean1) (snd-display #__line__ ";entry no frame"))
+ (if _gboolean2 (snd-display #__line__ ";entry activates default"))
+ (if (not (= _gint 0)) (snd-display #__line__ ";max length: ~A" _gint))
+ (if (not (= _gint1 -1)) (snd-display #__line__ ";width chars: ~A" _gint1))
+ (if (not (= (string-length _gchar_) 0)) (snd-display #__line__ ";entry text: ~A" _gchar_))
+ (if (fneq _gfloat 0.0) (snd-display #__line__ ";entry alignment: ~A" _gfloat))
+ (if (not (= _gint2 1)) (snd-display #__line__ ";completion min key: ~A" _gint2))
+ (if _GtkWidget_ (snd-display #__line__ ";completion get entry: ~A" _GtkWidget_))
+ (if _GtkEntryCompletion1_ (snd-display #__line__ ";entry get completion: ~A" _GtkEntryCompletion1_))
(gtk_widget_show (GTK_WIDGET _GtkEntry_))
(gtk_entry_set_visibility _GtkEntry_ #f)
- (if (gtk_entry_get_visibility _GtkEntry_) (snd-display ";set entry visible"))
+ (if (gtk_entry_get_visibility _GtkEntry_) (snd-display #__line__ ";set entry visible"))
(gtk_entry_set_invisible_char _GtkEntry_ 65)
(if (not (= (gtk_entry_get_invisible_char _GtkEntry_) 65))
- (snd-display ";set entry invisible char: ~A" (gtk_entry_get_invisible_char _GtkEntry_)))
+ (snd-display #__line__ ";set entry invisible char: ~A" (gtk_entry_get_invisible_char _GtkEntry_)))
(gtk_entry_set_has_frame _GtkEntry_ #f)
- (if (gtk_entry_get_has_frame _GtkEntry_) (snd-display ";set entry has frame: ~A" (gtk_entry_get_has_frame _GtkEntry_)))
+ (if (gtk_entry_get_has_frame _GtkEntry_) (snd-display #__line__ ";set entry has frame: ~A" (gtk_entry_get_has_frame _GtkEntry_)))
(gtk_entry_set_max_length _GtkEntry_ 40)
- (if (not (= (gtk_entry_get_max_length _GtkEntry_) 40)) (snd-display ";set entry max: ~A" (gtk_entry_get_max_length _GtkEntry_)))
+ (if (not (= (gtk_entry_get_max_length _GtkEntry_) 40)) (snd-display #__line__ ";set entry max: ~A" (gtk_entry_get_max_length _GtkEntry_)))
(gtk_entry_set_activates_default _GtkEntry_ #f)
(gtk_entry_set_width_chars _GtkEntry_ 40)
- (if (not (= (gtk_entry_get_width_chars _GtkEntry_) 40)) (snd-display ";set entry width: ~A" (gtk_entry_get_width_chars _GtkEntry_)))
+ (if (not (= (gtk_entry_get_width_chars _GtkEntry_) 40)) (snd-display #__line__ ";set entry width: ~A" (gtk_entry_get_width_chars _GtkEntry_)))
(gtk_entry_set_text _GtkEntry_ "some text")
- (if (not (string=? (gtk_entry_get_text _GtkEntry_) "some text")) (snd-display ";set entry text: ~A" (gtk_entry_get_text _GtkEntry_)))
+ (if (not (string=? (gtk_entry_get_text _GtkEntry_) "some text")) (snd-display #__line__ ";set entry text: ~A" (gtk_entry_get_text _GtkEntry_)))
(gtk_entry_set_completion _GtkEntry_ _GtkEntryCompletion_)
(gtk_entry_completion_set_minimum_key_length _GtkEntryCompletion_ 6)
(gtk_entry_completion_set_text_column _GtkEntryCompletion_ 4)
(gtk_entry_set_alignment _GtkEntry_ 0.1)
- (if (fneq (gtk_entry_get_alignment _GtkEntry_) 0.1) (snd-display ";set entry alignment: ~A" (gtk_entry_get_alignment _GtkEntry_)))
+ (if (fneq (gtk_entry_get_alignment _GtkEntry_) 0.1) (snd-display #__line__ ";set entry alignment: ~A" (gtk_entry_get_alignment _GtkEntry_)))
(gtk_entry_completion_insert_action_text _GtkEntryCompletion_ 10 "hiho"))
(let* ((_GtkCalendar_ (GTK_CALENDAR (gtk_calendar_new)))
@@ -61547,14 +61645,14 @@ EDITS: 1
(_gboolean (gtk_calendar_mark_day _GtkCalendar_ 2))
(_gboolean1 (gtk_calendar_unmark_day _GtkCalendar_ 3))
(_gboolean2 (gtk_calendar_select_month _GtkCalendar_ 7 1951)))
- (if (not _gboolean) (snd-display ";calendar mark day"))
- (if (not _gboolean1) (snd-display ";calendar unmark day"))
- (if (not _gboolean2) (snd-display ";calendar select month"))
+ (if (not _gboolean) (snd-display #__line__ ";calendar mark day"))
+ (if (not _gboolean1) (snd-display #__line__ ";calendar unmark day"))
+ (if (not _gboolean2) (snd-display #__line__ ";calendar select month"))
(gtk_calendar_clear_marks _GtkCalendar_)
(gtk_calendar_select_day _GtkCalendar_ 14)
(gtk_calendar_set_display_options _GtkCalendar_ _GtkCalendarDisplayOptions)
(let ((vals (gtk_calendar_get_date _GtkCalendar_))) ;(1951 7 14)
- (if (not (equal? vals (list 1951 7 14))) (snd-display ";calendar sez birthday: ~A" vals))))
+ (if (not (equal? vals (list 1951 7 14))) (snd-display #__line__ ";calendar sez birthday: ~A" vals))))
(let* ((_gboolean (gtk_rc_reparse_all))
(_GtkRcStyle_ (gtk_rc_style_new))
@@ -61587,9 +61685,9 @@ EDITS: 1
(let ((_gint (gtk_paned_get_position _GtkPaned_))
(_GtkWidget4_ (gtk_paned_get_child1 _GtkPaned_))
(_GtkWidget5_ (gtk_paned_get_child2 _GtkPaned_)))
- (if (not (= _gint 20)) (snd-display ";set paned position: ~A" _gint))
- (if (not (equal? _GtkWidget_ _GtkWidget4_)) (snd-display ";paned child1: ~A ~A" _GtkWidget_ _GtkWidget4_))
- (if (not (equal? _GtkWidget1_ _GtkWidget5_)) (snd-display ";paned child2: ~A ~A" _GtkWidget1_ _GtkWidget5_))))
+ (if (not (= _gint 20)) (snd-display #__line__ ";set paned position: ~A" _gint))
+ (if (not (equal? _GtkWidget_ _GtkWidget4_)) (snd-display #__line__ ";paned child1: ~A ~A" _GtkWidget_ _GtkWidget4_))
+ (if (not (equal? _GtkWidget1_ _GtkWidget5_)) (snd-display #__line__ ";paned child2: ~A ~A" _GtkWidget1_ _GtkWidget5_))))
(let* ((_GtkRuler_ (GTK_RULER (gtk_vruler_new)))
(_GtkRuler1_ (GTK_RULER (gtk_hruler_new)))
@@ -61599,14 +61697,14 @@ EDITS: 1
(gtk_ruler_set_metric _GtkRuler_ GTK_PIXELS)
(gtk_ruler_set_range _GtkRuler_ 0.0 1.0 0.1 0.5)
(let ((vals (gtk_ruler_get_range _GtkRuler_)))
- (if (not (feql vals (list 0.0 1.0 0.1 0.5))) (snd-display ";ruler get range: ~A" vals))))
+ (if (not (feql vals (list 0.0 1.0 0.1 0.5))) (snd-display #__line__ ";ruler get range: ~A" vals))))
(let* ((_GtkStatusbar_ (GTK_STATUSBAR (gtk_statusbar_new)))
(_gboolean (gtk_statusbar_get_has_resize_grip _GtkStatusbar_))
(_guint (gtk_statusbar_get_context_id _GtkStatusbar_ "hiho")))
- (if (not _gboolean) (snd-display ";statusbar grip"))
+ (if (not _gboolean) (snd-display #__line__ ";statusbar grip"))
(gtk_statusbar_set_has_resize_grip _GtkStatusbar_ #f)
- (if (gtk_statusbar_get_has_resize_grip _GtkStatusbar_) (snd-display ";set statusbar grip")))
+ (if (gtk_statusbar_get_has_resize_grip _GtkStatusbar_) (snd-display #__line__ ";set statusbar grip")))
(let* ((_GdkScreen_ (gdk_screen_get_default))
(_GdkDisplay_ (gdk_display_get_default))
@@ -61655,40 +61753,40 @@ EDITS: 1
(_list9 (gdk_window_get_internal_paint_info _GdkWindow_))
(_list10 (gtk_window_get_size _GtkWindow_))
)
- (if (gtk_window_get_icon_name _GtkWindow_) (snd-display ";get icon name: ~A" (gtk_window_get_icon_name _GtkWindow_)))
+ (if (gtk_window_get_icon_name _GtkWindow_) (snd-display #__line__ ";get icon name: ~A" (gtk_window_get_icon_name _GtkWindow_)))
(gtk_window_set_icon_name _GtkWindow_ "Snd")
(if (not (string=? (gtk_window_get_icon_name _GtkWindow_) "Snd"))
- (snd-display ";set icon name: ~A" (gtk_window_get_icon_name _GtkWindow_)))
- (if (not (gtk_window_get_focus_on_map _GtkWindow_)) (snd-display ";focus on map?"))
+ (snd-display #__line__ ";set icon name: ~A" (gtk_window_get_icon_name _GtkWindow_)))
+ (if (not (gtk_window_get_focus_on_map _GtkWindow_)) (snd-display #__line__ ";focus on map?"))
(gtk_window_set_default_icon_name "hiho")
- (if (not (= _GdkWindowTypeHint GDK_WINDOW_TYPE_HINT_NORMAL)) (snd-display ";_GdkWindowTypeHint: ~A" _GdkWindowTypeHint))
- (if _gboolean (snd-display ";gtk window destroy with parent"))
- (if (not _gboolean1) (snd-display ";gtk window not resizable"))
- (if (not (= _GdkGravity GDK_GRAVITY_NORTH_WEST)) (snd-display ";window gravity: ~A" _GdkGravity))
- (if _gboolean2 (snd-display ";gtk window has frame"))
- (if (not _gboolean3) (snd-display ";gtk window not decorated"))
- (if _gboolean4 (snd-display ";gtk window modal"))
- (if (not (= _GdkModifierType GDK_MOD1_MASK)) (snd-display ";_GdkModifierType: ~A" _GdkModifierType))
- (if (not _gboolean7) (snd-display ";window not focusable"))
- (if (not (= _GdkWindowType GDK_WINDOW_ROOT)) (snd-display ";root window type: ~A" _GdkWindowType))
- (if _gboolean10 (snd-display ";window visible"))
- (if (not _gboolean11) (snd-display ";window not viewable"))
- (if (not (= _GdkWindowState GDK_WINDOW_STATE_WITHDRAWN)) (snd-display ";window state: ~A" _GdkWindowState))
- (if (not (equal? (list 1 0 0) _list1)) (snd-display ";window get origin: ~A" _list1))
+ (if (not (= _GdkWindowTypeHint GDK_WINDOW_TYPE_HINT_NORMAL)) (snd-display #__line__ ";_GdkWindowTypeHint: ~A" _GdkWindowTypeHint))
+ (if _gboolean (snd-display #__line__ ";gtk window destroy with parent"))
+ (if (not _gboolean1) (snd-display #__line__ ";gtk window not resizable"))
+ (if (not (= _GdkGravity GDK_GRAVITY_NORTH_WEST)) (snd-display #__line__ ";window gravity: ~A" _GdkGravity))
+ (if _gboolean2 (snd-display #__line__ ";gtk window has frame"))
+ (if (not _gboolean3) (snd-display #__line__ ";gtk window not decorated"))
+ (if _gboolean4 (snd-display #__line__ ";gtk window modal"))
+ (if (not (= _GdkModifierType GDK_MOD1_MASK)) (snd-display #__line__ ";_GdkModifierType: ~A" _GdkModifierType))
+ (if (not _gboolean7) (snd-display #__line__ ";window not focusable"))
+ (if (not (= _GdkWindowType GDK_WINDOW_ROOT)) (snd-display #__line__ ";root window type: ~A" _GdkWindowType))
+ (if _gboolean10 (snd-display #__line__ ";window visible"))
+ (if (not _gboolean11) (snd-display #__line__ ";window not viewable"))
+ (if (not (= _GdkWindowState GDK_WINDOW_STATE_WITHDRAWN)) (snd-display #__line__ ";window state: ~A" _GdkWindowState))
+ (if (not (equal? (list 1 0 0) _list1)) (snd-display #__line__ ";window get origin: ~A" _list1))
(if (and (not (equal? (list 0 0 2560 1600 32) _list3))
(not (equal? (list 0 0 2560 1600 24) _list3)))
- (snd-display ";window geometry: ~A" _list3))
- (if (not (equal? (list -1 -1) _list4)) (snd-display ";window default size: ~A" _list4))
- (if (not (equal? (list 0 0 0 0) _list6)) (snd-display ";window frame: ~A" _list6))
- (if (not (equal? (list 0 0) _list7)) (snd-display ";window get root origin: ~A" _list7))
- (if (not (equal? (list 0 0) _list8)) (snd-display ";window get position: ~A" _list8))
+ (snd-display #__line__ ";window geometry: ~A" _list3))
+ (if (not (equal? (list -1 -1) _list4)) (snd-display #__line__ ";window default size: ~A" _list4))
+ (if (not (equal? (list 0 0 0 0) _list6)) (snd-display #__line__ ";window frame: ~A" _list6))
+ (if (not (equal? (list 0 0) _list7)) (snd-display #__line__ ";window get root origin: ~A" _list7))
+ (if (not (equal? (list 0 0) _list8)) (snd-display #__line__ ";window get position: ~A" _list8))
(gdk_window_set_user_data _GdkWindow_ (GPOINTER 123))
(gdk_window_set_title _GdkWindow_ "Snd") ; there's no corresponding get?
(gtk_window_set_title _GtkWindow_ "Snd")
(let ((title (gtk_window_get_title _GtkWindow_)))
- (if (not (string=? title "Snd")) (snd-display ";gtk_window_get_title: ~A?" title)))
+ (if (not (string=? title "Snd")) (snd-display #__line__ ";gtk_window_get_title: ~A?" title)))
(gtk_window_present _GtkWindow_)
(gtk_window_deiconify _GtkWindow_)
@@ -61709,10 +61807,10 @@ EDITS: 1
(_gdouble (gtk_progress_bar_get_fraction _GtkProgressBar_))
(_gdouble1 (gtk_progress_bar_get_pulse_step _GtkProgressBar_))
(_GtkProgressBarOrientation (gtk_progress_bar_get_orientation _GtkProgressBar_)))
- (if _gchar_ (snd-display ";progress text: ~A" _gchar_))
- (if (fneq _gdouble 0.0) (snd-display ";progress fraction: ~A" _gdouble))
- (if (fneq _gdouble1 0.1) (snd-display ";progress step: ~A" _gdouble1))
- (if (not (= _GtkProgressBarOrientation 0)) (snd-display ";progress orient: ~A" _GtkProgressBarOrientation))
+ (if _gchar_ (snd-display #__line__ ";progress text: ~A" _gchar_))
+ (if (fneq _gdouble 0.0) (snd-display #__line__ ";progress fraction: ~A" _gdouble))
+ (if (fneq _gdouble1 0.1) (snd-display #__line__ ";progress step: ~A" _gdouble1))
+ (if (not (= _GtkProgressBarOrientation 0)) (snd-display #__line__ ";progress orient: ~A" _GtkProgressBarOrientation))
(gtk_progress_bar_pulse _GtkProgressBar_)
(gtk_progress_bar_set_text _GtkProgressBar_ "hiho")
(gtk_progress_bar_set_fraction _GtkProgressBar_ .25)
@@ -61722,10 +61820,10 @@ EDITS: 1
(set! _gdouble (gtk_progress_bar_get_fraction _GtkProgressBar_))
(set! _gdouble1 (gtk_progress_bar_get_pulse_step _GtkProgressBar_))
(set! _GtkProgressBarOrientation (gtk_progress_bar_get_orientation _GtkProgressBar_))
- (if (not (string=? _gchar_ "hiho")) (snd-display ";set progress text: ~A" _gchar_))
- (if (fneq _gdouble 0.25) (snd-display ";set progress fraction: ~A" _gdouble))
- (if (fneq _gdouble1 0.2) (snd-display ";set progress step: ~A" _gdouble1))
- (if (not (= _GtkProgressBarOrientation GTK_PROGRESS_RIGHT_TO_LEFT)) (snd-display ";set progress orient: ~A" _GtkProgressBarOrientation)))
+ (if (not (string=? _gchar_ "hiho")) (snd-display #__line__ ";set progress text: ~A" _gchar_))
+ (if (fneq _gdouble 0.25) (snd-display #__line__ ";set progress fraction: ~A" _gdouble))
+ (if (fneq _gdouble1 0.2) (snd-display #__line__ ";set progress step: ~A" _gdouble1))
+ (if (not (= _GtkProgressBarOrientation GTK_PROGRESS_RIGHT_TO_LEFT)) (snd-display #__line__ ";set progress orient: ~A" _GtkProgressBarOrientation)))
(let* ((_GdkCursor_ (gdk_cursor_new GDK_BOTTOM_TEE))
(_GdkCursor1_ (gdk_cursor_ref _GdkCursor_)))
@@ -61754,33 +61852,33 @@ EDITS: 1
(_PangoLayout_ (gtk_scale_get_layout _GtkScale_))
(_list (gtk_scale_get_layout_offsets _GtkScale_))
(_list1 (gtk_layout_get_size _GtkLayout_)))
- (if (fneq _gdouble 1.0) (snd-display ";adjust init: ~A" _gdouble))
- (if _gboolean (snd-display ";range invert"))
- (if (fneq _gdouble1 0.0) (snd-display ";range init: ~A" _gdouble1))
- (if (not _gboolean1) (snd-display ";scale not drawn"))
- (if (not (= 1 _gint)) (snd-display ";scale init digits: ~A" _gint))
- (if (not (= _GtkPositionType 2)) (snd-display ";scale init pos: ~A" _GtkPositionType))
- (if (not (equal? _list1 (list 100 100))) (snd-display ";layout size: ~A" _list1))
- (if (not (= _GtkUpdateType GTK_UPDATE_CONTINUOUS)) (snd-display ";range update: ~A" _GtkUpdateType))
+ (if (fneq _gdouble 1.0) (snd-display #__line__ ";adjust init: ~A" _gdouble))
+ (if _gboolean (snd-display #__line__ ";range invert"))
+ (if (fneq _gdouble1 0.0) (snd-display #__line__ ";range init: ~A" _gdouble1))
+ (if (not _gboolean1) (snd-display #__line__ ";scale not drawn"))
+ (if (not (= 1 _gint)) (snd-display #__line__ ";scale init digits: ~A" _gint))
+ (if (not (= _GtkPositionType 2)) (snd-display #__line__ ";scale init pos: ~A" _GtkPositionType))
+ (if (not (equal? _list1 (list 100 100))) (snd-display #__line__ ";layout size: ~A" _list1))
+ (if (not (= _GtkUpdateType GTK_UPDATE_CONTINUOUS)) (snd-display #__line__ ";range update: ~A" _GtkUpdateType))
(gtk_range_set_update_policy _GtkRange_ GTK_UPDATE_DISCONTINUOUS)
(set! _GtkUpdateType (gtk_range_get_update_policy _GtkRange_))
- (if (not (= _GtkUpdateType GTK_UPDATE_DISCONTINUOUS)) (snd-display ";set range update: ~A" _GtkUpdateType))
+ (if (not (= _GtkUpdateType GTK_UPDATE_DISCONTINUOUS)) (snd-display #__line__ ";set range update: ~A" _GtkUpdateType))
(gtk_range_set_adjustment _GtkRange_ _GtkAdjustment4_)
(gtk_range_set_inverted _GtkRange_ #f)
(set! _gboolean (gtk_range_get_inverted _GtkRange_))
- (if _gboolean (snd-display ";set range invert"))
+ (if _gboolean (snd-display #__line__ ";set range invert"))
(gtk_range_set_value _GtkRange_ 0.5)
(set! _gdouble1 (gtk_range_get_value _GtkRange_))
- (if (fneq _gdouble1 0.5) (snd-display ";set range val: ~A" _gdouble1))
+ (if (fneq _gdouble1 0.5) (snd-display #__line__ ";set range val: ~A" _gdouble1))
(gtk_scale_set_digits _GtkScale_ 2)
(set! _gint (gtk_scale_get_digits _GtkScale_))
- (if (not (= 2 _gint)) (snd-display ";set scale digits: ~A" _gint))
+ (if (not (= 2 _gint)) (snd-display #__line__ ";set scale digits: ~A" _gint))
(gtk_scale_set_draw_value _GtkScale_ #t)
(set! _gboolean1 (gtk_scale_get_draw_value _GtkScale_))
- (if (not _gboolean1) (snd-display ";set scale drawn"))
+ (if (not _gboolean1) (snd-display #__line__ ";set scale drawn"))
(gtk_scale_set_value_pos _GtkScale_ GTK_POS_LEFT)
(set! _GtkPositionType (gtk_scale_get_value_pos _GtkScale_))
- (if (not (= _GtkPositionType GTK_POS_LEFT)) (snd-display ";set scale pos: ~A" _GtkPositionType))
+ (if (not (= _GtkPositionType GTK_POS_LEFT)) (snd-display #__line__ ";set scale pos: ~A" _GtkPositionType))
(gtk_range_set_increments _GtkRange_ 1.0 0.1)
(gtk_range_set_range _GtkRange_ 0.0 3.0)
(gtk_adjustment_set_value _GtkAdjustment_ 0.5)
@@ -61790,7 +61888,7 @@ EDITS: 1
(gtk_layout_set_vadjustment _GtkLayout_ _GtkAdjustment_)
(gtk_layout_set_size _GtkLayout_ 0 100)
(set! _list1 (gtk_layout_get_size _GtkLayout_))
- (if (not (equal? _list1 (list 0 100))) (snd-display ";layout set size: ~A" _list1))
+ (if (not (equal? _list1 (list 0 100))) (snd-display #__line__ ";layout set size: ~A" _list1))
(gtk_layout_put _GtkLayout_ _GtkWidget_ 0 10)
(gtk_layout_move _GtkLayout_ _GtkWidget_ 10 10))
@@ -61807,16 +61905,16 @@ EDITS: 1
(_GtkAdjustment1_ (gtk_spin_button_get_adjustment _GtkSpinButton1_))
(_list (gtk_spin_button_get_increments _GtkSpinButton_))
(_list1 (gtk_spin_button_get_range _GtkSpinButton_)))
- (if (not (equal? _GtkAdjustment_ _GtkAdjustment1_)) (snd-display ";spin button get adj: ~A ~A" _GtkAdjustment_ _GtkAdjustment1_))
- (if (not (= _guint 0)) (snd-display ";spin digits: ~A" _guint))
- (if (fneq _gdouble 0.0) (snd-display ";spin init: ~A" _gdouble))
- (if (not (= _GtkSpinButtonUpdatePolicy GTK_UPDATE_ALWAYS)) (snd-display ";spin update: ~A" _GtkSpinButtonUpdatePolicy))
- (if (not (= _gint 0)) (snd-display ";spin val as int: ~A" _gint))
- (if (not _gboolean) (snd-display ";spin not numeric"))
- (if _gboolean1 (snd-display ";spin wraps"))
- (if _gboolean2 (snd-display ";spin snaps"))
- (if (not (feql _list (list 1.0 10.0))) (snd-display ";spin incr: ~A" _list))
- (if (not (feql _list1 (list 0.0 20.0))) (snd-display ";spin range: ~A" _list1))
+ (if (not (equal? _GtkAdjustment_ _GtkAdjustment1_)) (snd-display #__line__ ";spin button get adj: ~A ~A" _GtkAdjustment_ _GtkAdjustment1_))
+ (if (not (= _guint 0)) (snd-display #__line__ ";spin digits: ~A" _guint))
+ (if (fneq _gdouble 0.0) (snd-display #__line__ ";spin init: ~A" _gdouble))
+ (if (not (= _GtkSpinButtonUpdatePolicy GTK_UPDATE_ALWAYS)) (snd-display #__line__ ";spin update: ~A" _GtkSpinButtonUpdatePolicy))
+ (if (not (= _gint 0)) (snd-display #__line__ ";spin val as int: ~A" _gint))
+ (if (not _gboolean) (snd-display #__line__ ";spin not numeric"))
+ (if _gboolean1 (snd-display #__line__ ";spin wraps"))
+ (if _gboolean2 (snd-display #__line__ ";spin snaps"))
+ (if (not (feql _list (list 1.0 10.0))) (snd-display #__line__ ";spin incr: ~A" _list))
+ (if (not (feql _list1 (list 0.0 20.0))) (snd-display #__line__ ";spin range: ~A" _list1))
(gtk_spin_button_update _GtkSpinButton_)
(gtk_spin_button_set_adjustment _GtkSpinButton_ _GtkAdjustment_)
(gtk_spin_button_set_digits _GtkSpinButton1_ 2)
@@ -61836,12 +61934,12 @@ EDITS: 1
(set! _gboolean1 (gtk_spin_button_get_wrap _GtkSpinButton_))
(set! _gboolean2 (gtk_spin_button_get_snap_to_ticks _GtkSpinButton_))
(set! _list1 (gtk_spin_button_get_range _GtkSpinButton_))
- (if (not (= _guint 2)) (snd-display ";set spin digits: ~A" _guint))
- (if (not (= _GtkSpinButtonUpdatePolicy GTK_UPDATE_ALWAYS)) (snd-display ";set spin update: ~A" _GtkSpinButtonUpdatePolicy))
- (if (not _gboolean) (snd-display ";set spin not numeric"))
- (if _gboolean1 (snd-display ";set spin wraps"))
- (if _gboolean2 (snd-display ";set spin snaps"))
- (if (not (feql _list1 (list 0.0 1.0))) (snd-display ";set spin range: ~A" _list1)))
+ (if (not (= _guint 2)) (snd-display #__line__ ";set spin digits: ~A" _guint))
+ (if (not (= _GtkSpinButtonUpdatePolicy GTK_UPDATE_ALWAYS)) (snd-display #__line__ ";set spin update: ~A" _GtkSpinButtonUpdatePolicy))
+ (if (not _gboolean) (snd-display #__line__ ";set spin not numeric"))
+ (if _gboolean1 (snd-display #__line__ ";set spin wraps"))
+ (if _gboolean2 (snd-display #__line__ ";set spin snaps"))
+ (if (not (feql _list1 (list 0.0 1.0))) (snd-display #__line__ ";set spin range: ~A" _list1)))
(let* ((_GtkToolbar_ (GTK_TOOLBAR (gtk_toolbar_new)))
(_GtkWidget_ (cadr (main-widgets)))
@@ -61850,7 +61948,7 @@ EDITS: 1
(_GtkSeparatorToolItem_ (GTK_SEPARATOR_TOOL_ITEM (gtk_separator_tool_item_new)))
(_GtkToggleToolButton_ (GTK_TOGGLE_TOOL_BUTTON (gtk_toggle_tool_button_new)))
(_GtkToolItem8_ (gtk_toggle_tool_button_new_from_stock GTK_STOCK_CANCEL))
-; (_GtkOrientation (gtk_toolbar_get_orientation _GtkToolbar_))
+ ; (_GtkOrientation (gtk_toolbar_get_orientation _GtkToolbar_))
(_GtkToolbarStyle (gtk_toolbar_get_style _GtkToolbar_))
(_GtkIconSize (gtk_toolbar_get_icon_size _GtkToolbar_))
(_gint (gtk_toolbar_get_n_items _GtkToolbar_))
@@ -61882,28 +61980,28 @@ EDITS: 1
(_gboolean10 (gtk_separator_tool_item_get_draw _GtkSeparatorToolItem_))
(_GtkToolItem5_ (gtk_radio_tool_button_new_from_stock #f GTK_STOCK_CANCEL)))
- (if (not (= _GtkToolbarStyle 2)) (snd-display ";toolbar style: ~A" _GtkToolbarStyle))
- (if (not (= _GtkIconSize 3)) (snd-display ";toolbar icon size: ~A" _GtkIconSize))
- (if (not (= _gint 0)) (snd-display ";toolbar items: ~A" _gint))
- (if (not _gboolean1) (snd-display ";toolbar no arrow"))
- (if (not (= _GtkReliefStyle 2)) (snd-display ";toolbar relief: ~A" _GtkReliefStyle))
- (if _gboolean2 (snd-display ";toolbar underlined"))
- (if (not (string=? _gchar1_ "gtk-cancel")) (snd-display ";tool button stock: ~A" _gchar1_))
- (if _gboolean3 (snd-display ";tool item homogenous"))
- (if _gboolean4 (snd-display ";tool item expands"))
- (if _gboolean5 (snd-display ";tool item drags"))
- (if (not _gboolean6) (snd-display ";tool item not visible horizontal"))
- (if (not _gboolean7) (snd-display ";tool item not visible vertical"))
- (if _gboolean8 (snd-display ";tool item important"))
- (if (not (= _GtkIconSize1 3)) (snd-display ";tool item icon size: ~A" _GtkIconSize1))
- (if (not (= _GtkOrientation1 0)) (snd-display ";tool item orientation: ~A" _GtkOrientation1))
- (if (not (= _GtkToolbarStyle1 0)) (snd-display ";tool item style: ~A" _GtkToolbarStyle1))
- (if (not (= _GtkReliefStyle1 2)) (snd-display ";tool item relief: ~A" _GtkReliefStyle))
+ (if (not (= _GtkToolbarStyle 2)) (snd-display #__line__ ";toolbar style: ~A" _GtkToolbarStyle))
+ (if (not (= _GtkIconSize 3)) (snd-display #__line__ ";toolbar icon size: ~A" _GtkIconSize))
+ (if (not (= _gint 0)) (snd-display #__line__ ";toolbar items: ~A" _gint))
+ (if (not _gboolean1) (snd-display #__line__ ";toolbar no arrow"))
+ (if (not (= _GtkReliefStyle 2)) (snd-display #__line__ ";toolbar relief: ~A" _GtkReliefStyle))
+ (if _gboolean2 (snd-display #__line__ ";toolbar underlined"))
+ (if (not (string=? _gchar1_ "gtk-cancel")) (snd-display #__line__ ";tool button stock: ~A" _gchar1_))
+ (if _gboolean3 (snd-display #__line__ ";tool item homogenous"))
+ (if _gboolean4 (snd-display #__line__ ";tool item expands"))
+ (if _gboolean5 (snd-display #__line__ ";tool item drags"))
+ (if (not _gboolean6) (snd-display #__line__ ";tool item not visible horizontal"))
+ (if (not _gboolean7) (snd-display #__line__ ";tool item not visible vertical"))
+ (if _gboolean8 (snd-display #__line__ ";tool item important"))
+ (if (not (= _GtkIconSize1 3)) (snd-display #__line__ ";tool item icon size: ~A" _GtkIconSize1))
+ (if (not (= _GtkOrientation1 0)) (snd-display #__line__ ";tool item orientation: ~A" _GtkOrientation1))
+ (if (not (= _GtkToolbarStyle1 0)) (snd-display #__line__ ";tool item style: ~A" _GtkToolbarStyle1))
+ (if (not (= _GtkReliefStyle1 2)) (snd-display #__line__ ";tool item relief: ~A" _GtkReliefStyle))
(gtk_radio_tool_button_set_group _GtkRadioToolButton_ #f)
(gtk_toggle_tool_button_set_active _GtkToggleToolButton_ #t)
(gtk_toolbar_unset_style _GtkToolbar_)
-; (gtk_toolbar_set_orientation _GtkToolbar_ GTK_ORIENTATION_HORIZONTAL)
+ ; (gtk_toolbar_set_orientation _GtkToolbar_ GTK_ORIENTATION_HORIZONTAL)
(gtk_toolbar_set_style _GtkToolbar_ GTK_TOOLBAR_TEXT)
(gtk_toolbar_set_show_arrow _GtkToolbar_ #f)
(gtk_tool_button_set_label _GtkToolButton_ "hi")
@@ -61929,11 +62027,11 @@ EDITS: 1
(_gboolean (gtk_table_get_homogeneous _GtkTable_))
(_guint2 (gtk_table_get_row_spacing _GtkTable_ 0))
(_guint3 (gtk_table_get_col_spacing _GtkTable_ 0)))
- (if (not (= _guint 0)) (snd-display ";table row def: ~A" _guint))
- (if (not (= _guint1 0)) (snd-display ";table col def: ~A" _guint1))
- (if (not (= _guint2 0)) (snd-display ";table row: ~A" _guint2))
- (if (not (= _guint3 0)) (snd-display ";table col: ~A" _guint3))
- (if (not _gboolean) (snd-display ";table not homogenous"))
+ (if (not (= _guint 0)) (snd-display #__line__ ";table row def: ~A" _guint))
+ (if (not (= _guint1 0)) (snd-display #__line__ ";table col def: ~A" _guint1))
+ (if (not (= _guint2 0)) (snd-display #__line__ ";table row: ~A" _guint2))
+ (if (not (= _guint3 0)) (snd-display #__line__ ";table col: ~A" _guint3))
+ (if (not _gboolean) (snd-display #__line__ ";table not homogenous"))
(gtk_table_set_row_spacings _GtkTable_ 10)
(gtk_table_set_col_spacings _GtkTable_ 10)
(gtk_table_set_homogeneous _GtkTable_ #t)
@@ -61945,9 +62043,9 @@ EDITS: 1
(set! _guint1 (gtk_table_get_default_col_spacing _GtkTable_))
(set! _guint2 (gtk_table_get_row_spacing _GtkTable_ 0))
(set! _guint3 (gtk_table_get_col_spacing _GtkTable_ 0))
- (if (not (= _guint1 10)) (snd-display ";set table col def: ~A" _guint1))
- (if (not (= _guint2 2)) (snd-display ";set table row: ~A" _guint2))
- (if (not (= _guint3 3)) (snd-display ";set table col: ~A" _guint3)))
+ (if (not (= _guint1 10)) (snd-display #__line__ ";set table col def: ~A" _guint1))
+ (if (not (= _guint2 2)) (snd-display #__line__ ";set table row: ~A" _guint2))
+ (if (not (= _guint3 3)) (snd-display #__line__ ";set table col: ~A" _guint3)))
(let* ((_GtkNotebook_ (GTK_NOTEBOOK (gtk_notebook_new)))
(page (gtk_button_new_with_label "hi"))
@@ -61966,18 +62064,18 @@ EDITS: 1
(_gchar1_ (gtk_notebook_get_menu_label_text _GtkNotebook_ page))
(_gint3 (gtk_notebook_prepend_page _GtkNotebook_ (gtk_button_new_with_label "ha") (gtk_label_new "ho")))
(_gint6 (gtk_notebook_insert_page _GtkNotebook_ (gtk_button_new_with_label "ha") (gtk_label_new "ho") 1)))
- (if (not (= _gint 0)) (snd-display ";notebook page: ~A" _gint))
- (if (not (= _gint1 -1)) (snd-display ";notebook current page: ~A" _gint1))
- (if (not _gboolean) (snd-display ";notebook no border"))
- (if (not _gboolean1) (snd-display ";notebook no show tabs"))
- (if (not (= _GtkPositionType 2)) (snd-display ";notebook tab pos: ~A" _GtkPositionType))
- (if _gboolean2 (snd-display ";notebook scrollable"))
- (if (not (= _int 1)) (snd-display ";notebook pages: ~A" _int))
- (if (not (equal? _GtkWidget_ page)) (snd-display ";notebook page widget: ~A ~A" _GtkWidget_ page))
- (if (not (= _gint2 0)) (snd-display ";notebook page num: ~A" _gint2))
- (if (not (string=? _gchar_ "ho")) (snd-display ";notebook tab label: ~A" _gchar_))
- (if (not (= _gint3 0)) (snd-display ";notebook prepend to: ~A" _gint3))
- (if (not (= _gint6 1)) (snd-display ";notebook insert to: ~A" _gint6))
+ (if (not (= _gint 0)) (snd-display #__line__ ";notebook page: ~A" _gint))
+ (if (not (= _gint1 -1)) (snd-display #__line__ ";notebook current page: ~A" _gint1))
+ (if (not _gboolean) (snd-display #__line__ ";notebook no border"))
+ (if (not _gboolean1) (snd-display #__line__ ";notebook no show tabs"))
+ (if (not (= _GtkPositionType 2)) (snd-display #__line__ ";notebook tab pos: ~A" _GtkPositionType))
+ (if _gboolean2 (snd-display #__line__ ";notebook scrollable"))
+ (if (not (= _int 1)) (snd-display #__line__ ";notebook pages: ~A" _int))
+ (if (not (equal? _GtkWidget_ page)) (snd-display #__line__ ";notebook page widget: ~A ~A" _GtkWidget_ page))
+ (if (not (= _gint2 0)) (snd-display #__line__ ";notebook page num: ~A" _gint2))
+ (if (not (string=? _gchar_ "ho")) (snd-display #__line__ ";notebook tab label: ~A" _gchar_))
+ (if (not (= _gint3 0)) (snd-display #__line__ ";notebook prepend to: ~A" _gint3))
+ (if (not (= _gint6 1)) (snd-display #__line__ ";notebook insert to: ~A" _gint6))
(gtk_notebook_set_current_page _GtkNotebook_ 1)
(gtk_notebook_next_page _GtkNotebook_)
(gtk_notebook_prev_page _GtkNotebook_)
@@ -61990,9 +62088,9 @@ EDITS: 1
(gtk_notebook_set_scrollable _GtkNotebook_ #t)
(gtk_notebook_set_tab_label_text _GtkNotebook_ page "yow")
(gtk_notebook_reorder_child _GtkNotebook_ _GtkWidget_ 0)
-;; (gtk_notebook_set_tab_label_packing _GtkNotebook_ page #f #f GTK_PACK_START)
-;; (let ((vals (gtk_notebook_query_tab_label_packing _GtkNotebook_ page)))
-;; (if (not (equal? vals (list #f #f GTK_PACK_START))) (snd-display ";notebook tab pack: ~A" vals)))
+ ;; (gtk_notebook_set_tab_label_packing _GtkNotebook_ page #f #f GTK_PACK_START)
+ ;; (let ((vals (gtk_notebook_query_tab_label_packing _GtkNotebook_ page)))
+ ;; (if (not (equal? vals (list #f #f GTK_PACK_START))) (snd-display #__line__ ";notebook tab pack: ~A" vals)))
(gtk_notebook_set_tab_label _GtkNotebook_ page (gtk_label_new "ho")))
(let* ((_GtkHandleBox_ (GTK_HANDLE_BOX (gtk_handle_box_new)))
@@ -62049,19 +62147,19 @@ EDITS: 1
(vals1 (gtk_widget_get_pointer shell))
(_GList1_ (gtk_widget_list_accel_closures _GtkWidget_))
(_list (gtk_widget_translate_coordinates _GtkWidget_ _GtkWidget_ 0 0)))
- (if (not (= _GtkTextDirection 1)) (snd-display ";gtk widget default dir: ~A" _GtkTextDirection))
- (if _gboolean (snd-display ";gtk widget activated"))
- (if _gboolean1 (snd-display ";gtk widget focussed"))
- (if (not (string=? _gchar_ "GtkWindow")) (snd-display ";gtk widget name: ~A" _gchar_))
- (if (not _gboolean2) (snd-display ";gtk widget child not visible"))
- (if (not (= _gint 65536)) (snd-display ";gtk widget events: ~A" _gint))
- (if (not (= _GtkTextDirection1 1)) (snd-display ";gtk widget get dir: ~A" _GtkTextDirection1))
- (if (not _gboolean4) (snd-display ";gtk widget no screen"))
- (if _gboolean5 (snd-display ";gtk widget show all"))
- (if (not _gboolean8) (snd-display ";gtk widget child not focussed"))
- (if _gboolean9 (snd-display ";gtk widget ancestor shell"))
- (if (not _gboolean11) (snd-display ";gtk widget no intersect"))
- (if (not (equal? vals (list -1 -1))) (snd-display ";gtk widget size request: ~A" vals))
+ (if (not (= _GtkTextDirection 1)) (snd-display #__line__ ";gtk widget default dir: ~A" _GtkTextDirection))
+ (if _gboolean (snd-display #__line__ ";gtk widget activated"))
+ (if _gboolean1 (snd-display #__line__ ";gtk widget focussed"))
+ (if (not (string=? _gchar_ "GtkWindow")) (snd-display #__line__ ";gtk widget name: ~A" _gchar_))
+ (if (not _gboolean2) (snd-display #__line__ ";gtk widget child not visible"))
+ (if (not (= _gint 65536)) (snd-display #__line__ ";gtk widget events: ~A" _gint))
+ (if (not (= _GtkTextDirection1 1)) (snd-display #__line__ ";gtk widget get dir: ~A" _GtkTextDirection1))
+ (if (not _gboolean4) (snd-display #__line__ ";gtk widget no screen"))
+ (if _gboolean5 (snd-display #__line__ ";gtk widget show all"))
+ (if (not _gboolean8) (snd-display #__line__ ";gtk widget child not focussed"))
+ (if _gboolean9 (snd-display #__line__ ";gtk widget ancestor shell"))
+ (if (not _gboolean11) (snd-display #__line__ ";gtk widget no intersect"))
+ (if (not (equal? vals (list -1 -1))) (snd-display #__line__ ";gtk widget size request: ~A" vals))
(gtk_widget_modify_fg _GtkWidget5_ GTK_STATE_NORMAL _GdkColor_)
(gtk_widget_modify_bg _GtkWidget5_ GTK_STATE_NORMAL _GdkColor_)
(gtk_widget_modify_text _GtkWidget5_ GTK_STATE_NORMAL _GdkColor_)
@@ -62091,23 +62189,23 @@ EDITS: 1
(gtk_widget_reset_shapes _GtkWidget5_)
(gtk_widget_queue_draw_area _GtkWidget5_ 0 0 100 100)
(set! _gchar_ (gtk_widget_get_name _GtkWidget5_))
- (if (not (string=? _gchar_ "hi")) (snd-display ";set gtk widget name: ~A" _gchar_)))
+ (if (not (string=? _gchar_ "hi")) (snd-display #__line__ ";set gtk widget name: ~A" _gchar_)))
(let* ((_GtkFrame_ (GTK_FRAME (gtk_frame_new "hi")))
(_GtkAspectFrame_ (GTK_ASPECT_FRAME (gtk_aspect_frame_new "hi" 1.0 2.0 3.0 #f)))
(_gchar_ (gtk_frame_get_label _GtkFrame_))
(_GtkWidget_ (gtk_frame_get_label_widget _GtkFrame_))
(_GtkShadowType (gtk_frame_get_shadow_type _GtkFrame_)))
- (if (not (string=? _gchar_ "hi")) (snd-display ";frame label: ~A" _gchar_))
+ (if (not (string=? _gchar_ "hi")) (snd-display #__line__ ";frame label: ~A" _gchar_))
(gtk_frame_set_label _GtkFrame_ "ho") ; actually sets label widget
(gtk_frame_set_label_widget _GtkFrame_ (gtk_label_new "ha"))
- (if (not (= _GtkShadowType GTK_SHADOW_ETCHED_IN)) (snd-display ";frame shadow: ~A" _GtkShadowType))
+ (if (not (= _GtkShadowType GTK_SHADOW_ETCHED_IN)) (snd-display #__line__ ";frame shadow: ~A" _GtkShadowType))
(gtk_frame_set_shadow_type _GtkFrame_ GTK_SHADOW_OUT)
(set! _GtkShadowType (gtk_frame_get_shadow_type _GtkFrame_))
- (if (not (= _GtkShadowType GTK_SHADOW_OUT)) (snd-display ";set frame shadow: ~A" _GtkShadowType))
+ (if (not (= _GtkShadowType GTK_SHADOW_OUT)) (snd-display #__line__ ";set frame shadow: ~A" _GtkShadowType))
(gtk_frame_set_label_align _GtkFrame_ .1 .1)
(let ((vals (gtk_frame_get_label_align _GtkFrame_)))
- (if (not (feql vals (list .1 .1))) (snd-display ";set frame align: ~A" vals)))
+ (if (not (feql vals (list .1 .1))) (snd-display #__line__ ";set frame align: ~A" vals)))
(gtk_aspect_frame_set _GtkAspectFrame_ .1 .2 .3 #f))
(let* ((_GtkDialog_ (GTK_DIALOG (gtk_dialog_new)))
@@ -62118,12 +62216,12 @@ EDITS: 1
(_GtkFontSelection_ (GTK_FONT_SELECTION (gtk_font_selection_new)))
(dialog (gtk_dialog_new_with_buttons "title" (GTK_WINDOW (cadr (main-widgets))) 0
(list GTK_STOCK_OK GTK_RESPONSE_ACCEPT GTK_STOCK_CANCEL GTK_RESPONSE_REJECT)))
-; (_GtkFileChooser_ (GTK_FILE_CHOOSER (gtk_file_chooser_widget_new GTK_FILE_CHOOSER_ACTION_OPEN)))
-; (_GtkFileChooserDialog_ (GTK_FILE_CHOOSER_DIALOG (gtk_file_chooser_dialog_new
-; "save" (GTK_WINDOW (cadr (main-widgets)))
-; GTK_FILE_CHOOSER_ACTION_SAVE (list GTK_STOCK_OK GTK_RESPONSE_ACCEPT))))
-; (_GtkFileSelection_ (GTK_FILE_SELECTION (gtk_file_selection_new "delete")))
-; (_GtkWidget_ (gtk_file_chooser_widget_new_with_backend 0 "linux"))
+ ; (_GtkFileChooser_ (GTK_FILE_CHOOSER (gtk_file_chooser_widget_new GTK_FILE_CHOOSER_ACTION_OPEN)))
+ ; (_GtkFileChooserDialog_ (GTK_FILE_CHOOSER_DIALOG (gtk_file_chooser_dialog_new
+ ; "save" (GTK_WINDOW (cadr (main-widgets)))
+ ; GTK_FILE_CHOOSER_ACTION_SAVE (list GTK_STOCK_OK GTK_RESPONSE_ACCEPT))))
+ ; (_GtkFileSelection_ (GTK_FILE_SELECTION (gtk_file_selection_new "delete")))
+ ; (_GtkWidget_ (gtk_file_chooser_widget_new_with_backend 0 "linux"))
(_GtkFileFilter_ (gtk_file_filter_new))
(_GdkColor_ (let ((tmp (GdkColor)))
(gdk_color_parse "red" tmp)
@@ -62143,14 +62241,14 @@ EDITS: 1
(_gboolean3 (gtk_dialog_get_has_separator _GtkDialog_))
(_GtkWidget_1 (gtk_dialog_add_button _GtkDialog_ "yow" 1))
)
- (if (not _gboolean) (snd-display ";dialog opacity"))
- (if _gboolean1 (snd-display ";dialog palette"))
- (if (not (= _guint16 65535)) (snd-display ";dialog alpha: ~A" _guint16))
- (if (not (= _guint161 65535)) (snd-display ";dialog prev alpha: ~A" _guint161))
- (if _gboolean2 (snd-display ";dialog adjusting"))
- (if (not (string=? _gchar_1 "Sans 10")) (snd-display ";dialog font: ~A" _gchar_1))
- (if (not (string=? _gchar_4 "abcdefghijk ABCDEFGHIJK")) (snd-display ";dialog preview text: ~A" _gchar_4))
- (if (not _gboolean3) (snd-display ";dialog no sep"))
+ (if (not _gboolean) (snd-display #__line__ ";dialog opacity"))
+ (if _gboolean1 (snd-display #__line__ ";dialog palette"))
+ (if (not (= _guint16 65535)) (snd-display #__line__ ";dialog alpha: ~A" _guint16))
+ (if (not (= _guint161 65535)) (snd-display #__line__ ";dialog prev alpha: ~A" _guint161))
+ (if _gboolean2 (snd-display #__line__ ";dialog adjusting"))
+ (if (not (string=? _gchar_1 "Sans 10")) (snd-display #__line__ ";dialog font: ~A" _gchar_1))
+ (if (not (string=? _gchar_4 "abcdefghijk ABCDEFGHIJK")) (snd-display #__line__ ";dialog preview text: ~A" _gchar_4))
+ (if (not _gboolean3) (snd-display #__line__ ";dialog no sep"))
(gtk_color_selection_set_current_alpha _GtkColorSelection_ 12345)
(gtk_color_selection_set_previous_alpha _GtkColorSelection_ 54321)
(gtk_dialog_set_default_response _GtkDialog_ 0)
@@ -62189,7 +62287,7 @@ EDITS: 1
(gtk_toggle_action_set_active _GtkToggleAction_ #t)
(gtk_toggle_action_set_draw_as_radio _GtkToggleAction_ #f)
; (let ((_GtkAction_1 (gtk_action_group_get_action _GtkActionGroup_ "unique")))
- ; (if (not (equal? _GtkAction_ _GtkAction_1)) (snd-display ";gtk_action_group_get_action: ~A, returned ~A" _GtkAction_ _GtkAction_1)))
+ ; (if (not (equal? _GtkAction_ _GtkAction_1)) (snd-display #__line__ ";gtk_action_group_get_action: ~A, returned ~A" _GtkAction_ _GtkAction_1)))
; appears to depend on test above commented out
(gtk_ui_manager_insert_action_group _GtkUIManager_ _GtkActionGroup_ 0)
(gtk_ui_manager_set_add_tearoffs _GtkUIManager_ #f)
@@ -62282,54 +62380,54 @@ EDITS: 1
(_GtkJustification (gtk_text_view_get_justification _GtkTextView_1))
(_PangoTabArray_ (gtk_text_view_get_tabs _GtkTextView_1))
(_GtkTextMark_2 (gtk_text_buffer_get_mark _GtkTextBuffer_ "mark-name")))
- (if (not (equal? _GtkTextBuffer_ _GtkTextBuffer_1)) (snd-display ";iter text buffer: ~A ~A" _GtkTextBuffer_ _GtkTextBuffer_1))
- (if (not (equal? _GtkTextBuffer_ _GtkTextBuffer_3)) (snd-display ";view text buffer: ~A ~A" _GtkTextBuffer_ _GtkTextBuffer_3))
- (if (not (equal? _GtkTextBuffer_1 _GtkTextBuffer_2)) (snd-display ";mark text buffer: ~A ~A" _GtkTextBuffer_1 _GtkTextBuffer_2))
- (if (not (equal? _GtkTextTag_1 _GtkTextTag_2)) (snd-display ";view text tag: ~A ~A" _GtkTextTag_1 _GtkTextTag_2))
- (if (not (= _gint 1)) (snd-display ";text lines: ~A" _gint))
- (if (not (= _gint1 5)) (snd-display ";text chars: ~A" _gint1))
- (if (not (= _gint2 5)) (snd-display ";text iter offset:~A" _gint2))
- (if (not (= _gint3 0)) (snd-display ";text iter line:~A" _gint3))
- (if (not (= _gint4 5)) (snd-display ";text iter line offset:~A" _gint4))
- (if (not (= _gint5 7)) (snd-display ";text iter index:~A" _gint5))
- (if (not (= _gint6 5)) (snd-display ";text vis line offset:~A" _gint6))
- (if (not (= _gint7 7)) (snd-display ";text vis line index:~A" _gint7))
- (if (not (= _gint8 5)) (snd-display ";text chars in line:~A" _gint8))
- (if (not (= _gint9 7)) (snd-display ";text bytes in line:~A" _gint9))
- (if (not (= _gint10 0)) (snd-display ";text priority:~A" _gint10))
- (if (not (= _gint11 1)) (snd-display ";text table size:~A" _gint11))
- (if (not (= _gint12 0)) (snd-display ";text left margin:~A" _gint12))
- (if (not (= _gint13 0)) (snd-display ";text right margin:~A" _gint13))
- (if (not (= _gint14 0)) (snd-display ";text indent:~A" _gint14))
- (if (not (= _gint15 0)) (snd-display ";text above:~A" _gint15))
- (if (not (= _gint16 0)) (snd-display ";text below:~A" _gint16))
- (if (not (= _gint17 0)) (snd-display ";text inside:~A" _gint17))
- (if (not (= _gint18 0)) (snd-display ";text iter compare:~A" _gint18))
- (if (not (eq? _gboolean #t)) (snd-display ";text modified"))
- (if (not (eq? _gboolean1 #f)) (snd-display ";text starts word"))
- (if (not (eq? _gboolean2 #f)) (snd-display ";text ends word"))
- (if (not (eq? _gboolean3 #f)) (snd-display ";text inside word"))
- (if (not (eq? _gboolean4 #f)) (snd-display ";text starts sentence"))
- (if (not (eq? _gboolean5 #t)) (snd-display ";text ends sentence"))
- (if (not (eq? _gboolean6 #f)) (snd-display ";text inside sentence"))
- (if (not (eq? _gboolean7 #f)) (snd-display ";text starts line"))
- (if (not (eq? _gboolean8 #t)) (snd-display ";text ends line"))
- (if (not (eq? _gboolean9 #t)) (snd-display ";text is cursor"))
- (if (not (eq? _gboolean10 #t)) (snd-display ";text is end"))
- (if (not (eq? _gboolean11 #f)) (snd-display ";text is start"))
- (if (not (eq? _gboolean12 #t)) (snd-display ";text editable"))
- (if (not (eq? _gboolean13 #f)) (snd-display ";text overwrite"))
- (if (not (eq? _gboolean14 #t)) (snd-display ";text tabs"))
- (if (not (eq? _gboolean15 #t)) (snd-display ";text iters equal"))
- (if (not (eq? _gboolean16 #f)) (snd-display ";text begins tag"))
- (if (not (eq? _gboolean17 #f)) (snd-display ";text ends tag"))
- (if (not (eq? _gboolean18 #f)) (snd-display ";text toggles tag"))
- (if (not (eq? _gboolean19 #f)) (snd-display ";text has attr"))
- (if (not (eq? _gboolean20 #f)) (snd-display ";text get attr"))
- (if (not (eq? _gboolean21 #f)) (snd-display ";text mark get visible"))
- (if (not (string=? _char_ "mark-name")) (snd-display ";text mark name: ~A" _char_))
- (if (not (= _GtkWrapMode 0)) (snd-display ";text wrap: ~A" _gtkWrapMode))
- (if (not (= _GtkJustification 0)) (snd-display ";text just: ~A" _GtkJustification))
+ (if (not (equal? _GtkTextBuffer_ _GtkTextBuffer_1)) (snd-display #__line__ ";iter text buffer: ~A ~A" _GtkTextBuffer_ _GtkTextBuffer_1))
+ (if (not (equal? _GtkTextBuffer_ _GtkTextBuffer_3)) (snd-display #__line__ ";view text buffer: ~A ~A" _GtkTextBuffer_ _GtkTextBuffer_3))
+ (if (not (equal? _GtkTextBuffer_1 _GtkTextBuffer_2)) (snd-display #__line__ ";mark text buffer: ~A ~A" _GtkTextBuffer_1 _GtkTextBuffer_2))
+ (if (not (equal? _GtkTextTag_1 _GtkTextTag_2)) (snd-display #__line__ ";view text tag: ~A ~A" _GtkTextTag_1 _GtkTextTag_2))
+ (if (not (= _gint 1)) (snd-display #__line__ ";text lines: ~A" _gint))
+ (if (not (= _gint1 5)) (snd-display #__line__ ";text chars: ~A" _gint1))
+ (if (not (= _gint2 5)) (snd-display #__line__ ";text iter offset:~A" _gint2))
+ (if (not (= _gint3 0)) (snd-display #__line__ ";text iter line:~A" _gint3))
+ (if (not (= _gint4 5)) (snd-display #__line__ ";text iter line offset:~A" _gint4))
+ (if (not (= _gint5 7)) (snd-display #__line__ ";text iter index:~A" _gint5))
+ (if (not (= _gint6 5)) (snd-display #__line__ ";text vis line offset:~A" _gint6))
+ (if (not (= _gint7 7)) (snd-display #__line__ ";text vis line index:~A" _gint7))
+ (if (not (= _gint8 5)) (snd-display #__line__ ";text chars in line:~A" _gint8))
+ (if (not (= _gint9 7)) (snd-display #__line__ ";text bytes in line:~A" _gint9))
+ (if (not (= _gint10 0)) (snd-display #__line__ ";text priority:~A" _gint10))
+ (if (not (= _gint11 1)) (snd-display #__line__ ";text table size:~A" _gint11))
+ (if (not (= _gint12 0)) (snd-display #__line__ ";text left margin:~A" _gint12))
+ (if (not (= _gint13 0)) (snd-display #__line__ ";text right margin:~A" _gint13))
+ (if (not (= _gint14 0)) (snd-display #__line__ ";text indent:~A" _gint14))
+ (if (not (= _gint15 0)) (snd-display #__line__ ";text above:~A" _gint15))
+ (if (not (= _gint16 0)) (snd-display #__line__ ";text below:~A" _gint16))
+ (if (not (= _gint17 0)) (snd-display #__line__ ";text inside:~A" _gint17))
+ (if (not (= _gint18 0)) (snd-display #__line__ ";text iter compare:~A" _gint18))
+ (if (not (eq? _gboolean #t)) (snd-display #__line__ ";text modified"))
+ (if (not (eq? _gboolean1 #f)) (snd-display #__line__ ";text starts word"))
+ (if (not (eq? _gboolean2 #f)) (snd-display #__line__ ";text ends word"))
+ (if (not (eq? _gboolean3 #f)) (snd-display #__line__ ";text inside word"))
+ (if (not (eq? _gboolean4 #f)) (snd-display #__line__ ";text starts sentence"))
+ (if (not (eq? _gboolean5 #t)) (snd-display #__line__ ";text ends sentence"))
+ (if (not (eq? _gboolean6 #f)) (snd-display #__line__ ";text inside sentence"))
+ (if (not (eq? _gboolean7 #f)) (snd-display #__line__ ";text starts line"))
+ (if (not (eq? _gboolean8 #t)) (snd-display #__line__ ";text ends line"))
+ (if (not (eq? _gboolean9 #t)) (snd-display #__line__ ";text is cursor"))
+ (if (not (eq? _gboolean10 #t)) (snd-display #__line__ ";text is end"))
+ (if (not (eq? _gboolean11 #f)) (snd-display #__line__ ";text is start"))
+ (if (not (eq? _gboolean12 #t)) (snd-display #__line__ ";text editable"))
+ (if (not (eq? _gboolean13 #f)) (snd-display #__line__ ";text overwrite"))
+ (if (not (eq? _gboolean14 #t)) (snd-display #__line__ ";text tabs"))
+ (if (not (eq? _gboolean15 #t)) (snd-display #__line__ ";text iters equal"))
+ (if (not (eq? _gboolean16 #f)) (snd-display #__line__ ";text begins tag"))
+ (if (not (eq? _gboolean17 #f)) (snd-display #__line__ ";text ends tag"))
+ (if (not (eq? _gboolean18 #f)) (snd-display #__line__ ";text toggles tag"))
+ (if (not (eq? _gboolean19 #f)) (snd-display #__line__ ";text has attr"))
+ (if (not (eq? _gboolean20 #f)) (snd-display #__line__ ";text get attr"))
+ (if (not (eq? _gboolean21 #f)) (snd-display #__line__ ";text mark get visible"))
+ (if (not (string=? _char_ "mark-name")) (snd-display #__line__ ";text mark name: ~A" _char_))
+ (if (not (= _GtkWrapMode 0)) (snd-display #__line__ ";text wrap: ~A" _gtkWrapMode))
+ (if (not (= _GtkJustification 0)) (snd-display #__line__ ";text just: ~A" _GtkJustification))
(let* ((_gint 1)
(_gboolean22 (gtk_text_iter_backward_chars _GtkTextIter_ _gint))
(_gboolean23 (gtk_text_iter_forward_chars _GtkTextIter_ _gint))
@@ -62472,15 +62570,15 @@ EDITS: 1
(_guint1 (g_timeout_add 200 (lambda (n) #t) #f))
(_GtkEventBox_ (GTK_EVENT_BOX (gtk_event_box_new)))
(_guint32 (gtk_get_current_event_time)))
- (if (not (string=? _gchar_ "notify")) (snd-display ";g signal name: ~A" _gchar_))
+ (if (not (string=? _gchar_ "notify")) (snd-display #__line__ ";g signal name: ~A" _gchar_))
(g_source_remove _guint)
(g_source_remove _guint1)
(gtk_event_box_set_visible_window _GtkEventBox_ #f)
(gtk_event_box_set_above_child _GtkEventBox_ #f)
(let* ((_gboolean (gtk_event_box_get_visible_window _GtkEventBox_))
(_gboolean1 (gtk_event_box_get_above_child _GtkEventBox_)))
- (if _gboolean (snd-display ";event box visible"))
- (if _gboolean1 (snd-display ";event box above")))
+ (if _gboolean (snd-display #__line__ ";event box visible"))
+ (if _gboolean1 (snd-display #__line__ ";event box above")))
(let* ((_PangoCoverage_ (pango_coverage_new))
(_PangoCoverage_1 (pango_coverage_ref _PangoCoverage_))
(_PangoCoverage_2 (pango_coverage_copy _PangoCoverage_))
@@ -62521,28 +62619,28 @@ EDITS: 1
(_guint16 (gtk_color_button_get_alpha _GtkColorButton_))
(_gboolean4 (gtk_color_button_get_use_alpha _GtkColorButton_))
(_gchar_2 (gtk_color_button_get_title _GtkColorButton_)))
- (if (not (string=? _gchar_ "hi")) (snd-display ";font button title: ~A" _gchar_))
- (if (not _gboolean) (snd-display ";font button use font"))
- (if _gboolean1 (snd-display ";font button use size"))
- (if (not (string=? _gchar_1 "Monospace 10")) (snd-display ";font button font: ~A" _gchar_1))
- (if _gboolean2 (snd-display ";font button style"))
- (if _gboolean3 (snd-display ";font button size"))
- (if (not (= _guint16 12345)) (snd-display ";color button alpha: ~A" _guint16))
- (if _gboolean4 (snd-display ";color button alpha"))
- (if (not (string=? _gchar_2 "hi")) (snd-display ";color button title: ~A" _gchar_2))))
+ (if (not (string=? _gchar_ "hi")) (snd-display #__line__ ";font button title: ~A" _gchar_))
+ (if (not _gboolean) (snd-display #__line__ ";font button use font"))
+ (if _gboolean1 (snd-display #__line__ ";font button use size"))
+ (if (not (string=? _gchar_1 "Monospace 10")) (snd-display #__line__ ";font button font: ~A" _gchar_1))
+ (if _gboolean2 (snd-display #__line__ ";font button style"))
+ (if _gboolean3 (snd-display #__line__ ";font button size"))
+ (if (not (= _guint16 12345)) (snd-display #__line__ ";color button alpha: ~A" _guint16))
+ (if _gboolean4 (snd-display #__line__ ";color button alpha"))
+ (if (not (string=? _gchar_2 "hi")) (snd-display #__line__ ";color button title: ~A" _gchar_2))))
(let* ((_GtkAlignment_ (GTK_ALIGNMENT (gtk_alignment_new .1 .2 .3 .4)))
(_GtkMisc_ (GTK_MISC (gtk_label_new "hi"))))
(gtk_alignment_set_padding _GtkAlignment_ 0 1 2 3)
(let ((vals (gtk_alignment_get_padding _GtkAlignment_)))
- (if (not (equal? vals (list 0 1 2 3))) (snd-display ";alignment pad: ~A" vals)))
+ (if (not (equal? vals (list 0 1 2 3))) (snd-display #__line__ ";alignment pad: ~A" vals)))
(gtk_alignment_set _GtkAlignment_ .1 .2 .3 .4)
(gtk_misc_set_alignment _GtkMisc_ .1 .2)
(let ((vals (gtk_misc_get_alignment _GtkMisc_)))
- (if (not (feql vals (list .1 .2))) (snd-display ";misc align: ~A" vals)))
+ (if (not (feql vals (list .1 .2))) (snd-display #__line__ ";misc align: ~A" vals)))
(gtk_misc_set_padding _GtkMisc_ 0 1)
(let ((vals (gtk_misc_get_padding _GtkMisc_)))
- (if (not (equal? vals (list 0 1))) (snd-display ";misc pad: ~A" vals))))
+ (if (not (equal? vals (list 0 1))) (snd-display #__line__ ";misc pad: ~A" vals))))
(let* ((_GdkDisplay_ (gdk_display_get_default))
(vals (gdk_display_get_maximal_cursor_size _GdkDisplay_))
(_GdkAtom (gdk_atom_intern "PRIMARY" #f))
@@ -62613,31 +62711,31 @@ EDITS: 1
(_gboolean9 (gtk_tree_view_get_rules_hint _GtkTreeView_))
(_gchar_ (gtk_tree_view_column_get_title _GtkTreeViewColumn_))
(_gfloat (gtk_tree_view_column_get_alignment _GtkTreeViewColumn_)))
- (if (not (equal? vals (list 1 0))) (snd-display ";scrolled policy: ~A" vals))
- (if (not (= _GtkCornerType 0)) (snd-display ";scrolled placement :~A" _GtkCornerType))
- (if (not (= _GtkShadowType 1)) (snd-display ";scrolled shadow :~A" _GtkShadowType))
- (if (and (not (= _gint 0)) (not (= _gint 1))) (snd-display ";tree col fix wid:~A" _gint))
- (if (not (= _gint1 -1)) (snd-display ";tree col max wid:~A" _gint1))
- (if (not (= _gint2 -1)) (snd-display ";tree col min wid :~A" _gint2))
- (if (not (= _gint3 -1)) (snd-display ";tree col sort id:~A" _gint3))
- (if (not (= _gint4 0)) (snd-display ";tree col spacing:~A" _gint4))
- (if (not (= _gint5 0)) (snd-display ";tree col wid:~A" _gint5))
- (if (not (= _gint6 0)) (snd-display ";tree view col:~A" _gint6))
- (if (not (= _gint7 1)) (snd-display ";tree model n col:~A" _gint7))
- (if (not (= _GtkTreeModelFlags 3)) (snd-display ";tree mode flags:~A" _GtkTreeModelFlags))
- (if (not (= _GtkSortType 0)) (snd-display ";tree view sort:~A" _GtkSortType))
- (if (not (eq? _gboolean #f)) (snd-display ";tree col click:~A" _gboolean))
- (if (not (eq? _gboolean1 #f)) (snd-display ";tree col expand:~A" _gboolean1))
- (if (not (eq? _gboolean2 #f)) (snd-display ";tree col reorder:~A" _gboolean2))
- (if (not (eq? _gboolean3 #f)) (snd-display ";tree col resize:~A" _gboolean3))
- (if (not (eq? _gboolean4 #f)) (snd-display ";tree col sort:~A" _gboolean4))
- (if (not (eq? _gboolean5 #t)) (snd-display ";tree col vis:~A" _gboolean5))
- (if (not (eq? _gboolean6 #t)) (snd-display ";tree view search:~A" _gboolean6))
- (if (not (eq? _gboolean7 #t)) (snd-display ";tree view vis:~A" _gboolean7))
- (if (not (eq? _gboolean8 #f)) (snd-display ";tree view reorder:~A" _gboolean8))
- (if (not (eq? _gboolean9 #f)) (snd-display ";tree view hint:~A" _gboolean9))
- (if (not (string=? _gchar_ "hiho")) (snd-display ";tree col title:~A" _gchar_))
- (if (fneq _gfloat 0.0) (snd-display ";tree col align:~A" _gfloat))
+ (if (not (equal? vals (list 1 0))) (snd-display #__line__ ";scrolled policy: ~A" vals))
+ (if (not (= _GtkCornerType 0)) (snd-display #__line__ ";scrolled placement :~A" _GtkCornerType))
+ (if (not (= _GtkShadowType 1)) (snd-display #__line__ ";scrolled shadow :~A" _GtkShadowType))
+ (if (and (not (= _gint 0)) (not (= _gint 1))) (snd-display #__line__ ";tree col fix wid:~A" _gint))
+ (if (not (= _gint1 -1)) (snd-display #__line__ ";tree col max wid:~A" _gint1))
+ (if (not (= _gint2 -1)) (snd-display #__line__ ";tree col min wid :~A" _gint2))
+ (if (not (= _gint3 -1)) (snd-display #__line__ ";tree col sort id:~A" _gint3))
+ (if (not (= _gint4 0)) (snd-display #__line__ ";tree col spacing:~A" _gint4))
+ (if (not (= _gint5 0)) (snd-display #__line__ ";tree col wid:~A" _gint5))
+ (if (not (= _gint6 0)) (snd-display #__line__ ";tree view col:~A" _gint6))
+ (if (not (= _gint7 1)) (snd-display #__line__ ";tree model n col:~A" _gint7))
+ (if (not (= _GtkTreeModelFlags 3)) (snd-display #__line__ ";tree mode flags:~A" _GtkTreeModelFlags))
+ (if (not (= _GtkSortType 0)) (snd-display #__line__ ";tree view sort:~A" _GtkSortType))
+ (if (not (eq? _gboolean #f)) (snd-display #__line__ ";tree col click:~A" _gboolean))
+ (if (not (eq? _gboolean1 #f)) (snd-display #__line__ ";tree col expand:~A" _gboolean1))
+ (if (not (eq? _gboolean2 #f)) (snd-display #__line__ ";tree col reorder:~A" _gboolean2))
+ (if (not (eq? _gboolean3 #f)) (snd-display #__line__ ";tree col resize:~A" _gboolean3))
+ (if (not (eq? _gboolean4 #f)) (snd-display #__line__ ";tree col sort:~A" _gboolean4))
+ (if (not (eq? _gboolean5 #t)) (snd-display #__line__ ";tree col vis:~A" _gboolean5))
+ (if (not (eq? _gboolean6 #t)) (snd-display #__line__ ";tree view search:~A" _gboolean6))
+ (if (not (eq? _gboolean7 #t)) (snd-display #__line__ ";tree view vis:~A" _gboolean7))
+ (if (not (eq? _gboolean8 #f)) (snd-display #__line__ ";tree view reorder:~A" _gboolean8))
+ (if (not (eq? _gboolean9 #f)) (snd-display #__line__ ";tree view hint:~A" _gboolean9))
+ (if (not (string=? _gchar_ "hiho")) (snd-display #__line__ ";tree col title:~A" _gchar_))
+ (if (fneq _gfloat 0.0) (snd-display #__line__ ";tree col align:~A" _gfloat))
(gtk_scrolled_window_set_hadjustment _GtkScrolledWindow_ _GtkAdjustment_)
(gtk_scrolled_window_set_placement _GtkScrolledWindow_ _GtkCornerType)
(gtk_scrolled_window_set_vadjustment _GtkScrolledWindow_ _GtkAdjustment_1)
@@ -62679,7 +62777,7 @@ EDITS: 1
(let* ((_gboolean (gtk_combo_box_get_active_iter _GtkComboBox_ _GtkTreeIterc1_))
(_gintc1 (gtk_combo_box_entry_get_text_column _GtkComboBoxEntry_))
(_gintc2 (gtk_combo_box_get_active _GtkComboBox_)))
- (if (not (= _gintc2 0)) (snd-display ";combo box active: ~A" _gintc2))))
+ (if (not (= _gintc2 0)) (snd-display #__line__ ";combo box active: ~A" _gintc2))))
(let* ((_GtkTreePath_1 (gtk_tree_path_new))
(_GtkTreePath_2 (gtk_tree_path_new_first))
(_GtkTreePath_3 (gtk_tree_path_new_from_string "0"))
@@ -62723,15 +62821,15 @@ EDITS: 1
(_gboolean (gtk_tree_sortable_has_default_sort_func _GtkTreeSortable_))
(_list (gtk_tree_sortable_get_sort_column_id _GtkTreeSortable_ 0))
(_GtkSelectionMode (gtk_tree_selection_get_mode _GtkTreeSelection_)))
- (if (not (string=? _gchar_ "0")) (snd-display ";tree path: ~S" _gchar_))
- (if (not (string=? _gchar_1 "0")) (snd-display ";tree model iter path: ~S" _gchar_1))
- (if (not (= _gint 1)) (snd-display ";tree path depth: ~A" _gint))
- (if (not (equal? _gint_ (list 0))) (snd-display ";tree path indices: ~A" _gint_))
- (if (not (equal? _GtkTreeModel_ _GtkTreeModel_5)) (snd-display ";tree model filter get model: ~A ~A" _GtkTreeModel_ _GtkTreeModel_5))
- (if (not (equal? _GtkTreeModel_ _GtkTreeModel_6)) (snd-display ";tree model sort get model: ~A ~A" _GtkTreeModel_ _GtkTreeModel_6))
- (if (not (equal? vals (list 10 10))) (snd-display ";cell renderer fixed size: ~A" vals))
- (if (not (= _GType G_TYPE_STRING)) (snd-display ";tree model col type: ~A" _GType))
- (if (not (equal? _GtkTreeView_ _GtkTreeView_3)) (snd-display ";tree selection get view: ~A ~A" _GtkTreeView_ _GtkTreeView_3))
+ (if (not (string=? _gchar_ "0")) (snd-display #__line__ ";tree path: ~S" _gchar_))
+ (if (not (string=? _gchar_1 "0")) (snd-display #__line__ ";tree model iter path: ~S" _gchar_1))
+ (if (not (= _gint 1)) (snd-display #__line__ ";tree path depth: ~A" _gint))
+ (if (not (equal? _gint_ (list 0))) (snd-display #__line__ ";tree path indices: ~A" _gint_))
+ (if (not (equal? _GtkTreeModel_ _GtkTreeModel_5)) (snd-display #__line__ ";tree model filter get model: ~A ~A" _GtkTreeModel_ _GtkTreeModel_5))
+ (if (not (equal? _GtkTreeModel_ _GtkTreeModel_6)) (snd-display #__line__ ";tree model sort get model: ~A ~A" _GtkTreeModel_ _GtkTreeModel_6))
+ (if (not (equal? vals (list 10 10))) (snd-display #__line__ ";cell renderer fixed size: ~A" vals))
+ (if (not (= _GType G_TYPE_STRING)) (snd-display #__line__ ";tree model col type: ~A" _GType))
+ (if (not (equal? _GtkTreeView_ _GtkTreeView_3)) (snd-display #__line__ ";tree selection get view: ~A ~A" _GtkTreeView_ _GtkTreeView_3))
(gtk_tree_model_filter_clear_cache _GtkTreeModelFilter_)
(gtk_tree_model_unref_node _GtkTreeModel_ _GtkTreeIter_)
(gtk_tree_model_ref_node _GtkTreeModel_ _GtkTreeIter_)
@@ -62769,7 +62867,7 @@ EDITS: 1
(_gboolean7 (gtk_tree_selection_path_is_selected _GtkTreeSelection_ _GtkTreePath_3))
(_gboolean8 (gtk_tree_model_sort_iter_is_valid _GtkTreeModelSort_ _GtkTreeIter_))
(_GtkTreeDragDest_ (GTK_TREE_DRAG_DEST _GtkTreeModel_)))
- (if _gboolean7 (snd-display ";tree path selected"))
+ (if _gboolean7 (snd-display #__line__ ";tree path selected"))
(gtk_tree_view_set_drag_dest_row _GtkTreeView_ _GtkTreePath_3 GTK_TREE_VIEW_DROP_AFTER)
(gtk_tree_view_get_drag_dest_row _GtkTreeView_))
(gtk_tree_view_set_cursor _GtkTreeView_ _GtkTreePath_3 _GtkTreeViewColumn_ #f)
@@ -62790,7 +62888,7 @@ EDITS: 1
(gtk_tree_store_append _GtkTreeStore_ _GtkTreeIter_t #f)
(gtk_tree_store_set _GtkTreeStore_ _GtkTreeIter_t '(0 "hiho"))
(let ((_gint (gtk_tree_store_iter_depth _GtkTreeStore_ _GtkTreeIter_t)))
- (if (not (= _gint 0)) (snd-display ";tree store iter depth: ~A" _gint))
+ (if (not (= _gint 0)) (snd-display #__line__ ";tree store iter depth: ~A" _gint))
;(gtk_tree_iter_free _GtkTreeIter_t2)
))
(let* ((_GtkScrolledWindow_1 (GTK_SCROLLED_WINDOW (gtk_scrolled_window_new #f #f)))
@@ -62806,12 +62904,12 @@ EDITS: 1
(_GtkTreePath_8 (gtk_tree_path_new_from_string "0"))
(_GtkTreeRowReference_1 (gtk_tree_row_reference_new _GtkTreeModel_ _GtkTreePath_8))
(_gboolean (gtk_tree_row_reference_valid _GtkTreeRowReference_1)))
- (if (not (= _GtkShadowType GTK_SHADOW_OUT)) (snd-display ";viewport shadow: ~A" _GtkShadowType))
+ (if (not (= _GtkShadowType GTK_SHADOW_OUT)) (snd-display #__line__ ";viewport shadow: ~A" _GtkShadowType))
(gtk_tree_row_reference_free _GtkTreeRowReference_1)))
(gtk_tree_view_column_clear _GtkTreeViewColumn_)
(gtk_tree_view_get_cursor _GtkTreeView_)
(let ((_int (gtk_tree_selection_count_selected_rows _GtkTreeSelection_)))
- (if (not (= _int 0)) (snd-display ";tree selection selected rows: ~A" _int)))
+ (if (not (= _int 0)) (snd-display #__line__ ";tree selection selected rows: ~A" _int)))
(gtk_list_store_clear _GtkListStore_2)
(let* ((_GtkTreePath_ (gtk_tree_model_filter_convert_child_path_to_path _GtkTreeModelFilter_ _GtkTreePath_3))
(_GdkPixmap_ (gtk_tree_view_create_row_drag_icon _GtkTreeView_ _GtkTreePath_3))
@@ -62837,13 +62935,13 @@ EDITS: 1
(_gboolean13 (gtk_tree_model_iter_has_child _GtkTreeModel_ _GtkTreeIter_2))
(_gboolean15 (gtk_tree_model_iter_nth_child _GtkTreeModel_ _GtkTreeIter_2 _GtkTreeIter_3 0))
(_gboolean16 (gtk_tree_model_iter_parent _GtkTreeModel_ _GtkTreeIter_2 _GtkTreeIter_3)))
- (if _gboolean10 (snd-display ";tree path copy is ancestor"))
- (if _gboolean11 (snd-display ";tree path copy is descendent"))))))
+ (if _gboolean10 (snd-display #__line__ ";tree path copy is ancestor"))
+ (if _gboolean11 (snd-display #__line__ ";tree path copy is descendent"))))))
(let* ((_GtkSizeGroup_ (gtk_size_group_new GTK_SIZE_GROUP_VERTICAL))
(_GtkSizeGroupMode (gtk_size_group_get_mode _GtkSizeGroup_))
(_lab (gtk_label_new "hi")))
- (if (not (= _GtkSizeGroupMode GTK_SIZE_GROUP_VERTICAL)) (snd-display ";size group mode: ~A" _GtkSizeGroupMode))
+ (if (not (= _GtkSizeGroupMode GTK_SIZE_GROUP_VERTICAL)) (snd-display #__line__ ";size group mode: ~A" _GtkSizeGroupMode))
(gtk_size_group_add_widget _GtkSizeGroup_ _lab)
(gtk_size_group_remove_widget _GtkSizeGroup_ _lab)
(gtk_size_group_set_mode _GtkSizeGroup_ GTK_SIZE_GROUP_HORIZONTAL))
@@ -62928,14 +63026,14 @@ EDITS: 1
(_GtkWidget_1 (gtk_label_new "1"))
(_GtkWidget_2 (gtk_label_new "2"))
(_GtkWidget_3 (gtk_label_new "3")))
- (if (not _gboolean) (snd-display ";box not homogenous"))
- (if (not (= _gint 0)) (snd-display ";box spacing: ~A" _gint))
+ (if (not _gboolean) (snd-display #__line__ ";box not homogenous"))
+ (if (not (= _gint 0)) (snd-display #__line__ ";box spacing: ~A" _gint))
(gtk_box_pack_start _GtkBox_ _GtkWidget_ #f #f 10)
-; (gtk_box_pack_start_defaults _GtkBox_ _GtkWidget_1)
+ ; (gtk_box_pack_start_defaults _GtkBox_ _GtkWidget_1)
(gtk_box_pack_end _GtkBox_ _GtkWidget_2 #t #t 10)
-; (gtk_box_pack_end_defaults _GtkBox_ _GtkWidget_3)
+ ; (gtk_box_pack_end_defaults _GtkBox_ _GtkWidget_3)
(let ((vals (gtk_box_query_child_packing _GtkBox_ _GtkWidget_)))
- (if (not (equal? vals (list #f #f 10 0))) (snd-display ";box child packing: ~A" vals)))
+ (if (not (equal? vals (list #f #f 10 0))) (snd-display #__line__ ";box child packing: ~A" vals)))
(gtk_box_set_homogeneous _GtkBox_ #t)
(gtk_box_set_spacing _GtkBox_ 4)
(gtk_box_reorder_child _GtkBox_ _GtkWidget_ 2)
@@ -62953,26 +63051,26 @@ EDITS: 1
(GTK_OBJECT_UNSET_FLAGS (GTK_OBJECT _GtkWidget_) 0))
(if (not (provided? 'cairo))
- (let* ((_GdkScreen_ (gdk_screen_get_default))
- (_GdkWindow_ (gdk_screen_get_root_window _GdkScreen_))
- (_GdkDrawable_ (GDK_DRAWABLE _GdkWindow_))
- (_GdkGC_ (gdk_gc_new _GdkDrawable_))
- (_GdkGC_1 (gdk_gc_new _GdkDrawable_)))
- (gdk_gc_copy _GdkGC_ _GdkGC_1)
- (gdk_gc_set_clip_origin _GdkGC_ 0 0)
- (gdk_gc_set_fill _GdkGC_ GDK_SOLID)
- (gdk_gc_set_exposures _GdkGC_ #f)
- (gdk_gc_set_function _GdkGC_ GDK_OR)
- (gdk_gc_offset _GdkGC_ 0 0)
- (gdk_gc_set_background _GdkGC_ (basic-color))
- (gdk_gc_set_colormap _GdkGC_ (gdk_colormap_get_system))
- (gdk_gc_set_foreground _GdkGC_ (highlight-color))
- (gdk_gc_set_clip_rectangle _GdkGC_ (GdkRectangle 0 0 100 100))
- (gdk_gc_set_rgb_bg_color _GdkGC_ (basic-color))
- (gdk_gc_set_rgb_fg_color _GdkGC_ (highlight-color))
- (gdk_gc_set_ts_origin _GdkGC_ 0 0)
- (gdk_gc_set_line_attributes _GdkGC_ 1 GDK_LINE_SOLID GDK_CAP_ROUND GDK_JOIN_MITER)
- (gdk_rgb_set_verbose #f)))
+ (let* ((_GdkScreen_ (gdk_screen_get_default))
+ (_GdkWindow_ (gdk_screen_get_root_window _GdkScreen_))
+ (_GdkDrawable_ (GDK_DRAWABLE _GdkWindow_))
+ (_GdkGC_ (gdk_gc_new _GdkDrawable_))
+ (_GdkGC_1 (gdk_gc_new _GdkDrawable_)))
+ (gdk_gc_copy _GdkGC_ _GdkGC_1)
+ (gdk_gc_set_clip_origin _GdkGC_ 0 0)
+ (gdk_gc_set_fill _GdkGC_ GDK_SOLID)
+ (gdk_gc_set_exposures _GdkGC_ #f)
+ (gdk_gc_set_function _GdkGC_ GDK_OR)
+ (gdk_gc_offset _GdkGC_ 0 0)
+ (gdk_gc_set_background _GdkGC_ (basic-color))
+ (gdk_gc_set_colormap _GdkGC_ (gdk_colormap_get_system))
+ (gdk_gc_set_foreground _GdkGC_ (highlight-color))
+ (gdk_gc_set_clip_rectangle _GdkGC_ (GdkRectangle 0 0 100 100))
+ (gdk_gc_set_rgb_bg_color _GdkGC_ (basic-color))
+ (gdk_gc_set_rgb_fg_color _GdkGC_ (highlight-color))
+ (gdk_gc_set_ts_origin _GdkGC_ 0 0)
+ (gdk_gc_set_line_attributes _GdkGC_ 1 GDK_LINE_SOLID GDK_CAP_ROUND GDK_JOIN_MITER)
+ (gdk_rgb_set_verbose #f)))
(let* ((_GtkCheckMenuItem_ (GTK_CHECK_MENU_ITEM (gtk_check_menu_item_new)))
(_GtkWidget_ (gtk_check_menu_item_new_with_label "hi"))
@@ -63004,11 +63102,11 @@ EDITS: 1
(_gboolean4 (gtk_menu_item_get_right_justified _GtkMenuItem_))
(_GtkWindow_ (GTK_WINDOW (cadr (main-widgets))))
(_GtkAction_ (gtk_action_new "unique" "label" "tooltip" GTK_STOCK_HELP)))
- (if _gboolean (snd-display ";menu item active"))
- (if _gboolean1 (snd-display ";menu item radio"))
- (if _gboolean2 (snd-display ";menu item inconsistent"))
- (if _gboolean3 (snd-display ";menu item tearoff"))
- (if _gboolean4 (snd-display ";menu item right justified"))
+ (if _gboolean (snd-display #__line__ ";menu item active"))
+ (if _gboolean1 (snd-display #__line__ ";menu item radio"))
+ (if _gboolean2 (snd-display #__line__ ";menu item inconsistent"))
+ (if _gboolean3 (snd-display #__line__ ";menu item tearoff"))
+ (if _gboolean4 (snd-display #__line__ ";menu item right justified"))
(gtk_menu_set_title _GtkMenu_ "title")
(gtk_menu_shell_append _GtkMenuShell_ (GTK_WIDGET _GtkMenuItem_))
(gtk_menu_shell_insert _GtkMenuShell_ (GTK_WIDGET _GtkMenuItem_1) 0)
@@ -63028,8 +63126,8 @@ EDITS: 1
(_GSList_ (gtk_accel_groups_from_object (G_OBJECT _GtkMenu_)))
(_list (gtk_accel_group_query _GtkAccelGroup_ GDK_C GDK_MOD1_MASK))
(_gboolean (gtk_accel_label_refetch _GtkAccelLabel_)))
- (if (not (= _guint 0)) (snd-display ";accel width: ~A" _guint))
- (if (not (string=? _gchar_ "title")) (snd-display ";menu title: ~A" _gchar_))
+ (if (not (= _guint 0)) (snd-display #__line__ ";accel width: ~A" _guint))
+ (if (not (string=? _gchar_ "title")) (snd-display #__line__ ";menu title: ~A" _gchar_))
(gtk_accel_map_foreach #f (lambda (a b c d e) #f))
(gtk_accel_map_foreach_unfiltered #f (lambda (a b c d e) #f)))
@@ -63046,9 +63144,9 @@ EDITS: 1
(let* ((vals (gtk_accelerator_parse "activate"))
(_gchar_ (gtk_accelerator_name GDK_C GDK_MOD1_MASK))
(_gboolean (gtk_accelerator_valid GDK_C GDK_MOD1_MASK)))
- (if (not _gboolean) (snd-display ";accelerator not valid"))
- (if (not (string=? _gchar_ "<Alt>c")) (snd-display ";accelerator name: ~A" _gchar_))
- (if (not (equal? vals (list 0 0))) (snd-display ";accelerator parse: ~A" vals)))
+ (if (not _gboolean) (snd-display #__line__ ";accelerator not valid"))
+ (if (not (string=? _gchar_ "<Alt>c")) (snd-display #__line__ ";accelerator name: ~A" _gchar_))
+ (if (not (equal? vals (list 0 0))) (snd-display #__line__ ";accelerator parse: ~A" vals)))
(gtk_menu_reposition _GtkMenu_)
(gtk_menu_item_activate _GtkMenuItem_)
(gtk_menu_set_active _GtkMenu_ 0)
@@ -63083,14 +63181,14 @@ EDITS: 1
(_gint (gtk_expander_get_spacing _GtkExpander_))
(_gint1 (gtk_editable_get_position _GtkEditable_))
(_GtkContainer_ (GTK_CONTAINER (gtk_vbox_new #t 0))))
- (if _gboolean (snd-display ";label is resize container"))
- (if (not _gboolean2) (snd-display ";editable not editable"))
- (if _gboolean3 (snd-display ";expander expanded"))
- (if _gboolean4 (snd-display ";expander use markup"))
- (if _gboolean5 (snd-display ";expander use underline"))
- (if (not (string=? "hi" _gchar_)) (snd-display ";expander name: ~A" _gchar_))
- (if (not (= _gint 0)) (snd-display ";expander spacing: ~A" _gint))
- (if (not (= _gint1 0)) (snd-display ";editable position: ~A" _gint1))
+ (if _gboolean (snd-display #__line__ ";label is resize container"))
+ (if (not _gboolean2) (snd-display #__line__ ";editable not editable"))
+ (if _gboolean3 (snd-display #__line__ ";expander expanded"))
+ (if _gboolean4 (snd-display #__line__ ";expander use markup"))
+ (if _gboolean5 (snd-display #__line__ ";expander use underline"))
+ (if (not (string=? "hi" _gchar_)) (snd-display #__line__ ";expander name: ~A" _gchar_))
+ (if (not (= _gint 0)) (snd-display #__line__ ";expander spacing: ~A" _gint))
+ (if (not (= _gint1 0)) (snd-display #__line__ ";editable position: ~A" _gint1))
(gtk_container_add _GtkContainer_ label)
(gtk_container_foreach _GtkContainer_ (lambda (w c) #f) #f)
(gtk_container_set_resize_mode _GtkContainer_ GTK_RESIZE_IMMEDIATE)
@@ -63102,7 +63200,7 @@ EDITS: 1
(gtk_editable_insert_text _GtkEditable_ "hiho" 4)
(gtk_editable_select_region _GtkEditable_ 1 2)
(let ((vals (gtk_editable_get_selection_bounds _GtkEditable_)))
- (if (not (equal? vals (list #t 1 2))) (snd-display ";editable selection: ~A" vals)))
+ (if (not (equal? vals (list #t 1 2))) (snd-display #__line__ ";editable selection: ~A" vals)))
(gtk_editable_set_position _GtkEditable_ 2)
(gtk_editable_delete_selection _GtkEditable_)
(gtk_editable_delete_text _GtkEditable_ 0 1)
@@ -63165,7 +63263,7 @@ EDITS: 1
(pango_layout_set_alignment _PangoLayout_ PANGO_ALIGN_LEFT)
(let* ((_PangoFontDescription_4 (pango_context_get_font_description _PangoContext_))
(_PangoDirection (pango_context_get_base_dir _PangoContext_)))
- (if (not (= _PangoDirection PANGO_DIRECTION_LTR)) (snd-display ";pango context base dir: ~A" _PangoDirection))
+ (if (not (= _PangoDirection PANGO_DIRECTION_LTR)) (snd-display #__line__ ";pango context base dir: ~A" _PangoDirection))
(pango_color_free _PangoColor_1)
(pango_font_description_set_family _PangoFontDescription_ "Monospace")
(pango_font_description_set_family_static _PangoFontDescription_ "Monospace")
@@ -63219,12 +63317,12 @@ EDITS: 1
(_PangoAttrList_1 (pango_layout_get_attributes _PangoLayout_))
(_PangoAttrList_ (pango_attr_list_new))
(_PangoAttrList_3 (pango_attr_list_new)))
- (if (not (string=? _char_ "Monospace")) (snd-display ";font descr familt: ~A" _char_))
- (if (not (= _PangoStretch PANGO_STRETCH_NORMAL)) (snd-display ";font descr stretch: ~A" _PangoStretch))
- (if (not (= _PangoStyle PANGO_STYLE_NORMAL)) (snd-display ";font descr style: ~A" _PangoStyle))
- (if (not (= _PangoWeight PANGO_WEIGHT_NORMAL)) (snd-display ";font descr weight: ~A" _PangoWeight))
- (if (not (= _PangoVariant PANGO_VARIANT_NORMAL)) (snd-display ";font descr variant: ~A" _PangoVariant))
- (if (not (= _PangoAlignment PANGO_ALIGN_LEFT)) (snd-display ";layout align: ~A" _PangoAlignment))
+ (if (not (string=? _char_ "Monospace")) (snd-display #__line__ ";font descr familt: ~A" _char_))
+ (if (not (= _PangoStretch PANGO_STRETCH_NORMAL)) (snd-display #__line__ ";font descr stretch: ~A" _PangoStretch))
+ (if (not (= _PangoStyle PANGO_STYLE_NORMAL)) (snd-display #__line__ ";font descr style: ~A" _PangoStyle))
+ (if (not (= _PangoWeight PANGO_WEIGHT_NORMAL)) (snd-display #__line__ ";font descr weight: ~A" _PangoWeight))
+ (if (not (= _PangoVariant PANGO_VARIANT_NORMAL)) (snd-display #__line__ ";font descr variant: ~A" _PangoVariant))
+ (if (not (= _PangoAlignment PANGO_ALIGN_LEFT)) (snd-display #__line__ ";layout align: ~A" _PangoAlignment))
(pango_layout_index_to_pos _PangoLayout_ 0 _PangoRectangle_)
(pango_layout_get_cursor_pos _PangoLayout_ 0 _PangoRectangle_1 _PangoRectangle_2)
(pango_layout_get_extents _PangoLayout_ _PangoRectangle_1 _PangoRectangle_2)
@@ -63278,231 +63376,231 @@ EDITS: 1
(pango_font_metrics_unref _PangoFontMetrics_1)))))
(if (not (provided? 'cairo))
- (let* ((_GdkScreen_ (gdk_screen_get_default))
- (_GtkWidget_ (cadr (main-widgets)))
- (scan-outer (let ((pane (gtk_hbox_new #f 0)))
- (gtk_box_pack_start (GTK_BOX (list-ref (main-widgets) 5)) pane #f #f 4)
- (gtk_widget_show pane)
- pane))
- (scan-pane (let ((grf (gtk_drawing_area_new)))
- (gtk_widget_set_events grf GDK_ALL_EVENTS_MASK)
- (gtk_box_pack_start (GTK_BOX scan-outer) grf #t #t 0)
- (gtk_widget_show grf)
- (gdk_window_set_background (gtk_widget_get_window grf) (graph-color))
- grf))
- (red-pixel
- (let ((tmp (GdkColor)))
- (gdk_color_parse "red" tmp)
- (let ((col (gdk_color_copy tmp)))
- (gdk_rgb_find_color (gdk_colormap_get_system) col)
- col)))
- (wnd (gtk_widget_get_window scan-pane))
- (_GdkWindow_ wnd)
- (wn (GDK_DRAWABLE wnd))
- (vect (make-vector 4 0))
- (pts1 #f)
- (vals (gdk_drawable_get_size wn))
- (_GdkColormap_ (gdk_colormap_get_system))
- (_GdkColor_ (gdk_color_copy red-pixel))
- (_gboolean (gdk_color_equal _GdkColor_ red-pixel))
- (_gboolean1 (gdk_colormap_alloc_color _GdkColormap_ _GdkColor_ #f #f))
- (_PangoLayout_ (gtk_widget_create_pango_layout scan-pane "hi"))
- (_GdkRegion_ (gdk_drawable_get_clip_region wn))
- (_GdkRegion_1 (gdk_drawable_get_visible_region wn))
- (_GdkVisual_ (gdk_drawable_get_visual wn))
- (_GdkAtom (gdk_atom_intern "MY_MESSAGE" #t))
- (_GtkIMContext_ (gtk_im_context_simple_new))
- (_GtkIMContext_1 (gtk_im_multicontext_new))
- (_GtkWindow_ (GTK_WINDOW (cadr (main-widgets))))
- (_GdkWindow_1 (gdk_selection_owner_get GDK_SELECTION_PRIMARY))
- (_gchar_ (gdk_atom_name GDK_SELECTION_SECONDARY))
- (_gchar_1 (gdk_utf8_to_string_target "hiho"))
- (_gchar_2 (gtk_check_version 2 3 1))
- (_guint (gtk_container_get_border_width (GTK_CONTAINER scan-outer)))
- (_GtkResizeMode (gtk_container_get_resize_mode (GTK_CONTAINER scan-outer)))
- (zero (g_signal_lookup "activate" G_TYPE_OBJECT))
- (_int (gdk_screen_get_monitor_at_point _GdkScreen_ 0 0))
- (_int1 (gdk_screen_get_monitor_at_window _GdkScreen_ _GdkWindow_))
- (_gint (gdk_drawable_get_depth wn))
- (hi (g_quark_from_string "hiho")))
- (if (not (string=? (g_quark_to_string hi) "hiho")) (snd-display ";g quark/string: ~A ~A" hi (g_quark_to_string hi)))
- (if (not _gboolean) (snd-display ";gdk colors copy not equal"))
- (if (not (string=? _gchar_ "SECONDARY")) (snd-display ";atom name: ~A" _gchar_))
- (gdk_colormap_query_color _GdkColormap_ 0 _GdkColor_)
- (gdk_color_hash _GdkColor_)
- (gdk_set_double_click_time 200)
- (gdk_screen_get_monitor_geometry _GdkScreen_ 0 (GdkRectangle))
- (gdk_screen_set_default_colormap _GdkScreen_ _GdkColormap_)
- (vector-set! vect 1 10)
- (vector-set! vect 2 20)
- (vector-set! vect 3 30)
- (let ((sgc (car (snd-gcs))))
- (gdk_draw_rectangle wn sgc #t 0 0 100 100)
- (gdk_draw_line wn sgc 0 0 100 100)
- (gdk_draw_point wn sgc 10 10)
- (gdk_draw_arc wn sgc #f 10 10 20 20 0 (* 45 64))
- (gdk_add_client_message_filter (gdk_atom_intern "SND_MESSAGE" #f) (lambda (xe e d) #f) #f)
- (set! pts1 (vector->GdkPoints vect))
- (gdk_draw_lines wn sgc (list 'GdkPoint_ pts1) 2)
- (gdk_draw_segments wn sgc (list 'GdkSegment_ pts1) 1)
- (gdk_draw_points wn sgc (list 'GdkPoint_ pts1) 2)
- (gdk_draw_polygon wn sgc #f (list 'GdkPoint_ pts1) 2)
- (freeGdkPoints pts1)
- (gdk_drawable_set_colormap wn (gdk_colormap_get_system))
- (gdk_draw_layout wn sgc 0 0 _PangoLayout_))
- (gdk_window_clear wnd)
- (gdk_window_clear_area wnd 0 0 10 10)
- (gdk_window_clear_area_e wnd 0 0 10 10)
- (gdk_window_begin_paint_rect wnd (GdkRectangle 0 0 10 10))
- (let* ((_GdkImage_ (gdk_drawable_get_image wn 0 0 20 20)) ; -> #f
- (_GtkImage_ (GTK_IMAGE (gtk_image_new)))
- (_GtkImageType (gtk_image_get_storage_type _GtkImage_)))
- (gtk_image_set_from_stock _GtkImage_ GTK_STOCK_CANCEL 32)
- (let* ((_GdkPixbuf_ (gtk_image_get_pixbuf (GTK_IMAGE (gtk_image_new)))) ; -> #f
- (_GdkImage_1 (gdk_image_new GDK_IMAGE_NORMAL _GdkVisual_ 32 32))
- (_GdkImage_2 (gdk_drawable_copy_to_image wn _GdkImage_1 0 0 0 0 32 32))
- (_GdkPixbuf_1 (gdk_pixbuf_get_from_image _GdkPixbuf_ _GdkImage_1 _GdkColormap_ 0 0 0 0 32 32))
- (_GdkPixbuf_2 (gdk_pixbuf_copy _GdkPixbuf_1))
- (_GdkPixmap_ (gdk_pixmap_new (GDK_DRAWABLE (car (main-widgets))) 16 16 -1))
- (arrow-strs (list
- "16 12 6 1"
- " c None s None"
- ". c gray50"
- "X c black"
- "o c white"
- "O c yellow"
- "- c ivory2 s basiccolor"
- "--------X---------"
- "---------X--------"
- "----------X-------"
- "-----------X------"
- "------------X-----"
- "XXXXXXXXXXXXXX----"
- "------------X-----"
- "-----------X------"
- "----------X-------"
- "---------X--------"
- "--------X---------"
- "-------X----------"))
- (_GdkPixmap_1 (gdk_pixmap_create_from_xpm_d (GDK_DRAWABLE (car (main-widgets))) #f (basic-color) (list->c-array arrow-strs "gchar**")))
- (_GdkColorspace (gdk_pixbuf_get_colorspace _GdkPixbuf_1))
- (_GtkWidget_2 (gtk_image_new_from_pixbuf _GdkPixbuf_1))
- (_GdkPixbuf_3 (gdk_pixbuf_get_from_drawable _GdkPixbuf_1 (GDK_DRAWABLE _GdkPixmap_1) _GdkColormap_ 0 0 0 0 10 10))
- (_PangoContext_ (gdk_pango_context_get))
- (_PangoLayout_ (pango_layout_new _PangoContext_))
- (_GdkPixbuf_5 (gdk_pixbuf_new_from_xpm_data (list->c-array arrow-strs "char**")))
- (_GdkPixbuf_4 (gdk_pixbuf_new _GdkColorspace #f 8 10 10))
- (_gboolean (gdk_pixbuf_get_has_alpha _GdkPixbuf_5))
- (_guchar_ (gdk_pixbuf_get_pixels _GdkPixbuf_5))
- (_int (gdk_pixbuf_get_bits_per_sample _GdkPixbuf_5))
- (_int1 (gdk_pixbuf_get_height _GdkPixbuf_5))
- (_int2 (gdk_pixbuf_get_n_channels _GdkPixbuf_5))
- (_int3 (gdk_pixbuf_get_rowstride _GdkPixbuf_5))
- (_int4 (gdk_pixbuf_get_width _GdkPixbuf_5))
- (_gchar_ (gdk_pixbuf_get_option _GdkPixbuf_5 "hi")))
+ (let* ((_GdkScreen_ (gdk_screen_get_default))
+ (_GtkWidget_ (cadr (main-widgets)))
+ (scan-outer (let ((pane (gtk_hbox_new #f 0)))
+ (gtk_box_pack_start (GTK_BOX (list-ref (main-widgets) 5)) pane #f #f 4)
+ (gtk_widget_show pane)
+ pane))
+ (scan-pane (let ((grf (gtk_drawing_area_new)))
+ (gtk_widget_set_events grf GDK_ALL_EVENTS_MASK)
+ (gtk_box_pack_start (GTK_BOX scan-outer) grf #t #t 0)
+ (gtk_widget_show grf)
+ (gdk_window_set_background (gtk_widget_get_window grf) (graph-color))
+ grf))
+ (red-pixel
+ (let ((tmp (GdkColor)))
+ (gdk_color_parse "red" tmp)
+ (let ((col (gdk_color_copy tmp)))
+ (gdk_rgb_find_color (gdk_colormap_get_system) col)
+ col)))
+ (wnd (gtk_widget_get_window scan-pane))
+ (_GdkWindow_ wnd)
+ (wn (GDK_DRAWABLE wnd))
+ (vect (make-vector 4 0))
+ (pts1 #f)
+ (vals (gdk_drawable_get_size wn))
+ (_GdkColormap_ (gdk_colormap_get_system))
+ (_GdkColor_ (gdk_color_copy red-pixel))
+ (_gboolean (gdk_color_equal _GdkColor_ red-pixel))
+ (_gboolean1 (gdk_colormap_alloc_color _GdkColormap_ _GdkColor_ #f #f))
+ (_PangoLayout_ (gtk_widget_create_pango_layout scan-pane "hi"))
+ (_GdkRegion_ (gdk_drawable_get_clip_region wn))
+ (_GdkRegion_1 (gdk_drawable_get_visible_region wn))
+ (_GdkVisual_ (gdk_drawable_get_visual wn))
+ (_GdkAtom (gdk_atom_intern "MY_MESSAGE" #t))
+ (_GtkIMContext_ (gtk_im_context_simple_new))
+ (_GtkIMContext_1 (gtk_im_multicontext_new))
+ (_GtkWindow_ (GTK_WINDOW (cadr (main-widgets))))
+ (_GdkWindow_1 (gdk_selection_owner_get GDK_SELECTION_PRIMARY))
+ (_gchar_ (gdk_atom_name GDK_SELECTION_SECONDARY))
+ (_gchar_1 (gdk_utf8_to_string_target "hiho"))
+ (_gchar_2 (gtk_check_version 2 3 1))
+ (_guint (gtk_container_get_border_width (GTK_CONTAINER scan-outer)))
+ (_GtkResizeMode (gtk_container_get_resize_mode (GTK_CONTAINER scan-outer)))
+ (zero (g_signal_lookup "activate" G_TYPE_OBJECT))
+ (_int (gdk_screen_get_monitor_at_point _GdkScreen_ 0 0))
+ (_int1 (gdk_screen_get_monitor_at_window _GdkScreen_ _GdkWindow_))
+ (_gint (gdk_drawable_get_depth wn))
+ (hi (g_quark_from_string "hiho")))
+ (if (not (string=? (g_quark_to_string hi) "hiho")) (snd-display #__line__ ";g quark/string: ~A ~A" hi (g_quark_to_string hi)))
+ (if (not _gboolean) (snd-display #__line__ ";gdk colors copy not equal"))
+ (if (not (string=? _gchar_ "SECONDARY")) (snd-display #__line__ ";atom name: ~A" _gchar_))
+ (gdk_colormap_query_color _GdkColormap_ 0 _GdkColor_)
+ (gdk_color_hash _GdkColor_)
+ (gdk_set_double_click_time 200)
+ (gdk_screen_get_monitor_geometry _GdkScreen_ 0 (GdkRectangle))
+ (gdk_screen_set_default_colormap _GdkScreen_ _GdkColormap_)
+ (vector-set! vect 1 10)
+ (vector-set! vect 2 20)
+ (vector-set! vect 3 30)
(let ((sgc (car (snd-gcs))))
- (gdk_draw_image wn sgc _GdkImage_1 0 0 0 0 32 32)
- (gdk_draw_drawable wn sgc (GDK_DRAWABLE _GdkPixmap_1) 0 0 0 0 32 32)
- (gdk_draw_gray_image wn sgc 0 0 10 10 GDK_RGB_DITHER_NONE "hihohohio" 0)
- (gdk_draw_rgb_image wn sgc 0 0 10 10 GDK_RGB_DITHER_NONE "hihohohio" 0)
- (gdk_draw_rgb_32_image wn sgc 0 0 10 10 GDK_RGB_DITHER_NONE "hihohohio" 0)
- (pango_layout_set_text _PangoLayout_ "hiho" -1)
- (let ((_PangoLayoutLine_ (pango_layout_get_line _PangoLayout_ 0)))
- (gdk_draw_layout_line wn sgc 0 0 _PangoLayoutLine_))
- (gdk_pixbuf_fill _GdkPixbuf_3 0))))
-
-
- (gdk_color_free _GdkColor_)
- (gdk_rgb_set_min_colors 8)
- (let ((_GdkRgbCmap_ (gdk_rgb_cmap_new (list->c-array '(0 0 0 0 0 0 0 0) "guint32*") 8)))
- (gdk_rgb_cmap_free _GdkRgbCmap_))
- (gdk_property_change wnd _GdkAtom GDK_TARGET_STRING 8 GDK_PROP_MODE_REPLACE "hiho" 4)
- (gdk_property_delete wnd _GdkAtom)
- (gdk_window_show wnd)
- (gtk_window_stick _GtkWindow_)
- (gtk_window_unstick _GtkWindow_)
- (gdk_window_stick wnd)
- (gdk_window_unstick wnd)
- (gtk_window_add_embedded_xid _GtkWindow_ 12345)
- (gtk_window_remove_embedded_xid _GtkWindow_ 12345)
- (gtk_window_set_accept_focus _GtkWindow_ #t)
- (gtk_window_set_decorated _GtkWindow_ #t)
- (gtk_window_set_destroy_with_parent _GtkWindow_ #t)
- (gdk_window_begin_paint_region _GdkWindow_ _GdkRegion_)
- (gdk_window_deiconify _GdkWindow_)
- (gdk_window_end_paint _GdkWindow_)
- (gdk_window_freeze_updates _GdkWindow_)
- (gdk_window_thaw_updates _GdkWindow_)
- (gdk_window_get_frame_extents _GdkWindow_ (GdkRectangle))
- (gdk_window_invalidate_rect _GdkWindow_ (GdkRectangle 0 0 10 10) #f)
- (gdk_window_invalidate_region _GdkWindow_ _GdkRegion_ #f)
- (gdk_window_move _GdkWindow_ 0 0)
- (gdk_window_move_resize _GdkWindow_ 0 0 500 800)
- (gdk_window_resize _GdkWindow_ 500 800)
- (gdk_window_set_accept_focus _GdkWindow_ #t)
- (gdk_window_set_background _GdkWindow_ red-pixel)
- (gdk_window_set_cursor _GdkWindow_ (gdk_cursor_new GDK_BOTTOM_TEE))
- (gdk_window_set_icon_name _GdkWindow_ "hiho")
- (gtk_window_move _GtkWindow_ 200 20)
- (gdk_window_resize (gtk_widget_get_window _GtkWidget_) 800 500)
- (let ((_guint (g_idle_add_full G_PRIORITY_DEFAULT_IDLE (lambda (n) #f) 1234 #f)))
- (g_source_remove _guint))
-
- #|
- (let ((_GtkTargetList_ (gtk_target_list_new #f 0)))
- (gtk_target_list_add _GtkTargetList_ GDK_TARGET_STRING 0 0)
+ (gdk_draw_rectangle wn sgc #t 0 0 100 100)
+ (gdk_draw_line wn sgc 0 0 100 100)
+ (gdk_draw_point wn sgc 10 10)
+ (gdk_draw_arc wn sgc #f 10 10 20 20 0 (* 45 64))
+ (gdk_add_client_message_filter (gdk_atom_intern "SND_MESSAGE" #f) (lambda (xe e d) #f) #f)
+ (set! pts1 (vector->GdkPoints vect))
+ (gdk_draw_lines wn sgc (list 'GdkPoint_ pts1) 2)
+ (gdk_draw_segments wn sgc (list 'GdkSegment_ pts1) 1)
+ (gdk_draw_points wn sgc (list 'GdkPoint_ pts1) 2)
+ (gdk_draw_polygon wn sgc #f (list 'GdkPoint_ pts1) 2)
+ (freeGdkPoints pts1)
+ (gdk_drawable_set_colormap wn (gdk_colormap_get_system))
+ (gdk_draw_layout wn sgc 0 0 _PangoLayout_))
+ (gdk_window_clear wnd)
+ (gdk_window_clear_area wnd 0 0 10 10)
+ (gdk_window_clear_area_e wnd 0 0 10 10)
+ (gdk_window_begin_paint_rect wnd (GdkRectangle 0 0 10 10))
+ (let* ((_GdkImage_ (gdk_drawable_get_image wn 0 0 20 20)) ; -> #f
+ (_GtkImage_ (GTK_IMAGE (gtk_image_new)))
+ (_GtkImageType (gtk_image_get_storage_type _GtkImage_)))
+ (gtk_image_set_from_stock _GtkImage_ GTK_STOCK_CANCEL 32)
+ (let* ((_GdkPixbuf_ (gtk_image_get_pixbuf (GTK_IMAGE (gtk_image_new)))) ; -> #f
+ (_GdkImage_1 (gdk_image_new GDK_IMAGE_NORMAL _GdkVisual_ 32 32))
+ (_GdkImage_2 (gdk_drawable_copy_to_image wn _GdkImage_1 0 0 0 0 32 32))
+ (_GdkPixbuf_1 (gdk_pixbuf_get_from_image _GdkPixbuf_ _GdkImage_1 _GdkColormap_ 0 0 0 0 32 32))
+ (_GdkPixbuf_2 (gdk_pixbuf_copy _GdkPixbuf_1))
+ (_GdkPixmap_ (gdk_pixmap_new (GDK_DRAWABLE (car (main-widgets))) 16 16 -1))
+ (arrow-strs (list
+ "16 12 6 1"
+ " c None s None"
+ ". c gray50"
+ "X c black"
+ "o c white"
+ "O c yellow"
+ "- c ivory2 s basiccolor"
+ "--------X---------"
+ "---------X--------"
+ "----------X-------"
+ "-----------X------"
+ "------------X-----"
+ "XXXXXXXXXXXXXX----"
+ "------------X-----"
+ "-----------X------"
+ "----------X-------"
+ "---------X--------"
+ "--------X---------"
+ "-------X----------"))
+ (_GdkPixmap_1 (gdk_pixmap_create_from_xpm_d (GDK_DRAWABLE (car (main-widgets))) #f (basic-color) (list->c-array arrow-strs "gchar**")))
+ (_GdkColorspace (gdk_pixbuf_get_colorspace _GdkPixbuf_1))
+ (_GtkWidget_2 (gtk_image_new_from_pixbuf _GdkPixbuf_1))
+ (_GdkPixbuf_3 (gdk_pixbuf_get_from_drawable _GdkPixbuf_1 (GDK_DRAWABLE _GdkPixmap_1) _GdkColormap_ 0 0 0 0 10 10))
+ (_PangoContext_ (gdk_pango_context_get))
+ (_PangoLayout_ (pango_layout_new _PangoContext_))
+ (_GdkPixbuf_5 (gdk_pixbuf_new_from_xpm_data (list->c-array arrow-strs "char**")))
+ (_GdkPixbuf_4 (gdk_pixbuf_new _GdkColorspace #f 8 10 10))
+ (_gboolean (gdk_pixbuf_get_has_alpha _GdkPixbuf_5))
+ (_guchar_ (gdk_pixbuf_get_pixels _GdkPixbuf_5))
+ (_int (gdk_pixbuf_get_bits_per_sample _GdkPixbuf_5))
+ (_int1 (gdk_pixbuf_get_height _GdkPixbuf_5))
+ (_int2 (gdk_pixbuf_get_n_channels _GdkPixbuf_5))
+ (_int3 (gdk_pixbuf_get_rowstride _GdkPixbuf_5))
+ (_int4 (gdk_pixbuf_get_width _GdkPixbuf_5))
+ (_gchar_ (gdk_pixbuf_get_option _GdkPixbuf_5 "hi")))
+ (let ((sgc (car (snd-gcs))))
+ (gdk_draw_image wn sgc _GdkImage_1 0 0 0 0 32 32)
+ (gdk_draw_drawable wn sgc (GDK_DRAWABLE _GdkPixmap_1) 0 0 0 0 32 32)
+ (gdk_draw_gray_image wn sgc 0 0 10 10 GDK_RGB_DITHER_NONE "hihohohio" 0)
+ (gdk_draw_rgb_image wn sgc 0 0 10 10 GDK_RGB_DITHER_NONE "hihohohio" 0)
+ (gdk_draw_rgb_32_image wn sgc 0 0 10 10 GDK_RGB_DITHER_NONE "hihohohio" 0)
+ (pango_layout_set_text _PangoLayout_ "hiho" -1)
+ (let ((_PangoLayoutLine_ (pango_layout_get_line _PangoLayout_ 0)))
+ (gdk_draw_layout_line wn sgc 0 0 _PangoLayoutLine_))
+ (gdk_pixbuf_fill _GdkPixbuf_3 0))))
+
+
+ (gdk_color_free _GdkColor_)
+ (gdk_rgb_set_min_colors 8)
+ (let ((_GdkRgbCmap_ (gdk_rgb_cmap_new (list->c-array '(0 0 0 0 0 0 0 0) "guint32*") 8)))
+ (gdk_rgb_cmap_free _GdkRgbCmap_))
+ (gdk_property_change wnd _GdkAtom GDK_TARGET_STRING 8 GDK_PROP_MODE_REPLACE "hiho" 4)
+ (gdk_property_delete wnd _GdkAtom)
+ (gdk_window_show wnd)
+ (gtk_window_stick _GtkWindow_)
+ (gtk_window_unstick _GtkWindow_)
+ (gdk_window_stick wnd)
+ (gdk_window_unstick wnd)
+ (gtk_window_add_embedded_xid _GtkWindow_ 12345)
+ (gtk_window_remove_embedded_xid _GtkWindow_ 12345)
+ (gtk_window_set_accept_focus _GtkWindow_ #t)
+ (gtk_window_set_decorated _GtkWindow_ #t)
+ (gtk_window_set_destroy_with_parent _GtkWindow_ #t)
+ (gdk_window_begin_paint_region _GdkWindow_ _GdkRegion_)
+ (gdk_window_deiconify _GdkWindow_)
+ (gdk_window_end_paint _GdkWindow_)
+ (gdk_window_freeze_updates _GdkWindow_)
+ (gdk_window_thaw_updates _GdkWindow_)
+ (gdk_window_get_frame_extents _GdkWindow_ (GdkRectangle))
+ (gdk_window_invalidate_rect _GdkWindow_ (GdkRectangle 0 0 10 10) #f)
+ (gdk_window_invalidate_region _GdkWindow_ _GdkRegion_ #f)
+ (gdk_window_move _GdkWindow_ 0 0)
+ (gdk_window_move_resize _GdkWindow_ 0 0 500 800)
+ (gdk_window_resize _GdkWindow_ 500 800)
+; (gdk_window_set_accept_focus _GdkWindow_ #t)
+ (gdk_window_set_background _GdkWindow_ red-pixel)
+ (gdk_window_set_cursor _GdkWindow_ (gdk_cursor_new GDK_BOTTOM_TEE))
+ (gdk_window_set_icon_name _GdkWindow_ "hiho")
+ (gtk_window_move _GtkWindow_ 200 20)
+ (gdk_window_resize (gtk_widget_get_window _GtkWidget_) 800 500)
+ (let ((_guint (g_idle_add_full G_PRIORITY_DEFAULT_IDLE (lambda (n) #f) 1234 #f)))
+ (g_source_remove _guint))
+
+ #|
+ (let ((_GtkTargetList_ (gtk_target_list_new #f 0)))
+ (gtk_target_list_add _GtkTargetList_ GDK_TARGET_STRING 0 0)
; (gtk_target_list_ref _GtkTargetList_)
- (gtk_target_list_unref _GtkTargetList_)
- (gtk_target_list_remove _GtkTargetList_ GDK_TARGET_STRING)
- (gtk_drag_dest_set (cadr (main-widgets)) GTK_DEST_DEFAULT_ALL
- (make-target-entry (list (list "STRING" 0 0) (list "FILENAME" 0 0))) 2
- (logior GDK_ACTION_COPY GDK_ACTION_MOVE))
- (let ((trg (gtk_drag_dest_get_target_list (cadr (main-widgets)))))
+ (gtk_target_list_unref _GtkTargetList_)
+ (gtk_target_list_remove _GtkTargetList_ GDK_TARGET_STRING)
+ (gtk_drag_dest_set (cadr (main-widgets)) GTK_DEST_DEFAULT_ALL
+ (make-target-entry (list (list "STRING" 0 0) (list "FILENAME" 0 0))) 2
+ (logior GDK_ACTION_COPY GDK_ACTION_MOVE))
+ (let ((trg (gtk_drag_dest_get_target_list (cadr (main-widgets)))))
(gtk_drag_dest_set_target_list (cadr (main-widgets)) trg))
-
- )
- |#
- (let* ((_GtkRadioAction_ (gtk_radio_action_new "hi" "label" "tool" GTK_STOCK_CANCEL 0))
- (_gint (gtk_radio_action_get_current_value _GtkRadioAction_))
- (_GSList_ (gtk_radio_action_get_group _GtkRadioAction_)))
- (if (not (= 0 _gint)) (snd-display ";radio action value: ~A" _gint)))))
+
+ )
+ |#
+ (let* ((_GtkRadioAction_ (gtk_radio_action_new "hi" "label" "tool" GTK_STOCK_CANCEL 0))
+ (_gint (gtk_radio_action_get_current_value _GtkRadioAction_))
+ (_GSList_ (gtk_radio_action_get_group _GtkRadioAction_)))
+ (if (not (= 0 _gint)) (snd-display #__line__ ";radio action value: ~A" _gint)))))
(let ((dialog (gtk_about_dialog_new)))
;; sort of half-implemented, apparently
- (if (not (GTK_IS_ABOUT_DIALOG dialog)) (snd-display ";about dialog isn't?"))
+ (if (not (GTK_IS_ABOUT_DIALOG dialog)) (snd-display #__line__ ";about dialog isn't?"))
(gtk_about_dialog_set_version (GTK_ABOUT_DIALOG dialog) "1234.4321.89765")
(let ((version (gtk_about_dialog_get_version (GTK_ABOUT_DIALOG dialog))))
- (if (not (string=? version "1234.4321.89765")) (snd-display ";about dialog version: ~A" version)))
+ (if (not (string=? version "1234.4321.89765")) (snd-display #__line__ ";about dialog version: ~A" version)))
(gtk_about_dialog_set_copyright (GTK_ABOUT_DIALOG dialog) "(c) 1234 Roger Bacon")
(let ((copyright (gtk_about_dialog_get_copyright (GTK_ABOUT_DIALOG dialog))))
- (if (not (string=? copyright "(c) 1234 Roger Bacon")) (snd-display ";about dialog copyright: ~A" copyright)))
+ (if (not (string=? copyright "(c) 1234 Roger Bacon")) (snd-display #__line__ ";about dialog copyright: ~A" copyright)))
(gtk_about_dialog_set_comments (GTK_ABOUT_DIALOG dialog) "This here dialog is About")
(let ((comments (gtk_about_dialog_get_comments (GTK_ABOUT_DIALOG dialog))))
- (if (not (string=? comments "This here dialog is About")) (snd-display ";about dialog comments: ~A" comments)))
+ (if (not (string=? comments "This here dialog is About")) (snd-display #__line__ ";about dialog comments: ~A" comments)))
(gtk_about_dialog_set_license (GTK_ABOUT_DIALOG dialog) "You can't use this, it sez right here!")
(let ((license (gtk_about_dialog_get_license (GTK_ABOUT_DIALOG dialog))))
- (if (not (string=? license "You can't use this, it sez right here!")) (snd-display ";about dialog license: ~A" license)))
+ (if (not (string=? license "You can't use this, it sez right here!")) (snd-display #__line__ ";about dialog license: ~A" license)))
(gtk_about_dialog_set_website (GTK_ABOUT_DIALOG dialog) "http://www.this.is.silly.com")
(let ((website (gtk_about_dialog_get_website (GTK_ABOUT_DIALOG dialog))))
- (if (not (string=? website "http://www.this.is.silly.com")) (snd-display ";about dialog website: ~A" website)))
+ (if (not (string=? website "http://www.this.is.silly.com")) (snd-display #__line__ ";about dialog website: ~A" website)))
(gtk_about_dialog_set_website_label (GTK_ABOUT_DIALOG dialog) "The Home Of About")
(let ((website_label (gtk_about_dialog_get_website_label (GTK_ABOUT_DIALOG dialog))))
(if (and (string? website_label)
(not (string=? website_label "The Home Of About")))
- (snd-display ";about dialog website_label: ~A" website_label)))
+ (snd-display #__line__ ";about dialog website_label: ~A" website_label)))
(gtk_about_dialog_set_authors (GTK_ABOUT_DIALOG dialog) (list->c-array (list "Who" "Why") "gchar**"))
(gtk_about_dialog_set_documenters (GTK_ABOUT_DIALOG dialog) (list->c-array (list "gah" "use an o") "gchar**"))
(let ((documenters (c-array->list (gtk_about_dialog_get_documenters (GTK_ABOUT_DIALOG dialog)) 2)))
(if (and (list? documenters)
(string? (car documenters))
(not (string=? (car documenters) "gah")))
- (snd-display ";about dialog documenters: ~A" documenters)))
+ (snd-display #__line__ ";about dialog documenters: ~A" documenters)))
(gtk_about_dialog_set_artists (GTK_ABOUT_DIALOG dialog) (list->c-array (list "Me!" "Just me!") "gchar**"))
(let ((artists (c-array->list (gtk_about_dialog_get_artists (GTK_ABOUT_DIALOG dialog)) 2)))
(if (and (list? artists)
(string? (car artists))
(not (string=? (car artists) "Me!")))
- (snd-display ";about dialog artists: ~A" artists)))
+ (snd-display #__line__ ";about dialog artists: ~A" artists)))
(gtk_about_dialog_set_translator_credits (GTK_ABOUT_DIALOG dialog) "he did it all")
(gtk_widget_show dialog)
(gtk_widget_hide dialog))
@@ -63511,13 +63609,13 @@ EDITS: 1
(_GtkTreeModelc_ (GTK_TREE_MODEL _GtkListStore_))
(_GtkComboBox_ (GTK_COMBO_BOX (gtk_combo_box_new_with_model _GtkTreeModelc_))))
(gtk_combo_box_set_add_tearoffs _GtkComboBox_ #t)
- (if (not (gtk_combo_box_get_add_tearoffs _GtkComboBox_)) (snd-display ";combo tear offs?"))
+ (if (not (gtk_combo_box_get_add_tearoffs _GtkComboBox_)) (snd-display #__line__ ";combo tear offs?"))
(let ((gint0 (gtk_combo_box_get_wrap_width _GtkComboBox_))
(gint1 (gtk_combo_box_get_row_span_column _GtkComboBox_))
(gint2 (gtk_combo_box_get_column_span_column _GtkComboBox_))
(gchar (gtk_combo_box_get_active_text _GtkComboBox_)))
(if (or (not (= gint0 0)) (not (= gint1 -1)) (not (= gint2 -1)))
- (snd-display ";combo gints: ~A ~A ~A" gint0 gint1 gint2))))
+ (snd-display #__line__ ";combo gints: ~A ~A ~A" gint0 gint1 gint2))))
;; taken from gtk demo dir
@@ -63548,22 +63646,22 @@ EDITS: 1
(let ((icon_view (gtk_icon_view_new_with_model (GTK_TREE_MODEL store))))
(gtk_icon_view_set_selection_mode (GTK_ICON_VIEW icon_view) GTK_SELECTION_SINGLE)
;; just calls
- (if (not (GTK_IS_ICON_VIEW icon_view)) (snd-display ";not icon view?"))
+ (if (not (GTK_IS_ICON_VIEW icon_view)) (snd-display #__line__ ";not icon view?"))
(let ((gint0 (gtk_icon_view_get_text_column (GTK_ICON_VIEW icon_view)))
(gint1 (gtk_icon_view_get_pixbuf_column (GTK_ICON_VIEW icon_view))))
- (if (or (not (= gint0 -1)) (not (= gint1 -1))) (snd-display ";icon view cols: ~A ~A" gint0 gint1)))
+ (if (or (not (= gint0 -1)) (not (= gint1 -1))) (snd-display #__line__ ";icon view cols: ~A ~A" gint0 gint1)))
(let ((ic (gtk_icon_view_new)))
- (if (not (GTK_IS_ICON_VIEW ic)) (snd-display ";icon view2?"))
+ (if (not (GTK_IS_ICON_VIEW ic)) (snd-display #__line__ ";icon view2?"))
(gtk_icon_view_set_orientation (GTK_ICON_VIEW ic) GTK_ORIENTATION_VERTICAL)
(if (not (= (gtk_icon_view_get_orientation (GTK_ICON_VIEW ic)) GTK_ORIENTATION_VERTICAL))
- (snd-display ";icon view orientation")))
+ (snd-display #__line__ ";icon view orientation")))
(let ((model (gtk_icon_view_get_model (GTK_ICON_VIEW icon_view))))
- (if (not (GTK_TREE_MODEL model)) (snd-display ";icon view model: ~A (~A)" model store))
+ (if (not (GTK_TREE_MODEL model)) (snd-display #__line__ ";icon view model: ~A (~A)" model store))
(gtk_icon_view_set_model (GTK_ICON_VIEW icon_view) (GTK_TREE_MODEL store)))
(let ((gint0 (gtk_icon_view_get_markup_column (GTK_ICON_VIEW icon_view))))
- (if (not (= gint0 -1)) (snd-display ";icon view markup: ~A" gint0)))
+ (if (not (= gint0 -1)) (snd-display #__line__ ";icon view markup: ~A" gint0)))
(let ((gint0 (gtk_icon_view_get_selection_mode (GTK_ICON_VIEW icon_view))))
- (if (not (= gint0 GTK_SELECTION_SINGLE)) (snd-display ";icon view selection mode")))
+ (if (not (= gint0 GTK_SELECTION_SINGLE)) (snd-display #__line__ ";icon view selection mode")))
(gtk_icon_view_set_markup_column (GTK_ICON_VIEW icon_view) -1)
(gtk_icon_view_select_all (GTK_ICON_VIEW icon_view))
(gtk_icon_view_unselect_all (GTK_ICON_VIEW icon_view))
@@ -63582,10 +63680,10 @@ EDITS: 1
(let ((store (gtk_list_store_new 2 (list G_TYPE_STRING G_TYPE_BOOLEAN))))
(let ((cell0 (gtk_cell_view_new))
(cell1 (gtk_cell_view_new_with_text "hiho")))
- (if (not (GTK_IS_CELL_VIEW cell1)) (snd-display ";not cell view? ~A" cell1))
+ (if (not (GTK_IS_CELL_VIEW cell1)) (snd-display #__line__ ";not cell view? ~A" cell1))
(gtk_cell_view_set_model (GTK_CELL_VIEW cell1) (GTK_TREE_MODEL store))
(if (not (provided? 'cairo))
- (gtk_cell_view_set_background_color (GTK_CELL_VIEW cell1) (basic-color)))
+ (gtk_cell_view_set_background_color (GTK_CELL_VIEW cell1) (basic-color)))
))
(let* ((_PangoLanguage_ (pango_language_from_string "de"))
@@ -63603,16 +63701,16 @@ EDITS: 1
(not (= int1 1024))
(and (not (= int2 3072)) (not (= int2 4096)))
(not (= int3 1024)))
- (snd-display ";pango underlines: ~A ~A ~A ~A" int0 int1 int2 int3)))
- (if (not _PangoScript) (snd-display ";pango script: ~A" _PangoScript))
+ (snd-display #__line__ ";pango underlines: ~A ~A ~A ~A" int0 int1 int2 int3)))
+ (if (not _PangoScript) (snd-display #__line__ ";pango script: ~A" _PangoScript))
(pango_script_iter_get_range _PangoScriptIter_)
(pango_script_iter_next _PangoScriptIter_)
(pango_script_iter_free _PangoScriptIter_))
(let ((cell0 (gtk_cell_renderer_combo_new))
(cell1 (gtk_cell_renderer_progress_new)))
- (if (not (GTK_IS_CELL_RENDERER_COMBO cell0)) (snd-display ";not cell renderer combo?"))
- (if (not (GTK_IS_CELL_RENDERER_PROGRESS cell1)) (snd-display ";not cell renderer progress?")))
+ (if (not (GTK_IS_CELL_RENDERER_COMBO cell0)) (snd-display #__line__ ";not cell renderer combo?"))
+ (if (not (GTK_IS_CELL_RENDERER_PROGRESS cell1)) (snd-display #__line__ ";not cell renderer progress?")))
(let* ((breakable-gtk-procs
(list ; these are problematic, but make sure they are defined
@@ -63721,12 +63819,12 @@ EDITS: 1
gdk_color_copy gdk_color_equal gdk_color_free
gdk_color_hash gdk_color_parse gdk_colormap_alloc_color gdk_colormap_alloc_colors
gdk_colormap_get_system gdk_colormap_get_visual gdk_colormap_new gdk_colormap_query_color
- ;gdk_cursor_new gdk_cursor_new_from_pixbuf
- ;gdk_cursor_new_from_pixmap gdk_cursor_ref gdk_cursor_unref ;gdk_device_free_history
+ ;gdk_cursor_new gdk_cursor_new_from_pixbuf
+ ;gdk_cursor_new_from_pixmap gdk_cursor_ref gdk_cursor_unref ;gdk_device_free_history
gdk_display_add_client_message_filter gdk_display_beep gdk_display_close gdk_display_flush ;gdk_display_get_core_pointer
gdk_display_get_default gdk_display_get_default_cursor_size gdk_display_get_default_group gdk_display_get_default_screen gdk_display_get_event
gdk_display_get_maximal_cursor_size gdk_display_get_n_screens gdk_display_get_name gdk_display_get_pointer gdk_display_get_screen
- gdk_display_get_window_at_pointer gdk_display_keyboard_ungrab gdk_display_list_devices gdk_display_open
+ gdk_display_get_window_at_pointer gdk_display_keyboard_ungrab gdk_display_open
gdk_display_peek_event gdk_display_pointer_is_grabbed gdk_display_pointer_ungrab gdk_display_put_event gdk_display_set_double_click_distance
gdk_display_set_double_click_time gdk_display_supports_clipboard_persistence gdk_display_supports_cursor_alpha
gdk_display_supports_cursor_color gdk_display_sync
@@ -63804,8 +63902,8 @@ EDITS: 1
gdk_window_lookup gdk_window_lower gdk_window_maximize gdk_window_merge_child_shapes gdk_window_move
gdk_window_move_resize gdk_window_new gdk_window_peek_children gdk_window_process_all_updates gdk_window_process_updates
gdk_window_raise gdk_window_register_dnd gdk_window_remove_filter gdk_window_reparent gdk_window_resize
- gdk_window_scroll gdk_window_set_accept_focus gdk_window_set_back_pixmap gdk_window_set_background gdk_window_set_child_shapes
- gdk_window_set_cursor gdk_window_set_debug_updates gdk_window_set_decorations gdk_window_set_events gdk_window_set_focus_on_map
+ gdk_window_scroll gdk_window_set_back_pixmap gdk_window_set_background gdk_window_set_child_shapes
+ gdk_window_set_cursor gdk_window_set_debug_updates gdk_window_set_decorations gdk_window_set_events
gdk_window_set_functions gdk_window_set_geometry_hints gdk_window_set_group gdk_window_set_icon gdk_window_set_icon_list
gdk_window_set_icon_name gdk_window_set_keep_above gdk_window_set_keep_below gdk_window_set_modal_hint gdk_window_set_override_redirect
gdk_window_set_role gdk_window_set_static_gravities gdk_window_set_title gdk_window_set_transient_for gdk_window_set_type_hint
@@ -63923,7 +64021,7 @@ EDITS: 1
gtk_entry_completion_set_inline_completion gtk_entry_completion_set_match_func
gtk_entry_completion_set_minimum_key_length gtk_entry_completion_set_model gtk_entry_completion_set_popup_completion
gtk_entry_completion_set_text_column gtk_entry_get_activates_default gtk_entry_get_alignment gtk_entry_get_completion gtk_entry_get_has_frame
- gtk_entry_get_invisible_char gtk_entry_get_layout gtk_entry_get_layout_offsets gtk_entry_get_max_length gtk_entry_get_text
+ gtk_entry_get_invisible_char gtk_entry_get_layout gtk_entry_get_max_length gtk_entry_get_text
gtk_entry_get_visibility gtk_entry_get_width_chars gtk_entry_layout_index_to_text_index gtk_entry_new
gtk_entry_set_activates_default gtk_entry_set_alignment gtk_entry_set_completion gtk_entry_set_has_frame gtk_entry_set_invisible_char
gtk_entry_set_max_length gtk_entry_set_text gtk_entry_set_visibility gtk_entry_set_width_chars gtk_entry_text_index_to_layout_index
@@ -64452,7 +64550,7 @@ EDITS: 1
(lambda args
(if (and (not (eq? (car args) 'wrong-type-arg))
(not (eq? (car args) 'out-of-range)))
- (snd-display ";1 arg: ~A ~A" args n))
+ (snd-display #__line__ ";1 arg: ~A ~A" args n))
(car args))))
gtk-procs1))
(list 1.5 "/hiho" (list 0 1) 1234 '#(0 1) 3/4 'mus-error (sqrt -1.0) (make-delay 32)
@@ -64670,8 +64768,8 @@ EDITS: 1
`(let ((start (get-internal-real-time)))
,a
(- (get-internal-real-time) start)))
-
-
+
+
(define (snd_test_28)
(define (traced a) (+ 2 a))
@@ -64705,13 +64803,13 @@ EDITS: 1
;; since 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
- (expt 2 (inexact->exact (ceiling (/ (log (/ cur-srate 10.0)) (log 2.0)))))
+ (expt 2 (ceiling (/ (log (/ cur-srate 10.0)) (log 2.0))))
snd chn)))
(define* (reverse-channels snd)
(let* ((ind (or snd (selected-sound) (car (sounds))))
(chns (chans ind)))
- (let ((swaps (inexact->exact (floor (/ chns 2)))))
+ (let ((swaps (floor (/ chns 2))))
(as-one-edit
(lambda ()
(do ((i 0 (+ 1 i))
@@ -64756,209 +64854,209 @@ EDITS: 1
(if (or (and (not (list? tag))
(not (pair? tag)))
(not (eq? (car tag) expected-tag)))
- (snd-display ";check-error-tag ~A from ~A: ~A"
+ (snd-display #__line__ ";check-error-tag ~A from ~A: ~A"
expected-tag (procedure-source thunk) tag))))
(set! (with-background-processes) #t)
(load "s7test.scm")
-
+
(if (and (provided? 'gsl)
(provided? 'gmp))
(begin
-
+
;; from GSL
- (num-test (bes-j0 0.1) 0.99750156206604003230)
- (num-test (bes-j0 2.0) 0.22389077914123566805)
- (num-test (bes-j0 100.0) 0.019985850304223122424)
- (num-test (bes-j0 1.0e+10) 2.1755917502468917269e-06)
- (num-test (bes-j1 0.1) 0.04993752603624199756)
- (num-test (bes-j1 2.0) 0.57672480775687338720)
- (num-test (bes-j1 100.0) -0.07714535201411215803)
- (num-test (bes-j1 1.0e+10) -7.676508175684157103e-06)
- (num-test (bes-jn 4 0.1) 2.6028648545684032338e-07)
- (num-test (bes-jn 5 2.0) 0.007039629755871685484)
- (num-test (bes-jn 10 20.0) 0.18648255802394508321)
- (num-test (bes-jn 100 100.0) 0.09636667329586155967)
- (num-test (bes-jn 2 900.0) -0.019974345269680646400)
- (num-test (bes-jn 2 15000.0) -0.0020455820181216382666)
- (num-test (bes-jn 0 1.0e+10) 2.1755917502468917269e-06)
- (num-test (bes-jn 1 1.0e+10) -7.676508175684157103e-06)
- (num-test (bes-jn 0 20000) 0.00556597490495494615709982972)
-
- (num-test (bes-y0 0.1) -1.5342386513503668441)
- (num-test (bes-y0 2) 0.5103756726497451196)
- (num-test (bes-y0 256.0) -0.03381290171792454909)
- (num-test (bes-y0 4294967296.0) 3.657903190017678681e-06)
- (num-test (bes-y1 0.1) -6.45895109470202698800)
- (num-test (bes-y1 2) -0.10703243154093754689)
- (num-test (bes-y1 100.0) -0.020372312002759793305)
- (num-test (bes-y1 4294967296.0) 0.000011612249378370766284)
- (num-test (bes-yn 4 0.1) -305832.29793353160319)
- (num-test (bes-yn 5 2) -9.935989128481974981)
- (num-test (bes-yn 100 100.0) -0.16692141141757650654)
- (num-test (bes-yn 100 4294967296.0) 3.657889671577715808e-06)
- (num-test (bes-yn 1000 4294967296.0) 3.656551321485397501e-06)
- (num-test (bes-yn 2 15000.0) -0.006185217273358617849)
-
- (num-test (bes-i0 0.1) 1.0025015629340956014)
- (num-test (bes-i0 2.0) 2.2795853023360672674)
- (num-test (bes-i0 100.0) 1.0737517071310738235e+42)
- (num-test (bes-i1 0.1) 0.05006252604709269211 )
- (num-test (bes-i1 2.0) 1.59063685463732906340 )
- (num-test (bes-i1 100.0) 1.0683693903381624812e+42)
- (num-test (bes-in 4 0.1) 2.6054690212996573677e-07)
- (num-test (bes-in 5 2.0) 0.009825679323131702321)
- (num-test (bes-in 100 100.0) 4.641534941616199114e+21)
-
- (num-test (bes-k0 0.1) 2.4270690247020166125)
- (num-test (bes-k0 2.0) 0.11389387274953343565)
- (num-test (bes-k0 100.0) 4.656628229175902019e-45)
- (num-test (bes-k1 0.1) 9.853844780870606135 )
- (num-test (bes-k1 2.0) 0.13986588181652242728)
- (num-test (bes-k1 100.0) 4.679853735636909287e-45)
- (num-test (bes-kn 4 0.1) 479600.2497925682849)
- (num-test (bes-kn 5 2.0) 9.431049100596467443)
- (num-test (bes-kn 100 100.0) 7.617129630494085416e-25)
-
-
- ;; from maxima
-
- (num-test (bes-j0 0.0) 1.0)
- (num-test (bes-j0 0.001) .9999997500000155)
- (num-test (bes-j0 0.01) .9999750001562496)
- (num-test (bes-j0 0.1) .9975015620660401)
- (num-test (bes-j0 1.0) .7651976865579666)
- (num-test (bes-j0 10.0) -.24593576445134830)
- (num-test (bes-j0 100.0) .01998585030422355)
- (num-test (bes-j0 1000.0) .02478668615241997)
- (num-test (bes-j0 10000.0) -.007096160353384438)
-
- (num-test (bes-j1 0.0) 0.0)
- (num-test (bes-j1 0.001) 4.9999993750000266E-4)
- (num-test (bes-j1 0.01) .004999937500260417)
- (num-test (bes-j1 0.1) 0.049937526036242)
- (num-test (bes-j1 1.0) .4400505857449335)
- (num-test (bes-j1 10.0) .04347274616886149)
- (num-test (bes-j1 100.0) -0.0771453520141124)
- (num-test (bes-j1 1000.0) .004728311907088393)
- (num-test (bes-j1 10000.0) .003647450755527218)
-
- (num-test (bes-jn 10 0.0) 0.0)
- (num-test (bes-jn 10 0.001) 2.691144394304978E-40)
- (num-test (bes-jn 10 0.01) 2.691138339236334E-30)
- (num-test (bes-jn 10 0.1) 2.690532895434216E-20)
- (num-test (bes-jn 10 1.0) 2.630615123687444E-10)
- (num-test (bes-jn 10 10.0) .2074861066333596)
- (num-test (bes-jn 10 100.0) -.05473217693547214)
- (num-test (bes-jn 10 1000.0) -.02452062230603636)
- (num-test (bes-jn 10 10000.0) .007114312383352328)
-
- (num-test (bes-jn 100 0.0) 0.0)
- (num-test (bes-jn 100 0.1) 8.45251653512169E-289)
- (num-test (bes-jn 100 1.0) 8.43182878962675E-189)
- (num-test (bes-jn 100 10.0) 6.597316064155484E-89)
- (num-test (bes-jn 100 100.0) 0.0963666732958616)
- (num-test (bes-jn 100 1000.0) .01167613500780332)
- (num-test (bes-jn 100 10000.0) -0.00797651631139348)
-
- (num-test (bes-jn 1000 1000.0) .04473067294796409)
- (num-test (bes-jn 10000 10000.0) .02076216527720082)
-
-
- (num-test (bes-i0 0.0) 1.0)
- (num-test (bes-i0 0.001) 1.000000250000016)
- (num-test (bes-i0 0.01) 1.00002500015625)
- (num-test (bes-i0 0.1) 1.002501562934096)
- (num-test (bes-i0 1.0) 1.266065877752009)
- (num-test (bes-i0 10.0) 2815.716628466254)
- (num-test (bes-i0 100.0) 1.073751707131074E+42)
-
- (num-test (bes-i1 0.0) 0.0)
- (num-test (bes-i1 0.001) 5.000000625000026E-4)
- (num-test (bes-i1 0.01) .005000062500260419)
- (num-test (bes-i1 0.1) .05006252604709269)
- (num-test (bes-i1 1.0) 0.565159103992485)
- (num-test (bes-i1 10.0) 2670.988303701255)
- (num-test (bes-i1 100.0) 1.068369390338162E+42)
-
- (num-test (bes-in 10 0.0) 0.0)
- (num-test (bes-in 10 0.001) 2.691144516629725E-40)
- (num-test (bes-in 10 0.01) 2.691150571711132E-30)
- (num-test (bes-in 10 0.1) 2.691756142922141E-20)
- (num-test (bes-in 10 1.0) 2.752948039836866E-10)
- (num-test (bes-in 10 10.0) 21.89170616372356)
- (num-test (bes-in 10 100.0) 6.498975524720151E+41)
-
- (num-test (bes-in 100 0.0) 0.0)
- (num-test (bes-in 100 0.1) 8.45293498689195E-289)
- (num-test (bes-in 100 1.0) 8.47367400813812E-189)
- (num-test (bes-in 100 10.0) 1.082344201749218E-88)
- (num-test (bes-in 100 100.0) 4.641534941616278E+21)
-
-
-
- (num-test (bes-y0 0.001) -4.471416611375923)
- (num-test (bes-y0 0.01) -3.005455637083646)
- (num-test (bes-y0 0.1) -1.534238651350367)
- (num-test (bes-y0 1.0) .08825696421567691)
- (num-test (bes-y0 10.0) .05567116728359947)
- (num-test (bes-y0 100.0) -.07724431336508303)
- (num-test (bes-y0 1000.0) .004715917977623911)
-
- (num-test (bes-y1 0.001) -636.6221672311393)
- (num-test (bes-y1 0.01) -63.67859628206064)
- (num-test (bes-y1 0.1) -6.458951094702027)
- (num-test (bes-y1 1.0) -.7812128213002888)
- (num-test (bes-y1 10.0) .2490154242069539)
- (num-test (bes-y1 100.0) -.02037231200275883)
- (num-test (bes-y1 1000.0) -0.024784331292352)
-
- (num-test (bes-yn 10 0.001) -1.182804937799041E+38)
- (num-test (bes-yn 10 0.01) -1.182808190517663E+28)
- (num-test (bes-yn 10 0.1) -1.18313351320452E+18)
- (num-test (bes-yn 10 1.0) -1.2161801427868918E+8)
- (num-test (bes-yn 10 10.0) -.3598141521834028)
- (num-test (bes-yn 10 100.0) .05833157423641527)
- (num-test (bes-yn 10 1000.0) -.005949000574163774)
-
- (num-test (bes-yn 100 0.1) -3.76586125601925E+285)
- (num-test (bes-yn 100 1.0) -3.77528781011053E+185)
- (num-test (bes-yn 100 10.0) -4.849148271180334E+85)
- (num-test (bes-yn 100 100.0) -.1669214114175733)
- (num-test (bes-yn 100 1000.0) -.02243868825772313)
-
- (num-test (bes-yn 1000 1000.0) -.07747600152069181)
-
-
- (num-test (bes-k0 0.001) 7.023688800562383)
- (num-test (bes-k0 0.01) 4.721244730161095)
- (num-test (bes-k0 0.1) 2.427069024702016)
- (num-test (bes-k0 1.0) .4210244382407085)
- (num-test (bes-k0 10.0) 1.7780062316167652E-5)
- (num-test (bes-k0 100.0) 4.656628229175902E-45)
-
- (num-test (bes-k1 0.001) 999.9962381560855)
- (num-test (bes-k1 0.01) 99.97389411829626)
- (num-test (bes-k1 0.1) 9.853844780870606)
- (num-test (bes-k1 1.0) .6019072301972346)
- (num-test (bes-k1 10.0) 1.8648773453825582E-5)
- (num-test (bes-k1 100.0) 4.67985373563691E-45)
-
- (num-test (bes-kn 10 0.001) 1.857945548390401E+38)
- (num-test (bes-kn 10 0.01) 1.857940439048065E+28)
- (num-test (bes-kn 10 0.1) 1.857429584630401E+18)
- (num-test (bes-kn 10 1.0) 1.807132899010295E+8)
- (num-test (bes-kn 10 10.0) 0.00161425530039067)
- (num-test (bes-kn 10 100.0) 7.655427977388101E-45)
-
- (num-test (bes-kn 100 0.1) 5.91510227809082E+285)
- (num-test (bes-kn 100 1.0) 5.90033318363862E+185)
- (num-test (bes-kn 100 10.0) 4.596674084269265E+85)
- (num-test (bes-kn 100 100.0) 7.617129630494247E-25)
- (num-test (bes-kn 100 1000.0) 0.0)
- ))
-
+ (num-test (bes-j0 0.1) 0.99750156206604003230)
+ (num-test (bes-j0 2.0) 0.22389077914123566805)
+ (num-test (bes-j0 100.0) 0.019985850304223122424)
+ (num-test (bes-j0 1.0e+10) 2.1755917502468917269e-06)
+ (num-test (bes-j1 0.1) 0.04993752603624199756)
+ (num-test (bes-j1 2.0) 0.57672480775687338720)
+ (num-test (bes-j1 100.0) -0.07714535201411215803)
+ (num-test (bes-j1 1.0e+10) -7.676508175684157103e-06)
+ (num-test (bes-jn 4 0.1) 2.6028648545684032338e-07)
+ (num-test (bes-jn 5 2.0) 0.007039629755871685484)
+ (num-test (bes-jn 10 20.0) 0.18648255802394508321)
+ (num-test (bes-jn 100 100.0) 0.09636667329586155967)
+ (num-test (bes-jn 2 900.0) -0.019974345269680646400)
+ (num-test (bes-jn 2 15000.0) -0.0020455820181216382666)
+ (num-test (bes-jn 0 1.0e+10) 2.1755917502468917269e-06)
+ (num-test (bes-jn 1 1.0e+10) -7.676508175684157103e-06)
+ (num-test (bes-jn 0 20000) 0.00556597490495494615709982972)
+
+ (num-test (bes-y0 0.1) -1.5342386513503668441)
+ (num-test (bes-y0 2) 0.5103756726497451196)
+ (num-test (bes-y0 256.0) -0.03381290171792454909)
+ (num-test (bes-y0 4294967296.0) 3.657903190017678681e-06)
+ (num-test (bes-y1 0.1) -6.45895109470202698800)
+ (num-test (bes-y1 2) -0.10703243154093754689)
+ (num-test (bes-y1 100.0) -0.020372312002759793305)
+ (num-test (bes-y1 4294967296.0) 0.000011612249378370766284)
+ (num-test (bes-yn 4 0.1) -305832.29793353160319)
+ (num-test (bes-yn 5 2) -9.935989128481974981)
+ (num-test (bes-yn 100 100.0) -0.16692141141757650654)
+ (num-test (bes-yn 100 4294967296.0) 3.657889671577715808e-06)
+ (num-test (bes-yn 1000 4294967296.0) 3.656551321485397501e-06)
+ (num-test (bes-yn 2 15000.0) -0.006185217273358617849)
+
+ (num-test (bes-i0 0.1) 1.0025015629340956014)
+ (num-test (bes-i0 2.0) 2.2795853023360672674)
+ (num-test (bes-i0 100.0) 1.0737517071310738235e+42)
+ (num-test (bes-i1 0.1) 0.05006252604709269211 )
+ (num-test (bes-i1 2.0) 1.59063685463732906340 )
+ (num-test (bes-i1 100.0) 1.0683693903381624812e+42)
+ (num-test (bes-in 4 0.1) 2.6054690212996573677e-07)
+ (num-test (bes-in 5 2.0) 0.009825679323131702321)
+ (num-test (bes-in 100 100.0) 4.641534941616199114e+21)
+
+ (num-test (bes-k0 0.1) 2.4270690247020166125)
+ (num-test (bes-k0 2.0) 0.11389387274953343565)
+ (num-test (bes-k0 100.0) 4.656628229175902019e-45)
+ (num-test (bes-k1 0.1) 9.853844780870606135 )
+ (num-test (bes-k1 2.0) 0.13986588181652242728)
+ (num-test (bes-k1 100.0) 4.679853735636909287e-45)
+ (num-test (bes-kn 4 0.1) 479600.2497925682849)
+ (num-test (bes-kn 5 2.0) 9.431049100596467443)
+ (num-test (bes-kn 100 100.0) 7.617129630494085416e-25)
+
+
+ ;; from maxima
+
+ (num-test (bes-j0 0.0) 1.0)
+ (num-test (bes-j0 0.001) .9999997500000155)
+ (num-test (bes-j0 0.01) .9999750001562496)
+ (num-test (bes-j0 0.1) .9975015620660401)
+ (num-test (bes-j0 1.0) .7651976865579666)
+ (num-test (bes-j0 10.0) -.24593576445134830)
+ (num-test (bes-j0 100.0) .01998585030422355)
+ (num-test (bes-j0 1000.0) .02478668615241997)
+ (num-test (bes-j0 10000.0) -.007096160353384438)
+
+ (num-test (bes-j1 0.0) 0.0)
+ (num-test (bes-j1 0.001) 4.9999993750000266E-4)
+ (num-test (bes-j1 0.01) .004999937500260417)
+ (num-test (bes-j1 0.1) 0.049937526036242)
+ (num-test (bes-j1 1.0) .4400505857449335)
+ (num-test (bes-j1 10.0) .04347274616886149)
+ (num-test (bes-j1 100.0) -0.0771453520141124)
+ (num-test (bes-j1 1000.0) .004728311907088393)
+ (num-test (bes-j1 10000.0) .003647450755527218)
+
+ (num-test (bes-jn 10 0.0) 0.0)
+ (num-test (bes-jn 10 0.001) 2.691144394304978E-40)
+ (num-test (bes-jn 10 0.01) 2.691138339236334E-30)
+ (num-test (bes-jn 10 0.1) 2.690532895434216E-20)
+ (num-test (bes-jn 10 1.0) 2.630615123687444E-10)
+ (num-test (bes-jn 10 10.0) .2074861066333596)
+ (num-test (bes-jn 10 100.0) -.05473217693547214)
+ (num-test (bes-jn 10 1000.0) -.02452062230603636)
+ (num-test (bes-jn 10 10000.0) .007114312383352328)
+
+ (num-test (bes-jn 100 0.0) 0.0)
+ (num-test (bes-jn 100 0.1) 8.45251653512169E-289)
+ (num-test (bes-jn 100 1.0) 8.43182878962675E-189)
+ (num-test (bes-jn 100 10.0) 6.597316064155484E-89)
+ (num-test (bes-jn 100 100.0) 0.0963666732958616)
+ (num-test (bes-jn 100 1000.0) .01167613500780332)
+ (num-test (bes-jn 100 10000.0) -0.00797651631139348)
+
+ (num-test (bes-jn 1000 1000.0) .04473067294796409)
+ (num-test (bes-jn 10000 10000.0) .02076216527720082)
+
+
+ (num-test (bes-i0 0.0) 1.0)
+ (num-test (bes-i0 0.001) 1.000000250000016)
+ (num-test (bes-i0 0.01) 1.00002500015625)
+ (num-test (bes-i0 0.1) 1.002501562934096)
+ (num-test (bes-i0 1.0) 1.266065877752009)
+ (num-test (bes-i0 10.0) 2815.716628466254)
+ (num-test (bes-i0 100.0) 1.073751707131074E+42)
+
+ (num-test (bes-i1 0.0) 0.0)
+ (num-test (bes-i1 0.001) 5.000000625000026E-4)
+ (num-test (bes-i1 0.01) .005000062500260419)
+ (num-test (bes-i1 0.1) .05006252604709269)
+ (num-test (bes-i1 1.0) 0.565159103992485)
+ (num-test (bes-i1 10.0) 2670.988303701255)
+ (num-test (bes-i1 100.0) 1.068369390338162E+42)
+
+ (num-test (bes-in 10 0.0) 0.0)
+ (num-test (bes-in 10 0.001) 2.691144516629725E-40)
+ (num-test (bes-in 10 0.01) 2.691150571711132E-30)
+ (num-test (bes-in 10 0.1) 2.691756142922141E-20)
+ (num-test (bes-in 10 1.0) 2.752948039836866E-10)
+ (num-test (bes-in 10 10.0) 21.89170616372356)
+ (num-test (bes-in 10 100.0) 6.498975524720151E+41)
+
+ (num-test (bes-in 100 0.0) 0.0)
+ (num-test (bes-in 100 0.1) 8.45293498689195E-289)
+ (num-test (bes-in 100 1.0) 8.47367400813812E-189)
+ (num-test (bes-in 100 10.0) 1.082344201749218E-88)
+ (num-test (bes-in 100 100.0) 4.641534941616278E+21)
+
+
+
+ (num-test (bes-y0 0.001) -4.471416611375923)
+ (num-test (bes-y0 0.01) -3.005455637083646)
+ (num-test (bes-y0 0.1) -1.534238651350367)
+ (num-test (bes-y0 1.0) .08825696421567691)
+ (num-test (bes-y0 10.0) .05567116728359947)
+ (num-test (bes-y0 100.0) -.07724431336508303)
+ (num-test (bes-y0 1000.0) .004715917977623911)
+
+ (num-test (bes-y1 0.001) -636.6221672311393)
+ (num-test (bes-y1 0.01) -63.67859628206064)
+ (num-test (bes-y1 0.1) -6.458951094702027)
+ (num-test (bes-y1 1.0) -.7812128213002888)
+ (num-test (bes-y1 10.0) .2490154242069539)
+ (num-test (bes-y1 100.0) -.02037231200275883)
+ (num-test (bes-y1 1000.0) -0.024784331292352)
+
+ (num-test (bes-yn 10 0.001) -1.182804937799041E+38)
+ (num-test (bes-yn 10 0.01) -1.182808190517663E+28)
+ (num-test (bes-yn 10 0.1) -1.18313351320452E+18)
+ (num-test (bes-yn 10 1.0) -1.2161801427868918E+8)
+ (num-test (bes-yn 10 10.0) -.3598141521834028)
+ (num-test (bes-yn 10 100.0) .05833157423641527)
+ (num-test (bes-yn 10 1000.0) -.005949000574163774)
+
+ (num-test (bes-yn 100 0.1) -3.76586125601925E+285)
+ (num-test (bes-yn 100 1.0) -3.77528781011053E+185)
+ (num-test (bes-yn 100 10.0) -4.849148271180334E+85)
+ (num-test (bes-yn 100 100.0) -.1669214114175733)
+ (num-test (bes-yn 100 1000.0) -.02243868825772313)
+
+ (num-test (bes-yn 1000 1000.0) -.07747600152069181)
+
+
+ (num-test (bes-k0 0.001) 7.023688800562383)
+ (num-test (bes-k0 0.01) 4.721244730161095)
+ (num-test (bes-k0 0.1) 2.427069024702016)
+ (num-test (bes-k0 1.0) .4210244382407085)
+ (num-test (bes-k0 10.0) 1.7780062316167652E-5)
+ (num-test (bes-k0 100.0) 4.656628229175902E-45)
+
+ (num-test (bes-k1 0.001) 999.9962381560855)
+ (num-test (bes-k1 0.01) 99.97389411829626)
+ (num-test (bes-k1 0.1) 9.853844780870606)
+ (num-test (bes-k1 1.0) .6019072301972346)
+ (num-test (bes-k1 10.0) 1.8648773453825582E-5)
+ (num-test (bes-k1 100.0) 4.67985373563691E-45)
+
+ (num-test (bes-kn 10 0.001) 1.857945548390401E+38)
+ (num-test (bes-kn 10 0.01) 1.857940439048065E+28)
+ (num-test (bes-kn 10 0.1) 1.857429584630401E+18)
+ (num-test (bes-kn 10 1.0) 1.807132899010295E+8)
+ (num-test (bes-kn 10 10.0) 0.00161425530039067)
+ (num-test (bes-kn 10 100.0) 7.655427977388101E-45)
+
+ (num-test (bes-kn 100 0.1) 5.91510227809082E+285)
+ (num-test (bes-kn 100 1.0) 5.90033318363862E+185)
+ (num-test (bes-kn 100 10.0) 4.596674084269265E+85)
+ (num-test (bes-kn 100 100.0) 7.617129630494247E-25)
+ (num-test (bes-kn 100 1000.0) 0.0)
+ ))
+
(if with-gui
(let* ((delay-32 (make-delay 32))
@@ -65015,8 +65113,7 @@ EDITS: 1
;new-sound in add-watcher
read-mix-sample next-sample read-region-sample
transform-normalization open-file-dialog-directory open-raw-sound open-sound previous-sample
- peaks ;play play-and-wait play-mix play-region play-selection
- player? players
+ peaks player? players
position-color position->x position->y add-directory-to-view-files-list add-file-to-view-files-list view-files-sort
view-files-amp view-files-speed view-files-files view-files-selected-files view-files-speed-style view-files-amp-env
print-length progress-report prompt-in-minibuffer pushed-button-color read-only
@@ -65096,7 +65193,7 @@ EDITS: 1
two-zero? wave-train wave-train? make-vct vct-add! vct-subtract! vct-copy
vct-length vct-multiply! vct-offset! vct-ref vct-scale! vct-fill! vct-set! vct-peak
vct? list->vct vct->list vector->vct vct->vector vct-move! vct-reverse! vct-subseq vct little-endian? vct->string
- clm-channel env-channel env-channel-with-base map-channel scan-channel play-channel
+ clm-channel env-channel env-channel-with-base map-channel scan-channel
reverse-channel seconds->samples samples->seconds
smooth-channel vct->channel channel->vct src-channel scale-channel ramp-channel pad-channel normalize-channel
cursor-position clear-listener mus-sound-prune mus-sound-forget xramp-channel ptree-channel
@@ -65161,7 +65258,7 @@ EDITS: 1
selected-sound selection-position selection-frames selection-member? sound-loop-info
srate time-graph-type x-position-slider x-zoom-slider
y-position-slider y-zoom-slider sound-data-ref mus-array-print-length mus-float-equal-fudge-factor
- ;mus-data
+ ;mus-data
mus-feedback mus-feedforward mus-frequency mus-hop
mus-increment mus-length mus-location mus-name mus-phase mus-ramp mus-scaler vct-ref x-axis-label
filter-control-coeffs locsig-type mus-file-buffer-size
@@ -65215,33 +65312,33 @@ EDITS: 1
"list->vct" "vct" "formant-bank"
))
)
-#|
+ #|
(for-each
- (lambda (n)
- (if (and (not (member n procs0))
- (not (member n procs1))
- (not (member n procs2))
- (not (member n procs3))
- (not (member n procs4))
- (not (member n procs5))
- (not (member n procs6))
- (not (member n procs8))
- (not (member n procs10)))
- (snd-display ";not in any list: ~A" n)))
- procs)
+ (lambda (n)
+ (if (and (not (member n procs0))
+ (not (member n procs1))
+ (not (member n procs2))
+ (not (member n procs3))
+ (not (member n procs4))
+ (not (member n procs5))
+ (not (member n procs6))
+ (not (member n procs8))
+ (not (member n procs10)))
+ (snd-display #__line__ ";not in any list: ~A" n)))
+ procs)
(for-each
- (lambda (n)
- (if (and (not (member n set-procs0))
- (not (member n set-procs1))
- (not (member n set-procs2))
- (not (member n set-procs3))
- (not (member n set-procs4)))
- (snd-display ";not in any set list: ~A" n)))
- set-procs)
-|#
+ (lambda (n)
+ (if (and (not (member n set-procs0))
+ (not (member n set-procs1))
+ (not (member n set-procs2))
+ (not (member n set-procs3))
+ (not (member n set-procs4)))
+ (snd-display #__line__ ";not in any set list: ~A" n)))
+ set-procs)
+ |#
(if all-args
- (snd-display ";procs 0: ~A ~A, 1: ~A ~A, 2: ~A ~A, 3: ~A ~A, 4: ~A ~A, 5: ~A, 6: ~A, 7: ~A, 8: ~A, 10: ~A"
+ (snd-display #__line__ ";procs 0: ~A ~A, 1: ~A ~A, 2: ~A ~A, 3: ~A ~A, 4: ~A ~A, 5: ~A, 6: ~A, 7: ~A, 8: ~A, 10: ~A"
(length procs0) (length set-procs0)
(length procs1) (length set-procs1)
(length procs2) (length set-procs2)
@@ -65303,7 +65400,7 @@ EDITS: 1
(set! cadr-main (make-oscil 440))
(set! a-hook (make-mixer 2 .1 .2 .1 .2))
))))))
-
+
(for-each (lambda (n)
(let ((tag
(catch #t
@@ -65311,7 +65408,7 @@ EDITS: 1
(n (integer->sound 123)))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-sound))
- (snd-display ";snd no-such-sound ~A: ~A" n tag))))
+ (snd-display #__line__ ";snd no-such-sound ~A: ~A" n tag))))
(list amp-control apply-controls channels chans comment contrast-control
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
reverb-control-length-bounds reverb-control-scale-bounds
@@ -65333,7 +65430,7 @@ EDITS: 1
(lambda args (car args)))))
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'mus-error)))
- (snd-display ";snd wrong-type-arg ~A: ~A ~A" n tag arg))))
+ (snd-display #__line__ ";snd wrong-type-arg ~A: ~A ~A" n tag arg))))
(list amp-control bomb apply-controls close-sound comment contrast-control
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
reverb-control-length-bounds reverb-control-scale-bounds
@@ -65358,7 +65455,7 @@ EDITS: 1
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'syntax-error))
(not (eq? tag 'error)))
- (snd-display ";snd set wrong-type-arg ~D: ~A: ~A ~A" ctr n tag arg))
+ (snd-display #__line__ ";snd set wrong-type-arg ~D: ~A: ~A ~A" ctr n tag arg))
(set! ctr (+ ctr 1))))
(list amp-control channels chans comment contrast-control contrast-control-amp
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
@@ -65381,7 +65478,7 @@ EDITS: 1
(set! (n index) arg))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";snd safe set wrong-type-arg ~A: ~A ~A ~A" ctr n tag arg))
+ (snd-display #__line__ ";snd safe set wrong-type-arg ~A: ~A ~A ~A" ctr n tag arg))
(set! ctr (+ ctr 1))))
(list amp-control contrast-control contrast-control-amp contrast-control? expand-control
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
@@ -65402,7 +65499,7 @@ EDITS: 1
(n arg))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";vct 0 wrong-type-arg ~A: ~A ~A" n tag arg))))
+ (snd-display #__line__ ";vct 0 wrong-type-arg ~A: ~A ~A" n tag arg))))
(list make-vct vct-copy vct-length vct->list vct-peak)))
(list (make-vector 1) "hiho" (sqrt -1.0) 1.5 (list 1 0) '#(0 1) delay-32))
@@ -65417,7 +65514,7 @@ EDITS: 1
(if (not (or (eq? tag 'wrong-type-arg)
(eq? tag 'wrong-number-of-args)
(eq? tag 'mus-error)))
- (snd-display ";vct 1 wrong-whatever ~A: ~A ~A ~A" n tag arg1 arg2))))
+ (snd-display #__line__ ";vct 1 wrong-whatever ~A: ~A ~A ~A" n tag arg1 arg2))))
(list vct-add! vct-subtract! vct-multiply! vct-ref vct-scale! vct-fill!)))
(list vct-5 "hiho" (sqrt -1.0) 1.5 (list 1 0) '#(0 1) delay-32)))
(list (make-vector 1) "hiho" (sqrt -1.0) 1.5 (list 1 0) '#(0 1) delay-32))
@@ -65430,7 +65527,7 @@ EDITS: 1
(n vct-3 arg))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";vct 2 wrong-type-arg ~A: ~A" n tag))))
+ (snd-display #__line__ ";vct 2 wrong-type-arg ~A: ~A" n tag))))
(list vct-add! vct-subtract! vct-multiply! vct-ref vct-scale! vct-fill!)))
(list (make-vector 1) "hiho" (sqrt -1.0) (list 1 0) '#(0 1) delay-32))
@@ -65440,7 +65537,7 @@ EDITS: 1
(make-vct -23))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";make-vct -23: ~A" tag)))
+ (snd-display #__line__ ";make-vct -23: ~A" tag)))
(let* ((v vct-3))
(let ((tag
@@ -65449,7 +65546,7 @@ EDITS: 1
(vct-ref v 12))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display ";vct[12]: ~A" tag))))
+ (snd-display #__line__ ";vct[12]: ~A" tag))))
(for-each (lambda (arg)
(for-each (lambda (n)
@@ -65459,7 +65556,7 @@ EDITS: 1
(n arg))
(lambda args (car args)))))
(if tag
- (snd-display ";?proc ~A: ~A" n tag))))
+ (snd-display #__line__ ";?proc ~A: ~A" n tag))))
(list all-pass? asymmetric-fm? comb? filtered-comb? convolve? delay? env? file->frame? file->sample? snd->sample?
filter? fir-filter? formant? firmant? frame->file? frame? granulate? iir-filter? locsig? mixer? move-sound? mus-input?
mus-output? notch? one-pole? one-zero? oscil? phase-vocoder? pulse-train? rand-interp? rand? readin?
@@ -65477,7 +65574,7 @@ EDITS: 1
(n (make-oscil 440)))
(lambda args (car args)))))
(if tag
- (snd-display ";oscil?proc ~A: ~A" n tag))))
+ (snd-display #__line__ ";oscil?proc ~A: ~A" n tag))))
(list all-pass? asymmetric-fm? comb? filtered-comb? convolve? delay? env? file->frame? file->sample? snd->sample?
filter? fir-filter? formant? firmant? frame->file? frame? granulate? iir-filter? locsig? mixer? move-sound? mus-input?
mus-output? notch? one-pole? one-zero? phase-vocoder? pulse-train? rand-interp? rand? readin?
@@ -65493,7 +65590,7 @@ EDITS: 1
(n))
(lambda args (car args)))))
(if (not (eq? tag 'no-active-selection))
- (snd-display ";selection ~A: ~A" n tag))))
+ (snd-display #__line__ ";selection ~A: ~A" n tag))))
(list reverse-selection selection-position selection-frames smooth-selection
scale-selection-to insert-selection delete-selection mix-selection))
@@ -65504,7 +65601,7 @@ EDITS: 1
(n 0.0))
(lambda args (car args)))))
(if (not (eq? tag 'no-active-selection))
- (snd-display ";selection ~A: ~A" n tag))))
+ (snd-display #__line__ ";selection ~A: ~A" n tag))))
(list src-selection filter-selection env-selection))
(for-each (lambda (arg)
@@ -65521,7 +65618,7 @@ EDITS: 1
(not (eq? tag 'bad-type))
(not (eq? tag 'error))
(not (eq? tag 'arg-error)))
- (snd-display ";clm ~A: tag: ~A arg: ~A [~A]" n tag arg ctr))
+ (snd-display #__line__ ";clm ~A: tag: ~A arg: ~A [~A]" n tag arg ctr))
(set! ctr (+ 1 ctr))))
(list all-pass asymmetric-fm clear-array comb filtered-comb convolve db->linear moving-average
degrees->radians delay env formant firmant frame->list granulate hz->radians linear->db
@@ -65555,7 +65652,7 @@ EDITS: 1
(eq? tag 'bad-arity)
(eq? tag 'error)
(eq? tag 'mus-error)))
- (snd-display ";clm-1 ~A: ~A" n tag))))
+ (snd-display #__line__ ";clm-1 ~A: ~A" n tag))))
(list all-pass array-interp asymmetric-fm comb filtered-comb contrast-enhancement convolution convolve moving-average
convolve-files delay dot-product env-interp file->frame file->sample snd->sample filter fir-filter formant firmant
formant-bank frame* frame+ frame->frame frame-ref frame->sample granulate iir-filter ina
@@ -65580,7 +65677,7 @@ EDITS: 1
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'syntax-error))
(not (eq? tag 'error)))
- (snd-display ";mus-gen ~A: ~A" n tag))))
+ (snd-display #__line__ ";mus-gen ~A: ~A" n tag))))
(list mus-channel mus-channels mus-data
mus-feedback mus-feedforward mus-frequency mus-hop mus-increment mus-length
mus-location mus-mix mus-name mus-order mus-phase mus-ramp mus-random mus-run mus-scaler mus-xcoeffs
@@ -65594,7 +65691,7 @@ EDITS: 1
(n vct-5))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";mus-sound ~A: ~A" n tag))))
+ (snd-display #__line__ ";mus-sound ~A: ~A" n tag))))
(list mus-sound-samples mus-sound-frames mus-sound-duration mus-sound-datum-size
mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-data-format
mus-sound-length mus-sound-type-specifier mus-header-type-name mus-data-format-name mus-sound-comment
@@ -65609,7 +65706,7 @@ EDITS: 1
(lambda args (car args)))))
(if (and (not (eq? tag 'wrong-number-of-args))
(not (eq? tag 'error)))
- (snd-display ";no arg mus-sound ~A: ~A" n tag))))
+ (snd-display #__line__ ";no arg mus-sound ~A: ~A" n tag))))
(list mus-sound-samples mus-sound-frames mus-sound-duration mus-sound-datum-size
mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-data-format
mus-sound-length mus-sound-type-specifier mus-header-type-name mus-data-format-name mus-sound-comment
@@ -65623,7 +65720,7 @@ EDITS: 1
(n "/bad/baddy"))
(lambda args (car args)))))
(if (not (eq? tag 'mus-error))
- (snd-display ";bad file mus-sound ~A: ~A" n tag))))
+ (snd-display #__line__ ";bad file mus-sound ~A: ~A" n tag))))
(list mus-sound-samples mus-sound-frames mus-sound-duration mus-sound-datum-size
mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-data-format
mus-sound-length mus-sound-type-specifier mus-sound-comment mus-sound-write-date mus-sound-maxamp
@@ -65640,7 +65737,7 @@ EDITS: 1
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'error))
(not (eq? tag 'no-such-sound)))
- (snd-display ";~D: chn (no snd) procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: chn (no snd) procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list channel-widgets count-matches cursor channel-properties channel-property
with-tracking-cursor cursor-position cursor-size cursor-style tracking-cursor-style delete-sample display-edits dot-size
@@ -65668,7 +65765,7 @@ EDITS: 1
(n 0 vct-5))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";~D: chn (no chn) procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: chn (no chn) procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list channel-widgets count-matches cursor channel-properties channel-property
cursor-position cursor-size cursor-style tracking-cursor-style delete-sample display-edits dot-size draw-dots draw-lines
@@ -65677,7 +65774,7 @@ EDITS: 1
graph graph-style lisp-graph? insert-region insert-sound left-sample
time-graph-style lisp-graph-style transform-graph-style
make-graph-data map-chan max-transform-peaks maxamp maxamp-position min-dB mix-region transform-normalization
- peaks play play-and-wait position->x position->y reverse-sound right-sample sample
+ peaks play position->x position->y reverse-sound right-sample sample
save-sound-as scan-chan show-axes show-transform-peaks show-marks
show-mix-waveforms show-y-zero show-grid show-sonogram-cursor
spectrum-end spectro-hop spectrum-start spectro-x-angle
@@ -65695,7 +65792,7 @@ EDITS: 1
(n (integer->sound 1234)))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-sound))
- (snd-display ";~D: chn procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: chn procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list channel-widgets cursor with-tracking-cursor channel-properties
cursor-position cursor-size cursor-style tracking-cursor-style
@@ -65706,8 +65803,6 @@ EDITS: 1
graph-data graph-style lisp-graph? left-sample
time-graph-style lisp-graph-style transform-graph-style
make-graph-data max-transform-peaks maxamp maxamp-position min-dB transform-normalization
-; (lambda (snd) (play snd 0))
-; (lambda (snd) (play-and-wait 0 snd))
(lambda (snd) (position->x 0 snd))
(lambda (snd) (position->y 0 snd))
(lambda (snd) (redo 1 snd)) reverse-sound revert-sound right-sample
@@ -65737,9 +65832,9 @@ EDITS: 1
(n 0 1234))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-sound))
- (snd-display ";~D: snd(1) chn procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: snd(1) chn procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
- (list delete-sample edit-fragment graph-data graph-style play play-and-wait position->x position->y redo
+ (list delete-sample edit-fragment graph-data graph-style play position->x position->y redo
time-graph-style lisp-graph-style transform-graph-style
scale-by scale-to undo x->position y->position x-axis-label)))
@@ -65752,7 +65847,7 @@ EDITS: 1
(n 0 index 1234))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-channel))
- (snd-display ";~D: snd(1 1234) chn procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: snd(1 1234) chn procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list delete-sample edit-fragment graph-data position->x position->y redo scale-by
scale-to undo x->position y->position))
@@ -65768,7 +65863,7 @@ EDITS: 1
(lambda args (car args)))))
(if (and (not (eq? tag 'no-such-channel))
(not (eq? tag 'no-such-sound)))
- (snd-display ";~D: chn procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: chn procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list channel-widgets cursor cursor-position cursor-size cursor-style tracking-cursor-style display-edits
dot-size edit-position edit-tree edits fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases
@@ -65795,7 +65890,7 @@ EDITS: 1
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'syntax-error))
(not (eq? tag 'error)))
- (snd-display ";~D: set chn procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: set chn procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list channel-widgets cursor cursor-position display-edits dot-size edit-tree edits
fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases transform-size transform-graph-type fft-window
@@ -65822,7 +65917,7 @@ EDITS: 1
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'syntax-error))
(not (eq? tag 'error)))
- (snd-display ";[0] ~D: mix procs ~A: ~A (~A)" ctr b tag vct-5))
+ (snd-display #__line__ ";[0] ~D: mix procs ~A: ~A (~A)" ctr b tag vct-5))
(set! ctr (+ ctr 1))))
(list mix-amp mix-amp-env mix-length mix-name mix-position mix-home mix-speed mix-tag-y)
(list 'mix-amp 'mix-amp-env 'mix-length 'mix-name 'mix-position 'mix-home 'mix-speed 'mix-tag-y)))
@@ -65835,7 +65930,7 @@ EDITS: 1
(n (integer->mix 1234)))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-mix))
- (snd-display ";[1] ~D: mix procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";[1] ~D: mix procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list mix-amp mix-length mix-name mix-position mix-home mix-speed mix-tag-y)))
@@ -65850,7 +65945,7 @@ EDITS: 1
(not (eq? tag 'syntax-error))
(not (eq? tag 'error))
(not (eq? tag 'no-such-mix))) ; if id checked first
- (snd-display ";[2] ~D: mix procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";[2] ~D: mix procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list mix-name mix-position mix-home mix-speed mix-tag-y)))
@@ -65866,7 +65961,7 @@ EDITS: 1
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'syntax-error))
(not (eq? tag 'error)))
- (snd-display ";[3] ~D: mix procs ~A: ~A (~A)" ctr b tag vct-5))
+ (snd-display #__line__ ";[3] ~D: mix procs ~A: ~A (~A)" ctr b tag vct-5))
(set! ctr (+ ctr 1))))
(list mix-name mix-position mix-home mix-speed mix-tag-y)
(list 'mix-name 'mix-position 'mix-home 'mix-speed 'mix-tag-y))
@@ -65880,7 +65975,7 @@ EDITS: 1
(n vct-5))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";~D: mark procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: mark procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list add-mark mark-name mark-sample mark-sync mark-home delete-mark delete-marks find-mark)))
@@ -65892,7 +65987,7 @@ EDITS: 1
(n (integer->mark 1234)))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-mark))
- (snd-display ";~D: no mark procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: no mark procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list mark-name mark-sample mark-sync mark-home delete-mark)))
@@ -65906,7 +66001,7 @@ EDITS: 1
(set! (n id) vct-5))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";~D: set mark procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: set mark procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list mark-name mark-sample mark-sync))
(close-sound index)
@@ -65922,7 +66017,7 @@ EDITS: 1
(lambda args (car args)))))
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'wrong-number-of-args)))
- (snd-display ";~D: region procs ~A: ~A ~A" ctr n tag arg))
+ (snd-display #__line__ ";~D: region procs ~A: ~A ~A" ctr n tag arg))
(set! ctr (+ ctr 1))))
(list region-chans region-home region-frames
region-position region-maxamp region-maxamp-position region-sample
@@ -65937,7 +66032,7 @@ EDITS: 1
(n (integer->region 1234)))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-region))
- (snd-display ";~D: (no) region procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: (no) region procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list region-chans region-home region-frames region-position
region-maxamp region-maxamp-position region-srate forget-region)))
@@ -65952,7 +66047,7 @@ EDITS: 1
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'syntax-error))
(not (eq? tag 'error)))
- (snd-display ";~D: misc procs ~A: ~A" ctr n tag))
+ (snd-display #__line__ ";~D: misc procs ~A: ~A" ctr n tag))
(set! ctr (+ ctr 1))))
(list axis-color enved-filter-order enved-filter filter-control-waveform-color ask-before-overwrite
auto-resize auto-update axis-label-font axis-numbers-font basic-color bind-key
@@ -65984,7 +66079,7 @@ EDITS: 1
(lambda () (add-hook! hook (lambda () (+ 1 2))))
(lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display ";hooks ~A: ~A" hook-name tag))))
+ (snd-display #__line__ ";hooks ~A: ~A" hook-name tag))))
(list (list after-graph-hook 'after-graph-hook)
(list after-lisp-graph-hook 'after-lisp-graph-hook)
(list lisp-graph-hook 'lisp-graph-hook)
@@ -66076,7 +66171,7 @@ EDITS: 1
(check-error-tag 'mus-error (lambda () (make-iir-filter :coeffs (make-vct 4) :ycoeffs (make-vct 4))))
(check-error-tag 'mus-error (lambda () (make-fir-filter :coeffs (make-vct 4) :xcoeffs (make-vct 4))))
(check-error-tag 'out-of-range (lambda () (make-table-lookup :size 123456789)))
-; (check-error-tag 'out-of-range (lambda () (make-src :srate -0.5)))
+ ; (check-error-tag 'out-of-range (lambda () (make-src :srate -0.5)))
(check-error-tag 'out-of-range (lambda () (make-granulate :ramp -0.5)))
(check-error-tag 'out-of-range (lambda () (make-granulate :ramp 1.5)))
(check-error-tag 'mus-error (lambda () (make-granulate :expansion 32000.0)))
@@ -66119,7 +66214,7 @@ EDITS: 1
(check-error-tag 'out-of-range (lambda () (mus-sound-close-input 2)))
(check-error-tag 'out-of-range (lambda () (set! (mus-array-print-length) -1)))
(check-error-tag 'out-of-range (lambda () (set! (print-length) -1)))
-; (check-error-tag 'wrong-type-arg (lambda () (vector->vct (make-vector 3 "hio"))))
+ ; (check-error-tag 'wrong-type-arg (lambda () (vector->vct (make-vector 3 "hio"))))
(check-error-tag 'out-of-range (lambda () (set! (enved-style) 12)))
(check-error-tag 'out-of-range (lambda () (make-color 1.5 0.0 0.0)))
(check-error-tag 'out-of-range (lambda () (make-color -0.5 0.0 0.0)))
@@ -66169,8 +66264,6 @@ EDITS: 1
(check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind mus-voc mus-bshort)))
(check-error-tag 'cannot-save (lambda () (save-selection "test.snd" mus-riff mus-bshort)))
(check-error-tag 'cannot-save (lambda () (save-selection "test.snd" mus-voc mus-bshort)))
- (check-error-tag 'wrong-type-arg (lambda () (play-selection 0 (lambda () #f))))
- (check-error-tag 'wrong-type-arg (lambda () (play-selection 0 0)))
(check-error-tag 'no-data (lambda () (draw-lines '#())))
(check-error-tag 'bad-length (lambda () (draw-lines '#(1 2 3))))
(check-error-tag 'out-of-range (lambda () (src-channel (make-env '(0 0 1 1) :length 11))))
@@ -66190,7 +66283,7 @@ EDITS: 1
(check-error-tag 'out-of-range (lambda () (snd-spectrum (make-vct 8) 0 0)))
(check-error-tag 'no-such-file (lambda () (play "/baddy/hiho")))
(check-error-tag 'bad-format (lambda () (play (string-append sf-dir "nist-shortpack.wav"))))
-; (check-error-tag 'no-such-channel (lambda () (play ind 0 :channel 123)))
+ ; (check-error-tag 'no-such-channel (lambda () (play ind 0 :channel 123)))
(check-error-tag 'no-such-channel (lambda () (make-player ind 123)))
(check-error-tag 'no-such-file (lambda () (mix "/baddy/hiho")))
(check-error-tag 'no-such-channel (lambda () (mix "oboe.snd" 0 2)))
@@ -66221,21 +66314,21 @@ EDITS: 1
(check-error-tag 'no-such-channel (lambda () (axis-info ind 1234)))
(check-error-tag 'no-such-sound (lambda () (axis-info 1234)))
(set! (time-graph-type) graph-once)
-; (check-error-tag 'out-of-range (lambda () (set! (x-bounds) (list 0 0))))
+ ; (check-error-tag 'out-of-range (lambda () (set! (x-bounds) (list 0 0))))
(check-error-tag 'out-of-range (lambda () (set! (x-bounds) (list .1 -.1))))
-; (check-error-tag 'out-of-range (lambda () (set! (y-bounds) (list .2 .1))))
+ ; (check-error-tag 'out-of-range (lambda () (set! (y-bounds) (list .2 .1))))
(check-error-tag 'out-of-range (lambda () (make-region 100 0)))
(check-error-tag 'no-such-sample (lambda () (delete-sample -1)))
(check-error-tag 'no-such-sample (lambda () (delete-sample (* 2 (frames ind)))))
(check-error-tag 'no-such-file (lambda () (play "/bad/baddy.snd")))
(check-error-tag 'no-such-sound (lambda () (play 1234 0)))
-; (check-error-tag 'no-such-channel (lambda () (play ind 0 :channel 1234)))
+ ; (check-error-tag 'no-such-channel (lambda () (play ind 0 :channel 1234)))
(if (= (length (regions)) 0) (make-region 0 100))
(check-error-tag 'no-such-channel (lambda () (region-sample (car (regions)) 0 1234)))
(check-error-tag 'no-such-channel (lambda () (region-frames (car (regions)) 1234)))
(check-error-tag 'no-such-channel (lambda () (region-position (car (regions)) 1234)))
-; (check-error-tag 'no-such-region (lambda () (region->vct #f 0 1)))
-; (check-error-tag 'no-such-channel (lambda () (region->vct (car regions) 0 1 1234)))
+ ; (check-error-tag 'no-such-region (lambda () (region->vct #f 0 1)))
+ ; (check-error-tag 'no-such-channel (lambda () (region->vct (car regions) 0 1 1234)))
(check-error-tag 'cannot-save (lambda () (save-sound-as "/bad/baddy.snd")))
(check-error-tag 'no-such-sound (lambda () (transform-sample 0 1 1234)))
(check-error-tag 'no-such-channel (lambda () (transform-sample 0 1 ind 1234)))
@@ -66243,7 +66336,6 @@ EDITS: 1
(check-error-tag 'no-such-channel (lambda () (samples->sound-data 0 100 ind 1234)))
(check-error-tag 'no-such-sound (lambda () (graph (vct 0 1) "hi" 0 1 0 1 1234)))
(check-error-tag 'no-such-channel (lambda () (graph (vct 0 1) "hi" 0 1 0 1 ind 1234)))
-; (check-error-tag 'wrong-type-arg (lambda () (play-region (car (regions)) #f (lambda () #f))))
(set! (selection-member? #t) #f)
(check-error-tag 'no-active-selection (lambda () (filter-selection (vct 0 0 1 1) 4)))
(check-error-tag 'no-active-selection (lambda () (save-selection "/bad/baddy.snd")))
@@ -66341,7 +66433,7 @@ EDITS: 1
(check-error-tag 'out-of-range (lambda () (make-delay 3 :max-size 100 :initial-contents (vct .1 .2 .3))))
(check-error-tag 'out-of-range (lambda () (make-table-lookup :size 100 :wave (make-vct 3))))
(check-error-tag 'out-of-range (lambda () (make-wave-train :size 100 :wave (make-vct 3))))
-; (check-error-tag 'out-of-range (lambda () (make-granulate :max-size (expt 2 30))))
+ ; (check-error-tag 'out-of-range (lambda () (make-granulate :max-size (expt 2 30))))
(check-error-tag 'out-of-range (lambda () (make-ssb-am 100 12345678)))
(check-error-tag 'mus-error (lambda () (make-rand :envelope '(0 0 1 1) :distribution (make-vct 10))))
(check-error-tag 'mus-error (lambda () (make-rand :envelope '(0 0 1))))
@@ -66365,7 +66457,7 @@ EDITS: 1
(check-error-tag 'mus-error (lambda () (let ((m (make-mixer 2))) (mixer-ref m 3 4))))
(check-error-tag 'bad-arity (lambda () (add-colormap "baddy" (lambda () #f))))
(check-error-tag 'bad-arity (lambda () (add-colormap "baddy" (lambda (a b c) #f))))
-; (check-error-tag 'out-of-range (lambda () (make-phase-vocoder :fft-size (expt 2 30))))
+ ; (check-error-tag 'out-of-range (lambda () (make-phase-vocoder :fft-size (expt 2 30))))
(check-error-tag 'out-of-range (lambda () (let ((sr (make-src :input (lambda (dir) 1.0)))) (src sr 2000000.0))))
(check-error-tag 'out-of-range (lambda () (partials->polynomial '(1 1) -1)))
(check-error-tag 'out-of-range (lambda () (partials->polynomial '(1 1) 3)))
@@ -66375,18 +66467,17 @@ EDITS: 1
(check-error-tag 'wrong-type-arg (lambda () (normalize-partials '())))
(check-error-tag 'bad-type (lambda () (normalize-partials '(1 2 3))))
(check-error-tag 'bad-type (lambda () (normalize-partials (vct 3))))
-
+
(check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (vct 1 1 -2 1))))
(check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (list 1 1 -2 1))))
- ;(check-error-tag 'wrong-type-arg (lambda () (make-polyshape 440.0 :partials (list 1 1 "hi" 1)))) ; can be 'no-data etc
- ;(check-error-tag 'wrong-type-arg (lambda () (make-polyshape 440.0 :partials (list 1 1 2 "hi"))))
+ ;(check-error-tag 'wrong-type-arg (lambda () (make-polyshape 440.0 :partials (list 1 1 "hi" 1)))) ; can be 'no-data etc
+ ;(check-error-tag 'wrong-type-arg (lambda () (make-polyshape 440.0 :partials (list 1 1 2 "hi"))))
(check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (list))))
-
+
(check-error-tag 'wrong-type-arg (lambda () (set! (mus-header-raw-defaults) 1234)))
(check-error-tag 'wrong-type-arg (lambda () (set! (mus-header-raw-defaults) (list 44100 2.123 "hi"))))
(check-error-tag 'no-such-mix (lambda () (mix-properties (integer->mix (+ 1 (mix-sync-max))))))
(check-error-tag 'no-such-mix (lambda () (set! (mix-properties (integer->mix (+ 1 (mix-sync-max)))) 1)))
- (check-error-tag 'no-such-mix (lambda () (play-mix (integer->mix (+ 1 (mix-sync-max))))))
))
(if (provided? 'snd-motif)
@@ -66396,15 +66487,15 @@ EDITS: 1
(lambda () (n (list 'Widget 0)))
(lambda args (car args)))))
(if (not (eq? tag 'no-such-widget))
- (snd-display ";~A of null widget -> ~A" name tag))))
+ (snd-display #__line__ ";~A of null widget -> ~A" name tag))))
(list widget-position widget-size widget-text hide-widget show-widget focus-widget)
(list 'widget-position 'widget-size 'widget-text 'hide-widget 'show-widget 'focus-widget)))
;; now try everything! (all we care about here is that Snd keeps running)
; (reset-hook! snd-error-hook)
- ; (add-hook! snd-error-hook (lambda (msg) (snd-display msg) #t))
-
+ ; (add-hook! snd-error-hook (lambda (msg) (snd-display #__line__ msg) #t))
+
;; ---------------- key args
(for-each
(lambda (arg1)
@@ -66457,8 +66548,8 @@ EDITS: 1
(list 1.5 "/hiho" (list 0 1) 1234 vct-3 :wave -1 0 1 #f #t '() vector-0 delay-32))))
;; (set! a-sound (new-sound "test.snd" mus-next mus-bshort 22050 1 "set-samples test" 100))
- (if all-args (snd-display ";args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time)))))
-
+ (if all-args (snd-display #__line__ ";args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time)))))
+
;; ---------------- 0 Args
(for-each
(lambda (n)
@@ -66467,28 +66558,28 @@ EDITS: 1
(n))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs0: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs0: ~A ~A" err (procedure-property n 'documentation)))))
procs0)
(dismiss-all-dialogs)
(let* ((main-args (list 1.5 "/hiho" (list 0 1) 1234 vct-3 color-95 '#(0 1) 3/4 'mus-error (sqrt -1.0) delay-32
- (lambda () #t) vct-5 sound-data-23 :order 0 1 -1 a-hook #f #t #\c 0.0 -1.0
- '() '3 64 -64 vector-0 '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0) car-main cadr-main
- (lambda (a) #f) abs
- 1.0+1.0i (cons 1 2) '((1 2) (3 4)) '((1 (2)) (((3) 4)))
- (vector 1 #\a '(3)) (make-vector 0)
- (let ((x 3)) (lambda (y) (+ x y))) (lambda args args)
- "" (make-hash-table 256)
- (symbol->value '_?__undefined__?_) ; -> #<undefined> hopefully
- (vector-fill! (vector 0) 0) ; -> #<unspecified>?
- (with-input-from-string "" (lambda () (read-char))) ; -> #<eof>?
- (make-random-state 1234)
- ))
+ (lambda () #t) vct-5 sound-data-23 :order 0 1 -1 a-hook #f #t #\c 0.0 -1.0
+ '() '3 64 -64 vector-0 '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0) car-main cadr-main
+ (lambda (a) #f) abs
+ 1.0+1.0i (cons 1 2) '((1 2) (3 4)) '((1 (2)) (((3) 4)))
+ (vector 1 #\a '(3)) (make-vector 0)
+ (let ((x 3)) (lambda (y) (+ x y))) (lambda args args)
+ "" (make-hash-table 256)
+ (symbol->value '_?__undefined__?_) ; -> #<undefined> hopefully
+ (vector-fill! (vector 0) 0) ; -> #<unspecified>?
+ (with-input-from-string "" (lambda () (read-char))) ; -> #<eof>?
+ (make-random-state 1234)
+ ))
(few-args (list 1.5 "/hiho" (list 0 1) 1234 vct-3 color-95 '#(0 1) 3/4 -1.0
(sqrt -1.0) delay-32 :feedback -1 0 1 "" 'hi (lambda (a) (+ a 1)) -64 #f #t '() vector-0))
(fewer-args (list "/hiho" 1234 vct-3 -1.0 (sqrt -1.0) delay-32 -1 0 1 #f #t "" '()))
(less-args (if all-args main-args few-args)))
-
+
;; ---------------- 1 Arg
(for-each
(lambda (arg)
@@ -66498,7 +66589,7 @@ EDITS: 1
(lambda () (n arg))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs1 wna: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs1 wna: ~A ~A" err (procedure-property n 'documentation)))))
procs1))
main-args)
@@ -66513,7 +66604,7 @@ EDITS: 1
(lambda () (n arg1 arg2))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs2: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs2: ~A ~A" err (procedure-property n 'documentation)))))
procs2))
main-args))
main-args)
@@ -66527,7 +66618,7 @@ EDITS: 1
(lambda () (set! (n) arg))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";set-procs0: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";set-procs0: ~A ~A" err (procedure-property n 'documentation)))))
set-procs0))
main-args)
@@ -66542,7 +66633,7 @@ EDITS: 1
(lambda () (set! (n arg1) arg2))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";set-procs1: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";set-procs1: ~A ~A" err (procedure-property n 'documentation)))))
set-procs1))
main-args))
main-args)
@@ -66560,7 +66651,7 @@ EDITS: 1
(lambda () (set! (n arg1 arg2) arg3))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";set-procs2: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";set-procs2: ~A ~A" err (procedure-property n 'documentation)))))
set-procs2))
less-args))
less-args))
@@ -66570,8 +66661,8 @@ EDITS: 1
;; these can take awhile...
(begin
- (snd-display ";3 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";3 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- 3 Args
(for-each
(lambda (arg1)
@@ -66586,14 +66677,14 @@ EDITS: 1
(lambda () (n arg1 arg2 arg3))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs3: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs3: ~A ~A" err (procedure-property n 'documentation)))))
procs3))
less-args))
less-args)))
less-args)
- (snd-display ";set 3 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";set 3 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- set! 3 Args
(for-each
(lambda (arg1)
@@ -66609,15 +66700,15 @@ EDITS: 1
(lambda () (set! (n arg1 arg2 arg3) arg4))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";set-procs3: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";set-procs3: ~A ~A" err (procedure-property n 'documentation)))))
set-procs3))
less-args))
less-args))
less-args))
less-args)
- (snd-display ";4 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";4 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- 4 Args
(for-each
(lambda (arg1)
@@ -66633,15 +66724,15 @@ EDITS: 1
(lambda () (n arg1 arg2 arg3 arg4))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs4: ~A ~A ~A" err n (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs4: ~A ~A ~A" err n (procedure-property n 'documentation)))))
procs4))
few-args))
few-args))
few-args))
few-args)
- (snd-display ";set 4 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";set 4 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- set! 4 Args
(for-each
(lambda (arg1)
@@ -66659,7 +66750,7 @@ EDITS: 1
(lambda () (set! (n arg1 arg2 arg3 arg4) arg5))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";set-procs4: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";set-procs4: ~A ~A" err (procedure-property n 'documentation)))))
set-procs4))
fewer-args))
fewer-args))
@@ -66669,8 +66760,8 @@ EDITS: 1
(clear-sincs)
(stop-playing)
- (snd-display ";5 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";5 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- 5 Args
(for-each
(lambda (arg1)
@@ -66688,7 +66779,7 @@ EDITS: 1
(lambda () (n arg1 arg2 arg3 arg4 arg5))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs5: ~A ~A ~A" err n (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs5: ~A ~A ~A" err n (procedure-property n 'documentation)))))
procs5))
fewer-args))
fewer-args))
@@ -66697,8 +66788,8 @@ EDITS: 1
fewer-args)
(clear-sincs)
- (snd-display ";6 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";6 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- 6 Args
(for-each
(lambda (arg1)
@@ -66718,7 +66809,7 @@ EDITS: 1
(lambda () (n arg1 arg2 arg3 arg4 arg5 arg6))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs6: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs6: ~A ~A" err (procedure-property n 'documentation)))))
procs6))
(list 1.5 "/hiho" -1234 -1 0 #f #t '() vct-3 delay-32)))
(list 1.5 "/hiho" -1234 0 vct-5 #f #t delay-32)))
@@ -66727,8 +66818,8 @@ EDITS: 1
(list 1.5 -1234 vct-3 vct-5 -1 0 #f #t delay-32)))
(list 1.5 "/hiho" -1234 #f #t vct-5 delay-32))
- (snd-display ";8 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";8 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- 8 Args
(for-each
(lambda (arg1)
@@ -66752,7 +66843,7 @@ EDITS: 1
(lambda () (n arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs8: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs8: ~A ~A" err (procedure-property n 'documentation)))))
procs8))
(list 1.5 -1 1234 #f '() delay-32)))
(list "/hiho" -1 1234 '() vct-5 delay-32)))
@@ -66764,8 +66855,8 @@ EDITS: 1
(list 1.5 -1 '() 1234 "/hiho" delay-32))
(clear-sincs)
- (snd-display ";10 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";10 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
;; ---------------- 10 Args
(for-each
(lambda (arg1)
@@ -66793,7 +66884,7 @@ EDITS: 1
(lambda () (n arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10))
(lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display ";procs10: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs10: ~A ~A" err (procedure-property n 'documentation)))))
procs10))
(list 1.5 -1 #f 1234 delay-32)))
(list "/hiho" -1 1234 delay-32)))
@@ -66806,9 +66897,9 @@ EDITS: 1
(list 1.5 -1 '() delay-32)))
(list #f -1 1234 delay-32))
))))
-
- (snd-display ";end args")
-
+
+ (snd-display #__line__ ";end args")
+
(if (defined? 'mus-audio-reinitialize) (mus-audio-reinitialize))
(set! (window-y) 10)
(dismiss-all-dialogs)
@@ -66826,13 +66917,13 @@ EDITS: 1
(update-sound ind))
(lambda args (car args)))))
(if (not (eq? tag 'cant-update-file))
- (snd-display ";update-sound after deletion: ~A" tag)))
+ (snd-display #__line__ ";update-sound after deletion: ~A" tag)))
(delete-sample 10)
(let ((tag (catch #t
(lambda () (save-sound ind))
(lambda args (car args)))))
(if (not (eq? tag 'cannot-save))
- (snd-display ";save file deleted: ~A" tag)))
+ (snd-display #__line__ ";save file deleted: ~A" tag)))
(close-sound ind))
(copy-file "oboe.snd" "test.snd")
@@ -66851,7 +66942,7 @@ EDITS: 1
(lambda () (save-sound ind))
(lambda args (car args)))))
(if (not (eq? tag 'cannot-save))
- (snd-display ";save protected sound msg: ~A" tag)))
+ (snd-display #__line__ ";save protected sound msg: ~A" tag)))
(close-sound ind))
(system "chmod 644 test.snd")
@@ -66866,7 +66957,7 @@ EDITS: 1
(lambda () (save-sound-as "test.snd"))
(lambda args (car args)))))
(if (not (eq? tag 'cannot-save))
- (snd-display ";save-as write-protected sound: ~A" tag)))
+ (snd-display #__line__ ";save-as write-protected sound: ~A" tag)))
(close-sound ind))
(system "chmod 644 test.snd")
(delete-file "test.snd")
@@ -66874,8 +66965,8 @@ EDITS: 1
;; these redefine several basic names ("tap"), so they're not in test 23
(if all-args
(begin
- (snd-display ";away and colony5: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
+ (snd-display #__line__ ";away and colony5: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
+
(set! (optimization) 6)
(set! *clm-table-size* 512)
(set! *clm-file-buffer-size* (* 1024 1024))
@@ -66883,14 +66974,14 @@ EDITS: 1
(file-exists? "away.frb"))
(begin
(let ((val (simple-time (load "away.scm"))))
- (snd-display ";away: ~A" val))
+ (snd-display #__line__ ";away: ~A" val))
(for-each close-sound (sounds))
(if (file-exists? "a.snd") (delete-file "a.snd"))
(if (file-exists? "ar.snd") (delete-file "ar.snd"))))
(if (file-exists? "colony5.scm")
(begin
(let ((val (simple-time (load "colony5.scm"))))
- (snd-display ";colony 5: ~A" val))
+ (snd-display #__line__ ";colony 5: ~A" val))
(for-each close-sound (sounds))
(if (file-exists? "col5.snd") (delete-file "col5.snd"))
(if (file-exists? "reverb.snd") (delete-file "reverb.snd"))))))
@@ -66906,26 +66997,26 @@ EDITS: 1
(close-sound ind))
0.0))))
(lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display ";map-channel closing own chan: ~A" tag)))
-
-#|
+ (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";map-channel closing own chan: ~A" tag)))
+
+ #|
;; this will return a truncated (at the start) result, but I currently can't think of a
;; reasonable way to disallow it. We either need a before-undo-hook, or edit-hook that is
;; local to the map-channel lambda (so that we can remove it before map-channel itself
;; wants to edit, but adding/removing it on every call seems silly).
-
+
(let ((ind (open-sound "oboe.snd"))
- (ctr 0))
- (set! (sample 100) .5)
- (map-channel (lambda (y)
- (if (= ctr 0)
- (begin
- (revert-sound ind)
- (set! (sample 200) .6)))
- (set! ctr (+ 1 ctr))
- (* y 3))))
-|#
-
+ (ctr 0))
+ (set! (sample 100) .5)
+ (map-channel (lambda (y)
+ (if (= ctr 0)
+ (begin
+ (revert-sound ind)
+ (set! (sample 200) .6)))
+ (set! ctr (+ 1 ctr))
+ (* y 3))))
+ |#
+
(let ((ind1 (open-sound "oboe.snd"))
(ind2 (open-sound "pistol.snd")))
(as-one-edit
@@ -66962,13 +67053,13 @@ EDITS: 1
(let ((home (sampler-home rd)))
(if (and (list? home)
(sound? (car home)))
- (snd-display ";reader-home of closed sound: ~A ~A" home (sounds))))
+ (snd-display #__line__ ";reader-home of closed sound: ~A ~A" home (sounds))))
(let ((loc (sampler-position rd)))
(if (not (= loc 0))
- (snd-display ";closed reader position: ~A" loc)))
+ (snd-display #__line__ ";closed reader position: ~A" loc)))
(let ((at-end (sampler-at-end? rd)))
(if (not at-end)
- (snd-display ";closed sampler at end: ~A" at-end)))))
+ (snd-display #__line__ ";closed sampler at end: ~A" at-end)))))
(let ((ind (open-sound "oboe.snd")))
(let ((mx (mix-vct (vct .1 .2 .3))))
@@ -66999,7 +67090,7 @@ EDITS: 1
#f))
(set! scl (/ 1.0 mx))))
(* scl y)))
- (if (fneq (sample 100 ind 0) 1.0) (snd-display ";scan + map 100: ~A" (sample 100 ind 0)))
+ (if (fneq (sample 100 ind 0) 1.0) (snd-display #__line__ ";scan + map 100: ~A" (sample 100 ind 0)))
(revert-sound ind)
(set! (sample 100 ind 0) .5)
@@ -67007,19 +67098,19 @@ EDITS: 1
(if (> y .4)
(set! (frames ind 0) 1))
y))
- (if (fneq (sample 100 ind 0) 0.5) (snd-display ";map + reset frames: ~A" (sample 100 ind 0)))
- (if (not (= (frames ind 0) 50828)) (snd-display ";map + reset frames, frames: ~A" (frames ind 0)))
+ (if (fneq (sample 100 ind 0) 0.5) (snd-display #__line__ ";map + reset frames: ~A" (sample 100 ind 0)))
+ (if (not (= (frames ind 0) 50828)) (snd-display #__line__ ";map + reset frames, frames: ~A" (frames ind 0)))
(undo 1 ind 0)
- (if (not (= (frames ind 0) 1)) (snd-display ";map + reset frames, undo frames: ~A" (frames ind 0)))
+ (if (not (= (frames ind 0) 1)) (snd-display #__line__ ";map + reset frames, undo frames: ~A" (frames ind 0)))
(revert-sound ind)
(set! (sample 100 ind 0) .5)
- ;(let ((tag (catch #t (lambda () (set! (frames ind 0 1) 1)) (lambda args (car args)))))
- ; (if (not (eq? tag 'wrong-number-of-args)) (snd-display ";set frames + edpos: ~A" tag)))
+ ;(let ((tag (catch #t (lambda () (set! (frames ind 0 1) 1)) (lambda args (car args)))))
+ ; (if (not (eq? tag 'wrong-number-of-args)) (snd-display #__line__ ";set frames + edpos: ~A" tag)))
(revert-sound ind)
(let ((tag (catch #t (lambda () (map-channel (lambda (y) (* y 0.0+1.0i)))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-type)) (snd-display ";map-channel rtn complex: ~A" tag)))
+ (if (not (eq? tag 'bad-type)) (snd-display #__line__ ";map-channel rtn complex: ~A" tag)))
(let ((rd (make-sampler 0)))
(do ((i 0 (+ 1 i)))
@@ -67033,25 +67124,25 @@ EDITS: 1
(let ((home (sampler-home crd)))
(if (and (list? home)
(sound? (car home)))
- (snd-display ";copy reader-home of closed sound: ~A ~A" home (sounds))))
+ (snd-display #__line__ ";copy reader-home of closed sound: ~A ~A" home (sounds))))
(let ((loc (sampler-position crd)))
(if (not (= loc 0))
- (snd-display ";closed copy reader position: ~A" loc)))
+ (snd-display #__line__ ";closed copy reader position: ~A" loc)))
(let ((at-end (sampler-at-end? crd)))
(if (not at-end)
- (snd-display ";closed copy sampler at end: ~A" at-end)))))
+ (snd-display #__line__ ";closed copy sampler at end: ~A" at-end)))))
(let ((tag (catch #t (lambda () (revert-sound ind)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sound)) (snd-display ";revert-sound of closed sound: ~A" tag)))
+ (if (not (eq? tag 'no-such-sound)) (snd-display #__line__ ";revert-sound of closed sound: ~A" tag)))
(set! ind (open-sound "oboe.snd")) ; closed in copy case above
(set! (sample 100 ind 0) .5)
(let ((tag (catch #t
(lambda () (scale-channel .5 0 100 ind 0 (lambda () (close-sound ind) current-edit-position)))
(lambda args (car args)))))
- (if (not (eq? tag 'bad-arity)) (snd-display ";edpos proc bad args: ~A" tag)))
+ (if (not (eq? tag 'bad-arity)) (snd-display #__line__ ";edpos proc bad args: ~A" tag)))
- (if (not (sound? ind)) (snd-display ";edpos bad arity proc clobbers chan?? ~A" ind))
+ (if (not (sound? ind)) (snd-display #__line__ ";edpos bad arity proc clobbers chan?? ~A" ind))
)
(set! env3 #f)
@@ -67070,10 +67161,10 @@ EDITS: 1
(set! a-hook #f)
(set! a-sound #f)
(set! vct-5 #f)
-
+
)))
-;(tracing #t)
+ ;(tracing #t)
(define test-funcs (make-vector (+ 1 total-tests)))
(vector-set! test-funcs 0 snd_test_0)
@@ -67115,8 +67206,8 @@ EDITS: 1
(run-hook before-test-hook snd-test)
((vector-ref test-funcs snd-test))
(run-hook after-test-hook snd-test)
- ))
-
+ ))
+
(if (and (not full-test)
(not keep-going)
(>= snd-test 0))
@@ -67124,7 +67215,7 @@ EDITS: 1
(run-hook before-test-hook snd-test)
((vector-ref test-funcs snd-test))
(run-hook after-test-hook snd-test))
-
+
(do ((i 0 (+ 1 i))) ; run all tests except the irritating ones
((> i total-tests))
(if (and (or (< i 24)
@@ -67156,7 +67247,6 @@ EDITS: 1
(if (and full-test
(= test-at-random 0)
- (provided? 'run)
(= tests 1)
(file-exists? "oldopt.log"))
(system "diff -w optimizer.log oldopt.log"))
@@ -67169,7 +67259,7 @@ EDITS: 1
(display (format #f "~%;all done!~%~A" original-prompt))
(set! (print-length) 64)
-(display (format #f "~%;times: ~A~%;total: ~A~%" timings (inexact->exact (round (- (real-time) overall-start-time)))))
+(display (format #f "~%;times: ~A~%;total: ~A~%" timings (round (- (real-time) overall-start-time))))
(let ((best-times (vector 59 58 114 95 2244 5373 613 134 11680 2892 609 743 868 976 815 1288 3020 197 168 2952 758 1925 4997 6567 846 183 0 242 6696))) ; 571
(do ((i 0 (+ 1 i)))
@@ -67341,24 +67431,24 @@ callgrind_annotate --auto=yes callgrind.out.<pid> > hi
14,661,979,458 io.c:mus_write_1 [/home/bil/snd-11/snd]
14,486,041,393 snd-sig.c:direct_filter [/home/bil/snd-11/snd]
10,836,543,187 run.c:eval_ptree [/home/bil/snd-11/snd]
- 6,663,065,404 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_mh [/usr/local/lib/libgsl.so.0.14.0]
- 4,848,628,373 ???:memset [/lib/ld-2.9.so]
- 4,354,124,652 clm.c:mus_out_any_to_file [/home/bil/snd-11/snd]
- 4,081,657,874 clm.c:mus_fir_filter [/home/bil/snd-11/snd]
- 3,881,809,674 snd-edits.c:next_sample_value [/home/bil/snd-11/snd]
- 3,676,951,173 clm.c:mus_src [/home/bil/snd-11/snd]
- 3,588,422,788 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_hm [/usr/local/lib/libgsl.so.0.14.0]
- 3,166,989,992 run.c:jump_if_not_equal [/home/bil/snd-11/snd]
- 2,997,117,922 s7.c:g_add [/home/bil/snd-11/snd]
- 2,761,768,633 s7.c:s7_mark_object_1'2 [/home/bil/snd-11/snd]
- 2,568,586,593 s7.c:s7_make_real [/home/bil/snd-11/snd]
- 2,533,319,957 xen.c:xen_s7_type_p [/home/bil/snd-11/snd]
- 2,450,756,818 /home/bil/test/gsl-1.13/linalg/../gsl/gsl_matrix_double.h:gsl_linalg_householder_mh
- 2,389,660,542 clm.c:mus_phase_vocoder_with_editors [/home/bil/snd-11/snd]
- 2,383,913,072 s7.c:copy_object'2 [/home/bil/snd-11/snd]
- 2,119,836,764 s7.c:s7_cons [/home/bil/snd-11/snd]
- 2,118,663,239 s7.c:new_cell [/home/bil/snd-11/snd]
- 1,815,226,062 s7.c:s7_object_value [/home/bil/snd-11/snd]
+6,663,065,404 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_mh [/usr/local/lib/libgsl.so.0.14.0]
+4,848,628,373 ???:memset [/lib/ld-2.9.so]
+4,354,124,652 clm.c:mus_out_any_to_file [/home/bil/snd-11/snd]
+4,081,657,874 clm.c:mus_fir_filter [/home/bil/snd-11/snd]
+3,881,809,674 snd-edits.c:next_sample_value [/home/bil/snd-11/snd]
+3,676,951,173 clm.c:mus_src [/home/bil/snd-11/snd]
+3,588,422,788 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_hm [/usr/local/lib/libgsl.so.0.14.0]
+3,166,989,992 run.c:jump_if_not_equal [/home/bil/snd-11/snd]
+2,997,117,922 s7.c:g_add [/home/bil/snd-11/snd]
+2,761,768,633 s7.c:s7_mark_object_1'2 [/home/bil/snd-11/snd]
+2,568,586,593 s7.c:s7_make_real [/home/bil/snd-11/snd]
+2,533,319,957 xen.c:xen_s7_type_p [/home/bil/snd-11/snd]
+2,450,756,818 /home/bil/test/gsl-1.13/linalg/../gsl/gsl_matrix_double.h:gsl_linalg_householder_mh
+2,389,660,542 clm.c:mus_phase_vocoder_with_editors [/home/bil/snd-11/snd]
+2,383,913,072 s7.c:copy_object'2 [/home/bil/snd-11/snd]
+2,119,836,764 s7.c:s7_cons [/home/bil/snd-11/snd]
+2,118,663,239 s7.c:new_cell [/home/bil/snd-11/snd]
+1,815,226,062 s7.c:s7_object_value [/home/bil/snd-11/snd]
7-Mar-10
318,148,021,968 PROGRAM TOTALS
@@ -67370,19 +67460,19 @@ callgrind_annotate --auto=yes callgrind.out.<pid> > hi
16,230,371,673 s7.c:gc [/home/bil/snd-s7/snd]
10,973,188,812 io.c:mus_write_1 [/home/bil/snd-s7/snd]
10,939,541,547 run.c:eval_ptree [/home/bil/snd-s7/snd]
- 8,918,483,945 snd-sig.c:direct_filter [/home/bil/snd-s7/snd]
- 7,030,924,951 s7.c:s7_mark_object_1'2 [/home/bil/snd-s7/snd]
- 6,663,065,404 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_mh [/usr/local/lib/libgsl.so.0.14.0]
- 3,946,755,027 clm.c:mus_out_any_to_file [/home/bil/snd-s7/snd]
- 3,702,560,061 snd-edits.c:next_sample_value [/home/bil/snd-s7/snd]
- 3,675,942,470 clm.c:mus_src [/home/bil/snd-s7/snd]
- 3,588,422,788 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_hm [/usr/local/lib/libgsl.so.0.14.0]
- 3,173,655,679 run.c:jump_if_not_equal [/home/bil/snd-s7/snd]
- 2,997,971,312 clm.c:mus_fir_filter [/home/bil/snd-s7/snd]
- 2,572,480,120 s7.c:g_add [/home/bil/snd-s7/snd]
- 2,450,756,818 /home/bil/test/gsl-1.13/linalg/../gsl/gsl_matrix_double.h:gsl_linalg_householder_mh
- 2,389,660,564 clm.c:mus_phase_vocoder_with_editors [/home/bil/snd-s7/snd]
- 2,383,162,838 s7.c:s7_make_real [/home/bil/snd-s7/snd]
- 2,256,089,964 clm.c:mus_formant [/home/bil/snd-s7/snd]
+8,918,483,945 snd-sig.c:direct_filter [/home/bil/snd-s7/snd]
+7,030,924,951 s7.c:s7_mark_object_1'2 [/home/bil/snd-s7/snd]
+6,663,065,404 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_mh [/usr/local/lib/libgsl.so.0.14.0]
+3,946,755,027 clm.c:mus_out_any_to_file [/home/bil/snd-s7/snd]
+3,702,560,061 snd-edits.c:next_sample_value [/home/bil/snd-s7/snd]
+3,675,942,470 clm.c:mus_src [/home/bil/snd-s7/snd]
+3,588,422,788 /home/bil/test/gsl-1.13/linalg/householder.c:gsl_linalg_householder_hm [/usr/local/lib/libgsl.so.0.14.0]
+3,173,655,679 run.c:jump_if_not_equal [/home/bil/snd-s7/snd]
+2,997,971,312 clm.c:mus_fir_filter [/home/bil/snd-s7/snd]
+2,572,480,120 s7.c:g_add [/home/bil/snd-s7/snd]
+2,450,756,818 /home/bil/test/gsl-1.13/linalg/../gsl/gsl_matrix_double.h:gsl_linalg_householder_mh
+2,389,660,564 clm.c:mus_phase_vocoder_with_editors [/home/bil/snd-s7/snd]
+2,383,162,838 s7.c:s7_make_real [/home/bil/snd-s7/snd]
+2,256,089,964 clm.c:mus_formant [/home/bil/snd-s7/snd]
|#
diff --git a/snd-xen.c b/snd-xen.c
index 9cfe717..b3ee84c 100644
--- a/snd-xen.c
+++ b/snd-xen.c
@@ -2602,7 +2602,7 @@ static s7_pointer listener_read(s7_scheme *sc, s7_read_t read_choice, s7_pointer
return(xen_false);
}
-static void listener_write(s7_scheme *sc, char c, s7_pointer port)
+static void listener_write(s7_scheme *sc, unsigned char c, s7_pointer port)
{
char str[2];
str[0] = c;
diff --git a/snd-xref.c b/snd-xref.c
index a36fc2f..5d628d8 100644
--- a/snd-xref.c
+++ b/snd-xref.c
@@ -1,792 +1,799 @@
/* Snd help index (generated by index.cl and indexer.scm) */
-#define HELP_NAMES_SIZE 1332
+#define HELP_NAMES_SIZE 1342
#if HAVE_SCHEME || HAVE_FORTH
static const char *help_names[HELP_NAMES_SIZE] = {
- "abort", "add-amp-controls", "add-colormap", "add-comment", "add-directory-to-view-files-list", "add-file-filter",
- "add-file-sorter", "add-file-to-view-files-list", "add-mark", "add-mark-pane", "add-player", "add-sound-file-extension",
- "add-source-file-extension", "add-to-main-menu", "add-to-menu", "add-tooltip", "add-transform", "add-watcher",
- "additive synthesis", "after-apply-controls-hook", "after-edit-hook", "after-graph-hook", "after-lisp-graph-hook", "after-open-hook",
- "after-save-as-hook", "after-save-state-hook", "after-transform-hook", "all-pass", "all-pass?", "amp-control",
- "amp-control-bounds", "amplitude-modulate", "analyse-ladspa", "any-env-channel", "append-sound", "apply-controls",
- "apply-ladspa", "array->file", "array-interp", "as-one-edit", "ask-before-overwrite", "asymmetric-fm",
- "asymmetric-fm?", "audio-input-device", "audio-output-device", "auto-resize", "auto-save", "auto-update",
- "auto-update-interval", "autocorrelate", "axis-color", "axis-info", "axis-label-font", "axis-numbers-font",
- "background-gradient", "bad-header-hook", "bagpipe", "basic-color", "beats-per-measure", "beats-per-minute",
- "before-close-hook", "before-exit-hook", "before-save-as-hook", "before-save-state-hook", "before-transform-hook", "bessel filters",
- "bigbird", "bind-key", "bird", "bold-peaks-font", "bomb", "break",
- "brown-noise", "butterworth filters", "c-g!", "c-g?", "call_in", "cascade->canonical",
- "chain-dsps", "channel->vct", "channel-amp-envs", "channel-data", "channel-envelope", "channel-polynomial",
- "channel-properties", "channel-property", "channel-rms", "channel-style", "channel-sync", "channel-widgets",
- "channels", "channels-equal?", "channels-separate", "channels=?", "chans", "chebyshev filters",
- "check-for-unsaved-edits", "check-mix-tags", "clean-channel", "clean-sound", "clear-array", "clear-listener",
- "clear-minibuffer", "clear-selection", "clip-hook", "clipping", "clm-channel", "clm-load",
- "clone-sound-as", "close-hook", "close-sound", "color->list", "color-cutoff", "color-hook",
- "color-inverted", "color-mixes", "color-orientation-dialog", "color-scale", "color?", "colormap",
- "colormap->integer", "colormap-name", "colormap-ref", "colormap-size", "colormap?", "comb",
- "comb?", "comment", "compand-channel", "compand-sound", "concatenate-envelopes", "continue-frame->file",
- "continue-sample->file", "contrast-channel", "contrast-control", "contrast-control-amp", "contrast-control-bounds", "contrast-control?",
- "contrast-enhancement", "contrast-sound", "controls->channel", "convolution", "convolution reverb", "convolve",
- "convolve-files", "convolve-selection-with", "convolve-with", "convolve?", "copy-frame-reader", "copy-sampler",
- "correlate", "count-matches", "create-ssb-dialog", "cross-fade (amplitude)", "cross-fade (frequency domain)", "cross-synthesis",
- "current-edit-position", "current-font", "cursor", "cursor-color", "cursor-follows-play", "cursor-in-view",
- "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style", "cursor-update-interval", "dac-combines-channels",
- "dac-hook", "dac-size", "data-color", "data-format", "data-location", "data-size",
- "db->linear", "def-clm-struct", "default-output-chans", "default-output-data-format", "default-output-header-type", "default-output-srate",
- "defgenerator", "define-envelope", "define-selection-via-marks", "definstrument", "defvar", "degrees->radians",
- "delay", "delay-channel-mixes", "delay-tick", "delay?", "delete-colormap", "delete-file-filter",
- "delete-file-sorter", "delete-mark", "delete-marks", "delete-sample", "delete-samples", "delete-selection",
- "delete-selection-and-smooth", "delete-transform", "delete-watcher", "describe-hook", "describe-mark", "dialog-widgets",
- "disable-control-panel", "display-bark-fft", "display-db", "display-edits", "display-scanned-synthesis", "dissolve-fade",
- "dither-channel", "dither-sound", "dlocsig", "do?", "doit-again-button-color", "doit-button-color",
- "dot-product", "dot-size", "draw-axes", "draw-dot", "draw-dots", "draw-line",
- "draw-lines", "draw-mark-hook", "draw-mix-hook", "draw-string", "drop sites", "drop-hook",
- "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook", "edit-list->function", "edit-position",
- "edit-properties", "edit-property", "edit-tree", "edits", "edot-product", "elliptic filters",
- "emacs-style-save-as", "env", "env-any", "env-channel", "env-channel-with-base", "env-expt-channel",
- "env-interp", "env-mixes", "env-selection", "env-sound", "env-sound-interp", "env?",
- "enved-base", "enved-clip?", "enved-dialog", "enved-envelope", "enved-filter", "enved-filter-order",
- "enved-hook", "enved-in-dB", "enved-power", "enved-style", "enved-target", "enved-wave?",
- "enved-waveform-color", "envelope-interp", "enveloped-mix", "eps-bottom-margin", "eps-file", "eps-left-margin",
- "eps-size", "eval-between-marks", "eval-over-selection", "every-sample?", "exit", "exit-hook",
- "expand-control", "expand-control-bounds", "expand-control-hop", "expand-control-jitter", "expand-control-length", "expand-control-ramp",
- "expand-control?", "explode-sf2", "exponentially-weighted-moving-average", "extract-channel", "extract-channels", "feedback fm",
- "fft", "fft sizes", "fft-edit", "fft-log-frequency", "fft-log-magnitude", "fft-smoother",
- "fft-squelch", "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database",
- "file->array", "file->frame", "file->frame?", "file->sample", "file->sample?", "file->sound-data",
- "file->vct", "file-name", "fill-polygon", "fill-rectangle", "filter", "filter-channel",
- "filter-control-coeffs", "filter-control-envelope", "filter-control-in-dB", "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color",
- "filter-control?", "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb",
- "filtered-comb?", "find-channel", "find-dialog", "find-mark", "find-mix", "find-sound",
- "finish-progress-report", "fir-filter", "fir-filter?", "firmant", "firmant?", "flocsig",
- "flocsig?", "flute model", "fm-bell", "fm-drum", "fm-noise", "fm-talker",
- "fm-trumpet", "fm-violin", "fm-voice", "focus-widget", "FOF synthesis", "for-each-child",
- "for-each-sound-file", "Forbidden Planet", "foreground-color", "forget-region", "formant", "formant?",
- "fourier-transform", "fractional-fourier-transform", "frame", "frame*", "frame+", "frame->file",
- "frame->file?", "frame->frame", "frame->list", "frame->sample", "frame->sound", "frame->sound-data",
- "frame->vct", "frame-copy", "frame-reader-at-end?", "frame-reader-chans", "frame-reader-home", "frame-reader-position",
- "frame-reader?", "frame-ref", "frame-reverse!", "frame-set!", "frame?", "frames",
- "free-frame-reader", "free-player", "free-sampler", "freeverb", "fullmix", "gaussian-distribution",
- "gc-off", "gc-on", "gl-graph->ps", "glSpectrogram", "goertzel", "goto-listener-end",
- "grani", "granulate", "granulate?", "granulated-sound-interp", "graph", "graph->ps",
- "graph-color", "graph-cursor", "graph-data", "graph-hook", "graph-lines", "graph-style",
- "graphic equalizer", "graphs-horizontal", "green-noise", "green-noise-interp", "grid-density", "harmonicizer",
- "Hartley transform", "header-type", "hello-dentist", "help-button-color", "help-dialog", "help-hook",
- "hide-widget", "highlight-color", "hilbert-transform", "hook-member", "html-dir", "html-program",
- "hz->radians", "iir-filter", "iir-filter?", "in", "in-any", "ina",
- "inb", "info-dialog", "init-ladspa", "initial-graph-hook", "insert-channel", "insert-file-dialog",
- "insert-frame", "insert-region", "insert-sample", "insert-samples", "insert-selection", "insert-silence",
- "insert-sound", "insert-sound-data", "insert-vct", "instruments", "integer->colormap", "integer->mark",
- "integer->mix", "integer->region", "integer->sound", "integer->transform", "integrate-envelope", "jc-reverb",
- "just-sounds", "kalman-filter-channel", "key", "key-binding", "key-press-hook", "ladspa-descriptor",
- "ladspa-dir", "left-sample", "level meters", "linear->db", "linear-src-channel", "lisp-graph-hook",
- "lisp-graph-style", "lisp-graph?", "list->vct", "list-ladspa", "listener-click-hook", "listener-color",
- "listener-font", "listener-prompt", "listener-selection", "listener-text-color", "little-endian?", "locsig",
- "locsig-ref", "locsig-reverb-ref", "locsig-reverb-set!", "locsig-set!", "locsig-type", "locsig?",
- "log-freq-start", "loop-between-marks", "lpc-coeffs", "lpc-predict", "main-menu", "main-widgets",
- "make-all-pass", "make-asymmetric-fm", "make-bandpass", "make-bandstop", "make-biquad", "make-birds",
- "make-color", "make-comb", "make-convolve", "make-delay", "make-differentiator", "make-env",
- "make-fft-window", "make-file->frame", "make-file->sample", "make-filter", "make-filtered-comb", "make-fir-filter",
- "make-firmant", "make-flocsig", "make-formant", "make-frame", "make-frame!", "make-frame->file",
- "make-frame-reader", "make-granulate", "make-graph-data", "make-hidden-controls-dialog", "make-highpass", "make-hilbert-transform",
- "make-iir-filter", "make-locsig", "make-lowpass", "make-mix-sampler", "make-mixer", "make-mixer!",
- "make-move-sound", "make-moving-autocorrelation", "make-moving-average", "make-moving-fft", "make-moving-pitch", "make-moving-scentroid",
- "make-moving-spectrum", "make-ncos", "make-noid", "make-notch", "make-nrxycos", "make-nrxysin",
- "make-nsin", "make-one-pole", "make-one-zero", "make-oscil", "make-phase-vocoder", "make-pixmap",
- "make-player", "make-polyoid", "make-polyshape", "make-polywave", "make-pulse-train", "make-rand",
- "make-rand-interp", "make-readin", "make-region", "make-region-frame-reader", "make-region-sampler", "make-sample->file",
- "make-sampler", "make-sawtooth-wave", "make-scalar-mixer", "make-selection", "make-selection-frame-reader", "make-snd->sample",
- "make-sound-box", "make-sound-data", "make-square-wave", "make-src", "make-ssb-am", "make-sync-frame-reader",
- "make-table-lookup", "make-triangle-wave", "make-two-pole", "make-two-zero", "make-variable-display", "make-variable-graph",
- "make-vct", "make-wave-train", "map-channel", "map-sound", "map-sound-files", "maracas",
- "mark->integer", "mark-click-hook", "mark-color", "mark-drag-hook", "mark-drag-triangle-hook", "mark-explode",
- "mark-home", "mark-hook", "mark-loops", "mark-name", "mark-name->id", "mark-properties",
- "mark-property", "mark-sample", "mark-sync", "mark-sync-max", "mark-tag-height", "mark-tag-width",
- "mark?", "marks", "match-sound-files", "max-envelope", "max-regions", "max-transform-peaks",
- "max-virtual-ptrees", "maxamp", "maxamp-position", "menu-widgets", "menus, optional", "min-dB",
- "minibuffer-history-length", "mix", "mix->integer", "mix->vct", "mix-amp", "mix-amp-env",
- "mix-channel", "mix-click-hook", "mix-color", "mix-dialog-mix", "mix-drag-hook", "mix-file-dialog",
- "mix-frame", "mix-home", "mix-length", "mix-maxamp", "mix-move-sound", "mix-name",
- "mix-name->id", "mix-position", "mix-properties", "mix-property", "mix-region", "mix-release-hook",
- "mix-sampler?", "mix-selection", "mix-sound", "mix-sound-data", "mix-speed", "mix-sync",
- "mix-sync-max", "mix-tag-height", "mix-tag-width", "mix-tag-y", "mix-vct", "mix-waveform-height",
- "mix?", "mixer", "mixer*", "mixer as matrix", "mixer+", "mixer-copy",
- "mixer-determinant", "mixer-inverse", "mixer-poly", "mixer-ref", "mixer-set!", "mixer-solve",
- "mixer-transpose", "mixer?", "mixes", "mono->stereo", "moog-filter", "mouse-click-hook",
- "mouse-drag-hook", "mouse-enter-graph-hook", "mouse-enter-label-hook", "mouse-enter-listener-hook", "mouse-enter-text-hook", "mouse-leave-graph-hook",
- "mouse-leave-label-hook", "mouse-leave-listener-hook", "mouse-leave-text-hook", "mouse-press-hook", "move-locsig", "move-mixes",
- "move-sound", "move-sound?", "moving-autocorrelation", "moving-autocorrelation?", "moving-average", "moving-average?",
- "moving-fft", "moving-fft?", "moving-length", "moving-max", "moving-pitch", "moving-pitch?",
- "moving-rms", "moving-scentroid", "moving-scentroid?", "moving-spectrum", "moving-spectrum?", "moving-sum",
- "mpg", "multiply-arrays", "mus-alsa-buffer-size", "mus-alsa-buffers", "mus-alsa-capture-device", "mus-alsa-device",
- "mus-alsa-playback-device", "mus-alsa-squelch-warning", "mus-array-print-length", "mus-audio-close", "mus-audio-describe", "mus-audio-open-input",
- "mus-audio-open-output", "mus-audio-read", "mus-audio-write", "mus-bytes-per-sample", "mus-channel", "mus-channels",
- "mus-chebyshev-tu-sum", "mus-clipping", "mus-close", "mus-data", "mus-data-format->string", "mus-data-format-name",
- "mus-describe", "mus-error-hook", "mus-error-type->string", "mus-expand-filename", "mus-feedback", "mus-feedforward",
- "mus-fft", "mus-file-buffer-size", "mus-file-clipping", "mus-file-name", "mus-file-prescaler", "mus-float-equal-fudge-factor",
- "mus-frequency", "mus-generator?", "mus-header-raw-defaults", "mus-header-type->string", "mus-header-type-name", "mus-hop",
- "mus-increment", "mus-input?", "mus-interp-type", "mus-interpolate", "mus-length", "mus-location",
- "mus-max-malloc", "mus-max-table-size", "mus-mix", "mus-name", "mus-offset", "mus-order",
- "mus-oss-set-buffers", "mus-out-format", "mus-output?", "mus-phase", "mus-prescaler", "mus-ramp",
- "mus-random", "mus-reset", "mus-run", "mus-safety", "mus-scaler", "mus-sound-chans",
- "mus-sound-close-input", "mus-sound-close-output", "mus-sound-comment", "mus-sound-data-format", "mus-sound-data-location", "mus-sound-datum-size",
- "mus-sound-duration", "mus-sound-forget", "mus-sound-frames", "mus-sound-header-type", "mus-sound-length", "mus-sound-loop-info",
- "mus-sound-mark-info", "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-open-input", "mus-sound-open-output", "mus-sound-prune",
- "mus-sound-read", "mus-sound-reopen-output", "mus-sound-report-cache", "mus-sound-samples", "mus-sound-seek-frame", "mus-sound-srate",
- "mus-sound-type-specifier", "mus-sound-write", "mus-sound-write-date", "mus-srate", "mus-width", "mus-xcoeff",
- "mus-xcoeffs", "mus-ycoeff", "mus-ycoeffs", "name-click-hook", "ncos", "ncos?",
- "new-sound", "new-sound-dialog", "new-sound-hook", "new-widget-hook", "next-frame", "next-sample",
- "noid", "normalize-channel", "normalize-envelope", "normalize-partials", "normalize-sound", "normalized-mix",
- "notch", "notch-channel", "notch-out-rumble-and-hiss", "notch-selection", "notch-sound", "notch?",
- "nrev", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin",
- "nsin?", "offset-channel", "offset-sound", "one-pole", "one-pole?", "one-zero",
- "one-zero?", "open-file-dialog", "open-file-dialog-directory", "open-hook", "open-next-file-in-directory", "open-raw-sound",
- "open-raw-sound-hook", "open-sound", "optimization", "optimization-hook", "orientation-hook", "oscil",
- "oscil?", "oscilloscope dialog", "out-any", "outa", "*output*", "output-comment-hook",
- "output-name-hook", "overlay-rms-env", "pad-channel", "pad-marks", "pad-sound", "pan-mix",
- "pan-mix-vct", "partials->polynomial", "partials->wave", "pausing", "peak-env-dir", "peak-env-hook",
- "peaks", "peaks-font", "phase-partials->wave", "phase-vocoder", "phase-vocoder?", "piano model",
- "pink-noise", "place-sound", "play", "play-between-marks", "play-hook", "play-mixes",
- "play-sines", "play-syncd-marks", "player-home", "player?", "players", "playing",
- "pluck", "polar->rectangular", "polynomial", "polynomial operations", "polyoid", "polyoid-env",
- "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?", "position->x",
- "position->y", "position-color", "power-env", "preferences-dialog", "previous-frame", "previous-sample",
- "print-dialog", "print-hook", "print-length", "profile", "progress-report", "prompt-in-minibuffer",
- "ptree-channel", "pulse-train", "pulse-train?", "pushed-button-color", "quit-button-color", "radians->degrees",
- "radians->hz", "ramp-channel", "rand", "rand-interp", "rand-interp?", "rand?",
- "read-frame", "read-hook", "read-mix-sample", "read-only", "read-region-sample", "read-sample",
- "readin", "readin?", "recorder-dialog", "rectangular->magnitudes", "rectangular->polar", "redo",
- "redo-channel", "redo-edit", "region->frame", "region->integer", "region->sound-data", "region->vct",
- "region-chans", "region-frames", "region-graph-style", "region-home", "region-maxamp", "region-maxamp-position",
- "region-play-list", "region-position", "region-sample", "region-sampler?", "region-srate", "region?",
- "regions", "remember-sound-state", "remove-from-menu", "report-in-minibuffer", "reset-all-hooks", "reset-button-color",
- "reset-controls", "reset-listener-cursor", "restore-controls", "*reverb*", "reverb-control-decay", "reverb-control-feedback",
- "reverb-control-length", "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds", "reverb-control?",
- "reverse-channel", "reverse-channels", "reverse-envelope", "reverse-selection", "reverse-sound", "revert-sound",
- "right-sample", "ring-modulate", "rms", "rms, gain, balance gens", "rms-envelope", "rotate-channel",
- "rubber-sound", "run", "sample", "sample->file", "sample->file?", "sample->frame",
- "sampler-at-end?", "sampler-home", "sampler-position", "sampler?", "samples", "samples->seconds",
- "sash-color", "save-controls", "save-dir", "save-edit-history", "save-envelopes", "save-hook",
- "save-listener", "save-macros", "save-mark-properties", "save-marks", "save-mix", "save-mixes",
- "save-region", "save-region-dialog", "save-selection", "save-selection-dialog", "save-sound", "save-sound-as",
- "save-sound-dialog", "save-state", "save-state-file", "save-state-hook", "savitzky-golay-filter", "sawtooth-wave",
- "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope", "scale-mixes", "scale-selection-by",
- "scale-selection-to", "scale-sound", "scale-tempo", "scale-to", "scan-channel", "scan-sound",
- "scanned synthesis", "scentroid", "script-arg", "script-args", "search-procedure", "seconds->samples",
- "select-all", "select-channel", "select-channel-hook", "select-sound", "select-sound-hook", "selected-channel",
- "selected-data-color", "selected-graph-color", "selected-sound", "selection", "selection->mix", "selection->sound-data",
- "selection-chans", "selection-color", "selection-creates-region", "selection-frames", "selection-maxamp", "selection-maxamp-position",
- "selection-member?", "selection-members", "selection-position", "selection-srate", "selection?", "send-mozilla",
- "set-global-sync", "set-samples", "shepard-tone", "short-file-name", "show-axes", "show-controls",
- "show-disk-space", "show-grid", "show-indices", "show-listener", "show-marks", "show-mix-waveforms",
- "show-selection", "show-selection-transform", "show-smpte-label", "show-sonogram-cursor", "show-transform-peaks", "show-widget",
- "show-y-zero", "silence-all-mixes", "silence-mixes", "sinc-train", "sinc-width", "sine-env-channel",
- "sine-ramp", "singer", "smooth-channel", "smooth-selection", "smooth-sound", "SMS synthesis",
- "snap-mark-to-beat", "snap-mix-to-beat", "snd->sample", "snd->sample?", "snd-color", "snd-error",
- "snd-error-hook", "snd-font", "snd-gcs", "snd-help", "snd-hooks", "*snd-opened-sound*",
- "snd-print", "snd-spectrum", "snd-tempnam", "snd-url", "snd-urls", "snd-version",
- "snd-warning", "snd-warning-hook", "sndwarp", "sound->amp-env", "sound->frame", "sound->integer",
- "sound->sound-data", "sound-data*", "sound-data+", "sound-data->file", "sound-data->frame", "sound-data->sound",
- "sound-data->sound-data", "sound-data->vct", "sound-data-add!", "sound-data-chans", "sound-data-copy", "sound-data-fill!",
- "sound-data-length", "sound-data-maxamp", "sound-data-multiply!", "sound-data-offset!", "sound-data-peak", "sound-data-ref",
- "sound-data-reverse!", "sound-data-scale!", "sound-data-set!", "sound-data?", "sound-file-extensions", "sound-file?",
- "sound-files-in-directory", "sound-interp", "sound-let", "sound-loop-info", "sound-properties", "sound-property",
- "sound-widgets", "sound?", "soundfont-info", "sounds", "spectral interpolation", "spectral-polynomial",
- "spectro-hop", "spectro-x-angle", "spectro-x-scale", "spectro-y-angle", "spectro-y-scale", "spectro-z-angle",
- "spectro-z-scale", "spectrum", "spectrum->coeffs", "spectrum-end", "spectrum-start", "speed-control",
- "speed-control-bounds", "speed-control-style", "speed-control-tones", "square-wave", "square-wave?", "squelch-update",
- "squelch-vowels", "srate", "src", "src-channel", "src-duration", "src-mixes",
- "src-selection", "src-sound", "src?", "ssb-am", "ssb-am?", "ssb-bank",
- "ssb-bank-env", "ssb-fm", "start-hook", "start-playing", "start-playing-hook", "start-playing-selection-hook",
- "start-progress-report", "start-waterfall", "stereo->mono", "stop-dac-hook", "stop-player", "stop-playing",
- "stop-playing-hook", "stop-playing-selection-hook", "stretch-envelope", "superimpose-ffts", "swap-channels", "swap-selection-channels",
- "sync", "sync-all", "sync-max", "syncd-marks", "table-lookup", "table-lookup?",
- "tap", "telephone", "temp-dir", "text-focus-color", "time-graph-hook", "time-graph-style",
- "time-graph-type", "time-graph?", "tiny-font", "tracking-cursor-style", "transform->integer", "transform->vct",
- "transform-dialog", "transform-frames", "transform-graph-style", "transform-graph-type", "transform-graph?", "transform-normalization",
- "transform-sample", "transform-size", "transform-type", "transform?", "transpose-mixes", "trap-segfault",
- "triangle-wave", "triangle-wave?", "tubular bell", "two-pole", "two-pole?", "two-zero",
- "two-zero?", "unbind-key", "unclip-channel", "undo", "undo-channel", "undo-edit",
- "undo-hook", "update-graphs", "update-hook", "update-lisp-graph", "update-sound", "update-time-graph",
- "update-transform-graph", "user interface extensions", "variable-display", "variable-graph?", "vct", "vct*",
- "vct+", "vct->channel", "vct->file", "vct->frame", "vct->list", "vct->sound-data",
- "vct->string", "vct->vector", "vct-add!", "vct-copy", "vct-fill!", "vct-length",
- "vct-map!", "vct-move!", "vct-multiply!", "vct-offset!", "vct-peak", "vct-polynomial",
- "vct-ref", "vct-reverse!", "vct-scale!", "vct-set!", "vct-subseq", "vct-subtract!",
- "vct?", "vector->vct", "verbose-cursor", "view-files-amp", "view-files-amp-env", "view-files-dialog",
- "view-files-files", "view-files-select-hook", "view-files-selected-files", "view-files-sort", "view-files-speed", "view-files-speed-style",
- "view-mixes-dialog", "view-regions-dialog", "view-sound", "voice physical model", "voiced->unvoiced", "volterra-filter",
- "wave-train", "wave-train?", "wavelet-type", "waveshaping voice", "wavo-hop", "wavo-trace",
- "weighted-moving-average", "widget-position", "widget-size", "widget-text", "window-height", "window-property",
- "window-property-changed-hook", "window-samples", "window-width", "window-x", "window-y", "with-background-processes",
- "with-file-monitor", "with-gl", "with-inset-graph", "with-local-hook", "with-marked-sound", "with-mix-tags",
- "with-mixed-sound", "with-mixed-sound->notelist", "with-pointer-focus", "with-relative-panes", "with-reopen-menu", "with-sound",
- "with-temp-sound", "with-temporary-selection", "with-threaded-channels", "with-threaded-sound", "with-tracking-cursor", "with-verbose-cursor",
- "x->position", "x-axis-label", "x-axis-style", "x-bounds", "x-position-slider", "x-zoom-slider",
- "xramp-channel", "y->position", "y-axis-label", "y-bounds", "y-position-slider", "y-zoom-slider",
- "z-transform", "zero-pad", "zip-sound", "zipper", "zoom-color", "zoom-focus-style"};
+ "*#readers*", "abort", "add-amp-controls", "add-colormap", "add-comment", "add-directory-to-view-files-list",
+ "add-file-filter", "add-file-sorter", "add-file-to-view-files-list", "add-mark", "add-mark-pane", "add-player",
+ "add-sound-file-extension", "add-source-file-extension", "add-to-main-menu", "add-to-menu", "add-tooltip", "add-transform",
+ "add-watcher", "additive synthesis", "after-apply-controls-hook", "after-edit-hook", "after-graph-hook", "after-lisp-graph-hook",
+ "after-open-hook", "after-save-as-hook", "after-save-state-hook", "after-transform-hook", "all-pass", "all-pass?",
+ "amp-control", "amp-control-bounds", "amplitude-modulate", "analyse-ladspa", "any-env-channel", "append-sound",
+ "apply-controls", "apply-ladspa", "array->file", "array-interp", "as-one-edit", "ask-before-overwrite",
+ "asymmetric-fm", "asymmetric-fm?", "audio-input-device", "audio-output-device", "auto-resize", "auto-save",
+ "auto-update", "auto-update-interval", "autocorrelate", "axis-color", "axis-info", "axis-label-font",
+ "axis-numbers-font", "background-gradient", "bad-header-hook", "bagpipe", "basic-color", "beats-per-measure",
+ "beats-per-minute", "before-close-hook", "before-exit-hook", "before-save-as-hook", "before-save-state-hook", "before-transform-hook",
+ "bessel filters", "bigbird", "binary files", "bind-key", "bird", "bold-peaks-font",
+ "bomb", "break", "brown-noise", "butterworth filters", "c-g!", "c-g?",
+ "call_in", "cascade->canonical", "chain-dsps", "channel->vct", "channel-amp-envs", "channel-data",
+ "channel-envelope", "channel-polynomial", "channel-properties", "channel-property", "channel-rms", "channel-style",
+ "channel-sync", "channel-widgets", "channels", "channels-equal?", "channels-separate", "channels=?",
+ "chans", "chebyshev filters", "check-for-unsaved-edits", "check-mix-tags", "clean-channel", "clean-sound",
+ "clear-array", "clear-listener", "clear-minibuffer", "clear-selection", "clip-hook", "clipping",
+ "clm-channel", "clm-load", "clone-sound-as", "close-hook", "close-sound", "color->list",
+ "color-cutoff", "color-hook", "color-inverted", "color-mixes", "color-orientation-dialog", "color-scale",
+ "color?", "colormap", "colormap->integer", "colormap-name", "colormap-ref", "colormap-size",
+ "colormap?", "comb", "comb?", "comment", "compand-channel", "compand-sound",
+ "concatenate-envelopes", "continue-frame->file", "continue-sample->file", "contrast-channel", "contrast-control", "contrast-control-amp",
+ "contrast-control-bounds", "contrast-control?", "contrast-enhancement", "contrast-sound", "controls->channel", "convolution",
+ "convolution reverb", "convolve", "convolve-files", "convolve-selection-with", "convolve-with", "convolve?",
+ "copy-frame-reader", "copy-sampler", "correlate", "count-matches", "create-ssb-dialog", "cross-fade (amplitude)",
+ "cross-fade (frequency domain)", "cross-synthesis", "current-edit-position", "current-font", "cursor", "cursor-color",
+ "cursor-follows-play", "cursor-in-view", "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style",
+ "cursor-update-interval", "dac-combines-channels", "dac-hook", "dac-size", "data-color", "data-format",
+ "data-location", "data-size", "db->linear", "def-clm-struct", "default-output-chans", "default-output-data-format",
+ "default-output-header-type", "default-output-srate", "defgenerator", "define-envelope", "define-selection-via-marks", "definstrument",
+ "defvar", "degrees->radians", "delay", "delay-channel-mixes", "delay-tick", "delay?",
+ "delete-colormap", "delete-file-filter", "delete-file-sorter", "delete-mark", "delete-marks", "delete-sample",
+ "delete-samples", "delete-selection", "delete-selection-and-smooth", "delete-transform", "delete-watcher", "describe-hook",
+ "describe-mark", "dialog-widgets", "disable-control-panel", "display-bark-fft", "display-db", "display-edits",
+ "display-scanned-synthesis", "dissolve-fade", "dither-channel", "dither-sound", "dlocsig", "do?",
+ "doit-again-button-color", "doit-button-color", "dot-product", "dot-size", "draw-axes", "draw-dot",
+ "draw-dots", "draw-line", "draw-lines", "draw-mark-hook", "draw-mix-hook", "draw-string",
+ "drop sites", "drop-hook", "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook",
+ "edit-list->function", "edit-position", "edit-properties", "edit-property", "edit-tree", "edits",
+ "edot-product", "elliptic filters", "emacs-style-save-as", "env", "env-any", "env-channel",
+ "env-channel-with-base", "env-expt-channel", "env-interp", "env-mixes", "env-selection", "env-sound",
+ "env-sound-interp", "env?", "enved-base", "enved-clip?", "enved-dialog", "enved-envelope",
+ "enved-filter", "enved-filter-order", "enved-hook", "enved-in-dB", "enved-power", "enved-style",
+ "enved-target", "enved-wave?", "enved-waveform-color", "envelope-interp", "enveloped-mix", "eps-bottom-margin",
+ "eps-file", "eps-left-margin", "eps-size", "*error-hook*", "*error-info*", "eval-between-marks",
+ "eval-over-selection", "every-sample?", "exit", "exit-hook", "expand-control", "expand-control-bounds",
+ "expand-control-hop", "expand-control-jitter", "expand-control-length", "expand-control-ramp", "expand-control?", "explode-sf2",
+ "exponentially-weighted-moving-average", "extract-channel", "extract-channels", "*features*", "feedback fm", "fft",
+ "fft sizes", "fft-edit", "fft-log-frequency", "fft-log-magnitude", "fft-smoother", "fft-squelch",
+ "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database", "file->array",
+ "file->frame", "file->frame?", "file->sample", "file->sample?", "file->sound-data", "file->vct",
+ "file-name", "fill-polygon", "fill-rectangle", "filter", "filter-channel", "filter-control-coeffs",
+ "filter-control-envelope", "filter-control-in-dB", "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color", "filter-control?",
+ "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb", "filtered-comb?",
+ "find-channel", "find-dialog", "find-mark", "find-mix", "find-sound", "finish-progress-report",
+ "fir-filter", "fir-filter?", "firmant", "firmant?", "flocsig", "flocsig?",
+ "flute model", "fm-bell", "fm-drum", "fm-noise", "fm-talker", "fm-trumpet",
+ "fm-violin", "fm-voice", "focus-widget", "FOF synthesis", "for-each-child", "for-each-sound-file",
+ "Forbidden Planet", "foreground-color", "forget-region", "formant", "formant?", "fourier-transform",
+ "fractional-fourier-transform", "frame", "frame*", "frame+", "frame->file", "frame->file?",
+ "frame->frame", "frame->list", "frame->sample", "frame->sound", "frame->sound-data", "frame->vct",
+ "frame-copy", "frame-reader-at-end?", "frame-reader-chans", "frame-reader-home", "frame-reader-position", "frame-reader?",
+ "frame-ref", "frame-reverse!", "frame-set!", "frame?", "frames", "free-frame-reader",
+ "free-player", "free-sampler", "freeverb", "fullmix", "gaussian-distribution", "gc-off",
+ "gc-on", "gl-graph->ps", "glSpectrogram", "goertzel", "goto-listener-end", "grani",
+ "granulate", "granulate?", "granulated-sound-interp", "graph", "graph->ps", "graph-color",
+ "graph-cursor", "graph-data", "graph-hook", "graph-lines", "graph-style", "graphic equalizer",
+ "graphs-horizontal", "green-noise", "green-noise-interp", "grid-density", "harmonicizer", "Hartley transform",
+ "header-type", "hello-dentist", "help-button-color", "help-dialog", "help-hook", "hide-widget",
+ "highlight-color", "hilbert-transform", "hook-member", "html-dir", "html-program", "hz->radians",
+ "iir-filter", "iir-filter?", "in", "in-any", "ina", "inb",
+ "info-dialog", "init-ladspa", "initial-graph-hook", "insert-channel", "insert-file-dialog", "insert-frame",
+ "insert-region", "insert-sample", "insert-samples", "insert-selection", "insert-silence", "insert-sound",
+ "insert-sound-data", "insert-vct", "instruments", "integer->colormap", "integer->mark", "integer->mix",
+ "integer->region", "integer->sound", "integer->transform", "integrate-envelope", "jc-reverb", "just-sounds",
+ "kalman-filter-channel", "key", "key-binding", "key-press-hook", "ladspa-descriptor", "ladspa-dir",
+ "left-sample", "level meters", "linear->db", "linear-src-channel", "lisp-graph-hook", "lisp-graph-style",
+ "lisp-graph?", "list->vct", "list-ladspa", "listener-click-hook", "listener-color", "listener-font",
+ "listener-prompt", "listener-selection", "listener-text-color", "little-endian?", "*load-hook*", "*load-path*",
+ "locsig", "locsig-ref", "locsig-reverb-ref", "locsig-reverb-set!", "locsig-set!", "locsig-type",
+ "locsig?", "log-freq-start", "loop-between-marks", "lpc-coeffs", "lpc-predict", "main-menu",
+ "main-widgets", "make-all-pass", "make-asymmetric-fm", "make-bandpass", "make-bandstop", "make-biquad",
+ "make-birds", "make-color", "make-comb", "make-convolve", "make-delay", "make-differentiator",
+ "make-env", "make-fft-window", "make-file->frame", "make-file->sample", "make-filter", "make-filtered-comb",
+ "make-fir-filter", "make-firmant", "make-flocsig", "make-formant", "make-frame", "make-frame!",
+ "make-frame->file", "make-frame-reader", "make-granulate", "make-graph-data", "make-hidden-controls-dialog", "make-highpass",
+ "make-hilbert-transform", "make-iir-filter", "make-locsig", "make-lowpass", "make-mix-sampler", "make-mixer",
+ "make-mixer!", "make-move-sound", "make-moving-autocorrelation", "make-moving-average", "make-moving-fft", "make-moving-pitch",
+ "make-moving-scentroid", "make-moving-spectrum", "make-ncos", "make-noid", "make-notch", "make-nrxycos",
+ "make-nrxysin", "make-nsin", "make-one-pole", "make-one-zero", "make-oscil", "make-phase-vocoder",
+ "make-pixmap", "make-player", "make-polyoid", "make-polyshape", "make-polywave", "make-pulse-train",
+ "make-rand", "make-rand-interp", "make-readin", "make-region", "make-region-frame-reader", "make-region-sampler",
+ "make-sample->file", "make-sampler", "make-sawtooth-wave", "make-scalar-mixer", "make-selection", "make-selection-frame-reader",
+ "make-snd->sample", "make-sound-box", "make-sound-data", "make-square-wave", "make-src", "make-ssb-am",
+ "make-sync-frame-reader", "make-table-lookup", "make-triangle-wave", "make-two-pole", "make-two-zero", "make-variable-display",
+ "make-variable-graph", "make-vct", "make-wave-train", "map-channel", "map-sound", "map-sound-files",
+ "maracas", "mark->integer", "mark-click-hook", "mark-color", "mark-drag-hook", "mark-drag-triangle-hook",
+ "mark-explode", "mark-home", "mark-hook", "mark-loops", "mark-name", "mark-name->id",
+ "mark-properties", "mark-property", "mark-sample", "mark-sync", "mark-sync-max", "mark-tag-height",
+ "mark-tag-width", "mark?", "marks", "match-sound-files", "max-envelope", "max-regions",
+ "max-transform-peaks", "max-virtual-ptrees", "maxamp", "maxamp-position", "menu-widgets", "menus, optional",
+ "min-dB", "minibuffer-history-length", "mix", "mix->integer", "mix->vct", "mix-amp",
+ "mix-amp-env", "mix-channel", "mix-click-hook", "mix-color", "mix-dialog-mix", "mix-drag-hook",
+ "mix-file-dialog", "mix-frame", "mix-home", "mix-length", "mix-maxamp", "mix-move-sound",
+ "mix-name", "mix-name->id", "mix-position", "mix-properties", "mix-property", "mix-region",
+ "mix-release-hook", "mix-sampler?", "mix-selection", "mix-sound", "mix-sound-data", "mix-speed",
+ "mix-sync", "mix-sync-max", "mix-tag-height", "mix-tag-width", "mix-tag-y", "mix-vct",
+ "mix-waveform-height", "mix?", "mixer", "mixer*", "mixer as matrix", "mixer+",
+ "mixer-copy", "mixer-determinant", "mixer-inverse", "mixer-poly", "mixer-ref", "mixer-set!",
+ "mixer-solve", "mixer-transpose", "mixer?", "mixes", "mono->stereo", "moog-filter",
+ "mouse-click-hook", "mouse-drag-hook", "mouse-enter-graph-hook", "mouse-enter-label-hook", "mouse-enter-listener-hook", "mouse-enter-text-hook",
+ "mouse-leave-graph-hook", "mouse-leave-label-hook", "mouse-leave-listener-hook", "mouse-leave-text-hook", "mouse-press-hook", "move-locsig",
+ "move-mixes", "move-sound", "move-sound?", "moving-autocorrelation", "moving-autocorrelation?", "moving-average",
+ "moving-average?", "moving-fft", "moving-fft?", "moving-length", "moving-max", "moving-pitch",
+ "moving-pitch?", "moving-rms", "moving-scentroid", "moving-scentroid?", "moving-spectrum", "moving-spectrum?",
+ "moving-sum", "mpg", "multiply-arrays", "mus-alsa-buffer-size", "mus-alsa-buffers", "mus-alsa-capture-device",
+ "mus-alsa-device", "mus-alsa-playback-device", "mus-alsa-squelch-warning", "mus-array-print-length", "mus-audio-close", "mus-audio-describe",
+ "mus-audio-open-input", "mus-audio-open-output", "mus-audio-read", "mus-audio-write", "mus-bytes-per-sample", "mus-channel",
+ "mus-channels", "mus-chebyshev-tu-sum", "mus-clipping", "mus-close", "mus-data", "mus-data-format->string",
+ "mus-data-format-name", "mus-describe", "mus-error-hook", "mus-error-type->string", "mus-expand-filename", "mus-feedback",
+ "mus-feedforward", "mus-fft", "mus-file-buffer-size", "mus-file-clipping", "mus-file-name", "mus-file-prescaler",
+ "mus-float-equal-fudge-factor", "mus-frequency", "mus-generator?", "mus-header-raw-defaults", "mus-header-type->string", "mus-header-type-name",
+ "mus-hop", "mus-increment", "mus-input?", "mus-interp-type", "mus-interpolate", "mus-length",
+ "mus-location", "mus-max-malloc", "mus-max-table-size", "mus-mix", "mus-name", "mus-offset",
+ "mus-order", "mus-oss-set-buffers", "mus-out-format", "mus-output?", "mus-phase", "mus-prescaler",
+ "mus-ramp", "mus-random", "mus-reset", "mus-run", "mus-safety", "mus-scaler",
+ "mus-sound-chans", "mus-sound-close-input", "mus-sound-close-output", "mus-sound-comment", "mus-sound-data-format", "mus-sound-data-location",
+ "mus-sound-datum-size", "mus-sound-duration", "mus-sound-forget", "mus-sound-frames", "mus-sound-header-type", "mus-sound-length",
+ "mus-sound-loop-info", "mus-sound-mark-info", "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-open-input", "mus-sound-open-output",
+ "mus-sound-prune", "mus-sound-read", "mus-sound-reopen-output", "mus-sound-report-cache", "mus-sound-samples", "mus-sound-seek-frame",
+ "mus-sound-srate", "mus-sound-type-specifier", "mus-sound-write", "mus-sound-write-date", "mus-srate", "mus-width",
+ "mus-xcoeff", "mus-xcoeffs", "mus-ycoeff", "mus-ycoeffs", "name-click-hook", "ncos",
+ "ncos?", "new-sound", "new-sound-dialog", "new-sound-hook", "new-widget-hook", "next-frame",
+ "next-sample", "noid", "normalize-channel", "normalize-envelope", "normalize-partials", "normalize-sound",
+ "normalized-mix", "notch", "notch-channel", "notch-out-rumble-and-hiss", "notch-selection", "notch-sound",
+ "notch?", "nrev", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?",
+ "nsin", "nsin?", "offset-channel", "offset-sound", "one-pole", "one-pole?",
+ "one-zero", "one-zero?", "open-file-dialog", "open-file-dialog-directory", "open-hook", "open-next-file-in-directory",
+ "open-raw-sound", "open-raw-sound-hook", "open-sound", "optimization", "optimization-hook", "orientation-hook",
+ "oscil", "oscil?", "oscilloscope dialog", "out-any", "outa", "*output*",
+ "output-comment-hook", "output-name-hook", "overlay-rms-env", "pad-channel", "pad-marks", "pad-sound",
+ "pan-mix", "pan-mix-vct", "partials->polynomial", "partials->wave", "pausing", "peak-env-dir",
+ "peak-env-hook", "peaks", "peaks-font", "phase-partials->wave", "phase-vocoder", "phase-vocoder?",
+ "piano model", "pink-noise", "place-sound", "play", "play-between-marks", "play-hook",
+ "play-mixes", "play-sines", "play-syncd-marks", "player-home", "player?", "players",
+ "playing", "pluck", "polar->rectangular", "polynomial", "polynomial operations", "polyoid",
+ "polyoid-env", "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?",
+ "position->x", "position->y", "position-color", "power-env", "preferences-dialog", "previous-frame",
+ "previous-sample", "print-dialog", "print-hook", "print-length", "profile", "progress-report",
+ "prompt-in-minibuffer", "ptree-channel", "pulse-train", "pulse-train?", "pushed-button-color", "quit-button-color",
+ "radians->degrees", "radians->hz", "ramp-channel", "rand", "rand-interp", "rand-interp?",
+ "rand?", "read-frame", "read-hook", "read-mix-sample", "read-only", "read-region-sample",
+ "read-sample", "readin", "readin?", "recorder-dialog", "rectangular->magnitudes", "rectangular->polar",
+ "redo", "redo-channel", "redo-edit", "region->frame", "region->integer", "region->sound-data",
+ "region->vct", "region-chans", "region-frames", "region-graph-style", "region-home", "region-maxamp",
+ "region-maxamp-position", "region-play-list", "region-position", "region-sample", "region-sampler?", "region-srate",
+ "region?", "regions", "remember-sound-state", "remove-from-menu", "report-in-minibuffer", "reset-all-hooks",
+ "reset-button-color", "reset-controls", "reset-listener-cursor", "restore-controls", "*reverb*", "reverb-control-decay",
+ "reverb-control-feedback", "reverb-control-length", "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds",
+ "reverb-control?", "reverse-channel", "reverse-channels", "reverse-envelope", "reverse-selection", "reverse-sound",
+ "revert-sound", "right-sample", "ring-modulate", "rms", "rms, gain, balance gens", "rms-envelope",
+ "rotate-channel", "rubber-sound", "run", "sample", "sample->file", "sample->file?",
+ "sample->frame", "sampler-at-end?", "sampler-home", "sampler-position", "sampler?", "samples",
+ "samples->seconds", "sash-color", "save-controls", "save-dir", "save-edit-history", "save-envelopes",
+ "save-hook", "save-listener", "save-macros", "save-mark-properties", "save-marks", "save-mix",
+ "save-mixes", "save-region", "save-region-dialog", "save-selection", "save-selection-dialog", "save-sound",
+ "save-sound-as", "save-sound-dialog", "save-state", "save-state-file", "save-state-hook", "savitzky-golay-filter",
+ "sawtooth-wave", "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope", "scale-mixes",
+ "scale-selection-by", "scale-selection-to", "scale-sound", "scale-tempo", "scale-to", "scan-channel",
+ "scan-sound", "scanned synthesis", "scentroid", "script-arg", "script-args", "search-procedure",
+ "seconds->samples", "select-all", "select-channel", "select-channel-hook", "select-sound", "select-sound-hook",
+ "selected-channel", "selected-data-color", "selected-graph-color", "selected-sound", "selection", "selection->mix",
+ "selection->sound-data", "selection-chans", "selection-color", "selection-creates-region", "selection-frames", "selection-maxamp",
+ "selection-maxamp-position", "selection-member?", "selection-members", "selection-position", "selection-srate", "selection?",
+ "send-mozilla", "set-global-sync", "set-samples", "shepard-tone", "short-file-name", "show-axes",
+ "show-controls", "show-disk-space", "show-grid", "show-indices", "show-listener", "show-marks",
+ "show-mix-waveforms", "show-selection", "show-selection-transform", "show-smpte-label", "show-sonogram-cursor", "show-transform-peaks",
+ "show-widget", "show-y-zero", "silence-all-mixes", "silence-mixes", "sinc-train", "sinc-width",
+ "sine-env-channel", "sine-ramp", "singer", "smooth-channel", "smooth-selection", "smooth-sound",
+ "SMS synthesis", "snap-mark-to-beat", "snap-mix-to-beat", "snd->sample", "snd->sample?", "snd-color",
+ "snd-error", "snd-error-hook", "snd-font", "snd-gcs", "snd-help", "snd-hooks",
+ "*snd-opened-sound*", "snd-print", "snd-spectrum", "snd-tempnam", "snd-url", "snd-urls",
+ "snd-version", "snd-warning", "snd-warning-hook", "sndwarp", "sound->amp-env", "sound->frame",
+ "sound->integer", "sound->sound-data", "sound-data*", "sound-data+", "sound-data->file", "sound-data->frame",
+ "sound-data->sound", "sound-data->sound-data", "sound-data->vct", "sound-data-add!", "sound-data-chans", "sound-data-copy",
+ "sound-data-fill!", "sound-data-length", "sound-data-maxamp", "sound-data-multiply!", "sound-data-offset!", "sound-data-peak",
+ "sound-data-ref", "sound-data-reverse!", "sound-data-scale!", "sound-data-set!", "sound-data?", "sound-file-extensions",
+ "sound-file?", "sound-files-in-directory", "sound-interp", "sound-let", "sound-loop-info", "sound-properties",
+ "sound-property", "sound-widgets", "sound?", "soundfont-info", "sounds", "spectral interpolation",
+ "spectral-polynomial", "spectro-hop", "spectro-x-angle", "spectro-x-scale", "spectro-y-angle", "spectro-y-scale",
+ "spectro-z-angle", "spectro-z-scale", "spectrum", "spectrum->coeffs", "spectrum-end", "spectrum-start",
+ "speed-control", "speed-control-bounds", "speed-control-style", "speed-control-tones", "square-wave", "square-wave?",
+ "squelch-update", "squelch-vowels", "srate", "src", "src-channel", "src-duration",
+ "src-mixes", "src-selection", "src-sound", "src?", "ssb-am", "ssb-am?",
+ "ssb-bank", "ssb-bank-env", "ssb-fm", "start-hook", "start-playing", "start-playing-hook",
+ "start-playing-selection-hook", "start-progress-report", "start-waterfall", "stereo->mono", "stop-dac-hook", "stop-player",
+ "stop-playing", "stop-playing-hook", "stop-playing-selection-hook", "stretch-envelope", "superimpose-ffts", "swap-channels",
+ "swap-selection-channels", "sync", "sync-all", "sync-max", "syncd-marks", "table-lookup",
+ "table-lookup?", "tap", "telephone", "temp-dir", "text-focus-color", "time-graph-hook",
+ "time-graph-style", "time-graph-type", "time-graph?", "tiny-font", "*trace-hook*", "tracking-cursor-style",
+ "transform->integer", "transform->vct", "transform-dialog", "transform-frames", "transform-graph-style", "transform-graph-type",
+ "transform-graph?", "transform-normalization", "transform-sample", "transform-size", "transform-type", "transform?",
+ "transpose-mixes", "trap-segfault", "triangle-wave", "triangle-wave?", "tubular bell", "two-pole",
+ "two-pole?", "two-zero", "two-zero?", "unbind-key", "*unbound-variable-hook*", "unclip-channel",
+ "undo", "undo-channel", "undo-edit", "undo-hook", "update-graphs", "update-hook",
+ "update-lisp-graph", "update-sound", "update-time-graph", "update-transform-graph", "user interface extensions", "variable-display",
+ "variable-graph?", "vct", "vct*", "vct+", "vct->channel", "vct->file",
+ "vct->frame", "vct->list", "vct->sound-data", "vct->string", "vct->vector", "vct-add!",
+ "vct-copy", "vct-fill!", "vct-length", "vct-map!", "vct-move!", "vct-multiply!",
+ "vct-offset!", "vct-peak", "vct-polynomial", "vct-ref", "vct-reverse!", "vct-scale!",
+ "vct-set!", "vct-subseq", "vct-subtract!", "vct?", "vector->vct", "*vector-print-length*",
+ "verbose-cursor", "view-files-amp", "view-files-amp-env", "view-files-dialog", "view-files-files", "view-files-select-hook",
+ "view-files-selected-files", "view-files-sort", "view-files-speed", "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog",
+ "view-sound", "voice physical model", "voiced->unvoiced", "volterra-filter", "wave-train", "wave-train?",
+ "wavelet-type", "waveshaping voice", "wavo-hop", "wavo-trace", "weighted-moving-average", "widget-position",
+ "widget-size", "widget-text", "window-height", "window-property", "window-property-changed-hook", "window-samples",
+ "window-width", "window-x", "window-y", "with-background-processes", "with-file-monitor", "with-gl",
+ "with-inset-graph", "with-local-hook", "with-marked-sound", "with-mix-tags", "with-mixed-sound", "with-mixed-sound->notelist",
+ "with-pointer-focus", "with-relative-panes", "with-reopen-menu", "with-sound", "with-temp-sound", "with-temporary-selection",
+ "with-threaded-channels", "with-threaded-sound", "with-tracking-cursor", "with-verbose-cursor", "x->position", "x-axis-label",
+ "x-axis-style", "x-bounds", "x-position-slider", "x-zoom-slider", "xramp-channel", "y->position",
+ "y-axis-label", "y-bounds", "y-position-slider", "y-zoom-slider", "z-transform", "zero-pad",
+ "zip-sound", "zipper", "zoom-color", "zoom-focus-style"};
#endif
#if HAVE_RUBY
static const char *help_names[HELP_NAMES_SIZE] = {
- "abort", "add_amp_controls", "add_colormap", "add_comment", "add_directory_to_view_files_list", "add_file_filter",
- "add_file_sorter", "add_file_to_view_files_list", "add_mark", "add_mark_pane", "add_player", "add_sound_file_extension",
- "add_source_file_extension", "add_to_main_menu", "add_to_menu", "add_tooltip", "add_transform", "add_watcher",
- "additive_synthesis", "after_apply_controls_hook", "after_edit_hook", "after_graph_hook", "after_lisp_graph_hook", "after_open_hook",
- "after_save_as_hook", "after_save_state_hook", "after_transform_hook", "all_pass", "all_pass?", "amp_control",
- "amp_control_bounds", "amplitude_modulate", "analyse_ladspa", "any_env_channel", "append_sound", "apply_controls",
- "apply_ladspa", "array2file", "array_interp", "as_one_edit", "ask_before_overwrite", "asymmetric_fm",
- "asymmetric_fm?", "audio_input_device", "audio_output_device", "auto_resize", "auto_save", "auto_update",
- "auto_update_interval", "autocorrelate", "axis_color", "axis_info", "axis_label_font", "axis_numbers_font",
- "background_gradient", "bad_header_hook", "bagpipe", "basic_color", "beats_per_measure", "beats_per_minute",
- "before_close_hook", "before_exit_hook", "before_save_as_hook", "before_save_state_hook", "before_transform_hook", "bessel_filters",
- "bigbird", "bind_key", "bird", "bold_peaks_font", "bomb", "break",
- "brown_noise", "butterworth_filters", "c_g!", "c_g?", "call_in", "cascade2canonical",
- "chain_dsps", "channel2vct", "channel_amp_envs", "channel_data", "channel_envelope", "channel_polynomial",
- "channel_properties", "channel_property", "channel_rms", "channel_style", "channel_sync", "channel_widgets",
- "channels", "channels_equal?", "Channels_separate", "channels_?", "chans", "chebyshev_filters",
- "check_for_unsaved_edits", "check_mix_tags", "clean_channel", "clean_sound", "clear_array", "clear_listener",
- "clear_minibuffer", "clear_selection", "clip_hook", "clipping", "clm_channel", "clm_load",
- "clone_sound_as", "close_hook", "close_sound", "color2list", "color_cutoff", "color_hook",
- "color_inverted", "color_mixes", "color_orientation_dialog", "color_scale", "color?", "colormap",
- "colormap2integer", "colormap_name", "colormap_ref", "colormap_size", "colormap?", "comb",
- "comb?", "comment", "compand_channel", "compand_sound", "concatenate_envelopes", "continue_frame2file",
- "continue_sample2file", "contrast_channel", "contrast_control", "contrast_control_amp", "contrast_control_bounds", "contrast_control?",
- "contrast_enhancement", "contrast_sound", "controls2channel", "convolution", "convolution_reverb", "convolve",
- "convolve_files", "convolve_selection_with", "convolve_with", "convolve?", "copy_frame_reader", "copy_sampler",
- "correlate", "count_matches", "create_ssb_dialog", "cross_fade__amplitude_", "cross_fade__frequency_domain_", "cross_synthesis",
- "Current_edit_position", "current_font", "cursor", "cursor_color", "cursor_follows_play", "Cursor_in_view",
- "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style", "cursor_update_interval", "dac_combines_channels",
- "dac_hook", "dac_size", "data_color", "data_format", "data_location", "data_size",
- "db2linear", "def_clm_struct", "default_output_chans", "default_output_data_format", "default_output_header_type", "default_output_srate",
- "defgenerator", "define_envelope", "define_selection_via_marks", "definstrument", "defvar", "degrees2radians",
- "delay", "delay_channel_mixes", "delay_tick", "delay?", "delete_colormap", "delete_file_filter",
- "delete_file_sorter", "delete_mark", "delete_marks", "delete_sample", "delete_samples", "delete_selection",
- "delete_selection_and_smooth", "delete_transform", "delete_watcher", "describe_hook", "describe_mark", "dialog_widgets",
- "disable_control_panel", "display_bark_fft", "display_db", "display_edits", "display_scanned_synthesis", "dissolve_fade",
- "dither_channel", "dither_sound", "dlocsig", "do?", "doit_again_button_color", "doit_button_color",
- "dot_product", "dot_size", "draw_axes", "draw_dot", "draw_dots", "draw_line",
- "draw_lines", "draw_mark_hook", "draw_mix_hook", "draw_string", "drop_sites", "drop_hook",
- "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook", "edit_list2function", "edit_position",
- "edit_properties", "edit_property", "edit_tree", "edits", "edot_product", "elliptic_filters",
- "emacs_style_save_as", "env", "env_any", "env_channel", "env_channel_with_base", "env_expt_channel",
- "env_interp", "env_mixes", "env_selection", "env_sound", "env_sound_interp", "env?",
- "enved_base", "enved_clip?", "enved_dialog", "enved_envelope", "enved_filter", "enved_filter_order",
- "enved_hook", "enved_in_dB", "enved_power", "enved_style", "enved_target", "enved_wave?",
- "enved_waveform_color", "envelope_interp", "enveloped_mix", "eps_bottom_margin", "eps_file", "eps_left_margin",
- "eps_size", "eval_between_marks", "eval_over_selection", "every_sample?", "exit", "exit_hook",
- "expand_control", "expand_control_bounds", "expand_control_hop", "expand_control_jitter", "expand_control_length", "expand_control_ramp",
- "expand_control?", "explode_sf2", "exponentially_weighted_moving_average", "extract_channel", "extract_channels", "feedback_fm",
- "fft", "fft_sizes", "fft_edit", "fft_log_frequency", "fft_log_magnitude", "fft_smoother",
- "fft_squelch", "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database",
- "file2array", "file2frame", "file2frame?", "file2sample", "file2sample?", "file2sound_data",
- "file2vct", "file_name", "fill_polygon", "fill_rectangle", "filter", "filter_channel",
- "filter_control_coeffs", "filter_control_envelope", "filter_control_in_dB", "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color",
- "filter_control?", "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb",
- "filtered_comb?", "find_channel", "find_dialog", "find_mark", "find_mix", "find_sound",
- "finish_progress_report", "fir_filter", "fir_filter?", "firmant", "firmant?", "flocsig",
- "flocsig?", "flute_model", "fm_bell", "fm_drum", "fm_noise", "fm_talker",
- "fm_trumpet", "fm_violin", "fm_voice", "focus_widget", "FOF_synthesis", "for_each_child",
- "for_each_sound_file", "Forbidden_Planet", "foreground_color", "forget_region", "formant", "formant?",
- "Fourier_transform", "fractional_fourier_transform", "frame", "frame_multiply", "frame_add", "frame2file",
- "frame2file?", "frame2frame", "frame2list", "frame2sample", "frame2sound", "frame2sound_data",
- "frame2vct", "frame_copy", "frame_reader_at_end?", "frame_reader_chans", "frame_reader_home", "frame_reader_position",
- "frame_reader?", "frame_ref", "frame_reverse!", "frame_set!", "frame?", "frames",
- "free_frame_reader", "free_player", "free_sampler", "freeverb", "fullmix", "gaussian_distribution",
- "gc_off", "gc_on", "gl_graph2ps", "glSpectrogram", "goertzel", "goto_listener_end",
- "grani", "granulate", "granulate?", "granulated_sound_interp", "graph", "graph2ps",
- "graph_color", "graph_cursor", "graph_data", "graph_hook", "Graph_lines", "graph_style",
- "graphic_equalizer", "graphs_horizontal", "green_noise", "green_noise_interp", "grid_density", "harmonicizer",
- "Hartley_transform", "header_type", "hello_dentist", "help_button_color", "help_dialog", "help_hook",
- "hide_widget", "highlight_color", "hilbert_transform", "hook_member", "html_dir", "html_program",
- "hz2radians", "iir_filter", "iir_filter?", "call_in", "in_any", "ina",
- "inb", "info_dialog", "init_ladspa", "initial_graph_hook", "insert_channel", "insert_file_dialog",
- "insert_frame", "insert_region", "insert_sample", "insert_samples", "insert_selection", "insert_silence",
- "insert_sound", "insert_sound_data", "insert_vct", "instruments", "integer2colormap", "integer2mark",
- "integer2mix", "integer2region", "integer2sound", "integer2transform", "integrate_envelope", "jc_reverb",
- "just_sounds", "kalman_filter_channel", "key", "key_binding", "key_press_hook", "ladspa_descriptor",
- "ladspa_dir", "left_sample", "level_meters", "linear2db", "linear_src_channel", "lisp_graph_hook",
- "lisp_graph_style", "lisp_graph?", "list2vct", "list_ladspa", "listener_click_hook", "listener_color",
- "listener_font", "listener_prompt", "listener_selection", "listener_text_color", "little_endian?", "locsig",
- "locsig_ref", "locsig_reverb_ref", "locsig_reverb_set!", "locsig_set!", "locsig_type", "locsig?",
- "log_freq_start", "loop_between_marks", "lpc_coeffs", "lpc_predict", "main_menu", "main_widgets",
- "make_all_pass", "make_asymmetric_fm", "make_bandpass", "make_bandstop", "make_biquad", "make_birds",
- "make_color", "make_comb", "make_convolve", "make_delay", "make_differentiator", "make_env",
- "make_fft_window", "make_file2frame", "make_file2sample", "make_filter", "make_filtered_comb", "make_fir_filter",
- "make_firmant", "make_flocsig", "make_formant", "make_frame", "make_frame!", "make_frame2file",
- "make_frame_reader", "make_granulate", "make_graph_data", "make_hidden_controls_dialog", "make_highpass", "make_hilbert_transform",
- "make_iir_filter", "make_locsig", "make_lowpass", "make_mix_sampler", "make_mixer", "make_mixer!",
- "make_move_sound", "make_moving_autocorrelation", "make_moving_average", "make_moving_fft", "make_moving_pitch", "make_moving_scentroid",
- "make_moving_spectrum", "make_ncos", "make_noid", "make_notch", "make_nrxycos", "make_nrxysin",
- "make_nsin", "make_one_pole", "make_one_zero", "make_oscil", "make_phase_vocoder", "make_pixmap",
- "make_player", "make_polyoid", "make_polyshape", "make_polywave", "make_pulse_train", "make_rand",
- "make_rand_interp", "make_readin", "make_region", "make_region_frame_reader", "make_region_sampler", "make_sample2file",
- "make_sampler", "make_sawtooth_wave", "make_scalar_mixer", "make_selection", "make_selection_frame_reader", "make_snd2sample",
- "make_sound_box", "make_sound_data", "make_square_wave", "make_src", "make_ssb_am", "make_sync_frame_reader",
- "make_table_lookup", "make_triangle_wave", "make_two_pole", "make_two_zero", "make_variable_display", "make_variable_graph",
- "make_vct", "make_wave_train", "map_channel", "map_sound", "map_sound_files", "maracas",
- "mark2integer", "mark_click_hook", "mark_color", "mark_drag_hook", "mark_drag_triangle_hook", "mark_explode",
- "mark_home", "mark_hook", "mark_loops", "mark_name", "mark_name2id", "mark_properties",
- "mark_property", "mark_sample", "mark_sync", "mark_sync_max", "mark_tag_height", "mark_tag_width",
- "mark?", "marks", "match_sound_files", "max_envelope", "max_regions", "max_transform_peaks",
- "max_virtual_ptrees", "maxamp", "maxamp_position", "menu_widgets", "menus__optional", "min_dB",
- "minibuffer_history_length", "mix", "mix2integer", "mix2vct", "mix_amp", "mix_amp_env",
- "mix_channel", "mix_click_hook", "mix_color", "mix_dialog_mix", "mix_drag_hook", "mix_file_dialog",
- "mix_frame", "mix_home", "mix_length", "mix_maxamp", "mix_move_sound", "mix_name",
- "mix_name2id", "mix_position", "mix_properties", "mix_property", "mix_region", "mix_release_hook",
- "mix_sampler?", "mix_selection", "mix_sound", "mix_sound_data", "mix_speed", "mix_sync",
- "mix_sync_max", "mix_tag_height", "mix_tag_width", "mix_tag_y", "mix_vct", "mix_waveform_height",
- "mix?", "mixer", "mixer_multiply", "mixer_as_matrix", "mixer_add", "mixer_copy",
- "mixer_determinant", "mixer_inverse", "mixer_poly", "mixer_ref", "mixer_set!", "mixer_solve",
- "mixer_transpose", "mixer?", "mixes", "mono2stereo", "moog_filter", "mouse_click_hook",
- "mouse_drag_hook", "mouse_enter_graph_hook", "mouse_enter_label_hook", "mouse_enter_listener_hook", "mouse_enter_text_hook", "mouse_leave_graph_hook",
- "mouse_leave_label_hook", "mouse_leave_listener_hook", "mouse_leave_text_hook", "mouse_press_hook", "move_locsig", "move_mixes",
- "move_sound", "move_sound?", "moving_autocorrelation", "moving_autocorrelation?", "moving_average", "moving_average?",
- "moving_fft", "moving_fft?", "moving_length", "moving_max", "moving_pitch", "moving_pitch?",
- "moving_rms", "moving_scentroid", "moving_scentroid?", "moving_spectrum", "moving_spectrum?", "moving_sum",
- "mpg", "multiply_arrays", "mus_alsa_buffer_size", "mus_alsa_buffers", "mus_alsa_capture_device", "mus_alsa_device",
- "mus_alsa_playback_device", "mus_alsa_squelch_warning", "mus_array_print_length", "mus_audio_close", "mus_audio_describe", "mus_audio_open_input",
- "mus_audio_open_output", "mus_audio_read", "mus_audio_write", "mus_bytes_per_sample", "mus_channel", "mus_channels",
- "mus_chebyshev_tu_sum", "mus_clipping", "mus_close", "mus_data", "mus_data_format2string", "mus_data_format_name",
- "mus_describe", "mus_error_hook", "mus_error_type2string", "mus_expand_filename", "mus_feedback", "mus_feedforward",
- "mus_fft", "mus_file_buffer_size", "mus_file_clipping", "mus_file_name", "mus_file_prescaler", "mus_float_equal_fudge_factor",
- "mus_frequency", "mus_generator?", "mus_header_raw_defaults", "mus_header_type2string", "mus_header_type_name", "mus_hop",
- "mus_increment", "mus_input?", "mus_interp_type", "mus_interpolate", "mus_length", "mus_location",
- "mus_max_malloc", "mus_max_table_size", "mus_mix", "mus_name", "mus_offset", "mus_order",
- "mus_oss_set_buffers", "Mus_out_format", "mus_output?", "mus_phase", "mus_prescaler", "mus_ramp",
- "mus_random", "mus_reset", "mus_run", "mus_safety", "mus_scaler", "mus_sound_chans",
- "mus_sound_close_input", "mus_sound_close_output", "mus_sound_comment", "mus_sound_data_format", "mus_sound_data_location", "mus_sound_datum_size",
- "mus_sound_duration", "mus_sound_forget", "mus_sound_frames", "mus_sound_header_type", "mus_sound_length", "mus_sound_loop_info",
- "mus_sound_mark_info", "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_open_input", "mus_sound_open_output", "mus_sound_prune",
- "mus_sound_read", "mus_sound_reopen_output", "mus_sound_report_cache", "mus_sound_samples", "mus_sound_seek_frame", "mus_sound_srate",
- "mus_sound_type_specifier", "mus_sound_write", "mus_sound_write_date", "mus_srate", "mus_width", "mus_xcoeff",
- "mus_xcoeffs", "mus_ycoeff", "mus_ycoeffs", "name_click_hook", "ncos", "ncos?",
- "new_sound", "new_sound_dialog", "new_sound_hook", "new_widget_hook", "next_frame", "next_sample",
- "noid", "normalize_channel", "normalize_envelope", "normalize_partials", "normalize_sound", "normalized_mix",
- "notch", "notch_channel", "notch_out_rumble_and_hiss", "notch_selection", "notch_sound", "notch?",
- "nrev", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin",
- "nsin?", "offset_channel", "offset_sound", "one_pole", "one_pole?", "one_zero",
- "one_zero?", "open_file_dialog", "open_file_dialog_directory", "open_hook", "open_next_file_in_directory", "open_raw_sound",
- "open_raw_sound_hook", "open_sound", "optimization", "optimization_hook", "orientation_hook", "oscil",
- "oscil?", "oscilloscope_dialog", "out_any", "outa", "_output_", "output_comment_hook",
- "output_name_hook", "overlay_rms_env", "pad_channel", "pad_marks", "pad_sound", "pan_mix",
- "pan_mix_vct", "partials2polynomial", "partials2wave", "pausing", "peak_env_dir", "peak_env_hook",
- "peaks", "peaks_font", "phase_partials2wave", "phase_vocoder", "phase_vocoder?", "piano_model",
- "pink_noise", "place_sound", "play", "play_between_marks", "play_hook", "play_mixes",
- "play_sines", "play_syncd_marks", "player_home", "player?", "players", "playing",
- "pluck", "polar2rectangular", "polynomial", "polynomial_operations", "polyoid", "polyoid_env",
- "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?", "position2x",
- "position2y", "position_color", "power_env", "preferences_dialog", "previous_frame", "previous_sample",
- "print_dialog", "print_hook", "print_length", "profile", "progress_report", "prompt_in_minibuffer",
- "ptree_channel", "pulse_train", "pulse_train?", "pushed_button_color", "quit_button_color", "radians2degrees",
- "radians2hz", "ramp_channel", "rand", "rand_interp", "rand_interp?", "rand?",
- "read_frame", "read_hook", "read_mix_sample", "read_only", "read_region_sample", "read_sample",
- "readin", "readin?", "recorder_dialog", "rectangular2magnitudes", "rectangular2polar", "redo_edit",
- "redo_channel", "redo_edit", "region2frame", "region2integer", "region2sound_data", "region2vct",
- "region_chans", "region_frames", "region_graph_style", "region_home", "region_maxamp", "region_maxamp_position",
- "region_play_list", "region_position", "region_sample", "region_sampler?", "region_srate", "region?",
- "regions", "remember_sound_state", "remove_from_menu", "report_in_minibuffer", "reset_all_hooks", "reset_button_color",
- "reset_controls", "reset_listener_cursor", "restore_controls", "_reverb_", "reverb_control_decay", "reverb_control_feedback",
- "reverb_control_length", "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds", "reverb_control?",
- "reverse_channel", "reverse_channels", "reverse_envelope", "reverse_selection", "reverse_sound", "revert_sound",
- "right_sample", "ring_modulate", "rms", "rms__gain__balance_gens", "rms_envelope", "rotate_channel",
- "rubber_sound", "run", "sample", "sample2file", "sample2file?", "sample2frame",
- "sampler_at_end?", "sampler_home", "sampler_position", "sampler?", "samples", "samples2seconds",
- "sash_color", "save_controls", "save_dir", "save_edit_history", "save_envelopes", "save_hook",
- "save_listener", "save_macros", "save_mark_properties", "save_marks", "save_mix", "save_mixes",
- "save_region", "save_region_dialog", "save_selection", "save_selection_dialog", "save_sound", "save_sound_as",
- "save_sound_dialog", "save_state", "save_state_file", "save_state_hook", "savitzky_golay_filter", "sawtooth_wave",
- "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope", "scale_mixes", "scale_selection_by",
- "scale_selection_to", "scale_sound", "scale_tempo", "scale_to", "scan_channel", "scan_sound",
- "scanned_synthesis", "scentroid", "script_arg", "script_args", "search_procedure", "seconds2samples",
- "select_all", "select_channel", "select_channel_hook", "select_sound", "select_sound_hook", "selected_channel",
- "selected_data_color", "selected_graph_color", "selected_sound", "selection", "selection2mix", "selection2sound_data",
- "selection_chans", "selection_color", "selection_creates_region", "selection_frames", "selection_maxamp", "selection_maxamp_position",
- "selection_member?", "selection_members", "selection_position", "selection_srate", "selection?", "send_mozilla",
- "set_global_sync", "set_samples", "shepard_tone", "short_file_name", "show_axes", "show_controls",
- "show_disk_space", "show_grid", "show_indices", "show_listener", "show_marks", "show_mix_waveforms",
- "show_selection", "show_selection_transform", "show_smpte_label", "show_sonogram_cursor", "show_transform_peaks", "show_widget",
- "show_y_zero", "silence_all_mixes", "silence_mixes", "sinc_train", "sinc_width", "sine_env_channel",
- "sine_ramp", "singer", "smooth_channel", "smooth_selection", "smooth_sound", "SMS_synthesis",
- "snap_mark_to_beat", "snap_mix_to_beat", "snd2sample", "snd2sample?", "snd_color", "snd_error",
- "snd_error_hook", "snd_font", "snd_gcs", "snd_help", "snd_hooks", "_snd_opened_sound_",
- "snd_print", "snd_spectrum", "snd_tempnam", "snd_url", "snd_urls", "snd_version",
- "snd_warning", "snd_warning_hook", "sndwarp", "sound2amp_env", "sound2frame", "sound2integer",
- "sound2sound_data", "sound_data_", "sound_data_", "sound_data2file", "sound_data2frame", "sound_data2sound",
- "sound_data2sound_data", "sound_data2vct", "sound_data_add!", "sound_data_chans", "sound_data_copy", "sound_data_fill!",
- "sound_data_length", "sound_data_maxamp", "sound_data_multiply!", "sound_data_offset!", "sound_data_peak", "sound_data_ref",
- "sound_data_reverse!", "sound_data_scale!", "sound_data_set!", "sound_data?", "sound_file_extensions", "sound_file?",
- "sound_files_in_directory", "sound_interp", "sound_let", "sound_loop_info", "sound_properties", "sound_property",
- "sound_widgets", "sound?", "soundfont_info", "sounds", "spectral_interpolation", "spectral_polynomial",
- "spectro_hop", "spectro_x_angle", "spectro_x_scale", "spectro_y_angle", "spectro_y_scale", "spectro_z_angle",
- "spectro_z_scale", "spectrum", "spectrum2coeffs", "spectrum_end", "spectrum_start", "speed_control",
- "speed_control_bounds", "speed_control_style", "speed_control_tones", "square_wave", "square_wave?", "squelch_update",
- "squelch_vowels", "srate", "src", "src_channel", "src_duration", "src_mixes",
- "src_selection", "src_sound", "src?", "ssb_am", "ssb_am?", "ssb_bank",
- "ssb_bank_env", "ssb_fm", "start_hook", "start_playing", "start_playing_hook", "start_playing_selection_hook",
- "start_progress_report", "start_waterfall", "stereo2mono", "stop_dac_hook", "stop_player", "stop_playing",
- "stop_playing_hook", "stop_playing_selection_hook", "stretch_envelope", "superimpose_ffts", "swap_channels", "swap_selection_channels",
- "sync", "sync_all", "sync_max", "syncd_marks", "table_lookup", "table_lookup?",
- "tap", "telephone", "temp_dir", "text_focus_color", "time_graph_hook", "time_graph_style",
- "time_graph_type", "time_graph?", "tiny_font", "tracking_cursor_style", "transform2integer", "transform2vct",
- "transform_dialog", "transform_frames", "transform_graph_style", "transform_graph_type", "transform_graph?", "transform_normalization",
- "transform_sample", "transform_size", "transform_type", "transform?", "transpose_mixes", "trap_segfault",
- "triangle_wave", "triangle_wave?", "tubular_bell", "two_pole", "two_pole?", "two_zero",
- "two_zero?", "unbind_key", "unclip_channel", "undo", "undo_channel", "undo_edit",
- "undo_hook", "update_graphs", "update_hook", "update_lisp_graph", "update_sound", "update_time_graph",
- "update_transform_graph", "user_interface_extensions", "variable_display", "variable_graph?", "vct", "vct_multiply",
- "vct_add", "vct2channel", "vct2file", "vct2frame", "vct2list", "vct2sound_data",
- "vct2string", "vct2vector", "vct_add!", "vct_copy", "vct_fill!", "vct_length",
- "vct_map!", "vct_move!", "vct_multiply!", "vct_offset!", "vct_peak", "vct_polynomial",
- "vct_ref", "vct_reverse!", "vct_scale!", "vct_set!", "vct_subseq", "vct_subtract!",
- "vct?", "vector2vct", "verbose_cursor", "view_files_amp", "view_files_amp_env", "view_files_dialog",
- "view_files_files", "view_files_select_hook", "view_files_selected_files", "view_files_sort", "view_files_speed", "view_files_speed_style",
- "view_mixes_dialog", "view_regions_dialog", "view_sound", "voice_physical_model", "voiced2unvoiced", "volterra_filter",
- "wave_train", "wave_train?", "wavelet_type", "waveshaping_voice", "wavo_hop", "wavo_trace",
- "weighted_moving_average", "widget_position", "widget_size", "widget_text", "window_height", "window_property",
- "window_property_changed_hook", "window_samples", "window_width", "window_x", "window_y", "with_background_processes",
- "with_file_monitor", "with_gl", "with_inset_graph", "with_local_hook", "with_marked_sound", "with_mix_tags",
- "with_mixed_sound", "with_mixed_sound2notelist", "with_pointer_focus", "with_relative_panes", "with_reopen_menu", "with_sound",
- "with_temp_sound", "with_temporary_selection", "with_threaded_channels", "with_threaded_sound", "with_tracking_cursor", "with_verbose_cursor",
- "x2position", "x_axis_label", "x_axis_style", "x_bounds", "x_position_slider", "x_zoom_slider",
- "xramp_channel", "y2position", "y_axis_label", "y_bounds", "y_position_slider", "y_zoom_slider",
- "z_transform", "zero_pad", "zip_sound", "zipper", "zoom_color", "zoom_focus_style"};
+ "*#readers*", "abort", "add_amp_controls", "add_colormap", "add_comment", "add_directory_to_view_files_list",
+ "add_file_filter", "add_file_sorter", "add_file_to_view_files_list", "add_mark", "add_mark_pane", "add_player",
+ "add_sound_file_extension", "add_source_file_extension", "add_to_main_menu", "add_to_menu", "add_tooltip", "add_transform",
+ "add_watcher", "additive_synthesis", "after_apply_controls_hook", "after_edit_hook", "after_graph_hook", "after_lisp_graph_hook",
+ "after_open_hook", "after_save_as_hook", "after_save_state_hook", "after_transform_hook", "all_pass", "all_pass?",
+ "amp_control", "amp_control_bounds", "amplitude_modulate", "analyse_ladspa", "any_env_channel", "append_sound",
+ "apply_controls", "apply_ladspa", "array2file", "array_interp", "as_one_edit", "ask_before_overwrite",
+ "asymmetric_fm", "asymmetric_fm?", "audio_input_device", "audio_output_device", "auto_resize", "auto_save",
+ "auto_update", "auto_update_interval", "autocorrelate", "axis_color", "axis_info", "axis_label_font",
+ "axis_numbers_font", "background_gradient", "bad_header_hook", "bagpipe", "basic_color", "beats_per_measure",
+ "beats_per_minute", "before_close_hook", "before_exit_hook", "before_save_as_hook", "before_save_state_hook", "before_transform_hook",
+ "bessel_filters", "bigbird", "binary_files", "bind_key", "bird", "bold_peaks_font",
+ "bomb", "break", "brown_noise", "butterworth_filters", "c_g!", "c_g?",
+ "call_in", "cascade2canonical", "chain_dsps", "channel2vct", "channel_amp_envs", "channel_data",
+ "channel_envelope", "channel_polynomial", "channel_properties", "channel_property", "channel_rms", "channel_style",
+ "channel_sync", "channel_widgets", "channels", "channels_equal?", "Channels_separate", "channels_?",
+ "chans", "chebyshev_filters", "check_for_unsaved_edits", "check_mix_tags", "clean_channel", "clean_sound",
+ "clear_array", "clear_listener", "clear_minibuffer", "clear_selection", "clip_hook", "clipping",
+ "clm_channel", "clm_load", "clone_sound_as", "close_hook", "close_sound", "color2list",
+ "color_cutoff", "color_hook", "color_inverted", "color_mixes", "color_orientation_dialog", "color_scale",
+ "color?", "colormap", "colormap2integer", "colormap_name", "colormap_ref", "colormap_size",
+ "colormap?", "comb", "comb?", "comment", "compand_channel", "compand_sound",
+ "concatenate_envelopes", "continue_frame2file", "continue_sample2file", "contrast_channel", "contrast_control", "contrast_control_amp",
+ "contrast_control_bounds", "contrast_control?", "contrast_enhancement", "contrast_sound", "controls2channel", "convolution",
+ "convolution_reverb", "convolve", "convolve_files", "convolve_selection_with", "convolve_with", "convolve?",
+ "copy_frame_reader", "copy_sampler", "correlate", "count_matches", "create_ssb_dialog", "cross_fade__amplitude_",
+ "cross_fade__frequency_domain_", "cross_synthesis", "Current_edit_position", "current_font", "cursor", "cursor_color",
+ "cursor_follows_play", "Cursor_in_view", "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style",
+ "cursor_update_interval", "dac_combines_channels", "dac_hook", "dac_size", "data_color", "data_format",
+ "data_location", "data_size", "db2linear", "def_clm_struct", "default_output_chans", "default_output_data_format",
+ "default_output_header_type", "default_output_srate", "defgenerator", "define_envelope", "define_selection_via_marks", "definstrument",
+ "defvar", "degrees2radians", "delay", "delay_channel_mixes", "delay_tick", "delay?",
+ "delete_colormap", "delete_file_filter", "delete_file_sorter", "delete_mark", "delete_marks", "delete_sample",
+ "delete_samples", "delete_selection", "delete_selection_and_smooth", "delete_transform", "delete_watcher", "describe_hook",
+ "describe_mark", "dialog_widgets", "disable_control_panel", "display_bark_fft", "display_db", "display_edits",
+ "display_scanned_synthesis", "dissolve_fade", "dither_channel", "dither_sound", "dlocsig", "do?",
+ "doit_again_button_color", "doit_button_color", "dot_product", "dot_size", "draw_axes", "draw_dot",
+ "draw_dots", "draw_line", "draw_lines", "draw_mark_hook", "draw_mix_hook", "draw_string",
+ "drop_sites", "drop_hook", "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook",
+ "edit_list2function", "edit_position", "edit_properties", "edit_property", "edit_tree", "edits",
+ "edot_product", "elliptic_filters", "emacs_style_save_as", "env", "env_any", "env_channel",
+ "env_channel_with_base", "env_expt_channel", "env_interp", "env_mixes", "env_selection", "env_sound",
+ "env_sound_interp", "env?", "enved_base", "enved_clip?", "enved_dialog", "enved_envelope",
+ "enved_filter", "enved_filter_order", "enved_hook", "enved_in_dB", "enved_power", "enved_style",
+ "enved_target", "enved_wave?", "enved_waveform_color", "envelope_interp", "enveloped_mix", "eps_bottom_margin",
+ "eps_file", "eps_left_margin", "eps_size", "_error_hook_", "_error_info_", "eval_between_marks",
+ "eval_over_selection", "every_sample?", "exit", "exit_hook", "expand_control", "expand_control_bounds",
+ "expand_control_hop", "expand_control_jitter", "expand_control_length", "expand_control_ramp", "expand_control?", "explode_sf2",
+ "exponentially_weighted_moving_average", "extract_channel", "extract_channels", "_features_", "feedback_fm", "fft",
+ "fft_sizes", "fft_edit", "fft_log_frequency", "fft_log_magnitude", "fft_smoother", "fft_squelch",
+ "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database", "file2array",
+ "file2frame", "file2frame?", "file2sample", "file2sample?", "file2sound_data", "file2vct",
+ "file_name", "fill_polygon", "fill_rectangle", "filter", "filter_channel", "filter_control_coeffs",
+ "filter_control_envelope", "filter_control_in_dB", "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color", "filter_control?",
+ "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb", "filtered_comb?",
+ "find_channel", "find_dialog", "find_mark", "find_mix", "find_sound", "finish_progress_report",
+ "fir_filter", "fir_filter?", "firmant", "firmant?", "flocsig", "flocsig?",
+ "flute_model", "fm_bell", "fm_drum", "fm_noise", "fm_talker", "fm_trumpet",
+ "fm_violin", "fm_voice", "focus_widget", "FOF_synthesis", "for_each_child", "for_each_sound_file",
+ "Forbidden_Planet", "foreground_color", "forget_region", "formant", "formant?", "Fourier_transform",
+ "fractional_fourier_transform", "frame", "frame_multiply", "frame_add", "frame2file", "frame2file?",
+ "frame2frame", "frame2list", "frame2sample", "frame2sound", "frame2sound_data", "frame2vct",
+ "frame_copy", "frame_reader_at_end?", "frame_reader_chans", "frame_reader_home", "frame_reader_position", "frame_reader?",
+ "frame_ref", "frame_reverse!", "frame_set!", "frame?", "frames", "free_frame_reader",
+ "free_player", "free_sampler", "freeverb", "fullmix", "gaussian_distribution", "gc_off",
+ "gc_on", "gl_graph2ps", "glSpectrogram", "goertzel", "goto_listener_end", "grani",
+ "granulate", "granulate?", "granulated_sound_interp", "graph", "graph2ps", "graph_color",
+ "graph_cursor", "graph_data", "graph_hook", "Graph_lines", "graph_style", "graphic_equalizer",
+ "graphs_horizontal", "green_noise", "green_noise_interp", "grid_density", "harmonicizer", "Hartley_transform",
+ "header_type", "hello_dentist", "help_button_color", "help_dialog", "help_hook", "hide_widget",
+ "highlight_color", "hilbert_transform", "hook_member", "html_dir", "html_program", "hz2radians",
+ "iir_filter", "iir_filter?", "call_in", "in_any", "ina", "inb",
+ "info_dialog", "init_ladspa", "initial_graph_hook", "insert_channel", "insert_file_dialog", "insert_frame",
+ "insert_region", "insert_sample", "insert_samples", "insert_selection", "insert_silence", "insert_sound",
+ "insert_sound_data", "insert_vct", "instruments", "integer2colormap", "integer2mark", "integer2mix",
+ "integer2region", "integer2sound", "integer2transform", "integrate_envelope", "jc_reverb", "just_sounds",
+ "kalman_filter_channel", "key", "key_binding", "key_press_hook", "ladspa_descriptor", "ladspa_dir",
+ "left_sample", "level_meters", "linear2db", "linear_src_channel", "lisp_graph_hook", "lisp_graph_style",
+ "lisp_graph?", "list2vct", "list_ladspa", "listener_click_hook", "listener_color", "listener_font",
+ "listener_prompt", "listener_selection", "listener_text_color", "little_endian?", "_load_hook_", "_load_path_",
+ "locsig", "locsig_ref", "locsig_reverb_ref", "locsig_reverb_set!", "locsig_set!", "locsig_type",
+ "locsig?", "log_freq_start", "loop_between_marks", "lpc_coeffs", "lpc_predict", "main_menu",
+ "main_widgets", "make_all_pass", "make_asymmetric_fm", "make_bandpass", "make_bandstop", "make_biquad",
+ "make_birds", "make_color", "make_comb", "make_convolve", "make_delay", "make_differentiator",
+ "make_env", "make_fft_window", "make_file2frame", "make_file2sample", "make_filter", "make_filtered_comb",
+ "make_fir_filter", "make_firmant", "make_flocsig", "make_formant", "make_frame", "make_frame!",
+ "make_frame2file", "make_frame_reader", "make_granulate", "make_graph_data", "make_hidden_controls_dialog", "make_highpass",
+ "make_hilbert_transform", "make_iir_filter", "make_locsig", "make_lowpass", "make_mix_sampler", "make_mixer",
+ "make_mixer!", "make_move_sound", "make_moving_autocorrelation", "make_moving_average", "make_moving_fft", "make_moving_pitch",
+ "make_moving_scentroid", "make_moving_spectrum", "make_ncos", "make_noid", "make_notch", "make_nrxycos",
+ "make_nrxysin", "make_nsin", "make_one_pole", "make_one_zero", "make_oscil", "make_phase_vocoder",
+ "make_pixmap", "make_player", "make_polyoid", "make_polyshape", "make_polywave", "make_pulse_train",
+ "make_rand", "make_rand_interp", "make_readin", "make_region", "make_region_frame_reader", "make_region_sampler",
+ "make_sample2file", "make_sampler", "make_sawtooth_wave", "make_scalar_mixer", "make_selection", "make_selection_frame_reader",
+ "make_snd2sample", "make_sound_box", "make_sound_data", "make_square_wave", "make_src", "make_ssb_am",
+ "make_sync_frame_reader", "make_table_lookup", "make_triangle_wave", "make_two_pole", "make_two_zero", "make_variable_display",
+ "make_variable_graph", "make_vct", "make_wave_train", "map_channel", "map_sound", "map_sound_files",
+ "maracas", "mark2integer", "mark_click_hook", "mark_color", "mark_drag_hook", "mark_drag_triangle_hook",
+ "mark_explode", "mark_home", "mark_hook", "mark_loops", "mark_name", "mark_name2id",
+ "mark_properties", "mark_property", "mark_sample", "mark_sync", "mark_sync_max", "mark_tag_height",
+ "mark_tag_width", "mark?", "marks", "match_sound_files", "max_envelope", "max_regions",
+ "max_transform_peaks", "max_virtual_ptrees", "maxamp", "maxamp_position", "menu_widgets", "menus__optional",
+ "min_dB", "minibuffer_history_length", "mix", "mix2integer", "mix2vct", "mix_amp",
+ "mix_amp_env", "mix_channel", "mix_click_hook", "mix_color", "mix_dialog_mix", "mix_drag_hook",
+ "mix_file_dialog", "mix_frame", "mix_home", "mix_length", "mix_maxamp", "mix_move_sound",
+ "mix_name", "mix_name2id", "mix_position", "mix_properties", "mix_property", "mix_region",
+ "mix_release_hook", "mix_sampler?", "mix_selection", "mix_sound", "mix_sound_data", "mix_speed",
+ "mix_sync", "mix_sync_max", "mix_tag_height", "mix_tag_width", "mix_tag_y", "mix_vct",
+ "mix_waveform_height", "mix?", "mixer", "mixer_multiply", "mixer_as_matrix", "mixer_add",
+ "mixer_copy", "mixer_determinant", "mixer_inverse", "mixer_poly", "mixer_ref", "mixer_set!",
+ "mixer_solve", "mixer_transpose", "mixer?", "mixes", "mono2stereo", "moog_filter",
+ "mouse_click_hook", "mouse_drag_hook", "mouse_enter_graph_hook", "mouse_enter_label_hook", "mouse_enter_listener_hook", "mouse_enter_text_hook",
+ "mouse_leave_graph_hook", "mouse_leave_label_hook", "mouse_leave_listener_hook", "mouse_leave_text_hook", "mouse_press_hook", "move_locsig",
+ "move_mixes", "move_sound", "move_sound?", "moving_autocorrelation", "moving_autocorrelation?", "moving_average",
+ "moving_average?", "moving_fft", "moving_fft?", "moving_length", "moving_max", "moving_pitch",
+ "moving_pitch?", "moving_rms", "moving_scentroid", "moving_scentroid?", "moving_spectrum", "moving_spectrum?",
+ "moving_sum", "mpg", "multiply_arrays", "mus_alsa_buffer_size", "mus_alsa_buffers", "mus_alsa_capture_device",
+ "mus_alsa_device", "mus_alsa_playback_device", "mus_alsa_squelch_warning", "mus_array_print_length", "mus_audio_close", "mus_audio_describe",
+ "mus_audio_open_input", "mus_audio_open_output", "mus_audio_read", "mus_audio_write", "mus_bytes_per_sample", "mus_channel",
+ "mus_channels", "mus_chebyshev_tu_sum", "mus_clipping", "mus_close", "mus_data", "mus_data_format2string",
+ "mus_data_format_name", "mus_describe", "mus_error_hook", "mus_error_type2string", "mus_expand_filename", "mus_feedback",
+ "mus_feedforward", "mus_fft", "mus_file_buffer_size", "mus_file_clipping", "mus_file_name", "mus_file_prescaler",
+ "mus_float_equal_fudge_factor", "mus_frequency", "mus_generator?", "mus_header_raw_defaults", "mus_header_type2string", "mus_header_type_name",
+ "mus_hop", "mus_increment", "mus_input?", "mus_interp_type", "mus_interpolate", "mus_length",
+ "mus_location", "mus_max_malloc", "mus_max_table_size", "mus_mix", "mus_name", "mus_offset",
+ "mus_order", "mus_oss_set_buffers", "Mus_out_format", "mus_output?", "mus_phase", "mus_prescaler",
+ "mus_ramp", "mus_random", "mus_reset", "mus_run", "mus_safety", "mus_scaler",
+ "mus_sound_chans", "mus_sound_close_input", "mus_sound_close_output", "mus_sound_comment", "mus_sound_data_format", "mus_sound_data_location",
+ "mus_sound_datum_size", "mus_sound_duration", "mus_sound_forget", "mus_sound_frames", "mus_sound_header_type", "mus_sound_length",
+ "mus_sound_loop_info", "mus_sound_mark_info", "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_open_input", "mus_sound_open_output",
+ "mus_sound_prune", "mus_sound_read", "mus_sound_reopen_output", "mus_sound_report_cache", "mus_sound_samples", "mus_sound_seek_frame",
+ "mus_sound_srate", "mus_sound_type_specifier", "mus_sound_write", "mus_sound_write_date", "mus_srate", "mus_width",
+ "mus_xcoeff", "mus_xcoeffs", "mus_ycoeff", "mus_ycoeffs", "name_click_hook", "ncos",
+ "ncos?", "new_sound", "new_sound_dialog", "new_sound_hook", "new_widget_hook", "next_frame",
+ "next_sample", "noid", "normalize_channel", "normalize_envelope", "normalize_partials", "normalize_sound",
+ "normalized_mix", "notch", "notch_channel", "notch_out_rumble_and_hiss", "notch_selection", "notch_sound",
+ "notch?", "nrev", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?",
+ "nsin", "nsin?", "offset_channel", "offset_sound", "one_pole", "one_pole?",
+ "one_zero", "one_zero?", "open_file_dialog", "open_file_dialog_directory", "open_hook", "open_next_file_in_directory",
+ "open_raw_sound", "open_raw_sound_hook", "open_sound", "optimization", "optimization_hook", "orientation_hook",
+ "oscil", "oscil?", "oscilloscope_dialog", "out_any", "outa", "_output_",
+ "output_comment_hook", "output_name_hook", "overlay_rms_env", "pad_channel", "pad_marks", "pad_sound",
+ "pan_mix", "pan_mix_vct", "partials2polynomial", "partials2wave", "pausing", "peak_env_dir",
+ "peak_env_hook", "peaks", "peaks_font", "phase_partials2wave", "phase_vocoder", "phase_vocoder?",
+ "piano_model", "pink_noise", "place_sound", "play", "play_between_marks", "play_hook",
+ "play_mixes", "play_sines", "play_syncd_marks", "player_home", "player?", "players",
+ "playing", "pluck", "polar2rectangular", "polynomial", "polynomial_operations", "polyoid",
+ "polyoid_env", "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?",
+ "position2x", "position2y", "position_color", "power_env", "preferences_dialog", "previous_frame",
+ "previous_sample", "print_dialog", "print_hook", "print_length", "profile", "progress_report",
+ "prompt_in_minibuffer", "ptree_channel", "pulse_train", "pulse_train?", "pushed_button_color", "quit_button_color",
+ "radians2degrees", "radians2hz", "ramp_channel", "rand", "rand_interp", "rand_interp?",
+ "rand?", "read_frame", "read_hook", "read_mix_sample", "read_only", "read_region_sample",
+ "read_sample", "readin", "readin?", "recorder_dialog", "rectangular2magnitudes", "rectangular2polar",
+ "redo_edit", "redo_channel", "redo_edit", "region2frame", "region2integer", "region2sound_data",
+ "region2vct", "region_chans", "region_frames", "region_graph_style", "region_home", "region_maxamp",
+ "region_maxamp_position", "region_play_list", "region_position", "region_sample", "region_sampler?", "region_srate",
+ "region?", "regions", "remember_sound_state", "remove_from_menu", "report_in_minibuffer", "reset_all_hooks",
+ "reset_button_color", "reset_controls", "reset_listener_cursor", "restore_controls", "_reverb_", "reverb_control_decay",
+ "reverb_control_feedback", "reverb_control_length", "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds",
+ "reverb_control?", "reverse_channel", "reverse_channels", "reverse_envelope", "reverse_selection", "reverse_sound",
+ "revert_sound", "right_sample", "ring_modulate", "rms", "rms__gain__balance_gens", "rms_envelope",
+ "rotate_channel", "rubber_sound", "run", "sample", "sample2file", "sample2file?",
+ "sample2frame", "sampler_at_end?", "sampler_home", "sampler_position", "sampler?", "samples",
+ "samples2seconds", "sash_color", "save_controls", "save_dir", "save_edit_history", "save_envelopes",
+ "save_hook", "save_listener", "save_macros", "save_mark_properties", "save_marks", "save_mix",
+ "save_mixes", "save_region", "save_region_dialog", "save_selection", "save_selection_dialog", "save_sound",
+ "save_sound_as", "save_sound_dialog", "save_state", "save_state_file", "save_state_hook", "savitzky_golay_filter",
+ "sawtooth_wave", "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope", "scale_mixes",
+ "scale_selection_by", "scale_selection_to", "scale_sound", "scale_tempo", "scale_to", "scan_channel",
+ "scan_sound", "scanned_synthesis", "scentroid", "script_arg", "script_args", "search_procedure",
+ "seconds2samples", "select_all", "select_channel", "select_channel_hook", "select_sound", "select_sound_hook",
+ "selected_channel", "selected_data_color", "selected_graph_color", "selected_sound", "selection", "selection2mix",
+ "selection2sound_data", "selection_chans", "selection_color", "selection_creates_region", "selection_frames", "selection_maxamp",
+ "selection_maxamp_position", "selection_member?", "selection_members", "selection_position", "selection_srate", "selection?",
+ "send_mozilla", "set_global_sync", "set_samples", "shepard_tone", "short_file_name", "show_axes",
+ "show_controls", "show_disk_space", "show_grid", "show_indices", "show_listener", "show_marks",
+ "show_mix_waveforms", "show_selection", "show_selection_transform", "show_smpte_label", "show_sonogram_cursor", "show_transform_peaks",
+ "show_widget", "show_y_zero", "silence_all_mixes", "silence_mixes", "sinc_train", "sinc_width",
+ "sine_env_channel", "sine_ramp", "singer", "smooth_channel", "smooth_selection", "smooth_sound",
+ "SMS_synthesis", "snap_mark_to_beat", "snap_mix_to_beat", "snd2sample", "snd2sample?", "snd_color",
+ "snd_error", "snd_error_hook", "snd_font", "snd_gcs", "snd_help", "snd_hooks",
+ "_snd_opened_sound_", "snd_print", "snd_spectrum", "snd_tempnam", "snd_url", "snd_urls",
+ "snd_version", "snd_warning", "snd_warning_hook", "sndwarp", "sound2amp_env", "sound2frame",
+ "sound2integer", "sound2sound_data", "sound_data_", "sound_data_", "sound_data2file", "sound_data2frame",
+ "sound_data2sound", "sound_data2sound_data", "sound_data2vct", "sound_data_add!", "sound_data_chans", "sound_data_copy",
+ "sound_data_fill!", "sound_data_length", "sound_data_maxamp", "sound_data_multiply!", "sound_data_offset!", "sound_data_peak",
+ "sound_data_ref", "sound_data_reverse!", "sound_data_scale!", "sound_data_set!", "sound_data?", "sound_file_extensions",
+ "sound_file?", "sound_files_in_directory", "sound_interp", "sound_let", "sound_loop_info", "sound_properties",
+ "sound_property", "sound_widgets", "sound?", "soundfont_info", "sounds", "spectral_interpolation",
+ "spectral_polynomial", "spectro_hop", "spectro_x_angle", "spectro_x_scale", "spectro_y_angle", "spectro_y_scale",
+ "spectro_z_angle", "spectro_z_scale", "spectrum", "spectrum2coeffs", "spectrum_end", "spectrum_start",
+ "speed_control", "speed_control_bounds", "speed_control_style", "speed_control_tones", "square_wave", "square_wave?",
+ "squelch_update", "squelch_vowels", "srate", "src", "src_channel", "src_duration",
+ "src_mixes", "src_selection", "src_sound", "src?", "ssb_am", "ssb_am?",
+ "ssb_bank", "ssb_bank_env", "ssb_fm", "start_hook", "start_playing", "start_playing_hook",
+ "start_playing_selection_hook", "start_progress_report", "start_waterfall", "stereo2mono", "stop_dac_hook", "stop_player",
+ "stop_playing", "stop_playing_hook", "stop_playing_selection_hook", "stretch_envelope", "superimpose_ffts", "swap_channels",
+ "swap_selection_channels", "sync", "sync_all", "sync_max", "syncd_marks", "table_lookup",
+ "table_lookup?", "tap", "telephone", "temp_dir", "text_focus_color", "time_graph_hook",
+ "time_graph_style", "time_graph_type", "time_graph?", "tiny_font", "_trace_hook_", "tracking_cursor_style",
+ "transform2integer", "transform2vct", "transform_dialog", "transform_frames", "transform_graph_style", "transform_graph_type",
+ "transform_graph?", "transform_normalization", "transform_sample", "transform_size", "transform_type", "transform?",
+ "transpose_mixes", "trap_segfault", "triangle_wave", "triangle_wave?", "tubular_bell", "two_pole",
+ "two_pole?", "two_zero", "two_zero?", "unbind_key", "_unbound_variable_hook_", "unclip_channel",
+ "undo", "undo_channel", "undo_edit", "undo_hook", "update_graphs", "update_hook",
+ "update_lisp_graph", "update_sound", "update_time_graph", "update_transform_graph", "user_interface_extensions", "variable_display",
+ "variable_graph?", "vct", "vct_multiply", "vct_add", "vct2channel", "vct2file",
+ "vct2frame", "vct2list", "vct2sound_data", "vct2string", "vct2vector", "vct_add!",
+ "vct_copy", "vct_fill!", "vct_length", "vct_map!", "vct_move!", "vct_multiply!",
+ "vct_offset!", "vct_peak", "vct_polynomial", "vct_ref", "vct_reverse!", "vct_scale!",
+ "vct_set!", "vct_subseq", "vct_subtract!", "vct?", "vector2vct", "_vector_print_length_",
+ "verbose_cursor", "view_files_amp", "view_files_amp_env", "view_files_dialog", "view_files_files", "view_files_select_hook",
+ "view_files_selected_files", "view_files_sort", "view_files_speed", "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog",
+ "view_sound", "voice_physical_model", "voiced2unvoiced", "volterra_filter", "wave_train", "wave_train?",
+ "wavelet_type", "waveshaping_voice", "wavo_hop", "wavo_trace", "weighted_moving_average", "widget_position",
+ "widget_size", "widget_text", "window_height", "window_property", "window_property_changed_hook", "window_samples",
+ "window_width", "window_x", "window_y", "with_background_processes", "with_file_monitor", "with_gl",
+ "with_inset_graph", "with_local_hook", "with_marked_sound", "with_mix_tags", "with_mixed_sound", "with_mixed_sound2notelist",
+ "with_pointer_focus", "with_relative_panes", "with_reopen_menu", "with_sound", "with_temp_sound", "with_temporary_selection",
+ "with_threaded_channels", "with_threaded_sound", "with_tracking_cursor", "with_verbose_cursor", "x2position", "x_axis_label",
+ "x_axis_style", "x_bounds", "x_position_slider", "x_zoom_slider", "xramp_channel", "y2position",
+ "y_axis_label", "y_bounds", "y_position_slider", "y_zoom_slider", "z_transform", "zero_pad",
+ "zip_sound", "zipper", "zoom_color", "zoom_focus_style"};
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
static const char **help_names = NULL;
#endif
static const char *help_urls[HELP_NAMES_SIZE] = {
- "abort", "sndscm.html#addampcontrols", "extsnd.html#addcolormap", "extsnd.html#addcomment",
- "extsnd.html#adddirectorytoviewfileslist", "extsnd.html#addfilefilter", "extsnd.html#addfilesorter", "extsnd.html#addfiletoviewfileslist",
- "extsnd.html#addmark", "sndscm.html#addmarkpane", "extsnd.html#addplayer", "extsnd.html#addsoundfileextension",
- "extsnd.html#addsourcefileextension", "extsnd.html#addtomainmenu", "extsnd.html#addtomenu", "sndscm.html#addtooltip",
- "extsnd.html#addtransform", "extsnd.html#addwatcher", "sndscm.html#spectra", "extsnd.html#afterapplycontrolshook",
- "extsnd.html#afteredithook", "extsnd.html#aftergraphhook", "extsnd.html#afterlispgraphhook", "extsnd.html#afteropenhook",
- "extsnd.html#aftersaveashook", "extsnd.html#aftersavestatehook", "extsnd.html#aftertransformhook", "sndclm.html#all-pass",
- "sndclm.html#all-pass?", "extsnd.html#ampcontrol", "extsnd.html#ampcontrolbounds", "sndclm.html#amplitude-modulate",
- "grfsnd.html#analyseladspa", "sndscm.html#anyenvchannel", "extsnd.html#appendsound", "extsnd.html#applycontrols",
- "grfsnd.html#applyladspa", "sndclm.html#arraytofile", "sndclm.html#array-interp", "extsnd.html#asoneedit",
- "extsnd.html#askbeforeoverwrite", "sndclm.html#asymmetric-fm", "sndclm.html#asymmetric-fm?", "extsnd.html#audioinputdevice",
- "extsnd.html#audiooutputdevice", "extsnd.html#autoresize", "sndscm.html#autosavedoc", "extsnd.html#autoupdate",
- "extsnd.html#autoupdateinterval", "sndclm.html#autocorrelate", "extsnd.html#axiscolor", "extsnd.html#axisinfo",
- "extsnd.html#axislabelfont", "extsnd.html#axisnumbersfont", "extsnd.html#backgroundgradient", "extsnd.html#badheaderhook",
- "sndscm.html#bagpipe", "extsnd.html#basiccolor", "extsnd.html#beatspermeasure", "extsnd.html#beatsperminute",
- "extsnd.html#beforeclosehook", "extsnd.html#beforeexithook", "extsnd.html#beforesaveashook", "extsnd.html#beforesavestatehook",
- "extsnd.html#beforetransformhook", "sndscm.html#analogfilterdoc", "sndscm.html#bigbird", "extsnd.html#bindkey",
- "sndscm.html#bird", "extsnd.html#boldpeaksfont", "extsnd.html#bomb", "extsnd.html#break",
- "sndclm.html#brown-noise", "sndscm.html#analogfilterdoc", "extsnd.html#cgx", "extsnd.html#cgp",
- "extsnd.html#callin", "sndscm.html#cascadetocanonical", "sndscm.html#chaindsps", "extsnd.html#channeltovct",
- "extsnd.html#channelampenvs", "extsnd.html#channeldata", "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial",
- "extsnd.html#channelproperties", "extsnd.html#channelproperty", "sndscm.html#channelrms", "extsnd.html#channelstyle",
- "sndscm.html#channelsync", "extsnd.html#channelwidgets", "extsnd.html#channels", "sndscm.html#channelsequal",
- "extsnd.html#channelstyleconstants", "sndscm.html#channels=", "extsnd.html#chans", "sndscm.html#analogfilterdoc",
- "sndscm.html#checkforunsavededits", "sndscm.html#checkmixtags", "sndscm.html#cleanchannel", "sndscm.html#cleansound",
- "sndclm.html#clear-array", "extsnd.html#clearlistener", "extsnd.html#clearminibuffer", "sndscm.html#clearselection",
- "extsnd.html#cliphook", "extsnd.html#clipping", "extsnd.html#clmchannel", "sndscm.html#clmload",
- "extsnd.html#clonesoundas", "extsnd.html#closehook", "extsnd.html#closesound", "extsnd.html#colortolist",
- "extsnd.html#colorcutoff", "extsnd.html#colorhook", "extsnd.html#colorinverted", "sndscm.html#colormixes",
- "extsnd.html#colororientationdialog", "extsnd.html#colorscale", "extsnd.html#colorp", "extsnd.html#colormap",
- "extsnd.html#colormaptointeger", "extsnd.html#colormapname", "extsnd.html#colormapref", "extsnd.html#colormapsize",
- "extsnd.html#colormapp", "sndclm.html#comb", "sndclm.html#comb?", "extsnd.html#comment",
- "sndscm.html#compandchannel", "sndscm.html#compandsound", "sndscm.html#concatenateenvelopes", "sndclm.html#continue-frametofile",
- "sndclm.html#continue-sampletofile", "sndscm.html#contrastchannel", "extsnd.html#contrastcontrol", "extsnd.html#contrastcontrolamp",
- "extsnd.html#contrastcontrolbounds", "extsnd.html#contrastcontrolp", "sndclm.html#contrast-enhancement", "sndscm.html#contrastsound",
- "extsnd.html#controlstochannel", "sndclm.html#convolution", "extsnd.html#convolvewith", "sndclm.html#convolve",
- "sndclm.html#convolvefiles", "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith", "sndclm.html#convolve?",
- "sndscm.html#copyframereader", "extsnd.html#copysampler", "sndclm.html#correlate", "extsnd.html#countmatches",
- "sndscm.html#createssbdialog", "sndscm.html#mixdoc", "sndscm.html#fadedoc", "sndscm.html#crosssynthesis",
- "extsnd.html#currenteditposition", "extsnd.html#currentfont", "extsnd.html#cursor", "extsnd.html#cursorcolor",
- "extsnd.html#cursorfollowsplay", "extsnd.html#cursorchoices", "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition",
- "extsnd.html#cursorsize", "extsnd.html#cursorstyle", "extsnd.html#cursorupdateinterval", "extsnd.html#dacfolding",
- "extsnd.html#dachook", "extsnd.html#dacsize", "extsnd.html#datacolor", "extsnd.html#dataformat",
- "extsnd.html#datalocation", "extsnd.html#datasize", "sndclm.html#dbtolinear", "sndscm.html#def-clm-struct",
- "extsnd.html#defaultoutputchans", "extsnd.html#defaultoutputdataformat", "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsrate",
- "sndclm.html#defgenerator", "extsnd.html#defineenvelope", "sndscm.html#defineselectionviamarks", "sndscm.html#definstrument",
- "extsnd.html#defvar", "sndclm.html#degreestoradians", "sndclm.html#delay", "sndscm.html#delaychannelmixes",
- "sndclm.html#delaytick", "sndclm.html#delay?", "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter",
- "extsnd.html#deletefilesorter", "extsnd.html#deletemark", "extsnd.html#deletemarks", "extsnd.html#deletesample",
- "extsnd.html#deletesamples", "extsnd.html#deleteselection", "sndscm.html#deleteselectionandsmooth", "extsnd.html#deletetransform",
- "extsnd.html#deletewatcher", "sndscm.html#describehook", "sndscm.html#describemark", "extsnd.html#dialogwidgets",
- "sndscm.html#disablecontrolpanel", "sndscm.html#displaybarkfft", "sndscm.html#displaydb", "extsnd.html#displayedits",
- "sndscm.html#displayscannedsynthesis", "sndscm.html#dissolvefade", "sndscm.html#ditherchannel", "sndscm.html#dithersound",
- "sndscm.html#dlocsig", "sndscm.html#dop", "extsnd.html#doitagainbuttoncolor", "extsnd.html#doitbuttoncolor",
- "sndclm.html#dot-product", "extsnd.html#dotsize", "extsnd.html#drawaxes", "extsnd.html#drawdot",
- "extsnd.html#drawdots", "extsnd.html#drawline", "extsnd.html#drawlines", "extsnd.html#drawmarkhook",
- "extsnd.html#drawmixhook", "extsnd.html#drawstring", "sndscm.html#makedropsite", "extsnd.html#drophook",
- "extsnd.html#duringopenhook", "extsnd.html#editfragment", "extsnd.html#editheaderdialog", "extsnd.html#edithook",
- "extsnd.html#editlisttofunction", "extsnd.html#editposition", "extsnd.html#editproperties", "extsnd.html#editproperty",
- "extsnd.html#edittree", "extsnd.html#edits", "sndclm.html#edot-product", "sndscm.html#analogfilterdoc",
- "sndscm.html#emacsstylesaveas", "sndclm.html#env", "sndclm.html#env-any", "extsnd.html#envchannel",
- "extsnd.html#envchannelwithbase", "sndscm.html#envexptchannel", "sndclm.html#env-interp", "sndscm.html#envmixes",
- "extsnd.html#envselection", "extsnd.html#envsound", "sndscm.html#envsoundinterp", "sndclm.html#env?",
- "extsnd.html#envedbase", "extsnd.html#envedclipping", "extsnd.html#enveddialog", "extsnd.html#envedenvelope",
- "extsnd.html#filterenv", "extsnd.html#filterenvorder", "extsnd.html#envedhook", "extsnd.html#envedin-dB",
- "extsnd.html#envedpower", "extsnd.html#envedstyle", "extsnd.html#envedtarget", "extsnd.html#envedwaving",
- "extsnd.html#envedwaveformcolor", "sndscm.html#envelopeinterp", "sndscm.html#envelopedmix", "extsnd.html#epsbottommargin",
- "extsnd.html#epsfile", "extsnd.html#epsleftmargin", "extsnd.html#epssize", "sndscm.html#evalbetweenmarks",
+ "*#readers*", "extsnd.html#abort", "sndscm.html#addampcontrols", "extsnd.html#addcolormap",
+ "extsnd.html#addcomment", "extsnd.html#adddirectorytoviewfileslist", "extsnd.html#addfilefilter", "extsnd.html#addfilesorter",
+ "extsnd.html#addfiletoviewfileslist", "extsnd.html#addmark", "sndscm.html#addmarkpane", "extsnd.html#addplayer",
+ "extsnd.html#addsoundfileextension", "extsnd.html#addsourcefileextension", "extsnd.html#addtomainmenu", "extsnd.html#addtomenu",
+ "sndscm.html#addtooltip", "extsnd.html#addtransform", "extsnd.html#addwatcher", "sndscm.html#spectra",
+ "extsnd.html#afterapplycontrolshook", "extsnd.html#afteredithook", "extsnd.html#aftergraphhook", "extsnd.html#afterlispgraphhook",
+ "extsnd.html#afteropenhook", "extsnd.html#aftersaveashook", "extsnd.html#aftersavestatehook", "extsnd.html#aftertransformhook",
+ "sndclm.html#all-pass", "sndclm.html#all-pass?", "extsnd.html#ampcontrol", "extsnd.html#ampcontrolbounds",
+ "sndclm.html#amplitude-modulate", "grfsnd.html#analyseladspa", "sndscm.html#anyenvchannel", "extsnd.html#appendsound",
+ "extsnd.html#applycontrols", "grfsnd.html#applyladspa", "sndclm.html#arraytofile", "sndclm.html#array-interp",
+ "extsnd.html#asoneedit", "extsnd.html#askbeforeoverwrite", "sndclm.html#asymmetric-fm", "sndclm.html#asymmetric-fm?",
+ "extsnd.html#audioinputdevice", "extsnd.html#audiooutputdevice", "extsnd.html#autoresize", "sndscm.html#autosavedoc",
+ "extsnd.html#autoupdate", "extsnd.html#autoupdateinterval", "sndclm.html#autocorrelate", "extsnd.html#axiscolor",
+ "extsnd.html#axisinfo", "extsnd.html#axislabelfont", "extsnd.html#axisnumbersfont", "extsnd.html#backgroundgradient",
+ "extsnd.html#badheaderhook", "sndscm.html#bagpipe", "extsnd.html#basiccolor", "extsnd.html#beatspermeasure",
+ "extsnd.html#beatsperminute", "extsnd.html#beforeclosehook", "extsnd.html#beforeexithook", "extsnd.html#beforesaveashook",
+ "extsnd.html#beforesavestatehook", "extsnd.html#beforetransformhook", "sndscm.html#analogfilterdoc", "sndscm.html#bigbird",
+ "sndscm.html#binaryiodoc", "extsnd.html#bindkey", "sndscm.html#bird", "extsnd.html#boldpeaksfont",
+ "extsnd.html#bomb", "extsnd.html#break", "sndclm.html#brown-noise", "sndscm.html#analogfilterdoc",
+ "extsnd.html#cgx", "extsnd.html#cgp", "extsnd.html#callin", "sndscm.html#cascadetocanonical",
+ "sndscm.html#chaindsps", "extsnd.html#channeltovct", "extsnd.html#channelampenvs", "extsnd.html#channeldata",
+ "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial", "extsnd.html#channelproperties", "extsnd.html#channelproperty",
+ "sndscm.html#channelrms", "extsnd.html#channelstyle", "sndscm.html#channelsync", "extsnd.html#channelwidgets",
+ "extsnd.html#channels", "sndscm.html#channelsequal", "extsnd.html#channelstyleconstants", "sndscm.html#channels=",
+ "extsnd.html#chans", "sndscm.html#analogfilterdoc", "sndscm.html#checkforunsavededits", "sndscm.html#checkmixtags",
+ "sndscm.html#cleanchannel", "sndscm.html#cleansound", "sndclm.html#clear-array", "extsnd.html#clearlistener",
+ "extsnd.html#clearminibuffer", "sndscm.html#clearselection", "extsnd.html#cliphook", "extsnd.html#clipping",
+ "extsnd.html#clmchannel", "sndscm.html#clmload", "extsnd.html#clonesoundas", "extsnd.html#closehook",
+ "extsnd.html#closesound", "extsnd.html#colortolist", "extsnd.html#colorcutoff", "extsnd.html#colorhook",
+ "extsnd.html#colorinverted", "sndscm.html#colormixes", "extsnd.html#colororientationdialog", "extsnd.html#colorscale",
+ "extsnd.html#colorp", "extsnd.html#colormap", "extsnd.html#colormaptointeger", "extsnd.html#colormapname",
+ "extsnd.html#colormapref", "extsnd.html#colormapsize", "extsnd.html#colormapp", "sndclm.html#comb",
+ "sndclm.html#comb?", "extsnd.html#comment", "sndscm.html#compandchannel", "sndscm.html#compandsound",
+ "sndscm.html#concatenateenvelopes", "sndclm.html#continue-frametofile", "sndclm.html#continue-sampletofile", "sndscm.html#contrastchannel",
+ "extsnd.html#contrastcontrol", "extsnd.html#contrastcontrolamp", "extsnd.html#contrastcontrolbounds", "extsnd.html#contrastcontrolp",
+ "sndclm.html#contrast-enhancement", "sndscm.html#contrastsound", "extsnd.html#controlstochannel", "sndclm.html#convolution",
+ "extsnd.html#convolvewith", "sndclm.html#convolve", "sndclm.html#convolvefiles", "extsnd.html#convolveselectionwith",
+ "extsnd.html#convolvewith", "sndclm.html#convolve?", "sndscm.html#copyframereader", "extsnd.html#copysampler",
+ "sndclm.html#correlate", "extsnd.html#countmatches", "sndscm.html#createssbdialog", "sndscm.html#mixdoc",
+ "sndscm.html#fadedoc", "sndscm.html#crosssynthesis", "extsnd.html#currenteditposition", "extsnd.html#currentfont",
+ "extsnd.html#cursor", "extsnd.html#cursorcolor", "extsnd.html#cursorfollowsplay", "extsnd.html#cursorchoices",
+ "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition", "extsnd.html#cursorsize", "extsnd.html#cursorstyle",
+ "extsnd.html#cursorupdateinterval", "extsnd.html#dacfolding", "extsnd.html#dachook", "extsnd.html#dacsize",
+ "extsnd.html#datacolor", "extsnd.html#dataformat", "extsnd.html#datalocation", "extsnd.html#datasize",
+ "sndclm.html#dbtolinear", "sndscm.html#def-clm-struct", "extsnd.html#defaultoutputchans", "extsnd.html#defaultoutputdataformat",
+ "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsrate", "sndclm.html#defgenerator", "extsnd.html#defineenvelope",
+ "sndscm.html#defineselectionviamarks", "sndscm.html#definstrument", "extsnd.html#defvar", "sndclm.html#degreestoradians",
+ "sndclm.html#delay", "sndscm.html#delaychannelmixes", "sndclm.html#delaytick", "sndclm.html#delay?",
+ "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter", "extsnd.html#deletefilesorter", "extsnd.html#deletemark",
+ "extsnd.html#deletemarks", "extsnd.html#deletesample", "extsnd.html#deletesamples", "extsnd.html#deleteselection",
+ "sndscm.html#deleteselectionandsmooth", "extsnd.html#deletetransform", "extsnd.html#deletewatcher", "sndscm.html#describehook",
+ "sndscm.html#describemark", "extsnd.html#dialogwidgets", "sndscm.html#disablecontrolpanel", "sndscm.html#displaybarkfft",
+ "sndscm.html#displaydb", "extsnd.html#displayedits", "sndscm.html#displayscannedsynthesis", "sndscm.html#dissolvefade",
+ "sndscm.html#ditherchannel", "sndscm.html#dithersound", "sndscm.html#dlocsig", "sndscm.html#dop",
+ "extsnd.html#doitagainbuttoncolor", "extsnd.html#doitbuttoncolor", "sndclm.html#dot-product", "extsnd.html#dotsize",
+ "extsnd.html#drawaxes", "extsnd.html#drawdot", "extsnd.html#drawdots", "extsnd.html#drawline",
+ "extsnd.html#drawlines", "extsnd.html#drawmarkhook", "extsnd.html#drawmixhook", "extsnd.html#drawstring",
+ "sndscm.html#makedropsite", "extsnd.html#drophook", "extsnd.html#duringopenhook", "extsnd.html#editfragment",
+ "extsnd.html#editheaderdialog", "extsnd.html#edithook", "extsnd.html#editlisttofunction", "extsnd.html#editposition",
+ "extsnd.html#editproperties", "extsnd.html#editproperty", "extsnd.html#edittree", "extsnd.html#edits",
+ "sndclm.html#edot-product", "sndscm.html#analogfilterdoc", "sndscm.html#emacsstylesaveas", "sndclm.html#env",
+ "sndclm.html#env-any", "extsnd.html#envchannel", "extsnd.html#envchannelwithbase", "sndscm.html#envexptchannel",
+ "sndclm.html#env-interp", "sndscm.html#envmixes", "extsnd.html#envselection", "extsnd.html#envsound",
+ "sndscm.html#envsoundinterp", "sndclm.html#env?", "extsnd.html#envedbase", "extsnd.html#envedclipping",
+ "extsnd.html#enveddialog", "extsnd.html#envedenvelope", "extsnd.html#filterenv", "extsnd.html#filterenvorder",
+ "extsnd.html#envedhook", "extsnd.html#envedin-dB", "extsnd.html#envedpower", "extsnd.html#envedstyle",
+ "extsnd.html#envedtarget", "extsnd.html#envedwaving", "extsnd.html#envedwaveformcolor", "sndscm.html#envelopeinterp",
+ "sndscm.html#envelopedmix", "extsnd.html#epsbottommargin", "extsnd.html#epsfile", "extsnd.html#epsleftmargin",
+ "extsnd.html#epssize", "s7.html#errorhook", "s7.html#errorinfo", "sndscm.html#evalbetweenmarks",
"sndscm.html#evaloverselection", "sndscm.html#everysample", "extsnd.html#exit", "extsnd.html#exithook",
"extsnd.html#expandcontrol", "extsnd.html#expandcontrolbounds", "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter",
"extsnd.html#expandcontrollength", "extsnd.html#expandcontrolramp", "extsnd.html#expandcontrolp", "sndscm.html#explodesf2",
- "sndclm.html#exponentially-weighted-moving-average", "extsnd.html#extractchannel", "extsnd.html#extractchannels", "sndscm.html#cellon",
- "extsnd.html#fft", "snd.html#fftsize", "sndscm.html#fftedit", "extsnd.html#fftlogfrequency",
- "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother", "sndscm.html#fftsquelch", "extsnd.html#fftwindow",
- "extsnd.html#fftalpha", "extsnd.html#fftbeta", "extsnd.html#fftwithphases", "sndscm.html#nbdoc",
- "sndclm.html#filetoarray", "sndclm.html#filetoframe", "sndclm.html#filetoframe?", "sndclm.html#filetosample",
- "sndclm.html#filetosample?", "sndscm.html#filetosounddata", "sndscm.html#filetovct", "extsnd.html#filename",
- "extsnd.html#fillpolygon", "extsnd.html#fillrectangle", "sndclm.html#filter", "extsnd.html#filterchannel",
- "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB", "extsnd.html#filtercontrolinhz",
- "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp", "extsnd.html#filterselection",
- "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound", "sndclm.html#filter?", "sndclm.html#filtered-comb",
- "sndclm.html#filtered-comb?", "extsnd.html#findchannel", "extsnd.html#finddialog", "extsnd.html#findmark",
- "sndscm.html#findmix", "extsnd.html#findsound", "extsnd.html#finishprogressreport", "sndclm.html#fir-filter",
- "sndclm.html#fir-filter?", "sndclm.html#firmant", "sndclm.html#firmant?", "sndclm.html#flocsig",
- "sndclm.html#flocsig?", "sndscm.html#stereoflute", "sndscm.html#fmbell", "sndscm.html#fmdrum",
- "sndscm.html#fmnoise", "sndscm.html#fmvox", "sndscm.html#fmtrumpet", "sndscm.html#vdoc",
- "sndscm.html#reson", "extsnd.html#focuswidget", "sndscm.html#fofins", "sndscm.html#foreachchild",
- "sndscm.html#foreachsoundfile", "sndscm.html#fp", "extsnd.html#foregroundcolor", "extsnd.html#forgetregion",
- "sndclm.html#formant", "sndclm.html#formant?", "extsnd.html#fouriertransform", "sndscm.html#fractionalfouriertransform",
- "sndclm.html#frame1", "sndclm.html#frame*", "sndclm.html#frame+", "sndclm.html#frametofile",
- "sndclm.html#frametofile?", "sndclm.html#frametoframe", "sndclm.html#frametolist", "sndclm.html#frametosample",
- "sndscm.html#frametosound", "sndscm.html#frametosounddata", "sndscm.html#frametovct", "sndscm.html#framecopy",
- "sndscm.html#framereaderatendQ", "sndscm.html#framereaderchans", "sndscm.html#framereaderhome", "sndscm.html#framereaderposition",
- "sndscm.html#framereaderQ", "sndclm.html#frame-ref", "sndscm.html#framereverse", "sndclm.html#frame-set!",
- "sndclm.html#frame?", "extsnd.html#frames", "sndscm.html#freeframereader", "extsnd.html#freeplayer",
- "extsnd.html#freesampler", "sndscm.html#freeverb", "sndscm.html#fullmix", "sndscm.html#gaussiandistribution",
- "extsnd.html#gcoff", "extsnd.html#gcon", "extsnd.html#glgraphtops", "extsnd.html#glspectrogram",
- "sndscm.html#goertzel", "extsnd.html#gotolistenerend", "sndscm.html#grani", "sndclm.html#granulate",
- "sndclm.html#granulate?", "sndscm.html#granulatedsoundinterp", "extsnd.html#graph", "extsnd.html#graphtops",
- "extsnd.html#graphcolor", "extsnd.html#graphcursor", "extsnd.html#graphdata", "extsnd.html#graphhook",
- "extsnd.html#graphlines", "extsnd.html#graphstyle", "sndscm.html#grapheq", "extsnd.html#graphshorizontal",
- "sndclm.html#green-noise", "sndclm.html#green-noise-interp", "extsnd.html#griddensity", "sndscm.html#harmonicizer",
- "sndscm.html#dht", "extsnd.html#headertype", "sndscm.html#hellodentist", "extsnd.html#helpbuttoncolor",
- "extsnd.html#helpdialog", "extsnd.html#helphook", "extsnd.html#hidewidget", "extsnd.html#highlightcolor",
- "sndscm.html#hilberttransform", "sndscm.html#hookmember", "extsnd.html#htmldir", "extsnd.html#htmlprogram",
- "sndclm.html#hztoradians", "sndclm.html#iir-filter", "sndclm.html#iir-filter?", "extsnd.html#gin",
- "sndclm.html#in-any", "sndclm.html#ina", "sndclm.html#inb", "extsnd.html#infodialog",
- "grfsnd.html#initladspa", "extsnd.html#initialgraphhook", "sndscm.html#insertchannel", "extsnd.html#insertfiledialog",
- "sndscm.html#insertframe", "extsnd.html#insertregion", "extsnd.html#insertsample", "extsnd.html#insertsamples",
- "extsnd.html#insertselection", "extsnd.html#insertsilence", "extsnd.html#insertsound", "sndscm.html#insertsounddata",
- "sndscm.html#insertvct", "sndclm.html#instruments", "extsnd.html#integertocolormap", "extsnd.html#integertomark",
- "extsnd.html#integertomix", "extsnd.html#integertoregion", "extsnd.html#integertosound", "extsnd.html#integertotransform",
- "sndscm.html#integrateenvelope", "sndscm.html#jcreverb", "extsnd.html#justsounds", "sndscm.html#kalmanfilterchannel",
- "extsnd.html#key", "extsnd.html#keybinding", "extsnd.html#keypresshook", "grfsnd.html#ladspadescriptor",
- "extsnd.html#ladspadir", "extsnd.html#leftsample", "sndscm.html#makelevelmeter", "sndclm.html#lineartodb",
- "sndscm.html#linearsrcchannel", "extsnd.html#lispgraphhook", "extsnd.html#lispgraphstyle", "extsnd.html#lispgraphp",
- "extsnd.html#listtovct", "grfsnd.html#listladspa", "extsnd.html#listenerclickhook", "extsnd.html#listenercolor",
- "extsnd.html#listenerfont", "extsnd.html#listenerprompt", "extsnd.html#listenerselection", "extsnd.html#listenertextcolor",
- "extsnd.html#littleendianp", "sndclm.html#locsig", "sndclm.html#locsig-ref", "sndclm.html#locsig-reverb-ref",
- "sndclm.html#locsig-reverb-set!", "sndclm.html#locsig-set!", "sndclm.html#locsig-type", "sndclm.html#locsig?",
- "extsnd.html#logfreqstart", "sndscm.html#loopbetweenmarks", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict",
- "extsnd.html#mainmenu", "extsnd.html#mainwidgets", "sndclm.html#make-all-pass", "sndclm.html#make-asymmetric-fm",
- "sndscm.html#makebandpass", "sndscm.html#makebandstop", "sndscm.html#makebiquad", "sndscm.html#makebirds",
- "extsnd.html#makecolor", "sndclm.html#make-comb", "sndclm.html#make-convolve", "sndclm.html#make-delay",
- "sndscm.html#makedifferentiator", "sndclm.html#make-env", "sndclm.html#make-fft-window", "sndclm.html#make-filetoframe",
- "sndclm.html#make-filetosample", "sndclm.html#make-filter", "sndclm.html#make-filtered-comb", "sndclm.html#make-fir-filter",
- "sndclm.html#make-firmant", "sndclm.html#make-flocsig", "sndclm.html#make-formant", "sndclm.html#make-frame",
- "sndclm.html#make-frame!", "sndclm.html#make-frametofile", "sndscm.html#makeframereader", "sndclm.html#make-granulate",
- "extsnd.html#makegraphdata", "sndscm.html#makehiddencontrolsdialog", "sndscm.html#makehighpass", "sndscm.html#makehilberttransform",
- "sndclm.html#make-iir-filter", "sndclm.html#make-locsig", "sndscm.html#makelowpass", "extsnd.html#makemixsampler",
- "sndclm.html#make-mixer", "sndclm.html#make-mixer!", "sndclm.html#make-move-sound", "sndclm.html#make-moving-autocorrelation",
- "sndclm.html#make-moving-average", "sndclm.html#make-moving-fft", "sndclm.html#make-moving-pitch", "sndclm.html#make-moving-scentroid",
- "sndclm.html#make-moving-spectrum", "sndclm.html#make-ncos", "sndclm.html#make-noid", "sndclm.html#make-notch",
- "sndclm.html#make-nrxycos", "sndclm.html#make-nrxysin", "sndclm.html#make-nsin", "sndclm.html#make-one-pole",
- "sndclm.html#make-one-zero", "sndclm.html#make-oscil", "sndclm.html#make-phase-vocoder", "sndscm.html#makepixmap",
- "extsnd.html#makeplayer", "sndclm.html#make-polyoid", "sndclm.html#make-polyshape", "sndclm.html#make-polywave",
- "sndclm.html#make-pulse-train", "sndclm.html#make-rand", "sndclm.html#make-rand-interp", "sndclm.html#make-readin",
- "extsnd.html#makeregion", "sndscm.html#makeregionframereader", "extsnd.html#makeregionsampler", "sndclm.html#make-sampletofile",
- "extsnd.html#makesampler", "sndclm.html#make-sawtooth-wave", "sndclm.html#make-scalar-mixer", "sndscm.html#makeselection",
- "sndscm.html#makeselectionframereader", "extsnd.html#makesndtosample", "sndscm.html#makesoundbox", "extsnd.html#makesounddata",
- "sndclm.html#make-square-wave", "sndclm.html#make-src", "sndclm.html#make-ssb-am", "sndscm.html#makesyncframereader",
- "sndclm.html#make-table-lookup", "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero",
- "sndscm.html#makevariabledisplay", "extsnd.html#makevariablegraph", "extsnd.html#makevct", "sndclm.html#make-wave-train",
- "extsnd.html#mapchannel", "sndscm.html#mapsound", "sndscm.html#mapsoundfiles", "sndscm.html#maracadoc",
- "extsnd.html#marktointeger", "extsnd.html#markclickhook", "extsnd.html#markcolor", "extsnd.html#markdraghook",
- "extsnd.html#markdragtrianglehook", "sndscm.html#markexplode", "extsnd.html#markhome", "extsnd.html#markhook",
- "sndscm.html#markloops", "extsnd.html#markname", "sndscm.html#marknametoid", "extsnd.html#markproperties",
- "extsnd.html#markproperty", "extsnd.html#marksample", "extsnd.html#marksync", "extsnd.html#marksyncmax",
- "extsnd.html#marktagheight", "extsnd.html#marktagwidth", "extsnd.html#markp", "extsnd.html#emarks",
- "sndscm.html#matchsoundfiles", "sndscm.html#maxenvelope", "extsnd.html#maxregions", "extsnd.html#maxfftpeaks",
- "extsnd.html#maxvirtualptrees", "extsnd.html#maxamp", "extsnd.html#maxampposition", "extsnd.html#menuwidgets",
- "sndscm.html#menusdoc", "extsnd.html#mindb", "extsnd.html#minibufferhistorylength", "extsnd.html#mix",
- "extsnd.html#mixtointeger", "sndscm.html#mixtovct", "extsnd.html#mixamp", "extsnd.html#mixampenv",
- "sndscm.html#mixchannel", "extsnd.html#mixclickhook", "extsnd.html#mixcolor", "extsnd.html#mixdialogmix",
- "extsnd.html#mixdraghook", "extsnd.html#mixfiledialog", "sndscm.html#mixframe", "extsnd.html#mixhome",
- "extsnd.html#mixlength", "sndscm.html#mixmaxamp", "extsnd.html#mixmovesound", "extsnd.html#mixname",
- "sndscm.html#mixnametoid", "extsnd.html#mixposition", "extsnd.html#mixproperties", "extsnd.html#mixproperty",
- "extsnd.html#mixregion", "extsnd.html#mixreleasehook", "extsnd.html#mixsamplerQ", "extsnd.html#mixselection",
- "sndscm.html#mixsound", "sndscm.html#mixsounddata", "extsnd.html#mixspeed", "extsnd.html#mixsync",
- "extsnd.html#mixsyncmax", "extsnd.html#mixtagheight", "extsnd.html#mixtagwidth", "extsnd.html#mixtagy",
- "extsnd.html#mixvct", "extsnd.html#mixwaveformheight", "extsnd.html#mixp", "sndclm.html#mixer1",
- "sndclm.html#mixermultiply", "sndscm.html#mixerdoc", "sndclm.html#mixeradd", "sndscm.html#mixercopy",
- "sndscm.html#mixer-determinant", "sndscm.html#mixer-inverse", "sndscm.html#mixer-poly", "sndclm.html#mixer-ref",
- "sndclm.html#mixer-set!", "sndscm.html#mixer-solve", "sndscm.html#mixer-transpose", "sndclm.html#mixer?",
- "extsnd.html#mixes", "sndscm.html#monotostereo", "sndscm.html#moogfilter", "extsnd.html#mouseclickhook",
- "extsnd.html#mousedraghook", "extsnd.html#mouseentergraphhook", "extsnd.html#mouseenterlabelhook", "extsnd.html#mouseenterlistenerhook",
- "extsnd.html#mouseentertexthook", "extsnd.html#mouseleavegraphhook", "extsnd.html#mouseleavelabelhook", "extsnd.html#mousleavelistenerhook",
- "extsnd.html#mousleavetexthook", "extsnd.html#mousepresshook", "sndclm.html#move-locsig", "sndscm.html#movemixes",
- "sndclm.html#move-sound", "sndclm.html#move-sound?", "sndclm.html#moving-autocorrelation", "sndclm.html#moving-autocorrelation?",
- "sndclm.html#moving-average", "sndclm.html#moving-average?", "sndclm.html#moving-fft", "sndclm.html#moving-fft?",
- "sndclm.html#moving-length", "sndclm.html#moving-max", "sndclm.html#moving-pitch", "sndclm.html#moving-pitch?",
- "sndclm.html#moving-rms", "sndclm.html#moving-scentroid", "sndclm.html#moving-scentroid?", "sndclm.html#moving-spectrum",
- "sndclm.html#moving-spectrum?", "sndclm.html#moving-sum", "sndscm.html#mpg", "sndclm.html#multiply-arrays",
- "extsnd.html#musalsabuffersize", "extsnd.html#musalsabuffers", "extsnd.html#musalsacapturedevice", "extsnd.html#musalsadevice",
- "extsnd.html#musalsaplaybackdevice", "extsnd.html#musalsasquelchwarning", "sndclm.html#musarrayprintlength", "extsnd.html#musaudioclose",
- "extsnd.html#musaudiodescribe", "extsnd.html#musaudioopeninput", "extsnd.html#musaudioopenoutput", "extsnd.html#musaudioread",
- "extsnd.html#musaudiowrite", "extsnd.html#musbytespersample", "sndclm.html#mus-channel", "sndclm.html#mus-channels",
- "sndclm.html#mus-chebyshev-tu-sum", "extsnd.html#musclipping", "sndclm.html#mus-close", "sndclm.html#mus-data",
- "extsnd.html#musdataformattostring", "extsnd.html#musdataformatname", "sndclm.html#mus-describe", "extsnd.html#muserrorhook",
- "extsnd.html#muserrortypetostring", "extsnd.html#musexpandfilename", "sndclm.html#mus-feedback", "sndclm.html#mus-feedforward",
- "extsnd.html#musfft", "sndclm.html#musfilebuffersize", "extsnd.html#musfileclipping", "sndclm.html#mus-file-name",
- "extsnd.html#musfileprescaler", "sndclm.html#musfloatequalfudgefactor", "sndclm.html#mus-frequency", "sndclm.html#musgeneratorp",
- "extsnd.html#musheaderrawdefaults", "extsnd.html#musheadertypetostring", "extsnd.html#musheadertypename", "sndclm.html#mus-hop",
- "sndclm.html#mus-increment", "sndclm.html#mus-input?", "sndclm.html#mus-interp-type", "sndclm.html#mus-interpolate",
- "sndclm.html#mus-length", "sndclm.html#mus-location", "extsnd.html#musmaxmalloc", "extsnd.html#musmaxtablesize",
- "sndscm.html#musmix", "sndclm.html#mus-name", "sndclm.html#mus-offset", "sndclm.html#mus-order",
- "extsnd.html#musosssetbuffers", "extsnd.html#musoutformat", "sndclm.html#mus-output?", "sndclm.html#mus-phase",
- "extsnd.html#musprescaler", "sndclm.html#mus-ramp", "sndclm.html#mus-random", "sndclm.html#mus-reset",
- "sndclm.html#mus-run", "sndclm.html#mus-safety", "sndclm.html#mus-scaler", "extsnd.html#mussoundchans",
- "extsnd.html#mussoundcloseinput", "extsnd.html#mussoundcloseoutput", "extsnd.html#mussoundcomment", "extsnd.html#mussounddataformat",
- "extsnd.html#mussounddatalocation", "extsnd.html#mussounddatumsize", "extsnd.html#mussoundduration", "extsnd.html#mussoundforget",
- "extsnd.html#mussoundframes", "extsnd.html#mussoundheadertype", "extsnd.html#mussoundlength", "extsnd.html#mussoundloopinfo",
- "extsnd.html#mussoundmarkinfo", "extsnd.html#mussoundmaxamp", "extsnd.html#mussoundmaxampexists", "extsnd.html#mussoundopeninput",
- "extsnd.html#mussoundopenoutput", "extsnd.html#mussoundprune", "extsnd.html#mussoundread", "extsnd.html#mussoundreopenoutput",
- "extsnd.html#mussoundreportcache", "extsnd.html#mussoundsamples", "extsnd.html#mussoundseekframe", "extsnd.html#mussoundsrate",
- "extsnd.html#mussoundtypespecifier", "extsnd.html#mussoundwrite", "extsnd.html#mussoundwritedate", "sndclm.html#mussrate",
- "sndclm.html#mus-width", "sndclm.html#mus-xcoeff", "sndclm.html#mus-xcoeffs", "sndclm.html#mus-ycoeff",
- "sndclm.html#mus-ycoeffs", "extsnd.html#nameclickhook", "sndclm.html#ncos", "sndclm.html#ncos?",
- "extsnd.html#newsound", "extsnd.html#newsounddialog", "extsnd.html#newsoundhook", "extsnd.html#newwidgethook",
- "sndscm.html#nextframe", "extsnd.html#nextsample", "sndclm.html#noid", "extsnd.html#normalizechannel",
- "sndscm.html#normalizeenvelope", "sndclm.html#normalizepartials", "sndscm.html#normalizesound", "sndscm.html#normalizedmix",
- "sndclm.html#notch", "sndscm.html#notchchannel", "sndscm.html#notchoutrumbleandhiss", "sndscm.html#notchselection",
- "sndscm.html#notchsound", "sndclm.html#notch?", "sndscm.html#nrev", "sndclm.html#nrxycos",
- "sndclm.html#nrxycos?", "sndclm.html#nrxysin", "sndclm.html#nrxysin?", "sndclm.html#nsin",
- "sndclm.html#nsin?", "sndscm.html#offsetchannel", "sndscm.html#offsetsound", "sndclm.html#one-pole",
- "sndclm.html#one-pole?", "sndclm.html#one-zero", "sndclm.html#one-zero?", "extsnd.html#openfiledialog",
- "extsnd.html#openfiledialogdirectory", "extsnd.html#openhook", "sndscm.html#opennextfileindirectory", "extsnd.html#openrawsound",
- "extsnd.html#openrawsoundhook", "extsnd.html#opensound", "extsnd.html#optimization", "extsnd.html#optimizationhook",
- "extsnd.html#orientationhook", "sndclm.html#oscil", "sndclm.html#oscil?", "sndscm.html#oscopedoc",
- "sndclm.html#out-any", "sndclm.html#outa", "sndclm.html#*output*", "extsnd.html#outputcommenthook",
- "extsnd.html#outputnamehook", "sndscm.html#overlayrmsenv", "extsnd.html#padchannel", "sndscm.html#padmarks",
- "sndscm.html#padsound", "sndscm.html#panmix", "sndscm.html#panmixvct", "sndclm.html#partialstopolynomial",
- "sndclm.html#partialstowave", "extsnd.html#pausing", "extsnd.html#peakenvdir", "extsnd.html#peakenvhook",
- "extsnd.html#peaks", "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave", "sndclm.html#phase-vocoder",
- "sndclm.html#phase-vocoder?", "sndscm.html#pianodoc", "sndclm.html#pink-noise", "sndscm.html#placesound",
- "extsnd.html#play", "sndscm.html#playbetweenmarks", "extsnd.html#playhook", "sndscm.html#playmixes",
- "sndscm.html#playsines", "sndscm.html#playsyncdmarks", "extsnd.html#playerhome", "extsnd.html#playerQ",
- "extsnd.html#players", "extsnd.html#playing", "sndscm.html#pluck", "sndclm.html#polartorectangular",
- "sndclm.html#polynomial", "sndscm.html#polydoc", "sndclm.html#polyoid", "sndclm.html#polyoidenv",
- "sndclm.html#polyoid?", "sndclm.html#polyshape", "sndclm.html#polyshape?", "sndclm.html#polywave",
- "sndclm.html#polywave?", "extsnd.html#positiontox", "extsnd.html#positiontoy", "extsnd.html#positioncolor",
- "sndscm.html#powerenv", "extsnd.html#preferencesdialog", "sndscm.html#previousframe", "extsnd.html#previoussample",
- "extsnd.html#printdialog", "extsnd.html#printhook", "extsnd.html#printlength", "sndscm.html#profile",
- "extsnd.html#progressreport", "extsnd.html#promptinminibuffer", "extsnd.html#ptreechannel", "sndclm.html#pulse-train",
- "sndclm.html#pulse-train?", "extsnd.html#pushedbuttoncolor", "extsnd.html#quitbuttoncolor", "sndclm.html#radianstodegrees",
- "sndclm.html#radianstohz", "extsnd.html#rampchannel", "sndclm.html#rand", "sndclm.html#rand-interp",
- "sndclm.html#rand-interp?", "sndclm.html#rand?", "sndscm.html#readframe", "extsnd.html#readhook",
- "extsnd.html#readmixsample", "extsnd.html#readonly", "extsnd.html#readregionsample", "extsnd.html#readsample",
- "sndclm.html#readin", "sndclm.html#readin?", "extsnd.html#recorderdialog", "sndclm.html#rectangulartomagnitudes",
- "sndclm.html#rectangulartopolar", "extsnd.html#redo", "extsnd.html#redochannel", "extsnd.html#redoedit",
- "sndscm.html#regiontoframe", "extsnd.html#regiontointeger", "sndscm.html#regiontosounddata", "extsnd.html#regiontovct",
- "extsnd.html#regionchans", "extsnd.html#regionframes", "extsnd.html#regiongraphstyle", "extsnd.html#regionhome",
- "extsnd.html#regionmaxamp", "extsnd.html#regionmaxampposition", "sndscm.html#regionplaylist", "extsnd.html#regionposition",
- "extsnd.html#regionsample", "extsnd.html#regionsamplerQ", "extsnd.html#regionsrate", "extsnd.html#regionok",
- "extsnd.html#eregions", "sndscm.html#remembersoundstate", "extsnd.html#removefrommenu", "extsnd.html#reportinminibuffer",
- "sndscm.html#resetallhooks", "extsnd.html#resetbuttoncolor", "extsnd.html#resetcontrols", "extsnd.html#resetlistenercursor",
- "extsnd.html#restorecontrols", "sndclm.html#*reverb*", "extsnd.html#reverbdecay", "extsnd.html#reverbcontrolfeedback",
- "extsnd.html#reverbcontrollength", "extsnd.html#reverbcontrollengthbounds", "extsnd.html#reverbcontrollowpass", "extsnd.html#reverbcontrolscale",
- "extsnd.html#reverbcontrolscalebounds", "extsnd.html#reverbcontrolp", "extsnd.html#reversechannel", "extsnd.html#reversechannels",
- "sndscm.html#reverseenvelope", "extsnd.html#reverseselection", "extsnd.html#reversesound", "extsnd.html#revertsound",
- "extsnd.html#rightsample", "sndclm.html#ring-modulate", "sndscm.html#rmsgain", "sndscm.html#rmsgain",
- "sndscm.html#rmsenvelope", "extsnd.html#rotatechannel", "sndscm.html#rubbersound", "extsnd.html#run",
- "extsnd.html#sample", "sndclm.html#sampletofile", "sndclm.html#sampletofile?", "sndclm.html#sampletoframe",
- "extsnd.html#sampleratendQ", "extsnd.html#samplerhome", "extsnd.html#samplerposition", "extsnd.html#samplerQ",
- "extsnd.html#samples", "sndclm.html#samplestoseconds", "extsnd.html#sashcolor", "extsnd.html#savecontrols",
- "extsnd.html#savedir", "extsnd.html#saveedithistory", "extsnd.html#saveenvelopes", "extsnd.html#savehook",
- "extsnd.html#savelistener", "extsnd.html#savemacros", "sndscm.html#savemarkproperties", "extsnd.html#savemarks",
- "extsnd.html#savemix", "sndscm.html#savemixes", "extsnd.html#saveregion", "extsnd.html#saveregiondialog",
- "extsnd.html#saveselection", "extsnd.html#saveselectiondialog", "extsnd.html#savesound", "extsnd.html#savesoundas",
- "extsnd.html#savesounddialog", "extsnd.html#savestate", "extsnd.html#savestatefile", "extsnd.html#savestatehook",
- "sndscm.html#sgfilter", "sndclm.html#sawtooth-wave", "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby",
- "extsnd.html#scalechannel", "sndscm.html#scaleenvelope", "sndscm.html#scalemixes", "extsnd.html#scaleselectionby",
- "extsnd.html#scaleselectionto", "sndscm.html#scalesound", "sndscm.html#scaletempo", "extsnd.html#scaleto",
- "extsnd.html#scanchannel", "sndscm.html#scansound", "sndscm.html#dspdocscanned", "sndscm.html#scentroid",
- "extsnd.html#scriptarg", "extsnd.html#scriptargs", "extsnd.html#searchprocedure", "sndclm.html#secondstosamples",
- "extsnd.html#selectall", "extsnd.html#selectchannel", "extsnd.html#selectchannelhook", "extsnd.html#selectsound",
- "extsnd.html#selectsoundhook", "extsnd.html#selectedchannel", "extsnd.html#selecteddatacolor", "extsnd.html#selectedgraphcolor",
- "extsnd.html#selectedsound", "extsnd.html#selection", "extsnd.html#selectiontomix", "sndscm.html#selectiontosounddata",
- "extsnd.html#selectionchans", "extsnd.html#selectioncolor", "extsnd.html#selectioncreatesregion", "extsnd.html#selectionframes",
- "extsnd.html#selectionmaxamp", "extsnd.html#selectionmaxampposition", "extsnd.html#selectionmember", "sndscm.html#selectionmembers",
- "extsnd.html#selectionposition", "extsnd.html#selectionsrate", "extsnd.html#selectionok", "extsnd.html#sendmozilla",
- "sndscm.html#setglobalsync", "extsnd.html#setsamples", "sndscm.html#shepardtone", "extsnd.html#shortfilename",
- "extsnd.html#showaxes", "extsnd.html#showcontrols", "sndscm.html#showdiskspace", "extsnd.html#showgrid",
- "extsnd.html#showindices", "extsnd.html#showlistener", "extsnd.html#showmarks", "extsnd.html#showmixwaveforms",
- "sndscm.html#showselection", "extsnd.html#showselectiontransform", "sndscm.html#showsmptelabel", "extsnd.html#showsonogramcursor",
- "extsnd.html#showtransformpeaks", "extsnd.html#showwidget", "extsnd.html#showyzero", "sndscm.html#silenceallmixes",
- "sndscm.html#silencemixes", "sndclm.html#sinc-train", "extsnd.html#sincwidth", "sndscm.html#sineenvchannel",
- "sndscm.html#sineramp", "sndscm.html#singerdoc", "extsnd.html#smoothchannel", "extsnd.html#smoothselection",
- "extsnd.html#smoothsound", "sndscm.html#pins", "sndscm.html#snapmarktobeat", "sndscm.html#snapmixtobeat",
- "extsnd.html#sndtosample", "extsnd.html#sndtosamplep", "extsnd.html#sndcolor", "extsnd.html#snderror",
- "extsnd.html#snderrorhook", "extsnd.html#sndfont", "extsnd.html#sndgcs", "extsnd.html#sndhelp",
- "sndscm.html#sndscmhooks", "extsnd.html#sndopenedsound", "extsnd.html#sndprint", "extsnd.html#sndspectrum",
- "extsnd.html#sndtempnam", "extsnd.html#sndurl", "extsnd.html#sndurls", "extsnd.html#sndversion",
- "extsnd.html#sndwarning", "extsnd.html#sndwarninghook", "sndscm.html#sndwarp", "sndscm.html#soundtoamp_env",
- "sndscm.html#soundtoframe", "extsnd.html#soundtointeger", "sndscm.html#soundtosounddata", "extsnd.html#sounddata*",
- "extsnd.html#sounddata+", "sndscm.html#sounddatatofile", "sndscm.html#sounddatatoframe", "sndscm.html#sounddatatosound",
- "extsnd.html#sounddatatosounddata", "extsnd.html#sounddatatovct", "extsnd.html#sounddataadd", "extsnd.html#sounddatachans",
- "extsnd.html#sounddatacopy", "extsnd.html#sounddatafill", "extsnd.html#sounddatalength", "extsnd.html#sounddatamaxamp",
- "extsnd.html#sounddatamultiply", "extsnd.html#sounddataoffset", "extsnd.html#sounddatapeak", "extsnd.html#sounddataref",
- "extsnd.html#sounddatareverse", "extsnd.html#sounddatascale", "extsnd.html#sounddataset", "extsnd.html#sounddata?",
- "extsnd.html#soundfileextensions", "extsnd.html#soundfilep", "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp",
- "sndscm.html#sound-let", "extsnd.html#soundloopinfo", "extsnd.html#soundproperties", "extsnd.html#soundproperty",
- "extsnd.html#soundwidgets", "extsnd.html#soundp", "extsnd.html#soundfontinfo", "extsnd.html#sounds",
- "sndscm.html#twotab", "sndscm.html#spectralpolynomial", "extsnd.html#spectrohop", "extsnd.html#spectroxangle",
- "extsnd.html#spectroxscale", "extsnd.html#spectroyangle", "extsnd.html#spectroyscale", "extsnd.html#spectrozangle",
- "extsnd.html#spectrozscale", "sndclm.html#spectrum", "sndscm.html#spectrumtocoeffs", "extsnd.html#spectrumend",
- "extsnd.html#spectrumstart", "extsnd.html#speedcontrol", "extsnd.html#speedcontrolbounds", "extsnd.html#speedstyle",
- "extsnd.html#speedtones", "sndclm.html#square-wave", "sndclm.html#square-wave?", "extsnd.html#squelchupdate",
- "sndscm.html#squelchvowels", "extsnd.html#srate", "sndclm.html#src", "extsnd.html#srcchannel",
- "sndscm.html#srcduration", "sndscm.html#srcmixes", "extsnd.html#srcsoundselection", "extsnd.html#srcsound",
- "sndclm.html#src?", "sndclm.html#ssb-am", "sndclm.html#ssb-am?", "sndscm.html#ssbbank",
- "sndscm.html#ssbbankenv", "sndscm.html#ssbfm", "extsnd.html#starthook", "extsnd.html#startplaying",
- "extsnd.html#startplayinghook", "extsnd.html#startplayingselectionhook", "extsnd.html#startprogressreport", "sndscm.html#startwaterfall",
- "sndscm.html#stereotomono", "extsnd.html#stopdachook", "extsnd.html#stopplayer", "extsnd.html#stopplaying",
- "extsnd.html#stopplayinghook", "extsnd.html#stopplayingselectionhook", "sndscm.html#stretchenvelope", "sndscm.html#superimposeffts",
- "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels", "extsnd.html#sync", "sndscm.html#sync-all",
- "extsnd.html#syncmax", "extsnd.html#syncdmarks", "sndclm.html#table-lookup", "sndclm.html#table-lookup?",
- "sndclm.html#tap", "sndscm.html#telephone", "extsnd.html#tempdir", "extsnd.html#textfocuscolor",
- "extsnd.html#timegraphhook", "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype", "extsnd.html#timegraphp",
- "extsnd.html#tinyfont", "extsnd.html#trackingcursorstyle", "extsnd.html#transformtointeger", "extsnd.html#transformtovct",
+ "sndclm.html#exponentially-weighted-moving-average", "extsnd.html#extractchannel", "extsnd.html#extractchannels", "s7.html#featureslist",
+ "sndscm.html#cellon", "extsnd.html#fft", "snd.html#fftsize", "sndscm.html#fftedit",
+ "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother", "sndscm.html#fftsquelch",
+ "extsnd.html#fftwindow", "extsnd.html#fftalpha", "extsnd.html#fftbeta", "extsnd.html#fftwithphases",
+ "sndscm.html#nbdoc", "sndclm.html#filetoarray", "sndclm.html#filetoframe", "sndclm.html#filetoframe?",
+ "sndclm.html#filetosample", "sndclm.html#filetosample?", "sndscm.html#filetosounddata", "sndscm.html#filetovct",
+ "extsnd.html#filename", "extsnd.html#fillpolygon", "extsnd.html#fillrectangle", "sndclm.html#filter",
+ "extsnd.html#filterchannel", "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB",
+ "extsnd.html#filtercontrolinhz", "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp",
+ "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound", "sndclm.html#filter?",
+ "sndclm.html#filtered-comb", "sndclm.html#filtered-comb?", "extsnd.html#findchannel", "extsnd.html#finddialog",
+ "extsnd.html#findmark", "sndscm.html#findmix", "extsnd.html#findsound", "extsnd.html#finishprogressreport",
+ "sndclm.html#fir-filter", "sndclm.html#fir-filter?", "sndclm.html#firmant", "sndclm.html#firmant?",
+ "sndclm.html#flocsig", "sndclm.html#flocsig?", "sndscm.html#stereoflute", "sndscm.html#fmbell",
+ "sndscm.html#fmdrum", "sndscm.html#fmnoise", "sndscm.html#fmvox", "sndscm.html#fmtrumpet",
+ "sndscm.html#vdoc", "sndscm.html#reson", "extsnd.html#focuswidget", "sndscm.html#fofins",
+ "sndscm.html#foreachchild", "sndscm.html#foreachsoundfile", "sndscm.html#fp", "extsnd.html#foregroundcolor",
+ "extsnd.html#forgetregion", "sndclm.html#formant", "sndclm.html#formant?", "extsnd.html#fouriertransform",
+ "sndscm.html#fractionalfouriertransform", "sndclm.html#frame1", "sndclm.html#frame*", "sndclm.html#frame+",
+ "sndclm.html#frametofile", "sndclm.html#frametofile?", "sndclm.html#frametoframe", "sndclm.html#frametolist",
+ "sndclm.html#frametosample", "sndscm.html#frametosound", "sndscm.html#frametosounddata", "sndscm.html#frametovct",
+ "sndscm.html#framecopy", "sndscm.html#framereaderatendQ", "sndscm.html#framereaderchans", "sndscm.html#framereaderhome",
+ "sndscm.html#framereaderposition", "sndscm.html#framereaderQ", "sndclm.html#frame-ref", "sndscm.html#framereverse",
+ "sndclm.html#frame-set!", "sndclm.html#frame?", "extsnd.html#frames", "sndscm.html#freeframereader",
+ "extsnd.html#freeplayer", "extsnd.html#freesampler", "sndscm.html#freeverb", "sndscm.html#fullmix",
+ "sndscm.html#gaussiandistribution", "extsnd.html#gcoff", "extsnd.html#gcon", "extsnd.html#glgraphtops",
+ "extsnd.html#glspectrogram", "sndscm.html#goertzel", "extsnd.html#gotolistenerend", "sndscm.html#grani",
+ "sndclm.html#granulate", "sndclm.html#granulate?", "sndscm.html#granulatedsoundinterp", "extsnd.html#graph",
+ "extsnd.html#graphtops", "extsnd.html#graphcolor", "extsnd.html#graphcursor", "extsnd.html#graphdata",
+ "extsnd.html#graphhook", "extsnd.html#graphlines", "extsnd.html#graphstyle", "sndscm.html#grapheq",
+ "extsnd.html#graphshorizontal", "sndclm.html#green-noise", "sndclm.html#green-noise-interp", "extsnd.html#griddensity",
+ "sndscm.html#harmonicizer", "sndscm.html#dht", "extsnd.html#headertype", "sndscm.html#hellodentist",
+ "extsnd.html#helpbuttoncolor", "extsnd.html#helpdialog", "extsnd.html#helphook", "extsnd.html#hidewidget",
+ "extsnd.html#highlightcolor", "sndscm.html#hilberttransform", "sndscm.html#hookmember", "extsnd.html#htmldir",
+ "extsnd.html#htmlprogram", "sndclm.html#hztoradians", "sndclm.html#iir-filter", "sndclm.html#iir-filter?",
+ "extsnd.html#gin", "sndclm.html#in-any", "sndclm.html#ina", "sndclm.html#inb",
+ "extsnd.html#infodialog", "grfsnd.html#initladspa", "extsnd.html#initialgraphhook", "sndscm.html#insertchannel",
+ "extsnd.html#insertfiledialog", "sndscm.html#insertframe", "extsnd.html#insertregion", "extsnd.html#insertsample",
+ "extsnd.html#insertsamples", "extsnd.html#insertselection", "extsnd.html#insertsilence", "extsnd.html#insertsound",
+ "sndscm.html#insertsounddata", "sndscm.html#insertvct", "sndclm.html#instruments", "extsnd.html#integertocolormap",
+ "extsnd.html#integertomark", "extsnd.html#integertomix", "extsnd.html#integertoregion", "extsnd.html#integertosound",
+ "extsnd.html#integertotransform", "sndscm.html#integrateenvelope", "sndscm.html#jcreverb", "extsnd.html#justsounds",
+ "sndscm.html#kalmanfilterchannel", "extsnd.html#key", "extsnd.html#keybinding", "extsnd.html#keypresshook",
+ "grfsnd.html#ladspadescriptor", "extsnd.html#ladspadir", "extsnd.html#leftsample", "sndscm.html#makelevelmeter",
+ "sndclm.html#lineartodb", "sndscm.html#linearsrcchannel", "extsnd.html#lispgraphhook", "extsnd.html#lispgraphstyle",
+ "extsnd.html#lispgraphp", "extsnd.html#listtovct", "grfsnd.html#listladspa", "extsnd.html#listenerclickhook",
+ "extsnd.html#listenercolor", "extsnd.html#listenerfont", "extsnd.html#listenerprompt", "extsnd.html#listenerselection",
+ "extsnd.html#listenertextcolor", "extsnd.html#littleendianp", "s7.html#loadhook", "s7.html#loadpath",
+ "sndclm.html#locsig", "sndclm.html#locsig-ref", "sndclm.html#locsig-reverb-ref", "sndclm.html#locsig-reverb-set!",
+ "sndclm.html#locsig-set!", "sndclm.html#locsig-type", "sndclm.html#locsig?", "extsnd.html#logfreqstart",
+ "sndscm.html#loopbetweenmarks", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict", "extsnd.html#mainmenu",
+ "extsnd.html#mainwidgets", "sndclm.html#make-all-pass", "sndclm.html#make-asymmetric-fm", "sndscm.html#makebandpass",
+ "sndscm.html#makebandstop", "sndscm.html#makebiquad", "sndscm.html#makebirds", "extsnd.html#makecolor",
+ "sndclm.html#make-comb", "sndclm.html#make-convolve", "sndclm.html#make-delay", "sndscm.html#makedifferentiator",
+ "sndclm.html#make-env", "sndclm.html#make-fft-window", "sndclm.html#make-filetoframe", "sndclm.html#make-filetosample",
+ "sndclm.html#make-filter", "sndclm.html#make-filtered-comb", "sndclm.html#make-fir-filter", "sndclm.html#make-firmant",
+ "sndclm.html#make-flocsig", "sndclm.html#make-formant", "sndclm.html#make-frame", "sndclm.html#make-frame!",
+ "sndclm.html#make-frametofile", "sndscm.html#makeframereader", "sndclm.html#make-granulate", "extsnd.html#makegraphdata",
+ "sndscm.html#makehiddencontrolsdialog", "sndscm.html#makehighpass", "sndscm.html#makehilberttransform", "sndclm.html#make-iir-filter",
+ "sndclm.html#make-locsig", "sndscm.html#makelowpass", "extsnd.html#makemixsampler", "sndclm.html#make-mixer",
+ "sndclm.html#make-mixer!", "sndclm.html#make-move-sound", "sndclm.html#make-moving-autocorrelation", "sndclm.html#make-moving-average",
+ "sndclm.html#make-moving-fft", "sndclm.html#make-moving-pitch", "sndclm.html#make-moving-scentroid", "sndclm.html#make-moving-spectrum",
+ "sndclm.html#make-ncos", "sndclm.html#make-noid", "sndclm.html#make-notch", "sndclm.html#make-nrxycos",
+ "sndclm.html#make-nrxysin", "sndclm.html#make-nsin", "sndclm.html#make-one-pole", "sndclm.html#make-one-zero",
+ "sndclm.html#make-oscil", "sndclm.html#make-phase-vocoder", "sndscm.html#makepixmap", "extsnd.html#makeplayer",
+ "sndclm.html#make-polyoid", "sndclm.html#make-polyshape", "sndclm.html#make-polywave", "sndclm.html#make-pulse-train",
+ "sndclm.html#make-rand", "sndclm.html#make-rand-interp", "sndclm.html#make-readin", "extsnd.html#makeregion",
+ "sndscm.html#makeregionframereader", "extsnd.html#makeregionsampler", "sndclm.html#make-sampletofile", "extsnd.html#makesampler",
+ "sndclm.html#make-sawtooth-wave", "sndclm.html#make-scalar-mixer", "sndscm.html#makeselection", "sndscm.html#makeselectionframereader",
+ "extsnd.html#makesndtosample", "sndscm.html#makesoundbox", "extsnd.html#makesounddata", "sndclm.html#make-square-wave",
+ "sndclm.html#make-src", "sndclm.html#make-ssb-am", "sndscm.html#makesyncframereader", "sndclm.html#make-table-lookup",
+ "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero", "sndscm.html#makevariabledisplay",
+ "extsnd.html#makevariablegraph", "extsnd.html#makevct", "sndclm.html#make-wave-train", "extsnd.html#mapchannel",
+ "sndscm.html#mapsound", "sndscm.html#mapsoundfiles", "sndscm.html#maracadoc", "extsnd.html#marktointeger",
+ "extsnd.html#markclickhook", "extsnd.html#markcolor", "extsnd.html#markdraghook", "extsnd.html#markdragtrianglehook",
+ "sndscm.html#markexplode", "extsnd.html#markhome", "extsnd.html#markhook", "sndscm.html#markloops",
+ "extsnd.html#markname", "sndscm.html#marknametoid", "extsnd.html#markproperties", "extsnd.html#markproperty",
+ "extsnd.html#marksample", "extsnd.html#marksync", "extsnd.html#marksyncmax", "extsnd.html#marktagheight",
+ "extsnd.html#marktagwidth", "extsnd.html#markp", "extsnd.html#emarks", "sndscm.html#matchsoundfiles",
+ "sndscm.html#maxenvelope", "extsnd.html#maxregions", "extsnd.html#maxfftpeaks", "extsnd.html#maxvirtualptrees",
+ "extsnd.html#maxamp", "extsnd.html#maxampposition", "extsnd.html#menuwidgets", "sndscm.html#menusdoc",
+ "extsnd.html#mindb", "extsnd.html#minibufferhistorylength", "extsnd.html#mix", "extsnd.html#mixtointeger",
+ "sndscm.html#mixtovct", "extsnd.html#mixamp", "extsnd.html#mixampenv", "sndscm.html#mixchannel",
+ "extsnd.html#mixclickhook", "extsnd.html#mixcolor", "extsnd.html#mixdialogmix", "extsnd.html#mixdraghook",
+ "extsnd.html#mixfiledialog", "sndscm.html#mixframe", "extsnd.html#mixhome", "extsnd.html#mixlength",
+ "sndscm.html#mixmaxamp", "extsnd.html#mixmovesound", "extsnd.html#mixname", "sndscm.html#mixnametoid",
+ "extsnd.html#mixposition", "extsnd.html#mixproperties", "extsnd.html#mixproperty", "extsnd.html#mixregion",
+ "extsnd.html#mixreleasehook", "extsnd.html#mixsamplerQ", "extsnd.html#mixselection", "sndscm.html#mixsound",
+ "sndscm.html#mixsounddata", "extsnd.html#mixspeed", "extsnd.html#mixsync", "extsnd.html#mixsyncmax",
+ "extsnd.html#mixtagheight", "extsnd.html#mixtagwidth", "extsnd.html#mixtagy", "extsnd.html#mixvct",
+ "extsnd.html#mixwaveformheight", "extsnd.html#mixp", "sndclm.html#mixer1", "sndclm.html#mixermultiply",
+ "sndscm.html#mixerdoc", "sndclm.html#mixeradd", "sndscm.html#mixercopy", "sndscm.html#mixer-determinant",
+ "sndscm.html#mixer-inverse", "sndscm.html#mixer-poly", "sndclm.html#mixer-ref", "sndclm.html#mixer-set!",
+ "sndscm.html#mixer-solve", "sndscm.html#mixer-transpose", "sndclm.html#mixer?", "extsnd.html#mixes",
+ "sndscm.html#monotostereo", "sndscm.html#moogfilter", "extsnd.html#mouseclickhook", "extsnd.html#mousedraghook",
+ "extsnd.html#mouseentergraphhook", "extsnd.html#mouseenterlabelhook", "extsnd.html#mouseenterlistenerhook", "extsnd.html#mouseentertexthook",
+ "extsnd.html#mouseleavegraphhook", "extsnd.html#mouseleavelabelhook", "extsnd.html#mousleavelistenerhook", "extsnd.html#mousleavetexthook",
+ "extsnd.html#mousepresshook", "sndclm.html#move-locsig", "sndscm.html#movemixes", "sndclm.html#move-sound",
+ "sndclm.html#move-sound?", "sndclm.html#moving-autocorrelation", "sndclm.html#moving-autocorrelation?", "sndclm.html#moving-average",
+ "sndclm.html#moving-average?", "sndclm.html#moving-fft", "sndclm.html#moving-fft?", "sndclm.html#moving-length",
+ "sndclm.html#moving-max", "sndclm.html#moving-pitch", "sndclm.html#moving-pitch?", "sndclm.html#moving-rms",
+ "sndclm.html#moving-scentroid", "sndclm.html#moving-scentroid?", "sndclm.html#moving-spectrum", "sndclm.html#moving-spectrum?",
+ "sndclm.html#moving-sum", "sndscm.html#mpg", "sndclm.html#multiply-arrays", "extsnd.html#musalsabuffersize",
+ "extsnd.html#musalsabuffers", "extsnd.html#musalsacapturedevice", "extsnd.html#musalsadevice", "extsnd.html#musalsaplaybackdevice",
+ "extsnd.html#musalsasquelchwarning", "sndclm.html#musarrayprintlength", "extsnd.html#musaudioclose", "extsnd.html#musaudiodescribe",
+ "extsnd.html#musaudioopeninput", "extsnd.html#musaudioopenoutput", "extsnd.html#musaudioread", "extsnd.html#musaudiowrite",
+ "extsnd.html#musbytespersample", "sndclm.html#mus-channel", "sndclm.html#mus-channels", "sndclm.html#mus-chebyshev-tu-sum",
+ "extsnd.html#musclipping", "sndclm.html#mus-close", "sndclm.html#mus-data", "extsnd.html#musdataformattostring",
+ "extsnd.html#musdataformatname", "sndclm.html#mus-describe", "extsnd.html#muserrorhook", "extsnd.html#muserrortypetostring",
+ "extsnd.html#musexpandfilename", "sndclm.html#mus-feedback", "sndclm.html#mus-feedforward", "extsnd.html#musfft",
+ "sndclm.html#musfilebuffersize", "extsnd.html#musfileclipping", "sndclm.html#mus-file-name", "extsnd.html#musfileprescaler",
+ "sndclm.html#musfloatequalfudgefactor", "sndclm.html#mus-frequency", "sndclm.html#musgeneratorp", "extsnd.html#musheaderrawdefaults",
+ "extsnd.html#musheadertypetostring", "extsnd.html#musheadertypename", "sndclm.html#mus-hop", "sndclm.html#mus-increment",
+ "sndclm.html#mus-input?", "sndclm.html#mus-interp-type", "sndclm.html#mus-interpolate", "sndclm.html#mus-length",
+ "sndclm.html#mus-location", "extsnd.html#musmaxmalloc", "extsnd.html#musmaxtablesize", "sndscm.html#musmix",
+ "sndclm.html#mus-name", "sndclm.html#mus-offset", "sndclm.html#mus-order", "extsnd.html#musosssetbuffers",
+ "extsnd.html#musoutformat", "sndclm.html#mus-output?", "sndclm.html#mus-phase", "extsnd.html#musprescaler",
+ "sndclm.html#mus-ramp", "sndclm.html#mus-random", "sndclm.html#mus-reset", "sndclm.html#mus-run",
+ "sndclm.html#mus-safety", "sndclm.html#mus-scaler", "extsnd.html#mussoundchans", "extsnd.html#mussoundcloseinput",
+ "extsnd.html#mussoundcloseoutput", "extsnd.html#mussoundcomment", "extsnd.html#mussounddataformat", "extsnd.html#mussounddatalocation",
+ "extsnd.html#mussounddatumsize", "extsnd.html#mussoundduration", "extsnd.html#mussoundforget", "extsnd.html#mussoundframes",
+ "extsnd.html#mussoundheadertype", "extsnd.html#mussoundlength", "extsnd.html#mussoundloopinfo", "extsnd.html#mussoundmarkinfo",
+ "extsnd.html#mussoundmaxamp", "extsnd.html#mussoundmaxampexists", "extsnd.html#mussoundopeninput", "extsnd.html#mussoundopenoutput",
+ "extsnd.html#mussoundprune", "extsnd.html#mussoundread", "extsnd.html#mussoundreopenoutput", "extsnd.html#mussoundreportcache",
+ "extsnd.html#mussoundsamples", "extsnd.html#mussoundseekframe", "extsnd.html#mussoundsrate", "extsnd.html#mussoundtypespecifier",
+ "extsnd.html#mussoundwrite", "extsnd.html#mussoundwritedate", "sndclm.html#mussrate", "sndclm.html#mus-width",
+ "sndclm.html#mus-xcoeff", "sndclm.html#mus-xcoeffs", "sndclm.html#mus-ycoeff", "sndclm.html#mus-ycoeffs",
+ "extsnd.html#nameclickhook", "sndclm.html#ncos", "sndclm.html#ncos?", "extsnd.html#newsound",
+ "extsnd.html#newsounddialog", "extsnd.html#newsoundhook", "extsnd.html#newwidgethook", "sndscm.html#nextframe",
+ "extsnd.html#nextsample", "sndclm.html#noid", "extsnd.html#normalizechannel", "sndscm.html#normalizeenvelope",
+ "sndclm.html#normalizepartials", "sndscm.html#normalizesound", "sndscm.html#normalizedmix", "sndclm.html#notch",
+ "sndscm.html#notchchannel", "sndscm.html#notchoutrumbleandhiss", "sndscm.html#notchselection", "sndscm.html#notchsound",
+ "sndclm.html#notch?", "sndscm.html#nrev", "sndclm.html#nrxycos", "sndclm.html#nrxycos?",
+ "sndclm.html#nrxysin", "sndclm.html#nrxysin?", "sndclm.html#nsin", "sndclm.html#nsin?",
+ "sndscm.html#offsetchannel", "sndscm.html#offsetsound", "sndclm.html#one-pole", "sndclm.html#one-pole?",
+ "sndclm.html#one-zero", "sndclm.html#one-zero?", "extsnd.html#openfiledialog", "extsnd.html#openfiledialogdirectory",
+ "extsnd.html#openhook", "sndscm.html#opennextfileindirectory", "extsnd.html#openrawsound", "extsnd.html#openrawsoundhook",
+ "extsnd.html#opensound", "extsnd.html#optimization", "extsnd.html#optimizationhook", "extsnd.html#orientationhook",
+ "sndclm.html#oscil", "sndclm.html#oscil?", "sndscm.html#oscopedoc", "sndclm.html#out-any",
+ "sndclm.html#outa", "sndclm.html#*output*", "extsnd.html#outputcommenthook", "extsnd.html#outputnamehook",
+ "sndscm.html#overlayrmsenv", "extsnd.html#padchannel", "sndscm.html#padmarks", "sndscm.html#padsound",
+ "sndscm.html#panmix", "sndscm.html#panmixvct", "sndclm.html#partialstopolynomial", "sndclm.html#partialstowave",
+ "extsnd.html#pausing", "extsnd.html#peakenvdir", "extsnd.html#peakenvhook", "extsnd.html#peaks",
+ "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave", "sndclm.html#phase-vocoder", "sndclm.html#phase-vocoder?",
+ "sndscm.html#pianodoc", "sndclm.html#pink-noise", "sndscm.html#placesound", "extsnd.html#play",
+ "sndscm.html#playbetweenmarks", "extsnd.html#playhook", "sndscm.html#playmixes", "sndscm.html#playsines",
+ "sndscm.html#playsyncdmarks", "extsnd.html#playerhome", "extsnd.html#playerQ", "extsnd.html#players",
+ "extsnd.html#playing", "sndscm.html#pluck", "sndclm.html#polartorectangular", "sndclm.html#polynomial",
+ "sndscm.html#polydoc", "sndclm.html#polyoid", "sndclm.html#polyoidenv", "sndclm.html#polyoid?",
+ "sndclm.html#polyshape", "sndclm.html#polyshape?", "sndclm.html#polywave", "sndclm.html#polywave?",
+ "extsnd.html#positiontox", "extsnd.html#positiontoy", "extsnd.html#positioncolor", "sndscm.html#powerenv",
+ "extsnd.html#preferencesdialog", "sndscm.html#previousframe", "extsnd.html#previoussample", "extsnd.html#printdialog",
+ "extsnd.html#printhook", "extsnd.html#printlength", "sndscm.html#profile", "extsnd.html#progressreport",
+ "extsnd.html#promptinminibuffer", "extsnd.html#ptreechannel", "sndclm.html#pulse-train", "sndclm.html#pulse-train?",
+ "extsnd.html#pushedbuttoncolor", "extsnd.html#quitbuttoncolor", "sndclm.html#radianstodegrees", "sndclm.html#radianstohz",
+ "extsnd.html#rampchannel", "sndclm.html#rand", "sndclm.html#rand-interp", "sndclm.html#rand-interp?",
+ "sndclm.html#rand?", "sndscm.html#readframe", "extsnd.html#readhook", "extsnd.html#readmixsample",
+ "extsnd.html#readonly", "extsnd.html#readregionsample", "extsnd.html#readsample", "sndclm.html#readin",
+ "sndclm.html#readin?", "extsnd.html#recorderdialog", "sndclm.html#rectangulartomagnitudes", "sndclm.html#rectangulartopolar",
+ "extsnd.html#redo", "extsnd.html#redochannel", "extsnd.html#redoedit", "sndscm.html#regiontoframe",
+ "extsnd.html#regiontointeger", "sndscm.html#regiontosounddata", "extsnd.html#regiontovct", "extsnd.html#regionchans",
+ "extsnd.html#regionframes", "extsnd.html#regiongraphstyle", "extsnd.html#regionhome", "extsnd.html#regionmaxamp",
+ "extsnd.html#regionmaxampposition", "sndscm.html#regionplaylist", "extsnd.html#regionposition", "extsnd.html#regionsample",
+ "extsnd.html#regionsamplerQ", "extsnd.html#regionsrate", "extsnd.html#regionok", "extsnd.html#eregions",
+ "sndscm.html#remembersoundstate", "extsnd.html#removefrommenu", "extsnd.html#reportinminibuffer", "sndscm.html#resetallhooks",
+ "extsnd.html#resetbuttoncolor", "extsnd.html#resetcontrols", "extsnd.html#resetlistenercursor", "extsnd.html#restorecontrols",
+ "sndclm.html#*reverb*", "extsnd.html#reverbdecay", "extsnd.html#reverbcontrolfeedback", "extsnd.html#reverbcontrollength",
+ "extsnd.html#reverbcontrollengthbounds", "extsnd.html#reverbcontrollowpass", "extsnd.html#reverbcontrolscale", "extsnd.html#reverbcontrolscalebounds",
+ "extsnd.html#reverbcontrolp", "extsnd.html#reversechannel", "extsnd.html#reversechannels", "sndscm.html#reverseenvelope",
+ "extsnd.html#reverseselection", "extsnd.html#reversesound", "extsnd.html#revertsound", "extsnd.html#rightsample",
+ "sndclm.html#ring-modulate", "sndscm.html#rmsgain", "sndscm.html#rmsgain", "sndscm.html#rmsenvelope",
+ "extsnd.html#rotatechannel", "sndscm.html#rubbersound", "extsnd.html#run", "extsnd.html#sample",
+ "sndclm.html#sampletofile", "sndclm.html#sampletofile?", "sndclm.html#sampletoframe", "extsnd.html#sampleratendQ",
+ "extsnd.html#samplerhome", "extsnd.html#samplerposition", "extsnd.html#samplerQ", "extsnd.html#samples",
+ "sndclm.html#samplestoseconds", "extsnd.html#sashcolor", "extsnd.html#savecontrols", "extsnd.html#savedir",
+ "extsnd.html#saveedithistory", "extsnd.html#saveenvelopes", "extsnd.html#savehook", "extsnd.html#savelistener",
+ "extsnd.html#savemacros", "sndscm.html#savemarkproperties", "extsnd.html#savemarks", "extsnd.html#savemix",
+ "sndscm.html#savemixes", "extsnd.html#saveregion", "extsnd.html#saveregiondialog", "extsnd.html#saveselection",
+ "extsnd.html#saveselectiondialog", "extsnd.html#savesound", "extsnd.html#savesoundas", "extsnd.html#savesounddialog",
+ "extsnd.html#savestate", "extsnd.html#savestatefile", "extsnd.html#savestatehook", "sndscm.html#sgfilter",
+ "sndclm.html#sawtooth-wave", "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby", "extsnd.html#scalechannel",
+ "sndscm.html#scaleenvelope", "sndscm.html#scalemixes", "extsnd.html#scaleselectionby", "extsnd.html#scaleselectionto",
+ "sndscm.html#scalesound", "sndscm.html#scaletempo", "extsnd.html#scaleto", "extsnd.html#scanchannel",
+ "sndscm.html#scansound", "sndscm.html#dspdocscanned", "sndscm.html#scentroid", "extsnd.html#scriptarg",
+ "extsnd.html#scriptargs", "extsnd.html#searchprocedure", "sndclm.html#secondstosamples", "extsnd.html#selectall",
+ "extsnd.html#selectchannel", "extsnd.html#selectchannelhook", "extsnd.html#selectsound", "extsnd.html#selectsoundhook",
+ "extsnd.html#selectedchannel", "extsnd.html#selecteddatacolor", "extsnd.html#selectedgraphcolor", "extsnd.html#selectedsound",
+ "extsnd.html#selection", "extsnd.html#selectiontomix", "sndscm.html#selectiontosounddata", "extsnd.html#selectionchans",
+ "extsnd.html#selectioncolor", "extsnd.html#selectioncreatesregion", "extsnd.html#selectionframes", "extsnd.html#selectionmaxamp",
+ "extsnd.html#selectionmaxampposition", "extsnd.html#selectionmember", "sndscm.html#selectionmembers", "extsnd.html#selectionposition",
+ "extsnd.html#selectionsrate", "extsnd.html#selectionok", "extsnd.html#sendmozilla", "sndscm.html#setglobalsync",
+ "extsnd.html#setsamples", "sndscm.html#shepardtone", "extsnd.html#shortfilename", "extsnd.html#showaxes",
+ "extsnd.html#showcontrols", "sndscm.html#showdiskspace", "extsnd.html#showgrid", "extsnd.html#showindices",
+ "extsnd.html#showlistener", "extsnd.html#showmarks", "extsnd.html#showmixwaveforms", "sndscm.html#showselection",
+ "extsnd.html#showselectiontransform", "sndscm.html#showsmptelabel", "extsnd.html#showsonogramcursor", "extsnd.html#showtransformpeaks",
+ "extsnd.html#showwidget", "extsnd.html#showyzero", "sndscm.html#silenceallmixes", "sndscm.html#silencemixes",
+ "sndclm.html#sinc-train", "extsnd.html#sincwidth", "sndscm.html#sineenvchannel", "sndscm.html#sineramp",
+ "sndscm.html#singerdoc", "extsnd.html#smoothchannel", "extsnd.html#smoothselection", "extsnd.html#smoothsound",
+ "sndscm.html#pins", "sndscm.html#snapmarktobeat", "sndscm.html#snapmixtobeat", "extsnd.html#sndtosample",
+ "extsnd.html#sndtosamplep", "extsnd.html#sndcolor", "extsnd.html#snderror", "extsnd.html#snderrorhook",
+ "extsnd.html#sndfont", "extsnd.html#sndgcs", "extsnd.html#sndhelp", "sndscm.html#sndscmhooks",
+ "extsnd.html#sndopenedsound", "extsnd.html#sndprint", "extsnd.html#sndspectrum", "extsnd.html#sndtempnam",
+ "extsnd.html#sndurl", "extsnd.html#sndurls", "extsnd.html#sndversion", "extsnd.html#sndwarning",
+ "extsnd.html#sndwarninghook", "sndscm.html#sndwarp", "sndscm.html#soundtoamp_env", "sndscm.html#soundtoframe",
+ "extsnd.html#soundtointeger", "sndscm.html#soundtosounddata", "extsnd.html#sounddata*", "extsnd.html#sounddata+",
+ "sndscm.html#sounddatatofile", "sndscm.html#sounddatatoframe", "sndscm.html#sounddatatosound", "extsnd.html#sounddatatosounddata",
+ "extsnd.html#sounddatatovct", "extsnd.html#sounddataadd", "extsnd.html#sounddatachans", "extsnd.html#sounddatacopy",
+ "extsnd.html#sounddatafill", "extsnd.html#sounddatalength", "extsnd.html#sounddatamaxamp", "extsnd.html#sounddatamultiply",
+ "extsnd.html#sounddataoffset", "extsnd.html#sounddatapeak", "extsnd.html#sounddataref", "extsnd.html#sounddatareverse",
+ "extsnd.html#sounddatascale", "extsnd.html#sounddataset", "extsnd.html#sounddata?", "extsnd.html#soundfileextensions",
+ "extsnd.html#soundfilep", "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp", "sndscm.html#sound-let",
+ "extsnd.html#soundloopinfo", "extsnd.html#soundproperties", "extsnd.html#soundproperty", "extsnd.html#soundwidgets",
+ "extsnd.html#soundp", "extsnd.html#soundfontinfo", "extsnd.html#sounds", "sndscm.html#twotab",
+ "sndscm.html#spectralpolynomial", "extsnd.html#spectrohop", "extsnd.html#spectroxangle", "extsnd.html#spectroxscale",
+ "extsnd.html#spectroyangle", "extsnd.html#spectroyscale", "extsnd.html#spectrozangle", "extsnd.html#spectrozscale",
+ "sndclm.html#spectrum", "sndscm.html#spectrumtocoeffs", "extsnd.html#spectrumend", "extsnd.html#spectrumstart",
+ "extsnd.html#speedcontrol", "extsnd.html#speedcontrolbounds", "extsnd.html#speedstyle", "extsnd.html#speedtones",
+ "sndclm.html#square-wave", "sndclm.html#square-wave?", "extsnd.html#squelchupdate", "sndscm.html#squelchvowels",
+ "extsnd.html#srate", "sndclm.html#src", "extsnd.html#srcchannel", "sndscm.html#srcduration",
+ "sndscm.html#srcmixes", "extsnd.html#srcsoundselection", "extsnd.html#srcsound", "sndclm.html#src?",
+ "sndclm.html#ssb-am", "sndclm.html#ssb-am?", "sndscm.html#ssbbank", "sndscm.html#ssbbankenv",
+ "sndscm.html#ssbfm", "extsnd.html#starthook", "extsnd.html#startplaying", "extsnd.html#startplayinghook",
+ "extsnd.html#startplayingselectionhook", "extsnd.html#startprogressreport", "sndscm.html#startwaterfall", "sndscm.html#stereotomono",
+ "extsnd.html#stopdachook", "extsnd.html#stopplayer", "extsnd.html#stopplaying", "extsnd.html#stopplayinghook",
+ "extsnd.html#stopplayingselectionhook", "sndscm.html#stretchenvelope", "sndscm.html#superimposeffts", "extsnd.html#swapchannels",
+ "sndscm.html#swapselectionchannels", "extsnd.html#sync", "sndscm.html#sync-all", "extsnd.html#syncmax",
+ "extsnd.html#syncdmarks", "sndclm.html#table-lookup", "sndclm.html#table-lookup?", "sndclm.html#tap",
+ "sndscm.html#telephone", "extsnd.html#tempdir", "extsnd.html#textfocuscolor", "extsnd.html#timegraphhook",
+ "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype", "extsnd.html#timegraphp", "extsnd.html#tinyfont",
+ "s7.html#tracehook", "extsnd.html#trackingcursorstyle", "extsnd.html#transformtointeger", "extsnd.html#transformtovct",
"extsnd.html#transformdialog", "extsnd.html#transformframes", "extsnd.html#transformgraphstyle", "extsnd.html#transformgraphtype",
"extsnd.html#transformgraphp", "extsnd.html#normalizefft", "extsnd.html#transformsample", "extsnd.html#transformsize",
"extsnd.html#transformtype", "extsnd.html#transformp", "sndscm.html#transposemixes", "extsnd.html#trapsegfault",
"sndclm.html#triangle-wave", "sndclm.html#triangle-wave?", "sndscm.html#tubebell", "sndclm.html#two-pole",
"sndclm.html#two-pole?", "sndclm.html#two-zero", "sndclm.html#two-zero?", "extsnd.html#unbindkey",
- "sndscm.html#unclipchannel", "extsnd.html#undo", "extsnd.html#undochannel", "extsnd.html#undoedit",
- "extsnd.html#undohook", "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph",
- "extsnd.html#updatesound", "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#sndmotifdoc",
- "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "extsnd.html#vct", "extsnd.html#vcttimes",
- "extsnd.html#vctplus", "extsnd.html#vcttochannel", "sndscm.html#vcttofile", "sndscm.html#vcttoframe",
- "extsnd.html#vcttolist", "extsnd.html#vcttosounddata", "extsnd.html#vcttostring", "extsnd.html#vcttovector",
- "extsnd.html#vctadd", "extsnd.html#vctcopy", "extsnd.html#vctfill", "extsnd.html#vctlength",
- "extsnd.html#vctmap", "extsnd.html#vctmove", "extsnd.html#vctmultiply", "extsnd.html#vctoffset",
- "extsnd.html#vctpeak", "sndscm.html#vctpolynomial", "extsnd.html#vctref", "extsnd.html#vctreverse",
- "extsnd.html#vctscale", "extsnd.html#vctset", "extsnd.html#vctsubseq", "extsnd.html#vctsubtract",
- "extsnd.html#vctp", "extsnd.html#vectortovct", "extsnd.html#verbosecursor", "extsnd.html#viewfilesamp",
- "extsnd.html#viewfilesampenv", "extsnd.html#viewfilesdialog", "extsnd.html#viewfilesfiles", "extsnd.html#viewfilesselecthook",
- "extsnd.html#viewfilesselectedfiles", "extsnd.html#viewfilessort", "extsnd.html#viewfilesspeed", "extsnd.html#viewfilesspeedstyle",
- "extsnd.html#viewmixesdialog", "extsnd.html#viewregionsdialog", "extsnd.html#viewsound", "sndscm.html#singerdoc",
- "sndscm.html#voicedtounvoiced", "sndscm.html#volterrafilter", "sndclm.html#wave-train", "sndclm.html#wave-train?",
- "extsnd.html#wavelettype", "sndscm.html#pqwvox", "extsnd.html#wavohop", "extsnd.html#wavotrace",
- "sndclm.html#weighted-moving-average", "extsnd.html#widgetposition", "extsnd.html#widgetsize", "extsnd.html#widgettext",
- "extsnd.html#windowheight", "extsnd.html#windowproperty", "extsnd.html#windowpropertychangedhook", "sndscm.html#windowsamples",
- "extsnd.html#windowwidth", "extsnd.html#windowx", "extsnd.html#windowy", "extsnd.html#withbackgroundprocesses",
- "extsnd.html#withfilemonitor", "extsnd.html#withgl", "extsnd.html#withinsetgraph", "sndscm.html#withlocalhook",
- "sndscm.html#withmarkedsound", "extsnd.html#withmixtags", "sndscm.html#withmixedsound", "sndscm.html#withmixedsoundtonotelist",
- "extsnd.html#withpointerfocus", "extsnd.html#withrelativepanes", "sndscm.html#withreopenmenu", "sndscm.html#withsound",
- "sndscm.html#withtempsound", "sndscm.html#withtemporaryselection", "sndscm.html#withthreadedchannels", "sndscm.html#withthreadedsound",
- "extsnd.html#withtrackingcursor", "extsnd.html#withverbosecursor", "extsnd.html#xtoposition", "extsnd.html#xaxislabel",
- "extsnd.html#xaxisstyle", "extsnd.html#xbounds", "extsnd.html#xpositionslider", "extsnd.html#xzoomslider",
- "extsnd.html#xrampchannel", "extsnd.html#ytoposition", "extsnd.html#yaxislabel", "extsnd.html#ybounds",
- "extsnd.html#ypositionslider", "extsnd.html#yzoomslider", "sndscm.html#ztransform", "extsnd.html#zeropad",
- "sndscm.html#zipsound", "sndscm.html#zipper", "extsnd.html#zoomcolor", "extsnd.html#zoomfocusstyle"};
+ "s7.html#unboundvariablehook", "sndscm.html#unclipchannel", "extsnd.html#undo", "extsnd.html#undochannel",
+ "extsnd.html#undoedit", "extsnd.html#undohook", "sndscm.html#updategraphs", "extsnd.html#updatehook",
+ "extsnd.html#updatelispgraph", "extsnd.html#updatesound", "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph",
+ "sndscm.html#sndmotifdoc", "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "extsnd.html#vct",
+ "extsnd.html#vcttimes", "extsnd.html#vctplus", "extsnd.html#vcttochannel", "sndscm.html#vcttofile",
+ "sndscm.html#vcttoframe", "extsnd.html#vcttolist", "extsnd.html#vcttosounddata", "extsnd.html#vcttostring",
+ "extsnd.html#vcttovector", "extsnd.html#vctadd", "extsnd.html#vctcopy", "extsnd.html#vctfill",
+ "extsnd.html#vctlength", "extsnd.html#vctmap", "extsnd.html#vctmove", "extsnd.html#vctmultiply",
+ "extsnd.html#vctoffset", "extsnd.html#vctpeak", "sndscm.html#vctpolynomial", "extsnd.html#vctref",
+ "extsnd.html#vctreverse", "extsnd.html#vctscale", "extsnd.html#vctset", "extsnd.html#vctsubseq",
+ "extsnd.html#vctsubtract", "extsnd.html#vctp", "extsnd.html#vectortovct", "s7.html#vectorprintlength",
+ "extsnd.html#verbosecursor", "extsnd.html#viewfilesamp", "extsnd.html#viewfilesampenv", "extsnd.html#viewfilesdialog",
+ "extsnd.html#viewfilesfiles", "extsnd.html#viewfilesselecthook", "extsnd.html#viewfilesselectedfiles", "extsnd.html#viewfilessort",
+ "extsnd.html#viewfilesspeed", "extsnd.html#viewfilesspeedstyle", "extsnd.html#viewmixesdialog", "extsnd.html#viewregionsdialog",
+ "extsnd.html#viewsound", "sndscm.html#singerdoc", "sndscm.html#voicedtounvoiced", "sndscm.html#volterrafilter",
+ "sndclm.html#wave-train", "sndclm.html#wave-train?", "extsnd.html#wavelettype", "sndscm.html#pqwvox",
+ "extsnd.html#wavohop", "extsnd.html#wavotrace", "sndclm.html#weighted-moving-average", "extsnd.html#widgetposition",
+ "extsnd.html#widgetsize", "extsnd.html#widgettext", "extsnd.html#windowheight", "extsnd.html#windowproperty",
+ "extsnd.html#windowpropertychangedhook", "sndscm.html#windowsamples", "extsnd.html#windowwidth", "extsnd.html#windowx",
+ "extsnd.html#windowy", "extsnd.html#withbackgroundprocesses", "extsnd.html#withfilemonitor", "extsnd.html#withgl",
+ "extsnd.html#withinsetgraph", "sndscm.html#withlocalhook", "sndscm.html#withmarkedsound", "extsnd.html#withmixtags",
+ "sndscm.html#withmixedsound", "sndscm.html#withmixedsoundtonotelist", "extsnd.html#withpointerfocus", "extsnd.html#withrelativepanes",
+ "sndscm.html#withreopenmenu", "sndscm.html#withsound", "sndscm.html#withtempsound", "sndscm.html#withtemporaryselection",
+ "sndscm.html#withthreadedchannels", "sndscm.html#withthreadedsound", "extsnd.html#withtrackingcursor", "extsnd.html#withverbosecursor",
+ "extsnd.html#xtoposition", "extsnd.html#xaxislabel", "extsnd.html#xaxisstyle", "extsnd.html#xbounds",
+ "extsnd.html#xpositionslider", "extsnd.html#xzoomslider", "extsnd.html#xrampchannel", "extsnd.html#ytoposition",
+ "extsnd.html#yaxislabel", "extsnd.html#ybounds", "extsnd.html#ypositionslider", "extsnd.html#yzoomslider",
+ "sndscm.html#ztransform", "extsnd.html#zeropad", "sndscm.html#zipsound", "sndscm.html#zipper",
+ "extsnd.html#zoomcolor", "extsnd.html#zoomfocusstyle"};
static const char *Copying_xrefs[] = {
@@ -919,7 +926,7 @@ static const char *Regions_xrefs[] = {
"Max length of region list: {max-regions}",
"Whether selection creates a region: {selection-creates-region}",
"To play region repeatedly: {play-region-forever}",
- "Start region browser from Scheme: {view-regions-dialog}",
+ "Start region browser: {view-regions-dialog}",
"All about regions: {regions}",
"The region dialog: {region browser}",
"Region rms amp: {region-rms}",
@@ -1715,22 +1722,29 @@ NULL,
#define AUTOLOAD_FILES 63
static const char *autoload_files[AUTOLOAD_FILES] = {
- "analog-filter.scm", "animals.scm", "autosave.scm", "big-gens.scm", "bird.scm", "clean.scm", "clm-ins.scm",
- "cmn-glyphs.lisp", "dlocsig.scm", "draw.scm", "dsp.scm", "env.scm", "enved.scm",
- "examp.scm", "expandn.scm", "extensions.scm", "fade.scm", "frame.scm", "freeverb.scm",
- "fullmix.scm", "generators.scm", "grani.scm", "hooks.scm", "index.scm", "jcrev.scm",
- "jcvoi.scm", "maraca.scm", "marks.scm", "maxf.scm", "mix.scm", "mixer.scm",
- "moog.scm", "musglyphs.scm", "nb.scm", "noise.scm", "numerics.scm", "peak-phases.scm",
- "piano.scm", "play.scm", "poly.scm", "popup.scm", "prc95.scm", "pretty-print.scm",
- "primes.scm", "pvoc.scm", "rtio.scm", "rubber.scm", "selection.scm", "singer.scm",
- "snd10.scm", "snd11.scm", "snd6.scm", "snd7.scm", "snd8.scm", "snd9.scm",
+ "analog-filter.scm", "animals.scm", "autosave.scm", "big-gens.scm", "binary-io.scm", "bird.scm", "clean.scm",
+ "clm-ins.scm", "cmn-glyphs.lisp", "dlocsig.scm", "draw.scm", "dsp.scm", "env.scm",
+ "enved.scm", "examp.scm", "expandn.scm", "extensions.scm", "fade.scm", "frame.scm",
+ "freeverb.scm", "fullmix.scm", "generators.scm", "grani.scm", "hooks.scm", "index.scm",
+ "jcrev.scm", "jcvoi.scm", "maraca.scm", "marks.scm", "maxf.scm", "mix.scm",
+ "mixer.scm", "moog.scm", "musglyphs.scm", "nb.scm", "noise.scm", "numerics.scm",
+ "peak-phases.scm", "piano.scm", "play.scm", "poly.scm", "popup.scm", "prc95.scm",
+ "pretty-print.scm", "primes.scm", "pvoc.scm", "rtio.scm", "rubber.scm", "selection.scm",
+ "singer.scm", "snd10.scm", "snd11.scm", "snd7.scm", "snd8.scm", "snd9.scm",
"snddiff.scm", "sndwarp.scm", "spokenword.scm", "stochastic.scm", "strad.scm", "v.scm",
"ws.scm", "zip.scm"};
-#define AUTOLOAD_NAMES 1689
+#define AUTOLOAD_NAMES 1757
static const char *autoload_names[AUTOLOAD_NAMES] = {
- "->frequency", "->sample", "->x", "->y", "?",
+ "*clm-array-print-length*", "*clm-channels*", "*clm-clipped*", "*clm-data-format*", "*clm-default-frequency*",
+ "*clm-delete-reverb*", "*clm-file-buffer-size*", "*clm-file-name*", "*clm-header-type*",
+ "*clm-locsig-type*", "*clm-notehook*", "*clm-output-safety*", "*clm-play*",
+ "*clm-player*", "*clm-reverb*", "*clm-reverb-channels*", "*clm-reverb-data*",
+ "*clm-safety*", "*clm-search-list*", "*clm-srate*", "*clm-statistics*",
+ "*clm-table-size*", "*clm-threads*", "*clm-verbose*", "*clm-with-sound-depth*",
+ "*default-player*", "*definstrument-hook*", "*to-snd*", "->frequency",
+ "->sample", "->x", "->y", "?",
"Ci", "Si", "a-cricket", "a-frog",
"abcos", "abcos-methods", "abcos?", "absin",
"absin-methods", "absin?", "acadian-flycatcher", "acorn-woodpecker",
@@ -1739,10 +1753,10 @@ static const char *autoload_names[AUTOLOAD_NAMES] = {
"adjustable-sawtooth-wave", "adjustable-sawtooth-wave-methods", "adjustable-sawtooth-wave?", "adjustable-square-wave",
"adjustable-square-wave-methods", "adjustable-square-wave?", "adjustable-triangle-wave", "adjustable-triangle-wave-methods",
"adjustable-triangle-wave?", "adsat", "after-save-as-hook-replace-sound", "all-chans",
- "am", "amargosa-toad", "american-crow", "american-crow-no-formants",
- "american-robin", "american-toad", "amplify", "analog->digital",
- "angles-in-degree", "angles-in-radians", "angles-in-turns", "anoi",
- "any-env-channel", "any-random", "append-to-minibuffer", "aref",
+ "am", "amargosa-toad", "ambisonics-channels", "american-crow",
+ "american-crow-no-formants", "american-robin", "american-toad", "amplify",
+ "analog->digital", "angles-in-degree", "angles-in-radians", "angles-in-turns",
+ "anoi", "any-env-channel", "any-random", "aref",
"arrange-speakers", "ash-throated-flycatcher", "asyfm-I", "asyfm-J",
"asyfm-methods", "asyfm?", "attack-point", "attract",
"auto-dot", "auto-save", "aux-f", "aux-g",
@@ -1790,84 +1804,85 @@ static const char *autoload_names[AUTOLOAD_NAMES] = {
"carolina-grasshopper", "carolina-wren", "cascade->canonical", "cassins-sparrow",
"cassins-vireo", "cedar-waxwing", "cellon", "chain-dsps",
"change-fft-popup-color", "change-graph-popup-color", "change-label", "change-listener-popup-color",
- "change-menu-color", "change-property", "change-selection-popup-color", "change-window-property",
- "channel-average-power", "channel-clipped?", "channel-distance", "channel-lp",
- "channel-lp-inf", "channel-mean", "channel-norm", "channel-polynomial",
- "channel-rms", "channel-total-energy", "channel-variance", "channel2-angle",
- "channel2-coefficient-of-projection", "channel2-inner-product", "channel2-orthogonal?", "channels-equal?",
- "channels=?", "cheby-hka", "chebyshev", "chebyshev-polynomial",
- "chebyshev-prototype", "check-for-unsaved-edits", "check-freq", "check-mix-tags",
- "checkpt", "chestnut-sided-warbler", "chipping-sparrow", "chordalize",
- "chorus", "chuck-wills-widow", "circle", "cis",
- "clamp-rxycos-r", "clarinet", "clean-channel", "clean-sound",
- "clear-selection", "click-for-listener-help", "click-middle-button-to-open-next-file-in-directory", "click-to-sync",
- "clm-display-globals", "clm-expsrc", "clm-find-file", "clm-load",
- "close-all-buffers", "close-buffer", "cnvrev", "cnvtest",
- "color-mixes", "color-samples", "comb-chord", "comb-filter",
- "common-gull", "common-loon-1", "common-loon-2", "common-pauraque",
- "common-yellowthroat", "compand", "compand-channel", "compand-sound",
- "compute-string", "compute-uniform-circular-string", "concatenate-envelopes", "confused-ground-cricket",
- "constant-velocity", "contrast-channel", "contrast-sound", "convolve-arrays",
- "copy-frame-reader", "copy-list", "cosine-summation", "crawfish-frog",
- "create-initial-envelopes", "crested-caracara", "cross-correlate", "cross-fade",
- "cross-synthesis", "current-label", "curveto", "dac-is-running",
- "dark-eyed-junco", "davis-tree-cricket", "db-envelope", "dblsum",
- "dblsum-methods", "dblsum?", "dc-block", "define-selection-via-marks",
- "delay-channel-mixes", "delaya", "delayl", "delete-from-out-to-in",
- "delete-mix", "delete-selection-and-smooth", "describe", "describe-hook",
- "describe-mark", "dht", "differentiator", "display-bark-fft",
- "display-colored-samples", "display-correlation", "display-db", "display-energy",
- "display-previous-edits", "display-samples-in-color", "dissolve-fade", "distance",
- "distances-in-feet", "distances-in-meters", "dither-channel", "dither-sound",
- "dlocsig", "dlya-methods", "dlya?", "do-all-chans",
- "do-chans", "do-go-on", "do-sound-chans", "dog-day-cicada",
- "dolph", "dolph-1", "down-oct", "draw",
- "draw-128th-rest", "draw-16th-rest", "draw-32nd-rest", "draw-64th-rest",
- "draw-8th-flag-down", "draw-8th-flag-up", "draw-8th-rest", "draw-a-note",
- "draw-accent", "draw-arpeggio", "draw-arpeggios", "draw-bass-clef",
- "draw-breath-mark", "draw-c-clef", "draw-caesura", "draw-circled-x",
- "draw-coda", "draw-common-time", "draw-cut-time", "draw-diamond",
- "draw-diamond-1", "draw-double-flat", "draw-double-mordent", "draw-double-sharp",
- "draw-double-whole-note", "draw-double-whole-rest", "draw-down-bow", "draw-eight",
- "draw-extend-flag-down", "draw-extend-flag-up", "draw-f", "draw-fermata",
- "draw-filled-diamond-1", "draw-five", "draw-flat", "draw-four",
- "draw-half-note", "draw-half-rest", "draw-left-paren", "draw-lig-p",
- "draw-lower-bracket", "draw-m", "draw-measure-rest", "draw-mordent",
- "draw-mslash", "draw-n", "draw-natural", "draw-niente",
- "draw-nine", "draw-one", "draw-p", "draw-ped",
- "draw-pedal-off", "draw-percussion-clef", "draw-plus", "draw-quarter-note",
- "draw-quarter-rest", "draw-r", "draw-repeat-sign", "draw-rhythmX",
- "draw-right-paren", "draw-s", "draw-segno", "draw-seven",
- "draw-sharp", "draw-six", "draw-slash", "draw-square",
- "draw-staff", "draw-subito", "draw-three", "draw-tnecca",
- "draw-tr", "draw-treble-clef", "draw-triangle", "draw-trill-section",
- "draw-trill-sections", "draw-turn", "draw-two", "draw-up-bow",
- "draw-upper-bracket", "draw-upside-down-fermata", "draw-wedge", "draw-whole-note",
- "draw-whole-rest", "draw-z", "draw-zero", "drone",
- "dusky-flycatcher", "eared-grebe", "eastern-bluebird", "eastern-meadowlark",
- "eastern-wood-pewee-1", "eastern-wood-pewee-2", "echo", "edhist-apply-edits",
- "edhist-clear-edits", "edhist-help-edits", "edhist-reapply-edits", "edhist-save-edits",
- "edit-fft-popup-menu", "edit-graph-popup-menu", "edit-history-popup-menu", "eliminate-hum",
- "elliptic-prototype", "env-expt-channel", "env-mixes", "env-sound-interp",
- "env-squared-channel", "envelope-exp", "envelope-interp", "envelope-last-x",
- "envelope-or-number", "enveloped-mix", "enveloping-key-press", "eoddcos",
- "eoddcos-methods", "eoddcos?", "ercos", "ercos-methods",
- "ercos?", "ercoser", "erssb", "erssb-methods",
- "erssb?", "eval-between-marks", "eval-over-selection", "evening-grosbeak",
- "every-sample?", "exp-envelope", "exp-snd", "expandn",
- "expfil", "explode-sf2", "exponentially-weighted-moving-average", "exponentially-weighted-moving-average-methods",
- "exponentially-weighted-moving-average?", "expseg", "expseg-methods", "expseg?",
- "expsnd", "expsrc", "factorial", "factorize",
- "fast-calling-tree-cricket", "fejer-sum", "fft-cancel", "fft-edit",
- "fft-env-data", "fft-env-edit", "fft-env-interp", "fft-peak",
- "fft-smoother", "fft-squelch", "field-sparrow", "file->sound-data",
- "file->vct", "files-popdown-info", "files-popup-info", "fill-in",
- "fillfnc", "filter-fft", "filter-selection-and-smooth", "filtered-env",
- "find-click", "find-if", "find-mix", "find-noddsin-max",
- "find-nxysin-max", "find-other-mins", "find-pitch", "find-sine",
- "finfo", "finish-with-sound", "first-mark-in-window-at-left", "fit-path",
- "fit-selection-between-marks", "flammulated-owl", "flash-selected-data", "flatten-partials",
- "flecho", "flipxy", "flocsig", "flocsig-methods",
+ "change-menu-color", "change-selection-popup-color", "change-window-property", "channel-average-power",
+ "channel-clipped?", "channel-distance", "channel-lp", "channel-lp-inf",
+ "channel-mean", "channel-norm", "channel-polynomial", "channel-rms",
+ "channel-total-energy", "channel-variance", "channel2-angle", "channel2-coefficient-of-projection",
+ "channel2-inner-product", "channel2-orthogonal?", "channels-equal?", "channels=?",
+ "cheby-hka", "chebyshev", "chebyshev-polynomial", "chebyshev-prototype",
+ "check-for-unsaved-edits", "check-freq", "check-mix-tags", "checkpt",
+ "chestnut-sided-warbler", "chipping-sparrow", "chordalize", "chorus",
+ "chuck-wills-widow", "circle", "cis", "clamp-rxycos-r",
+ "clarinet", "clean-channel", "clean-sound", "clear-selection",
+ "click-for-listener-help", "click-middle-button-to-open-next-file-in-directory", "click-to-sync", "clm-display-globals",
+ "clm-expsrc", "clm-find-file", "clm-load", "close-all-buffers",
+ "close-buffer", "cnvrev", "cnvtest", "color-mixes",
+ "color-samples", "comb-chord", "comb-filter", "common-gull",
+ "common-loon-1", "common-loon-2", "common-pauraque", "common-yellowthroat",
+ "compand", "compand-channel", "compand-sound", "compute-string",
+ "compute-uniform-circular-string", "concatenate-envelopes", "confused-ground-cricket", "constant-velocity",
+ "contrast-channel", "contrast-sound", "copy-frame-reader", "copy-list",
+ "cosine-summation", "crawfish-frog", "create-initial-envelopes", "crested-caracara",
+ "cross-correlate", "cross-fade", "cross-synthesis", "current-label",
+ "curveto", "dac-is-running", "dark-eyed-junco", "davis-tree-cricket",
+ "db-envelope", "dblsum", "dblsum-methods", "dblsum?",
+ "dc-block", "def-clm-struct", "defgenerator", "define-selection-via-marks",
+ "definstrument", "delay-channel-mixes", "delaya", "delayl",
+ "delete-from-out-to-in", "delete-mix", "delete-selection-and-smooth", "describe",
+ "describe-hook", "describe-mark", "dht", "differentiator",
+ "display-bark-fft", "display-colored-samples", "display-correlation", "display-db",
+ "display-energy", "display-previous-edits", "display-samples-in-color", "dissolve-fade",
+ "distance", "distances-in-feet", "distances-in-meters", "dither-channel",
+ "dither-sound", "dlocsig", "dlya-methods", "dlya?",
+ "do-all-chans", "do-chans", "do-go-on", "do-sound-chans",
+ "do?", "dog-day-cicada", "dolph", "dolph-1",
+ "down-oct", "draw", "draw-128th-rest", "draw-16th-rest",
+ "draw-32nd-rest", "draw-64th-rest", "draw-8th-flag-down", "draw-8th-flag-up",
+ "draw-8th-rest", "draw-a-note", "draw-accent", "draw-arpeggio",
+ "draw-arpeggios", "draw-bass-clef", "draw-breath-mark", "draw-c-clef",
+ "draw-caesura", "draw-circled-x", "draw-coda", "draw-common-time",
+ "draw-cut-time", "draw-diamond", "draw-diamond-1", "draw-double-flat",
+ "draw-double-mordent", "draw-double-sharp", "draw-double-whole-note", "draw-double-whole-rest",
+ "draw-down-bow", "draw-eight", "draw-extend-flag-down", "draw-extend-flag-up",
+ "draw-f", "draw-fermata", "draw-filled-diamond-1", "draw-five",
+ "draw-flat", "draw-four", "draw-half-note", "draw-half-rest",
+ "draw-left-paren", "draw-lig-p", "draw-lower-bracket", "draw-m",
+ "draw-measure-rest", "draw-mordent", "draw-mslash", "draw-n",
+ "draw-natural", "draw-niente", "draw-nine", "draw-one",
+ "draw-p", "draw-ped", "draw-pedal-off", "draw-percussion-clef",
+ "draw-plus", "draw-quarter-note", "draw-quarter-rest", "draw-r",
+ "draw-repeat-sign", "draw-rhythmX", "draw-right-paren", "draw-s",
+ "draw-segno", "draw-seven", "draw-sharp", "draw-six",
+ "draw-slash", "draw-square", "draw-staff", "draw-subito",
+ "draw-three", "draw-tnecca", "draw-tr", "draw-treble-clef",
+ "draw-triangle", "draw-trill-section", "draw-trill-sections", "draw-turn",
+ "draw-two", "draw-up-bow", "draw-upper-bracket", "draw-upside-down-fermata",
+ "draw-wedge", "draw-whole-note", "draw-whole-rest", "draw-z",
+ "draw-zero", "drone", "dusky-flycatcher", "eared-grebe",
+ "eastern-bluebird", "eastern-meadowlark", "eastern-wood-pewee-1", "eastern-wood-pewee-2",
+ "echo", "edhist-apply-edits", "edhist-clear-edits", "edhist-help-edits",
+ "edhist-reapply-edits", "edhist-save-edits", "edit-fft-popup-menu", "edit-graph-popup-menu",
+ "edit-history-popup-menu", "eliminate-hum", "elliptic-prototype", "env-expt-channel",
+ "env-mixes", "env-sound-interp", "env-squared-channel", "envelope-exp",
+ "envelope-interp", "envelope-last-x", "envelope-or-number", "enveloped-mix",
+ "enveloping-key-press", "eoddcos", "eoddcos-methods", "eoddcos?",
+ "ercos", "ercos-methods", "ercos?", "ercoser",
+ "erssb", "erssb-methods", "erssb?", "eval-between-marks",
+ "eval-over-selection", "evening-grosbeak", "every-sample?", "exp-envelope",
+ "exp-snd", "expandn", "expfil", "explode-sf2",
+ "exponentially-weighted-moving-average", "exponentially-weighted-moving-average-methods", "exponentially-weighted-moving-average?", "expseg",
+ "expseg-methods", "expseg?", "expsnd", "expsrc",
+ "factorial", "factorize", "fast-calling-tree-cricket", "fejer-sum",
+ "fft-cancel", "fft-edit", "fft-env-data", "fft-env-edit",
+ "fft-env-interp", "fft-peak", "fft-smoother", "fft-squelch",
+ "field-sparrow", "file->sound-data", "file->vct", "files-popdown-info",
+ "files-popup-info", "fill-in", "fillfnc", "filter-fft",
+ "filter-selection-and-smooth", "filtered-env", "find-click", "find-if",
+ "find-mix", "find-noddsin-max", "find-nxysin-max", "find-other-mins",
+ "find-pitch", "find-sine", "finfo", "finish-with-sound",
+ "first-mark-in-window-at-left", "fit-path", "fit-selection-between-marks", "flammulated-owl",
+ "flash-selected-data", "flatten-partials", "flecho", "flipxy",
+ "float64_to_int32", "float64_to_int64", "flocsig", "flocsig-methods",
"flocsig?", "fltit-1", "flute", "fm-bell",
"fm-cancellation", "fm-cascade-component", "fm-complex-component", "fm-drum",
"fm-insect", "fm-noise", "fm-parallel-component", "fm-trumpet",
@@ -1900,132 +1915,131 @@ static const char *autoload_names[AUTOLOAD_NAMES] = {
"hz->2pi", "if-cursor-follows-play-it-stays-where-play-stopped", "in-out", "inca-dove-1",
"inca-dove-2", "indri", "init-with-sound", "insert-channel",
"insert-frame", "insert-sound-data", "insert-vct", "inspect-sampler",
- "integrate-envelope", "inverse-chebyshev-prototype", "inverse-integrate", "invert-filter",
- "invert-matrix", "izcos", "izcos-methods", "izcos?",
- "j0evencos", "j0evencos-methods", "j0evencos?", "j0j1cos",
- "j0j1cos-methods", "j0j1cos?", "j2cos", "j2cos-methods",
- "j2cos?", "jackson-sum", "jc-reverb", "jettable",
- "jjcos", "jjcos-methods", "jjcos?", "jl-reverb",
- "jncos", "jncos-methods", "jncos?", "jpcos",
- "jpcos-methods", "jpcos?", "jycos", "jycos-methods",
- "jycos?", "k2cos", "k2cos-methods", "k2cos?",
- "k2sin", "k2sin-methods", "k2sin?", "k2ssb",
- "k2ssb-methods", "k2ssb?", "k3sin", "k3sin-methods",
- "k3sin?", "kalman-filter-channel", "keypad-spectro-bindings", "killdeer",
- "kirtlands-warbler", "knudsens-frog", "kosine-summation", "krksin",
- "krksin-methods", "krksin?", "lag?", "laguerre",
- "laguerre-polynomial", "last", "lbj-piano", "least-bittern",
- "least-flycatcher", "legendre", "legendre-polynomial", "legendre-sum",
- "lesser-nighthawk", "linear-src-channel", "lineto", "linnaeus-cicada",
- "lip", "lip-set-freq", "list->hook", "list??",
- "listp", "literal-render", "little-grass-frog", "local-data",
- "local-peak", "local-rms", "local-smooth", "locate-zero",
- "lock-track", "log10", "loggerhead-shrike-1", "loggerhead-shrike-2",
- "long-eared-owl", "long-spurred-meadow-katydid", "loop-between-marks", "lowpass",
- "lp", "lpc-coeffs", "lpc-predict", "lucys-warbler",
- "lutish", "lyric-cicada", "macgillivrays-warbler", "machine1",
- "magnolia-warbler", "make-a-even", "make-a-odd", "make-abcos",
- "make-absin", "make-adjustable-oscil", "make-adjustable-sawtooth-wave", "make-adjustable-square-wave",
- "make-adjustable-triangle-wave", "make-asyfm", "make-bandpass", "make-bandstop",
- "make-bess", "make-bessel-bandpass", "make-bessel-bandstop", "make-bessel-highpass",
- "make-bessel-lowpass", "make-bezier-1", "make-bezier-path", "make-big-ncos",
- "make-big-nsin", "make-big-one-pole", "make-big-one-zero", "make-big-oscil",
- "make-big-table-lookup", "make-biquad", "make-birds", "make-blackman",
- "make-bowtable", "make-brown-noise", "make-butter-band-pass", "make-butter-band-reject",
- "make-butter-bp", "make-butter-bs", "make-butter-high-pass", "make-butter-hp",
- "make-butter-low-pass", "make-butter-lp", "make-butterworth-bandpass", "make-butterworth-bandstop",
- "make-butterworth-highpass", "make-butterworth-lowpass", "make-chebyshev-bandpass", "make-chebyshev-bandstop",
- "make-chebyshev-highpass", "make-chebyshev-lowpass", "make-closed-path", "make-current-window-display",
- "make-db-env", "make-dblsum", "make-dc-block", "make-delaya",
- "make-delayl", "make-differentiator", "make-dlocsig", "make-dlya",
- "make-eliminate-hum", "make-elliptic-bandpass", "make-elliptic-bandstop", "make-elliptic-highpass",
- "make-elliptic-lowpass", "make-eoddcos", "make-ercos", "make-erssb",
- "make-exponentially-weighted-moving-average", "make-expseg", "make-flocsig", "make-fm-noise",
- "make-fm2", "make-fmssb", "make-frame-reader", "make-gr-env",
- "make-green-noise", "make-green-noise-interp", "make-grn", "make-group",
- "make-highpass", "make-hilbert-transform", "make-iir-band-pass-2", "make-iir-band-stop-2",
- "make-iir-high-pass-1", "make-iir-high-pass-2", "make-iir-low-pass-1", "make-iir-low-pass-2",
- "make-inverse-chebyshev-bandpass", "make-inverse-chebyshev-bandstop", "make-inverse-chebyshev-highpass", "make-inverse-chebyshev-lowpass",
- "make-izcos", "make-j0evencos", "make-j0j1cos", "make-j2cos",
- "make-jjcos", "make-jncos", "make-jpcos", "make-jycos",
- "make-k2cos", "make-k2sin", "make-k2ssb", "make-k3sin",
- "make-krksin", "make-list-1", "make-literal-path", "make-literal-polar-path",
- "make-lowpass", "make-mfilter", "make-mflt", "make-moog",
- "make-moog-filter", "make-moving-autocorrelation", "make-moving-fft", "make-moving-length",
- "make-moving-max", "make-moving-pitch", "make-moving-rms", "make-moving-scentroid",
- "make-moving-spectrum", "make-moving-sum", "make-moving-variance", "make-mvm",
- "make-n1cos", "make-nchoosekcos", "make-ncos2", "make-ncos4",
- "make-nkssb", "make-noddcos", "make-noddsin", "make-noddssb",
- "make-noid", "make-notch-frequency-response", "make-npcos", "make-nrcos",
- "make-nrsin", "make-nrssb", "make-nsincos", "make-nssb",
- "make-nxy1cos", "make-nxy1sin", "make-nxycos", "make-nxysin",
- "make-octaves-env", "make-one-pole-allpass", "make-one-pole-swept", "make-onep",
- "make-onezero", "make-open-bezier-path", "make-path", "make-peaking-2",
- "make-penv", "make-pink-noise", "make-plsenv", "make-pnoise",
- "make-polar-path", "make-polygon", "make-polyoid", "make-popdown-entry",
- "make-popup-menu", "make-power-env", "make-ppolar", "make-pulsed-env",
- "make-pvocoder", "make-r2k!cos", "make-r2k2cos", "make-ramp",
- "make-rcos", "make-reed", "make-region-frame-reader", "make-rk!cos",
- "make-rk!ssb", "make-rkcos", "make-rkoddssb", "make-rksin",
- "make-rkssb", "make-rmsg", "make-rmsgain", "make-round-interp",
- "make-rssb", "make-rxycos", "make-rxyk!cos", "make-rxyk!sin",
- "make-rxysin", "make-safe-rxycos", "make-savitzky-golay-filter", "make-sbfm",
- "make-selection", "make-selection-frame-reader", "make-semitones-env", "make-simple-popdown-menu",
- "make-sinc-train", "make-sine-summation", "make-sound-interp", "make-speaker-config",
- "make-spencer-filter", "make-spiral-path", "make-ssb-fm", "make-sum-of-cosines",
- "make-sum-of-sines", "make-sync-frame-reader", "make-table-lookup-with-env", "make-tanhsin",
- "make-volterra-filter", "make-wave-train-with-env", "make-waveshape", "make-weighted-moving-average",
- "make-zdata", "make-zero-mixer", "make-zipper", "make-zpolar",
- "map-envelopes", "map-sound", "map-sound-files", "maraca",
- "mark-click-info", "mark-explode", "mark-in", "mark-loops",
- "mark-name->id", "mark-out", "marsh-meadow-grasshopper", "match-sound-files",
- "max-envelope", "max-sounds", "maxfilter", "metal",
- "mfilter", "mfilter-1", "mflt-methods", "mflt?",
- "min-envelope", "mirror-path", "mix->vct", "mix-channel",
- "mix-chans", "mix-click-info", "mix-click-sets-amp", "mix-frame",
- "mix-maxamp", "mix-name->id", "mix-notelists", "mix-sound",
- "mix-sound-data", "mixer-copy", "mixer-determinant", "mixer-diagonal?",
- "mixer-inverse", "mixer-poly", "mixer-solve", "mixer-trace",
- "mixer-transpose", "mixes-length", "mixes-maxamp", "mono->stereo",
- "mono-files->stereo", "montezuma-quail", "moog-filter", "moog-methods",
- "moog?", "mosquito", "mountain-quail", "mourning-dove",
- "mouse-drag-envelope", "mouse-press-envelope", "mouse-release-envelope", "move-mixes",
- "move-syncd-marks", "moveto", "moving-autocorrelation", "moving-autocorrelation-methods",
- "moving-autocorrelation?", "moving-fft", "moving-fft-methods", "moving-fft?",
- "moving-formant", "moving-length", "moving-length-methods", "moving-length?",
- "moving-max", "moving-max-methods", "moving-max?", "moving-pitch",
- "moving-pitch-methods", "moving-pitch?", "moving-rms", "moving-rms-methods",
- "moving-rms?", "moving-scentroid", "moving-scentroid-methods", "moving-scentroid?",
- "moving-spectrum", "moving-spectrum-methods", "moving-spectrum?", "moving-sum",
- "moving-sum-methods", "moving-sum?", "moving-variance", "moving-variance-methods",
- "moving-variance?", "mpg", "multi-expt-env", "multiply-envelopes",
- "mus-bank", "mus-file-set-data-clipped", "mus-file-set-prescaler", "mus-set-rand-seed",
- "mus-set-srate", "mus-sound-seek", "mus-sound-set-maxamp", "music-font",
- "mvm-methods", "mvm?", "n-choose-k", "n1cos",
- "n1cos-methods", "n1cos?", "narrow-winged-tree-cricket", "nashville-warbler",
- "nb", "nchoosekcos", "nchoosekcos-methods", "nchoosekcos?",
- "ncos2", "ncos2-methods", "ncos2?", "ncos4",
- "nearest-point", "next-frame", "next-peak", "next-phrase",
- "nkssb", "nkssb-interp", "nkssb-methods", "nkssb?",
- "nkssber", "noddcos", "noddcos-methods", "noddcos?",
- "noddsin", "noddsin-methods", "noddsin?", "noddssb",
- "noddssb-methods", "noddssb?", "noid", "noid?",
- "normalize-envelope", "normalize-sound", "normalized-mix", "northern-beardless-tyrannulet",
- "northern-goshawk", "northern-leopard-frog-1", "northern-leopard-frog-2", "not-fitted",
- "not-parsed", "not-rendered", "not-transformed", "notch-channel",
- "notch-filter", "notch-selection", "notch-sound", "note-data->accidental",
- "note-data->cclass", "note-data->octave", "note-data->pclass", "note-data->pitch",
- "npcos", "npcos-methods", "npcos?", "nrcos",
- "nrcos-methods", "nrcos?", "nrev", "nrsin",
- "nrsin-methods", "nrsin?", "nrssb", "nrssb-interp",
- "nrssb-methods", "nrssb?", "nsincos", "nsincos-methods",
- "nsincos?", "nssb", "nssb-methods", "nssb?",
- "nxy1cos", "nxy1cos-methods", "nxy1cos?", "nxy1sin",
- "nxy1sin-methods", "nxy1sin?", "nxycos", "nxycos-methods",
- "nxycos?", "nxysin", "nxysin-methods", "nxysin?",
- "oak-titmouse", "oak-toad", "oboish", "octaves-envelope",
- "offset-channel", "offset-sound", "old-formant-bank", "old-make-formant",
- "old-map-chan", "old-map-channel", "olive-sided-flycatcher", "one-pole-allpass",
+ "int_to_float32", "int_to_float64", "integrate-envelope", "inverse-chebyshev-prototype",
+ "inverse-integrate", "invert-filter", "invert-matrix", "izcos",
+ "izcos-methods", "izcos?", "j0evencos", "j0evencos-methods",
+ "j0evencos?", "j0j1cos", "j0j1cos-methods", "j0j1cos?",
+ "j2cos", "j2cos-methods", "j2cos?", "jackson-sum",
+ "jc-reverb", "jettable", "jjcos", "jjcos-methods",
+ "jjcos?", "jl-reverb", "jncos", "jncos-methods",
+ "jncos?", "jpcos", "jpcos-methods", "jpcos?",
+ "jycos", "jycos-methods", "jycos?", "k2cos",
+ "k2cos-methods", "k2cos?", "k2sin", "k2sin-methods",
+ "k2sin?", "k2ssb", "k2ssb-methods", "k2ssb?",
+ "k3sin", "k3sin-methods", "k3sin?", "kalman-filter-channel",
+ "keypad-spectro-bindings", "killdeer", "kirtlands-warbler", "knudsens-frog",
+ "kosine-summation", "krksin", "krksin-methods", "krksin?",
+ "lag?", "laguerre", "laguerre-polynomial", "last",
+ "lbj-piano", "least-bittern", "least-flycatcher", "legendre",
+ "legendre-polynomial", "legendre-sum", "lesser-nighthawk", "linear-src-channel",
+ "lineto", "linnaeus-cicada", "lip", "lip-set-freq",
+ "list->hook", "list??", "listp", "literal-render",
+ "little-grass-frog", "local-data", "local-peak", "local-rms",
+ "local-smooth", "locate-zero", "lock-track", "log10",
+ "loggerhead-shrike-1", "loggerhead-shrike-2", "long-eared-owl", "long-spurred-meadow-katydid",
+ "loop-between-marks", "lowpass", "lp", "lpc-coeffs",
+ "lpc-predict", "lucys-warbler", "lutish", "lyric-cicada",
+ "macgillivrays-warbler", "machine1", "magnolia-warbler", "make-a-even",
+ "make-a-odd", "make-abcos", "make-absin", "make-adjustable-oscil",
+ "make-adjustable-sawtooth-wave", "make-adjustable-square-wave", "make-adjustable-triangle-wave", "make-asyfm",
+ "make-bandpass", "make-bandstop", "make-bess", "make-bessel-bandpass",
+ "make-bessel-bandstop", "make-bessel-highpass", "make-bessel-lowpass", "make-bezier-1",
+ "make-bezier-path", "make-big-ncos", "make-big-nsin", "make-big-one-pole",
+ "make-big-one-zero", "make-big-oscil", "make-big-table-lookup", "make-biquad",
+ "make-birds", "make-blackman", "make-bowtable", "make-brown-noise",
+ "make-butter-band-pass", "make-butter-band-reject", "make-butter-bp", "make-butter-bs",
+ "make-butter-high-pass", "make-butter-hp", "make-butter-low-pass", "make-butter-lp",
+ "make-butterworth-bandpass", "make-butterworth-bandstop", "make-butterworth-highpass", "make-butterworth-lowpass",
+ "make-chebyshev-bandpass", "make-chebyshev-bandstop", "make-chebyshev-highpass", "make-chebyshev-lowpass",
+ "make-closed-path", "make-current-window-display", "make-db-env", "make-dblsum",
+ "make-dc-block", "make-delaya", "make-delayl", "make-differentiator",
+ "make-dlocsig", "make-dlya", "make-eliminate-hum", "make-elliptic-bandpass",
+ "make-elliptic-bandstop", "make-elliptic-highpass", "make-elliptic-lowpass", "make-eoddcos",
+ "make-ercos", "make-erssb", "make-exponentially-weighted-moving-average", "make-expseg",
+ "make-flocsig", "make-fm-noise", "make-fm2", "make-fmssb",
+ "make-frame-reader", "make-gr-env", "make-green-noise", "make-green-noise-interp",
+ "make-grn", "make-group", "make-highpass", "make-hilbert-transform",
+ "make-iir-band-pass-2", "make-iir-band-stop-2", "make-iir-high-pass-1", "make-iir-high-pass-2",
+ "make-iir-low-pass-1", "make-iir-low-pass-2", "make-inverse-chebyshev-bandpass", "make-inverse-chebyshev-bandstop",
+ "make-inverse-chebyshev-highpass", "make-inverse-chebyshev-lowpass", "make-izcos", "make-j0evencos",
+ "make-j0j1cos", "make-j2cos", "make-jjcos", "make-jncos",
+ "make-jpcos", "make-jycos", "make-k2cos", "make-k2sin",
+ "make-k2ssb", "make-k3sin", "make-krksin", "make-list-1",
+ "make-literal-path", "make-literal-polar-path", "make-lowpass", "make-mfilter",
+ "make-mflt", "make-moog", "make-moog-filter", "make-moving-autocorrelation",
+ "make-moving-fft", "make-moving-length", "make-moving-max", "make-moving-pitch",
+ "make-moving-rms", "make-moving-scentroid", "make-moving-spectrum", "make-moving-sum",
+ "make-moving-variance", "make-mvm", "make-n1cos", "make-nchoosekcos",
+ "make-ncos2", "make-ncos4", "make-nkssb", "make-noddcos",
+ "make-noddsin", "make-noddssb", "make-noid", "make-notch-frequency-response",
+ "make-npcos", "make-nrcos", "make-nrsin", "make-nrssb",
+ "make-nsincos", "make-nssb", "make-nxy1cos", "make-nxy1sin",
+ "make-nxycos", "make-nxysin", "make-octaves-env", "make-one-pole-allpass",
+ "make-one-pole-swept", "make-onep", "make-onezero", "make-open-bezier-path",
+ "make-path", "make-peaking-2", "make-penv", "make-pink-noise",
+ "make-plsenv", "make-pnoise", "make-polar-path", "make-polygon",
+ "make-polyoid", "make-popdown-entry", "make-popup-menu", "make-power-env",
+ "make-ppolar", "make-pulsed-env", "make-pvocoder", "make-r2k!cos",
+ "make-r2k2cos", "make-ramp", "make-rcos", "make-reed",
+ "make-region-frame-reader", "make-rk!cos", "make-rk!ssb", "make-rkcos",
+ "make-rkoddssb", "make-rksin", "make-rkssb", "make-rmsg",
+ "make-rmsgain", "make-round-interp", "make-rssb", "make-rxycos",
+ "make-rxyk!cos", "make-rxyk!sin", "make-rxysin", "make-safe-rxycos",
+ "make-savitzky-golay-filter", "make-sbfm", "make-selection", "make-selection-frame-reader",
+ "make-semitones-env", "make-simple-popdown-menu", "make-sinc-train", "make-sine-summation",
+ "make-sound-interp", "make-speaker-config", "make-spencer-filter", "make-spiral-path",
+ "make-ssb-fm", "make-sum-of-cosines", "make-sum-of-sines", "make-sync-frame-reader",
+ "make-table-lookup-with-env", "make-tanhsin", "make-volterra-filter", "make-wave-train-with-env",
+ "make-waveshape", "make-weighted-moving-average", "make-zdata", "make-zero-mixer",
+ "make-zipper", "make-zpolar", "map-envelopes", "map-sound",
+ "map-sound-files", "maraca", "mark-click-info", "mark-explode",
+ "mark-in", "mark-loops", "mark-name->id", "mark-out",
+ "marsh-meadow-grasshopper", "match-sound-files", "max-envelope", "maxfilter",
+ "metal", "mfilter", "mfilter-1", "mflt-methods",
+ "mflt?", "min-envelope", "mirror-path", "mix->vct",
+ "mix-channel", "mix-chans", "mix-click-info", "mix-click-sets-amp",
+ "mix-frame", "mix-maxamp", "mix-name->id", "mix-notelists",
+ "mix-sound", "mix-sound-data", "mixer-copy", "mixer-determinant",
+ "mixer-diagonal?", "mixer-inverse", "mixer-poly", "mixer-solve",
+ "mixer-trace", "mixer-transpose", "mixes-length", "mixes-maxamp",
+ "mono->stereo", "mono-files->stereo", "montezuma-quail", "moog-filter",
+ "moog-methods", "moog?", "mosquito", "mountain-quail",
+ "mourning-dove", "mouse-drag-envelope", "mouse-press-envelope", "mouse-release-envelope",
+ "move-mixes", "move-syncd-marks", "moveto", "moving-autocorrelation",
+ "moving-autocorrelation-methods", "moving-autocorrelation?", "moving-fft", "moving-fft-methods",
+ "moving-fft?", "moving-formant", "moving-length", "moving-length-methods",
+ "moving-length?", "moving-max", "moving-max-methods", "moving-max?",
+ "moving-pitch", "moving-pitch-methods", "moving-pitch?", "moving-rms",
+ "moving-rms-methods", "moving-rms?", "moving-scentroid", "moving-scentroid-methods",
+ "moving-scentroid?", "moving-spectrum", "moving-spectrum-methods", "moving-spectrum?",
+ "moving-sum", "moving-sum-methods", "moving-sum?", "moving-variance",
+ "moving-variance-methods", "moving-variance?", "mpg", "multi-expt-env",
+ "multiply-envelopes", "mus-bank", "music-font", "mvm-methods",
+ "mvm?", "n-choose-k", "n1cos", "n1cos-methods",
+ "n1cos?", "narrow-winged-tree-cricket", "nashville-warbler", "nb",
+ "nchoosekcos", "nchoosekcos-methods", "nchoosekcos?", "ncos2",
+ "ncos2-methods", "ncos2?", "ncos4", "nearest-point",
+ "next-frame", "next-peak", "next-phrase", "nkssb",
+ "nkssb-interp", "nkssb-methods", "nkssb?", "nkssber",
+ "noddcos", "noddcos-methods", "noddcos?", "noddsin",
+ "noddsin-methods", "noddsin?", "noddssb", "noddssb-methods",
+ "noddssb?", "noid", "noid?", "normalize-envelope",
+ "normalize-sound", "normalized-mix", "northern-beardless-tyrannulet", "northern-goshawk",
+ "northern-leopard-frog-1", "northern-leopard-frog-2", "not-fitted", "not-parsed",
+ "not-rendered", "not-transformed", "notch-channel", "notch-filter",
+ "notch-selection", "notch-sound", "note-data->accidental", "note-data->cclass",
+ "note-data->octave", "note-data->pclass", "note-data->pitch", "npcos",
+ "npcos-methods", "npcos?", "nrcos", "nrcos-methods",
+ "nrcos?", "nrev", "nrsin", "nrsin-methods",
+ "nrsin?", "nrssb", "nrssb-interp", "nrssb-methods",
+ "nrssb?", "nsincos", "nsincos-methods", "nsincos?",
+ "nssb", "nssb-methods", "nssb?", "nxy1cos",
+ "nxy1cos-methods", "nxy1cos?", "nxy1sin", "nxy1sin-methods",
+ "nxy1sin?", "nxycos", "nxycos-methods", "nxycos?",
+ "nxysin", "nxysin-methods", "nxysin?", "oak-titmouse",
+ "oak-toad", "oboish", "octaves-envelope", "offset-channel",
+ "offset-sound", "old-formant-bank", "old-make-formant", "old-map-chan",
+ "old-map-channel", "old-play", "olive-sided-flycatcher", "one-pole-allpass",
"one-pole-allpass-methods", "one-pole-allpass?", "one-pole-swept", "one-pole-swept-methods",
"one-pole-swept?", "one-turn-is", "open-buffer", "open-current-buffer",
"open-next-file-in-directory", "open-play-output", "open-sound-file", "orange-crowned-warbler",
@@ -2040,112 +2054,122 @@ static const char *autoload_names[AUTOLOAD_NAMES] = {
"pianoy1", "pianoy2", "pileated-woodpecker", "pine-tree-cricket",
"pine-warbler", "pinewoods-tree-frog", "pink-noise", "pink-noise-methods",
"pink-noise?", "pins", "pinyon-jay", "place-sound",
- "plain-chacalaca", "plains-spadefoot", "play-ac3", "play-between-marks",
- "play-mixes", "play-often", "play-panned", "play-preview",
- "play-region-forever", "play-sine", "play-sines", "play-sound",
- "play-syncd-marks", "play-until-c-g", "play-with-amps", "play-with-envs",
- "plgndr", "plsenv-methods", "plsenv?", "pluck",
- "plucky", "plumbeous-vireo-1", "plumbeous-vireo-2", "pnoise",
- "pnoise-methods", "pnoise?", "poly*", "poly+",
- "poly-as-vector*", "poly-as-vector+", "poly-as-vector-derivative", "poly-as-vector-discriminant",
- "poly-as-vector-eval", "poly-as-vector-gcd", "poly-as-vector-reduce", "poly-as-vector-resultant",
- "poly-as-vector-roots", "poly-as-vector/", "poly-derivative", "poly-discriminant",
- "poly-gcd", "poly-reduce", "poly-resultant", "poly-roots",
- "poly/", "polyoid", "polyoid-env", "polyoid-methods",
- "polyoid?", "poussin-sum", "powenv-channel", "power-env",
- "power-env-channel", "pprint", "pqw", "pqw-vox",
- "prefs-activate-initial-bounds", "prefs-deactivate-initial-bounds", "prefs-initial-bounds", "pretty-print",
- "pretty-print-with-keys", "previous-frame", "previous-phrase", "profile",
- "protect-region", "prototype->highpass", "prune-db", "pulse-voice",
+ "plain-chacalaca", "plains-spadefoot", "play-ac3", "play-and-wait",
+ "play-between-marks", "play-channel", "play-mix", "play-mixes",
+ "play-often", "play-panned", "play-preview", "play-region",
+ "play-region-forever", "play-selection", "play-sine", "play-sines",
+ "play-sound", "play-syncd-marks", "play-until-c-g", "play-with-amps",
+ "play-with-envs", "plgndr", "plsenv-methods", "plsenv?",
+ "pluck", "plucky", "plumbeous-vireo-1", "plumbeous-vireo-2",
+ "pnoise", "pnoise-methods", "pnoise?", "poly*",
+ "poly+", "poly-as-vector*", "poly-as-vector+", "poly-as-vector-derivative",
+ "poly-as-vector-discriminant", "poly-as-vector-eval", "poly-as-vector-gcd", "poly-as-vector-reduce",
+ "poly-as-vector-resultant", "poly-as-vector-roots", "poly-as-vector/", "poly-derivative",
+ "poly-discriminant", "poly-gcd", "poly-reduce", "poly-resultant",
+ "poly-roots", "poly/", "polyoid", "polyoid-env",
+ "polyoid-methods", "polyoid?", "poussin-sum", "powenv-channel",
+ "power-env", "power-env-channel", "pprint", "pqw",
+ "pqw-vox", "prefs-activate-initial-bounds", "prefs-deactivate-initial-bounds", "prefs-initial-bounds",
+ "pretty-print", "pretty-print-with-keys", "previous-frame", "previous-phrase",
+ "profile", "prototype->highpass", "prune-db", "pulse-voice",
"pulsed-env", "pulsed-env?", "purple-finch", "pvoc",
"pvocoder", "pygmy-nuthatch", "r2k!cos", "r2k!cos-methods",
"r2k!cos?", "r2k2cos", "r2k2cos-methods", "r2k2cos-norm",
"r2k2cos?", "raised-cosine", "ramp", "ramp-expt",
"ramp-squared", "rcos", "rcos-methods", "rcos?",
- "read-ascii", "read-flac", "read-frame", "read-ogg",
- "read-speex", "recolor-widget", "red-breasted-nuthatch", "red-eyed-vireo",
- "red-shouldered-hawk", "red-spotted-toad", "redo-channel", "reedtable",
- "region->frame", "region->sound-data", "region-play-list", "region-play-sequence",
- "region-rms", "region-samples", "region-samples->vct", "remember-sound-state",
- "remove-clicks", "remove-if", "remove-pops", "remove-single-sample-clicks",
- "render-path", "repeat-envelope", "replace-with-selection", "report-mark-names",
- "reset-all-hooks", "reset-fit", "reset-rendering", "reset-transformation",
- "resflt", "reson", "reverse-by-blocks", "reverse-envelope",
- "reverse-string-append", "reverse-within-blocks", "rhodey", "ring-mod",
- "ring-modulate-channel", "river-frog", "rk!cos", "rk!cos-methods",
- "rk!cos?", "rk!ssb", "rk!ssb-methods", "rk!ssb?",
- "rkcos", "rkcos-methods", "rkcos?", "rkoddssb",
- "rkoddssb-methods", "rkoddssb?", "rksin", "rksin-methods",
- "rksin?", "rkssb", "rkssb-methods", "rkssb?",
- "rlineto", "rmoveto", "rms", "rms-envelope",
- "rmsg-methods", "rmsg?", "rotate-path", "rotate-phase",
- "round-interp", "round-interp-methods", "round-interp?", "rssb",
- "rssb-interp", "rssb-methods", "rssb?", "rubber-sound",
- "ruby-crowned-kinglet", "ruffed-grouse", "run-with-fm-and-pm", "rxycos",
- "rxycos-methods", "rxycos?", "rxyk!cos", "rxyk!cos-methods",
- "rxyk!cos?", "rxyk!sin", "rxyk!sin-methods", "rxyk!sin?",
- "rxysin", "rxysin-methods", "rxysin?", "safe-rxycos",
- "safe-rxycos-methods", "safe-rxycos?", "safe-srate", "sage-sparrow",
- "samples->sound-data", "samples->vct", "samples-via-colormap", "sandhill-crane",
- "savannah-sparrow", "save-mark-properties", "save-mixes", "says-phoebe",
- "sbfm-methods", "sbfm?", "scale-envelope", "scale-mixes",
- "scale-path", "scale-sound", "scale-sound-by", "scale-sound-to",
- "scale-tempo", "scaled-quail", "scan-sound", "scentroid",
- "scotts-oriole", "scramble-channel", "scramble-channels", "scratch",
- "scrub-euphonia", "search-for-click", "secs->samples", "selection->sound-data",
- "selection-members", "selection-rms", "selection-rms-1", "semitones-envelope",
- "set-gain", "set-global-sync", "set-mixes-tag-y", "set-pole",
- "set-speaker-configuration", "setf-aref", "shift-channel-pitch", "show-digits-of-pi-starting-at-digit",
- "show-draggable-input-fft", "show-input", "show-input-fft", "show-mins",
- "show-selection", "signum", "silence-all-mixes", "silence-mixes",
- "silence?", "simplify-complex", "simplify-envelope", "simultaneous-zero-crossing",
- "sin-m*pi/n", "sin-nx-peak", "sinc-train", "sinc-train-methods",
- "sinc-train?", "sine-bank", "sine-env", "sine-env-channel",
- "sine-ramp", "singer", "slightly-musical-conehead", "smooth-channel-via-ptree",
- "smooth-vct", "smoothing-filter", "snap-mark-to-beat", "snap-marks",
- "snap-mix-1", "snap-mix-to-beat", "snap-syncd-mixes-1", "snap-syncd-mixes-to-beat",
- "snd-apropos", "snd-hooks", "snd-msg", "snddiff",
- "snddiff-1", "snddiff-2", "sndwarp", "snowy-tree-cricket",
- "soft-clipped", "song-sparrow", "sonoran-desert-toad", "sora",
- "sort-samples", "sound->frame", "sound->sound-data", "sound-data->file",
- "sound-data->frame", "sound-data->list", "sound-data->sound", "sound-interp",
- "sounds->segment-data", "southeastern-field-cricket", "southern-cricket-frog", "southern-mole-cricket",
- "southwestern-toad", "spectra", "spectral-polynomial", "spectrum->coeffs",
- "sphagnum-ground-cricket", "spike", "spiral-render", "spot-freq",
- "spring-peeper", "square-env", "squelch-vowels", "squirrel-tree-frog-1",
- "src-duration", "src-fit-envelope", "src-mixes", "ssb-bank",
- "ssb-bank-env", "ssb-fm", "start-dac", "start-enveloping",
- "start-sync", "stellers-jay", "stereo->mono", "stereo-flute",
- "stochastic", "stop-enveloping", "stop-sync", "stretch-envelope",
- "stretch-sound-via-dft", "stringy", "striped-ground-cricket", "sub-matrix",
- "sum-of-n-odd-cosines", "sum-of-n-odd-sines", "sum-of-n-sines", "summer-tanager",
- "superimpose-ffts", "swainsons-thrush", "swap-selection-channels", "switch-to-buf",
- "sync-all", "sync-all-mixes", "syncd-mixes", "syncup",
- "tanhsin", "tanhsin-methods", "tanhsin?", "test-notch-hum",
- "test-remove-DC", "test-remove-pops", "test-remove-single-clicks", "test-sv",
- "texas-toad", "third", "times->samples", "tinkling-ground-cricket",
- "title-with-date", "touch-tone", "townsends-solitaire", "transform-path",
- "transform-samples", "translate-path", "transpose-mixes", "tree-for-each",
- "tree-for-each-reversed", "trumpeter-swan-1", "tstall", "tstallderiv",
- "tstallf", "tsteven", "tstodd", "tstoddderiv",
- "tstprime", "tubebell", "tufted-titmouse", "tvf-channel",
- "two-tab", "unb", "unclip-channel", "unclip-sound",
- "uncolor-samples", "unconvolve", "unconvolve-1", "undisplay-bark-fft",
- "undo-channel", "update-graphs", "varied-thrush", "various-gull-cries-from-end-of-colony-5",
- "vct->file", "vct->frame", "vct->samples", "vct->sound-file",
- "vct-convolve!", "vct-polynomial", "vct-size", "vector-add!",
- "vector-copy", "vector-scale!", "vector-synthesis", "verdin",
- "vermillion-flycatcher", "vibro", "virginia-rail", "virtual-filter-channel",
- "voiced->unvoiced", "volterra-filter", "vox", "warbling-vireo",
- "weighted-moving-average", "weighted-moving-average-methods", "weighted-moving-average?", "western-meadowlark",
- "western-tanager", "western-toad", "western-wood-pewee-1", "western-wood-pewee-2",
- "whip-poor-will", "white-breasted-nuthatch", "white-eyed-vireo", "white-headed-woodpecker",
- "white-throated-sparrow", "white-tipped-dove", "whooping-crane", "willet",
- "willow-flycatcher", "wilsons-warbler", "window-envelope", "window-rms",
- "window-samples", "with-local-hook", "with-mix-file-extension", "with-mix-find-file-with-extensions",
- "with-mixed-sound->notelist", "with-mixed-sound-mix-info", "with-reopen-menu", "with-simple-sound-helper",
- "with-sound-helper", "with-temporary-selection", "with-threaded-channels", "wood-duck",
- "wrentit", "write-flac", "write-ogg", "write-speex",
+ "read-ascii", "read-au-header", "read-bfloat32", "read-bfloat64",
+ "read-bfloat80->int", "read-bint16", "read-bint32", "read-bint64",
+ "read-chars", "read-flac", "read-frame", "read-lfloat32",
+ "read-lfloat64", "read-lint16", "read-lint32", "read-lint64",
+ "read-ogg", "read-speex", "read-string", "recolor-widget",
+ "red-breasted-nuthatch", "red-eyed-vireo", "red-shouldered-hawk", "red-spotted-toad",
+ "redo-channel", "reedtable", "region->frame", "region->sound-data",
+ "region-play-list", "region-play-sequence", "region-rms", "region-samples->vct",
+ "remember-sound-state", "remove-clicks", "remove-if", "remove-pops",
+ "remove-single-sample-clicks", "render-path", "repeat-envelope", "replace-with-selection",
+ "report-mark-names", "reset-all-hooks", "reset-fit", "reset-rendering",
+ "reset-transformation", "resflt", "reson", "reverse-by-blocks",
+ "reverse-envelope", "reverse-string-append", "reverse-within-blocks", "rhodey",
+ "ring-mod", "ring-modulate-channel", "river-frog", "rk!cos",
+ "rk!cos-methods", "rk!cos?", "rk!ssb", "rk!ssb-methods",
+ "rk!ssb?", "rkcos", "rkcos-methods", "rkcos?",
+ "rkoddssb", "rkoddssb-methods", "rkoddssb?", "rksin",
+ "rksin-methods", "rksin?", "rkssb", "rkssb-methods",
+ "rkssb?", "rlineto", "rmoveto", "rms",
+ "rms-envelope", "rmsg-methods", "rmsg?", "rotate-path",
+ "rotate-phase", "round-interp", "round-interp-methods", "round-interp?",
+ "rssb", "rssb-interp", "rssb-methods", "rssb?",
+ "rubber-sound", "ruby-crowned-kinglet", "ruffed-grouse", "run-with-fm-and-pm",
+ "rxycos", "rxycos-methods", "rxycos?", "rxyk!cos",
+ "rxyk!cos-methods", "rxyk!cos?", "rxyk!sin", "rxyk!sin-methods",
+ "rxyk!sin?", "rxysin", "rxysin-methods", "rxysin?",
+ "safe-rxycos", "safe-rxycos-methods", "safe-rxycos?", "safe-srate",
+ "sage-sparrow", "samples->sound-data", "samples->vct", "samples-via-colormap",
+ "sandhill-crane", "savannah-sparrow", "save-mark-properties", "save-mixes",
+ "says-phoebe", "sbfm-methods", "sbfm?", "scale-envelope",
+ "scale-mixes", "scale-path", "scale-sound", "scale-sound-by",
+ "scale-sound-to", "scale-tempo", "scaled-quail", "scan-sound",
+ "scentroid", "scotts-oriole", "scramble-channel", "scramble-channels",
+ "scratch", "scrub-euphonia", "search-for-click", "secs->samples",
+ "selection->sound-data", "selection-members", "selection-rms", "selection-rms-1",
+ "semitones-envelope", "set-gain", "set-global-sync", "set-mixes-tag-y",
+ "set-pole", "set-speaker-configuration", "setf-aref", "shift-channel-pitch",
+ "show-digits-of-pi-starting-at-digit", "show-draggable-input-fft", "show-input", "show-input-fft",
+ "show-mins", "show-selection", "signum", "silence-all-mixes",
+ "silence-mixes", "silence?", "simplify-complex", "simplify-envelope",
+ "simultaneous-zero-crossing", "sin-m*pi/n", "sin-nx-peak", "sinc-train",
+ "sinc-train-methods", "sinc-train?", "sine-bank", "sine-env",
+ "sine-env-channel", "sine-ramp", "singer", "slightly-musical-conehead",
+ "smooth-channel-via-ptree", "smooth-vct", "smoothing-filter", "snap-mark-to-beat",
+ "snap-marks", "snap-mix-1", "snap-mix-to-beat", "snap-syncd-mixes-1",
+ "snap-syncd-mixes-to-beat", "snd-apropos", "snd-display", "snd-hooks",
+ "snd-msg", "snddiff", "snddiff-1", "snddiff-2",
+ "sndwarp", "snowy-tree-cricket", "soft-clipped", "song-sparrow",
+ "sonoran-desert-toad", "sora", "sort-samples", "sound->frame",
+ "sound->sound-data", "sound-data->file", "sound-data->frame", "sound-data->list",
+ "sound-data->sound", "sound-interp", "sound-let", "sounds->segment-data",
+ "southeastern-field-cricket", "southern-cricket-frog", "southern-mole-cricket", "southwestern-toad",
+ "spectra", "spectral-polynomial", "spectrum->coeffs", "sphagnum-ground-cricket",
+ "spike", "spiral-render", "spot-freq", "spring-peeper",
+ "square-env", "squelch-vowels", "squirrel-tree-frog-1", "src-duration",
+ "src-fit-envelope", "src-mixes", "ssb-bank", "ssb-bank-env",
+ "ssb-fm", "start-dac", "start-enveloping", "start-sync",
+ "stellers-jay", "stereo->mono", "stereo-flute", "stochastic",
+ "stop-enveloping", "stop-sync", "stretch-envelope", "stretch-sound-via-dft",
+ "stringy", "striped-ground-cricket", "sub-matrix", "sum-of-n-odd-cosines",
+ "sum-of-n-odd-sines", "sum-of-n-sines", "summer-tanager", "superimpose-ffts",
+ "swainsons-thrush", "swap-selection-channels", "switch-to-buf", "sync-all",
+ "sync-all-mixes", "syncd-mixes", "syncup", "tanhsin",
+ "tanhsin-methods", "tanhsin?", "test-notch-hum", "test-remove-DC",
+ "test-remove-pops", "test-remove-single-clicks", "test-sv", "texas-toad",
+ "third", "times->samples", "tinkling-ground-cricket", "title-with-date",
+ "touch-tone", "townsends-solitaire", "transform-path", "translate-path",
+ "transpose-mixes", "tree-for-each", "tree-for-each-reversed", "trumpeter-swan-1",
+ "tstall", "tstallderiv", "tstallf", "tsteven",
+ "tstodd", "tstoddderiv", "tstprime", "tubebell",
+ "tufted-titmouse", "tvf-channel", "two-tab", "unb",
+ "unclip-channel", "unclip-sound", "uncolor-samples", "unconvolve",
+ "unconvolve-1", "undisplay-bark-fft", "undo-channel", "update-graphs",
+ "varied-thrush", "various-gull-cries-from-end-of-colony-5", "vct->file", "vct->frame",
+ "vct->samples", "vct->sound-file", "vct-convolve!", "vct-polynomial",
+ "vct-size", "vector-add!", "vector-copy", "vector-scale!",
+ "vector-synthesis", "verdin", "vermillion-flycatcher", "vibro",
+ "virginia-rail", "virtual-filter-channel", "voiced->unvoiced", "volterra-filter",
+ "vox", "warbling-vireo", "weighted-moving-average", "weighted-moving-average-methods",
+ "weighted-moving-average?", "western-meadowlark", "western-tanager", "western-toad",
+ "western-wood-pewee-1", "western-wood-pewee-2", "whip-poor-will", "white-breasted-nuthatch",
+ "white-eyed-vireo", "white-headed-woodpecker", "white-throated-sparrow", "white-tipped-dove",
+ "whooping-crane", "willet", "willow-flycatcher", "wilsons-warbler",
+ "window-envelope", "window-rms", "window-samples", "with-full-sound",
+ "with-local-hook", "with-marked-sound", "with-mix-file-extension", "with-mix-find-file-with-extensions",
+ "with-mixed-sound", "with-mixed-sound->notelist", "with-mixed-sound-mix-info", "with-reopen-menu",
+ "with-simple-sound", "with-simple-sound-helper", "with-sound", "with-sound-helper",
+ "with-temp-sound", "with-temporary-selection", "with-threaded-channels", "with-threaded-sound",
+ "wood-duck", "wrentit", "write-au-header", "write-bfloat32",
+ "write-bfloat64", "write-bint16", "write-bint32", "write-bint64",
+ "write-chars", "write-flac", "write-int->bfloat80", "write-lfloat32",
+ "write-lfloat64", "write-lint16", "write-lint32", "write-lint64",
+ "write-ogg", "write-speex", "write-string", "ws-interrupt?",
"ws-save-state", "wurley", "x-norm", "xb-close",
"xb-open", "xparse-path", "yellow-bellied-flycatcher", "yellow-green-vireo",
"yellow-rumped-warbler", "yellow-warbler", "z-transform", "za",
@@ -2154,77 +2178,80 @@ static const char *autoload_names[AUTOLOAD_NAMES] = {
"zipper", "zn", "zone-tailed-hawk", "zoom-spectrum"};
static int autoload_indices[AUTOLOAD_NAMES] = {
- 61, 61, 32, 32, 23, 35, 35, 1, 1, 20, 20, 20, 20, 20, 20, 1, 1, 11, 40, 13, 40, 25, 20, 20, 20,
- 20, 20, 20, 20, 20, 20, 20, 20, 20, 10, 52, 13, 13, 1, 1, 1, 1, 1, 45, 0, 8, 8, 8, 6,
- 15, 10, 51, 25, 8, 1, 20, 20, 20, 20, 34, 6, 13, 2, 35, 35, 4, 4, 4, 4, 4, 4, 4, 4,
- 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
- 4, 4, 4, 4, 4, 4, 4, 1, 52, 52, 52, 52, 52, 52, 6, 6, 1, 54, 54, 10, 10, 1, 1, 1,
- 35, 35, 6, 35, 35, 20, 20, 20, 0, 8, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 26, 3, 3, 3,
- 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 4, 35, 35, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 20, 20, 20, 15, 15, 20, 1, 1, 20, 59, 41,
- 41, 41, 20, 10, 10, 1, 1, 1, 1, 20, 20, 20, 1, 20, 1, 1, 10, 0, 8, 1, 1, 1, 1, 1,
- 20, 1, 1, 1, 1, 1, 1, 2, 6, 1, 45, 1, 1, 1, 10, 1, 1, 1, 6, 13, 40, 40, 40, 40,
- 40, 51, 40, 52, 10, 13, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 15, 15, 10, 35, 35,
- 0, 15, 5, 29, 25, 1, 1, 10, 10, 1, 32, 8, 20, 41, 5, 5, 47, 9, 13, 27, 61, 6, 61, 61,
- 13, 13, 6, 13, 29, 9, 13, 13, 1, 1, 1, 1, 1, 13, 13, 13, 10, 10, 11, 1, 8, 15, 15, 51,
- 17, 8, 54, 1, 12, 1, 55, 16, 13, 40, 32, 52, 1, 1, 21, 20, 20, 20, 41, 27, 29, 41, 41, 57,
- 29, 47, 8, 22, 27, 10, 10, 10, 9, 13, 13, 13, 9, 9, 16, 8, 8, 8, 15, 15, 8, 41, 41, 13,
- 13, 13, 13, 1, 10, 10, 10, 32, 7, 7, 7, 7, 7, 7, 7, 32, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 32, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 6,
- 1, 1, 1, 1, 1, 1, 13, 40, 40, 40, 40, 40, 40, 40, 40, 10, 0, 15, 29, 13, 15, 11, 11, 11,
- 21, 15, 12, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 27, 47, 1, 13, 21, 6, 14, 6, 13, 20, 20,
- 20, 37, 37, 37, 13, 13, 35, 43, 1, 54, 13, 13, 13, 13, 13, 13, 13, 13, 1, 17, 17, 33, 33, 32,
- 25, 13, 47, 13, 13, 20, 29, 20, 20, 36, 13, 10, 13, 61, 13, 8, 27, 1, 13, 10, 13, 25, 20, 20,
- 20, 10, 41, 6, 20, 10, 10, 6, 6, 34, 10, 6, 60, 25, 6, 20, 20, 20, 25, 50, 6, 40, 15, 13,
- 13, 52, 52, 52, 1, 8, 1, 13, 20, 10, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 10, 32,
- 19, 32, 6, 6, 1, 10, 10, 35, 20, 42, 36, 8, 36, 20, 15, 10, 5, 1, 6, 6, 21, 13, 6, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 20, 20, 20, 20, 20, 20, 1, 1, 1, 6, 6,
- 1, 1, 6, 1, 1, 10, 10, 13, 1, 1, 35, 35, 10, 10, 22, 1, 1, 45, 23, 1, 10, 57, 45, 1,
- 1, 1, 61, 15, 17, 17, 17, 52, 11, 0, 10, 10, 30, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
- 20, 54, 24, 41, 20, 20, 20, 6, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
- 20, 20, 20, 20, 20, 10, 49, 1, 1, 1, 54, 20, 20, 20, 55, 35, 35, 8, 6, 1, 1, 35, 35, 54,
- 1, 10, 32, 1, 41, 41, 22, 8, 8, 8, 1, 57, 57, 57, 57, 13, 53, 10, 1, 1, 1, 1, 38, 10,
- 45, 10, 10, 1, 20, 1, 1, 20, 1, 8, 8, 20, 20, 20, 20, 20, 20, 20, 10, 10, 20, 0, 0, 0,
- 0, 32, 8, 3, 3, 3, 3, 3, 3, 10, 4, 20, 41, 20, 10, 10, 10, 10, 10, 10, 10, 10, 0, 0,
- 0, 0, 0, 0, 0, 0, 8, 50, 21, 20, 41, 41, 41, 10, 8, 41, 10, 0, 0, 0, 0, 20, 20, 20,
- 20, 37, 20, 34, 6, 20, 17, 21, 20, 20, 6, 8, 10, 10, 10, 10, 52, 10, 52, 10, 0, 0, 0, 0,
- 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 8, 8, 8, 10, 54, 54, 31, 31, 20, 20, 20,
- 20, 20, 20, 20, 20, 20, 20, 28, 20, 20, 20, 20, 20, 20, 20, 20, 20, 10, 20, 20, 20, 20, 20, 20,
- 20, 20, 20, 20, 21, 37, 37, 41, 41, 8, 8, 10, 11, 20, 20, 37, 8, 32, 20, 40, 40, 11, 54, 20,
- 44, 20, 20, 13, 20, 41, 17, 20, 20, 20, 20, 20, 20, 6, 6, 20, 20, 20, 20, 20, 20, 20, 10, 6,
- 47, 17, 21, 40, 20, 49, 13, 8, 10, 8, 6, 49, 49, 17, 20, 20, 10, 20, 20, 20, 62, 30, 62, 54,
- 11, 17, 15, 26, 27, 27, 57, 13, 27, 57, 1, 15, 11, 51, 28, 6, 54, 54, 54, 54, 11, 8, 29, 15,
- 53, 29, 29, 17, 29, 29, 61, 29, 17, 30, 30, 30, 30, 30, 30, 30, 30, 29, 29, 15, 15, 1, 31, 31,
- 31, 1, 1, 1, 12, 12, 12, 29, 27, 32, 20, 20, 20, 20, 20, 20, 13, 20, 20, 20, 20, 20, 20, 20,
- 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 13, 20, 11, 52, 51, 51, 51,
- 51, 51, 51, 32, 28, 28, 35, 20, 20, 20, 1, 1, 33, 20, 20, 20, 20, 20, 20, 20, 8, 17, 13, 57,
- 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 11, 15, 15, 1, 1, 1, 1, 8,
- 8, 8, 8, 10, 13, 10, 10, 32, 32, 32, 32, 32, 20, 20, 20, 20, 20, 20, 6, 20, 20, 20, 20, 20,
- 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 1, 1, 20, 21,
- 15, 15, 52, 54, 52, 52, 1, 37, 37, 37, 37, 37, 37, 8, 13, 13, 13, 38, 53, 1, 20, 1, 13, 52,
- 32, 9, 9, 37, 1, 1, 27, 15, 29, 29, 29, 29, 10, 8, 8, 20, 8, 8, 8, 8, 11, 11, 10, 1,
- 1, 57, 57, 20, 20, 20, 1, 1, 1, 1, 20, 20, 20, 6, 1, 13, 1, 1, 13, 27, 29, 38, 12, 57,
- 38, 38, 38, 38, 27, 38, 38, 12, 35, 20, 20, 6, 41, 1, 1, 37, 37, 37, 39, 39, 39, 39, 39, 39,
- 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 20, 20, 20, 20, 54, 11, 11, 11, 42, 6, 6,
- 15, 15, 15, 42, 42, 17, 57, 15, 51, 0, 33, 13, 20, 20, 1, 44, 44, 1, 20, 20, 20, 20, 20, 20,
- 20, 21, 13, 15, 15, 20, 20, 20, 13, 13, 17, 13, 13, 52, 1, 1, 1, 1, 15, 41, 17, 17, 13, 13,
- 13, 51, 52, 15, 13, 15, 5, 5, 8, 11, 47, 27, 22, 8, 8, 8, 6, 6, 13, 11, 42, 13, 6, 13,
- 13, 1, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 32, 32, 6, 11,
- 6, 6, 8, 10, 20, 20, 20, 20, 20, 20, 20, 46, 1, 1, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
- 20, 20, 20, 20, 20, 20, 62, 1, 38, 52, 9, 1, 1, 27, 29, 1, 6, 6, 11, 29, 8, 15, 52, 52,
- 29, 1, 17, 10, 1, 13, 13, 6, 1, 13, 57, 17, 47, 13, 13, 21, 41, 15, 29, 41, 8, 25, 10, 35,
- 45, 45, 45, 36, 47, 10, 29, 29, 57, 39, 11, 17, 35, 35, 20, 20, 20, 54, 20, 15, 15, 48, 1, 13,
- 5, 54, 27, 27, 29, 29, 29, 29, 52, 22, 28, 55, 55, 55, 56, 1, 10, 1, 1, 1, 13, 17, 17, 17,
- 17, 52, 17, 13, 13, 1, 1, 1, 1, 6, 10, 10, 1, 10, 8, 10, 1, 20, 13, 1, 10, 10, 29, 10,
- 10, 6, 38, 12, 27, 1, 15, 6, 58, 12, 27, 11, 10, 20, 1, 30, 54, 54, 54, 1, 13, 1, 47, 13,
- 13, 29, 29, 27, 20, 20, 20, 5, 5, 5, 5, 20, 1, 8, 61, 1, 13, 6, 1, 8, 51, 8, 29, 29,
- 29, 1, 36, 36, 36, 36, 36, 36, 36, 6, 1, 5, 6, 33, 10, 10, 9, 55, 55, 10, 15, 13, 1, 4,
- 17, 17, 52, 53, 52, 10, 55, 39, 39, 39, 38, 1, 1, 13, 1, 13, 13, 10, 6, 1, 20, 20, 20, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 11, 13, 13, 22, 50, 50, 61, 61, 15, 61,
- 61, 47, 61, 1, 1, 13, 13, 13, 61, 6, 8, 13, 13, 8, 1, 1, 1, 1, 10, 6, 6, 13, 62, 62,
- 13, 13, 10, 62, 62, 6, 1, 13};
+ 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61,
+ 61, 61, 61, 61, 61, 33, 33, 24, 36, 36, 1, 1, 21, 21, 21, 21, 21, 21, 1, 1, 12, 41, 14, 41,
+ 26, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 11, 52, 14, 14, 1, 9, 1, 1, 1, 1, 46,
+ 0, 9, 9, 9, 7, 16, 11, 26, 9, 1, 21, 21, 21, 21, 35, 7, 14, 2, 36, 36, 5, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 1, 52, 52, 52, 52, 52, 52, 7, 7, 1, 54, 54, 11,
+ 11, 1, 1, 1, 36, 36, 7, 36, 36, 21, 21, 21, 0, 9, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 27, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 5, 36, 36, 5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 21, 21, 21, 16, 16, 21, 1,
+ 1, 21, 59, 42, 42, 42, 21, 11, 11, 1, 1, 1, 1, 21, 21, 21, 1, 21, 1, 1, 11, 0, 9, 1,
+ 1, 1, 1, 1, 21, 1, 1, 1, 1, 1, 1, 2, 7, 1, 46, 1, 1, 1, 11, 1, 1, 1, 7, 14,
+ 41, 41, 41, 41, 41, 41, 52, 11, 14, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 16, 16,
+ 11, 36, 36, 0, 16, 6, 30, 26, 1, 1, 11, 11, 1, 33, 9, 21, 42, 6, 6, 48, 10, 14, 28, 61,
+ 7, 61, 61, 14, 14, 7, 14, 30, 10, 14, 14, 1, 1, 1, 1, 1, 14, 14, 14, 11, 11, 12, 1, 9,
+ 16, 16, 18, 9, 54, 1, 13, 1, 55, 17, 14, 41, 33, 52, 1, 1, 22, 21, 21, 21, 42, 61, 21, 28,
+ 61, 30, 42, 42, 57, 30, 48, 9, 23, 28, 11, 11, 11, 10, 14, 14, 14, 10, 10, 17, 9, 9, 9, 16,
+ 16, 9, 42, 42, 14, 14, 14, 14, 14, 1, 11, 11, 11, 33, 8, 8, 8, 8, 8, 8, 8, 33, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 33, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 7, 1, 1, 1, 1, 1, 1, 14, 41, 41, 41, 41, 41, 41, 41, 41, 11, 0, 16,
+ 30, 14, 16, 12, 12, 12, 22, 16, 13, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 28, 48, 1, 14, 22,
+ 7, 15, 7, 14, 21, 21, 21, 38, 38, 38, 14, 14, 36, 44, 1, 54, 14, 14, 14, 14, 14, 14, 14, 14,
+ 1, 18, 18, 34, 34, 33, 26, 14, 48, 14, 14, 21, 30, 21, 21, 37, 14, 11, 14, 61, 14, 9, 28, 1,
+ 14, 11, 14, 26, 4, 4, 21, 21, 21, 11, 42, 7, 21, 11, 11, 7, 7, 35, 11, 7, 60, 26, 7, 21,
+ 21, 21, 26, 51, 7, 41, 16, 14, 14, 52, 52, 52, 1, 9, 1, 14, 21, 11, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 19, 11, 33, 20, 33, 7, 7, 1, 11, 11, 36, 21, 43, 37, 9, 37, 21, 16, 11,
+ 6, 1, 7, 7, 22, 14, 7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 21, 21, 21,
+ 21, 21, 21, 1, 1, 1, 7, 7, 1, 1, 7, 1, 1, 11, 11, 14, 1, 1, 36, 36, 11, 11, 23, 1,
+ 1, 46, 24, 1, 11, 57, 46, 1, 1, 1, 61, 16, 18, 18, 18, 52, 4, 4, 12, 0, 11, 11, 31, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 54, 25, 42, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 11, 50, 1, 1, 1, 54, 21, 21, 21,
+ 55, 36, 36, 9, 7, 1, 1, 36, 36, 54, 1, 11, 33, 1, 42, 42, 23, 9, 9, 9, 1, 57, 57, 57,
+ 57, 14, 53, 11, 1, 1, 1, 1, 39, 11, 46, 11, 11, 1, 21, 1, 1, 21, 1, 9, 9, 21, 21, 21,
+ 21, 21, 21, 21, 11, 11, 21, 0, 0, 0, 0, 33, 9, 3, 3, 3, 3, 3, 3, 11, 5, 21, 42, 21,
+ 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0, 0, 9, 51, 22, 21, 42, 42, 42, 11,
+ 9, 42, 11, 0, 0, 0, 0, 21, 21, 21, 21, 38, 21, 35, 7, 21, 18, 22, 21, 21, 7, 9, 11, 11,
+ 11, 11, 52, 11, 52, 11, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 9,
+ 9, 9, 11, 54, 54, 32, 32, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 29, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 11, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 38, 38, 42, 42, 9, 9, 11, 12, 21,
+ 21, 38, 9, 33, 21, 41, 41, 12, 54, 21, 45, 21, 21, 14, 21, 42, 18, 21, 21, 21, 21, 21, 21, 7,
+ 7, 21, 21, 21, 21, 21, 21, 21, 11, 7, 48, 18, 22, 41, 21, 50, 14, 9, 11, 9, 7, 50, 50, 18,
+ 21, 21, 11, 21, 21, 21, 62, 31, 62, 54, 12, 18, 16, 27, 28, 28, 57, 14, 28, 57, 1, 16, 12, 29,
+ 7, 54, 54, 54, 54, 12, 9, 30, 16, 53, 30, 30, 18, 30, 30, 61, 30, 18, 31, 31, 31, 31, 31, 31,
+ 31, 31, 30, 30, 16, 16, 1, 32, 32, 32, 1, 1, 1, 13, 13, 13, 30, 28, 33, 21, 21, 21, 21, 21,
+ 21, 14, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 14, 21, 12, 52, 33, 29, 29, 36, 21, 21, 21, 1, 1, 34, 21, 21, 21, 21, 21, 21, 21, 9,
+ 18, 14, 57, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 12, 16, 16, 1, 1,
+ 1, 1, 9, 9, 9, 9, 11, 14, 11, 11, 33, 33, 33, 33, 33, 21, 21, 21, 21, 21, 21, 7, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 1,
+ 1, 21, 22, 16, 16, 52, 54, 52, 52, 51, 1, 38, 38, 38, 38, 38, 38, 9, 14, 14, 14, 39, 53, 1,
+ 21, 1, 14, 52, 33, 10, 10, 38, 1, 1, 28, 16, 30, 30, 30, 30, 11, 9, 9, 21, 9, 9, 9, 9,
+ 12, 12, 11, 1, 1, 57, 57, 21, 21, 21, 1, 1, 1, 1, 21, 21, 21, 7, 1, 14, 1, 1, 14, 51,
+ 28, 51, 51, 30, 39, 13, 57, 51, 39, 51, 39, 39, 39, 28, 39, 39, 13, 36, 21, 21, 7, 42, 1, 1,
+ 38, 38, 38, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 21, 21,
+ 21, 21, 54, 12, 12, 12, 43, 7, 7, 16, 16, 16, 43, 43, 18, 57, 16, 0, 34, 14, 21, 21, 1, 45,
+ 45, 1, 21, 21, 21, 21, 21, 21, 21, 22, 14, 16, 16, 21, 21, 21, 14, 4, 4, 4, 4, 4, 4, 4,
+ 4, 14, 18, 4, 4, 4, 4, 4, 14, 14, 4, 52, 1, 1, 1, 1, 16, 42, 18, 18, 14, 14, 14, 52,
+ 16, 14, 16, 6, 6, 9, 12, 48, 28, 23, 9, 9, 9, 7, 7, 14, 12, 43, 14, 7, 14, 14, 1, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 33, 33, 7, 12, 7, 7, 9,
+ 11, 21, 21, 21, 21, 21, 21, 21, 47, 1, 1, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 62, 1, 39, 52, 10, 1, 1, 28, 30, 1, 7, 7, 12, 30, 9, 16, 52, 52, 30, 1, 18,
+ 11, 1, 14, 14, 7, 1, 14, 57, 18, 48, 14, 14, 22, 42, 16, 30, 42, 9, 26, 11, 36, 46, 46, 46,
+ 37, 48, 11, 30, 30, 57, 40, 12, 18, 36, 36, 21, 21, 21, 54, 21, 16, 16, 49, 1, 14, 6, 54, 28,
+ 28, 30, 30, 30, 30, 52, 21, 23, 29, 55, 55, 55, 56, 1, 11, 1, 1, 1, 14, 18, 18, 18, 18, 52,
+ 18, 14, 61, 14, 1, 1, 1, 1, 7, 11, 11, 1, 11, 9, 11, 1, 21, 14, 1, 11, 11, 30, 11, 11,
+ 7, 39, 13, 28, 1, 16, 7, 58, 13, 28, 12, 11, 21, 1, 31, 54, 54, 54, 1, 14, 1, 48, 14, 14,
+ 30, 30, 28, 21, 21, 21, 6, 6, 6, 6, 21, 1, 9, 61, 1, 14, 7, 1, 9, 9, 30, 30, 30, 1,
+ 37, 37, 37, 37, 37, 37, 37, 7, 1, 6, 7, 34, 11, 11, 10, 55, 55, 11, 16, 14, 1, 5, 18, 18,
+ 52, 53, 52, 11, 55, 40, 40, 40, 39, 1, 1, 14, 1, 14, 14, 11, 7, 1, 21, 21, 21, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 12, 14, 14, 61, 23, 61, 51, 51, 61, 61, 61, 16,
+ 61, 61, 61, 61, 61, 48, 61, 61, 1, 1, 4, 4, 4, 4, 4, 4, 4, 14, 4, 4, 4, 4, 4, 4,
+ 14, 14, 4, 61, 61, 7, 9, 14, 14, 9, 1, 1, 1, 1, 11, 7, 7, 14, 62, 62, 14, 14, 11, 62,
+ 62, 7, 1, 14};
#endif
diff --git a/snd-xsnd.c b/snd-xsnd.c
index 735345b..13eab4c 100644
--- a/snd-xsnd.c
+++ b/snd-xsnd.c
@@ -1,7 +1,5 @@
#include "snd.h"
-/* TODO: fix the multisound multichannel update resize bug! */
-
#if HAVE_XPM
#include <X11/xpm.h>
#endif
diff --git a/snd.c b/snd.c
index ab9abf9..c2305cc 100644
--- a/snd.c
+++ b/snd.c
@@ -3,8 +3,6 @@
* originally intended as a re-implementation of my much-missed dpysnd -- the Foonly/SAIL/E/Mus10/Grnlib sound editor from ca 1983.
*/
-/* SOMEDAY: use emacs as the listener via the xembed protocol? (this connection is not quite ready) */
-
#include "snd.h"
snd_state *ss = NULL;
diff --git a/snd.h b/snd.h
index 4b6f396..3fc719c 100644
--- a/snd.h
+++ b/snd.h
@@ -71,11 +71,11 @@
#include "snd-strings.h"
-#define SND_DATE "30-Apr-10"
+#define SND_DATE "7-June-10"
#ifndef SND_VERSION
-#define SND_VERSION "11.5"
+#define SND_VERSION "11.6"
#endif
#define SND_MAJOR_VERSION "11"
-#define SND_MINOR_VERSION "5"
+#define SND_MINOR_VERSION "6"
#endif
diff --git a/snd.html b/snd.html
index 8a30688..a4b7e7e 100644
--- a/snd.html
+++ b/snd.html
@@ -1418,7 +1418,7 @@ together so that the loudest reaches that amplitude
means that both channels are scaled by the same amount so
that the loudest point in the file becomes .5). There's
one special case here: if you (<a class=quiet href="extsnd.html#scaleto" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleto_tip)">scale-to</a> 1.0) in a sound
-that is stored as short ints and you haven't set the data-clipped
+that is stored as short ints and you haven't set the clipping
variable to #t, since 1.0 itself is not representable,
the actual scaled-to value is just less than 1.0 to avoid the
(unwanted) wrap-around.
diff --git a/snd11.scm b/snd11.scm
index 4de33c3..6341c57 100644
--- a/snd11.scm
+++ b/snd11.scm
@@ -147,3 +147,40 @@ but not anymore.
;(define def-optkey-fun define*)
;(define def-optkey-instrument definstrument)
+(define spectro-cutoff spectrum-start)
+(define spectro-end spectrum-end)
+
+
+
+(define* (play-region reg wait stop-func)
+ (play (if (integer? reg) (integer->region reg) reg) :wait wait :stop stop-func))
+
+(define* (play-selection wait stop-func)
+ (play (selection) :wait wait :stop stop-func))
+
+(define* (play-mix id (beg 0))
+ (play (if (integer? id) (integer->mix id) id) beg))
+
+(define* (play-and-wait (start 0) snd chn syncd end (pos -1) stop-proc)
+ (if (string? start)
+ (play start (or snd 0) :end (or chn -1) :wait #t)
+ (play (if (integer? snd) (integer->sound snd)
+ (if (sound? snd) snd
+ (or (selected-sound) (car (sounds)))))
+ :channel (or chn -1) :wait #t :with-sync syncd :start start :end (or end -1)
+ :stop stop-proc :edit-position pos)))
+
+(define* (old-play (start 0) snd chn syncd end (pos -1) stop-proc (out-chan -1))
+ (play (if (integer? snd) (integer->sound snd)
+ (if (sound? snd) snd
+ (or (selected-sound) (car (sounds)))))
+ :channel (or chn -1) :with-sync syncd :start start :end (or end -1)
+ :stop stop-proc :out-channel out-chan :edit-position pos))
+
+(define* (play-channel (beg 0) dur snd chn (pos -1) stop-proc (out-chan -1))
+ (play (if (integer? snd) (integer->sound snd)
+ (if (sound? snd) snd
+ (or (selected-sound) (car (sounds)))))
+ :channel (or chn -1) :with-sync #f :start beg :end (if dur (+ beg dur) -1)
+ :stop stop-proc :out-channel out-chan :edit-position pos))
+
diff --git a/snd6.scm b/snd6.scm
deleted file mode 100644
index e40c712..0000000
--- a/snd6.scm
+++ /dev/null
@@ -1,125 +0,0 @@
-;;; backwards compatibility for Snd-7
-
-(provide 'snd-snd6.scm)
-
-(define graph-lisp? lisp-graph?)
-(define graph-transform? transform-graph?)
-(define graph-time? time-graph?)
-
-(define graph-time-once graph-once)
-(define graph-transform-once graph-once)
-(define graph-time-as-wavogram graph-as-wavogram)
-(define graph-transform-as-sonogram graph-as-sonogram)
-(define graph-transform-as-spectrogram graph-as-spectrogram)
-
-(define dont-normalize-transform dont-normalize)
-(define normalize-transform-by-channel normalize-by-channel)
-(define normalize-transform-by-sound normalize-by-sound)
-(define normalize-transform-globally normalize-globally)
-
-(define set-oss-buffers mus-oss-set-buffers)
-(define hanning-window hann-window)
-
-(define (max-sounds)
- "(max-sounds) -> current max sound index"
- (apply max (sounds)))
-
-(define (transform-samples snd chn)
- "(transform-samples snd chn) returns a vector with the given channel's transform samples"
- (vct->vector (transform-samples->vct snd chn)))
-
-(define (region-samples samp samps reg chn)
- "(region-samples samp samps reg chn) returns a vector with the given samples in region 'reg'"
- (vct->vector (region-samples->vct samp samps reg chn)))
-
-(define (convolve-arrays v0 v1)
- "(convolve-arrays v0 v1) is a wrapper for vct-convolve! -- v0 and v1 can be vcts or vectors"
- (let ((vc0 (if (vector? v0) (vector->vct v0) v0))
- (vc1 (if (vector? v1) (vector->vct v1) v1)))
- (vct-convolve! vc0 vc1)
- (if (vector? v0)
- (vct->vector vc0)
- vc0)))
-
-(define* (append-to-minibuffer msg snd)
- "(append-to-minibuffer msg snd) appends 'msg' to whatever is in snd's minibuffer"
- (if (and (sound? snd)
- (not (provided? 'snd-nogui)))
- (let* ((minibuffer (and (sound-widgets snd)
- (list-ref (sound-widgets snd) 3)))
- (text (and minibuffer
- (widget-text minibuffer))))
- (if (string? text)
- (set! (widget-text minibuffer) (string-append text msg))
- (report-in-minibuffer msg snd)))))
-
-(define use-sinc-interp
- (make-procedure-with-setter
- (lambda ()
- "dummy accessor for obsolete use-sinc-interp"
- #t)
- (lambda (val) val)))
-
-(define (mus-set-srate val)
- "obsolete way to set mus-srate"
- (set! (mus-srate) val))
-
-(define (mus-set-rand-seed val)
- "obsolete way to set the random number seed, mus-rand-seed"
- (set! (mus-rand-seed) val))
-
-(define (mus-file-set-prescaler fd val)
- "obsolete way to set mus-file-prescaler"
- (set! (mus-file-prescaler fd) val))
-
-(define (mus-file-set-data-clipped fd val)
- "obsolete way to set mus-file-clipping"
- (set! (mus-file-clipping fd) val))
-
-(define (mus-sound-set-maxamp file vals)
- "obsolete way to set mus-sound-maxamp"
- (set! (mus-sound-maxamp file) vals))
-
-(define (change-property w a v)
- "obsolete way to change a window-property"
- (set! (window-property w a) v))
-
-;;; to get a vector from samples, use vct->vector
-
-(define (mus-sound-seek fd loc seek format chans)
- "obsolete way to go to a position in a sound file -- use mus-sound-seek-frame instead"
- ;; mus-sound-seek-frame = lseek fd data-location+frames*chans*sample-size-in-bytes seek-set
- ;; old mus-sound-seek = lseek fd data-location+loc-as-16-in-bytes seek-set
- ;; but there's no direct way to get the data-format and chans from the file descriptor
- ;; so in this replacement, there are two added args
- (mus-sound-seek-frame fd loc))
-
-(if (not (provided? 'snd-mix.scm)) (load "mix.scm"))
-
-(define (protect-region n)
- "obsolete -- simply produces an error"
- (snd-error "protect-region has been removed"))
-
-(define button-font
- (make-procedure-with-setter
- (lambda ()
- "dummy accessor for obsolete button-font"
- #f)
- (lambda (val)
- #f)))
-
-(define bold-button-font
- (make-procedure-with-setter
- (lambda ()
- "dummy accessor for obsolete bold-button-font"
- #f)
- (lambda (val)
- #f)))
-
-(define help-text-font
- (make-procedure-with-setter
- (lambda ()
- "dummy accessor for obsolete help-text-font"
- #f)
- (lambda (val)
- #f)))
diff --git a/snd9.scm b/snd9.scm
index d6582a9..7830fec 100644
--- a/snd9.scm
+++ b/snd9.scm
@@ -193,7 +193,6 @@ the amp (more or less), 'N' is 1..10 or thereabouts, 'fi' is the phase incremen
:eps (* 2.0 (sin (/ (* pi frequency) (mus-srate))))))
(define (mfilter-1 m x-input y-input)
- ;; no optional args, for 'run'
(let* ((xn1 (+ x-input
(* (mflt-decay m) (- (mflt-xn m)
(* (mflt-eps m) (mflt-yn m))))))
diff --git a/sndclm.html b/sndclm.html
index 47538da..de2c8ce 100644
--- a/sndclm.html
+++ b/sndclm.html
@@ -580,8 +580,30 @@ as the generator object:
</td></tr></table>
<p>There are many more such generators scattered around the Snd package, most now collected in generators.scm.
-I'm also writing pure-scheme versions of the built-in generators: big-gens.scm.
+I'm also writing pure-scheme versions of the built-in generators: big-gens.scm. For comparison, here is the sinewave
+instrument in Grace (Common Music) and Snd-rt:
</p>
+<table border=0 hspace=40><tr><td>
+<pre>
+
+file "test.wav" ()
+ with osc = make-oscil(440)
+ loop for i below 44100
+ outa(i, .1 * oscil(osc))
+ end
+end
+
+
+snd-rt:
+
+(&lt;rt-out&gt; :len 1 (oscil :freq 440))
+
+(&lt;rt-stalin&gt;
+ (sound :dur 1:-s
+ (out (oscil :freq 440))))
+</pre>
+</td></tr></table>
+
<br><br>
@@ -910,11 +932,11 @@ are times when nothing but a ton of oscils will do:
(do ((i 0 (+ 1 i)))
((= i len))
- (vector-set! freqs i (list-ref peaks (* i 2)))
- (vector-set! oscs i (<em class=red>make-oscil</em> (vector-ref freqs i) (random pi)))
- (vector-set! amps i (list-ref peaks (+ 1 (* 2 i))))
- (vector-set! ramps i (<a class=quiet href="#make-rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_interp_tip)">make-rand-interp</a> (+ 1.0 (* i (/ 20.0 len)))
- (* (+ .1 (* i (/ 3.0 len))) (vector-ref amps i)))))
+ (set! (freqs i) (peaks (* i 2)))
+ (set! (oscs i) (<em class=red>make-oscil</em> (freqs i) (random pi)))
+ (set! (amps i) (peaks (+ 1 (* 2 i))))
+ (set! (ramps i) (<a class=quiet href="#make-rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_interp_tip)">make-rand-interp</a> (+ 1.0 (* i (/ 20.0 len)))
+ (* (+ .1 (* i (/ 3.0 len))) (amps i)))))
(run
(do ((i 0 (+ 1 i)))
((= i samps))
@@ -922,9 +944,9 @@ are times when nothing but a ton of oscils will do:
(fm (<a class=quiet href="#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> vib)))
(do ((k 0 (+ 1 k)))
((= k len))
- (set! sum (+ sum (* (+ (vector-ref amps k)
- (<a class=quiet href="#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> (vector-ref ramps k)))
- (<em class=red>oscil</em> (vector-ref oscs k) (* (vector-ref freqs k) fm))))))
+ (set! sum (+ sum (* (+ (amps k)
+ (<a class=quiet href="#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> (ramps k)))
+ (<em class=red>oscil</em> (oscs k) (* (freqs k) fm))))))
(<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) sum)))))))
</pre>
</td></tr></table>
@@ -942,7 +964,7 @@ are times when nothing but a ton of oscils will do:
(do ((i 0 (+ i 1))
(k 0 (+ k 2)))
((= i len))
- (vct-set! amps (list-ref peaks k) (list-ref peaks (+ k 1))))
+ (set! (amps (list-ref peaks k)) (list-ref peaks (+ k 1))))
...
(outa i (* (env ampf) (<em class=red>mus-chebyshev-t-sum</em> angle amps)))
(set! angle (+ angle freq (rand-interp vib)))
@@ -984,7 +1006,7 @@ are times when nothing but a ton of oscils will do:
(do ((i 0 (+ i 1))
(k 0 (+ k 2)))
((= i len))
- (vct-set! amps (list-ref peaks k) (list-ref peaks (+ k 1))))
+ (set! (amps (list-ref peaks k)) (list-ref peaks (+ k 1))))
(run
(do ((i 0 (+ 1 i)))
@@ -1751,7 +1773,7 @@ If you're trying to produce a sum of sinusoids, use polywave &mdash; it makes a
(let* ((pitch 2.0)
(size 64)
(wave (let ((v (make-vct size 0.0)))
- (vct-set! v (/ size 2) 1.0)
+ (set! (v (/ size 2)) 1.0)
v))
(tbl1 (make-table-lookup pitch 0.0 wave size mus-interp-none))
(tbl2 (make-table-lookup pitch 0.0 wave size mus-interp-linear))
@@ -2044,8 +2066,8 @@ in phase and amplitude at run-time by setting a vct value.
(do ((k 1 (+ k 3))
(i 0 (+ i 2)))
((= i (* 5 2)))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> harms i k) ; harmonic number (k*freq)
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> harms (+ i 1) (/ 1.0 (sqrt k)))) ; harmonic amplitude
+ (set! (harms i) k) ; harmonic number (k*freq)
+ (set! (harms (+ i 1)) (/ 1.0 (sqrt k)))) ; harmonic amplitude
harms)))
(ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 10 1 11 0) :duration 1.0 :scaler .5)))
(do ((i 0 (+ 1 i)))
@@ -2163,7 +2185,7 @@ is scaled to be -1..1, so that adds another layer of confusion). There's a longe
(let ((oscs (make-vector 3 #f)))
(do ((i 0 (+ 1 i)))
((= i 3))
- (vector-set! oscs i (make-oscil (* freq (+ 1 i)))))
+ (set! (oscs i) (make-oscil (* freq (+ 1 i)))))
oscs)
(if (= type 1)
(make-ncos freq 3)
@@ -2195,7 +2217,7 @@ is scaled to be -1..1, so that adds another layer of confusion). There's a longe
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k 3))
- (set! sum (+ sum (oscil (vector-ref carrier k) (* (+ 1 k) md))))) ; or leave unscaled
+ (set! sum (+ sum (oscil (carrier k) (* (+ 1 k) md))))) ; or leave unscaled
(/ sum 3))
(if (= type 1)
(sum-of-cosines carrier md)
@@ -2258,8 +2280,8 @@ get changing spectra is to interpolate between two or more sets of coefficients.
(do ((i 0 (+ 1 i)))
((= i samps))
(let ((harm (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> harmf)))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> coeffs 3 harm)
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> coeffs 4 (- .25 harm))
+ (set! (coeffs 3) harm)
+ (set! (coeffs 4) (- .25 harm))
(<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
(<em class=red>mus-chebyshev-t-sum</em> x coeffs)))
(set! x (+ x incr))))))
@@ -3143,26 +3165,26 @@ we can truncate its spectrum at the desired number of harmonics:
(lambda* (n B)
(or (and (&lt; n 128)
(not B)
- (vector-ref previous-results n))
+ (previous-results n))
(let* ((coeffs (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> (* 2 n)))
(size (expt 2 12))
(rl (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
(im (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
(incr (/ (* 2 pi) size))
- (index (or B (max 1 (inexact-&gt;exact (floor (/ n 2)))))))
+ (index (or B (max 1 (floor (/ n 2))))))
(do ((i 0 (+ 1 i))
(x 0.0 (+ x incr)))
((= i size))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> rl i (<em class=red>tanh</em> (* index (<em class=red>sin</em> x))))) ; make our desired square wave
+ (set! (rl i) (<em class=red>tanh</em> (* index (<em class=red>sin</em> x))))) ; make our desired square wave
(<a class=quiet href="#spectrum" onmouseout="UnTip()" onmouseover="Tip(sndclm_spectrum_tip)">spectrum</a> rl im #f 2) ; get its spectrum
(do ((i 0 (+ i 1))
(j 0 (+ j 2)))
((= i n))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> coeffs j (+ j 1))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> coeffs (+ j 1) (/ (* 2 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> rl (+ j 1))) size)))
+ (set! (coeffs j) (+ j 1))
+ (set! (coeffs (+ j 1)) (/ (* 2 (rl (+ j 1))) size)))
(if (and (&lt; n 128) ; save this set so we don't have to compute it again
(not B))
- (vector-set! previous-results n coeffs))
+ (set! (previous-results n) coeffs))
coeffs)))))
(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
@@ -3680,7 +3702,7 @@ getting waveforms and results like these:
(do ((i 0 (+ 1 i)))
((= i n))
(if (vct? phases)
- (vector-set! (ngencos-arr g) i (make-oscil (* frq (+ 1 i)) (vct-ref phases i)))
+ (vector-set! (ngencos-arr g) i (make-oscil (* frq (+ 1 i)) (phases i)))
(vector-set! (ngencos-arr g) i (make-oscil (* frq (+ 1 i)) (random (* 2 pi)))))))
g))
(frequency 0.0) (n 1 :type int) (phases #f :type vct) (arr #f :type clm-vector))
@@ -3816,7 +3838,7 @@ compare ncos as FM and direct sum of cos:
(mods (make-vector n)))
(do ((i 0 (+ 1 i)))
((= i n))
- (vector-set! mods i (make-oscil (* (+ 1 i) 100) (* 0.5 pi))))
+ (set! (mods i) (make-oscil (* (+ 1 i) 100) (* 0.5 pi))))
(do ((i start (+ 1 i)))
((= i stop))
(let ((amp (env ampf)))
@@ -4719,10 +4741,10 @@ And the fourth used the ssb-am-bank function in dsp.scm rewritten here for with-
((&gt; i pairs))
(let* ((aff (* i old-freq))
(bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (vector-set! ssbs (- i 1) (<em class=red>make-ssb-am</em> (* i factor old-freq)))
- (vector-set! bands (- i 1) (<a class=quiet href="sndscm.html#makebandpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebandpass_tip)">make-bandpass</a> (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz-&gt;radians</a> (- aff bwf)) ; bandpass is in dsp.scm
- (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz-&gt;radians</a> (+ aff bwf))
- order))))
+ (set! (ssbs (- i 1)) (<em class=red>make-ssb-am</em> (* i factor old-freq)))
+ (set! (bands (- i 1)) (<a class=quiet href="sndscm.html#makebandpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebandpass_tip)">make-bandpass</a> (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz-&gt;radians</a> (- aff bwf)) ; bandpass is in dsp.scm
+ (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz-&gt;radians</a> (+ aff bwf))
+ order))))
(<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
(do ((i start (+ 1 i)))
((= i end))
@@ -4730,8 +4752,8 @@ And the fourth used the ssb-am-bank function in dsp.scm rewritten here for with-
(y (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> rd)))
(do ((band 0 (+ 1 band)))
((= band pairs))
- (set! sum (+ sum (<em class=red>ssb-am</em> (vector-ref ssbs band)
- (<a class=quiet href="sndscm.html#makebandpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebandpass_tip)">bandpass</a> (vector-ref bands band) y)))))
+ (set! sum (+ sum (<em class=red>ssb-am</em> (ssbs band)
+ (<a class=quiet href="sndscm.html#makebandpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebandpass_tip)">bandpass</a> (bands band) y)))))
(<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp sum)))))))
(let* ((sound "oboe.snd")
@@ -4751,7 +4773,7 @@ We would replace the current make-ssb-am line with:
</p>
<pre>
(vector-set! ssbs (- i 1) (<em class=red>make-ssb-am</em> (+ (* i factor old-freq)
- (* new-freq (inexact-&gt;exact (round (* i <em class=red>stretch</em>)))))))
+ (* new-freq (round (* i <em class=red>stretch</em>))))))
</pre>
@@ -4791,7 +4813,7 @@ We would replace the current make-ssb-am line with:
(set! (mus-phase g) (* -0.5 pi))
(do ((i 0 (+ 1 i)))
((= i 64))
- (vct-set! v i (ncos g)))
+ (set! (v i) (ncos g)))
v))))
(do ((i 0 (+ 1 i)))
((= i 44100))
@@ -4863,7 +4885,7 @@ make-wave-train-with-env (defined in generators.scm) returns a new wave-train ge
(g (make-sum-of-cosines 10 400 (* -0.5 pi))))
(do ((i 0 (+ 1 i)))
((= i 64))
- (vct-set! v i (sum-of-cosines g)))
+ (set! (v i) (sum-of-cosines g)))
v))))
(run
(do ((i 0 (+ 1 i)))
@@ -4896,7 +4918,7 @@ Here is a FOF instrument based loosely on fof.c of Perry Cook and the article
(wt0 (<em class=red>make-wave-train</em> :wave foftab :frequency frq)))
(do ((i 0 (+ 1 i)))
((= i foflen))
- (set! (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> foftab i) ;; this is not the pulse shape used by B&amp;R
+ (set! (foftab i) ;; this is not the pulse shape used by B&amp;R
(* (+ (* a0 (sin (* i frq0)))
(* a1 (sin (* i frq1)))
(* a2 (sin (* i frq2))))
@@ -4947,15 +4969,15 @@ using the same frequency envelope as the wave-train, so we have some idea when t
(outa i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) (<em class=red>wave-train</em> grains gliss)))
(let ((click (<em class=red>pulse-train</em> click-track gliss)))
(if (&gt; click 0.0)
- (let* ((scaler (max 0.1 (exact-&gt;inexact (/ (- i beg) len))))
+ (let* ((scaler (max 0.1 (* 1.0 (/ (- i beg) len))))
(comb-len 32)
(c1 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler comb-len))
- (c2 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (inexact-&gt;exact (floor (* comb-len .75)))))
- (c3 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (inexact-&gt;exact (floor (* comb-len 1.25))))))
+ (c2 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (floor (* comb-len .75))))
+ (c3 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (floor (* comb-len 1.25)))))
(do ((k 0 (+ 1 k)))
((= k grain-size))
- (let ((x (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> original-grain k)))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> grain k (+ (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c1 x) (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c2 x) (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c3 x))))))))))))))
+ (let ((x (original-grain k)))
+ (set! (grain k) (+ (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c1 x) (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c2 x) (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c3 x))))))))))))))
(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (when? 0 4 2.0 8.0 "right-now.snd"))
</pre>
@@ -5159,16 +5181,16 @@ do perfectly well:
(rands (make-vector n #f)))
(do ((i 0 (+ 1 i)))
((= i n))
- (vector-set! rands i (<em class=red>make-rand</em> :frequency (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) :amplitude (/ 100 n)))
- (rand (vector-ref rands i)))
+ (set! (rands i) (<em class=red>make-rand</em> :frequency (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) :amplitude (/ 100 n)))
+ (rand (rands i)))
(do ((i 0 (+ 1 i)))
((= i 100000))
(let ((sum 0.0))
(do ((k 0 (+ 1 k)))
((= k n))
- (set! sum (+ sum (<em class=red>rand</em> (vector-ref rands k)))))
- (let ((bin (inexact-&gt;exact (+ 100 (round sum)))))
- (vector-set! bins bin (+ (vector-ref bins bin) 1)))))
+ (set! sum (+ sum (<em class=red>rand</em> (rands k)))))
+ (let ((bin (floor (+ 100 (round sum)))))
+ (set! (bins bin) (+ (bins bin) 1)))))
bins))
(let ((ind (<a class=quiet href="extsnd.html#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "test.snd")))
@@ -5228,7 +5250,7 @@ but 0.5 should happen three times as often as either of the others:
(let ((vals (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0.0 0.5 0.5 0.5 1.0)))
(do ((i 0 (+ 1 i)))
((= i 10))
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f ";~A " (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> vals (inexact-&gt;exact (floor (random 5.0))))))))
+ (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f ";~A " (vals (floor (random 5.0)))))))
</pre>
<p>These "distributions" refer to the values returned by the random number
@@ -5250,14 +5272,14 @@ than the preceding:
(let ((rans (make-vector n)))
(do ((i 0 (+ 1 i)))
((= i n) rans)
- (vector-set! rans i (<em class=red>make-rand</em> :frequency (/ (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) (expt 2 i)))))))
+ (set! (rans i) (<em class=red>make-rand</em> :frequency (/ (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) (expt 2 i)))))))
(define (1f-noise rans)
(let ((val 0.0)
(len (length rans)))
(do ((i 0 (+ 1 i)))
((= i len) (/ val len))
- (set! val (+ val (<em class=red>rand</em> (vector-ref rans i)))))))
+ (set! val (+ val (<em class=red>rand</em> (rans i)))))))
</pre>
</td></tr></table>
@@ -5809,7 +5831,7 @@ If "radius" is .99, you get a glass-harmonica effect; if it's less, you get more
(let ((start-frq (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> menv)))
(do ((i 0 (+ 1 i)))
((= i num-formants))
- (vector-set! frms i (<em class=red>make-formant</em> (* (+ i 1) start-frq) radius))))
+ (set! (frms i) (<em class=red>make-formant</em> (* (+ i 1) start-frq) radius))))
(<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
(do ((k beg (+ 1 k)))
((= k end))
@@ -5818,10 +5840,10 @@ If "radius" is .99, you get a glass-harmonica effect; if it's less, you get more
(frq (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> menv)))
(do ((i 0 (+ 1 i)))
((= i num-formants))
- (set! sum (+ sum (<em class=red>formant</em> (vector-ref frms i) x)))
+ (set! sum (+ sum (<em class=red>formant</em> (frms i) x)))
(let ((curfrq (* (+ i 1) frq)))
(if (&lt; (* 2 curfrq) (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>))
- (set! (<em class=red>mus-frequency</em> (vector-ref frms i)) curfrq))))
+ (set! (<em class=red>mus-frequency</em> (frms i)) curfrq))))
(<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> k (* amp sum)))))))
(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
@@ -5957,21 +5979,13 @@ order (it is the size of the coefficient array).
<td>
<pre>
(let ((xout 0.0))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> state 0 input)
-
+ (set! (state 0) input)
(do ((j (- order 1) (- j 1)))
((= j 0))
- (set! xout (+ xout
- (* (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> xcoeffs j)
- (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> state j))))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> state 0 (- (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> state 0)
- (* (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> ycoeffs j)
- (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> state j))))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> state j (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> state (- j 1))))
-
- (+ xout
- (* (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> state 0)
- (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> xcoeffs 0))))
+ (set! xout (+ xout (* (xcoeffs j) (state j))))
+ (set! (state 0) (- (state 0) (* (ycoeffs j) (state j))))
+ (set! (state j) (state (- j 1))))
+ (+ xout (* (state 0) (xcoeffs 0))))
</pre>
</td>
</tr></table>
@@ -6007,9 +6021,9 @@ The Hilbert transform can be implemented with an fir-filter:
(denom (* pi i))
(num (- 1.0 (cos (* pi i)))))
(if (or (= num 0.0) (= i 0))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> arr k 0.0)
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> arr k (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (set! (arr k) 0.0)
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
(<em class=red>make-fir-filter</em> arrlen arr)))
(define hilbert-transform <em class=red>fir-filter</em>)
@@ -6163,7 +6177,7 @@ mus-interp-lagrange, mus-interp-bezier, or mus-interp-hermite.
<br>
<pre>
(let ((result (<a class=quiet href="#array-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_array_interp_tip)">array-interp</a> line (- loc pm))))
- (set! (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> line loc) input)
+ (set! (line loc) input)
(set! loc (+ 1 loc))
(if (&lt;= size loc) (set! loc 0))
result)
@@ -6403,14 +6417,14 @@ delay line as the coefficients for an FIR filter:
(rd (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file)))
(do ((k 0 (+ 1 k)))
((= k num-combs0))
- (vector-set! cmbs0 k
- (<em class=red>make-comb</em> scaler
- (inexact-&gt;exact (floor (* comb-len (list-ref combs0 k)))))))
+ (set! (cmbs0 k)
+ (<em class=red>make-comb</em> scaler
+ (floor (* comb-len (list-ref combs0 k))))))
(do ((k 0 (+ 1 k)))
((= k num-combs1))
- (vector-set! cmbs1 k
- (<em class=red>make-comb</em> scaler
- (inexact-&gt;exact (floor (* comb-len (list-ref combs1 k)))))))
+ (set! (cmbs1 k)
+ (<em class=red>make-comb</em> scaler
+ (floor (* comb-len (list-ref combs1 k))))))
(<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
(do ((i beg (+ 1 i)))
((= i end))
@@ -6420,10 +6434,10 @@ delay line as the coefficients for an FIR filter:
(x (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> rd)))
(do ((k 0 (+ 1 k)))
((= k num-combs0))
- (set! sum0 (+ sum0 (<em class=red>comb</em> (vector-ref cmbs0 k) x))))
+ (set! sum0 (+ sum0 (<em class=red>comb</em> (cmbs0 k) x))))
(do ((k 0 (+ 1 k)))
((= k num-combs1))
- (set! sum1 (+ sum1 (<em class=red>comb</em> (vector-ref cmbs1 k) x))))
+ (set! sum1 (+ sum1 (<em class=red>comb</em> (cmbs1 k) x))))
(<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (+ (* interp sum0) (* (- 1.0 interp) sum1))))))))
(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:scaled-to .5)
@@ -7311,7 +7325,7 @@ one argument that return a new input sample whenever they are called by granulat
<pre>
(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (granulate-sound file beg dur (orig-beg 0.0) (exp-amt 1.0))
(let* ((f-srate (srate file))
- (f-start (inexact-&gt;exact (round (* f-srate orig-beg))))
+ (f-start (round (* f-srate orig-beg)))
(f (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file :start f-start))
(st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds-&gt;samples</a> beg))
(new-dur (or dur (- (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> file) orig-beg)))
@@ -7879,7 +7893,7 @@ writes out the new "sound":
((= i size))
(do ((j 0 (+ j 1)))
((= j size))
- (vct-set! samps samp (<em class=red>mixer-ref</em> mx i j))
+ (set! (samps samp) (<em class=red>mixer-ref</em> mx i j))
(set! samp (+ samp 1))))
(vct-&gt;channel samps 0 (* size size) nsnd)))
@@ -8313,7 +8327,7 @@ use its :output argument:
(do ((i 0 (+ 1 i)))
((= i 10))
(outa i (* i .1) (lambda (loc val chan)
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> outv loc val))))))
+ (set! (outv loc) val))))))
outv) ; this is equivalent to using :output (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 10) as a with-sound argument
</pre>
</td></tr></table>
@@ -8490,7 +8504,7 @@ Here is an example of move-locsig:
(let ((sig (* .5 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc))))
(<em class=red>locsig</em> loc j sig)
(set! j (+ 1 j))))
- (<em class=red>move-locsig</em> loc (exact-&gt;inexact i) 1.0)))))
+ (<em class=red>move-locsig</em> loc (* 1.0 i) 1.0)))))
</pre>
</td></tr></table>
@@ -8787,7 +8801,7 @@ set of components and component amplitudes. We could, for example, change noid
</p>
<pre>
- (vct-set! amps (+ j 1) (/ (expt r (- i 1)) norm))
+ (set! (amps (+ j 1)) (/ (expt r (- i 1)) norm))
</pre>
<p>where "r" is the ratio between successive component amplitude: "nroid"?
@@ -9801,7 +9815,7 @@ can calculate the safe maximum r, given the current srate and frequency (this fu
(min 0.999999 (expt (* .001 topk) (/ 1.0 topk)))))
</pre>
-<p>
+<p>Similar to rkcos is (expt (asin (sqrt (oscil x))) 2).
rksin and rkcos provide a nice demonstration of how insensitive the ear is to phase. These two waveforms look different, but
have the same timbre. The sawtooth sounds louder to me, despite having the same peak amplitude.
</p>
@@ -10250,7 +10264,7 @@ via mus-data.
(set! last-pitch pitch)
(set! pitch (<em class=red>moving-pitch</em> scn))
(if (not (= last-pitch pitch))
- (format #t "~A: ~A~%" (exact-&gt;inexact (/ i cur-srate)) pitch))))
+ (format #t "~A: ~A~%" (* 1.0 (/ i cur-srate)) pitch))))
(set! (mus-srate) old-srate))
</pre>
<br>
@@ -10697,7 +10711,7 @@ We could define our own FIR filter using dot-product:
(xs (cadr flt))
(xlen (length xs)))
(<a class=quiet href="extsnd.html#vctmove" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctmove_tip)">vct-move!</a> xs (- xlen 1) (- xlen 2) #t)
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> xs 0 x)
+ (set! (xs 0) x)
(<em class=red>dot-product</em> coeffs xs xlen)))
</pre>
</td></tr></table>
@@ -10879,10 +10893,10 @@ only difference is that mus-fft includes the fft length as an argument, whereas
<table border=0 hspace=40><tr><td>
<pre>
(let* ((len (mus-sound-frames "oboe.snd"))
- (fsize (expt 2 (inexact-&gt;exact (ceiling (/ (log len) (log 2.0))))))
+ (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
(rdata (make-vct fsize))
(idata (make-vct fsize))
- (cutoff (inexact-&gt;exact (round (/ fsize 10))))
+ (cutoff (round (/ fsize 10)))
(fsize2 (/ fsize 2)))
(file-&gt;array "oboe.snd" 0 0 len rdata)
@@ -10890,10 +10904,10 @@ only difference is that mus-fft includes the fft length as an argument, whereas
(do ((i cutoff (+ 1 i))
(j (- fsize 1) (- j 1)))
((= i fsize2))
- (vct-set! rdata i 0.0)
- (vct-set! idata i 0.0)
- (vct-set! rdata j 0.0)
- (vct-set! idata j 0.0))
+ (set! (rdata i) 0.0)
+ (set! (idata i) 0.0)
+ (set! (rdata j) 0.0)
+ (set! (idata j) 0.0))
(<em class=red>mus-fft</em> rdata idata fsize -1)
(array-&gt;file "test.snd"
diff --git a/sndlib-ws.scm b/sndlib-ws.scm
index 438aef4..82de5ea 100644
--- a/sndlib-ws.scm
+++ b/sndlib-ws.scm
@@ -499,14 +499,14 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
(et-pitch (+ base-pitch (* 12 octave))))
(set! last-octave octave)
(if pythagorean
- (* main-pitch (expt 2 octave) (vector-ref ratios base-pitch))
+ (* main-pitch (expt 2 octave) (ratios base-pitch))
(* main-pitch (expt 2.0 (/ et-pitch 12)))))
pitch))))
(define (->sample beg)
"(->sample time-in-seconds) -> time-in-samples"
- (inexact->exact (round (* (if (not (null? (sounds))) (srate) (mus-srate)) beg))))
+ (round (* (if (not (null? (sounds))) (srate) (mus-srate)) beg)))
diff --git a/sndscm.html b/sndscm.html
index 05c21b6..6cdeee2 100644
--- a/sndscm.html
+++ b/sndscm.html
@@ -86,173 +86,176 @@ For help with Forth and Snd/CLM, see the Forth documentation section "Snd, CLM,
<tr><td><a href="#bessdoc">bess</a></td>
<td onmouseout="UnTip()" onmouseover="Tip(bess_doc_tip)">FM demo</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#birddoc">bird</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(bird_doc_tip)">North-American birds</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#binaryiodoc">binary-io</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(binary_io_doc_tip)">binary files</td></tr>
-<tr><td><a href="#cleandoc">clean</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(clean_doc_tip)">noise reduction</td></tr>
+<tr><td><a href="#birddoc">bird</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(bird_doc_tip)">North-American birds</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#clminsdoc">clm-ins, clm23, jcvoi</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(clm_ins_doc_tip)">various CLM instruments</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#cleandoc">clean</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(clean_doc_tip)">noise reduction</td></tr>
-<tr><td><a href="#dlocsigdoc">dlocsig</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(dlocsig_doc_tip)">moving sounds (Michael Scholz)</td></tr>
+<tr><td><a href="#clminsdoc">clm-ins, clm23, jcvoi</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(clm_ins_doc_tip)">various CLM instruments</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#drawdoc">draw</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(draw_doc_tip)">graphics additions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#dlocsigdoc">dlocsig</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dlocsig_doc_tip)">moving sounds (Michael Scholz)</td></tr>
-<tr><td><a href="#dspdoc">dsp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(dsp_doc_tip)">various DSP-related procedures</td></tr>
+<tr><td><a href="#drawdoc">draw</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(draw_doc_tip)">graphics additions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#envdoc">env</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(env_doc_tip)">envelope functions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#dspdoc">dsp</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dsp_doc_tip)">various DSP-related procedures</td></tr>
-<tr><td><a href="#enveddoc">enved</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(enved_doc_tip)">envelope editor</td></tr>
+<tr><td><a href="#envdoc">env</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(env_doc_tip)">envelope functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#exampdoc">examp</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(examp_doc_tip)">many examples</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#enveddoc">enved</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(enved_doc_tip)">envelope editor</td></tr>
-<tr><td><a href="#extensionsdoc">extensions</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(extensions_doc_tip)">various generally useful Snd extensions</td></tr>
+<tr><td><a href="#exampdoc">examp</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(examp_doc_tip)">many examples</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#fadedoc">fade</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(fade_doc_tip)">frequency-domain cross-fades</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#extensionsdoc">extensions</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(extensions_doc_tip)">various generally useful Snd extensions</td></tr>
-<tr><td><a href="#framedoc">frame</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(frame_doc_tip)">frames, vcts, sound-data objects</td></tr>
+<tr><td><a href="#fadedoc">fade</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(fade_doc_tip)">frequency-domain cross-fades</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#freeverbdoc">freeverb</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(freeverb_doc_tip)">a reverb</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#framedoc">frame</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(frame_doc_tip)">frames, vcts, sound-data objects</td></tr>
-<tr><td><a href="sndclm.html#othergenerators">generators.scm</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(generators_doc_tip)">a bunch of generators</td></tr>
+<tr><td><a href="#freeverbdoc">freeverb</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(freeverb_doc_tip)">a reverb</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#granidoc">grani</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(grani_doc_tip)">CLM's grani (Fernando Lopez-Lezcano) translated by Mike Scholz</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="sndclm.html#othergenerators">generators.scm</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(generators_doc_tip)">a bunch of generators</td></tr>
-<tr><td><a href="#heartdoc">heart</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(heart_doc_tip)">use Snd with non-sound (arbitrary range) data</td></tr>
+<tr><td><a href="#granidoc">grani</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(grani_doc_tip)">CLM's grani (Fernando Lopez-Lezcano) translated by Mike Scholz</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#hooksdoc">hooks</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(hooks_doc_tip)">functions related to hooks</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#heartdoc">heart</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(heart_doc_tip)">use Snd with non-sound (arbitrary range) data</td></tr>
-<tr><td><a href="#indexdoc">index</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(index_doc_tip)">snd-help extension</td></tr>
+<tr><td><a href="#hooksdoc">hooks</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(hooks_doc_tip)">functions related to hooks</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#dotemacs">inf-snd.el, DotEmacs</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(inf_snd_doc_tip)">Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#indexdoc">index</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(index_doc_tip)">snd-help extension</td></tr>
-<tr><td><a href="#jcrevdoc">jcrev</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(jcrev_doc_tip)">John Chowning's ancient reverb</td></tr>
+<tr><td><a href="#dotemacs">inf-snd.el, DotEmacs</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(inf_snd_doc_tip)">Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#maracadoc">maraca</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(maraca_doc_tip)">Perry Cook's maraca physical model</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#jcrevdoc">jcrev</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(jcrev_doc_tip)">John Chowning's ancient reverb</td></tr>
-<tr><td><a href="#marksdoc">marks</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(marks_doc_tip)">functions related to marks</td></tr>
+<tr><td><a href="#maracadoc">maraca</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(maraca_doc_tip)">Perry Cook's maraca physical model</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#maxfdoc">maxf</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(maxf_doc_tip)">Max Mathews resonator</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#marksdoc">marks</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(marks_doc_tip)">functions related to marks</td></tr>
-<tr><td><a href="#menusdoc">menus</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(menus_doc_tip)">additional menus</td></tr>
+<tr><td><a href="#maxfdoc">maxf</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(maxf_doc_tip)">Max Mathews resonator</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#mixdoc">mix</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(mix_doc_tip)">functions related to mixes</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#menusdoc">menus</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(menus_doc_tip)">additional menus</td></tr>
-<tr><td><a href="#mixerdoc">mixer</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(mixer_doc_tip)">functions related to linear algebra</td></tr>
+<tr><td><a href="#mixdoc">mix</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(mix_doc_tip)">functions related to mixes</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#moogdoc">moog</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(moog_doc_tip)">Moog filter</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#mixerdoc">mixer</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(mixer_doc_tip)">functions related to linear algebra</td></tr>
-<tr><td><a href="#musglyphs">musglyphs</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(musglyphs_doc_tip)">Music notation symbols (from CMN)</td></tr>
+<tr><td><a href="#moogdoc">moog</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(moog_doc_tip)">Moog filter</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#nbdoc">nb</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(nb_doc_tip)">Popup File info etc</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#musglyphs">musglyphs</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(musglyphs_doc_tip)">Music notation symbols (from CMN)</td></tr>
-<tr><td><a href="#noisedoc">noise</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(noise_doc_tip)">noise maker</td></tr>
+<tr><td><a href="#nbdoc">nb</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(nb_doc_tip)">Popup File info etc</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#numericsdoc">numerics</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(numerics_doc_tip)">various numerical functions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#noisedoc">noise</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(noise_doc_tip)">noise maker</td></tr>
-<tr><td><a href="#oscopedoc">oscope</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(oscope_doc_tip)">an oscilloscope/spectrum analysis dialog</td></tr>
+<tr><td><a href="#numericsdoc">numerics</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(numerics_doc_tip)">various numerical functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#peakphasesdoc">peak-phases</a></td>
- <td bgcolor="#f2f4ff">phases for the unpulse-train</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#oscopedoc">oscope</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(oscope_doc_tip)">an oscilloscope/spectrum analysis dialog</td></tr>
-<tr><td><a href="#pianodoc">piano</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(piano_doc_tip)">piano physical model</td></tr>
+<tr><td><a href="#peakphasesdoc">peak-phases</a></td>
+ <td>phases for the unpulse-train</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#playdoc">play</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(play_doc_tip)">play-related functions</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#pianodoc">piano</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(piano_doc_tip)">piano physical model</td></tr>
-<tr><td><a href="#polydoc">poly</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(poly_doc_tip)">polynomial-related stuff</td></tr>
+<tr><td><a href="#playdoc">play</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(play_doc_tip)">play-related functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#popupdoc">popup, gtk-popup</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(popup_doc_tip)">Popup menu specializations</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#polydoc">poly</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(poly_doc_tip)">polynomial-related stuff</td></tr>
-<tr><td><a href="#prc95doc">prc95</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(prc95_doc_tip)">Perry Cook's physical model examples</td></tr>
+<tr><td><a href="#popupdoc">popup, gtk-popup</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(popup_doc_tip)">Popup menu specializations</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#pvocdoc">pvoc</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(pvoc_doc_tip)">phase-vocoder</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#prc95doc">prc95</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(prc95_doc_tip)">Perry Cook's physical model examples</td></tr>
-<tr><td><a href="#rgbdoc">rgb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rgb_doc_tip)">color names</td></tr>
+<tr><td><a href="#pvocdoc">pvoc</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(pvoc_doc_tip)">phase-vocoder</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#rtiodoc">rtio</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(rtio_doc_tip)">real-time stuff</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#rgbdoc">rgb</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(rgb_doc_tip)">color names</td></tr>
-<tr><td><a href="#rubberdoc">rubber</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rubber_doc_tip)">rubber-sound</td></tr>
+<tr><td><a href="#rtiodoc">rtio</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(rtio_doc_tip)">real-time stuff</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#selectiondoc">selection</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(selection_doc_tip)">functions acting on the current selection</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#rubberdoc">rubber</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(rubber_doc_tip)">rubber-sound</td></tr>
-<tr><td><a href="#singerdoc">singer</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(singer_doc_tip)">Perry Cook's vocal-tract physical model</td></tr>
+<tr><td><a href="#selectiondoc">selection</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(selection_doc_tip)">functions acting on the current selection</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#sndolddoc">snd6|7|8|9|10|11.scm</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(sndold_doc_tip)">Backwards compatibility</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#singerdoc">singer</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(singer_doc_tip)">Perry Cook's vocal-tract physical model</td></tr>
-<tr><td><a href="#snddiffdoc">snddiff</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snddiff_doc_tip)">sound difference detection</td></tr>
+<tr><td><a href="#sndolddoc">snd6|7|8|9|10|11.scm</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(sndold_doc_tip)">Backwards compatibility</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#sndgldoc">snd-gl</a></td>
- <td bgcolor="#f2f4ff"onmouseout="UnTip()" onmouseover="Tip(snd_gl_doc_tip)">OpenGL examples (gl.c)</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#snddiffdoc">snddiff</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snddiff_doc_tip)">sound difference detection</td></tr>
-<tr><td><a href="#sndmotifdoc">snd-motif, snd-gtk, snd-xm</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snd_motif_doc_tip)">Motif/Gtk module (xm.c, xg.c)</td></tr>
+<tr><td><a href="#sndgldoc">snd-gl</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(snd_gl_doc_tip)">OpenGL examples (gl.c)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#sndtestdoc">snd-test</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snd_test_doc_tip)">Snd regression tests</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#sndmotifdoc">snd-motif, snd-gtk, snd-xm</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snd_motif_doc_tip)">Motif/Gtk module (xm.c, xg.c)</td></tr>
-<tr><td><a href="#sndwarpdoc">sndwarp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(sndwarp_doc_tip)">Bret Battey's sndwarp instrument</td></tr>
+<tr><td><a href="#sndtestdoc">snd-test</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(snd_test_doc_tip)">Snd regression tests</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#spectrdoc">spectr</a></td>
- <td bgcolor="#f2f4ff">instrument steady state spectra</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#sndwarpdoc">sndwarp</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(sndwarp_doc_tip)">Bret Battey's sndwarp instrument</td></tr>
-<tr><td><a href="#stochasticdoc">stochastic</a></td>
- <td>Bill Sack's dynamic stochastic synthesis</td></tr>
+<tr><td><a href="#spectrdoc">spectr</a></td>
+ <td>instrument steady state spectra</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#straddoc">strad</a></td>
- <td bgcolor="#f2f4ff">string physical model (from CLM)</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#stochasticdoc">stochastic</a></td>
+ <td bgcolor="#f2f4ff">Bill Sack's dynamic stochastic synthesis</td></tr>
-<tr><td><a href="#vdoc">v</a></td>
- <td>fm-violin</td></tr>
+<tr><td><a href="#straddoc">strad</a></td>
+ <td>string physical model (from CLM)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#wsdoc">ws</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(ws_doc_tip)">with-sound</td></tr>
+<tr><td bgcolor="#f2f4ff"><a href="#vdoc">v</a></td>
+ <td bgcolor="#f2f4ff">fm-violin</td></tr>
-<tr><td><a href="#zipdoc">zip</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(zip_doc_tip)">the zipper (the anti-cross-fader)</td></tr>
+<tr><td><a href="#wsdoc">ws</a></td>
+ <td onmouseout="UnTip()" onmouseover="Tip(ws_doc_tip)">with-sound</td></tr>
+
+<tr><td bgcolor="#f2f4ff"><a href="#zipdoc">zip</a></td>
+ <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(zip_doc_tip)">the zipper (the anti-cross-fader)</td></tr>
</table>
</td></tr></table>
@@ -730,6 +733,31 @@ Michael Scholz, based on CLM's bess5.cl and rt.lisp.
<br>
+<!-- ---------------------------------------- FILE: binary-io ---------------------------------------- -->
+
+<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
+<A NAME="binaryiodoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>binary-io</h2></td></tr></table>
+</td></tr></table>
+
+<!-- main-index |binaryiodoc:binary files -->
+<A NAME="binaryio"></A>
+
+<table border=0><tr><td bgcolor="#f2f3ff">
+<em class=emdef>read|write-l|bint16|32|64</em><br>
+<em class=emdef>read|write-l|bfloat32|64</em><br>
+<em class=emdef>read|write-chars|string</em><br>
+<em class=emdef>read|write-au-header</em>
+</td></tr></table>
+
+<p>This file has functions to read and write numbers and strings to and from binary files.
+The function names are similar to those used for data-format names, so for example,
+read-bint32 reads the next 4 bytes from the current input port,
+interpreting them as a big-endian 32-bit integer.
+</p>
+
+<br>
+<br>
+
<!-- ---------------------------------------- FILE: bird ---------------------------------------- -->
<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
@@ -874,8 +902,8 @@ time for perfection...):
(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-data clip-ctr) clip-beg)
+ (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))
@@ -918,30 +946,30 @@ end points. (This is also "just-good-enough" software).
(samps (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel-&gt;vct</a> (- clip-beg-1 4) (+ dur 9)))
(clip-beg 3)
(clip-end (+ dur 4)))
- (let ((samp0 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps clip-beg))
- (samp1 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps clip-end)))
+ (let ((samp0 (samps clip-beg))
+ (samp1 (samps clip-end)))
(if (or (&gt; samp0 .99) (&lt; samp0 -.99))
(begin
;; weird! some of the clipped passages have "knees"
;; this looks nuts, but no time to scratch my head
(set! clip-beg (- clip-beg 1))
- (set! samp0 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps clip-beg))
+ (set! samp0 (samps clip-beg))
(if (or (&gt; samp0 .99) (&lt; samp0 -.99))
(begin
(set! clip-beg (- clip-beg 1))
- (set! samp0 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps clip-beg))))))
+ (set! samp0 (samps clip-beg))))))
(if (or (&gt; samp1 .99) (&lt; samp1 -.99))
(begin
(set! clip-end (+ 1 clip-end))
- (set! samp1 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps clip-end))
+ (set! samp1 (samps clip-end))
(if (or (&gt; samp1 .99) (&lt; samp1 -.99))
(begin
(set! clip-end (+ 1 clip-end))
- (set! samp1 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps clip-end))))))
+ (set! samp1 (samps clip-end))))))
;; now we have semi-plausible bounds
;; make sine dependent on rate of change of current
- (let* ((samp00 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps (- clip-beg 1)))
- (samp11 (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> samps (+ 1 clip-end)))
+ (let* ((samp00 (samps (- clip-beg 1)))
+ (samp11 (samps (+ 1 clip-end)))
(dist (- clip-end clip-beg))
(incr (/ pi dist))
(amp (* .125 (+ (abs (- samp0 samp00)) (abs (- samp1 samp11))) dist)))
@@ -950,12 +978,12 @@ end points. (This is also "just-good-enough" software).
(do ((i (+ 1 clip-beg) (+ 1 i))
(angle incr (+ angle incr)))
((= i clip-end))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> samps i (+ 1.0 (* amp (sin angle)))))
+ (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))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> samps i (- -1.0 (* amp (sin angle))))))
+ (set! (samps i) (- -1.0 (* amp (sin angle))))))
(<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct-&gt;channel</a> samps (- clip-beg-1 4))))
#t) ; return values so I can tell when I hit a 1-sample section during testing
#f))
@@ -997,7 +1025,7 @@ telephone recordings, I assumed anything under 40 Hz or above
;; since I'm assuming 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-&gt;exact (expt 2 (ceiling (/ (log (/ cur-srate 10.0)) (log 2.0)))))
+ (floor (expt 2 (ceiling (/ (log (/ cur-srate 10.0)) (log 2.0)))))
snd chn)))
(notch-out-rumble-and-hiss)
@@ -2537,9 +2565,9 @@ z-transform performs a z-transform returning a vector (to accommodate complex re
:<em class=typing>(define d0 (make-vct 8))</em>
<em class=listener>#&lt;unspecified&gt;</em>
;; and similarly for d1 and d2 ...
- :<em class=typing>(vct-set! d0 2 1.0)</em>
+ :<em class=typing>(set! (d0 2) 1.0)</em>
<em class=listener>1.0</em>
- :<em class=typing>(vct-set! d1 2 1.0)</em>
+ :<em class=typing>(set! (d1 2) 1.0)</em>
<em class=listener>1.0</em>
:<em class=typing>(z-transform d0 8 (exp (make-rectangular 0.0 (* .25 pi))))</em>
;; Ruby: z_transform(d0, 8, exp(Complex(0.0, (2.0 / 8) * PI)))
@@ -3187,7 +3215,7 @@ then
(do ((i 0 (+ 1 i)))
((= i 12))
(let ((val (sin (/ (* 2 pi i) 12.0))))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> x1 (+ i (- (/ size 4) 6)) val)))
+ (set! (x1 (+ i (- (/ size 4) 6))) val)))
(do ((i 0 (+ 1 i)))
((or (<a class=quiet href="extsnd.html#cgp" onmouseout="UnTip()" onmouseover="Tip(extsnd_cgp_tip)">c-g?</a>) (= i 1024)))
(<em class=red>compute-uniform-circular-string</em> size x0 x1 x2 1.0 0.1 0.0)
@@ -3694,10 +3722,10 @@ current spectrum value.
(define (brfft lofrq hifrq)
"(brfft lofrq hifrq) removes all frequencies between lofrq and hifrq: (brfft 1000.0 2000.0)"
(let* ((len (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (fsize (expt 2 (inexact-&gt;exact (ceiling (/ (log len) (log 2.0))))))
+ (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
(ctr -1)
- (lo (inexact-&gt;exact (round (/ (* fsize lofrq) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))))
- (hi (inexact-&gt;exact (round (/ (* fsize hifrq) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))))
+ (lo (round (/ (* fsize lofrq) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))
+ (hi (round (/ (* fsize hifrq) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))))
(<em class=red>filter-fft</em> (lambda (y)
(set! ctr (+ 1 ctr))
(if (and (&gt;= ctr lo)
@@ -7774,43 +7802,51 @@ all 56 7.3719 0.4963, odd 41 6.3276 0.4968
all 44 6.5525 0.4968, odd 43 6.4809 0.4969
all 36 5.9314 0.4968, odd 45 6.6310 0.4970
all 46 6.6997 0.4968, odd 42 6.4085 0.4970
-all 43 6.4824 0.4969, odd 37 6.0249 0.4974
-all 49 6.9216 0.4971, odd 74 8.5058 0.4974
-all 84 9.0496 0.4971, odd 46 6.7167 0.4975
-all 41 6.3364 0.4972, odd 39 6.1875 0.4975
-all 53 7.2114 0.4976, odd 40 6.2779 0.4980
-all 52 7.1497 0.4978, odd 57 7.4982 0.4983
-all 48 6.8711 0.4979, odd 56 7.4388 0.4985
-all 98 9.8164 0.4982, odd 82 8.9991 0.4986
-all 55 7.3621 0.4982, odd 51 7.1024 0.4986
-all 68 8.1976 0.4986, odd 59 7.6434 0.4988
-all 7 2.6394 0.4988, odd 44 6.6048 0.4989
-all 80 8.8986 0.4988, odd 77 8.7389 0.4991
-all 50 7.0407 0.4989, odd 78 8.8023 0.4992
-all 38 6.1411 0.4990, odd 61 7.7859 0.4992
-all 57 7.5207 0.4990, odd 76 8.6919 0.4993
-all 99 9.9063 0.4990, odd 38 6.1502 0.4994
-all 86 9.2397 0.4992, odd 58 7.6006 0.4995
-all 74 8.5725 0.4992, odd 48 6.9153 0.4995
-all 77 8.7464 0.4993, odd 63 7.9226 0.4996
-all 61 7.7868 0.4993, odd 81 8.9849 0.4996
-all 42 6.4658 0.4994, odd 36 5.9961 0.4998
-all 47 6.8394 0.4994, odd 49 6.9979 0.4999
-all 70 8.3468 0.4994, odd 53 7.2779 0.4999
-all 63 7.9218 0.4995
-all 51 7.1289 0.4996
-all 73 8.5279 0.4996
-all 105 10.2269 0.4996
-all 64 7.9862 0.4996
-all 67 8.1712 0.4996
-all 54 7.3372 0.4996
-all 66 8.1118 0.4996
+all 43 6.4824 0.4969, odd 82 8.9488 0.4973
+all 49 6.9216 0.4971, odd 37 6.0249 0.4974
+all 84 9.0496 0.4971, odd 74 8.5058 0.4974
+all 41 6.3364 0.4972, odd 46 6.7167 0.4975
+all 53 7.2114 0.4976, odd 39 6.1875 0.4975
+all 52 7.1497 0.4978, odd 47 6.7934 0.4976
+all 48 6.8711 0.4979, odd 40 6.2779 0.4980
+all 98 9.8164 0.4982, odd 57 7.4982 0.4983
+all 55 7.3621 0.4982, odd 56 7.4388 0.4985
+all 68 8.1976 0.4986, odd 51 7.1024 0.4986
+all 7 2.6394 0.4988, odd 89 9.3775 0.4987
+all 80 8.8986 0.4988, odd 101 9.9903 0.4987
+all 77 8.7312 0.4988, odd 59 7.6434 0.4988
+all 76 8.6755 0.4989, odd 55 7.3809 0.4988
+all 50 7.0407 0.4989, odd 105 10.1929 0.4989
+all 40 6.2990 0.4989, odd 44 6.6048 0.4989
+all 38 6.1411 0.4990, odd 60 7.7158 0.4990
+all 78 8.7941 0.4990, odd 77 8.7389 0.4991
+all 57 7.5207 0.4990, odd 78 8.8023 0.4992
+all 99 9.9063 0.4990, odd 61 7.7859 0.4992
+all 86 9.2397 0.4992, odd 76 8.6919 0.4993
+all 74 8.5725 0.4992, odd 38 6.1502 0.4994
+all 61 7.7868 0.4993, odd 69 8.2868 0.4994
+all 42 6.4658 0.4994, odd 81 8.9788 0.4995
+all 47 6.8394 0.4994, odd 110 10.4618 0.4995
+all 70 8.3468 0.4994, odd 91 9.5171 0.4995
+all 69 8.2898 0.4995, odd 106 10.2708 0.4995
+all 63 7.9218 0.4995, odd 58 7.6006 0.4995
+all 51 7.1289 0.4996, odd 48 6.9153 0.4995
+all 73 8.5279 0.4996, odd 63 7.9226 0.4996
+all 105 10.2269 0.4996, odd 83 9.0984 0.4997
+all 64 7.9862 0.4996, odd 53 7.2716 0.4997
+all 67 8.1712 0.4996, odd 54 7.3417 0.4998
+all 54 7.3372 0.4996, odd 36 5.9961 0.4998
+all 66 8.1118 0.4996, odd 88 9.3742 0.4998
+all 85 9.2065 0.4997, odd 49 6.9979 0.4999
all 79 8.8770 0.4997
+all 91 9.5289 0.4998
all 104 10.1881 0.4998
all 59 7.6748 0.4998
all 45 6.7031 0.4998
all 62 7.8677 0.4998
+all 90 9.4791 0.4998
all 65 8.0570 0.4998
+all 81 8.9940 0.4998
all 71 8.4245 0.5000
all 58 7.6146 0.5000
</pre>
@@ -7824,35 +7860,31 @@ all 58 7.6146 0.5000
<pre>
n peak (log peak n) n peak (log peak n)
-all 76 8.7247 0.5002, odd 65 8.0648 0.5001
-all 88 9.3913 0.5002, odd 55 7.4259 0.5003
-all 40 6.3306 0.5003, odd 47 6.8698 0.5005
-all 81 9.0237 0.5006, odd 62 7.8935 0.5006
-all 91 9.5660 0.5006, odd 54 7.3707 0.5008
-all 78 8.8593 0.5007, odd 80 8.9753 0.5008
-all 72 8.5148 0.5008, odd 70 8.3994 0.5009
-all 120 11.0013 0.5009, odd 60 7.7768 0.5010
-all 97 9.8937 0.5010, odd 102 10.1469 0.5010
-all 75 8.7008 0.5011, odd 110 10.5415 0.5011
-all 85 9.2689 0.5012, odd 69 8.3506 0.5012
-all 93 9.7038 0.5014, odd 83 9.1609 0.5013
-all 92 9.6547 0.5014, odd 73 8.5958 0.5014
-all 82 9.1158 0.5015, odd 67 8.2449 0.5017
-all 126 11.3113 0.5016, odd 75 8.7265 0.5018
-all 69 8.3626 0.5016, odd 91 9.6182 0.5018
-all 112 10.6695 0.5017, odd 66 8.1870 0.5018
-all 87 9.3995 0.5017, odd 95 9.8316 0.5019
-all 111 10.6273 0.5018, odd 68 8.3151 0.5020
-all 90 9.5718 0.5020, odd 101 10.1560 0.5023
-all 106 10.3949 0.5021, odd 64 8.0768 0.5023
-all 83 9.2037 0.5023, odd 96 9.9047 0.5024
-all 116 10.8960 0.5024, odd 113 10.7634 0.5026
-all 122 11.1853 0.5026, odd 89 9.5501 0.5027
-all 89 9.5523 0.5028, odd 97 9.9869 0.5030
-all 117 10.9612 0.5028, odd 106 10.4460 0.5031
-all 123 11.2551 0.5031, odd 92 9.7295 0.5032
-all 108 10.5434 0.5031, odd 90 9.6256 0.5032
-all 114 10.8344 0.5031, odd 87 9.4658 0.5033
+all 88 9.3913 0.5002, odd 65 8.0634 0.5000
+all 72 8.5093 0.5007, odd 67 8.1895 0.5001
+all 75 8.6899 0.5008, odd 108 10.4063 0.5003
+all 120 11.0013 0.5009, odd 103 10.1685 0.5004
+all 89 9.4726 0.5009, odd 95 9.7666 0.5004
+all 97 9.8937 0.5010, odd 90 9.5105 0.5006
+all 83 9.1618 0.5013, odd 62 7.8935 0.5006
+all 82 9.1087 0.5013, odd 75 8.6837 0.5006
+all 96 9.8586 0.5014, odd 80 8.9753 0.5008
+all 93 9.7038 0.5014, odd 102 10.1408 0.5009
+all 92 9.6547 0.5014, odd 73 8.5776 0.5009
+all 87 9.3910 0.5015, odd 70 8.3994 0.5009
+all 126 11.3113 0.5016, odd 92 9.6345 0.5010
+all 112 10.6695 0.5017, odd 66 8.1577 0.5010
+all 111 10.6273 0.5018, odd 96 9.8485 0.5011
+all 106 10.3949 0.5021, odd 97 9.9084 0.5013
+all 116 10.8960 0.5024, odd 114 10.7456 0.5013
+all 122 11.1853 0.5026, odd 113 10.7143 0.5017
+all 117 10.9612 0.5028, odd 87 9.4015 0.5018
+all 95 9.8722 0.5028, odd 64 8.0638 0.5019
+all 123 11.2551 0.5031, odd 68 8.3132 0.5019
+all 108 10.5434 0.5031, odd 120 11.0803 0.5024
+all 114 10.8344 0.5031, odd 84 9.2632 0.5024
+all 124 11.3159 0.5033, odd 118 11.0121 0.5029
+all 102 10.2586 0.5034, odd 86 9.3989 0.5030
</pre>
</td></tr></table>
@@ -7862,7 +7894,7 @@ possible only at an enlightened institution like CCRMA.
</p>
<p>
-Here is a graph of the values I've found so far (as of February, 2010), followed by a graph of
+Here is a graph of the values I've found so far (as of May, 2010), followed by a graph of
the exponent vs n (n^y = peak amp).
</p>
@@ -7881,8 +7913,8 @@ of the genetic algorithm):
(let ((new-phases (make-vector n 0.0))) ; place in new phase vector shifted up
(do ((k 0 (+ k 1)))
((= k (- n 1)))
- (vector-set! new-phases (+ k 1) (vector-ref all k)))
- (vector-set! new-phases 0 0.0)
+ (set! (new-phases (+ k 1)) (all k)))
+ (set! (new-phases 0) 0.0)
(fpsap 2 n new-phases))) ; search that vicinity for a good set (2 = even harmonics)
</pre>
@@ -8018,56 +8050,56 @@ In code:
(let ((n-min-val (vector-find-if (lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) i)
- (let ((a-val (vector-ref val 1))
+ (= (val 0) i)
+ (let ((a-val (val 1))
(a-len (length val)))
(do ((k 2 (1+ k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
- (set! a-val (vector-ref val k))))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
a-val)))
noid-min-peak-phases)))
(let ((odd-min-val (vector-find-if (lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) i)
- (let ((a-val (vector-ref val 1))
+ (= (val 0) i)
+ (let ((a-val (val 1))
(a-len (length val)))
(do ((k 2 (1+ k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
- (set! a-val (vector-ref val k))))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
a-val)))
nodd-min-peak-phases)))
(let ((prime-min-val (vector-find-if (lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) i)
- (let ((a-val (vector-ref val 1))
+ (= (val 0) i)
+ (let ((a-val (val 1))
(a-len (length val)))
(do ((k 2 (1+ k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
- (set! a-val (vector-ref val k))))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
a-val)))
primoid-min-peak-phases)))
(let ((even-min-val (vector-find-if (lambda (val)
(and val
(vector? val)
- (= (vector-ref val 0) i)
- (let ((a-val (vector-ref val 1))
+ (= (val 0) i)
+ (let ((a-val (val 1))
(a-len (length val)))
(do ((k 2 (1+ k)))
((= k a-len))
- (if (and (number? (vector-ref val k))
- (< (vector-ref val k) a-val))
- (set! a-val (vector-ref val k))))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
a-val)))
neven-min-peak-phases)))
@@ -8198,7 +8230,10 @@ In code:
-->
-<p>We can also use <a href="#withmixedsound">with-mixed-sound</a> to watch the waveforms "in real-time":
+<p>I wonder if minimizing the peak amplitude maximizes the length of the curve.
+</p>
+<p>
+We can also use <a href="#withmixedsound">with-mixed-sound</a> to watch the waveforms "in real-time":
</p>
<table border=0 hspace=40><tr><td>
@@ -8266,7 +8301,7 @@ If this worked in general, we could use it to speed up our search by following a
(format #t ";~A: ~A~%" x p)
(do ((k 0 (+ k 1)))
((= k n))
- (vector-set! phases k (modulo (vct-ref p k) 2.0)))))))
+ (set! (phases k) (modulo (p k) 2.0)))))))
</pre>
<p>
Since we can restrict our search to 0.1 (maybe less) in each direction (rather than 2.0), we
@@ -8275,6 +8310,180 @@ a problem. The search works for n=2 -&gt; 3 -&gt; 4 -&gt; 5, but going from 5 t
non-optimal (but still very good) path.
</p>
+
+<p>
+Since all the compute time (more than 99%) is spent in the FFT,
+we obviously want to know how big the FFT needs to be
+to give a reasonably accurate peak (say
+within 0.001 of the true peak).
+According to N Higham in "Accuracy and Stability of Numerical Algorithms",
+the FFT is stable and very accurate. He has a graph showing accumulated
+numerical errors down in the 10^-15 range! But that is not where the
+inverse FFT loses. We get n points back from an n-point FFT, so
+effectively we're sampling the resultant waveform at those n points.
+This subsampling can easily miss the peak.
+Here are the errors for inverse FFT's of various sizes for the
+8 and 128 all harmonics case (all initial phases = 0.0,
+multiply "mult" by the number of harmonics to get the FFT size):
+</p>
+<!--
+(let ((phases (make-vector 8 0.0))
+ (correct 6.1442))
+ (do ((i 2 (* i 2)))
+ ((> i 8192))
+ (let ((fftval (fft-all 8 i phases)))
+ (format #t "~D: ~A -> ~A~%" i fftval (abs (- fftval correct))))))
+-->
+<pre>
+ 8 harmonics 128 harmonics
+
+mult reported peak error reported peak error
+
+2 5.02733 1.11686e0 81.48324 11.62779
+4 5.57658 5.67621e-1 81.98630 11.12473
+8 6.10774 3.64636e-2 93.08931 0.021721
+16 6.10774 3.64636e-2 93.08931 0.021721
+32 6.14247 1.72736e-3 93.08931 0.021721
+64 6.14247 1.72736e-3 93.08931 0.021721
+128 6.14391 2.87163e-4 93.10728 0.003753
+256 6.14405 1.50636e-4 93.10980 0.001232
+512 6.14420 5.36694e-6 93.11143 0.000391
+1024 6.14420 5.36694e-6 93.11143 0.000391
+2048 6.14420 1.59697e-6 93.11156 0.000525
+4096 6.14420 1.44227e-7 93.11156 0.000525
+8192 6.14420 3.60112e-8 93.11156 0.000526
+</pre>
+
+
+<p>
+128 seems pretty good. Those are spikey cases. If we try the
+best minimum-peak case, the errors are much smaller. Here are graphs of both
+the 0.0 phase and minimum phase cases for 8 harmonics:
+</p>
+
+<table border=0 hspace=20 vspace=10>
+<tr><td>
+<img src="pix/8.png"></td><td width=20></td><td>
+<img src="pix/88.png">
+</td></tr></table>
+
+
+<!--
+(let ((phases #(0.000000 0.666709 0.807769 1.605408 0.837217 0.044625 0.144433 1.873342))
+ (correct 2.7949089))
+ (do ((i 2 (* i 2)))
+ ((> i 8192))
+ (let ((fftval (fft-all 8 i phases)))
+ (format #t "~D: ~A -> ~A~%" i fftval (abs (- fftval correct))))))
+
+2: 2.7906633022277 -> 0.0042455977723455
+4: 2.7906633022277 -> 0.0042455977723455
+8: 2.7906633022277 -> 0.0042455977723455
+16: 2.7914621378061 -> 0.0034467621938754
+32: 2.794721427123 -> 0.00018747287701526
+64: 2.794721427123 -> 0.00018747287701526
+128: 2.794721427123 -> 0.00018747287701526
+256: 2.7948623970663 -> 4.6502933732206e-05
+512: 2.7948904456648 -> 1.8454335195095e-05
+1024: 2.7949073674377 -> 1.5325622837459e-06
+2048: 2.7949073674377 -> 1.5325622837459e-06
+4096: 2.7949089386041 -> 3.8604115459862e-08
+8192: 2.7949089386041 -> 3.8604115903951e-08
+
+and for 128:
+
+2: 11.600891830857 -> 8.6119827837905e-06
+4: 11.600891830857 -> 8.6119827837905e-06
+8: 11.600891830857 -> 8.6119827837905e-06
+16: 11.600891830857 -> 8.6119827837905e-06
+32: 11.600891830857 -> 8.6119827837905e-06
+64: 11.600891830857 -> 8.6119827837905e-06
+128: 11.600891830857 -> 8.6119827837905e-06
+256: 11.600891830857 -> 8.6119827837905e-06
+512: 11.600891830857 -> 8.6119827837905e-06
+1024: 11.600891830857 -> 8.6119827837905e-06
+2048: 11.600894542871 -> 5.8999694552142e-06
+4096: 11.600900716528 -> 2.7368773736214e-07
+8192: 11.600900716528 -> 2.7368773736214e-07
+
+(I think this happens because the waveform becomes very flat &mdash; there
+are lots of peaks that are all about the same size, so we don't need great
+accuracy to hit the one peak just right).
+Perhaps we could reduce the FFT size once we narrow the search down
+to a good candidate, but that seems like asking for trouble.
+
+(let ((dur 2048))
+
+ (let ((old (find-sound "test.snd")))
+ (if (sound? old)
+ (close-sound old)))
+
+(let ((ns (new-sound "test.snd" :channels 5))
+ (data (make-vct dur)))
+
+ (let ((phases (make-vector 8 0.0))
+ (correct 6.1442))
+
+ (set! (y-bounds) (list -6.2 6.2))
+
+ (do ((chan 0 (+ chan 1))
+ (n 4 (* n 4)))
+ ((> n 512))
+
+ (let* ((size (expt 2 (ceiling (/ (log (* 8 n)) (log 2)))))
+ (fft-rl (make-vct size))
+ (fft-im (make-vct size))
+ (pi2 (/ pi 2)))
+
+ (do ((m 0 (+ m 1)))
+ ((= m 8))
+ (let ((phi (+ (* pi (phases m)) pi2))
+ (bin (+ m 1)))
+ (set! (fft-rl bin) (cos phi))
+ (set! (fft-im bin) (sin phi))))
+
+ (mus-fft fft-rl fft-im size -1)
+
+ (do ((i 0 (+ i 1))
+ (k 0)
+ (step (/ dur size))
+ (step-ctr 0 (+ step-ctr 1)))
+ ((= i dur))
+ (set! (data i) (fft-rl k))
+ (if (>= step-ctr step)
+ (begin
+ (set! k (+ k 1))
+ (set! step-ctr (- step-ctr step)))))
+
+ (vct->channel data 0 dur ns chan)))
+
+ (let ((len 8)
+ (incr (/ (* 2 pi) dur)))
+ (do ((x 0.0 (+ x incr))
+ (i 0 (+ i 1)))
+ ((>= i dur))
+ (let ((val 0.0))
+ (do ((k 0 (+ k 1))
+ (j 1 (+ j 1)))
+ ((= k len))
+ (set! val (+ val (sin (+ (* j x) (* pi (phases k)))))))
+ (set! (data i) val)))
+ (vct->channel data 0 dur ns 4))
+
+ (set! (selected-graph-color) (make-color 1 1 1))
+ (set! (selected-data-color) (make-color 0 0 0))
+
+ (set! (x-axis-label ns 0) "fft size: 32")
+ (set! (x-axis-label ns 1) "fft size: 128")
+ (set! (x-axis-label ns 2) "fft size: 512")
+ (set! (x-axis-label ns 3) "fft size: 2048")
+
+ (set! (x-axis-label ns 4) "sum of sines")
+
+ )))
+-->
+
+
<br><br>
@@ -9076,10 +9285,10 @@ A more complex example is singer's attempt to say "requiem":
<br>
-<!-- ---------------------------------------- FILE: snd6|7|8|9|10|11 ---------------------------------------- -->
+<!-- ---------------------------------------- FILE: snd7|8|9|10|11 ---------------------------------------- -->
<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="sndolddoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>snd6|7|8|9|10|11</h2></td></tr></table>
+<A NAME="sndolddoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>snd7|8|9|10|11</h2></td></tr></table>
</td></tr></table>
<p>These files contain a number of the procedures
@@ -9090,14 +9299,6 @@ Some of the other procedures are:
<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-<!-- append-to-minibuffer -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>append-to-minibuffer</em> <code>msg snd</code>
-</td></tr><tr><td></td><td>
-appends 'msg' to whatever is in the sound's minibuffer. (snd6.scm)
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
<!-- backward-graph -->
<tr><td colspan=2 bgcolor="#f2f4ff">
<em class=emdef>backward-graph</em> <code>count snd chn</code>
@@ -9123,14 +9324,6 @@ move the cursor back 'count' mix tags (C-x C-j), returning the mix id. (snd7.scm
</td></tr><tr><td colspan=2 height=16></td></tr>
-<!-- clear-audio-inputs -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>clear-audio-inputs</em>
-</td></tr><tr><td></td><td>
-try to reduce soundcard noise by turning off various inputs (OSS only). (snd6.scm)
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
<!-- emacs-style-save-as -->
<tr><td colspan=2 bgcolor="#f2f4ff"><a class=def name="emacsstylesaveas">emacs-style-save-as</a>
</td></tr><tr><td></td><td colspan=2>
@@ -10250,8 +10443,8 @@ in fmv.scm, the simpler one being:
(data (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel-&gt;vct</a> beg dur)))
(do ((i 0 (+ 1 i)))
((= i dur))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data i (+ (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> data i)
- (<em class=red>v</em>))))
+ (set! (data i) (+ (data i)
+ (<em class=red>v</em>))))
(<a class=quiet href="extsnd.html#setsamples" onmouseout="UnTip()" onmouseover="Tip(extsnd_setsamples_tip)">set-samples</a> beg dur data))))
</pre></td></tr></table>
@@ -11293,7 +11486,7 @@ by calling the oscils and whatnot directly in the with-sound body:
(oscs (make-vector 12)))
(do ((i 0 (+ 1 i)))
((= i 12))
- (vector-set! oscs i (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> :frequency 0.0)))
+ (set! (oscs i) (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> :frequency 0.0)))
(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100)
(run ; use "run" to speed up computation by about a factor of 10
(do ((samp 0 (+ 1 samp)))
@@ -11305,7 +11498,7 @@ by calling the oscils and whatnot directly in the with-sound body:
(if (&gt; loc 1.0) (set! loc (- loc 1.0)))
(set! sum (+ sum (* (let ((y (- 4.0 (* 8.0 loc))))
(exp (* -0.5 y y))) ; Gaussian normal curve as amplitude envelope
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> (vector-ref oscs i)
+ (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> (oscs i)
(<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz-&gt;radians</a> (expt 2.0 (+ 2 (* loc 12.0))))))))))
;; (- 1.0 loc) to go down
(set! x (+ x incr))
@@ -11786,11 +11979,11 @@ an upward ramp and a downward ramp, then zips them together:
(let ((data (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 10000)))
(<a class=quiet href="extsnd.html#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "new-0.snd")
(do ((i 0 (+ 1 i))) ((= i 10000))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data i (* i .0001)))
+ (set! (data i) (* i .0001)))
(<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct-&gt;channel</a> data 0 10000 0)
(<a class=quiet href="extsnd.html#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "new-1.snd")
(do ((i 0 (+ 1 i))) ((= i 10000))
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> data i (- 1.0 (* i .0001))))
+ (set! (data i) (- 1.0 (* i .0001))))
(<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct-&gt;channel</a> data 0 10000 1)
(let* ((dur (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
(zp (<em class=red>make-zipper</em> (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :length dur)
diff --git a/sndwarp.scm b/sndwarp.scm
index d8a7033..e43458e 100644
--- a/sndwarp.scm
+++ b/sndwarp.scm
@@ -228,7 +228,7 @@
;; flag = #f, however, allows 1st section to start as determined by time-ptr instead.
(adj-time-val (if zero-start-time-ptr 0.0 time-val)))
(set! readstart (round (* fsr (+ inputbeg overlap-start adj-time-val))))
- (if (not (= overlap 0)) (set! winsamps (inexact->exact (* winsamps overlap-ratio)))))
+ (if (not (= overlap 0)) (set! winsamps (floor (* winsamps overlap-ratio)))))
;; remaining sections
(set! readstart (round (* fsr (+ inputbeg time-val)))))
;; STRETCH mode
@@ -244,7 +244,7 @@
0)))
(begin
(set! readstart (round (* fsr (+ inputbeg init-read-start))))
- (if (not (= overlap 0)) (set! winsamps (inexact->exact (* winsamps overlap-ratio))))))
+ (if (not (= overlap 0)) (set! winsamps (floor (* winsamps overlap-ratio))))))
;; remaining sections
(set! readstart (round (+ readstart (* fsr (/ winlen time-val)))))))
;; Set readin position and sampling rate
diff --git a/stochastic.scm b/stochastic.scm
index 4b67721..07e7c5c 100644
--- a/stochastic.scm
+++ b/stochastic.scm
@@ -36,7 +36,7 @@
(b (expt 2 (- bits 1))); because we use signed ints - see (- b) below
;;make vct to hold x,y breakpoints
(xy-array (make-vct (* (length init-array) 2)))
- (xy-array-l (inexact->exact (length xy-array)))
+ (xy-array-l (floor (length xy-array)))
)
;;fill xy-array with values from init-array
(do ((iy 0 (+ iy 2));;index for reading values from init-array (a 2-dimensional list)
@@ -51,13 +51,13 @@
))))
(ws-interrupt?) ;;does this really belong here?
(run
- (do ((i beg (1+ i)))
+ (do ((i beg (+ 1 i)))
((= i end))
(if (= dx dt);;when current sample is a breakpoint
(begin
- (set! dx (inexact->exact (vct-ref xy-array (modulo m xy-array-l))))
+ (set! dx (floor (vct-ref xy-array (modulo m xy-array-l))))
(set! y (vct-ref xy-array (+ (modulo m xy-array-l) 1)))
- (set! prev-dx (inexact->exact (vct-ref xy-array (modulo (- m 2) xy-array-l))))
+ (set! prev-dx (floor (vct-ref xy-array (modulo (- m 2) xy-array-l))))
(set! dy (- y oldy))
(set! oldy y)
;;straight uniform distribution for y
diff --git a/test.snd b/test.snd
new file mode 100644
index 0000000..4a17081
--- /dev/null
+++ b/test.snd
Binary files differ
diff --git a/toolbar.scm b/toolbar.scm
index d713004..22e465a 100644
--- a/toolbar.scm
+++ b/toolbar.scm
@@ -1172,7 +1172,7 @@
(list icon-mid-window
(lambda (w c i)
(if (not (null? (sounds)))
- (set! (cursor) (inexact->exact (round (/ (+ (left-sample) (right-sample)) 2))))))
+ (set! (cursor) (round (/ (+ (left-sample) (right-sample)) 2)))))
"Move to mid-window")
(list icon-forward-one-sample
diff --git a/tools/index.cl b/tools/index.cl
index 432e42a..1cf05da 100644
--- a/tools/index.cl
+++ b/tools/index.cl
@@ -523,10 +523,9 @@
(offset (ceiling n cols)))
(do ((i 0 (1+ i)))
((>= row offset))
- (let* ((x (+ row (* ctr offset)))
- (name (aref tnames x)))
+ (let* ((x (+ row (* ctr offset))))
(if (< x n)
- (progn
+ (let ((name (aref tnames x)))
(format ofil
"<td~A>~A~A~A</td>"
(if (not (ind-name name))
diff --git a/tools/indexer.scm b/tools/indexer.scm
index c055c3b..31aacd3 100644
--- a/tools/indexer.scm
+++ b/tools/indexer.scm
@@ -4,7 +4,7 @@
;(load "edit123.scm")
(load "snd7.scm")
(load "snd11.scm")
-(load "snd6.scm")
+;(load "snd6.scm")
(load "snd9.scm")
(load "snd8.scm")
(load "snd10.scm")
@@ -14,6 +14,7 @@
;;; (load "new-effects.scm")
(load "autosave.scm")
(load "noise.scm")
+(load "binary-io.scm")
;(load "bess1.scm")
(load "nrev.scm")
;(load "bess.scm")
@@ -117,7 +118,7 @@
(lambda (binding)
(let ((symbol (car binding))
(value (cdr binding)))
- (if (procedure? value)
+ (if (procedure? value)
(let ((file (where-is value)))
(if (and file
(not (string=? file "~/.snd_s7"))
@@ -131,13 +132,76 @@
(set! places (cons file places)))))))))
alist))
+ ;; handle the main macros by hand
+ (for-each
+ (lambda (symbol-and-file)
+ (let ((symbol (car symbol-and-file))
+ (file (cadr symbol-and-file)))
+ (set! names (cons (cons symbol file) names))
+ (if (not (member file places))
+ (set! places (cons file places)))))
+ (list
+ (list 'with-sound "ws.scm")
+ (list 'with-mixed-sound "ws.scm")
+ (list 'with-full-sound "ws.scm")
+ (list 'with-threaded-sound "ws.scm")
+ (list 'with-temp-sound "ws.scm")
+ (list 'with-marked-sound "ws.scm")
+ (list 'with-simple-sound "ws.scm")
+ (list 'sound-let "ws.scm")
+ (list 'def-clm-struct "ws.scm")
+ (list 'ws-interrupt? "ws.scm")
+ (list 'definstrument "ws.scm")
+ (list 'defgenerator "generators.scm")
+ (list 'do? "examp.scm")))
+
+ ;; and some of the main variables
+ (for-each
+ (lambda (symbol-and-file)
+ (let ((symbol (car symbol-and-file))
+ (file (cadr symbol-and-file)))
+ (set! names (cons (cons symbol file) names))
+ (if (not (member file places))
+ (set! places (cons file places)))))
+ (list
+ (list '*clm-srate* "ws.scm")
+ (list '*clm-file-name* "ws.scm")
+ (list '*clm-channels* "ws.scm")
+ (list '*clm-data-format* "ws.scm")
+ (list '*clm-header-type* "ws.scm")
+ (list '*clm-verbose* "ws.scm")
+ (list '*clm-play* "ws.scm")
+ (list '*clm-statistics* "ws.scm")
+ (list '*clm-reverb* "ws.scm")
+ (list '*clm-reverb-channels* "ws.scm")
+ (list '*clm-reverb-data* "ws.scm")
+ (list '*clm-table-size* "ws.scm")
+ (list '*clm-file-buffer-size* "ws.scm")
+ (list '*clm-locsig-type* "ws.scm")
+ (list '*clm-clipped* "ws.scm")
+ (list '*clm-array-print-length* "ws.scm")
+ (list '*clm-player* "ws.scm")
+ (list '*clm-notehook* "ws.scm")
+ (list '*clm-with-sound-depth* "ws.scm")
+ (list '*clm-default-frequency* "ws.scm")
+ (list '*clm-safety* "ws.scm")
+ (list '*clm-delete-reverb* "ws.scm")
+ (list '*clm-threads* "ws.scm")
+ (list '*clm-output-safety* "ws.scm")
+ (list '*to-snd* "ws.scm")
+ (list '*clm-search-list* "ws.scm")
+ (list '*definstrument-hook* "ws.scm")))
+
+
+
+
(for-each
(lambda (frame)
(if (vector? frame)
(let ((len (vector-length frame)))
(do ((i 0 (+ i 1)))
((= i len))
- (apropos-1 (vector-ref frame i))))
+ (apropos-1 (frame i))))
(apropos-1 frame)))
(global-environment))
@@ -202,8 +266,3 @@
(report-places))
(exit)
-
-
-
-;;; TODO: snd-motif|gtk (or neither) based on gui choice
-
diff --git a/tools/makexg.scm b/tools/makexg.scm
index 901a94d..c6738ec 100755
--- a/tools/makexg.scm
+++ b/tools/makexg.scm
@@ -157,6 +157,13 @@
(define names-2190 '())
(define types-2190 '())
+(define funcs-2901 '())
+(define casts-2901 '())
+(define checks-2901 '())
+(define names-2901 '())
+(define types-2901 '())
+(define ints-2901 '())
+
(define cairo-funcs '())
(define cairo-png-funcs '())
(define cairo-ints '())
@@ -213,11 +220,13 @@
"GdkFillRule" "GdkGCValuesMask"
"GdkPropMode" "GdkRgbDither" "GdkWMFunction" "GdkWindowEdge" "GdkWindowHints" "GtkAccelFlags" "GtkArrowType"
"GtkAttachOptions" "GtkCellRendererState" "GtkCurveType" "GtkDestDefaults" "GtkDestroyNotify" "GtkDialogFlags"
- "GtkDirectionType" "GtkExpanderStyle" "GtkIconLookupFlags" "GtkMenuPositionFunc" "GtkPathType" "GtkSpinType"
+ "GtkDirectionType" "GtkExpanderStyle" "GtkIconLookupFlags" ;"GtkMenuPositionFunc"
+ "GtkPathType" "GtkSpinType"
"GtkTextSearchFlags" "GtkTreeIterCompareFunc" "GtkTreeSelectionFunc" "GtkUIManagerItemType" "GtkWindowPosition"
"GtkWindowType" "PangoGlyph" "PangoUnderline" "gssize"
- "GtkMenuBar*" "GtkTranslateFunc" "GtkMenuPositionFunc" "GtkTreeIterCompareFunc" "GtkTreeSelectionFunc"
+ "GtkMenuBar*" "GtkTranslateFunc" ;"GtkMenuPositionFunc"
+ "GtkTreeIterCompareFunc" "GtkTreeSelectionFunc"
"GtkDestroyNotify"
"GtkAssistant*" "GtkRecentChooser*" "GtkRecentChooserMenu*"
@@ -251,7 +260,9 @@
"GdkScrollDirection" "GdkSettingAction" "GdkVisibilityState" "GdkWindowState" "GdkWindowType"
"GtkImageType" "GtkTreeModelFlags" "gint8" "gshort" "guint8" "lambda"
- "time_t" "GtkWindowGroup*" "GtkSettings*" "GdkDevice*" "GtkScaleButton*"
+ "time_t" ;"GtkWindowGroup*"
+ "GtkSettings*" ;"GdkDevice*"
+ "GtkScaleButton*"
"GtkPrintOperationResult" "GtkPrintStatus"
"cairo_font_type_t" "cairo_pattern_type_t" "cairo_surface_type_t"
))
@@ -268,7 +279,9 @@
"GdkScrollDirection" "GdkSettingAction" "GdkVisibilityState" "GdkWindowState" "GdkWindowType"
"GtkImageType" "GtkTreeModelFlags" "etc" "gshort"
- "GtkWindowGroup*" "time_t" "GtkSettings*" "GdkDevice*" "GtkScaleButton*"
+ ;"GtkWindowGroup*"
+ "time_t" "GtkSettings*" ;"GdkDevice*"
+ "GtkScaleButton*"
"GtkPrintOperationResult" "GtkPrintStatus"
"cairo_surface_type_t" "cairo_pattern_type_t" "cairo_font_type_t"
@@ -477,6 +490,7 @@
((2173 callback-2173) (set! types-2173 (cons type types-2173)))
((2177 callback-2177) (set! types-2177 (cons type types-2177)))
((2190) (set! types-2190 (cons type types-2190)))
+ ((2901) (set! types-2901 (cons type types-2901)))
((cairo) (set! cairo-types (cons type cairo-types)))
(else (if (not (member type types))
(set! types (cons type types)))))))
@@ -1352,6 +1366,22 @@
(set! funcs-2190 (cons (list name type strs args) funcs-2190)))
(set! names (cons (cons name (func-type strs)) names)))))))
+(define* (CFNC-2901 data spec)
+ (let ((name (cadr-str data))
+ (args (caddr-str data)))
+ (if (assoc name names)
+ (no-way "CFNC-2901: ~A~%" (list name data))
+ (let ((type (car-str data)))
+ (if (not (member type all-types))
+ (begin
+ (set! all-types (cons type all-types))
+ (set! types-2901 (cons type types-2901))))
+ (let ((strs (parse-args args '2901)))
+ (if spec
+ (set! funcs-2901 (cons (list name type strs args spec) funcs-2901))
+ (set! funcs-2901 (cons (list name type strs args) funcs-2901)))
+ (set! names (cons (cons name (func-type strs)) names)))))))
+
(define* (CAIRO-FUNC data spec)
(let ((name (cadr-str data))
(args (caddr-str data)))
@@ -1733,6 +1763,14 @@
(set! ints-2177 (cons name ints-2177))
(set! names (cons (cons name 'int) names)))))
+(define* (CINT-2901 name type)
+ (save-declared-type type)
+ (if (assoc name names)
+ (no-way "~A CINT-2901~%" name)
+ (begin
+ (set! ints-2901 (cons name ints-2901))
+ (set! names (cons (cons name 'int) names)))))
+
(define* (CAIRO-INT name type)
(save-declared-type type)
(if (assoc name names)
@@ -1844,6 +1882,13 @@
(set! casts-2190 (cons (list name type) casts-2190))
(set! names (cons (cons name 'def) names)))))
+(define (CCAST-2901 name type)
+ (if (assoc name names)
+ (no-way "~A CCAST-2901~%" name)
+ (begin
+ (set! casts-2901 (cons (list name type) casts-2901))
+ (set! names (cons (cons name 'def) names)))))
+
(define (CCHK name type)
(if (assoc name names)
(no-way "~A CCHK~%" name)
@@ -1928,6 +1973,13 @@
(set! checks-2190 (cons (list name type) checks-2190))
(set! names (cons (cons name 'def) names)))))
+(define (CCHK-2901 name type)
+ (if (assoc name names)
+ (no-way "~A CCHK-2901~%" name)
+ (begin
+ (set! checks-2901 (cons (list name type) checks-2901))
+ (set! names (cons (cons name 'def) names)))))
+
(define (STRUCT data)
(let ((name (car-str data)) ; struct name (type)
@@ -2092,6 +2144,11 @@
(thunk)
(dpy "#endif~%~%"))
+(define (with-2901 dpy thunk)
+ (dpy "#if HAVE_GTK_SCALE_NEW~%")
+ (thunk)
+ (dpy "#endif~%~%"))
+
(define (with-cairo dpy thunk)
(dpy "#if HAVE_CAIRO_CREATE~%")
@@ -2427,7 +2484,7 @@
(hey "#define C_TO_XEN_GtkLinkButtonUriFunc(Arg) WRAP_FOR_XEN(\"GtkLinkButtonUriFunc\", Arg)~%")
;(hey "#define C_TO_XEN_GtkTreeIterCompareFunc(Arg) WRAP_FOR_XEN(\"GtkTreeViewSearchEqualFunc\", Arg)~%")
;(hey "#define C_TO_XEN_GtkTreeSelectionFunc(Arg) WRAP_FOR_XEN(\"GtkTreeSelectionFunc\", Arg)~%")
-;(hey "#define C_TO_XEN_GtkMenuPositionFunc(Arg) WRAP_FOR_XEN(\"GtkMenuPositionFunc\", Arg)~%")
+(hey "#define C_TO_XEN_GtkMenuPositionFunc(Arg) WRAP_FOR_XEN(\"GtkMenuPositionFunc\", Arg)~%")
;(hey "#define C_TO_XEN_GtkDestroyNotify(Arg) WRAP_FOR_XEN(\"GtkDestroyNotify\", Arg)~%")
(hey "#define XEN_TO_C_GdkFilterReturn(Arg) (GdkFilterReturn)XEN_TO_C_INT(Arg)~%")
@@ -2457,10 +2514,10 @@
(with-func hey (lambda ()
(for-each type-it (reverse type-list))))))
(list types-21 types-22 types-23 types-236 types-250 types-256 types-260 types-270 types-290
- types-210 types-211 types-213 types-2134 types-2150 types-2172 types-2173 types-2177 types-2190
+ types-210 types-211 types-213 types-2134 types-2150 types-2172 types-2173 types-2177 types-2190 types-2901
cairo-types cairo-types-140 cairo-types-164)
(list with-21 with-22 with-23 with-236 with-250 with-256 with-260 with-270 with-290
- with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190
+ with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190 with-2901
with-cairo with-cairo-140 with-cairo-164))
@@ -3081,10 +3138,10 @@
(with-func hey (lambda ()
(for-each handle-func (reverse func-list))))))
(list funcs-21 funcs-22 funcs-23 funcs-236 funcs-250 funcs-256 funcs-260 funcs-270 funcs-273 funcs-290
- funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190
+ funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190 funcs-2901
cairo-funcs cairo-png-funcs cairo-funcs-140 cairo-funcs-164)
(list with-21 with-22 with-23 with-236 with-250 with-256 with-260 with-270 with-273 with-290
- with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190
+ with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190 with-2901
with-cairo with-cairo-png with-cairo-140 with-cairo-164))
@@ -3106,8 +3163,8 @@
(if (not (null? cast-list))
(cast-func hey (lambda ()
(for-each cast-it (reverse cast-list))))))
- (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190 casts-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
;;; checks have to use the built-in macros, not local symbol-based type checks
@@ -3121,8 +3178,8 @@
(if (not (null? check-list))
(check-func hey (lambda ()
(for-each make-check (reverse check-list))))))
- (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190 checks-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
(hey "~%~%/* ---------------------------------------- special functions ---------------------------------------- */~%~%")
@@ -3437,10 +3494,10 @@
(with-func hey (lambda ()
(for-each argify-func (reverse func-list))))))
(list funcs-21 funcs-22 funcs-23 funcs-236 funcs-250 funcs-256 funcs-260 funcs-270 funcs-273 funcs-290
- funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190
+ funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190 funcs-2901
cairo-funcs cairo-png-funcs cairo-funcs-140 cairo-funcs-164)
(list with-21 with-22 with-23 with-236 with-250 with-256 with-260 with-270 with-273 with-290
- with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190
+ with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190 with-2901
with-cairo with-cairo-png with-cairo-140 with-cairo-164))
@@ -3462,8 +3519,8 @@
(if (not (null? cast-list))
(cast-func hey (lambda ()
(for-each ruby-cast (reverse cast-list))))))
- (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190 casts-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
(define (ruby-check func) (hey "XEN_NARGIFY_1(gxg_~A_w, gxg_~A)~%" (no-arg (car func)) (no-arg (car func))))
(for-each ruby-check (reverse checks))
@@ -3472,8 +3529,8 @@
(if (not (null? check-list))
(check-func hey (lambda ()
(for-each ruby-check (reverse check-list))))))
- (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190 checks-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
(for-each (lambda (field) (hey "XEN_NARGIFY_1(gxg_~A_w, gxg_~A)~%" field field)) struct-fields)
@@ -3510,10 +3567,10 @@
(with-func hey (lambda ()
(for-each unargify-func (reverse func-list))))))
(list funcs-21 funcs-22 funcs-23 funcs-236 funcs-250 funcs-256 funcs-260 funcs-270 funcs-273 funcs-290
- funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190
+ funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190 funcs-2901
cairo-funcs cairo-png-funcs cairo-funcs-140 cairo-funcs-164)
(list with-21 with-22 with-23 with-236 with-250 with-256 with-260 with-270 with-273 with-290
- with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190
+ with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190 with-2901
with-cairo with-cairo-png with-cairo-140 with-cairo-164))
@@ -3533,8 +3590,8 @@
(if (not (null? cast-list))
(cast-func hey (lambda ()
(for-each ruby-uncast (reverse cast-list))))))
- (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190 casts-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
(define (ruby-uncheck func) (hey "#define gxg_~A_w gxg_~A~%" (no-arg (car func)) (no-arg (car func))))
@@ -3544,8 +3601,8 @@
(if (not (null? check-list))
(check-func hey (lambda ()
(for-each ruby-uncheck (reverse check-list))))))
- (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190 checks-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
(for-each (lambda (field) (hey "#define gxg_~A_w gxg_~A~%" field field)) struct-fields)
(for-each (lambda (field) (hey "#define gxg_~A_w gxg_~A~%" field field)) settable-struct-fields)
@@ -3605,10 +3662,10 @@
(with-func hey (lambda ()
(for-each defun (reverse func-list))))))
(list funcs-21 funcs-22 funcs-23 funcs-236 funcs-250 funcs-256 funcs-260 funcs-270 funcs-273 funcs-290
- funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190
+ funcs-210 funcs-211 funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190 funcs-2901
cairo-funcs cairo-png-funcs cairo-funcs-140 cairo-funcs-164)
(list with-21 with-22 with-23 with-236 with-250 with-256 with-260 with-270 with-273 with-290
- with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190
+ with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190 with-2901
with-cairo with-cairo-png with-cairo-140 with-cairo-164))
(define (cast-out func)
@@ -3626,8 +3683,8 @@
(if (not (null? cast-list))
(cast-func hey (lambda ()
(for-each cast-out (reverse cast-list))))))
- (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list casts-21 casts-23 casts-236 casts-250 casts-256 casts-290 casts-210 casts-211 casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190 casts-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
(hey " XG_DEFINE_PROCEDURE(c-array->list, c_array_to_xen_list_w, 2, 0, 0, NULL);~%")
@@ -3651,8 +3708,8 @@
(if (not (null? check-list))
(check-func hey (lambda ()
(for-each check-out (reverse check-list))))))
- (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190)
- (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190))
+ (list checks-21 checks-23 checks-236 checks-250 checks-256 checks-290 checks-210 checks-211 checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190 checks-2901)
+ (list with-21 with-23 with-236 with-250 with-256 with-290 with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-2901))
(hey "}~%~%")
@@ -3719,10 +3776,10 @@
(hey " DEFINE_INTEGER(~A);~%" val))
(reverse ints-list))))))
(list ints-22 ints-23 ints-236 ints-250 ints-256 ints-260 ints-270 ints-273 ints-290
- ints-210 ints-211 ints-213 ints-2134 ints-2150 ints-2172 ints-2173 ints-2177
+ ints-210 ints-211 ints-213 ints-2134 ints-2150 ints-2172 ints-2173 ints-2177 ints-2901
cairo-ints cairo-ints-140 cairo-ints-164)
(list with-22 with-23 with-236 with-250 with-256 with-260 with-270 with-273 with-290
- with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177
+ with-210 with-211 with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2901
with-cairo with-cairo-140 with-cairo-164))
diff --git a/tools/xgdata.scm b/tools/xgdata.scm
index 123eab4..dae6ec9 100644
--- a/tools/xgdata.scm
+++ b/tools/xgdata.scm
@@ -313,6 +313,8 @@
(CINT "GDK_SETTING" "GdkEventType")
(CINT-250 "GDK_OWNER_CHANGE" "GdkEventType")
(CINT-273 "GDK_GRAB_BROKEN" "GdkEventType")
+
+;;; these may be out 2.90.1
(CINT "GDK_EXPOSURE_MASK" "GdkEventMask")
(CINT "GDK_POINTER_MOTION_MASK" "GdkEventMask")
(CINT "GDK_POINTER_MOTION_HINT_MASK" "GdkEventMask")
@@ -335,6 +337,8 @@
(CINT "GDK_SUBSTRUCTURE_MASK" "GdkEventMask")
(CINT "GDK_SCROLL_MASK" "GdkEventMask")
(CINT "GDK_ALL_EVENTS_MASK" "GdkEventMask")
+
+
(CINT "GDK_VISIBILITY_UNOBSCURED " "GdkVisibilityState")
(CINT "GDK_VISIBILITY_PARTIAL " "GdkVisibilityState")
(CINT "GDK_VISIBILITY_FULLY_OBSCURED" "GdkVisibilityState")
@@ -4263,7 +4267,7 @@
(CFNC-21 "void gdk_display_beep GdkDisplay* display")
(CFNC-21 "void gdk_display_sync GdkDisplay* display")
(CFNC-21 "void gdk_display_close GdkDisplay* display")
-(CFNC-21 "GList* gdk_display_list_devices GdkDisplay* display")
+;;;; 2-90.1 (CFNC-21 "GList* gdk_display_list_devices GdkDisplay* display")
(CFNC-21 "GdkEvent* gdk_display_get_event GdkDisplay* display")
(CFNC-21 "GdkEvent* gdk_display_peek_event GdkDisplay* display")
(CFNC-21 "void gdk_display_put_event GdkDisplay* display GdkEvent* event")
@@ -4832,7 +4836,7 @@
(CFNC-236 "void gdk_display_set_double_click_distance GdkDisplay* display guint distance")
(CFNC-236 "GdkWindow* gdk_display_get_default_group GdkDisplay* display")
-(CFNC-236 "void gdk_window_set_accept_focus GdkWindow* window gboolean accept_focus")
+;;; changed return type 2.90.1 (CFNC-236 "void gdk_window_set_accept_focus GdkWindow* window gboolean accept_focus")
(CFNC-236 "GdkWindow* gdk_window_get_group GdkWindow* window")
(CFNC-236 "gboolean gtk_action_group_get_sensitive GtkActionGroup* action_group")
(CFNC-236 "void gtk_action_group_set_sensitive GtkActionGroup* action_group gboolean sensitive")
@@ -4936,7 +4940,7 @@
;;; out 2.5.6 (CFNC-250 "void gtk_cell_view_set_cell_data GtkCellView* cellview")
;;; out 2.17.2 (CFNC-250 "GList* gtk_cell_view_get_cell_renderers GtkCellView* cellview") ; FREE (g_list_free)
-(CFNC-250 "void gdk_window_set_focus_on_map GdkWindow* window gboolean focus_on_map")
+;;; changed return type 2.90.1 (CFNC-250 "void gdk_window_set_focus_on_map GdkWindow* window gboolean focus_on_map")
(CFNC-250 "void gdk_window_enable_synchronized_configure GdkWindow* window")
(CFNC-250 "void gdk_window_configure_finished GdkWindow* window")
;;;(CFNC-250 "gchar* gtk_action_group_translate_string GtkActionGroup* action_group gchar* string") -- out 2.5.2
@@ -7077,8 +7081,81 @@
(CFNC-2190 "void gtk_widget_set_mapped GtkWidget* widget gboolean mapped")
(CFNC-2190 "gboolean gtk_widget_get_mapped GtkWidget* widget")
+
;;; 2.19.6
+(CFNC-2901 "void gdk_keymap_add_virtual_modifiers GdkKeymap* keymap GdkModifierType* state")
+(CFNC-2901 "void gtk_widget_get_requisition GtkWidget* widget GtkRequisition* requisition")
+
+;;; 2.21.0
+(CFNC-2901 "void gdk_window_coords_to_parent GdkWindow* window gdouble x gdouble y gdouble* [parent_x] gdouble* [parent_y]")
+(CFNC-2901 "void gdk_window_coords_from_parent GdkWindow* window gdouble parent_x gdouble parent_y gdouble* [x] gdouble* [y]")
+(CFNC-2901 "GdkWindow* gdk_window_get_effective_parent GdkWindow* window")
+(CFNC-2901 "GdkWindow* gdk_window_get_effective_toplevel GdkWindow* window")
+(CFNC-2901 "GtkWidget* gtk_accessible_get_widget GtkAccessible* accessible")
+(CFNC-2901 "GtkAdjustment* gtk_text_view_get_hadjustment GtkTextView* text_view")
+(CFNC-2901 "GtkAdjustment* gtk_text_view_get_vadjustment GtkTextView* text_view")
+(CFNC-2901 "gboolean gtk_widget_send_focus_change GtkWidget* widget GdkEvent* event")
+
+;;; 2.90.1
+(CFNC-2901 "void gdk_display_get_device_state GdkDisplay* display GdkDevice* device GdkScreen** [screen] gint* [x] gint* [y] GdkModifierType* [mask]")
+(CFNC-2901 "GdkWindow* gdk_display_get_window_at_device_position GdkDisplay* display GdkDevice* device gint* [win_x] gint* [win_y]")
+(CFNC-2901 "void gdk_display_warp_device GdkDisplay* display GdkDevice* device GdkScreen* screen gint x gint y")
+(CFNC-2901 "GdkDeviceManager* gdk_display_get_device_manager GdkDisplay* display")
+(CFNC-2901 "void gdk_drag_context_set_device GdkDragContext* context GdkDevice* device")
+(CFNC-2901 "GdkDevice* gdk_drag_context_get_device GdkDragContext* context")
+(CFNC-2901 "GList* gdk_drag_context_list_targets GdkDragContext* context")
#|
-(CFUNC-2190 "void gdk_keymap_add_virtual_modifiers GdkKeymap* keymap GdkModifierType* state")
-(CFUNC-2190 "void gtk_widget_get_requisition GtkWidget* widget GtkRequisition* requisition")
+;;; aren't these public?
+(CFNC-2901 "GdkDragAction gdk_drag_context_get_actions GdkDragContext* context")
+(CFNC-2901 "GdkDragAction gdk_drag_context_get_suggested_action GdkDragContext* context")
+(CFNC-2901 "GdkDragAction gdk_drag_context_get_action GdkDragContext* context")
+(CFNC-2901 "GdkImageType gdk_image_get_image_type GdkImage* image")
|#
+(CFNC-2901 "void gdk_event_set_device GdkEvent* event GdkDevice* device")
+(CFNC-2901 "GdkDevice* gdk_event_get_device GdkEvent* event")
+(CFNC-2901 "gboolean gdk_events_get_distance GdkEvent* event1 GdkEvent* event2 gdouble* [distance]")
+(CFNC-2901 "gboolean gdk_events_get_angle GdkEvent* event1 GdkEvent* event2 gdouble* [angle]")
+(CFNC-2901 "gboolean gdk_events_get_center GdkEvent* event1 GdkEvent* event2 gdouble* [x] gdouble* [y]")
+(CFNC-2901 "GdkVisual* gdk_image_get_visual GdkImage* image")
+(CFNC-2901 "GdkByteOrder gdk_image_get_byte_order GdkImage* image")
+(CFNC-2901 "gint gdk_image_get_width GdkImage* image")
+(CFNC-2901 "gint gdk_image_get_height GdkImage* image")
+(CFNC-2901 "guint16 gdk_image_get_depth GdkImage* image")
+(CFNC-2901 "guint16 gdk_image_get_bytes_per_pixel GdkImage* image")
+(CFNC-2901 "guint16 gdk_image_get_bytes_per_line GdkImage* image")
+(CFNC-2901 "guint16 gdk_image_get_bits_per_pixel GdkImage* image")
+(CFNC-2901 "gboolean gdk_window_get_accept_focus GdkWindow* window")
+(CFNC-2901 "gboolean gdk_window_get_focus_on_map GdkWindow* window")
+(CFNC-2901 "gboolean gdk_window_get_composited GdkWindow* window")
+(CFNC-2901 "gboolean gdk_window_is_input_only GdkWindow* window")
+(CFNC-2901 "gboolean gdk_window_is_shaped GdkWindow* window")
+(CFNC-2901 "gboolean gdk_window_get_modal_hint GdkWindow* window")
+(CFNC-2901 "void gdk_window_get_background GdkWindow* window GdkColor* color")
+(CFNC-2901 "void gdk_window_get_back_pixmap GdkWindow* window GdkPixmap** [pixmap] gboolean* [parent_relative]")
+(CFNC-2901 "void gdk_window_set_device_cursor GdkWindow* window GdkDevice* device GdkCursor* cursor")
+(CFNC-2901 "GdkCursor* gdk_window_get_device_cursor GdkWindow* window GdkDevice* device")
+(CFNC-2901 "GdkWindow* gdk_window_get_device_position GdkWindow* window GdkDevice* device gint* [x] gint* [y] GdkModifierType* [mask]")
+(CFNC-2901 "void gdk_window_set_device_events GdkWindow* window GdkDevice* device GdkEventMask event_mask")
+(CFNC-2901 "GdkEventMask gdk_window_get_device_events GdkWindow* window GdkDevice* device")
+(CFNC-2901 "void gtk_combo_box_popup_for_device GtkComboBox* combo_box GdkDevice* device")
+(CFNC-2901 "void gtk_device_grab_add GtkWidget* widget GdkDevice* device gboolean block_others")
+(CFNC-2901 "void gtk_device_grab_remove GtkWidget* widget GdkDevice* device")
+(CFNC-2901 "GdkDevice* gtk_get_current_event_device void")
+(CFNC-2901 "void gtk_menu_popup_for_device GtkMenu* menu GdkDevice* device GtkWidget* parent_menu_shell GtkWidget* parent_menu_item GtkMenuPositionFunc func lambda_data #func_info guint button guint32 activate_time")
+(CFNC-2901 "GtkWidget* gtk_paned_new GtkOrientation orientation")
+(CFNC-2901 "void gtk_radio_action_join_group GtkRadioAction* action GtkRadioAction* group_source")
+(CFNC-2901 "GtkWidget* gtk_ruler_new GtkOrientation orientation")
+(CFNC-2901 "GtkWidget* gtk_scale_new GtkOrientation orientation GtkAdjustment* adjustment")
+(CFNC-2901 "GtkWidget* gtk_scale_new_with_range GtkOrientation orientation gdouble min gdouble max gdouble step")
+(CFNC-2901 "GtkWidget* gtk_scrollbar_new GtkOrientation orientation GtkAdjustment* adjustment")
+(CFNC-2901 "GtkWidget* gtk_separator_new GtkOrientation orientation")
+(CFNC-2901 "gboolean gtk_widget_device_is_shadowed GtkWidget* widget GdkDevice* device")
+(CFNC-2901 "void gtk_widget_set_device_events GtkWidget* widget GdkDevice* device GdkEventMask events")
+(CFNC-2901 "void gtk_widget_add_device_events GtkWidget* widget GdkDevice* device GdkEventMask events")
+(CFNC-2901 "gboolean gtk_widget_get_support_multidevice GtkWidget* widget")
+(CFNC-2901 "void gtk_widget_set_support_multidevice GtkWidget* widget gboolean support_multidevice")
+(CFNC-2901 "GdkEventMask gtk_widget_get_device_events GtkWidget* widget GdkDevice* device")
+(CFNC-2901 "GtkWidget* gtk_window_group_get_current_device_grab GtkWindowGroup* window_group GdkDevice* device")
+
+(CINT-2901 "GTK_MULTIDEVICE" "GtkWidgetFlags")
+
diff --git a/v.scm b/v.scm
index 0574096..b5f12c6 100644
--- a/v.scm
+++ b/v.scm
@@ -33,8 +33,7 @@
(degree #f)
(distance 1.0)
(reverb-amount 0.01)
- (base 1.0)
- :allow-other-keys)
+ (base 1.0))
"(fm-violin startime dur frequency amplitude
(fm-index 1.0) (amp-env '(0 0 25 1 75 1 100 0))
@@ -69,14 +68,14 @@ This version of the fm-violin assumes it is running within with-sound (where *ou
(= fm1-rat (floor fm1-rat))
(= fm2-rat (floor fm2-rat))
(= fm3-rat (floor fm3-rat))
- (integer? (inexact->exact (/ fm2-rat fm1-rat))) ; might be 2=2 but 1=3 or whatever
- (integer? (inexact->exact (/ fm3-rat fm1-rat)))))
+ (integer? (rationalize (/ fm2-rat fm1-rat))) ; might be 2=2 but 1=3 or whatever
+ (integer? (rationalize (/ fm3-rat fm1-rat)))))
(norm (or (and easy-case modulate 1.0) index1))
(carrier (make-oscil frequency))
(fmosc1 (if modulate
(if easy-case
(make-polywave (* fm1-rat frequency)
- (list (inexact->exact fm1-rat) index1
+ (list (floor fm1-rat) index1
(floor (/ fm2-rat fm1-rat)) index2
(floor (/ fm3-rat fm1-rat)) index3)
mus-chebyshev-second-kind)
diff --git a/ws.scm b/ws.scm
index 1f102a2..7b81ba8 100644
--- a/ws.scm
+++ b/ws.scm
@@ -26,7 +26,7 @@
(define *clm-locsig-type* mus-interp-linear)
(define *clm-clipped* #t)
(define *clm-array-print-length* (print-length))
-(define *clm-player* #f) ; default is play-and-wait (takes index of newly created sound, not the sound's file name)
+(define *clm-player* #f)
(define *clm-notehook* #f)
(define *clm-with-sound-depth* 0) ; for CM, not otherwise used
(define *clm-default-frequency* 0.0)
@@ -36,6 +36,7 @@
(define *clm-output-safety* 0) ; if 1, assume output buffers will not need to be flushed except at the very end
(define *to-snd* #t)
+(define *default-player* (lambda (s) (play s :wait #t))) ; we need to perserve "play" because it is used as a keyword argument in with-sound
(define (times->samples beg dur)
@@ -257,7 +258,7 @@
(let ((snd-output #f)
(cur-sync #f))
(if statistics
- (set! cycles (exact->inexact (/ (- (get-internal-real-time) start) internal-time-units-per-second))))
+ (set! cycles (/ (* 1.0 (- (get-internal-real-time) start)) internal-time-units-per-second)))
(if (and to-snd output-to-file)
(let* ((cur (find-sound output-1)))
@@ -335,18 +336,18 @@
(if (> pk 0.0)
(let ((scl (/ scaled-to pk)))
(do ((i 0 (+ i 1)))
- ((= i (vector-length output-1)))
- (vector-set! output-1 i (* scl (vector-ref output-1 i)))))))
+ ((= i (length output-1)))
+ (set! (output-1 i) (* scl (output-1 i)))))))
(do ((i 0 (+ i 1)))
- ((= i (vector-length output-1)))
- (vector-set! output-1 i (* scaled-by (vector-ref output-1 i))))))))))
+ ((= i (length output-1)))
+ (set! (output-1 i) (* scaled-by (output-1 i))))))))))
(if (and play output-to-file)
(if to-snd
(if *clm-player*
(*clm-player* snd-output)
- (play-and-wait 0 snd-output))
- (play output-1)))
+ (*default-player* snd-output))
+ (*default-player* output-1))) ; this was (play output-1) which could not have worked?!
(if (and to-snd output-to-file)
(begin
@@ -561,7 +562,7 @@
(report-in-minibuffer (format #f "mix ~A: ~A"
id (or (and info
(cadddr info))
- (exact->inexact (/ (mix-position id) (srate outsnd))))))
+ (/ (mix-position id) (* 1.0 (srate outsnd))))))
#t))) ; #t -> don't print the mix id in the minibuffer
(dynamic-wind
@@ -627,8 +628,8 @@
(if (not (= (cadr info) (mix-position id)))
(display (format #f " (~A ~,3F~{ ~A~})~%"
(car call)
- (exact->inexact (/ (mix-position id) (srate snd)))
- (cddr call))
+ (/ (mix-position id) (* 1.0 (srate snd)))
+ (cddr call))
oput)
(display (format #f " ~A~%" call) oput)))
(report-in-minibuffer "can't find note associated with mix ~A" id))))
@@ -825,7 +826,7 @@ finish-with-sound to complete the process."
(if scaled-by
(scale-by scaled-by snd-output)))
(save-sound snd-output)))
- (if play (play-and-wait 0 snd-output))
+ (if play (*default-player* snd-output))
(update-time-graph snd-output)))
(set! (mus-srate) old-srate)
output)
@@ -899,7 +900,7 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
(et-pitch (+ base-pitch (* 12 octave))))
(set! last-octave octave)
(if pythagorean
- (* main-pitch (expt 2 octave) (vector-ref ratios base-pitch))
+ (* main-pitch (expt 2 octave) (ratios base-pitch))
(* main-pitch (expt 2.0 (/ et-pitch 12)))))
pitch))))
@@ -958,7 +959,7 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
(if (and (list? n)
(= (length n) 2))
(if (number? (cadr n))
- (if (exact? (cadr n))
+ (if (rational? (cadr n))
'int
'float)
(if (string? (cadr n))
@@ -1077,7 +1078,7 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
;;; -------- *clm-search-list*
-;;; PERHAPS: doc/test *clm-search-list*, and use to choose output loc?
+;;; PERHAPS: doc/test *clm-search-list*, and use to choose input/output loc?
(define *clm-search-list* (list "."))
diff --git a/wz_data.js b/wz_data.js
index 384d2c1..a123c09 100644
--- a/wz_data.js
+++ b/wz_data.js
@@ -1363,6 +1363,8 @@ var autosave_doc_tip = "periodically save current sound edits in a backup file,
var bess_doc_tip = "This sets up a dialog to experiment with simple FM, <br>" +
"the fm-violin, or with a compositional algorithm";
+var binary_io_doc_tip = "This file has functions to read and write binary files";
+
var bird_doc_tip = "simple synthesis of about 50 birds using additive synthesis.<br>" +
"see animals.scm for much more elaborate versions of these birds";
@@ -1480,7 +1482,7 @@ var selection_doc_tip = "includes swap-selection-channels, replace-with-selectio
var singer_doc_tip = "This is based on Perry's singer.c and CLM's singer.ins";
-var sndold_doc_tip = "These files (snd6.scm to snd9.scm) provide backwards compatibility<br>" +
+var sndold_doc_tip = "These files (snd7.scm to snd11.scm) provide backwards compatibility<br>" +
" with earlier versions of Snd.";
var snddiff_doc_tip = "a diff or grep-like function for sounds. It can currently find<br>" +
diff --git a/xg.c b/xg.c
index 574977d..c1bedc6 100644
--- a/xg.c
+++ b/xg.c
@@ -355,6 +355,7 @@ static void define_xm_obj(void)
#define C_TO_XEN_GtkTreeViewSearchPositionFunc(Arg) WRAP_FOR_XEN("GtkTreeViewSearchPositionFunc", Arg)
#define C_TO_XEN_GtkTreeViewSearchEqualFunc(Arg) WRAP_FOR_XEN("GtkTreeViewSearchEqualFunc", Arg)
#define C_TO_XEN_GtkLinkButtonUriFunc(Arg) WRAP_FOR_XEN("GtkLinkButtonUriFunc", Arg)
+#define C_TO_XEN_GtkMenuPositionFunc(Arg) WRAP_FOR_XEN("GtkMenuPositionFunc", Arg)
#define XEN_TO_C_GdkFilterReturn(Arg) (GdkFilterReturn)XEN_TO_C_INT(Arg)
#define XEN_TO_C_String(Arg) ((XEN_STRING_P(Arg)) ? XEN_TO_C_STRING(Arg) : NULL)
#define C_TO_XEN_String(Arg) ((Arg != NULL) ? C_TO_XEN_STRING((char *)Arg) : XEN_FALSE)
@@ -930,7 +931,7 @@ XM_TYPE_PTR(GtkRecentInfo_, GtkRecentInfo*)
#define XEN_TO_C_GtkSensitivityType(Arg) (GtkSensitivityType)(XEN_TO_C_INT(Arg))
#define XEN_GtkSensitivityType_P(Arg) XEN_INTEGER_P(Arg)
XM_TYPE_1(GDestroyNotify, GDestroyNotify)
-XM_TYPE_PTR_2(GtkWindowGroup_, GtkWindowGroup*)
+XM_TYPE_PTR(GtkWindowGroup_, GtkWindowGroup*)
XM_TYPE_PTR_1(GtkAssistant_, GtkAssistant*)
#define C_TO_XEN_GtkAssistantPageType(Arg) C_TO_XEN_INT(Arg)
#define XEN_TO_C_GtkAssistantPageType(Arg) (GtkAssistantPageType)(XEN_TO_C_INT(Arg))
@@ -1017,6 +1018,13 @@ XM_TYPE_PTR(GtkToolItemGroup_, GtkToolItemGroup*)
XM_TYPE_1(GtkToolPaletteDragTargets, GtkToolPaletteDragTargets)
#endif
+#if HAVE_GTK_SCALE_NEW
+XM_TYPE_PTR_1(GdkModifierType_, GdkModifierType*)
+XM_TYPE_PTR(GdkDevice_, GdkDevice*)
+XM_TYPE_PTR(GdkDeviceManager_, GdkDeviceManager*)
+#define C_TO_XEN_GdkByteOrder(Arg) C_TO_XEN_INT(Arg)
+#endif
+
#if HAVE_CAIRO_CREATE
XM_TYPE_PTR(cairo_t_, cairo_t*)
XM_TYPE_PTR(cairo_surface_t_, cairo_surface_t*)
@@ -19753,13 +19761,6 @@ static XEN gxg_gdk_display_close(XEN display)
return(XEN_FALSE);
}
-static XEN gxg_gdk_display_list_devices(XEN display)
-{
- #define H_gdk_display_list_devices "GList* gdk_display_list_devices(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_list_devices", "GdkDisplay*");
- return(C_TO_XEN_GList_(gdk_display_list_devices(XEN_TO_C_GdkDisplay_(display))));
-}
-
static XEN gxg_gdk_display_get_event(XEN display)
{
#define H_gdk_display_get_event "GdkEvent* gdk_display_get_event(GdkDisplay* display)"
@@ -23162,15 +23163,6 @@ static XEN gxg_gdk_display_get_default_group(XEN display)
return(C_TO_XEN_GdkWindow_(gdk_display_get_default_group(XEN_TO_C_GdkDisplay_(display))));
}
-static XEN gxg_gdk_window_set_accept_focus(XEN window, XEN accept_focus)
-{
- #define H_gdk_window_set_accept_focus "void gdk_window_set_accept_focus(GdkWindow* window, gboolean accept_focus)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_accept_focus", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(accept_focus), accept_focus, 2, "gdk_window_set_accept_focus", "gboolean");
- gdk_window_set_accept_focus(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(accept_focus));
- return(XEN_FALSE);
-}
-
static XEN gxg_gdk_window_get_group(XEN window)
{
#define H_gdk_window_get_group "GdkWindow* gdk_window_get_group(GdkWindow* window)"
@@ -23630,15 +23622,6 @@ GdkColor* color)"
return(XEN_FALSE);
}
-static XEN gxg_gdk_window_set_focus_on_map(XEN window, XEN focus_on_map)
-{
- #define H_gdk_window_set_focus_on_map "void gdk_window_set_focus_on_map(GdkWindow* window, gboolean focus_on_map)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_focus_on_map", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(focus_on_map), focus_on_map, 2, "gdk_window_set_focus_on_map", "gboolean");
- gdk_window_set_focus_on_map(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(focus_on_map));
- return(XEN_FALSE);
-}
-
static XEN gxg_gdk_window_enable_synchronized_configure(XEN window)
{
#define H_gdk_window_enable_synchronized_configure "void gdk_window_enable_synchronized_configure(GdkWindow* window)"
@@ -32298,6 +32281,587 @@ static XEN gxg_gtk_widget_get_mapped(XEN widget)
#endif
+#if HAVE_GTK_SCALE_NEW
+static XEN gxg_gdk_keymap_add_virtual_modifiers(XEN keymap, XEN state)
+{
+ #define H_gdk_keymap_add_virtual_modifiers "void gdk_keymap_add_virtual_modifiers(GdkKeymap* keymap, \
+GdkModifierType* state)"
+ XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_add_virtual_modifiers", "GdkKeymap*");
+ XEN_ASSERT_TYPE(XEN_GdkModifierType__P(state), state, 2, "gdk_keymap_add_virtual_modifiers", "GdkModifierType*");
+ gdk_keymap_add_virtual_modifiers(XEN_TO_C_GdkKeymap_(keymap), XEN_TO_C_GdkModifierType_(state));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_widget_get_requisition(XEN widget, XEN requisition)
+{
+ #define H_gtk_widget_get_requisition "void gtk_widget_get_requisition(GtkWidget* widget, GtkRequisition* requisition)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_requisition", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GtkRequisition__P(requisition), requisition, 2, "gtk_widget_get_requisition", "GtkRequisition*");
+ gtk_widget_get_requisition(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkRequisition_(requisition));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gdk_window_coords_to_parent(XEN window, XEN x, XEN y, XEN ignore_parent_x, XEN ignore_parent_y)
+{
+ #define H_gdk_window_coords_to_parent "void gdk_window_coords_to_parent(GdkWindow* window, gdouble x, \
+gdouble y, gdouble* [parent_x], gdouble* [parent_y])"
+ gdouble ref_parent_x;
+ gdouble ref_parent_y;
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_coords_to_parent", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_gdouble_P(x), x, 2, "gdk_window_coords_to_parent", "gdouble");
+ XEN_ASSERT_TYPE(XEN_gdouble_P(y), y, 3, "gdk_window_coords_to_parent", "gdouble");
+ gdk_window_coords_to_parent(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gdouble(x), XEN_TO_C_gdouble(y), &ref_parent_x, &ref_parent_y);
+ return(XEN_LIST_2(C_TO_XEN_gdouble(ref_parent_x), C_TO_XEN_gdouble(ref_parent_y)));
+}
+
+static XEN gxg_gdk_window_coords_from_parent(XEN window, XEN parent_x, XEN parent_y, XEN ignore_x, XEN ignore_y)
+{
+ #define H_gdk_window_coords_from_parent "void gdk_window_coords_from_parent(GdkWindow* window, gdouble parent_x, \
+gdouble parent_y, gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_coords_from_parent", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_gdouble_P(parent_x), parent_x, 2, "gdk_window_coords_from_parent", "gdouble");
+ XEN_ASSERT_TYPE(XEN_gdouble_P(parent_y), parent_y, 3, "gdk_window_coords_from_parent", "gdouble");
+ gdk_window_coords_from_parent(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gdouble(parent_x), XEN_TO_C_gdouble(parent_y), &ref_x,
+ &ref_y);
+ return(XEN_LIST_2(C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
+}
+
+static XEN gxg_gdk_window_get_effective_parent(XEN window)
+{
+ #define H_gdk_window_get_effective_parent "GdkWindow* gdk_window_get_effective_parent(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_effective_parent", "GdkWindow*");
+ return(C_TO_XEN_GdkWindow_(gdk_window_get_effective_parent(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gdk_window_get_effective_toplevel(XEN window)
+{
+ #define H_gdk_window_get_effective_toplevel "GdkWindow* gdk_window_get_effective_toplevel(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_effective_toplevel", "GdkWindow*");
+ return(C_TO_XEN_GdkWindow_(gdk_window_get_effective_toplevel(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gtk_accessible_get_widget(XEN accessible)
+{
+ #define H_gtk_accessible_get_widget "GtkWidget* gtk_accessible_get_widget(GtkAccessible* accessible)"
+ XEN_ASSERT_TYPE(XEN_GtkAccessible__P(accessible), accessible, 1, "gtk_accessible_get_widget", "GtkAccessible*");
+ return(C_TO_XEN_GtkWidget_(gtk_accessible_get_widget(XEN_TO_C_GtkAccessible_(accessible))));
+}
+
+static XEN gxg_gtk_text_view_get_hadjustment(XEN text_view)
+{
+ #define H_gtk_text_view_get_hadjustment "GtkAdjustment* gtk_text_view_get_hadjustment(GtkTextView* text_view)"
+ XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_hadjustment", "GtkTextView*");
+ return(C_TO_XEN_GtkAdjustment_(gtk_text_view_get_hadjustment(XEN_TO_C_GtkTextView_(text_view))));
+}
+
+static XEN gxg_gtk_text_view_get_vadjustment(XEN text_view)
+{
+ #define H_gtk_text_view_get_vadjustment "GtkAdjustment* gtk_text_view_get_vadjustment(GtkTextView* text_view)"
+ XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_vadjustment", "GtkTextView*");
+ return(C_TO_XEN_GtkAdjustment_(gtk_text_view_get_vadjustment(XEN_TO_C_GtkTextView_(text_view))));
+}
+
+static XEN gxg_gtk_widget_send_focus_change(XEN widget, XEN event)
+{
+ #define H_gtk_widget_send_focus_change "gboolean gtk_widget_send_focus_change(GtkWidget* widget, GdkEvent* event)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_send_focus_change", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 2, "gtk_widget_send_focus_change", "GdkEvent*");
+ return(C_TO_XEN_gboolean(gtk_widget_send_focus_change(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkEvent_(event))));
+}
+
+static XEN gxg_gdk_display_get_device_state(XEN display, XEN device, XEN ignore_screen, XEN ignore_x, XEN ignore_y, XEN ignore_mask)
+{
+ #define H_gdk_display_get_device_state "void gdk_display_get_device_state(GdkDisplay* display, GdkDevice* device, \
+GdkScreen** [screen], gint* [x], gint* [y], GdkModifierType* [mask])"
+ GdkScreen* ref_screen = NULL;
+ gint ref_x;
+ gint ref_y;
+ GdkModifierType ref_mask;
+ XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_device_state", "GdkDisplay*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_display_get_device_state", "GdkDevice*");
+ gdk_display_get_device_state(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GdkDevice_(device), &ref_screen, &ref_x, &ref_y, &ref_mask);
+ return(XEN_LIST_4(C_TO_XEN_GdkScreen_(ref_screen), C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_GdkModifierType(ref_mask)));
+}
+
+static XEN gxg_gdk_display_get_window_at_device_position(XEN display, XEN device, XEN ignore_win_x, XEN ignore_win_y)
+{
+ #define H_gdk_display_get_window_at_device_position "GdkWindow* gdk_display_get_window_at_device_position(GdkDisplay* display, \
+GdkDevice* device, gint* [win_x], gint* [win_y])"
+ gint ref_win_x;
+ gint ref_win_y;
+ XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_window_at_device_position", "GdkDisplay*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_display_get_window_at_device_position", "GdkDevice*");
+ {
+ XEN result = XEN_FALSE;
+ result = C_TO_XEN_GdkWindow_(gdk_display_get_window_at_device_position(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GdkDevice_(device),
+ &ref_win_x, &ref_win_y));
+ return(XEN_LIST_3(result, C_TO_XEN_gint(ref_win_x), C_TO_XEN_gint(ref_win_y)));
+ }
+}
+
+static XEN gxg_gdk_display_warp_device(XEN display, XEN device, XEN screen, XEN x, XEN y)
+{
+ #define H_gdk_display_warp_device "void gdk_display_warp_device(GdkDisplay* display, GdkDevice* device, \
+GdkScreen* screen, gint x, gint y)"
+ XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_warp_device", "GdkDisplay*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_display_warp_device", "GdkDevice*");
+ XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 3, "gdk_display_warp_device", "GdkScreen*");
+ XEN_ASSERT_TYPE(XEN_gint_P(x), x, 4, "gdk_display_warp_device", "gint");
+ XEN_ASSERT_TYPE(XEN_gint_P(y), y, 5, "gdk_display_warp_device", "gint");
+ gdk_display_warp_device(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkScreen_(screen), XEN_TO_C_gint(x),
+ XEN_TO_C_gint(y));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gdk_display_get_device_manager(XEN display)
+{
+ #define H_gdk_display_get_device_manager "GdkDeviceManager* gdk_display_get_device_manager(GdkDisplay* display)"
+ XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_device_manager", "GdkDisplay*");
+ return(C_TO_XEN_GdkDeviceManager_(gdk_display_get_device_manager(XEN_TO_C_GdkDisplay_(display))));
+}
+
+static XEN gxg_gdk_drag_context_set_device(XEN context, XEN device)
+{
+ #define H_gdk_drag_context_set_device "void gdk_drag_context_set_device(GdkDragContext* context, GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_context_set_device", "GdkDragContext*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_drag_context_set_device", "GdkDevice*");
+ gdk_drag_context_set_device(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkDevice_(device));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gdk_drag_context_get_device(XEN context)
+{
+ #define H_gdk_drag_context_get_device "GdkDevice* gdk_drag_context_get_device(GdkDragContext* context)"
+ XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_context_get_device", "GdkDragContext*");
+ return(C_TO_XEN_GdkDevice_(gdk_drag_context_get_device(XEN_TO_C_GdkDragContext_(context))));
+}
+
+static XEN gxg_gdk_drag_context_list_targets(XEN context)
+{
+ #define H_gdk_drag_context_list_targets "GList* gdk_drag_context_list_targets(GdkDragContext* context)"
+ XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_context_list_targets", "GdkDragContext*");
+ return(C_TO_XEN_GList_(gdk_drag_context_list_targets(XEN_TO_C_GdkDragContext_(context))));
+}
+
+static XEN gxg_gdk_event_set_device(XEN event, XEN device)
+{
+ #define H_gdk_event_set_device "void gdk_event_set_device(GdkEvent* event, GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_set_device", "GdkEvent*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_event_set_device", "GdkDevice*");
+ gdk_event_set_device(XEN_TO_C_GdkEvent_(event), XEN_TO_C_GdkDevice_(device));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gdk_event_get_device(XEN event)
+{
+ #define H_gdk_event_get_device "GdkDevice* gdk_event_get_device(GdkEvent* event)"
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_get_device", "GdkEvent*");
+ return(C_TO_XEN_GdkDevice_(gdk_event_get_device(XEN_TO_C_GdkEvent_(event))));
+}
+
+static XEN gxg_gdk_events_get_distance(XEN event1, XEN event2, XEN ignore_distance)
+{
+ #define H_gdk_events_get_distance "gboolean gdk_events_get_distance(GdkEvent* event1, GdkEvent* event2, \
+gdouble* [distance])"
+ gdouble ref_distance;
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event1), event1, 1, "gdk_events_get_distance", "GdkEvent*");
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event2), event2, 2, "gdk_events_get_distance", "GdkEvent*");
+ {
+ XEN result = XEN_FALSE;
+ result = C_TO_XEN_gboolean(gdk_events_get_distance(XEN_TO_C_GdkEvent_(event1), XEN_TO_C_GdkEvent_(event2), &ref_distance));
+ return(XEN_LIST_2(result, C_TO_XEN_gdouble(ref_distance)));
+ }
+}
+
+static XEN gxg_gdk_events_get_angle(XEN event1, XEN event2, XEN ignore_angle)
+{
+ #define H_gdk_events_get_angle "gboolean gdk_events_get_angle(GdkEvent* event1, GdkEvent* event2, gdouble* [angle])"
+ gdouble ref_angle;
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event1), event1, 1, "gdk_events_get_angle", "GdkEvent*");
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event2), event2, 2, "gdk_events_get_angle", "GdkEvent*");
+ {
+ XEN result = XEN_FALSE;
+ result = C_TO_XEN_gboolean(gdk_events_get_angle(XEN_TO_C_GdkEvent_(event1), XEN_TO_C_GdkEvent_(event2), &ref_angle));
+ return(XEN_LIST_2(result, C_TO_XEN_gdouble(ref_angle)));
+ }
+}
+
+static XEN gxg_gdk_events_get_center(XEN event1, XEN event2, XEN ignore_x, XEN ignore_y)
+{
+ #define H_gdk_events_get_center "gboolean gdk_events_get_center(GdkEvent* event1, GdkEvent* event2, \
+gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event1), event1, 1, "gdk_events_get_center", "GdkEvent*");
+ XEN_ASSERT_TYPE(XEN_GdkEvent__P(event2), event2, 2, "gdk_events_get_center", "GdkEvent*");
+ {
+ XEN result = XEN_FALSE;
+ result = C_TO_XEN_gboolean(gdk_events_get_center(XEN_TO_C_GdkEvent_(event1), XEN_TO_C_GdkEvent_(event2), &ref_x, &ref_y));
+ return(XEN_LIST_3(result, C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
+ }
+}
+
+static XEN gxg_gdk_image_get_visual(XEN image)
+{
+ #define H_gdk_image_get_visual "GdkVisual* gdk_image_get_visual(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_visual", "GdkImage*");
+ return(C_TO_XEN_GdkVisual_(gdk_image_get_visual(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_image_get_byte_order(XEN image)
+{
+ #define H_gdk_image_get_byte_order "GdkByteOrder gdk_image_get_byte_order(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_byte_order", "GdkImage*");
+ return(C_TO_XEN_GdkByteOrder(gdk_image_get_byte_order(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_image_get_width(XEN image)
+{
+ #define H_gdk_image_get_width "gint gdk_image_get_width(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_width", "GdkImage*");
+ return(C_TO_XEN_gint(gdk_image_get_width(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_image_get_height(XEN image)
+{
+ #define H_gdk_image_get_height "gint gdk_image_get_height(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_height", "GdkImage*");
+ return(C_TO_XEN_gint(gdk_image_get_height(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_image_get_depth(XEN image)
+{
+ #define H_gdk_image_get_depth "guint16 gdk_image_get_depth(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_depth", "GdkImage*");
+ return(C_TO_XEN_guint16(gdk_image_get_depth(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_image_get_bytes_per_pixel(XEN image)
+{
+ #define H_gdk_image_get_bytes_per_pixel "guint16 gdk_image_get_bytes_per_pixel(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_bytes_per_pixel", "GdkImage*");
+ return(C_TO_XEN_guint16(gdk_image_get_bytes_per_pixel(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_image_get_bytes_per_line(XEN image)
+{
+ #define H_gdk_image_get_bytes_per_line "guint16 gdk_image_get_bytes_per_line(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_bytes_per_line", "GdkImage*");
+ return(C_TO_XEN_guint16(gdk_image_get_bytes_per_line(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_image_get_bits_per_pixel(XEN image)
+{
+ #define H_gdk_image_get_bits_per_pixel "guint16 gdk_image_get_bits_per_pixel(GdkImage* image)"
+ XEN_ASSERT_TYPE(XEN_GdkImage__P(image), image, 1, "gdk_image_get_bits_per_pixel", "GdkImage*");
+ return(C_TO_XEN_guint16(gdk_image_get_bits_per_pixel(XEN_TO_C_GdkImage_(image))));
+}
+
+static XEN gxg_gdk_window_get_accept_focus(XEN window)
+{
+ #define H_gdk_window_get_accept_focus "gboolean gdk_window_get_accept_focus(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_accept_focus", "GdkWindow*");
+ return(C_TO_XEN_gboolean(gdk_window_get_accept_focus(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gdk_window_get_focus_on_map(XEN window)
+{
+ #define H_gdk_window_get_focus_on_map "gboolean gdk_window_get_focus_on_map(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_focus_on_map", "GdkWindow*");
+ return(C_TO_XEN_gboolean(gdk_window_get_focus_on_map(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gdk_window_get_composited(XEN window)
+{
+ #define H_gdk_window_get_composited "gboolean gdk_window_get_composited(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_composited", "GdkWindow*");
+ return(C_TO_XEN_gboolean(gdk_window_get_composited(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gdk_window_is_input_only(XEN window)
+{
+ #define H_gdk_window_is_input_only "gboolean gdk_window_is_input_only(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_is_input_only", "GdkWindow*");
+ return(C_TO_XEN_gboolean(gdk_window_is_input_only(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gdk_window_is_shaped(XEN window)
+{
+ #define H_gdk_window_is_shaped "gboolean gdk_window_is_shaped(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_is_shaped", "GdkWindow*");
+ return(C_TO_XEN_gboolean(gdk_window_is_shaped(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gdk_window_get_modal_hint(XEN window)
+{
+ #define H_gdk_window_get_modal_hint "gboolean gdk_window_get_modal_hint(GdkWindow* window)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_modal_hint", "GdkWindow*");
+ return(C_TO_XEN_gboolean(gdk_window_get_modal_hint(XEN_TO_C_GdkWindow_(window))));
+}
+
+static XEN gxg_gdk_window_get_background(XEN window, XEN color)
+{
+ #define H_gdk_window_get_background "void gdk_window_get_background(GdkWindow* window, GdkColor* color)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_background", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gdk_window_get_background", "GdkColor*");
+ gdk_window_get_background(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkColor_(color));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gdk_window_get_back_pixmap(XEN window, XEN ignore_pixmap, XEN ignore_parent_relative)
+{
+ #define H_gdk_window_get_back_pixmap "void gdk_window_get_back_pixmap(GdkWindow* window, GdkPixmap** [pixmap], \
+gboolean* [parent_relative])"
+ GdkPixmap* ref_pixmap = NULL;
+ gboolean ref_parent_relative;
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_back_pixmap", "GdkWindow*");
+ gdk_window_get_back_pixmap(XEN_TO_C_GdkWindow_(window), &ref_pixmap, &ref_parent_relative);
+ return(XEN_LIST_2(C_TO_XEN_GdkPixmap_(ref_pixmap), C_TO_XEN_gboolean(ref_parent_relative)));
+}
+
+static XEN gxg_gdk_window_set_device_cursor(XEN window, XEN device, XEN cursor)
+{
+ #define H_gdk_window_set_device_cursor "void gdk_window_set_device_cursor(GdkWindow* window, GdkDevice* device, \
+GdkCursor* cursor)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_device_cursor", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_set_device_cursor", "GdkDevice*");
+ XEN_ASSERT_TYPE(XEN_GdkCursor__P(cursor), cursor, 3, "gdk_window_set_device_cursor", "GdkCursor*");
+ gdk_window_set_device_cursor(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkCursor_(cursor));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gdk_window_get_device_cursor(XEN window, XEN device)
+{
+ #define H_gdk_window_get_device_cursor "GdkCursor* gdk_window_get_device_cursor(GdkWindow* window, \
+GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_device_cursor", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_get_device_cursor", "GdkDevice*");
+ return(C_TO_XEN_GdkCursor_(gdk_window_get_device_cursor(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device))));
+}
+
+static XEN gxg_gdk_window_get_device_position(XEN window, XEN device, XEN ignore_x, XEN ignore_y, XEN ignore_mask)
+{
+ #define H_gdk_window_get_device_position "GdkWindow* gdk_window_get_device_position(GdkWindow* window, \
+GdkDevice* device, gint* [x], gint* [y], GdkModifierType* [mask])"
+ gint ref_x;
+ gint ref_y;
+ GdkModifierType ref_mask;
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_device_position", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_get_device_position", "GdkDevice*");
+ {
+ XEN result = XEN_FALSE;
+ result = C_TO_XEN_GdkWindow_(gdk_window_get_device_position(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device),
+ &ref_x, &ref_y, &ref_mask));
+ return(XEN_LIST_4(result, C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_GdkModifierType(ref_mask)));
+ }
+}
+
+static XEN gxg_gdk_window_set_device_events(XEN window, XEN device, XEN event_mask)
+{
+ #define H_gdk_window_set_device_events "void gdk_window_set_device_events(GdkWindow* window, GdkDevice* device, \
+GdkEventMask event_mask)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_device_events", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_set_device_events", "GdkDevice*");
+ XEN_ASSERT_TYPE(XEN_GdkEventMask_P(event_mask), event_mask, 3, "gdk_window_set_device_events", "GdkEventMask");
+ gdk_window_set_device_events(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkEventMask(event_mask));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gdk_window_get_device_events(XEN window, XEN device)
+{
+ #define H_gdk_window_get_device_events "GdkEventMask gdk_window_get_device_events(GdkWindow* window, \
+GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_device_events", "GdkWindow*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_get_device_events", "GdkDevice*");
+ return(C_TO_XEN_GdkEventMask(gdk_window_get_device_events(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device))));
+}
+
+static XEN gxg_gtk_combo_box_popup_for_device(XEN combo_box, XEN device)
+{
+ #define H_gtk_combo_box_popup_for_device "void gtk_combo_box_popup_for_device(GtkComboBox* combo_box, \
+GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_popup_for_device", "GtkComboBox*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_combo_box_popup_for_device", "GdkDevice*");
+ gtk_combo_box_popup_for_device(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_GdkDevice_(device));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_device_grab_add(XEN widget, XEN device, XEN block_others)
+{
+ #define H_gtk_device_grab_add "void gtk_device_grab_add(GtkWidget* widget, GdkDevice* device, gboolean block_others)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_device_grab_add", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_device_grab_add", "GdkDevice*");
+ XEN_ASSERT_TYPE(XEN_gboolean_P(block_others), block_others, 3, "gtk_device_grab_add", "gboolean");
+ gtk_device_grab_add(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device), XEN_TO_C_gboolean(block_others));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_device_grab_remove(XEN widget, XEN device)
+{
+ #define H_gtk_device_grab_remove "void gtk_device_grab_remove(GtkWidget* widget, GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_device_grab_remove", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_device_grab_remove", "GdkDevice*");
+ gtk_device_grab_remove(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_get_current_event_device(void)
+{
+ #define H_gtk_get_current_event_device "GdkDevice* gtk_get_current_event_device( void)"
+ return(C_TO_XEN_GdkDevice_(gtk_get_current_event_device()));
+}
+
+static XEN gxg_gtk_menu_popup_for_device(XEN menu, XEN device, XEN parent_menu_shell, XEN parent_menu_item, XEN func, XEN func_info, XEN button, XEN activate_time)
+{
+ #define H_gtk_menu_popup_for_device "void gtk_menu_popup_for_device(GtkMenu* menu, GdkDevice* device, \
+GtkWidget* parent_menu_shell, GtkWidget* parent_menu_item, GtkMenuPositionFunc func, lambda_data func_info, \
+guint button, guint32 activate_time)"
+ XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_popup_for_device", "GtkMenu*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_menu_popup_for_device", "GdkDevice*");
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(parent_menu_shell), parent_menu_shell, 3, "gtk_menu_popup_for_device", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(parent_menu_item), parent_menu_item, 4, "gtk_menu_popup_for_device", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GtkMenuPositionFunc_P(func), func, 5, "gtk_menu_popup_for_device", "GtkMenuPositionFunc");
+ if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
+ else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 6, "gtk_menu_popup_for_device", "lambda_data");
+ XEN_ASSERT_TYPE(XEN_guint_P(button), button, 7, "gtk_menu_popup_for_device", "guint");
+ XEN_ASSERT_TYPE(XEN_guint32_P(activate_time), activate_time, 8, "gtk_menu_popup_for_device", "guint32");
+ {
+ XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ xm_protect(gxg_ptr);
+ gtk_menu_popup_for_device(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GtkWidget_(parent_menu_shell), XEN_TO_C_GtkWidget_(parent_menu_item),
+ XEN_TO_C_GtkMenuPositionFunc(func), XEN_TO_C_lambda_data(func_info), XEN_TO_C_guint(button), XEN_TO_C_guint32(activate_time));
+ return(XEN_FALSE);
+ }
+}
+
+static XEN gxg_gtk_paned_new(XEN orientation)
+{
+ #define H_gtk_paned_new "GtkWidget* gtk_paned_new(GtkOrientation orientation)"
+ XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_paned_new", "GtkOrientation");
+ return(C_TO_XEN_GtkWidget_(gtk_paned_new(XEN_TO_C_GtkOrientation(orientation))));
+}
+
+static XEN gxg_gtk_radio_action_join_group(XEN action, XEN group_source)
+{
+ #define H_gtk_radio_action_join_group "void gtk_radio_action_join_group(GtkRadioAction* action, GtkRadioAction* group_source)"
+ XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(action), action, 1, "gtk_radio_action_join_group", "GtkRadioAction*");
+ XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(group_source), group_source, 2, "gtk_radio_action_join_group", "GtkRadioAction*");
+ gtk_radio_action_join_group(XEN_TO_C_GtkRadioAction_(action), XEN_TO_C_GtkRadioAction_(group_source));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_ruler_new(XEN orientation)
+{
+ #define H_gtk_ruler_new "GtkWidget* gtk_ruler_new(GtkOrientation orientation)"
+ XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_ruler_new", "GtkOrientation");
+ return(C_TO_XEN_GtkWidget_(gtk_ruler_new(XEN_TO_C_GtkOrientation(orientation))));
+}
+
+static XEN gxg_gtk_scale_new(XEN orientation, XEN adjustment)
+{
+ #define H_gtk_scale_new "GtkWidget* gtk_scale_new(GtkOrientation orientation, GtkAdjustment* adjustment)"
+ XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_scale_new", "GtkOrientation");
+ XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 2, "gtk_scale_new", "GtkAdjustment*");
+ return(C_TO_XEN_GtkWidget_(gtk_scale_new(XEN_TO_C_GtkOrientation(orientation), XEN_TO_C_GtkAdjustment_(adjustment))));
+}
+
+static XEN gxg_gtk_scale_new_with_range(XEN orientation, XEN min, XEN max, XEN step)
+{
+ #define H_gtk_scale_new_with_range "GtkWidget* gtk_scale_new_with_range(GtkOrientation orientation, \
+gdouble min, gdouble max, gdouble step)"
+ XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_scale_new_with_range", "GtkOrientation");
+ XEN_ASSERT_TYPE(XEN_gdouble_P(min), min, 2, "gtk_scale_new_with_range", "gdouble");
+ XEN_ASSERT_TYPE(XEN_gdouble_P(max), max, 3, "gtk_scale_new_with_range", "gdouble");
+ XEN_ASSERT_TYPE(XEN_gdouble_P(step), step, 4, "gtk_scale_new_with_range", "gdouble");
+ return(C_TO_XEN_GtkWidget_(gtk_scale_new_with_range(XEN_TO_C_GtkOrientation(orientation), XEN_TO_C_gdouble(min), XEN_TO_C_gdouble(max),
+ XEN_TO_C_gdouble(step))));
+}
+
+static XEN gxg_gtk_scrollbar_new(XEN orientation, XEN adjustment)
+{
+ #define H_gtk_scrollbar_new "GtkWidget* gtk_scrollbar_new(GtkOrientation orientation, GtkAdjustment* adjustment)"
+ XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_scrollbar_new", "GtkOrientation");
+ XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 2, "gtk_scrollbar_new", "GtkAdjustment*");
+ return(C_TO_XEN_GtkWidget_(gtk_scrollbar_new(XEN_TO_C_GtkOrientation(orientation), XEN_TO_C_GtkAdjustment_(adjustment))));
+}
+
+static XEN gxg_gtk_separator_new(XEN orientation)
+{
+ #define H_gtk_separator_new "GtkWidget* gtk_separator_new(GtkOrientation orientation)"
+ XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_separator_new", "GtkOrientation");
+ return(C_TO_XEN_GtkWidget_(gtk_separator_new(XEN_TO_C_GtkOrientation(orientation))));
+}
+
+static XEN gxg_gtk_widget_device_is_shadowed(XEN widget, XEN device)
+{
+ #define H_gtk_widget_device_is_shadowed "gboolean gtk_widget_device_is_shadowed(GtkWidget* widget, \
+GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_device_is_shadowed", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_device_is_shadowed", "GdkDevice*");
+ return(C_TO_XEN_gboolean(gtk_widget_device_is_shadowed(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device))));
+}
+
+static XEN gxg_gtk_widget_set_device_events(XEN widget, XEN device, XEN events)
+{
+ #define H_gtk_widget_set_device_events "void gtk_widget_set_device_events(GtkWidget* widget, GdkDevice* device, \
+GdkEventMask events)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_device_events", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_set_device_events", "GdkDevice*");
+ XEN_ASSERT_TYPE(XEN_GdkEventMask_P(events), events, 3, "gtk_widget_set_device_events", "GdkEventMask");
+ gtk_widget_set_device_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkEventMask(events));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_widget_add_device_events(XEN widget, XEN device, XEN events)
+{
+ #define H_gtk_widget_add_device_events "void gtk_widget_add_device_events(GtkWidget* widget, GdkDevice* device, \
+GdkEventMask events)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_add_device_events", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_add_device_events", "GdkDevice*");
+ XEN_ASSERT_TYPE(XEN_GdkEventMask_P(events), events, 3, "gtk_widget_add_device_events", "GdkEventMask");
+ gtk_widget_add_device_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkEventMask(events));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_widget_get_support_multidevice(XEN widget)
+{
+ #define H_gtk_widget_get_support_multidevice "gboolean gtk_widget_get_support_multidevice(GtkWidget* widget)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_support_multidevice", "GtkWidget*");
+ return(C_TO_XEN_gboolean(gtk_widget_get_support_multidevice(XEN_TO_C_GtkWidget_(widget))));
+}
+
+static XEN gxg_gtk_widget_set_support_multidevice(XEN widget, XEN support_multidevice)
+{
+ #define H_gtk_widget_set_support_multidevice "void gtk_widget_set_support_multidevice(GtkWidget* widget, \
+gboolean support_multidevice)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_support_multidevice", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_gboolean_P(support_multidevice), support_multidevice, 2, "gtk_widget_set_support_multidevice", "gboolean");
+ gtk_widget_set_support_multidevice(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(support_multidevice));
+ return(XEN_FALSE);
+}
+
+static XEN gxg_gtk_widget_get_device_events(XEN widget, XEN device)
+{
+ #define H_gtk_widget_get_device_events "GdkEventMask gtk_widget_get_device_events(GtkWidget* widget, \
+GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_device_events", "GtkWidget*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_get_device_events", "GdkDevice*");
+ return(C_TO_XEN_GdkEventMask(gtk_widget_get_device_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device))));
+}
+
+static XEN gxg_gtk_window_group_get_current_device_grab(XEN window_group, XEN device)
+{
+ #define H_gtk_window_group_get_current_device_grab "GtkWidget* gtk_window_group_get_current_device_grab(GtkWindowGroup* window_group, \
+GdkDevice* device)"
+ XEN_ASSERT_TYPE(XEN_GtkWindowGroup__P(window_group), window_group, 1, "gtk_window_group_get_current_device_grab", "GtkWindowGroup*");
+ XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_window_group_get_current_device_grab", "GdkDevice*");
+ return(C_TO_XEN_GtkWidget_(gtk_window_group_get_current_device_grab(XEN_TO_C_GtkWindowGroup_(window_group), XEN_TO_C_GdkDevice_(device))));
+}
+
+#endif
+
#if HAVE_CAIRO_CREATE
static XEN gxg_cairo_create(XEN target)
{
@@ -37125,7 +37689,6 @@ XEN_NARGIFY_1(gxg_gdk_display_pointer_is_grabbed_w, gxg_gdk_display_pointer_is_g
XEN_NARGIFY_1(gxg_gdk_display_beep_w, gxg_gdk_display_beep)
XEN_NARGIFY_1(gxg_gdk_display_sync_w, gxg_gdk_display_sync)
XEN_NARGIFY_1(gxg_gdk_display_close_w, gxg_gdk_display_close)
-XEN_NARGIFY_1(gxg_gdk_display_list_devices_w, gxg_gdk_display_list_devices)
XEN_NARGIFY_1(gxg_gdk_display_get_event_w, gxg_gdk_display_get_event)
XEN_NARGIFY_1(gxg_gdk_display_peek_event_w, gxg_gdk_display_peek_event)
XEN_NARGIFY_2(gxg_gdk_display_put_event_w, gxg_gdk_display_put_event)
@@ -37501,7 +38064,6 @@ XEN_NARGIFY_2(gxg_gtk_file_chooser_select_uri_w, gxg_gtk_file_chooser_select_uri
XEN_NARGIFY_2(gxg_gtk_file_chooser_set_current_folder_uri_w, gxg_gtk_file_chooser_set_current_folder_uri)
XEN_NARGIFY_2(gxg_gdk_display_set_double_click_distance_w, gxg_gdk_display_set_double_click_distance)
XEN_NARGIFY_1(gxg_gdk_display_get_default_group_w, gxg_gdk_display_get_default_group)
-XEN_NARGIFY_2(gxg_gdk_window_set_accept_focus_w, gxg_gdk_window_set_accept_focus)
XEN_NARGIFY_1(gxg_gdk_window_get_group_w, gxg_gdk_window_get_group)
XEN_NARGIFY_1(gxg_gtk_action_group_get_sensitive_w, gxg_gtk_action_group_get_sensitive)
XEN_NARGIFY_2(gxg_gtk_action_group_set_sensitive_w, gxg_gtk_action_group_set_sensitive)
@@ -37557,7 +38119,6 @@ XEN_NARGIFY_2(gxg_gtk_cell_view_set_displayed_row_w, gxg_gtk_cell_view_set_displ
XEN_NARGIFY_1(gxg_gtk_cell_view_get_displayed_row_w, gxg_gtk_cell_view_get_displayed_row)
XEN_NARGIFY_3(gxg_gtk_cell_view_get_size_of_row_w, gxg_gtk_cell_view_get_size_of_row)
XEN_NARGIFY_2(gxg_gtk_cell_view_set_background_color_w, gxg_gtk_cell_view_set_background_color)
-XEN_NARGIFY_2(gxg_gdk_window_set_focus_on_map_w, gxg_gdk_window_set_focus_on_map)
XEN_NARGIFY_1(gxg_gdk_window_enable_synchronized_configure_w, gxg_gdk_window_enable_synchronized_configure)
XEN_NARGIFY_1(gxg_gdk_window_configure_finished_w, gxg_gdk_window_configure_finished)
XEN_NARGIFY_1(gxg_gtk_combo_box_get_wrap_width_w, gxg_gtk_combo_box_get_wrap_width)
@@ -38561,6 +39122,71 @@ XEN_NARGIFY_2(gxg_gtk_widget_set_mapped_w, gxg_gtk_widget_set_mapped)
XEN_NARGIFY_1(gxg_gtk_widget_get_mapped_w, gxg_gtk_widget_get_mapped)
#endif
+#if HAVE_GTK_SCALE_NEW
+XEN_NARGIFY_2(gxg_gdk_keymap_add_virtual_modifiers_w, gxg_gdk_keymap_add_virtual_modifiers)
+XEN_NARGIFY_2(gxg_gtk_widget_get_requisition_w, gxg_gtk_widget_get_requisition)
+XEN_ARGIFY_5(gxg_gdk_window_coords_to_parent_w, gxg_gdk_window_coords_to_parent)
+XEN_ARGIFY_5(gxg_gdk_window_coords_from_parent_w, gxg_gdk_window_coords_from_parent)
+XEN_NARGIFY_1(gxg_gdk_window_get_effective_parent_w, gxg_gdk_window_get_effective_parent)
+XEN_NARGIFY_1(gxg_gdk_window_get_effective_toplevel_w, gxg_gdk_window_get_effective_toplevel)
+XEN_NARGIFY_1(gxg_gtk_accessible_get_widget_w, gxg_gtk_accessible_get_widget)
+XEN_NARGIFY_1(gxg_gtk_text_view_get_hadjustment_w, gxg_gtk_text_view_get_hadjustment)
+XEN_NARGIFY_1(gxg_gtk_text_view_get_vadjustment_w, gxg_gtk_text_view_get_vadjustment)
+XEN_NARGIFY_2(gxg_gtk_widget_send_focus_change_w, gxg_gtk_widget_send_focus_change)
+XEN_ARGIFY_6(gxg_gdk_display_get_device_state_w, gxg_gdk_display_get_device_state)
+XEN_ARGIFY_4(gxg_gdk_display_get_window_at_device_position_w, gxg_gdk_display_get_window_at_device_position)
+XEN_NARGIFY_5(gxg_gdk_display_warp_device_w, gxg_gdk_display_warp_device)
+XEN_NARGIFY_1(gxg_gdk_display_get_device_manager_w, gxg_gdk_display_get_device_manager)
+XEN_NARGIFY_2(gxg_gdk_drag_context_set_device_w, gxg_gdk_drag_context_set_device)
+XEN_NARGIFY_1(gxg_gdk_drag_context_get_device_w, gxg_gdk_drag_context_get_device)
+XEN_NARGIFY_1(gxg_gdk_drag_context_list_targets_w, gxg_gdk_drag_context_list_targets)
+XEN_NARGIFY_2(gxg_gdk_event_set_device_w, gxg_gdk_event_set_device)
+XEN_NARGIFY_1(gxg_gdk_event_get_device_w, gxg_gdk_event_get_device)
+XEN_ARGIFY_3(gxg_gdk_events_get_distance_w, gxg_gdk_events_get_distance)
+XEN_ARGIFY_3(gxg_gdk_events_get_angle_w, gxg_gdk_events_get_angle)
+XEN_ARGIFY_4(gxg_gdk_events_get_center_w, gxg_gdk_events_get_center)
+XEN_NARGIFY_1(gxg_gdk_image_get_visual_w, gxg_gdk_image_get_visual)
+XEN_NARGIFY_1(gxg_gdk_image_get_byte_order_w, gxg_gdk_image_get_byte_order)
+XEN_NARGIFY_1(gxg_gdk_image_get_width_w, gxg_gdk_image_get_width)
+XEN_NARGIFY_1(gxg_gdk_image_get_height_w, gxg_gdk_image_get_height)
+XEN_NARGIFY_1(gxg_gdk_image_get_depth_w, gxg_gdk_image_get_depth)
+XEN_NARGIFY_1(gxg_gdk_image_get_bytes_per_pixel_w, gxg_gdk_image_get_bytes_per_pixel)
+XEN_NARGIFY_1(gxg_gdk_image_get_bytes_per_line_w, gxg_gdk_image_get_bytes_per_line)
+XEN_NARGIFY_1(gxg_gdk_image_get_bits_per_pixel_w, gxg_gdk_image_get_bits_per_pixel)
+XEN_NARGIFY_1(gxg_gdk_window_get_accept_focus_w, gxg_gdk_window_get_accept_focus)
+XEN_NARGIFY_1(gxg_gdk_window_get_focus_on_map_w, gxg_gdk_window_get_focus_on_map)
+XEN_NARGIFY_1(gxg_gdk_window_get_composited_w, gxg_gdk_window_get_composited)
+XEN_NARGIFY_1(gxg_gdk_window_is_input_only_w, gxg_gdk_window_is_input_only)
+XEN_NARGIFY_1(gxg_gdk_window_is_shaped_w, gxg_gdk_window_is_shaped)
+XEN_NARGIFY_1(gxg_gdk_window_get_modal_hint_w, gxg_gdk_window_get_modal_hint)
+XEN_NARGIFY_2(gxg_gdk_window_get_background_w, gxg_gdk_window_get_background)
+XEN_ARGIFY_3(gxg_gdk_window_get_back_pixmap_w, gxg_gdk_window_get_back_pixmap)
+XEN_NARGIFY_3(gxg_gdk_window_set_device_cursor_w, gxg_gdk_window_set_device_cursor)
+XEN_NARGIFY_2(gxg_gdk_window_get_device_cursor_w, gxg_gdk_window_get_device_cursor)
+XEN_ARGIFY_5(gxg_gdk_window_get_device_position_w, gxg_gdk_window_get_device_position)
+XEN_NARGIFY_3(gxg_gdk_window_set_device_events_w, gxg_gdk_window_set_device_events)
+XEN_NARGIFY_2(gxg_gdk_window_get_device_events_w, gxg_gdk_window_get_device_events)
+XEN_NARGIFY_2(gxg_gtk_combo_box_popup_for_device_w, gxg_gtk_combo_box_popup_for_device)
+XEN_NARGIFY_3(gxg_gtk_device_grab_add_w, gxg_gtk_device_grab_add)
+XEN_NARGIFY_2(gxg_gtk_device_grab_remove_w, gxg_gtk_device_grab_remove)
+XEN_NARGIFY_0(gxg_gtk_get_current_event_device_w, gxg_gtk_get_current_event_device)
+XEN_ARGIFY_8(gxg_gtk_menu_popup_for_device_w, gxg_gtk_menu_popup_for_device)
+XEN_NARGIFY_1(gxg_gtk_paned_new_w, gxg_gtk_paned_new)
+XEN_NARGIFY_2(gxg_gtk_radio_action_join_group_w, gxg_gtk_radio_action_join_group)
+XEN_NARGIFY_1(gxg_gtk_ruler_new_w, gxg_gtk_ruler_new)
+XEN_NARGIFY_2(gxg_gtk_scale_new_w, gxg_gtk_scale_new)
+XEN_NARGIFY_4(gxg_gtk_scale_new_with_range_w, gxg_gtk_scale_new_with_range)
+XEN_NARGIFY_2(gxg_gtk_scrollbar_new_w, gxg_gtk_scrollbar_new)
+XEN_NARGIFY_1(gxg_gtk_separator_new_w, gxg_gtk_separator_new)
+XEN_NARGIFY_2(gxg_gtk_widget_device_is_shadowed_w, gxg_gtk_widget_device_is_shadowed)
+XEN_NARGIFY_3(gxg_gtk_widget_set_device_events_w, gxg_gtk_widget_set_device_events)
+XEN_NARGIFY_3(gxg_gtk_widget_add_device_events_w, gxg_gtk_widget_add_device_events)
+XEN_NARGIFY_1(gxg_gtk_widget_get_support_multidevice_w, gxg_gtk_widget_get_support_multidevice)
+XEN_NARGIFY_2(gxg_gtk_widget_set_support_multidevice_w, gxg_gtk_widget_set_support_multidevice)
+XEN_NARGIFY_2(gxg_gtk_widget_get_device_events_w, gxg_gtk_widget_get_device_events)
+XEN_NARGIFY_2(gxg_gtk_window_group_get_current_device_grab_w, gxg_gtk_window_group_get_current_device_grab)
+#endif
+
#if HAVE_CAIRO_CREATE
XEN_NARGIFY_1(gxg_cairo_create_w, gxg_cairo_create)
XEN_NARGIFY_0(gxg_cairo_version_w, gxg_cairo_version)
@@ -41129,7 +41755,6 @@ XEN_NARGIFY_0(gxg_make_cairo_matrix_t_w, gxg_make_cairo_matrix_t)
#define gxg_gdk_display_beep_w gxg_gdk_display_beep
#define gxg_gdk_display_sync_w gxg_gdk_display_sync
#define gxg_gdk_display_close_w gxg_gdk_display_close
-#define gxg_gdk_display_list_devices_w gxg_gdk_display_list_devices
#define gxg_gdk_display_get_event_w gxg_gdk_display_get_event
#define gxg_gdk_display_peek_event_w gxg_gdk_display_peek_event
#define gxg_gdk_display_put_event_w gxg_gdk_display_put_event
@@ -41505,7 +42130,6 @@ XEN_NARGIFY_0(gxg_make_cairo_matrix_t_w, gxg_make_cairo_matrix_t)
#define gxg_gtk_file_chooser_set_current_folder_uri_w gxg_gtk_file_chooser_set_current_folder_uri
#define gxg_gdk_display_set_double_click_distance_w gxg_gdk_display_set_double_click_distance
#define gxg_gdk_display_get_default_group_w gxg_gdk_display_get_default_group
-#define gxg_gdk_window_set_accept_focus_w gxg_gdk_window_set_accept_focus
#define gxg_gdk_window_get_group_w gxg_gdk_window_get_group
#define gxg_gtk_action_group_get_sensitive_w gxg_gtk_action_group_get_sensitive
#define gxg_gtk_action_group_set_sensitive_w gxg_gtk_action_group_set_sensitive
@@ -41561,7 +42185,6 @@ XEN_NARGIFY_0(gxg_make_cairo_matrix_t_w, gxg_make_cairo_matrix_t)
#define gxg_gtk_cell_view_get_displayed_row_w gxg_gtk_cell_view_get_displayed_row
#define gxg_gtk_cell_view_get_size_of_row_w gxg_gtk_cell_view_get_size_of_row
#define gxg_gtk_cell_view_set_background_color_w gxg_gtk_cell_view_set_background_color
-#define gxg_gdk_window_set_focus_on_map_w gxg_gdk_window_set_focus_on_map
#define gxg_gdk_window_enable_synchronized_configure_w gxg_gdk_window_enable_synchronized_configure
#define gxg_gdk_window_configure_finished_w gxg_gdk_window_configure_finished
#define gxg_gtk_combo_box_get_wrap_width_w gxg_gtk_combo_box_get_wrap_width
@@ -42565,6 +43188,71 @@ XEN_NARGIFY_0(gxg_make_cairo_matrix_t_w, gxg_make_cairo_matrix_t)
#define gxg_gtk_widget_get_mapped_w gxg_gtk_widget_get_mapped
#endif
+#if HAVE_GTK_SCALE_NEW
+#define gxg_gdk_keymap_add_virtual_modifiers_w gxg_gdk_keymap_add_virtual_modifiers
+#define gxg_gtk_widget_get_requisition_w gxg_gtk_widget_get_requisition
+#define gxg_gdk_window_coords_to_parent_w gxg_gdk_window_coords_to_parent
+#define gxg_gdk_window_coords_from_parent_w gxg_gdk_window_coords_from_parent
+#define gxg_gdk_window_get_effective_parent_w gxg_gdk_window_get_effective_parent
+#define gxg_gdk_window_get_effective_toplevel_w gxg_gdk_window_get_effective_toplevel
+#define gxg_gtk_accessible_get_widget_w gxg_gtk_accessible_get_widget
+#define gxg_gtk_text_view_get_hadjustment_w gxg_gtk_text_view_get_hadjustment
+#define gxg_gtk_text_view_get_vadjustment_w gxg_gtk_text_view_get_vadjustment
+#define gxg_gtk_widget_send_focus_change_w gxg_gtk_widget_send_focus_change
+#define gxg_gdk_display_get_device_state_w gxg_gdk_display_get_device_state
+#define gxg_gdk_display_get_window_at_device_position_w gxg_gdk_display_get_window_at_device_position
+#define gxg_gdk_display_warp_device_w gxg_gdk_display_warp_device
+#define gxg_gdk_display_get_device_manager_w gxg_gdk_display_get_device_manager
+#define gxg_gdk_drag_context_set_device_w gxg_gdk_drag_context_set_device
+#define gxg_gdk_drag_context_get_device_w gxg_gdk_drag_context_get_device
+#define gxg_gdk_drag_context_list_targets_w gxg_gdk_drag_context_list_targets
+#define gxg_gdk_event_set_device_w gxg_gdk_event_set_device
+#define gxg_gdk_event_get_device_w gxg_gdk_event_get_device
+#define gxg_gdk_events_get_distance_w gxg_gdk_events_get_distance
+#define gxg_gdk_events_get_angle_w gxg_gdk_events_get_angle
+#define gxg_gdk_events_get_center_w gxg_gdk_events_get_center
+#define gxg_gdk_image_get_visual_w gxg_gdk_image_get_visual
+#define gxg_gdk_image_get_byte_order_w gxg_gdk_image_get_byte_order
+#define gxg_gdk_image_get_width_w gxg_gdk_image_get_width
+#define gxg_gdk_image_get_height_w gxg_gdk_image_get_height
+#define gxg_gdk_image_get_depth_w gxg_gdk_image_get_depth
+#define gxg_gdk_image_get_bytes_per_pixel_w gxg_gdk_image_get_bytes_per_pixel
+#define gxg_gdk_image_get_bytes_per_line_w gxg_gdk_image_get_bytes_per_line
+#define gxg_gdk_image_get_bits_per_pixel_w gxg_gdk_image_get_bits_per_pixel
+#define gxg_gdk_window_get_accept_focus_w gxg_gdk_window_get_accept_focus
+#define gxg_gdk_window_get_focus_on_map_w gxg_gdk_window_get_focus_on_map
+#define gxg_gdk_window_get_composited_w gxg_gdk_window_get_composited
+#define gxg_gdk_window_is_input_only_w gxg_gdk_window_is_input_only
+#define gxg_gdk_window_is_shaped_w gxg_gdk_window_is_shaped
+#define gxg_gdk_window_get_modal_hint_w gxg_gdk_window_get_modal_hint
+#define gxg_gdk_window_get_background_w gxg_gdk_window_get_background
+#define gxg_gdk_window_get_back_pixmap_w gxg_gdk_window_get_back_pixmap
+#define gxg_gdk_window_set_device_cursor_w gxg_gdk_window_set_device_cursor
+#define gxg_gdk_window_get_device_cursor_w gxg_gdk_window_get_device_cursor
+#define gxg_gdk_window_get_device_position_w gxg_gdk_window_get_device_position
+#define gxg_gdk_window_set_device_events_w gxg_gdk_window_set_device_events
+#define gxg_gdk_window_get_device_events_w gxg_gdk_window_get_device_events
+#define gxg_gtk_combo_box_popup_for_device_w gxg_gtk_combo_box_popup_for_device
+#define gxg_gtk_device_grab_add_w gxg_gtk_device_grab_add
+#define gxg_gtk_device_grab_remove_w gxg_gtk_device_grab_remove
+#define gxg_gtk_get_current_event_device_w gxg_gtk_get_current_event_device
+#define gxg_gtk_menu_popup_for_device_w gxg_gtk_menu_popup_for_device
+#define gxg_gtk_paned_new_w gxg_gtk_paned_new
+#define gxg_gtk_radio_action_join_group_w gxg_gtk_radio_action_join_group
+#define gxg_gtk_ruler_new_w gxg_gtk_ruler_new
+#define gxg_gtk_scale_new_w gxg_gtk_scale_new
+#define gxg_gtk_scale_new_with_range_w gxg_gtk_scale_new_with_range
+#define gxg_gtk_scrollbar_new_w gxg_gtk_scrollbar_new
+#define gxg_gtk_separator_new_w gxg_gtk_separator_new
+#define gxg_gtk_widget_device_is_shadowed_w gxg_gtk_widget_device_is_shadowed
+#define gxg_gtk_widget_set_device_events_w gxg_gtk_widget_set_device_events
+#define gxg_gtk_widget_add_device_events_w gxg_gtk_widget_add_device_events
+#define gxg_gtk_widget_get_support_multidevice_w gxg_gtk_widget_get_support_multidevice
+#define gxg_gtk_widget_set_support_multidevice_w gxg_gtk_widget_set_support_multidevice
+#define gxg_gtk_widget_get_device_events_w gxg_gtk_widget_get_device_events
+#define gxg_gtk_window_group_get_current_device_grab_w gxg_gtk_window_group_get_current_device_grab
+#endif
+
#if HAVE_CAIRO_CREATE
#define gxg_cairo_create_w gxg_cairo_create
#define gxg_cairo_version_w gxg_cairo_version
@@ -45140,7 +45828,6 @@ static void define_functions(void)
XG_DEFINE_PROCEDURE(gdk_display_beep, gxg_gdk_display_beep_w, 1, 0, 0, H_gdk_display_beep);
XG_DEFINE_PROCEDURE(gdk_display_sync, gxg_gdk_display_sync_w, 1, 0, 0, H_gdk_display_sync);
XG_DEFINE_PROCEDURE(gdk_display_close, gxg_gdk_display_close_w, 1, 0, 0, H_gdk_display_close);
- XG_DEFINE_PROCEDURE(gdk_display_list_devices, gxg_gdk_display_list_devices_w, 1, 0, 0, H_gdk_display_list_devices);
XG_DEFINE_PROCEDURE(gdk_display_get_event, gxg_gdk_display_get_event_w, 1, 0, 0, H_gdk_display_get_event);
XG_DEFINE_PROCEDURE(gdk_display_peek_event, gxg_gdk_display_peek_event_w, 1, 0, 0, H_gdk_display_peek_event);
XG_DEFINE_PROCEDURE(gdk_display_put_event, gxg_gdk_display_put_event_w, 2, 0, 0, H_gdk_display_put_event);
@@ -45516,7 +46203,6 @@ static void define_functions(void)
XG_DEFINE_PROCEDURE(gtk_file_chooser_set_current_folder_uri, gxg_gtk_file_chooser_set_current_folder_uri_w, 2, 0, 0, H_gtk_file_chooser_set_current_folder_uri);
XG_DEFINE_PROCEDURE(gdk_display_set_double_click_distance, gxg_gdk_display_set_double_click_distance_w, 2, 0, 0, H_gdk_display_set_double_click_distance);
XG_DEFINE_PROCEDURE(gdk_display_get_default_group, gxg_gdk_display_get_default_group_w, 1, 0, 0, H_gdk_display_get_default_group);
- XG_DEFINE_PROCEDURE(gdk_window_set_accept_focus, gxg_gdk_window_set_accept_focus_w, 2, 0, 0, H_gdk_window_set_accept_focus);
XG_DEFINE_PROCEDURE(gdk_window_get_group, gxg_gdk_window_get_group_w, 1, 0, 0, H_gdk_window_get_group);
XG_DEFINE_PROCEDURE(gtk_action_group_get_sensitive, gxg_gtk_action_group_get_sensitive_w, 1, 0, 0, H_gtk_action_group_get_sensitive);
XG_DEFINE_PROCEDURE(gtk_action_group_set_sensitive, gxg_gtk_action_group_set_sensitive_w, 2, 0, 0, H_gtk_action_group_set_sensitive);
@@ -45572,7 +46258,6 @@ static void define_functions(void)
XG_DEFINE_PROCEDURE(gtk_cell_view_get_displayed_row, gxg_gtk_cell_view_get_displayed_row_w, 1, 0, 0, H_gtk_cell_view_get_displayed_row);
XG_DEFINE_PROCEDURE(gtk_cell_view_get_size_of_row, gxg_gtk_cell_view_get_size_of_row_w, 3, 0, 0, H_gtk_cell_view_get_size_of_row);
XG_DEFINE_PROCEDURE(gtk_cell_view_set_background_color, gxg_gtk_cell_view_set_background_color_w, 2, 0, 0, H_gtk_cell_view_set_background_color);
- XG_DEFINE_PROCEDURE(gdk_window_set_focus_on_map, gxg_gdk_window_set_focus_on_map_w, 2, 0, 0, H_gdk_window_set_focus_on_map);
XG_DEFINE_PROCEDURE(gdk_window_enable_synchronized_configure, gxg_gdk_window_enable_synchronized_configure_w, 1, 0, 0, H_gdk_window_enable_synchronized_configure);
XG_DEFINE_PROCEDURE(gdk_window_configure_finished, gxg_gdk_window_configure_finished_w, 1, 0, 0, H_gdk_window_configure_finished);
XG_DEFINE_PROCEDURE(gtk_combo_box_get_wrap_width, gxg_gtk_combo_box_get_wrap_width_w, 1, 0, 0, H_gtk_combo_box_get_wrap_width);
@@ -46576,6 +47261,71 @@ static void define_functions(void)
XG_DEFINE_PROCEDURE(gtk_widget_get_mapped, gxg_gtk_widget_get_mapped_w, 1, 0, 0, H_gtk_widget_get_mapped);
#endif
+#if HAVE_GTK_SCALE_NEW
+ XG_DEFINE_PROCEDURE(gdk_keymap_add_virtual_modifiers, gxg_gdk_keymap_add_virtual_modifiers_w, 2, 0, 0, H_gdk_keymap_add_virtual_modifiers);
+ XG_DEFINE_PROCEDURE(gtk_widget_get_requisition, gxg_gtk_widget_get_requisition_w, 2, 0, 0, H_gtk_widget_get_requisition);
+ XG_DEFINE_PROCEDURE(gdk_window_coords_to_parent, gxg_gdk_window_coords_to_parent_w, 3, 2, 0, H_gdk_window_coords_to_parent);
+ XG_DEFINE_PROCEDURE(gdk_window_coords_from_parent, gxg_gdk_window_coords_from_parent_w, 3, 2, 0, H_gdk_window_coords_from_parent);
+ XG_DEFINE_PROCEDURE(gdk_window_get_effective_parent, gxg_gdk_window_get_effective_parent_w, 1, 0, 0, H_gdk_window_get_effective_parent);
+ XG_DEFINE_PROCEDURE(gdk_window_get_effective_toplevel, gxg_gdk_window_get_effective_toplevel_w, 1, 0, 0, H_gdk_window_get_effective_toplevel);
+ XG_DEFINE_PROCEDURE(gtk_accessible_get_widget, gxg_gtk_accessible_get_widget_w, 1, 0, 0, H_gtk_accessible_get_widget);
+ XG_DEFINE_PROCEDURE(gtk_text_view_get_hadjustment, gxg_gtk_text_view_get_hadjustment_w, 1, 0, 0, H_gtk_text_view_get_hadjustment);
+ XG_DEFINE_PROCEDURE(gtk_text_view_get_vadjustment, gxg_gtk_text_view_get_vadjustment_w, 1, 0, 0, H_gtk_text_view_get_vadjustment);
+ XG_DEFINE_PROCEDURE(gtk_widget_send_focus_change, gxg_gtk_widget_send_focus_change_w, 2, 0, 0, H_gtk_widget_send_focus_change);
+ XG_DEFINE_PROCEDURE(gdk_display_get_device_state, gxg_gdk_display_get_device_state_w, 2, 4, 0, H_gdk_display_get_device_state);
+ XG_DEFINE_PROCEDURE(gdk_display_get_window_at_device_position, gxg_gdk_display_get_window_at_device_position_w, 2, 2, 0, H_gdk_display_get_window_at_device_position);
+ XG_DEFINE_PROCEDURE(gdk_display_warp_device, gxg_gdk_display_warp_device_w, 5, 0, 0, H_gdk_display_warp_device);
+ XG_DEFINE_PROCEDURE(gdk_display_get_device_manager, gxg_gdk_display_get_device_manager_w, 1, 0, 0, H_gdk_display_get_device_manager);
+ XG_DEFINE_PROCEDURE(gdk_drag_context_set_device, gxg_gdk_drag_context_set_device_w, 2, 0, 0, H_gdk_drag_context_set_device);
+ XG_DEFINE_PROCEDURE(gdk_drag_context_get_device, gxg_gdk_drag_context_get_device_w, 1, 0, 0, H_gdk_drag_context_get_device);
+ XG_DEFINE_PROCEDURE(gdk_drag_context_list_targets, gxg_gdk_drag_context_list_targets_w, 1, 0, 0, H_gdk_drag_context_list_targets);
+ XG_DEFINE_PROCEDURE(gdk_event_set_device, gxg_gdk_event_set_device_w, 2, 0, 0, H_gdk_event_set_device);
+ XG_DEFINE_PROCEDURE(gdk_event_get_device, gxg_gdk_event_get_device_w, 1, 0, 0, H_gdk_event_get_device);
+ XG_DEFINE_PROCEDURE(gdk_events_get_distance, gxg_gdk_events_get_distance_w, 2, 1, 0, H_gdk_events_get_distance);
+ XG_DEFINE_PROCEDURE(gdk_events_get_angle, gxg_gdk_events_get_angle_w, 2, 1, 0, H_gdk_events_get_angle);
+ XG_DEFINE_PROCEDURE(gdk_events_get_center, gxg_gdk_events_get_center_w, 2, 2, 0, H_gdk_events_get_center);
+ XG_DEFINE_PROCEDURE(gdk_image_get_visual, gxg_gdk_image_get_visual_w, 1, 0, 0, H_gdk_image_get_visual);
+ XG_DEFINE_PROCEDURE(gdk_image_get_byte_order, gxg_gdk_image_get_byte_order_w, 1, 0, 0, H_gdk_image_get_byte_order);
+ XG_DEFINE_PROCEDURE(gdk_image_get_width, gxg_gdk_image_get_width_w, 1, 0, 0, H_gdk_image_get_width);
+ XG_DEFINE_PROCEDURE(gdk_image_get_height, gxg_gdk_image_get_height_w, 1, 0, 0, H_gdk_image_get_height);
+ XG_DEFINE_PROCEDURE(gdk_image_get_depth, gxg_gdk_image_get_depth_w, 1, 0, 0, H_gdk_image_get_depth);
+ XG_DEFINE_PROCEDURE(gdk_image_get_bytes_per_pixel, gxg_gdk_image_get_bytes_per_pixel_w, 1, 0, 0, H_gdk_image_get_bytes_per_pixel);
+ XG_DEFINE_PROCEDURE(gdk_image_get_bytes_per_line, gxg_gdk_image_get_bytes_per_line_w, 1, 0, 0, H_gdk_image_get_bytes_per_line);
+ XG_DEFINE_PROCEDURE(gdk_image_get_bits_per_pixel, gxg_gdk_image_get_bits_per_pixel_w, 1, 0, 0, H_gdk_image_get_bits_per_pixel);
+ XG_DEFINE_PROCEDURE(gdk_window_get_accept_focus, gxg_gdk_window_get_accept_focus_w, 1, 0, 0, H_gdk_window_get_accept_focus);
+ XG_DEFINE_PROCEDURE(gdk_window_get_focus_on_map, gxg_gdk_window_get_focus_on_map_w, 1, 0, 0, H_gdk_window_get_focus_on_map);
+ XG_DEFINE_PROCEDURE(gdk_window_get_composited, gxg_gdk_window_get_composited_w, 1, 0, 0, H_gdk_window_get_composited);
+ XG_DEFINE_PROCEDURE(gdk_window_is_input_only, gxg_gdk_window_is_input_only_w, 1, 0, 0, H_gdk_window_is_input_only);
+ XG_DEFINE_PROCEDURE(gdk_window_is_shaped, gxg_gdk_window_is_shaped_w, 1, 0, 0, H_gdk_window_is_shaped);
+ XG_DEFINE_PROCEDURE(gdk_window_get_modal_hint, gxg_gdk_window_get_modal_hint_w, 1, 0, 0, H_gdk_window_get_modal_hint);
+ XG_DEFINE_PROCEDURE(gdk_window_get_background, gxg_gdk_window_get_background_w, 2, 0, 0, H_gdk_window_get_background);
+ XG_DEFINE_PROCEDURE(gdk_window_get_back_pixmap, gxg_gdk_window_get_back_pixmap_w, 1, 2, 0, H_gdk_window_get_back_pixmap);
+ XG_DEFINE_PROCEDURE(gdk_window_set_device_cursor, gxg_gdk_window_set_device_cursor_w, 3, 0, 0, H_gdk_window_set_device_cursor);
+ XG_DEFINE_PROCEDURE(gdk_window_get_device_cursor, gxg_gdk_window_get_device_cursor_w, 2, 0, 0, H_gdk_window_get_device_cursor);
+ XG_DEFINE_PROCEDURE(gdk_window_get_device_position, gxg_gdk_window_get_device_position_w, 2, 3, 0, H_gdk_window_get_device_position);
+ XG_DEFINE_PROCEDURE(gdk_window_set_device_events, gxg_gdk_window_set_device_events_w, 3, 0, 0, H_gdk_window_set_device_events);
+ XG_DEFINE_PROCEDURE(gdk_window_get_device_events, gxg_gdk_window_get_device_events_w, 2, 0, 0, H_gdk_window_get_device_events);
+ XG_DEFINE_PROCEDURE(gtk_combo_box_popup_for_device, gxg_gtk_combo_box_popup_for_device_w, 2, 0, 0, H_gtk_combo_box_popup_for_device);
+ XG_DEFINE_PROCEDURE(gtk_device_grab_add, gxg_gtk_device_grab_add_w, 3, 0, 0, H_gtk_device_grab_add);
+ XG_DEFINE_PROCEDURE(gtk_device_grab_remove, gxg_gtk_device_grab_remove_w, 2, 0, 0, H_gtk_device_grab_remove);
+ XG_DEFINE_PROCEDURE(gtk_get_current_event_device, gxg_gtk_get_current_event_device_w, 0, 0, 0, H_gtk_get_current_event_device);
+ XG_DEFINE_PROCEDURE(gtk_menu_popup_for_device, gxg_gtk_menu_popup_for_device_w, 7, 1, 0, H_gtk_menu_popup_for_device);
+ XG_DEFINE_PROCEDURE(gtk_paned_new, gxg_gtk_paned_new_w, 1, 0, 0, H_gtk_paned_new);
+ XG_DEFINE_PROCEDURE(gtk_radio_action_join_group, gxg_gtk_radio_action_join_group_w, 2, 0, 0, H_gtk_radio_action_join_group);
+ XG_DEFINE_PROCEDURE(gtk_ruler_new, gxg_gtk_ruler_new_w, 1, 0, 0, H_gtk_ruler_new);
+ XG_DEFINE_PROCEDURE(gtk_scale_new, gxg_gtk_scale_new_w, 2, 0, 0, H_gtk_scale_new);
+ XG_DEFINE_PROCEDURE(gtk_scale_new_with_range, gxg_gtk_scale_new_with_range_w, 4, 0, 0, H_gtk_scale_new_with_range);
+ XG_DEFINE_PROCEDURE(gtk_scrollbar_new, gxg_gtk_scrollbar_new_w, 2, 0, 0, H_gtk_scrollbar_new);
+ XG_DEFINE_PROCEDURE(gtk_separator_new, gxg_gtk_separator_new_w, 1, 0, 0, H_gtk_separator_new);
+ XG_DEFINE_PROCEDURE(gtk_widget_device_is_shadowed, gxg_gtk_widget_device_is_shadowed_w, 2, 0, 0, H_gtk_widget_device_is_shadowed);
+ XG_DEFINE_PROCEDURE(gtk_widget_set_device_events, gxg_gtk_widget_set_device_events_w, 3, 0, 0, H_gtk_widget_set_device_events);
+ XG_DEFINE_PROCEDURE(gtk_widget_add_device_events, gxg_gtk_widget_add_device_events_w, 3, 0, 0, H_gtk_widget_add_device_events);
+ XG_DEFINE_PROCEDURE(gtk_widget_get_support_multidevice, gxg_gtk_widget_get_support_multidevice_w, 1, 0, 0, H_gtk_widget_get_support_multidevice);
+ XG_DEFINE_PROCEDURE(gtk_widget_set_support_multidevice, gxg_gtk_widget_set_support_multidevice_w, 2, 0, 0, H_gtk_widget_set_support_multidevice);
+ XG_DEFINE_PROCEDURE(gtk_widget_get_device_events, gxg_gtk_widget_get_device_events_w, 2, 0, 0, H_gtk_widget_get_device_events);
+ XG_DEFINE_PROCEDURE(gtk_window_group_get_current_device_grab, gxg_gtk_window_group_get_current_device_grab_w, 2, 0, 0, H_gtk_window_group_get_current_device_grab);
+#endif
+
#if HAVE_CAIRO_CREATE
XG_DEFINE_PROCEDURE(cairo_create, gxg_cairo_create_w, 1, 0, 0, H_cairo_create);
XG_DEFINE_PROCEDURE(cairo_version, gxg_cairo_version_w, 0, 0, 0, H_cairo_version);
@@ -48505,6 +49255,10 @@ static void define_integers(void)
DEFINE_INTEGER(GDK_WINDOW_OFFSCREEN);
#endif
+#if HAVE_GTK_SCALE_NEW
+ DEFINE_INTEGER(GTK_MULTIDEVICE);
+#endif
+
#if HAVE_CAIRO_CREATE
DEFINE_INTEGER(CAIRO_STATUS_SUCCESS);
DEFINE_INTEGER(CAIRO_STATUS_NO_MEMORY);
@@ -49124,7 +49878,7 @@ void Init_libxg(void)
define_atoms();
define_strings();
XEN_YES_WE_HAVE("xg");
- XEN_DEFINE("xg-version", C_TO_XEN_STRING("10-Feb-10"));
+ XEN_DEFINE("xg-version", C_TO_XEN_STRING("30-May-10"));
xg_already_inited = true;
#if HAVE_SCHEME
/* these are macros in glib/gobject/gsignal.h, but we want the types handled in some convenient way in the extension language */
diff --git a/xm-enved.scm b/xm-enved.scm
index 6a56cb2..06dce2e 100644
--- a/xm-enved.scm
+++ b/xm-enved.scm
@@ -339,20 +339,18 @@
px0
(min px1
(max px0
- (inexact->exact
- (floor (+ px0 (* (- px1 px0)
- (/ (- x ix0)
- (- ix1 ix0))))))))))
+ (floor (+ px0 (* (- px1 px0)
+ (/ (- x ix0)
+ (- ix1 ix0)))))))))
(define (xe-grfy drawer y)
(if (= py0 py1)
py0
(min py0 ; grows downward so y1 < y0
(max py1
- (inexact->exact
- (floor (+ py1 (* (- py0 py1)
- (/ (- y iy1)
- (- iy0 iy1))))))))))
+ (floor (+ py1 (* (- py0 py1)
+ (/ (- y iy1)
+ (- iy0 iy1)))))))))
(if (> py0 py1)
(begin