5 Commits

5 changed files with 1121 additions and 533 deletions

View File

@ -1 +0,0 @@
profile = compact

View File

@ -1,6 +1,12 @@
open Js_of_ocaml open Js_of_ocaml
open Lwt.Infix
module NVG = Graphv_webgl module NVG = Graphv_webgl
let _ =
Logs.set_reporter (Human.Logs_browser.console_reporter ());
Logs.set_level (Some Debug);
Logs.debug (fun m -> m "hello")
(* This scales the canvas to match the DPI of the window, (* This scales the canvas to match the DPI of the window,
it prevents blurriness when rendering to the canvas *) it prevents blurriness when rendering to the canvas *)
let scale_canvas (canvas : Dom_html.canvasElement Js.t) = let scale_canvas (canvas : Dom_html.canvasElement Js.t) =
@ -8,48 +14,55 @@ let scale_canvas (canvas : Dom_html.canvasElement Js.t) =
let rect = canvas##getBoundingClientRect in let rect = canvas##getBoundingClientRect in
let width = rect##.right -. rect##.left in let width = rect##.right -. rect##.left in
let height = rect##.bottom -. rect##.top in let height = rect##.bottom -. rect##.top in
canvas##.width := width *. dpr |> int_of_float ; canvas##.width := width *. dpr |> int_of_float;
canvas##.height := height *. dpr |> int_of_float ; canvas##.height := height *. dpr |> int_of_float;
let width = let width =
Printf.sprintf "%dpx" (int_of_float width) |> Js.string in Printf.sprintf "%dpx" (int_of_float width) |> Js.string
in
let height = let height =
Printf.sprintf "%dpx" (int_of_float height) |> Js.string in Printf.sprintf "%dpx" (int_of_float height) |> Js.string
canvas##.style##.width := width ; in
canvas##.style##.width := width;
canvas##.style##.height := height canvas##.style##.height := height
let _ = let _ =
let canvas = let canvas =
Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas") in Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas")
scale_canvas canvas ; in
scale_canvas canvas;
let webgl_ctx = let webgl_ctx =
(* Graphv requires a stencil buffer to work properly *) (* Graphv requires a stencil buffer to work properly *)
let attrs = WebGL.defaultContextAttributes in let attrs = WebGL.defaultContextAttributes in
attrs##.stencil := Js._true ; attrs##.stencil := Js._true;
match match
WebGL.getContextWithAttributes canvas attrs |> Js.Opt.to_option WebGL.getContextWithAttributes canvas attrs |> Js.Opt.to_option
with with
| None -> | None ->
print_endline "Sorry your browser does not support WebGL" ; print_endline "Sorry your browser does not support WebGL";
raise Exit raise Exit
| Some ctx -> ctx in | Some ctx -> ctx
in
let open NVG in let open NVG in
let vg = let vg =
create create
~flags:CreateFlags.(antialias lor stencil_strokes) ~flags:CreateFlags.(antialias lor stencil_strokes)
webgl_ctx in webgl_ctx
in
(* File in this case is actually the CSS font name *) (* File in this case is actually the CSS font name *)
Text.create vg ~name:"sans" ~file:"sans" |> ignore ; Text.create vg ~name:"sans" ~file:"sans" |> ignore;
webgl_ctx##clearColor 0.3 0.3 0.32 1. ; webgl_ctx##clearColor 0.3 0.3 0.32 1.;
let render ev =
(*
let render ev =
webgl_ctx##clear webgl_ctx##clear
( webgl_ctx##._COLOR_BUFFER_BIT_ (webgl_ctx##._COLOR_BUFFER_BIT_
lor webgl_ctx##._DEPTH_BUFFER_BIT_ lor webgl_ctx##._DEPTH_BUFFER_BIT_
lor webgl_ctx##._STENCIL_BUFFER_BIT_ ) ; lor webgl_ctx##._STENCIL_BUFFER_BIT_);
let device_ratio = Dom_html.window##.devicePixelRatio in let device_ratio = Dom_html.window##.devicePixelRatio in
begin_frame vg ~width:canvas##.width ~height:canvas##.height begin_frame vg ~width:canvas##.width ~height:canvas##.height
~device_ratio ; ~device_ratio;
Transform.scale vg ~x:device_ratio ~y:device_ratio ; Transform.scale vg ~x:device_ratio ~y:device_ratio;
ignore Human.Panel.Ui.(panel vg Gg.P2.o test ev) ; ignore Human.Panel.Ui.(panel vg Gg.P2.o test ev);
(* (*
Path.begin_ vg ; Path.begin_ vg ;
Path.rect vg ~x:40. ~y:40. ~w:320. ~h:320. ; Path.rect vg ~x:40. ~y:40. ~w:320. ~h:320. ;
@ -62,11 +75,31 @@ let _ =
Text.set_align vg ~align:Align.(center lor middle) ; Text.set_align vg ~align:Align.(center lor middle) ;
set_fill_color vg ~color:Color.white ; set_fill_color vg ~color:Color.white ;
Text.text vg ~x:0. ~y:0. "Hello World!" ; *) Text.text vg ~x:0. ~y:0. "Hello World!" ; *)
NVG.end_frame vg in NVG.end_frame vg
in
Dom_html.window##requestAnimationFrame Dom_html.window##requestAnimationFrame
(Js.wrap_callback (fun _ -> render Human.Event.empty)) (Js.wrap_callback (fun _ -> render Human.Event.empty))
|> ignore ; |> ignore;*)
Dom_html.document##.onkeydown let open Js_of_ocaml_lwt.Lwt_js_events in
:= Dom.handler (fun (evt : Dom_html.keyboardEvent Js.t) -> async (fun () ->
render (Human.Event_js.evt_of_jskey `Press evt) ; buffered_loop (make_event Dom_html.Event.keydown)
Js._false ) Dom_html.document (fun ev _ ->
webgl_ctx##clear
(webgl_ctx##._COLOR_BUFFER_BIT_
lor webgl_ctx##._DEPTH_BUFFER_BIT_
lor webgl_ctx##._STENCIL_BUFFER_BIT_);
let device_ratio = Dom_html.window##.devicePixelRatio in
begin_frame vg ~width:canvas##.width ~height:canvas##.height
~device_ratio;
Transform.scale vg ~x:device_ratio ~y:device_ratio;
Human.Panel.Ui.(
render_lwt vg Gg.P2.o
(Human.Event_js.evt_of_jskey `Press ev))
>>= fun () ->
NVG.end_frame vg;
Lwt.return_unit))
(* Dom_html.document##.onkeydown
:= Dom.handler (fun (evt : Dom_html.keyboardEvent Js.t) ->
render (Human.Event_js.evt_of_jskey `Press evt) ;
Js._false ) *)

7
cors_proxy.sh Executable file
View File

@ -0,0 +1,7 @@
#!/bin/bash
if [ ! -f /tmp/key.pem ]; then
echo Creating key
openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout /tmp/key.pem -out /tmp/cert.pem -batch
fi
npx http-server --cors -S -P https://github.com --log-ip -c-1 -C /tmp/cert.pem -K /tmp/key.pem

19
dune
View File

@ -1,6 +1,8 @@
(env (env
(dev (flags (:standard -warn-error -A)) (dev (flags (:standard -warn-error -A))
(js_of_ocaml (flags) (compilation_mode separate)))) (js_of_ocaml (flags --no-inline --pretty --source-map-inline --debug-info)
(build_runtime_flags --no-inline --pretty --source-map-inline --debug-info)
(link_flags --source-map-inline))))
(executable (executable
(name boot_js) (name boot_js)
@ -10,11 +12,18 @@
(modules boot_js human) (modules boot_js human)
(libraries (libraries
fmt fmt
logs
graphv_webgl graphv_webgl
js_of_ocaml js_of_ocaml-lwt
lwt digestif.ocaml
; irmin-git irmin.mem
; irmin-indexeddb git
irmin-git
httpaf
cohttp
cohttp-lwt-jsoo
mimic
uri
zed zed
gg gg

1542
human.ml

File diff suppressed because it is too large Load Diff