This commit is contained in:
cqc
2024-05-10 20:52:25 -05:00
parent 366364c9b2
commit 2fdc9b0397
3 changed files with 35 additions and 14 deletions

View File

@ -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.(

31
ogui.ml
View File

@ -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 =
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 =
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 @."
(Lwt_main.run (TextBuffer.length g.job.text))
(Array.length g.rows);
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; *)
TextBuffer.contents g.job.text >>= fun contents ->
let contents_len = String.length contents in
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 =
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);

View File

@ -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