console/oplevel
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

events

Browse Source
This commit is contained in:
cqc
2024-04-28 12:30:57 -05:00
parent 54e9cc90d3
commit d5c74b2ceb
3 changed files with 425 additions and 359 deletions
Download Patch File Download Diff File Expand all files Collapse all files

218
oplevel.ml
View File

@ -1,4 +1,3 @@
open Lwt.Infix
module F = Fmt
open Tgles2
module Gv = Graphv_gles2_native
@ -37,153 +36,6 @@ let load_data vg =
Gv.Text.add_fallback vg ~name:"sans-bold" ~fallback:"emoji";
Gv.Text.set_font_face vg ~name:"mono"
let pp_glfw_key : GLFW.key F.t =
fun ppf k ->
F.pf ppf
GLFW.(
match k with
| Unknown -> "Unknown"
| Space -> "Space"
| Apostrophe -> "Apostrophe"
| Comma -> "Comma"
| Minus -> "Minus"
| Period -> "Period"
| Slash -> "Slash"
| Num0 -> "Num0"
| Num1 -> "Num1"
| Num2 -> "Num2"
| Num3 -> "Num3"
| Num4 -> "Num4"
| Num5 -> "Num5"
| Num6 -> "Num6"
| Num7 -> "Num7"
| Num8 -> "Num8"
| Num9 -> "Num9"
| Semicolon -> "Semicolon"
| Equal -> "Equal"
| A -> "A"
| B -> "B"
| C -> "C"
| D -> "D"
| E -> "E"
| F -> "F"
| G -> "G"
| H -> "H"
| I -> "I"
| J -> "J"
| K -> "K"
| L -> "L"
| M -> "M"
| N -> "N"
| O -> "O"
| P -> "P"
| Q -> "Q"
| R -> "R"
| S -> "S"
| T -> "T"
| U -> "U"
| V -> "V"
| W -> "W"
| X -> "X"
| Y -> "Y"
| Z -> "Z"
| LeftBracket -> "LeftBracket"
| Backslash -> "Backslash"
| RightBracket -> "RightBracket"
| GraveAccent -> "GraveAccent"
| World1 -> "World1"
| World2 -> "World2"
| Escape -> "Escape"
| Enter -> "Enter"
| Tab -> "Tab"
| Backspace -> "Backspace"
| Insert -> "Insert"
| Delete -> "Delete"
| Right -> "Right"
| Left -> "Left"
| Down -> "Down"
| Up -> "Up"
| PageUp -> "PageUp"
| PageDown -> "PageDown"
| Home -> "Home"
| End -> "End"
| CapsLock -> "CapsLock"
| ScrollLock -> "ScrollLock"
| NumLock -> "NumLock"
| PrintScreen -> "PrintScreen"
| Pause -> "Pause"
| F1 -> "F1"
| F2 -> "F2"
| F3 -> "F3"
| F4 -> "F4"
| F5 -> "F5"
| F6 -> "F6"
| F7 -> "F7"
| F8 -> "F8"
| F9 -> "F9"
| F10 -> "F10"
| F11 -> "F11"
| F12 -> "F12"
| F13 -> "F13"
| F14 -> "F14"
| F15 -> "F15"
| F16 -> "F16"
| F17 -> "F17"
| F18 -> "F18"
| F19 -> "F19"
| F20 -> "F20"
| F21 -> "F21"
| F22 -> "F22"
| F23 -> "F23"
| F24 -> "F24"
| F25 -> "F25"
| Kp0 -> "Kp0"
| Kp1 -> "Kp1"
| Kp2 -> "Kp2"
| Kp3 -> "Kp3"
| Kp4 -> "Kp4"
| Kp5 -> "Kp5"
| Kp6 -> "Kp6"
| Kp7 -> "Kp7"
| Kp8 -> "Kp8"
| Kp9 -> "Kp9"
| KpDecimal -> "KpDecimal"
| KpDivide -> "KpDivide"
| KpMultiply -> "KpMultiply"
| KpSubtract -> "KpSubtract"
| KpAdd -> "KpAdd"
| KpEnter -> "KpEnter"
| KpEqual -> "KpEqual"
| LeftShift -> "LeftShift"
| LeftControl -> "LeftControl"
| LeftAlt -> "LeftAlt"
| LeftSuper -> "LeftSuper"
| RightShift -> "RightShift"
| RightControl -> "RightControl"
| RightAlt -> "RightAlt"
| RightSuper -> "RightSuper"
| Menu -> "Menu")
let pp_glfw_key_action : GLFW.key_action F.t =
fun ppf s ->
F.pf ppf
GLFW.(
match s with
| Release -> "Release"
| Press -> "Press"
| Repeat -> "Repeat")
let pp_glfw_mods =
F.(
list (fun ppf s ->
pf ppf
GLFW.(
match s with
| Shift -> "Shift"
| Control -> "Control"
| Alt -> "Alt"
| Super -> "Super")))
let () =
GLFW.init ();
at_exit GLFW.terminate;
@ -218,24 +70,10 @@ let () =
F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
Toploop.initialize_toplevel_env ();
let text =
let rootrepo =
Lwt_main.run
((fun () ->
Store.init_default
(F.str "%s/console/rootstore.git" Secrets.giturl)
>>= fun t ->
Store.S.tree t >>= fun rootstore ->
(try Store.S.Tree.get rootstore [ ".config"; "init.ml" ] with
| Not_found | Invalid_argument _ ->
Lwt.return
"print_newline \"rootstore://.config/init.ml not \
found\";;"
| exc ->
Lwt.return
(F.str ".config/init.ml load exception: %s"
(Printexc.to_string exc)))
>>= fun text -> Lwt.return text)
())
(Store.init_default
(F.str "%s/console/rootstore.git" Secrets.giturl))
in
let ui =
@ -245,17 +83,32 @@ let () =
GLFW.setKeyCallback ~window
~f:
(Some
(fun window key int state mods ->
F.epr
"GLFW.setKeyCallback ~f: _win key=%a int=%d state=%a \
mods=%a@."
pp_glfw_key key int pp_glfw_key_action state pp_glfw_mods
mods;
Ogui.Ui.keycallback ui window key int state mods))
Glfw_types.(
fun _window key int state mods ->
F.epr
"GLFW.setKeyCallback ~f: _win key=%a int=%d state=%a \
mods=%a@."
pp_key key int pp_key_action state pp_mods mods;
Ogui.Ui.keycallback ui state key mods))
|> ignore;
let t = GLFW.getTime () |> ref in
GLFW.setCharCallback ~window
~f:
(Some
(fun _window ch ->
let uc = Uchar.of_int ch in
F.epr "GLFW.setCharCallback ~f: _win ch=%d(%a)@." ch
F.(option string)
(if Uchar.is_char uc then
Some (String.make 1 @@ Uchar.to_char uc)
else None);
Ogui.Ui.chrcallback ui ch))
|> ignore;
F.pr "oplevel.ml: entering drawing loop@.";
let t = GLFW.getTime () |> ref in
while (not GLFW.(windowShouldClose ~window)) && !continue do
Lwt_main.run
((fun () ->
@ -277,24 +130,27 @@ let () =
Gl.clear
(Gl.color_buffer_bit lor Gl.depth_buffer_bit
lor Gl.stencil_buffer_bit);
Gl.enable Gl.blend;
Gl.blend_func Gl.src_alpha Gl.one_minus_src_alpha;
Gl.enable Gl.cull_face_enum;
Gl.disable Gl.depth_test;
let win_w, win_h = (float win_w, float win_h) in
Gv.begin_frame ctx ~width:win_w ~height:win_h
~device_ratio:1.;
let width, height = (float win_w, float win_h) in
Perfgraph.render graph ctx (win_w -. 205.) 5.;
ignore Ogui.TextEdit.(show (multiline (String text)) ui);
Gv.begin_frame ctx ~width ~height ~device_ratio:1.;
Perfgraph.render graph ctx (width -. 205.) 5.;
ignore
Ogui.TextEdit.(
show
(multiline
(Ogui.TextBuffer.of_repo
~path:[ ".config"; "init.ml" ]
~repo:rootrepo))
ui);
(* Demo.render_demo ctx mx my win_w win_h now !blowup data; *)
Gv.end_frame ctx;
Gc.major_slice 0 |> ignore;
GLFW.swapBuffers ~window;
GLFW.pollEvents ();
Lwt.return_unit)