Updated the code the latest js_of_ocamlHEADmaster

1 files changed, 124 insertions, 109 deletions

diff --git a/viz.js/convert.ml b/viz.js/convert.ml
index 68bf244..a615ce4 100755
--- a/viz.js/convert.ml
+++ b/viz.js/convert.ml
@@ -2,153 +2,168 @@ 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 (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
 
-(** Message send by the worker *)
 type message = Process.t
+(** Message send by the worker *)
+
 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
+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
+    (* 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
+  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 = 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
+  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 handler : (_, (_, _) Dom_html.messageEvent Js.t) Dom_html.event_listener =
+    Dom.handler (fun (event : (_, message) Dom_html.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 _ = Dispatch.call generated_svg_event (image, gv) in
+        Js._true)
+  in
+  worker##.onmessage := handler;
 
   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) ->
-
+  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 _ = Elements.Transfert.send
-              ~mime_type:(Jstr.v "text/plain")
-              ~filename:(Jstr.v "output.dot")
-              (Obj.magic input) in
-          Js._false
-        );
+      dot_button##.onclick :=
+        Dom_html.handler (fun _ev ->
+            let _ =
+              Elements.Transfert.send ~mime_type:(Jstr.v "text/plain")
+                ~filename:(Jstr.v "output.dot") (Obj.magic input)
+            in
+            Js._false);
 
       (* Convert the svg in png *)
-      output_button##.onclick := Dom_html.handler (fun _->
-          (*download image*)
-          CanvasTool.generate_png image (fun image ->
-              let _ =
-                Elements.Transfert.send_raw
-                  ~filename:(Jstr.v "output.png")
-                  (Obj.magic image) in
-              ()
-            );
-          Js._false
-        );
-    );
+      output_button##.onclick :=
+        Dom_html.handler (fun _ ->
+            (*download image*)
+            CanvasTool.generate_png image (fun image ->
+                let _ =
+                  Elements.Transfert.send_raw ~filename:(Jstr.v "output.png")
+                    (Obj.magic image)
+                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) ));
+      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 () ());
-    );
+      Lwt.ignore_result (change_event worker input () ()));
 
-  (** Handle the separation window *)
+  (* 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
-       ()
-    )
+      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 _ = Lwt.bind (Lwt_js_events.onload ()) (fun _ -> load ())
 
 let _ =
   Js.export "generator"
-    (object%js
+    object%js
       method load = load ()
-    end)
+    end