1\ snd-forth-docs.fs -- examples from sndclm.html
2
3\ Usage: snd-forth-nogui -noinit snd-forth-docs.fs
4
5require clm
6require examp
7
8\ OSCIL
9lambda: ( -- )
10  440.0 make-oscil { gen }
11  44100 0 do
12    i  gen 0 0 oscil  f2/ *output* outa drop
13  loop
14; :play #t with-sound drop
15
16\ ENV
17lambda: ( -- )
18  440.0 make-oscil { gen }
19  '( 0 0 0.01 1 0.25 0.1 0.5 0.01 1 0 )
20  :scaler 0.5 :length 44100 make-env { ampf }
21  44100 0 do
22    i  gen 0 0 oscil  ampf env  f* *output*  outa drop
23  loop
24; :play #t with-sound drop
25
26\ TABLE-LOOKUP
27lambda: ( -- )
28  440.0 :wave '( 1 0.5  2 0.5 ) #f #f partials->wave make-table-lookup { gen }
29  44100 0 do
30    i  gen 0 table-lookup  f2/ *output* outa drop
31  loop
32; :play #t with-sound drop
33
34\ POLYWAVE
35lambda: ( -- )
36  440.0 :partials '( 1 0.5 2 0.5 ) make-polywave { gen }
37  44100 0 do
38    i  gen 0 polywave  f2/ *output* outa drop
39  loop
40; :play #t with-sound drop
41
42\ TRIANBLE-WAVE
43lambda: ( -- )
44  440.0 make-triangle-wave { gen }
45  44100 0 do
46    i  gen 0 triangle-wave  f2/ *output* outa drop
47  loop
48; :play #t with-sound drop
49
50\ NCOS
51lambda: ( -- )
52  440.0 10 make-ncos { gen }
53  44100 0 do
54    i  gen 0 ncos  f2/ *output* outa drop
55  loop
56; :play #t with-sound drop
57
58\ NRXYCOS
59lambda: ( -- )
60  440.0 :n 10 make-nrxycos { gen }
61  44100 0 ?do
62    i  gen 0 nrxycos  f2/ *output* outa drop
63  loop
64; :play #t with-sound drop
65
66\ SSB-AM
67lambda: ( -- )
68  440.0 20 make-ssb-am { shifter }
69  440.0 make-oscil { osc }
70  44100 0 ?do
71    i  shifter  osc 0 0 oscil  0 ssb-am f2/ *output* outa drop
72  loop
73; :play #t :statistics #t :srate 44100 with-sound drop
74
75\ WAVE-TRAIN
76lambda: ( -- )
77  400 10 make-ncos { g }
78  g -0.5 pi f* set-mus-phase drop
79  64 make-vct map! g 0 ncos end-map { v }
80  440.0 :wave v make-wave-train { gen }
81  44100 0 do
82    i  gen 0 wave-train  f2/ *output* outa drop
83  loop
84; :play #t with-sound drop
85
86\ RAND
87lambda: ( -- )
88  5.0 220.0 hz->radians make-rand { ran1 }
89  5.0 330.0 hz->radians make-rand-interp { ran2 }
90   440.0 make-oscil { osc1 }
91  1320.0 make-oscil { osc2 }
92  88200 0 do
93    i  osc1  ran1 0 rand         0 oscil  f2/ *output* outa drop
94    i  osc2  ran2 0 rand-interp  0 oscil  f2/ *output* outb drop
95  loop
96; :channels 2 :play #t with-sound drop
97
98\ TWO-POLE
99lambda: ( -- )
100  1000.0 0.999 make-two-pole { flt }
101  10000.0 0.002 make-rand { ran1 }
102  44100 0 do
103    i  flt  ran1 0 rand  two-pole  f2/ *output* outa drop
104  loop
105; :play #t with-sound drop
106
107\ FIRMANT
108lambda: ( -- )
109  1000.0 0.999 make-firmant { flt }
110  10000.0 5.0 make-rand { ran1 }
111  44100 0 do
112    i  flt  ran1 0 rand  #f firmant  f2/ *output* outa drop
113  loop
114; :play #t with-sound drop
115
116\ IIR-FILTER
117lambda: ( -- )
118  3 vct( 0.0 -1.978 0.998 ) make-iir-filter { flt }
119  10000.0 0.002 make-rand { ran1 }
120  44100 0 do
121    i  flt  ran1 0 rand  iir-filter  f2/ *output* outa drop
122  loop
123; :play #t with-sound drop
124
125\ DELAY
126lambda: ( -- )
127  0.5 seconds->samples make-delay { dly }
128  440.0 make-oscil { osc1 }
129  660.0 make-oscil { osc2 }
130  44100 0 do
131    i
132    osc1 0 0 oscil
133    dly  osc2 0 0 oscil  0 delay f+
134    f2/ *output* outa drop
135  loop
136; :play #t with-sound drop
137
138\ COMB
139lambda: ( -- )
140  0.4 0.4 seconds->samples make-comb { cmb }
141  440.0 make-oscil { osc }
142  '( 0 0 1 1 2 1 3 0 ) :length 4410 make-env { ampf }
143  88200 0 do
144    i
145    cmb ( gen )
146    ampf env  osc 0 0 oscil  f* ( val )
147    0 ( pm )
148    comb f2/ *output* outa drop
149  loop
150; :play #t with-sound drop
151
152\ ALL-PASS
153lambda: ( -- )
154  -0.4 0.4 0.4 seconds->samples make-all-pass { alp }
155  440.0 make-oscil { osc }
156  '( 0 0 1 1 2 1 3 0 ) :length 4410 make-env { ampf }
157  88200 0 do
158    i
159    alp ( gen )
160    ampf env  osc 0 0 oscil  f* ( val )
161    0 ( pm )
162    all-pass f2/ *output* outa drop
163  loop
164; :play #t with-sound drop
165
166\ MOVING-AVERAGE
167lambda: ( -- )
168  4410 make-moving-average { avg }
169  440.0 make-oscil { osc }
170  44100 4410 - { stop }
171  0.0 { val }
172  stop 0 do
173    osc 0 0 oscil to val
174    i  avg val fabs moving-average  val f* *output* outa drop
175  loop
176  44100 stop do
177    i  avg 0.0 moving-average  osc 0 0 oscil f*  *output* outa drop
178  loop
179; :play #t with-sound drop
180
181\ SRC1
182lambda: ( -- )
183  "oboe.snd" make-readin { rd }
184  rd 0.5 make-src { sr }
185  "oboe.snd" mus-sound-framples 2* ( len ) 0 do
186    i  sr 0 #f src  *output* outa drop
187  loop
188; :play #t :srate 22050 with-sound drop
189
190\ SRC2
191: make-src-proc { osc -- prc; dir self -- val }
192  1 proc-create osc , ( prc )
193 does> { dir self -- val }
194  self @ ( osc ) 0 0 oscil
195;
196
197lambda: ( -- )
198  440.0 make-oscil { osc }
199  osc make-src-proc { prc }
200  :srate 2.0 make-src { sr }
201  44100 0 do
202    i  sr 0 prc src  *output* outa drop
203  loop
204; :play #t with-sound drop
205
206\ CONVOLVE1
207lambda: ( -- )
208  "pistol.snd" make-readin ( rd )
209  "oboe.snd" file->vct ( v ) make-convolve { cnv }
210  88200 0 do
211    i  cnv #f convolve  0.25 f* *output* outa drop
212  loop
213; :play #t :statistics #t with-sound drop
214
215\ CONVOLVE2
216lambda: ( -- )
217  "oboe.snd" "pistol.snd" 0.5 "convolved.snd" convolve-files { tempfile }
218  tempfile make-readin { reader }
219  tempfile mus-sound-framples ( len ) 0 do
220    i  reader readin  *output* outa drop
221  loop
222  tempfile file-delete
223; :play #t with-sound drop
224
225\ GRANULATE1
226lambda: ( -- )
227  "oboe.snd" make-readin 2.0 make-granulate { grn }
228  44100 0 do
229    i  grn #f #f granulate  *output* outa drop
230  loop
231; :play #t with-sound drop
232
233\ GRANULATE2
234: make-granulate-proc { osc sweep -- prc; dir self -- val }
235  1 proc-create osc , sweep , ( prc )
236 does> { dir self -- val }
237  self @ ( osc )  self cell+ @ ( sweep ) env  0 oscil  0.2 f*
238;
239
240lambda: ( -- )
241  440.0 make-oscil { osc }
242  '( 0 0 1 1 ) :scaler 440.0 hz->radians :length 44100 make-env { sweep }
243  osc sweep make-granulate-proc :expansion 2.0 :length 0.5 make-granulate { grn }
244  88200 0 do
245    i  grn #f #f granulate  *output* outa drop
246  loop
247; :play #t with-sound drop
248
249\ PHASE-VOCODER1
250lambda: ( -- )
251  "oboe.snd" make-readin :pitch 2.0 make-phase-vocoder { pv }
252  44100 0 do
253    i  pv #f #f #f #f phase-vocoder  *output* outa drop
254  loop
255; :play #t with-sound drop
256
257\ PHASE-VOCODER2
258lambda: ( -- )
259  "oboe.snd" make-readin :interp 256 make-phase-vocoder { pv }
260  "oboe.snd" mus-sound-framples 2* ( samps ) 0 do
261    i  pv #f #f #f #f phase-vocoder  *output* outa drop
262  loop
263; :play #t :srate 22050 with-sound drop
264
265\ ASYMMETRIC-FM
266lambda: ( -- )
267  440.0 0.0 0.9 0.5 make-asymmetric-fm { fm }
268  44100 0 do
269    i  fm 1.0 0 asymmetric-fm  f2/ *output* outa drop
270  loop
271; :play #t with-sound drop
272
273\ FILE->FRAME->FILE
274lambda: ( -- )
275  "stereo.snd" make-file->frame { input }
276  2 make-frame { frm }
277  "stereo.snd" mus-sound-framples ( len ) 0 do
278    input i frm file->frame ( frm ) 1 frame-ref ( val1 )
279    frm 0 frame-ref ( val0 ) frm 1 rot frame-set! drop
280    ( val1 ) frm 0 rot frame-set! drop
281    *output* i frm frame->file drop
282  loop
283; :channels 2 :play #t with-sound drop
284
285\ READIN
286lambda: ( -- )
287  "oboe.snd" make-readin { reader }
288  44100 0 do
289    i  reader readin  f2/ *output* outa drop
290  loop
291; :play #t with-sound drop
292
293\ IN-OUT-ANY
294lambda: ( -- )
295  "oboe.snd" make-file->sample { infile }
296  44100 0 do
297    i  i 0 infile in-any  0 *output* out-any drop
298  loop
299; :play #t with-sound drop
300
301\ LOCSIG
302lambda: ( -- )
303  60.0 make-locsig { loc }
304  440.0 make-oscil { osc }
305  44100 0 do
306    loc i  osc 0 0 oscil f2/  locsig drop
307  loop
308; :play #t :channels 2 with-sound drop
309
310\ AMPLITUDE-MODULATE
311lambda: ( -- )
312  440.0 make-oscil { osc1 }
313  220.0 make-oscil { osc2 }
314  44100 0 do
315    i
316    0.3            ( car )
317    osc1 0 0 oscil ( in1 )
318    osc2 0 0 oscil ( in2 ) amplitude-modulate  f2/ *output* outa drop
319  loop
320; :play #t with-sound drop
321
322bye
323
324\ snd-forth-docs.fs ends here
325