Compare commits
2 Commits
dcf34873a4
...
51dd25deee
| Author | SHA1 | Date | |
|---|---|---|---|
| 51dd25deee | |||
| 8ccef92056 |
94
ogui.ml
94
ogui.ml
@ -5,6 +5,7 @@ module Str = Re.Str
|
|||||||
|
|
||||||
type stroke = { width : float; color : Gv.Color.t }
|
type stroke = { width : float; color : Gv.Color.t }
|
||||||
|
|
||||||
|
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 =
|
||||||
@ -22,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;
|
||||||
@ -456,7 +457,7 @@ module TextLayout = struct
|
|||||||
field "byte_range"
|
field "byte_range"
|
||||||
(fun s -> s.byte_range)
|
(fun s -> s.byte_range)
|
||||||
(pair ~sep:(any ",") int int);
|
(pair ~sep:(any ",") int int);
|
||||||
field "format" (fun s -> s.format) pp_format;
|
(* field "format" (fun s -> s.format) pp_format; *)
|
||||||
])
|
])
|
||||||
|
|
||||||
let section_default =
|
let section_default =
|
||||||
@ -484,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 =
|
||||||
@ -536,6 +537,9 @@ 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 !debuglayout then
|
||||||
|
F.epr "with_range section cs=%d ce=%d s=%d e=%d@." cs ce
|
||||||
|
s e;
|
||||||
|
|
||||||
l
|
l
|
||||||
@ (if
|
@ (if
|
||||||
@ -570,6 +574,10 @@ 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 !debuglayout then
|
||||||
|
F.epr "with_cursor %a@."
|
||||||
|
F.(brackets @@ list ~sep:cut pp_section)
|
||||||
|
c.sections;
|
||||||
c
|
c
|
||||||
|
|
||||||
let with_mark (mark : int option) (cur : int)
|
let with_mark (mark : int option) (cur : int)
|
||||||
@ -623,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.;
|
||||||
@ -776,27 +785,49 @@ module TextEdit = struct
|
|||||||
| Some start' ->
|
| Some start' ->
|
||||||
if rows - 1 > 0 then index_rows_from s (start' + 1) (rows - 1)
|
if rows - 1 > 0 then index_rows_from s (start' + 1) (rows - 1)
|
||||||
else Some (start' + 1)
|
else Some (start' + 1)
|
||||||
| None -> None
|
| None -> None (* eof *)
|
||||||
|
|
||||||
|
let rec rindex_rows_from (s : string) (start : int) (rows : int) :
|
||||||
|
int option =
|
||||||
|
match String.rindex_from_opt s start '\n' with
|
||||||
|
| Some start' ->
|
||||||
|
if start' - 1 <= 0 then None
|
||||||
|
else if rows - 1 > 0 then
|
||||||
|
rindex_rows_from s (start' - 1) (rows - 1)
|
||||||
|
else Some (start' + 1)
|
||||||
|
| None -> None (* eof *)
|
||||||
|
|
||||||
let scroll_update ({ text; cursor; scroll; rows; _ } as t : t) :
|
let scroll_update ({ text; cursor; scroll; rows; _ } as t : t) :
|
||||||
unit Lwt.t =
|
unit Lwt.t =
|
||||||
F.epr "scroll_update cursor=%d scroll=%d rows=%d" cursor.index
|
|
||||||
scroll rows;
|
|
||||||
TextBuffer.fold_string text (fun s ->
|
TextBuffer.fold_string text (fun s ->
|
||||||
|
let slen = String.length s in
|
||||||
(if cursor.index < scroll then
|
(if cursor.index < scroll then
|
||||||
match String.rindex_from_opt s cursor.index '\n' with
|
match
|
||||||
|
String.rindex_from_opt s
|
||||||
|
(min (slen - 1) (cursor.index - 1))
|
||||||
|
'\n'
|
||||||
|
with
|
||||||
| Some i' -> t.scroll <- i' + 1
|
| Some i' -> t.scroll <- i' + 1
|
||||||
| None -> t.scroll <- 0
|
| None -> t.scroll <- 0
|
||||||
else
|
else
|
||||||
match index_rows_from s scroll rows with
|
match index_rows_from s scroll rows with
|
||||||
| None -> (* eof *) ()
|
|
||||||
| Some eow -> (
|
|
||||||
F.epr " eow=%d" eow;
|
|
||||||
if cursor.index > eow then
|
|
||||||
match String.index_from_opt s cursor.index '\n' with
|
|
||||||
| None -> ()
|
| None -> ()
|
||||||
| Some i' -> t.scroll <- i' + 1));
|
| Some eow -> (
|
||||||
F.epr "@.")
|
F.epr "eow=%d@." eow;
|
||||||
|
if cursor.index >= eow then
|
||||||
|
match
|
||||||
|
rindex_rows_from s
|
||||||
|
(min (slen - 1) cursor.index)
|
||||||
|
rows
|
||||||
|
with
|
||||||
|
| None -> ()
|
||||||
|
| Some i' -> t.scroll <- i'));
|
||||||
|
F.epr
|
||||||
|
"scroll_update slen=%d cursor=%d scroll=%d c-s=%d rows=%d@."
|
||||||
|
(String.length s) t.cursor.index t.scroll
|
||||||
|
(cursor.index - t.scroll)
|
||||||
|
rows;
|
||||||
|
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 ->
|
||||||
@ -877,19 +908,19 @@ module TextEdit = struct
|
|||||||
Str.search_backward (Str.regexp "^") s
|
Str.search_backward (Str.regexp "^") s
|
||||||
in
|
in
|
||||||
let bol = sbol t.cursor.index in
|
let bol = sbol t.cursor.index in
|
||||||
if bol > 0 then (
|
if bol > 0 then
|
||||||
let prev_bol = sbol (max 0 (bol - 1)) in
|
let prev_bol = sbol (max 0 (bol - 1)) in
|
||||||
let prev_line_len = bol - 1 - prev_bol in
|
let prev_line_len = bol - 1 - prev_bol in
|
||||||
F.epr
|
|
||||||
|
(*F.epr
|
||||||
"up: index=%d bol=%d prev_bol=%d \
|
"up: index=%d bol=%d prev_bol=%d \
|
||||||
prev_line_len=%d @."
|
prev_line_len=%d @."
|
||||||
t.cursor.index bol prev_bol prev_line_len;
|
t.cursor.index bol prev_bol prev_line_len; *)
|
||||||
|
|
||||||
prev_bol
|
prev_bol
|
||||||
+
|
+
|
||||||
if t.cursor.last_col > prev_line_len then
|
if t.cursor.last_col > prev_line_len then
|
||||||
prev_line_len
|
prev_line_len
|
||||||
else min prev_line_len t.cursor.last_col)
|
else min prev_line_len t.cursor.last_col
|
||||||
else t.cursor.index)
|
else t.cursor.index)
|
||||||
>>= cursor_set t);
|
>>= cursor_set t);
|
||||||
]
|
]
|
||||||
@ -1142,29 +1173,32 @@ 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 ->
|
||||||
let contents_len = String.length contents in
|
let contents_len = String.length contents in
|
||||||
let row_count =
|
let row_count =
|
||||||
Gv.Text.break_lines t ~break_width:(Box2.w rect) ~max_rows
|
Gv.Text.break_lines t ~break_width:(Box2.w rect) ~max_rows
|
||||||
~lines contents
|
~lines ~start:te.scroll contents
|
||||||
in
|
in
|
||||||
Seq.fold_left
|
Seq.fold_left
|
||||||
(fun ((cur, next) : p2 * int) (row : Gv.Text.text_row) ->
|
(fun ((cur, start) : p2 * int) (row : Gv.Text.text_row) ->
|
||||||
F.epr "text_layout row=%a@." pp_text_row row;
|
if !debuglayout then
|
||||||
|
F.epr "start=%d row=%a %a @." start pp_text_row row
|
||||||
|
F.(brackets @@ list TextLayout.pp_section)
|
||||||
|
g.sections;
|
||||||
let sections =
|
let sections =
|
||||||
List.filter
|
List.filter
|
||||||
(fun (r : TextLayout.section) ->
|
(fun (r : TextLayout.section) ->
|
||||||
fst r.byte_range <= row.end_index
|
fst r.byte_range <= row.end_index
|
||||||
&& snd r.byte_range > next)
|
&& snd r.byte_range > start)
|
||||||
g.sections
|
g.sections
|
||||||
in
|
in
|
||||||
List.fold_left
|
List.fold_left
|
||||||
(fun (cur' : p2) (sec : TextLayout.section) ->
|
(fun (cur' : p2) (sec : TextLayout.section) ->
|
||||||
let start, end_ =
|
let start, end_ =
|
||||||
( next |> max (fst sec.byte_range) |> min contents_len,
|
( start |> max (fst sec.byte_range) |> min contents_len,
|
||||||
row.end_index |> min contents_len
|
row.end_index |> min contents_len
|
||||||
|> min (snd sec.byte_range) )
|
|> min (snd sec.byte_range) )
|
||||||
in
|
in
|
||||||
@ -1199,7 +1233,7 @@ module Painter = struct
|
|||||||
sections
|
sections
|
||||||
|> fun cur'' ->
|
|> fun cur'' ->
|
||||||
(V2.(v (max (x cur) (x cur'')) (y cur'')), row.next))
|
(V2.(v (max (x cur) (x cur'')) (y cur'')), row.next))
|
||||||
(Box2.o rect, 0)
|
(Box2.o rect, te.scroll)
|
||||||
(Seq.take row_count (Array.to_seq lines))
|
(Seq.take row_count (Array.to_seq lines))
|
||||||
|> fst
|
|> fst
|
||||||
|> Box2.(of_pts (o rect))
|
|> Box2.(of_pts (o rect))
|
||||||
@ -1208,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
|
||||||
@ -1235,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
|
||||||
|
|||||||
10
oplevel.ml
10
oplevel.ml
@ -103,15 +103,17 @@ 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
|
||||||
(TextBuffer.of_repo
|
(TextBuffer.of_repo
|
||||||
~path:[ ".config"; "init.ml" ]
|
~path:[ ".config"; "init.ml" ]
|
||||||
~repo:rootrepo));
|
~repo:rootrepo));
|
||||||
textedit
|
(*textedit
|
||||||
(TextEdit.multiline ui
|
(TextEdit.multiline ui
|
||||||
(TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo));
|
(TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo)); *)
|
||||||
])
|
])
|
||||||
in
|
in
|
||||||
|
|
||||||
@ -154,7 +156,9 @@ let () =
|
|||||||
Gl.disable Gl.depth_test;
|
Gl.disable Gl.depth_test;
|
||||||
|
|
||||||
let width, height = (float win_w, float win_h) in
|
let width, height = (float win_w, float win_h) in
|
||||||
let box = Gg.(Box2.v V2.zero Size2.(v width height)) in
|
let box =
|
||||||
|
Gg.(Box2.v V2.zero Size2.(v width (height -. 20.)))
|
||||||
|
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;
|
||||||
|
|||||||
Reference in New Issue
Block a user