- let last_round = try fst (M.max_binding m) with Not_found -> 0 in
- let s_node = "node" ^ (string_of_int (T.preorder tree node)) in
- fprintf odot "%s[ id=\"%s\" label=\"%s\" style=filled fillcolor=\"%f,1.0,1.0\"];\n"
- s_node s_node (QName.to_string (T.tag tree node))
- (0.2 *. (1.0 -. (float last_round /. float !max_round))) ;
- 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
+ CTable.add ctable x s;
+ s
+
+let text_color x =
+ let r,g,b = rgb x in
+ let av = (r + g + b) / 3 in
+ if av > 128 then "rgb(0,0,0)"
+ else "rgb(255,255,255)"
+
+let get_conf sel l i =
+ List.fold_left (fun (accb,accl) a ->
+ accb || StateSet.intersect a.(i) sel,
+ a.(i) :: accl) (false,[]) l
+
+let gen_trace (type s) = fun auto sat_arrays t tree ->
+ let module T = (val (t) : Tree.S with type t = s) in
+ let root = T.root tree in
+ let sel = Ata.get_selecting_states auto in
+ let rec loop output node parent x y =
+ if node != T.nil then begin
+ let node_id = T.preorder tree node in
+ let marked, conf = get_conf sel sat_arrays node_id in
+ let scolor, tcolor = color conf, text_color conf 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 output
+ "<rect id=\"%s\" onclick=\"activate(\'%s\');\" x=\"%i\" y=\"%i\"\
+ width=\"%i\" height=\"20\" style=\"fill:%s;stroke:rgb(0,0,0)%s\"/>\n%!"
+ s_node
+ s_node
+ x y
+ lbox
+ scolor
+ (if marked
+ then ";stroke-width:4"
+ else ";stroke-width:2;stroke-dasharray:2,2");
+ fprintf output "<text x=\"%i\" y=\"%i\" style=\"fill:%s;font-size:17;\
+font-family:typewriter;\" onclick=\"activate(\'%s\');\" >%s</text>\n"
+ (x+10)
+ (y+15)
+ tcolor s_node tag;
+ let first = T.first_child tree node in
+ let maxw1, maxy1 = loop output 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 output "<line x1=\"%i\" y1=\"%i\" x2=\"%i\" y2=\"%i\"\
+style=\"stroke:rgb(0,0,0);stroke-width:2\"/>\n"
+ (x + lbox / 2) (y-20) (x + lbox / 2) (y);
+ if next != T.nil then
+ fprintf output "<line x1=\"%i\" y1=\"%i\" x2=\"%i\" y2=\"%i\"\
+style=\"stroke:rgb(0,0,0);stroke-width:2\"/>\n"
+ (x + lbox) (y+10) x_next (y+10);
+ end;
+ let maxw2, maxy2 = loop output next node x_next y in
+ maxw2, max maxy1 maxy2