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