console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

basic text field edition

Browse Source
This commit is contained in:
cqc
2022-12-14 09:46:09 -06:00
parent a64fcbb010
commit 5c10f3860a
3 changed files with 368 additions and 281 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
boot_js.ml
View File

@ -94,8 +94,12 @@ let _ =
let ui =
Nottui_widgets.(
let string s = Lwd.pure @@ Nottui_widgets.string s in
scroll_area
@@ Lwd_utils.pack Ui.pack_y
line_table_of_string
"edit me?\n\
derp derp derp\n\
herp herp derp\n\
ding dong beep beep"
(* @@ Lwd_utils.pack Ui.pack_y
[
edit_field edit_me;
string "derp derp derp";
@ -111,7 +115,7 @@ let _ =
string "herp herp derp";
string "ding dong beep beep";
main_menu_item wm "Quit" (fun () -> exit 0);
])
] *))
in
let root =
Lwd.set body

439
human.ml
View File

@ -256,8 +256,7 @@ module Git_console_http = struct
| Ok (_resp, contents) ->
Lwt.return_ok (`Data (Cstruct.of_string contents))
| Error err ->
Lwt.return_error
(`Msg (Fmt.str "%a" Git_af.pp_error err)))
Lwt.return_error (`Msg (Fmt.str "%a" pp_error err)))
let close _ = Lwt.return_unit
@ -489,14 +488,6 @@ module Input = struct
type code =
[ `Uchar of Uchar.t (* A unicode character. *) | special ]
type mods = [ `Super | `Meta | `Ctrl | `Shift ] list
type mouse =
[ `Press of button | `Drag | `Release ] * (float * float) * mods
type paste = [ `Start | `End ]
type keyaction = [ `Press | `Release | `Repeat ]
(* stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *)
let string_of_code = function
| `Uchar ch ->
@ -518,6 +509,25 @@ module Input = struct
| `Delete -> "Delete"
| `Backspace -> "Backspace"
| `Unknown s -> String.concat "Unknown " [ "\""; s; "\"" ]
| _ -> "Code Unknown!"
let pp_code ppf v = F.pf ppf "%s" (string_of_code v)
type mods = [ `Super | `Meta | `Ctrl | `Shift ] list
let pp_mods =
F.(
list (fun ppf -> function
| `Super -> pf ppf "`Super"
| `Meta -> pf ppf "`Meta"
| `Ctrl -> pf ppf "`Ctrl"
| `Shift -> pf ppf "`Shift"))
type mouse =
[ `Press of button | `Drag | `Release ] * (float * float) * mods
type paste = [ `Start | `End ]
type keyaction = [ `Press | `Release | `Repeat ]
end
module Event_js = struct
@ -583,14 +593,17 @@ module NVG = struct
and lightcyan = rgbf ~r:0.5 ~g:1.0 ~b:1.0
and lightwhite = rgbf ~r:1.0 ~g:1.0 ~b:1.0
let ( = ) a b = a.r = b.r && a.g = b.g && a.b = b.b && a.a = b.a
let ( ++ ) a b =
(* {
{
r = Float.clamp ~min:0. ~max:1. (a.r +. b.r);
g = Float.clamp ~min:0. ~max:1. (a.g +. b.g);
b = Float.clamp ~min:0. ~max:1. (a.b +. b.b);
a = Float.clamp ~min:0. ~max:1. (a.a +. b.a);
} *)
if a = none then b else a
}
let replace ~prev ~next = if next = none then prev else next
let pp ppf t : unit =
if t != none then
@ -746,6 +759,8 @@ module Style = struct
match t.font with
| `Sans -> Text.set_font_face vg ~name:"sans"
| _ -> ()
let replace ~prev ~next = merge prev next
end
type t = { fg : Color.t; bg : Color.t; font : Font.t }
@ -772,6 +787,13 @@ module Style = struct
font = Font.merge a1.font a2.font;
}
let replace ~prev ~next =
{
fg = Color.replace ~prev:prev.fg ~next:next.fg;
bg = Color.replace ~prev:prev.bg ~next:next.bg;
font = Font.replace ~prev:prev.font ~next:next.font;
}
let fg ?(t = empty) c = { t with fg = c }
let bg ?(t = empty) c = { t with bg = c }
let font ?(t = empty) c = { t with font = c }
@ -823,15 +845,19 @@ module I = struct
V2.(v (Float.max (x p1) (x p2)) (Float.max (y p1) (y p2)))
[@@inline]
let bounds_segment vg p : Text.t -> NVG.Text.bounds = function
| String s ->
let open NVG.Text in
let { ascender; _ } = NVG.Text.metrics vg in
bounds vg ~x:(V2.x p) ~y:(V2.y p +. ascender) s
let rec size vg p = function
| Empty -> V2.zero
| Segment s ->
let NVG.Bounds.{ xmin; ymin; xmax; ymax } =
(NVG.Text.bounds vg ~x:(V2.x p) ~y:(V2.y p)
(Text.to_string s))
.box
let NVG.Text.{ box = { ymax; ymin; _ }; advance } =
bounds_segment vg p s
in
V2.v (xmax -. xmin) (ymax -. ymin)
V2.v advance (ymax -. ymin)
| Attr (t, _a) -> size vg p t
| Hcompose (t1, t2) ->
let p1 = size vg p t1 in
@ -853,7 +879,7 @@ module I = struct
let void w h = Void (P2.v w h)
let attr a = function
| Attr (t, a0) -> Attr (t, A.(a ++ a0))
| Attr (t, a0) -> Attr (t, A.(replace ~prev:a0 ~next:a))
| t -> Attr (t, a)
let ( <|> ) t1 t2 =
@ -877,11 +903,11 @@ module I = struct
(* crop is positive value, pad is negative *)
let hcrop left right img =
Log.debug (fun m -> m "Hcrop (%f, %f)" left right);
(* 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);
(* 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 =
@ -1042,7 +1068,7 @@ module I = struct
set_fill_color vg ~color;
fill vg;
NVG.restore vg;
Log.debug (fun m -> m "fill_box: %a" Box2.pp b);
(* Log.debug (fun m -> m "fill_box: %a" Box2.pp b); *)
Box2.size b
let path_box vg color ?(width = 0.) b =
@ -1073,8 +1099,9 @@ module I = struct
| Segment v -> fmt "@[<h>Segment %a@]" ppf Text.pp v
| Attr (t, a) ->
fmt "@[<h>Attr %a@]" ppf
(pair ~sep:comma A.pp (pp ~attr:A.(attr ++ a)))
(A.(attr ++ a), t)
(pair ~sep:comma A.pp
(pp ~attr:A.(replace ~prev:attr ~next:a)))
(A.(replace ~prev:attr ~next: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
@ -1084,18 +1111,37 @@ module I = struct
fmt "Vcrop (%.1f,%.1f,%a)" ppf top bottom (pp ~attr) t
| Void dim -> fmt "Void %a" ppf (parens V2.pp) dim
let segment_kern_cache = ref (Box2.zero, "")
let rec segment vg p : Text.t -> P2.t = function
| String s ->
(* Log.debug (fun m -> m "I.Draw.segment p=%a %s" Gg.V2.pp p s); *)
(* let p' =
let cache_p, cache_s = !segment_kern_cache in
(* tries to get the kerning right across segments *)
if V2.(equal (Box2.max cache_p) p) then
V2.(
Box2.o cache_p
+ v
((bounds_segment vg (Box2.o cache_p)
(Text.of_string (cache_s ^ s)))
.advance
-. (bounds_segment vg p (Text.of_string s)).advance
)
0.)
else p
in *)
let metrics = NVG.Text.metrics vg in
NVG.Text.text vg ~x:(V2.x p)
~y:(V2.y p +. metrics.ascender)
(* TODO make segments include neighbors so kerning is correct *)
s;
let NVG.Bounds.{ xmin; ymin; xmax; ymax } =
(NVG.Text.bounds vg ~x:(V2.x p) ~y:(V2.y p) s).box
let sz =
V2.v (bounds_segment vg p (Text.of_string s)).advance
metrics.line_height
in
V2.v (xmax -. xmin) (ymax -. ymin)
segment_kern_cache := (Box2.(v p sz), s);
sz
and node vg attr p n : p2 =
(* returns the *size* of the drawn area not the max coordinates anymore *)
@ -1104,12 +1150,12 @@ module I = struct
| Empty | Void _ -> p
| Segment text -> segment vg p text
| Attr (i, a) ->
let a0 = A.(attr ++ a) in
let a0 = A.(replace ~prev:attr ~next:a) in
if
A.(a0.bg) != NVG.Color.transparent
&& A.(a0.bg) != A.(attr.bg)
(A.(a.bg) != A.(attr.bg))
&& A.(a0.bg) != NVG.Color.transparent
then fill_box vg a0.bg (Box2.v p (size vg p i)) |> ignore;
if A.(attr.fg) != a0.fg then (
if A.(attr.fg) != a.fg then (
NVG.set_fill_color vg ~color:Style.(a0.fg);
NVG.set_stroke_color vg ~color:Style.(a0.fg));
node vg a0 p i
@ -1287,6 +1333,10 @@ module Nottui = struct
module Ui = struct
type may_handle = [ `Unhandled | `Handled ]
let pp_may_handle ppf = function
| `Unhandled -> F.pf ppf "`Unhandled"
| `Handled -> F.pf ppf "`Unhandled"
type mouse_handler =
x:float ->
y:float ->
@ -1309,6 +1359,25 @@ module Nottui = struct
[ Input.special | `Uchar of Uchar.t | semantic_key ]
* Input.mods
let pp_key =
F.(
pair
(fun ppf v ->
match v with
| `Copy -> pf ppf "`Copy"
| `Paste -> pf ppf "`Paste"
| `Focus v ->
pf ppf "`Focus %s"
(match v with
| `Next -> "`Next"
| `Prev -> "`Prev"
| `Left -> "`Left"
| `Right -> "`Right"
| `Up -> "`Up"
| `Down -> "`Down")
| a -> pf ppf "%a" Input.pp_code a)
Input.pp_mods)
type mouse = Input.mouse
type event =
@ -1627,11 +1696,11 @@ module Nottui = struct
(a +. ratio, b +. flex -. ratio)
else (a, b)
in
Log.debug (fun m ->
(* 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 sa b sb total a' b'); *)
(a', b')
let pack ~fixed ~stretch total g1 g2 =
@ -1645,9 +1714,9 @@ module Nottui = struct
| `Neutral -> (flex /. 2., fixed)
| `Positive -> (flex, fixed)
in
Log.debug (fun m ->
(* Log.debug (fun m ->
m "pack fixed=%.1f stretch=%.1f total=%.1f (%.1f, %.1f)"
fixed stretch total v1 v2);
fixed stretch total v1 v2); *)
(v1, v2)
let has_transient_sensor flags =
@ -1794,16 +1863,7 @@ module Nottui = struct
| 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 with
w;
h;
sw = w;
sh = h;
desc;
sensor_cache = None;
cache;
}
{ ui with w; h; desc; sensor_cache = None; cache }
let update t size (ui : Ui.t) =
t.size <- size;
@ -1876,8 +1936,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);
(* 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
@ -1907,8 +1967,28 @@ 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); *)
if
let cache = t.cache in
vx1 >= Interval.fst cache.vx
&& vy1 >= Interval.fst cache.vy
&& vx2 <= Interval.snd cache.vx
&& vy2 <= Interval.snd cache.vy
then t.cache
else if vx2 < 0. || vy2 < 0. || sw < vx1 || sh < vy1 then
{
vx = Interval.make vx1 vx2;
vy = Interval.make vy1 vy2;
image = I.void sw sh;
}
else
let cache =
match t.desc with
| Atom image ->
{
@ -1931,7 +2011,8 @@ module Nottui = struct
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)
resize_canvas vg sw sh
(I.crop ~l:sx ~t:sy cache.image)
in
{ vx; vy; image }
| X (a, b) ->
@ -1942,8 +2023,10 @@ module Nottui = struct
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))
(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))
@ -1964,8 +2047,10 @@ module Nottui = struct
(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))
(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
@ -2001,30 +2086,9 @@ module Nottui = struct
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
&& vy1 >= Interval.fst cache.vy
&& vx2 <= Interval.snd cache.vx
&& vy2 <= Interval.snd cache.vy
then t.cache
else if vx2 < 0. || vy2 < 0. || sw < vx1 || sh < vy1 then
{
vx = Interval.make vx1 vx2;
vy = Interval.make vy1 vy2;
image = I.void sw sh;
}
else
let cache = _render_node vg vx1 vy1 vx2 vy2 sw sh t in
| Event_filter (t, _f) ->
render_node vg vx1 vy1 vx2 vy2 sw sh t
in
t.cache <- cache;
cache
@ -2048,7 +2112,6 @@ module Nottui = struct
in
iter st'
| Focus_area (t, f) -> (
Log.debug (fun m -> m "dispatch_raw_key Focus_area");
match iter [ t ] with
| `Handled -> `Handled
| `Unhandled -> (
@ -2097,18 +2160,10 @@ module Nottui = struct
| Event_filter (t, _) ->
dispatch_focus t dir
| Focus_area (t', _) ->
if Focus.has_focus t'.focus then (
Log.debug (fun m ->
m "dispatch_focus: Focus.has_focus t'.focus");
dispatch_focus t' dir || grab_focus t)
else if
Log.debug (fun m ->
m "dispatch_focus: Focus.has_focus t.focus");
Focus.has_focus t.focus
then false
else (
Log.debug (fun m -> m "dispatch_focus: grab_focus");
grab_focus t)
if Focus.has_focus t'.focus then
dispatch_focus t' dir || grab_focus t
else if Focus.has_focus t.focus then false
else grab_focus t
| X (a, b) -> (
if Focus.has_focus a.focus then
dispatch_focus a dir
@ -2228,7 +2283,6 @@ module Nottui_lwt = struct
in
refresh ();
let process_event e =
Log.debug (fun m -> m "Nottui_lwt.render= process_event");
match e with
| `Key (`Uchar c, [ `Meta ]) as event
when Uchar.(equal c (of_char 'q')) -> (
@ -2239,10 +2293,11 @@ module Nottui_lwt = struct
match Renderer.dispatch_event renderer event with
| `Handled -> ()
| `Unhandled ->
Log.warn (fun m ->
(* Log.warn (fun m ->
m
"Nottui_lwt.render process_event #Ui.event -> \
`Unhandled"))
`Unhandled") *)
())
| `Resize size' ->
size := size';
refresh ()
@ -2284,8 +2339,11 @@ module Nottui_widgets = struct
let attr_menu_main = A.(bg Color.green ++ fg Color.black)
let attr_menu_sub = A.(bg Color.lightgreen ++ fg Color.black)
let attr_clickable = A.(bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5)
let attr_cursor = A.(bg @@ Color.rgbf ~r:0.4 ~g:0.4 ~b:0.1)
let attr_clickable =
A.((bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5) ++ (fg @@ Color.light))
let attr_cursor = A.((fg @@ Color.dark) ++ (bg @@ Color.yellow))
type window_manager = {
overlays : ui Lwd.t Lwd_table.t;
@ -2397,73 +2455,6 @@ module Nottui_widgets = struct
let scroll_step = 7.
type scroll_state = {
position : float;
bound : float;
visible : float;
total : float;
}
let default_scroll_state =
{ position = 0.; bound = 0.; visible = 0.; total = 0. }
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 =
let position = state.position +. delta in
let position = max 0. (min state.bound position) in
if position <> state.position then
change `Action { state with position };
`Handled
in
let focus_handler state = function
(*| `Arrow `Left , _ -> scroll (-scroll_step) 0*)
(*| `Arrow `Right, _ -> scroll (+scroll_step) 0*)
| `Arrow `Up, [] -> scroll state (-.scroll_step)
| `Arrow `Down, [] -> scroll state (+.scroll_step)
| `Page `Up, [] -> scroll state (-.scroll_step *. 8.)
| `Page `Down, [] -> scroll state (+.scroll_step *. 8.)
| _ -> `Unhandled
in
let scroll_handler state ~x:_ ~y:_ = function
| `Scroll `Up -> scroll state (-.scroll_step)
| `Scroll `Down -> scroll state (+.scroll_step)
| _ -> `Unhandled
in
Lwd.map2 t state ~f:(fun t state ->
t
|> Ui.shift_area 0. state.position
|> Ui.resize ~h:0. ~sh:1.
|> Ui.size_sensor (fun ~w:_ ~h ->
let tchange =
if !total <> Ui.(layout_spec t).h then (
total := Ui.(layout_spec t).h;
true)
else false
in
let vchange =
if !visible <> h then (
visible := h;
true)
else false
in
if tchange || vchange then
change `Content
{
state with
visible = !visible;
total = !total;
bound = max 0. (!total -. !visible);
})
|> Ui.mouse_area (scroll_handler state)
|> Ui.keyboard_area (focus_handler state))
let scroll_area ?(offset = (0., 0.)) t =
let offset = Lwd.var offset in
let scroll d_x d_y =
@ -2637,12 +2628,9 @@ module Nottui_widgets = struct
let sub' str p l =
if p = 0 && l = String.length str then str else String.sub str p l
let edit_field ?(focus = Focus.make ()) ?(on_change = ignore)
let edit_field ?(focus = Focus.make ()) ?(on_change = Fun.id)
?(on_submit = ignore) state =
let on_change a =
on_change a;
Lwd.set state a
in
let on_change a = Lwd.set state (on_change a) in
let update focus_h focus (text, pos) =
let pos = min (max 0 pos) (String.length text) in
let content =
@ -2651,25 +2639,18 @@ module Nottui_widgets = struct
if Focus.has_focus focus then
let attr = attr_clickable in
let len = String.length text in
(if pos >= len then [ I.string ~attr text ]
else [ I.string ~attr (sub' text 0 pos) ])
@
if pos < String.length text then
if pos >= len then
[ I.string ~attr text; I.string ~attr:attr_cursor " " ]
else
[
I.string ~attr (sub' text 0 pos);
I.string ~attr:attr_cursor (sub' text pos 1);
I.string ~attr (sub' text (pos + 1) (len - pos - 1));
]
else [ I.string ~attr:A.(bg Color.lightred) " " ]
else
[
I.string
~attr:A.(font Font.underline)
(if text = "" then " " else text);
]
else [ I.string (if text = "" then " " else text) ]
in
let handler k =
(* Log.debug (fun m -> m "edit_field keyboard_area handler");*)
match k with
(match k with
| `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) ->
on_change ("", 0);
`Handled (* clear *)
@ -2715,7 +2696,12 @@ module Nottui_widgets = struct
on_change (text, pos);
`Handled)
else `Unhandled
| _ -> `Unhandled
| _ -> `Unhandled)
|> fun r ->
Log.debug (fun m ->
m "edit_field keyboard_area handler %a -> %a" Ui.pp_key k
Ui.pp_may_handle r);
r
in
Ui.keyboard_area ~focus handler content
in
@ -2735,6 +2721,95 @@ module Nottui_widgets = struct
open Lwd.Infix
type line = {
focus : Focus.handle;
state : (string * int) Lwd.var;
ui : Ui.t Lwd.t;
}
let _line_on_change _table _row (s, i) = (s, i)
let eq_uc_c uc c = Uchar.(equal uc (of_char c))
let copy_line_cursor (x : line) (y : line) =
let _, xi = Lwd.peek x.state in
let ys, _ = Lwd.peek y.state in
let yi = Int.max 0 (Int.min xi (String.length ys)) in
Lwd.set y.state (ys, yi)
let cursor_move cursor
(f : line Lwd_table.row -> line Lwd_table.row option) =
match Lwd.peek cursor with
| Some cursor_line -> (
match f cursor_line with
| Some new_line ->
(match Lwd_table.get new_line with
| Some line' ->
cursor_line |> Lwd_table.get
|> Option.iter (fun line ->
copy_line_cursor line line');
Focus.request line'.focus
| None -> ());
Lwd.set cursor (Some new_line);
`Handled
| None -> `Unhandled)
| None -> `Unhandled
let line_append ?(table = Lwd_table.make ()) str =
let focus = Focus.make () in
let state = Lwd.var (str, 0) in
let row = Lwd_table.append table in
Lwd_table.set row
{
focus;
state;
ui =
edit_field ~focus
~on_change:(_line_on_change table row)
state;
}
let line_table_of_string ?(table = Lwd_table.make ())
?(focus = Focus.make ()) (s : string) : Ui.t Lwd.t =
(* Append lines from s to table *)
List.iter (line_append ~table) (String.split_on_char '\n' s);
(* create the cursor var *)
let cursor = Lwd.var @@ Lwd_table.first table in
Option.iter
(fun cursor ->
Option.iter (fun first -> Focus.request first.focus)
@@ Lwd_table.get cursor)
(Lwd.peek cursor);
(* Build view of table *)
Lwd_table.map_reduce
(fun _ { ui; _ } -> ui)
(Lwd_utils.lift_monoid Ui.pack_y)
table
|> Lwd.join
|> Lwd.map2
~f:(fun focus ->
Ui.keyboard_area ~focus (function
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' ->
cursor_move cursor (fun c -> Lwd_table.next c)
| `Arrow `Down, _ ->
cursor_move cursor (fun c -> Lwd_table.next c)
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' ->
cursor_move cursor (fun c -> Lwd_table.prev c)
| `Arrow `Up, _ ->
cursor_move cursor (fun c -> Lwd_table.prev c)
| `Uchar u, [ `Meta ] when eq_uc_c u '<' ->
cursor_move cursor (fun _ -> Lwd_table.first table)
| `Uchar u, [ `Meta ] when eq_uc_c u '>' ->
cursor_move cursor (fun _ -> Lwd_table.last table)
(* | `Enter, [] -> (
let row = Lwd.peek cursor in
match Lwd_table.get row with
| Some line ->
Lwd_table.after row ~set:Lwd.set cursor
| None -> `Unhandled) *)
| _ -> `Unhandled))
(Focus.status focus)
(** Tab view, where exactly one element of [l] is shown at a time. *)
let tabs (tabs : (string * (unit -> Ui.t Lwd.t)) list) : Ui.t Lwd.t
=

8
notes.org
View File

@ -24,6 +24,14 @@
* principles?
an "anywhere" programming environment
* 221211
ok you got the scroll box mostly working so next:
** fix the scroll jump bugs
** setup better keybindings
** fix cursor and active focus indicators
* 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