padding
This commit is contained in:
cqc
171
human.ml
171
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 "@[<hov>focus=%a %a@]" Focus.pp_status t.focus pp_desc
|
||||
t.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
|
||||
~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
|
||||
|
||||
Reference in New Issue
Block a user