1 files changed, 155 insertions, 0 deletions
diff --git a/viz.js/convert.ml b/viz.js/convert.ml
new file mode 100755
index 0000000..75c4fcd
--- /dev/null
+++ b/viz.js/convert.ml
@@ -0,0 +1,155 @@
+open Js_of_ocaml
+open Js_of_ocaml_lwt
+
+(** Event generated once the library has created the svg image *)
+let (generated_svg_event:(Dom_svg.svgElement Js.t * Js.js_string Js.t) Dom.Event.typ)
+  = Dom_html.Event.make "generated_svg"
+
+(* Save the generated image *)
+let on_result_png image = begin
+  let a = Dom_html.createA Dom_html.document in
+  a##.href := image##.src;
+  Js.Unsafe.set a (Js.string "download") (Js.string "output.png");
+  Dom.appendChild Dom_html.document##.body a;
+  a##click;
+  Dom.removeChild Dom_html.document##.body a
+end
+
+let on_result_svg
+  : Dom_html.element Js.t -> (Dom.node Js.t) -> unit
+  = fun svg_display image -> begin
+      let childNodes = svg_display##.childNodes in
+      for i = 0 to childNodes##.length do
+        Js.Opt.iter (childNodes##item i) (fun elem -> ignore @@ svg_display##removeChild elem)
+      done;
+      Dom.appendChild svg_display image;
+      ()
+    end
+
+let download data (filename : Js.js_string Js.t) (mime: Js.js_string Js.t)
+  = Js.Unsafe.(
+      fun_call (js_expr "download")
+        [| inject data
+         ; inject filename
+         ; inject mime |])
+
+(** Message send by the worker *)
+type message = Process.t
+type worker = (Js.js_string Js.t, message) Worker.worker Js.t
+
+let change_event (worker:worker) input _ev _ = begin
+  let text: Js.js_string Js.t = input##.value in
+
+  (* Send the content to the worker *)
+  let () = worker##postMessage text in
+  Lwt.return_unit
+end
+
+class type _Dom_parser = object
+  method parseFromString: Js.js_string Js.t -> Js.js_string Js.t -> Dom_html.document Js.t Js.meth
+end
+
+let dom_parser = (Js.Unsafe.global##._DOMParser)
+let dom_parser = new%js dom_parser
+
+let load () =
+
+  (* The URL is be relative with the page location. If the worker is called
+     from diffenent location, it becomes mandatory to declare the URL as
+     absolute. *)
+  let (worker:worker) = Worker.create "/resources/viz.js/worker.js" in
+
+  worker##.onmessage := Dom.handler (fun (event: message Worker.messageEvent Js.t) ->
+      let gv, image = event##.data in
+      let image = dom_parser##parseFromString image "image/svg+xml" in
+      let image = image##.documentElement in
+
+      let _ = Dispatch.call generated_svg_event (image, gv) in
+      Js._true);
+
+  let svg_display = Dom_html.getElementById_exn "svg"
+  and output_button = Dom_html.getElementById_exn "png_output"
+  and dot_button = Dom_html.getElementById_exn "dot_output"
+  and editor = Dom_html.getElementById_exn "editor" in
+
+  ignore @@ Dispatch.register generated_svg_event (fun (image, input) ->
+
+      on_result_svg svg_display (image :> Dom.node Js.t);
+
+      (* Download the dot file *)
+      dot_button##.onclick := Dom_html.handler (fun _ev ->
+          let _ = download input (Js.string "output.dot") (Js.string "text/plain") in
+          Js._false
+        );
+
+      (* Convert the svg in png *)
+      output_button##.onclick := Dom_html.handler (fun _->
+          (*download image*)
+          CanvasTool.generate_png image (fun image ->
+              let _ = download image (Js.string "output.png") (Js.string "text/plain") in
+              ()
+            );
+          Js._false
+        );
+    );
+
+  Js.Opt.iter (Dom_html.CoerceTo.textarea editor) (fun input ->
+      Lwt_js_events.async (fun () -> (Lwt_js_events.limited_loop Lwt_js_events.change ~elapsed_time:0.1 editor (change_event worker input) ));
+      Lwt_js_events.async (fun () -> (Lwt_js_events.limited_loop  Lwt_js_events.input ~elapsed_time:0.1 editor (change_event worker input) ));
+      (* Run the first generation *)
+      Lwt.ignore_result (change_event worker input () ());
+    );
+
+  (** Handle the separation window *)
+  Option.iter
+    (fun button ->
+       let _ = Dom_events.listen button Dom_html.Event.click (fun _ _ ->
+
+           let opt_window2 = Dom_html.window##open_
+               (Js.string "")
+               (Js.string "_image")
+               Js.Opt.empty in
+
+           Js.Opt.iter opt_window2 (fun window2 ->
+
+               let callback
+                 : Dom_svg.svgElement Js.t * Js.js_string Js.t -> unit
+                 = fun (image, _gv)  -> begin
+                     let node2 = image##cloneNode Js._true in
+                     let () = on_result_svg window2##.document##.body
+                         (node2 :> Dom.node Js.t) in
+                     ()
+                   end in
+               let handler = Dispatch.register generated_svg_event callback in
+
+               (* Remove the update event when the window is closed *)
+               window2##.onunload := Dom_html.handler (fun _ev ->
+                   Dispatch.remove generated_svg_event handler;
+                   Js._false
+                 );
+
+               (* Copy the current display to the new window *)
+               let childNodes = svg_display##.childNodes in
+               for i = 0 to childNodes##.length do
+                 Js.Opt.iter
+                   (childNodes##item i)
+                   (fun elem ->
+                      Dom.appendChild window2##.document##.body (elem##cloneNode Js._true)
+                   )
+               done;
+             );
+
+           false
+         ) in
+       ()
+    )
+    (Dom_html.getElementById_opt "btn_window");
+  Lwt.return Js._false
+
+let _ = Lwt.bind (Lwt_js_events.onload ()) (fun _ -> load())
+
+let _ =
+  Js.export "generator"
+    (object%js
+      method load = load ()
+    end)