Rough support for midi over serial

Author: gridbugs

examples/dune

@@ -81,3 +81,9 @@
  (modules midi_cat)
  (package llama)
  (libraries llama))
+
+(executable
+ (public_name midi_serial)
+ (modules midi_serial)
+ (package llama_interactive)
+ (libraries llama_interactive))

examples/midi_interactive.ml

@@ -120,15 +120,15 @@ module Args = struct
   type t = {
     list_midi_ports : bool;
     echo_effect : bool;
-    print_events : bool;
+    print_messages : bool;
     midi_port : int;
     sample_paths : string list;
   }
 
   let parse () =
     let list_midi_ports = ref false in
     let echo_effect = ref false in
-    let print_events = ref false in
+    let print_messages = ref false in
     let midi_port = ref 0 in
     let sample_paths = ref [] in
     Arg.parse
@@ -137,8 +137,8 @@ module Args = struct
           Arg.Set list_midi_ports,
           "List midi ports by index and exit" );
         ("--echo-effect", Arg.Set echo_effect, "Use echo effect");
-        ( "--print-events",
-          Arg.Set print_events,
+        ( "--print-messages",
+          Arg.Set print_messages,
           "Print each midi event to stdout" );
         ( "--midi-port",
           Arg.Set_int midi_port,
@@ -149,7 +149,7 @@ module Args = struct
     {
       list_midi_ports = !list_midi_ports;
       echo_effect = !echo_effect;
-      print_events = !print_events;
+      print_messages = !print_messages;
       midi_port = !midi_port;
       sample_paths = List.rev !sample_paths;
     }
@@ -159,7 +159,7 @@ let () =
   let {
     Args.list_midi_ports;
     echo_effect;
-    print_events;
+    print_messages;
     midi_port;
     sample_paths;
   } =
@@ -176,22 +176,22 @@ let () =
       ~f:(fun i name -> Printf.printf "%d: %s\n" i name)
       midi_port_names
   else
-    let midi_events =
-      Llama.Midi.live_midi_signal midi_input midi_port |> Result.get_ok
+    let midi_messages =
+      Llama.Midi.live_midi_signal_messages midi_input midi_port |> Result.get_ok
     in
-    let midi_events =
-      if print_events then
-        Signal.debug midi_events
+    let midi_messages =
+      if print_messages then
+        Signal.debug midi_messages
           ~f:
-            (List.iter ~f:(fun event ->
-                 print_endline (Midi.Event.to_string event)))
-      else midi_events
+            (List.iter ~f:(fun message ->
+                 print_endline (Midi.Message.to_string message)))
+      else midi_messages
     in
     let main_sequencer =
-      Llama.Midi.Midi_sequencer.signal midi_events ~channel:0 ~polyphony:12
+      Llama.Midi.Midi_sequencer.signal midi_messages ~channel:0 ~polyphony:12
     in
     let pad_gates =
-      Llama.Midi.Midi_sequencer.key_gates ~channel:9 midi_events
+      Llama.Midi.Midi_sequencer.key_gates ~channel:9 midi_messages
     in
     with_window ~background_rgba_01:(0.0, 0.05, 0.0, 1.0) (fun window ->
         let signal =

examples/midi_serial.ml

@@ -0,0 +1,112 @@
+open StdLabels
+open Llama_interactive
+open Dsl
+
+let make_voice frequency_hz gate =
+  let detune_factor = const 1.005 in
+  let oscillator_frequency_hz = frequency_hz in
+  let waveform = const Saw in
+  let osc =
+    mean
+      [
+        oscillator waveform oscillator_frequency_hz;
+        oscillator waveform (oscillator_frequency_hz *.. detune_factor);
+        oscillator waveform (oscillator_frequency_hz /.. detune_factor);
+      ]
+  in
+  let attack_s = const 0.05 in
+  let release_s = const 0.01 in
+  let amp_env = ar_linear ~gate ~attack_s ~release_s in
+  lazy_amplifier osc ~volume:amp_env
+
+let signal ~main_sequencer ~secondary_sequencer =
+  let {
+    Midi.Midi_sequencer.voices;
+    pitch_wheel_multiplier;
+    controller_table = _;
+  } =
+    main_sequencer
+  in
+  let { Midi.Midi_sequencer.controller_table; _ } = secondary_sequencer in
+  let voice =
+    List.map voices
+      ~f:(fun { Midi.Midi_sequencer.frequency_hz; gate; velocity = _ } ->
+        make_voice (frequency_hz *.. pitch_wheel_multiplier) gate)
+    |> sum
+  in
+  let filter_cutoff =
+    sum
+      [
+        const 100.0;
+        Midi.Controller_table.get_raw controller_table 21 |> scale 2000.0;
+      ]
+  in
+  chebyshev_low_pass_filter voice ~cutoff_hz:filter_cutoff
+    ~resonance:(const 1.0)
+
+module Args = struct
+  type t = { list_midi_ports : bool; print_messages : bool; midi_port : int }
+
+  let parse () =
+    let list_midi_ports = ref false in
+    let print_messages = ref false in
+    let midi_port = ref 0 in
+    Arg.parse
+      [
+        ( "--list-midi-ports",
+          Arg.Set list_midi_ports,
+          "List midi ports by index and exit" );
+        ( "--print-messages",
+          Arg.Set print_messages,
+          "Print each midi event to stdout" );
+        ( "--midi-port",
+          Arg.Set_int midi_port,
+          "Use the midi port with this index" );
+      ]
+      (fun _ -> failwith "unexpected anonymous argument")
+      "Play music with a midi keyboard";
+    {
+      list_midi_ports = !list_midi_ports;
+      print_messages = !print_messages;
+      midi_port = !midi_port;
+    }
+end
+
+let () =
+  let { Args.list_midi_ports; print_messages; midi_port } = Args.parse () in
+  let midi_input = Llama.Midi.Midi_input.create () in
+  if list_midi_ports then
+    let midi_port_names = Llama.Midi.Midi_input.port_names midi_input in
+    List.iteri
+      ~f:(fun i name -> Printf.printf "%d: %s\n" i name)
+      midi_port_names
+  else
+    let midi_messages =
+      Llama.Midi.live_midi_signal_messages midi_input midi_port |> Result.get_ok
+    in
+    let midi_messages_control =
+      Llama.Midi.live_midi_messages_serial ~port:"/dev/ttyUSB0" ~baud:115200
+    in
+    let midi_messages_control =
+      if print_messages then
+        Signal.debug midi_messages_control
+          ~f:
+            (List.iter ~f:(fun message ->
+                 print_endline (Midi.Message.to_string message)))
+      else midi_messages_control
+    in
+    let main_sequencer =
+      Llama.Midi.Midi_sequencer.signal midi_messages ~channel:0 ~polyphony:12
+    in
+    let secondary_sequencer =
+      Llama.Midi.Midi_sequencer.signal midi_messages_control ~channel:0
+        ~polyphony:1
+    in
+    with_window ~background_rgba_01:(0.0, 0.05, 0.0, 1.0) (fun window ->
+        let signal = signal ~main_sequencer ~secondary_sequencer in
+        let viz'd_signal =
+          visualize ~stable:true ~stride:1 ~pixel_scale:1 ~sample_scale:0.4
+            ~sample_to_rgba_01:(Fun.const (0.0, 0.5, 0.0, 1.0))
+            window signal
+        in
+        play_signal ~scale_output_volume:0.5 viz'd_signal)

src/core/midi.ml

@@ -5,12 +5,7 @@ module Controller_table = struct
   type t = float Signal.t array
 
   let num_controllers = 128
-
-  let create () =
-    let refs = Array.init num_controllers ~f:(fun _ -> ref 0.0) in
-    let t = Array.map refs ~f:Signal.of_ref in
-    (t, refs)
-
+  let create_refs () = Array.init num_controllers ~f:(fun _ -> ref 0.0)
   let get_raw = Array.get
   let modulation t = get_raw t 1
   let volume t = get_raw t 7
@@ -46,14 +41,14 @@ module Midi_sequencer = struct
 
   type voice_state = { note : int; gate : bool; velocity : int }
 
-  let key_gates ~channel (track_signal : Event.t list Signal.t) =
+  let key_gates ~channel (messages : Message.t list Signal.t) =
     let ref_array = Array.init num_notes ~f:(fun _ -> ref false) in
     let update_signal =
       Signal.of_raw (fun ctx ->
           let voice_messages =
-            Signal.sample track_signal ctx
-            |> List.filter_map ~f:(fun (event : Event.t) ->
-                   match event.message with
+            Signal.sample messages ctx
+            |> List.filter_map ~f:(fun (message : Message.t) ->
+                   match message with
                    | Message.Channel_voice_message voice_message ->
                        if voice_message.channel == channel then
                          Some voice_message.message
@@ -71,7 +66,7 @@ module Midi_sequencer = struct
         Signal.map update_signal ~f:(fun _ -> !(Array.get ref_array i))
         |> Signal.gate)
 
-  let signal ~channel ~polyphony (track_signal : Event.t list Signal.t) =
+  let signal ~channel ~polyphony (messages : Message.t list Signal.t) =
     let voices =
       Array.init polyphony
         ~f:(Fun.const { note = 0; gate = false; velocity = 0 })
@@ -87,14 +82,14 @@ module Midi_sequencer = struct
     let currently_playing_voice_index_by_note =
       Array.init num_notes ~f:(Fun.const None)
     in
-    let controller_table, controller_refs = Controller_table.create () in
+    let controller_refs = Controller_table.create_refs () in
     let pitch_wheel_multiplier = ref 1.0 in
     let signal_to_update_state =
       Signal.of_raw (fun ctx ->
           let voice_messages =
-            Signal.sample track_signal ctx
-            |> List.filter_map ~f:(fun (event : Event.t) ->
-                   match event.message with
+            Signal.sample messages ctx
+            |> List.filter_map ~f:(fun (message : Message.t) ->
+                   match message with
                    | Message.Channel_voice_message voice_message ->
                        if voice_message.channel == channel then
                          Some voice_message.message
@@ -172,6 +167,10 @@ module Midi_sequencer = struct
           { frequency_hz; gate; velocity })
     in
     let pitch_wheel_multiplier = Signal.of_ref pitch_wheel_multiplier in
+    let controller_table =
+      Array.map controller_refs ~f:(fun controller_ref ->
+          Signal.map signal_to_update_state ~f:(fun () -> !controller_ref))
+    in
     { voices; pitch_wheel_multiplier; controller_table }
 end
 
@@ -201,3 +200,4 @@ let track_signal (track : Track.t) clock =
           List.rev (loop [ next_event ]))
         else [])
       else [])
+  |> Signal.map ~f:(List.map ~f:(fun (event : Event.t) -> event.message))

src/core/midi.mli

@@ -29,11 +29,11 @@ module Midi_sequencer : sig
     controller_table : Controller_table.t;
   }
 
-  val key_gates : channel:int -> Event.t list Signal.t -> Gate_table.t
+  val key_gates : channel:int -> Message.t list Signal.t -> Gate_table.t
   (** Create a table of gate signals that arrive on a given channel, ignoring
       other information. *)
 
-  val signal : channel:int -> polyphony:int -> Event.t list Signal.t -> output
+  val signal : channel:int -> polyphony:int -> Message.t list Signal.t -> output
 end
 
-val track_signal : Track.t -> Signal.Trigger.t -> Event.t list Signal.t
+val track_signal : Track.t -> Signal.Trigger.t -> Message.t list Signal.t

src/llama/llama.ml

@@ -1,3 +1,4 @@
+open StdLabels
 include Llama_core
 
 module Live = struct
@@ -42,7 +43,19 @@ module Midi = struct
              Midi.Event.parse_multi_from_char_array raw_data)))
     else Error `No_such_port
 
-  let live_midi_sequencer input ~port ~channel ~polyphony =
+  let live_midi_signal_messages input port =
     live_midi_signal input port
+    |> Result.map (fun event_signal ->
+           Signal.map event_signal
+             ~f:(List.map ~f:(fun (event : Event.t) -> event.message)))
+
+  let live_midi_sequencer input ~port ~channel ~polyphony =
+    live_midi_signal_messages input port
     |> Result.map (Midi_sequencer.signal ~channel ~polyphony)
+
+  let live_midi_messages_serial ~port ~baud =
+    let midi_serial = Midi_serial.create ~port ~baud in
+    Signal.of_raw (fun _ ->
+        Midi_serial.consume_all_available_bytes midi_serial;
+        Midi_serial.drain_messages midi_serial)
 end

src/llama/llama.mli

@@ -45,6 +45,10 @@ module Midi : sig
     Midi_input.t -> int -> (Event.t list Signal.t, [ `No_such_port ]) result
   (** Create a signal of lists of midi events that arrive on a given midi port in real time *)
 
+  val live_midi_signal_messages :
+    Midi_input.t -> int -> (Message.t list Signal.t, [ `No_such_port ]) result
+  (** Create a signal of lists of midi events that arrive on a given midi port in real time *)
+
   val live_midi_sequencer :
     Midi_input.t ->
     port:int ->
@@ -54,4 +58,7 @@ module Midi : sig
   (** Create a midi sequencer that processes midi events on a single midi
       channel from a given port. Use this for simple cases where you're only
       interested in events on a single channel. *)
+
+  val live_midi_messages_serial :
+    port:string -> baud:int -> Message.t list Signal.t
 end