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 edit_me = Lwd.var ("edit me?", 0) in
let root =
Lwd_utils.pack Nottui.Ui.pack_y
[
(* 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)
let open Nottui_widgets in
edit_field (Lwd.get edit_me)
~on_change:(fun ((text, pos) as state) ->
Log.debug (fun m -> m "--- on_change (%s,%d)" text pos);
Lwd.set edit_me state)
~on_submit:ignore;
]
~on_submit:ignore
in
let events, push_event = Lwt_stream.create () in
@ -140,7 +106,9 @@ let _ =
render_stream canvas webgl_ctx vg
(fun vg ?(time = 0.) p i ->
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
Logs.debug (fun m ->
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 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 =
F.(
fmt "%a" ppf
(record
[
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)
(list ~sep:(any "|") float)
[ t.r; t.g; t.b; t.a ])
end
end
@ -607,12 +609,15 @@ let str_of_box b =
let fill_box vg color b =
let module Path = NVG.Path in
let open NVG in
NVG.save vg;
Path.begin_ vg;
Path.rect vg ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b)
~h:(Box2.h b);
set_fill_color vg ~color;
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 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;
NVG.set_stroke_color vg ~color;
NVG.stroke vg;
Box2.max b
Box2.size b
module Style = struct
module Font = struct
@ -634,6 +639,11 @@ module Style = struct
underline : [ `Underline | `None ];
}
let pp ppf =
F.(
fmt "%a" ppf
(record [ field "size" (fun a -> a.size) (option float) ]))
let empty =
{
size = None;
@ -691,6 +701,16 @@ module Style = struct
type t = { fg : Color.t; bg : Color.t; font : Font.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 empty =
@ -703,13 +723,10 @@ module Style = struct
let dark = { empty with fg = Color.light; bg = Color.dark }
let ( ++ ) a1 a2 =
if a1 == empty then a2
else if a2 == empty then a1
else
{
a1 with
fg = Color.lerp a1.fg a2.fg ~a:0.5;
bg = Color.lerp a1.bg a2.bg ~a:0.5;
fg = Color.(a1.fg ++ a2.fg);
bg = Color.(a1.bg ++ a2.bg);
font = Font.merge a1.font a2.font;
}
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 pp ppf : t -> unit = function
| String s -> F.(fmt "String %s" ppf s)
| String s -> F.(fmt "String \"%s\"" ppf s)
end
module A = Style
@ -1041,20 +1058,22 @@ module I = struct
(Float.max_num (V2.x a) (V2.x 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)
| Segment v -> F.(fmt "Segment %a" ppf (parens Text.pp) v)
| Attr v ->
F.(fmt "Attr %a" ppf (pair (parens pp) (any "...")) v)
| Hcompose a ->
F.(fmt "Hcompose %a" ppf (pair (parens pp) (parens pp)) a)
| Vcompose a ->
F.(fmt "Vcompose %a" ppf (pair (parens pp) (parens pp)) a)
| Zcompose a ->
F.(fmt "Zcompose %a" ppf (pair (parens pp) (parens pp)) a)
| Hcrop (t, h, w) -> F.(fmt "Hcrop (%a,%f,%f)" ppf pp t h w)
| Vcrop (t, h, w) -> F.(fmt "Vcrop (%a,%f,%f)" ppf pp t h w)
| Void dim -> F.(fmt "Void %a" ppf (parens V2.pp) dim)
| Attr (t, a) ->
fmt "attr %a" ppf
(pair A.pp (parens (pp ~attr:A.(attr ++ a))))
(A.(attr ++ 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
| Hcrop (t, h, w) -> fmt "Hcrop (%a,%f,%f)" ppf (pp ~attr) t h w
| Vcrop (t, h, w) -> fmt "Vcrop (%a,%f,%f)" ppf (pp ~attr) t h w
| Void dim -> fmt "Void %a" ppf (parens V2.pp) dim
let rec segment vg p : Text.t -> P2.t = function
| String s ->
@ -1062,6 +1081,7 @@ module I = struct
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
@ -1069,14 +1089,21 @@ module I = struct
V2.v (xmax -. xmin) (ymax -. ymin)
and node vg attr p n : p2 =
(* returns the *size* of the drawn area not the max coordinates anymore *)
let b' =
match n with
| Empty | Void _ -> p
| Segment text -> segment vg p text
| Attr (i, a0) ->
if Style.(attr.fg) != a0.fg then
NVG.set_fill_color vg ~color:Style.(attr.fg);
node vg A.(attr ++ a0) p i
| Attr (i, a) ->
let a0 = A.(attr ++ a) in
if
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) ->
let p1 = node vg attr p i1 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 fst : t -> float
val snd : t -> float
(*val size : t -> int*)
val size : t -> float
val zero : t
end = struct
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_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 = {
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_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 row = Lwd_table.append (window_manager_overlays wm) in
let h_pad =
match Gravity.h g with
| `Negative -> Ui.space (x + dx) 0
| `Neutral -> Ui.space (x + dx + (w / 2)) 0
| `Positive -> Ui.space (x + dx + w) 0
| `Negative -> Ui.space (x +. dx) 0.
| `Neutral -> Ui.space (x +. dx +. (w /. 2.)) 0.
| `Positive -> Ui.space (x +. dx +. w) 0.
in
let v_pad =
match Gravity.v g with
| `Negative -> Ui.space 0 (y + dy)
| `Neutral -> Ui.space 0 (y + dy + (h / 2))
| `Positive -> Ui.space 0 (y + dy + h)
| `Negative -> Ui.space 0. (y +. dy)
| `Neutral -> Ui.space 0. (y +. dy +. (h /. 2.))
| `Positive -> Ui.space 0. (y +. dy +. h)
in
let view =
Lwd.map body ~f:(fun 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)
in
let bg =
Ui.resize_to (Ui.layout_spec body)
~bg:A.(bg lightgreen)
~bg:A.(bg Color.lightgreen)
Ui.empty
in
let catchall =
@ -2169,7 +2196,7 @@ module Nottui_widgets = struct
Lwd_table.remove row;
`Handled
| _ -> `Handled)
(Ui.resize ~sw:1 ~sh:1 Ui.empty)
(Ui.resize ~sw:1. ~sh:1. Ui.empty)
in
Ui.join_z catchall @@ Ui.join_y v_pad @@ Ui.join_x h_pad
@@ Ui.join_z bg body)
@ -2178,16 +2205,24 @@ module Nottui_widgets = struct
in
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 clicked = ref false in
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 =
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
let click_handler ~x:_ ~y:_ = function
| `Left -> clicked := true; Lwd.set refresh (); `Handled
| `Left ->
clicked := true;
Lwd.set refresh ();
`Handled
| _ -> `Unhandled
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 h_pad = Ui.space (x + dx) 0 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 =
Ui.mouse_area
(fun ~x:_ ~y:_ -> function
| `Left -> Lwd_table.remove row; `Handled
| `Left ->
Lwd_table.remove row;
`Handled
| _ -> `Handled)
(Ui.resize ~sw:1 ~sh:1 Ui.empty)
in
@ -2209,27 +2247,27 @@ module Nottui_widgets = struct
in
Lwd_table.set row view
in
Ui.transient_sensor sensor ui
) else ui*)
Ui.transient_sensor sensor ui)
else ui *)
let scroll_step = 1
let scroll_step = 4.
type scroll_state = {
position : int;
bound : int;
visible : int;
total : int;
position : float;
bound : float;
visible : float;
total : float;
}
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 visible = ref (-1) in
let total = ref (-1) in
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
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
@ -2237,25 +2275,25 @@ module Nottui_widgets = struct
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)
| `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)
| `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.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).Ui.h then (
total := (Ui.layout_spec t).Ui.h;
if !total <> Ui.(layout_spec t).h then (
total := Ui.(layout_spec t).h;
true)
else false
in
@ -2271,38 +2309,38 @@ module Nottui_widgets = struct
state with
visible = !visible;
total = !total;
bound = max 0 (!total - !visible);
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 scroll_area ?(offset = (0., 0.)) t =
let offset = Lwd.var offset in
let scroll d_x d_y =
let s_x, s_y = Lwd.peek offset in
let s_x = max 0 (s_x + d_x) in
let s_y = max 0 (s_y + d_y) in
let s_x = max 0. (s_x +. d_x) in
let s_y = max 0. (s_y +. d_y) in
Lwd.set offset (s_x, s_y);
`Handled
in
let focus_handler = function
| `Arrow `Left, [] -> scroll (-scroll_step) 0
| `Arrow `Right, [] -> scroll (+scroll_step) 0
| `Arrow `Up, [] -> scroll 0 (-scroll_step)
| `Arrow `Down, [] -> scroll 0 (+scroll_step)
| `Page `Up, [] -> scroll 0 (-scroll_step * 8)
| `Page `Down, [] -> scroll 0 (+scroll_step * 8)
| `Arrow `Left, [] -> scroll (-.scroll_step) 0.
| `Arrow `Right, [] -> scroll (+.scroll_step) 0.
| `Arrow `Up, [] -> scroll 0. (-.scroll_step)
| `Arrow `Down, [] -> scroll 0. (+.scroll_step)
| `Page `Up, [] -> scroll 0. (-.scroll_step *. 8.)
| `Page `Down, [] -> scroll 0. (+.scroll_step *. 8.)
| _ -> `Unhandled
in
let scroll_handler ~x:_ ~y:_ = function
| `Scroll `Up -> scroll 0 (-scroll_step)
| `Scroll `Down -> scroll 0 (+scroll_step)
| `Scroll `Up -> scroll 0. (-.scroll_step)
| `Scroll `Down -> scroll 0. (+.scroll_step)
| _ -> `Unhandled
in
Lwd.map2 t (Lwd.get offset) ~f:(fun t (s_x, s_y) ->
t |> Ui.shift_area s_x s_y
|> Ui.mouse_area scroll_handler
|> keyboard_area focus_handler)
|> Ui.keyboard_area focus_handler)
let main_menu_item wm text f =
let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in
@ -2355,19 +2393,19 @@ module Nottui_widgets = struct
Ui.mouse_area on_click text
type pane_state =
| Split of { pos : int; max : int }
| Re_split of { pos : int; max : int; at : int }
| Split of { pos : float; max : float }
| Re_split of { pos : float; max : float; at : float }
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 (Split { pos; max } | Re_split { pos; max; _ }) = state 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 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 splitter =
Ui.resize
~bg:Notty.A.(bg lightyellow)
~w:1 ~h:0 ~sw:0 ~sh:1 Ui.empty
~bg:A.(bg Color.lightyellow)
~w:1. ~h:0. ~sw:0. ~sh:1. Ui.empty
in
let splitter =
Ui.mouse_area
@ -2388,14 +2426,14 @@ module Nottui_widgets = struct
splitter
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 =
match state with
| Split _ -> ui
| Re_split { at; _ } ->
Ui.transient_sensor
(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
in
ui
@ -2403,15 +2441,15 @@ module Nottui_widgets = struct
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair left right)
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 (Split { pos; max } | Re_split { pos; max; _ }) = state 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 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 splitter =
Ui.resize
~bg:Notty.A.(bg lightyellow)
~w:0 ~h:1 ~sw:1 ~sh:0 Ui.empty
~bg:A.(bg Color.lightyellow)
~w:0. ~h:1. ~sw:1. ~sh:0. Ui.empty
in
let splitter =
Ui.mouse_area
@ -2432,20 +2470,19 @@ module Nottui_widgets = struct
splitter
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 =
match state with
| Split _ -> ui
| Re_split { at; _ } ->
Ui.transient_sensor
(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
in
ui
in
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot)
*)
let 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
[
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));
]
else [ I.string ~attr:A.(bg Color.lightred) " " ]
@ -2542,7 +2579,8 @@ module Nottui_widgets = struct
Lwd.map2 state node ~f:(fun 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. *)
let tabs (tabs : (string * (unit -> Ui.t Lwd.t)) list) : Ui.t Lwd.t
=
@ -2556,7 +2594,7 @@ module Nottui_widgets = struct
tabs
|> List.mapi (fun i (s, _) ->
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
let tab_annot = printf ~attr "[%s]" s in
Ui.mouse_area
@ -2570,6 +2608,7 @@ module Nottui_widgets = struct
in
f () >|= Ui.join_y tab_bar
(*
(** 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
have the same height.
@ -2643,7 +2682,7 @@ module Nottui_widgets = struct
if too_big then
Ui.join_y summary (Ui.join_x (string " ") fold)
else Ui.join_x summary fold)
*)
let hbox l = Lwd_utils.pack Ui.pack_x l
let vbox l = Lwd_utils.pack Ui.pack_y l
let zbox l = Lwd_utils.pack Ui.pack_z l
@ -2680,7 +2719,7 @@ module Nottui_widgets = struct
in
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.
@param max_h maximum height of a cell
@ -2841,49 +2880,56 @@ module Nottui_widgets = struct
toggle_ st lbl f
in
(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 off =
if off + visible > total then total - visible else off
if off +. visible > total then total -. visible else off
in
let off = if off < 0 then 0 else off in
let off = if off < 0. then 0. else off in
off
let decr_if x cond = if cond then x - 1 else x
let scrollbar_bg = Notty.A.gray 4
let scrollbar_fg = Notty.A.gray 7
let decr_if x cond = if cond then x -. 1. else x
let scrollbar_bg = Color.gray 0.4
let scrollbar_fg = Color.gray 0.7
let scrollbar_click_step =
3 (* Clicking scrolls one third of the screen *)
3. (* Clicking scrolls one third of the screen *)
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 prefix = offset * visible / total in
let suffix = (total - offset - visible) * visible / total in
let handle = visible - prefix - suffix in
let prefix = offset *. visible /. total in
let suffix = (total -. offset -. visible) *. visible /. total in
let handle = visible -. prefix -. suffix in
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
let mouse_handler ~x ~y:_ = function
| `Left ->
if x < prefix then (
set (offset - max 1 (visible / scrollbar_click_step));
set (offset -. max 1. (visible /. scrollbar_click_step));
`Handled)
else if x > prefix + handle then (
set (offset + max 1 (visible / scrollbar_click_step));
else if x > prefix +. handle then (
set (offset +. max 1. (visible /. scrollbar_click_step));
`Handled)
else
`Grab
( (fun ~x:x' ~y:_ ->
set (offset + ((x' - x) * total / visible))),
set (offset +. ((x' -. x) *. total /. visible))),
fun ~x:_ ~y:_ -> () )
| `Scroll dir ->
let dir = match dir with `Down -> 1 | `Up -> -1 in
set (offset + (dir * max 1 (visible / scrollbar_wheel_step)));
let dir = match dir with `Down -> 1. | `Up -> -1. in
set
(offset
+. (dir *. max 1. (visible /. scrollbar_wheel_step)));
`Handled
| _ -> `Unhandled
in
@ -2894,28 +2940,30 @@ module Nottui_widgets = struct
++ render suffix scrollbar_bg)
let vscrollbar visible total offset ~set =
let prefix = offset * visible / total in
let suffix = (total - offset - visible) * visible / total in
let handle = visible - prefix - suffix in
let prefix = offset *. visible /. total in
let suffix = (total -. offset -. visible) *. visible /. total in
let handle = visible -. prefix -. suffix in
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
let mouse_handler ~x:_ ~y = function
| `Left ->
if y < prefix then (
set (offset - max 1 (visible / scrollbar_click_step));
set (offset -. max 1. (visible /. scrollbar_click_step));
`Handled)
else if y > prefix + handle then (
set (offset + max 1 (visible / scrollbar_click_step));
else if y > prefix +. handle then (
set (offset +. max 1. (visible /. scrollbar_click_step));
`Handled)
else
`Grab
( (fun ~x:_ ~y:y' ->
set (offset + ((y' - y) * total / visible))),
set (offset +. ((y' -. y) *. total /. visible))),
fun ~x:_ ~y:_ -> () )
| `Scroll dir ->
let dir = match dir with `Down -> 1 | `Up -> -1 in
set (offset + (dir * max 1 (visible / scrollbar_wheel_step)));
let dir = match dir with `Down -> 1. | `Up -> -1. in
set
(offset
+. (dir *. max 1. (visible /. scrollbar_wheel_step)));
`Handled
| _ -> `Unhandled
in
@ -2927,7 +2975,7 @@ module Nottui_widgets = struct
let scrollbox t =
(* 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 *)
let update_size ~w ~h =
let state = Lwd.peek state_var in
@ -2936,7 +2984,7 @@ module Nottui_widgets = struct
in
let measure_size body =
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
(* Given body and state, composite scroll bars *)
let compose_bars body state =
@ -2952,7 +3000,7 @@ module Nottui_widgets = struct
let state_y = adjust_offset state_h bh state.y in
(* Composite visible scroll bars *)
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)
in
let set_vscroll y =
@ -2974,9 +3022,9 @@ module Nottui_widgets = struct
crop body
<|> vscrollbar state_h bh state_y ~set:set_vscroll
<-> (hscrollbar state_w bw state_x ~set:set_hscroll
<|> Ui.space 1 1)
<|> Ui.space 1. 1.)
in
(* Render final box *)
Lwd.map2 t (Lwd.get state_var) ~f:(fun ui size ->
measure_size (compose_bars ui size)) *)
measure_size (compose_bars ui size))
end