From c6a89f390d6171f99d98f794427c1cce42fbf40c Mon Sep 17 00:00:00 2001
From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= <kn@lri.fr>
Date: Sun, 8 Dec 2013 10:55:54 +0100
Subject: [PATCH] Refactor HTML Tracing to not depend on external files (style,
 javascript). Add a general facility to turn a file into an OCaml string. The
 content of file.ml.str is turned into let content = "..." in  a file file.ml.

---
 .gitignore              |   2 +
 Remakefile.in           |  13 ++-
 src/html.ml             | 201 ----------------------------------------
 src/html.mli            |   1 -
 src/html_trace.ml       | 114 ++++++++++-------------
 src/run.ml              |   2 +-
 src/trace_css.ml.str    |  46 +++++++++
 src/trace_js.ml.str     |  55 +++++++++++
 tools/ocamlmoduledep.sh |   2 +-
 9 files changed, 164 insertions(+), 272 deletions(-)
 delete mode 100644 src/html.ml
 delete mode 100644 src/html.mli
 create mode 100644 src/trace_css.ml.str
 create mode 100644 src/trace_js.ml.str

diff --git a/.gitignore b/.gitignore
index 5bd3841..6902bbf 100644
--- a/.gitignore
+++ b/.gitignore
@@ -19,6 +19,8 @@ remake
 .remake
 src/xpath/xpath_internal_parser.ml
 src/xpath/xpath_internal_parser.mli
+src/trace_css.ml
+src/trace_js.ml
 tests/xmark*.xml
 tests/xmark*.xml.queries
 
diff --git a/Remakefile.in b/Remakefile.in
index a4fe1c9..1ff0b30 100644
--- a/Remakefile.in
+++ b/Remakefile.in
@@ -37,7 +37,7 @@ clean:
 	for dir in src tools; do
 		find $dir -name '*.cm*' -o -name '*.o' -o -name '*.byte' -o \
 			  -name '*.native' -o -name '*.mll' -o -name '*.mly' -o \
-			  -name '*.class' -o -name '*.depo' -o -name '*.depx' | while read file; do
+			  -name '*.class' -o -name '*.depo' -o -name '*.depx' -o -name '*.ml.str' | while read file; do
 		case "$file" in
 			*.mll)
 				rm -f "${file%.mll}.ml"
@@ -45,8 +45,11 @@ clean:
 			*.mly)
 				rm -f "${file%.mly}.ml" "${file%.mly}.mli"
 			;;
+			*.ml.str)
+				rm -f "${file%.ml.str}.ml"
+			;;
 			*)
-			rm -f "$file"
+				rm -f "$file"
 			;;
 		esac
 		done
@@ -78,6 +81,12 @@ distclean: clean test_clean
 	elif test -f $*.mll; then
 		$(REMAKE) $*.mll
 		$(OCAMLLEX) $*.mll
+	elif test -f $*.ml.str; then
+		$(REMAKE) $*.ml.str
+		echo -n 'let content = "' > $*.ml
+		sed -e 's/\(["\\]\)/\\\1/g' $*.ml.str | sed -e 's/^\(.*\)$/\1\\n\\/g' >> $*.ml
+                echo '' >> $*.ml
+                echo '"' >> $*.ml
 	fi
 
 %.cmx %.depx:
diff --git a/src/html.ml b/src/html.ml
deleted file mode 100644
index f5aa8b2..0000000
--- a/src/html.ml
+++ /dev/null
@@ -1,201 +0,0 @@
-INCLUDE "utils.ml"
-
-open Format
-module M = Map.Make(struct type t = int let compare = compare end)
-
-type info = { sat : StateSet.t;
-              todo : StateSet.t;
-              msg : string;
-            }
-let info = Hashtbl.create 2017
-let final = Hashtbl.create 2017
-
-let max_round = ref 0
-
-
-let buff = Buffer.create 20
-let fmt = formatter_of_buffer buff
-
-
-let trace ?(msg="") nid r t d  =
-  if r > !max_round then max_round := r;
-  let m = try Hashtbl.find info nid with Not_found -> M.empty in
-  let () = pp_print_flush fmt () in
-  let _ = fprintf fmt
-    "node: %i<br/>%s<br/>todo: %a<br/>sat: %a<br/>_______________________<br/>"
-    nid msg  StateSet.print t StateSet.print d
-  in
-  let () = pp_print_flush fmt () in
-  let msg = Buffer.contents buff in
-  let () = Buffer.clear buff in
-  let old_inf = try M.find r m with Not_found -> [] in
-  let m' = M.add r ({ sat = d; todo = t; msg = msg }::old_inf) m in
-  Hashtbl.replace info nid m'
-
-let finalize_node n r b =
-  Hashtbl.replace final n (b,r)
-module K =
-struct
-  type t = StateSet.t list
-  let hash l =
-    List.fold_left (fun acc set ->
-      HASHINT2(acc, (set.StateSet.id :> int))) 17 l
-
-  let equal l1 l2 =
-    try
-      List.for_all2 (==) l1 l2
-    with _ -> false
-end
-
-module CTable = Hashtbl.Make (K)
-
-let ctable = CTable.create 20
-
-let rgb x =
-  let h = K.hash x in
-  let r = h land 0xff
-  and g = (h lsr 8) land 0xff
-  and b = (h lsr 16) land 0xff
-  in
-  r, g, b
-
-let color x =
-  try
-    CTable.find ctable x
-  with
-    Not_found ->
-      let r,g,b = rgb x in
-      let s = "rgb(" ^ (string_of_int r) ^ ","
-        ^ (string_of_int g) ^ ","
-        ^ (string_of_int b) ^ ")"
-      in
-      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
-    end
-    else x, y
-  in
-  ignore (Sys.command "mkdir -p tests/trace");
-  let ohtml_ = open_out "tests/trace/trace.html" in
-  let ohtml = formatter_of_out_channel ohtml_ in
-  fprintf ohtml "<html>\
-<head><title></title>
-<meta http-equiv='content-type' content='text/html;charset=utf-8'/>\
-<style>\
-div#data {\
-    position: absolute;\
-    top: 0%%;\
-    left: 50%%;\
-    width: 50%%;\
-    height: 50%%;\
-    overflow: auto;\
-}\
-div#svg {\
-    position: absolute;\
-    top: 50%%;\
-    left: 0%%;\
-    width: 100%%;\
-    height: 50%%;\
-    overflow: auto;\
-}\
-\
-div#automata {\
-    white-space: pre;\
-    overflow: auto;\
-    position: absolute;\
-    width: 50%%;\
-    top: 0%%;\
-    left: 0%%;\
-    height: 50%%;\
-}\
-</style>\
-</head>\
-<body>\
-<div id='automata' >%a
-</div>
-<div id='data' > </div>\n\
-<script type='text/javascript'>\n\
-var data = new Array();\n\
-var rounds = %i;\n"
-    Ata.print auto
-    (List.length sat_arrays);
-  List.iteri (fun i a ->
-    fprintf ohtml "data[%i] = new Array();\n" i;
-    Array.iteri (fun id set ->
-      fprintf ohtml "data[%i]['node%i'] = \"%a\";\n"
-      i id StateSet.print set) a) (List.rev sat_arrays);
-  fprintf ohtml "var activate = function (id) {\
-  var d = document.getElementById('data');
-  var msg = '';
-  for (i=0; i < rounds; i++)
-     msg += ('<p>round: ' + i + ':<br/>') + data[i][id] + '</p>\\n';
-  d.innerHTML = msg;
-  return;
-  };\n";
-  fprintf ohtml "</script>\n<div id='svg'><svg id='svgimg' width='' height='' xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\">\n";
-  let maxw, maxh = loop ohtml (T.root tree) T.nil 50 50 in
-  fprintf ohtml "</svg>\n<script type=\"text/javascript\">window.onload = function () {\
-  var svg = document.getElementById('svgimg');
-  svg.setAttribute('width', %i);
-  svg.setAttribute('height', %i);
-};\
-</script>\
-</div></body></html>\n%!"
-    maxw maxh;
-  pp_print_flush ohtml ();
-  close_out ohtml_
diff --git a/src/html.mli b/src/html.mli
deleted file mode 100644
index 5e8d4c2..0000000
--- a/src/html.mli
+++ /dev/null
@@ -1 +0,0 @@
-val gen_trace : Ata.t -> StateSet.t array list -> (module Tree.S with type t = 'a) -> 'a -> unit
diff --git a/src/html_trace.ml b/src/html_trace.ml
index f5aa8b2..58c1f68 100644
--- a/src/html_trace.ml
+++ b/src/html_trace.ml
@@ -87,7 +87,7 @@ 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 =
+  let rec loop output node parent prevsib 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
@@ -95,9 +95,11 @@ let gen_trace (type s) = fun auto sat_arrays t tree ->
       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
+      let first = T.first_child tree node in
+      let next = T.next_sibling tree node 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%!"
+ width=\"%i\" height=\"22\" style=\"fill:%s;stroke:rgb(0,0,0)%s\">%!"
         s_node
         s_node
         x y
@@ -106,26 +108,28 @@ let gen_trace (type s) = fun auto sat_arrays t tree ->
         (if marked
          then ";stroke-width:4"
          else ";stroke-width:2;stroke-dasharray:2,2");
+      fprintf output "<metadata id='%s_fs'>node%i</metadata><metadata id='%s_ns'>node%i</metadata><metadata id='%s_par'>node%i</metadata><metadata id='%s_ps'>node%i</metadata></rect>\n%!"
+s_node (T.preorder tree first) s_node (T.preorder tree next)
+s_node (T.preorder tree parent) s_node (T.preorder tree prevsib)
+;
       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 maxw1, maxy1 = loop output first node T.nil x (y + 40) in
       let x_next = max (x+lbox) (maxw1+10) in
       if node != root then begin
-        if node == T.first_child tree parent then
+        if prevsib == 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 / 2) (y-20) (x + lbox / 2) (y);
+            (x + lbox / 2) (y-18) (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);
+            (x + lbox) (y+11) x_next (y+11);
       end;
-      let maxw2, maxy2 = loop output next node x_next y in
+      let maxw2, maxy2 = loop output next parent node x_next y in
       maxw2, max maxy1 maxy2
     end
     else x, y
@@ -133,69 +137,47 @@ style=\"stroke:rgb(0,0,0);stroke-width:2\"/>\n"
   ignore (Sys.command "mkdir -p tests/trace");
   let ohtml_ = open_out "tests/trace/trace.html" in
   let ohtml = formatter_of_out_channel ohtml_ in
-  fprintf ohtml "<html>\
-<head><title></title>
-<meta http-equiv='content-type' content='text/html;charset=utf-8'/>\
-<style>\
-div#data {\
-    position: absolute;\
-    top: 0%%;\
-    left: 50%%;\
-    width: 50%%;\
-    height: 50%%;\
-    overflow: auto;\
-}\
-div#svg {\
-    position: absolute;\
-    top: 50%%;\
-    left: 0%%;\
-    width: 100%%;\
-    height: 50%%;\
-    overflow: auto;\
-}\
-\
-div#automata {\
-    white-space: pre;\
-    overflow: auto;\
-    position: absolute;\
-    width: 50%%;\
-    top: 0%%;\
-    left: 0%%;\
-    height: 50%%;\
-}\
-</style>\
-</head>\
-<body>\
-<div id='automata' >%a
-</div>
+  fprintf ohtml "<html>\n\
+<head><title></title>\n\
+<meta http-equiv='content-type' content='text/html;charset=utf-8'/>\n\
+<style>\n\
+%s
+</style>\n\
+</head>\n\
+<body>\n\
+<div id='automata' >%a</div>\n\
 <div id='data' > </div>\n\
 <script type='text/javascript'>\n\
 var data = new Array();\n\
 var rounds = %i;\n"
+    Trace_css.content
     Ata.print auto
     (List.length sat_arrays);
-  List.iteri (fun i a ->
-    fprintf ohtml "data[%i] = new Array();\n" i;
-    Array.iteri (fun id set ->
-      fprintf ohtml "data[%i]['node%i'] = \"%a\";\n"
-      i id StateSet.print set) a) (List.rev sat_arrays);
-  fprintf ohtml "var activate = function (id) {\
-  var d = document.getElementById('data');
-  var msg = '';
-  for (i=0; i < rounds; i++)
-     msg += ('<p>round: ' + i + ':<br/>') + data[i][id] + '</p>\\n';
-  d.innerHTML = msg;
-  return;
-  };\n";
-  fprintf ohtml "</script>\n<div id='svg'><svg id='svgimg' width='' height='' xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\">\n";
-  let maxw, maxh = loop ohtml (T.root tree) T.nil 50 50 in
-  fprintf ohtml "</svg>\n<script type=\"text/javascript\">window.onload = function () {\
-  var svg = document.getElementById('svgimg');
-  svg.setAttribute('width', %i);
-  svg.setAttribute('height', %i);
-};\
-</script>\
-</div></body></html>\n%!"
+    List.iteri (fun i _ ->
+      fprintf ohtml "data[%i] = new Array();\n" i) sat_arrays;
+    for node_id = 0 to (Array.length (List.hd sat_arrays)) - 1 do
+      let _,_ = List.fold_left (fun (pass, diff_set) a ->
+        let cur_set = a.(node_id) in
+        fprintf ohtml "data[%i]['node%i'] = \"new states %a<br/>full states = %a\";\n"
+        pass node_id StateSet.print (StateSet.diff cur_set diff_set) StateSet.print cur_set;
+        (pass+1, StateSet.union diff_set cur_set))
+        (0, StateSet.empty) (List.rev sat_arrays)
+      in ()
+    done;
+  fprintf ohtml "%s\n" Trace_js.content;
+  fprintf ohtml "%s"
+    "</script>\n\
+<div id='svg'>\n
+   <svg id='svgimg' width='' height='' xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\">\n";
+  let maxw, maxh = loop ohtml (T.root tree) T.nil T.nil 50 50 in
+  fprintf ohtml "</svg>\n</div><script type='text/javascript'>\n\
+window.onload = function () {\n
+    var svg = document.getElementById('svgimg');\n
+    svg.setAttribute('width', %i);\n
+    svg.setAttribute('height', %i);\n
+    activate('node0');\n
+};\n
+</script></body></html>\n%!"
     maxw maxh;
   pp_print_flush ohtml ();
   close_out ohtml_
diff --git a/src/run.ml b/src/run.ml
index c021dc2..f9ab76a 100644
--- a/src/run.ml
+++ b/src/run.ml
@@ -365,7 +365,7 @@ module Make (T : Tree.S) =
       run.bu_cache <- Cache.N6.create dummy_set;
     done;
     pass := Ata.get_max_rank auto + 1;
-    IFHTML(Html.gen_trace auto run.sat (module T : Tree.S with type t = T.t) tree ,());
+    IFHTML(Html_trace.gen_trace auto run.sat (module T : Tree.S with type t = T.t) tree ,());
     run
 
   let full_eval auto tree nodes =
diff --git a/src/trace_css.ml.str b/src/trace_css.ml.str
new file mode 100644
index 0000000..513b239
--- /dev/null
+++ b/src/trace_css.ml.str
@@ -0,0 +1,46 @@
+div#data {
+    position: absolute;
+    top: 0%;
+    left: 50%;
+    width: 50%;
+    height: 50%;
+    overflow: auto;
+}
+div#svg {
+    position: absolute;
+    top: 50%;
+    left: 0%;
+    width: 100%;
+    height: 50%;
+    overflow: auto;
+}
+
+div#automata {
+    white-space: pre;
+    overflow: auto;
+    position: absolute;
+    width: 50%;
+    top: 0%;
+    left: 0%;
+    height: 50%;
+}
+@-webkit-keyframes fadein {
+    from { fill-opacity: 0; }
+    to { fill-opacity: 1; }
+}
+
+@-moz-keyframes fadein {
+    from { fill-opacity: 0; }
+    to { fill-opacity: 1; }
+}
+
+@keyframes fadein {
+    from { fill-opacity: 0; }
+    to { fill-opacity: 1; }
+}
+
+.blink {
+    -webkit-animation: fadein 1.2s ease-in alternate infinite;
+    -moz-animation: fadein 1.2s ease-in alternate infinite;
+    animation: fadein 1.2s ease-in alternate infinite;
+}
\ No newline at end of file
diff --git a/src/trace_js.ml.str b/src/trace_js.ml.str
new file mode 100644
index 0000000..382132a
--- /dev/null
+++ b/src/trace_js.ml.str
@@ -0,0 +1,55 @@
+var old_timer = null;
+var old_node = null;
+
+var make_button = function (target, label)
+{
+    var msg  = '<button onclick="';
+    msg += 'activate(\'' + target + '\')"';
+    if (target == 'node-1') msg+= ' disabled="disabled" ';
+    msg+= '>' + label + '</button>';
+    return msg;
+};
+
+var activate = function (id)
+{
+    if (old_node) {
+        clearInterval(old_timer);
+        old_node.style.fillOpacity = 1.0;
+        old_node.style.stroke = 'black';
+        old_node.classList.remove('blink');
+    };
+    var node = document.getElementById(id);
+    var div = document.getElementById('svg');
+    var node_dim = node.getBBox();
+    var div_dim = div.getBoundingClientRect();
+    var nx = node_dim.x;
+    var ny = node_dim.y;
+    var hs = nx - (div_dim.width / 2 - node_dim.width / 2);
+    var vs = ny - (div_dim.height / 2 - node_dim.height / 2);
+    div.scrollLeft = hs;
+    div.scrollTop = vs;
+    node.style.stroke = 'red';
+    old_node = node;
+    node.classList.add('blink');
+
+    var d = document.getElementById('data');
+    var msg = '';
+    for (i=0; i < rounds; i++)
+	msg += ('<p>round: ' + i + ':<br/>') + data[i][id] + '</p>\n';
+
+    var rect = document.getElementById(id);
+    var fce = rect.firstElementChild;
+    var nse = fce.nextElementSibling;
+    var pare = nse.nextElementSibling;
+    var pse = pare.nextElementSibling;
+    var fc = fce.textContent;
+    var ns = nse.textContent;
+    var par = pare.textContent;
+    var ps = pse.textContent;
+    msg += make_button(par, "↑");
+    msg += make_button(ps, "←");
+    msg += make_button(fc, "↓");
+    msg += make_button(ns,"→");
+    d.innerHTML = msg;
+    return;
+};
diff --git a/tools/ocamlmoduledep.sh b/tools/ocamlmoduledep.sh
index a9f2ee9..b38eed7 100755
--- a/tools/ocamlmoduledep.sh
+++ b/tools/ocamlmoduledep.sh
@@ -51,7 +51,7 @@ for MODULE in $MODULES; do
         if test  \( "$INTER" = "1" \) -a \( -f "$base".mli \) ; then
 	    ## if we want to depend only on cmi of a module
                 echo -n "$base"."cmi "
-        elif test -f "$base".ml -o -f "$base".mly -o -f "$base".mll -o -f "$base".pack; then
+        elif test -f "$base".ml -o -f "$base".mly -o -f "$base".mll -o -f "$base".pack -o -f "$base".ml.str; then
 	    ## else we depend on the implementation 
             echo -n "$base"."$ext "
             break
-- 
2.17.1