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

moar

Browse Source
This commit is contained in:
cqc
2022-12-08 20:12:56 -06:00
parent cb263b5758
commit af92f03706
2 changed files with 744 additions and 728 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
boot_js.ml
View File

@ -88,46 +88,12 @@ let _ =
let open Js_of_ocaml_lwt.Lwt_js_events in let open Js_of_ocaml_lwt.Lwt_js_events in
let edit_me = Lwd.var ("edit me?", 0) in let edit_me = Lwd.var ("edit me?", 0) in
let root = let root =
Lwd_utils.pack Nottui.Ui.pack_y let open Nottui_widgets in
[ edit_field (Lwd.get edit_me)
(* Lwd_utils.pack Nottui.Ui.pack_x
[
Lwd.pure @@ Nottui_widgets.string "hello daddy";
Lwd.pure
@@ Nottui_widgets.string
"What is going to be displayed here?";
];
Lwd_utils.pack Nottui.Ui.pack_x
[
Lwd.pure @@ Nottui_widgets.string "hello daddy";
Lwd.pure
@@ Nottui_widgets.string
"What is going to be displayed here?";
];
Lwd_utils.pack Nottui.Ui.pack_x
[
Lwd.pure @@ Nottui_widgets.string "hello";
Lwd.pure @@ Nottui_widgets.string "hello";
Lwd.pure @@ Nottui_widgets.string "hello";
Lwd.pure @@ Nottui_widgets.string "hello";
Lwd.pure @@ Nottui_widgets.string "hello";
];
Lwd_utils.pack Nottui.Ui.pack_x
[
Lwd.pure @@ Nottui_widgets.string "it ";
Lwd.pure @@ Nottui_widgets.string "want ";
Lwd.pure @@ Nottui_widgets.string "you ";
Lwd.pure @@ Nottui_widgets.string "do ";
Lwd.pure @@ Nottui_widgets.string "when ";
];
Lwd.pure @@ Nottui_widgets.string "when when when when";
Lwd.pure @@ Nottui_widgets.string "when when when when";*)
Nottui_widgets.edit_field (Lwd.get edit_me)
~on_change:(fun ((text, pos) as state) -> ~on_change:(fun ((text, pos) as state) ->
Log.debug (fun m -> m "--- on_change (%s,%d)" text pos); Log.debug (fun m -> m "--- on_change (%s,%d)" text pos);
Lwd.set edit_me state) Lwd.set edit_me state)
~on_submit:ignore; ~on_submit:ignore
]
in in
let events, push_event = Lwt_stream.create () in let events, push_event = Lwt_stream.create () in
@ -140,7 +106,9 @@ let _ =
render_stream canvas webgl_ctx vg render_stream canvas webgl_ctx vg
(fun vg ?(time = 0.) p i -> (fun vg ?(time = 0.) p i ->
Log.debug (fun m -> Log.debug (fun m ->
m "Drawing image: p=%a n=%a" Gg.V2.pp p I.Draw.pp i); m "Drawing image: p=%a n=%a" Gg.V2.pp p
(I.Draw.pp ~attr:A.dark)
i);
let p' = I.Draw.node vg A.dark p i in let p' = I.Draw.node vg A.dark p i in
Logs.debug (fun m -> Logs.debug (fun m ->
m "Drawing finished: p'=%a" Gg.V2.pp p')) m "Drawing finished: p'=%a" Gg.V2.pp p'))

334
human.ml
View File

@ -584,17 +584,19 @@ module NVG = struct
and lightcyan = rgbf ~r:0.5 ~g:1.0 ~b:1.0 and lightcyan = rgbf ~r:0.5 ~g:1.0 ~b:1.0
and lightwhite = rgbf ~r:1.0 ~g:1.0 ~b:1.0 and lightwhite = rgbf ~r:1.0 ~g:1.0 ~b:1.0
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);
}
let pp ppf t : unit = let pp ppf t : unit =
F.( F.(
fmt "%a" ppf fmt "%a" ppf
(record (list ~sep:(any "|") float)
[ [ t.r; t.g; t.b; t.a ])
field "r" (fun t -> t.r) F.float;
field "g" (fun t -> t.g) F.float;
field "b" (fun t -> t.b) F.float;
field "a" (fun t -> t.a) F.float;
])
t)
end end
end end
@ -607,12 +609,15 @@ let str_of_box b =
let fill_box vg color b = let fill_box vg color b =
let module Path = NVG.Path in let module Path = NVG.Path in
let open NVG in let open NVG in
NVG.save vg;
Path.begin_ vg; Path.begin_ vg;
Path.rect vg ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b) Path.rect vg ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b)
~h:(Box2.h b); ~h:(Box2.h b);
set_fill_color vg ~color; set_fill_color vg ~color;
fill vg; fill vg;
Box2.max b 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 = let path_box vg color ?(width = 0.) b =
let module Path = NVG.Path in let module Path = NVG.Path in
@ -622,7 +627,7 @@ let path_box vg color ?(width = 0.) b =
if width != 0. then NVG.set_stroke_width vg ~width; if width != 0. then NVG.set_stroke_width vg ~width;
NVG.set_stroke_color vg ~color; NVG.set_stroke_color vg ~color;
NVG.stroke vg; NVG.stroke vg;
Box2.max b Box2.size b
module Style = struct module Style = struct
module Font = struct module Font = struct
@ -634,6 +639,11 @@ module Style = struct
underline : [ `Underline | `None ]; underline : [ `Underline | `None ];
} }
let pp ppf =
F.(
fmt "%a" ppf
(record [ field "size" (fun a -> a.size) (option float) ]))
let empty = let empty =
{ {
size = None; size = None;
@ -691,6 +701,16 @@ module Style = struct
type t = { fg : Color.t; bg : Color.t; font : Font.t } type t = { fg : Color.t; bg : Color.t; font : Font.t }
type attr = t type attr = t
let pp ppf =
F.(
fmt "%a" ppf
(record
[
field "fg" (fun a -> a.fg) Color.pp;
field "bg" (fun a -> a.bg) Color.pp;
field "font" (fun a -> a.font) Font.pp;
]))
let equal = ( == ) let equal = ( == )
let empty = let empty =
@ -703,13 +723,10 @@ module Style = struct
let dark = { empty with fg = Color.light; bg = Color.dark } let dark = { empty with fg = Color.light; bg = Color.dark }
let ( ++ ) a1 a2 = let ( ++ ) a1 a2 =
if a1 == empty then a2
else if a2 == empty then a1
else
{ {
a1 with fg = Color.(a1.fg ++ a2.fg);
fg = Color.lerp a1.fg a2.fg ~a:0.5; bg = Color.(a1.bg ++ a2.bg);
bg = Color.lerp a1.bg a2.bg ~a:0.5; font = Font.merge a1.font a2.font;
} }
let fg ?(t = empty) c = { t with fg = c } let fg ?(t = empty) c = { t with fg = c }
@ -809,7 +826,7 @@ module Text = struct
let replicatec w c = String (String.make (int_of_float w) c) let replicatec w c = String (String.make (int_of_float w) c)
let pp ppf : t -> unit = function let pp ppf : t -> unit = function
| String s -> F.(fmt "String %s" ppf s) | String s -> F.(fmt "String \"%s\"" ppf s)
end end
module A = Style module A = Style
@ -1041,20 +1058,22 @@ module I = struct
(Float.max_num (V2.x a) (V2.x b)) (Float.max_num (V2.x a) (V2.x b))
(Float.max_num (V2.y a) (V2.y b)) (Float.max_num (V2.y a) (V2.y b))
let rec pp ppf : t -> unit = function let rec pp ?(attr = A.empty) ppf : t -> unit =
let open F in
let compose = pair (parens (pp ~attr)) (parens (pp ~attr)) in
function
| Empty -> F.(fmt "Empty" ppf) | Empty -> F.(fmt "Empty" ppf)
| Segment v -> F.(fmt "Segment %a" ppf (parens Text.pp) v) | Segment v -> F.(fmt "Segment %a" ppf (parens Text.pp) v)
| Attr v -> | Attr (t, a) ->
F.(fmt "Attr %a" ppf (pair (parens pp) (any "...")) v) fmt "attr %a" ppf
| Hcompose a -> (pair A.pp (parens (pp ~attr:A.(attr ++ a))))
F.(fmt "Hcompose %a" ppf (pair (parens pp) (parens pp)) a) (A.(attr ++ a), t)
| Vcompose a -> | Hcompose a -> fmt "hcat %a" ppf compose a
F.(fmt "Vcompose %a" ppf (pair (parens pp) (parens pp)) a) | Vcompose a -> fmt "vcat %a" ppf compose a
| Zcompose a -> | Zcompose a -> fmt "zcat %a" ppf compose a
F.(fmt "Zcompose %a" ppf (pair (parens pp) (parens pp)) a) | Hcrop (t, h, w) -> fmt "Hcrop (%a,%f,%f)" ppf (pp ~attr) t h w
| Hcrop (t, h, w) -> F.(fmt "Hcrop (%a,%f,%f)" ppf pp t h w) | Vcrop (t, h, w) -> fmt "Vcrop (%a,%f,%f)" ppf (pp ~attr) t h w
| Vcrop (t, h, w) -> F.(fmt "Vcrop (%a,%f,%f)" ppf pp t h w) | Void dim -> fmt "Void %a" ppf (parens V2.pp) dim
| Void dim -> F.(fmt "Void %a" ppf (parens V2.pp) dim)
let rec segment vg p : Text.t -> P2.t = function let rec segment vg p : Text.t -> P2.t = function
| String s -> | String s ->
@ -1062,6 +1081,7 @@ module I = struct
let metrics = NVG.Text.metrics vg in let metrics = NVG.Text.metrics vg in
NVG.Text.text vg ~x:(V2.x p) NVG.Text.text vg ~x:(V2.x p)
~y:(V2.y p +. metrics.ascender) ~y:(V2.y p +. metrics.ascender)
(* TODO make segments include neighbors so kerning is correct *)
s; s;
let NVG.Bounds.{ xmin; ymin; xmax; ymax } = let NVG.Bounds.{ xmin; ymin; xmax; ymax } =
(NVG.Text.bounds vg ~x:(V2.x p) ~y:(V2.y p) s).box (NVG.Text.bounds vg ~x:(V2.x p) ~y:(V2.y p) s).box
@ -1069,14 +1089,21 @@ module I = struct
V2.v (xmax -. xmin) (ymax -. ymin) V2.v (xmax -. xmin) (ymax -. ymin)
and node vg attr p n : p2 = and node vg attr p n : p2 =
(* returns the *size* of the drawn area not the max coordinates anymore *)
let b' = let b' =
match n with match n with
| Empty | Void _ -> p | Empty | Void _ -> p
| Segment text -> segment vg p text | Segment text -> segment vg p text
| Attr (i, a0) -> | Attr (i, a) ->
if Style.(attr.fg) != a0.fg then let a0 = A.(attr ++ a) in
NVG.set_fill_color vg ~color:Style.(attr.fg); if
node vg A.(attr ++ a0) p i A.(a0.bg) != NVG.Color.transparent
&& A.(a0.bg) != A.(attr.bg)
then fill_box vg a0.bg (Box2.v p (size vg p i)) |> ignore;
if A.(attr.fg) != a0.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
| Hcompose (i1, i2) -> | Hcompose (i1, i2) ->
let p1 = node vg attr p i1 in let p1 = node vg attr p i1 in
let p2 = node vg attr V2.(p + v (V2.x p1) 0.) i2 in let p2 = node vg attr V2.(p + v (V2.x p1) 0.) i2 in
@ -1228,8 +1255,7 @@ module Nottui = struct
val shift : t -> float -> t val shift : t -> float -> t
val fst : t -> float val fst : t -> float
val snd : t -> float val snd : t -> float
val size : t -> float
(*val size : t -> int*)
val zero : t val zero : t
end = struct end = struct
type t = float * float type t = float * float
@ -2113,7 +2139,8 @@ module Nottui_widgets = struct
let attr_menu_main = A.(bg Color.green ++ fg Color.black) let attr_menu_main = A.(bg Color.green ++ fg Color.black)
let attr_menu_sub = A.(bg Color.lightgreen ++ fg Color.black) let attr_menu_sub = A.(bg Color.lightgreen ++ fg Color.black)
let attr_clickable = A.(fg Color.lightblue) 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)
type window_manager = { type window_manager = {
overlays : ui Lwd.t Lwd_table.t; overlays : ui Lwd.t Lwd_table.t;
@ -2136,30 +2163,30 @@ module Nottui_widgets = struct
let window_manager_view wm = wm.view let window_manager_view wm = wm.view
let window_manager_overlays wm = wm.overlays let window_manager_overlays wm = wm.overlays
(* let menu_overlay wm g ?(dx = 0) ?(dy = 0) body around = let menu_overlay wm g ?(dx = 0.) ?(dy = 0.) body around =
let sensor ~x ~y ~w ~h () = let sensor ~x ~y ~w ~h () =
let row = Lwd_table.append (window_manager_overlays wm) in let row = Lwd_table.append (window_manager_overlays wm) in
let h_pad = let h_pad =
match Gravity.h g with match Gravity.h g with
| `Negative -> Ui.space (x + dx) 0 | `Negative -> Ui.space (x +. dx) 0.
| `Neutral -> Ui.space (x + dx + (w / 2)) 0 | `Neutral -> Ui.space (x +. dx +. (w /. 2.)) 0.
| `Positive -> Ui.space (x + dx + w) 0 | `Positive -> Ui.space (x +. dx +. w) 0.
in in
let v_pad = let v_pad =
match Gravity.v g with match Gravity.v g with
| `Negative -> Ui.space 0 (y + dy) | `Negative -> Ui.space 0. (y +. dy)
| `Neutral -> Ui.space 0 (y + dy + (h / 2)) | `Neutral -> Ui.space 0. (y +. dy +. (h /. 2.))
| `Positive -> Ui.space 0 (y + dy + h) | `Positive -> Ui.space 0. (y +. dy +. h)
in in
let view = let view =
Lwd.map body ~f:(fun body -> Lwd.map body ~f:(fun body ->
let body = let body =
let pad = Ui.space 1 0 in let pad = Ui.space 1. 0. in
Ui.join_x pad (Ui.join_x body pad) Ui.join_x pad (Ui.join_x body pad)
in in
let bg = let bg =
Ui.resize_to (Ui.layout_spec body) Ui.resize_to (Ui.layout_spec body)
~bg:A.(bg lightgreen) ~bg:A.(bg Color.lightgreen)
Ui.empty Ui.empty
in in
let catchall = let catchall =
@ -2169,7 +2196,7 @@ module Nottui_widgets = struct
Lwd_table.remove row; Lwd_table.remove row;
`Handled `Handled
| _ -> `Handled) | _ -> `Handled)
(Ui.resize ~sw:1 ~sh:1 Ui.empty) (Ui.resize ~sw:1. ~sh:1. Ui.empty)
in in
Ui.join_z catchall @@ Ui.join_y v_pad @@ Ui.join_x h_pad Ui.join_z catchall @@ Ui.join_y v_pad @@ Ui.join_x h_pad
@@ Ui.join_z bg body) @@ Ui.join_z bg body)
@ -2178,16 +2205,24 @@ module Nottui_widgets = struct
in in
Ui.transient_sensor sensor around Ui.transient_sensor sensor around
(*let menu_overlay wm ?(dx=0) ?(dy=0) handler body = (* let menu_overlay wm ?(dx = 0) ?(dy = 0) handler body =
let refresh = Lwd.var () in let refresh = Lwd.var () in
let clicked = ref false in let clicked = ref false in
Lwd.map' body @@ fun body -> Lwd.map' body @@ fun body ->
let body = let pad = Ui.space 1 0 in Ui.join_x pad (Ui.join_x body pad) in let body =
let pad = Ui.space 1 0 in
Ui.join_x pad (Ui.join_x body pad)
in
let bg = let bg =
Ui.resize_to (Ui.layout_spec body) ~bg:A.(bg lightgreen) Ui.empty Ui.resize_to (Ui.layout_spec body)
~bg:A.(bg lightgreen)
Ui.empty
in in
let click_handler ~x:_ ~y:_ = function let click_handler ~x:_ ~y:_ = function
| `Left -> clicked := true; Lwd.set refresh (); `Handled | `Left ->
clicked := true;
Lwd.set refresh ();
`Handled
| _ -> `Unhandled | _ -> `Unhandled
in in
let ui = Ui.mouse_area click_handler (Ui.join_z bg body) in let ui = Ui.mouse_area click_handler (Ui.join_z bg body) in
@ -2197,11 +2232,14 @@ module Nottui_widgets = struct
let row = Lwd_table.append (window_manager_overlays wm) in let row = Lwd_table.append (window_manager_overlays wm) in
let h_pad = Ui.space (x + dx) 0 in let h_pad = Ui.space (x + dx) 0 in
let v_pad = Ui.space 0 (y + h + dy) in let v_pad = Ui.space 0 (y + h + dy) in
let view = Lwd.map' (handler ()) @@ fun view -> let view =
Lwd.map' (handler ()) @@ fun view ->
let catchall = let catchall =
Ui.mouse_area Ui.mouse_area
(fun ~x:_ ~y:_ -> function (fun ~x:_ ~y:_ -> function
| `Left -> Lwd_table.remove row; `Handled | `Left ->
Lwd_table.remove row;
`Handled
| _ -> `Handled) | _ -> `Handled)
(Ui.resize ~sw:1 ~sh:1 Ui.empty) (Ui.resize ~sw:1 ~sh:1 Ui.empty)
in in
@ -2209,27 +2247,27 @@ module Nottui_widgets = struct
in in
Lwd_table.set row view Lwd_table.set row view
in in
Ui.transient_sensor sensor ui Ui.transient_sensor sensor ui)
) else ui*) else ui *)
let scroll_step = 1 let scroll_step = 4.
type scroll_state = { type scroll_state = {
position : int; position : float;
bound : int; bound : float;
visible : int; visible : float;
total : int; total : float;
} }
let default_scroll_state = let default_scroll_state =
{ position = 0; bound = 0; visible = 0; total = 0 } { position = 0.; bound = 0.; visible = 0.; total = 0. }
let vscroll_area ~state ~change t = let vscroll_area ~state ~change t =
let visible = ref (-1) in let visible = ref (-1.) in
let total = ref (-1) in let total = ref (-1.) in
let scroll state delta = let scroll state delta =
let position = state.position + delta in let position = state.position +. delta in
let position = max 0 (min state.bound position) in let position = max 0. (min state.bound position) in
if position <> state.position then if position <> state.position then
change `Action { state with position }; change `Action { state with position };
`Handled `Handled
@ -2237,25 +2275,25 @@ module Nottui_widgets = struct
let focus_handler state = function let focus_handler state = function
(*| `Arrow `Left , _ -> scroll (-scroll_step) 0*) (*| `Arrow `Left , _ -> scroll (-scroll_step) 0*)
(*| `Arrow `Right, _ -> scroll (+scroll_step) 0*) (*| `Arrow `Right, _ -> scroll (+scroll_step) 0*)
| `Arrow `Up, [] -> scroll state (-scroll_step) | `Arrow `Up, [] -> scroll state (-.scroll_step)
| `Arrow `Down, [] -> scroll state (+scroll_step) | `Arrow `Down, [] -> scroll state (+.scroll_step)
| `Page `Up, [] -> scroll state (-scroll_step * 8) | `Page `Up, [] -> scroll state (-.scroll_step *. 8.)
| `Page `Down, [] -> scroll state (+scroll_step * 8) | `Page `Down, [] -> scroll state (+.scroll_step *. 8.)
| _ -> `Unhandled | _ -> `Unhandled
in in
let scroll_handler state ~x:_ ~y:_ = function let scroll_handler state ~x:_ ~y:_ = function
| `Scroll `Up -> scroll state (-scroll_step) | `Scroll `Up -> scroll state (-.scroll_step)
| `Scroll `Down -> scroll state (+scroll_step) | `Scroll `Down -> scroll state (+.scroll_step)
| _ -> `Unhandled | _ -> `Unhandled
in in
Lwd.map2 t state ~f:(fun t state -> Lwd.map2 t state ~f:(fun t state ->
t t
|> Ui.shift_area 0 state.position |> Ui.shift_area 0. state.position
|> Ui.resize ~h:0 ~sh:1 |> Ui.resize ~h:0. ~sh:1.
|> Ui.size_sensor (fun ~w:_ ~h -> |> Ui.size_sensor (fun ~w:_ ~h ->
let tchange = let tchange =
if !total <> (Ui.layout_spec t).Ui.h then ( if !total <> Ui.(layout_spec t).h then (
total := (Ui.layout_spec t).Ui.h; total := Ui.(layout_spec t).h;
true) true)
else false else false
in in
@ -2271,38 +2309,38 @@ module Nottui_widgets = struct
state with state with
visible = !visible; visible = !visible;
total = !total; total = !total;
bound = max 0 (!total - !visible); bound = max 0. (!total -. !visible);
}) })
|> Ui.mouse_area (scroll_handler state) |> Ui.mouse_area (scroll_handler state)
|> Ui.keyboard_area (focus_handler state)) |> Ui.keyboard_area (focus_handler state))
let scroll_area ?(offset = (0, 0)) t = let scroll_area ?(offset = (0., 0.)) t =
let offset = Lwd.var offset in let offset = Lwd.var offset in
let scroll d_x d_y = let scroll d_x d_y =
let s_x, s_y = Lwd.peek offset in let s_x, s_y = Lwd.peek offset in
let s_x = max 0 (s_x + d_x) in let s_x = max 0. (s_x +. d_x) in
let s_y = max 0 (s_y + d_y) in let s_y = max 0. (s_y +. d_y) in
Lwd.set offset (s_x, s_y); Lwd.set offset (s_x, s_y);
`Handled `Handled
in in
let focus_handler = function let focus_handler = function
| `Arrow `Left, [] -> scroll (-scroll_step) 0 | `Arrow `Left, [] -> scroll (-.scroll_step) 0.
| `Arrow `Right, [] -> scroll (+scroll_step) 0 | `Arrow `Right, [] -> scroll (+.scroll_step) 0.
| `Arrow `Up, [] -> scroll 0 (-scroll_step) | `Arrow `Up, [] -> scroll 0. (-.scroll_step)
| `Arrow `Down, [] -> scroll 0 (+scroll_step) | `Arrow `Down, [] -> scroll 0. (+.scroll_step)
| `Page `Up, [] -> scroll 0 (-scroll_step * 8) | `Page `Up, [] -> scroll 0. (-.scroll_step *. 8.)
| `Page `Down, [] -> scroll 0 (+scroll_step * 8) | `Page `Down, [] -> scroll 0. (+.scroll_step *. 8.)
| _ -> `Unhandled | _ -> `Unhandled
in in
let scroll_handler ~x:_ ~y:_ = function let scroll_handler ~x:_ ~y:_ = function
| `Scroll `Up -> scroll 0 (-scroll_step) | `Scroll `Up -> scroll 0. (-.scroll_step)
| `Scroll `Down -> scroll 0 (+scroll_step) | `Scroll `Down -> scroll 0. (+.scroll_step)
| _ -> `Unhandled | _ -> `Unhandled
in in
Lwd.map2 t (Lwd.get offset) ~f:(fun t (s_x, s_y) -> Lwd.map2 t (Lwd.get offset) ~f:(fun t (s_x, s_y) ->
t |> Ui.shift_area s_x s_y t |> Ui.shift_area s_x s_y
|> Ui.mouse_area scroll_handler |> Ui.mouse_area scroll_handler
|> keyboard_area focus_handler) |> Ui.keyboard_area focus_handler)
let main_menu_item wm text f = let main_menu_item wm text f =
let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in
@ -2355,19 +2393,19 @@ module Nottui_widgets = struct
Ui.mouse_area on_click text Ui.mouse_area on_click text
type pane_state = type pane_state =
| Split of { pos : int; max : int } | Split of { pos : float; max : float }
| Re_split of { pos : int; max : int; at : int } | Re_split of { pos : float; max : float; at : float }
let h_pane left right = let h_pane left right =
let state_var = Lwd.var (Split { pos = 5; max = 10 }) in let state_var = Lwd.var (Split { pos = 5.; max = 10. }) in
let render state (l, r) = let render state (l, r) =
let (Split { pos; max } | Re_split { pos; max; _ }) = state in let (Split { pos; max } | Re_split { pos; max; _ }) = state in
let l = Ui.resize ~w:0 ~h:0 ~sh:1 ~sw:pos l in let l = Ui.resize ~w:0. ~h:0. ~sh:1. ~sw:pos l in
let r = Ui.resize ~w:0 ~h:0 ~sh:1 ~sw:(max - pos) r in let r = Ui.resize ~w:0. ~h:0. ~sh:1. ~sw:(max -. pos) r in
let splitter = let splitter =
Ui.resize Ui.resize
~bg:Notty.A.(bg lightyellow) ~bg:A.(bg Color.lightyellow)
~w:1 ~h:0 ~sw:0 ~sh:1 Ui.empty ~w:1. ~h:0. ~sw:0. ~sh:1. Ui.empty
in in
let splitter = let splitter =
Ui.mouse_area Ui.mouse_area
@ -2388,14 +2426,14 @@ module Nottui_widgets = struct
splitter splitter
in in
let ui = Ui.join_x l (Ui.join_x splitter r) in let ui = Ui.join_x l (Ui.join_x splitter r) in
let ui = Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 ui in let ui = Ui.resize ~w:100. ~h:100. ~sw:10. ~sh:10. ui in
let ui = let ui =
match state with match state with
| Split _ -> ui | Split _ -> ui
| Re_split { at; _ } -> | Re_split { at; _ } ->
Ui.transient_sensor Ui.transient_sensor
(fun ~x ~y:_ ~w ~h:_ () -> (fun ~x ~y:_ ~w ~h:_ () ->
Lwd.set state_var (Split { pos = at - x; max = w })) Lwd.set state_var (Split { pos = at -. x; max = w }))
ui ui
in in
ui ui
@ -2403,15 +2441,15 @@ module Nottui_widgets = struct
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair left right) Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair left right)
let v_pane top bot = let v_pane top bot =
let state_var = Lwd.var (Split { pos = 5; max = 10 }) in let state_var = Lwd.var (Split { pos = 5.; max = 10. }) in
let render state (top, bot) = let render state (top, bot) =
let (Split { pos; max } | Re_split { pos; max; _ }) = state in let (Split { pos; max } | Re_split { pos; max; _ }) = state in
let top = Ui.resize ~w:0 ~h:0 ~sw:1 ~sh:pos top in let top = Ui.resize ~w:0. ~h:0. ~sw:1. ~sh:pos top in
let bot = Ui.resize ~w:0 ~h:0 ~sw:1 ~sh:(max - pos) bot in let bot = Ui.resize ~w:0. ~h:0. ~sw:1. ~sh:(max -. pos) bot in
let splitter = let splitter =
Ui.resize Ui.resize
~bg:Notty.A.(bg lightyellow) ~bg:A.(bg Color.lightyellow)
~w:0 ~h:1 ~sw:1 ~sh:0 Ui.empty ~w:0. ~h:1. ~sw:1. ~sh:0. Ui.empty
in in
let splitter = let splitter =
Ui.mouse_area Ui.mouse_area
@ -2432,20 +2470,19 @@ module Nottui_widgets = struct
splitter splitter
in in
let ui = Ui.join_y top (Ui.join_y splitter bot) in let ui = Ui.join_y top (Ui.join_y splitter bot) in
let ui = Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 ui in let ui = Ui.resize ~w:10. ~h:10. ~sw:1. ~sh:1. ui in
let ui = let ui =
match state with match state with
| Split _ -> ui | Split _ -> ui
| Re_split { at; _ } -> | Re_split { at; _ } ->
Ui.transient_sensor Ui.transient_sensor
(fun ~x:_ ~y ~w:_ ~h () -> (fun ~x:_ ~y ~w:_ ~h () ->
Lwd.set state_var (Split { pos = at - y; max = h })) Lwd.set state_var (Split { pos = at -. y; max = h }))
ui ui
in in
ui ui
in in
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot) Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot)
*)
let sub' str p l = let sub' str p l =
if p = 0 && l = String.length str then str else String.sub str p l if p = 0 && l = String.length str then str else String.sub str p l
@ -2465,7 +2502,7 @@ module Nottui_widgets = struct
@ @
if pos < String.length text then if pos < String.length text then
[ [
I.string ~attr:A.(bg Color.lightred) (sub' text pos 1); I.string ~attr:attr_cursor (sub' text pos 1);
I.string ~attr (sub' text (pos + 1) (len - 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.(bg Color.lightred) " " ]
@ -2542,7 +2579,8 @@ module Nottui_widgets = struct
Lwd.map2 state node ~f:(fun state content -> Lwd.map2 state node ~f:(fun state content ->
Ui.mouse_area (mouse_grab state) content *) Ui.mouse_area (mouse_grab state) content *)
(* open Lwd.Infix
(** Tab view, where exactly one element of [l] is shown at a time. *) (** 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 let tabs (tabs : (string * (unit -> Ui.t Lwd.t)) list) : Ui.t Lwd.t
= =
@ -2556,7 +2594,7 @@ module Nottui_widgets = struct
tabs tabs
|> List.mapi (fun i (s, _) -> |> List.mapi (fun i (s, _) ->
let attr = let attr =
if i = idx_sel then A.(st underline) else A.empty if i = idx_sel then A.(bg Color.blue) else A.empty
in in
let tab_annot = printf ~attr "[%s]" s in let tab_annot = printf ~attr "[%s]" s in
Ui.mouse_area Ui.mouse_area
@ -2570,6 +2608,7 @@ module Nottui_widgets = struct
in in
f () >|= Ui.join_y tab_bar f () >|= Ui.join_y tab_bar
(*
(** Horizontal/vertical box. We fill lines until there is no room, (** Horizontal/vertical box. We fill lines until there is no room,
and then go to the next ligne. All widgets in a line are considered to and then go to the next ligne. All widgets in a line are considered to
have the same height. have the same height.
@ -2643,7 +2682,7 @@ module Nottui_widgets = struct
if too_big then if too_big then
Ui.join_y summary (Ui.join_x (string " ") fold) Ui.join_y summary (Ui.join_x (string " ") fold)
else Ui.join_x summary fold) else Ui.join_x summary fold)
*)
let hbox l = Lwd_utils.pack Ui.pack_x l let hbox l = Lwd_utils.pack Ui.pack_x l
let vbox l = Lwd_utils.pack Ui.pack_y l let vbox l = Lwd_utils.pack Ui.pack_y l
let zbox l = Lwd_utils.pack Ui.pack_z l let zbox l = Lwd_utils.pack Ui.pack_z l
@ -2680,7 +2719,7 @@ module Nottui_widgets = struct
in in
l_filter >>= Lwd_utils.pack Ui.pack_y l_filter >>= Lwd_utils.pack Ui.pack_y
let rec iterate n f x = if n = 0 then x else iterate (n - 1) f (f x) (* let rec iterate n f x = if n = 0 then x else iterate (n - 1) f (f x)
(** A grid layout, with alignment in all rows/columns. (** A grid layout, with alignment in all rows/columns.
@param max_h maximum height of a cell @param max_h maximum height of a cell
@ -2841,49 +2880,56 @@ module Nottui_widgets = struct
toggle_ st lbl f toggle_ st lbl f
in in
(toggle, toggle') (toggle, toggle')
*)
type scrollbox_state = { w : int; h : int; x : int; y : int } type scrollbox_state = {
w : float;
h : float;
x : float;
y : float;
}
let adjust_offset visible total off = let adjust_offset visible total off =
let off = let off =
if off + visible > total then total - visible else off if off +. visible > total then total -. visible else off
in in
let off = if off < 0 then 0 else off in let off = if off < 0. then 0. else off in
off off
let decr_if x cond = if cond then x - 1 else x let decr_if x cond = if cond then x -. 1. else x
let scrollbar_bg = Notty.A.gray 4 let scrollbar_bg = Color.gray 0.4
let scrollbar_fg = Notty.A.gray 7 let scrollbar_fg = Color.gray 0.7
let scrollbar_click_step = let scrollbar_click_step =
3 (* Clicking scrolls one third of the screen *) 3. (* Clicking scrolls one third of the screen *)
let scrollbar_wheel_step = let scrollbar_wheel_step =
8 (* Wheel event scrolls 1/8th of the screen *) 8. (* Wheel event scrolls 1/8th of the screen *)
let hscrollbar visible total offset ~set = let hscrollbar visible total offset ~set =
let prefix = offset * visible / total in let prefix = offset *. visible /. total in
let suffix = (total - offset - visible) * visible / total in let suffix = (total -. offset -. visible) *. visible /. total in
let handle = visible - prefix - suffix in let handle = visible -. prefix -. suffix in
let render size color = let render size color =
Ui.atom Notty.(I.char (A.bg color) ' ' size 1) Ui.atom (I.char ~attr:(A.bg color) ' ' size 1.)
in in
let mouse_handler ~x ~y:_ = function let mouse_handler ~x ~y:_ = function
| `Left -> | `Left ->
if x < prefix then ( if x < prefix then (
set (offset - max 1 (visible / scrollbar_click_step)); set (offset -. max 1. (visible /. scrollbar_click_step));
`Handled) `Handled)
else if x > prefix + handle then ( else if x > prefix +. handle then (
set (offset + max 1 (visible / scrollbar_click_step)); set (offset +. max 1. (visible /. scrollbar_click_step));
`Handled) `Handled)
else else
`Grab `Grab
( (fun ~x:x' ~y:_ -> ( (fun ~x:x' ~y:_ ->
set (offset + ((x' - x) * total / visible))), set (offset +. ((x' -. x) *. total /. visible))),
fun ~x:_ ~y:_ -> () ) fun ~x:_ ~y:_ -> () )
| `Scroll dir -> | `Scroll dir ->
let dir = match dir with `Down -> 1 | `Up -> -1 in let dir = match dir with `Down -> 1. | `Up -> -1. in
set (offset + (dir * max 1 (visible / scrollbar_wheel_step))); set
(offset
+. (dir *. max 1. (visible /. scrollbar_wheel_step)));
`Handled `Handled
| _ -> `Unhandled | _ -> `Unhandled
in in
@ -2894,28 +2940,30 @@ module Nottui_widgets = struct
++ render suffix scrollbar_bg) ++ render suffix scrollbar_bg)
let vscrollbar visible total offset ~set = let vscrollbar visible total offset ~set =
let prefix = offset * visible / total in let prefix = offset *. visible /. total in
let suffix = (total - offset - visible) * visible / total in let suffix = (total -. offset -. visible) *. visible /. total in
let handle = visible - prefix - suffix in let handle = visible -. prefix -. suffix in
let render size color = let render size color =
Ui.atom Notty.(I.char (A.bg color) ' ' 1 size) Ui.atom (I.char ~attr:(A.bg color) ' ' 1. size)
in in
let mouse_handler ~x:_ ~y = function let mouse_handler ~x:_ ~y = function
| `Left -> | `Left ->
if y < prefix then ( if y < prefix then (
set (offset - max 1 (visible / scrollbar_click_step)); set (offset -. max 1. (visible /. scrollbar_click_step));
`Handled) `Handled)
else if y > prefix + handle then ( else if y > prefix +. handle then (
set (offset + max 1 (visible / scrollbar_click_step)); set (offset +. max 1. (visible /. scrollbar_click_step));
`Handled) `Handled)
else else
`Grab `Grab
( (fun ~x:_ ~y:y' -> ( (fun ~x:_ ~y:y' ->
set (offset + ((y' - y) * total / visible))), set (offset +. ((y' -. y) *. total /. visible))),
fun ~x:_ ~y:_ -> () ) fun ~x:_ ~y:_ -> () )
| `Scroll dir -> | `Scroll dir ->
let dir = match dir with `Down -> 1 | `Up -> -1 in let dir = match dir with `Down -> 1. | `Up -> -1. in
set (offset + (dir * max 1 (visible / scrollbar_wheel_step))); set
(offset
+. (dir *. max 1. (visible /. scrollbar_wheel_step)));
`Handled `Handled
| _ -> `Unhandled | _ -> `Unhandled
in in
@ -2927,7 +2975,7 @@ module Nottui_widgets = struct
let scrollbox t = let scrollbox t =
(* Keep track of scroll state *) (* Keep track of scroll state *)
let state_var = Lwd.var { w = 0; h = 0; x = 0; y = 0 } in let state_var = Lwd.var { w = 0.; h = 0.; x = 0.; y = 0. } in
(* Keep track of size available for display *) (* Keep track of size available for display *)
let update_size ~w ~h = let update_size ~w ~h =
let state = Lwd.peek state_var in let state = Lwd.peek state_var in
@ -2936,7 +2984,7 @@ module Nottui_widgets = struct
in in
let measure_size body = let measure_size body =
Ui.size_sensor update_size Ui.size_sensor update_size
(Ui.resize ~w:0 ~h:0 ~sw:1 ~sh:1 body) (Ui.resize ~w:0. ~h:0. ~sw:1. ~sh:1. body)
in in
(* Given body and state, composite scroll bars *) (* Given body and state, composite scroll bars *)
let compose_bars body state = let compose_bars body state =
@ -2952,7 +3000,7 @@ module Nottui_widgets = struct
let state_y = adjust_offset state_h bh state.y in let state_y = adjust_offset state_h bh state.y in
(* Composite visible scroll bars *) (* Composite visible scroll bars *)
let crop b = let crop b =
Ui.resize ~sw:1 ~sh:1 ~w:0 ~h:0 Ui.resize ~sw:1. ~sh:1. ~w:0. ~h:0.
(Ui.shift_area state_x state_y b) (Ui.shift_area state_x state_y b)
in in
let set_vscroll y = let set_vscroll y =
@ -2974,9 +3022,9 @@ module Nottui_widgets = struct
crop body crop body
<|> vscrollbar state_h bh state_y ~set:set_vscroll <|> vscrollbar state_h bh state_y ~set:set_vscroll
<-> (hscrollbar state_w bw state_x ~set:set_hscroll <-> (hscrollbar state_w bw state_x ~set:set_hscroll
<|> Ui.space 1 1) <|> Ui.space 1. 1.)
in in
(* Render final box *) (* Render final box *)
Lwd.map2 t (Lwd.get state_var) ~f:(fun ui size -> Lwd.map2 t (Lwd.get state_var) ~f:(fun ui size ->
measure_size (compose_bars ui size)) *) measure_size (compose_bars ui size))
end end