From a64fcbb0100f25e83857978753c7ba963db48de9 Mon Sep 17 00:00:00 2001 From: cqc Date: Sun, 11 Dec 2022 18:25:57 -0600 Subject: [PATCH] refactored resizing and stuff --- boot_js.ml | 1 + human.ml | 607 ++++++++++++++++++++++++++++++----------------------- notes.org | 10 + 3 files changed, 360 insertions(+), 258 deletions(-) diff --git a/boot_js.ml b/boot_js.ml index ab3f315..f9158fc 100644 --- a/boot_js.ml +++ b/boot_js.ml @@ -128,6 +128,7 @@ let _ = async (fun () -> render_stream canvas webgl_ctx vg (fun vg ?(time = 0.) p i -> + let _ = time in Log.debug (fun m -> m "Drawing image: p=%a n=%a" Gg.V2.pp p (I.Draw.pp ~attr:A.dark) diff --git a/human.ml b/human.ml index 75bd17e..39e35aa 100644 --- a/human.ml +++ b/human.ml @@ -810,7 +810,7 @@ module I = struct type t = | Empty - | Segment of Text.t + | Segment of Text.t (* box2 is +crop/-pad of drawn Text.t *) | Attr of (t * A.t) | Hcompose of (t * t) | Vcompose of (t * t) @@ -843,6 +843,7 @@ module I = struct V2.(v (Float.max (x p1) (x p2)) (y p1 +. y p2)) | Zcompose (t1, t2) -> p2_max (size vg p t1) (size vg p t2) | Hcrop (t, left, right) -> + (* positive values are crop, negative is pad *) V2.(size vg (p - v left 0.) t - v right 0.) | Vcrop (t, top, bottom) -> V2.(size vg (p - v 0. top) t - v 0. bottom) @@ -873,8 +874,15 @@ module I = struct | Empty, _ -> t2 | _ -> Zcompose (t1, t2) - let hcrop left right img = Hcrop (img, left, right) - let vcrop top bottom img = Vcrop (img, top, bottom) + (* crop is positive value, pad is negative *) + + let hcrop left right img = + 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); + Vcrop (img, top, bottom) let crop ?(l = 0.) ?(r = 0.) ?(t = 0.) ?(b = 0.) img = let img = if l <> 0. || r <> 0. then hcrop l r img else img in @@ -1067,11 +1075,13 @@ module I = struct fmt "@[Attr %a@]" ppf (pair ~sep:comma A.pp (pp ~attr:A.(attr ++ a))) (A.(attr ++ 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 - | Hcrop (t, h, w) -> fmt "Hcrop (%a,%f,%f)" ppf (pp ~attr) t h w - | Vcrop (t, h, w) -> fmt "Vcrop (%a,%f,%f)" ppf (pp ~attr) t h w + | Hcompose a -> fmt "Hcat %a" ppf compose a + | Vcompose a -> fmt "Vcat %a" ppf compose a + | Zcompose a -> fmt "Zcat %a" ppf compose a + | Hcrop (t, left, right) -> + fmt "Hcrop (%.1f,%.1f,%a)" ppf left right (pp ~attr) t + | Vcrop (t, top, bottom) -> + fmt "Vcrop (%.1f,%.1f,%a)" ppf top bottom (pp ~attr) t | Void dim -> fmt "Void %a" ppf (parens V2.pp) dim let rec segment vg p : Text.t -> P2.t = function @@ -1115,9 +1125,26 @@ module I = struct let p1 = node vg attr p i1 in let p2 = node vg attr p i2 in p2_max p1 p2 - | Hcrop (i, left, right) -> node vg attr p i - | Vcrop (i, top, bottom) -> node vg attr p i + | 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) + ~w:(V2.x p0 -. right) + ~h:(V2.y p0); + let p1 = node vg attr V2.(p - v left 0.) i in + NVG.restore vg; + V2.(p1 - v (left +. right) 0.) + | 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) + ~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 (path_box vg.vg (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) @@ -1294,9 +1321,7 @@ module Nottui = struct sh : float; } - let pp_layout_spec ppf { w; h; sw; sh } = - Format.fprintf ppf "{ w = %f; h = %f; sw = %f; sh = %f }" w h sw - sh + let pp_float ppf = F.fmt "%.1f" ppf type flags = int @@ -1309,37 +1334,37 @@ module Nottui = struct type frame_sensor = x:float -> y:float -> w:float -> h:float -> unit -> unit + type image = I.t + type cache = { vx : Interval.t; vy : Interval.t; image : image } + + type 'a desc = + | Atom of image + | 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) + | Shift_area of 'a * float * float + | 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 t = { mutable w : float; mutable h : float; sw : float; sh : float; - mutable desc : desc; + mutable desc : t desc; focus : Focus.status; mutable flags : flags; mutable sensor_cache : (float * float * float * float) option; mutable cache : cache; } - and image = I.t - 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) - | Shift_area of t * float * float - | 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 = + let layout_spec (t : t) : layout_spec = { w = t.w; h = t.h; sw = t.sw; sh = t.sh } let layout_width t = t.w @@ -1347,14 +1372,19 @@ module Nottui = struct let layout_height t = t.h let layout_stretch_height t = t.sh + let pp_layout_spec ppf { w; h; sw; sh; _ } = + let p = pp_float in + Format.fprintf ppf "{w=%a;@ h=%a;@ sw=%a;@ sh=%a}" p w p h p sw + p sh + let cache : cache = { vx = Interval.zero; vy = Interval.zero; image = I.empty } let empty : t = { w = 0.; - sw = 0.; h = 0.; + sw = 0.; sh = 0.; flags = flags_none; focus = Focus.empty; @@ -1366,8 +1396,8 @@ module Nottui = struct let atom img : t = { w = 0.; - sw = 0.; h = 0.; + sw = 0.; sh = 0.; focus = Focus.empty; flags = flags_none; @@ -1391,7 +1421,7 @@ module Nottui = struct let space x y = atom (I.void x y) let mouse_area f t : t = { t with desc = Mouse_handler (t, f) } - let keyboard_area ?focus f t : t = + let keyboard_area ?focus f (t : t) : t = let focus = match focus with | None -> t.focus @@ -1423,63 +1453,64 @@ module Nottui = struct | Some g, None | None, Some g -> Gravity.(pair g g) | Some pad, Some crop -> Gravity.(pair pad crop) - let resize ?w ?h ?sw ?sh ?pad ?crop ?(bg = A.empty) t : t = + let resize ?w ?h ?sw ?sh ?pad ?crop ?(attr = A.empty) (t : t) : t + = + let _ = attr in + let wo, ho = (w, h) in let g = prepare_gravity (pad, crop) in match ((w, t.w), (h, t.h), (sw, t.sw), (sh, t.sh)) with - | ( (Some w, _ | None, w), - (Some h, _ | None, h), - (Some sw, _ | None, sw), - (Some sh, _ | None, sh) ) -> - { t with w; h; sw; sh; desc = Resize (t, g, bg) } + | ( (Some w, _ | _, w), + (Some h, _ | _, h), + (Some sw, _ | _, sw), + (Some sh, _ | _, sh) ) -> + { t with w; h; sw; sh; desc = Resize (t, wo, ho, g) } - let resize_to ({ w; h; sw; sh } : layout_spec) ?pad ?crop - ?(attr = A.empty) t : t = + let resize_to (l : layout_spec) ?pad ?crop ?(attr = A.empty) t : t + = + let _ = attr in let g = prepare_gravity (pad, crop) in - { t with w; h; sw; sh; desc = Resize (t, g, attr) } + { t with desc = Resize (t, Some l.w, Some l.h, g) } - let event_filter ?focus f t : t = + let event_filter ?focus f (t : t) : t = let focus = match focus with None -> t.focus | Some focus -> focus in { t with desc = Event_filter (t, f); focus } - let join_x a b = + let join_x (a : t) (b : t) = { + empty with w = a.w +. b.w; - sw = a.sw +. b.sw; h = max a.h b.h; + sw = a.sw +. b.sw; sh = max a.sh b.sh; flags = a.flags lor b.flags; focus = Focus.merge a.focus b.focus; desc = X (a, b); - sensor_cache = None; - cache; } - let join_y a b = + let join_y (a : t) (b : t) = { + empty with w = max a.w b.w; - sw = max a.sw b.sw; h = a.h +. b.h; + sw = max a.sw b.sw; sh = a.sh +. b.sh; flags = a.flags lor b.flags; focus = Focus.merge a.focus b.focus; desc = Y (a, b); - sensor_cache = None; - cache; } - let join_z a b = + let join_z (a : t) (b : t) = { + empty with w = max a.w b.w; - sw = max a.sw b.sw; h = max a.h b.h; + sw = max a.sw b.sw; sh = max a.sh b.sh; flags = a.flags lor b.flags; focus = Focus.merge a.focus b.focus; desc = Z (a, b); - sensor_cache = None; - cache; } let pack_x = (empty, join_x) @@ -1502,10 +1533,12 @@ module Nottui = struct 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)" Gravity.pp - (Gravity.p1 gravity) Gravity.pp (Gravity.p2 gravity) pp - desc + | Resize (desc, x, y, _gravity) -> + F.pf ppf "Resize (%a, %a,@ _,@ %a)" (F.option pp_float) x + (F.option pp_float) y + (* Gravity.pp (Gravity.p1 gravity) Gravity.pp + (Gravity.p2 gravity) *) + pp desc | Mouse_handler (n, _) -> Format.fprintf ppf "%a" (*"Mouse (%a,@ _)"*) pp n | Focus_area (n, _) -> Format.fprintf ppf "Focus (%a,@ _)" pp n @@ -1523,7 +1556,7 @@ module Nottui = struct | Size_sensor (u, _) | Transient_sensor (u, _) | Permanent_sensor (u, _) - | Resize (u, _, _) + | Resize (u, _, _, _) | Mouse_handler (u, _) | Focus_area (u, _) | Shift_area (u, _, _) @@ -1556,29 +1589,53 @@ module Nottui = struct let size t = t.size - let solve_focus ui i = + let iter f (ui : ui) = + match ui.desc with + | Atom _ -> () + | Size_sensor (u, _) + | Transient_sensor (u, _) + | Permanent_sensor (u, _) + | Resize (u, _, _, _) + | Mouse_handler (u, _) + | Focus_area (u, _) + | Shift_area (u, _, _) + | Event_filter (u, _) -> + f u + | X (u1, u2) | Y (u1, u2) | Z (u1, u2) -> + f u1; + f u2 + + let solve_focus (ui : ui) i = let rec aux ui = match ui.focus with | Focus.Empty | Focus.Handle (0, _) -> () | Focus.Handle (i', _) when i = i' -> () | Focus.Handle (_, v) -> Lwd.set v 0 - | Focus.Conflict _ -> Ui.iter aux ui + | Focus.Conflict _ -> iter aux ui in aux ui let split ~a ~sa ~b ~sb total = let stretch = sa +. sb in let flex = total -. a -. b in - if stretch > 0. && flex > 0. then - let ratio = - if sa > sb then flex *. sa /. stretch - else flex -. (flex *. sb /. stretch) - in - (a +. ratio, b +. flex -. ratio) - else (a, b) + let a', b' = + if stretch > 0. && flex > 0. then + let ratio = + if sa > sb then flex *. sa /. stretch + else flex -. (flex *. sb /. stretch) + in + (a +. ratio, b +. flex -. ratio) + else (a, b) + in + Log.debug (fun m -> + m + "split: a=%.1f sa=%.1f b=%.1f sb=%.1f total=%.1f (%.1f, \ + %.1f)" + a sa b sb total a' b'); + (a', b') let pack ~fixed ~stretch total g1 g2 = - let x, y = + let v1, v2 = let flex = total -. fixed in if stretch > 0. && flex > 0. then (0., total) else @@ -1590,8 +1647,8 @@ module Nottui = struct in Log.debug (fun m -> m "pack fixed=%.1f stretch=%.1f total=%.1f (%.1f, %.1f)" - fixed stretch total x y); - (x, y) + fixed stretch total v1 v2); + (v1, v2) let has_transient_sensor flags = flags land flag_transient_sensor <> 0 @@ -1599,7 +1656,7 @@ module Nottui = struct let has_permanent_sensor flags = flags land flag_permanent_sensor <> 0 - let rec update_sensors ox oy sw sh ui = + let rec update_sensors ox oy sw sh (ui : ui) = if has_transient_sensor ui.flags || has_permanent_sensor ui.flags @@ -1628,13 +1685,21 @@ module Nottui = struct let sensor = sensor ~x:ox ~y:oy ~w:sw ~h:sh in update_sensors ox oy sw sh t; sensor () - | Resize (t, g, _) -> + | Resize (t, x, y, g) -> let open Gravity in let dx, rw = - pack ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g)) + pack + ~fixed:(Option.value x ~default: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)) + pack + ~fixed:(Option.value y ~default:t.h) + ~stretch:t.sh sh + (v (p1 g)) + (v (p2 g)) in update_sensors (ox +. dx) (oy +. dy) rw rh t | Shift_area (t, sx, sy) -> @@ -1656,56 +1721,95 @@ module Nottui = struct | Focus.Empty | Focus.Handle _ -> () | Focus.Conflict i -> solve_focus ui i - let rec update_size vg (size : box2) ui = - let s1 = - match ui.desc with - | Atom i -> I.size vg (Box2.o size) i + let rec t_size_desc_of_t vg (size : box2) (ui : Ui.t desc) = + match ui with + | Atom _ as a -> a + | 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) + | Focus_area (t, v) -> Focus_area (t_size_of_t vg size t, v) + | Event_filter (t, v) -> Event_filter (t_size_of_t vg size t, v) + | Transient_sensor (t, v) -> + Transient_sensor (t_size_of_t vg size t, v) + | Permanent_sensor (t, v) -> + Permanent_sensor (t_size_of_t vg size t, v) + | Resize (t, w, h, g2) -> + Resize + ( t_size_of_t vg + (Box2.v (Box2.o size) + (V2.v + (Option.value w ~default:(Box2.w size)) + (Option.value h ~default:(Box2.h size)))) + t, + w, + h, + g2 ) + | Shift_area (t, sx, sy) -> + Shift_area + ( t_size_of_t vg + (Box2.of_pts + V2.(Box2.o size - of_tuple (sx, sy)) + (Box2.max size)) + t, + sx, + sy ) + | X (a, b) -> + let a' = t_size_of_t vg size a in + let b' = + t_size_of_t vg + (Box2.of_pts + V2.(v (Box2.minx size +. a'.w) (Box2.miny size)) + (Box2.max size)) + b + in + X (a', b') + | Y (a, b) -> + let a' = t_size_of_t vg size a in + let b' = + t_size_of_t vg + (Box2.of_pts + V2.(v (Box2.minx size) (Box2.miny size +. a'.h)) + (Box2.max size)) + b + in + Y (a', b') + | Z (a, b) -> Z (t_size_of_t vg size a, t_size_of_t vg size b) + + and t_size_of_t vg (size : box2) (ui : Ui.t) : ui = + let desc = t_size_desc_of_t vg size ui.desc in + let w, h = + match desc with + | Atom i -> V2.to_tuple (I.size vg (Box2.o size) i) | Size_sensor (t, _) | Mouse_handler (t, _) | Focus_area (t, _) | Event_filter (t, _) | Transient_sensor (t, _) | Permanent_sensor (t, _) -> - update_size vg size t - | Resize (t, g2, _) -> update_size vg size t - | Shift_area (t, sx, sy) -> - update_size vg - (Box2.of_pts - V2.(of_tuple (sx, sy) - Box2.o size) - (Box2.max size)) - t - | X (a, b) -> - let p1 = update_size vg size a in - let p2 = - update_size vg - (Box2.of_pts - V2.(v (x p1) (Box2.miny size)) - (Box2.max size)) - b - in - I.p2_max p1 p2 - | Y (a, b) -> - let p1 = update_size vg size a in - let p2 = - update_size vg - (Box2.of_pts - V2.(v (Box2.minx size) (y p1)) - (Box2.max size)) - b - in - I.p2_max p1 p2 - | Z (a, b) -> - I.p2_max (update_size vg size a) (update_size vg size b) + (t.w, t.h) + | Resize (t, w, h, _) -> + (Option.value w ~default:t.w, Option.value h ~default:t.h) + | 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) + | Z (a, b) -> (max a.w b.w, max a.h b.h) in - ui.w <- V2.x s1 -. Box2.minx size; - ui.h <- V2.y s1 -. Box2.miny size; - s1 + { + ui with + w; + h; + sw = w; + sh = h; + desc; + sensor_cache = None; + cache; + } - let update t size ui = - t.size <- update_size t.vg (Box2.v V2.zero size) ui; - t.view <- ui; - update_sensors 0. 0. (P2.x size) (P2.y size) ui; - update_focus ui + let update t size (ui : Ui.t) = + t.size <- size; + t.view <- t_size_of_t t.vg (Box2.v V2.zero size) ui; + update_sensors 0. 0. (P2.x size) (P2.y size) t.view; + update_focus t.view let dispatch_mouse st x y btn w h t = let handle ox oy f = @@ -1747,7 +1851,7 @@ module Nottui = struct aux ox oy sw sh desc | Shift_area (desc, sx, sy) -> aux (ox -. sx) (oy -. sy) sw sh desc - | Resize (t, g, _bg) -> + | Resize (t, _, _, g) -> let open Gravity in let dx, rw = pack ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g)) @@ -1772,6 +1876,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 -> + 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 @@ -1801,13 +1907,109 @@ 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 = - (* 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); *) + 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 + + 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 @@ -1822,128 +2024,13 @@ module Nottui = struct image = I.void sw sh; } else - 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 - Log.debug (fun m -> - m - "render_node X()@ vx1=%.0f@ vy1=%.0f@ vx2=%.0f@ \ - vy2=%.0f@ sw=%.0f@ sh=%.0f aw=%.0f bw=%.0f" - vx1 vy1 vx2 vy2 sw sh aw bw); - 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 - Log.debug (fun m -> - m - "render_node Y()@ vx1=%.0f@ vy1=%.0f@ vx2=%.0f@ \ - vy2=%.0f@ sw=%.0f@ sh=%.0f ah=%.0f bh=%.0f" - vx1 vy1 vx2 vy2 sw sh ah bh); - { 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, a) -> - 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 image = - if a.bg != Color.none then - I.(image char ~attr:a ' ' sw sh) - else 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 + let cache = _render_node vg vx1 vy1 vx2 vy2 sw sh t in t.cache <- cache; cache let image vg { size; view; _ } = let w, h = V2.to_tuple size in - Log.debug (fun m -> m "Renderer.image view=%a" Ui.pp view); + (*Log.debug (fun m -> m "Renderer.image view=%a" Ui.pp view);*) (render_node vg 0. 0. w h w h view).image let dispatch_raw_key st key = @@ -1973,7 +2060,7 @@ module Nottui = struct | Transient_sensor (t, _) | Permanent_sensor (t, _) | Shift_area (t, _, _) - | Resize (t, _, _) -> + | Resize (t, _, _, _) -> iter (t :: tl) | Event_filter (t, f) -> ( match f (`Key key) with @@ -2006,7 +2093,7 @@ module Nottui = struct | Transient_sensor (t, _) | Permanent_sensor (t, _) | Shift_area (t, _, _) - | Resize (t, _, _) + | Resize (t, _, _, _) | Event_filter (t, _) -> dispatch_focus t dir | Focus_area (t', _) -> @@ -2150,7 +2237,7 @@ module Nottui_lwt = struct | None -> ignore (Renderer.dispatch_event renderer event)) | #Ui.event as event -> ( match Renderer.dispatch_event renderer event with - | `Handled -> refresh () + | `Handled -> () | `Unhandled -> Log.warn (fun m -> m @@ -2308,7 +2395,7 @@ module Nottui_widgets = struct Ui.transient_sensor sensor ui) else ui *) - let scroll_step = 4. + let scroll_step = 7. type scroll_state = { position : float; @@ -2320,7 +2407,12 @@ module Nottui_widgets = struct let default_scroll_state = { position = 0.; bound = 0.; visible = 0.; total = 0. } - let vscroll_area ~state ~change t = + 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 = @@ -2462,7 +2554,7 @@ module Nottui_widgets = struct let r = Ui.resize ~w:0. ~h:0. ~sh:1. ~sw:(max -. pos) r in let splitter = Ui.resize - ~bg:A.(bg Color.lightyellow) + ~attr:A.(bg Color.lightyellow) ~w:1. ~h:0. ~sw:0. ~sh:1. Ui.empty in let splitter = @@ -2506,7 +2598,7 @@ module Nottui_widgets = struct let bot = Ui.resize ~w:0. ~h:0. ~sw:1. ~sh:(max -. pos) bot in let splitter = Ui.resize - ~bg:A.(bg Color.lightyellow) + ~attr:A.(bg Color.lightyellow) ~w:0. ~h:1. ~sw:1. ~sh:0. Ui.empty in let splitter = @@ -2576,7 +2668,7 @@ module Nottui_widgets = struct ] in let handler k = - Log.debug (fun m -> m "edit_field keyboard_area handler"); + (* Log.debug (fun m -> m "edit_field keyboard_area handler");*) match k with | `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) -> on_change ("", 0); @@ -2957,7 +3049,8 @@ module Nottui_widgets = struct let off = if off < 0. then 0. else off in off - let decr_if x cond = if cond then x -. 1. else x + let scrollbar_width = 10. + let decr_if x cond = if cond then x -. scrollbar_width else x let scrollbar_bg = Color.gray 0.4 let scrollbar_fg = Color.gray 0.7 @@ -2967,8 +3060,6 @@ module Nottui_widgets = struct let scrollbar_wheel_step = 8. (* Wheel event scrolls 1/8th of the screen *) - let scrollbar_width = 10. - let hscrollbar visible total offset ~set = let prefix = offset *. visible /. total in let suffix = (total -. offset -. visible) *. visible /. total in @@ -3064,7 +3155,7 @@ module Nottui_widgets = struct let state_y = adjust_offset state_h bh state.y in (* Composite visible scroll bars *) let crop b = - Ui.resize ~sw:1. ~sh:1. ~w:0. ~h:0. + Ui.resize ~sw:scrollbar_width ~sh:scrollbar_width ~w:0. ~h:0. (Ui.shift_area state_x state_y b) in let set_vscroll y = @@ -3086,7 +3177,7 @@ module Nottui_widgets = struct crop body <|> vscrollbar state_h bh state_y ~set:set_vscroll <-> (hscrollbar state_w bw state_x ~set:set_hscroll - <|> Ui.space 1. 1.) + <|> Ui.space scrollbar_width scrollbar_width) in (* Render final box *) Lwd.map2 t (Lwd.get state_var) ~f:(fun ui size -> diff --git a/notes.org b/notes.org index eba35b5..696e331 100644 --- a/notes.org +++ b/notes.org @@ -24,3 +24,13 @@ * principles? an "anywhere" programming environment +* 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 + +currently you were planning to combine update_sensors and update_size + +in the original nottui.ml library, are Ui.t.w and Ui.t.h determined from the top down orbottom up? +the bottom up, becahse they are chars + +