Tyxml - 将 svg 元素添加到 dom 树

Tyxml - adding svg element to dom tree

刚开始使用 Tyxml 打破僵局 - 似乎没有比这更进一步的了 -

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

createCircle 参数需要一个 'Dom_svg.document Js.t' 但被赋予了一个 'Dom_html.canvasElement Js.t'

有人可以告诉我如何将 svg 元素插入到 dom 树中吗?

谢谢 尼克

js_of_ocaml/examples/hyperbolic 中的一个优秀示例涵盖了这一点以及更多内容。针对我最初的问题,以下内容(摘自 hypertree.ml)是:

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