/src/visualiser/visualiser.ml
OCaml | 86 lines | 75 code | 10 blank | 1 comment | 11 complexity | b9cbd870e491db309a6749600d507b29 MD5 | raw file
1open Logger 2open Msg 3open Thread 4open Printf 5open Fvar 6 7class visualiser (e : Dom.element) t0 t1 m0 m1 = 8object (self) 9 val threads = Hashtbl.create 10 10 11 method w = float_of_int (e#_get_offsetWidth - 4) (* would be nice if this were froc-ed *) 12 13 method set_msg_loc msg msg_elt s t0 t1 = 14 let d = t1 -. t0 in 15 let w = self#w in 16 let ts = Msg.timestamp msg in 17 let l = ((ts -. s) *. w) /. d in 18 ignore (msg_elt#_get_style#_set_left (string_of_int (int_of_float l))) 19 20 method set_fun_loc f msg_elt fs fe ts t0 t1 = 21 let fs = if fs < 0. then m0#get else fs in 22 let fe = if fe < 0. then m1#get else fe in 23 let d = t1 -. t0 in 24 let w = self#w in 25 let l = ((fs -. ts) *. w) /. d in 26 let wi = ((fe -. fs) *. w) /. d in 27 ignore (msg_elt#_get_style#_set_left (string_of_int (int_of_float l))); 28 ignore (msg_elt#_get_style#_set_width (string_of_int (int_of_float wi))) 29 30 method set_thread_loc thread_elt ts tf t0 t1 = 31 let ts = if ts < 0. then m0#get else ts in 32 let tf = if tf < 0. then m1#get else tf in 33 let d = t1 -. t0 in 34 let w = self#w in 35 let l = ((ts -. t0) *. w) /. d in 36 let r = ((tf -. t0) *. w) /. d in 37 ignore (thread_elt#_get_style#_set_left (string_of_int (int_of_float l))); 38 ignore (thread_elt#_get_style#_set_width (string_of_int (int_of_float (r -. l)))) 39 40 method create_event_div (thread_elt : Dom.element) classname title = 41 let msg_elt = (Dom.document#createElement "div" : Dom.element) in 42 ignore (msg_elt#_set_className classname); 43 ignore (msg_elt#_set_title title); 44 ignore (thread_elt#appendChild msg_elt); 45 msg_elt 46 47 method render_msg (thread_elt : Dom.element) thread = function 48 | E_msg m -> 49 let div = self#create_event_div thread_elt "msg" (Msg.desc m) in 50 m#set_froc_loc (Froc.lift3 (self#set_msg_loc m div) thread#start#b t0 t1) 51 | E_fn f -> 52 let div = self#create_event_div thread_elt "fn" f#name in 53 f#set_froc_loc (Froc.lift5 (self#set_fun_loc f div) f#start#b f#finish#b thread#start#b t0 t1) 54 | Dummy -> () 55 56 method render_thread id thread = 57 let thread_elt = (Dom.document#createElement "div" : Dom.element) in 58 ignore (thread_elt#_set_className "thread"); 59 ignore (thread_elt#_get_style#_set_top (string_of_int (25 * thread#index))); 60 ignore (Froc.lift4 (self#set_thread_loc thread_elt) thread#start#b thread#finish#b t0 t1); 61 ignore (e#appendChild thread_elt); 62 thread_elt 63 64 method add_to_thread msg = 65 (*debug (sprintf "event of type %s" (Msg.ty msg));*) 66 let tid = Msg.threadId msg in 67 (if not (Hashtbl.mem threads tid) then 68 begin 69 let thread = new thread tid in 70 Hashtbl.add threads tid (thread); 71 let thread_elt = self#render_thread tid thread in 72 thread#msgs#lift (self#render_msg thread_elt thread) 73 end); 74 let thread = Hashtbl.find threads tid in 75 thread#parse_msg msg; 76 let ts = Msg.timestamp msg in 77 if ts >= 0. then 78 begin 79 if ts < m0#get or m0#get = (-1.) then m0#set ts; 80 if ts > m1#get or m1#get = (-1.) then m1#set ts; 81 end; 82end 83 84let init (elt : Dom.element) t0 t1 m0 m1 = 85 let v = new visualiser elt t0 t1 m0 m1 in 86 v