From 5c507f69e1b43ba41cb71288c2656b3d0ffdbd41 Mon Sep 17 00:00:00 2001 From: cqc Date: Sun, 12 May 2024 16:35:35 -0500 Subject: [PATCH] moar --- ogui.ml | 108 ++++++++++++++++++++--------------------------------- oplevel.ml | 2 +- store.ml | 11 +++--- 3 files changed, 48 insertions(+), 73 deletions(-) diff --git a/ogui.ml b/ogui.ml index c3ddbe1..83606aa 100644 --- a/ogui.ml +++ b/ogui.ml @@ -281,35 +281,9 @@ module Event = struct match e with | Key (a, k, 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 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 open Gg @@ -667,10 +641,6 @@ module Ui = struct let id = ref 0 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 = { rect; @@ -721,6 +691,37 @@ module Ui = struct let chrcallback _t (chr : int) : unit Lwt.t = !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 module TextEdit = struct @@ -730,8 +731,6 @@ module TextEdit = struct mutable text : TextBuffer.t; mutable cursor : TextLayout.cursor; mutable mark : int option; - id : id option; - id_source : id option; text_format : TextLayout.format; formatter : (Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option; @@ -932,8 +931,15 @@ module TextEdit = struct TextBuffer.fold_string t.text (fun s -> TextBuffer.remove t.text ( t.cursor.index, - Str.search_forward (Str.regexp "$") s - t.cursor.index ) + let eol = + Str.search_forward (Str.regexp "$") s + t.cursor.index + in + if + eol == t.cursor.index + && String.length s > eol + then eol + 1 + else eol ) >>= fun text -> t.text <- text; t.mark <- None; @@ -982,8 +988,6 @@ module TextEdit = struct text; cursor = TextLayout.cursor 0; mark = None; - id = None; - id_source = None; text_format; formatter = None; password = false; @@ -1007,37 +1011,7 @@ end module Layout = struct open Gg - - 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 + module Style = Ui.Style type frame = { t : t; mutable size : size; style : Style.t } diff --git a/oplevel.ml b/oplevel.ml index 36a2182..f175ca8 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -118,7 +118,7 @@ let () = (let open GLFW in let open Event in let open Ui in - update_bindings ui + Ui.update_bindings ui (adds [ [ Key (Press, X, [ Control ]); Key (Press, E, [ Control ]) ]; diff --git a/store.ml b/store.ml index caf081a..7cb8d75 100644 --- a/store.ml +++ b/store.ml @@ -21,8 +21,9 @@ let init_default upstream_url : Sync.db Lwt.t = S.Repo.v (Irmin_git.Conf.init "../rootstore") >>= fun repo -> S.of_branch repo "lablgtk" >>= fun t -> S.remote upstream_url >>= fun upstream -> - (try Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return_unit - with Invalid_argument a -> - F.epr "Sync.pull_exn raised Invalid_argument(%s)" a; - Lwt.return_unit) - >>= fun () -> Lwt.return t + (* (try Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return_unit + with Invalid_argument a -> + F.epr "Sync.pull_exn raised Invalid_argument(%s)" a; + Lwt.return_unit) + >>= fun () -> *) + Lwt.return t