basic cursor forward back

dune

@@ -20,17 +20,17 @@
    lwt
    store
    memtrace
+   glfw-ocaml
    tgls
    tgls.tgles2
    graphv_gles2_native
-   stb_image
-   glfw-ocaml
    gg
    irmin-git
    compiler-libs.toplevel
  )
  (link_flags (-linkall))
- (ocamlopt_flags (:standard -O3 -unboxed-types))
+ ; (ocamlopt_flags (:standard -O3 -unboxed-types))
+  (ocamlc_flags (:standard -verbose))
  (modes byte)
  (preprocess
   (pps ppx_irmin))

ogui.ml

@@ -181,11 +181,11 @@ module TextLayout = struct
           field "background" (fun s -> s.background) pp_color;
         ])
 
-  let text_format_default () =
+  let text_format_default =
     {
-      font_id = FontId ("sans", 12.0);
+      font_id = FontId ("mono", 18.0);
       extra_letter_spacing = 0.0;
-      line_height = None;
+      line_height = Some 19.;
       color = Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9;
       background = Gv.Color.transparent;
       italics = false;
@@ -195,7 +195,7 @@ module TextLayout = struct
     }
 
   let text_format_simple font_id color : text_format =
-    { (text_format_default ()) with font_id; color }
+    { text_format_default with font_id; color }
 
   type text_wrapping = {
     max_width : float;
@@ -242,14 +242,22 @@ module TextLayout = struct
           field "format" (fun s -> s.format) pp_text_format;
         ])
 
+  let layout_section_default =
+    {
+      leading_space = 0.0;
+      byte_range = (0, 0);
+      format = text_format_default;
+    }
+
   type layout_job = {
     text : string;
-    sections : layout_section list;
+    sections : layout_section array;
     wrap : text_wrapping;
     first_row_min_height : float;
     break_on_newline : bool;
     halign : align;
     justify : bool;
+    line_height : float option;
   }
 
   let pp_layout_job =
@@ -259,7 +267,7 @@ module TextLayout = struct
           field "text" (fun s -> String.length s.text) int;
           field "sections"
             (fun s -> s.sections)
-            (list pp_layout_section);
+            (array pp_layout_section);
           field "wrap" (fun s -> s.wrap) pp_text_wrapping;
           field "first_row_min_height"
             (fun s -> s.first_row_min_height)
@@ -272,12 +280,13 @@ module TextLayout = struct
   let default_layout_job () =
     {
       text = "";
-      sections = [];
+      sections = Array.make 0 layout_section_default;
       wrap = default_text_wrapping ();
       first_row_min_height = 0.0;
       break_on_newline = true;
       halign = Min;
       justify = false;
+      line_height = Some 18.;
     }
 
   type uv_rect = {
@@ -430,60 +439,141 @@ module TextLayout = struct
     prefer_next_row : bool;
   }
 
+  let cursor_default =
+    { index = 0; row = None; prefer_next_row = false }
+
   type cursor_range = cursor * cursor
   type cursor_state = cursor_range option
 
   let cursor_index = ref 0
+  let cursor_range c = ((fst c).index, (snd c).index)
 
-  let new_cursor ?(loc = 0) () =
+  let new_cursor ?(loc = 0) () : cursor =
     cursor_index := !cursor_index + 1;
     { index = loc; row = None; prefer_next_row = false }
 
-  let simple text (font : font_selection) color wrap_width :
+  let new_cursor_range (s, e) : cursor_range =
+    ( { cursor_default with index = s },
+      { cursor_default with index = e } )
+
+  let cursor_state_update ~(f : int -> int -> int * int)
+      (c : cursor_state) : cursor_state =
+    match c with
+    | Some (a, b) ->
+        let a', b' = f a.index b.index in
+        Some (new_cursor_range (max a' 0, max b' 0))
+    | None -> None
+
+  let layout_job text ?(format = text_format_default) wrap_width :
       layout_job =
     {
       (default_layout_job ()) with
       text;
       sections =
-        [
+        Array.make 1
           {
             leading_space = 0.0;
             byte_range = (0, String.length text);
-            format = text_format_simple font color;
+            format;
           };
-        ];
       wrap =
         { (default_text_wrapping ()) with max_width = wrap_width };
       break_on_newline = true;
     }
 
-  let simple_singleline text (font : font_selection) color :
+  let simple text (format : text_format) wrap_width : layout_job =
-      layout_job =
     {
       (default_layout_job ()) with
       text;
       sections =
-        [
+        Array.make 1
           {
             leading_space = 0.0;
             byte_range = (0, String.length text);
-            format = text_format_simple font color;
+            format;
+          };
+      wrap =
+        { (default_text_wrapping ()) with max_width = wrap_width };
+      break_on_newline = true;
+    }
+
+  let simple_singleline text (format : text_format) : layout_job =
+    {
+      (default_layout_job ()) with
+      text;
+      sections =
+        Array.make 1
+          {
+            leading_space = 0.0;
+            byte_range = (0, String.length text);
+            format;
           };
-        ];
       wrap = default_text_wrapping ();
       break_on_newline = true;
     }
 
-  let layout (gv : Gv.t) (fonts : Fonts.t) (job : layout_job) : galley
+  let cursor_color = ref (Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.)
-      =
+
-    F.epr "TextLayout.layout@.";
+  let default_cursor_formatter (f : text_format) =
-    F.epr "job.wrap.max_width=%f@." job.wrap.max_width;
+    { f with background = !cursor_color }
-    F.epr "job.wrap.max_rows=%d@." job.wrap.max_rows;
+
+  let with_cursor (cur : cursor_range)
+      ?(cursor_format = default_cursor_formatter) layout_job :
+      layout_job =
+    let cs, ce = ((fst cur).index, (snd cur).index) in
+    {
+      layout_job with
+      sections =
+        Array.of_list
+          (* Lol maybe this is inefficient? (or maybe not) *)
+          (List.fold_left
+             (fun (l : layout_section list) sec ->
+               let s, e = sec.byte_range in
+
+               if e < cs || ce < s then l @ [ sec ]
+               else
+                 l
+                 @ (if s = cs then
+                      [
+                        {
+                          sec with
+                          byte_range = (s, if ce > e then e else ce);
+                          format = cursor_format sec.format;
+                        };
+                      ]
+                    else if s < cs && cs <= e then
+                      (* cursor start in section *)
+                      [
+                        { sec with byte_range = (s, cs) };
+                        {
+                          sec with
+                          byte_range = (cs, if ce > e then e else ce);
+                          format = cursor_format sec.format;
+                        };
+                      ]
+                    else if cs < s && e < ce then
+                      [
+                        { sec with format = cursor_format sec.format };
+                      ]
+                    else [])
+                 @
+                 if ce > s && ce < e then
+                   [ { sec with byte_range = (ce, e) } ]
+                 else [])
+             []
+             (Array.to_list layout_job.sections));
+    }
+
+  let layout (gv : Gv.t) (fonts : Fonts.t) (job : layout_job)
+      (pos : v2) : galley =
+    (* F.epr "TextLayout.layout@.";
+       F.epr "job.wrap.max_width=%f@." job.wrap.max_widtha;
+       F.epr "job.wrap.max_rows=%d@." job.wrap.max_rows; *)
     if job.wrap.max_rows == 0 then
       {
         job;
         rows = Array.make 1 (row_default ());
-        rect = Box2.zero;
+        rect = Box2.move pos Box2.zero;
         mesh_bounds = Box2.zero;
         elided = true;
         num_vertices = 0;
@@ -497,20 +587,24 @@ module TextLayout = struct
         Gv.Text.break_lines gv ~break_width:job.wrap.max_width
           ~max_rows:job.wrap.max_rows ~lines job.text
       in
-      F.epr "row_count=%d@." row_count;
+      (* F.epr "row_count=%d@." row_count; *)
-      let height = ref 0. in
+      let height = ref (V2.y pos) in
       let max_width = ref 0. in
+      let line_height =
+        Option.value ~default:metrics.line_height job.line_height
+      in
       {
         job;
         rows =
           Array.init row_count (fun n ->
               let text_row = Array.get lines n in
-              height := !height +. metrics.line_height;
+              height := !height +. line_height;
               let rect =
                 Box2.v
-                  (P2.v text_row.minx !height)
+                  (P2.v (V2.x pos) !height)
-                  (P2.v text_row.maxx
+                  (P2.v
-                     (!height +. metrics.line_height))
+                     (text_row.width +. V2.x pos)
+                     (!height +. line_height))
               in
               max_width := Float.max text_row.maxx !max_width;
               {
@@ -529,7 +623,7 @@ module TextLayout = struct
         rect =
           Box2.v Size2.zero
             (P2.v job.wrap.max_width
-               (Float.of_int row_count *. metrics.line_height));
+               (Float.of_int row_count *. line_height));
         elided = row_count > job.wrap.max_rows (* TODO *);
         mesh_bounds = Box2.v Size2.zero (P2.v !max_width !height);
         num_indices = 0 (* TODO *);
@@ -551,30 +645,33 @@ module Painter = struct
   type t = Gv.t
 
   let galley (t : t) (g : TextLayout.galley) : unit =
-    F.epr
+    (* F.epr
          "Painter.galley (String.length g.job.text)=%d (Array.length \
           g.rows)=%d @."
          (String.length g.job.text)
          (Array.length g.rows);
-    F.epr "g.rect=%a@." Gg.Box2.pp g.rect;
+       F.epr "g.rect=%a@." Gg.Box2.pp g.rect; *)
-    F.epr "g.job=%a@." F.(braces TextLayout.pp_layout_job) g.job;
+
     (* F.epr "g.rows=%a@." F.(braces (array TextLayout.pp_row)) g.rows;*)
-    Array.iteri
+    Array.iter
       Gv.(
-        fun _n (row : TextLayout.row) ->
+        fun (row : TextLayout.row) ->
           let sections =
             List.filter
               (fun (r : TextLayout.layout_section) ->
-                row.text_row.start_index <= snd r.byte_range)
+                fst r.byte_range <= row.text_row.end_index
-              (nth_tl row.section_index_at_start g.job.sections)
+                && snd r.byte_range > row.text_row.start_index)
-            (* TODO don't need to iterate the whole list *)
+              (Array.to_list
+              @@ Array.sub g.job.sections row.section_index_at_start
+                   (Array.length g.job.sections
+                   - row.section_index_at_start))
           in
           assert (List.length sections > 0);
 
           ignore
-            (List.fold_left
             Gg.(
-                 fun x (sec : TextLayout.layout_section) ->
+              List.fold_left
+                (fun x (sec : TextLayout.layout_section) ->
                   let start, end_ =
                     ( min
                         (String.length g.job.text - 1)
@@ -590,7 +687,7 @@ module Painter = struct
 
                   let font_name, font_size =
                     match sec.format.font_id with
-                     | Default -> ("mono", 12.)
+                    | Default -> ("mono", 18.)
                     | FontId (s, size) -> (s, size)
                   in
                   Text.set_font_face t ~name:font_name;
@@ -598,8 +695,7 @@ module Painter = struct
                   Text.set_align t ~align:Align.(left lor top);
                   let metrics = Gv.Text.metrics t in
                   let bounds =
-                     Gv.Text.bounds t ~x:0. ~y:0. ~start ~end_
+                    Gv.Text.bounds t ~x ~y:0. ~start ~end_ g.job.text
-                       g.job.text
                   in
                   Path.begin_ t;
                   Path.rect t ~x ~y:(Box2.miny row.rect)
@@ -609,11 +705,11 @@ module Painter = struct
 
                   set_fill_color t ~color:sec.format.color;
                   let w =
-                     Text.text_w t ~x:(Box2.minx row.rect)
+                    Text.text_w t ~x ~y:(Box2.miny row.rect) ~start
-                       ~y:(Box2.miny row.rect) ~start ~end_ g.job.text
+                      ~end_ g.job.text
                   in
-                   x +. w)
+                  w)
-               0. sections))
+                (Box2.minx row.rect) sections))
       g.rows
 end
 
@@ -781,12 +877,23 @@ module Placer = struct
 end
 
 module Ui = struct
-  type t = {
+  type key_callback =
+    t ->
+    GLFW.window ->
+    GLFW.key ->
+    int ->
+    GLFW.key_action ->
+    GLFW.key_mod list ->
+    unit
+
+  and t = {
     id : id;
     style : Style.t;
     placer : Placer.t;
     enabled : bool;
     gv : Gv.t;
+    glfw_window : GLFW.window option;
+    mutable key : key_callback;
   }
 
   let id = ref 0
@@ -800,8 +907,9 @@ module Ui = struct
     (!id, size)
 
   let cursor_origin (ui : t) = Gg.Box2.o ui.placer.region.max_rect
+  let key_callback_default _ _ _ _ _ _ = ()
 
-  let window gv rect : t =
+  let window gv ?(window : GLFW.window option) rect : t =
     let id, rect = allocate_space gv rect in
     {
       id;
@@ -811,8 +919,20 @@ module Ui = struct
           Layout.{ min_rect = rect; max_rect = rect; cursor = rect };
       enabled = true;
       gv;
+      glfw_window = window;
+      key = key_callback_default;
     }
 
+  let keycallback t window key int state mods : unit =
+    t.key t window key int state mods
+
+  let add_key_callback (t : t) ~(f : key_callback) : unit =
+    let g = t.key in
+    t.key <-
+      (fun a1 a2 a3 a4 a5 a6 ->
+        f a1 a2 a3 a4 a5 a6;
+        g a1 a2 a3 a4 a5 a6)
+
   let interact (_ui : t) rect (id : id option) sense : Response.t =
     let id = Option.value id ~default:(-1) in
     {
@@ -852,8 +972,7 @@ module TextEdit = struct
     hint_text : TextLayout.widget_text;
     id : id option;
     id_source : id option;
-    font_selection : TextLayout.font_selection;
+    text_format : TextLayout.text_format;
-    text_color : Gv.Color.t option;
     layouter :
       (Ui.t -> TextBuffer.t -> float -> TextLayout.galley) option;
     password : bool;
@@ -872,14 +991,51 @@ module TextEdit = struct
   }
 
   type state = {
-    cursor : TextLayout.cursor_state;
+    mutable cursor : TextLayout.cursor_state;
     (* undoer : undoer; *)
     singleline_offset : float;
     last_edit_time : float;
   }
 
-  let load_state _ui _id =
+  let state_mem : (int * state) list ref = ref []
-    { cursor = None; singleline_offset = 0.0; last_edit_time = 0.0 }
+
+  let process_key (state : state) (key : GLFW.key)
+      (action : GLFW.key_action) (mods : GLFW.key_mod list) : unit =
+    let open GLFW in
+    match (action, key, mods) with
+    | Press, F, [ Control ] | Press, Right, [] ->
+        state.cursor <-
+          TextLayout.cursor_state_update
+            ~f:(fun a b ->
+              F.epr "cursor_state_update %d %d@." a b;
+              (a + 1, b + 1))
+            state.cursor
+    | Press, B, [ Control ] | Press, Left, [] ->
+        state.cursor <-
+          TextLayout.cursor_state_update
+            ~f:(fun a b ->
+              F.epr "cursor_state_update %d %d@." a b;
+              (a - 1, b - 1))
+            state.cursor
+    | _ -> ()
+
+  let load_state ui id =
+    match List.assoc_opt id !state_mem with
+    | Some state -> state
+    | None ->
+        let state =
+          {
+            cursor = Some (TextLayout.new_cursor_range (12, 13));
+            singleline_offset = 0.0;
+            last_edit_time = 0.0;
+          }
+        in
+        state_mem := (id, state) :: !state_mem;
+        (* We use this as the one shot for registering keyboard shortcuts
+           since they just operate on the state *)
+        Ui.add_key_callback ui ~f:(fun _ _ key _ action mods ->
+            process_key state key action mods);
+        state
 
   type output = {
     response : Response.t;
@@ -890,14 +1046,14 @@ module TextEdit = struct
     cursor_range : TextLayout.cursor_range option;
   }
 
-  let multiline (text : TextBuffer.t) : t =
+  let multiline ?(text_format = TextLayout.text_format_default)
+      (text : TextBuffer.t) : t =
     {
       text;
       hint_text = RichText TextLayout.rich_text_default;
       id = None;
       id_source = None;
-      font_selection = Default;
+      text_format;
-      text_color = Some (Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9);
       layouter = None;
       password = false;
       frame = true;
@@ -923,9 +1079,8 @@ module TextEdit = struct
 
   let show_content (t : t) (ui : Ui.t) : output =
     let origin = Ui.cursor_origin ui in
-    let text_color = t.text_color in
     (* TODO .or(ui.visuals().override_text_color) *)
-    let row_height = (Gv.Text.metrics ui.gv).line_height in
+    (* let row_height = (Gv.Text.metrics ui.gv).line_height in *)
     let available_width =
       Ui.available_width ui -. (t.margin.left +. t.margin.right)
     in
@@ -938,29 +1093,33 @@ module TextEdit = struct
         available_width
       else Float.min desired_width available_width
     in
-    let text_color =
+    let state = load_state ui (Option.value ~default:(-1) t.id) in
-      Option.value
-        ~default:(Gv.Color.rgbf ~r:0.5 ~g:0.5 ~b:0.5)
-        text_color
-    in
     let default_layouter (ui : Ui.t) (text : TextBuffer.t)
         (wrap_width : size1) : TextLayout.galley =
       let font =
-        match Gv.Text.find_font ui.gv ~name:"sans" with
+        match Gv.Text.find_font ui.gv ~name:"mono" with
         | Some gv -> Fonts.{ gv; pixels_per_point = 1.0 }
-        | None -> failwith "can't font font 'sans'"
+        | None -> failwith "can't font font 'mono'"
       in
       let layout_job =
         if t.multiline then
           TextLayout.simple
             (TextBuffer.as_string text)
-            t.font_selection text_color wrap_width
+            t.text_format wrap_width
         else
           TextLayout.simple_singleline
             (TextBuffer.as_string text)
-            t.font_selection text_color
+            t.text_format
       in
-      Ui.fonts ui.gv (fun f -> TextLayout.layout f font layout_job)
+      let layout_job =
+        TextLayout.with_cursor
+          (Option.value
+             ~default:(TextLayout.new_cursor_range (0, 0))
+             state.cursor)
+          layout_job
+      in
+      Ui.fonts ui.gv (fun f ->
+          TextLayout.layout f font layout_job origin)
     in
 
     let layouter =
@@ -972,9 +1131,6 @@ module TextEdit = struct
       if t.clip_text then wrap_width
       else Float.max (Size2.w (Box2.size galley_size)) wrap_width
     in
-    let _desired_height =
-      Float.min (Int.to_float t.desired_height_rows) 1.0 *. row_height
-    in
     let desired_inner_size =
       V2.v desired_width (Box2.maxy galley_size)
     in
@@ -987,7 +1143,7 @@ module TextEdit = struct
     let rect = Margin.inner t.margin outer_rect in
     (* TODO id = ui.make_persistent_id(id_source) else auto_id *)
     (* TODO state = TextEditState::load(ui.ctx(), id)... *)
-    let state = load_state ui.gv t.id in
+    (* TODO moved up let state = load_state (Option.value ~default:(-1) t.id) in *)
     (* TODO allow_drag_to_select = ... *)
     let sense = if t.interactive then Sense.click else Sense.hover in
 
@@ -1000,6 +1156,7 @@ module TextEdit = struct
     let galley_pos =
       Align.size_within_rect (Box2.size galley_size) rect
     in
+
     (*    if Ui.is_rect_visible ui rect then  *)
     Painter.galley ui.gv galley;
 

oplevel.ml

@@ -37,6 +37,153 @@ 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;
@@ -65,11 +212,13 @@ let () =
   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
+  F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
+  Toploop.initialize_toplevel_env ();
 
+  let text =
     Lwt_main.run
       ((fun () ->
          Store.init_default
@@ -85,18 +234,31 @@ let () =
              Lwt.return
                (F.str ".config/init.ml load exception: %s"
                   (Printexc.to_string exc)))
-       >>= fun text ->
+         >>= fun text -> Lwt.return text)
+         ())
+  in
+
+  let ui =
+    Ogui.Ui.window ctx ~window Gg.(Box2.v P2.o (P2.v 500. 500.))
+  in
+
   GLFW.setKeyCallback ~window
     ~f:
       (Some
-              (fun _ key _ state _ ->
+         (fun window key int state mods ->
-                match (key, state) with
+           F.epr
-                | GLFW.Space, GLFW.Release -> blowup := not !blowup
+             "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))
   |> ignore;
 
   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;
@@ -127,9 +289,6 @@ let () =
 
          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;
@@ -137,8 +296,9 @@ let () =
          Gc.major_slice 0 |> ignore;
 
          GLFW.swapBuffers ~window;
-         GLFW.pollEvents ()
+         GLFW.pollEvents ();
-         (*continue := false;*)
+         Lwt.return_unit)
+         ())
   done;
 
   Printf.printf "MIN %.2f\n" !min_fps;
@@ -148,11 +308,9 @@ let () =
     while not GLFW.(windowShouldClose ~window) do
       GLFW.pollEvents ();
       Unix.sleepf 0.25
-         done;
+    done
-       F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
-       Toploop.initialize_toplevel_env ();
 
-       (* let out_ppf =
+(* let out_ppf =
      Format.formatter_of_out_functions
        Format.
          {
@@ -169,10 +327,8 @@ let () =
          }
    in *)
 
-       (* ignore
+(* ignore
    (Toploop.use_input out_ppf
       (String "#use \"topfind\";;\n#list;;")); *)
-       (* ignore (Toploop.use_input Format.std_formatter (String text)); *)
+(* ignore (Toploop.use_input Format.std_formatter (String text)); *)
-       (* Wait for it to be closed. *)
+(* Wait for it to be closed. *)
-       Lwt.return ())
-       ())