open Lwt.Infix module F = Fmt open Tgles2 module Gv = Graphv_gles2_native open Ogui module GLFWExtras = struct open Ctypes open Foreign let glfwSetErrorCallback : (int -> string -> unit) -> int -> string -> unit = let errorfun = int @-> string @-> returning void in foreign "glfwSetErrorCallback" (funptr errorfun @-> returning (funptr errorfun)) end let errorcb error desc = Printf.printf "GLFW error %d: %s\n%!" error desc let load_data vg = let _ = Gv.Text.create vg ~name:"mono" ~file:"./assets/mono.ttf" in let _ = Gv.Text.create vg ~name:"icons" ~file:"./assets/entypo.ttf" in let _ = Gv.Text.create vg ~name:"sans" ~file:"./assets/Roboto-Regular.ttf" in let _ = Gv.Text.create vg ~name:"sans-bold" ~file:"./assets/Roboto-Bold.ttf" in let _ = Gv.Text.create vg ~name:"emoji" ~file:"./assets/NotoEmoji-Regular.ttf" in Gv.Text.add_fallback vg ~name:"sans" ~fallback:"emoji"; Gv.Text.add_fallback vg ~name:"sans-bold" ~fallback:"emoji"; Gv.Text.set_font_face vg ~name:"mono" let () = GLFW.init (); at_exit GLFW.terminate; let _res = GLFWExtras.glfwSetErrorCallback errorcb in GLFW.windowHint ~hint:GLFW.ClientApi ~value:GLFW.OpenGLESApi; GLFW.windowHint ~hint:GLFW.ContextVersionMajor ~value:2; GLFW.windowHint ~hint:GLFW.ContextVersionMinor ~value:0; let window = GLFW.createWindow ~width:1000 ~height:600 ~title:"window" () in (* Make the window's context current *) GLFW.makeContextCurrent ~window:(Some window); GLFW.swapInterval ~interval:0; Gl.clear_color 0.1 0.2 0.2 1.; Memtrace.trace_if_requested (); let ctx = Gv.create ~flags:Gv.CreateFlags.(antialias lor stencil_strokes) () in let graph = Perfgraph.init Perfgraph.FPS "Frame Time" in let _odata = load_data ctx in let continue = ref true in let min_fps = ref Float.max_float in let max_fps = ref Float.min_float in (* Thread which is woken up when the main window is closed. *) let _waiter, _wakener = Lwt.wait () in F.pr "oplevel.ml: Toploop.initialize_toplevel_env@."; Toploop.initialize_toplevel_env (); let rootrepo = Store.init_default (F.str "%s/console/rootstore.git" Secrets.giturl) in let ui = Ogui.Ui.window ctx ~window Gg.(Box2.v P2.o (P2.v 500. 500.)) in GLFW.setKeyCallback ~window ~f: (Some (fun _window key _int state mods -> Lwt.async (fun () -> Ogui.Ui.keycallback ui state key mods >>= fun _ -> Lwt.return_unit))) |> ignore; GLFW.setCharCallback ~window ~f: (Some (fun _window ch -> Lwt.async (fun () -> Ogui.Ui.chrcallback ui ch >>= fun _ -> Lwt.return_unit))) |> ignore; F.pr "oplevel.ml: building initial page@."; let page = ref Layout.( vbox [ textedit (TextEdit.multiline ui (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo)); textedit (TextEdit.multiline ui (TextBuffer.of_repo ~path:[ ".config"; "init.ml" ] ~repo:rootrepo)); ]) in (let open GLFW in let open Event in let open Ui in Ui.update_bindings ui (adds [ [ Key (Press, X, [ Control ]); Key (Press, E, [ Control ]) ]; ] [ Custom (fun () -> Lwt.return ()) ])); F.pr "oplevel.ml: entering drawing loop@."; let period_min = 1.0 /. 30. in let t = GLFW.getTime () |> ref in while (not GLFW.(windowShouldClose ~window)) && !continue do Lwt_main.run ((fun () -> let now = GLFW.getTime () in let dt = now -. !t in t := now; Perfgraph.update graph dt; if now > 2. then ( let avg = 1. /. Perfgraph.average graph in min_fps := Float.min avg !min_fps; max_fps := Float.max avg !max_fps); let _mx, _my = GLFW.getCursorPos ~window in let win_w, win_h = GLFW.getWindowSize ~window in Gl.viewport 0 0 win_w win_h; 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 width, height = (float win_w, float win_h) in let box = Gg.(Box2.v V2.zero Size2.(v width height)) in Gv.begin_frame ctx ~width ~height ~device_ratio:1.; Perfgraph.render graph ctx (width -. 205.) 5.; (* F.epr "box=%a@." Gg.Box2.pp box; F.epr "Painter.layout=%a@." Gg.Box2.pp *) Painter.layout box ui !page >>= fun _ -> (* 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 (); Unix.sleepf Float.(max 0. (period_min -. GLFW.getTime () +. !t)); Lwt.return_unit) ()) done; Printf.printf "MIN %.2f\n" !min_fps; Printf.printf "MAX %.2f\n%!" !max_fps; if Array.length Sys.argv = 1 then while not GLFW.(windowShouldClose ~window) do GLFW.pollEvents (); Unix.sleepf 0.25 done (* let out_ppf = Format.formatter_of_out_functions Format. { out_string = (fun s _ _ -> output_buffer#insert s); out_flush = (fun () -> ()); out_indent = (fun n -> for _ = 0 to n do output_buffer#insert " " done); out_newline = (fun () -> output_buffer#insert "\n"); out_spaces = (fun n -> output_buffer#insert (String.make n ' ')); } in *) (* ignore (Toploop.use_input out_ppf (String "#use \"topfind\";;\n#list;;")); *) (* ignore (Toploop.use_input Format.std_formatter (String text)); *) (* Wait for it to be closed. *)