<commit_before>(******************************************************************************)
(*      Copyright (c) 2007, <NAME>                                  *)
(*                                                                            *)
(*      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.                                       *)
(******************************************************************************)


(**
 Generic track editor that should work for MIDI and META events.
 {b Work in progress}
 @author <NAME>
 *)


module App = SeqApp
module S = StringServer

(** {3 Internal GUI utilities} *)

(** append a label to a box *)
let util_append_label text (box:GPack.box) = ignore (
  GMisc.label ~text ~packing:(box#pack ~expand:false ~fill:false ~padding:0) ()
)


(** Append a vertical separator to a box *)
let util_append_vertsepar (box:GPack.box) = (
  let sep =
    GMisc.separator `VERTICAL
    ~packing:(box#pack ~expand:false ~fill:false ~padding:0) 
    ~show:true () in
  sep#misc#set_size_request ~width:30 ();
)

(** Append an horizontal separator to a box *)
let util_append_horzsepar (box:GPack.box) = (
  let sep =
    GMisc.separator `HORIZONTAL
    ~packing:(box#pack ~expand:false ~fill:false ~padding:0) ~show:true () in
  sep#misc#set_size_request ~width:10 ();
)

(** Make a text mono-stable button and append it to a box *)
let util_append_button text (box:GPack.box) = (
  GButton.button ~label:text
  ~packing:(box#pack ~expand:false ~fill:false ~padding:0)  ~show:true ()
)

(** Make a text bi-stable button and append it to a box *)
let util_append_toggle text (box:GPack.box) = (
  GButton.toggle_button ~label:text ~active:false ~relief:`NORMAL
  ~packing:(box#pack ~expand:false ~fill:false ~padding:0)  ~show:true ()
)

(** Make an horizontal box (1 row) *)
let util_append_hbox (box:GPack.box) = (
  GPack.hbox  ~homogeneous:false
  ~packing:(box#pack ~expand:false ~fill:false ~padding:0) ~show:true ()
)

(** Make a [spin_button] for an integer value *)
let util_int_spin_button min max box = (
  let adj =
    GData.adjustment ~value:min ~lower:min ~upper:max
    ~step_incr:1.0 ~page_incr:10.0 ~page_size:0.0 () in
  GEdit.spin_button ~adjustment:adj ~packing:(box#add) ()
)

(******************************************************************************)
(** {3 More generic utilities} *)

let util_note_octave_of_event ev = (
  ev.Midi.data_1 mod 12 , (ev.Midi.data_1 / 12) + 1
)
let util_note_of_val_octave value octave = (octave - 1) * 12 + value

let util_note_to_string note = (
  let value,octave = util_note_octave_of_event note in
  let virtual_note = StringServer.note_names.(value) in
  let chan = note.Midi.channel in
  Printf.sprintf "NOTE: %s%d -> %d" virtual_note octave chan
)

let util_midi_event_to_string midi_ev = (
  let cmd = Midi.midi_cmd_of_event midi_ev in
  let chan = midi_ev.Midi.channel in
  Printf.sprintf "%s -> %d" (Midi.midi_cmd_to_string cmd) chan
)

(******************************************************************************)
(** {3 The model} *)

(** A {i minimalistic} variant to optimize matching *)
type track_type = MIDI_TRACK | META_TRACK

type editable_event =
  | EE_None
  (** The [editable_event] is a kind of [option] *)
  | EE_Midi of Midi.midi_event
  (** Generic midi event *)
  | EE_MidiNote of (Midi.midi_event * Midi.midi_event) list
  (** One midi note, and its instances in the track (NoteOn, NoteOff) *)
  | EE_MetaSpec of Tracker.meta_action_spec


(** An {i ugly} mapping structure that encloses both midi and meta tracks for
 the editor  *)
type track_values = {
  mutable tv_app: SeqApp.seq_app; (** The {i application} handle *)
  mutable tv_tk_id: int; (** The track ID *)
  mutable tv_type : track_type; (** Midi or Meta *)
  mutable tv_name: string;
  mutable tv_length_b: int;
  mutable tv_length_q: int;
  mutable tv_length_t: int;
  mutable tv_pqn : int ;
  mutable tv_port: int;
  mutable tv_edit_evts : editable_event array;
}

let util_make_midi_editables midi_events track_length = (

  let module HT = Hashtbl in

  let note_ons  = HT.create 50 in
  let note_offs  = HT.create 50 in
  let note_on_keys = ref [] in
  let add_key note = 
    note_on_keys := note::(List.filter (fun x -> x <> note) !note_on_keys) in
    

  let other_list = ref [] in
  let notes_list = ref [] in

  List.iter (
    fun midi_ev ->
      match midi_ev.Midi.status with
      | rs when ((0x80<= rs) && (rs <= 0x8F)) ->
          HT.add note_offs midi_ev.Midi.data_1 midi_ev;
      | rs when ((0x90<= rs) && (rs <= 0x9F)) -> 
          HT.add note_ons midi_ev.Midi.data_1 midi_ev;
          add_key midi_ev.Midi.data_1;
      | _ -> other_list := (EE_Midi midi_ev)::!other_list;
  ) midi_events;

  List.iter (
    fun x -> 
      let for_this_note = ref [] in

      let ons  = ref (
        List.fast_sort (fun x y -> compare x.Midi.ticks y.Midi.ticks)
        (HT.find_all note_ons x)) in
      let ofs = ref (
        List.fast_sort (fun x y -> compare x.Midi.ticks y.Midi.ticks)
        (HT.find_all note_offs x)) in
      let ons_iter = ref (List.length !ons) in
      let ofs_iter = ref (List.length !ofs) in
      while !ons_iter > 0 && !ofs_iter > 0 do
        let the_on,the_of = List.hd !ons , List.hd !ofs in
        if the_on.Midi.ticks < the_of.Midi.ticks
        then (
          (* "normal" case: *)
          for_this_note := (the_on, the_of) :: !for_this_note;
          ons := List.tl !ons; decr ons_iter;
          ofs := List.tl !ofs; decr ofs_iter;
        ) else (
          Log.p "Not off (%d) before note on (%d)\n"
          the_of.Midi.ticks the_on.Midi.ticks;
          other_list := (EE_Midi the_of)::!other_list;
          ofs := List.tl !ofs; decr ofs_iter;
        );
      done;
      if !for_this_note <> [] then (
        notes_list :=  (EE_MidiNote !for_this_note)::!notes_list;
      );
      List.iter (
        fun x ->  other_list := (EE_Midi x)::!other_list;
      ) !ons;
      List.iter (
        fun x ->  other_list := (EE_Midi x)::!other_list;
      ) !ofs;

  ) !note_on_keys;

  (List.append (List.fast_sort (
    fun x y -> 
      let get_note = function | EE_MidiNote ((mev,_)::_) -> mev.Midi.data_1
      | _ -> failwith "not a note in note list" in
      - (compare (get_note x) (get_note y))
  ) !notes_list) (List.rev (!other_list)))
)

(** [track_values] constructor *)
let tv_make_track_values app tk_ref = (
  match tk_ref with
  | `MIDI tk -> 
      let name,port,length =
        App.get_midi_track_information app tk in
      let _,p = App.get_bpm_ppqn app in
      let b,q,t = S.unitize_length_tuple length p in
      let midi_events = App.get_midi_track app tk in
      let editables_list = util_make_midi_editables midi_events length in
        (* List.rev (List.rev_map ( *)
        (* fun midi_ev -> EE_Midi midi_ev) midi_events) in *)
      let editables_array = Array.of_list editables_list in
      {
        tv_app = app;
        tv_tk_id = tk;
        tv_type = MIDI_TRACK;
        tv_name = name; 
        tv_length_b = b; 
        tv_length_q = q; 
        tv_length_t = t; 
        tv_pqn = p ;
        tv_port = port;
        tv_edit_evts = editables_array;
      }
  | `META tk ->
      let name,length = App.get_meta_track_information app tk in
      let _,p = App.get_bpm_ppqn app in
      let b,q,t = S.unitize_length_tuple length p in
      let meta_events = App.get_meta_track app tk in
      let editables_list = List.rev (List.rev_map (
        fun meta_ev -> EE_MetaSpec meta_ev) meta_events) in
      let editables_array = Array.of_list editables_list in
      {
        tv_app = app;
        tv_tk_id = tk;
        tv_type = META_TRACK;
        tv_name = name; 
        tv_length_b = b; 
        tv_length_q = q; 
        tv_length_t = t; 
        tv_pqn = p ;
        tv_port = 0;
        tv_edit_evts = editables_array;
      }
)

let tv_ticks_length tv = (
  let b,q,t =
    tv.tv_length_b, tv.tv_length_q, tv.tv_length_t in
  let p = tv.tv_pqn in
  b * 4 * p + q * p + t
)
let tv_rebuild_editables tv = (
  begin match tv.tv_type with
  | MIDI_TRACK ->
      let midi_events = App.get_midi_track tv.tv_app tv.tv_tk_id in
      let length = tv_ticks_length tv in
      let editables_list = util_make_midi_editables midi_events length in
      let editables_array = Array.of_list editables_list in
      tv.tv_edit_evts <- editables_array;
  | META_TRACK ->
      let meta_events = App.get_meta_track tv.tv_app tv.tv_tk_id in
      let editables_list = List.rev (List.rev_map (
        fun meta_ev -> EE_MetaSpec meta_ev) meta_events) in
      let editables_array = Array.of_list editables_list in
      tv.tv_edit_evts <- editables_array;
  end;
)

let tv_update_track_info tv = (
  begin match tv.tv_type with
  | MIDI_TRACK ->
      App.set_midi_track_information tv.tv_app tv.tv_tk_id
      tv.tv_name tv.tv_port 
      ( (tv.tv_length_b * tv.tv_pqn * 4)
      + (tv.tv_length_q * tv.tv_pqn) + tv.tv_length_t) ;
  | META_TRACK ->
      Log.warn "tv_update_track_info (META) NOT IMPLEMENTED\n" ;
  end

)
(******************************************************************************)
(** {3 The event editor frame} *)

type edit_pointer_tool =
  | EPTool_None
  | EPTool_Write
  | EPTool_Erase
  | EPTool_Resize

(** The current status of the pointer *)
type edit_pointer_status =
  | EPStatus_Idle
  | EPStatus_DragStarted of int * int * int (** event_id, x, y *)
  (* going deprecated ? *)
  | EPStatus_XDrag of (int -> bool) * (int -> unit)
  (** dragging callback X -> continue?, mouse release callback: gets X *)

type edit_pointer = {
  mutable ep_tool: edit_pointer_tool;
  mutable ep_status: edit_pointer_status;

  mutable ep_precision: int;
}


(** The "draw" object *)
type event_frame = {
  mutable ef_model: track_values;
  mutable ef_draw: GDraw.pixmap;
  mutable ef_imag: GMisc.image;

  mutable ef_pointer: edit_pointer; (** The pointer for edition *)

  mutable ef_grid_begin_x: int;
  mutable ef_h: int;
  mutable ef_w: int;
  mutable ef_zoom: int;

  mutable ef_current_selection: int;

  mutable ef_cut_quarters: int; (** The number of sub-quarter divisions *)

  ef_set_cursor: Gdk.Cursor.cursor_type -> unit;
  ef_on_selection: event_frame -> unit;
}


(** The editor font: *)
let global_main_font = ref "Monospace 6"


let make_color str = (`NAME str : GDraw.color)
let global_bg_color   = ref (make_color "#4A00DD")
let global_grid_color = ref (make_color "#E8B500")
let global_text_color = ref (make_color "#B9FFB1")
let global_selected_text_color = ref (make_color "#FF0C00")
let global_text_velocity_color = ref (make_color "#D40000")
let global_midi_event_tick_color = ref (make_color "#BB006A")
let global_midi_event_range_color = ref (make_color "#5AFE00")

let global_separ_width = ref 3
let global_horiz_lines_width = ref 2

let global_vert_cut_quarter_width = ref 1
let global_vert_quarter_width = ref 2

let ef_update_size ef = (
  (* we add some pixels to have an elegant drawing... *)
  (* ef.ef_area#set_size ~width:(ef.ef_w+2) ~height:(ef.ef_h+2); *)
  let pixmap = GDraw.pixmap ~width:(ef.ef_w+2) ~height:(ef.ef_h+2) () in
  ef.ef_draw <- pixmap;
)

let ef_make_layout ef str = (
  let lo = 
    Pango.Layout.create ef.ef_imag#misc#pango_context#as_context in
  Pango.Layout.set_text lo str;
  lo
)
let ef_set_font ef  str = (
  let font = Pango.Font.from_string str in
  let ctx = ef.ef_imag#misc#pango_context#as_context in
  Pango.Context.set_font_description ctx font;
)

let ef_event_number ef = ( Array.length ef.ef_model.tv_edit_evts ;)

let ef_ticks_to_pixels ef ticks = (ef.ef_zoom * ticks / 50 )
let ef_pixels_to_ticks ef pixels = (pixels * 50 / ef.ef_zoom)

let ef_draw_background ef = (

  (* The Width *)
  let ticks_length = tv_ticks_length ef.ef_model in
  let pixel_length = ef_ticks_to_pixels ef ticks_length in
  ef.ef_w <- ef.ef_grid_begin_x + pixel_length;

  (* The Height *)
  let dummy_layout = ef_make_layout ef "Chouniard !!!" in
  let _, ly = Pango.Layout.get_pixel_size dummy_layout in
  let ev_nb = ef_event_number ef in
  ef.ef_h <- 1 + (ly * ev_nb);

  ef_update_size ef ;

  (* The background: *)
  ef.ef_draw#set_foreground !global_bg_color;
  ef.ef_draw#rectangle ~x:0 ~y:0
  ~width:ef.ef_w ~height:ef.ef_h ~filled:true ();
  ef.ef_draw#set_foreground !global_grid_color;
  ef.ef_draw#rectangle ~x:0 ~y:0
  ~width:ef.ef_w ~height:ef.ef_h ~filled:false ();

  (* The vertical separator: *)
  ef.ef_draw#rectangle ~x:(ef.ef_grid_begin_x - !global_separ_width) ~y:0
  ~width:!global_separ_width ~height:ef.ef_h ~filled:true ();

  (* Horizontal lines: *)
  for i = 1 to ev_nb do
    ef.ef_draw#rectangle ~x:0 ~y:( 1 + (i * ly) )
    ~width:ef.ef_w ~height:!global_horiz_lines_width ~filled:true ();
  done;


  (* Vertical lines: *)
  for i = 0 to ticks_length do
    if ( i mod ef.ef_model.tv_pqn) = 0 then (
      let x = ef_ticks_to_pixels ef i in
      ef.ef_draw#rectangle ~x:(ef.ef_grid_begin_x + x) ~y:0
      ~width:!global_vert_quarter_width
      ~height:ef.ef_h ~filled:true ();
    ) else (
      if ( i mod (ef.ef_model.tv_pqn / ef.ef_cut_quarters) ) = 0 then (
        let x = ef_ticks_to_pixels ef i in
        ef.ef_draw#rectangle ~x:(ef.ef_grid_begin_x + x) ~y:0
        ~width:!global_vert_cut_quarter_width
        ~height:ef.ef_h ~filled:true ();
      )
    )
  done;
)

let ef_draw_event ef index event = (
  let choose_text_color () = 
    if (index = ef.ef_current_selection) then (
      ef.ef_draw#set_foreground !global_selected_text_color;
    ) else (
      ef.ef_draw#set_foreground !global_text_color;
    );
  in
  begin match event with
  | EE_Midi ev ->
      let str = util_midi_event_to_string ev in
      let lo = ef_make_layout ef str in
      let _, l_y = Pango.Layout.get_pixel_size lo in
      let cur_y = 2 + (index * l_y) in
      choose_text_color ();
      ef.ef_draw#put_layout ~x:10 ~y:cur_y lo ;
      
      let x_in_grid =
        ef.ef_grid_begin_x + 
        (ef_ticks_to_pixels ef ev.Midi.ticks) in
      ef.ef_draw#set_foreground !global_midi_event_tick_color;
      ef.ef_draw#rectangle ~x:x_in_grid ~y:(cur_y + 1)
      ~width:3 ~height:(l_y - 2) ~filled:true ();
  | EE_MidiNote [] -> Log.p "An empty midi note...\n" ;
  | EE_MidiNote ev_list ->
      let ev_on, _ = List.hd ev_list in
      let str = util_note_to_string ev_on in
      let lo = ef_make_layout ef str in
      let _, l_y = Pango.Layout.get_pixel_size lo in
      let cur_y = 2 + (index * l_y) in
      choose_text_color ();
      ef.ef_draw#put_layout ~x:10 ~y:cur_y lo ;
      
      List.iter (
        fun (ev_on , ev_off) ->
          let x_on_in_grid =
            ef.ef_grid_begin_x + (ef_ticks_to_pixels ef ev_on.Midi.ticks) in
          let x_off_in_grid =
            ef.ef_grid_begin_x + (ef_ticks_to_pixels ef ev_off.Midi.ticks) in
          ef.ef_draw#set_foreground !global_midi_event_range_color;
          ef.ef_draw#rectangle ~x:x_on_in_grid ~y:(cur_y + 2)
          ~width:(x_off_in_grid - x_on_in_grid) ~height:(l_y - 3)
          ~filled:true ();

          let str = Printf.sprintf "[%d]" ev_on.Midi.data_2 in
          ef.ef_draw#set_foreground !global_text_velocity_color;
          ef.ef_draw#put_layout ~x:(x_on_in_grid  + 3)
          ~y:(cur_y + 1) (ef_make_layout ef str);
     
      ) ev_list;
  | _ -> Log.warn "NOT IMPLEMENTED\n" ;
  end
)

let ef_make_draw ef = (
  ef_draw_background ef;
  Array.iteri (ef_draw_event ef) ef.ef_model.tv_edit_evts;
  ef.ef_imag#set_pixmap ef.ef_draw;
)

let ef_cmd_redraw ef = (
  (* GtkBase.Widget.queue_draw ef.ef_imag#as_widget ; *)
  ef_make_draw ef;
)

let ef_y_to_event ef y = (
  let ev_size = (ef.ef_h - 1) / (ef_event_number ef) in
  let ev = y / ev_size in
  if (0 <= ev) && (ev < (ef_event_number ef)) then
    y / ev_size
  else 
    -1
)

let ef_pointer_touches_ticks ef x_point ticks = (
  let x_of_ticks = ef_ticks_to_pixels ef ticks in
  let ep = ef.ef_pointer in
  let x = x_point - ef.ef_grid_begin_x in
  Log.p "--- ticks:%d(%d) x:%d\n" ticks x_of_ticks x;
  (x - ep.ep_precision < x_of_ticks ) && (x_of_ticks < x + ep.ep_precision)
)
let ef_pointer_in_ticks_interval ef x_point (t_min, t_max) = (
  let x_min = ef_ticks_to_pixels ef t_min in
  let x_max = ef_ticks_to_pixels ef t_max in
  let x = x_point - ef.ef_grid_begin_x in
  (* Log.p "--- ticks:%d(%d) in [%d, %d] ?\n" x x_point x_min x_max; *)
  (x_min <= x ) && (x <= x_max)
)

let ef_on_mouse_press ef x y = (
  (* Log.p "ef_on_mouse_press is called: (%d,%d) on event: %d !!\n" *)
  x y (ef_y_to_event ef y);
  if (ef.ef_pointer.ep_tool = EPTool_None && x < ef.ef_grid_begin_x) then (
    ef.ef_current_selection <- (ef_y_to_event ef y);
    ef_cmd_redraw ef;
    ef.ef_on_selection ef;
  );

  (* Utilities for this automata: *)
  let module LocalUtil = struct
    let start_resize_midi_ticks ef midi_ev ~valid_interval = (<commit_msg>GuiEditor: typo-bug fix<commit_after>(******************************************************************************)
(*      Copyright (c) 2007, <NAME>                                  *)
(*                                                                            *)
(*      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.                                       *)
(******************************************************************************)


(**
 Generic track editor that should work for MIDI and META events.
 {b Work in progress}
 @author <NAME>
 *)


module App = SeqApp
module S = StringServer

(** {3 Internal GUI utilities} *)

(** append a label to a box *)
let util_append_label text (box:GPack.box) = ignore (
  GMisc.label ~text ~packing:(box#pack ~expand:false ~fill:false ~padding:0) ()
)


(** Append a vertical separator to a box *)
let util_append_vertsepar (box:GPack.box) = (
  let sep =
    GMisc.separator `VERTICAL
    ~packing:(box#pack ~expand:false ~fill:false ~padding:0) 
    ~show:true () in
  sep#misc#set_size_request ~width:30 ();
)

(** Append an horizontal separator to a box *)
let util_append_horzsepar (box:GPack.box) = (
  let sep =
    GMisc.separator `HORIZONTAL
    ~packing:(box#pack ~expand:false ~fill:false ~padding:0) ~show:true () in
  sep#misc#set_size_request ~width:10 ();
)

(** Make a text mono-stable button and append it to a box *)
let util_append_button text (box:GPack.box) = (
  GButton.button ~label:text
  ~packing:(box#pack ~expand:false ~fill:false ~padding:0)  ~show:true ()
)

(** Make a text bi-stable button and append it to a box *)
let util_append_toggle text (box:GPack.box) = (
  GButton.toggle_button ~label:text ~active:false ~relief:`NORMAL
  ~packing:(box#pack ~expand:false ~fill:false ~padding:0)  ~show:true ()
)

(** Make an horizontal box (1 row) *)
let util_append_hbox (box:GPack.box) = (
  GPack.hbox  ~homogeneous:false
  ~packing:(box#pack ~expand:false ~fill:false ~padding:0) ~show:true ()
)

(** Make a [spin_button] for an integer value *)
let util_int_spin_button min max box = (
  let adj =
    GData.adjustment ~value:min ~lower:min ~upper:max
    ~step_incr:1.0 ~page_incr:10.0 ~page_size:0.0 () in
  GEdit.spin_button ~adjustment:adj ~packing:(box#add) ()
)

(******************************************************************************)
(** {3 More generic utilities} *)

let util_note_octave_of_event ev = (
  ev.Midi.data_1 mod 12 , (ev.Midi.data_1 / 12) + 1
)
let util_note_of_val_octave value octave = (octave - 1) * 12 + value

let util_note_to_string note = (
  let value,octave = util_note_octave_of_event note in
  let virtual_note = StringServer.note_names.(value) in
  let chan = note.Midi.channel in
  Printf.sprintf "NOTE: %s%d -> %d" virtual_note octave chan
)

let util_midi_event_to_string midi_ev = (
  let cmd = Midi.midi_cmd_of_event midi_ev in
  let chan = midi_ev.Midi.channel in
  Printf.sprintf "%s -> %d" (Midi.midi_cmd_to_string cmd) chan
)

(******************************************************************************)
(** {3 The model} *)

(** A {i minimalistic} variant to optimize matching *)
type track_type = MIDI_TRACK | META_TRACK

type editable_event =
  | EE_None
  (** The [editable_event] is a kind of [option] *)
  | EE_Midi of Midi.midi_event
  (** Generic midi event *)
  | EE_MidiNote of (Midi.midi_event * Midi.midi_event) list
  (** One midi note, and its instances in the track (NoteOn, NoteOff) *)
  | EE_MetaSpec of Tracker.meta_action_spec


(** An {i ugly} mapping structure that encloses both midi and meta tracks for
 the editor  *)
type track_values = {
  mutable tv_app: SeqApp.seq_app; (** The {i application} handle *)
  mutable tv_tk_id: int; (** The track ID *)
  mutable tv_type : track_type; (** Midi or Meta *)
  mutable tv_name: string;
  mutable tv_length_b: int;
  mutable tv_length_q: int;
  mutable tv_length_t: int;
  mutable tv_pqn : int ;
  mutable tv_port: int;
  mutable tv_edit_evts : editable_event array;
}

let util_make_midi_editables midi_events track_length = (

  let module HT = Hashtbl in

  let note_ons  = HT.create 50 in
  let note_offs  = HT.create 50 in
  let note_on_keys = ref [] in
  let add_key note = 
    note_on_keys := note::(List.filter (fun x -> x <> note) !note_on_keys) in
    

  let other_list = ref [] in
  let notes_list = ref [] in

  List.iter (
    fun midi_ev ->
      match midi_ev.Midi.status with
      | rs when ((0x80<= rs) && (rs <= 0x8F)) ->
          HT.add note_offs midi_ev.Midi.data_1 midi_ev;
      | rs when ((0x90<= rs) && (rs <= 0x9F)) -> 
          HT.add note_ons midi_ev.Midi.data_1 midi_ev;
          add_key midi_ev.Midi.data_1;
      | _ -> other_list := (EE_Midi midi_ev)::!other_list;
  ) midi_events;

  List.iter (
    fun x -> 
      let for_this_note = ref [] in

      let ons  = ref (
        List.fast_sort (fun x y -> compare x.Midi.ticks y.Midi.ticks)
        (HT.find_all note_ons x)) in
      let ofs = ref (
        List.fast_sort (fun x y -> compare x.Midi.ticks y.Midi.ticks)
        (HT.find_all note_offs x)) in
      let ons_iter = ref (List.length !ons) in
      let ofs_iter = ref (List.length !ofs) in
      while !ons_iter > 0 && !ofs_iter > 0 do
        let the_on,the_of = List.hd !ons , List.hd !ofs in
        if the_on.Midi.ticks < the_of.Midi.ticks
        then (
          (* "normal" case: *)
          for_this_note := (the_on, the_of) :: !for_this_note;
          ons := List.tl !ons; decr ons_iter;
          ofs := List.tl !ofs; decr ofs_iter;
        ) else (
          Log.p "Not off (%d) before note on (%d)\n"
          the_of.Midi.ticks the_on.Midi.ticks;
          other_list := (EE_Midi the_of)::!other_list;
          ofs := List.tl !ofs; decr ofs_iter;
        );
      done;
      if !for_this_note <> [] then (
        notes_list :=  (EE_MidiNote !for_this_note)::!notes_list;
      );
      List.iter (
        fun x ->  other_list := (EE_Midi x)::!other_list;
      ) !ons;
      List.iter (
        fun x ->  other_list := (EE_Midi x)::!other_list;
      ) !ofs;

  ) !note_on_keys;

  (List.append (List.fast_sort (
    fun x y -> 
      let get_note = function | EE_MidiNote ((mev,_)::_) -> mev.Midi.data_1
      | _ -> failwith "not a note in note list" in
      - (compare (get_note x) (get_note y))
  ) !notes_list) (List.rev (!other_list)))
)

(** [track_values] constructor *)
let tv_make_track_values app tk_ref = (
  match tk_ref with
  | `MIDI tk -> 
      let name,port,length =
        App.get_midi_track_information app tk in
      let _,p = App.get_bpm_ppqn app in
      let b,q,t = S.unitize_length_tuple length p in
      let midi_events = App.get_midi_track app tk in
      let editables_list = util_make_midi_editables midi_events length in
        (* List.rev (List.rev_map ( *)
        (* fun midi_ev -> EE_Midi midi_ev) midi_events) in *)
      let editables_array = Array.of_list editables_list in
      {
        tv_app = app;
        tv_tk_id = tk;
        tv_type = MIDI_TRACK;
        tv_name = name; 
        tv_length_b = b; 
        tv_length_q = q; 
        tv_length_t = t; 
        tv_pqn = p ;
        tv_port = port;
        tv_edit_evts = editables_array;
      }
  | `META tk ->
      let name,length = App.get_meta_track_information app tk in
      let _,p = App.get_bpm_ppqn app in
      let b,q,t = S.unitize_length_tuple length p in
      let meta_events = App.get_meta_track app tk in
      let editables_list = List.rev (List.rev_map (
        fun meta_ev -> EE_MetaSpec meta_ev) meta_events) in
      let editables_array = Array.of_list editables_list in
      {
        tv_app = app;
        tv_tk_id = tk;
        tv_type = META_TRACK;
        tv_name = name; 
        tv_length_b = b; 
        tv_length_q = q; 
        tv_length_t = t; 
        tv_pqn = p ;
        tv_port = 0;
        tv_edit_evts = editables_array;
      }
)

let tv_ticks_length tv = (
  let b,q,t =
    tv.tv_length_b, tv.tv_length_q, tv.tv_length_t in
  let p = tv.tv_pqn in
  b * 4 * p + q * p + t
)
let tv_rebuild_editables tv = (
  begin match tv.tv_type with
  | MIDI_TRACK ->
      let midi_events = App.get_midi_track tv.tv_app tv.tv_tk_id in
      let length = tv_ticks_length tv in
      let editables_list = util_make_midi_editables midi_events length in
      let editables_array = Array.of_list editables_list in
      tv.tv_edit_evts <- editables_array;
  | META_TRACK ->
      let meta_events = App.get_meta_track tv.tv_app tv.tv_tk_id in
      let editables_list = List.rev (List.rev_map (
        fun meta_ev -> EE_MetaSpec meta_ev) meta_events) in
      let editables_array = Array.of_list editables_list in
      tv.tv_edit_evts <- editables_array;
  end;
)

let tv_update_track_info tv = (
  begin match tv.tv_type with
  | MIDI_TRACK ->
      App.set_midi_track_information tv.tv_app tv.tv_tk_id
      tv.tv_name tv.tv_port 
      ( (tv.tv_length_b * tv.tv_pqn * 4)
      + (tv.tv_length_q * tv.tv_pqn) + tv.tv_length_t) ;
  | META_TRACK ->
      Log.warn "tv_update_track_info (META) NOT IMPLEMENTED\n" ;
  end

)
(******************************************************************************)
(** {3 The event editor frame} *)

type edit_pointer_tool =
  | EPTool_None
  | EPTool_Write
  | EPTool_Erase
  | EPTool_Resize

(** The current status of the pointer *)
type edit_pointer_status =
  | EPStatus_Idle
  | EPStatus_DragStarted of int * int * int (** event_id, x, y *)
  (* going deprecated ? *)
  | EPStatus_XDrag of (int -> bool) * (int -> unit)
  (** dragging callback X -> continue?, mouse release callback: gets X *)

type edit_pointer = {
  mutable ep_tool: edit_pointer_tool;
  mutable ep_status: edit_pointer_status;

  mutable ep_precision: int;
}


(** The "draw" object *)
type event_frame = {
  mutable ef_model: track_values;
  mutable ef_draw: GDraw.pixmap;
  mutable ef_imag: GMisc.image;

  mutable ef_pointer: edit_pointer; (** The pointer for edition *)

  mutable ef_grid_begin_x: int;
  mutable ef_h: int;
  mutable ef_w: int;
  mutable ef_zoom: int;

  mutable ef_current_selection: int;

  mutable ef_cut_quarters: int; (** The number of sub-quarter divisions *)

  ef_set_cursor: Gdk.Cursor.cursor_type -> unit;
  ef_on_selection: event_frame -> unit;
}


(** The editor font: *)
let global_main_font = ref "Monospace 6"


let make_color str = (`NAME str : GDraw.color)
let global_bg_color   = ref (make_color "#4A00DD")
let global_grid_color = ref (make_color "#E8B500")
let global_text_color = ref (make_color "#B9FFB1")
let global_selected_text_color = ref (make_color "#FF0C00")
let global_text_velocity_color = ref (make_color "#D40000")
let global_midi_event_tick_color = ref (make_color "#BB006A")
let global_midi_event_range_color = ref (make_color "#5AFE00")

let global_separ_width = ref 3
let global_horiz_lines_width = ref 2

let global_vert_cut_quarter_width = ref 1
let global_vert_quarter_width = ref 2

let ef_update_size ef = (
  (* we add some pixels to have an elegant drawing... *)
  (* ef.ef_area#set_size ~width:(ef.ef_w+2) ~height:(ef.ef_h+2); *)
  let pixmap = GDraw.pixmap ~width:(ef.ef_w+2) ~height:(ef.ef_h+2) () in
  ef.ef_draw <- pixmap;
)

let ef_make_layout ef str = (
  let lo = 
    Pango.Layout.create ef.ef_imag#misc#pango_context#as_context in
  Pango.Layout.set_text lo str;
  lo
)
let ef_set_font ef  str = (
  let font = Pango.Font.from_string str in
  let ctx = ef.ef_imag#misc#pango_context#as_context in
  Pango.Context.set_font_description ctx font;
)

let ef_event_number ef = ( Array.length ef.ef_model.tv_edit_evts ;)

let ef_ticks_to_pixels ef ticks = (ef.ef_zoom * ticks / 50 )
let ef_pixels_to_ticks ef pixels = (pixels * 50 / ef.ef_zoom)

let ef_draw_background ef = (

  (* The Width *)
  let ticks_length = tv_ticks_length ef.ef_model in
  let pixel_length = ef_ticks_to_pixels ef ticks_length in
  ef.ef_w <- ef.ef_grid_begin_x + pixel_length;

  (* The Height *)
  let dummy_layout = ef_make_layout ef "Chouniard !!!" in
  let _, ly = Pango.Layout.get_pixel_size dummy_layout in
  let ev_nb = ef_event_number ef in
  ef.ef_h <- 1 + (ly * ev_nb);

  ef_update_size ef ;

  (* The background: *)
  ef.ef_draw#set_foreground !global_bg_color;
  ef.ef_draw#rectangle ~x:0 ~y:0
  ~width:ef.ef_w ~height:ef.ef_h ~filled:true ();
  ef.ef_draw#set_foreground !global_grid_color;
  ef.ef_draw#rectangle ~x:0 ~y:0
  ~width:ef.ef_w ~height:ef.ef_h ~filled:false ();

  (* The vertical separator: *)
  ef.ef_draw#rectangle ~x:(ef.ef_grid_begin_x - !global_separ_width) ~y:0
  ~width:!global_separ_width ~height:ef.ef_h ~filled:true ();

  (* Horizontal lines: *)
  for i = 1 to ev_nb do
    ef.ef_draw#rectangle ~x:0 ~y:( 1 + (i * ly) )
    ~width:ef.ef_w ~height:!global_horiz_lines_width ~filled:true ();
  done;


  (* Vertical lines: *)
  for i = 0 to ticks_length do
    if ( i mod ef.ef_model.tv_pqn) = 0 then (
      let x = ef_ticks_to_pixels ef i in
      ef.ef_draw#rectangle ~x:(ef.ef_grid_begin_x + x) ~y:0
      ~width:!global_vert_quarter_width
      ~height:ef.ef_h ~filled:true ();
    ) else (
      if ( i mod (ef.ef_model.tv_pqn / ef.ef_cut_quarters) ) = 0 then (
        let x = ef_ticks_to_pixels ef i in
        ef.ef_draw#rectangle ~x:(ef.ef_grid_begin_x + x) ~y:0
        ~width:!global_vert_cut_quarter_width
        ~height:ef.ef_h ~filled:true ();
      )
    )
  done;
)

let ef_draw_event ef index event = (
  let choose_text_color () = 
    if (index = ef.ef_current_selection) then (
      ef.ef_draw#set_foreground !global_selected_text_color;
    ) else (
      ef.ef_draw#set_foreground !global_text_color;
    );
  in
  begin match event with
  | EE_Midi ev ->
      let str = util_midi_event_to_string ev in
      let lo = ef_make_layout ef str in
      let _, l_y = Pango.Layout.get_pixel_size lo in
      let cur_y = 2 + (index * l_y) in
      choose_text_color ();
      ef.ef_draw#put_layout ~x:10 ~y:cur_y lo ;
      
      let x_in_grid =
        ef.ef_grid_begin_x + 
        (ef_ticks_to_pixels ef ev.Midi.ticks) in
      ef.ef_draw#set_foreground !global_midi_event_tick_color;
      ef.ef_draw#rectangle ~x:x_in_grid ~y:(cur_y + 1)
      ~width:3 ~height:(l_y - 2) ~filled:true ();
  | EE_MidiNote [] -> Log.p "An empty midi note...\n" ;
  | EE_MidiNote ev_list ->
      let ev_on, _ = List.hd ev_list in
      let str = util_note_to_string ev_on in
      let lo = ef_make_layout ef str in
      let _, l_y = Pango.Layout.get_pixel_size lo in
      let cur_y = 2 + (index * l_y) in
      choose_text_color ();
      ef.ef_draw#put_layout ~x:10 ~y:cur_y lo ;
      
      List.iter (
        fun (ev_on , ev_off) ->
          let x_on_in_grid =
            ef.ef_grid_begin_x + (ef_ticks_to_pixels ef ev_on.Midi.ticks) in
          let x_off_in_grid =
            ef.ef_grid_begin_x + (ef_ticks_to_pixels ef ev_off.Midi.ticks) in
          ef.ef_draw#set_foreground !global_midi_event_range_color;
          ef.ef_draw#rectangle ~x:x_on_in_grid ~y:(cur_y + 2)
          ~width:(x_off_in_grid - x_on_in_grid) ~height:(l_y - 3)
          ~filled:true ();

          let str = Printf.sprintf "[%d]" ev_on.Midi.data_2 in
          ef.ef_draw#set_foreground !global_text_velocity_color;
          ef.ef_draw#put_layout ~x:(x_on_in_grid  + 3)
          ~y:(cur_y + 1) (ef_make_layout ef str);
     
      ) ev_list;
  | _ -> Log.warn "NOT IMPLEMENTED\n" ;
  end
)

let ef_make_draw ef = (
  ef_draw_background ef;
  Array.iteri (ef_draw_event ef) ef.ef_model.tv_edit_evts;
  ef.ef_imag#set_pixmap ef.ef_draw;
)

let ef_cmd_redraw ef = (
  (* GtkBase.Widget.queue_draw ef.ef_imag#as_widget ; *)
  ef_make_draw ef;
)

let ef_y_to_event ef y = (
  let ev_size = (ef.ef_h - 1) / (ef_event_number ef) in
  let ev = y / ev_size in
  if (0 <= ev) && (ev < (ef_event_number ef)) then
    y / ev_size
  else 
    -1
)

let ef_pointer_touches_ticks ef x_point ticks = (
  let x_of_ticks = ef_ticks_to_pixels ef ticks in
  let ep = ef.ef_pointer in
  let x = x_point - ef.ef_grid_begin_x in
  Log.p "--- ticks:%d(%d) x:%d\n" ticks x_of_ticks x;
  (x - ep.ep_precision < x_of_ticks ) && (x_of_ticks < x + ep.ep_precision)
)
let ef_pointer_in_ticks_interval ef x_point (t_min, t_max) = (
  let x_min = ef_ticks_to_pixels ef t_min in
  let x_max = ef_ticks_to_pixels ef t_max in
  let x = x_point - ef.ef_grid_begin_x in
  (* Log.p "--- ticks:%d(%d) in [%d, %d] ?\n" x x_point x_min x_max; *)
  (x_min <= x ) && (x <= x_max)
)

let ef_on_mouse_press ef x y = (
  (* Log.p "ef_on_mouse_press is called: (%d,%d) on event: %d !!\n" *)
  (* x y (ef_y_to_event ef y); *)
  if (ef.ef_pointer.ep_tool = EPTool_None && x < ef.ef_grid_begin_x) then (
    ef.ef_current_selection <- (ef_y_to_event ef y);
    ef_cmd_redraw ef;
    ef.ef_on_selection ef;
  );

  (* Utilities for this automata: *)
  let module LocalUtil = struct
    let start_resize_midi_ticks ef midi_ev ~valid_interval = (
{'fraction_non_alphanumeric': 0.12899350117415762, 'fraction_numerical': 0.006881109715471574, 'mean_word_length': 2.8141012289106437, 'pattern_counts': {'":': 0, '<': 47, '<?xml version=': 0, '>': 83, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 28, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6296405', 'n_tokens_mistral': 13956, 'n_tokens_neox': 13160, 'n_words': 3332}