(**************************************************************************)
(*                                                                        *)
(*  Ocamlviz --- real-time profiling tools for Objective Caml             *)
(*  Copyright (C) by INRIA - CNRS - Universite Paris Sud                  *)
(*  Authors: Julien Robert                                                *)
(*           Guillaume Von Tokarski                                       *)
(*           Sylvain Conchon                                              *)
(*           Jean-Christophe Filliatre                                    *)
(*           Fabrice Le Fessant                                           *)
(*  GNU Library General Public License version 2                          *)
(*  See file LICENSE for details                                          *)
(*                                                                        *)
(**************************************************************************)

open Protocol
open Db
open Gui_misc
open Gui_models



(*******************************************************************
	             VIEW CREATION FUNCTIONS							    
********************************************************************
********************************************************************)


let item_toggled (model : GTree.list_store) (model': GTree.model_sort) ~column path =
  let row = model'#get_iter path in
  let row = model'#convert_iter_to_child_iter row in
  let b = model#get ~row ~column in
  model#set ~row ~column (not b);
  ()

let item_toggled_radio (model : GTree.list_store) (model': GTree.model_sort) ~column path =
  let row = model'#get_iter path in
  let row = model'#convert_iter_to_child_iter row in
  let b = model#get ~row ~column in
  model#foreach
    (fun _ r ->
       model#set ~row:r ~column false;
       false
    );
  model#set ~row ~column (not b)

(* Makes the view from the model s in the hbox hb with its scrollbar sb *)
   
let mk_view_aux i v name ?color s = 
  let view = GTree.view_column ~title:name  () in
  let renderer = GTree.cell_renderer_text [ `XALIGN 0.] in
  view#set_resizable true;
  view#pack renderer ;
  view#add_attribute renderer "text" s ;
  view#set_sort_column_id i ;
  view#set_min_width 10;
  v#append_column view;
  begin
    match color with
      |Some c -> view#add_attribute renderer "foreground" c
      |None -> ()
  end;
  view


let mk_view_aux_progress i v name ?color s = 
  let view = GTree.view_column ~title:name () in
  let renderer = GTree.cell_renderer_progress [ `XALIGN 0.] in
  view#set_resizable true;
  view#pack renderer ;
  view#add_attribute renderer "value" s ;
  view#set_sort_column_id i ;
  v#append_column view;
  begin
    match color with
      |Some c -> view#add_attribute renderer "foreground" c
      |None -> ()
  end;
  view


let mk_view_aux_with_toggle i v name ?color model model' s s'= 
  let view = mk_view_aux i v name ?color s in
  let renderer'= GTree.cell_renderer_toggle [ `XALIGN 0.] in
  ignore(renderer'#connect#toggled ~callback:(item_toggled model model' ~column:s'));
  view#pack renderer';
  view#add_attribute renderer' "active" s'


let mk_view_aux_progress_with_toggle i v name ?color model model' s s'= 
  let view = mk_view_aux_progress i v name ?color s in
  let renderer'= GTree.cell_renderer_toggle [ `XALIGN 0.] in
  ignore(renderer'#connect#toggled ~callback:(item_toggled model model' ~column:s'));
  view#pack renderer';
  view#add_attribute renderer' "active" s'


let mk_view_aux_with_toggle_and_time i v name ?color model model' s s' s''= 
  let view = mk_view_aux i v name ?color s in
  let renderer'= GTree.cell_renderer_toggle [ `XALIGN 0.] in
  ignore(renderer'#connect#toggled ~callback:(item_toggled model model' ~column:s'));
  let renderer''= GTree.cell_renderer_text [ `XALIGN 0.] in
  view#pack renderer'';
  view#pack renderer';
  view#add_attribute renderer'' "text" s'' ;
  view#add_attribute renderer' "active" s';
  begin
    match color with
      |Some c -> view#add_attribute renderer'' "foreground" c
      |None -> ()
  end


let mk_view_aux_with_radio_and_time i v name ?color model model' s s' s''= 
  let view = mk_view_aux i v name ?color s in
  let renderer'= GTree.cell_renderer_toggle [ `RADIO true ; `XALIGN 0.] in
  ignore(renderer'#connect#toggled ~callback:(item_toggled_radio model model' ~column:s'));
  let renderer''= GTree.cell_renderer_text [ `XALIGN 0.] in
  view#pack renderer'';
  view#pack renderer';
  view#add_attribute renderer'' "text" s'' ;
  view#add_attribute renderer' "active" s';
  begin
    match color with
      |Some c -> view#add_attribute renderer'' "foreground" c
      |None -> ()
  end


let mk_view_tree (model:#GTree.model) (model': GTree.model_sort) (box:GPack.box) =
  let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
    ~vpolicy:`AUTOMATIC ~packing:box#add () in
  let view = GTree.view ~model ~packing:sw#add () in
  view#set_rules_hint true;
  ignore(mk_view_aux_with_radio_and_time 0 view "Name" model model' tree_name_col tree_radio_col tree_lm_s_col)


let mk_view_list (model:#GTree.model) col1 col2 col3 col4 (box:GPack.box) =
  let v = 
    let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
      ~vpolicy:`AUTOMATIC ~packing:box#add () in
    GTree.view ~model ~packing:sw#add () 
  in
  v#set_rules_hint true;
  ignore(mk_view_aux 0 v "Name" col1);
  ignore(mk_view_aux 1 v "Value" ~color:col4 col2);
  ignore(mk_view_aux 2 v "Last Modified" ~color:col4 col3)

	 

let mk_view (model:#GTree.model) (model': GTree.model_sort) (box:GPack.box) noteb =
  let v = 
    match noteb with
      |Gc -> GTree.view ~model:model' ~packing:(box#pack ~expand:false) ()
      |_ -> 
	 let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
      ~vpolicy:`AUTOMATIC ~packing:box#add () in
	 GTree.view ~model:model' ~packing:sw#add () 
  in
  v#set_rules_hint true;
  match noteb with
    |Stat -> 
       ignore(mk_view_aux 0 v "Name" s_name_col); 
	mk_view_aux_with_toggle_and_time 1 v "Count" 
	  ~color:s_count_color_col model model' s_count_col s_check_count_col s_count_lm_s_col; 
	mk_view_aux_with_toggle_and_time 2 v "Time" 
	  ~color:s_time_color_col model model' s_time_col s_check_time_col s_time_lm_s_col; 
       mk_view_aux_with_toggle 3 v "Overall Time" ~color:s_time_color_col model model' s_percent_col s_check_percent_col
    |Tag -> 
       ignore(mk_view_aux 0 v "Name" t_name_col); 
	mk_view_aux_with_toggle_and_time 1 v "Count" 
	  ~color:t_count_color_col model model' t_count_col t_check_count_col t_count_lm_s_col; 
	mk_view_aux_with_toggle_and_time 2 v "Max Count" 
	  ~color:t_count_color_col model model' t_max_count_col t_check_max_count_col t_max_count_lm_s_col; 
	mk_view_aux_with_toggle_and_time 3 v "Size" 
	  ~color:t_size_color_col model model' t_size_col t_check_size_col t_size_lm_s_col;
	mk_view_aux_with_toggle_and_time 4 v "Max Size" 
	  ~color:t_size_color_col model model' t_max_size_col t_check_max_size_col t_max_size_lm_s_col;
	mk_view_aux_with_toggle 5 v "Overall Size" ~color:t_size_color_col model model' t_percent_col t_check_percent_col
    |Gc -> 
       mk_view_aux_with_toggle 0 v "Total Size" model model' gc_total gc_check_total; 
	mk_view_aux_with_toggle 1 v "Max Size" model model' gc_max gc_check_max; 
	mk_view_aux_with_toggle 2 v "Living Bytes" model model' gc_alive gc_check_alive; 
    |Value_int -> 
       ignore(mk_view_aux 0 v "Name" v_i_name_col); 
	mk_view_aux_with_toggle_and_time 1 v "Value" 
	  ~color:v_i_color_col model model' v_i_value_col v_i_check_value_col v_i_value_lm_s_col
    |Value_float -> 
       ignore(mk_view_aux 0 v "Name" v_f_name_col); 
	mk_view_aux_with_toggle_and_time 1 v "Value" 
	  ~color:v_f_color_col model model' v_f_value_col v_f_check_value_col v_f_value_lm_s_col
    |Value_bool -> 
       ignore(mk_view_aux 0 v "Name" v_b_name_col); 
	mk_view_aux_with_toggle_and_time 1 v "Value" 
	  ~color:v_b_color_col model model' v_b_value_col v_b_check_value_col v_b_value_lm_s_col
    |Value_string -> 
       ignore(mk_view_aux 0 v "Name" v_s_name_col); 
	mk_view_aux_with_toggle_and_time 1 v "Value" 
	  ~color:v_s_color_col model model' v_s_value_col v_s_check_value_col v_s_value_lm_s_col
    |Exported_graph _ -> ()
    |Hash -> 
        ignore(mk_view_aux 0 v "Name" h_name_col); 
	mk_view_aux_with_toggle 1 v "# Elements" 
	  model model' h_length_col h_length_check_col; 
	mk_view_aux_with_toggle 2 v "# Empty Buckets" 
	  model model' h_empty_b_col h_empty_b_check_col; 
	mk_view_aux_with_toggle 3 v "Array Size" 
	  model model' h_real_length_col h_real_length_check_col; 
	mk_view_aux_progress_with_toggle 4 v "Filling Rate" 
	  model model' h_percent_col h_percent_check_col; 
	mk_view_aux_with_toggle 5 v "Longest Bucket" 
	  model model' h_length_b_col h_length_b_check_col;
	mk_view_aux_with_toggle 6 v "Mean Bucket Length" 
	  model model' h_mean_col h_mean_check_col;
	ignore(mk_view_aux 7 v "Last Modified" h_lm_s_col)
    |_ -> assert false



let mk_view_value (box : GPack.box) value model s =
  let exp = GBin.expander ~expanded:true ~label:s ~packing:(box#pack ~expand:true) () in
  let hb = GPack.hbox ~packing:exp#add () in
  let m,m' = mk_model model value in
  mk_view m m' hb value


let mk_view_log (model:#GTree.model) (box:GPack.box) =
  let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
    ~vpolicy:`AUTOMATIC ~packing:box#add () in
  let v = GTree.view ~model ~packing:sw#add () in
  ignore(mk_view_aux 0 v ~color:l_color_col "Time" l_time_col);
  ignore(mk_view_aux 1 v "Log" l_log_col)


 (*
Local Variables: 
compile-command: "unset LANG; make -C .."
End: 
*)
