Synchronize the sequencer domain with the clock domain

Co-authored-by: [email protected] <[email protected]>

bin/clock.ml

@@ -1,26 +1,41 @@
 type clock_source = Internal of int | External of int
 
+module CQueue = struct
+  type t = {
+    cond : Condition.t;
+    mutex : Mutex.t;
+    queue : (Midi.Note.t * int) Queue.t;
+  }
+
+  let create () =
+    let queue = Queue.create () in
+    let mutex = Mutex.create () in
+    let cond = Condition.create () in
+    { queue; cond; mutex }
+end
+
 let milestone : (Midi.Note.t option * int) Atomic.t = Atomic.make (None, 96)
 let clock_iterator = ref 0
 
-let process_event queue device (ev : Portmidi.Portmidi_event.t) =
+let process_event { CQueue.queue; cond; _ } device
+    (ev : Portmidi.Portmidi_event.t) =
   let tick () =
     incr clock_iterator;
     let note, note_length = Atomic.get milestone in
     if !clock_iterator >= note_length then (
       (match note with
-      | Some note ->
-          Midi.(write_output device [ message_off ~note () ]);
-          print_endline "milestone ended: turn off note"
+      | Some note -> Midi.(write_output device [ message_off ~note () ])
       | None -> ());
-      match Saturn.Queue.pop_opt queue with
-      | None -> Atomic.set milestone (None, 96)
+      match Queue.take_opt queue with
+      | None ->
+          Condition.signal cond;
+          Atomic.set milestone (None, 1)
       | Some (note, notes_per_beat) ->
           let cycles = 24 / notes_per_beat in
-          print_endline "milestone started: turn on note";
           Midi.(write_output device [ message_on ~note () ]);
           Atomic.set milestone (Some note, cycles);
-          clock_iterator := 0)
+          clock_iterator := 0;
+          if Queue.is_empty queue then Condition.signal cond)
   in
   match ev.message with
   | 0xF8l -> tick ()
@@ -34,19 +49,24 @@ let external_main input_device_id output_device note_queue =
     | Ok l -> List.iter (process_event note_queue output_device) l
     | Error _ -> print_endline "oh no"
   done;
+  Condition.signal note_queue.CQueue.cond;
   match Portmidi.close_input device with
   | Error _ -> Printf.eprintf "Error while closing input device\n"
   | _ -> ()
 
-let internal_main bpm device note_queue =
+let internal_main bpm device { CQueue.queue; cond; _ } =
   while not (Atomic.get Watchdog.terminate) do
-    match Saturn.Queue.pop_opt note_queue with
-    | None -> Unix.sleepf (60. /. float_of_int bpm)
+    match Queue.take_opt queue with
+    | None ->
+        Condition.signal cond;
+        Unix.sleepf 0.01
     | Some (note, n) ->
         Midi.(write_output device [ message_on ~note () ]);
         Unix.sleepf (60. /. float_of_int bpm /. float_of_int n);
-        Midi.(write_output device [ message_off ~note () ])
-  done
+        Midi.(write_output device [ message_off ~note () ]);
+        if Queue.is_empty queue then Condition.signal cond
+  done;
+  Condition.signal cond
 
 let clock_func clock_source output_device note_queue () =
   match clock_source with

bin/dune

@@ -1,4 +1,4 @@
 (executable
  (public_name cardio_crumble)
  (name main)
- (libraries runtime_events unix sexplib0 portmidi cmdliner saturn))
+ (libraries runtime_events unix sexplib0 portmidi cmdliner))

bin/stat_engine.ml

@@ -26,8 +26,9 @@ let polling_func path_pid _ =
   let c = create_cursor path_pid in
   let cbs = Callbacks.create ~runtime_begin () in
   while not (Atomic.get Watchdog.terminate) do
-    ignore (read_poll c cbs None);
-    Unix.sleepf 0.1
+    ignore (read_poll c cbs None)
+    (* FIXME: Probably we want to sleep at least a bit *)
+    (* Unix.sleepf 0.01 *)
   done
 
 let threshold = function
@@ -60,48 +61,54 @@ let get_increment num_beats event =
   Mutex.unlock quantifier_table_lock;
   incr
 
-let rec sequencer_func num_beats tones device bpm queue _ =
-  let interesting_stuff =
-    let compare e1 e2 =
-      Int.neg (Event.compare ~f:(get_increment num_beats) e1 e2)
+let sequencer_func num_beats tones _device _bpm queue _ =
+  (* FIXME *)
+  Mutex.lock queue.Clock.CQueue.mutex;
+  let rec aux num_beats =
+    let interesting_stuff =
+      let compare e1 e2 =
+        Int.neg (Event.compare ~f:(get_increment num_beats) e1 e2)
+      in
+      let sorted_events = List.sort compare Event.all in
+
+      let rec loop acc = function
+        | hd :: tl ->
+            let i = List.length acc in
+            if i = 6 then acc
+            else
+              let new_acc =
+                if get_increment num_beats hd > threshold i then Some hd :: acc
+                else None :: acc
+              in
+              loop new_acc tl
+        | [] -> acc
+      in
+      loop [] sorted_events
     in
-    let sorted_events = List.sort compare Event.all in
-
-    let rec loop acc = function
-      | hd :: tl ->
-          let i = List.length acc in
-          if i = 6 then acc
-          else
-            let new_acc =
-              if get_increment num_beats hd > threshold i then Some hd :: acc
-              else None :: acc
-            in
-            loop new_acc tl
-      | [] -> acc
+    let n =
+      List.fold_left
+        (fun acc -> function Some _ -> acc + 1 | None -> acc)
+        0 interesting_stuff
     in
-    loop [] sorted_events
+    List.iter
+      (function
+        | None -> ()
+        | Some event ->
+            let note = Play.event_to_note tones event in
+            (* Debug: Adjust threashold: Currently, it's almost always pushing 6 nots or no notes. *)
+            (* Printf.printf "Pushing a note with rythm %n to the queue\n%!" n; *)
+            Queue.push (note, n) queue.Clock.CQueue.queue)
+      interesting_stuff;
+    Mutex.lock event_table_lock;
+    Hashtbl.clear event_table;
+    Mutex.unlock event_table_lock;
+    Condition.wait queue.Clock.CQueue.cond queue.mutex;
+    if Atomic.get Watchdog.terminate then () else aux (num_beats + 1)
   in
-  let n =
-    List.fold_left
-      (fun acc -> function Some _ -> acc + 1 | None -> acc)
-      0 interesting_stuff
-  in
-  List.iter
-    (function
-      | None -> ()
-      | Some event ->
-          let note = Play.event_to_note tones event in
-          Saturn.Queue.push queue (note, n))
-    interesting_stuff;
-  Mutex.lock event_table_lock;
-  Hashtbl.clear event_table;
-  Mutex.unlock event_table_lock;
-  (* Unix.sleepf (60. /. Float.of_int bpm); *)
-  if Atomic.get Watchdog.terminate then ()
-  else sequencer_func (num_beats + 1) tones device bpm queue ()
+  aux num_beats
 
 let tracing midi_in bpm device child_alive path_pid tones =
-  let queue = Saturn.Queue.create () in
+  let queue = Clock.CQueue.create () in
   let clock_source =
     match (midi_in, bpm) with
     | None, None ->

cardio_crumble.opam

@@ -14,7 +14,6 @@ depends: [
   "dune" {>= "3.3"}
   "portmidi" {>= "0.1"}
   "cmdliner" {>= "1.1.1"}
-  "saturn" 
   "odoc" {with-doc}
 ]
 build: [