aboutsummaryrefslogtreecommitdiff
path: root/viz.js/convert.ml
diff options
context:
space:
mode:
Diffstat (limited to 'viz.js/convert.ml')
-rwxr-xr-xviz.js/convert.ml233
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
generated by cgit v1.2.3 (git 2.46.0) at 2026-11-09 19:32:18 +0000