New upstream version 18.0

1 files changed, 1480 insertions, 582 deletions

diff --git a/clm.fs b/clm.fs
index ca4f658..1235eb3 100644
--- a/clm.fs
+++ b/clm.fs
@@ -2,9 +2,9 @@
 
 \ Author: Michael Scholz <mi-scholz@users.sourceforge.net>
 \ Created: 04/03/15 19:25:58
-\ Changed: 17/09/25 22:08:35
+\ Changed: 18/01/02 07:20:24
 \
-\ @(#)clm.fs	1.122 9/25/17
+\ @(#)clm.fs	2.2 1/2/18
 
 \ clm-print		( fmt :optional args -- )
 \ clm-message		( fmt :optional args -- )
@@ -20,56 +20,74 @@
 \ bpm->seconds		( bpm -- secs )
 \ rhythm->seconds	( rhy -- secs )
 \ 
-\ tempnam		( -- name )
 \ fth-tempnam		( -- name )
 \ make-default-comment	( -- str )
 \ times->samples	( start dur -- len beg )
 \ 
-\ ws-local-variables	( -- )
-\ ws-info		( start dur vars -- start dur )
-\ run			( start dur -- )
-\ run-instrument	( start dur locsig-args -- )
-\ end-run		( sample -- )
-\ reverb-info		( caller in-chans out-chans -- )
 \ instrument:		( "name" -- )
 \ ;instrument		( -- )
 \ event:		( "name" -- )
 \ ;event		( -- )
 \
 \ find-file		( file -- fname|#f )
-\ snd-info		( output :key reverb-file-name scaled? timer -- )
+\ snd-info		( obj -- )
+\ play-sound		( :optional input verbose player -- )
+\ clm-mix		( infile keyword-args -- )
+\ 
+\ ws-local-variables	( -- )
+\ ws-info		( start dur vars -- start dur )
+\ run			( start dur -- )
+\ run-instrument	( start dur locsig-args -- )
+\ end-run		( sample -- )
+\ ws-out[a-c]		( idx val gen -- )
+\ ws-out-any		( idx val chn gen -- )
+\ reverb-info		( caller in-chans out-chans -- )
+\ run-reverb		( dur -- in-val )
+\ end-run-reverb	( -- )
+\ end-run-reverb-out-1	( samp -- )
+\ end-run-reverb-out-2	( samp1 samp2 -- )
+\ end-run-reverb-out-4	( samp1 samp2 samp3 samp4 -- )
+\ set-to-snd		( f -- )
+\ run-gen-instrument	( start dur dummy --; samp args -- val )
+\ end-run-gen		( -- )
+\ run-gen-body		( samp y -- y' )
+\ run-gen		( -- prc; y self -- y' )
 \
-\ clm-mix		( ifile keyword-args -- )
+\ ws-play		( ws -- )
 \ ws-output		( ws -- fname )
+\ ws-framples		( gen -- len )
+\ ws-close-snd		( fname -- )
+\ ws-is-output?		( gen -- f )
+\ with-sound-main	( body-xt ws -- ws )
 \ with-sound		( body-xt keyword-args -- ws )
 \ clm-load		( fname keyword-args -- ws )
-\ with-current-sound	( body-xt :key offset scaled-to scaled-by -- )
+\ with-current-sound	( body-xt keyword-args -- )
 \ scaled-to		( body-xt scl -- )
 \ scaled-by		( body-xt scl -- )
 \ with-offset		( body-xt secs -- )
-\ with-mix		( body-str|nil args fname start -- )
+\ with-mix		( body-str args fname start -- )
 \ sound-let		( ws-xt-lst body-xt -- )
 \
-\ play-sound		( :key verbose player :optional input -- )
-\
 \ example instruments:
 \ simp			( star dur freq amp -- )
 \ src-simp		( start dur amp sr sr-env fname -- )
 \ conv-simp		( start dur filt fname amp -- )
-\ arpeggio		( start dur freq amp :key ampenv offset -- )
+\ arpeggio		( start dur freq amp keyword-args -- )
+\ simp-gen		( start dur freq amp --; samp args -- val )
+\ violin-gen		( start dur freq amp keyword-args --; samp args -- val )
 \
 \ from generators.scm:
 \ make-waveshape	( :optional freq parts wave size -- )
 \ waveshape		( gen :optional index fm -- val )
 \ waveshape?		( obj -- f )
 \ partials->waveshape	( part :optional size -- wave )
-\ make-sum-of-sines	( :key sines frequency initial-phase -- gen )
+\ make-sum-of-sines	( keyword-args -- gen )
 \ sum-of-sines		( gen :optional fm -- val )
 \ sum-of-sines?		( obj -- f )
-\ make-sum-of-cosines	( :key cosines frequency initial-phase -- gen )
+\ make-sum-of-cosines	( keyword-args -- gen )
 \ sum-of-cosines	( gen :optional fm -- val )
 \ sum-of-cosines?	( obj -- f )
-\ make-sine-summation	( :key frequency initial-phase n a ratio -- gen )
+\ make-sine-summation	( keyword-args -- gen )
 \ sine-summation	( gen :optional fm -- val )
 \ sine-summation?	( obj -- f )
 
@@ -83,13 +101,18 @@
 'sndlib provided? [unless] dl-load sndlib Init_sndlib [then]
 
 'snd provided? [unless]
+	<'> noop alias channel->vct
 	<'> noop alias close-sound
 	<'> noop alias find-sound
+	<'> noop alias framples
+	<'> noop alias mix-vct
+	<'> noop alias new-sound
 	<'> noop alias open-sound
 	<'> noop alias save-sound
 	<'> noop alias scale-channel
 	<'> noop alias sound?
-	<'> noop alias framples
+	<'> noop alias update-sound
+	<'> noop alias vct->channel
 
 	\ Some generic words for non-Snd use.
 	: channels <{ :optional obj #f -- n }>
@@ -112,14 +135,33 @@
 		then
 	;
 
-	: maxamp <{ :optional snd #f chn #f edpos #f -- r }>
-		snd string? if
-			snd mus-sound-maxamp
+	: maxamp <{ :optional obj #f chn #f edpos #f -- r }>
+		obj string? if
+			obj mus-sound-maxamp
+		else
+			obj vct? if
+				obj vct-peak
+			else
+				obj mus-generator? if
+					obj mus-data vct-peak
+				else
+					0.0
+				then
+			then
+		then
+	;
+
+	\ set to *clm-file-name* below
+	defer *clm-fname*
+
+	: file-name <{ :optional obj #f -- name }>
+		obj string? if
+			obj			
 		else
-			snd vct? if
-				snd vct-peak
+			obj mus-generator? if
+				obj mus-file-name
 			else
-				0.0
+				*clm-fname*
 			then
 		then
 	;
@@ -127,7 +169,7 @@
 
 [ifundef] clm-print
 	\ "hello" clm-print
-	\ "file %s, line %d\n" '( "oboe.snd" 123 ) clm-print
+	\ "file %s, line %d\n" '( "clm.fs" 135 ) clm-print
 	[ifdef] snd-print
 		: clm-print ( fmt :optional args -- )
 			string-format snd-print drop
@@ -137,6 +179,28 @@
 	[then]
 [then]
 
+[ifundef] stack-check
+	\ added to examples/fth-lib/fth.fs on 2017/12/16
+	hide
+	: (stack-check) ( req xt -- )
+		{ req xt }
+		depth req < if
+			depth { d }
+			'wrong-number-of-args
+			    #( "%s: not enough arguments, %s instead of %s"
+			       xt xt->name
+			       d
+			       req ) fth-throw
+		then
+	;
+	set-current
+
+	: stack-check ( req -- )
+		postpone running-word postpone (stack-check)
+	; immediate compile-only
+	previous
+[then]
+
 \ Put comment sign before output string and finish with carriage return.
 : clm-message ( fmt :optional args -- )
 	string-format { msg }
@@ -150,11 +214,11 @@ hide
 0.25 value *clm-beat*
 set-current
 
-: now@ ( -- secs )   *clm-current-time* ;
-: now! ( secs -- )   to *clm-current-time* ;
-: step ( secs -- )   now@ f+ now! ;
-: tempo@ ( -- secs )   *clm-tempo* ;
-: tempo! ( secs -- )   to *clm-tempo* ;
+: now@ ( -- secs )	*clm-current-time* ;
+: now! ( secs -- )	to *clm-current-time* ;
+: step ( secs -- )	now@ f+ now! ;
+: tempo@ ( -- secs )	*clm-tempo* ;
+: tempo! ( secs -- )	to *clm-tempo* ;
 previous
 
 \ --- Pitches ---
@@ -256,8 +320,8 @@ set-current
 previous
 
 \ --- Note length ---
-: bpm->seconds ( bpm -- secs )   60.0 swap f/ ;
-: rhythm->seconds ( rhy -- secs )   4.0 tempo@ bpm->seconds f* f* ;
+: bpm->seconds ( bpm -- secs )		60.0 swap f/ ;
+: rhythm->seconds ( rhy -- secs )	4.0 tempo@ bpm->seconds f* f* ;
 
 hide
 : notelength ( scale "name" --; self -- r )
@@ -281,33 +345,45 @@ set-current
 previous
 
 \ === Global User Variables (settable in ~/.snd_forth or ~/.fthrc) ===
-"fth 2017/09/25"  value *clm-version*
-#f 	      	  value *locsig*
-mus-lshort    	  value *clm-audio-format*
-#f            	  value *clm-comment*
-1.0           	  value *clm-decay-time*
-#f  	      	  value *clm-delete-reverb*
-"test.snd"    	  value *clm-file-name*
-#f 	      	  value *clm-notehook*
-#f  	      	  value *clm-play*
-#f            	  value *clm-player*           
-#f 	      	  value *clm-reverb*
-1     	      	  value *clm-reverb-channels*
-#()           	  value *clm-reverb-data*
-"test.reverb" 	  value *clm-reverb-file-name*
-#f  	      	  value *clm-statistics*
-#f	      	  value *clm-verbose*
-#f            	  value *clm-debug*
+"fth 2018/01/02"	value *clm-version*
+mus-lshort	value *clm-audio-format*
+#f		value *clm-comment*
+1.0		value *clm-decay-time*
+#f		value *clm-delete-reverb*
+"test.snd"	value *clm-file-name*
+#f		value *clm-notehook*
+#f		value *clm-play*
+#f		value *clm-player*           
+#f		value *clm-reverb*
+1		value *clm-reverb-channels*
+#()		value *clm-reverb-data*
+"test.reverb"	value *clm-reverb-file-name*
+#f		value *clm-statistics*
+#f		value *clm-to-dac*
+#f		value *clm-to-snd*
+#f		value *clm-verbose*
+#f		value *clm-debug*
 "CLM_SEARCH_PATH" getenv "." || ":" string-split value *clm-search-list*
 
 <'> *clm-search-list*
 "List of directories with sound files." help-set!
+
 #() value *clm-instruments*
 <'> *clm-instruments*
 "List of #( ins-name start dur local-vars ) elements.  \
 Instruments using RUN or RUN-INSTRUMENT add entries to the list." help-set!
 
+#() value *dac-instruments*
+<'> *dac-instruments*
+"List of collected dac instruments of #( ins-xt beg end ) elements.  \
+Used with :to-dac #t." help-set!
+
+#f value *clm-current-instrument*
+<'> *clm-current-instrument*
+"Current instrument set in INSTRUMENT:." help-set!
+
 'snd provided? [unless]
+	<'> *clm-file-name* is *clm-fname*
 	1          constant default-output-chans
 	44100      constant default-output-srate
 	mus-next   constant default-output-header-type
@@ -315,33 +391,36 @@ Instruments using RUN or RUN-INSTRUMENT add entries to the list." help-set!
 	1024       constant dac-size
 [then]
 
-default-output-chans       value *clm-channels*
-default-output-srate       value *clm-srate*
-locsig-type                value *clm-locsig-type*
-default-output-header-type value *clm-header-type*
-default-output-sample-type value *clm-sample-type*
-dac-size                   value *clm-rt-bufsize*
-mus-file-buffer-size       value *clm-file-buffer-size*
-mus-clipping               value *clm-clipped*
-mus-array-print-length     value *clm-array-print-length*
-clm-table-size             value *clm-table-size*
-440.0                      value *clm-default-frequency*
-
-\ for backward compatibility
-*clm-sample-type* value *clm-data-format*
-<'> *clm-data-format* lambda: <{ val -- res }>
-	val to *clm-sample-type*
-	val
-; trace-var
+default-output-chans		value *clm-channels*
+default-output-srate		value *clm-srate*
+locsig-type			value *clm-locsig-type*
+default-output-header-type	value *clm-header-type*
+default-output-sample-type	value *clm-sample-type*
+dac-size			value *clm-rt-bufsize*
+mus-file-buffer-size		value *clm-file-buffer-size*
+mus-clipping			value *clm-clipped*
+mus-array-print-length		value *clm-array-print-length*
+clm-table-size			value *clm-table-size*
+440.0				value *clm-default-frequency*
  
 <'> *clm-table-size* lambda: <{ val -- res }>
 	val set-clm-table-size
 ; trace-var
 
+<'> *clm-srate* lambda: <{ val -- res }>
+	val set-mus-srate f>s
+; trace-var
+
 \ internal global variables
-*clm-channels* value *channels*
-*clm-verbose*  value *verbose*
-*clm-notehook* value *notehook*
+*clm-channels*		value *channels*
+*clm-verbose*		value *verbose*
+*clm-notehook*		value *notehook*
+*clm-decay-time*	value *decay-time*
+0.0			value *degree*
+1.0			value *distance*
+0.05			value *reverbamount*
+0			value *start*
+#f			value *outgen*
 
 'snd provided? [if]
 	<'> snd-tempnam alias fth-tempnam
@@ -387,133 +466,11 @@ Produces something like:\n\
 ;
 
 : times->samples { start dur -- len beg }
-	start seconds->samples { beg }
-	dur   seconds->samples { len }
+	start s>f seconds->samples { beg }
+	dur   s>f seconds->samples { len }
 	beg len d+ beg
 ;
 
-\ === With-Sound Run-Instrument ===
-"with-sound error"     create-exception with-sound-error
-"with-sound interrupt" create-exception with-sound-interrupt
-#() value *ws-args*			\ array for recursive with-sound calls 
-#f value *clm-current-instrument*	\ current instrument set in INSTRUMENT:
-
-: ws-local-variables ( -- )
-	nil { vals }
-	*clm-instruments* empty? if
-		"*clm-instruments* is empty" #() clm-message
-	else
-		"" #() clm-message
-		*clm-instruments* each to vals
-			"=== %s [%.3f-%.3f] ==="
-			#( vals 0 array-ref
-			   vals 1 array-ref
-			   vals 2 array-ref ) clm-message
-			vals 3 array-ref each { var }
-				\ var: '( name . value ) )
-				"%s = %s" var clm-message
-			end-each
-			"" #() clm-message
-		end-each
-	then
-;
-
-: ws-info { start dur vars -- start dur }
-	*clm-instruments*
-	    #( *clm-current-instrument* start dur vars ) array-push drop
-	*notehook* word? if
-		*notehook* #( *clm-current-instrument* start dur ) run-proc drop
-	then
-	start dur
-;
-
-hide
-: (run) ( start dur vars -- limit begin ) ws-info times->samples ;
-
-: (run-instrument) { start dur args vars -- limit begin }
-	args hash? unless
-		#{} to args
-	then
-	:degree args :degree hash-ref 0.0 ||
-	    :distance args :distance hash-ref 1.0 ||
-	    :reverb args :reverb hash-ref 0.05 ||
-	    :channels args :channels hash-ref *channels* ||
-	    :output args :output hash-ref *output* ||
-	    :revout args :revout hash-ref *reverb* ||
-	    :type args :type hash-ref locsig-type || make-locsig to *locsig*
-	\ we set channel 3/4 if any to 0.5 * channel 1/2
-	*output* mus-output? if
-		*output* mus-channels 2 > if
-			*locsig* 2
-			    *locsig* 0 locsig-ref f2/
-			    locsig-set! drop
-			*output* mus-channels 3 > if
-				*locsig* 3
-				    *locsig* 1 locsig-ref f2/
-				    locsig-set! drop
-			then
-		then
-	then
-	*reverb* mus-output? if
-		*reverb* mus-channels 2 > if
-			*locsig* 2
-			    *locsig* 0 locsig-reverb-ref f2/
-			    locsig-reverb-set! drop
-			*reverb* mus-channels 3 > if
-				*locsig* 3
-				    *locsig* 1 locsig-reverb-ref f2/
-				    locsig-reverb-set! drop
-			then
-		then
-	then
-	start dur vars (run)
-;
-
-: (end-run) { val idx -- } *locsig* idx val locsig drop ;
-set-current
-
-\ RUN/LOOP is only a simple replacement of
-\ start dur TIMES->SAMPLES ?DO ... LOOP
-\
-\ RUN-INSTRUMENT/END-RUN requires at least an opened *output*
-\ generator (file->sample), optional an opened *reverb* generator.  It
-\ uses LOCSIG to set samples in output file.  At the end of the loop a
-\ sample value must remain on top of stack!
-\
-\ instrument: foo
-\   0 0.1 nil run-instrument 0.2 end-run
-\ ;instrument
-\ <'> foo with-sound
-\
-\ fills a sound file of length 0.1 seconds with 2205 samples (srate
-\ 22050) with 0.2.
-\ 
-\ 0.0 1.0                   RUN            ... LOOP
-\ 0.0 1.0 #{ :degree 45.0 } RUN-INSTRUMENT ... END-RUN
-: run ( start dur -- )
-	postpone local-variables
-	postpone (run)
-	postpone ?do
-; immediate compile-only
-
-: run-instrument ( start dur locsig-args -- )
-	postpone local-variables
-	postpone (run-instrument)
-	postpone ?do
-; immediate compile-only
-
-: end-run ( sample -- )
-	postpone r@
-	postpone (end-run)
-	postpone loop
-; immediate compile-only
-previous
-
-: reverb-info { caller in-chans out-chans -- }
-	"%s on %d in and %d out channels"
-	    #( caller in-chans out-chans ) clm-message
-;
-
 \ === Helper functions for instruments ===
 hide
 : ins-info ( ins-name -- )   to *clm-current-instrument* ;
@@ -540,7 +497,12 @@ set-current
 <'> ;instrument alias ;event immediate
 previous
 
-\ === Playing and Recording Sound Files ===
+<'> #{}      alias #w{}    ( -- ws )
+<'> hash?    alias ws?     ( obj -- f )
+<'> hash-ref alias ws-ref  ( ws key     -- val )
+: ws-set! ( ws key val -- 'ws ) 3 pick >r hash-set! r> ;
+
+\ === Playing Sound Files ===
 : find-file ( file -- fname|#f )
 	doc" Return the possible full path name of FILE if FILE exists or \
 if FILE was found in *CLM-SEARCH-LIST*, otherwise return #f."
@@ -600,19 +562,25 @@ hide
 		"   ratio: no ratio" #()
 	then clm-message
 ;
-set-current
 
-: snd-info <{ output :key reverb-file-name #f scaled? #f timer #f -- }>
+: .file { output chans srate -- }
+	"filename: %s" #( output ) clm-message
+	"   chans: %d, srate: %d" #( chans srate ) clm-message
+;
+
+: .file-info { output reverb-file-name scaled? timer -- }
 	output mus-sound-duration { dur }
 	output mus-sound-framples { frms }
-	output mus-sound-chans { channels }
+	output mus-sound-chans { chans }
 	output mus-sound-srate { srate }
-	"filename: %S" #( output ) clm-message
-	"   chans: %d, srate: %d" #( channels srate f>s ) clm-message
-	"  format: %s [%s]"
-	    #( output mus-sound-sample-type mus-sample-type-name
-	       output mus-sound-header-type mus-header-type-name ) clm-message
-	"  length: %.3f  (%d frames)" #( dur frms ) clm-message
+	output mus-sound-sample-type mus-sample-type-name { st }
+	output mus-sound-header-type mus-header-type-name { ht }
+	output mus-sound-write-date { dt }
+	"%a %b %d %H:%M:%S %Z %Y" dt strftime { tm }
+	output mus-sound-comment { meta }
+	output chans srate .file
+	"  format: %s [%s]"		#( st ht ) clm-message
+	"  length: %.3f  (%d framples)"	#( dur frms ) clm-message
 	timer timer? if
 		timer .timer
 		srate frms timer .timer-ratio
@@ -621,89 +589,713 @@ set-current
 	reverb-file-name ?dup-if
 		"revamp" srate #f .maxamps
 	then
-	output mus-sound-comment { comm }
-	comm empty? unless
-		" comment: %S" #( comm ) clm-message
+	" written: %s"			#( tm ) clm-message
+	meta empty? unless
+		" comment: %s"		#( meta ) clm-message
+	then
+;
+
+: .dac-info { ws -- }
+	ws :timer ws-ref { timer }
+	timer if
+		timer .timer
+		ws :srate ws-ref ws :framples ws-ref timer .timer-ratio
+	then
+;
+set-current
+
+\ obj:	a string or ws object
+\	string: an existing file name (for play-sound)
+\	    ws: *clm-to-dac* is #t and keyargs are not used
+: snd-info { obj -- }
+	obj string? if
+		obj #f #f #f .file-info
+	else
+		*clm-to-dac* if
+			obj .dac-info
+		else
+			obj :output ws-ref		{ output }
+			obj :reverb-file-name ws-ref	{ reverb-file }
+			obj :scaled-to ws-ref
+			obj :scaled-by ws-ref ||	{ scaled }
+			obj :timer ws-ref		{ tm }
+			output reverb-file scaled tm .file-info
+		then
 	then
 ;
+
+: dac-info { ws -- }
+	ws :output ws-ref ws :channels ws-ref ws :srate ws-ref .file
+;
 previous
 
+\ === Playing Sounds ===
+
+defer ws-play
+
+: play-sound <{ :optional
+    input   *clm-file-name*
+    verbose *clm-verbose*
+    player  *clm-player* -- }>
+	doc" Play sound file INPUT.\n\
+\"bell.snd\" #t play-sound\n\
+\"bell.snd\" #f \"sndplay\" play-sound"
+	input string? if
+		input find-file dup unless
+			drop
+			'no-such-file
+			    #( "%s: %s" get-func-name input ) fth-throw
+		else
+			to input
+		then
+	else
+		input mus-output? if
+			input mus-file-name
+		else
+			*output* mus-output? if
+				*output* mus-file-name
+			else
+				#f
+			then
+		then to input
+	then
+	input if
+		verbose if
+			input snd-info
+		then
+		#w{} :output input ws-set! :player player ws-set! ws-play
+	then
+;
+
+'snd provided? [unless]
+	: play ( keyword-args :optional obj -- f )
+		:start		#f get-optkey drop
+		:end		#f get-optkey drop
+		:channel	#f get-optkey drop
+		:edit-position	#f get-optkey drop
+		:out-channel	#f get-optkey drop
+		:with-sync	#f get-optkey drop
+		:wait		#f get-optkey drop
+		:stop		#f get-optkey drop
+		:srate		#f get-optkey drop
+		:channels	#f get-optkey drop
+		0 *clm-file-name* get-optarg #f #f play-sound
+		#f
+	;
+[then]
+
 : clm-mix <{ infile :key
     output #f
     output-frame 0
-    frames #f
+    framples #f
     input-frame 0
     scaler #f -- }>
 	doc" Mix files in with-sound's *output* generator.\n\
 \"oboe.snd\" clm-mix\n\
 Mixes oboe.snd in *output* at *output*'s \
 location 0 from oboe.snd's location 0 on.  \
-The whole oboe.snd file will be mixed in because :frames is not specified."
+The whole oboe.snd file will be mixed in because :framples is not specified."
 	0 { chans }
 	*output* mus-output? { outgen }
+	*output* sound? { outsnd }
 	output unless
 		outgen if
 			*output* mus-channels to chans
 			*output* mus-file-name to output
 		else
-			'with-sound-error
-			    #( "%s: *output* gen or :output required"
-			       get-func-name ) fth-throw
+			outsnd if
+				*output* channels to chans
+				*output* file-name to output
+			else
+				'with-sound-error
+				    #( "%s: *output* gen or :output required"
+				       get-func-name ) fth-throw
+			then
 		then
 	then
 	infile find-file to infile
 	infile unless
 		'file-not-found
-		    #( "%s: can't find %S" get-func-name infile ) fth-throw
+		    #( "%s: %S not found" get-func-name infile ) fth-throw
 	then
-	frames
+	framples
 	infile mus-sound-framples || dup unless
 		drop undef
-	then to frames
+	then to framples
 	outgen if
 		*output* mus-close drop
+	else
+		outsnd if
+			*output* save-sound drop
+			*output* close-sound drop
+		then
 	then
-	chans 0>
-	scaler &&
-	scaler f0<> && if
-		chans chans * scaler make-vct
+	scaler number? if
+		scaler f0<> scaler 1.0 f<> && if
+			chans chans * scaler make-vct
+		else
+			#f
+		then
 	else
 		#f
 	then { mx }
 	output       ( outfile )
 	infile       ( infile )
 	output-frame ( outloc )
-	frames       ( frames )
+	framples     ( framples )
 	input-frame  ( inloc )
 	mx           ( matrix )
 	#f           ( envs ) mus-file-mix drop
 	outgen if
 		output continue-sample->file to *output*
+	else
+		outsnd if
+			output open-sound to *output*
+		then
 	then
 ;
 
-[ifundef] ws-is-array?
-	#f value ws-is-array?
-[then]
+\ === With-Sound Run-Instrument ===
+"with-sound error"     create-exception with-sound-error
+"with-sound interrupt" create-exception with-sound-interrupt
+#() value *ws-args*			\ array for recursive with-sound calls 
 
-ws-is-array? [if]
-	<'> #()              alias #w{}    ( -- ws )
-	<'> array?           alias ws?     ( obj -- f )
-	<'> array-assoc-ref  alias ws-ref  ( ws key     -- val )
-	<'> array-assoc-set! alias ws-set! ( ws key val -- 'ws )
-[else]
-	<'> #{}              alias #w{}    ( -- ws )
-	<'> hash?            alias ws?     ( obj -- f )
-	<'> hash-ref         alias ws-ref  ( ws key     -- val )
-	: ws-set! ( ws key val -- 'ws ) 3 pick >r hash-set! r> ;
-[then]
+: ws-local-variables ( -- )
+	nil { vals }
+	*clm-instruments* empty? if
+		"*clm-instruments* is empty" #() clm-message
+	else
+		"" #() clm-message
+		*clm-instruments* each to vals
+			"=== %s [%.3f-%.3f] ==="
+			#( vals 0 array-ref
+			   vals 1 array-ref
+			   vals 2 array-ref ) clm-message
+			vals 3 array-ref each { var }
+				\ var: '( name value ) )
+				"%16s = %s" var clm-message
+			end-each
+			"" #() clm-message
+		end-each
+	then
+;
+
+: ws-info { start dur vars -- start dur }
+	start s>f to start
+	dur   s>f to dur
+	#( *clm-current-instrument* start dur vars ) { args }
+	*clm-instruments* args array-push drop
+	args array-pop drop
+	*notehook* word? if
+		*notehook* args run-proc drop
+	then
+	start dur
+;
+
+hide
+defer (run) ( start dur vars -- end beg )
+
+: (run-snd) ( start dur vars -- end beg )
+	ws-info ( start dur ) nip seconds->samples 0
+;
+
+: (run-clm) ( start dur vars -- end beg )
+	ws-info ( start dur ) times->samples ( end beg )
+;
+
+defer (run-instrument) ( start dur args vars -- end beg )
+
+: f0<>|| { res def -- val }
+	res number? if
+		res f0<> if
+			res
+		else
+			def
+		then
+	else
+		def
+	then
+;
+
+: (run-snd-instrument) { start dur args vars -- end beg }
+	args hash? unless
+		#{} to args
+	then
+	args :degree	hash-ref 45.0	f0<>|| to *degree*
+	args :distance	hash-ref 1.0	f0<>|| to *distance*
+	args :reverb	hash-ref 0.05	f0<>|| to *reverbamount*
+	start s>f seconds->samples to *start*
+	dur   s>f seconds->samples 0.0 make-vct to *outgen*
+	start dur vars (run-snd) ( end beg )
+;
+
+: (run-clm-instrument) { start dur args vars -- end beg }
+	args hash? unless
+		#{} to args
+	then
+	:degree		args :degree	hash-ref 45.0		f0<>||
+	:distance	args :distance	hash-ref *distance*	f0<>||
+	:reverb		args :reverb	hash-ref *reverbamount*	f0<>||
+	:channels	args :channels	hash-ref *channels*	||
+	:output		args :output	hash-ref *output*	||
+	:revout		args :revout	hash-ref *reverb*	||
+	:type		args :type	hash-ref locsig-type	||
+	make-locsig to *outgen*
+	start dur vars (run-clm) ( end beg )
+;
+
+defer (end-run) ( val idx -- )
+
+: (end-snd-run) ( val idx -- )
+	\ gen idx val gen-set!
+	\ *outgen* => vct
+	*outgen* swap rot vct-set! drop
+;
+
+: (end-clm-run) ( val idx -- )
+	\ gen idx val gen-set!
+	\ *outgen* => locsig gen
+	*outgen* swap rot locsig drop
+;
+
+defer (end-run-finish) ( -- )
+
+: (end-snd-run-finish) ( -- )
+	*start*         { beg }
+	*output*        { snd }
+	0               { chn }
+	snd channels    { chans }
+	*outgen*        { v }
+	*degree*        { frac }
+	*distance*      { scl }
+	scl             { s }
+	chans 1 = if
+		v scl vct-scale! beg snd chn #f undef mix-vct drop
+	else
+		*degree* 90.0 f/ to frac
+		scl 1.0 frac f- f*	{ left }
+		scl frac f*		{ right }
+		chans 2 = if
+			0 to chn
+			v vct-copy left vct-scale!
+			beg snd chn #f undef mix-vct drop
+			1 to chn
+			v right vct-scale!
+			beg snd chn #f undef mix-vct drop
+		else
+			chans 1 do i to chn
+				i 2 mod if
+					right
+				else
+					left
+				then to s
+				v vct-copy s vct-scale!
+				beg snd chn #f undef mix-vct drop
+			loop
+			0 to chn
+			right to s
+			v s vct-scale!
+			beg snd chn #f undef mix-vct drop
+		then
+	then
+	*reverb* sound? if
+		v vct-length { len }
+		v *reverbamount* vct-scale!
+		beg len *reverb* 0 #f undef vct->channel drop
+	then
+;
+set-current
+
+\ RUN/LOOP is only a simple replacement of
+\ start dur TIMES->SAMPLES ?DO ... LOOP
+\
+\ RUN-INSTRUMENT/END-RUN for use with with-sound instruments.
+\ Requires at least an opened *output* (file->sample or sound),
+\ optional an opened *reverb* generator or sound.  At the end of
+\ the loop a sample value must remain on stack!
+\
+\ instrument: foo
+\   0 0.1 nil run-instrument 0.2 end-run
+\ ;instrument
+\ <'> foo :srate 22050 with-sound
+\
+\ fills a sound file of length 0.1 seconds with 2205 samples (srate
+\ 22050) with 0.2.
+\ 
+\ 0.0 1.0                   RUN            ... LOOP
+\ 0.0 1.0 #{ :degree 45.0 } RUN-INSTRUMENT ... END-RUN
+: run ( start dur -- )
+	postpone local-variables
+	postpone (run)
+	postpone ?do
+; immediate compile-only
+
+: run-instrument ( start dur locsig-args -- )
+	postpone local-variables
+	postpone (run-instrument)
+	postpone ?do
+; immediate compile-only
+
+: end-run ( sample -- )
+	postpone r@
+	postpone (end-run)
+	postpone loop
+	postpone (end-run-finish)
+; immediate compile-only
+previous
+
+defer ws-outa		( idx val gen -- )
+defer ws-outb		( idx val gen -- )
+defer ws-outc		( idx val gen -- )
+defer ws-outd		( idx val gen -- )
+defer ws-out-any	( idx val chn gen -- )
+
+\ XXX: ws-snd-outX
+\ We vct-set sample in a fresh vct, later vct-mix'ed in the sound.
+\ No need for vct-ref val f+ vct-set here.
+
+: ws-snd-out-any { idx val chn gen -- }
+	swap array-ref rot rot vct-set! drop
+;
+
+: ws-snd-outa ( idx val gen -- )
+	0 array-ref rot rot vct-set! drop
+;
+
+: ws-snd-outb ( idx val gen -- )
+	1 array-ref rot rot vct-set! drop
+;
+
+: ws-snd-outc ( idx val gen -- )
+	2 array-ref rot rot vct-set! drop
+;
+
+: ws-snd-outd ( idx val gen -- )
+	3 array-ref rot rot vct-set! drop
+;
+
+: ws-clm-out-any ( idx val chn gen -- )	out-any drop ;
+: ws-clm-outa	( idx val gen -- )	outa drop ;
+: ws-clm-outb	( idx val gen -- )	outb drop ;
+: ws-clm-outc	( idx val gen -- )	outc drop ;
+: ws-clm-outd	( idx val gen -- )	outd drop ;
+
+\ XXX: *clm-to-snd* == #t   idx gen ina etc.
+\ If gen is a vct, ina, inb, and in-any all return the same value.
+\ If gen is an array, it should be an array of numbers not of vcts.
+\
+\ #( vct( 0 1 2 ) vct( 2 1 0 ) ) value gen
+\ builds not the expected stereo gen
+\ 0 gen inb => garbage ( first vct taken as double )
+
+<'> ina		alias ws-ina
+<'> inb		alias ws-inb
+<'> in-any	alias ws-in-any
+
+: reverb-info { caller in-chans out-chans -- }
+	"%s on %d in and %d out channels"
+	    #( caller in-chans out-chans ) clm-message
+;
+
+hide
+defer (run-reverb) ( dur vars -- end beg )
+
+: rr-before-reverb { dur vars -- end beg }
+	0.0 dur vars ws-info ( start dur ) times->samples { end beg }
+	*verbose* if
+		*clm-current-instrument* *reverb* channels *output* channels
+		    reverb-info
+	then
+	end beg
+;
+
+#f value old-*output*
+#f value old-*reverb*
+
+: (run-snd-reverb) { dur vars -- end beg }
+	dur vars rr-before-reverb { end beg }
+	*output* save-sound drop
+	*output* to old-*output*
+	*output* channels make-array map!
+		beg end *output* i #f channel->vct
+	end-map to *output*
+	*reverb* save-sound drop
+	*reverb* to old-*reverb*
+	beg end *reverb* 0 #f channel->vct to *reverb*
+	\ *output* is Array of Vcts
+	\ *reverb* is Vct
+	beg to *start*
+	end 0
+;
+
+: (run-clm-reverb) { dur vars -- end beg }
+	dur vars rr-before-reverb { end beg }
+	*reverb* to old-*reverb*
+	*reverb* mus-file-name { revfile }
+	revfile undef make-file->sample to *reverb*
+	*reverb* file->sample? unless
+		'with-sound-error
+		    #( "%s: can't open %s" get-func-name revfile ) fth-throw
+	then
+	\ *output* is sample->file (mus-output)
+	\ *reverb* is file->sample (mus-input)
+	beg to *start*
+	end 0
+;
+
+: (run-reverb-inval-1) ( idx -- in-val )
+	*reverb* ina
+;
+
+: (end-run-reverb-1) ( samp idx -- )
+	swap *output* ws-outa
+;
+
+: (end-run-reverb-2) { samp1 samp2 idx -- }
+	idx samp1 *output* ws-outa
+	idx samp2 *output* ws-outb
+;
+
+: (end-run-reverb-4) { samp1 samp2 samp3 samp4 idx -- }
+	idx samp1 *output* ws-outa
+	idx samp2 *output* ws-outb
+	idx samp3 *output* ws-outc
+	idx samp4 *output* ws-outd
+;
+
+defer (end-run-reverb-finish) ( -- )
+
+: (end-snd-run-reverb-finish) ( -- )
+	*output* each ( v )
+		*start* old-*output* i #f undef mix-vct drop
+	end-each
+	old-*output* to *output*
+	old-*reverb* to *reverb*
+;
+
+: (end-clm-run-reverb-finish) ( -- )
+	*output* mus-close drop
+	*reverb* mus-close drop
+	old-*reverb* to *reverb*
+;
+set-current
+
+\ RUN-REVERB/END-RUN-REVERB-OUT-1|2|4 for use with with-sound reverb
+\ instruments.  Requires an opened *output* (file->sample or sound)
+\ and an opened *reverb* generator or sound.  The inval is the sample
+\ from the reverb file, the out samples are written to the output
+\ file.
+\
+\ run-reverb ( dur -- inval )
+\ end-run-reverb-out-1 ( samp -- )
+\ end-run-reverb-out-2 ( samp1 samp2 -- )
+\
+\ reverb for mono output file:
+\ 10.0 run-reverb { inval }
+\	inval 2.0 f*
+\ end-run-reverb-out-1
+\
+\ reverb for stereo output file:
+\ 10.0 run-reverb { inval }
+\	inval 2.0 f* ( samp1 )
+\	inval 4.0 f* ( samp1 samp2 )
+\ end-run-reverb-out-2
+\
+\ reverb for quad output file:
+\ 10.0 run-reverb { inval }
+\	inval 2.0 f* ( samp1 )
+\	inval 4.0 f* ( samp1 samp2 )
+\	inval 2.0 f* ( samp1 samp2 samp3 )
+\	inval 4.0 f* ( samp1 samp2 samp3 samp4 )
+\ end-run-reverb-out-4
+
+: run-reverb ( dur -- in-val )
+	postpone local-variables
+	postpone (run-reverb)
+	postpone ?do
+	postpone r@
+	postpone (run-reverb-inval-1)
+; immediate compile-only
+
+: end-run-reverb ( -- )
+	postpone loop
+	postpone (end-run-reverb-finish)
+; immediate compile-only
+
+: end-run-reverb-out-1 ( samp -- )
+	postpone r@
+	postpone (end-run-reverb-1)
+	postpone loop
+	postpone (end-run-reverb-finish)
+; immediate compile-only
+
+: end-run-reverb-out-2 ( samp1 samp2 - )
+	postpone r@
+	postpone (end-run-reverb-2)
+	postpone loop
+	postpone (end-run-reverb-finish)
+; immediate compile-only
+
+: end-run-reverb-out-4 ( samp1 samp2 samp3 samp4 - )
+	postpone r@
+	postpone (end-run-reverb-4)
+	postpone loop
+	postpone (end-run-reverb-finish)
+; immediate compile-only
+
+: set-to-snd ( f -- )
+	( f ) 'snd provided? && if
+		#t to *clm-to-snd*
+		\ RUN-INSTRUMENT
+		<'> (run-snd)			[is] (run)
+		<'> (run-snd-instrument)	[is] (run-instrument)
+		<'> (end-snd-run)		[is] (end-run)
+		<'> (end-snd-run-finish)	[is] (end-run-finish)
+		\ RUN-REVERB
+		<'> (run-snd-reverb)		[is] (run-reverb)
+		<'> (end-snd-run-reverb-finish)	[is] (end-run-reverb-finish)
+		\ OUT-ANY
+		<'> ws-snd-outa			[is] ws-outa
+		<'> ws-snd-outb			[is] ws-outb
+		<'> ws-snd-outc			[is] ws-outc
+		<'> ws-snd-outd			[is] ws-outd
+		<'> ws-snd-out-any		[is] ws-out-any
+	else
+		#f to *clm-to-snd*
+		\ RUN-INSTRUMENT
+		<'> (run-clm)			[is] (run)
+		<'> (run-clm-instrument)	[is] (run-instrument)
+		<'> (end-clm-run)		[is] (end-run)
+		<'> noop			[is] (end-run-finish)
+		\ RUN-REVERB
+		<'> (run-clm-reverb)		[is] (run-reverb)
+		<'> (end-clm-run-reverb-finish)	[is] (end-run-reverb-finish)
+		\ OUT-ANY
+		<'> ws-clm-outa			[is] ws-outa
+		<'> ws-clm-outb			[is] ws-outb
+		<'> ws-clm-outc			[is] ws-outc
+		<'> ws-clm-outd			[is] ws-outd
+		<'> ws-clm-out-any		[is] ws-out-any
+	then
+;
+previous
+
+\ Instruments prepared with run-gen-instrument ... end-run-gen can
+\ be used for map-channel or ":to-dac #t with-sound".  Example
+\ instruments and gen tests can be found at the end of this file.
+\
+\ <'> test-gen :channels 1 :srate 22050 :to-dac #t with-sound drop
+\ <'> violin-gen-test :channels 1 :srate 11025 :to-dac #t with-sound drop
+\ or
+\ test-gen run-gen map-channel
+\ violin-gen-test run-gen map-channel
+hide
+lambda: <{ a b -- f }>
+	a 1 array-ref { ba }
+	b 1 array-ref { bb }
+	ba bb < if
+		-1
+	else
+		ba bb > if
+			1
+		else
+			0
+		then
+	then
+; value dac-sort
+
+lambda: <{ a b -- f }>
+	a 1 array-ref { ba }
+	b 1 array-ref { bb }
+	ba bb f< if
+		-1
+	else
+		ba bb f> if
+			1
+		else
+			0
+		then
+	then
+; value clm-sort
+
+: (run-gen-instrument) { start dur dummy vars -- vars }
+	start s>f to start
+	dur   s>f to dur
+	#( *clm-current-instrument* start dur vars ) { args }
+	*clm-instruments* args array-push clm-sort array-sort! drop
+	start dur times->samples { end beg }
+	1 proc-create { prc }
+	*dac-instruments* #( prc beg end ) array-push dac-sort array-sort! drop
+	vars
+;
+set-current
+
+: run-gen-instrument ( start dur dummy --; samp args -- val )
+	\ This replaces the following:
+	\ 	start dur dummy local-variables (instrument-does) ,
+	\   does> ( samp self -- val )
+	\ 	@	this replaces self's address with its contents,
+	\ 		a hash with local variables
+	\ the stack is now: ( samp args )
+	postpone local-variables
+	postpone (run-gen-instrument) ( vars ) postpone compile,
+	postpone does> ( samp self -- val )
+	postpone @ ( samp args )
+; immediate compile-only
+
+<'> noop	alias end-run-gen
+<'> hash-ref	alias args@
+
+: run-gen-body { samp y -- y' }
+	0 0 { beg end }
+	nil nil { args prc }
+	*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
+		then
+	end-each
+	y
+;
+
+\ 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' )
+	*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
+	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
+;
+previous
 
 hide
 : ws-get-snd ( ws -- snd )
 	( ws ) :output ws-ref find-file { fname }
-	fname 0 find-sound dup sound? if
-		dup save-sound drop close-sound
-	then drop
+	fname 0 find-sound { snd }
+	snd sound? if
+		snd save-sound drop
+		snd close-sound drop
+	then
 	fname open-sound
 ;
 
@@ -748,67 +1340,63 @@ hide
 ;
 
 : ws-before-output { ws -- }
-	ws     :old-table-size         clm-table-size         ws-set!
-	( ws ) :old-file-buffer-size   mus-file-buffer-size   ws-set!
-	( ws ) :old-array-print-length mus-array-print-length ws-set!
-	( ws ) :old-clipped            mus-clipping           ws-set!
-	( ws ) :old-srate              mus-srate              ws-set!
-	( ws ) :old-locsig-type        locsig-type            ws-set!
-	( ws ) :old-*output*           *output*               ws-set!
-	( ws ) :old-*reverb*           *reverb*               ws-set!
-	( ws ) :old-verbose            *verbose*              ws-set! 
-	( ws ) :old-debug              *clm-debug*            ws-set!
-	( ws ) :old-channels           *channels*             ws-set!
-	( ws ) :old-notehook           *notehook*             ws-set!
-	( ws ) :old-decay-time         *clm-decay-time*       ws-set! to ws
-	ws :verbose              ws-ref to *verbose*
-	ws :debug                ws-ref to *clm-debug*
-	ws :channels             ws-ref to *channels*
-	ws :notehook             ws-ref to *notehook*
-	ws :decay-time           ws-ref to *clm-decay-time*
-	*clm-file-buffer-size*   set-mus-file-buffer-size   drop
-	*clm-array-print-length* set-mus-array-print-length drop
+	ws     :old-table-size		clm-table-size		ws-set!
+	( ws ) :old-file-buffer-size	mus-file-buffer-size	ws-set!
+	( ws ) :old-array-print-length	mus-array-print-length	ws-set!
+	( ws ) :old-clipped		mus-clipping		ws-set!
+	( ws ) :old-srate		mus-srate f>s		ws-set!
+	( ws ) :old-locsig-type		locsig-type		ws-set!
+	( ws ) :old-*output*		*output*		ws-set!
+	( ws ) :old-*reverb*		*reverb*		ws-set!
+	( ws ) :old-verbose		*verbose*		ws-set! 
+	( ws ) :old-debug		*clm-debug*		ws-set!
+	( ws ) :old-channels		*channels*		ws-set!
+	( ws ) :old-notehook		*notehook*		ws-set!
+	( ws ) :old-decay-time		*clm-decay-time*	ws-set! to ws
+	ws :verbose	ws-ref to *verbose*
+	ws :debug	ws-ref to *clm-debug*
+	ws :channels	ws-ref to *channels*
+	ws :notehook	ws-ref to *notehook*
+	ws :decay-time	ws-ref to *clm-decay-time*
+	*clm-file-buffer-size*		set-mus-file-buffer-size drop
+	*clm-array-print-length*	set-mus-array-print-length drop
 	ws :scaled-to ws-ref
 	ws :scaled-by ws-ref || if
 		#( mus-bfloat
 		   mus-lfloat
 		   mus-bdouble
 		   mus-ldouble ) ws :sample-type ws-ref array-member? if
-			#f set-mus-clipping
+			#f
 		else
-			*clm-clipped* set-mus-clipping
+			*clm-clipped*
 		then
 	else
-		*clm-clipped* set-mus-clipping
-	then drop
-	ws :srate       ws-ref set-mus-srate   drop
-	ws :locsig-type ws-ref set-locsig-type drop
+		*clm-clipped*
+	then set-mus-clipping drop
+	ws :to-dac ws-ref if
+		#t set-mus-clipping drop
+	then
+	ws :srate	ws-ref set-mus-srate drop
+	ws :locsig-type	ws-ref set-locsig-type drop
 ;
 
 : ws-after-output { ws -- ws }
-	ws :old-table-size         ws-ref set-clm-table-size         drop
-	ws :old-file-buffer-size   ws-ref set-mus-file-buffer-size   drop
-	ws :old-array-print-length ws-ref set-mus-array-print-length drop
-	ws :old-clipped            ws-ref set-mus-clipping           drop
-	ws :old-srate       	   ws-ref set-mus-srate              drop
-	ws :old-locsig-type 	   ws-ref set-locsig-type            drop
-	ws :old-*output*    	   ws-ref to *output*
-	ws :old-*reverb*    	   ws-ref to *reverb*
-	ws :old-verbose     	   ws-ref to *verbose*
-	ws :old-debug       	   ws-ref to *clm-debug*
-	ws :old-channels    	   ws-ref to *channels*
-	ws :old-notehook    	   ws-ref to *notehook*
-	ws :old-decay-time  	   ws-ref to *clm-decay-time*
+	ws :old-table-size		ws-ref set-clm-table-size drop
+	ws :old-file-buffer-size	ws-ref set-mus-file-buffer-size drop
+	ws :old-array-print-length	ws-ref set-mus-array-print-length drop
+	ws :old-clipped			ws-ref set-mus-clipping drop
+	ws :old-srate			ws-ref set-mus-srate drop
+	ws :old-locsig-type		ws-ref set-locsig-type drop
+	ws :old-*output*		ws-ref to *output*
+	ws :old-*reverb*		ws-ref to *reverb*
+	ws :old-verbose			ws-ref to *verbose*
+	ws :old-debug			ws-ref to *clm-debug*
+	ws :old-channels		ws-ref to *channels*
+	ws :old-notehook		ws-ref to *notehook*
+	ws :old-decay-time		ws-ref to *clm-decay-time*
 	*ws-args* array-pop
 ;
 
-: ws-statistics { ws -- }
-	ws :output ws-ref
-	    :reverb-file-name ws :reverb-file-name ws-ref
-	    :scaled?          ws :scaled-to ws-ref ws :scaled-by ws-ref ||
-	    :timer            ws :timer ws-ref   snd-info
-;
-
 : set-args { key def ws -- }
 	key def get-optkey ws key rot ws-set! to ws
 ;
@@ -816,8 +1404,7 @@ set-current
 
 \ player: xt, proc, string, or #f.
 \
-\       xt: output player execute
-\     proc: player #( output ) run-proc
+\  xt/proc: player #( output ) run-proc
 \   string: "player output" system
 \ else snd: output :wait #t play
 \   or clm: output play-sound
@@ -825,65 +1412,122 @@ set-current
 \ A player may look like this:
 \
 \ : play-3-times { output -- }
-\ 	3 0 ?do
+\ 	3 0 do
 \		output :wait #t play drop
 \	loop
 \ ;
 \ <'> play-3-times to *clm-player*
 
-defer ws-play
-: ws-play-it { ws -- }
+: (ws-play) { ws -- }
 	ws :output ws-ref { output }
 	ws :player ws-ref { player }
 	player word? if
-		player #( output ) run-proc
+		player #( output ) run-proc drop
 	else
+		player unless
+			"sndplay" to player
+		then
 		player string? if
-			player $space $+ output $+ file-system
+			"%s %s" '( player output ) string-format { cmd }
+			cmd file-system unless
+				    "%s: can't execute %S (exit %d)"
+					'( get-func-name cmd
+					   exit-status ) fth-warning
+			then
 		else
 			'snd provided? if
-				output find-file :wait #t ws-play
+				output find-file :wait #t play drop
 			else
-				"sndplay " output $+ file-system
+				"%s: no player found for %s"
+				    '( get-func-name output ) fth-warning
 			then
 		then
-	then drop
+	then
 ;
+<'> (ws-play) is ws-play
 
 : ws-output ( ws -- fname )
 	:output ws-ref
 ;
 
+: ws-framples { gen -- len }
+	0 { len }
+	gen sound? if
+		gen #f #f framples to len
+	else
+		#f { cont }
+		gen mus-output? if
+			#t to cont
+			gen mus-close drop
+		then
+		gen file-name mus-sound-framples to len
+		cont if
+			gen file-name continue-sample->file to gen
+		then
+	then
+	len
+;
+
+'snd provided? [if]
+	: ws-close-snd { fname -- }
+		fname 0 find-sound { snd }
+		snd sound? if
+			snd close-sound drop
+		then
+	;
+[else]
+	: ws-close-snd ( fname -- ) drop ;
+[then]
+
+: ws-is-output? ( gen -- f )
+	*clm-to-snd* if
+		sound?
+	else
+		mus-output?
+	then
+;
+previous
+
+hide
 : with-sound-default-args ( keyword-args -- ws )
 	#() to *clm-instruments*
+	#() to *dac-instruments*
 	#w{} { ws }
 	*ws-args* ws array-push to *ws-args*
-	:channels          *clm-channels*         ws set-args
-	:clipped           *clm-clipped*          ws set-args
-	:comment           *clm-comment*          ws set-args
-	:continue-old-file #f                     ws set-args
-	:sample-type       *clm-sample-type*      ws set-args
-	:debug             *clm-debug*            ws set-args
-	:decay-time        *clm-decay-time*       ws set-args
-	:delete-reverb     *clm-delete-reverb*    ws set-args
-	:header-type       *clm-header-type*      ws set-args
-	:locsig-type       *clm-locsig-type*      ws set-args
-	:notehook          *clm-notehook*         ws set-args
-	:output            *clm-file-name*        ws set-args
-	:play              *clm-play*             ws set-args
-	:player            *clm-player*           ws set-args
-	:reverb            *clm-reverb*           ws set-args
-	:reverb-channels   *clm-reverb-channels*  ws set-args
-	:reverb-data       *clm-reverb-data*      ws set-args
-	:reverb-file-name  *clm-reverb-file-name* ws set-args
-	:scaled-by         #f                     ws set-args
-	:scaled-to         #f                     ws set-args
-	:srate             *clm-srate*            ws set-args
-	:statistics        *clm-statistics*       ws set-args
-	:verbose           *clm-verbose*          ws set-args
-	\ for backward compatibility
-	:data-format *clm-sample-type* get-optkey
-	    ws :sample-type rot ws-set! to ws
+	:channels		*clm-channels*		ws set-args
+	:clipped		*clm-clipped*		ws set-args
+	:comment		*clm-comment*		ws set-args
+	:continue-old-file	#f			ws set-args
+	:debug			*clm-debug*		ws set-args
+	:decay-time		*clm-decay-time*	ws set-args
+	:delete-reverb		*clm-delete-reverb*	ws set-args
+	:header-type		*clm-header-type*	ws set-args
+	:locsig-type		*clm-locsig-type*	ws set-args
+	:notehook		*clm-notehook*		ws set-args
+	:output			*clm-file-name*		ws set-args
+	:play			*clm-play*		ws set-args
+	:player			*clm-player*		ws set-args
+	:reverb			*clm-reverb*		ws set-args
+	:reverb-channels	*clm-reverb-channels*	ws set-args
+	:reverb-data		*clm-reverb-data*	ws set-args
+	:reverb-file-name	*clm-reverb-file-name*	ws set-args
+	:sample-type		*clm-sample-type*	ws set-args
+	:scaled-by		#f			ws set-args
+	:scaled-to		#f			ws set-args
+	:srate			*clm-srate*		ws set-args
+	:statistics		*clm-statistics*	ws set-args
+	:to-snd			*clm-to-snd*		ws set-args	
+	:to-dac			*clm-to-dac*		ws set-args	
+	:verbose		*clm-verbose*		ws set-args
+	ws :to-dac ws-ref if
+		:output "dac" ws set-args
+	else
+		ws :output ws-ref "dac" string= if
+			:to-dac #t ws set-args
+		then
+	then
+	ws :to-dac ws-ref to *clm-to-dac*
+	ws :to-snd ws-ref set-to-snd
 	ws
 ;  
 
@@ -891,36 +1535,103 @@ defer ws-play
 	#w{} { ws }
 	*ws-args* -1 array-ref { ws1 }
 	*ws-args* ws array-push to *ws-args*
-	:play              #f                    ws set-args
-	:player            #f                    ws set-args
-	:statistics        #f                    ws set-args
-	:continue-old-file #f               	 ws set-args
-	:verbose           ws1 :verbose     	 ws-ref ws set-args
-	:debug             ws1 :debug       	 ws-ref ws set-args
-	:output            ws1 :output      	 ws-ref ws set-args
-	:channels          ws1 :channels    	 ws-ref ws set-args
-	:srate             ws1 :srate       	 ws-ref ws set-args
-	:locsig-type       ws1 :locsig-type 	 ws-ref ws set-args
-	:header-type       ws1 :header-type 	 ws-ref ws set-args
-	:sample-type       ws1 :sample-type 	 ws-ref ws set-args
+	:continue-old-file	#f ws set-args
+	:play			#f ws set-args
+	:player			#f ws set-args
+	:statistics		#f ws set-args
+	:channels		ws1 :channels		ws-ref ws set-args
 	:comment "with-sound level %d"
 	    #( *ws-args* length ) string-format ws set-args
-	:notehook          ws1 :notehook         ws-ref ws set-args
-	:scaled-to         ws1 :scaled-to        ws-ref ws set-args
-	:scaled-by         ws1 :scaled-by        ws-ref ws set-args
-	:delete-reverb     ws1 :delete-reverb    ws-ref ws set-args
-	:reverb            ws1 :reverb           ws-ref ws set-args
-	:reverb-data       ws1 :reverb-data      ws-ref ws set-args
-	:reverb-channels   ws1 :reverb-channels  ws-ref ws set-args
-	:reverb-file-name  ws1 :reverb-file-name ws-ref ws set-args
-	:decay-time        ws1 :decay-time       ws-ref ws set-args
-	\ for backward compatibility
-	:data-format ws1 :sample-type ws-ref get-optkey
-	    ws :sample-type rot ws-set! to ws
+	:debug			ws1 :debug		ws-ref ws set-args
+	:decay-time		ws1 :decay-time		ws-ref ws set-args
+	:delete-reverb		ws1 :delete-reverb	ws-ref ws set-args
+	:header-type		ws1 :header-type	ws-ref ws set-args
+	:locsig-type		ws1 :locsig-type	ws-ref ws set-args
+	:notehook		ws1 :notehook		ws-ref ws set-args
+	:output			ws1 :output		ws-ref ws set-args
+	:reverb			ws1 :reverb		ws-ref ws set-args
+	:reverb-channels	ws1 :reverb-channels	ws-ref ws set-args
+	:reverb-data		ws1 :reverb-data	ws-ref ws set-args
+	:reverb-file-name	ws1 :reverb-file-name	ws-ref ws set-args
+	:sample-type		ws1 :sample-type	ws-ref ws set-args
+	:scaled-by		ws1 :scaled-by		ws-ref ws set-args
+	:scaled-to		ws1 :scaled-to		ws-ref ws set-args
+	:srate			ws1 :srate		ws-ref ws set-args
+	:verbose		ws1 :verbose		ws-ref ws set-args
 	ws
 ;
 
-: with-sound-main { body-xt ws -- ws }
+: ws-is-sound? ( gen -- f )
+	*clm-to-snd* if
+		sound?
+	else
+		sample->file?
+	then
+;
+
+: ws-create-sound { fname chans sr st ht com -- gen }
+	*clm-to-snd* if
+		save-stack { rest }
+		fname chans sr st ht com 1 new-sound { gen }
+		rest restore-stack gen
+	else
+		fname chans st ht com make-sample->file
+	then
+;
+
+: ws-continue-sound { fname -- gen }
+	*clm-to-snd* if
+		fname 0 find-sound
+	else
+		fname continue-sample->file
+	then
+;
+
+: ws-close-sound { gen -- }
+	*clm-to-snd* if
+		gen sound? if
+			gen save-sound drop
+			gen close-sound drop
+		then
+	else
+		gen file-name ws-close-snd
+		gen mus-close drop
+	then
+;
+
+: ws-reset-handler <{ retval -- }>
+	stack-reset
+	*output* if
+		*output* ws-close-sound
+	then
+	*reverb* if
+		*reverb* ws-close-sound
+	then
+	*ws-args* array-pop drop
+	"#<=== WS-ERROR: %s ===>\n" '( retval car exception-name ) clm-print
+	*clm-debug* if
+		"#<DEBUG: %s>\n" '( retval ) clm-print
+	then
+	#f #f #f fth-raise
+;
+
+: play-cb { len -- prc; self -- val }
+	0 proc-create ( prc )
+	0 , len ,
+  does> { self -- val }
+	self @ { samp }
+	self cell+ @ { len }
+	samp len <= if
+		samp 0.0 run-gen-body ( sum )
+		samp 1+ self !
+	else
+		#f
+	then
+;
+
+: (with-sound-file-main) ( body-xt ws -- ws )
+	2 stack-check
+	{ body-xt ws }
 	body-xt word? body-xt 1 "a proc or xt" assert-type
 	ws      ws?   ws      2 "a ws object"  assert-type
 	ws ws-before-output
@@ -931,98 +1642,74 @@ defer ws-play
 	else
 		#f
 	then { rev? }
-	ws :output            ws-ref { output }
-	ws :reverb-file-name  ws-ref { revput }
-	ws :continue-old-file ws-ref { cont? }
+	ws :output		ws-ref { output }
+	ws :reverb-file-name	ws-ref { revout }
+	ws :continue-old-file	ws-ref { cont? }
+	ws :channels		ws-ref { chans }
+	ws :reverb-channels	ws-ref { rchans }
+	ws :srate		ws-ref { sr }
+	ws :sample-type		ws-ref { st }
+	ws :header-type		ws-ref { ht }
+	ws :comment		ws-ref { com }
+	com empty? if
+		make-default-comment to com
+	then
 	cont? if
-		output continue-sample->file
+		output ws-continue-sound
 	else
 		output file-delete
-		output
-		ws :channels    ws-ref
-		ws :sample-type ws-ref
-		ws :header-type ws-ref
-		ws :comment ws-ref dup empty? if
-			drop make-default-comment
-		then make-sample->file
+		output chans sr st ht com ws-create-sound
 	then to *output*
-	*output* sample->file? unless
+	*output* ws-is-sound? unless
 		'with-sound-error
-		    #( "%s: can't open sample->file" get-func-name ) fth-throw
+		    #( "%s: can't open %s" get-func-name output ) fth-throw
 	then
 	cont? if
-		output mus-sound-srate set-mus-srate drop
-		'snd provided? if
-			output 0 find-sound dup sound? if
-				close-sound
-			then drop
+		*clm-to-snd* if
+			*output* close-sound drop
+		else
+			output mus-sound-srate set-mus-srate drop
+			output ws-close-snd
 		then
 	then
 	rev? if
 		cont? if
-			revput continue-sample->file
+			revout ws-continue-sound
 		else
-			revput file-delete
-			revput
-			ws :reverb-channels ws-ref
-			ws :sample-type     ws-ref
-			ws :header-type     ws-ref
-			"with-sound temporary reverb file" make-sample->file
+			"with-sound temporary reverb file" to com
+			revout file-delete
+			revout rchans sr st ht com ws-create-sound
 		then to *reverb*
-		*reverb* sample->file? unless
+		*reverb* ws-is-sound? unless
 			'with-sound-error
-			    #( "%s: can't open reverb sample->file"
-			       get-func-name ) fth-throw
+			    #( "%s: can't open reverb %s"
+			       get-func-name revout ) fth-throw
 		then
 	then
 	ws :timer make-timer ws-set! to ws
 	\ compute ws body
-	body-xt #t nil fth-catch if
-		stack-reset
-		*output* mus-close drop
-		*reverb* if
-			*reverb* mus-close drop
-		then
-		ws ws-after-output ( ws )
-		"%s: body-xt interrupted; output closed"
-		    #( get-func-name ) clm-message
-		\ reraise last exception
-		#f #f #f fth-raise
-	then
+	body-xt execute
 	reverb-xt if
-		*reverb* mus-close drop
-		ws :reverb-file-name ws-ref undef make-file->sample to *reverb*
-		*reverb* file->sample? unless
-			'with-sound-error
-			    #( "%s: can't open file->sample" get-func-name )
-			    fth-throw
+		ws :decay-time ws-ref to *decay-time*
+		*reverb* mus-output? if
+			*reverb* mus-close drop
 		then
 		\ compute ws reverb
 		\ push reverb arguments on stack
-		ws :reverb-data ws-ref each end-each
-		reverb-xt #t nil fth-catch if
-			stack-reset
-			*output* mus-close drop
-			*reverb* mus-close drop
-			ws ws-after-output ( ws )
-			"%s: reverb-xt interrupted; output closed"
-			    #( get-func-name ) clm-message
-			\ reraise last exception
-			#f #f #f fth-raise
-		then
-		*reverb* mus-close drop
+		ws :reverb-data ws-ref each end-each reverb-xt execute
+		*reverb* ws-close-sound
 	then
-	*output* mus-close drop
+	*output* ws-close-sound
 	ws :timer ws-ref stop-timer
 	'snd provided? if
 		ws ws-get-snd drop
 	then
 	ws :statistics ws-ref if
-		ws ws-statistics
+		ws snd-info
 	then
 	reverb-xt if
 		ws :delete-reverb ws-ref if
-			ws :reverb-file-name ws-ref file-delete
+			revout file-delete
 		then
 	then
 	ws :scaled-to ws-ref if
@@ -1032,40 +1719,81 @@ defer ws-play
 		ws ws-scaled-by
 	then
 	ws :play ws-ref if
-		ws ws-play-it
+		ws ws-play
 	then
 	ws ws-after-output ( ws )
 ;
-previous
+
+: (with-sound-dac-main) ( body-xt ws -- ws )
+	1 stack-check
+	{ ws }
+	ws ws? ws 1 "a ws object" assert-type
+	0 #f get-optarg { body-xt }
+	ws ws-before-output
+	ws :timer make-timer ws-set! drop
+	body-xt if
+		body-xt execute
+	then
+	*notehook* word? if
+		*clm-instruments* each { args }
+			*notehook* args run-proc drop
+		end-each
+	then
+	0 { len }
+	*dac-instruments* each ( args )
+		2 array-ref len max to len
+	end-each
+	ws :framples len ws-set! drop
+	ws :statistics ws-ref if
+		ws dac-info
+	then
+	len play-cb :wait #t play drop
+	ws :timer ws-ref stop-timer
+	ws :statistics ws-ref if
+		ws snd-info
+	then
+	ws ws-after-output ( ws )
+;
+set-current
+
+: with-sound-main ( body-xt ws -- ws )
+	*clm-to-dac* if
+		<'> (with-sound-dac-main)
+	else
+		<'> (with-sound-file-main)
+	then #t <'> ws-reset-handler fth-catch drop ( ws )
+;
 
 \ Usage: <'> resflt-test with-sound drop
-\        <'> resflt-test :play #f :channels 2 with-sound .g
+\        <'> resflt-test :play #f :channels 2 with-sound . cr
 \        lambda: resflt-test ; :output "resflt.snd" with-sound drop
 : with-sound ( body-xt keyword-args -- ws )
 	doc" \\ keywords and default values:\n\
-:play              *clm-play*             (#f)\n\
-:statistics        *clm-statistics*       (#f)\n\
-:verbose           *clm-verbose*          (#f)\n\
-:debug             *clm-debug*            (#f)\n\
-:continue-old-file                        (#f)\n\
-:output            *clm-file-name*        (\"test.snd\")\n\
 :channels          *clm-channels*         (1)\n\
-:srate             *clm-srate*            (44100)\n\
-:locsig-type       *clm-locsig-type*      (mus-interp-linear)\n\
-:header-type       *clm-header-type*      (mus-next)\n\
-:sample-type       *clm-sample-type*      (mus-lfloat)\n\
-:clipped           *clm-clipped*          (#t)\n\
+:clipped           *clm-clipped*          (#f)\n\
 :comment           *clm-comment*          (#f)\n\
-:notehook          *clm-notehook*         (#f)\n\
-:scaled-to                                (#f)\n\  
-:scaled-by                                (#f)\n\  
+:continue-old-file                        (#f)\n\
+:debug             *clm-debug*            (#f)\n\
+:decay-time        *clm-decay-time*       (1.0)\n\
 :delete-reverb     *clm-delete-reverb*    (#f)\n\
+:header-type       *clm-header-type*      (mus-next)\n\
+:locsig-type       *clm-locsig-type*      (mus-interp-linear)\n\
+:notehook          *clm-notehook*         (#f)\n\
+:output            *clm-file-name*        (\"test.snd\")\n\
+:play              *clm-play*             (#f)\n\
+:player            *clm-player*           (#f)\n\
 :reverb            *clm-reverb*           (#f)\n\
-:reverb-data       *clm-reverb-data*      (#())\n\
 :reverb-channels   *clm-reverb-channels*  (1)\n\
+:reverb-data       *clm-reverb-data*      (#())\n\
 :reverb-file-name  *clm-reverb-file-name* (\"test.reverb\")\n\
-:player            *clm-player*           (#f)\n\
-:decay-time        *clm-decay-time*       (1.0)\n\
+:sample-type       *clm-sample-type*      (mus-lfloat)\n\
+:scaled-by                                (#f)\n\
+:scaled-to                                (#f)\n\
+:srate             *clm-srate*            (44100)\n\
+:statistics        *clm-statistics*       (#f)\n\
+:to-snd            *clm-to-snd*           (#f)\n\
+:to-dac            *clm-to-dac*           (#f)\n\
+:verbose           *clm-verbose*          (#f)\n\
 Execute BODY-XT, a proc object or an xt, \
 and returns a ws-args object with with-sound arguments.\n\
 <'> resflt-test with-sound .$ cr\n\
@@ -1074,7 +1802,7 @@ and returns a ws-args object with with-sound arguments.\n\
 		with-sound-default-args
 	else
 		with-sound-args
-	then with-sound-main ( ws )
+	then ( ws ) with-sound-main ( ws )
 ;
 
 : clm-load ( fname keyword-args -- ws )
@@ -1085,26 +1813,28 @@ See with-sound for a full keyword list.\n\
 		with-sound-default-args
 	else
 		with-sound-args
-	then
-	{ fname ws }
+	then { ws }
+	{ fname }
 	fname file-exists? if
 		ws :verbose ws-ref if
-			"loading %S" #( fname ) clm-message
+			"loading %s" #( fname ) clm-message
 		then
-		fname <'> file-eval ws with-sound-main ( ws )
+		fname <'> file-eval ws with-sound-main to ws
 	else
 		'no-such-file
 		    #( "%s: %S not found" get-func-name fname ) fth-throw
 	then
+	ws ws-output ws-close-snd
+	ws
 ;
 
 : with-current-sound <{ body-xt :key offset 0.0 scaled-to #f scaled-by #f -- }>
 	doc" Must be called within with-sound body.  \
-Take all arguments from current with-sound except \
-:output, :scaled-to, :scaled-by and :comment."
+Takes all arguments from current with-sound except \
+:output, :scaled-to, :scaled-by, and :comment."
 	*output* mus-output? false? if
 		'with-sound-error
-		    #( "%s can only be called within with-sound"
+		    #( "%s: can only be called within with-sound"
 		       get-func-name ) fth-throw
 	then
 	with-sound-args { ws }
@@ -1116,10 +1846,11 @@ Take all arguments from current with-sound except \
 	output :output-frame offset seconds->samples clm-mix
 	output file-delete
 ;
+previous
 
 : scaled-to <{ body-xt scl -- }>
 	doc" Must be called within with-sound body.  \
-Scale BODY-XT's resulting sound file to SCL.\n\
+Scales BODY-XT's resulting sound file to SCL.\n\
 lambda: ( -- )\n\
   0.0 0.1 660.0 0.5 fm-violin\n\
   0.5 0.1 550.0 0.1 <'> fm-violin 0.8 scaled-to ( scaled to 0.8 )\n\
@@ -1129,7 +1860,7 @@ lambda: ( -- )\n\
 
 : scaled-by <{ body-xt scl -- }>
 	doc" Must be called within with-sound body.  \
-Scale BODY-XT's resulting sound file by SCL.\n\
+Scales BODY-XT's resulting sound file by SCL.\n\
 lambda: ( -- )\n\
   0.0 0.1 660.0 0.5 fm-violin\n\
   0.5 0.1 550.0 0.1 <'> fm-violin 2.0 scaled-by ( scaled to 0.2 )\n\
@@ -1139,11 +1870,11 @@ lambda: ( -- )\n\
 
 : with-offset <{ body-xt sec -- }>
 	doc" Must be called within with-sound body.  \
-Mix BODY-XT's resulting sound file into main sound file at SEC seconds.\n\
+Mixes BODY-XT's resulting sound file into main sound file at SEC seconds.\n\
 lambda: ( -- )\n\
   0.0 0.1 660.0 0.5 fm-violin\n\
-  0.5 0.1 550.0 0.1 <'> fm-violin 1.0 \
-with-offset ( its actual begin time is 1.5 )\n\
+  0.5 0.1 550.0 0.1 <'> fm-violin 1.0 with-offset\n\
+  ( its actual begin time is 1.5 )\n\
 ; with-sound"
 	body-xt :offset sec with-current-sound
 ;
@@ -1153,7 +1884,7 @@ with-offset ( its actual begin time is 1.5 )\n\
 ARGS is an array of with-sound arguments, \
 FNAME is the temporary mix file name without extension, \
 and START is the begin time for mix in.  \
-If BODY-STR is NIL a notelist file FNAME.fsm must exist.\n\
+If BODY-STR is NIL, a notelist file FNAME.fsm must exist.\n\
 lambda: ( -- )\n\
   0.0 0.1 440 0.1 fm-violin\n\
   \"\n\
@@ -1172,9 +1903,9 @@ lambda: ( -- )\n\
 	    2 "an array or a list" assert-type
 	fname string? fname 3 "a string" assert-type
 	start number? start 4 "a number" assert-type
-	*output* mus-output? false? if
+	*output* ws-is-output? unless
 		'with-sound-error
-		    #( "%s can only be called within with-sound"
+		    #( "%s: can only be called within with-sound"
 			get-func-name ) fth-throw
 	then
 	fname ".snd" $+ { snd-file }
@@ -1183,111 +1914,171 @@ lambda: ( -- )\n\
 	snd-file file-exists? if
 		snd-file file-mtime
 	else
-		#f
+		0 s>d
 	then { snd-time }
 	body-str string? if
 		mix-file file-exists? if
 			mix-file readlines "" array-join
 		else
 			""
-		then ( old-body ) body-str string= if
-			mix-file file-mtime
-		else
+		then ( old-body ) body-str string<> if
 			mix-file #( body-str ) writelines
-			#f
 		then
+		mix-file file-mtime
 	else			\ body-str is nil
 		mix-file file-exists? if
 			mix-file file-mtime
 		else
 			'no-such-file
-			    #( "%s: %S not found"
-			       get-func-name
-			       mix-file ) fth-throw
+			    #( "%s: %S not found" get-func-name mix-file )
+			    fth-throw
 		then
 	then { mix-time }
-	snd-time      false?
-	mix-time      false? ||
-	snd-time mix-time d< || if
+	snd-time mix-time d< if
 		mix-file args each
 			( put all args on stack )
 		end-each :output snd-file :reverb-file-name rev-file
 		    clm-load drop
 	then
-	snd-file :output-frame start seconds->samples clm-mix
+	snd-file :output-frame start s>f seconds->samples clm-mix
 ;
 
 : sound-let ( ws-xt-lst body-xt -- )
-	doc" Require array of arrays WS-XT-LST with with-sound args \
+	doc" Requires an array of arrays WS-XT-LST with with-sound args \
 and xts, and a BODY-XT.  \
 The BODY-XT must take WS-XT-LST length arguments which are tempfile names.  \
-with-sound will be feed with ws-args und ws-xts from WS-XT-LST.  \
-:output is set to tempnam which will be on stack before executing BODY-XT.  \
+with-sound gets ws-args und ws-xts from WS-XT-LST.  \
 These temporary files will be deleted after execution of BODY-XT.\n\
-#( #( #( :reverb <'> jc-reverb ) 0.0 1 220 0.2 <'> fm-violin )\n\
-   #( #() 0.5 1 440 0.3 <'> fm-violin ) ) ( the ws-xt-lst )\n\
-lambda: { tmp1 tmp2 }\n\
-  tmp1 :output tmp2 clm-mix\n\
+\\ The WS-XT-LST:\n\
+'( '( '( :reverb <'> jc-reverb ) 0.0 1 220 0.2 <'> fm-violin )\n\
+   '( '()                        0.5 1 440 0.3 <'> fm-violin )\n\
+   '( '()                        '( 10 'a-symbol ) ) )\n\
+\\ The BODY-XT:\n\
+lambda: <{ tmp1 tmp2 tmp3 -- }>\n\
+  tmp1 . cr\n\
+  tmp2 . cr\n\
+  tmp3 . cr\n\
   tmp1 clm-mix\n\
-; ( the body-xt ) <'> sound-let with-sound drop"
+  tmp2 clm-mix\n\
+; <'> sound-let with-sound drop"
+	2 stack-check
 	{ ws-xt-lst body-xt }
 	ws-xt-lst array? ws-xt-lst 1 "an array"     assert-type
 	body-xt word?    body-xt   2 "a proc or xt" assert-type
-	*output* mus-output? unless
-		'with-sound-error
-		    #( "%s can only be called within with-sound"
-		       get-func-name ) fth-throw
-	then
+	nil nil { args rest }
 	ws-xt-lst map
-		*key* 0 array-ref ( args ) each
-			( put all args on stack )
-		end-each with-sound-args
-		( ws ) :output fth-tempnam ws-set! { ws }
-		*key* 1 array-ref ( xt ) each
-			( put all xts on stack )
-		end-each ws with-sound-main :output ws-ref ( outfile )
+		*key* car to args
+		*key* cdr to rest
+		rest -1 list-ref word? if
+			\ '( 0.0 1 220 0.2 <'> fm-violin )
+			rest each
+				( put all args and xt on stack )
+			end-each
+			\ '( :reverb <'> jc-reverb )
+			args ( with-sound args ) each
+				( put all ws-args on stack )
+			end-each
+			:output fth-tempnam with-sound ws-output ( outfile )
+		else
+			\ a single value; from example above: '( 10 'a-symbol )
+			rest car ( val )
+		then
 	end-map { outfiles }
-	body-xt xt? if
-		outfiles each end-each body-xt execute
-	else
+	body-xt word? if
 		body-xt outfiles run-proc drop
 	then
-	outfiles each ( file )
-		file-delete
+	outfiles each { file }
+		file file-exists? if
+			file ws-close-snd
+			file file-delete
+		then
 	end-each
 ;
 
-\ === Playing Sounds ===
-: play-sound <{ :key verbose *clm-verbose* player *clm-player*
-    :optional input *clm-file-name* -- }>
-	doc" Play sound file INPUT.\n\
-\"bell.snd\" :verbose #t play-sound"
-	input find-file to input
-	input unless
-		'no-such-file #( "%s: %s" get-func-name input ) fth-throw
-	then
-	verbose if
-		input snd-info
-	then
-	#w{} :output input ws-set! :player player ws-set! ws-play-it
-;
-
-'snd provided? [unless]
-	<'> play-sound alias play
+0 [if]
+\ CLM examples (see clm.html) and their Snd/Forth counterparts:
+
+\ (with-sound () 
+\   (mix (with-sound (:output "hiho.snd") 
+\          (fm-violin 0 1 440 .1))
+\        :amplitude .5))
+
+lambda: ( -- )
+	0.0 1.0 440 0.1 <'> fm-violin
+	:output "hiho.snd" with-sound ws-output :scaler 2.0 clm-mix
+; with-sound drop 
+
+\ (with-sound ()
+\   (with-mix () "s1" 0
+\     (sound-let ((tmp () (fm-violin 0 1 440 .1)))
+\       (mix tmp))))
+
+lambda: ( -- )
+	"
+	'( '( '() 0.0 1.0 440 0.1 <'> fm-violin ) )
+	lambda: <{ tmp -- }>
+		tmp clm-mix
+	; sound-let
+	" '() "s1" 0 with-mix
+; with-sound drop 
+
+\ (with-sound (:verbose t)
+\   (with-mix () "s6" 0
+\     (sound-let ((tmp () (fm-violin 0 1 440 .1))
+\                 (tmp1 (:reverb nrev) (mix "oboe.snd")))
+\       (mix tmp1)
+\       (mix tmp :amplitude .2 :output-frame *srate*))
+\     (fm-violin .5 .1 330 .1)))
+
+lambda: ( -- )
+	"
+	'( '( '() 0.0 1.0 440 0.1 <'> fm-violin )
+	   '( '( :reverb <'> nrev ) \"oboe.snd\" <'> clm-mix ) )
+	lambda: <{ tmp tmp1 -- }>
+		tmp1 clm-mix
+		tmp :scaler 5.0 :output-frame 1.0 seconds->samples clm-mix
+	; sound-let
+	0.5 0.1 330 0.1 fm-violin
+	" '() "s6" 0 with-mix
+; :verbose #t with-sound drop 
+
+\ (with-sound (:verbose t)
+\   (sound-let ((tmp () (with-mix () "s7" 0
+\                    (sound-let ((tmp () (fm-violin 0 1 440 .1))
+\                                (tmp1 () (mix "oboe.snd")))
+\                      (mix tmp1)
+\                      (mix tmp :output-frame *srate*))
+\                    (fm-violin .5 .1 330 .1))))
+\      (mix tmp :amplitude .5)))
+
+'( '( '() "
+	'( '( '() 0.0 1.0 440 0.1 <'> fm-violin )
+	   '( '()      \"oboe.snd\" <'> clm-mix ) )
+	lambda: <{ tmp tmp1 -- }>
+		tmp1 clm-mix
+		tmp :output-frame 1.0 seconds->samples clm-mix
+	; sound-let
+	0.5 0.1 330 0.1 fm-violin
+	" '() "s7" 0 <'> with-mix ) )
+lambda: <{ tmp -- }>
+	tmp :scaler 2.0 clm-mix
+; <'> sound-let :verbose #t with-sound drop 
 [then]
-<'> play is ws-play
 
 \ === Example instruments, more in clm-ins.fs ===
 instrument: simp { start dur freq amp -- }
 	:frequency freq make-oscil { os }
 	:envelope #( 0 0 25 1 75 1 100 0 )
 	    :duration dur :scaler amp make-env { en }
-	start dur run
-		i  os 0.0 0.0 oscil en env f*  *output* outa drop
-	loop
+	\ start dur run
+	\	i  os 0.0 0.0 oscil en env f*  *output* outa drop
+	\ loop	
+	start dur nil run-instrument
+		os 0.0 0.0 oscil  en env  f*
+	end-run
 ;instrument
 
-: run-test ( -- ) 0.0 1.0 330.0 0.5 simp ;
+: run-test ( -- )	0.0 1.0 330.0 0.5 simp ;
 
 : input-fn { gen -- prc; dir self -- r }
 	1 proc-create ( prc )
@@ -1300,9 +2091,12 @@ instrument: src-simp { start dur amp sr sr-env fname -- }
 	:file fname find-file make-readin { f }
 	:input f input-fn :srate sr make-src { sc }
 	:envelope sr-env :duration dur make-env { en }
-	start dur run
-		i  sc en env #f src amp f*  *output* outa drop
-	loop
+	\ start dur run
+	\	i  sc en env #f src amp f*  *output* outa drop
+	\ loop
+	start dur nil run-instrument
+		sc  en env  #f src  amp f*
+	end-run
 	f mus-close drop
 ;instrument
 
@@ -1315,9 +2109,12 @@ instrument: conv-simp { start dur filt fname amp -- }
 		filt
 	then { data }
 	:input f input-fn :filter data make-convolve { cv }
-	start dur run
-		i cv #f convolve  amp f*  *output* outa drop
-	loop
+	\ start dur run
+	\	i cv #f convolve  amp f*  *output* outa drop
+	\ loop
+	start dur nil run-instrument
+		cv #f convolve  amp f*
+	end-run
 	f mus-close drop
 ;instrument
 
@@ -1331,7 +2128,7 @@ event: conv1-test ( -- )
 	0.0 1.0 vct( 0.5 0.2 0.1 0.05 0 0 0 0 ) "fyow.snd" 1.0 conv-simp
 ;event
 
-\ <'> conc2-test with-sound drop
+\ <'> conv2-test with-sound drop
 event: conv2-test ( -- )
 	0.0 1.0 "pistol.snd" "fyow.snd" 0.2 conv-simp
 ;event
@@ -1343,79 +2140,6 @@ event: inst-test ( -- )
 	2.4 1.0 "pistol.snd" "fyow.snd" 0.2 conv-simp
 ;event
 
-\ generators.scm
-: make-waveshape <{ :optional
-    freq *clm-default-frequency*
-    parts #( 1 1 )
-    wave #f
-    size *clm-table-size* -- gen }>
-	doc" See make-polyshape."
-	:frequency freq
-	    wave if
-		    :coeffs wave
-	    else
-		    :partials parts
-	    then make-polyshape
-;
-
-<'> polyshape  alias waveshape  ( gen :optional index 1.0 fm 0.0 -- val )
-<'> polyshape? alias waveshape? ( obj -- f )
-<'> waveshape  <'> polyshape  help-ref  help-set!
-<'> waveshape? <'> polyshape? help-ref  help-set!
-
-: partials->waveshape <{ partials :optional size *clm-table-size* -- wave }>
-	doc" See partials->polynomial."
-	partials partials->polynomial ( wave )
-;
-
-\ snd10.scm
-: make-sum-of-sines <{ :key
-    sines 1
-    frequency 0.0
-    initial-phase 0.0 -- gen }>
-	doc" See make-nsin."
-	:frequency frequency :n sines make-nsin { gen }
-	gen initial-phase set-mus-phase drop
-	gen
-;
-
-<'> nsin  alias sum-of-sines  ( gen :optional fm 0.0 -- val )
-<'> nsin? alias sum-of-sines? ( obj -- f )
-<'> sum-of-sines  <'> nsin  help-ref  help-set!
-<'> sum-of-sines? <'> nsin? help-ref  help-set!
-
-: make-sum-of-cosines <{ :key
-    cosines 1
-    frequency 0.0
-    initial-phase 0.0 -- gn }>
-	doc" See make-ncos."
-	:frequency frequency :n cosines make-ncos { gen }
-	gen initial-phase set-mus-phase drop
-	gen
-;
-
-<'> ncos  alias sum-of-cosines  ( gen :optional fm 0.0 -- val )
-<'> ncos? alias sum-of-cosines? ( obj -- f )
-<'> sum-of-cosines  <'> ncos  help-ref  help-set!
-<'> sum-of-cosines? <'> ncos? help-ref  help-set!
-
-: make-sine-summation <{ :key
-    frequency 0.0
-    initial-phase 0.0
-    n 1
-    a 0.5
-    ratio 1.0 -- gen }>
-	doc" See make-nrxysin."
-	:frequency frequency :ratio ratio :n n :r a make-nrxysin { gen }
-	gen initial-phase set-mus-phase drop
-	gen
-;
-
-<'> nrxysin  alias sine-summation  ( gen :optional fm 0.0 -- val )
-<'> nrxysin? alias sine-summation? ( obj -- f )
-<'> sine-summation  <'> nrxysin  help-ref  help-set!
-<'> sine-summation? <'> nrxysin? help-ref  help-set!
-
 'snd provided? [if]
 	instrument: snd-arpeggio
 	  <{ start dur freq amp :key ampenv #( 0 0 0.5 1 1 0 ) offset 1.0 -- }>
@@ -1490,4 +2214,178 @@ event: arpeggio-test ( -- )
 	0 10 65 0.5 arpeggio
 ;event
 
+instrument: simp-gen { start dur freq amp -- ; samp args -- val }
+	doc" simple example for an instrument generator:\n\
+<'> test-gen :channels 1 :srate 22050 :to-dac #t with-sound drop\n\
+or\n\
+test-gen run-gen map-channel drop"
+	:frequency freq make-oscil { os }
+	:envelope #( 0 0 25 1 75 1 100 0 )
+	:duration dur :scaler amp make-env { en }
+	start dur nil run-gen-instrument { samp args -- val }
+		args "os" args@ 0.0 0.0 oscil  args "en" args@ env f*
+	end-run-gen
+;instrument
+
+\ <'> test-gen :channels 1 :srate 22050 :to-dac #t with-sound drop
+\ or
+\ test-gen run-gen map-channel drop
+: test-gen ( -- )
+	0.0 0.1  440 0.2 simp-gen
+	0.5 0.2  550 0.2 simp-gen
+	0.6 0.1  660 0.2 simp-gen
+	1.0 0.1  880 0.2 simp-gen
+	1.1 0.1 1320 0.2 simp-gen
+	2.0 0.1  220 0.2 simp-gen
+;
+
+\ snd/fm.html
+\ see clm-ins.fs for file version
+instrument: violin-gen <{ start dur freq amp :key
+    fm-index 1.0
+    amp-env #( 0 0 25 1 75 1 100 0 )
+    index-env #( 0 1 25 0.4 75 0.6 100 0 )
+    degree #f
+    distance #f
+    reverb-amount #f -- }>
+	doc" Violin example from snd/fm.html as generator:\n\
+<'> violin-gen-test :channels 1 :srate 11025 :to-dac #t with-sound drop\n\
+or\n\
+violin-gen-test run-gen map-channel drop"
+	freq hz->radians { frq-scl }
+	frq-scl fm-index f* { maxdev }
+	5.0 freq flog f/ maxdev f* { index1 }
+	8.5 freq flog f- 3.0 freq 1000.0 f/ f+ f/ maxdev 3.0 f* f* { index2 }
+	4.0 freq fsqrt f/ maxdev f* { index3 }
+	:frequency freq make-oscil { carrier }
+	:frequency freq make-oscil { fmosc1 }
+	:frequency freq 3.0 f* make-oscil { fmosc2 }
+	:frequency freq 4.0 f* make-oscil { fmosc3 }
+	:envelope amp-env :scaler amp :duration dur make-env { ampf }
+	:envelope index-env :scaler index1 :duration dur make-env { indf1 }
+	:envelope index-env :scaler index2 :duration dur make-env { indf2 }
+	:envelope index-env :scaler index3 :duration dur make-env { indf3 }
+	:frequency 5.0
+	    :amplitude 0.0025 frq-scl f* make-triangle-wave { pervib }
+	:frequency 16.0
+	    :amplitude 0.005 frq-scl f* make-rand-interp   { ranvib }
+	start dur nil run-gen-instrument { samp args -- val }
+		args "pervib" args@ 0.0 triangle-wave
+		args "ranvib" args@ 0.0 rand-interp f+ { vib }
+		args "carrier" args@
+		    vib
+		    args "fmosc1" args@ vib 0.0 oscil
+		    args "indf1" args@ env f* f+
+		    args "fmosc2" args@ 3.0 vib f* 0.0 oscil
+		    args "indf2" args@ env f* f+
+		    args "fmosc3" args@ 4.0 vib f* 0.0 oscil
+		    args "indf3" args@ env f* f+
+		    0.0 oscil
+		args "ampf" args@ env f*
+	end-run-gen
+;instrument
+
+\ <'> violin-gen-test :channels 1 :srate 11025 :to-dac #t with-sound drop
+\ or
+\ violin-gen-test run-gen map-channel drop
+: violin-gen-test <{ :optional start 0.0 dur 1.0 -- }>
+	start now!
+	now@ dur |Bf4 0.5 violin-gen dur f2/ step
+	now@ dur |A4  0.5 violin-gen dur f2/ step
+	now@ dur |C5  0.5 violin-gen dur f2/ step
+	now@ dur |B4  0.5 violin-gen dur f2/ step
+	0.2 step
+;
+
+: violin-dac-test ( -- )
+	<'> violin-gen-test :channels 1 :srate 11025 :to-dac #t with-sound drop
+;
+
+'snd provided? [if]
+	: violin-map-test ( -- )
+		\ fill *dac-instruments* with #( prc beg end ) elements
+		violin-gen-test
+		0 { size }
+		*dac-instruments* each { el }
+			el 2 array-ref size max to size
+		end-each
+		get-func-name ".snd" $+ :channels 1 :size size new-sound { snd }
+		run-gen map-channel drop
+		snd play drop
+	;
+[then]
+
+\ generators.scm
+: make-waveshape <{ :optional
+    freq *clm-default-frequency*
+    parts #( 1 1 )
+    wave #f
+    size *clm-table-size* -- gen }>
+	doc" See make-polyshape."
+	:frequency freq
+	    wave if
+		    :coeffs wave
+	    else
+		    :partials parts
+	    then make-polyshape
+;
+
+<'> polyshape  alias waveshape  ( gen :optional index 1.0 fm 0.0 -- val )
+<'> polyshape? alias waveshape? ( obj -- f )
+<'> waveshape  <'> polyshape  help-ref  help-set!
+<'> waveshape? <'> polyshape? help-ref  help-set!
+
+: partials->waveshape <{ partials :optional size *clm-table-size* -- wave }>
+	doc" See partials->polynomial."
+	partials partials->polynomial ( wave )
+;
+
+\ snd10.scm
+: make-sum-of-sines <{ :key
+    sines 1
+    frequency 0.0
+    initial-phase 0.0 -- gen }>
+	doc" See make-nsin."
+	:frequency frequency :n sines make-nsin { gen }
+	gen initial-phase set-mus-phase drop
+	gen
+;
+
+<'> nsin  alias sum-of-sines  ( gen :optional fm 0.0 -- val )
+<'> nsin? alias sum-of-sines? ( obj -- f )
+<'> sum-of-sines  <'> nsin  help-ref  help-set!
+<'> sum-of-sines? <'> nsin? help-ref  help-set!
+
+: make-sum-of-cosines <{ :key
+    cosines 1
+    frequency 0.0
+    initial-phase 0.0 -- gn }>
+	doc" See make-ncos."
+	:frequency frequency :n cosines make-ncos { gen }
+	gen initial-phase set-mus-phase drop
+	gen
+;
+
+<'> ncos  alias sum-of-cosines  ( gen :optional fm 0.0 -- val )
+<'> ncos? alias sum-of-cosines? ( obj -- f )
+<'> sum-of-cosines  <'> ncos  help-ref  help-set!
+<'> sum-of-cosines? <'> ncos? help-ref  help-set!
+
+: make-sine-summation <{ :key
+    frequency 0.0
+    initial-phase 0.0
+    n 1
+    a 0.5
+    ratio 1.0 -- gen }>
+	doc" See make-nrxysin."
+	:frequency frequency :ratio ratio :n n :r a make-nrxysin { gen }
+	gen initial-phase set-mus-phase drop
+	gen
+;
+
+<'> nrxysin  alias sine-summation  ( gen :optional fm 0.0 -- val )
+<'> nrxysin? alias sine-summation? ( obj -- f )
+<'> sine-summation  <'> nrxysin  help-ref  help-set!
+<'> sine-summation? <'> nrxysin? help-ref  help-set!
+
 \ clm.fs ends here