Files
oplevel/ogui.ml
2024-04-20 13:58:47 -05:00

1182 lines
32 KiB
OCaml

module Gv = Graphv_gles2_native
module F = Fmt
type stroke = { width : float; color : Gv.Color.t }
let stroke_none = { width = 0.; color = Gv.Color.transparent }
module Margin = struct
open Gg
type t = {
left : size1;
right : size1;
top : size1;
bottom : size1;
}
let symmetric h w = { left = w; right = w; top = h; bottom = h }
let sum t : size2 = Size2.v (t.left +. t.right) (t.top +. t.bottom)
let inner t b : box2 =
Box2.v
(V2.v (Box2.minx b +. t.left) (Box2.miny b +. t.top))
(V2.v (Box2.maxx b -. t.right) (Box2.maxy b -. t.bottom))
end
type margin = Margin.t
module Sense = struct
type t = {
click : bool;
drag : bool;
focusable : bool;
edit : bool;
}
let click =
{ click = true; drag = false; focusable = true; edit = false }
let hover =
{ click = false; drag = false; focusable = true; edit = false }
end
module EventFilter = struct
type t = {
tab : bool;
horizontal_arrrows : bool;
vertical_arrows : bool;
escape : bool;
}
let default =
{
tab = false;
horizontal_arrrows = false;
vertical_arrows = false;
escape = false;
}
end
type id = int
type event_filter = EventFilter.t
module Context = struct
type t = { derp : bool }
end
module Response = struct
type t = {
ctx : Context.t;
(* layer_id : LayerId.t; *)
id : id;
rect : Gg.box2;
interact_rect : Gg.box2;
sense : Sense.t;
enabled : bool;
contains_pointer : bool;
hovered : bool;
highlighted : bool;
clicked : bool;
fake_primary_click : bool;
long_touched : bool;
drag_started : bool;
dragged : bool;
drag_stopped : bool;
is_pointer_button_down_on : bool;
interact_pointer_pos : Gg.p2 option;
changed : bool;
}
end
module Align = struct
open Gg
type range = size1 * size1
type t =
| Min (* Left or top. *)
| Center (* Horizontal or vertical center *)
| Max (* Right or bottom *)
let pp_t ppf =
F.(
function
| Min -> pf ppf "Min"
| Center -> pf ppf "Center"
| Max -> pf ppf "Max")
let size_within_rect (size : size2) (frame : box2) : box2 =
let size_within_range (size : size1) (range : range) : range =
let min, max = range in
if max -. min == Float.infinity && size == Float.infinity then
range
else range
in
let x_range =
size_within_range (P2.x size) (Box2.minx frame, Box2.maxx frame)
in
let y_range =
size_within_range (P2.y size) (Box2.miny frame, Box2.maxy frame)
in
Box2.v
(P2.v (fst x_range) (fst y_range))
(P2.v (snd x_range) (snd y_range))
end
type align = Align.t
module Fonts = struct
open Gg
let pixels_per_point = ref 1.0
type t = { gv : Gv.Text.font; pixels_per_point : size1 }
let find_font gv name : t option =
Option.fold
~some:(fun gv ->
Some { gv; pixels_per_point = !pixels_per_point })
~none:None
(Gv.Text.find_font gv ~name)
end
let pp_color : Gv.Color.t Fmt.t =
F.(
record
[
field "r" (fun (s : Gv.Color.t) -> s.r) float;
field "g" (fun (s : Gv.Color.t) -> s.g) float;
field "b" (fun (s : Gv.Color.t) -> s.b) float;
field "a" (fun (s : Gv.Color.t) -> s.a) float;
])
module TextLayout = struct
open Gg
type font_selection = Default | FontId of (string * float)
type text_format = {
font_id : font_selection;
extra_letter_spacing : float;
line_height : float option;
color : Gv.Color.t;
background : Gv.Color.t;
italics : bool;
underline : stroke;
strikethrough : stroke;
valign : align;
}
let pp_text_format : text_format F.t =
F.(
record
[
field "font_id" (fun _ -> "...") string;
field "extra_letter_spacing"
(fun s -> s.extra_letter_spacing)
float;
field "line_height" (fun s -> s.line_height) (option float);
field "color" (fun s -> s.color) pp_color;
field "background" (fun s -> s.background) pp_color;
])
let text_format_default =
{
font_id = FontId ("mono", 18.0);
extra_letter_spacing = 0.0;
line_height = Some 19.;
color = Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9;
background = Gv.Color.transparent;
italics = false;
underline = stroke_none;
strikethrough = stroke_none;
valign = Max;
}
let text_format_simple font_id color : text_format =
{ text_format_default with font_id; color }
type text_wrapping = {
max_width : float;
max_rows : int;
break_anywhere : bool;
overflow_character : string option;
}
let pp_text_wrapping =
F.(
record
[
field "max_width" (fun s -> s.max_width) float;
field "max_rows" (fun s -> s.max_rows) int;
field "break_anywhere" (fun s -> s.break_anywhere) bool;
field "overflow_character"
(fun s -> s.overflow_character)
(option string);
])
let default_text_wrapping () =
{
max_width = Float.infinity;
max_rows = 100;
(* TODO *)
break_anywhere = false;
overflow_character = Some "";
}
type layout_section = {
leading_space : float;
byte_range : int * int;
format : text_format;
}
let pp_layout_section : Format.formatter -> 'a -> unit =
F.(
record
[
field "leading_space" (fun s -> s.leading_space) float;
field "byte_range"
(fun s -> s.byte_range)
(pair ~sep:(any ",") int int);
field "format" (fun s -> s.format) pp_text_format;
])
let layout_section_default =
{
leading_space = 0.0;
byte_range = (0, 0);
format = text_format_default;
}
type layout_job = {
text : string;
sections : layout_section array;
wrap : text_wrapping;
first_row_min_height : float;
break_on_newline : bool;
halign : align;
justify : bool;
line_height : float option;
}
let pp_layout_job =
F.(
record
[
field "text" (fun s -> String.length s.text) int;
field "sections"
(fun s -> s.sections)
(array pp_layout_section);
field "wrap" (fun s -> s.wrap) pp_text_wrapping;
field "first_row_min_height"
(fun s -> s.first_row_min_height)
float;
field "break_on_newline" (fun s -> s.break_on_newline) bool;
field "halign" (fun s -> s.halign) Align.pp_t;
field "justify" (fun s -> s.justify) bool;
])
let default_layout_job () =
{
text = "";
sections = Array.make 0 layout_section_default;
wrap = default_text_wrapping ();
first_row_min_height = 0.0;
break_on_newline = true;
halign = Min;
justify = false;
line_height = Some 18.;
}
type uv_rect = {
offset : Gg.v2;
size : Gg.v2;
min : Gg.p2; (* Top left corner UV in texture *)
max : Gg.p2; (* Bottom right corner (exclusive) *)
}
type glyph = {
chr : string;
pos : Gg.p2;
ascent : float;
size : Gg.size2;
uv_rect : uv_rect;
section_index : int;
}
type row_visuals = {
(* mesh : mesh; *)
mesh_bounds : Gg.box2;
glyph_vertex_range : int * int;
}
let pp_row_visuals =
F.(
record
[
field "mesh_bounds"
(fun (s : row_visuals) -> s.mesh_bounds)
Gg.Box2.pp;
field "glyph_vertex_range"
(fun (s : row_visuals) -> s.glyph_vertex_range)
(pair ~sep:(any ",") int int);
])
let pp_text_row : Format.formatter -> Gv.Text.text_row -> unit =
F.(
record
[
field "start_index"
(fun (s : Gv.Text.text_row) -> s.start_index)
int;
field "end_index"
(fun (s : Gv.Text.text_row) -> s.end_index)
int;
field "width" (fun (s : Gv.Text.text_row) -> s.width) float;
field "minx" (fun (s : Gv.Text.text_row) -> s.minx) float;
field "maxx" (fun (s : Gv.Text.text_row) -> s.maxx) float;
])
type row = {
text_row : Gv.Text.text_row;
section_index_at_start : int;
glyphs : glyph list;
rect : Gg.box2;
visuals : row_visuals;
ends_with_newline : bool;
}
let pp_row : Format.formatter -> row -> unit =
F.(
record
[
field "text_row" (fun s -> s.text_row) pp_text_row;
field "section_index_at_start"
(fun (s : row) -> s.section_index_at_start)
int;
field "format" (fun (s : row) -> List.length s.glyphs) int;
field "rect" (fun (s : row) -> s.rect) Gg.Box2.pp;
field "visuals" (fun (s : row) -> s.visuals) pp_row_visuals;
field "ends_with_newline"
(fun (s : row) -> s.ends_with_newline)
bool;
])
let row_default () =
{
text_row =
{
start_index = 0;
end_index = 0;
width = 0.;
minx = 0.;
maxx = 0.;
next = 0;
};
section_index_at_start = 0;
glyphs = [];
rect = Box2.zero;
visuals =
{ mesh_bounds = Box2.zero; glyph_vertex_range = (0, 0) };
ends_with_newline = false;
}
type galley = {
job : layout_job;
rows : row array;
elided : bool;
rect : Gg.box2;
mesh_bounds : Gg.box2;
num_vertices : int;
num_indices : int;
pixels_per_point : float;
}
type rich_text = {
text : string;
size : float option;
extra_letter_spacing : float;
line_height : float option;
font : string option;
background_color : Gv.Color.t;
text_color : Gv.Color.t;
code : bool;
strong : bool;
weak : bool;
strikethrough : bool;
underline : bool;
italics : bool;
raised : bool;
}
let rich_text_default =
{
text = "";
size = None;
extra_letter_spacing = 0.0;
line_height = None;
font = None;
background_color = Gv.Color.transparent;
text_color = Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9;
code = false;
strong = false;
weak = false;
strikethrough = false;
underline = false;
italics = false;
raised = false;
}
type widget_text =
| RichText of rich_text
| LayoutJob of layout_job
| Galley of galley
type cursor = {
index : int;
row : int option;
prefer_next_row : bool;
}
let cursor_default =
{ index = 0; row = None; prefer_next_row = false }
type cursor_range = cursor * cursor
type cursor_state = cursor_range option
let cursor_index = ref 0
let cursor_range c = ((fst c).index, (snd c).index)
let new_cursor ?(loc = 0) () : cursor =
cursor_index := !cursor_index + 1;
{ index = loc; row = None; prefer_next_row = false }
let new_cursor_range (s, e) : cursor_range =
( { cursor_default with index = s },
{ cursor_default with index = e } )
let cursor_state_update ~(f : int -> int -> int * int)
(c : cursor_state) : cursor_state =
match c with
| Some (a, b) ->
let a', b' = f a.index b.index in
Some (new_cursor_range (max a' 0, max b' 0))
| None -> None
let layout_job text ?(format = text_format_default) wrap_width :
layout_job =
{
(default_layout_job ()) with
text;
sections =
Array.make 1
{
leading_space = 0.0;
byte_range = (0, String.length text);
format;
};
wrap =
{ (default_text_wrapping ()) with max_width = wrap_width };
break_on_newline = true;
}
let simple text (format : text_format) wrap_width : layout_job =
{
(default_layout_job ()) with
text;
sections =
Array.make 1
{
leading_space = 0.0;
byte_range = (0, String.length text);
format;
};
wrap =
{ (default_text_wrapping ()) with max_width = wrap_width };
break_on_newline = true;
}
let simple_singleline text (format : text_format) : layout_job =
{
(default_layout_job ()) with
text;
sections =
Array.make 1
{
leading_space = 0.0;
byte_range = (0, String.length text);
format;
};
wrap = default_text_wrapping ();
break_on_newline = true;
}
let cursor_color = ref (Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.)
let default_cursor_formatter (f : text_format) =
{ f with background = !cursor_color }
let with_cursor (cur : cursor_range)
?(cursor_format = default_cursor_formatter) layout_job :
layout_job =
let cs, ce = ((fst cur).index, (snd cur).index) in
{
layout_job with
sections =
Array.of_list
(* Lol maybe this is inefficient? (or maybe not) *)
(List.fold_left
(fun (l : layout_section list) sec ->
let s, e = sec.byte_range in
if e < cs || ce < s then l @ [ sec ]
else
l
@ (if s = cs then
[
{
sec with
byte_range = (s, if ce > e then e else ce);
format = cursor_format sec.format;
};
]
else if s < cs && cs <= e then
(* cursor start in section *)
[
{ sec with byte_range = (s, cs) };
{
sec with
byte_range = (cs, if ce > e then e else ce);
format = cursor_format sec.format;
};
]
else if cs < s && e < ce then
[
{ sec with format = cursor_format sec.format };
]
else [])
@
if ce > s && ce < e then
[ { sec with byte_range = (ce, e) } ]
else [])
[]
(Array.to_list layout_job.sections));
}
let layout (gv : Gv.t) (fonts : Fonts.t) (job : layout_job)
(pos : v2) : galley =
(* F.epr "TextLayout.layout@.";
F.epr "job.wrap.max_width=%f@." job.wrap.max_widtha;
F.epr "job.wrap.max_rows=%d@." job.wrap.max_rows; *)
if job.wrap.max_rows == 0 then
{
job;
rows = Array.make 1 (row_default ());
rect = Box2.move pos Box2.zero;
mesh_bounds = Box2.zero;
elided = true;
num_vertices = 0;
num_indices = 0;
pixels_per_point = fonts.pixels_per_point;
}
else
let metrics = Gv.Text.metrics gv in
let lines = Gv.Text.make_empty_rows job.wrap.max_rows in
let row_count =
Gv.Text.break_lines gv ~break_width:job.wrap.max_width
~max_rows:job.wrap.max_rows ~lines job.text
in
(* F.epr "row_count=%d@." row_count; *)
let height = ref (V2.y pos) in
let max_width = ref 0. in
let line_height =
Option.value ~default:metrics.line_height job.line_height
in
{
job;
rows =
Array.init row_count (fun n ->
let text_row = Array.get lines n in
height := !height +. line_height;
let rect =
Box2.v
(P2.v (V2.x pos) !height)
(P2.v
(text_row.width +. V2.x pos)
(!height +. line_height))
in
max_width := Float.max text_row.maxx !max_width;
{
text_row;
section_index_at_start = 0;
glyphs = [ (* TODO *) ];
rect;
visuals =
{
mesh_bounds = rect;
glyph_vertex_range =
(text_row.start_index, text_row.end_index);
};
ends_with_newline = false (* TODO *);
});
rect =
Box2.v Size2.zero
(P2.v job.wrap.max_width
(Float.of_int row_count *. line_height));
elided = row_count > job.wrap.max_rows (* TODO *);
mesh_bounds = Box2.v Size2.zero (P2.v !max_width !height);
num_indices = 0 (* TODO *);
num_vertices = 0 (* TODO *);
pixels_per_point = fonts.pixels_per_point;
}
end
let rec nth_tl n = function
| hd :: tl -> if n > 0 then nth_tl (n - 1) tl else hd :: tl
| [] -> []
let _ =
assert (List.equal Int.equal (nth_tl 2 [ 0; 1; 2; 3 ]) [ 2; 3 ]);
assert (List.equal Int.equal (nth_tl 3 [ 0; 1; 2 ]) []);
assert (List.equal Int.equal (nth_tl 0 [ 0; 1 ]) [ 0; 1 ])
module Painter = struct
type t = Gv.t
let galley (t : t) (g : TextLayout.galley) : unit =
(* F.epr
"Painter.galley (String.length g.job.text)=%d (Array.length \
g.rows)=%d @."
(String.length g.job.text)
(Array.length g.rows);
F.epr "g.rect=%a@." Gg.Box2.pp g.rect; *)
(* F.epr "g.rows=%a@." F.(braces (array TextLayout.pp_row)) g.rows;*)
Array.iter
Gv.(
fun (row : TextLayout.row) ->
let sections =
List.filter
(fun (r : TextLayout.layout_section) ->
fst r.byte_range <= row.text_row.end_index
&& snd r.byte_range > row.text_row.start_index)
(Array.to_list
@@ Array.sub g.job.sections row.section_index_at_start
(Array.length g.job.sections
- row.section_index_at_start))
in
assert (List.length sections > 0);
ignore
Gg.(
List.fold_left
(fun x (sec : TextLayout.layout_section) ->
let start, end_ =
( min
(String.length g.job.text - 1)
(max 0
(max (fst sec.byte_range)
row.text_row.start_index)),
min
(String.length g.job.text - 1)
(max 0
(min (snd sec.byte_range)
row.text_row.end_index)) )
in
let font_name, font_size =
match sec.format.font_id with
| Default -> ("mono", 18.)
| FontId (s, size) -> (s, size)
in
Text.set_font_face t ~name:font_name;
Text.set_size t ~size:font_size;
Text.set_align t ~align:Align.(left lor top);
let metrics = Gv.Text.metrics t in
let bounds =
Gv.Text.bounds t ~x ~y:0. ~start ~end_ g.job.text
in
Path.begin_ t;
Path.rect t ~x ~y:(Box2.miny row.rect)
~w:bounds.advance ~h:metrics.line_height;
set_fill_color t ~color:sec.format.background;
fill t;
set_fill_color t ~color:sec.format.color;
let w =
Text.text_w t ~x ~y:(Box2.miny row.rect) ~start
~end_ g.job.text
in
w)
(Box2.minx row.rect) sections))
g.rows
end
module Style = struct
open Gg
type text_style = unit
type spacing = {
item_spacing : Gg.size2;
window_margin : Margin.t;
indent : Gg.size1;
interact_size : Gg.size2;
slider_width : Gg.size1;
text_edit_width : Gg.size1;
icon_width : Gg.size1;
icon_width_inner : Gg.size1;
icon_spacing : Gg.size1;
}
type t = {
override_text_style : text_style option;
override_font : TextLayout.font_selection option;
wrap : bool option;
spacing : spacing;
(*interaction: Interaction.t; *)
animation_time : float;
}
let default =
{
override_text_style = None;
override_font = None;
wrap = None;
spacing =
{
item_spacing = Size2.v 10. 10.;
window_margin = Margin.symmetric 5. 5.;
indent = 5.;
slider_width = 5.;
text_edit_width = 500.;
icon_width = 40.;
icon_width_inner = 35.;
icon_spacing = 50.;
interact_size = P2.v 500. 500.;
};
animation_time = 0.1;
}
end
module Layout = struct
open Gg
type direction = LeftToRight | RightToLeft | TopDown | BottomUp
type t = {
main_dir : direction;
main_wrap : bool;
main_align : align;
main_justify : bool;
cross_align : align;
cross_justify : bool;
}
let horizontal =
{
main_dir = LeftToRight;
main_wrap = true;
main_align = Min;
main_justify = true;
cross_align = Min;
cross_justify = true;
}
let vertical =
{
main_dir = TopDown;
main_wrap = true;
main_align = Min;
main_justify = true;
cross_align = Min;
cross_justify = true;
}
type region = { min_rect : box2; max_rect : box2; cursor : box2 }
let rec is_horizontal = function
| `Direction d -> (
match d with
| LeftToRight | RightToLeft -> true
| TopDown | BottomUp -> false)
| `Layout t -> is_horizontal (`Direction t.main_dir)
let available_from_cursor_max_rect t cursor max_rect : box2 =
(* TODO assert !cursor.any_nan() *)
(* TODO assert !max_rect.any_nan() *)
(* TODO assert !max_rect.is_finite() *)
let avail =
match t.main_dir with
| LeftToRight ->
Box2.of_pts
(V2.v (Box2.minx cursor) (Box2.miny max_rect))
(V2.v
Float.(
max
(max (Box2.maxx max_rect) (Box2.minx cursor))
(Box2.minx max_rect))
Float.(max (Box2.maxy max_rect) (Box2.miny max_rect)))
| RightToLeft -> Box2.zero (* TODO *)
| TopDown | BottomUp -> Box2.zero
in
let avail = Box2.inter avail cursor in
(* todo make sure it isn't negative (won't because Gg.maxx is maxing )*)
avail
let available_size t r =
if t.main_wrap then
if is_horizontal (`Direction t.main_dir) then
V2.v (Box2.w r.max_rect) (Box2.h r.cursor)
else V2.v (Box2.w r.cursor) (Box2.h r.max_rect)
else
Box2.size (available_from_cursor_max_rect t r.cursor r.max_rect)
let horizontal_justify (l : t) =
if is_horizontal (`Layout l) then l.main_justify
else l.cross_justify
module Grid = struct
type state = {
col_widths : Gg.size1 list;
row_heights : Gg.size1 list;
}
type t = {
id : id;
is_first_frame : bool;
prev_state : state;
initial_available : Gg.size1 option;
spacing : Gg.v2;
min_cell_size : Gg.v2;
max_cell_size : Gg.v2;
col : int;
row : int;
}
let available_rect _t _r = Gg.Box2.zero (*TODO*)
end
end
module Placer = struct
type t = {
grid : Layout.Grid.t option;
layout : Layout.t;
region : Layout.region;
}
let available_size t =
match t.grid with
| Some grid ->
Gg.Box2.size (Layout.Grid.available_rect grid t.region)
| None -> Layout.available_size t.layout t.region
let create layout region = { grid = None; layout; region }
end
module Ui = struct
type key_callback =
t ->
GLFW.window ->
GLFW.key ->
int ->
GLFW.key_action ->
GLFW.key_mod list ->
unit
and t = {
id : id;
style : Style.t;
placer : Placer.t;
enabled : bool;
gv : Gv.t;
glfw_window : GLFW.window option;
mutable key : key_callback;
}
let id = ref 0
let spacing ui = ui.style.spacing
let available_size ui = Placer.available_size ui.placer
let available_width ui = Gg.P2.x (available_size ui)
let fonts ui (reader : Gv.t -> 'a) : 'a = reader ui
let allocate_space (_gv : Gv.t) (size : Gg.box2) : id * Gg.box2 =
id := !id + 1;
(!id, size)
let cursor_origin (ui : t) = Gg.Box2.o ui.placer.region.max_rect
let key_callback_default _ _ _ _ _ _ = ()
let window gv ?(window : GLFW.window option) rect : t =
let id, rect = allocate_space gv rect in
{
id;
style = Style.default;
placer =
Placer.create Layout.vertical
Layout.{ min_rect = rect; max_rect = rect; cursor = rect };
enabled = true;
gv;
glfw_window = window;
key = key_callback_default;
}
let keycallback t window key int state mods : unit =
t.key t window key int state mods
let add_key_callback (t : t) ~(f : key_callback) : unit =
let g = t.key in
t.key <-
(fun a1 a2 a3 a4 a5 a6 ->
f a1 a2 a3 a4 a5 a6;
g a1 a2 a3 a4 a5 a6)
let interact (_ui : t) rect (id : id option) sense : Response.t =
let id = Option.value id ~default:(-1) in
{
ctx = { derp = false };
id;
rect;
interact_rect = rect;
sense;
enabled = true;
contains_pointer = (*TODO*) true;
hovered = (*TODO*) true;
highlighted = (*TODO*) true;
clicked = (*TODO*) true;
fake_primary_click = (*TODO*) false;
long_touched = (*TODO*) false;
drag_started = false;
dragged = false;
drag_stopped = false;
is_pointer_button_down_on = false;
interact_pointer_pos = None;
changed = false;
}
end
module TextBuffer = struct
type t = String of string
let is_mutable = function String _ -> true
let as_string = function String s -> s
end
module TextEdit = struct
open Gg
type t = {
text : TextBuffer.t;
hint_text : TextLayout.widget_text;
id : id option;
id_source : id option;
text_format : TextLayout.text_format;
layouter :
(Ui.t -> TextBuffer.t -> float -> TextLayout.galley) option;
password : bool;
frame : bool;
margin : margin;
multiline : bool;
interactive : bool;
desired_width : float option;
desired_height_rows : int;
event_filter : event_filter;
cursor_at_end : bool;
min_size : Gg.v2;
align : align;
clip_text : bool;
char_limit : int; (* return_key : keyboard_shortcut; *)
}
type state = {
mutable cursor : TextLayout.cursor_state;
(* undoer : undoer; *)
singleline_offset : float;
last_edit_time : float;
}
let state_mem : (int * state) list ref = ref []
let process_key (state : state) (key : GLFW.key)
(action : GLFW.key_action) (mods : GLFW.key_mod list) : unit =
let open GLFW in
match (action, key, mods) with
| Press, F, [ Control ] | Press, Right, [] ->
state.cursor <-
TextLayout.cursor_state_update
~f:(fun a b ->
F.epr "cursor_state_update %d %d@." a b;
(a + 1, b + 1))
state.cursor
| Press, B, [ Control ] | Press, Left, [] ->
state.cursor <-
TextLayout.cursor_state_update
~f:(fun a b ->
F.epr "cursor_state_update %d %d@." a b;
(a - 1, b - 1))
state.cursor
| _ -> ()
let load_state ui id =
match List.assoc_opt id !state_mem with
| Some state -> state
| None ->
let state =
{
cursor = Some (TextLayout.new_cursor_range (12, 13));
singleline_offset = 0.0;
last_edit_time = 0.0;
}
in
state_mem := (id, state) :: !state_mem;
(* We use this as the one shot for registering keyboard shortcuts
since they just operate on the state *)
Ui.add_key_callback ui ~f:(fun _ _ key _ action mods ->
process_key state key action mods);
state
type output = {
response : Response.t;
galley : TextLayout.galley;
galley_pos : Gg.p2;
text_clip_rect : Gg.box2;
state : state;
cursor_range : TextLayout.cursor_range option;
}
let multiline ?(text_format = TextLayout.text_format_default)
(text : TextBuffer.t) : t =
{
text;
hint_text = RichText TextLayout.rich_text_default;
id = None;
id_source = None;
text_format;
layouter = None;
password = false;
frame = true;
margin = Margin.symmetric 4.0 2.0;
multiline = true;
interactive = true;
desired_width = None;
desired_height_rows = 4;
event_filter =
{
EventFilter.default with
horizontal_arrrows = true;
vertical_arrows = true;
tab = false;
};
cursor_at_end = true;
min_size = Gg.V2.zero;
align = Min;
clip_text = false;
char_limit = Int.max_int;
(* return_key = keyboard_shortcut; *)
}
let show_content (t : t) (ui : Ui.t) : output =
let origin = Ui.cursor_origin ui in
(* TODO .or(ui.visuals().override_text_color) *)
(* let row_height = (Gv.Text.metrics ui.gv).line_height in *)
let available_width =
Ui.available_width ui -. (t.margin.left +. t.margin.right)
in
let desired_width =
Option.fold ~none:(Ui.spacing ui).text_edit_width ~some:Fun.id
t.desired_width
in
let wrap_width =
if Layout.horizontal_justify ui.placer.layout then
available_width
else Float.min desired_width available_width
in
let state = load_state ui (Option.value ~default:(-1) t.id) in
let default_layouter (ui : Ui.t) (text : TextBuffer.t)
(wrap_width : size1) : TextLayout.galley =
let font =
match Gv.Text.find_font ui.gv ~name:"mono" with
| Some gv -> Fonts.{ gv; pixels_per_point = 1.0 }
| None -> failwith "can't font font 'mono'"
in
let layout_job =
if t.multiline then
TextLayout.simple
(TextBuffer.as_string text)
t.text_format wrap_width
else
TextLayout.simple_singleline
(TextBuffer.as_string text)
t.text_format
in
let layout_job =
TextLayout.with_cursor
(Option.value
~default:(TextLayout.new_cursor_range (0, 0))
state.cursor)
layout_job
in
Ui.fonts ui.gv (fun f ->
TextLayout.layout f font layout_job origin)
in
let layouter =
Option.value ~default:default_layouter t.layouter
in
let galley = layouter ui t.text wrap_width in
let galley_size = galley.mesh_bounds in
let desired_width =
if t.clip_text then wrap_width
else Float.max (Size2.w (Box2.size galley_size)) wrap_width
in
let desired_inner_size =
V2.v desired_width (Box2.maxy galley_size)
in
let desired_outer_size =
V2.(desired_inner_size + Margin.sum t.margin)
in
let (_auto_id, outer_rect) : id * box2 =
Ui.allocate_space ui.gv (Box2.v origin desired_outer_size)
in
let rect = Margin.inner t.margin outer_rect in
(* TODO id = ui.make_persistent_id(id_source) else auto_id *)
(* TODO state = TextEditState::load(ui.ctx(), id)... *)
(* TODO moved up let state = load_state (Option.value ~default:(-1) t.id) in *)
(* TODO allow_drag_to_select = ... *)
let sense = if t.interactive then Sense.click else Sense.hover in
let response = Ui.interact ui outer_rect t.id sense in
(* TODO *)
let text_clip_rect = rect in
(* let painter = Ui.painter_at ui text_clip_rect in *)
let cursor_range = None in
(* TODO cursor_range *)
let galley_pos =
Align.size_within_rect (Box2.size galley_size) rect
in
(* if Ui.is_rect_visible ui rect then *)
Painter.galley ui.gv galley;
let _align_offset = rect in
{
response;
galley;
galley_pos = Box2.o galley_pos;
text_clip_rect;
state;
cursor_range;
}
let show (t : t) ui : output =
let _is_mutable = TextBuffer.is_mutable t.text in
let _frame = t.frame in
let _margin = t.margin in
let output = show_content t ui in
let _outer_rect = output.response.rect in
output
end