Commit 5a088b89 authored by IOhannes m zmölnig's avatar IOhannes m zmölnig

New upstream version 17.5

parent e5686186
Snd change log
16-Jun: Snd 17.5.
6-May: Snd 17.4. New clm optimizer.
28-Mar: Snd 17.3.
22-Feb: Snd 17.2.
16-Jan: Snd 17.1.
2017 ----------------------------------------------------------------
......
Snd 17.1:
Snd 17.5:
*rootlet-redefinition-hook*
{apply_values} -> apply-values, {list} -> list-values, {append} -> append
a case clause without a result returns the selector
(*s7* 'autoloading) to turn the autoloader on and off
sandbox in stuff.scm for protected evaluation
s7: s7_history and s7_add_to_history (Kjetil's suggestion).
(*s7* 'history) for non-error scheme-side access to the history info
lambda* keyword argument handling changed slightly.
multithread sanity-checks thanks to Kjetil.
Kjetil also ported s7 to mingw.
in clm: clm.asd updated by Tito Latini.
checked: gsl 2.2.1, gtk 3.89.2, sbcl 1.13.3, FreeBSD 11.0
Thanks!: Tito Latini, Kjetil Matheussen, Juan Cerillo, Mike Scholz.
checked: gtk 3.91.0, sbcl 1.3.18, FC 26 (gcc 7.1.1)
Thanks!: Kjetil Matheussen, Rick Taube
......@@ -30,8 +30,9 @@ The configure script has a bunch of arguments:
mv ruby.pc /usr/local/lib/pkgconfig/ruby.pc
You may also have to set PKG_CONFIG_PATH:
PKG_CONFIG_PATH=.:/opt/X11/lib/pkgconfig/ ./configure --with-gtk --with-ruby --with-portaudio
(Debian: ruby-dev)
--with-forth use Forth (Mike Scholz's FTH) as the extension language.
--with-forth use Forth (Mike Scholz's FTH) as the extension language. (libfth or fth at sourceforge)
--without-extension-language build Snd without any extension language
......@@ -45,17 +46,17 @@ The configure script has a bunch of arguments:
in *BSD, pkg install open-motif, or perhaps use pkgin?
in Debian, apt-get install libmotif4, libmotif-dev, libxt-dev, libxpm-dev
--with-gtk use Gtk+
--with-gtk use Gtk+ (Debian package libgtk-3-dev).
--with-gui make Snd with graphics support (actually intended for use as --without-gui)
--with-gl include support for OpenGL (default: no, Motif only)
--with-gl include support for OpenGL (default: no, Motif only) (debian: libgl-dev libglu-dev)
--with-gl2ps include gl2ps (postscript output from OpenGL graphics)
Audio:
--with-alsa use ALSA if possible (the default in Linux)
--with-alsa use ALSA if possible (the default in Linux) (Debian: libasound2-dev)
--with-oss use OSS (not tested in a long time)
......@@ -70,8 +71,10 @@ The configure script has a bunch of arguments:
Other options:
--with-gmp use gmp, mpfr, and mpc to implement multiprecision arithmetic
(Debian: libgmp-dev libmpfr-dev libmpc-dev)
--with-ladspa include LADSPA plugin support (default: yes in Linux)
(get ladaps.h and put it in /usr/local/include or some such directory)
--with-temp-dir directory to use for temp files (default: ".")
--with-save-dir directory to use for saved-state files (default: ".")
......@@ -383,6 +386,10 @@ tab on /Applications, adapt the Path by adding Object and typing /usr/local/bin/
Create your shortcut in XQuartz so it will start immediately by typing Command-s
Later this update:
./configure CFLAGS="-arch x86_64 -I/opt/X11/include" LDFLAGS="-L/opt/X11/lib -lmx -bind_at_load" --with-motif
---- old, possibly out-of-date instructions
You can use either Motif or Gtk running under X11; to start Snd from an
......@@ -606,10 +613,10 @@ There is also a port in /usr/ports/audio/snd with version 13.0 from August
-------- Debian --------
The last time I installed Debian (via netinstall) I installed the following
The last time I installed Debian (25-Jan-17) I installed the following
Snd-related packages by hand:
libgmp-dev fftw-dev libgtk-3-dev libmpfr-dev libmpc-dev
libgsl0-dev libasound2-dev libgl1-mesa-dev
libfftw3-3 libgsl2 libgtk-3-dev libmotif-dev libxpm-dev libxt-dev libmpfr-dev libmpc-dev
libgsl-dev libfftw3-dev libgl-dev libglu-dev libutf8proc-dev libjack-dev ruby-dev libasound2-dev
and for Fedora Core 22:
......
......@@ -21,6 +21,29 @@
#define is_power_of_2(x) ((((x) - 1) & (x)) == 0)
#if 0
#define clear_floats(Arr, Len) memset((void *)(Arr), 0, (Len) * sizeof(mus_float_t))
#define copy_floats(Dst, Src, Len) memcpy((void *)(Dst), (void *)(Src), (Len) * sizeof(mus_float_t))
#else
#define clear_floats(Arr, Len) \
do { \
mus_long_t K; \
mus_float_t *dst; \
dst = Arr; \
for (K = Len; K > 0; K--) \
*dst++ = 0.0; \
} while (0)
#define copy_floats(Dst, Src, Len) \
do { \
mus_long_t K; \
mus_float_t *dst, *src; \
dst = Dst; \
src = Src; \
for (K = Len; K > 0; K--) \
*dst++ = *src++; \
} while (0)
#endif
#define MUS_MAX_MALLOC_DEFAULT (1 << 26)
#define MUS_MAX_TABLE_SIZE_DEFAULT (1024 * 1024 * 20) /* delay line allocation etc */
......@@ -86,6 +109,7 @@
#define MUS_JACK_API 2
#define G7XX 0
#define MUS_MAX_CHANS 256
#include "sndlib.h"
#include "xen.h"
......
......@@ -376,9 +376,10 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
((= i n))
(do ((step (/ (- xmax xmin) (- n 1.0)))
(j 0 (+ j 1))
(s xmin (+ s step)))
(s xmin))
((= j (- n 1)))
(float-vector-set! x j s))
(float-vector-set! x j s)
(set! s (+ s step)))
(set! (x (- n 1)) xmax)
(do ((j 0 (+ j 1)))
((= j n))
......
......@@ -688,7 +688,7 @@
(do ((k 0 (+ k 1)))
((= k pulse-out))
(set! (rk k) (rk!cos gen1 (env pulse-frqf))))
(float-vector-set! rk k (rk!cos gen1 (env pulse-frqf))))
(do ((k i (+ k 1)))
((= k reset-stop))
......@@ -1347,7 +1347,7 @@
(outa n (* pulse-amp
(env pulse-ampf)
(+ (* (env low-ampf)
(polywave gp (ina k saved-frq)))
(polywave gp (float-vector-ref saved-frq k)))
(polywave gen1 (env frqf))))))
(mus-reset pulse-ampf)
(set! (mus-location ampf) (- i attack-stop))
......
......@@ -27,7 +27,7 @@
(with-let *motif*
(set! *clm-srate* 22050)
;(set! *clm-srate* 22050)
(define *clm-sample-type* mus-lfloat)
(define *clm-rt-bufsize* 1024)
......
This diff is collapsed.
......@@ -312,7 +312,7 @@
(float-vector->channel data)
(let ((dc (goertzel 0.0))
(sig (goertzel 35.0)))
(let ((dcflt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))))
(let ((dcflt (make-filter 2 #r(1 -1) #r(0 -0.99))))
(map-channel (lambda (y) (filter dcflt y)))
(let ((ndc (goertzel 0.0))
(nsig (goertzel 35.0)))
......@@ -410,7 +410,7 @@
;; look for DC
(let ((dc (check-freq 0.0 snd chn)))
(if (> dc 30.0)
(let ((dcflt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))))
(let ((dcflt (make-filter 2 #r(1 -1) #r(0 -0.99))))
(map-channel (lambda (y) (filter dcflt y)) 0 (framples snd chn) snd chn)
(format () "~%; block DC: ~A -> ~A" dc (check-freq 0.0 snd chn)))))
......
......@@ -682,18 +682,18 @@ is a physical model of a flute:
(definstrument (fm-drum start-time duration frequency amplitude index
high (degree 0.0) (distance 1.0) (reverb-amount 0.01))
(let (;; many of the following variables were originally passed as arguments
(casrat (if high 8.525 3.515))
(fmrat (if high 3.414 1.414))
(glsfun '(0 0 25 0 75 1 100 1))
(indxfun '(0 0 5 .014 10 .033 15 .061 20 .099
25 .153 30 .228 35 .332 40 .477
45 .681 50 .964 55 .681 60 .478 65 .332
70 .228 75 .153 80 .099 85 .061
90 .033 95 .0141 100 0))
(indxpt (- 100 (* 100 (/ (- duration .1) duration))))
(ampfun '(0 0 3 .05 5 .2 7 .8 8 .95 10 1.0 12 .95 20 .3 30 .1 100 0))
(atdrpt (* 100 (/ (if high .01 .015) duration))))
(let ((divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt)))
(let ((divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt))
(ampfun '(0 0 3 .05 5 .2 7 .8 8 .95 10 1.0 12 .95 20 .3 30 .1 100 0))
(casrat (if high 8.525 3.515))
(fmrat (if high 3.414 1.414))
(glsfun '(0 0 25 0 75 1 100 1)))
(let ((beg (seconds->samples start-time))
(end (seconds->samples (+ start-time duration)))
(glsf (make-env glsfun :scaler (if high (hz->radians 66) 0.0) :duration duration))
......@@ -795,6 +795,7 @@ is a physical model of a flute:
(outa i (* scale x))))))
;;; -------- PQW
(definstrument (pqw start dur spacing-freq carrier-freq amplitude ampfun indexfun partials
(degree 0.0)
......@@ -1348,7 +1349,7 @@ is a physical model of a flute:
(definstrument (lbj-piano begin-time duration frequency amplitude pfreq
(degree 45) (reverb-amount 0) (distance 1))
(define (get-piano-partials freq)
(define get-piano-partials
(let ((piano-spectra #((1.97 .0326 2.99 .0086 3.95 .0163 4.97 .0178 5.98 .0177 6.95 .0315 8.02 .0001
8.94 .0076 9.96 .0134 10.99 .0284 11.98 .0229 13.02 .0229 13.89 .0010 15.06 .0090 16.00 .0003
17.08 .0078 18.16 .0064 19.18 .0129 20.21 .0085 21.27 .0225 22.32 .0061 23.41 .0102 24.48 .0005
......@@ -1750,9 +1751,9 @@ is a physical model of a flute:
(1.00 .0080 2.00 .0005 3.19 .0001)
(1.01 .0298 2.01 .0005)))
(pitch (round (* 12 (log (/ freq 32.703) 2)))))
(piano-spectra pitch)))
(1.01 .0298 2.01 .0005))))
(lambda (freq)
(piano-spectra (round (* 12 (log (/ freq 32.703) 2)))))))
(let ((*piano-attack-duration* .04)
(*piano-release-duration* .2))
......
This diff is collapsed.
This diff is collapsed.
......@@ -218,8 +218,8 @@
(macros ()) ; these are protected by #ifdef ... #endif
(inits ()) ; C code (a string in s7) inserted in the library initialization function
(p #f)
(if-funcs ()) ; if-functions (guaranteed to return int, so we can optimize away make-integer etc)
(rf-funcs ()) ; rf-functions
(int-funcs ()) ; functions guaranteed to return int
(double-funcs ()) ; functions returning double
(sig-symbols (list (cons 'integer? 0) (cons 'boolean? 0) (cons 'real? 0) (cons 'float? 0)
(cons 'char? 0) (cons 'string? 0) (cons 'c-pointer? 0) (cons 't 0)))
(signatures (make-hash-table)))
......@@ -363,44 +363,58 @@
(format p "}~%"))
;; add optimizer connection
(when (and (eq? return-type 'double) ; double (f double) -- s7_rf_t: double f(s7, s7_pointer **p)
(eq? (car arg-types) 'double)
(or (= num-args 1)
(and (= num-args 2) ; double (f double double)
(eq? (cadr arg-types) 'double))))
(set! rf-funcs (cons (cons func-name scheme-name) rf-funcs))
(format p (if (= num-args 1)
"static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~
{s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
"static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~% ~
{s7_rf_t f; s7_double x, y; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); return(~A(x, y));}~%")
func-name func-name)
(format p "static s7_rf_t ~A_rf(s7_scheme *sc, s7_pointer expr) ~
{if (s7_arg_to_rf(sc, s7_cadr(expr))) return(~A_rf_r); return(NULL);}~%"
func-name func-name))
(define (sig-every? f sequence)
(do ((arg sequence (cdr arg)))
((not (and (pair? arg)
(f (car arg))))
(null? arg))))
(when (and (eq? return-type 'double)
(< num-args 5)
(sig-every? (lambda (p) (eq? p 'double)) arg-types))
(let ((local-name #f))
(case num-args
((0)
(set! local-name "_d")
(format p "static s7_double ~A~A(void) {return(~A());}~%" func-name local-name func-name))
((1)
(set! local-name "_d_d")
(format p "static s7_double ~A~A(s7_double x) {return(~A(x));}~%" func-name local-name func-name))
((2)
(set! local-name "_d_dd")
(format p "static s7_double ~A~A(s7_double x1, s7_double x2) {return(~A(x1, x2));}~%" func-name local-name func-name))
((3)
(set! local-name "_d_ddd")
(format p "static s7_double ~A~A(s7_double x1, s7_double x2, s7_double x3) {return(~A(x1, x2, x3));}~%" func-name local-name func-name))
((4)
(set! local-name "_d_dddd")
(format p "static s7_double ~A~A(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(~A(x1, x2, x3, x4));}~%" func-name local-name func-name)))
(set! double-funcs (cons (list func-name scheme-name local-name) double-funcs))))
(when (and (eq? return-type 'int) ; int (f int|double|void)
(memq (car arg-types) '(int double void))
(<= num-args 1))
(set! if-funcs (cons (cons func-name scheme-name) if-funcs))
(case (car arg-types)
((double)
(format p "static s7_int ~A_if_r(s7_scheme *sc, s7_pointer **p)~
{s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
func-name func-name)
(format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
{if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_r); return(NULL);}~%"
func-name func-name))
((int)
(format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p)~
{s7_if_t f; s7_int x; f = (s7_if_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
func-name (if (string=? func-name "abs") "llabs" func-name))
(format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
{if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_i); return(NULL);}~%"
func-name func-name))
((void)
(format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p) {return(~A());}~%" func-name func-name)
(format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) {return(~A_if_i);}~%" func-name func-name))))
(or ;(= num-args 0)
(and (= num-args 1)
(memq (car arg-types) '(int double)))
(and (= num-args 2)
(eq? (car arg-types) 'int)
(eq? (cadr arg-types) 'int))))
(let ((local-name #f))
(case (car arg-types)
((void)
(set! local-name "_i")
(format p "static s7_int ~A~A(void) {return(~A());}~%" func-name local-name func-name))
((double)
(set! local-name "_i_d")
(format p "static s7_int ~A~A(s7_double x) {return(~A(x));}~%" func-name local-name func-name))
((int)
(if (= num-args 1)
(begin
(set! local-name "_i_i")
(format p "static s7_int ~A~A(s7_int i1) {return(~A(i1));}~%" func-name local-name (if (string=? func-name "abs") "llabs" func-name)))
(begin
(set! local-name "_i_ii")
(format p "static s7_int ~A~A(s7_int i1, s7_int i2) {return(~A(i1, i2));}~%" func-name local-name func-name)))))
(set! int-funcs (cons (list func-name scheme-name local-name) int-funcs))))
(format p "~%")
(set! functions (cons (list scheme-name base-name
......@@ -518,19 +532,19 @@
functions)
;; optimizer connection
(when (pair? rf-funcs)
(format p "~% /* rf optimizer connections */~%")
(when (pair? double-funcs)
(format p "~% /* double optimizer connections */~%")
(for-each
(lambda (f)
(format p " s7_rf_set_function(s7_name_to_value(sc, ~S), ~A_rf);~%" (cdr f) (car f)))
rf-funcs))
(format p " s7_set~A_function(s7_name_to_value(sc, ~S), ~A~A);~%" (caddr f) (cadr f) (car f) (caddr f)))
double-funcs))
(when (pair? if-funcs)
(format p "~% /* if optimizer connections */~%")
(when (pair? int-funcs)
(format p "~% /* int optimizer connections */~%")
(for-each
(lambda (f)
(format p " s7_if_set_function(s7_name_to_value(sc, ~S), ~A_if);~%" (cdr f) (car f)))
if-funcs))
(format p " s7_set~A_function(s7_name_to_value(sc, ~S), ~A~A);~%" (caddr f) (cadr f) (car f) (caddr f)))
int-funcs))
(format p "}~%")
(close-output-port p)
......
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for snd 17.1.
# Generated by GNU Autoconf 2.69 for snd 17.5.
#
# Report bugs to <bil@ccrma.stanford.edu>.
#
......@@ -580,8 +580,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='snd'
PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-17.tar.gz'
PACKAGE_VERSION='17.1'
PACKAGE_STRING='snd 17.1'
PACKAGE_VERSION='17.5'
PACKAGE_STRING='snd 17.5'
PACKAGE_BUGREPORT='bil@ccrma.stanford.edu'
PACKAGE_URL=''
......@@ -711,6 +711,7 @@ infodir
docdir
oldincludedir
includedir
runstatedir
localstatedir
sharedstatedir
sysconfdir
......@@ -808,6 +809,7 @@ datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
runstatedir='${localstatedir}/run'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
......@@ -1060,6 +1062,15 @@ do
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
-runstatedir | --runstatedir | --runstatedi | --runstated \
| --runstate | --runstat | --runsta | --runst | --runs \
| --run | --ru | --r)
ac_prev=runstatedir ;;
-runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
| --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
| --run=* | --ru=* | --r=*)
runstatedir=$ac_optarg ;;
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
......@@ -1197,7 +1208,7 @@ fi
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
libdir localedir mandir
libdir localedir mandir runstatedir
do
eval ac_val=\$$ac_var
# Remove trailing slashes.
......@@ -1310,7 +1321,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 17.1 to adapt to many kinds of systems.
\`configure' configures snd 17.5 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
......@@ -1350,6 +1361,7 @@ Fine tuning of the installation directories:
--sysconfdir=DIR read-only single-machine data [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
--localstatedir=DIR modifiable single-machine data [PREFIX/var]
--runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run]
--libdir=DIR object code libraries [EPREFIX/lib]
--includedir=DIR C header files [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc [/usr/include]
......@@ -1380,7 +1392,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
short | recursive ) echo "Configuration of snd 17.1:";;
short | recursive ) echo "Configuration of snd 17.5:";;
esac
cat <<\_ACEOF
......@@ -1496,7 +1508,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
snd configure 17.1
snd configure 17.5
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
......@@ -1957,7 +1969,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 17.1, which was
It was created by snd $as_me 17.5, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
......@@ -3304,7 +3316,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
VERSION=17.1
VERSION=17.5
#--------------------------------------------------------------------------------
# configuration options
......@@ -5185,7 +5197,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-2.2 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
XEN_CFLAGS="`$PKG_CONFIG ruby-2.2 --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-2.2 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-2.2 --libs`"
LOCAL_LANGUAGE="Ruby"
......@@ -5197,7 +5209,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-2.1 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
XEN_CFLAGS="`$PKG_CONFIG ruby-2.1 --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-2.1 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-2.1 --libs`"
LOCAL_LANGUAGE="Ruby"
......@@ -5209,7 +5221,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-2.0 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
XEN_CFLAGS="`$PKG_CONFIG ruby-2.0 --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-2.0 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-2.0 --libs`"
LOCAL_LANGUAGE="Ruby"
......@@ -5221,7 +5233,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
XEN_CFLAGS="`$PKG_CONFIG ruby --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby --libs`"
LOCAL_LANGUAGE="Ruby"
......@@ -5233,7 +5245,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-1.9.3 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
XEN_CFLAGS="`$PKG_CONFIG ruby-1.9.3 --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-1.9.3 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-1.9.3 --libs`"
LOCAL_LANGUAGE="Ruby"
......@@ -5245,7 +5257,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-1.9 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
XEN_CFLAGS="`$PKG_CONFIG ruby-1.9 --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-1.9 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-1.9 --libs`"
LOCAL_LANGUAGE="Ruby"
......@@ -5257,7 +5269,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-1.8 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
XEN_CFLAGS="`$PKG_CONFIG ruby-1.8 --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-1.8 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-1.8 --libs`"
LOCAL_LANGUAGE="Ruby"
......@@ -6691,7 +6703,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 17.1, which was
This file was extended by snd $as_me 17.5, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
......@@ -6753,7 +6765,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 17.1
snd config.status 17.5
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
......
......@@ -5,7 +5,7 @@
# gmp, mpfr, and mpc deliberately have none!
AC_INIT(snd, 17.1, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-17.tar.gz)
AC_INIT(snd, 17.5, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-17.tar.gz)
AC_CONFIG_SRCDIR(snd.c)
AC_CANONICAL_HOST # needed by case $host below
......@@ -24,7 +24,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
VERSION=17.1
VERSION=17.5
#--------------------------------------------------------------------------------
# configuration options
......@@ -378,7 +378,7 @@ if test "$with_ruby" = yes ; then
if test "$ac_snd_extension_language" = none ; then
if $PKG_CONFIG ruby_version --exists ; then
AC_DEFINE(HAVE_RUBY)
XEN_CFLAGS="`$PKG_CONFIG ruby_version --cflags`"
XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby_version --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby_version --libs`"
LOCAL_LANGUAGE="Ruby"
......
This diff is collapsed.
......@@ -79,11 +79,12 @@
(do ((den (/ 1.0 (cosh (* N (acosh alpha)))))
(freq (/ pi N))
(i 0 (+ i 1))
(phase 0.0 (+ phase freq)))
(phase 0.0))
((= i N))
(let ((val (* den (cos (* N (acos (* alpha (cos phase))))))))
(set! (rl i) (real-part val))
(set! (im i) (imag-part val))))) ;this is always essentially 0.0
(set! (im i) (imag-part val))) ;this is always essentially 0.0
(set! phase (+ phase freq))))
(fft rl im -1) ;direction could also be 1
(float-vector-scale! rl (/ 1.0 (float-vector-peak rl)))
(do ((i 0 (+ i 1))
......@@ -107,9 +108,10 @@
(freq (/ pi N))
(mult -1 (- mult))
(i 0 (+ i 1))
(phase (* -0.5 pi) (+ phase freq)))
(phase (* -0.5 pi)))
((= i N))
(set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))))
(set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))
(set! phase (+ phase freq))))
;; now take the DFT
(let ((pk 0.0)
(w (make-vector N)))
......@@ -1825,7 +1827,7 @@ and replaces it with the spectrum given in coeffs")
(pcoeffs (partials->polynomial coeffs))
(peaks (make-vector pairs))
(peaks2 (make-vector pairs))
(flt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.9)))
(flt (make-filter 2 #r(1 -1) #r(0 -0.9)))
(old-mx (maxamp))
(len (- (or dur (framples snd chn edpos)) beg)))
(let ((summer (make-float-vector len))
......
......@@ -47,7 +47,7 @@ end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"))
((<= x end)
(set! nenv (append nenv (list x y)))
(if (= x end) (return-early nenv)))
((> x end)
(else ;(> x end)
(return-early
(append nenv (list end (envelope-interp end e))))))))
(append nenv (list end lasty))))))))
......@@ -58,37 +58,35 @@ end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"))
(define map-envelopes
(let ((documentation "(map-envelopes func env1 env2) maps func over the breakpoints in env1 and env2 returning a new envelope"))
(lambda (op e1 e2)
(let ((xs ()))
(let ((at0
(lambda (e)
(let* ((diff (car e))
(len (length e))
(lastx (e (- len 2)))
(newe (copy e)))
(do ((i 0 (+ i 2)))
((>= i len) newe)
(let ((x (/ (- (newe i) diff) lastx)))
(set! xs (cons x xs))
(set! (newe i) x)))))))
(if (null? e1)
(at0 e2)
(if (null? e2)
(at0 e1)
(let ((ee1 (at0 e1))
(ee2 (at0 e2))
(newe ()))
(set! xs (sort!
(let rem-dup ((lst xs)
(nlst ()))
(cond ((null? lst) nlst)
((member (car lst) nlst) (rem-dup (cdr lst) nlst))
(else (rem-dup (cdr lst) (cons (car lst) nlst)))))
<))
(do ((len (length xs))
(i 0 (+ i 1)))
((= i len) newe)
(let ((x (xs i)))
(set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2)))))))))))))))
(let* ((xs ())
(at0 (lambda (e)
(let* ((diff (car e))
(len (length e))
(lastx (e (- len 2)))
(newe (copy e)))
(do ((i 0 (+ i 2)))