make_instrument   xtlang


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/libs/core/instruments.xtm

Implementation

(bind-func make_instrument
  (lambda (note_kernel:NOTE_KERNEL effect_kernel:FX_KERNEL)
    (effect_kernel.notekernel:NOTE_KERNEL note_kernel)
    (let* ((maxpoly:i64 MAXPOLYPHONY)
           (tmp_active:i64 0)
           (name:String* (effect_kernel.name))
           (numactive:i64 0)
           (poly:i64 maxpoly)
           (notes:NoteData** (zalloc poly))
           (note_event_buf:i64 10)
           (note_events:<i64,SAMPLE,SAMPLE,i64,NoteData*>* (alloc note_event_buf))
           (note_event:<i64,SAMPLE,SAMPLE,i64,NoteData*>* null)
           (note_event_b:<i64,SAMPLE,SAMPLE,i64,NoteData*>* null)
           (note_event_c:<i64,SAMPLE,SAMPLE,i64,NoteData*>* null)
           (note_event_in_idx:i64 0)
           (note_event_out_idx:i64 0)
           (note_event_out_idx_b:i64 0)
           (note_event_out_idx_c:i64 0)
           (note_event_out_time:i64 #x0FFFFFFFFFFFFFFF)
           (note_event_out_time_b:i64 #x0FFFFFFFFFFFFFFF)
           (note_event_out_time_c:i64 #x0FFFFFFFFFFFFFFF)
           (note_event_note:NoteData* null)
           (note:NoteData* null)
           (kernels:[SAMPLE,i64,i64]** (zalloc poly))
           (kernel:[SAMPLE,i64,i64]* null)
           (nullkernel:[SAMPLE,i64,i64]* null)
           (starttime:i64 0)
           (out:SAMPLE 0.0)
           (zzone:mzone* null)
           (k:i64 0) (i:i64 0) (j: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)))
                         (if (null? free_note)
                             null
                             (if (or (note_active free_note) #f) ;; (> (note_refcnt free_note) 0))
                                 (begin ;; resuse existing kernel
                                   ;; (println "A idx:" (note_idx free_note) start freq amp dur)
                                   (set! kernel (pref kernels (note_idx free_note)))
                                   (tset! free_note 2 freq)
                                   (tset! free_note 3 amp)
                                   (tset! free_note 4 dur)
                                   (tset! free_note 5 1.0)
                                   (tset! free_note 7 start)
                                   (cset! (cast kernel [void]*) data free_note NoteData*)
                                   ;; existing kernel is still in use!
                                   free_note)
                                 (begin ;; create new kernel
                                   ;; (println "B idx:" (note_idx free_note) start freq amp dur)
                                   (reset_zone zone)
                                   (push_zone zone)
                                   ;; initialize kernel with active set to #f
                                   (tfill! free_note idx start freq amp dur 1.0 #f start (cast zone i8*))
                                   ;; init new kernel
                                   (pset! kernels idx (note_kernel free_note nargs dargs))
                                   ;; activate to true once kernel is valid
                                   (note_active free_note #t) ;; don't activate until kernel is valid!
                                   (pop_zone)
                                   free_note)))))))
      ;; init note events
      (dotimes (i 10)
        (tfill! (pref-ptr note_events i) #x0FFFFFFFFFFFFFFF 0.0 0.0 0 null))
      ;; 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))))))
      ;; sum all active note kernels and then process through effect kernel
      (lambda (in:SAMPLE time:i64 chan:i64 dat:SAMPLE*)
        (set! out 0.0)
        (set! tmp_active 0)
        (dotimes (k poly) ;; sum all active notes
          (set! note (pref notes k))
          (set! starttime (tref note 1)) ;; tref (faster)
          (if (not (tref note 6)) ;; if not active
              (begin void) ;(tset! note 1 #x0FFFFFFFFFFFFFFF) void) ;; (pset! kernels k nullkernel) void)
              (begin (set! tmp_active (+ tmp_active 1)) void))
          (set! kernel (pref kernels k))
          (if (and (>= time starttime) (tref note 6)) ; (not (null? kernel)))
              (set! out (+ out (* 0.2 (kernel time chan))))))
        (set! numactive tmp_active)
        (effect_kernel out time chan dat)))))


Back to Index

Similar Entries

  • CV_MAKE_TYPE    xtlang
  • aiProcess_MakeLeftHanded    scheme
  • cl:make-list    scheme
  • cvMakeColour    xtlang
  • glfw_make_context_current    xtlang
  • impc:ir:compile:make-closure    scheme
  • impc:ir:compile:make-closureenv    scheme
  • impc:ir:compile:make-env    scheme
  • impc:ir:compile:make-static    scheme
  • impc:ir:compiler:make-array    scheme
  • impc:ir:compiler:make-tuple    scheme
  • impc:ir:compiler:make-vector    scheme
  • impc:ir:make-arglist-str    scheme
  • impc:ir:make-const-string    scheme
  • impc:ir:make-function-str    scheme
  • impc:ir:make-string    scheme
  • impc:ir:make-struct-str    scheme
  • impc:ir:make-struct-str-env    scheme
  • impc:ti:make-array-check    scheme
  • impc:ti:make-tuple-check    scheme
  • impc:ti:make-vector-check    scheme
  • impc:ti:nativef-generics-make-gtypes-unique    scheme
  • instrument_find_note    xtlang
  • make-bezier    scheme
  • make-envelope    xtlang
  • make-environment    macro
  • make-instrument    macro
  • make-list    scheme
  • make-list-with-proc    scheme
  • make-metre    scheme
  • make-metro    scheme
  • make-rhythm    scheme
  • make-timeline    scheme
  • make-vector-with-proc    scheme
  • make_bodies    xtlang
  • make_instrument    xtlang
  • make_mono    xtlang
  • make_static_scheme_wrapper_ir    scheme
  • make_window_transparent    xtlang
  • match-result:make    scheme
  • matcher:make    scheme
  • my-inc-maker    xtlang
  • my-inc-maker-wrapper    xtlang
  • pc:make-chord    scheme
  • pc:make-chord-fixed    scheme
  • plet-make-bindings    scheme
  • sys_dir_make    xtlang
  • sys_dir_make_recursive    xtlang
  • xtm_make_model    xtlang