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