This commit is contained in:
cqc
2024-05-13 21:16:08 -05:00
parent c0645cbdad
commit dcf34873a4

60
ogui.ml
View File

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