1 files changed, 39 insertions, 0 deletions
diff --git a/viz.js/canvasTool.ml b/viz.js/canvasTool.ml
new file mode 100755
index 0000000..1b21143
--- /dev/null
+++ b/viz.js/canvasTool.ml
@@ -0,0 +1,39 @@
+open Js_of_ocaml
+
+let (pixelRatio: int) = 2 * Js.Unsafe.get Dom_html.window (Js.string "devicePixelRatio")
+
+class type xmlSerializer = object
+  method serializeToString: Dom.element Js.t -> Js.js_string Js.t Js.meth
+end
+
+let (xmlSerializer: xmlSerializer Js.t Js.constr) = Js.Unsafe.global##._XMLSerializer
+
+(* Extract an image from a svg element *)
+let generate_png (svg_image : Dom_svg.svgElement Js.t) callback = begin
+  let image = Dom_html.createImg Dom_html.document in
+
+  image##.onload := Dom_html.handler (fun _ev ->
+
+      let canvas = Dom_html.createCanvas Dom_html.document in
+      let context = canvas##getContext Dom_html._2d_ in
+      let width = svg_image##.width##.baseVal##.value
+      and height = svg_image##.height##.baseVal##.value in
+
+      image##.width := pixelRatio * (int_of_float width);
+      image##.height := pixelRatio * (int_of_float height);
+
+      canvas##.width := pixelRatio * (int_of_float width);
+      canvas##.height := pixelRatio * (int_of_float height);
+
+      context##drawImage_withSize image 0.0 0.0 ((float_of_int pixelRatio) *. width) ((float_of_int pixelRatio) *. height);
+
+      callback @@ canvas##toDataURL_type (Js.string "image/png");
+      Js._false
+    );
+
+  let xml = new%js xmlSerializer in
+  let svg_xml = xml##serializeToString (svg_image :> Dom.element Js.t) in
+  let svg_src = (Js.string "data:image/svg+xml;base64,")##concat (Dom_html.window##btoa (Js.unescape (Js.encodeURIComponent  svg_xml))) in
+  image##.src := svg_src;
+
+end