diff --git a/dune b/dune index ef2aa88..1414199 100644 --- a/dune +++ b/dune @@ -28,6 +28,7 @@ irmin-git compiler-libs.toplevel re + lwd ) (link_flags (-linkall)) (ocamlopt_flags (:standard -O3 -unboxed-types)) diff --git a/ogui.ml b/ogui.ml index a23df7b..9c14db9 100644 --- a/ogui.ml +++ b/ogui.ml @@ -90,11 +90,25 @@ module TextBuffer = struct mutable path : string list; mutable tree : Store.S.tree; repo : Store.Sync.db Lwt.t; + var : string Lwd.var; } - let of_repo ~path ~(repo : Store.Sync.db Lwt.t) = + let of_repo ~path ~(repo : Store.Sync.db Lwt.t) : t Lwt.t = let tree = Lwt_main.run (repo >>= Store.S.tree) in - { path; tree; repo } + Store.S.Tree.find tree path >>= fun res -> + Lwt.return + { + path; + tree; + repo; + var = + Lwd.var + (match res with + | Some s -> s + | None -> + F.epr "TextBuffer.of_repo: None@."; + ""); + } let of_string ~path ?(repo = None) str = { @@ -103,13 +117,13 @@ module TextBuffer = struct repo = ( Store.S.Repo.v (Irmin_mem.config ()) >>= fun repo' -> Option.value ~default:Store.S.(empty repo') repo ); + var = Lwd.var str; } let insert_uchar t n uc : t Lwt.t = - F.epr "TextBuffer.insert_uchar %d %a@." n pp_uchar uc; - + (* F.epr "TextBuffer.insert_uchar %d %a@." n pp_uchar uc; *) match t with - | { path; tree; _ } as tt -> + | { path; tree; var; _ } as tt -> Store.S.Tree.update tree path (function | Some src -> let sn = String.length src in @@ -125,15 +139,16 @@ module TextBuffer = struct BytesLabels.blit_string ~src ~src_pos:n ~dst ~dst_pos:(n + uclen) ~len:(sn - (n + uclen)); - Some (Bytes.to_string dst) + Lwd.set var (Bytes.to_string dst); + Some (Lwd.peek var) | None -> None) >>= fun tree -> Lwt.return { tt with tree } let remove t (a, b) : t Lwt.t = let a, b = (min a b, max a b) in - F.epr "TextBuffer.remove (%d, %d)@." a b; + (* F.epr "TextBuffer.remove (%d, %d)@." a b; *) match t with - | { path; tree; _ } as tt -> + | { path; tree; var; _ } as tt -> Store.S.Tree.update tree path (function | Some src -> let srcn = String.length src in @@ -141,14 +156,15 @@ module TextBuffer = struct let dst = Bytes.create (srcn - (b - a)) in Bytes.blit_string src 0 dst 0 a; Bytes.blit_string src b dst a (srcn - b); + Lwd.set var (Bytes.to_string dst); Some (Bytes.to_string dst) | v -> v) >>= fun tree -> Lwt.return { tt with tree } let remove_uchar t n : t Lwt.t = - F.epr "TextBuffer.remove_subset n=%d @." n; + (* F.epr "TextBuffer.remove_subset n=%d @." n; *) match t with - | { path; tree; _ } as tt -> + | { path; tree; var; _ } as tt -> Store.S.Tree.update tree path (function | Some src -> let srcn = String.length src in @@ -159,8 +175,11 @@ module TextBuffer = struct let dst = Bytes.create (srcn - ucn) in Bytes.blit_string src 0 dst 0 n; Bytes.blit_string src (n + ucn) dst n (srcn - n - ucn); + Lwd.set var (Bytes.to_string dst); Some (Bytes.to_string dst) - | v -> v) + | None -> + F.epr "TextBuffer.remove_uchar None"; + None) >>= fun tree -> Lwt.return { tt with tree } let fold_string t (f : string -> 'a) : 'a Lwt.t = @@ -168,6 +187,8 @@ module TextBuffer = struct | { path; tree; _ } -> Store.S.Tree.get tree path >>= fun text -> Lwt.return (f text) + let get t = Lwd.get t.var + let contents { path; tree; _ } = (try Store.S.Tree.get tree path with | Not_found | Invalid_argument _ -> @@ -503,19 +524,16 @@ module TextLayout = struct ]) let cursor_default = { index = 0; last_col = 0 } + let cursor ?(last_col = 0) index : cursor = { index; last_col } - let cursor ?(last_col = 0) index : cursor = - F.epr "cursor last_col=%d index=%d@." last_col index; - { index; last_col } - - let simple text ?(start = 0) ?(format = format_default) wrap_width : - layout Lwt.t = - TextBuffer.fold_string text (fun s -> + let simple (text : 'a) ?(start = Lwd.pure 0) + ?(format = format_default) wrap_width : layout Lwd.t = + Lwd.map2 (TextBuffer.get text) start ~f:(fun str start -> { layout_default with text; sections = - [ { byte_range = (start, String.length s); format } ]; + [ { byte_range = (start, String.length str); format } ]; wrap = { (default_text_wrapping ()) with max_width = wrap_width }; }) @@ -566,17 +584,19 @@ module TextLayout = struct [] layout.sections; } - let with_cursor (cur : cursor) ?(format = default_cursor_formatter) - layout : layout = - let c = with_range (cur.index, cur.index + 1) ~format layout in - c + let with_cursor (cursor : cursor Lwd.t) + ?(format = default_cursor_formatter) layout : layout Lwd.t = + Lwd.map2 cursor layout ~f:(fun c l -> + with_range (c.index, c.index + 1) ~format l) - let with_mark (mark : int option) (cur : int) - ?(format = default_mark_formatter) layout : layout = - match mark with - | Some mark' -> - with_range ~format (min mark' cur, max mark' cur) layout - | None -> layout + let with_mark (mark : int option Lwd.t) (cursor : cursor Lwd.t) + ?(format = default_mark_formatter) layout : layout Lwd.t = + Lwd.bind layout ~f:(fun l -> + Lwd.map2 mark cursor ~f:(fun m c -> + match m with + | Some m' -> + with_range ~format (min m' c.index, max m' c.index) l + | None -> l)) end let rec nth_tl n = function @@ -585,11 +605,11 @@ let rec nth_tl n = function module Ui = struct type t = { - mutable rect : Gg.box2; + rect : Gg.box2 Lwd.var; enabled : bool; gv : Gv.t; glfw_window : GLFW.window option; - mutable bindings : action list Event.t; + bindings : action list Event.t Lwd.var; } and action = Custom of (unit -> unit Lwt.t) @@ -602,7 +622,7 @@ module Ui = struct enabled = true; gv; glfw_window = window; - bindings = Event.empty; + bindings = Lwd.var Event.empty; } let callback_resolver : action list Event.resolver option ref = @@ -613,7 +633,13 @@ module Ui = struct let res = match !callback_resolver with | Some res -> res - | None -> Event.resolver [ Event.pack Fun.id t.bindings ] + | None -> + Event.resolver + [ + Event.pack Fun.id + (t.bindings |> Lwd.get |> Lwd.observe + |> Lwd.quick_sample); + ] in (*Event.( @@ -636,7 +662,7 @@ module Ui = struct let update_bindings ui (f : action list Event.t -> action list Event.t) = - ui.bindings <- f ui.bindings + Lwd.set ui.bindings (f (Lwd.peek ui.bindings)) let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref = ref (fun _c -> @@ -682,11 +708,11 @@ module TextEdit = struct open Gg type t = { - mutable text : TextBuffer.t; - mutable cursor : TextLayout.cursor; - mutable mark : int option; - mutable scroll : int; - mutable rows : int; + text : TextBuffer.t; + cursor : TextLayout.cursor Lwd.var; + mark : int option Lwd.var; + scroll : int Lwd.var; + rows : int Lwd.var; text_format : TextLayout.format; formatter : (Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option; @@ -706,8 +732,8 @@ module TextEdit = struct let col t = TextBuffer.fold_string t.text (fun s -> - t.cursor.index - - Str.search_backward (Str.regexp "^") s t.cursor.index) + let c = Lwd.peek t.cursor in + c.index - Str.search_backward (Str.regexp "^") s c.index) let rec newlines (s : string) (i : int) : int list = match String.index_from_opt s i '\n' with @@ -735,20 +761,21 @@ module TextEdit = struct let scroll_update ({ text; cursor; scroll; rows; _ } as t : t) : unit Lwt.t = TextBuffer.fold_string text (fun s -> + let cursor = Lwd.peek cursor in + let rows = Lwd.peek rows in let slen = String.length s in - if cursor.index < scroll then + if cursor.index < Lwd.peek scroll then match String.rindex_from_opt s (min (slen - 1) (cursor.index - 1)) '\n' with - | Some i' -> t.scroll <- i' + 1 - | None -> t.scroll <- 0 + | Some i' -> Lwd.set t.scroll (i' + 1) + | None -> Lwd.set t.scroll 0 else - match index_rows_from s scroll rows with + match index_rows_from s (Lwd.peek scroll) rows with | None -> () | Some eow -> ( - F.epr "eow=%d@." eow; if cursor.index >= eow then match rindex_rows_from s @@ -756,14 +783,16 @@ module TextEdit = struct rows with | None -> () - | Some i' -> t.scroll <- i')) + | Some i' -> Lwd.set t.scroll i')) let cursor_update (t : t) (f : int -> int) : unit Lwt.t = col t >>= fun last_col -> TextBuffer.fold_string t.text (fun s -> - t.cursor <- - TextLayout.cursor ~last_col - (f t.cursor.index |> max 0 |> min (String.length s))) + Lwd.set t.cursor + (TextLayout.cursor ~last_col + (f (Lwd.peek t.cursor).index + |> max 0 + |> min (String.length s)))) >>= fun () -> scroll_update t let cursor_move (t : t) (amt : int) : unit Lwt.t = @@ -810,16 +839,18 @@ module TextEdit = struct Str.search_forward (Str.regexp "$") in let next_bol = - min sn (seol s t.cursor.index + 1) + min sn (seol s (Lwd.peek t.cursor).index + 1) in let next_line_len = seol s next_bol - next_bol in next_bol + - if t.cursor.last_col > next_line_len then - next_line_len - else min next_line_len t.cursor.last_col) + if (Lwd.peek t.cursor).last_col > next_line_len + then next_line_len + else + min next_line_len + (Lwd.peek t.cursor).last_col) >>= cursor_set t); ] |> adds @@ -836,7 +867,7 @@ module TextEdit = struct let sbol = Str.search_backward (Str.regexp "^") s in - let bol = sbol t.cursor.index in + let bol = sbol (Lwd.peek t.cursor).index in if bol > 0 then let prev_bol = sbol (max 0 (bol - 1)) in let prev_line_len = bol - 1 - prev_bol in @@ -847,10 +878,14 @@ module TextEdit = struct t.cursor.index bol prev_bol prev_line_len; *) prev_bol + - if t.cursor.last_col > prev_line_len then - prev_line_len - else min prev_line_len t.cursor.last_col - else t.cursor.index) + if + (Lwd.peek t.cursor).last_col + > prev_line_len + then prev_line_len + else + min prev_line_len + (Lwd.peek t.cursor).last_col + else (Lwd.peek t.cursor).index) >>= cursor_set t); ] |> adds (* EOL *) @@ -864,14 +899,14 @@ module TextEdit = struct TextBuffer.fold_string t.text (fun s -> let bol = Str.search_backward (Str.regexp "^") s - t.cursor.index + (Lwd.peek t.cursor).index in let eol = Str.search_forward (Str.regexp "$") s - t.cursor.index + (Lwd.peek t.cursor).index in - t.cursor <- - TextLayout.cursor ~last_col:(eol - bol) eol)); + Lwd.set t.cursor + @@ TextLayout.cursor ~last_col:(eol - bol) eol)); ] |> adds (* BOL *) [ @@ -882,10 +917,10 @@ module TextEdit = struct Custom (fun () -> TextBuffer.fold_string t.text (fun s -> - t.cursor <- - TextLayout.cursor ~last_col:0 - (Str.search_backward (Str.regexp "^") s - t.cursor.index))); + Lwd.set t.cursor + @@ TextLayout.cursor ~last_col:0 + (Str.search_backward (Str.regexp "^") s + (Lwd.peek t.cursor).index))); ] |> adds [ @@ -895,20 +930,19 @@ module TextEdit = struct [ Custom (fun () -> - match t.mark with + match Lwd.peek t.mark with | Some mark -> - TextBuffer.remove t.text (mark, t.cursor.index) - >>= fun text -> - t.text <- text; - t.mark <- None; - cursor_set t (min mark t.cursor.index) + TextBuffer.remove t.text + (mark, (Lwd.peek t.cursor).index) + >>= fun _ -> + Lwd.set t.mark None; + cursor_set t + (min mark (Lwd.peek t.cursor).index) | None -> - if t.cursor.index > 0 then ( + if (Lwd.peek t.cursor).index > 0 then TextBuffer.remove_uchar t.text - (t.cursor.index - 1) - >>= fun text -> - t.text <- text; - cursor_move t (-1)) + ((Lwd.peek t.cursor).index - 1) + >>= fun _ -> cursor_move t (-1) else Lwt.return_unit); ] |> adds @@ -918,20 +952,19 @@ module TextEdit = struct (fun () -> TextBuffer.fold_string t.text (fun s -> TextBuffer.remove t.text - ( t.cursor.index, + ( (Lwd.peek t.cursor).index, let eol = Str.search_forward (Str.regexp "$") s - t.cursor.index + (Lwd.peek t.cursor).index in if - eol == t.cursor.index + eol == (Lwd.peek t.cursor).index && String.length s > eol then eol + 1 else eol ) - >>= fun text -> - t.text <- text; - t.mark <- None; - cursor_set t t.cursor.index) + >>= fun _ -> + Lwd.set t.mark None; + cursor_set t (Lwd.peek t.cursor).index) >>= fun u -> u); ] |> adds @@ -941,30 +974,26 @@ module TextEdit = struct [ Custom (fun () -> - TextBuffer.insert_uchar t.text t.cursor.index - (Uchar.of_char '\n') - >>= fun text -> - t.text <- text; - cursor_move t 1); + TextBuffer.insert_uchar t.text + (Lwd.peek t.cursor).index (Uchar.of_char '\n') + >>= fun _ -> cursor_move t 1); ] |> adds [ [ Key (Press, Space, [ Control ]) ] ] (* Mark set *) [ Custom (fun () -> - t.mark <- - (match t.mark with + Lwd.set t.mark + (match Lwd.peek t.mark with | Some _ -> None - | None -> Some t.cursor.index); + | None -> Some (Lwd.peek t.cursor).index); Lwt.return_unit); ]); (* WARN XXX TKTK TODO this is probably "breaking" the lwt context and being used in other calls to Lwt_main.run *) (Ui.chrcallback_ref := fun c -> - TextBuffer.insert_uchar t.text t.cursor.index c - >>= fun text -> - t.text <- text; - cursor_move t 1 + TextBuffer.insert_uchar t.text (Lwd.peek t.cursor).index c + >>= fun _ -> cursor_move t 1 (* This creates a giant stack of calls lol >>= fun () -> !Ui.chrcallback_ref c *)); Lwt.return_unit @@ -974,10 +1003,10 @@ module TextEdit = struct let t = { text; - cursor = TextLayout.cursor 0; - mark = None; - scroll = 0; - rows = 0; + cursor = Lwd.var (TextLayout.cursor 0); + mark = Lwd.var None; + scroll = Lwd.var 0; + rows = Lwd.var 0; text_format; formatter = None; password = false; @@ -1009,7 +1038,7 @@ module Layout = struct [ `Box of [ `H | `V | `Z ] * frame list | `String of string | `Buffer of TextBuffer.t - | `TextEdit of TextEdit.t + | `TextEdit of TextEdit.t * TextLayout.layout Lwd.root | `None ] and size = [ `Fixed of size2 | `Max | `Min ] @@ -1028,8 +1057,14 @@ module Layout = struct margin = Margin.symmetric 10. 10.; } - let textedit ?size ?(style = textedit_style) te = - frame ?size ~style (`TextEdit te) + let textedit ?size ?(style = textedit_style) (t : TextEdit.t) = + let open TextLayout in + simple t.text ~start:(Lwd.get t.scroll) ~format:t.text_format + (Option.value ~default:80. t.desired_width) + |> with_cursor (Lwd.get t.cursor) + |> with_mark (Lwd.get t.mark) (Lwd.get t.cursor) + |> Lwd.observe + |> fun root -> frame ?size ~style (`TextEdit (t, root)) let pp_dir ppf (t : [ `H | `V | `Z ]) = F.pf ppf "%s" @@ -1097,19 +1132,20 @@ module Painter = struct Text.set_align t ~align:Align.(left lor top) let text_layout (t : Gv.t) (rect : box2) (te : TextEdit.t) - (g : TextLayout.layout) : box2 Lwt.t = + (layout : TextLayout.layout Lwd.root) : box2 Lwt.t = + let g = Lwd.quick_sample layout in let line_height = Option.value ~default:(Gv.Text.metrics t).line_height g.line_height in let max_rows = Int.of_float (Box2.h rect /. line_height) in - te.rows <- max_rows; + Lwd.set te.rows max_rows; let lines = Gv.Text.make_empty_rows max_rows in TextBuffer.contents g.text >>= fun contents -> let contents_len = String.length contents in let row_count = Gv.Text.break_lines t ~break_width:(Box2.w rect) ~max_rows - ~lines ~start:te.scroll contents + ~lines ~start:(Lwd.peek te.scroll) contents in Seq.fold_left (fun ((cur, start) : p2 * int) (row : Gv.Text.text_row) -> @@ -1155,17 +1191,17 @@ module Painter = struct |> fun cur'' -> ( V2.(v (max (x cur) (x cur'')) (y cur'' +. line_height)), row.next )) - (Box2.o rect, te.scroll) + (Box2.o rect, Lwd.peek te.scroll) (Seq.take row_count (Array.to_seq lines)) |> fst |> (fun cur''' -> V2.(cur''' - v 0. line_height)) |> Box2.(of_pts (o rect)) |> Lwt.return - let rec layout (box : box2) (ui : Ui.t) (frame : frame) : box2 Lwt.t - = - let box' = Margin.inner frame.style.margin box in - (match frame.t with + let rec layout (box : box2) (ui : Ui.t) ({ t; style; _ } : frame) : + box2 Lwt.t = + let box' = Margin.inner style.margin box in + (match t with | `Box (dir, ll) -> Lwt_list.fold_left_s (fun (c : box2) f -> @@ -1179,23 +1215,14 @@ module Painter = struct in Lwt.return c') box' ll - | `TextEdit t -> - TextLayout.( - simple t.text ~start:t.scroll ~format:t.text_format - (Option.value ~default:(Box2.w box') t.desired_width) - >>= fun layout -> - with_cursor t.cursor layout - |> with_mark t.mark t.cursor.index - |> text_layout ui.gv box' t) + | `TextEdit (t, root) -> text_layout ui.gv box' t root | _ -> Lwt.return box) >>= fun r -> let r' = Box2.add_pt r - V2.( - Box2.max r - + v frame.style.margin.right frame.style.margin.bottom) - |> Margin.outer frame.style.margin + V2.(Box2.max r + v style.margin.right style.margin.bottom) + |> Margin.outer style.margin in - draw_box ui.gv ~box:r' ~style:frame.style; + draw_box ui.gv ~box:r' ~style; Lwt.return r' end diff --git a/oplevel.ml b/oplevel.ml index 0d83aa9..874dade 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -18,7 +18,7 @@ end let errorcb error desc = Printf.printf "GLFW error %d: %s\n%!" error desc -let load_data vg = +let load_fonts vg = let _ = Gv.Text.create vg ~name:"mono" ~file:"./assets/mono.ttf" in let _ = Gv.Text.create vg ~name:"icons" ~file:"./assets/entypo.ttf" @@ -62,8 +62,6 @@ let () = 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 @@ -78,9 +76,11 @@ let () = in let ui = - Ogui.Ui.window ctx ~window Gg.(Box2.v P2.o (P2.v 500. 500.)) + Ogui.Ui.window ctx ~window + (Lwd.var Gg.(Box2.v P2.o (P2.v 500. 500.))) in + load_fonts ui.gv; GLFW.setKeyCallback ~window ~f: (Some @@ -100,7 +100,7 @@ let () = F.pr "oplevel.ml: building initial page@."; let page = - ref + Lwd.var Layout.( vbox ~style: @@ -108,82 +108,76 @@ let () = [ textedit (TextEdit.multiline ui - (TextBuffer.of_repo - ~path:[ ".config"; "init.ml" ] - ~repo:rootrepo)); + (Lwt_main.run + (TextBuffer.of_repo + ~path:[ ".config"; "init.ml" ] + ~repo:rootrepo))); (*textedit (TextEdit.multiline ui (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo)); *) ]) in - (let open GLFW in - let open Event in - let open Ui in - Ui.update_bindings ui - (adds + let open GLFW in + let open Event in + Ui.update_bindings ui + Ui.( + adds [ [ Key (Press, X, [ Control ]); Key (Press, E, [ Control ]) ]; ] - [ Custom (fun () -> Lwt.return ()) ])); + [ 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; + let render page = + let now = GLFW.getTime () in + let dt = now -. !t in + t := now; - 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); + Perfgraph.update graph dt; - let _mx, _my = GLFW.getCursorPos ~window in - let win_w, win_h = GLFW.getWindowSize ~window in + 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); - 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 _mx, _my = GLFW.getCursorPos ~window in + let win_w, win_h = GLFW.getWindowSize ~window in - let width, height = (float win_w, float win_h) in - let box = - Gg.(Box2.v V2.zero Size2.(v width (height -. 20.))) - 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; + 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; - Gc.major_slice 0 |> ignore; - GLFW.swapBuffers ~window; - GLFW.pollEvents (); - Unix.sleepf - Float.(max 0. (period_min -. GLFW.getTime () +. !t)); - Lwt.return_unit) - ()) + let width, height = (float win_w, float win_h) in + let box = Gg.(Box2.v V2.zero Size2.(v width (height -. 20.))) 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 + in + + while not GLFW.(windowShouldClose ~window) do + Lwt_main.run (render (Lwd.peek page)) 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 + Printf.printf "MAX %.2f\n%!" !max_fps (* let out_ppf = Format.formatter_of_out_functions @@ -205,5 +199,3 @@ let () = (* 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. *)