From e18811d4c5ce085c384af0549d53c3c2e92ba6f6 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Wed, 15 May 2024 19:41:43 -0400 Subject: [PATCH] Add 'external/bwac/' from commit '77339db087df30c932ecf01c1c6f702a9cbc3771' git-subtree-dir: external/bwac git-subtree-mainline: 395e120a26b23ac7a2fa97c1512bad826e158e08 git-subtree-split: 77339db087df30c932ecf01c1c6f702a9cbc3771 --- .gitignore | 3 + .gitlab-ci.yml | 61 ++++++ LICENSE | 21 ++ README.md | 61 ++++++ dune-project | 2 + misuja.opam | 33 +++ src/lib/.ocamlformat | 5 + src/lib/config/discover.ml | 17 ++ src/lib/config/dune | 3 + src/lib/dune | 18 ++ src/lib/misuja.ml | 59 ++++++ src/lib/misuja_jack_seq.c | 406 +++++++++++++++++++++++++++++++++++++ src/test/.ocamlformat | 5 + src/test/dune | 3 + src/test/relay.ml | 42 ++++ 15 files changed, 739 insertions(+) create mode 100644 .gitignore create mode 100644 .gitlab-ci.yml create mode 100644 LICENSE create mode 100644 README.md create mode 100644 dune-project create mode 100644 misuja.opam create mode 100644 src/lib/.ocamlformat create mode 100644 src/lib/config/discover.ml create mode 100644 src/lib/config/dune create mode 100644 src/lib/dune create mode 100644 src/lib/misuja.ml create mode 100644 src/lib/misuja_jack_seq.c create mode 100644 src/test/.ocamlformat create mode 100644 src/test/dune create mode 100644 src/test/relay.ml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b6f9f5 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +/.merlin +/.ocamlinit +/_build/ diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000..df169f7 --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,61 @@ +variables: + BUILD_SCRIPT: > + sudo apt-get update -qq && + sudo apt-get install -y pkg-config libjack-jackd2-dev m4 && + opam config exec -- opam remote add mothership https://github.com/ocaml/opam-repository.git && + opam config exec -- opam update --yes && + opam config exec -- opam upgrade --yes && + opam config exec -- opam install --yes depext && + opam config exec -- opam pin --yes -n add misuja . && + opam config exec -- opam depext --install --yes misuja && + opam config exec -- opam install --yes misuja && + opam config exec -- dune build @install src/test/relay.exe + BUILD_DOC: > + opam config exec -- opam install --yes odoc && + opam config exec -- dune build @doc && + mkdir -p public && + cp -r _build/default/_doc/_html/* public/ + +ocaml:4030: + image: ocaml/opam2:4.03 + script: + - bash -c "$BUILD_SCRIPT" + +ocaml:4042: + image: ocaml/opam2:4.04 + script: + - bash -c "$BUILD_SCRIPT" + +ocaml:4050: + image: ocaml/opam2:4.05 + script: + - bash -c "$BUILD_SCRIPT" + +ocaml:4060: + image: ocaml/opam2:4.06 + script: + - bash -c "$BUILD_SCRIPT" + +ocaml:4070: + image: ocaml/opam2:4.07 + script: + - bash -c "$BUILD_SCRIPT" + +testpages: + image: ocaml/opam2:4.07 + script: + - bash -c "$BUILD_SCRIPT" + - bash -c "$BUILD_DOC" + except: + - master + +pages: + image: ocaml/opam2:4.07 + script: + - bash -c "$BUILD_SCRIPT" + - bash -c "$BUILD_DOC" + artifacts: + paths: + - public + only: + - master diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..7d6b92e --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2017 Seb Mondet + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..46c84a5 --- /dev/null +++ b/README.md @@ -0,0 +1,61 @@ +Misuja: Midi Sequencer Using Jack +================================= + +A library to drive the MIDI system of the Jack Audio Connection Kit. + +Misuja is a low-latency “MIDI communications thread” implemented in C +which is manipulated with an OCaml API: +[`Misuja.Sequencer`](https://smondet.gitlab.io/misuja/misuja/Misuja/Sequencer/index.html) +(the process communicates with the Sequencer thread through ring-buffers +provided by the Jack API). + +This library is extracted from the venerable +[Locoseq](https://github.com/smondet/locoseq). + + +Build/Install +------------- + +To build/install the library: + + opam pin add misuja . -kgit + +or to build locally: + + dune build @install + +The library requires the development files of the JACK library, see the +`depexts` field in the `misuja.opam` file; the package is named +[`jack-audio-connection-kit-devel`](https://pkgs.org/download/jack-audio-connection-kit-devel) +on most RPM-based distributions, and +[`libjack-jackd2-dev`](https://packages.ubuntu.com/xenial/libjack-jackd2-dev) on +Ubuntu/Debian. + + +On Nix, this may look like: + + nix-shell -p pkg-config -p libjack2 --run 'dune build @install src/test/relay.exe' + +Tests +----- + +Build them: + + dune build @install src/test/relay.exe + +then: + + _build/default/src/test/relay.exe + +The test opens a Jack-midi client with 10 input and 10 output ports; it just +relays everything it gets as input but in the case of “note-on/off” MIDI events +it “power-harmonizes” them (it makes just “power chords,” i.e. it adds fifths +and octaves). + +Here is a setup with `a2jmidid`, `vmpk`, QSynth (in Jack-midi mode) connected +with QJackCtl: + +
diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..e32dad3 --- /dev/null +++ b/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.7) +(name misuja) diff --git a/misuja.opam b/misuja.opam new file mode 100644 index 0000000..528340e --- /dev/null +++ b/misuja.opam @@ -0,0 +1,33 @@ +opam-version: "2.0" +maintainer: "Seb Mondet " +authors: "Seb Mondet " +homepage: "https://gitlab.com/smondet/misuja" +bug-reports: "https://gitlab.com/smondet/misuja/issues" +dev-repo: "git+https://gitlab.com/smondet/misuja.git" +license: "MIT" +build: [ "dune" "build" "-p" name "-j" jobs ] +depends: [ + "ocaml" {>= "4.03.0"} + "dune" {build & >= "1.8.2"} + "base-unix" +] +depexts: [ + [["ubuntu"] ["libjack-jackd2-dev"]] + [["debian"] ["libjack-jackd2-dev"]] + [["alpine"] ["jack-dev"]] + [["fedora"] ["jack-audio-connection-kit-devel"]] + # Those RPMs depend on the EPEL package repository: + [["centos"] ["jack-audio-connection-kit-devel"]] + [["rhel"] ["jack-audio-connection-kit-devel"]] + # This one seems to require: "openSUSE Multimedia Libs" + [["opensuse"] ["libjack-devel"]] + # Cf. https://github.com/ocaml/opam-repository/pull/10167 for OSX: + [["homebrew" "osx"] ["jack"]] +] +synopsis: "A library to use JACK-MIDI" +description: """ +Misuja is a low-latency “MIDI communications thread” implemented in C +which is manipulated with an OCaml API: `Misuja.Sequencer. (the +process communicates with the Sequencer thread through ring-buffers +provided by the Jack API). +""" diff --git a/src/lib/.ocamlformat b/src/lib/.ocamlformat new file mode 100644 index 0000000..b825f82 --- /dev/null +++ b/src/lib/.ocamlformat @@ -0,0 +1,5 @@ +version=0.24.1 +profile=default +exp-grouping=preserve +parse-docstrings +sequence-blank-line=compact diff --git a/src/lib/config/discover.ml b/src/lib/config/discover.ml new file mode 100644 index 0000000..1afc797 --- /dev/null +++ b/src/lib/config/discover.ml @@ -0,0 +1,17 @@ +module C = Configurator.V1 + +let () = + C.main ~name:"jack" (fun c -> + let default : C.Pkg_config.package_conf = + { libs = [ "-ljack" ]; cflags = [ "-I/usr/include/jack" ] } + in + let conf = + match C.Pkg_config.get c with + | None -> default + | Some pc -> ( + match C.Pkg_config.query pc ~package:"jack" with + | None -> default + | Some a -> a) + in + C.Flags.write_sexp "c_flags.sexp" (conf.cflags @ [ "-fPIC" ]); + C.Flags.write_sexp "c_library_flags.sexp" conf.libs) diff --git a/src/lib/config/dune b/src/lib/config/dune new file mode 100644 index 0000000..21a5f9a --- /dev/null +++ b/src/lib/config/dune @@ -0,0 +1,3 @@ +(executable + (name discover) + (libraries dune.configurator)) diff --git a/src/lib/dune b/src/lib/dune new file mode 100644 index 0000000..93351ce --- /dev/null +++ b/src/lib/dune @@ -0,0 +1,18 @@ +(library + (name misuja) + (public_name misuja) + (libraries unix) + (foreign_stubs + (language c) + (names misuja_jack_seq) + (flags + (:include c_flags.sexp))) + (c_library_flags + (:include c_library_flags.sexp))) + +(rule + (targets c_flags.sexp c_library_flags.sexp) + (deps + (:< config/discover.exe)) + (action + (run %{<}))) diff --git a/src/lib/misuja.ml b/src/lib/misuja.ml new file mode 100644 index 0000000..58dd1f9 --- /dev/null +++ b/src/lib/misuja.ml @@ -0,0 +1,59 @@ +(******************************************************************************) +(* Copyright (c) 2007,2017 Sebastien MONDET *) +(* *) +(* Permission is hereby granted, free of charge, to any person *) +(* obtaining a copy of this software and associated documentation *) +(* files (the "Software"), to deal in the Software without *) +(* restriction, including without limitation the rights to use, *) +(* copy, modify, merge, publish, distribute, sublicense, and/or sell *) +(* copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following *) +(* conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be *) +(* included in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) +(* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *) +(* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) +(* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT *) +(* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, *) +(* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR *) +(* OTHER DEALINGS IN THE SOFTWARE. *) +(******************************************************************************) + +(** OCaml types and functions providing high level access to a jack midi + sequencer. + + @author S. Mondet *) +module Sequencer = struct + type t + (** The sequencer object *) + + external make : + name:string -> input_ports:string array -> output_ports:string array -> t + = "ml_jackseq_make" + (** The sequencer constructor should be called as + + {[ + let my_seq = + Sequencer.make "client_name" + [| "input_port_A" ; "input_port_B" |] + [| "out1" ; "out2" ; "outN" |] + in + ]} *) + + external close : t -> unit = "ml_jackseq_close" + (** Close the sequencer ({i ie} jack client) *) + + external output_event : + t -> port:int -> stat:int -> chan:int -> dat1:int -> dat2:int -> unit + = "ml_jackseq_output_event_bytecode" "ml_jackseq_output_event" + (** Put an event in the output buffer, it will be really output at next jack + frame (which means quasi immediately) *) + + external get_input : t -> (int * int * int * int * int) array + = "ml_jackseq_get_input" + (** Get all events in input buffer and clear it *) +end diff --git a/src/lib/misuja_jack_seq.c b/src/lib/misuja_jack_seq.c new file mode 100644 index 0000000..f9fe338 --- /dev/null +++ b/src/lib/misuja_jack_seq.c @@ -0,0 +1,406 @@ +/******************************************************************************/ +/* Copyright (c) 2007, Sebastien MONDET */ +/* */ +/* Permission is hereby granted, free of charge, to any person */ +/* obtaining a copy of this software and associated documentation */ +/* files (the "Software"), to deal in the Software without */ +/* restriction, including without limitation the rights to use, */ +/* copy, modify, merge, publish, distribute, sublicense, and/or sell */ +/* copies of the Software, and to permit persons to whom the */ +/* Software is furnished to do so, subject to the following */ +/* conditions: */ +/* */ +/* The above copyright notice and this permission notice shall be */ +/* included in all copies or substantial portions of the Software. */ +/* */ +/* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, */ +/* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES */ +/* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND */ +/* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT */ +/* HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, */ +/* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING */ +/* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR */ +/* OTHER DEALINGS IN THE SOFTWARE. */ +/******************************************************************************/ + + +/* + * The 'C' Jack midi interface + * + * Author: S. MONDET (http://sebmdt.googlepages.com) + * + */ + +/* + * Classic includes: + */ +#include +#include +#include +#include +#include +#include + +/* + * Jack's includes: + */ +#include +#include +#include + + +/* + * Caml wrapping includes: + * + */ +#include +#include +#include +#include +#include + + +typedef struct { + jack_client_t *js_client; + + size_t js_oports_nb; + jack_port_t **js_oports; + jack_ringbuffer_t *js_o_rbuf; + + size_t js_iports_nb; + jack_port_t **js_iports; + jack_ringbuffer_t *js_i_rbuf; + +} jack_seq_t; + +typedef struct { + int me_port; + char me_stat; + char me_chan; + char me_dat1; + char me_dat2; +} jack_seq_midi_event_t; + + +/**** ****/ +void +rt_assert(int condition, char *msg) { + if (condition == 0) { + fprintf(stderr, "[C][RT][ERR] Assert Failed: %s\n", msg) ; + perror("[C][RT][ERR] Unix Error: "); + /* TODO: find something TODO there !! */ + } +} + +/* + * The process schedulled by JACK + * (real-time function: no mallocs & Co, see jack/jack.h) + */ +int +process_callback(jack_nframes_t nframes, void * context) { + jack_seq_t *js; + + js = context; + + { /* Preprocess the output buffers: */ + size_t i; + void *o_port_buf; + for (i = 0; i < js->js_oports_nb; i++) { + o_port_buf = jack_port_get_buffer(js->js_oports[i], nframes); + jack_midi_clear_buffer(o_port_buf); + } + } + + { /* Do the output */ + jack_seq_midi_event_t stack_event; + jack_midi_data_t *midi_buf = NULL; + void *o_port_buf; + size_t to_read, i, to_write; + int ret; + + to_read = jack_ringbuffer_read_space(js->js_o_rbuf); + for (i = 0; i < to_read; i += sizeof(jack_seq_midi_event_t)) { + ret = jack_ringbuffer_read(js->js_o_rbuf, + (void*)&stack_event, sizeof(jack_seq_midi_event_t)); + rt_assert(ret == sizeof(jack_seq_midi_event_t), + "Can't read in ring buffer !!"); + o_port_buf = + jack_port_get_buffer(js->js_oports[stack_event.me_port], nframes); + if (0xC0 <= (unsigned char)stack_event.me_stat + && (unsigned char)stack_event.me_stat <= 0xDF) { + to_write = 2; + } else { + to_write = 3; + } + midi_buf = jack_midi_event_reserve(o_port_buf, 0, to_write); + midi_buf[0] = (stack_event.me_stat & 0xF0) + (stack_event.me_chan & 0x0F); + midi_buf[1] = stack_event.me_dat1; + if (to_write == 3) { + midi_buf[2] = stack_event.me_dat2; + } + } + } + + { /* Get the input */ + jack_seq_midi_event_t stack_event; + jack_nframes_t n_in; + jack_midi_event_t event; + void *i_port_buf; + unsigned int i, j; + size_t writable; + int ret; + + for (i = 0; i < js->js_iports_nb; i++) { + /* Get In Event count: */ + i_port_buf = jack_port_get_buffer(js->js_iports[i], nframes); + n_in = jack_midi_get_event_count(i_port_buf); + for (j = 0; j < n_in; j++) { + jack_midi_event_get(&event, i_port_buf, j); + if (event.size >= 2) { + stack_event.me_port = i; + stack_event.me_stat = event.buffer[0] & 0xF0; + stack_event.me_chan = event.buffer[0] & 0x0F; + stack_event.me_dat1 = event.buffer[1]; + if (event.size == 2) { + stack_event.me_dat2 = 0; + } else { + stack_event.me_dat2 = event.buffer[2]; + } + writable = jack_ringbuffer_write_space(js->js_i_rbuf); + if (writable >= sizeof(jack_seq_midi_event_t)) { + ret = jack_ringbuffer_write(js->js_i_rbuf, + (char *)&stack_event, sizeof(jack_seq_midi_event_t)); + rt_assert(ret == sizeof(jack_seq_midi_event_t), + "Can't write in ring buffer !!"); + } /* else { higher level does not consume => we stop writing } */ + } else { + char msg[34]; + sprintf(msg, "Got an event of size: %lu", event.size); + rt_assert(0, msg); + } + } + } + } + + return 0; +} + +/**** ****/ + +/* + * An assert function that trows a Failure exception. + * + */ +void +js_exn_assert(int condition, char *msg) { + if (condition == 0) { + fprintf(stderr, "[C-jack][ERR] Assert Failed: %s\n", msg) ; + perror("[C-jack][ERR] Unix Error: "); + caml_failwith("GENERAL ASSERT FAILED in jackseq.c") ; + } +} + + +/* + * Destroy the Sequencer (by ocaml's GC) + */ +void +custom_ml_jackseq_destroy(value jseq){ + + /* must not use CAMLparam1 in destructor */ + jack_seq_t *seq = NULL ; + + /* Get the sequencer: */ + seq = *((jack_seq_t **)Data_custom_val(jseq)) ; + + jack_ringbuffer_free(seq->js_o_rbuf); + jack_ringbuffer_free(seq->js_i_rbuf); + free(seq->js_oports); + free(seq->js_iports); + free(seq); + /* printf("JACK SEQUENCER DETROYED\n"); */ +} + +static struct custom_operations sequencer_custom_ops = { + "locoseq.jack_sequencer", + /* custom_finalize_default,*/ custom_ml_jackseq_destroy, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + + +/* + * Constructor of the sequencer "object" + * + */ +CAMLprim value +ml_jackseq_make(value app_name, value in_names_array, value ou_names_array) { + + CAMLparam3(app_name, in_names_array, ou_names_array) ; + jack_seq_t *js = NULL ; + unsigned int i; + int ret; + value the_sequencer; + + /* Allocating the structure */ + js = malloc (sizeof(jack_seq_t)) ; + js_exn_assert(js != NULL, "jack_seq_t mallocation"); + memset(js , 0 , sizeof(jack_seq_t)); + + /* try to become a client of the JACK server */ + js->js_client = jack_client_open ( String_val(app_name), JackNoStartServer, NULL); + js_exn_assert(js->js_client != NULL, + "Couldn't create a client, is jackd running ?"); + + /* Creating the input ports from string array in_names_array: */ + js->js_iports_nb = Wosize_val(in_names_array) ; + js->js_iports = malloc(sizeof(jack_port_t *) * js->js_iports_nb) ; + for ( i = 0 ; i < js->js_iports_nb ; i++ ) { + js->js_iports[i] = jack_port_register(js->js_client, + String_val(Field(in_names_array, i)), + JACK_DEFAULT_MIDI_TYPE, JackPortIsInput, 0); + js_exn_assert(js->js_iports != NULL, "Couldn't register input MIDI port"); + } + + /* Creating the input ports from string array ou_names_array: */ + js->js_oports_nb = Wosize_val(ou_names_array) ; + js->js_oports = malloc(sizeof(jack_port_t *) * js->js_oports_nb) ; + for ( i = 0 ; i < js->js_oports_nb ; i++ ) { + js->js_oports[i] = jack_port_register(js->js_client, + String_val(Field(ou_names_array, i)), + JACK_DEFAULT_MIDI_TYPE, JackPortIsOutput, 0); + js_exn_assert(js->js_iports != NULL, "Couldn't register output MIDI port"); + } + + /* The two ring buffers */ + js->js_i_rbuf = jack_ringbuffer_create (1024*sizeof(jack_midi_event_t)); + js_exn_assert(js->js_i_rbuf != NULL, "Error creating the ring buffer"); + memset(js->js_i_rbuf->buf, 0, js->js_i_rbuf->size); + js->js_o_rbuf = jack_ringbuffer_create (1024*sizeof(jack_midi_event_t)); + js_exn_assert(js->js_o_rbuf != NULL, "Error creating the ring buffer"); + memset(js->js_o_rbuf->buf, 0, js->js_o_rbuf->size); + + ret = jack_set_process_callback(js->js_client, process_callback, js); + js_exn_assert(ret == 0, "Couldn't set the callback procedure !"); + + ret = jack_activate(js->js_client); + js_exn_assert(ret == 0, "Couldn't activate the client !"); + + + /* Return an abstract value: */ + the_sequencer = caml_alloc_custom( + &sequencer_custom_ops, sizeof(jack_seq_t *), 0, 1); + *((jack_seq_t **)Data_custom_val(the_sequencer)) = js; + CAMLreturn (the_sequencer) ; +} + + +/* + * Close the sequencer + */ +CAMLprim value +ml_jackseq_close(value ml_seq){ + CAMLparam1 (ml_seq); + jack_seq_t *js = NULL ; + int ret; + js = *((jack_seq_t **)Data_custom_val(ml_seq)) ; + ret = jack_client_close(js->js_client); + CAMLreturn(Val_int(0)); +} + +/* + * Output event directly + * (puts the event in jack_seq_t's output ringbuffer) + */ +CAMLprim value +ml_jackseq_output_event(value ml_seq, value ml_port, value ml_stat, + value ml_chan, value ml_dat1, value ml_dat2) { + CAMLparam5(ml_seq, ml_port, ml_stat, ml_chan, ml_dat1); + CAMLxparam1(ml_dat2); + + jack_seq_t *js = NULL ; + int ret; + jack_seq_midi_event_t stack_event; + + stack_event.me_port = Int_val(ml_port); + stack_event.me_stat = Int_val(ml_stat); + stack_event.me_chan = Int_val(ml_chan); + stack_event.me_dat1 = Int_val(ml_dat1); + stack_event.me_dat2 = Int_val(ml_dat2); + js = *((jack_seq_t **)Data_custom_val(ml_seq)) ; + + ret = jack_ringbuffer_write(js->js_o_rbuf, + (char *)&stack_event, sizeof(jack_seq_midi_event_t)); + if (ret != sizeof(jack_seq_midi_event_t)) { + fprintf(stderr, "[C-jack]DBG: %d %ld, for read: %ld, for write: %ld\n", + ret, sizeof(jack_seq_midi_event_t), + jack_ringbuffer_read_space(js->js_o_rbuf), + jack_ringbuffer_write_space(js->js_o_rbuf) + ); + } + js_exn_assert(ret == sizeof(jack_seq_midi_event_t), + "Couldn't write in the ring buffer"); + + CAMLreturn(Val_int(0)); +} +CAMLprim value +ml_jackseq_output_event_bytecode(value *argv, int argn) +{ + return ml_jackseq_output_event( + argv[0], argv[1], argv[2], argv[3], argv[4], argv[argn - 1]); +} + + +/* + * Get the input midi events + */ +CAMLprim value +ml_jackseq_get_input(value ml_seq){ + CAMLparam1 (ml_seq); + CAMLlocal2(return_array, one_ml_event); + jack_seq_t *js = NULL ; + jack_seq_midi_event_t stack_event; + size_t i, to_read; + int ret; + js = *((jack_seq_t **)Data_custom_val(ml_seq)) ; + + to_read = jack_ringbuffer_read_space(js->js_i_rbuf) + / sizeof(jack_seq_midi_event_t); + + return_array = caml_alloc(to_read , 0) ; + + for (i = 0; i < to_read; i++) { + + ret = jack_ringbuffer_read(js->js_i_rbuf, + (void *)&stack_event, sizeof(jack_seq_midi_event_t)); + if (ret != sizeof(jack_seq_midi_event_t)) { + fprintf(stderr, "[C-jack]DBG-read: %d %ld, for read: %ld, for write: %ld\n", + ret, sizeof(jack_seq_midi_event_t), + jack_ringbuffer_read_space(js->js_o_rbuf), + jack_ringbuffer_write_space(js->js_o_rbuf)); + } + js_exn_assert(ret == sizeof(jack_seq_midi_event_t), + "Couldn't read in the ring buffer"); + one_ml_event = caml_alloc(5, 0); + Store_field(one_ml_event, 0, Val_int(stack_event.me_port)); + Store_field(one_ml_event, 1, Val_int(stack_event.me_stat & 0xFF)); + Store_field(one_ml_event, 2, Val_int(stack_event.me_chan & 0xFF)); + Store_field(one_ml_event, 3, Val_int(stack_event.me_dat1 & 0xFF)); + Store_field(one_ml_event, 4, Val_int(stack_event.me_dat2 & 0xFF)); + + Store_field(return_array, i, one_ml_event); + + } + + CAMLreturn(return_array); +} + + + + + + + + diff --git a/src/test/.ocamlformat b/src/test/.ocamlformat new file mode 100644 index 0000000..b825f82 --- /dev/null +++ b/src/test/.ocamlformat @@ -0,0 +1,5 @@ +version=0.24.1 +profile=default +exp-grouping=preserve +parse-docstrings +sequence-blank-line=compact diff --git a/src/test/dune b/src/test/dune new file mode 100644 index 0000000..5c3f0b0 --- /dev/null +++ b/src/test/dune @@ -0,0 +1,3 @@ +(executable + (name relay) + (libraries threads.posix misuja)) diff --git a/src/test/relay.ml b/src/test/relay.ml new file mode 100644 index 0000000..3c00008 --- /dev/null +++ b/src/test/relay.ml @@ -0,0 +1,42 @@ +open Printf +module Array = ArrayLabels + +let test_jack_seq ~jack_name () = + let open Misuja in + let seq = + let input_ports = Array.init 10 ~f:(sprintf "in%d") in + let output_ports = Array.init 10 ~f:(sprintf "out%d") in + Sequencer.make ~name:jack_name ~input_ports ~output_ports + in + for i = 0 to 25000000 do + Thread.delay 0.02; + let input = Sequencer.get_input seq in + Array.iter input ~f:(fun (port, stat, chan, dat1, dat2) -> + Printf.printf "[%d] port:%d stat:%x chan:%d dat1:%d dat2:%d\n%!" i port + stat chan dat1 dat2; + let high_level = + match stat with + | rs when 0x80 <= rs && rs <= 0x8F -> `Note_off (rs, dat1, dat2) + | rs when 0x90 <= rs && rs <= 0x9F -> + if dat2 = 0 (* If velocity = 0 -> note off ! *) then + `Note_off (rs, dat1, dat2) + else `Note_on (rs, dat1, dat2) + | _other -> `None + in + match high_level with + | `None -> Sequencer.output_event seq ~port ~stat ~chan ~dat1 ~dat2 + | `Note_on (_, dat1, dat2) | `Note_off (_, dat1, dat2) -> + Sequencer.output_event seq ~port ~stat ~chan ~dat1 ~dat2; + Sequencer.output_event seq ~port ~stat ~chan ~dat1:(dat1 + 7) ~dat2; + Sequencer.output_event seq ~port ~stat ~chan ~dat1:(dat1 + 12) ~dat2; + Sequencer.output_event seq ~port ~stat ~chan ~dat1:(dat1 + 19) ~dat2; + Sequencer.output_event seq ~port ~stat ~chan ~dat1:(dat1 + 24) ~dat2) + done; + Sequencer.close seq; + Unix.sleep 3; + () + +let () = + match Sys.argv |> Array.to_list with + | [ _; jack_name ] -> test_jack_seq ~jack_name () + | _ -> Format.kasprintf failwith "usage: %s " Sys.argv.(0) -- GitLab