Commit 8b022ab6 authored by Alessio Treglia's avatar Alessio Treglia

Imported Upstream version 11.1

parent 5cd66eec
This diff is collapsed.
Snd change log
30-Nov: Snd 11.1.
23-Nov: colormaps are objects now. integer->colormap, colormap->integer.
transforms are also objects. integer->transform, transform->integer.
20-Nov: play is generic now, "old-play" is the previous form.
6-Nov: removed all support for gtkglext.
2-Nov: selection function/object. selection->mix.
28-Oct: pretty-print.scm.
22-Oct: Snd 11.0.
16-Oct: clm.rb and grani.rb (thanks to Mike Scholz).
12-Oct: generic length, srate, channels, frames, file-name, sync, maxamp.
7-Oct: removed run-safety; the run macro only works in s7.
......
Snd 10.9
Snd 11.1:
Kjetil improved the rt stuff.
added env.scm to sndlib (for jcvoi.scm).
optimization now defaults to 6.
show-backtrace removed.
many more ruby/forth improvements thanks to Mike.
s7: *error-info* for better error reporting.
vector-for-each, vector-map, string-for-each
generic map, for-each
*trace-hook* in s7. Also defmacro* and define-macro*. make-list.
added s7-slib-init.scm: slib support. It assumes getenv, file-exists?, and system
are provided elsewhere (this is the case if s7 is running in Snd or sndlib).
force and delay are now included in s7 only if WITH_FORCE is defined.
The slib implementation is used. The promise? function has been removed.
I used "make-promise" for "delay" in earlier versions of s7 to avoid
collisions with CLM.
added s7.html
s7: with-environment, true multiple-values, vectors can have > 2^31 elements (you'll
need a lot of memory). multiple-value-bind and multiple-value-set!.
removed the sbcl ppc undefined_alien_function stuff from cmus.c.
checked: gtk 2.17.7|8|9|10|11, guile 1.9.2|3, sbcl 1.0.31, gsl 1.13
removed all support for gtkglext and fftw2 (use fftw3).
in sbcl, something has changed in the double float array handling, so functions
like convolution can't be called from lisp. The instruments seem to be ok.
(The two use the same calling sequence so I'm a bit mystified).
play is generic, and uses optkey args (this is a non-compatible change).
"old-play" is the old version of play. play-channel, play-mix, play-region,
play-selection, and play-and-wait are deprecated.
Thanks!: Rick Taube, Ralf Mattes, Kjetil Matheussen, Mike Scholz
selection function/object; added selection choice to the generic funcs.
selection->mix.
The graphed selection bounds can be changed by dragging the mouse.
The mix dialog follows the (mix-)sync field, and has 2 new buttons!
copy and fill! for selection and sound, and copy for mix and mark.
moved with-mix from ws.scm to snd11.scm.
moved save-mix from mix.scm into C.
added check-mix-tags to mix.scm.
added snd-forth-docs.fs (incorporated in sndclm.html), thanks to Mike.
colormaps are objects now, not ints; added the predefined colormaps
as built-in objects (hot-colormap, etc), and integer->colormap,
colormap->integer. Each colormap function now takes a colormap object
as the first argument, not an integer.
transforms are objects also; fourier-transform etc; integer->transform and
transform->integer. add-transform returns such an object, delete-transform
and transform-type take one.
removed tools/snd-index.cl.
checked: sbcl 1.0.32, gtk 2.19.0, acl 8.2, mpc 0.8, guile 1.9.5, fth 1.2.8
Thanks!: Geoff Lee, Mike Scholz, Rick Taube, Alan Grover, Kjetil Matheussen.
......@@ -44,7 +44,7 @@ The configure script has a bunch of arguments:
--with-no-gui make Snd without any graphics support
--with-gl include support for OpenGL (default: no)
--with-gl include support for OpenGL (default: no, Motif only)
--with-just-gl same but omit extension language bindings in gl.c (default: no)
The gl module is only useful if you want to write
code to add your own OpenGL graphics to Snd.
......@@ -147,7 +147,6 @@ Version info:
if Forth, any version
if S7, any version
if GSL, version 0.8 or later
if gtkglext, version 1.0 or later
if gamin, version 0.1.0 or later
if Cairo and the xg module, version 1.2.6 or later
......@@ -336,7 +335,6 @@ Motif:
Gtk+:
http://www.gtk.org
ftp://ftp.gtk.org/pub/gtk/
http://sourceforge.net/projects/gtkglext/
OpenGL:
http://www.mesa3d.org/
......@@ -498,7 +496,7 @@ If you get some complaint like
try setting:
(set! mus-alsa-device "plughw:0")
(set! (mus-alsa-device) "plughw:0")
then try playing again. The "default" device is always completely
broken.
......@@ -522,35 +520,21 @@ the lang.csh file in /etc/profile.d).
---- Motif: ----
Only Motif 2.n is supported.
Only Motif 2.n is supported. Be sure to get the Motif development
package if you want to build Snd (you need the Motif headers).
If you get the error:
snd-x0.h:9 Xm/XmAll: No such file or directory
This probably means you don't have the Motif headers installed -- to
build Snd with a GUI from the sources, you need either Motif or Gtk+.
Motif has been released as open source software: see the url
mentioned below. If you installed the openmotif library rpm package,
it may not have included the headers (look under
/usr/X11R6/include/Xm); to build Snd from the sources you need the
headers (in the openmotif-devel packages).
In Debian, apt-get install libmotif-dev.
If you have installed Motif in some weird place, use the -I compiler
flag to provide that information to the compiler. I've added the
-with-motif-prefix argument to the configure script, but don't know if
it works; if, for example, you have Motif in /usr/local/lib and
/usr/local/include, try --with-motif-prefix=/usr/local
If you have installed Motif in some weird place, use the --with-motif-prefix
configure argument.
If Snd using Lesstif is messed up, that's Lesstif's problem! I'm
not trying to support this anymore.
In Fedora 7, openMotif will need /usr/include/X11/extensions/Print.h
In Fedora 7 and later, openMotif will need /usr/include/X11/extensions/Print.h
/usr/include/X11/bitmaps/gray, and /usr/X11R6/lib/libXp.so. I copy these
from old machines, but there must be a better way...
On 64-bit machines, use motif 2.3.2 or later.
---- Gtk+: ----
......@@ -569,8 +553,8 @@ you can find where it occurs by:
where
In some cases, if you installed gtk from an RPM file, you
also need to install gtk-devel. Otherwise the configure
process thinks you have an old, unusable version of gtk.
also need to install gtk-devel.
---- GSL: ----
......@@ -599,15 +583,6 @@ to install the guile-devel package. Otherwise the configure process
will say it can't find Guile (actually guile-config).
---- Gtk and OpenGL ----
The Gtk/GL version of Snd can kill the X server! I don't know why, and
others out in webland are equally bewildered. I believe that gtkglext
is officially unmaintained, and Gtk has decided to go with cairo instead.
Ideally, Gtk would flush cairo which is a total loss, and use openGL
directly, but I guess technical criteria are not driving this process.
---- Sun ----
If the make process complains about lt_dlclose and friends, add -lltdl
......
......@@ -325,9 +325,6 @@ enum {MUS_NO_ERROR, MUS_NO_FREQUENCY, MUS_NO_PHASE, MUS_NO_GEN, MUS_NO_LENGTH,
#if HAVE_FORTH
#define S_setB "set-"
#endif
#if HAVE_CL
#define S_setB "setf"
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
#define S_setB "set-"
#endif
......
#!/usr/bin/guile -s
!#
(use-modules (ice-9 format))
;;; for the Ruby version, see bess.rb by Michael Scholz
;;; load sndlib and xmlib
(if (not (provided? 'sndlib))
(let ((sndlib (dynamic-link "libsndlib.so")))
(if (not (dynamic-object? sndlib))
(set! sndlib (dynamic-link "sndlib.so")))
(if (not (dynamic-object? sndlib))
(error "can't find sndlib.so or libsndlib.so")
(dynamic-call (dynamic-func "Init_sndlib" sndlib) #f))))
(if (not (provided? 'xm))
(let ((libxm (dynamic-link "libxm.so")))
(if (not (dynamic-object? libxm))
(error "can't find libxm")
(dynamic-call (dynamic-func "Init_libxm" libxm) #f))))
;;; if these fail, first strace bess.scm and see where it failed
;;; if it actually did find the library, try running Snd and (dlopen "sndlib.so")
;;; Snd's dlopen will report a truthful error message (libtool lies)
(define use-snd (provided? 'snd))
;;; set up our user-interface
(let* ((shell-app (if (not use-snd)
(XtVaOpenApplication
"FM Forever!" 0 '()
applicationShellWidgetClass
(list XmNallowShellResize #t)
(list "*fontList: 9x15"
"*enableEtchedInMenu: True"
"*enableThinThickness: True"
"*enableToggleColor: True"
"*enableToggleVisual: True"))
#f))
(app (if use-snd
(car (main-widgets))
(cadr shell-app)))
(let* ((shell-app #f)
(app (car (main-widgets)))
(shell (if use-snd
(let* ((xdismiss (XmStringCreate "Go away" XmFONTLIST_DEFAULT_TAG))
(xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
(titlestr (XmStringCreate "FM Forever!" XmFONTLIST_DEFAULT_TAG))
(dialog (XmCreateTemplateDialog (cadr (main-widgets)) "FM Forever!"
(list XmNcancelLabelString xdismiss
XmNhelpLabelString xhelp
XmNautoUnmanage #f
XmNdialogTitle titlestr
XmNresizePolicy XmRESIZE_GROW
XmNnoResize #f
XmNtransient #f))))
(XtAddCallback dialog
XmNhelpCallback (lambda (w context info)
(snd-print "This dialog lets you experiment with simple FM")))
(XmStringFree xhelp)
(XmStringFree xdismiss)
(XmStringFree titlestr)
dialog)
(car shell-app)))
(shell (let* ((xdismiss (XmStringCreate "Go away" XmFONTLIST_DEFAULT_TAG))
(xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
(titlestr (XmStringCreate "FM Forever!" XmFONTLIST_DEFAULT_TAG))
(dialog (XmCreateTemplateDialog (cadr (main-widgets)) "FM Forever!"
(list XmNcancelLabelString xdismiss
XmNhelpLabelString xhelp
XmNautoUnmanage #f
XmNdialogTitle titlestr
XmNresizePolicy XmRESIZE_GROW
XmNnoResize #f
XmNtransient #f))))
(XtAddCallback dialog
XmNhelpCallback (lambda (w context info)
(snd-print "This dialog lets you experiment with simple FM")))
(XmStringFree xhelp)
(XmStringFree xdismiss)
(XmStringFree titlestr)
dialog))
(dpy (XtDisplay shell))
(screen (DefaultScreenOfDisplay dpy))
......@@ -85,9 +43,6 @@
(XtVaSetValues label (list XmNlabelString s1))
(XmStringFree s1)))
(if (not use-snd)
(XtSetValues shell (list XmNtitle "FM Forever!")))
(let* ((light-blue (position-color))
(form (XtCreateManagedWidget "form" xmFormWidgetClass shell
(list XmNbackground white
......@@ -262,9 +217,8 @@
(XmScaleSetValue fm-scale (inexact->exact (floor (* 100 (/ index high-index)))))
(XmScaleSetValue cm-scale (inexact->exact (floor (* ratio (/ 100 high-ratio)))))
(if use-snd
(XtManageChild shell)
(XtRealizeWidget shell))
(XtManageChild shell)
(XtRealizeWidget shell)
;; send fm data to dac
(mus-oss-set-buffers 4 12) ; a no-op except in OSS/Linux
......@@ -283,12 +237,11 @@
(XtRemoveWorkProc proc) ; odd that there's no XtAppRemoveWorkProc
(mus-audio-close port))
#f)
(if use-snd
(XtAddCallback shell
XmNcancelCallback (lambda (w context info)
(XtRemoveWorkProc proc)
(mus-audio-close port)
(XtUnmanageChild shell))))
(XtAddCallback shell
XmNcancelCallback (lambda (w context info)
(XtRemoveWorkProc proc)
(mus-audio-close port)
(XtUnmanageChild shell)))
(set! proc (XtAppAddWorkProc
app
(lambda (ignored-arg)
......@@ -304,7 +257,5 @@
(hz->radians (* ratio frequency)))))))))
(mus-audio-write port data bufsize)
#f))))
(if (not use-snd)
(XtAppMainLoop app))))
))
This diff is collapsed.
......@@ -2,7 +2,7 @@
\ Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
\ Created: Fri Feb 03 10:36:51 CET 2006
\ Changed: Wed Oct 14 00:12:50 CEST 2009
\ Changed: Fri Nov 06 00:14:12 CET 2009
\ Commentary:
\
......@@ -104,7 +104,7 @@ instrument: jc-reverb-fs <{ :key
doubled chan4 || if :size delay3 seconds->samples make-delay else #f then { outdel3 }
chan4 doubled chan2 && || if :size delay4 seconds->samples make-delay else #f then { outdel4 }
amp-env if :envelope amp-env :scaler volume :duration dur make-env else #f then { env-a }
doubled chan4 && if $" jc-reverb is not set up for doubled reverb in quad" _ error then
doubled chan4 && if $" jc-reverb is not set up for doubled reverb in quad" error then
0.0 0.0 { comb-sum comb-sum-1 }
0.0 dur run
0.0 rev-chans 0 ?do j i *reverb* in-any f+ loop { in-val }
......@@ -214,7 +214,7 @@ instrument: fm-violin-fs <{ start dur freq amp
doc" FM-Violin from clm/v.ins|snd/v.scm|rb.\n\
0 3 440 0.5 :fm-index 0.5 <'> fm-violin with-sound"
freq fabs 1.0 f<= if
$" freq = %s? reset to 440.0" _ #( freq ) string-format warning
$" freq = %s? reset to 440.0" #( freq ) string-format warning
440.0 to freq
then
freq hz->radians { frq-scl }
......
......@@ -50,10 +50,6 @@
#if HAVE_FFTW3
#include <fftw3.h>
#else
#if HAVE_FFTW
#include <rfftw.h>
#endif
#endif
#if HAVE_COMPLEX_TRIG
......@@ -9872,59 +9868,19 @@ mus_float_t mus_granulate(mus_any *ptr, mus_float_t (*input)(void *arg, int dire
/* fft of mus_float_t data in zero-based arrays
*/
#if HAVE_FFTW3
static double *rdata = NULL, *idata = NULL;
static fftw_plan rplan, iplan;
/*
* this "plan" business makes multi-threaded reallocs less attractive --
* I don't think a system like sinc_table would work here because we still have
* to make sure only one thread is using a given set of arrays and their plan.
*/
static int last_fft_size = 0;
#if HAVE_PTHREADS
static mus_lock_t fft_lock = MUS_LOCK_INITIALIZER;
#endif
void mus_fftw(mus_float_t *rl, int n, int dir)
{
int i;
/* array names are confusing here: rdata = input data, idata = output data */
MUS_LOCK(&fft_lock);
if (n != last_fft_size)
{
if (rdata) {fftw_free(rdata); fftw_free(idata); fftw_destroy_plan(rplan); fftw_destroy_plan(iplan);}
rdata = (double *)fftw_malloc(n * sizeof(double));
idata = (double *)fftw_malloc(n * sizeof(double));
rplan = fftw_plan_r2r_1d(n, rdata, idata, (fftw_r2r_kind)FFTW_FORWARD, FFTW_ESTIMATE);
iplan = fftw_plan_r2r_1d(n, rdata, idata, (fftw_r2r_kind)FFTW_BACKWARD, FFTW_ESTIMATE);
last_fft_size = n;
}
memset((void *)idata, 0, n * sizeof(double));
for (i = 0; i < n; i++) rdata[i] = rl[i];
if (dir != -1)
fftw_execute(rplan);
else fftw_execute(iplan);
for (i = 0; i < n; i++) rl[i] = idata[i];
MUS_UNLOCK(&fft_lock);
}
static void mus_big_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is);
#if HAVE_COMPLEX_TRIG && (!__cplusplus)
#if HAVE_FFTW3 && HAVE_COMPLEX_TRIG && (!__cplusplus)
static fftw_complex *c_in_data = NULL, *c_out_data = NULL;
static fftw_plan c_r_plan, c_i_plan;
static int last_c_fft_size = 0;
#if HAVE_PTHREADS
static mus_lock_t c_fft_lock = MUS_LOCK_INITIALIZER;
#endif
void mus_fftw_with_imag(mus_float_t *rl, mus_float_t *im, int n, int dir)
static void mus_fftw_with_imag(mus_float_t *rl, mus_float_t *im, int n, int dir)
{
int i;
......@@ -9960,51 +9916,8 @@ void mus_fftw_with_imag(mus_float_t *rl, mus_float_t *im, int n, int dir)
MUS_UNLOCK(&c_fft_lock);
}
#endif
#else
#if HAVE_FFTW
static fftw_real *rdata = NULL, *idata = NULL;
static rfftw_plan rplan, iplan;
static int last_fft_size = 0;
#if HAVE_PTHREADS
static mus_lock_t fft_lock = MUS_LOCK_INITIALIZER;
#endif
void mus_fftw(mus_float_t *rl, int n, int dir)
{
int i;
MUS_LOCK(&fft_lock);
if (n != last_fft_size)
{
if (rdata) {clm_free(rdata); clm_free(idata); rfftw_destroy_plan(rplan); rfftw_destroy_plan(iplan);}
rplan = rfftw_create_plan(n, FFTW_REAL_TO_COMPLEX, FFTW_ESTIMATE); /* I didn't see any improvement here from using FFTW_MEASURE */
iplan = rfftw_create_plan(n, FFTW_COMPLEX_TO_REAL, FFTW_ESTIMATE);
last_fft_size = n;
rdata = (fftw_real *)clm_calloc(n, sizeof(fftw_real), "fftw");
idata = (fftw_real *)clm_calloc(n, sizeof(fftw_real), "fftw");
}
memset((void *)idata, 0, n * sizeof(fftw_real));
/* if mus_float_t (default float) == fftw_real (default double) we could forego the data copy */
for (i = 0; i < n; i++) rdata[i] = rl[i];
if (dir != -1)
rfftw_one(rplan, rdata, idata);
else rfftw_one(iplan, rdata, idata);
for (i = 0; i < n; i++) rl[i] = idata[i];
MUS_UNLOCK(&fft_lock);
}
#endif
#endif
static void mus_big_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is);
#if HAVE_FFTW3 && HAVE_COMPLEX_TRIG && (!__cplusplus)
void mus_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is)
{
/* simple timing tests indicate fftw is slightly less than 4 times faster than mus_fft in this context */
......@@ -10696,7 +10609,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
cw = cos(2 * M_PI * beta);
n1 = (size - 1) * 0.5;
if ((size * size * sizeof(double)) > mus_max_malloc())
if ((mus_long_t)(size * size * sizeof(double)) > mus_max_malloc())
{
mus_error(MUS_ARG_OUT_OF_RANGE, "dpss window requires size^2 * 8 bytes, but that exceeds the current mus-max-malloc amount");
return(window);
......@@ -12221,10 +12134,10 @@ void mus_initialize(void)
array_print_length = MUS_DEFAULT_ARRAY_PRINT_LENGTH;
clm_file_buffer_size = MUS_DEFAULT_FILE_BUFFER_SIZE;
#if HAVE_FFTW3 || HAVE_FFTW
last_fft_size = 0;
#if HAVE_FFTW3 && HAVE_COMPLEX_TRIG && (!__cplusplus)
last_c_fft_size = 0;
/* is there a problem if the caller built fftw with --enable-threads?
* TODO: How to tell via configure that we need to initialize the thread stuff in libfftw?
* How to tell via configure that we need to initialize the thread stuff in libfftw?
*/
#endif
......
......@@ -2,7 +2,7 @@
\ Author: Michael Scholz <mi-scholz@users.sourceforge.net>
\ Created: Mon Mar 15 19:25:58 CET 2004
\ Changed: Wed Oct 14 04:01:54 CEST 2009
\ Changed: Thu Nov 26 18:29:52 CET 2009
\ Commentary:
\
......@@ -53,7 +53,7 @@
\ with-mix ( body-str args fname beg -- )
\ sound-let ( ws-xt-lst body-xt -- )
$" fth 9-Oct-2009" value *clm-version*
$" fth 26-Nov-2009" value *clm-version*
\ defined in snd/snd-xen.c
[ifundef] snd-print : snd-print ( str -- str ) dup .string ; [then]
......@@ -68,7 +68,14 @@ $" fth 9-Oct-2009" value *clm-version*
dl-load sndlib Init_sndlib
'snd provided? [unless]
'snd provided? [if]
'snd-nogui provided? [if]
: x-bounds <{ :optional snd 0 chn 0 axis 0 -- }> #f ;
: y-bounds <{ :optional snd 0 chn 0 axis 0 -- }> #f ;
: set-x-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- }> #f ;
: set-y-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- }> #f ;
[then]
[else]
<'> noop alias main-widgets
<'> noop alias sounds
<'> noop alias set-selected-sound
......@@ -326,7 +333,7 @@ previous
;
: make-default-comment ( -- str )
$" Written %s by %s at %s using clm (%s)" _
$" Written %s by %s at %s using clm (%s)"
#( $" %a %d-%b-%y %H:%M %Z" current-time strftime
getlogin
gethostname
......@@ -337,7 +344,7 @@ previous
{ start dur }
start seconds->samples { beg }
dur seconds->samples { len }
beg len b+ beg
beg len d+ beg
;
: normalize-partials ( parts1 -- parts2 )
......@@ -558,7 +565,7 @@ previous
input mus-sound-srate { srate }
input mus-sound-chans { chans }
chans 2 > if
$" %s: we can only handle 2 chans, not %d" _ #( get-func-name chans ) string-format warning
$" %s: we can only handle 2 chans, not %d" #( get-func-name chans ) string-format warning
2 to chans
then
verbose if input snd-info then
......@@ -566,9 +573,9 @@ previous
bufsize 0> if
chans bufsize make-sound-data { data }
input mus-sound-open-input { snd-fd }
snd-fd 0< if 'forth-error #( get-func-name $" cannot open %s" _ input ) fth-throw then
snd-fd 0< if 'forth-error #( get-func-name $" cannot open %s" input ) fth-throw then
mus-audio-default srate chans 2 min audio-format bufsize mus-audio-open-output { dac-fd }
dac-fd 0< if 'forth-error #( get-func-name $" cannot open dac" _ ) fth-throw then
dac-fd 0< if 'forth-error #( get-func-name $" cannot open dac" ) fth-throw then
frames 0 ?do
i bufsize + frames > if frames i - to bufsize then
snd-fd 0 bufsize 1- chans data mus-sound-read drop
......@@ -599,7 +606,7 @@ previous
duration seconds->samples { frames }
dac-size frames min { bufsize }
channels 2 min { chans }
comment empty? if $" written %s by %s" _ #( date get-func-name ) string-format to comment then
comment empty? if $" written %s by %s" #( date get-func-name ) string-format to comment then
chans bufsize make-sound-data { data }
\ INFO: commented out on Sun Sep 20 17:02:02 CEST 2009 [ms]
\ chans 0.25 make-vct { vals }
......@@ -607,9 +614,9 @@ previous
\ vals 0.75 vct-fill! drop
\ vals each drop output-device mus-audio-amp i vals mus-audio-mixer-write drop end-each
output srate chans data-format header-type comment mus-sound-open-output { snd-fd }
snd-fd 0< if 'forth-error #( get-func-name $" cannot open %S" _ output ) fth-throw then
snd-fd 0< if 'forth-error #( get-func-name $" cannot open %S" output ) fth-throw then
output-device srate chans audio-format bufsize mus-audio-open-input { dac-fd }
dac-fd 0< if 'forth-error #( get-func-name $" cannot open dac" _ ) fth-throw then
dac-fd 0< if 'forth-error #( get-func-name $" cannot open dac" ) fth-throw then
verbose if
$" filename: %s" #( output ) clm-message
$" device: %d" #( output-device ) clm-message
......@@ -763,14 +770,14 @@ hide
\ xt: output player execute
\ proc: player #( output ) run-proc
\ string: "player output" system
\ else snd: output play-and-wait
\ else snd: output :wait #t play
\ clm: output play-sound
\
\ A player may look like this:
\
\ : play-3-times ( output -- )
\ { output }
\ 3 0 ?do output play-and-wait drop loop
\ 3 0 ?do output :wait #t play drop loop
\ ;
\ <'> play-3-times to *clm-player*
: ws-play-it ( ws -- )
......@@ -784,7 +791,7 @@ hide
$" %s %s" #( player output ) string-format file-shell drop
else
'snd provided? if
output find-file play-and-wait drop
output find-file :wait #t play drop
else
output :verbose #f play-sound
then
......@@ -879,7 +886,7 @@ set-current
make-sample->file
then to *output*
*output* sample->file? unless
'with-sound-error #( get-func-name $" cannot open sample->file" _ ) fth-throw
'with-sound-error #( get-func-name $" cannot open sample->file" ) fth-throw
then
cont? if
output mus-sound-srate set-mus-srate drop
......@@ -897,7 +904,7 @@ set-current
$" with-sound temporary reverb file" make-sample->file
then to *reverb*
*reverb* sample->file? unless
'with-sound-error #( get-func-name $" cannot open reverb sample->file" _ ) fth-throw
'with-sound-error #( get-func-name $" cannot open reverb sample->file" ) fth-throw
then
then
ws :timer make-timer array-assoc-set! to ws
......@@ -919,7 +926,7 @@ set-current
*reverb* mus-close drop
ws :reverb-file-name array-assoc-ref undef make-file->sample to *reverb*
*reverb* file->sample? unless
'with-sound-error #( get-func-name $" cannot open file->sample" _ ) fth-throw
'with-sound-error #( get-func-name $" cannot open file->sample" ) fth-throw
then
\ compute ws reverb
*clm-debug* if
......@@ -997,7 +1004,7 @@ See with-sound for a full keyword list.\n\
then
{ fname ws }
fname file-exists? if
ws :verbose array-assoc-ref if $" loading %S" _ #( fname ) clm-message then
ws :verbose array-assoc-ref if $" loading %S" #( fname ) clm-message then
fname <'> file-eval ws with-sound-main ( ws )
else
'no-such-file $" %s: %S not found" #( get-func-name fname ) fth-raise
......@@ -1090,7 +1097,7 @@ lambda: ( -- )\n\
then { mix-time }
snd-time false?
mix-time false? ||
snd-time mix-time b< || if
snd-time mix-time d< || if
mix-file args each end-each :output snd-file clm-load drop
then
snd-file :output-frame start seconds->samples clm-mix
......@@ -1262,7 +1269,8 @@ event: inst-test ( -- )
:header-type mus-next
:data-format mus-lfloat
:channels 2
:srate mus-srate f>s new-sound { snd }
:srate mus-srate f>s
:comment make-default-comment new-sound { snd }
0 10 65 0.5 arpeggio
snd save-sound drop
;event
......
This diff is collapsed.
This diff is collapsed.
......@@ -2,7 +2,7 @@
# Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Wed Oct 14 23:02:57 CEST 2009
# Changed: Thu Oct 15 00:29:48 CEST 2009
# Changed: Wed Oct 28 22:37:22 CET 2009
# Commentary:
#
......@@ -536,6 +536,23 @@ if provided? :snd