;; make sampler instrument
(bind-func make_instrument
(lambda (note_kernel:NOTE_KERNEL_SAMPLER effect_kernel:FX_KERNEL)
(effect_kernel.notekernel:NOTE_KERNEL_SAMPLER note_kernel)
(let ((poly:i64 36)
(samples:|20,|128,SAMPLE*||* (zalloc)) ;; 128 samples * 20 'banks'
(samples_length:|20,|128,i64||* (zalloc)) ;; 128 samples * 20
(samples_channels:|20,|128,i64||* (zalloc)) ;; 128 samples * 20
(samples_offsets:|20,|128,i64||* (zalloc)) ;; 128 samples * 20
(notes:NoteData** (zalloc poly))
(note:NoteData* null)
(kernels:[SAMPLE,i64,i64]** (zalloc poly))
(kernel:[SAMPLE,i64,i64]* null)
(starttime:i64 0)
(out:SAMPLE 0.0)
(k:i64 0) (i:i64 0)
(new_note (lambda (start:i64 freq:SAMPLE dur:i64 amp:SAMPLE nargs:i64 dargs:SAMPLE*)
(let ((free_note (instrument_find_note notes poly))
(idx (note_idx free_note))
(zone (note_zone (free_note)))
(bank:i32 (if (< nargs 1) (i64toi32 0) (convert (pref dargs 0))))
(midiidx:i64 (convert (floor (frq2midi freq))))
(closest 1000000)
(i:i64 0) (iii:i64 0) (idxi:i64 0)
(new_idx idx))
(dotimes (idxi 128)
(let ((v (llabs (- midiidx idxi))))
(if (and (<> (aref (aref-ptr samples_length bank) idxi) 0)
(< v closest))
(begin (set! new_idx idxi)
(set! closest v) 0))))
(if (or (< (- (aref (aref-ptr samples_length bank) new_idx) 10) 1)
(null? (aref (aref-ptr samples bank) new_idx)))
(begin
(println 'No 'samples 'loaded 'in 'bank bank)
null)
(if (null? free_note)
null
(if (note_active free_note)
(begin
;; existing kernel is still in use!
;; simply update note details (i.e. data) and keep on truckin!
(tfill! free_note idx start freq amp dur 1.0 #t 0 (cast zone))
free_note)
(begin ;; new kernel required!
(reset_zone zone)
(push_zone zone)
(tfill! free_note idx start freq amp dur 1.0 #t 0 (cast zone))
(pset! kernels idx (note_kernel free_note
(aref-ptr samples bank)
(aref-ptr samples_length bank)
(aref-ptr samples_offsets bank)
(aref-ptr samples_channels bank)
new_idx
nargs
dargs))
(pop_zone)
free_note))))))))
(dotimes (k 128)
(dotimes (i 20) ;20 banks
(aset! (aref-ptr samples_offsets i) k 0)
(aset! (aref-ptr samples_length i) k 0)))
;; init notes
(dotimes (i poly)
(pset! kernels i (cast null))
(pset! notes i (NoteData i 0 0.0 0.0 0 1.0 #f 0 (cast (create_zone (* 10 1024))))))
(lambda (in:SAMPLE time:i64 chan:i64 dat:SAMPLE*)
(set! out 0.0)
(dotimes (k poly) ;; sum all active notes
(set! note (pref notes k))
(set! starttime (note_starttime note))
(if (not (note_active note)) (pset! kernels k (cast null)))
(set! kernel (pref kernels k))
(if (and (> time starttime) (not (null? kernel)))
(set! out (+ out (* 0.3 (kernel time chan))))))
(* 2.0 (effect_kernel out time chan dat))))))