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

basic cursor forward back

Browse Source
This commit is contained in:
cqc
2024-04-20 13:58:47 -05:00
parent eb0da91aa2
commit 54e9cc90d3
3 changed files with 489 additions and 176 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
dune
View File

@ -20,17 +20,17 @@
lwt
store
memtrace
glfw-ocaml
tgls
tgls.tgles2
graphv_gles2_native
stb_image
glfw-ocaml
gg
irmin-git
compiler-libs.toplevel
)
(link_flags (-linkall))
(ocamlopt_flags (:standard -O3 -unboxed-types))
; (ocamlopt_flags (:standard -O3 -unboxed-types))
(ocamlc_flags (:standard -verbose))
(modes byte)
(preprocess
(pps ppx_irmin))

303
ogui.ml
View File

@ -181,11 +181,11 @@ module TextLayout = struct
field "background" (fun s -> s.background) pp_color;
])
let text_format_default () =
let text_format_default =
{
font_id = FontId ("sans", 12.0);
font_id = FontId ("mono", 18.0);
extra_letter_spacing = 0.0;
line_height = None;
line_height = Some 19.;
color = Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9;
background = Gv.Color.transparent;
italics = false;
@ -195,7 +195,7 @@ module TextLayout = struct
}
let text_format_simple font_id color : text_format =
{ (text_format_default ()) with font_id; color }
{ text_format_default with font_id; color }
type text_wrapping = {
max_width : float;
@ -242,14 +242,22 @@ module TextLayout = struct
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 list;
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 =
@ -259,7 +267,7 @@ module TextLayout = struct
field "text" (fun s -> String.length s.text) int;
field "sections"
(fun s -> s.sections)
(list pp_layout_section);
(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)
@ -272,12 +280,13 @@ module TextLayout = struct
let default_layout_job () =
{
text = "";
sections = [];
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 = {
@ -430,60 +439,141 @@ module TextLayout = struct
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) () =
let new_cursor ?(loc = 0) () : cursor =
cursor_index := !cursor_index + 1;
{ index = loc; row = None; prefer_next_row = false }
let simple text (font : font_selection) color wrap_width :
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 = text_format_simple font color;
format;
};
];
wrap =
{ (default_text_wrapping ()) with max_width = wrap_width };
break_on_newline = true;
}
let simple_singleline text (font : font_selection) color :
layout_job =
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 = text_format_simple font color;
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 layout (gv : Gv.t) (fonts : Fonts.t) (job : layout_job) : galley
=
F.epr "TextLayout.layout@.";
F.epr "job.wrap.max_width=%f@." job.wrap.max_width;
F.epr "job.wrap.max_rows=%d@." job.wrap.max_rows;
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.zero;
rect = Box2.move pos Box2.zero;
mesh_bounds = Box2.zero;
elided = true;
num_vertices = 0;
@ -497,20 +587,24 @@ module TextLayout = struct
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 0. 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 +. metrics.line_height;
height := !height +. line_height;
let rect =
Box2.v
(P2.v text_row.minx !height)
(P2.v text_row.maxx
(!height +. metrics.line_height))
(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;
{
@ -529,7 +623,7 @@ module TextLayout = struct
rect =
Box2.v Size2.zero
(P2.v job.wrap.max_width
(Float.of_int row_count *. metrics.line_height));
(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 *);
@ -551,30 +645,33 @@ module Painter = struct
type t = Gv.t
let galley (t : t) (g : TextLayout.galley) : unit =
F.epr
(* 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.job=%a@." F.(braces TextLayout.pp_layout_job) g.job;
F.epr "g.rect=%a@." Gg.Box2.pp g.rect; *)
(* F.epr "g.rows=%a@." F.(braces (array TextLayout.pp_row)) g.rows;*)
Array.iteri
Array.iter
Gv.(
fun _n (row : TextLayout.row) ->
fun (row : TextLayout.row) ->
let sections =
List.filter
(fun (r : TextLayout.layout_section) ->
row.text_row.start_index <= snd r.byte_range)
(nth_tl row.section_index_at_start g.job.sections)
(* TODO don't need to iterate the whole list *)
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
(List.fold_left
Gg.(
fun x (sec : TextLayout.layout_section) ->
List.fold_left
(fun x (sec : TextLayout.layout_section) ->
let start, end_ =
( min
(String.length g.job.text - 1)
@ -590,7 +687,7 @@ module Painter = struct
let font_name, font_size =
match sec.format.font_id with
| Default -> ("mono", 12.)
| Default -> ("mono", 18.)
| FontId (s, size) -> (s, size)
in
Text.set_font_face t ~name:font_name;
@ -598,8 +695,7 @@ module Painter = struct
Text.set_align t ~align:Align.(left lor top);
let metrics = Gv.Text.metrics t in
let bounds =
Gv.Text.bounds t ~x:0. ~y:0. ~start ~end_
g.job.text
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)
@ -609,11 +705,11 @@ module Painter = struct
set_fill_color t ~color:sec.format.color;
let w =
Text.text_w t ~x:(Box2.minx row.rect)
~y:(Box2.miny row.rect) ~start ~end_ g.job.text
Text.text_w t ~x ~y:(Box2.miny row.rect) ~start
~end_ g.job.text
in
x +. w)
0. sections))
w)
(Box2.minx row.rect) sections))
g.rows
end
@ -781,12 +877,23 @@ module Placer = struct
end
module Ui = struct
type t = {
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
@ -800,8 +907,9 @@ module Ui = struct
(!id, size)
let cursor_origin (ui : t) = Gg.Box2.o ui.placer.region.max_rect
let key_callback_default _ _ _ _ _ _ = ()
let window gv rect : t =
let window gv ?(window : GLFW.window option) rect : t =
let id, rect = allocate_space gv rect in
{
id;
@ -811,8 +919,20 @@ module Ui = struct
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
{
@ -852,8 +972,7 @@ module TextEdit = struct
hint_text : TextLayout.widget_text;
id : id option;
id_source : id option;
font_selection : TextLayout.font_selection;
text_color : Gv.Color.t option;
text_format : TextLayout.text_format;
layouter :
(Ui.t -> TextBuffer.t -> float -> TextLayout.galley) option;
password : bool;
@ -872,14 +991,51 @@ module TextEdit = struct
}
type state = {
cursor : TextLayout.cursor_state;
mutable cursor : TextLayout.cursor_state;
(* undoer : undoer; *)
singleline_offset : float;
last_edit_time : float;
}
let load_state _ui _id =
{ cursor = None; singleline_offset = 0.0; last_edit_time = 0.0 }
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;
@ -890,14 +1046,14 @@ module TextEdit = struct
cursor_range : TextLayout.cursor_range option;
}
let multiline (text : TextBuffer.t) : t =
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;
font_selection = Default;
text_color = Some (Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9);
text_format;
layouter = None;
password = false;
frame = true;
@ -923,9 +1079,8 @@ module TextEdit = struct
let show_content (t : t) (ui : Ui.t) : output =
let origin = Ui.cursor_origin ui in
let text_color = t.text_color in
(* TODO .or(ui.visuals().override_text_color) *)
let row_height = (Gv.Text.metrics ui.gv).line_height in
(* 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
@ -938,29 +1093,33 @@ module TextEdit = struct
available_width
else Float.min desired_width available_width
in
let text_color =
Option.value
~default:(Gv.Color.rgbf ~r:0.5 ~g:0.5 ~b:0.5)
text_color
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:"sans" with
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 'sans'"
| None -> failwith "can't font font 'mono'"
in
let layout_job =
if t.multiline then
TextLayout.simple
(TextBuffer.as_string text)
t.font_selection text_color wrap_width
t.text_format wrap_width
else
TextLayout.simple_singleline
(TextBuffer.as_string text)
t.font_selection text_color
t.text_format
in
Ui.fonts ui.gv (fun f -> TextLayout.layout f font layout_job)
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 =
@ -972,9 +1131,6 @@ module TextEdit = struct
if t.clip_text then wrap_width
else Float.max (Size2.w (Box2.size galley_size)) wrap_width
in
let _desired_height =
Float.min (Int.to_float t.desired_height_rows) 1.0 *. row_height
in
let desired_inner_size =
V2.v desired_width (Box2.maxy galley_size)
in
@ -987,7 +1143,7 @@ module TextEdit = struct
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)... *)
let state = load_state ui.gv t.id in
(* 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
@ -1000,6 +1156,7 @@ module TextEdit = struct
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;

188
oplevel.ml
View File

@ -37,6 +37,153 @@ let load_data vg =
Gv.Text.add_fallback vg ~name:"sans-bold" ~fallback:"emoji";
Gv.Text.set_font_face vg ~name:"mono"
let pp_glfw_key : GLFW.key F.t =
fun ppf k ->
F.pf ppf
GLFW.(
match k with
| Unknown -> "Unknown"
| Space -> "Space"
| Apostrophe -> "Apostrophe"
| Comma -> "Comma"
| Minus -> "Minus"
| Period -> "Period"
| Slash -> "Slash"
| Num0 -> "Num0"
| Num1 -> "Num1"
| Num2 -> "Num2"
| Num3 -> "Num3"
| Num4 -> "Num4"
| Num5 -> "Num5"
| Num6 -> "Num6"
| Num7 -> "Num7"
| Num8 -> "Num8"
| Num9 -> "Num9"
| Semicolon -> "Semicolon"
| Equal -> "Equal"
| A -> "A"
| B -> "B"
| C -> "C"
| D -> "D"
| E -> "E"
| F -> "F"
| G -> "G"
| H -> "H"
| I -> "I"
| J -> "J"
| K -> "K"
| L -> "L"
| M -> "M"
| N -> "N"
| O -> "O"
| P -> "P"
| Q -> "Q"
| R -> "R"
| S -> "S"
| T -> "T"
| U -> "U"
| V -> "V"
| W -> "W"
| X -> "X"
| Y -> "Y"
| Z -> "Z"
| LeftBracket -> "LeftBracket"
| Backslash -> "Backslash"
| RightBracket -> "RightBracket"
| GraveAccent -> "GraveAccent"
| World1 -> "World1"
| World2 -> "World2"
| Escape -> "Escape"
| Enter -> "Enter"
| Tab -> "Tab"
| Backspace -> "Backspace"
| Insert -> "Insert"
| Delete -> "Delete"
| Right -> "Right"
| Left -> "Left"
| Down -> "Down"
| Up -> "Up"
| PageUp -> "PageUp"
| PageDown -> "PageDown"
| Home -> "Home"
| End -> "End"
| CapsLock -> "CapsLock"
| ScrollLock -> "ScrollLock"
| NumLock -> "NumLock"
| PrintScreen -> "PrintScreen"
| Pause -> "Pause"
| F1 -> "F1"
| F2 -> "F2"
| F3 -> "F3"
| F4 -> "F4"
| F5 -> "F5"
| F6 -> "F6"
| F7 -> "F7"
| F8 -> "F8"
| F9 -> "F9"
| F10 -> "F10"
| F11 -> "F11"
| F12 -> "F12"
| F13 -> "F13"
| F14 -> "F14"
| F15 -> "F15"
| F16 -> "F16"
| F17 -> "F17"
| F18 -> "F18"
| F19 -> "F19"
| F20 -> "F20"
| F21 -> "F21"
| F22 -> "F22"
| F23 -> "F23"
| F24 -> "F24"
| F25 -> "F25"
| Kp0 -> "Kp0"
| Kp1 -> "Kp1"
| Kp2 -> "Kp2"
| Kp3 -> "Kp3"
| Kp4 -> "Kp4"
| Kp5 -> "Kp5"
| Kp6 -> "Kp6"
| Kp7 -> "Kp7"
| Kp8 -> "Kp8"
| Kp9 -> "Kp9"
| KpDecimal -> "KpDecimal"
| KpDivide -> "KpDivide"
| KpMultiply -> "KpMultiply"
| KpSubtract -> "KpSubtract"
| KpAdd -> "KpAdd"
| KpEnter -> "KpEnter"
| KpEqual -> "KpEqual"
| LeftShift -> "LeftShift"
| LeftControl -> "LeftControl"
| LeftAlt -> "LeftAlt"
| LeftSuper -> "LeftSuper"
| RightShift -> "RightShift"
| RightControl -> "RightControl"
| RightAlt -> "RightAlt"
| RightSuper -> "RightSuper"
| Menu -> "Menu")
let pp_glfw_key_action : GLFW.key_action F.t =
fun ppf s ->
F.pf ppf
GLFW.(
match s with
| Release -> "Release"
| Press -> "Press"
| Repeat -> "Repeat")
let pp_glfw_mods =
F.(
list (fun ppf s ->
pf ppf
GLFW.(
match s with
| Shift -> "Shift"
| Control -> "Control"
| Alt -> "Alt"
| Super -> "Super")))
let () =
GLFW.init ();
at_exit GLFW.terminate;
@ -65,11 +212,13 @@ let () =
let continue = ref true in
let min_fps = ref Float.max_float in
let max_fps = ref Float.min_float in
let blowup = ref false in
(* Thread which is woken up when the main window is closed. *)
let _waiter, _wakener = Lwt.wait () in
F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
Toploop.initialize_toplevel_env ();
let text =
Lwt_main.run
((fun () ->
Store.init_default
@ -85,18 +234,31 @@ let () =
Lwt.return
(F.str ".config/init.ml load exception: %s"
(Printexc.to_string exc)))
>>= fun text ->
>>= fun text -> Lwt.return text)
())
in
let ui =
Ogui.Ui.window ctx ~window Gg.(Box2.v P2.o (P2.v 500. 500.))
in
GLFW.setKeyCallback ~window
~f:
(Some
(fun _ key _ state _ ->
match (key, state) with
| GLFW.Space, GLFW.Release -> blowup := not !blowup
| _ -> ()))
(fun window key int state mods ->
F.epr
"GLFW.setKeyCallback ~f: _win key=%a int=%d state=%a \
mods=%a@."
pp_glfw_key key int pp_glfw_key_action state pp_glfw_mods
mods;
Ogui.Ui.keycallback ui window key int state mods))
|> ignore;
let t = GLFW.getTime () |> ref in
while (not GLFW.(windowShouldClose ~window)) && !continue do
Lwt_main.run
((fun () ->
let now = GLFW.getTime () in
let dt = now -. !t in
t := now;
@ -127,9 +289,6 @@ let () =
Perfgraph.render graph ctx (win_w -. 205.) 5.;
let ui =
Ogui.Ui.window ctx Gg.(Box2.v P2.o (P2.v 500. 500.))
in
ignore Ogui.TextEdit.(show (multiline (String text)) ui);
(* Demo.render_demo ctx mx my win_w win_h now !blowup data; *)
Gv.end_frame ctx;
@ -137,8 +296,9 @@ let () =
Gc.major_slice 0 |> ignore;
GLFW.swapBuffers ~window;
GLFW.pollEvents ()
(*continue := false;*)
GLFW.pollEvents ();
Lwt.return_unit)
())
done;
Printf.printf "MIN %.2f\n" !min_fps;
@ -148,9 +308,7 @@ let () =
while not GLFW.(windowShouldClose ~window) do
GLFW.pollEvents ();
Unix.sleepf 0.25
done;
F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
Toploop.initialize_toplevel_env ();
done
(* let out_ppf =
Format.formatter_of_out_functions
@ -174,5 +332,3 @@ let () =
(String "#use \"topfind\";;\n#list;;")); *)
(* ignore (Toploop.use_input Format.std_formatter (String text)); *)
(* Wait for it to be closed. *)
Lwt.return ())
())