diff options
Diffstat (limited to 'viz.js/canvasTool.ml')
-rwxr-xr-x | viz.js/canvasTool.ml | 50 |
1 files changed, 28 insertions, 22 deletions
diff --git a/viz.js/canvasTool.ml b/viz.js/canvasTool.ml index 1b21143..1fcd317 100755 --- a/viz.js/canvasTool.ml +++ b/viz.js/canvasTool.ml @@ -1,39 +1,45 @@ open Js_of_ocaml -let (pixelRatio: int) = 2 * Js.Unsafe.get Dom_html.window (Js.string "devicePixelRatio") +let (pixelRatio : float) = + 2 * Js.Unsafe.get Dom_html.window (Js.string "devicePixelRatio") + |> float_of_int class type xmlSerializer = object - method serializeToString: Dom.element Js.t -> Js.js_string Js.t Js.meth + 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 +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 generate_png (svg_image : Dom_svg.svgElement Js.t) callback = let image = Dom_html.createImg Dom_html.document in - image##.onload := Dom_html.handler (fun _ev -> + 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 |> Js.to_float + and height = svg_image##.height##.baseVal##.value |> Js.to_float in - 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 := Float.to_int @@ (pixelRatio *. width); + image##.height := Float.to_int @@ (pixelRatio *. height); - image##.width := pixelRatio * (int_of_float width); - image##.height := pixelRatio * (int_of_float height); + canvas##.width := Float.to_int @@ (pixelRatio *. width); + canvas##.height := Float.to_int @@ (pixelRatio *. height); - canvas##.width := pixelRatio * (int_of_float width); - canvas##.height := pixelRatio * (int_of_float height); + context##drawImage_withSize + image (Js.number_of_float 0.0) (Js.number_of_float 0.0) + (Js.number_of_float (pixelRatio *. width)) + (Js.number_of_float (pixelRatio *. 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 - ); + 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 + 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 |