implement permanent sensors

lib/nottui-widgets/nottui_widgets.ml

@@ -97,7 +97,7 @@ let vscroll_area ~state ~change t =
   t
   |> Ui.scroll_area 0 state.position
   |> Ui.resize ~h:0 ~sh:1
-  |> Ui.size_sensor (fun _ h ->
+  |> Ui.size_sensor (fun ~w:_ ~h ->
       let tchange =
         if !total <> (Ui.layout_spec t).Ui.h
         then (total := (Ui.layout_spec t).Ui.h; true)
@@ -232,7 +232,7 @@ let v_pane left right =
   in
   splitter $= Lwd.map (Ui.mouse_area action) (Lwd.get splitter_bg);
   render ();
-  let on_resize ew eh =
+  let on_resize ~w:ew ~h:eh =
     if !w <> ew || !h <> eh then (
       w := ew; h := eh;
       render ()
@@ -271,7 +271,7 @@ let h_pane top bottom =
   in
   splitter $= Lwd.map (Ui.mouse_area action) (Lwd.get splitter_bg);
   render ();
-  let on_resize ew eh =
+  let on_resize ~w:ew ~h:eh =
     if !w <> ew || !h <> eh then (
       w := ew; h := eh;
       render ()

lib/nottui/nottui.ml

@@ -188,36 +188,41 @@ struct
   let pp_layout_spec ppf { w; h; sw; sh } =
     Format.fprintf ppf "{ w = %d; h = %d; sw = %d; sh = %d }" w h sw sh
 
-  type 'a desc =
-    | Atom of image
-    | Size_sensor of 'a * (int -> int -> unit)
-    | Full_sensor of 'a * (int -> int -> int -> int -> unit) * (int -> int -> int -> int -> unit)
-    | Resize of 'a * Gravity.t2 * A.t
-    | Mouse_handler of 'a * mouse_handler
-    | Focus_area of 'a * (key -> may_handle)
-    | Scroll_area of 'a * int * int
-    | Event_filter of 'a * ([`Key of key | `Mouse of mouse] -> may_handle)
-    | X of 'a * 'a
-    | Y of 'a * 'a
-    | Z of 'a * 'a
-
   type flags = int
   let flags_none = 0
   let flag_transient_sensor = 1
-  (*let flag_permanent_sensor = 1*)
+  let flag_permanent_sensor = 2
+
+  type size_sensor = w:int -> h:int -> unit
+  type frame_sensor = x:int -> y:int -> w:int -> h:int -> unit -> unit
 
   type t = {
     w : int; sw : int;
     h : int; sh : int;
-    mutable desc : t desc;
+    mutable desc : desc;
     focus : Focus.status;
     mutable flags : flags;
+    mutable sensor_cache : (int * int * int * int) option;
     mutable cache : cache;
   }
   and cache = {
     vx : Interval.t; vy : Interval.t;
     image : image;
   }
+  and desc =
+    | Atom of image
+    | Size_sensor of t * size_sensor
+    | Transient_sensor of t * frame_sensor
+    | Permanent_sensor of t * frame_sensor
+    | Resize of t * Gravity.t2 * A.t
+    | Mouse_handler of t * mouse_handler
+    | Focus_area of t * (key -> may_handle)
+    | Scroll_area of t * int * int
+    | Event_filter of t * ([`Key of key | `Mouse of mouse] -> may_handle)
+    | X of t * t
+    | Y of t * t
+    | Z of t * t
+
 
   let layout_spec t : layout_spec =
     { w = t.w; h = t.h; sw = t.sw; sh = t.sh }
@@ -226,17 +231,20 @@ struct
   let layout_height t = t.h
   let layout_stretch_height t = t.sh
 
-  let cache : cache = { vx = Interval.zero; vy = Interval.zero; image = I.empty }
+  let cache : cache =
+    { vx = Interval.zero; vy = Interval.zero; image = I.empty }
 
   let empty : t =
     { w = 0; sw = 0; h = 0; sh = 0; flags = flags_none;
-      focus = Focus.empty; desc = Atom I.empty; cache }
+      focus = Focus.empty; desc = Atom I.empty;
+      sensor_cache = None; cache }
 
   let atom img : t =
     { w = I.width img; sw = 0;
       h = I.height img; sh = 0;
       focus = Focus.empty; flags = flags_none;
-      desc = Atom img; cache; }
+      desc = Atom img;
+      sensor_cache = None; cache; }
 
   let void x y = atom (I.void x y)
 
@@ -256,11 +264,14 @@ struct
   let size_sensor handler t : t =
     { t with desc = Size_sensor (t, handler) }
 
-  let ignore_sensor _ _ _ _ = ()
-  let full_sensor ?(before=ignore_sensor) ?(after=ignore_sensor) t =
-    { t with desc = Full_sensor (t, before, after);
+  let transient_sensor frame_sensor t =
+    { t with desc = Transient_sensor (t, frame_sensor);
              flags = t.flags lor flag_transient_sensor }
 
+  let permanent_sensor frame_sensor t =
+    { t with desc = Permanent_sensor (t, frame_sensor);
+             flags = t.flags lor flag_permanent_sensor }
+
   let resize ?w ?h ?sw ?sh ?fill ?crop ?(bg=A.empty) t : t =
     let g = match fill, crop with
       | None, None -> Gravity.(pair default default)
@@ -283,21 +294,24 @@ struct
     w = (a.w + b.w);   sw = (a.sw + b.sw);
     h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
     flags = a.flags lor b.flags;
-    focus = Focus.merge a.focus b.focus; desc = X (a, b); cache
+    focus = Focus.merge a.focus b.focus; desc = X (a, b);
+    sensor_cache = None; cache
   }
 
   let join_y a b = {
     w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
     h = (a.h + b.h);   sh = (a.sh + b.sh);
     flags = a.flags lor b.flags;
-    focus = Focus.merge a.focus b.focus; desc = Y (a, b); cache;
+    focus = Focus.merge a.focus b.focus; desc = Y (a, b);
+    sensor_cache = None; cache;
   }
 
   let join_z a b = {
     w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
     h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
     flags = a.flags lor b.flags;
-    focus = Focus.merge a.focus b.focus; desc = Z (a, b); cache;
+    focus = Focus.merge a.focus b.focus; desc = Z (a, b);
+    sensor_cache = None; cache;
   }
 
   let pack_x = (empty, join_x)
@@ -319,8 +333,10 @@ struct
     | Atom _   -> Format.fprintf ppf "Atom _"
     | Size_sensor (desc, _) ->
       Format.fprintf ppf "Size_sensor (@[%a,@ _@])" pp desc
-    | Full_sensor (desc, _, _) ->
-      Format.fprintf ppf "Full_sensor (@[%a,@ _@])" pp desc
+    | Transient_sensor (desc, _) ->
+      Format.fprintf ppf "Transient_sensor (@[%a,@ _@])" pp desc
+    | Permanent_sensor (desc, _) ->
+      Format.fprintf ppf "Permanent_sensor (@[%a,@ _@])" pp desc
     | Resize (desc, gravity, _bg) ->
       Format.fprintf ppf "Resize (@[%a,@ %a,@ %a@])" pp desc
         Gravity.pp (Gravity.p1 gravity)
@@ -339,7 +355,7 @@ struct
 
   let iter f ui = match ui.desc with
     | Atom _ -> ()
-    | Size_sensor (u, _) | Full_sensor (u, _, _)
+    | Size_sensor (u, _) | Transient_sensor (u, _) | Permanent_sensor (u, _)
     | Resize (u, _, _) | Mouse_handler (u, _)
     | Focus_area (u, _) | Scroll_area (u, _, _) | Event_filter (u, _)
       -> f u
@@ -403,39 +419,54 @@ struct
       | `Neutral  -> (flex / 2, fixed)
       | `Positive -> (flex, fixed)
 
+  let has_transient_sensor flags = flags land flag_transient_sensor <> 0
+  let has_permanent_sensor flags = flags land flag_permanent_sensor <> 0
+
   let rec update_sensors ox oy sw sh ui =
-    if ui.flags land flag_transient_sensor <> 0 then (
+    if has_transient_sensor ui.flags || (
+        has_permanent_sensor ui.flags &&
+        match ui.sensor_cache with
+        | None -> false
+        | Some (ox', oy', sw', sh') ->
+          ox = ox' && oy = oy' && sw = sw' && sh = sh'
+      )
+    then (
       ui.flags <- ui.flags land lnot flag_transient_sensor;
-      update_sub_sensors ox oy sw sh ui
+      if has_permanent_sensor ui.flags then
+        ui.sensor_cache <- Some (ox, oy, sw, sh);
+      match ui.desc with
+      | Atom _ -> ()
+      | Size_sensor (t, _) | Mouse_handler (t, _)
+      | Focus_area (t, _) | Event_filter (t, _) ->
+        update_sensors ox oy sw sh t
+      | Transient_sensor (t, sensor) ->
+        ui.desc <- t.desc;
+        let sensor = sensor ~x:ox ~y:oy ~w:sw ~h:sh in
+        update_sensors ox oy sw sh t;
+        sensor ()
+      | Permanent_sensor (t, sensor) ->
+        let sensor = sensor ~x:ox ~y:oy ~w:sw ~h:sh in
+        update_sensors ox oy sw sh t;
+        sensor ()
+      | 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
+        update_sensors (ox + dx) (oy + dy) rw rh t
+      | Scroll_area (t, sx, sy) ->
+        update_sensors (ox - sx) (oy - sy) sw sh t
+      | X (a, b) ->
+        let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw sw in
+        update_sensors ox oy aw sh a;
+        update_sensors (ox + aw) oy bw sh b
+      | Y (a, b) ->
+        let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh sh in
+        update_sensors ox oy sw ah a;
+        update_sensors ox (oy + ah) sw bh b
+      | Z (a, b) ->
+        update_sensors ox oy sw sh a;
+        update_sensors ox oy sw sh b
     )
-  and update_sub_sensors ox oy sw sh ui = match ui.desc with
-    | Atom _ -> ()
-    | Size_sensor (t, _) | Mouse_handler (t, _)
-    | Focus_area (t, _) | Event_filter (t, _) ->
-      update_sensors ox oy sw sh t
-    | Full_sensor (t, before, after) ->
-      ui.desc <- t.desc;
-      before ox oy sw sh;
-      update_sensors ox oy sw sh t;
-      after ox oy sw sh
-    | 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
-      update_sensors (ox + dx) (oy + dy) rw rh t
-    | Scroll_area (t, sx, sy) ->
-      update_sensors (ox - sx) (oy - sy) sw sh t
-    | X (a, b) ->
-      let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw sw in
-      update_sensors ox oy aw sh a;
-      update_sensors (ox + aw) oy bw sh b
-    | Y (a, b) ->
-      let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh sh in
-      update_sensors ox oy sw ah a;
-      update_sensors ox (oy + ah) sw bh b
-    | Z (a, b) ->
-      update_sensors ox oy sw sh a;
-      update_sensors ox oy sw sh b
 
   let update_focus ui =
     match ui.focus with
@@ -477,7 +508,8 @@ struct
         assert (_offsetx = 0 && _offsety = 0);
         (x - ox >= 0 && x - ox <= rw && y - oy >= 0 && y - oy <= rh) &&
         (aux ox oy sw sh t || handle ox oy f)
-      | Size_sensor (desc, _) | Full_sensor (desc, _, _)
+      | Size_sensor (desc, _)
+      | Transient_sensor (desc, _) | Permanent_sensor (desc, _)
       | Focus_area (desc, _) ->
         aux ox oy sw sh desc
       | Scroll_area (desc, sx, sy) ->
@@ -552,9 +584,9 @@ struct
             vy = Interval.make 0 sh;
             image = resize_canvas sw sh image }
         | Size_sensor (desc, handler) ->
-          handler sw sh;
+          handler ~w:sw ~h:sh;
           render_node vx1 vy1 vx2 vy2 sw sh desc
-        | Full_sensor (desc, _, _) ->
+        | Transient_sensor (desc, _) | Permanent_sensor (desc, _) ->
           render_node vx1 vy1 vx2 vy2 sw sh desc
         | Focus_area (desc, _) | Mouse_handler (desc, _) ->
           render_node vx1 vy1 vx2 vy2 sw sh desc
@@ -649,7 +681,8 @@ struct
                 | `Handled -> `Handled
                 | `Unhandled -> iter tl
             end
-          | Mouse_handler (t, _) | Size_sensor (t, _) | Full_sensor (t, _, _)
+          | Mouse_handler (t, _) | Size_sensor (t, _)
+          | Transient_sensor (t, _) | Permanent_sensor (t, _)
           | Scroll_area (t, _, _) | Resize (t, _, _) ->
             iter (t :: tl)
           | Event_filter (t, f) ->
@@ -675,7 +708,8 @@ struct
   let rec dispatch_focus t dir =
     match t.desc with
     | Atom _ -> false
-    | Mouse_handler (t, _) | Size_sensor (t, _) | Full_sensor (t, _, _)
+    | Mouse_handler (t, _) | Size_sensor (t, _)
+    | Transient_sensor (t, _) | Permanent_sensor (t, _)
     | Scroll_area (t, _, _) | Resize (t, _, _) | Event_filter (t, _) ->
       dispatch_focus t dir
     | Focus_area (t', _) ->

lib/nottui/nottui.mli

@@ -67,10 +67,14 @@ sig
   val has_focus : t -> bool
   val keyboard_area : ?focus:Focus.status -> (key -> may_handle) -> t -> t
   val scroll_area : int -> int -> t -> t
-  val size_sensor : (int -> int -> unit) -> t -> t
-  val full_sensor :
-    ?before:(int -> int -> int -> int -> unit) ->
-    ?after:(int -> int -> int -> int -> unit) -> t -> t
+
+  type size_sensor = w:int -> h:int -> unit
+  val size_sensor : size_sensor -> t -> t
+
+  type frame_sensor = x:int -> y:int -> w:int -> h:int -> unit -> unit
+  val transient_sensor : frame_sensor -> t -> t
+  val permanent_sensor : frame_sensor -> t -> t
+
   val resize :
     ?w:int -> ?h:int -> ?sw:int -> ?sh:int ->
     ?fill:Gravity.t -> ?crop:Gravity.t -> ?bg:attr -> t -> t