From 684a2c100cee2050d96db40c0a70773f3882ab38 Mon Sep 17 00:00:00 2001 From: Sonja Heinze Date: Fri, 26 Jan 2024 20:18:22 +0100 Subject: [PATCH] Synchronize the sequencer domain with the clock domain Co-authored-by: heyabigael@proton.me --- bin/clock.ml | 46 +++++++++++++++++------- bin/dune | 2 +- bin/stat_engine.ml | 85 ++++++++++++++++++++++++--------------------- cardio_crumble.opam | 1 - 4 files changed, 80 insertions(+), 54 deletions(-) diff --git a/bin/clock.ml b/bin/clock.ml index 8b902b1..8926ed7 100644 --- a/bin/clock.ml +++ b/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 diff --git a/bin/dune b/bin/dune index 498aa60..d9c724e 100644 --- a/bin/dune +++ b/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)) diff --git a/bin/stat_engine.ml b/bin/stat_engine.ml index 7e1202f..1a0fc86 100644 --- a/bin/stat_engine.ml +++ b/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 -> diff --git a/cardio_crumble.opam b/cardio_crumble.opam index 13a5dc4..f3bd95e 100644 --- a/cardio_crumble.opam +++ b/cardio_crumble.opam @@ -14,7 +14,6 @@ depends: [ "dune" {>= "3.3"} "portmidi" {>= "0.1"} "cmdliner" {>= "1.1.1"} - "saturn" "odoc" {with-doc} ] build: [