From 2fdc9b0397fcf7b75bb54b1f93535dbeb5a508e9 Mon Sep 17 00:00:00 2001 From: cqc Date: Fri, 10 May 2024 20:52:25 -0500 Subject: [PATCH] stuff --- glfw_types.ml | 2 +- ogui.ml | 41 +++++++++++++++++++++++++++++------------ store.ml | 6 +++++- 3 files changed, 35 insertions(+), 14 deletions(-) diff --git a/glfw_types.ml b/glfw_types.ml index 1e1d582..59a85ac 100644 --- a/glfw_types.ml +++ b/glfw_types.ml @@ -1,7 +1,7 @@ open GLFW module F = Fmt -let pp_key : GLFW.key F.t = +let pp_key : key F.t = fun ppf k -> F.pf ppf GLFW.( diff --git a/ogui.ml b/ogui.ml index 822d7d4..ef23fb8 100644 --- a/ogui.ml +++ b/ogui.ml @@ -730,8 +730,8 @@ module TextLayout = struct else []) @ if - ce >= s - && ce < e (* if cursor end is in this section *) + ce > s + && ce <= e (* if cursor end is in this section *) then [ { sec with byte_range = (ce, e) } ] else []) [] @@ -741,7 +741,10 @@ module TextLayout = struct let with_cursor (cur : cursor) ?(cursor_format = default_cursor_formatter) layout_job : layout_job = - with_range (cur.index, cur.index + 1) ~cursor_format layout_job + let c = + with_range (cur.index, cur.index + 1) ~cursor_format layout_job + in + c let with_mark (mark : int option) (cur : int) ?(cursor_format = default_mark_formatter) layout_job : @@ -1333,15 +1336,14 @@ module Painter = struct open Gg let paint_galley (t : Gv.t) (g : TextLayout.galley) : box2 Lwt.t = - (* F.epr - "Painter.galley (String.length g.job.text)=%d (Array.length \ - g.rows)=%d @." - (Lwt_main.run (TextBuffer.length g.job.text)) - (Array.length g.rows); - F.epr "g.job=%a@." TextLayout.pp_layout_job g.job; - F.epr "g.rows=%a@." F.(braces (array TextLayout.pp_row)) g.rows; *) TextBuffer.contents g.job.text >>= fun contents -> let contents_len = String.length contents in + (*F.epr + "Painter.galley (String.length g.job.text)=%d (Array.length \ + g.rows)=%d @." + contents_len (Array.length g.rows); + F.epr "g.job=%a@." TextLayout.pp_layout_job g.job; + F.epr "g.rows=%a@." F.(braces (array TextLayout.pp_row)) g.rows; *) g.rows |> Array.fold_left (fun (br : box2) (row : TextLayout.row) -> @@ -1357,6 +1359,9 @@ module Painter = struct in assert (List.length sections > 0); + (*F.epr "paint_galley sections:%a@." + F.(list TextLayout.pp_layout_section) + sections; *) ignore (List.fold_left (fun x (sec : TextLayout.layout_section) -> @@ -1370,7 +1375,6 @@ module Painter = struct (min (snd sec.byte_range) row.text_row.end_index)) ) in - let font_name, font_size = match sec.format.font_id with | Default -> ("mono", 18.) @@ -1382,15 +1386,28 @@ 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 ~y:0. ~start ~end_ contents + if start == row.text_row.end_index then + (* hack to display cursor at end of row *) + Gv.Text.bounds t ~x ~y:0. " " + else + Gv.Text.bounds t ~x ~y:0. ~start ~end_ contents in + Path.begin_ t; Path.rect t ~x ~y:(Box2.miny row.rect) ~w:bounds.advance ~h:metrics.line_height; set_fill_color t ~color:sec.format.background; + set_stroke_color t + ~color:(Gv.Color.rgbf ~r:0.9 ~g:0.2 ~b:0.2); + set_stroke_width t ~width:2.0; fill t; + (* stroke t; *) set_fill_color t ~color:sec.format.color; + (*F.epr "paint_galley row=%d:%d %d:%d %S@." + row.text_row.start_index row.text_row.end_index + start end_ + (String.sub contents start (end_ - start)); *) Text.text_w t ~x ~y:(Box2.miny row.rect) ~start ~end_ contents) (Box2.minx row.rect) sections); diff --git a/store.ml b/store.ml index 5193b6c..caf081a 100644 --- a/store.ml +++ b/store.ml @@ -21,4 +21,8 @@ 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 -> - Sync.pull_exn t upstream `Set >>= 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