blob: 68bf2441bb63a2eb0e849a17cc63f1bb32e6e883 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
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
(** 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 _ = 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
);
);
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)
|
