X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fhtml.ml;h=d59265813564e1f259b7aeb14c183ac8d82a4ab1;hp=c7990b32c74f40824348b78c5fb8076f42ec18d3;hb=20ef25a27a326b250ae7f32997fa6d249a6b1751;hpb=a601c67e92d85f7096db693e4fde86950be598c6 diff --git a/src/html.ml b/src/html.ml index c7990b3..d592658 100644 --- a/src/html.ml +++ b/src/html.ml @@ -31,10 +31,11 @@ let finalize_node n r b = Hashtbl.replace final n (b,r) -let gen_trace (type s) = (); fun t tree -> +let gen_trace (type s) = fun auto t tree -> let module T = (val (t) : Tree.S with type t = s) in - let rec loop odot ohtml node parent = - if node == T.nil then () else begin + let root = T.root tree in + let rec loop osvg ohtml node parent x y = + if node != T.nil then begin let m = try Hashtbl.find info (T.preorder tree node) @@ -44,56 +45,65 @@ let gen_trace (type s) = (); fun t tree -> let marked, last_round = try Hashtbl.find final node_id with Not_found -> Printf.eprintf ">>> %i\n%!" node_id; false, !max_round; in + let pc = if !max_round == 0 then 1. else float_of_int last_round /. float_of_int !max_round in + let color = int_of_float (255. *. (1. -. pc)) in + let tag = QName.to_string (T.tag tree node) in + let lbox = (String.length tag + 2) * 10 in let s_node = "node" ^ (string_of_int node_id) in - fprintf odot "%s[ id=\"%s\" label=\"%s\" style=filled fillcolor=\"%f,1.0,1.0\"\ -shape=\"%s\" ];\n" - s_node - s_node - (QName.to_string (T.tag tree node)) - (1.0 -. (float (last_round+1) /. float (!max_round+1))) - (if marked then "oval" else "box") ; + fprintf osvg "\n%!" + s_node s_node x y lbox color color (if marked then "" else ";stroke-dasharray:2,2"); + fprintf osvg "%s\n" (x+10) (y+15) s_node tag; fprintf ohtml "data['%s'] = new Array();\n" s_node; M.iter (fun i s -> fprintf ohtml "data['%s'][%i] = '%s';\n" s_node i s) m; - if parent != T.nil then - fprintf odot "node%i -> %s;\n" - (T.preorder tree parent) s_node; - loop odot ohtml (T.first_child tree node) node; - loop odot ohtml (T.next_sibling tree node) parent + let first = T.first_child tree node in + let maxw1, maxy1 = loop osvg ohtml first node x (y + 40) in + let next = T.next_sibling tree node in + let x_next = max (x+lbox) (maxw1+10) in + if node != root then begin + if node == T.first_child tree parent then + fprintf osvg "\n" + (x + lbox / 2) (y-20) (x + lbox / 2) (y); + if next != T.nil then + fprintf osvg "\n" + (x + lbox) (y+10) x_next (y+10); + end; + let maxw2, maxy2 = loop osvg ohtml next node x_next y in + maxw2, max maxy1 maxy2 end + else x, y in ignore (Sys.command "mkdir -p tests/trace"); - let odot_ = open_out "tests/trace/trace.dot" in + let osvg_ = open_out "tests/trace/trace.svg" in let ohtml_ = open_out "tests/trace/trace.html" in - let odot = formatter_of_out_channel odot_ in + let osvg = formatter_of_out_channel osvg_ in let ohtml = formatter_of_out_channel ohtml_ in - fprintf odot "digraph G {\n node[shape=box, style=filled, fillcolor=white];splines=false;"; fprintf ohtml "\ \ \ \ \ +

%a +

\ -\n

\n"; - let fi = open_in "tests/trace/trace2.svg" in + fprintf ohtml "\n

\n%!"; + fprintf ohtml "\n

\n%!"; pp_print_flush ohtml (); close_out ohtml_; close_in fi +