[SOLVED] Tyxml - adding svg element to dom tree

Tyxml - adding svg element to dom tree

Just beginning to break the ice with Tyxml - can't seem to get any further than this -

let main _ =
  let d = Dom_html.window ## document in
  let c = Dom_html.createCanvas d in
  let s = Dom_svg.createCircle c in
  c ## width <- Js.string "100";
  c ## height <- Js.string "100";
  s ## cx <- Js.string "100";
  s ## cy <- Js.string "100";
  s ## r <- Js.string "40";
  s ## stroke <- Js.string "green";
  (* s ## strokeWidth <- Js.string "4"; *)
  s ## fill <- Js.string "yellow";
  Dom.appendChild (d ## body) c;
  Dom.appendChild c s


let () = Dom_html.window ## onload <- Dom_html.handler main

The createCircle parameter expects a 'Dom_svg.document Js.t' but is given a 'Dom_html.canvasElement Js.t'

Could someone possibly give me some idea of how to insert a svg element into a dom tree?

Thanks Nick

Solution

An excellent example in js_of_ocaml/examples/hyperbolic covers this and a lot more. In response to my original question, the following (extracted from hypertree.ml) is :

module Html = Dom_html

let create_canvas w h =
  let d = Html.window##document in
  let c = Html.createCanvas d in
  c##width <- w;
  c##height <- h;
  c

let unsupported_messages () =
  let doc = Html.document in
  let txt = Html.createDiv doc in
  txt##className <- Js.string "text";
  txt##style##width <- Js.string "80%";
  txt##style##margin <- Js.string "auto";
  txt##innerHTML <- Js.string
    "Unfortunately, this browser is not supported. \
     Please try again with another browser, \
     such as <a href=\"http://www.mozilla.org/firefox/\">Firefox</a>, \
     <a href=\"http://www.google.com/chrome/\">Chrome</a> or \
     <a href=\"http://www.opera.com/\">Opera</a>.";
  let cell = Html.createDiv doc in
  cell##style##display <- Js.string "table-cell";
  cell##style##verticalAlign <- Js.string "middle";
  Dom.appendChild cell txt;
  let table = Html.createDiv doc in
  table##style##width <- Js.string "100%";
  table##style##height <- Js.string "100%";
  table##style##display <- Js.string "table";
  Dom.appendChild table cell;
  let overlay = Html.createDiv doc in
  overlay##className <- Js.string "overlay";
  Dom.appendChild overlay table;
  Dom.appendChild (doc##body) overlay


let start _ =
  Lwt.ignore_result
    (
     let doc = Html.document in
     let page = doc##documentElement in
     page##style##overflow <- Js.string "hidden";
     page##style##height <- Js.string "100%";
     doc##body##style##overflow <- Js.string "hidden";
     doc##body##style##margin <- Js.string "0px";
     doc##body##style##height <- Js.string "100%";
     let w = page##clientWidth in
     let h = page##clientHeight in
     let canvas = create_canvas w h in
     Dom.appendChild doc##body canvas;
     let c = canvas##getContext (Html._2d_) in
  c##beginPath ();
  c##moveTo (10., 10.);
  c##lineTo (100.,100.);
  c##stroke ();

     Lwt.return ());
  Js._false



let start _ =
  try
    ignore (Html.createCanvas (Html.window##document));
    start ()
  with Html.Canvas_not_available ->
    unsupported_messages ();
    Js._false

let _ =
Html.window##onload <- Html.handler start