(**************************************************************************)
(*                                                                        *)
(*  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


type t = {
  mutable tree:Protocol.variant;
  mutable oldtree:Protocol.variant;
  area:GMisc.drawing_area;
  mutable pixbuf:GdkPixbuf.pixbuf;
  mutable pixmap:Gdk.pixmap;
  cols:GTree.column_list;
  col:string GTree.column;
  model:GTree.tree_store;
  mutable width:float;
  mutable height:float;
  mutable scale:float;
}


let mk_model (model: GTree.tree_store) col row (Node (s,l)) = 
  let rec fct row = function
    |Node (s,l) ->
       let row' = model#append ~parent:row () in
       model#set ~row:row' ~column:col s;
       List.iter (fun el -> fct row' el) l
  in 
  model#set ~row:row ~column:col s;
  List.iter (fun el -> fct row el) l
         

let create_image colored tree = 
  let dot = Filename.temp_file "ocamlviz" ".dot" in
  Dot.write_to ~colored dot tree;
  let png = Filename.temp_file "ocamlviz" ".png" in
  let exit_code = Sys.command (Format.sprintf "dot -Tpng %s -o %s" dot png) in
  if exit_code <> 0
  then png,false
  else 
    begin
      Sys.remove dot;
      png,true
    end
  
    
let redraw t_p colored = 
  let png,b = create_image colored t_p.oldtree in
  if b then 
    begin
      let pixbuf = GdkPixbuf.from_file png in
      let width = GdkPixbuf.get_width pixbuf in
      let height = GdkPixbuf.get_height pixbuf in
      t_p.width <- float width;
      t_p.height <- float height;
      
      let pixbuf = GdkPixbuf.from_file_at_size 
        ~width:(int_of_float (t_p.width*.t_p.scale)) 
        ~height:(int_of_float(t_p.height*.t_p.scale)) png in
      t_p.pixbuf <- pixbuf;
      let width = GdkPixbuf.get_width pixbuf in
      let height = GdkPixbuf.get_height pixbuf in
      t_p.area#set_size ~width ~height;
      let dw = new GDraw.drawable t_p.area#misc#window in
      let pixmap,_ = GdkPixbuf.create_pixmap pixbuf in
      t_p.pixmap <- pixmap;
      dw#put_pixmap ~x:0 ~y:0 pixmap
    end

let refresh t_p =
  t_p.model#clear ();
  mk_model t_p.model t_p.col (t_p.model#append ()) t_p.tree;
  t_p.oldtree <- t_p.tree;
  redraw t_p []


let path v a =
  let rec path_aux i = function
      Node (s,l) -> 
	if i < (Array.length a) - 1
	then path_aux (i+1) (List.nth l a.(i))
	else List.nth l a.(i)
  in
  if Array.length a = 1 
  then v
  else path_aux 1 v
  

let color_tree t_p view = 
  let s_rows = view#selection#get_selected_rows in
  let node_list = ref [] in
  List.iter (fun p -> 
	       let a = GTree.Path.get_indices p in
	       let node = path t_p.oldtree a in
	       node_list := node :: !node_list
	    ) s_rows;
  redraw t_p !node_list


let zoom t_p view scale = 
  t_p.scale <- (scale*.0.01);
  color_tree t_p view

let mk_view t_p (sw: GBin.scrolled_window) name = 
  let tree_view = GTree.view ~model:t_p.model ~packing:sw#add () in
  tree_view#set_rules_hint true;
  let col_view = GTree.view_column ~title:name ()
      ~renderer:(GTree.cell_renderer_text[], ["text",t_p.col]) in
  tree_view#selection#set_mode `MULTIPLE;
  ignore(tree_view#selection#connect#changed ~callback:(fun () -> color_tree t_p tree_view));
  ignore(tree_view#append_column col_view);
  tree_view
  

let create ?packing name tree =
  let vbox = GPack.vbox ?packing () in
  vbox#set_spacing 15;
  let table = GPack.table ~columns:4 ~rows:1 ~packing:(vbox#pack ~expand:false) () in
  table#set_col_spacings 5;
  
  let butt = GButton.button ~label:" Refresh" ~packing:(table#attach ~left:0 ~top:0) () in
  let im = GMisc.image ~stock:`REFRESH ~icon_size:`MENU () in
  butt#set_image im#coerce;

  let butt_exp = GButton.button ~label:" Expand" ~packing:(table#attach ~left:1 ~top:0) () in
  let im_exp = GMisc.image ~stock:`SORT_DESCENDING ~icon_size:`MENU () in
  butt_exp#set_image im_exp#coerce;

  let _ = GMisc.image ~stock:`ZOOM_FIT ~packing:(table#attach ~left:2 ~top:0) () in

  let spin =  GEdit.spin_button ~update_policy:`IF_VALID
    ~digits:0 ~packing:(table#attach ~top:0 ~left:3 ~expand:`NONE) () in
  spin#adjustment#set_bounds ~lower:5. ~upper:100. ~step_incr:5. ~page_incr:20. ();
  spin#adjustment#set_value 100.;
  
  let paned = GPack.paned `HORIZONTAL ~packing:vbox#add () in

  let cols = new GTree.column_list in
  let col = cols#add Gobject.Data.string in
  let model = GTree.tree_store cols in
  mk_model model col (model#append ()) tree;

  
  let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
    ~vpolicy:`AUTOMATIC ~packing:paned#add () in
  
  let png,b = create_image [] tree in
  
  let sw2 = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
    ~vpolicy:`AUTOMATIC ~packing:paned#add () in
  let frame2 = GBin.frame ~shadow_type:`ETCHED_IN ~packing:sw2#add_with_viewport () in
  
  let pixbuf = 
    if b then GdkPixbuf.from_file png 
    else GdkPixbuf.from_file "/usr/share/icons/gnome/scalable/status/gtk-missing-image.svg"
  in
  let width = GdkPixbuf.get_width pixbuf in
  let height = GdkPixbuf.get_height pixbuf in
  
  let area = 
    GMisc.drawing_area ~width ~height ~packing:frame2#add ()
  in
  area#misc#modify_bg [(`NORMAL,`WHITE)];
  let dw = new GDraw.drawable area#misc#window in
  let pixmap,_ = GdkPixbuf.create_pixmap pixbuf in
  dw#put_pixmap ~x:0 ~y:0 pixmap;
  let t_p = {tree = tree ; oldtree = tree ; area = area ; pixbuf = pixbuf ; pixmap = pixmap ;
	     cols = cols ; col = col ; model = model;width=float width ;height=float height; scale = 1.} in
  let tree_view = mk_view t_p sw name in
  ignore(butt#connect#clicked ~callback:(fun () -> refresh t_p));
  ignore(butt_exp#connect#clicked ~callback:(fun () -> tree_view#expand_all ()));
  ignore (t_p.area#event#connect#expose
	    ~callback:(fun _ -> 
			 let dw = new GDraw.drawable t_p.area#misc#window in
			 dw#put_pixmap ~x:0 ~y:0 t_p.pixmap; true));
  ignore ( spin#connect#value_changed (fun () -> zoom t_p tree_view (spin#adjustment#value)));
  t_p




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