Commit de00036e authored by Seb Mondet's avatar Seb Mondet

Clean-up and reshape `Midi` module

parent 4ddd0882
......@@ -9,7 +9,7 @@ let build_tests =
try Sys.getenv "WITH_TESTS" = "true" with _ -> false
let findlib_deps = [
"nonstd";
"ppx_deriving.std";
]
let meta_dot_ml = "src/lib/meta.ml"
......
This diff is collapsed.
......@@ -155,32 +155,24 @@ let write_var_length_in_buffer buf lg = (
* *)
let read_header data fin =
data.Midi.file_id <- read_long fin ;
data.Midi.header_length <- read_long fin ;
data.Midi.midi_format <- read_short fin ;
data.Midi.track_number <- read_short fin ;
data.Midi.per_quarter_note <- read_short fin ;
;;
let make_meta_event tik serv ev_data =
Midi.MetaEvent {
Midi.meta_ticks = tik ;
Midi.service_id = serv ;
Midi.service_data = ev_data ;
}
;;
data.Midi.File.id <- read_long fin ;
data.Midi.File.header_length <- read_long fin ;
data.Midi.File.midi_format <- read_short fin ;
data.Midi.File.track_number <- read_short fin ;
data.Midi.File.per_quarter_note <- read_short fin ;
()
let read_track track fin =
track.Midi.track_id <- read_long fin ;
if ( track.Midi.track_id <> 0x4D54726Bl)
track.Midi.Track.id <- read_long fin ;
if ( track.Midi.Track.id <> 0x4D54726Bl)
then (
raise( Parsing_error (Printf.sprintf
"Invalid Track Id: %lx" track.Midi.track_id));
"Invalid Track Id: %lx" track.Midi.Track.id));
) ;
(* warn: it's the length in bytes (not in events) *)
track.Midi.track_length <- read_long fin ;
track.Midi.Track.length <- read_long fin ;
(* We do not know the number of events so put them in a stack *)
let event_stack = Stack.create () in
......@@ -192,7 +184,7 @@ let read_track track fin =
(* We need to count read bytes *)
let nb_bytes_read = ref 0 in
while !nb_bytes_read < (Int32.to_int track.Midi.track_length) - 1 do
while !nb_bytes_read < (Int32.to_int track.Midi.Track.length) - 1 do
let tik,nbb = read_var_length fin in
cur_ticks := tik ;
......@@ -211,62 +203,60 @@ let read_track track fin =
) else (
pr "Using the preceding (read_byte=0x%x) (%s)\n" !read_byte Meta.version;
);
let next_event =
match !running_status with
(* It is a META EVENT: *)
| rs when (0xFF = rs) -> (
| rs when (0xFF = rs) ->
let serv = !read_byte in
let size,nbr = read_var_length fin in
nb_bytes_read := !nb_bytes_read + nbr;
let ev_data = Array.init size (
fun x -> incr nb_bytes_read ; input_byte fin ) in
make_meta_event !cur_ticks serv ev_data ;
)
fun x -> incr nb_bytes_read ; input_byte fin ) in
Midi.Event.Meta (
Midi.Meta_event.make
~ticks:!cur_ticks ~service_id:serv ~service_data:ev_data)
(* It is a 2 bytes MIDI EVENT: *)
| rs when (((0x80 <= rs) && (rs <= 0xBF))
|| ((0xE0 <= rs) && (rs <= 0xEF))) -> (
|| ((0xE0 <= rs) && (rs <= 0xEF))) ->
let note = !read_byte in
let velo = input_byte fin in
incr nb_bytes_read ;
(* let cmd = make_2B_cmd rs note velo in *)
Midi.MidiEvent {
Midi.ticks = !cur_ticks ;
Midi.status = rs land 0xF0 ;
Midi.channel = !running_status mod 16 ;
Midi.data_1 = note ;
Midi.data_2 = velo ;
}
)
Midi.Event.Midi (
Midi.Midi_event.make
~ticks:!cur_ticks
~status:(rs land 0xF0)
~channel:(!running_status mod 16)
~data_1:note
~data_2:velo
)
(* It is a 1 byte MIDI EVENT: *)
| rs when ((0xB0 <= rs) && (rs <= 0xCF)) -> (
| rs when ((0xB0 <= rs) && (rs <= 0xCF)) ->
let note = !read_byte in
let velo = -1 in
(* let cmd = make_1B_cmd rs !read_byte in *)
Midi.MidiEvent {
Midi.ticks = !cur_ticks ;
Midi.status = rs land 0xF0 ;
Midi.channel = !running_status mod 16 ;
Midi.data_1 = note ;
Midi.data_2 = velo ;
}
)
Midi.Event.Midi Midi.Midi_event.{
ticks = !cur_ticks ;
status = rs land 0xF0 ;
channel = !running_status mod 16 ;
data_1 = note ;
data_2 = velo ;
}
| rs -> (
pr "Unknown event: %x (at tick: %d) !! !\n" rs tik ;
raise (Parsing_error "Error: unknown event !!") ;
)
pr "Unknown event: %x (at tick: %d) !! !\n" rs tik ;
raise (Parsing_error "Error: unknown event !!") ;
)
in
Stack.push next_event event_stack ;
done;
(* Creation of the array of events: *)
let ev_nb = Stack.length event_stack in
track.Midi.events <- Midi.make_events ev_nb ;
track.Midi.Track.events <- Midi.Track.make_events ev_nb;
for i = ev_nb - 1 downto 0 do
track.Midi.events.(i) <- Stack.pop event_stack ;
done ;
track.Midi.Track.events.(i) <- Stack.pop event_stack;
done;
()
;;
(*
......@@ -276,87 +266,79 @@ let read_track track fin =
let parse_smf file = (
(* open_in_bin may behave like open_in on many systems *)
let fin = open_in_bin file in
let ret = Midi.empty_midi_data () in
let ret = Midi.File.empty () in
(* Read the header: *)
read_header ret fin ;
(* Read all the tracks: *)
ret.Midi.tracks <- Midi.make_tracks ret.Midi.track_number ;
pr "%d tracks.\n" ret.Midi.track_number ;
for cur_track = 0 to ret.Midi.track_number - 1 do
read_track ret.Midi.tracks.(cur_track) fin ;
ret.Midi.File.tracks <- Midi.File.make_tracks ret.Midi.File.track_number ;
pr "%d tracks.\n" ret.Midi.File.track_number ;
for cur_track = 0 to ret.Midi.File.track_number - 1 do
read_track ret.Midi.File.tracks.(cur_track) fin;
done;
ret
)
let write_header data chan = (
write_long chan data.Midi.file_id ;
write_long chan data.Midi.header_length ;
write_short chan data.Midi.midi_format ;
write_short chan data.Midi.track_number ;
write_short chan data.Midi.per_quarter_note ;
)
let write_track track fout = (
let write_header data chan =
write_long chan data.Midi.File.id;
write_long chan data.Midi.File.header_length;
write_short chan data.Midi.File.midi_format;
write_short chan data.Midi.File.track_number;
write_short chan data.Midi.File.per_quarter_note ;
()
let write_track track fout =
let buffer = Buffer.create 10028 in
let append_chari i = Buffer.add_char buffer (char_of_int i) in
Array.iteri (
ArrayLabels.iteri track.Midi.Track.events ~f:(
fun i ev ->
match ev with
Midi.EmptyEvent | Midi.SysEvent _ -> () |
Midi.MidiEvent e -> (
| Midi.Event.Empty | Midi.Event.Sys _ -> ()
| Midi.Event.Midi e ->
(* Log.p "Here it is ! stat:%d chan: %d write: %x \n" e.Midi.status e.Midi.channel (e.Midi.status lor e.Midi.channel); *)
write_var_length_in_buffer buffer (I.of_int e.Midi.ticks);
append_chari (e.Midi.status lor e.Midi.channel) ;
let rs = e.Midi.status in
write_var_length_in_buffer buffer (I.of_int e.Midi.Midi_event.ticks);
append_chari (e.Midi.Midi_event.status lor e.Midi.Midi_event.channel) ;
let rs = e.Midi.Midi_event.status in
if (
((0x80 <= rs) && (rs <= 0xBF)) || ((0xE0 <= rs) && (rs <= 0xEF))
) then (
append_chari e.Midi.data_1 ;
append_chari e.Midi.data_2 ;
append_chari e.Midi.Midi_event.data_1;
append_chari e.Midi.Midi_event.data_2;
) else (
pr "Special status:%d\n" rs ;
append_chari e.Midi.data_1 ;
append_chari e.Midi.Midi_event.data_1;
);
) |
Midi.MetaEvent e -> (
if (e.Midi.meta_ticks = 1 ) then pr "Here it is ! \n" ;
| Midi.Event.Meta e ->
if (e.Midi.Meta_event.ticks = 1 ) then pr "Here it is ! \n" ;
(* Log.p "Write Meta Ev: ticks:%d id:%d\n" e.Midi.meta_ticks e.Midi.service_id ; *)
write_var_length_in_buffer buffer (I.of_int e.Midi.meta_ticks);
write_var_length_in_buffer buffer (I.of_int e.Midi.Meta_event.ticks);
append_chari 0xFF ;(* status of meta events... *)
append_chari e.Midi.service_id ;
append_chari e.Midi.Meta_event.service_id ;
write_var_length_in_buffer buffer
(I.of_int (Array.length e.Midi.service_data));
(I.of_int (Array.length e.Midi.Meta_event.service_data));
Array.iter ( fun c ->
append_chari c ;
) e.Midi.service_data ;
)
) track.Midi.events ;
append_chari c ;
) e.Midi.Meta_event.service_data;
);
let len = I.of_int (Buffer.length buffer) in
if (len <> track.Midi.track_length) then (
pr "Grrr... must be a problem: %ld <> %ld\n" len track.Midi.track_length;
if (len <> track.Midi.Track.length) then (
pr "Grrr... must be a problem: %ld <> %ld\n" len track.Midi.Track.length;
);
write_long fout track.Midi.track_id ;
write_long fout track.Midi.Track.id ;
write_long fout len ;
Buffer.output_buffer fout buffer ;
)
Buffer.output_buffer fout buffer;
()
let write_smf data file = (
let write_smf data file =
let fout = open_out_bin file in
write_header data fout ;
for cur_track = 0 to data.Midi.track_number - 1 do
write_track data.Midi.tracks.(cur_track) fout ;
for cur_track = 0 to data.Midi.File.track_number - 1 do
write_track data.Midi.File.tracks.(cur_track) fout ;
done;
close_out fout ;
)
close_out fout;
()
......@@ -10,7 +10,7 @@ let () =
begin match Sys.argv.(1) with
| path ->
Stamifi.Midi_file.parse_smf path
|> Stamifi.Midi.midi_to_string
|> Stamifi.Midi.File.show
|> line "%s"
| exception _ ->
line "usage: %s <path>" Sys.argv.(0);
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment