basic text field edition

boot_js.ml

@@ -94,24 +94,28 @@ let _ =
   let ui =
     Nottui_widgets.(
       let string s = Lwd.pure @@ Nottui_widgets.string s in
-      scroll_area
+      line_table_of_string
-      @@ Lwd_utils.pack Ui.pack_y
+        "edit me?\n\
-           [
+         derp derp derp\n\
-             edit_field edit_me;
+         herp herp derp\n\
-             string "derp derp derp";
+         ding dong beep beep"
-             string "herp herp derp";
+      (* @@ Lwd_utils.pack Ui.pack_y
-             string "ding dong beep beep";
+            [
-             string "derp derp derp";
+              edit_field edit_me;
-             string "herp herp derp";
+              string "derp derp derp";
-             string "ding dong beep beep";
+              string "herp herp derp";
-             string "derp derp derp";
+              string "ding dong beep beep";
-             string "herp herp derp";
+              string "derp derp derp";
-             string "ding dong beep beep";
+              string "herp herp derp";
-             string "derp derp derp";
+              string "ding dong beep beep";
-             string "herp herp derp";
+              string "derp derp derp";
-             string "ding dong beep beep";
+              string "herp herp derp";
-             main_menu_item wm "Quit" (fun () -> exit 0);
+              string "ding dong beep beep";
-           ])
+              string "derp derp derp";
+              string "herp herp derp";
+              string "ding dong beep beep";
+              main_menu_item wm "Quit" (fun () -> exit 0);
+            ] *))
   in
   let root =
     Lwd.set body

human.ml

@@ -256,8 +256,7 @@ module Git_console_http = struct
           | Ok (_resp, contents) ->
               Lwt.return_ok (`Data (Cstruct.of_string contents))
           | Error err ->
-              Lwt.return_error
+              Lwt.return_error (`Msg (Fmt.str "%a" pp_error err)))
-                (`Msg (Fmt.str "%a" Git_af.pp_error err)))
 
     let close _ = Lwt.return_unit
 
@@ -489,14 +488,6 @@ module Input = struct
   type code =
     [ `Uchar of Uchar.t (* A unicode character. *) | special ]
 
-  type mods = [ `Super | `Meta | `Ctrl | `Shift ] list
-
-  type mouse =
-    [ `Press of button | `Drag | `Release ] * (float * float) * mods
-
-  type paste = [ `Start | `End ]
-  type keyaction = [ `Press | `Release | `Repeat ]
-
   (* stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *)
   let string_of_code = function
     | `Uchar ch ->
@@ -518,6 +509,25 @@ module Input = struct
     | `Delete -> "Delete"
     | `Backspace -> "Backspace"
     | `Unknown s -> String.concat "Unknown " [ "\""; s; "\"" ]
+    | _ -> "Code Unknown!"
+
+  let pp_code ppf v = F.pf ppf "%s" (string_of_code v)
+
+  type mods = [ `Super | `Meta | `Ctrl | `Shift ] list
+
+  let pp_mods =
+    F.(
+      list (fun ppf -> function
+        | `Super -> pf ppf "`Super"
+        | `Meta -> pf ppf "`Meta"
+        | `Ctrl -> pf ppf "`Ctrl"
+        | `Shift -> pf ppf "`Shift"))
+
+  type mouse =
+    [ `Press of button | `Drag | `Release ] * (float * float) * mods
+
+  type paste = [ `Start | `End ]
+  type keyaction = [ `Press | `Release | `Repeat ]
 end
 
 module Event_js = struct
@@ -583,14 +593,17 @@ module NVG = struct
     and lightcyan = rgbf ~r:0.5 ~g:1.0 ~b:1.0
     and lightwhite = rgbf ~r:1.0 ~g:1.0 ~b:1.0
 
+    let ( = ) a b = a.r = b.r && a.g = b.g && a.b = b.b && a.a = b.a
+
     let ( ++ ) a b =
-      (* {
+      {
-         r = Float.clamp ~min:0. ~max:1. (a.r +. b.r);
+        r = Float.clamp ~min:0. ~max:1. (a.r +. b.r);
-         g = Float.clamp ~min:0. ~max:1. (a.g +. b.g);
+        g = Float.clamp ~min:0. ~max:1. (a.g +. b.g);
-         b = Float.clamp ~min:0. ~max:1. (a.b +. b.b);
+        b = Float.clamp ~min:0. ~max:1. (a.b +. b.b);
-         a = Float.clamp ~min:0. ~max:1. (a.a +. b.a);
+        a = Float.clamp ~min:0. ~max:1. (a.a +. b.a);
-         } *)
+      }
-      if a = none then b else a
+
+    let replace ~prev ~next = if next = none then prev else next
 
     let pp ppf t : unit =
       if t != none then
@@ -746,6 +759,8 @@ module Style = struct
       match t.font with
       | `Sans -> Text.set_font_face vg ~name:"sans"
       | _ -> ()
+
+    let replace ~prev ~next = merge prev next
   end
 
   type t = { fg : Color.t; bg : Color.t; font : Font.t }
@@ -772,6 +787,13 @@ module Style = struct
       font = Font.merge a1.font a2.font;
     }
 
+  let replace ~prev ~next =
+    {
+      fg = Color.replace ~prev:prev.fg ~next:next.fg;
+      bg = Color.replace ~prev:prev.bg ~next:next.bg;
+      font = Font.replace ~prev:prev.font ~next:next.font;
+    }
+
   let fg ?(t = empty) c = { t with fg = c }
   let bg ?(t = empty) c = { t with bg = c }
   let font ?(t = empty) c = { t with font = c }
@@ -823,15 +845,19 @@ module I = struct
     V2.(v (Float.max (x p1) (x p2)) (Float.max (y p1) (y p2)))
     [@@inline]
 
+  let bounds_segment vg p : Text.t -> NVG.Text.bounds = function
+    | String s ->
+        let open NVG.Text in
+        let { ascender; _ } = NVG.Text.metrics vg in
+        bounds vg ~x:(V2.x p) ~y:(V2.y p +. ascender) s
+
   let rec size vg p = function
     | Empty -> V2.zero
     | Segment s ->
-        let NVG.Bounds.{ xmin; ymin; xmax; ymax } =
+        let NVG.Text.{ box = { ymax; ymin; _ }; advance } =
-          (NVG.Text.bounds vg ~x:(V2.x p) ~y:(V2.y p)
+          bounds_segment vg p s
-             (Text.to_string s))
-            .box
         in
-        V2.v (xmax -. xmin) (ymax -. ymin)
+        V2.v advance (ymax -. ymin)
     | Attr (t, _a) -> size vg p t
     | Hcompose (t1, t2) ->
         let p1 = size vg p t1 in
@@ -853,7 +879,7 @@ module I = struct
   let void w h = Void (P2.v w h)
 
   let attr a = function
-    | Attr (t, a0) -> Attr (t, A.(a ++ a0))
+    | Attr (t, a0) -> Attr (t, A.(replace ~prev:a0 ~next:a))
     | t -> Attr (t, a)
 
   let ( <|> ) t1 t2 =
@@ -877,11 +903,11 @@ module I = struct
   (* crop is positive value, pad is negative *)
 
   let hcrop left right img =
-    Log.debug (fun m -> m "Hcrop (%f, %f)" left right);
+    (* Log.debug (fun m -> m "Hcrop (%f, %f)" left right); *)
     Hcrop (img, left, right)
 
   let vcrop top bottom img =
-    Log.debug (fun m -> m "Vcrop (%f, %f)" top bottom);
+    (* Log.debug (fun m -> m "Vcrop (%f, %f)" top bottom); *)
     Vcrop (img, top, bottom)
 
   let crop ?(l = 0.) ?(r = 0.) ?(t = 0.) ?(b = 0.) img =
@@ -1042,7 +1068,7 @@ module I = struct
       set_fill_color vg ~color;
       fill vg;
       NVG.restore vg;
-      Log.debug (fun m -> m "fill_box: %a" Box2.pp b);
+      (* Log.debug (fun m -> m "fill_box: %a" Box2.pp b); *)
       Box2.size b
 
     let path_box vg color ?(width = 0.) b =
@@ -1073,8 +1099,9 @@ module I = struct
       | Segment v -> fmt "@[<h>Segment %a@]" ppf Text.pp v
       | Attr (t, a) ->
           fmt "@[<h>Attr %a@]" ppf
-            (pair ~sep:comma A.pp (pp ~attr:A.(attr ++ a)))
+            (pair ~sep:comma A.pp
-            (A.(attr ++ a), t)
+               (pp ~attr:A.(replace ~prev:attr ~next:a)))
+            (A.(replace ~prev:attr ~next:a), t)
       | Hcompose a -> fmt "Hcat %a" ppf compose a
       | Vcompose a -> fmt "Vcat %a" ppf compose a
       | Zcompose a -> fmt "Zcat %a" ppf compose a
@@ -1084,18 +1111,37 @@ module I = struct
           fmt "Vcrop (%.1f,%.1f,%a)" ppf top bottom (pp ~attr) t
       | Void dim -> fmt "Void %a" ppf (parens V2.pp) dim
 
+    let segment_kern_cache = ref (Box2.zero, "")
+
     let rec segment vg p : Text.t -> P2.t = function
       | String s ->
           (* Log.debug (fun m -> m "I.Draw.segment p=%a %s" Gg.V2.pp p s); *)
+          (* let p' =
+               let cache_p, cache_s = !segment_kern_cache in
+               (* tries to get the kerning right across segments *)
+               if V2.(equal (Box2.max cache_p) p) then
+                 V2.(
+                   Box2.o cache_p
+                   + v
+                       ((bounds_segment vg (Box2.o cache_p)
+                           (Text.of_string (cache_s ^ s)))
+                          .advance
+                      -. (bounds_segment vg p (Text.of_string s)).advance
+                       )
+                       0.)
+               else p
+             in *)
           let metrics = NVG.Text.metrics vg in
           NVG.Text.text vg ~x:(V2.x p)
             ~y:(V2.y p +. metrics.ascender)
-              (* TODO make segments include neighbors so kerning is correct *)
             s;
-          let NVG.Bounds.{ xmin; ymin; xmax; ymax } =
+
-            (NVG.Text.bounds vg ~x:(V2.x p) ~y:(V2.y p) s).box
+          let sz =
+            V2.v (bounds_segment vg p (Text.of_string s)).advance
+              metrics.line_height
           in
-          V2.v (xmax -. xmin) (ymax -. ymin)
+          segment_kern_cache := (Box2.(v p sz), s);
+          sz
 
     and node vg attr p n : p2 =
       (* returns the *size* of the drawn area not the max coordinates anymore *)
@@ -1104,12 +1150,12 @@ module I = struct
         | Empty | Void _ -> p
         | Segment text -> segment vg p text
         | Attr (i, a) ->
-            let a0 = A.(attr ++ a) in
+            let a0 = A.(replace ~prev:attr ~next:a) in
             if
-              A.(a0.bg) != NVG.Color.transparent
+              (A.(a.bg) != A.(attr.bg))
-              && A.(a0.bg) != A.(attr.bg)
+              && A.(a0.bg) != NVG.Color.transparent
             then fill_box vg a0.bg (Box2.v p (size vg p i)) |> ignore;
-            if A.(attr.fg) != a0.fg then (
+            if A.(attr.fg) != a.fg then (
               NVG.set_fill_color vg ~color:Style.(a0.fg);
               NVG.set_stroke_color vg ~color:Style.(a0.fg));
             node vg a0 p i
@@ -1287,6 +1333,10 @@ module Nottui = struct
   module Ui = struct
     type may_handle = [ `Unhandled | `Handled ]
 
+    let pp_may_handle ppf = function
+      | `Unhandled -> F.pf ppf "`Unhandled"
+      | `Handled -> F.pf ppf "`Unhandled"
+
     type mouse_handler =
       x:float ->
       y:float ->
@@ -1309,6 +1359,25 @@ module Nottui = struct
       [ Input.special | `Uchar of Uchar.t | semantic_key ]
       * Input.mods
 
+    let pp_key =
+      F.(
+        pair
+          (fun ppf v ->
+            match v with
+            | `Copy -> pf ppf "`Copy"
+            | `Paste -> pf ppf "`Paste"
+            | `Focus v ->
+                pf ppf "`Focus %s"
+                  (match v with
+                  | `Next -> "`Next"
+                  | `Prev -> "`Prev"
+                  | `Left -> "`Left"
+                  | `Right -> "`Right"
+                  | `Up -> "`Up"
+                  | `Down -> "`Down")
+            | a -> pf ppf "%a" Input.pp_code a)
+          Input.pp_mods)
+
     type mouse = Input.mouse
 
     type event =
@@ -1627,11 +1696,11 @@ module Nottui = struct
           (a +. ratio, b +. flex -. ratio)
         else (a, b)
       in
-      Log.debug (fun m ->
+      (* Log.debug (fun m ->
-          m
+               m
-            "split: a=%.1f sa=%.1f b=%.1f sb=%.1f total=%.1f (%.1f, \
+                 "split: a=%.1f sa=%.1f b=%.1f sb=%.1f total=%.1f (%.1f, \
-             %.1f)"
+                  %.1f)"
-            a sa b sb total a' b');
+                 a sa b sb total a' b'); *)
       (a', b')
 
     let pack ~fixed ~stretch total g1 g2 =
@@ -1645,9 +1714,9 @@ module Nottui = struct
           | `Neutral -> (flex /. 2., fixed)
           | `Positive -> (flex, fixed)
       in
-      Log.debug (fun m ->
+      (* Log.debug (fun m ->
-          m "pack fixed=%.1f stretch=%.1f total=%.1f (%.1f, %.1f)"
+           m "pack fixed=%.1f stretch=%.1f total=%.1f (%.1f, %.1f)"
-            fixed stretch total v1 v2);
+             fixed stretch total v1 v2); *)
       (v1, v2)
 
     let has_transient_sensor flags =
@@ -1794,16 +1863,7 @@ module Nottui = struct
         | Y (a, b) -> (max a.w b.w, a.h +. b.h)
         | Z (a, b) -> (max a.w b.w, max a.h b.h)
       in
-      {
+      { ui with w; h; desc; sensor_cache = None; cache }
-        ui with
-        w;
-        h;
-        sw = w;
-        sh = h;
-        desc;
-        sensor_cache = None;
-        cache;
-      }
 
     let update t size (ui : Ui.t) =
       t.size <- size;
@@ -1876,8 +1936,8 @@ module Nottui = struct
 
     let resize_canvas vg rw rh image =
       let w, h = V2.to_tuple @@ I.size vg V2.zero image in
-      Log.debug (fun m ->
+      (* Log.debug (fun m ->
-          m "resize_canvas: w=%.1f rw=%.1f h=%.1f rh=%.1f" w rw h rh);
+           m "resize_canvas: w=%.1f rw=%.1f h=%.1f rh=%.1f" w rw h rh); *)
       if w <> rw || h <> rh then I.pad ~r:(rw -. w) ~b:(rh -. h) image
       else image
 
@@ -1907,109 +1967,13 @@ module Nottui = struct
       then `Handled
       else `Unhandled
 
-    let rec _render_node vg (vx1 : size1) (vy1 : size1) (vx2 : size1)
+    let rec render_node vg (vx1 : size1) (vy1 : size1) (vx2 : size1)
         (vy2 : size1) (sw : size1) (sh : size1) (t : ui) : cache =
-      match t.desc with
+      (* Log.debug (fun m ->
-      | Atom image ->
+           m
-          {
+             "render_node vx1=%.0f@ vy1=%.0f@ vx2=%.0f@ vy2=%.0f@ \
-            vx = Interval.make 0. sw;
+              sw=%.0f@ sh=%.0f@ @[%a@]"
-            vy = Interval.make 0. sh;
+             vx1 vy1 vx2 vy2 sw sh pp t); *)
-            image = resize_canvas vg sw sh image;
-          }
-      | Size_sensor (desc, handler) ->
-          handler ~w:sw ~h:sh;
-          render_node vg vx1 vy1 vx2 vy2 sw sh desc
-      | Transient_sensor (desc, _) | Permanent_sensor (desc, _) ->
-          render_node vg vx1 vy1 vx2 vy2 sw sh desc
-      | Focus_area (desc, _) | Mouse_handler (desc, _) ->
-          render_node vg vx1 vy1 vx2 vy2 sw sh desc
-      | Shift_area (t', sx, sy) ->
-          let cache =
-            render_node vg (vx1 +. sx) (vy1 +. sy) (vx2 +. sx)
-              (vy2 +. sy) (sx +. sw) (sy +. sh) t'
-          in
-          let vx = Interval.make vx1 vx2
-          and vy = Interval.make vy1 vy2 in
-          let image =
-            resize_canvas vg sw sh (I.crop ~l:sx ~t:sy cache.image)
-          in
-          { vx; vy; image }
-      | X (a, b) ->
-          let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw sw in
-          let ca = render_node vg vx1 vy1 vx2 vy2 aw sh a in
-          let cb =
-            render_node vg (vx1 -. aw) vy1 (vx2 -. aw) vy2 bw sh b
-          in
-          let vx =
-            Interval.make
-              (max (Interval.fst ca.vx) (Interval.fst cb.vx +. aw))
-              (min (Interval.snd ca.vx) (Interval.snd cb.vx +. aw))
-          and vy =
-            Interval.make
-              (max (Interval.fst ca.vy) (Interval.fst cb.vy))
-              (min (Interval.snd ca.vy) (Interval.snd cb.vy))
-          and image =
-            resize_canvas vg sw sh I.(ca.image <|> cb.image)
-          in
-          { vx; vy; image }
-      | Y (a, b) ->
-          let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh sh in
-          let ca = render_node vg vx1 vy1 vx2 vy2 sw ah a in
-          let cb =
-            render_node vg vx1 (vy1 -. ah) vx2 (vy2 -. ah) sw bh b
-          in
-          let vx =
-            Interval.make
-              (max (Interval.fst ca.vx) (Interval.fst cb.vx))
-              (min (Interval.snd ca.vx) (Interval.snd cb.vx))
-          and vy =
-            Interval.make
-              (max (Interval.fst ca.vy) (Interval.fst cb.vy +. ah))
-              (min (Interval.snd ca.vy) (Interval.snd cb.vy +. ah))
-          and image =
-            resize_canvas vg sw sh (I.( <-> ) ca.image cb.image)
-          in
-          { vx; vy; image }
-      | Z (a, b) ->
-          let ca = render_node vg vx1 vy1 vx2 vy2 sw sh a in
-          let cb = render_node vg vx1 vy1 vx2 vy2 sw sh b in
-          let vx =
-            Interval.make
-              (max (Interval.fst ca.vx) (Interval.fst cb.vx))
-              (min (Interval.snd ca.vx) (Interval.snd cb.vx))
-          and vy =
-            Interval.make
-              (max (Interval.fst ca.vy) (Interval.fst cb.vy))
-              (min (Interval.snd ca.vy) (Interval.snd cb.vy))
-          and image =
-            resize_canvas vg sw sh (I.( </> ) cb.image ca.image)
-          in
-          { vx; vy; image }
-      | Resize (t, _, _, g) ->
-          let open Gravity in
-          let dx, rw =
-            pack ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g))
-          in
-          let dy, rh =
-            pack ~fixed:t.h ~stretch:t.sh sh (v (p1 g)) (v (p2 g))
-          in
-          let c =
-            render_node vg (vx1 -. dx) (vy1 -. dy) (vx2 -. dx)
-              (vy2 -. dy) rw rh t
-          in
-          let image = resize_canvas2 vg dx dy sw sh c.image in
-          let vx = Interval.shift c.vx dx in
-          let vy = Interval.shift c.vy dy in
-          { vx; vy; image }
-      | Event_filter (t, _f) -> render_node vg vx1 vy1 vx2 vy2 sw sh t
-
-    and render_node vg (vx1 : size1) (vy1 : size1) (vx2 : size1)
-        (vy2 : size1) (sw : size1) (sh : size1) (t : ui) : cache =
-      Log.debug (fun m ->
-          m
-            "render_node vx1=%.0f@ vy1=%.0f@ vx2=%.0f@ vy2=%.0f@ \
-             sw=%.0f@ sh=%.0f@ @[%a@]"
-            vx1 vy1 vx2 vy2 sw sh pp t);
       if
         let cache = t.cache in
         vx1 >= Interval.fst cache.vx
@@ -2024,7 +1988,107 @@ module Nottui = struct
           image = I.void sw sh;
         }
       else
-        let cache = _render_node vg vx1 vy1 vx2 vy2 sw sh t in
+        let cache =
+          match t.desc with
+          | Atom image ->
+              {
+                vx = Interval.make 0. sw;
+                vy = Interval.make 0. sh;
+                image = resize_canvas vg sw sh image;
+              }
+          | Size_sensor (desc, handler) ->
+              handler ~w:sw ~h:sh;
+              render_node vg vx1 vy1 vx2 vy2 sw sh desc
+          | Transient_sensor (desc, _) | Permanent_sensor (desc, _) ->
+              render_node vg vx1 vy1 vx2 vy2 sw sh desc
+          | Focus_area (desc, _) | Mouse_handler (desc, _) ->
+              render_node vg vx1 vy1 vx2 vy2 sw sh desc
+          | Shift_area (t', sx, sy) ->
+              let cache =
+                render_node vg (vx1 +. sx) (vy1 +. sy) (vx2 +. sx)
+                  (vy2 +. sy) (sx +. sw) (sy +. sh) t'
+              in
+              let vx = Interval.make vx1 vx2
+              and vy = Interval.make vy1 vy2 in
+              let image =
+                resize_canvas vg sw sh
+                  (I.crop ~l:sx ~t:sy cache.image)
+              in
+              { vx; vy; image }
+          | X (a, b) ->
+              let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw sw in
+              let ca = render_node vg vx1 vy1 vx2 vy2 aw sh a in
+              let cb =
+                render_node vg (vx1 -. aw) vy1 (vx2 -. aw) vy2 bw sh b
+              in
+              let vx =
+                Interval.make
+                  (max (Interval.fst ca.vx)
+                     (Interval.fst cb.vx +. aw))
+                  (min (Interval.snd ca.vx)
+                     (Interval.snd cb.vx +. aw))
+              and vy =
+                Interval.make
+                  (max (Interval.fst ca.vy) (Interval.fst cb.vy))
+                  (min (Interval.snd ca.vy) (Interval.snd cb.vy))
+              and image =
+                resize_canvas vg sw sh I.(ca.image <|> cb.image)
+              in
+              { vx; vy; image }
+          | Y (a, b) ->
+              let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh sh in
+              let ca = render_node vg vx1 vy1 vx2 vy2 sw ah a in
+              let cb =
+                render_node vg vx1 (vy1 -. ah) vx2 (vy2 -. ah) sw bh b
+              in
+              let vx =
+                Interval.make
+                  (max (Interval.fst ca.vx) (Interval.fst cb.vx))
+                  (min (Interval.snd ca.vx) (Interval.snd cb.vx))
+              and vy =
+                Interval.make
+                  (max (Interval.fst ca.vy)
+                     (Interval.fst cb.vy +. ah))
+                  (min (Interval.snd ca.vy)
+                     (Interval.snd cb.vy +. ah))
+              and image =
+                resize_canvas vg sw sh (I.( <-> ) ca.image cb.image)
+              in
+              { vx; vy; image }
+          | Z (a, b) ->
+              let ca = render_node vg vx1 vy1 vx2 vy2 sw sh a in
+              let cb = render_node vg vx1 vy1 vx2 vy2 sw sh b in
+              let vx =
+                Interval.make
+                  (max (Interval.fst ca.vx) (Interval.fst cb.vx))
+                  (min (Interval.snd ca.vx) (Interval.snd cb.vx))
+              and vy =
+                Interval.make
+                  (max (Interval.fst ca.vy) (Interval.fst cb.vy))
+                  (min (Interval.snd ca.vy) (Interval.snd cb.vy))
+              and image =
+                resize_canvas vg sw sh (I.( </> ) cb.image ca.image)
+              in
+              { vx; vy; image }
+          | Resize (t, _, _, g) ->
+              let open Gravity in
+              let dx, rw =
+                pack ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g))
+              in
+              let dy, rh =
+                pack ~fixed:t.h ~stretch:t.sh sh (v (p1 g)) (v (p2 g))
+              in
+              let c =
+                render_node vg (vx1 -. dx) (vy1 -. dy) (vx2 -. dx)
+                  (vy2 -. dy) rw rh t
+              in
+              let image = resize_canvas2 vg dx dy sw sh c.image in
+              let vx = Interval.shift c.vx dx in
+              let vy = Interval.shift c.vy dy in
+              { vx; vy; image }
+          | Event_filter (t, _f) ->
+              render_node vg vx1 vy1 vx2 vy2 sw sh t
+        in
         t.cache <- cache;
         cache
 
@@ -2048,7 +2112,6 @@ module Nottui = struct
                 in
                 iter st'
             | Focus_area (t, f) -> (
-                Log.debug (fun m -> m "dispatch_raw_key Focus_area");
                 match iter [ t ] with
                 | `Handled -> `Handled
                 | `Unhandled -> (
@@ -2097,18 +2160,10 @@ module Nottui = struct
       | Event_filter (t, _) ->
           dispatch_focus t dir
       | Focus_area (t', _) ->
-          if Focus.has_focus t'.focus then (
+          if Focus.has_focus t'.focus then
-            Log.debug (fun m ->
+            dispatch_focus t' dir || grab_focus t
-                m "dispatch_focus: Focus.has_focus t'.focus");
+          else if Focus.has_focus t.focus then false
-            dispatch_focus t' dir || grab_focus t)
+          else grab_focus t
-          else if
-            Log.debug (fun m ->
-                m "dispatch_focus: Focus.has_focus t.focus");
-            Focus.has_focus t.focus
-          then false
-          else (
-            Log.debug (fun m -> m "dispatch_focus: grab_focus");
-            grab_focus t)
       | X (a, b) -> (
           if Focus.has_focus a.focus then
             dispatch_focus a dir
@@ -2228,7 +2283,6 @@ module Nottui_lwt = struct
     in
     refresh ();
     let process_event e =
-      Log.debug (fun m -> m "Nottui_lwt.render= process_event");
       match e with
       | `Key (`Uchar c, [ `Meta ]) as event
         when Uchar.(equal c (of_char 'q')) -> (
@@ -2239,10 +2293,11 @@ module Nottui_lwt = struct
           match Renderer.dispatch_event renderer event with
           | `Handled -> ()
           | `Unhandled ->
-              Log.warn (fun m ->
+              (* Log.warn (fun m ->
                   m
                     "Nottui_lwt.render process_event #Ui.event -> \
-                     `Unhandled"))
+                     `Unhandled") *)
+              ())
       | `Resize size' ->
           size := size';
           refresh ()
@@ -2284,8 +2339,11 @@ module Nottui_widgets = struct
 
   let attr_menu_main = A.(bg Color.green ++ fg Color.black)
   let attr_menu_sub = A.(bg Color.lightgreen ++ fg Color.black)
-  let attr_clickable = A.(bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5)
+
-  let attr_cursor = A.(bg @@ Color.rgbf ~r:0.4 ~g:0.4 ~b:0.1)
+  let attr_clickable =
+    A.((bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5) ++ (fg @@ Color.light))
+
+  let attr_cursor = A.((fg @@ Color.dark) ++ (bg @@ Color.yellow))
 
   type window_manager = {
     overlays : ui Lwd.t Lwd_table.t;
@@ -2397,73 +2455,6 @@ module Nottui_widgets = struct
 
   let scroll_step = 7.
 
-  type scroll_state = {
-    position : float;
-    bound : float;
-    visible : float;
-    total : float;
-  }
-
-  let default_scroll_state =
-    { position = 0.; bound = 0.; visible = 0.; total = 0. }
-
-  let pp_scroll_state ppf { position; bound; visible; total } =
-    Format.fprintf ppf
-      "{position=%.1f;@ bound=%.1f;@ visible=%.1f;@ total=%.1f}"
-      position bound visible total
-
-  let vscroll_area ~state ~change (t : Ui.t Lwd.t) =
-    let visible = ref (-1.) in
-    let total = ref (-1.) in
-    let scroll state delta =
-      let position = state.position +. delta in
-      let position = max 0. (min state.bound position) in
-      if position <> state.position then
-        change `Action { state with position };
-      `Handled
-    in
-    let focus_handler state = function
-      (*| `Arrow `Left , _ -> scroll (-scroll_step) 0*)
-      (*| `Arrow `Right, _ -> scroll (+scroll_step) 0*)
-      | `Arrow `Up, [] -> scroll state (-.scroll_step)
-      | `Arrow `Down, [] -> scroll state (+.scroll_step)
-      | `Page `Up, [] -> scroll state (-.scroll_step *. 8.)
-      | `Page `Down, [] -> scroll state (+.scroll_step *. 8.)
-      | _ -> `Unhandled
-    in
-    let scroll_handler state ~x:_ ~y:_ = function
-      | `Scroll `Up -> scroll state (-.scroll_step)
-      | `Scroll `Down -> scroll state (+.scroll_step)
-      | _ -> `Unhandled
-    in
-    Lwd.map2 t state ~f:(fun t state ->
-        t
-        |> Ui.shift_area 0. state.position
-        |> Ui.resize ~h:0. ~sh:1.
-        |> Ui.size_sensor (fun ~w:_ ~h ->
-               let tchange =
-                 if !total <> Ui.(layout_spec t).h then (
-                   total := Ui.(layout_spec t).h;
-                   true)
-                 else false
-               in
-               let vchange =
-                 if !visible <> h then (
-                   visible := h;
-                   true)
-                 else false
-               in
-               if tchange || vchange then
-                 change `Content
-                   {
-                     state with
-                     visible = !visible;
-                     total = !total;
-                     bound = max 0. (!total -. !visible);
-                   })
-        |> Ui.mouse_area (scroll_handler state)
-        |> Ui.keyboard_area (focus_handler state))
-
   let scroll_area ?(offset = (0., 0.)) t =
     let offset = Lwd.var offset in
     let scroll d_x d_y =
@@ -2637,12 +2628,9 @@ module Nottui_widgets = struct
   let sub' str p l =
     if p = 0 && l = String.length str then str else String.sub str p l
 
-  let edit_field ?(focus = Focus.make ()) ?(on_change = ignore)
+  let edit_field ?(focus = Focus.make ()) ?(on_change = Fun.id)
       ?(on_submit = ignore) state =
-    let on_change a =
+    let on_change a = Lwd.set state (on_change a) in
-      on_change a;
-      Lwd.set state a
-    in
     let update focus_h focus (text, pos) =
       let pos = min (max 0 pos) (String.length text) in
       let content =
@@ -2651,25 +2639,18 @@ module Nottui_widgets = struct
         if Focus.has_focus focus then
           let attr = attr_clickable in
           let len = String.length text in
-          (if pos >= len then [ I.string ~attr text ]
+          if pos >= len then
-          else [ I.string ~attr (sub' text 0 pos) ])
+            [ I.string ~attr text; I.string ~attr:attr_cursor " " ]
-          @
+          else
-          if pos < String.length text then
             [
+              I.string ~attr (sub' text 0 pos);
               I.string ~attr:attr_cursor (sub' text pos 1);
               I.string ~attr (sub' text (pos + 1) (len - pos - 1));
             ]
-          else [ I.string ~attr:A.(bg Color.lightred) " " ]
+        else [ I.string (if text = "" then " " else text) ]
-        else
-          [
-            I.string
-              ~attr:A.(font Font.underline)
-              (if text = "" then " " else text);
-          ]
       in
       let handler k =
-        (* Log.debug (fun m -> m "edit_field keyboard_area handler");*)
+        (match k with
-        match k with
         | `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) ->
             on_change ("", 0);
             `Handled (* clear *)
@@ -2715,7 +2696,12 @@ module Nottui_widgets = struct
               on_change (text, pos);
               `Handled)
             else `Unhandled
-        | _ -> `Unhandled
+        | _ -> `Unhandled)
+        |> fun r ->
+        Log.debug (fun m ->
+            m "edit_field keyboard_area handler %a -> %a" Ui.pp_key k
+              Ui.pp_may_handle r);
+        r
       in
       Ui.keyboard_area ~focus handler content
     in
@@ -2735,6 +2721,95 @@ module Nottui_widgets = struct
 
   open Lwd.Infix
 
+  type line = {
+    focus : Focus.handle;
+    state : (string * int) Lwd.var;
+    ui : Ui.t Lwd.t;
+  }
+
+  let _line_on_change _table _row (s, i) = (s, i)
+  let eq_uc_c uc c = Uchar.(equal uc (of_char c))
+
+  let copy_line_cursor (x : line) (y : line) =
+    let _, xi = Lwd.peek x.state in
+    let ys, _ = Lwd.peek y.state in
+    let yi = Int.max 0 (Int.min xi (String.length ys)) in
+    Lwd.set y.state (ys, yi)
+
+  let cursor_move cursor
+      (f : line Lwd_table.row -> line Lwd_table.row option) =
+    match Lwd.peek cursor with
+    | Some cursor_line -> (
+        match f cursor_line with
+        | Some new_line ->
+            (match Lwd_table.get new_line with
+            | Some line' ->
+                cursor_line |> Lwd_table.get
+                |> Option.iter (fun line ->
+                       copy_line_cursor line line');
+                Focus.request line'.focus
+            | None -> ());
+            Lwd.set cursor (Some new_line);
+            `Handled
+        | None -> `Unhandled)
+    | None -> `Unhandled
+
+  let line_append ?(table = Lwd_table.make ()) str =
+    let focus = Focus.make () in
+    let state = Lwd.var (str, 0) in
+    let row = Lwd_table.append table in
+    Lwd_table.set row
+      {
+        focus;
+        state;
+        ui =
+          edit_field ~focus
+            ~on_change:(_line_on_change table row)
+            state;
+      }
+
+  let line_table_of_string ?(table = Lwd_table.make ())
+      ?(focus = Focus.make ()) (s : string) : Ui.t Lwd.t =
+    (* Append lines from s to table *)
+    List.iter (line_append ~table) (String.split_on_char '\n' s);
+    (* create the cursor var *)
+    let cursor = Lwd.var @@ Lwd_table.first table in
+    Option.iter
+      (fun cursor ->
+        Option.iter (fun first -> Focus.request first.focus)
+        @@ Lwd_table.get cursor)
+      (Lwd.peek cursor);
+
+    (* Build view of table *)
+    Lwd_table.map_reduce
+      (fun _ { ui; _ } -> ui)
+      (Lwd_utils.lift_monoid Ui.pack_y)
+      table
+    |> Lwd.join
+    |> Lwd.map2
+         ~f:(fun focus ->
+           Ui.keyboard_area ~focus (function
+             | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' ->
+                 cursor_move cursor (fun c -> Lwd_table.next c)
+             | `Arrow `Down, _ ->
+                 cursor_move cursor (fun c -> Lwd_table.next c)
+             | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' ->
+                 cursor_move cursor (fun c -> Lwd_table.prev c)
+             | `Arrow `Up, _ ->
+                 cursor_move cursor (fun c -> Lwd_table.prev c)
+             | `Uchar u, [ `Meta ] when eq_uc_c u '<' ->
+                 cursor_move cursor (fun _ -> Lwd_table.first table)
+             | `Uchar u, [ `Meta ] when eq_uc_c u '>' ->
+                 cursor_move cursor (fun _ -> Lwd_table.last table)
+             (* | `Enter, [] -> (
+                  let row = Lwd.peek cursor in
+                  match Lwd_table.get row with
+                  | Some line ->
+                      Lwd_table.after row ~set:Lwd.set cursor
+                  | None -> `Unhandled) *)
+             | _ -> `Unhandled))
+         (Focus.status focus)
+
   (** Tab view, where exactly one element of [l] is shown at a time. *)
   let tabs (tabs : (string * (unit -> Ui.t Lwd.t)) list) : Ui.t Lwd.t
       =

notes.org

@@ -24,6 +24,14 @@
 * principles?
 an "anywhere" programming environment
 
+* 221211
+ok you got the scroll box mostly working so next:
+** fix the scroll jump bugs
+** setup better keybindings
+** fix cursor and active focus indicators
+
+
+
 * 221210 -
 ** need to resolve the issue with the ui.t Resize type.
 this is an issue with the direction of the determination of the .height and .width fields of Ui.t