From dcf34873a4879ea1769c975ac3a48516724acd8c Mon Sep 17 00:00:00 2001 From: cqc Date: Mon, 13 May 2024 21:16:08 -0500 Subject: [PATCH] better --- ogui.ml | 60 +++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 37 insertions(+), 23 deletions(-) diff --git a/ogui.ml b/ogui.ml index e48e2d3..e382f4d 100644 --- a/ogui.ml +++ b/ogui.ml @@ -7,6 +7,29 @@ type stroke = { width : float; color : Gv.Color.t } let stroke_none = { width = 0.; color = Gv.Color.transparent } +let pp_text_row : Gv.Text.text_row F.t = + F.( + record + [ + field "start_index" (fun r -> Gv.Text.(r.start_index)) int; + field "end_index" (fun r -> Gv.Text.(r.end_index)) int; + field "width" (fun r -> Gv.Text.(r.width)) float; + field "minx" (fun r -> Gv.Text.(r.minx)) float; + field "maxx" (fun r -> Gv.Text.(r.maxx)) float; + field "next" (fun r -> Gv.Text.(r.next)) int; + ]) + +let pp_color : Gv.Color.t Fmt.t = + F.( + hbox + @@ record + [ + field "r" (fun (s : Gv.Color.t) -> s.r) float; + field "g" (fun (s : Gv.Color.t) -> s.g) float; + field "b" (fun (s : Gv.Color.t) -> s.b) float; + field "a" (fun (s : Gv.Color.t) -> s.a) float; + ]) + module Margin = struct open Gg @@ -337,17 +360,6 @@ module Fonts = struct (Gv.Text.find_font gv ~name) end -let pp_color : Gv.Color.t Fmt.t = - F.( - hbox - @@ record - [ - field "r" (fun (s : Gv.Color.t) -> s.r) float; - field "g" (fun (s : Gv.Color.t) -> s.g) float; - field "b" (fun (s : Gv.Color.t) -> s.b) float; - field "a" (fun (s : Gv.Color.t) -> s.a) float; - ]) - module TextLayout = struct open Gg @@ -1140,30 +1152,30 @@ module Painter = struct ~lines contents in Seq.fold_left - (fun (cur : p2) (row : Gv.Text.text_row) -> + (fun ((cur, next) : p2 * int) (row : Gv.Text.text_row) -> + F.epr "text_layout row=%a@." pp_text_row row; let sections = List.filter (fun (r : TextLayout.section) -> fst r.byte_range <= row.end_index - && snd r.byte_range > row.start_index) + && snd r.byte_range > next) g.sections in List.fold_left (fun (cur' : p2) (sec : TextLayout.section) -> let start, end_ = - ( row.start_index - |> max (fst sec.byte_range) - |> min contents_len, + ( next |> max (fst sec.byte_range) |> min contents_len, row.end_index |> min contents_len |> min (snd sec.byte_range) ) in - let bounds = + let width = if start == row.end_index then (* hack to display cursor at end of row *) - Gv.Text.bounds t ~x:(P2.x cur') ~y:0. " " + (Gv.Text.bounds t ~x:(P2.x cur') ~y:0. " ").advance else - Gv.Text.bounds t ~x:(P2.x cur') ~y:0. ~start ~end_ - contents + (Gv.Text.bounds t ~x:(P2.x cur') ~y:0. ~start ~end_ + contents) + .advance in let line_height = Option.value ~default:(Gv.Text.metrics t).line_height @@ -1173,7 +1185,7 @@ module Painter = struct ~box: (Box2.v (V2.v (P2.x cur') (P2.y cur)) - (V2.v bounds.advance line_height)) + (V2.v width line_height)) ~style: Layout.Style. { default with fill = sec.format.background }; @@ -1185,9 +1197,11 @@ module Painter = struct Float.(max (P2.y cur +. line_height) (P2.y cur'))) P2.(v (Box2.minx rect) (y cur)) sections - |> fun cur'' -> V2.(v (max (x cur) (x cur'')) (y cur''))) - (Box2.o rect) + |> fun cur'' -> + (V2.(v (max (x cur) (x cur'')) (y cur'')), row.next)) + (Box2.o rect, 0) (Seq.take row_count (Array.to_seq lines)) + |> fst |> Box2.(of_pts (o rect)) |> Lwt.return