aboutsummaryrefslogtreecommitdiff
path: root/viz.js/convert.ml
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)