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

more cleanup

Browse Source
This commit is contained in:
cqc
2024-05-11 23:26:15 -05:00
parent 1820e5f8a9
commit 46a08e011f
3 changed files with 229 additions and 275 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
dune
View File

@ -26,11 +26,11 @@
graphv_gles2_native
gg
irmin-git
; compiler-libs.toplevel
compiler-libs.toplevel
re
)
; (link_flags (-linkall))
; (ocamlopt_flags (:standard -O3 -unboxed-types))
(link_flags (-linkall))
(ocamlopt_flags (:standard -O3 -unboxed-types))
(ocamlc_flags (:standard -verbose))
(modes byte)
(preprocess

140
ogui.ml
View File

@ -379,7 +379,7 @@ module TextLayout = struct
type font_selection = Default | FontId of (string * float)
type text_format = {
type format = {
font_id : font_selection;
extra_letter_spacing : float;
line_height : float option;
@ -398,7 +398,7 @@ module TextLayout = struct
overflow_character : string option;
}
type section = { byte_range : int * int; format : text_format }
type section = { byte_range : int * int; format : format }
type layout = {
text : TextBuffer.t;
@ -411,7 +411,7 @@ module TextLayout = struct
type cursor = { index : int; last_col : int }
let pp_text_format : text_format F.t =
let pp_format : format F.t =
F.(
record
[
@ -420,13 +420,13 @@ module TextLayout = struct
(fun s -> s.extra_letter_spacing)
float;
field "line_height"
(fun (s : text_format) -> s.line_height)
(fun (s : format) -> 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 =
let format_default =
{
font_id = FontId ("mono", 18.0);
extra_letter_spacing = 0.0;
@ -439,8 +439,8 @@ module TextLayout = struct
valign = Max;
}
let text_format_simple font_id color : text_format =
{ text_format_default with font_id; color }
let format_simple font_id color : format =
{ format_default with font_id; color }
let pp_text_wrapping =
F.(
@ -470,11 +470,11 @@ module TextLayout = struct
field "byte_range"
(fun s -> s.byte_range)
(pair ~sep:(any ",") int int);
field "format" (fun s -> s.format) pp_text_format;
field "format" (fun s -> s.format) pp_format;
])
let section_default =
{ byte_range = (0, 0); format = text_format_default }
{ byte_range = (0, 0); format = format_default }
let pp_layout =
F.(
@ -524,8 +524,8 @@ module TextLayout = struct
row last_col index;
{ index; last_col }
let simple text ?(format = text_format_default) wrap_width :
layout Lwt.t =
let simple text ?(format = format_default) wrap_width : layout Lwt.t
=
TextBuffer.length text >>= fun textlen ->
Lwt.return
{
@ -538,10 +538,10 @@ module TextLayout = struct
let cursor_color = ref (Gv.Color.rgbf ~r:0.5 ~g:0.5 ~b:0.)
let default_cursor_formatter (f : text_format) =
let default_cursor_formatter (f : format) =
{ f with background = !cursor_color }
let default_mark_formatter (f : text_format) =
let default_mark_formatter (f : format) =
{ f with background = Gv.Color.rgbf ~r:0.3 ~g:0.3 ~b:0.3 }
let with_range ((cs, ce) : int * int)
@ -710,6 +710,10 @@ module Ui = struct
callback_resolver := None;
Lwt.return false
let update_bindings ui
(f : action list Event.t -> action list Event.t) =
ui.bindings <- f ui.bindings
let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref =
ref (fun c ->
F.epr "chrcallback: '%a'@." pp_uchar c;
@ -728,7 +732,7 @@ module TextEdit = struct
mutable mark : int option;
id : id option;
id_source : id option;
text_format : TextLayout.text_format;
text_format : TextLayout.format;
formatter :
(Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option;
password : bool;
@ -769,12 +773,12 @@ module TextEdit = struct
(index' - Str.search_backward (Str.regexp "^") s index')
index')
let add_bindings (t : t) (ui : Ui.t) : unit Lwt.t =
let default_bindings (t : t) (ui : Ui.t) : unit Lwt.t =
let open GLFW in
let open Event in
let open Ui in
ui.bindings <-
empty
Ui.update_bindings ui (fun a ->
a
|> adds
[
[ Key (Press, F, [ Control ]) ];
@ -803,11 +807,15 @@ module TextEdit = struct
(fun () ->
TextBuffer.fold_string t.text (fun s ->
let sn = String.length s in
let seol = Str.search_forward (Str.regexp "$") in
let seol =
Str.search_forward (Str.regexp "$")
in
let next_bol =
min sn (seol s t.cursor.index + 1)
in
let next_line_len = seol s next_bol - next_bol in
let next_line_len =
seol s next_bol - next_bol
in
(* F.epr
"Down: index=%d last_col=%d eol=%d eol'=%d \
bol=%d @."
@ -820,7 +828,8 @@ module TextEdit = struct
+
if t.cursor.last_col > next_line_len then
next_line_len
else min next_line_len t.cursor.last_col);
else min next_line_len t.cursor.last_col
);
}));
]
|> adds
@ -851,15 +860,16 @@ module TextEdit = struct
index =
(prev_bol
+
if t.cursor.last_col > prev_line_len then
prev_line_len
else min prev_line_len t.cursor.last_col
);
if t.cursor.last_col > prev_line_len
then prev_line_len
else
min prev_line_len t.cursor.last_col);
})));
]
|> adds (* EOL *)
[
[ Key (Press, E, [ Control ]) ]; [ Key (Press, End, []) ];
[ Key (Press, E, [ Control ]) ];
[ Key (Press, End, []) ];
]
[
Custom
@ -931,7 +941,9 @@ module TextEdit = struct
>>= fun u -> u);
]
|> adds
[ [ Key (Press, Enter, []) ]; [ Key (Repeat, Enter, []) ] ]
[
[ Key (Press, Enter, []) ]; [ Key (Repeat, Enter, []) ];
]
[
Custom
(fun () ->
@ -951,8 +963,7 @@ module TextEdit = struct
| Some _ -> None
| None -> Some t.cursor.index);
Lwt.return_unit);
];
]);
(* WARN XXX TKTK TODO this is probably "breaking" the lwt context and being used in other calls to Lwt_main.run *)
(Ui.chrcallback_ref :=
fun c ->
@ -964,7 +975,7 @@ module TextEdit = struct
>>= fun () -> !Ui.chrcallback_ref c *));
Lwt.return_unit
let multiline ui ?(text_format = TextLayout.text_format_default)
let multiline ui ?(text_format = TextLayout.format_default)
(text : TextBuffer.t) : t =
let t =
{
@ -990,75 +1001,8 @@ module TextEdit = struct
(* return_key = keyboard_shortcut; *)
}
in
Lwt_main.run (add_bindings t ui);
Lwt_main.run (default_bindings t ui);
t
(*
let show_content (t : t) (ui : Ui.t) : output =
let state = load_state (Option.value ~default:(-1) t.id) in
Lwt_main.run (add_bindings t ui state);
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 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
{
galley;
galley_pos = Box2.o galley_pos;
text_clip_rect;
state;
cursor_range;
}
let show (t : t) ui : output =
let _margin = t.margin in
let output = show_content t ui in
(* let _outer_rect = output.response.rect in *)
output
*)
end
module Layout = struct
@ -1177,7 +1121,7 @@ module Painter = struct
stroke t);
fill t
let set_text_format (t : Gv.t) (format : TextLayout.text_format) =
let set_text_format (t : Gv.t) (format : TextLayout.format) =
let font_name, font_size =
match format.font_id with
| Default -> ("mono", 18.)

16
oplevel.ml
View File

@ -70,8 +70,8 @@ let () =
(* 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 (); *)
F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
Toploop.initialize_toplevel_env ();
let rootrepo =
Store.init_default
(F.str "%s/console/rootstore.git" Secrets.giturl)
@ -100,6 +100,7 @@ let () =
F.pr "oplevel.ml: building initial page@.";
let page =
ref
Layout.(
vbox
[
@ -114,6 +115,15 @@ let () =
])
in
(let open GLFW in
let open Event in
let open Ui in
update_bindings ui
(adds
[
[ Key (Press, X, [ Control ]); Key (Press, E, [ Control ]) ];
]
[ Custom (fun () -> Lwt.return ()) ]));
F.pr "oplevel.ml: entering drawing loop@.";
let period_min = 1.0 /. 30. in
let t = GLFW.getTime () |> ref in
@ -149,7 +159,7 @@ let () =
Perfgraph.render graph ctx (width -. 205.) 5.;
(* F.epr "box=%a@." Gg.Box2.pp box;
F.epr "Painter.layout=%a@." Gg.Box2.pp *)
Painter.layout box ui page >>= fun _ ->
Painter.layout box ui !page >>= fun _ ->
(* Demo.render_demo ctx mx my win_w win_h now !blowup data; *)
Gv.end_frame ctx;