From 6948a65a973c960a43f5a52c73d41b5e88b3d9a3 Mon Sep 17 00:00:00 2001 From: cqc Date: Sun, 5 Feb 2023 14:47:26 -0600 Subject: [PATCH] padding --- human.ml | 171 +++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 117 insertions(+), 54 deletions(-) diff --git a/human.ml b/human.ml index 266024d..7e1663d 100644 --- a/human.ml +++ b/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) - ~w:(V2.x p0) + NVG.Scissor.scissor vg + ~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 - (path_box vg.vg - (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) - (Box2.of_pts b b')); *) + ignore + (path_box vg + (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) + (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 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 attr a t = { t with desc = Attr (t, a) } 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 "@[focus=%a %a@]" Focus.pp_status t.focus pp_desc - t.desc + if has_focus t then + F.pf ppf "@[%a %a@]" Focus.pp_status t.focus pp_desc + t.desc + else F.pf ppf "@[ %a@]" pp_desc t.desc and pp_desc ppf = function | Atom a -> Format.fprintf ppf "Atom @[(%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 - ~f:(fun focus -> + |> Lwd.map2 (Focus.status 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 -> - Lwd_table.get cursor - |> Option.iter (fun first -> Focus.request first.focus)); - + |> Option.iter (fun r -> + Lwd_table.get r + |> 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 - | `Arrow `Up, _ -> cursor_move cursor Lwd_table.prev + cursor_move cursor Lwd_table.prev |> ignore; + `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, [] -> - Lwd.peek cursor - |> Option.iter (fun c -> - Lwd_table.get c - |> Option.iter (fun (f, _step) -> - Focus.release focus; - Focus.request f)); - `Unhandled + | `Enter, [] -> `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 -> - Ui.keyboard_area ~focus + ~f:(fun (focus', selection) ui -> + 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