Commit b3b583be authored by IOhannes m zmölnig's avatar IOhannes m zmölnig

New upstream version 18.1

parent 1b3b1b2a
Snd change log
14-Feb: Snd 18.1.
9-Jan-18: Snd-18.0.
2018 ----------------------------------------------------------------
......
Snd 18.0:
Snd 18.1
many Forth/Ruby improvements thanks to Mike.
s7: added (*s7* 'max-heap-size)
in Snd, xg.c is no longer included automatically. The changes for
gtk 4 are very extensive.
checked: sbcl 1.4.4
added snd.desktop and tools/auto-tester.scm.
checked: sbcl 1.4.2|3, gtk 3.93.0
Thanks!: Mike Scholz, Kjetil Matheussen, Yuri, Daniel Hensel
Thanks!: Mike Scholz, Kjetil Matheussen, Marty Hayman, Yuri
......@@ -46,7 +46,7 @@ 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+ (Debian package libgtk-3-dev).
--with-gtk use Gtk+ (Debian package libgtk-3-dev, Fedora gtk3-devel or gtk4-devel)
--with-gui make Snd with graphics support (actually intended for use as --without-gui)
......@@ -98,7 +98,7 @@ Here at CCRMA, we use this configure invocation:
Version info:
if Gtk, then Gtk+ 2.13 or later and Cairo 1.6.4 or later
if Gtk, then Gtk+ 2.13 or later (but anything after gtk 3.22 is work-in-progress), and Cairo 1.6.4 or later
if Motif, then Motif 2.n but not Lesstif
in Linux, if ALSA, then ALSA 1.0 or later
if Ruby, Ruby 1.8.0 or later.
......
This diff is collapsed.
;;; this is obsolete -- it needs some replacement for the mus-audio* functions
(when (provided? 'snd-motif)
(with-let (sublet *motif*)
;; set up our user-interface
(let* ((app (car (main-widgets)))
(shell (let* ((xdismiss (XmStringCreate "Go away" XmFONTLIST_DEFAULT_TAG))
(let* ((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!"
......@@ -14,6 +10,7 @@
XmNhelpLabelString xhelp
XmNautoUnmanage #f
XmNdialogTitle titlestr
XmNwidth 600
XmNresizePolicy XmRESIZE_GROW
XmNnoResize #f
XmNtransient #f))))
......@@ -27,7 +24,6 @@
(dpy (XtDisplay shell))
(screen (DefaultScreenOfDisplay dpy))
;; (cmap (DefaultColormap dpy (DefaultScreen dpy)))
(black (BlackPixelOfScreen screen))
(white (WhitePixelOfScreen screen))
......@@ -153,7 +149,7 @@
(let ((frequency 220.0)
(low-frequency 40.0)
(high-frequency 2000.0)
(amplitude 0.5)
(amplitude 0.25)
(index 1.0)
(high-index 3.0)
(ratio 1)
......@@ -190,6 +186,17 @@
(set! ratio (floor (* (.value i) (/ high-ratio 100.0))))
(set-ilabel cm-label ratio))
(define (fm)
(* amplitude playing
(oscil carosc
(+ (hz->radians frequency)
(* index
(oscil modosc
(hz->radians (* ratio frequency))))))))
;; go-away button
(XtAddCallback shell XmNcancelCallback (lambda (w c i) (stop-playing) (XtUnmanageChild w)))
;; add scale-change (drag and value-changed) callbacks
(XtAddCallback freq-scale XmNdragCallback freq-callback)
(XtAddCallback freq-scale XmNvalueChangedCallback freq-callback)
......@@ -204,6 +211,7 @@
(XtAddCallback cm-scale XmNvalueChangedCallback ratio-callback)
(XtAddCallback play-button XmNvalueChangedCallback (lambda (w c i) (set! playing (if (.set i) 1.0 0.0))))
(XmAddWMProtocolCallback (XtParent shell) (XmInternAtom (XtDisplay (cadr (main-widgets))) "WM_DELETE_WINDOW" #f) (lambda (w c i) (stop-playing)) #f)
;; set initial values
(set-flabel freq-label frequency)
......@@ -219,34 +227,6 @@
(XtManageChild shell)
(XtRealizeWidget shell)
;; send fm data to dac
(let ((bufsize 256)
(work-proc #f))
(let ((port (mus-audio-open-output mus-audio-default 22050 1 mus-lshort (* bufsize 2))))
(if (< port 0)
(format () "can't open DAC!"))
(XmAddWMProtocolCallback (cadr (main-widgets)) ; shell
(XmInternAtom dpy "WM_DELETE_WINDOW" #f)
(lambda (w c i)
(XtRemoveWorkProc work-proc) ; odd that there's no XtAppRemoveWorkProc
(mus-audio-close port))
#f)
(XtAddCallback shell
XmNcancelCallback (lambda (w context info)
(XtRemoveWorkProc work-proc)
(mus-audio-close port)
(XtUnmanageChild shell)))
(set! work-proc (XtAppAddWorkProc app
(lambda (ignored-arg)
(let ((data (make-float-vector bufsize)))
(do ((i 0 (+ 1 i)))
((= i bufsize))
(float-vector-set! data i (* amplitude playing
(oscil carosc
(+ (hz->radians frequency)
(* index
(oscil modosc
(hz->radians (* ratio frequency)))))))))
(mus-audio-write port data bufsize)
#f))))))))))
\ No newline at end of file
(play fm)))))
This diff is collapsed.
......@@ -49,6 +49,35 @@
#define TWO_PI (2.0 * M_PI)
#endif
#if (!USE_SND)
#define mus_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 mus_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)
#define mus_add_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
struct mus_any_class {
int type;
char *name;
......
......@@ -2,9 +2,9 @@
\ Author: Michael Scholz <mi-scholz@users.sourceforge.net>
\ Created: 04/03/15 19:25:58
\ Changed: 18/01/02 07:20:24
\ Changed: 18/01/06 06:54:06
\
\ @(#)clm.fs 2.2 1/2/18
\ @(#)clm.fs 2.4 1/6/18
\ clm-print ( fmt :optional args -- )
\ clm-message ( fmt :optional args -- )
......@@ -345,7 +345,7 @@ set-current
previous
\ === Global User Variables (settable in ~/.snd_forth or ~/.fthrc) ===
"fth 2018/01/02" value *clm-version*
"fth 2018/01/06" value *clm-version*
mus-lshort value *clm-audio-format*
#f value *clm-comment*
1.0 value *clm-decay-time*
......@@ -1246,45 +1246,47 @@ set-current
<'> noop alias end-run-gen
<'> hash-ref alias args@
: run-gen-body { samp y -- y' }
0 0 { beg end }
nil nil { args prc }
: run-gen-body { samp -- res }
nil nil 0 0 { args prc beg end }
0.0 { sum }
*dac-instruments* each to args
args 0 array-ref to prc
args 1 array-ref to beg
args 2 array-ref to end
samp beg end within if
samp prc execute y f+ to y
samp prc execute sum f+ to sum
then
end-each
y
sum
;
\ Returns a proc ( y -- res ) for use with map-channel.
\ Requires a filled *dac-instruments* variable, usually done with
\ run-gen-instrument ... end-run-gen prepared functions, see simp-gen
\ and violin-gen at the end of this file.
: run-gen ( -- prc; y self -- y' )
: run-gen ( -- prc; y self -- res )
*dac-instruments* empty? if
'with-sound-error
#( "%s: filled *dac-instruments* required"
get-func-name ) fth-throw
then
0 { len }
*dac-instruments* each { el }
el 2 array-ref len max to len
nil nil 0 0 0 { args prc beg end len }
*dac-instruments* each to args
args 2 array-ref len max to len
end-each
len 0.0 make-vct { v }
*dac-instruments* each to args
args 0 array-ref to prc
args 1 array-ref to beg
args 2 array-ref to end
end beg ?do
i prc execute v i rot object-set+!
loop
end-each
1 proc-create ( prc )
0 , len ,
does> { y self -- val }
self @ { samp }
self cell+ @ { len }
samp len <= if
samp y run-gen-body ( y' )
samp 1+ self !
else
0.0
then
v ,
does> { y self -- res }
self @ ( v ) cycle-ref y f+
;
previous
......@@ -1622,7 +1624,7 @@ hide
self @ { samp }
self cell+ @ { len }
samp len <= if
samp 0.0 run-gen-body ( sum )
samp run-gen-body ( sum )
samp 1+ self !
else
#f
......
This diff is collapsed.
......@@ -5,7 +5,7 @@
# gmp, mpfr, and mpc deliberately have none!
AC_INIT(snd, 18.0, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-18.tar.gz)
AC_INIT(snd, 18.1, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-18.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=18.0
VERSION=18.1
#--------------------------------------------------------------------------------
# configuration options
......@@ -113,7 +113,7 @@ if test "$with_fftw" != no; then
FFTW_LIBS="`$PKG_CONFIG fftw3 --libs`"
FFTW_CFLAGS="`$PKG_CONFIG fftw3 --cflags`"
AC_DEFINE(HAVE_FFTW3)
OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fftw3"
OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fftw-`$PKG_CONFIG fftw3 --modversion`"
AC_MSG_RESULT(yes)
else
AC_MSG_RESULT(no)
......@@ -158,7 +158,7 @@ if test "$with_gsl" != no; then
GSL_LIBS="`$PKG_CONFIG gsl --libs`"
GSL_CFLAGS="`$PKG_CONFIG gsl --cflags`"
AC_DEFINE(HAVE_GSL)
OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gsl"
OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gsl-`$PKG_CONFIG gsl --modversion`"
AC_MSG_RESULT(yes)
else
AC_MSG_RESULT(no)
......@@ -260,41 +260,44 @@ fi
if test "$ac_snd_gui_choice" = none ; then
if test x$PKG_CONFIG != xno ; then
if $PKG_CONFIG gtk+-3.0 --exists ; then
GTK_CFLAGS="`$PKG_CONFIG gtk+-3.0 --cflags`"
GTK_LIBS="`$PKG_CONFIG gtk+-3.0 --libs`"
GTK_LD_LIBS="`$PKG_CONFIG gtk+-3.0 --libs-only-L` `$PKG_CONFIG gtk+-3.0 --libs-only-l`"
ac_snd_gui_choice=gtk
else
if $PKG_CONFIG gtk+-2.0 --exists ; then
GTK_CFLAGS="`$PKG_CONFIG gtk+-2.0 --cflags`"
GTK_LIBS="`$PKG_CONFIG gtk+-2.0 --libs`"
GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
m4_foreach([gtk_version], [[gtk+-4.0], [gtk+-3.0], [gtk+-2.0]],
[
if test "$ac_snd_gui_choice" = none ; then
if $PKG_CONFIG gtk_version --exists ; then
GTK_CFLAGS="`$PKG_CONFIG gtk_version --cflags`"
GTK_LIBS="`$PKG_CONFIG gtk_version --libs`"
GTK_LD_LIBS="`$PKG_CONFIG gtk_version --libs-only-L` `$PKG_CONFIG gtk_version --libs-only-l`"
ac_snd_gui_choice=gtk
GRAPHICS_TOOLKIT=Gtk+-`$PKG_CONFIG gtk_version --modversion`
fi
fi
fi
])
if test "$ac_snd_gui_choice" = gtk ; then
GX_FILES="GTK_O_FILES"
GX_HEADERS="SND_G_HEADERS"
AC_DEFINE(USE_GTK)
GRAPHICS_TOOLKIT="Gtk"
if test x$PKG_CONFIG != xno ; then
CAIRO_CFLAGS="`$PKG_CONFIG cairo --cflags-only-I`"
AC_SUBST(CAIRO_CFLAGS)
fi
fi
fi
fi
#--------------------------------------------------------------------------------
# no GUI
#--------------------------------------------------------------------------------
if test "$ac_snd_gui_choice" = none ; then
AC_DEFINE(USE_NO_GUI)
GX_FILES="NO_GUI_O_FILES"
GX_HEADERS="NO_GUI_HEADERS"
fi
# fallback on no-gui
if test "$with_gui" = no ; then
AC_DEFINE(USE_NO_GUI)
......@@ -303,6 +306,7 @@ if test "$with_gui" = no ; then
ac_snd_gui_choice=no
fi
AC_SUBST(XLIBS)
AC_SUBST(XFLAGS)
......@@ -390,7 +394,7 @@ if test "$with_ruby" = yes ; then
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"
LOCAL_LANGUAGE=Ruby-`$PKG_CONFIG ruby_version --modversion`
ac_snd_extension_language=Ruby
fi
fi
......
......@@ -4455,7 +4455,7 @@ static void define_functions(void)
{
#if HAVE_SCHEME
static s7_pointer s_boolean, s_integer, s_real, s_any;
static s7_pointer pl_bi, pl_bit, pl_tiirrrrt, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriirriit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiiiiit, pl_ti, pl_tir, pl_tit, pl_tiit, pl_tiir, pl_tiib, pl_tiiit, pl_tiiib, pl_tiiiit, pl_tirrir, pl_tibiit, pl_tirriit, pl_tiiiiit, pl_t, pl_iiiiiit, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiiiiit, pl_prrrt, pl_prrrrtttrrt, pl_i, pl_tb, pl_bt, pl_pit, pl_ttr, pl_ttb, pl_tti, pl_ttri, pl_ttit, pl_ttir, pl_piit, pl_piiit, pl_ttiti, pl_ttrri, pl_ttrrri, pl_ttrriir, pl_ttititi, pl_ttititiiti, pl_tr, pl_trrrrt;
static s7_pointer pl_i, pl_tb, pl_bt, pl_tr, pl_trrrrt, pl_iiiiiit, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiiiiit, pl_t, pl_prrrt, pl_prrrrtttrrt, pl_ti, pl_tir, pl_tit, pl_tiit, pl_tiir, pl_tiib, pl_tiiit, pl_tiiib, pl_tiiiit, pl_tirrir, pl_tibiit, pl_tirriit, pl_tiiiiit, pl_tiirrrrt, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriirriit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiiiiit, pl_pit, pl_piit, pl_piiit, pl_ttr, pl_ttb, pl_tti, pl_ttri, pl_ttit, pl_ttir, pl_ttiti, pl_ttrri, pl_ttrrri, pl_ttrriir, pl_ttititi, pl_ttititiiti, pl_bi, pl_bit;
#if USE_MOTIF
static s7_pointer pl_pt, pl_pttit, pl_tttti, pl_ttttb;
#endif
......@@ -4465,15 +4465,21 @@ static s7_pointer pl_pt, pl_pttit, pl_tttti, pl_ttttb;
s_real = s7_make_symbol(s7, "real?");
s_any = s7_t(s7);
pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any);
pl_tiirrrrt = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_real, s_real, s_real, s_real, s_any);
pl_tiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tirriirriit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_real, s_real, s_integer, s_integer, s_any);
pl_tiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tiiiiiit = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_i = s7_make_circular_signature(s7, 0, 1, s_integer);
pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean);
pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any);
pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real);
pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any);
pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiit = s7_make_circular_signature(s7, 7, 8, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
pl_prrrt = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_any);
pl_prrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_any, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any);
pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer);
pl_tir = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_real);
pl_tit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any);
......@@ -4487,36 +4493,30 @@ static s7_pointer pl_pt, pl_pttit, pl_tttti, pl_ttttb;
pl_tibiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_boolean, s_integer, s_integer, s_any);
pl_tirriit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_any);
pl_tiiiiit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiit = s7_make_circular_signature(s7, 7, 8, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_prrrt = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_any);
pl_prrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_any, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any);
pl_i = s7_make_circular_signature(s7, 0, 1, s_integer);
pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean);
pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any);
pl_tiirrrrt = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_real, s_real, s_real, s_real, s_any);
pl_tiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tirriirriit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_real, s_real, s_integer, s_integer, s_any);
pl_tiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tiiiiiit = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_pit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any);
pl_piit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any);
pl_piiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any);
pl_ttr = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_real);
pl_ttb = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_boolean);
pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer);
pl_ttri = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_real, s_integer);
pl_ttit = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_any);
pl_ttir = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_real);
pl_piit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any);
pl_piiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any);
pl_ttiti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_integer, s_any, s_integer);
pl_ttrri = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_real, s_real, s_integer);
pl_ttrrri = s7_make_circular_signature(s7, 5, 6, s_any, s_any, s_real, s_real, s_real, s_integer);
pl_ttrriir = s7_make_circular_signature(s7, 6, 7, s_any, s_any, s_real, s_real, s_integer, s_integer, s_real);
pl_ttititi = s7_make_circular_signature(s7, 6, 7, s_any, s_any, s_integer, s_any, s_integer, s_any, s_integer);
pl_ttititiiti = s7_make_circular_signature(s7, 9, 10, s_any, s_any, s_integer, s_any, s_integer, s_any, s_integer, s_integer, s_any, s_integer);
pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real);
pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any);
pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any);
#if USE_MOTIF
pl_pt = s7_make_circular_signature(s7, 1, 2, s_any, s_any);
......@@ -5736,7 +5736,7 @@ void Init_libgl(void)
define_integers();
define_functions();
Xen_provide_feature("gl");
Xen_define("gl-version", C_string_to_Xen_string("01-Jan-18"));
Xen_define("gl-version", C_string_to_Xen_string("11-Feb-18"));
gl_already_inited = true;
}
}
......
......@@ -352,7 +352,9 @@ static int glistener_cursor(glistener *g, GtkTextIter *cursor)
void glistener_set_cursor_shape(glistener *g, GdkCursor *cursor_shape)
{
#if (!GTK_CHECK_VERSION(3, 93, 0))
gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(g->text), GTK_TEXT_WINDOW_TEXT), cursor_shape);
#endif
}
......
......@@ -1541,7 +1541,7 @@ if you have an executable file with:
</p>
<pre class="indented">
#!/home/bil/test/snd-17/snd -l
#!/home/bil/test/snd-18/snd -l
!#
(define a-test 32)
(display "hiho")
......@@ -1552,12 +1552,12 @@ if you have an executable file with:
</p>
<pre class="indented">
/home/bil/test/snd-17/ script
/home/bil/test/snd-18/ script
hiho
&gt; a-test
32
&gt; (<a class=quiet href="extsnd.html#exit">exit</a>)
/home/bil/test/snd-17/
/home/bil/test/snd-18/
</pre>
<p>
......@@ -1574,7 +1574,7 @@ writes the result as "test.snd":
<tr>
<td class="scheme">
<pre class="indented">
#!/home/bil/snd-17/snd -l
#!/home/bil/snd-18/snd -l
!#
(open-sound "oboe.snd")
(scale-by 2.0)
......@@ -1585,7 +1585,7 @@ writes the result as "test.snd":
<td class="ruby">
<pre class="indented">
#!/home/bil/snd-17/snd -batch
#!/home/bil/snd-18/snd -batch
open_sound "oboe.snd"
scale_by 2.0
save_sound_as "test.snd"
......@@ -1616,7 +1616,7 @@ as it scans the startup arguments (see snd-test.scm).
</p>
<pre class="indented">
#!/home/bil/test/snd-17/snd -l
#!/home/bil/test/snd-18/snd -l
!#
(if (= (length (<a class=quiet href="extsnd.html#scriptargs">script-args</a>)) 2) ;i.e. ("-l" "script")
(display "usage: script file-name...")
......
;;; this is not ready for use
(if (provided? 'gtk4)
(gtk_init)
(gtk_init 0 #f))
......@@ -85,7 +85,8 @@
(if (provided? 'gtk4)
(gdk_window_set_event_compression (gtk_widget_get_window repl) #f)
(gtk_widget_set_events repl GDK_ALL_EVENTS_MASK))
;(gtk_widget_set_events repl GDK_ALL_EVENTS_MASK)
)
(g_signal_connect (G_OBJECT repl) "key_press_event" repl-key-press)
;; TODO in gtk4 I think repl-key-press receives 2 args
......@@ -118,8 +119,10 @@ void libgtk_s7_init(s7_scheme *sc);
int main(int argc, char **argv)
{
s7_scheme *sc;
sc = s7_init();
libgtk_s7_init(sc);
s7_load(sc, "gtkex.scm");
}
......
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -28,8 +28,8 @@
(call-with-exit
(lambda (return)
(for-each
(lambda (symbol)
(let* ((sym (symbol->string symbol))
(lambda (par)
(let* ((sym (symbol->string par))
(sym-len (length sym)))
(when (and (>= sym-len text-len)
(string=? text (substring sym 0 text-len)))
......
This diff is collapsed.
#ifndef S7_H
#define S7_H
#define S7_VERSION "5.12"
#define S7_DATE "11-Dec-17"
#define S7_VERSION "5.13"
#define S7_DATE "26-Jan-18"
#include <stdint.h> /* for int64_t */
......@@ -468,6 +468,7 @@ s7_pointer s7_make_continuation(s7_scheme *sc); /* c
const char *s7_documentation(s7_scheme *sc, s7_pointer p); /* (documentation x) if any (don't free the string) */
s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj); /* (setter obj) */
s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter); /* (set! (setter p) setter) */
s7_pointer s7_signature(s7_scheme *sc, s7_pointer func); /* (signature obj) */
s7_pointer s7_make_signature(s7_scheme *sc, int32_t len, ...); /* procedure-signature data */
s7_pointer s7_make_circular_signature(s7_scheme *sc, int32_t cycle_point, int32_t len, ...);
......@@ -884,6 +885,7 @@ void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function
*
* s7 changes
*
* 26-Jan-18: s7_set_setter.
* 11-Dec: s7_gc_protect_via_stack
* 3-Oct: renamed procedure-signature -> signature, procedure-documentation -> documentation, and procedure-setter -> setter.
* 18-Sep: s7_immutable, s7_is_immutable. define-constant follows lexical scope now.
......
......@@ -886,6 +886,17 @@ unknown key handling is not good, :allow-key-values?
((lambda* (hi ho) (list hi ho)) (symbol->keyword a) b))
(f8 'hi 32) -> (32 #f)
(f8 'ho 32) -> (#f 32)
another amusing lambda* case:
(call/cc
(lambda* (a (b (call/cc (lambda (c) c)))) ; even with-baffle still a loop (legit)
(b (call/cc (lambda (d) d)))))
;; equivalent to:
(let ((c (call/cc (lambda (c) c))))
(call/cc (lambda (a)
(c (call/cc (lambda (d) d))))))
-->
</blockquote>
......@@ -5162,7 +5173,8 @@ is also passed (the weird argument order is an historical artifact).
<em class="gray">#(1 2 0)</em>
</pre>
<p>define-constant is more restrictive than a symbol-setter that raises an error: the latter
<p>See also typed-let in stuff.scm.
define-constant is more restrictive than a symbol-setter that raises an error: the latter
does not block nested (possibly non-constant) bindings of the symbol. The symbol-setters
are kind of ugly. Here's a macro that lets you put the let variable's setter after
the initial value:
......@@ -5376,7 +5388,7 @@ at startup *features* is:
<pre class="indented">
&gt; *features*
<em class="gray">(snd-17.0 snd17 snd audio snd-s7 snd-gtk gsl alsa gtk2 xg clm6 clm sndlib linux
<em class="gray">(snd-18.0 snd17 snd audio snd-s7 snd-gtk gsl alsa gtk2 xg clm6 clm sndlib linux
dlopen complex-numbers system-extras ratio s7-4.14 s7) </em>
&gt; (provided? 'gsl)
<em class="gray">#t</em>
......@@ -6032,6 +6044,7 @@ stacktrace-defaults stacktrace formatting info for error handler
symbol-table a vector
rootlet-size the number of globals
heap-size total cells currently available (settable)
max-heap-size max heap size (settable)
free-heap-size the number of currently unused cells
gc-freed number of cells freed by the last GC pass
gc-protected-objects vector of the objects permanently protected from the GC
......@@ -6058,11 +6071,9 @@ Use the standard environment syntax to access these fields:
more info in (*s7* 'history) for s7_apply_function, s7_call and s7_eval
less aggressive optimization in with-let and lambda
warnings about syntax redefinition
2: incoming s7_pointer checks in some FFI functions
clm optimization off
incoming s7_pointer checks in some FFI functions
bignum int to s7_int conversion checks
3: all optimization off
4: vector, string, and pair constants are immutable (but checks for this are currently sparse)
2: vector, string, and pair constants are immutable (but checks for this are currently sparse)
</pre>
<p><code>(*s7* 'stacktrace-defaults)</code> is a list of four integers and a boolean that tell the error
......@@ -6117,6 +6128,20 @@ the generic functions mechanism, much like a c-object:
<em class="gray">"I am pointer 1 of type 'abc!"</em>
</pre>
<div class="separator"></div>
<p>There are several tree-oriented functions currently built into s7:
</p>
<pre class="indented">
(<em class=def id="treecyclic">tree-cyclic?</em> tree) returns #t if tree contains a cycle.
(<em class=def id="treeleaves">tree-leaves</em> tree) returns the number of leaves in tree.
(<em class=def id="treememq">tree-memq</em> obj tree) returns #t if obj is in tree (using eq?).
(<em class=def id="treesetmemq">tree-set-memq</em> set tree) returns #t if any member of the list set is in tree.
(<em class=def id="treecount">tree-count</em> obj tree) returns how many times obj is in tree.
</pre>
<div class="separator"></div>
<blockquote>
......@@ -6200,15 +6225,25 @@ definition, and a later redefinition does not affect earlier uses.
<li>change with-output-to-* and with-input-from-* to omit the pointless lambda.
<li>remove the with-* IO functions (e.g. with-input-from-string), keeping the call-with-* versions (call-with-input-string).
<li>remove assq, assv, memq, and memv (these are pointless now that assoc and member can be passed eq? and eqv?).
<li>move all the "*var*" names to *s7*: *load-hook* becomes (*s7* 'load-hook) for example.
</ul>
<p>With the move to s7_setter and s7_set_setter (setter in Scheme),
dilambda and dilambda? have been reduced to trivial conveniences, so perhaps they can also be
removed.
</p>
<p>There are several less-than-ideal names. Perhaps s7 should use *pi*, *most-negative-fixnum*,
*most-positive-fixnum* (*fixleast* and *fixmost*?) so that all the built-in variables and constants have the
same kind of name (or +pi+ to show it is a constant?).
get-output-string should be current-output-string. write-char behaves like display, not write.
provided? should be feature? or *features* should be *provisions*.
list-ref, list-set!, and list-tail actually only apply to pairs.
And let-temporarily should be templet, or maybe set-temporarily.
let-temporarily should be templet, or maybe set-temporarily.
Finally, the CL-inspired "log*" names such as logand look very old-fashioned. Standard scheme opts