rev: 3827f53bae88e48a594610914ba74b9512ead6dd tukan/testing/test_audio2.sc -rw-r--r-- 15.2 KiB View raw Log this file
3827f53bae88 — Leonard Ritter * more work on module system 3 months ago
                                                                                
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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
using import itertools
using import glm
using import ..tukan.dsp.utils
using import ..tukan.midi
using import ..tukan.sdl
import ..tukan.dsp.svf
let svf = tukan.dsp.svf
using import .testaudio

let pi2 = (2.0 * pi)

inline key-missing ()
    static-error "key missing"

inline musictime (bpm srate)
    """"given an integer beat per minute and a sampling rate, return a
        converter that turns integer sample index to a f32 beat index
    fn (samples)
        beat-time := (samples * bpm) // 60
        beat := beat-time // srate
        ph := (beat-time % srate) / srate
        (f32 beat) + ph

let phasor~ =
    stateful-map
        inline "phasor~" (src phase)
            """"in: samplerate:f32 frequency:f32
            let srate freq =
                call
                    inline "phasor-keys" (samplerate frequency ...)
                        _ samplerate frequency
                    src;
            _
                inline () phase
                (phase + (freq / srate)) % 1.0
        0.0

inline vec-phasor~ (n)
    let one =
        vector.smear 1.0 n
    stateful-map
        inline "phasor~" (src phase)
            """"in: samplerate:f32 frequency:f32
            let srate freq =
                call
                    inline "phasor-keys" (samplerate frequency ...)
                        _ samplerate frequency
                    src;
            _
                inline () phase
                (phase + (freq / srate)) % one
        vector.smear 0.0 n

enum ADSRState Attack Decay Sustain Release Idle
# key state
enum KeyState Off Idle On

let MIN_ATTACK_TIME = 2.2e-03

let ramp~ =
    stateful-map
        inline "ramp~" (src value)
            """"in: samplerate:f32 target:f32 attack:f32 decay:f32
            let srate target attack decay =
                call
                    inline "ramp-keys" (samplerate target attack decay ...)
                        _ samplerate target attack decay
                    src;
            let attack-rate = (/ (attack * srate))
            let decay-rate = (/ (decay * srate))
            let value =
                ? (value < target)
                    min (value + attack-rate) target
                    max (value - decay-rate) target
            output := value * value * (3.0 - 2.0 * value)
            _ (inline () output) value
        0.0

inline vec-ramp~ (n)
    let one = (vector.smear 1.0 n)
    let two = (vector.smear 2.0 n)
    let three = (vector.smear 3.0 n)
    stateful-map
        inline "ramp~" (src value)
            """"in: samplerate:f32 target:f32 attack:f32 decay:f32
            let srate target attack decay =
                call
                    inline "ramp-keys" (samplerate target attack decay ...)
                        _ samplerate target attack decay
                    src;
            let attack-rate = (one / (attack * srate))
            let decay-rate = (one / (decay * srate))
            let value =
                ? (value < target)
                    min (value + attack-rate) target
                    max (value - decay-rate) target
            output := value * value * (three - two * value)
            _ (inline () output) value
        vector.smear 0.0 n

inline adsr~ (srate)
    let srate = (srate as f32)
    stateful-map
        inline "adsr~" (src value target state)
            let on attack decay sustain release = (src)
            let target state =
                switch on
                case KeyState.On
                    _ (? (target <= 0.0) 1.0 target) ADSRState.Attack
                case KeyState.Off
                    _ 0.0 ADSRState.Release
                default (_ target state)
            let attack-rate = (/ (attack * srate))
            let decay-rate = (max ((1.0 - sustain) / (decay * srate)) 0.0)
            let release-rate = (max (sustain / (release * srate)) 0.0)
            let value target state =
                switch state
                case ADSRState.Attack
                    value := value + attack-rate
                    if (value >= target)
                        _ target sustain ADSRState.Decay
                    else
                        _ value target state
                case ADSRState.Decay
                    if (value > sustain)
                        value := value - decay-rate
                        if (value <= sustain)
                            _ sustain target ADSRState.Sustain
                        else
                            _ value target state
                    else
                        # attack target < sustain level
                        value := value + decay-rate
                        if (value >= sustain)
                            _ sustain target ADSRState.Sustain
                        else
                            _ value target state
                case ADSRState.Release
                    value := value - release-rate
                    if (value <= 0.0)
                        _ 0.0 target ADSRState.Idle
                    else
                        _ value target state
                default (_ value target state)
            _ (inline () value) value target state
        \ 0.0 0.0 ADSRState.Idle

let trigger~ =
    stateful-map
        inline (src state)
            let held = (src)
            let outval state =
                if (held == state)
                    _ KeyState.Idle state
                else
                    _ held held
            _ (inline () outval) state
        KeyState.Off

inline const~ (n...)
    map (inline (...) n...)

inline svf~ (srate)
    let srate = (srate as f32)
    let invsrate = (/ (2.0 * srate))
    stateful-map
        inline "svf~" (src state...)
            # signal 523.0 0.0 0.0
            let in cutoff res drive = (src)
            drive := (drive * 0.1)
            freq := 2.0 * (sin (pi * (min 0.25 (cutoff * invsrate))))
            damp := (min 2.0
                (2.0 * (1.0 - (pow res 0.25))) (2.0 / freq - freq * 0.5))
            inline step (notch low high band)
                notch := (in - damp * band)
                low := (low + freq * band)
                high := (notch - low)
                band := (freq * high + band - drive * band * band * band)
                _ notch low high band
            let notch1 low1 high1 band1 = (step state...)
            let notch2 low2 high2 band2 = (step notch1 low1 high1 band1)
            _
                inline ()
                    let a = (vec4 notch1 low1 high1 band1)
                    let b = (vec4 notch2 low2 high2 band2)
                    a * 0.5 + b * 0.5
                \ notch2 low2 high2 band2
        # notch low high band
        \ 0.0 0.0 0.0 0.0

inline softclamp~ (n)
    """"a simple amplitude limiter
        n is the reciprocal of the first derivative at x=0

        inverse: n*x*(abs(x) + 1) / (1 - x * x)
    let n =
        static-if (none? n) 1.0
        else n
    let n = (/ (n as f32))
    map
        inline (s)
            s / ((abs s) + n)
            # nice for distortion:
                functions that roll back after a certain amplitude
                s / ((abs (s * s)) + n)
                sin (s * 0.5 * pi)

inline kick (x)
    """"generates a 4/4 kick frequency from a beat index and phase
    x := (x % 1.0)
    x := (min (x * 4.0) 1.0)
    x := x * 8.0 + 1.0
    x := (/ (x * x))
    hz (mix (F 2) (F 8) x)

inline +~ (coll...)
    demux 0.0 (do +) coll...

inline *~ (coll...)
    demux 1.0 (do *) coll...

inline vec-*~ (n coll...)
    demux (vector.smear 1.0 n) (do *) coll...

inline midi~ ()
    local event = (nullof SDL_Event)
    map
        inline (...)
            if ((SDL_PollEvent (& event)) != 0)
                if (event.type == MIDIEvent)
                    let timestamp channel command param1 param2 =
                        midi-unpack-message event
                    #if
                        or
                            command == MIDICommand.NoteOn
                            command == MIDICommand.NoteOff
                        print timestamp channel command param1 param2
                    switch (command as MIDICommand)
                    pass MIDICommand.NoteOn
                    case MIDICommand.NoteOff
                        #print "PRESS" param1 param2
                        return (note = param1) (velocity = param2)
                    default
                        ;
            return (note = 0) (velocity = 0)
        #if (event.type == SDL_QUIT)
            break;

let mono~ =
    stateful-map
        inline (src last-note last-vel)
            let note vel =
                (inline (note velocity ...) (_ note velocity)) (src)
            let note vel =
                if ((last-note == note) | (vel != 0))
                    _ note vel
                else
                    _ last-note last-vel
            _
                inline ()
                    _
                        note = note
                        velocity = vel
                note
                vel
        \ 0 0

inline vec-mono~ (n)
    let vecT = (vector i32 n)
    let nullvec = (nullof vecT)
    stateful-map
        inline (src last-note last-vel)
            let note vel =
                (inline (note velocity ...) (_ note velocity)) (src)
            let cmp = ((last-note == note) | (vel != nullvec))
            let note vel =
                ? cmp note last-note
                ? cmp vel last-vel
            _
                inline ()
                    _
                        note = note
                        velocity = vel
                note
                vel
        \ (nullof vecT) (nullof vecT)

inline voiceselect~ (n)
    map
        inline (channel note velocity ...)
            if (channel == n)
                _ (note = note) (velocity = velocity)
            else
                _ (note = 0) (velocity = 0)

inline vec-voiceselect~ (n)
    let vecT = (vector i32 n)
    map
        inline (channel note velocity ...)
            let notes = (nullof vecT)
            let velocities = (nullof vecT)
            let notes =
                insertelement notes note channel
            let velocities =
                insertelement velocities velocity channel
            _ (note = notes) (velocity = velocities)

inline pop-front (queue stride)
    """"for a queue with entries of stride bitwidth, pop value at the front
        and leave an empty slot at index 0.
        returns the new queue and the value that was popped.
    let T = (typeof queue)
    mask := ((-1 as T) << stride)
    val := queue & (~ mask)
    l := queue >> stride
    _ l val

inline pop (queue stride index)
    """"for a queue with entries of stride bitwidth, pop value from index
        and move the front of the queue to leave an empty slot at index 0.
        returns the new queue and the value that was popped.
    let T = (typeof queue)
    allbits := (-1 as T)
    bits := (index * stride)
    val := (queue >> bits) & (~ (allbits << stride))
    mask := allbits << bits
    l := queue & (mask << stride)
    r := (queue & (~ mask)) << stride
    _ (l | r) val

fn process-poly8 (notes channels note vel)
    if (note != 0) # event registered?
        let note64 = (note as u64)
        if (vel == 0) # key off?
            # find voice to turn off
            for i in (range 8)
                bits := (i * 8) as u64
                if (((notes >> bits) & 0xff:u64) == note64)
                    # move entry to front
                    let channels ch = (pop channels 3:u32 (i as u32))
                    let notes = (pop notes 8:u64 (i as u64))
                    channels := channels | ch
                    let ch = (ch as i32)
                    return (ch as i32 + 1) notes channels
        else # key on?
            # pop from front
            let channels ch = (pop-front channels 3:u32)
            let notes = (pop-front notes 8:u64)
            # insert at the back
            channels := channels | (ch << (3:u32 * 7:u32))
            notes := notes | (note64 << (8:u32 * 7:u32))
            return (ch as i32 + 1) notes channels
    # nothing happened
    return 0 notes channels

let poly8~ =
    # for eight voices
    stateful-map
        # notes: 8 notes, 8 bits per entry
        # channels: 8 voice indices, 3 bits per entry
        inline (src notes channels)
            # receive note and velocity
            let note vel =
                (inline (note velocity ...) (_ note velocity)) (src)
            let ch notes channels = (process-poly8 notes channels note vel)
            _
                inline ()
                    _
                        channel = ch
                        note = note
                        velocity = vel
                notes
                channels
        \ 0:u64 0xfac688:u32

inline polyphonic-sine-synth ()
    """"in: samplerate:f32 note:i32 velocity:i32
    inline gen-voices (n)
        let pi2 = (vector.smear pi2 n)

        inline sine (x)
            sin (pi2 * x)

        let fvecT = (vector f32 n)
        let f127 = (vector.smear (/ 127.0) n)
        let f01 = (vector.smear 0.1 n)
        let f440 = (vector.smear 440.0 n)
        let f69 = (vector.smear 69.0 n)
        let f12 = (vector.smear (/ 12.0) n)

        inline hz (c)
            f440 * (exp2 ((c - f69) * f12))

        compose
            # clamp input arguments
            map
                inline (samplerate channel note velocity ...)
                    _
                        samplerate = (vector.smear samplerate n)
                        channel = channel
                        note = note
                        velocity = velocity
            retain
                # filter previous note velocity attributes
                inline (note velocity ...)
                    ...
                vec-voiceselect~ n
                #map
                    inline (...)
                        print ...
                        ...
                vec-mono~ n
            vec-*~ n
                # amplitude
                compose
                    map
                        inline (samplerate velocity ...)
                            _
                                samplerate = samplerate
                                target =
                                    (sitofp velocity fvecT) * f127
                                attack = (vector.smear MIN_ATTACK_TIME n)
                                decay = (vector.smear 0.5 n)
                    vec-ramp~ n
                # tone
                compose
                    retain _
                        # vibrato
                        retain _
                            const~
                                frequency = (vector.smear 7.0 n)
                        vec-phasor~ n
                        map sine
                        map (inline (s) (_ (vibrato = s)))
                    map
                        inline (note vibrato ...)
                            _
                                note = note
                                frequency =
                                    hz ((sitofp note fvecT) + vibrato * f01)
                                ...
                    vec-phasor~ n
                    map sine

    compose
        retain _
            midi~;
            poly8~
        gen-voices 8
        map
            inline (voices)
                vector-reduce fadd voices
        map
            inline (v)
                volume -2.0 v
        #softclamp~;
        map stereo

midi-init;
test-audio
    polyphonic-sine-synth;
    time =
        ? main-module? 3600 2
midi-exit;