Tyxml - 将svg元素添加到dom树中

时间:2016-03-25 13:48:46

标签: js-of-ocaml

刚开始用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树中吗?

由于 尼克

1 个答案:

答案 0 :(得分:0)

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