From 7473c66bee2dfd096422bd6efe72f27cf664a912 Mon Sep 17 00:00:00 2001 From: cqc Date: Sat, 11 May 2024 13:57:30 -0500 Subject: [PATCH] . --- ogui.ml | 289 +++++++++++++++++++++++++++++++++-------------------- oplevel.ml | 14 +-- 2 files changed, 190 insertions(+), 113 deletions(-) diff --git a/ogui.ml b/ogui.ml index ef23fb8..fcc4b0d 100644 --- a/ogui.ml +++ b/ogui.ml @@ -17,6 +17,7 @@ module Margin = struct bottom : size1; } + let empty = { left = 0.; right = 0.; top = 0.; bottom = 0. } let symmetric h w = { left = w; right = w; top = h; bottom = h } let sum t : size2 = Size2.v (t.left +. t.right) (t.top +. t.bottom) @@ -24,6 +25,15 @@ module Margin = struct Box2.v (V2.v (Box2.minx b +. t.left) (Box2.miny b +. t.top)) (V2.v (Box2.maxx b -. t.right) (Box2.maxy b -. t.bottom)) + + let outer t b = + Box2.( + v + (V2.v (minx b -. t.left) (miny b -. t.top)) + (V2.v (maxx b +. t.right) (maxy b +. t.bottom))) + + let pp ppf t = + F.pf ppf "l=%f@;r=%f@;t=%f@;b=%f" t.left t.right t.top t.bottom end type margin = Margin.t @@ -1296,7 +1306,38 @@ end module Layout = struct open Gg - type frame = { t : t; mutable size : size } + module Style = struct + type t = { + stroke : float option * Gv.Color.t; + fill : Gv.Color.t; + margin : Margin.t; + } + + let default = + { + stroke = (None, Gv.Color.transparent); + fill = Gv.Color.transparent; + margin = Margin.empty; + } + + let pp ppf t = + F.pf ppf "%a" + F.( + record + [ + field "stroke" + (fun t -> t.stroke) + (hbox + @@ pair ~sep:comma + (option ~none:(any "None") float) + pp_color); + field "fill" (fun t -> t.fill) pp_color; + field "margin" (fun t -> t.margin) Margin.pp; + ]) + t + end + + type frame = { t : t; mutable size : size; style : Style.t } and t = [ `Box of [ `H | `V | `Z ] * frame list @@ -1305,23 +1346,52 @@ module Layout = struct | `TextEdit of TextEdit.t | `None ] - and size = - [ `Fixed of p2 | `Percent (* of container *) of p2 | `Auto ] + and size = [ `Fixed of size2 | `Max | `Min ] - let frame ?(size = `Auto) t : frame = { t; size } - let box d t = frame (`Box (d, t)) + let frame ?(size = `Max) ?(style = Style.default) t : frame = + { t; size; style } + + let box d ?style t = frame ?style (`Box (d, t)) let hbox, vbox, zbox = (box `H, box `V, box `Z) - let pp_t_frame ppf f = + let textedit_style = + Style. + { + default with + stroke = (Some 1.2, Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9); + margin = Margin.symmetric 10. 10.; + } + + let textedit ?size ?(style = textedit_style) te = + frame ?size ~style (`TextEdit te) + + let pp_dir ppf (t : [ `H | `V | `Z ]) = F.pf ppf "%s" - (match f with - | `Hbox -> "`Hbox" - | `Vbox -> "`Vbox" - | `Buffer -> "`Buffer" - | `TextEdit -> "`TextEdit" - | `S s -> F.str "%s" s + (match t with `H -> "`H" | `V -> "`V" | `Z -> "`Z") + + let pp_t ppf (t : t) = + F.pf ppf "%s" + (match t with + | `Box (d, _) -> F.str "`Box %a" pp_dir d + | `Buffer _ -> "`Buffer" + | `TextEdit _ -> "`TextEdit" + | `String s -> F.str "`String %s" s | `None -> "`None") + let pp_size ppf = function + | `Fixed p -> F.pf ppf "`Fixed %a" Gg.V2.pp p + | `Max -> F.pf ppf "`Max" + | `Min -> F.pf ppf "`Min" + + let pp_frame = + F.( + record + [ + field "t" (fun t -> t.t) pp_t; + field "size" (fun t -> t.size) pp_size; + field "style" (fun t -> t.style) Style.pp; + ]) + let parse_t_frame s = match s with | "`Box" -> `Vbox @@ -1335,105 +1405,104 @@ module Painter = struct open Layout open Gg + let draw_box (t : Gv.t) ~(box : Gg.box2) ~(style : Layout.Style.t) = + let open Gv in + let open Box2 in + Path.begin_ t; + Path.rect t ~x:(minx box) ~y:(miny box) ~w:(w box) ~h:(h box); + set_fill_color t ~color:style.fill; + set_stroke_color t ~color:(snd style.stroke); + (match style.stroke with + | None, _ -> () + | Some width, _ -> + set_stroke_width t ~width; + stroke t); + fill t + + let set_text_format (t : Gv.t) (format : TextLayout.text_format) = + let font_name, font_size = + match format.font_id with + | Default -> ("mono", 18.) + | FontId (s, size) -> (s, size) + in + let open Gv in + Text.set_font_face t ~name:font_name; + Text.set_size t ~size:font_size; + Text.set_align t ~align:Align.(left lor top) + 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 @." - 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; *) g.rows - |> Array.fold_left - (fun (br : box2) (row : TextLayout.row) -> - let sections = - List.filter - (fun (r : TextLayout.layout_section) -> - fst r.byte_range <= row.text_row.end_index - && snd r.byte_range > row.text_row.start_index) - (Array.to_list - @@ Array.sub g.job.sections row.section_index_at_start - (Array.length g.job.sections - - row.section_index_at_start)) - in - assert (List.length sections > 0); + |> ( Array.iter @@ fun (row : TextLayout.row) -> + let sections = + List.filter + (fun (r : TextLayout.layout_section) -> + fst r.byte_range <= row.text_row.end_index + && snd r.byte_range > row.text_row.start_index) + Array.( + to_list + @@ sub g.job.sections row.section_index_at_start + @@ (length g.job.sections - row.section_index_at_start)) + in + assert (List.length sections > 0); + let y = Box2.miny row.rect in + List.fold_left + (fun x (sec : TextLayout.layout_section) -> + let start, end_ = + Stdlib. + ( row.text_row.start_index + |> max (fst sec.byte_range) + |> min contents_len, + row.text_row.end_index |> min contents_len + |> min (snd sec.byte_range) ) + in + 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 - (*F.epr "paint_galley sections:%a@." - F.(list TextLayout.pp_layout_section) - sections; *) - ignore - (List.fold_left - (fun x (sec : TextLayout.layout_section) -> - let start, end_ = - ( min (contents_len - 1) - (max 0 - (max (fst sec.byte_range) - row.text_row.start_index)), - min (contents_len - 1) - (max 0 - (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.) - | FontId (s, size) -> (s, size) - in - let open Gv in - Text.set_font_face t ~name:font_name; - Text.set_size t ~size:font_size; - 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 + let line_height = + Option.value ~default:metrics.line_height + sec.format.line_height + 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; + draw_box t + ~box: + Box2.(v (V2.v x y) (V2.v bounds.advance line_height)) + ~style: + Layout.Style. + { default with fill = sec.format.background }; - (* 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); - Box2.(union br row.rect)) - Box2.empty - |> Lwt.return + set_text_format t sec.format; + Gv.set_fill_color t ~color:sec.format.color; + Gv.Text.text_w t ~x ~y ~start ~end_ contents) + (Box2.minx row.rect) sections + |> ignore ) + |> ignore; + Lwt.return g.rect let rec layout (box : box2) (ui : Ui.t) (frame : frame) : box2 Lwt.t = - match frame.t with + let box' = Margin.inner frame.style.margin box in + (match frame.t with | `Box (dir, ll) -> Lwt_list.fold_left_s - (fun (o : box2) f -> - layout - (match dir with - | `H -> - Box2.of_pts - V2.(v (Box2.minx o) (Box2.miny box)) - (Box2.br_pt o) - | `V -> - Box2.of_pts - V2.(v (Box2.minx box) (Box2.miny o)) - (Box2.br_pt o) - | `Z -> box) - ui f) - box ll + (fun (c : box2) f -> + layout c ui f >>= fun r -> + let c' = + let open Box2 in + match dir with + | `V -> Box2.of_pts (V2.v (minx c) (maxy r)) (max c) + | `H -> Box2.of_pts (V2.v (maxx r) (miny c)) (max c) + | `Z -> box + in + + Lwt.return c') + box' ll | `TextEdit t -> let font = match Gv.Text.find_font ui.gv ~name:"mono" with @@ -1442,15 +1511,21 @@ module Painter = struct in (if t.multiline then TextLayout.simple t.text ~format:t.text_format - (Option.value ~default:(Box2.w box) t.desired_width) + (Option.value ~default:(Box2.w box') t.desired_width) else TextLayout.singleline t.text t.text_format) >>= fun layout_job -> - Ui.fonts ui.gv (fun gv -> - TextLayout.layout gv font - (TextLayout.with_cursor t.cursor - (TextLayout.with_mark t.mark t.cursor.index - layout_job)) - (Box2.o box)) + Ui.fonts ui.gv + TextLayout.( + fun gv -> + (layout gv font + (with_cursor t.cursor + (with_mark t.mark t.cursor.index layout_job))) + (Box2.o box')) >>= fun galley -> paint_galley ui.gv galley - | _ -> Lwt.return box + | _ -> Lwt.return box) + >>= fun r -> + F.epr "@[layout@;box=%a@;box'=%a@;r=%a@;%a@]@." Box2.pp box + Box2.pp box' Box2.pp r pp_frame frame; + draw_box ui.gv ~box:r ~style:frame.style; + Lwt.return r end diff --git a/oplevel.ml b/oplevel.ml index 61b4b02..24e04b6 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -115,12 +115,14 @@ let () = Layout.( vbox [ - frame - (`TextEdit - (TextEdit.multiline ui - (TextBuffer.of_repo - ~path:[ "README" ] (*[ ".config"; "init.ml" ] *) - ~repo:rootrepo))); + textedit + (TextEdit.multiline ui + (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo)); + textedit + (TextEdit.multiline ui + (TextBuffer.of_repo + ~path:[ ".config"; "init.ml" ] + ~repo:rootrepo)); ]) in