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 graphv_gles2_native
gg gg
irmin-git irmin-git
; compiler-libs.toplevel compiler-libs.toplevel
re re
) )
; (link_flags (-linkall)) (link_flags (-linkall))
; (ocamlopt_flags (:standard -O3 -unboxed-types)) (ocamlopt_flags (:standard -O3 -unboxed-types))
(ocamlc_flags (:standard -verbose)) (ocamlc_flags (:standard -verbose))
(modes byte) (modes byte)
(preprocess (preprocess

458
ogui.ml
View File

@ -379,7 +379,7 @@ module TextLayout = struct
type font_selection = Default | FontId of (string * float) type font_selection = Default | FontId of (string * float)
type text_format = { type format = {
font_id : font_selection; font_id : font_selection;
extra_letter_spacing : float; extra_letter_spacing : float;
line_height : float option; line_height : float option;
@ -398,7 +398,7 @@ module TextLayout = struct
overflow_character : string option; overflow_character : string option;
} }
type section = { byte_range : int * int; format : text_format } type section = { byte_range : int * int; format : format }
type layout = { type layout = {
text : TextBuffer.t; text : TextBuffer.t;
@ -411,7 +411,7 @@ module TextLayout = struct
type cursor = { index : int; last_col : int } type cursor = { index : int; last_col : int }
let pp_text_format : text_format F.t = let pp_format : format F.t =
F.( F.(
record record
[ [
@ -420,13 +420,13 @@ module TextLayout = struct
(fun s -> s.extra_letter_spacing) (fun s -> s.extra_letter_spacing)
float; float;
field "line_height" field "line_height"
(fun (s : text_format) -> s.line_height) (fun (s : format) -> s.line_height)
(option float); (option float);
field "color" (fun s -> s.color) pp_color; field "color" (fun s -> s.color) pp_color;
field "background" (fun s -> s.background) pp_color; field "background" (fun s -> s.background) pp_color;
]) ])
let text_format_default = let format_default =
{ {
font_id = FontId ("mono", 18.0); font_id = FontId ("mono", 18.0);
extra_letter_spacing = 0.0; extra_letter_spacing = 0.0;
@ -439,8 +439,8 @@ module TextLayout = struct
valign = Max; valign = Max;
} }
let text_format_simple font_id color : text_format = let format_simple font_id color : format =
{ text_format_default with font_id; color } { format_default with font_id; color }
let pp_text_wrapping = let pp_text_wrapping =
F.( F.(
@ -470,11 +470,11 @@ module TextLayout = struct
field "byte_range" field "byte_range"
(fun s -> s.byte_range) (fun s -> s.byte_range)
(pair ~sep:(any ",") int int); (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 = let section_default =
{ byte_range = (0, 0); format = text_format_default } { byte_range = (0, 0); format = format_default }
let pp_layout = let pp_layout =
F.( F.(
@ -524,8 +524,8 @@ module TextLayout = struct
row last_col index; row last_col index;
{ index; last_col } { index; last_col }
let simple text ?(format = text_format_default) wrap_width : let simple text ?(format = format_default) wrap_width : layout Lwt.t
layout Lwt.t = =
TextBuffer.length text >>= fun textlen -> TextBuffer.length text >>= fun textlen ->
Lwt.return 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 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 } { 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 } { f with background = Gv.Color.rgbf ~r:0.3 ~g:0.3 ~b:0.3 }
let with_range ((cs, ce) : int * int) let with_range ((cs, ce) : int * int)
@ -710,6 +710,10 @@ module Ui = struct
callback_resolver := None; callback_resolver := None;
Lwt.return false 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 = let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref =
ref (fun c -> ref (fun c ->
F.epr "chrcallback: '%a'@." pp_uchar c; F.epr "chrcallback: '%a'@." pp_uchar c;
@ -728,7 +732,7 @@ module TextEdit = struct
mutable mark : int option; mutable mark : int option;
id : id option; id : id option;
id_source : id option; id_source : id option;
text_format : TextLayout.text_format; text_format : TextLayout.format;
formatter : formatter :
(Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option; (Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option;
password : bool; password : bool;
@ -769,190 +773,197 @@ module TextEdit = struct
(index' - Str.search_backward (Str.regexp "^") s index') (index' - Str.search_backward (Str.regexp "^") s index')
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 GLFW in
let open Event in let open Event in
let open Ui in let open Ui in
ui.bindings <- Ui.update_bindings ui (fun a ->
empty a
|> adds |> adds
[ [
[ Key (Press, F, [ Control ]) ]; [ Key (Press, F, [ Control ]) ];
[ Key (Repeat, F, [ Control ]) ]; [ Key (Repeat, F, [ Control ]) ];
[ Key (Press, Right, []) ]; [ Key (Press, Right, []) ];
[ Key (Repeat, Right, []) ]; [ Key (Repeat, Right, []) ];
] ]
[ Custom (fun () -> cursor_move t 1) ] [ Custom (fun () -> cursor_move t 1) ]
|> adds |> adds
[ [
[ Key (Press, B, [ Control ]) ]; [ Key (Press, B, [ Control ]) ];
[ Key (Repeat, B, [ Control ]) ]; [ Key (Repeat, B, [ Control ]) ];
[ Key (Press, Left, []) ]; [ Key (Press, Left, []) ];
[ Key (Repeat, Left, []) ]; [ Key (Repeat, Left, []) ];
] ]
[ Custom (fun () -> cursor_move t (-1)) ] [ Custom (fun () -> cursor_move t (-1)) ]
|> adds |> adds
[ [
[ Key (Press, N, [ Control ]) ]; [ Key (Press, N, [ Control ]) ];
[ Key (Repeat, N, [ Control ]) ]; [ Key (Repeat, N, [ Control ]) ];
[ Key (Press, Down, []) ]; [ Key (Press, Down, []) ];
[ Key (Repeat, Down, []) ]; [ Key (Repeat, Down, []) ];
] ]
[ [
Custom Custom
(fun () -> (fun () ->
TextBuffer.fold_string t.text (fun s -> TextBuffer.fold_string t.text (fun s ->
let sn = String.length s in let sn = String.length s in
let seol = Str.search_forward (Str.regexp "$") in let seol =
let next_bol = Str.search_forward (Str.regexp "$")
min sn (seol s t.cursor.index + 1) in
in let next_bol =
let next_line_len = seol s next_bol - next_bol in min sn (seol s t.cursor.index + 1)
(* F.epr in
"Down: index=%d last_col=%d eol=%d eol'=%d \ let next_line_len =
bol=%d @." seol s next_bol - next_bol
t.cursor.index last_col eol' bol; *) in
t.cursor <- (* F.epr
{ "Down: index=%d last_col=%d eol=%d eol'=%d \
t.cursor with bol=%d @."
index = t.cursor.index last_col eol' bol; *)
(next_bol
+
if t.cursor.last_col > next_line_len then
next_line_len
else min next_line_len t.cursor.last_col);
}));
]
|> adds
[
[ Key (Press, P, [ Control ]) ];
[ Key (Repeat, P, [ Control ]) ];
[ Key (Press, Up, []) ];
[ Key (Repeat, Up, []) ];
]
[
Custom
(fun () ->
TextBuffer.fold_string t.text (fun s ->
let sbol =
Str.search_backward (Str.regexp "^") s
in
let bol = sbol t.cursor.index in
if bol > 0 then (
let prev_bol = sbol (max 0 (bol - 1)) in
let prev_line_len = bol - 1 - prev_bol in
F.epr
"up: index=%d bol=%d prev_bol=%d \
prev_line_len=%d @."
t.cursor.index bol prev_bol prev_line_len;
t.cursor <- t.cursor <-
{ {
t.cursor with t.cursor with
index = index =
(prev_bol (next_bol
+ +
if t.cursor.last_col > prev_line_len then if t.cursor.last_col > next_line_len then
prev_line_len next_line_len
else min prev_line_len t.cursor.last_col else min next_line_len t.cursor.last_col
); );
}))); }));
] ]
|> adds (* EOL *) |> adds
[ [
[ Key (Press, E, [ Control ]) ]; [ Key (Press, End, []) ]; [ Key (Press, P, [ Control ]) ];
] [ Key (Repeat, P, [ Control ]) ];
[ [ Key (Press, Up, []) ];
Custom [ Key (Repeat, Up, []) ];
(fun () -> ]
TextBuffer.fold_string t.text (fun s -> [
let bol = Custom
Str.search_backward (Str.regexp "^") s (fun () ->
t.cursor.index TextBuffer.fold_string t.text (fun s ->
in let sbol =
let eol = Str.search_backward (Str.regexp "^") s
Str.search_forward (Str.regexp "$") s in
t.cursor.index let bol = sbol t.cursor.index in
in if bol > 0 then (
t.cursor <- let prev_bol = sbol (max 0 (bol - 1)) in
TextLayout.cursor ~last_col:(eol - bol) eol)); let prev_line_len = bol - 1 - prev_bol in
] F.epr
|> adds (* BOL *) "up: index=%d bol=%d prev_bol=%d \
[ prev_line_len=%d @."
[ Key (Press, A, [ Control ]) ]; t.cursor.index bol prev_bol prev_line_len;
[ Key (Press, Home, []) ]; t.cursor <-
] {
[ t.cursor with
Custom index =
(fun () -> (prev_bol
TextBuffer.fold_string t.text (fun s -> +
t.cursor <- if t.cursor.last_col > prev_line_len
TextLayout.cursor ~last_col:0 then prev_line_len
(Str.search_backward (Str.regexp "^") s else
t.cursor.index))); min prev_line_len t.cursor.last_col);
] })));
|> adds ]
[ |> adds (* EOL *)
[ Key (Press, Backspace, []) ]; [
[ Key (Repeat, Backspace, []) ]; [ Key (Press, E, [ Control ]) ];
] [ Key (Press, End, []) ];
[ ]
Custom [
(fun () -> Custom
match t.mark with (fun () ->
| Some mark -> TextBuffer.fold_string t.text (fun s ->
TextBuffer.remove t.text (mark, t.cursor.index) let bol =
>>= fun text -> Str.search_backward (Str.regexp "^") s
t.text <- text; t.cursor.index
t.mark <- None; in
cursor_set t (min mark t.cursor.index) let eol =
| None -> Str.search_forward (Str.regexp "$") s
if t.cursor.index > 0 then ( t.cursor.index
TextBuffer.remove_uchar t.text in
(t.cursor.index - 1) t.cursor <-
TextLayout.cursor ~last_col:(eol - bol) eol));
]
|> adds (* BOL *)
[
[ Key (Press, A, [ Control ]) ];
[ Key (Press, Home, []) ];
]
[
Custom
(fun () ->
TextBuffer.fold_string t.text (fun s ->
t.cursor <-
TextLayout.cursor ~last_col:0
(Str.search_backward (Str.regexp "^") s
t.cursor.index)));
]
|> adds
[
[ Key (Press, Backspace, []) ];
[ Key (Repeat, Backspace, []) ];
]
[
Custom
(fun () ->
match t.mark with
| Some mark ->
TextBuffer.remove t.text (mark, t.cursor.index)
>>= fun text -> >>= fun text ->
t.text <- text; t.text <- text;
cursor_move t (-1)) t.mark <- None;
else Lwt.return_unit); cursor_set t (min mark t.cursor.index)
] | None ->
|> adds if t.cursor.index > 0 then (
[ [ Key (Press, K, [ Control ]) ] ] TextBuffer.remove_uchar t.text
[ (t.cursor.index - 1)
Custom >>= fun text ->
(fun () -> t.text <- text;
TextBuffer.fold_string t.text (fun s -> cursor_move t (-1))
TextBuffer.remove t.text else Lwt.return_unit);
( t.cursor.index, ]
Str.search_forward (Str.regexp "$") s |> adds
t.cursor.index ) [ [ Key (Press, K, [ Control ]) ] ]
>>= fun text -> [
t.text <- text; Custom
t.mark <- None; (fun () ->
cursor_set t t.cursor.index) TextBuffer.fold_string t.text (fun s ->
>>= fun u -> u); TextBuffer.remove t.text
] ( t.cursor.index,
|> adds Str.search_forward (Str.regexp "$") s
[ [ Key (Press, Enter, []) ]; [ Key (Repeat, Enter, []) ] ] t.cursor.index )
[ >>= fun text ->
Custom t.text <- text;
(fun () -> t.mark <- None;
TextBuffer.insert_uchar t.text t.cursor.index cursor_set t t.cursor.index)
(Uchar.of_char '\n') >>= fun u -> u);
>>= fun text -> ]
t.text <- text; |> adds
cursor_move t 1); [
] [ Key (Press, Enter, []) ]; [ Key (Repeat, Enter, []) ];
|> adds ]
[ [ Key (Press, Space, [ Control ]) ] ] (* Mark set *) [
[ Custom
Custom (fun () ->
(fun () -> TextBuffer.insert_uchar t.text t.cursor.index
t.mark <- (Uchar.of_char '\n')
(match t.mark with >>= fun text ->
| Some _ -> None t.text <- text;
| None -> Some t.cursor.index); cursor_move t 1);
Lwt.return_unit); ]
]; |> adds
[ [ Key (Press, Space, [ Control ]) ] ] (* Mark set *)
[
Custom
(fun () ->
t.mark <-
(match t.mark with
| 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 *) (* WARN XXX TKTK TODO this is probably "breaking" the lwt context and being used in other calls to Lwt_main.run *)
(Ui.chrcallback_ref := (Ui.chrcallback_ref :=
fun c -> fun c ->
@ -964,7 +975,7 @@ module TextEdit = struct
>>= fun () -> !Ui.chrcallback_ref c *)); >>= fun () -> !Ui.chrcallback_ref c *));
Lwt.return_unit Lwt.return_unit
let multiline ui ?(text_format = TextLayout.text_format_default) let multiline ui ?(text_format = TextLayout.format_default)
(text : TextBuffer.t) : t = (text : TextBuffer.t) : t =
let t = let t =
{ {
@ -990,75 +1001,8 @@ module TextEdit = struct
(* return_key = keyboard_shortcut; *) (* return_key = keyboard_shortcut; *)
} }
in in
Lwt_main.run (add_bindings t ui); Lwt_main.run (default_bindings t ui);
t 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 end
module Layout = struct module Layout = struct
@ -1177,7 +1121,7 @@ module Painter = struct
stroke t); stroke t);
fill 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 = let font_name, font_size =
match format.font_id with match format.font_id with
| Default -> ("mono", 18.) | Default -> ("mono", 18.)

40
oplevel.ml
View File

@ -70,8 +70,8 @@ let () =
(* Thread which is woken up when the main window is closed. *) (* Thread which is woken up when the main window is closed. *)
let _waiter, _wakener = Lwt.wait () in let _waiter, _wakener = Lwt.wait () in
(* F.pr "oplevel.ml: Toploop.initialize_toplevel_env@."; F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
Toploop.initialize_toplevel_env (); *) Toploop.initialize_toplevel_env ();
let rootrepo = let rootrepo =
Store.init_default Store.init_default
(F.str "%s/console/rootstore.git" Secrets.giturl) (F.str "%s/console/rootstore.git" Secrets.giturl)
@ -100,20 +100,30 @@ let () =
F.pr "oplevel.ml: building initial page@."; F.pr "oplevel.ml: building initial page@.";
let page = let page =
Layout.( ref
vbox Layout.(
[ vbox
textedit [
(TextEdit.multiline ui textedit
(TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo)); (TextEdit.multiline ui
textedit (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo));
(TextEdit.multiline ui textedit
(TextBuffer.of_repo (TextEdit.multiline ui
~path:[ ".config"; "init.ml" ] (TextBuffer.of_repo
~repo:rootrepo)); ~path:[ ".config"; "init.ml" ]
]) ~repo:rootrepo));
])
in 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@."; F.pr "oplevel.ml: entering drawing loop@.";
let period_min = 1.0 /. 30. in let period_min = 1.0 /. 30. in
let t = GLFW.getTime () |> ref in let t = GLFW.getTime () |> ref in
@ -149,7 +159,7 @@ let () =
Perfgraph.render graph ctx (width -. 205.) 5.; Perfgraph.render graph ctx (width -. 205.) 5.;
(* F.epr "box=%a@." Gg.Box2.pp box; (* F.epr "box=%a@." Gg.Box2.pp box;
F.epr "Painter.layout=%a@." Gg.Box2.pp *) 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; *) (* Demo.render_demo ctx mx my win_w win_h now !blowup data; *)
Gv.end_frame ctx; Gv.end_frame ctx;