This commit is contained in:
cqc
2024-05-14 22:42:58 -05:00
parent 8ccef92056
commit 51dd25deee
2 changed files with 21 additions and 15 deletions

26
ogui.ml
View File

@ -5,7 +5,7 @@ module Str = Re.Str
type stroke = { width : float; color : Gv.Color.t } type stroke = { width : float; color : Gv.Color.t }
let debugsec = ref false let debuglayout = ref false
let stroke_none = { width = 0.; color = Gv.Color.transparent } let stroke_none = { width = 0.; color = Gv.Color.transparent }
let pp_text_row : Gv.Text.text_row F.t = let pp_text_row : Gv.Text.text_row F.t =
@ -23,7 +23,7 @@ let pp_text_row : Gv.Text.text_row F.t =
let pp_color : Gv.Color.t Fmt.t = let pp_color : Gv.Color.t Fmt.t =
F.( F.(
hbox hbox
@@ record @@ record ~sep:sp
[ [
field "r" (fun (s : Gv.Color.t) -> s.r) float; field "r" (fun (s : Gv.Color.t) -> s.r) float;
field "g" (fun (s : Gv.Color.t) -> s.g) float; field "g" (fun (s : Gv.Color.t) -> s.g) float;
@ -485,7 +485,7 @@ module TextLayout = struct
wrap = default_text_wrapping (); wrap = default_text_wrapping ();
halign = Min; halign = Min;
justify = false; justify = false;
line_height = Some 18.; line_height = Some 20.;
} }
let pp_text_row : Format.formatter -> Gv.Text.text_row -> unit = let pp_text_row : Format.formatter -> Gv.Text.text_row -> unit =
@ -537,7 +537,7 @@ module TextLayout = struct
List.fold_left List.fold_left
(fun (l : section list) sec -> (fun (l : section list) sec ->
let s, e = sec.byte_range in let s, e = sec.byte_range in
if !debugsec then if !debuglayout then
F.epr "with_range section cs=%d ce=%d s=%d e=%d@." cs ce F.epr "with_range section cs=%d ce=%d s=%d e=%d@." cs ce
s e; s e;
@ -574,7 +574,7 @@ module TextLayout = struct
let with_cursor (cur : cursor) ?(format = default_cursor_formatter) let with_cursor (cur : cursor) ?(format = default_cursor_formatter)
layout : layout = layout : layout =
let c = with_range (cur.index, cur.index + 1) ~format layout in let c = with_range (cur.index, cur.index + 1) ~format layout in
if !debugsec then if !debuglayout then
F.epr "with_cursor %a@." F.epr "with_cursor %a@."
F.(brackets @@ list ~sep:cut pp_section) F.(brackets @@ list ~sep:cut pp_section)
c.sections; c.sections;
@ -631,7 +631,8 @@ module Style = struct
spacing = spacing =
{ {
item_spacing = Size2.v 10. 10.; item_spacing = Size2.v 10. 10.;
window_margin = Margin.symmetric 5. 5.; window_margin =
Margin.{ (symmetric 5. 5.) with bottom = 0. };
indent = 5.; indent = 5.;
slider_width = 5.; slider_width = 5.;
text_edit_width = 500.; text_edit_width = 500.;
@ -826,7 +827,7 @@ module TextEdit = struct
(String.length s) t.cursor.index t.scroll (String.length s) t.cursor.index t.scroll
(cursor.index - t.scroll) (cursor.index - t.scroll)
rows; rows;
debugsec := true) debuglayout := true)
let cursor_update (t : t) (f : int -> int) : unit Lwt.t = let cursor_update (t : t) (f : int -> int) : unit Lwt.t =
col t >>= fun last_col -> col t >>= fun last_col ->
@ -1172,7 +1173,7 @@ module Painter = struct
Option.value ~default:(Gv.Text.metrics t).line_height Option.value ~default:(Gv.Text.metrics t).line_height
g.line_height g.line_height
in in
let max_rows = Int.of_float (Box2.h rect /. line_height) in let max_rows = Int.of_float (Box2.h rect /. line_height) + 1 in
te.rows <- max_rows; te.rows <- max_rows;
let lines = Gv.Text.make_empty_rows max_rows in let lines = Gv.Text.make_empty_rows max_rows in
TextBuffer.contents g.text >>= fun contents -> TextBuffer.contents g.text >>= fun contents ->
@ -1183,11 +1184,10 @@ module Painter = struct
in in
Seq.fold_left Seq.fold_left
(fun ((cur, start) : p2 * int) (row : Gv.Text.text_row) -> (fun ((cur, start) : p2 * int) (row : Gv.Text.text_row) ->
if !debugsec then if !debuglayout then
F.epr "start=%d row=%a %a @." start pp_text_row row F.epr "start=%d row=%a %a @." start pp_text_row row
F.(brackets @@ list TextLayout.pp_section) F.(brackets @@ list TextLayout.pp_section)
g.sections; g.sections;
debugsec := false;
let sections = let sections =
List.filter List.filter
(fun (r : TextLayout.section) -> (fun (r : TextLayout.section) ->
@ -1242,6 +1242,7 @@ module Painter = struct
let rec layout (box : box2) (ui : Ui.t) (frame : frame) : box2 Lwt.t let rec layout (box : box2) (ui : Ui.t) (frame : frame) : box2 Lwt.t
= =
let box' = Margin.inner frame.style.margin box in let box' = Margin.inner frame.style.margin box in
if !debuglayout then F.epr "layout box'=%a@." Gg.Box2.pp box';
(match frame.t with (match frame.t with
| `Box (dir, ll) -> | `Box (dir, ll) ->
Lwt_list.fold_left_s Lwt_list.fold_left_s
@ -1269,4 +1270,9 @@ module Painter = struct
let r' = Margin.outer frame.style.margin r in let r' = Margin.outer frame.style.margin r in
draw_box ui.gv ~box:r' ~style:frame.style; draw_box ui.gv ~box:r' ~style:frame.style;
Lwt.return r' Lwt.return r'
let layout a b c =
let r = layout a b c in
debuglayout := false;
r
end end

View File

@ -103,6 +103,8 @@ let () =
ref ref
Layout.( Layout.(
vbox vbox
~style:
Style.{ default with margin = Margin.symmetric 10.0 10.0 }
[ [
textedit textedit
(TextEdit.multiline ui (TextEdit.multiline ui
@ -153,12 +155,10 @@ let () =
Gl.enable Gl.cull_face_enum; Gl.enable Gl.cull_face_enum;
Gl.disable Gl.depth_test; Gl.disable Gl.depth_test;
let width, height = let width, height = (float win_w, float win_h) in
( float win_w, let box =
float (win_h - 50) Gg.(Box2.v V2.zero Size2.(v width (height -. 20.)))
(* TKTK might be an artifact of exwm or something *) )
in in
let box = Gg.(Box2.v V2.zero Size2.(v width height)) in
Gv.begin_frame ctx ~width ~height ~device_ratio:1.; Gv.begin_frame ctx ~width ~height ~device_ratio:1.;
Perfgraph.render graph ctx (width -. 205.) 5.; Perfgraph.render graph ctx (width -. 205.) 5.;
(* F.epr "box=%a@." Gg.Box2.pp box; (* F.epr "box=%a@." Gg.Box2.pp box;