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

type kind = Undefined | Int | Float | Byte | Percentage

type style = Full | Dashed | Empty

type elt = {
  name:string option;
  tag:int;
  fct:unit-> float*style;
  mutable y_prec:float;
  mutable r:float;
  mutable g:float;
  mutable b:float;
  mutable visible:bool;
  mutable graph:float array;
  mutable drawing:style array;
}

type t = {
  mutable data : elt list;
  mutable draw : bool;
  mutable area : GMisc.drawing_area;
  mutable idx : int; (* 0..steps-1 *)
  mutable max : float;
  mutable max_changed : int;
  mutable min : float;
  mutable min_changed : int;
  mutable steps: int;
  mutable grid_divx: int;
  mutable grid_divy: int;
  mutable lborder: float;
  mutable rborder: float;
  mutable vborder: float;
  mutable xaxis: int;
  mutable yaxis: int;
  mutable timer : GMain.Timeout.id option;
  mutable time : float;
  mutable period : int;
  mutable kind : kind
}


let update_max t = 
  let max = ref (-.max_float) in
  let index = ref 0 in
  List.iter 
    (fun e -> 
       for i = 0 to t.idx-1 do
	 if e.graph.(i) > !max then 
	   let _ = index := i in
	   max := e.graph.(i) +. 1.;
       done;
       for i = t.idx to t.steps-1 do
	 if e.graph.(i) > !max then 
	   let _ = index := i in
	   max := e.graph.(i) +. 1.;
	 done;
    ) t.data;
  let temp a b =
    if a > b then a-b
    else t.steps - b + a
  in
  let _ = t.max <- if !max>0. then !max*.1.5 else !max*.0.5 in t.max_changed <- (temp !index t.idx)
  

let update_min t = 
  let min = ref max_float in
  let index = ref 0 in
  List.iter 
    (fun e -> 
       for i = 0 to t.idx-1 do
	 if e.graph.(i) < !min then
	   let _ = index := i in
	   min := e.graph.(i) -. 1.;
       done;
       for i = t.idx to t.steps-1 do
	 if e.graph.(i) < !min then
	   let _ = index := i in
	   min := e.graph.(i) -. 1.;
       done;
    ) t.data;
  let temp a b = 
    if a > b then a-b 
    else t.steps - b + a 
  in
  let _ = t.min <- if !min>0. then !min*.0.5 else !min*.1.5 in t.min_changed <- (temp !index t.idx)
  


(********* adds a function f to the graph t *********)

let add t tag ?name f typ (cr,cg,cb) =
  let elt = { 
    name = name; 
    tag = tag;
    fct = f; 
    r = cr;
    g = cg;
    b = cb;
    y_prec = 0.;
    visible = true;
    graph = Array.make t.steps 0.;
    drawing = Array.make t.steps Empty;
  }
  in
  if t.kind = Undefined
  then t.kind <- typ;
  t.data <- elt :: t.data;
  update_min t;
  update_max t;
  elt


(********* remove the element e from the graph t *********)

let remove t e = 
  t.data <- List.filter 
    (fun a ->not( a.name = e.name && a.r = e.r && a.g = e.g && a.b == e.b) ) t.data;
  update_max t;
  update_min t;
  if (t.data = [])
  then t.kind <- Undefined


let set_color e (r,g,b) =
  e.r <- r;
  e.g <- g;
  e.b <- b

let get_color e = 
  (e.r,e.g,e.b)

let get_nb_fct t = List.length t.data

let get_kind t = t.kind

let string_of_byte b = 
  let temp b x =
    let s = Int64.to_string b in
    let l = String.length s in
    let s1 = String.sub s 0 (l-x) in
    let s2 = String.sub s (l-x) 3 in
    Format.sprintf "%s.%s" s1 s2
  in
  if b > (Int64.of_int 1000000000) then
    Format.sprintf "%s GB" (temp b 9)
  else if b > (Int64.of_int 1000000) then
    Format.sprintf "%s MB" (temp b 6)
  else if b > (Int64.of_int 1000) then
    Format.sprintf "%s KB" (temp b 3)
  else let s = Int64.to_string b in Format.sprintf "%s B" s


(********* handles the y-axis legend depending on graph type *)

let ylegend_function i t =
  match t.kind with
    | Undefined -> ""
    | Int -> 
	let f = t.max -. float i *. (t.max -. t.min) /. float t.grid_divy in
	string_of_float f
    | Float -> 	let f = t.max -. float i *. (t.max -. t.min) /. float t.grid_divy in
	string_of_float f
    | Percentage -> let f = t.max -. float i *. (t.max -. t.min) /. float t.grid_divy in
      let s = (string_of_float f) in
      begin
      try 
	Format.sprintf "%s %%" (String.sub s 0 5)
      with Invalid_argument a ->  
	try
	  Format.sprintf "%s %%" (String.sub s 0 4)
	with Invalid_argument a -> Format.sprintf "%s %%" (String.sub s 0 3)
      end
    | Byte -> 
 	let f = t.max -. float i *. (t.max -. t.min) /. float t.grid_divy in
	string_of_byte (Int64.of_float f)
	


(********** draws the 2 axis, the grid, the legends ************)

let draw_background cr t width height =
  Cairo.rectangle cr ~x:t.lborder ~y:t.vborder ~width:(float width -. t.lborder -. t.rborder) ~height:(float height -. 2.*.t.vborder);
  Cairo.set_source_rgb cr 1.0 1.0 1.0;
  Cairo.fill cr;
  Cairo.set_source_rgb cr 0.0 0.0 0.0;
  Cairo.set_line_width cr 0.2;
  Cairo.set_dash cr [|2.|] 1.5;
  
  for i = 0 to t.grid_divx do
    
    let x = t.lborder +. float i *. (float width -. t.lborder -. t.rborder) /. float t.grid_divx in
    Cairo.move_to cr x t.vborder ;
    Cairo.line_to cr x (float_of_int height -. t.vborder);
    
    (* x-axis legend *)
    if (i mod t.xaxis = 0) then
      begin
	let interval = int_of_float (float (t.steps*t.period) /. 1000.) / t.grid_divx in
	Cairo.move_to cr (x -. 5.) (float height-. t.vborder +. 10.);
	let s' = (t.grid_divx -i)* interval in 
	Cairo.show_text cr (string_of_int s')
      end;
    
  done;
  
  for i = 0 to t.grid_divy do
    
    let y = t.vborder +. float i *. (float height -. 2.*.t.vborder) /. float t.grid_divy in
    Cairo.move_to cr t.lborder y ;
    Cairo.line_to cr (float_of_int width -. t.rborder) y;

    (* y-axis legend *)
    if ((* i <> t.grid_divy && *) i mod t.yaxis = 0) then
      begin
	Cairo.move_to cr (float width -. t.rborder +. 5.) (y+.5.);
	let s = ylegend_function i t in
	Cairo.show_text cr s;
      end;
    
  done;
  Cairo.stroke cr
  

(************ draws a function above the background **************)

let redraw_fct t e cr width height =
  if e.visible then 
    begin
      let idx = t.idx in
      let gr = e.graph in
      let dr = e.drawing in
      let absc = (float height -. t.vborder) in
      let dx = (float width -. t.rborder -. t.lborder) /. (float t.steps) in
      let x = ref (float width -. t.rborder) in
      let max = t.max in
      let min = t.min in
      let h = float height -. (2. *. t.vborder) in
      set_dash cr [||] 0.;
      set_source_rgb cr e.r e.g e.b;
      set_line_width cr 1.;
      e.y_prec <- absc-.((h *. (gr.(idx) -.min))/. (max-.min));
      move_to cr !x e.y_prec;
      
      for i=idx to t.steps-1 do
	let ord = e.y_prec in
	let next_i = (i+1) mod t.steps in
	e.y_prec <- absc-.((h *. (gr.(next_i) -.min))/.(max-.min));
	begin match dr.(i) with
	  |Full -> line_to cr ~x:(!x-.dx) ~y:ord
	  |Dashed ->       
	     begin
	       Cairo.set_dash cr [|3.;2.|] 2.;
	       move_to cr !x e.y_prec;
	     end
	  |Empty ->
	     move_to cr !x e.y_prec
	end;
	x := (!x -.dx);
      done;
      
      for i=0 to idx-1 do
	let ord = absc-.((h *. (gr.(i)-.min))/.(max-.min)) in
	let next_i = (i+1) mod t.steps in
	e.y_prec <- absc-.((h *. (gr.(next_i) -.min))/.(max-.min));
	begin match dr.(i) with
	  |Full -> line_to cr ~x:(!x-.dx) ~y:ord
	  |Dashed ->       
	     begin
	       Cairo.set_dash cr [|3.;2.|] 2.;
	       move_to cr !x e.y_prec;
	     end
	  |Empty ->
	     move_to cr !x e.y_prec
	end;
	x := (!x -.dx);
      done;
      stroke cr
    end


(************** updates the graph by getting a new value for every function **********)

let update_values t =
  t.time <- Db.get_current_time ();
  let idx = t.idx - 1 in
  let idx = if idx < 0 then t.steps-1 else idx in
  t.idx <- idx;
  List.iter 
    (fun e -> 
       let x,st = e.fct () in
       if x > t.max then 
	 begin
	   t.max <- max 
	     (if x>0. then (1.5 *. x) else (0.5 *. x)) 
	     (if t.max>0. then (1.5 *. t.max) else (0.5 *. t.max));
	   t.max_changed <- 0; 
	 end ;
       if x < t.min then 
	 begin
	   t.min <- min 
	     (if x<0. then (1.5 *. x) else (0.5 *. x)) 
	     (if t.min<0. then (1.5 *. t.min) else (0.5 *. t.min));
	   t.min_changed <- 0; 
	 end ;
       e.drawing.(idx) <- st;
       e.graph.(idx) <- x) 
    t.data;
  let _ =
    if t.max_changed = t.steps then 
      update_max t
    else t.max_changed <- t.max_changed +1
  in
  if t.min_changed = t.steps then 
    update_min t
  else t.min_changed <- t.min_changed +1
  

(************ draws the background and the function on the drawing area ***********)

let redraw t =
  try
    let cr = Cairo_lablgtk.create (t.area)#misc#window in
    let allocation = (t.area)#misc#allocation in
    let width = allocation.Gtk.width in
    let height = allocation.Gtk.height in
    draw_background cr t width height;
    List.iter (fun elt -> redraw_fct t elt cr width height) t.data;
  with e ->
    Format.eprintf " *** exn in redraw: %s@." (Printexc.to_string e)


let expose t ev =
  t.draw <- true;
  redraw t ;
  true


let refresh t () =
  update_values t;
  GtkBase.Widget.queue_draw (t.area)#as_widget;
  true

let stop t = 
  match t.timer with
    | None -> ()
    | Some timer -> GMain.Timeout.remove timer; t.timer <- None


let reset t = 
  t.idx <- 0;
  t.max <- 0.;
  t.max_changed <- 0;
  t.min <- 0.;
  t.min_changed <- 0

let clear t = 
  List.iter (fun e -> 
	       for i=0 to t.steps-1 do
		 e.graph.(i) <- 0.;
		 e.drawing.(i) <- Empty;
	       done;
	    ) t.data;
  reset t


let get_timer t = t.timer

let get_period t = t.period

let get_steps t = t.steps

let get_gridx t = t.grid_divx

let get_gridy t = t.grid_divy

let get_xaxis t = t.xaxis

let get_yaxis t = t.yaxis


(********** creates an array of size stp from the old array elt.graph of size ostp ************)

let new_array t elt stp ostp = 
  let a = Array.make stp 0. in
  let a' = Array.make stp Empty in
  let idx = t.idx in
  let _ =
    if stp >= ostp then (* new array is bigger *)
      begin
	Array.blit elt.graph idx a 0 (ostp-idx);
	Array.blit elt.drawing idx a' 0 (ostp-idx);
	Array.blit elt.graph 0 a (ostp-1-idx) idx;
	Array.blit elt.drawing 0 a' (ostp-1-idx) idx;
      end
    else
      begin
	let diff = ostp - 1 - idx in
	let bool = diff <= stp in
	let borne = if bool then ostp-1 else idx+stp-1 in
	Array.blit elt.graph idx a 0 (borne-idx);
	Array.blit elt.drawing idx a' 0 (borne-idx);
	if bool then 
	  let diff = stp - 1 - (ostp - 1 - idx) in
	  let borne = if idx > diff then diff-1 else idx in
	  Array.blit elt.graph 0 a (stp-diff) (borne+1);
	  Array.blit elt.drawing 0 a' (stp-diff) (borne+1);
      end
  in
  elt.drawing <- a';
  elt.graph <- a
  


let new_period t p elt =  
  let a = Array.make t.steps 0. in
  let a' = Array.make t.steps Empty in
  let idx = t.idx in
  let oindex = ref idx in
  let op = t.period in
  let tp = ref 0 in
  let otp = ref 0 in
  let ograph = ref 0. in
  let odrawing = ref Empty in
  let b = ref true in
  
  let rec fct i = 
    
    let incrindex () = 
      incr oindex;
      if !oindex = t.steps
      then oindex := 0;
      if !oindex = idx 
      then b := false;
      
    in
    
    let maj_old () =
      ograph := elt.graph.(!oindex);
      odrawing := elt.drawing.(!oindex);
      otp := !otp + op;
    in
    
    let affect () = 
      a.(i) <- !ograph;
      a'.(i) <- !odrawing;
      tp := !tp + p;
    in

    if !b then
      if otp = tp
      then
	begin
	  maj_old ();
	  affect ();
	  incrindex ();
	end
      else 
	if otp > tp
	then
	  begin
	    affect ();
	  end
	else
	  begin
	    maj_old ();
	    incrindex ();
	    fct i
	  end;
    
  in
  
  for i=0 to t.steps-1 do
    fct i
  done;
  
  elt.drawing <- a';
  elt.graph <- a



(* let float_of_value = function *)
(*     Protocol.Int i -> float_of_int i *)
(*   | Protocol.Float f -> f *)
(*   | Protocol.Int64 i -> Int64.to_float i *)
(*   | _ -> assert false *)



(* let go_tp_elt gr t elt = *)
(*   Format.eprintf "t:%f@." t; *)
(*   let a = Array.make gr.steps 0. in *)
(*   let a' = Array.make gr.steps Empty in *)
(*   (\* let tm = *\) *)
(* (\*     match elt.ttag with *\) *)
(* (\*       | Simple -> Db.get_tmap_tag elt.tag *\) *)
(* (\*       | Max_count -> Db.get_tmap_tag_max_count elt.tag *\) *)
(* (\*       | Max_size -> Db.get_tmap_tag_max_size elt.tag *\) *)
(* (\*       | GC_max -> Db.get_tmap_tag_GC_max () *\) *)
(* (\*   in *\) *)
(*   let oindex = ref gr.idx in *)
(*   let tp = ref t in *)
(*   let b = ref true in *)
(*   let period = float gr.period *. 0.001 in *)
(*   let tmin = gr.time-. (float gr.steps *. period) in *)
  
(*   let incrindex () = *)
(*     incr oindex; *)
(*     if !oindex = gr.steps *)
(*     then oindex := 0; *)
(*     if !oindex = gr.idx *)
(*     then b := false; *)
(*   in *)

(*   let rec fct i = match i with *)
(*     |0 -> () *)
(*     |_ -> incrindex ();fct (i-1) *)
(*   in *)

(*   Format.eprintf "\n\ntime:%f tmin:%f idx:%d@." gr.time tmin gr.idx; *)

(*   if !tp > gr.time *)
(*   then *)
(*     begin *)
(*       for i=0 to gr.steps-1 do *)
	
(* 	if !tp >= 0. *)
(* 	then *)
(* 	  begin *)
(* 	    if !tp > gr.time *)
(* 	    then *)
(* 	      begin *)
(* 		(\* let _,v = Timemap.find tm !tp in *\) *)
(* (\* 		a.(i) <- float_of_value v; *\) *)
(* (\* 		a'.(i) <- Full *\) *)
(* 	      end *)
(* 	    else *)
(* 	      begin *)
(* 		a.(i) <- elt.graph.(!oindex); *)
(* 		a'.(i) <- elt.drawing.(!oindex); *)
(* 		incrindex () *)
(* 	      end; *)
(* 	  end; *)
(* 	tp := !tp -. period; *)
(*       done *)
(*     end *)
(*   else *)
(*     begin *)
(*       fct (int_of_float ((gr.time -. !tp) /. period)); *)
(*       for i=0 to gr.steps-1 do *)
(* 	if !tp >= 0. *)
(* 	then *)
(* 	  begin *)
(* 	    Format.eprintf "tp:%f @." !tp; *)
(* 	    if !tp > tmin *)
(* 	    then *)
(* 	      begin *)
(* 		Format.eprintf "oindex:%d i:%d@." !oindex i; *)
(* 		a.(i) <- elt.graph.(!oindex); *)
(* 		a'.(i) <- elt.drawing.(!oindex); *)
(* 		incrindex () *)
(* 	      end *)
(* 	    else *)
(* 	      begin *)
(* 		(\* let _,v = Timemap.find tm !tp in *\) *)
(* (\* 		a.(i) <- float_of_value v; *\) *)
(* (\* 		a'.(i) <- Full *\) *)
(* 	      end; *)
(* 	  end; *)
(* 	tp := !tp -. period; *)
(*       done; *)
(*     end; *)

(*   elt.drawing <- a'; *)
(*   elt.graph <- a(\* ; *\) *)
  
  

(* let go_tp gr t = *)
(*   List.iter (go_tp_elt gr t) gr.data; *)
(*   gr.idx <- 0 *)

let set_preferences t ~step ~divx ~divy ~xaxis ~yaxis =
  let old_steps = t.steps in
  if(old_steps != step) then
    begin
      List.iter (fun elt -> new_array t elt step old_steps) t.data;
      t.steps <- step;
      t.idx <- 0
    end;
  t.grid_divx <- divx;
  t.grid_divy <- divy;
  t.xaxis <- xaxis;
  t.yaxis <- yaxis


let set_timer t i =
  match t.timer with
    | None -> 
       	t.timer <- Some (GMain.Timeout.add ~ms:i ~callback:(refresh t))
    | Some timer -> 
	GMain.Timeout.remove timer;  
       	t.timer <- Some (GMain.Timeout.add ~ms:i ~callback:(refresh t))
          

let restart t p = 
  if p <> t.period then
    begin
      List.iter (new_period t p) t.data;
      t.idx <- 0;
      t.period <- p;
    end;
  clear t;
  set_timer t p

let resume t =
  set_timer  t t.period


let set_visible e b = 
  e.visible <- b


let create ?(width=350) ?(height=200) ?(timeout=100) ?(steps=500) ?(grid_divx=5) ?(grid_divy=5) ?(lborder=10.) 
    ?(rborder=70.) ?(vborder=20.) ?(xaxis=1) ?(yaxis=1) ?packing ?(kind=Undefined) () = 
  let area = 
    GMisc.drawing_area ~width ~height ?packing ()
  in
  let t = { draw = false;data = [];area=area;idx = 0;
	    max = min_float ; max_changed=0;
	    min = max_float ; min_changed=0;
	    steps=steps ; grid_divx=grid_divx; grid_divy=grid_divy;
	    lborder=lborder ; rborder=rborder ; vborder=vborder;
	    xaxis=xaxis; yaxis=yaxis ; timer=None ;
	    time = 0.; period=timeout ; kind=kind} in
  ignore (area#event#connect#expose (expose t));
  let timer = GMain.Timeout.add ~ms:timeout ~callback:(refresh t) in
  t.timer <- Some timer;
  t


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