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)