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