better
This commit is contained in:
60
ogui.ml
60
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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user