Imported Upstream version 12.0

1 files changed, 58 insertions, 18 deletions

diff --git a/examp.fs b/examp.fs
index ba0fd30..637f22e 100644
--- a/examp.fs
+++ b/examp.fs
@@ -1,9 +1,8 @@
-\ -*- snd-forth -*-
 \ examp.fs -- examples from examp.scm|rb
 
 \ Author: Michael Scholz <mi-scholz@users.sourceforge.net>
 \ Created: Tue Jul 05 13:09:37 CEST 2005
-\ Changed: Wed Aug 18 19:07:45 CEST 2010
+\ Changed: Sat Feb 19 17:25:03 CET 2011
 
 \ Commentary:
 \
@@ -115,7 +114,7 @@
 \ reverse-by-blocks         ( block-len :optional snd chn -- val )
 \ reverse-within-blocks     ( block-len :optional snd chn -- val )
 \ channel-clipped?          ( :optional snd chn -- val )
-\ sync-all                  ( -- )
+\ sync-everything           ( -- )
 \ 
 \ make-moog-filter    	    ( freq Q -- gen )
 \ moog-frequecy@      	    ( gen -- frq )
@@ -450,8 +449,8 @@ y0 and y1 are ignored."
   sf next-sample fabs { val1 }
   begin
     sf sampler-at-end?
-    c-g?                     ||
-    val0 val1 f+ limit f<    || not
+    \ c-g?                  ||
+    val0 val1 f+ limit f< || not
   while
       start 1+ to start
       val1 to val0
@@ -504,6 +503,50 @@ y0 and y1 are ignored."
 ;
 \ "mpeg.mpg" "mpeg.raw" mpg
 
+\ ;;; -------- read ASCII files
+\ ;;;
+\ ;;; these are used by Octave (WaveLab) -- each line has one integer, apparently a signed short.
+
+hide
+: read-ascii-cb { fname snd -- prc; self -- }
+  0 proc-create fname , snd , ( thunk )
+ does> { self -- }
+  self @ ( fname ) readlines { in-buffer }
+  self cell+ @ { snd }
+  512 { bufsize }
+  bufsize 0.0 make-vct { data }
+  0 { loc }
+  0 { frame }
+  32768.0 1/f { short->float }
+  nil { val }
+  in-buffer each ( line ) nil string-split each ( str-val ) string->number ( val ) short->float f*
+      data loc rot vct-set! drop
+      loc 1+ to loc
+      loc bufsize = if
+	data frame bufsize snd 0 vct->channel drop
+	frame bufsize d+ to frame
+	0 to loc
+      then
+    end-each
+  end-each
+  loc d0> if
+    data frame loc snd 0 vct->channel drop
+  then
+;
+set-current
+
+: read-ascii <{ in-filename :optional
+     out-filename "test.snd"
+     out-type     mus-next
+     out-format   mus-bshort
+     out-srate    44100 -- snd }>
+  doc" tries to read an ASCII sound file"
+  out-filename out-type out-format out-srate 1 $" created by read-ascii: " in-filename $+ new-sound { snd }
+  in-filename snd read-ascii-cb as-one-edit drop
+  snd
+;
+previous
+
 \ ;;; -------- make dot size dependent on number of samples being displayed
 \ ;;; 
 \ ;;; this could be extended to set time-graph-style to graph-lines
@@ -1422,11 +1465,10 @@ previous
   freq-inc make-array map! i bin * radius make-formant end-map { formants }
   out-len 0.0 make-vct map!
     i freq-inc mod 0= if
-      c-g? if "interrupted" leave then	\ ;; if C-g exit the loop returning the string "interrupted"
       inctr fftsize snd chn #f channel->vct to fdr
       fdr vct-peak old-peak-amp fmax to old-peak-amp
       fdr fdi #f 2 spectrum ( fdr ) spectr vct-subtract! ( fdr ) freq-inc 1/f vct-scale! drop
-      hop +to inctr
+      hop inctr + to inctr
     then
     spectr fdr vct? if fdr vct-add! then formants noi 0.0 rand formant-bank ( outval )
     dup fabs new-peak-amp fmax to new-peak-amp
@@ -1450,11 +1492,10 @@ previous
   freq-inc make-array map! i bin * radius make-formant end-map { formants }
   len 0.0 make-vct map!
     i freq-inc mod 0= if
-      c-g? if "interrupted" leave then	\ ;; if C-g exit the loop returning the string "interrupted"
       inctr fftsize snd chn #f channel->vct to fdr
       fdr vct-peak old-peak-amp fmax to old-peak-amp
       fdr fdi #f 2 spectrum ( fdr ) spectr vct-subtract! ( fdr ) freq-inc 1/f vct-scale! drop
-      freq-inc +to inctr
+      freq-inc inctr + to inctr
     then
     spectr fdr vct-add! ( spectr ) formants pulse 0.0 sum-of-cosines formant-bank ( outval )
     dup fabs new-peak-amp fmax to new-peak-amp
@@ -1642,7 +1683,7 @@ previous
 	position-in-original jitter mus-random f+ fround->s 0 max snd chn 1 #f make-sampler
 	cycle-set!
 	grain-envs next-reader array-ref mus-reset drop
-	hop-frames +to next-reader-start-at
+	hop-frames next-reader-start-at + to next-reader-start-at
       then
       0.0 ( sum )
       readers each { rd }
@@ -1803,7 +1844,6 @@ previous
   10 0.0 make-vct { samps }
   #f 					\ flag
   #f #f #f frames loc ?do
-    c-g? ?leave
     samp1 to samp0
     samp2 to samp1
     rd next-sample to samp2
@@ -1820,7 +1860,7 @@ previous
   -2 { click }
   begin
     click 2+ find-click to click
-    click c-g? not &&
+    click
   while
       click 2- 4 #f #f smooth-sound drop
   repeat
@@ -2009,7 +2049,7 @@ previous
   ( data ) map
     *key* { id }
     time { cur }
-    id 0 region-frames id region-srate f/ +to time
+    id 0 region-frames id region-srate f/ time f+ to time
     #( cur id )
   end-map region-play-list
 ;
@@ -2213,7 +2253,7 @@ hide
   data 0 vct-ref { angle }
   data 1 vct-ref { incr }
   angle fsin y f* ( val )
-  data 0 angle incr forward if + else - then vct-set! drop ( val )
+  data 0 angle incr forward if f+ else f- then vct-set! drop ( val )
 ;
 : rmc-cb2 { freq snd -- prc; frag-beg frag-dur self -- vct }
   2 proc-create { prc } freq , snd , prc
@@ -2291,7 +2331,7 @@ hide
       then
     then
     reg start #f #f 0 mix-region drop
-    reg 0 region-frames +to start
+    reg 0 region-frames start + to start
     reg forget-region drop
   loop
   pieces
@@ -2342,7 +2382,7 @@ hide
       val actual-block-len beg - f* 0.1 f* to val
     then
   then
-  1 +to beg
+  beg 1+ to beg
   beg actual-block-len = if
     1 self 2 cells + +! ( ctr++ )
     0 self 1 cells + !  ( beg = 0 )
@@ -2418,9 +2458,9 @@ set-current
 ;
 previous
 
-\ ;;; -------- sync-all
+\ ;;; -------- sync-everything
 
-: sync-all ( -- )
+: sync-everything ( -- )
   doc" Sets the sync fields of all currently open sounds to the same, unique value."
   sync-max 1+ { new-sync }
   sounds each ( snd ) new-sync swap set-sync drop end-each