padding

human.ml

@@ -96,6 +96,10 @@ let _ =
   Logs.set_level (Some Debug)
 
 module Log = Logs
+
+let when_some (f : 'b -> 'a -> 'a) (o : 'b option) (v : 'a) : 'a =
+  match o with Some a -> f a v | None -> v
+
 module Cohttp_backend = Cohttp_lwt_jsoo
 
 module Git_af = struct
@@ -1149,7 +1153,7 @@ module I = struct
           sz
 
     and node vg attr p n : p2 =
-      (* returns the *size* of the drawn area not the max coordinates anymore *)
+      (* returns the *size* of the drawn area not the max coordinates *)
       let b' =
         match n with
         | Empty | Void _ -> p
@@ -1179,7 +1183,12 @@ module I = struct
         | Hcrop (i, left, right) ->
             let p0 = size vg p i in
             NVG.save vg;
-            NVG.Scissor.scissor vg ~x:(V2.x p) ~y:(V2.y p)
+            (* NVG.Scissor.scissor:
+               - w, h are positive only
+            *)
+            NVG.Scissor.scissor vg
+              ~x:(V2.(x p) +. left)
+              ~y:(V2.y p)
               ~w:(V2.x p0 -. right)
               ~h:(V2.y p0);
             let p1 = node vg attr V2.(p - v left 0.) i in
@@ -1188,18 +1197,19 @@ module I = struct
         | Vcrop (i, top, bottom) ->
             let p0 = size vg p i in
             NVG.save vg;
-            NVG.Scissor.scissor vg ~x:(V2.x p) ~y:(V2.y p)
+            NVG.Scissor.scissor vg
-              ~w:(V2.x p0)
+              ~x:(V2.(x p) +. top)
+              ~y:(V2.y p) ~w:(V2.x p0)
               ~h:(V2.y p0 -. bottom);
             let p1 = node vg attr V2.(p - v 0. top) i in
             NVG.restore vg;
             V2.(p1 - v 0. (top +. bottom))
       in
 
-      (* ignore
+      ignore
-         (path_box vg.vg
+        (path_box vg
            (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
-            (Box2.of_pts b b')); *)
+           (Box2.v p b'));
       b'
   end
 end
@@ -1430,12 +1440,14 @@ module Nottui = struct
 
     type 'a desc =
       | Atom of image
+      | Attr of 'a * Style.t
       | Size_sensor of 'a * size_sensor
       | Transient_sensor of 'a * frame_sensor
       | Permanent_sensor of 'a * frame_sensor
       | Resize of 'a * float option * float option * Gravity.t2
       | Mouse_handler of 'a * mouse_handler
       | Focus_area of 'a * (key -> may_handle)
+      | Pad of 'a * (float * float * float * float)
       | Shift_area of 'a * float * float
       | Event_filter of
           'a * ([ `Key of key | `Mouse of mouse ] -> may_handle)
@@ -1497,18 +1509,7 @@ module Nottui = struct
         cache;
       }
 
-    (* let space_1_0 = atom (I.void 1 0)
+    let attr a t = { t with desc = Attr (t, a) }
-       let space_0_1 = atom (I.void 0 1)
-       let space_1_1 = atom (I.void 1 1)
-
-       let space x y =
-         match (x, y) with
-         | 0, 0 -> empty
-         | 1, 0 -> space_1_0
-         | 0, 1 -> space_0_1
-         | 1, 1 -> space_1_1
-          | _ -> atom (I.void x y) *)
-
     let space x y = atom (I.void x y)
     let mouse_area f t : t = { t with desc = Mouse_handler (t, f) }
 
@@ -1522,6 +1523,9 @@ module Nottui = struct
 
     let shift_area x y t : t = { t with desc = Shift_area (t, x, y) }
 
+    let pad ?a ?(l = 0.) ?(r = 0.) ?(t = 0.) ?(b = 0.) tt =
+      when_some attr a { tt with desc = Pad (tt, (l, r, t, b)) }
+
     let size_sensor handler t : t =
       { t with desc = Size_sensor (t, handler) }
 
@@ -1613,13 +1617,16 @@ module Nottui = struct
     let has_focus t = Focus.has_focus t.focus
 
     let rec pp ppf t =
-      F.pf ppf "@[<hov>focus=%a %a@]" Focus.pp_status t.focus pp_desc
+      if has_focus t then
+        F.pf ppf "@[<hov>%a %a@]" Focus.pp_status t.focus pp_desc
           t.desc
+      else F.pf ppf "@[<hov> %a@]" pp_desc t.desc
 
     and pp_desc ppf = function
       | Atom a ->
           Format.fprintf ppf "Atom @[<hov>(%a)@]"
             (I.Draw.pp ?attr:None) a
+      | Attr (desc, a) -> F.pf ppf "Attr (%a, %a)" Style.pp a pp desc
       | Size_sensor (desc, _) ->
           Format.fprintf ppf "Size_sensor (%a, _)" pp desc
       | Transient_sensor (desc, _) ->
@@ -1635,6 +1642,8 @@ module Nottui = struct
       | Mouse_handler (n, _) ->
           Format.fprintf ppf "%a" (*"Mouse (%a,@ _)"*) pp n
       | Focus_area (n, _) -> Format.fprintf ppf "Focus (%a,@ _)" pp n
+      | Pad (n, (l, r, t, b)) ->
+          F.pf ppf "Pad (%.0f,%.0f,%.0f,%.0f,%a)" l r t b pp n
       | Shift_area (n, x, y) ->
           Format.fprintf ppf "Shift (%.0f,%.0f,%a)" x y pp n
       | Event_filter (n, _) ->
@@ -1646,12 +1655,14 @@ module Nottui = struct
     let iter f ui =
       match ui.desc with
       | Atom _ -> ()
+      | Attr (u, _)
       | Size_sensor (u, _)
       | Transient_sensor (u, _)
       | Permanent_sensor (u, _)
       | Resize (u, _, _, _)
       | Mouse_handler (u, _)
       | Focus_area (u, _)
+      | Pad (u, _)
       | Shift_area (u, _, _)
       | Event_filter (u, _) ->
           f u
@@ -1748,6 +1759,7 @@ module Nottui = struct
           ui.sensor_cache <- Some (ox, oy, sw, sh);
         match ui.desc with
         | Atom _ -> ()
+        | Attr (t, _)
         | Size_sensor (t, _)
         | Mouse_handler (t, _)
         | Focus_area (t, _)
@@ -1779,6 +1791,8 @@ module Nottui = struct
                 (v (p2 g))
             in
             update_sensors (ox +. dx) (oy +. dy) rw rh t
+        | Pad (tt, (l, r, t, b)) ->
+            update_sensors (ox +. l) (oy +. t) (sw +. r) (sh +. b) tt
         | Shift_area (t, sx, sy) ->
             update_sensors (ox -. sx) (oy -. sy) sw sh t
         | X (a, b) ->
@@ -1801,6 +1815,7 @@ module Nottui = struct
     let rec t_size_desc_of_t vg (size : box2) (ui : Ui.t desc) =
       match ui with
       | Atom _ as a -> a
+      | Attr (t, v) -> Attr (t_size_of_t vg size t, v)
       | Size_sensor (t, v) -> Size_sensor (t_size_of_t vg size t, v)
       | Mouse_handler (t, v) ->
           Mouse_handler (t_size_of_t vg size t, v)
@@ -1821,6 +1836,14 @@ module Nottui = struct
               w,
               h,
               g2 )
+      | Pad (tt, (l, r, t, b)) ->
+          Pad
+            ( t_size_of_t vg
+                (Box2.of_pts
+                   V2.(Box2.o size + of_tuple (l, t))
+                   V2.(Box2.max size + of_tuple (r, b)))
+                tt,
+              (l, r, t, b) )
       | Shift_area (t, sx, sy) ->
           Shift_area
             ( t_size_of_t vg
@@ -1857,6 +1880,7 @@ module Nottui = struct
       let w, h =
         match desc with
         | Atom i -> V2.to_tuple (I.size vg (Box2.o size) i)
+        | Attr (t, _)
         | Size_sensor (t, _)
         | Mouse_handler (t, _)
         | Focus_area (t, _)
@@ -1866,6 +1890,7 @@ module Nottui = struct
             (t.w, t.h)
         | Resize (t, w, h, _) ->
             (Option.value w ~default:t.w, Option.value h ~default:t.h)
+        | Pad (tt, (l, r, t, b)) -> (tt.w +. l +. r, tt.h +. t +. b)
         | Shift_area (t, x, y) -> (t.w +. x, t.h +. y)
         | X (a, b) -> (a.w +. b.w, max a.h b.h)
         | Y (a, b) -> (max a.w b.w, a.h +. b.h)
@@ -1912,11 +1937,14 @@ module Nottui = struct
             && y -. oy >= 0.
             && y -. oy <= rh)
             && (aux ox oy sw sh t || handle ox oy f)
+        | Attr (desc, _)
         | Size_sensor (desc, _)
         | Transient_sensor (desc, _)
         | Permanent_sensor (desc, _)
         | Focus_area (desc, _) ->
             aux ox oy sw sh desc
+        | Pad (desc, (l, r, t, b)) ->
+            aux (ox +. l) (oy +. t) (sw +. r) (sh +. b) desc
         | Shift_area (desc, sx, sy) ->
             aux (ox -. sx) (oy -. sy) sw sh desc
         | Resize (t, _, _, g) ->
@@ -2010,12 +2038,17 @@ module Nottui = struct
                 vy = Interval.make 0. sh;
                 image = resize_canvas vg sw sh image;
               }
+          | Attr (desc, attr) ->
+              let cache = render_node vg vx1 vy1 vx2 vy2 sw sh desc in
+              { cache with image = I.attr attr cache.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, _) ->
+          | Focus_area (desc, _) ->
+              render_node vg vx1 vy1 vx2 vy2 sw sh desc
+          | Mouse_handler (desc, _) ->
               render_node vg vx1 vy1 vx2 vy2 sw sh desc
           | Shift_area (t', sx, sy) ->
               let cache =
@@ -2029,6 +2062,19 @@ module Nottui = struct
                   (I.crop ~l:sx ~t:sy cache.image)
               in
               { vx; vy; image }
+          | Pad (t', (l, r, t, b)) ->
+              let cache =
+                render_node vg (vx1 +. l) (vy1 +. t)
+                  (vx2 +. l +. r)
+                  (vy2 +. t +. b)
+                  (sw +. r) (sh +. b) t'
+              in
+              let vx = Interval.make vx1 vx2
+              and vy = Interval.make vy1 vy2 in
+              let image =
+                resize_canvas vg sw sh (I.pad ~l ~r ~t ~b 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
@@ -2132,10 +2178,12 @@ module Nottui = struct
                     match f key with
                     | `Handled -> `Handled
                     | `Unhandled -> iter tl))
+            | Attr (t, _)
             | Mouse_handler (t, _)
             | Size_sensor (t, _)
             | Transient_sensor (t, _)
             | Permanent_sensor (t, _)
+            | Pad (t, _)
             | Shift_area (t, _, _)
             | Resize (t, _, _, _) ->
                 iter (t :: tl)
@@ -2168,10 +2216,12 @@ module Nottui = struct
     let rec dispatch_focus t dir =
       match t.desc with
       | Atom _ -> false
+      | Attr (t, _)
       | Mouse_handler (t, _)
       | Size_sensor (t, _)
       | Transient_sensor (t, _)
       | Permanent_sensor (t, _)
+      | Pad (t, _)
       | Shift_area (t, _, _)
       | Resize (t, _, _, _)
       | Event_filter (t, _) ->
@@ -2706,9 +2756,6 @@ module Widgets = struct
         | `Escape, [] ->
             Focus.release focus_h;
             `Handled
-        (* | `Enter, _ ->
-            on_submit (text, pos);
-            `Handled *)
         | `Arrow `Left, [] ->
             if pos > 0 then on_change (text, pos - 1) else `Unhandled
         | `Arrow `Right, [] ->
@@ -2821,13 +2868,15 @@ module Widgets = struct
           else find_focus a
       | Conflict _, Atom _ -> Ui.empty
       | ( Conflict _,
-          ( Size_sensor (t, _)
+          ( Attr (t, _)
+          | Size_sensor (t, _)
           | Mouse_handler (t, _)
           | Focus_area (t, _)
           | Event_filter (t, _)
           | Transient_sensor (t, _)
           | Permanent_sensor (t, _)
           | Resize (t, _, _, _)
+          | Pad (t, _)
           | Shift_area (t, _, _) ) ) ->
           find_focus t)
 
@@ -2861,8 +2910,7 @@ module Widgets = struct
       (Lwd_utils.lift_monoid Ui.pack_y)
       table
     |> Lwd.join
-    |> Lwd.map2
+    |> Lwd.map2 (Focus.status focus) ~f:(fun focus ->
-         ~f:(fun focus ->
            Ui.keyboard_area ~focus (fun k ->
                Log.debug (fun m ->
                    m "keyboard_area: edit_area handler %a" Ui.pp_key k);
@@ -2915,14 +2963,12 @@ module Widgets = struct
                            else `Unhandled))
                | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
                | _ -> `Unhandled))
-         (Focus.status focus)
 
   (* TODO: view_metadata *)
 
   let node_edit_area ?(table = Lwd_table.make ())
       ?(focus = Focus.make ()) ((store, path) : Nav.S.t * Nav.path) :
       Ui.t Lwd.t Lwt.t =
-    let cursor = Lwd.var @@ Lwd_table.first table in
     let open Lwt.Infix in
     Nav.S.tree store >>= fun tree ->
     let save_stream, save_push = Lwt_stream.create () in
@@ -2941,7 +2987,6 @@ module Widgets = struct
               store path tree'
             >>= fun _ -> Lwt.return_unit)
           save_stream);
-
     Nav.S.Tree.find_all tree path >>= function
     | None ->
         lwt_lwd_string
@@ -2949,12 +2994,11 @@ module Widgets = struct
          ^ " -> None")
     | Some (contents, _metadata) ->
         line_table_of_string ~table contents |> ignore;
-
+        let cursor = Lwd.var (Lwd_table.first table) in
         Lwd.peek cursor
-        |> Option.iter (fun cursor ->
+        |> Option.iter (fun r ->
-               Lwd_table.get cursor
+               Lwd_table.get r
-               |> Option.iter (fun first -> Focus.request first.focus));
+               |> Option.iter (fun l -> Focus.request l.focus));
-
         (* Build view of table *)
         Lwt.return
           (Lwd_table.map_reduce
@@ -2963,6 +3007,13 @@ module Widgets = struct
              table
           |> Lwd.join
           |> Lwd.map2 (Focus.status focus) ~f:(fun focus' ->
+                 if Focus.has_focus focus' then
+                   Lwd.peek cursor
+                   |> Option.iter (fun r ->
+                          Lwd_table.get r
+                          |> Option.iter (fun l ->
+                                 Focus.request l.focus));
+
                  Ui.keyboard_area ~focus:focus' (fun k ->
                      Log.debug (fun m ->
                          m "node_edit_area handler %a" Ui.pp_key k);
@@ -3077,17 +3128,27 @@ module Widgets = struct
          table
       |> Lwd.join
       |> Lwd.map2 (Focus.status focus) ~f:(fun focus' ->
+             if Focus.has_focus focus' then
+               Lwd.peek cursor
+               |> Option.iter (fun cursor ->
+                      Lwd_table.get cursor
+                      |> Option.iter (fun (f, _) -> Focus.request f));
              Ui.keyboard_area ~focus:focus' (fun k ->
                  Log.debug (fun m ->
                      m "keyboard_area: tree_nav %a" Ui.pp_key k);
                  match k with
                  | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' ->
-                     cursor_move cursor Lwd_table.next
+                     cursor_move cursor Lwd_table.next |> ignore;
+                     `Handled
                  | `Arrow `Down, _ ->
-                     cursor_move cursor Lwd_table.next
+                     cursor_move cursor Lwd_table.next |> ignore;
+                     `Handled
                  | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' ->
-                     cursor_move cursor Lwd_table.prev
+                     cursor_move cursor Lwd_table.prev |> ignore;
-                 | `Arrow `Up, _ -> cursor_move cursor Lwd_table.prev
+                     `Handled
+                 | `Arrow `Up, _ ->
+                     cursor_move cursor Lwd_table.prev |> ignore;
+                     `Handled
                  | `Uchar u, [ `Meta ] when eq_uc_c u '<' ->
                      cursor_move cursor (fun _ ->
                          Lwd_table.first table)
@@ -3095,14 +3156,7 @@ module Widgets = struct
                      cursor_move cursor (fun _ ->
                          Lwd_table.last table)
                  | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
-                 | `Enter, [] ->
+                 | `Enter, [] -> `Unhandled
-                     Lwd.peek cursor
-                     |> Option.iter (fun c ->
-                            Lwd_table.get c
-                            |> Option.iter (fun (f, _step) ->
-                                   Focus.release focus;
-                                   Focus.request f));
-                     `Unhandled
                  | `Backspace, [] -> `Unhandled
                  | _ -> `Unhandled)))
 
@@ -3170,20 +3224,21 @@ module Widgets = struct
                 Lwd.map2
                   (Lwd.pair (Focus.status focus) (Lwd.get selection))
                   ui
-                  ~f:(fun (focus, selection) ui ->
+                  ~f:(fun (focus', selection) ui ->
-                    Ui.keyboard_area ~focus
+                    Ui.keyboard_area ~focus:focus'
                       (fun k ->
                         Log.debug (fun m ->
                             m "keyboard_area: node_ui %a" Ui.pp_key k);
 
                         match k with
                         | `Enter, [] -> (
+                            Focus.release focus;
                             match selection with
                             | Some sel ->
-                                Log.debug (fun m ->
+                                Log.info (fun m ->
                                     m "node_ui selecting '%s'" sel);
                                 node_ui store (path @ [ sel ]) f;
-                                Log.debug (fun m ->
+                                Log.info (fun m ->
                                     m "node_ui done selecting '%s'"
                                       sel);
 
@@ -3206,7 +3261,15 @@ module Widgets = struct
       paths;
     let _cursor = Lwd.var @@ Lwd_table.first table in
     Lwd_table.map_reduce
-      (fun _row (_focus, ui) -> ui)
+      (fun _row (focus, ui) ->
+        Lwd.map2 ui (Focus.status focus) ~f:(fun ui focus ->
+            Ui.pad
+              ?a:
+                (if Focus.has_focus focus then
+                 Some
+                   A.(bg (NVG.Color.rgbaf ~r:1. ~g:1. ~b:1. ~a:0.5))
+                else None)
+              ~l:5. ~r:10. ~t:15. ~b:20. ui))
       (Lwd_utils.lift_monoid Ui.pack_x)
       table
     |> Lwd.join