oplevel/oplevel.ml

open Lwt.Infix
module F = Fmt
open Tgles2
module Gv = Graphv_gles2_native

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.3 0.3 0.32 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
  let blowup = ref false in

  (* Thread which is woken up when the main window is closed. *)
  let _waiter, _wakener = Lwt.wait () in

  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 ->
       GLFW.setKeyCallback ~window
         ~f:
           (Some
              (fun _ key _ state _ ->
                match (key, state) with
                | GLFW.Space, GLFW.Release -> blowup := not !blowup
                | _ -> ()))
       |> ignore;

       let t = GLFW.getTime () |> ref in
       while (not GLFW.(windowShouldClose ~window)) && !continue do
         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 win_w, win_h = (float win_w, float win_h) in
         Gv.begin_frame ctx ~width:win_w ~height:win_h
           ~device_ratio:1.;

         Perfgraph.render graph ctx (win_w -. 205.) 5.;

         let ui =
           Ogui.Ui.window ctx Gg.(Box2.v P2.o (P2.v 500. 500.))
         in
         ignore Ogui.TextEdit.(show (multiline (String text)) 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 ()
         (*continue := false;*)
       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;
       F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
       Toploop.initialize_toplevel_env ();

       (* 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. *)
       Lwt.return ())
       ())