This commit is contained in:
cqc
2024-05-12 16:35:35 -05:00
parent 46a08e011f
commit 5c507f69e1
3 changed files with 48 additions and 73 deletions

106
ogui.ml
View File

@ -281,35 +281,9 @@ module Event = struct
match e with match e with
| Key (a, k, m) -> | Key (a, k, m) ->
F.pf ppf "Key %a, %a, %a" pp_key_action a pp_key k pp_mods m F.pf ppf "Key %a, %a, %a" pp_key_action a pp_key k pp_mods m
(* | Char u -> F.pf ppf "Char %a" pp_uchar u
| AnyChar -> F.pf ppf "AnyChar" *)
end end
type event = Event.event type event = Event.event
type id = int
module Response = struct
type 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 module Align = struct
open Gg open Gg
@ -667,10 +641,6 @@ module Ui = struct
let id = ref 0 let id = ref 0
let spacing ui = ui.style.spacing let spacing ui = ui.style.spacing
let allocate_space (_gv : Gv.t) (size : Gg.box2) : id * Gg.box2 =
id := !id + 1;
(!id, size)
let window gv ?(window : GLFW.window option) rect : t = let window gv ?(window : GLFW.window option) rect : t =
{ {
rect; rect;
@ -721,6 +691,37 @@ module Ui = struct
let chrcallback _t (chr : int) : unit Lwt.t = let chrcallback _t (chr : int) : unit Lwt.t =
!chrcallback_ref @@ Uchar.of_int chr !chrcallback_ref @@ Uchar.of_int chr
module Style = struct
type t = {
stroke : float option * Gv.Color.t;
fill : Gv.Color.t;
margin : Margin.t;
}
let default =
{
stroke = (None, Gv.Color.transparent);
fill = Gv.Color.transparent;
margin = Margin.empty;
}
let pp ppf t =
F.pf ppf "%a"
F.(
record
[
field "stroke"
(fun t -> t.stroke)
(hbox
@@ pair ~sep:comma
(option ~none:(any "None") float)
pp_color);
field "fill" (fun t -> t.fill) pp_color;
field "margin" (fun t -> t.margin) Margin.pp;
])
t
end
end end
module TextEdit = struct module TextEdit = struct
@ -730,8 +731,6 @@ module TextEdit = struct
mutable text : TextBuffer.t; mutable text : TextBuffer.t;
mutable cursor : TextLayout.cursor; mutable cursor : TextLayout.cursor;
mutable mark : int option; mutable mark : int option;
id : id option;
id_source : id option;
text_format : TextLayout.format; text_format : TextLayout.format;
formatter : formatter :
(Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option; (Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option;
@ -932,8 +931,15 @@ module TextEdit = struct
TextBuffer.fold_string t.text (fun s -> TextBuffer.fold_string t.text (fun s ->
TextBuffer.remove t.text TextBuffer.remove t.text
( t.cursor.index, ( t.cursor.index,
let eol =
Str.search_forward (Str.regexp "$") s Str.search_forward (Str.regexp "$") s
t.cursor.index ) t.cursor.index
in
if
eol == t.cursor.index
&& String.length s > eol
then eol + 1
else eol )
>>= fun text -> >>= fun text ->
t.text <- text; t.text <- text;
t.mark <- None; t.mark <- None;
@ -982,8 +988,6 @@ module TextEdit = struct
text; text;
cursor = TextLayout.cursor 0; cursor = TextLayout.cursor 0;
mark = None; mark = None;
id = None;
id_source = None;
text_format; text_format;
formatter = None; formatter = None;
password = false; password = false;
@ -1007,37 +1011,7 @@ end
module Layout = struct module Layout = struct
open Gg open Gg
module Style = Ui.Style
module Style = struct
type t = {
stroke : float option * Gv.Color.t;
fill : Gv.Color.t;
margin : Margin.t;
}
let default =
{
stroke = (None, Gv.Color.transparent);
fill = Gv.Color.transparent;
margin = Margin.empty;
}
let pp ppf t =
F.pf ppf "%a"
F.(
record
[
field "stroke"
(fun t -> t.stroke)
(hbox
@@ pair ~sep:comma
(option ~none:(any "None") float)
pp_color);
field "fill" (fun t -> t.fill) pp_color;
field "margin" (fun t -> t.margin) Margin.pp;
])
t
end
type frame = { t : t; mutable size : size; style : Style.t } type frame = { t : t; mutable size : size; style : Style.t }

View File

@ -118,7 +118,7 @@ let () =
(let open GLFW in (let open GLFW in
let open Event in let open Event in
let open Ui in let open Ui in
update_bindings ui Ui.update_bindings ui
(adds (adds
[ [
[ Key (Press, X, [ Control ]); Key (Press, E, [ Control ]) ]; [ Key (Press, X, [ Control ]); Key (Press, E, [ Control ]) ];

View File

@ -21,8 +21,9 @@ let init_default upstream_url : Sync.db Lwt.t =
S.Repo.v (Irmin_git.Conf.init "../rootstore") >>= fun repo -> S.Repo.v (Irmin_git.Conf.init "../rootstore") >>= fun repo ->
S.of_branch repo "lablgtk" >>= fun t -> S.of_branch repo "lablgtk" >>= fun t ->
S.remote upstream_url >>= fun upstream -> S.remote upstream_url >>= fun upstream ->
(try Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return_unit (* (try Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return_unit
with Invalid_argument a -> with Invalid_argument a ->
F.epr "Sync.pull_exn raised Invalid_argument(%s)" a; F.epr "Sync.pull_exn raised Invalid_argument(%s)" a;
Lwt.return_unit) Lwt.return_unit)
>>= fun () -> Lwt.return t >>= fun () -> *)
Lwt.return t