diff --git a/human.ml b/human.ml index 1f9ceab..b7e4ddb 100644 --- a/human.ml +++ b/human.ml @@ -492,8 +492,8 @@ module Input = struct (* stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *) let string_of_code = function | `Uchar ch -> - if Uchar.is_char ch then F.str "Char '%c'" (Uchar.to_char ch) - else F.str "Char 0x%02x" (Uchar.to_int ch) + if Uchar.is_char ch then F.str "%c" (Uchar.to_char ch) + else F.str "0x%02x" (Uchar.to_int ch) | `Enter -> "Enter" | `Escape -> "Escape" | `Tab -> "Tab" @@ -573,7 +573,7 @@ module NVG = struct include Graphv_webgl.Color let none = Color.transparent - let rgbf = Color.rgbf + let transparent = rgbaf ~r:0. ~g:0. ~b:0. ~a:0.000001 let gray a = rgbf ~r:a ~g:a ~b:a let light = gray 0.8 let dark = gray 0.2 @@ -1078,7 +1078,6 @@ module I = struct set_fill_color vg ~color; fill vg; NVG.restore vg; - (* Log.debug (fun m -> m "fill_box: %a" Box2.pp b); *) Box2.size b let path_box vg color ?(width = 0.) b = @@ -1413,7 +1412,7 @@ module Nottui = struct | a -> pf ppf "%a" Input.pp_code a) Input.pp_mods) - let pp_keys = F.(list ~sep:F.comma pp_key) + let pp_keys = F.(list ~sep:F.semi pp_key) type mouse = Input.mouse @@ -2154,6 +2153,23 @@ module Nottui = struct | Event_filter (t, _f) -> render_node vg vx1 vy1 vx2 vy2 sw sh t in + let cache = + if Focus.has_focus t.focus then ( + Log.debug (fun m -> + m "render_node has_focus %a" Focus.pp_status t.focus); + { + cache with + image = + I.attr + A.(bg (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.1)) + cache.image; + }) + else + { + cache with + image = I.attr A.(bg Color.transparent) cache.image; + } + in t.cache <- cache; cache @@ -3050,7 +3066,7 @@ module Widgets = struct |> 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 (fun _ { ui; _ } -> ui) @@ -3150,8 +3166,8 @@ module Widgets = struct Ui.may_handle (Lwd.peek cursor) (fun cursor_row -> Ui.may_handle (f cursor_row) (fun new_row -> Lwd_table.get new_row - |> Option.iter (fun (new_line_focus, new_line_sel) -> - Lwd.set selection (Some new_line_sel); + |> Option.iter (fun ((new_line_focus, _) as new_line) -> + Lwd.set selection (Some new_line); Lwd_table.get cursor_row |> Option.iter (fun (cursor_line_focus, _) -> Focus.release cursor_line_focus); @@ -3258,52 +3274,43 @@ module Widgets = struct open Lwt.Infix let rec node_ui ?(focus = Focus.make ()) store path - (f : Focus.handle * ui Lwd.t -> unit) : unit = + (f : ui Lwd.t -> unit) : unit = Lwt.async (fun () -> Nav.S.tree store >>= fun tree -> Nav.S.Tree.kind tree path >>= function | None -> f - ( focus, - Lwd.pure - @@ string - ("Nav.S.Tree.kind " ^ String.concat "/" path - ^ " how'd you get here??") ); + (Lwd.pure + @@ string + ("Nav.S.Tree.kind " ^ String.concat "/" path + ^ " how'd you get here??")); Lwt.return_unit | Some `Node -> let selection = Lwd.var None in tree_nav ~selection ~focus (store, path) >>= fun ui -> f - ( focus, - Lwd.map2 - (Lwd.pair (Focus.status focus) (Lwd.get selection)) - ui - ~f:(fun (focus', selection) ui -> - Ui.keyboard_area ~focus:focus' - (fun k -> - Log.debug (fun m -> - m "keyboard_area: node_ui %a" Ui.pp_keys k); - - match k with - | [ (`Enter, []) ] -> ( - Focus.release focus; - match selection with - | Some sel -> - Log.info (fun m -> - m "node_ui selecting '%s'" sel); - node_ui store (path @ [ sel ]) f; - Log.info (fun m -> - m "node_ui done selecting '%s'" - sel); - - `Handled - | None -> `Unhandled) - | _ -> `Unhandled) - ui) ); + (Lwd.map2 + (Lwd.pair (Focus.status focus) (Lwd.get selection)) + ui + ~f:(fun (focus', selection) ui -> + Ui.keyboard_area ~focus:focus' + (fun k -> + Log.debug (fun m -> + m "keyboard_area: node_ui %a" Ui.pp_keys k); + match k with + | [ (`Enter, []) ] -> ( + match selection with + | Some (sel_focus, sel_str) -> + node_ui store (path @ [ sel_str ]) f; + Focus.release sel_focus; + `Handled + | None -> `Unhandled) + | _ -> `Unhandled) + ui)); Lwt.return_unit | Some `Contents -> node_edit_area ~focus (store, path) >>= fun ui -> - f (focus, ui); + f ui; Lwt.return_unit) let h_node_area ?(table = Lwd_table.make ()) @@ -3313,17 +3320,10 @@ module Widgets = struct (fun path -> node_ui store path (fun v -> Lwd_table.append' table v)) paths; - let _cursor = Lwd.var @@ Lwd_table.first table in Lwd_table.map_reduce - (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)) + (fun _row ui -> + Lwd.map ui ~f:(fun ui -> + Ui.pad ~l:10. ~r:10. ~t:10. ~b:10. ui)) (Lwd_utils.lift_monoid Ui.pack_x) table |> Lwd.join