1\ .snd_forth -- start up file for Snd/Forth
2\
3\ 20/09/13 13:36:21
4\
5
6\ You can install the *.fs scripts with:
7\
8\   cd ${top_srcdir}/examples/site-lib
9\   ./install.fth
10\
11\ or even better
12\
13\   cd ${top_builddir}
14\   make install
15\
16\ If you have installed *.fs scripts with one of the above mentioned
17\ commands, you don't need to add a path to *load-path*.
18\ ${prefix}/share/fth/site-fth is already included.  Otherwise you can
19\ add a path with e.g.:
20\
21\   "/home/mike/snd" add-load-path
22
23\ A special *SND-HOME* path points to ~/.snd.d:
24\
25\ ~/.snd.d/sound      directory for *clm-file-name*
26\ ~/.snd.d/zap        directory for set-temp-dir
27\                                   set-save-dir
28\ ~/.snd.d/peaks      directory for set-peak-env-dir
29\
30\ "HOME" getenv       constant *home*
31\ *home* "/.snd.d" $+ constant *snd-home*
32\
33\ Change these paths!
34\
35
36#t to *fth-verbose*
37#f to *fth-debug*
38
39\ Redirect Fth output (stdout) to the Snd listener (with snd-print).
40:port-name "sndout" :write-line <'> snd-print make-soft-port set-*stdout* drop
41\ Now force output to listener:
42#t set-show-listener drop
43
44before-load-hook lambda: <{ fname -- f }>
45	*fth-verbose* if
46		"\\ loading %s\n" #( fname ) fth-print
47	then
48	#t
49; add-hook!
50
51before-load-hook '( *filename* ) run-hook drop
52
53"HOME" getenv		constant *home*
54*home* "/.snd.d" $+	constant *snd-home*
55hostname		constant *hostname*
56*hostname* "." string-split car constant *short-hostname*
57*argv* length 0> [if]
58	*argv* car undef file-basename
59[else]
60	"snd"
61[then] constant *program-name*
62
63\ if configured --with-shared-sndlib
64'sndlib provided? [unless] dl-load sndlib Init_sndlib [then]
65
66\ Set them before loading clm.fs.
672		set-default-output-chans drop
6848000		set-default-output-srate drop
69mus-bdouble	set-default-output-sample-type drop
70512		set-dac-size drop
71mus-clipping	set-clipping drop
721024 1024 *	set-mus-file-buffer-size drop
7348		set-mus-array-print-length drop
74mus-array-print-length set-print-length drop
75128		set-object-print-length
76
77require clm
78require clm-ins
79
80\ Environment variable CLM_SEARCH_PATH
81\ Path variable where sound files reside.
82\ csh: setenv CLM_SEARCH_PATH /usr/gnu/sound/SFiles:${HOME}/.snd.d/sound
83\  sh: export CLM_SEARCH_PATH=/usr/gnu/sound/SFiles:${HOME}/.snd.d/sound
84
85"CLM_SEARCH_PATH" getenv dup [if]
86	":" string-split [each]
87		*clm-search-list* swap array-push to *clm-search-list*
88	[end-each]
89[else]
90	drop
91	*clm-search-list* *snd-home* "/sound" $+ array-push to *clm-search-list*
92[then]
93
94: clm-print-instrument <{ ins beg dur -- }>
95	"%14s: %5.2f %5.2f" '( ins beg dur ) clm-message
96;
97
98: clm-sox-player <{ output -- }>
99	"sox -qV1 %s -d" #( output ) string-format file-system unless
100		"exit %d\n" #( exit-status ) fth-print
101	then
102;
103
104#t to *clm-play*
105#t to *clm-statistics*
106#t to *clm-verbose*
107#f to *clm-debug*
108*snd-home* "/sound/fth-test.snd" $+ to *clm-file-name*
109*snd-home* "/sound/fth-test.reverb" $+ to *clm-reverb-file-name*
110#t to *clm-delete-reverb*
111<'> clm-print-instrument to *clm-notehook*
112<'> clm-sox-player to *clm-player*
113
114*snd-home* add-load-path
115"BROWSER" getenv "firefox" || set-html-program drop
116*snd-home* "/sound" $+	set-open-file-dialog-directory ( dir )
117"/saved-snd.fs" $+	set-save-state-file drop
118*snd-home* "/zap" $+	set-save-dir ( dir )
119			set-temp-dir drop
1200.0			set-auto-update-interval drop
121#t			set-trap-segfault drop
122
123#( "rev" "reverb" "wave" ) [each] ( ext )
124	add-sound-file-extension drop
125[end-each]
126
127\ make-default-comment from clm.fs
128output-comment-hook lambda: <{ str -- s }>
129	str empty? if
130		make-default-comment
131	else
132		str
133	then
134; add-hook!
135
136require examp
137[ifundef] read-eval-loop-prompt
138	"ok " value read-eval-loop-prompt
139[then]
140
141'snd-nogui provided? [if]
142	\ snd-nogui repl and prompt hooks
143	before-repl-hook reset-hook!	\ remove default hook
144	before-repl-hook lambda: <{ -- }>
145		"" #f clm-message
146		"Starting session on %s."
147		    #( "%a %b %d %r %Z %Y" current-time strftime ) clm-message
148		"" #f clm-message
149	; add-hook!
150
151	\
152	\ Remove duplicates from history file.
153	\
154	after-repl-hook lambda: <{ history -- }>
155		history readlines array-reverse! { hary }
156		#() "" "" { nhary hline tline }
157		hary array-length 0 ?do
158			hary i    array-ref to hline
159			hary i 1+ array-ref to tline
160			nhary hline array-member? unless
161				nhary hline array-unshift
162				    ( nhary ) tline array-unshift drop
163			then
164		2 +loop
165		history nhary writelines
166		\ Be polite.
167		"" #f clm-message
168		"Thank you for using %s!"
169		    #( *program-name* string-upcase ) clm-message
170		"" #f clm-message
171		1 sleep
172	; add-hook!
173
174	\
175	\ A more elaborated prompt for fth and snd-forth-nogui.
176	\
177	before-prompt-hook lambda: <{ prompt pos -- new-prompt }>
178		"%I:%M%p" current-time strftime string-downcase! { tm }
179		"%%S[%s %s] (%d)%%s %%Bok%%b "
180		    #( *short-hostname* tm pos ) string-format
181	; add-hook!
182[else]				\ snd-motif
183	read-hook lambda: <{ text -- flag }>
184		\ Prints "\n" to put output at next line.
185		\ This separates better input from output.
186		cr
187		#f
188	; add-hook!
189
190	require snd-xm
191	after-open-hook <'> show-disk-space add-hook!
192
193	require effects
194	#f to use-combo-box-for-fft-size	\ boolean (default #f)
195
196	'snd-motif provided? [if]
197		*clm-search-list* [each] ( dir )
198			undef add-directory-to-view-files-list drop
199		[end-each]
200		\ snd-xm.fs
201		add-mark-pane
202		require popup
203		edhist-save-hook lambda: <{ prc -- }>
204			"%S" #( prc ) clm-message
205		; add-hook!
206	[then]
207
208	require extensions
209	with-reopen-menu
210	with-buffers-menu
211
212	\ examp.fs
213	graph-hook <'> auto-dot add-hook!
214	graph-hook <'> zoom-spectrum add-hook!
215	lisp-graph-hook <'> display-energy add-hook!
216	after-transform-hook <'> fft-peak add-hook!
217	\ graph-hook <'> display-correlate add-hook!
218	\ graph-hook <'> superimpose-ffts add-hook!
219	\ lisp-graph-hook <'> display-db add-hook!
220
221	require mix
222	mix-click-hook <'> mix-click-sets-amp add-hook!
223	mix-click-hook <'> mix-click-info add-hook!
224
225	require marks
226	save-mark-properties
227	mark-click-hook <'> mark-click-info add-hook!
228
229	require dsp
230	require env
231	enved-hook lambda: <{ en pt x y reason -- en'|#f }>
232		reason enved-move-point = if
233			x en 0 array-ref f>
234			x en -2 array-ref f< && if
235				en en pt 2* array-ref
236				    x #f #f stretch-envelope ( new-en )
237				    dup pt 2* 1+ y array-set!
238				    ( new-en )
239			else
240				#f
241			then
242		else
243			#f
244		then
245	; add-hook!
246
247	\ xm-enved.fs (already loaded by effects.fs)
248	before-enved-hook lambda: <{ gen pos x y reason -- f }>
249 		enved-hook hook-empty? if
250 			#f
251 		else
252			gen xenved-envelope@ { res }
253			enved-hook each { prc }
254				prc #( res pos x y reason ) run-proc to res
255				res false? ?leave
256			end-each
257			res array? if
258				gen res xenved-envelope!
259			then
260			res
261 		then
262	; add-hook!
263
264	after-open-hook lambda: <{ snd -- }>
265		snd channels 0 ?do
266			snd short-file-name
267			    snd i ( chn ) time-graph set-x-axis-label drop
268			\ to force a verbose cursor
269			0 snd i ( chn ) #f set-cursor drop
270		loop
271		cursor-line snd #t set-cursor-style drop
272		channels-combined snd set-channel-style
273	; add-hook!
274
275	require rgb
276	blue			set-selected-data-color drop
277	beige			set-selected-graph-color drop
278
279	rainbow-colormap	set-colormap drop
280	#t			set-enved-wave? drop
281	#t			set-just-sounds drop
282	\ defined in examp.fs
283	read-eval-loop-prompt	set-listener-prompt drop
284	#t			set-show-full-duration drop
285	#t			set-show-indices drop
286	#t			set-show-transform-peaks drop
287	#t			set-show-y-zero drop
288	speed-control-as-ratio	set-speed-control-style drop
289	\ graph-once
290	\ graph-as-sonogram
291	\ graph-as-spectrogram
292	graph-once		set-transform-graph-type drop
293	#t			set-with-inset-graph drop
294	#t			set-with-pointer-focus drop
295	#t			set-with-smpte-label drop
296	#t			set-with-toolbar drop
297	#t			set-with-tracking-cursor drop
298	#t			set-with-verbose-cursor drop
299	1200			set-window-width drop
300	150			set-window-x drop
301	0			set-window-y drop
302	\ The listener appears in a more convenient size with this trick:
303	800			set-window-height drop
304	1000			set-window-height drop
305
306	\ bind-key ( key modifiers func
307	\            :optional extended=#f origin="" prefs-info="" -- val )
308	\
309	\ modifiers:
310	\   0 normal
311	\   1 shift
312	\   4 control
313	\   8 meta
314	\
315	\ extended (prefix key):
316	\   #t  C-x
317	\   #f  none
318	\
319	\ func ( -- val )
320	\
321	\ val should be:
322	\   cursor-in-view
323	\   cursor-on-left
324	\   cursor-on-right
325	\   cursor-in-middle
326	\   keyboard-no-action
327	\
328	\ C-x C-c terminate Snd
329	<char> c 4 lambda: <{ -- val }>
330		0 snd-exit drop
331		cursor-in-view
332	; #t "terminate Snd" "terminate-snd" bind-key drop
333
334	\ C-x k close selected sound
335	<char> k 0 lambda: <{ -- val }>
336		selected-sound close-sound-extend
337		cursor-in-view
338	; #t "close sound and jump to next open"
339	    "close-current-sound" bind-key drop
340
341	\ C-x C-k toggle listener
342	<char> k 4 lambda: <{ -- val }>
343		show-listener not set-show-listener drop
344		cursor-in-view
345	; #t "show listener" "show-listener" bind-key drop
346
347	\ C-x C-x play
348	<char> x 4 lambda: <{ -- val }>
349		#t play drop
350		cursor-in-view
351	; #t "play current sound" "play-current-sound" bind-key drop
352
353	\ C-x C-t play from cursor
354	<char> t 4 lambda: <{ -- val }>
355		selected-sound :start undef undef undef cursor play drop
356		cursor-in-view
357	; #t "play from cursor" "play-from-cursor" bind-key drop
358
359	"End" 0 lambda: <{ -- val }>
360		selected-sound { snd }
361		snd #f #f framples { frms }
362		snd srate { sr }
363		'( 0.0 frms sr f/ ) snd #f undef set-x-bounds ( val )
364	; #f "view full sound" undef bind-key drop
365
366	<char> m 0 <'> first-mark-in-window-at-left #f
367	    "align window left edge with mark"
368	    "first-mark-in-window-at-left" bind-key drop
369[then]				\ snd-nogui
370
371\ find-file searchs in *clm-search-list*
372let:
373	sounds empty? if
374		*clm-file-name* find-file { fname }
375		fname if
376			fname open-sound drop
377		then
378		cr
379	then
380;let
381
382"%s (Fth %s)" #( snd-version fth-version ) clm-message
383
384\ Finally, after loading files with possible error messages, redirect
385\ Fth error output (stderr) to the Snd listener too.
386*stdout* set-*stderr* drop
387
388\ .snd_forth ends here
389