diff --git a/ogui.ml b/ogui.ml index bde8626..499ae03 100644 --- a/ogui.ml +++ b/ogui.ml @@ -241,13 +241,8 @@ end type event = Event.event type id = int -module Context = struct - type t = { derp : bool } -end - module Response = struct type t = { - ctx : Context.t; (* layer_id : LayerId.t; *) id : id; rect : Gg.box2; @@ -449,7 +444,7 @@ module TextLayout = struct int; field "sections" (fun s -> s.sections) - (array pp_layout_section); + (brackets @@ array pp_layout_section); field "wrap" (fun s -> s.wrap) pp_text_wrapping; field "first_row_min_height" (fun s -> s.first_row_min_height) @@ -626,30 +621,16 @@ module TextLayout = struct let cursor_default = { index = 0; row = None; prefer_next_row = false } - type cursor_range = cursor * cursor - type cursor_state = cursor_range option - - let cursor_index = ref 0 - let cursor_range c = ((fst c).index, (snd c).index) - - let new_cursor ?(loc = 0) () : cursor = - cursor_index := !cursor_index + 1; + let cursor loc : cursor = { index = loc; row = None; prefer_next_row = false } - let new_cursor_range (s, e) : cursor_range = - ( { cursor_default with index = s }, - { cursor_default with index = e } ) + let cursor_move amt max c : cursor = + cursor + (if c.index + amt < 0 then 0 + else if c.index + amt > max then max + else c.index + amt) - let cursor_state_update ~(f : int -> int -> int * int) - (c : cursor_state) : cursor_state = - match c with - | Some (a, b) -> - let a', b' = f a.index b.index in - F.epr "cursor_state_update %d %d@." a' b'; - Some (new_cursor_range (max a' 0, max b' 0)) - | None -> None - - let layout_job text ?(format = text_format_default) wrap_width : + let simple text ?(format = text_format_default) wrap_width : layout_job = { (default_layout_job ()) with @@ -666,48 +647,24 @@ module TextLayout = struct break_on_newline = true; } - let simple (text : TextBuffer.t) (format : text_format) wrap_width : + let singleline (text : TextBuffer.t) (format : text_format) : layout_job = { - (default_layout_job ()) with - text; - sections = - Array.make 1 - { - leading_space = 0.0; - byte_range = (0, Lwt_main.run (TextBuffer.length text)); - format; - }; - wrap = - { (default_text_wrapping ()) with max_width = wrap_width }; - break_on_newline = true; - } - - let simple_singleline (text : TextBuffer.t) (format : text_format) : - layout_job = - { - (default_layout_job ()) with - text; - sections = - Array.make 1 - { - leading_space = 0.0; - byte_range = (0, Lwt_main.run (TextBuffer.length text)); - format; - }; + (simple text ~format Float.infinity) with wrap = default_text_wrapping (); break_on_newline = true; } - let cursor_color = ref (Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.) + let cursor_color = ref (Gv.Color.rgbf ~r:0.5 ~g:0.5 ~b:0.) let default_cursor_formatter (f : text_format) = { f with background = !cursor_color } - let with_cursor (cur : cursor_range) + let with_cursor (cur : cursor) ?(cursor_format = default_cursor_formatter) layout_job : layout_job = - let cs, ce = ((fst cur).index, (snd cur).index) in + (* this is more like a general range application to layout sections, but i don't need it yet *) + let cs, ce = (cur.index, cur.index + 1) in { layout_job with sections = @@ -717,36 +674,36 @@ module TextLayout = struct (fun (l : layout_section list) sec -> let s, e = sec.byte_range in - if e < cs || ce < s then l @ [ sec ] - else - l - @ (if s = cs then - [ - { - sec with - byte_range = (s, if ce > e then e else ce); - format = cursor_format sec.format; - }; - ] - else if s < cs && cs <= e then - (* cursor start in section *) - [ - { sec with byte_range = (s, cs) }; - { - sec with - byte_range = (cs, if ce > e then e else ce); - format = cursor_format sec.format; - }; - ] - else if cs < s && e < ce then - [ - { sec with format = cursor_format sec.format }; - ] - else []) - @ - if ce > s && ce < e then - [ { sec with byte_range = (ce, e) } ] - else []) + l + @ (if + e < cs || ce < s + (* cursor start is after this section or cursor end is before this section *) + then [ sec ] + else []) + @ (if + cs > s + && cs + <= e (* if cursor start is in this section *) + then [ { sec with byte_range = (s, cs) } ] + else []) + @ (if + cs <= e && ce >= s + (* if cursor start is at or before the end this section and cursor end is at or after the beginning of this section *) + then + [ + { + sec with + format = cursor_format sec.format; + byte_range = (max cs s, min ce e); + }; + ] + else []) + @ + if + ce >= s + && ce < e (* if cursor end is in this section *) + then [ { sec with byte_range = (ce, e) } ] + else []) [] (Array.to_list layout_job.sections)); } @@ -829,80 +786,6 @@ let _ = assert (List.equal Int.equal (nth_tl 3 [ 0; 1; 2 ]) []); assert (List.equal Int.equal (nth_tl 0 [ 0; 1 ]) [ 0; 1 ]) -module Painter = struct - type t = Gv.t - - let galley (t : t) (g : TextLayout.galley) : unit = - (* F.epr - "Painter.galley (String.length g.job.text)=%d (Array.length \ - g.rows)=%d @." - (String.length g.job.text) - (Array.length g.rows); - F.epr "g.rect=%a@." Gg.Box2.pp g.rect; *) - - (* F.epr "g.rows=%a@." F.(braces (array TextLayout.pp_row)) g.rows;*) - 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 - @@ 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); - - ignore - Gg.( - List.fold_left - (fun x (sec : TextLayout.layout_section) -> - let start, end_ = - ( min - (Lwt_main.run (TextBuffer.length g.job.text) - 1) - (max 0 - (max (fst sec.byte_range) - row.text_row.start_index)), - min - (Lwt_main.run (TextBuffer.length g.job.text) - 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 = - Gv.Text.bounds t ~x ~y:0. ~start ~end_ - (Lwt_main.run (TextBuffer.contents g.job.text)) - 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; - fill t; - - set_fill_color t ~color:sec.format.color; - let w = - Text.text_w t ~x ~y:(Box2.miny row.rect) ~start - ~end_ - (Lwt_main.run (TextBuffer.contents g.job.text)) - in - w) - (Box2.minx row.rect) sections)) - g.rows -end - module Style = struct open Gg @@ -950,127 +833,10 @@ module Style = struct } end -module Layout = struct - open Gg - - type direction = LeftToRight | RightToLeft | TopDown | BottomUp - - type t = { - main_dir : direction; - main_wrap : bool; - main_align : align; - main_justify : bool; - cross_align : align; - cross_justify : bool; - } - - let horizontal = - { - main_dir = LeftToRight; - main_wrap = true; - main_align = Min; - main_justify = true; - cross_align = Min; - cross_justify = true; - } - - let vertical = - { - main_dir = TopDown; - main_wrap = true; - main_align = Min; - main_justify = true; - cross_align = Min; - cross_justify = true; - } - - type region = { min_rect : box2; max_rect : box2; cursor : box2 } - - let rec is_horizontal = function - | `Direction d -> ( - match d with - | LeftToRight | RightToLeft -> true - | TopDown | BottomUp -> false) - | `Layout t -> is_horizontal (`Direction t.main_dir) - - let available_from_cursor_max_rect t cursor max_rect : box2 = - (* TODO assert !cursor.any_nan() *) - (* TODO assert !max_rect.any_nan() *) - (* TODO assert !max_rect.is_finite() *) - let avail = - match t.main_dir with - | LeftToRight -> - Box2.of_pts - (V2.v (Box2.minx cursor) (Box2.miny max_rect)) - (V2.v - Float.( - max - (max (Box2.maxx max_rect) (Box2.minx cursor)) - (Box2.minx max_rect)) - Float.(max (Box2.maxy max_rect) (Box2.miny max_rect))) - | RightToLeft -> Box2.zero (* TODO *) - | TopDown | BottomUp -> Box2.zero - in - let avail = Box2.inter avail cursor in - - (* todo make sure it isn't negative (won't because Gg.maxx is maxing )*) - avail - - let available_size t r = - if t.main_wrap then - if is_horizontal (`Direction t.main_dir) then - V2.v (Box2.w r.max_rect) (Box2.h r.cursor) - else V2.v (Box2.w r.cursor) (Box2.h r.max_rect) - else - Box2.size (available_from_cursor_max_rect t r.cursor r.max_rect) - - let horizontal_justify (l : t) = - if is_horizontal (`Layout l) then l.main_justify - else l.cross_justify - - module Grid = struct - type state = { - col_widths : Gg.size1 list; - row_heights : Gg.size1 list; - } - - type t = { - id : id; - is_first_frame : bool; - prev_state : state; - initial_available : Gg.size1 option; - spacing : Gg.v2; - min_cell_size : Gg.v2; - max_cell_size : Gg.v2; - col : int; - row : int; - } - - let available_rect _t _r = Gg.Box2.zero (*TODO*) - end -end - -module Placer = struct - type t = { - grid : Layout.Grid.t option; - layout : Layout.t; - region : Layout.region; - } - - let available_size t = - match t.grid with - | Some grid -> - Gg.Box2.size (Layout.Grid.available_rect grid t.region) - | None -> Layout.available_size t.layout t.region - - let create layout region = { grid = None; layout; region } -end - module Ui = struct type t = { - id : id; + mutable rect : Gg.box2; style : Style.t; - placer : Placer.t; enabled : bool; gv : Gv.t; glfw_window : GLFW.window option; @@ -1081,24 +847,16 @@ module Ui = struct let id = ref 0 let spacing ui = ui.style.spacing - let available_size ui = Placer.available_size ui.placer - let available_width ui = Gg.P2.x (available_size ui) let fonts ui (reader : Gv.t -> 'a) : 'a = reader ui let allocate_space (_gv : Gv.t) (size : Gg.box2) : id * Gg.box2 = id := !id + 1; (!id, size) - let cursor_origin (ui : t) = Gg.Box2.o ui.placer.region.max_rect - let window gv ?(window : GLFW.window option) rect : t = - let id, rect = allocate_space gv rect in { - id; + rect; style = Style.default; - placer = - Placer.create Layout.vertical - Layout.{ min_rect = rect; max_rect = rect; cursor = rect }; enabled = true; gv; glfw_window = window; @@ -1153,6 +911,7 @@ module TextEdit = struct type t = { mutable text : TextBuffer.t; + mutable cursor : TextLayout.cursor; id : id option; id_source : id option; text_format : TextLayout.text_format; @@ -1166,22 +925,13 @@ module TextEdit = struct desired_width : float option; desired_height_rows : int; cursor_at_end : bool; - min_size : Gg.v2; + min_size : v2; align : align; clip_text : bool; char_limit : int; (* return_key : keyboard_shortcut; *) } - and state = { - mutable cursor : TextLayout.cursor_state; - (* undoer : undoer; *) - singleline_offset : float; - last_edit_time : float; - } - - let state_mem : (int * state) list ref = ref [] - - let add_bindings (t : t) (ui : Ui.t) (state : state) : unit Lwt.t = + let add_bindings (t : t) (ui : Ui.t) : unit Lwt.t = let open GLFW in let open Event in let open Ui in @@ -1195,10 +945,8 @@ module TextEdit = struct [ Custom (fun () -> - state.cursor <- - TextLayout.cursor_state_update - ~f:(fun a b -> (a + 1, b + 1)) - state.cursor; + TextBuffer.length t.text >>= fun textlen -> + t.cursor <- TextLayout.cursor_move 1 textlen t.cursor; Lwt.return_unit); ] |> adds @@ -1209,10 +957,9 @@ module TextEdit = struct [ Custom (fun () -> - state.cursor <- - TextLayout.cursor_state_update - ~f:(fun a b -> (a - 1, b - 1)) - state.cursor; + TextBuffer.length t.text >>= fun textlen -> + t.cursor <- + TextLayout.cursor_move (-1) textlen t.cursor; Lwt.return_unit); ] |> adds @@ -1223,10 +970,9 @@ module TextEdit = struct [ Custom (fun () -> - state.cursor <- - TextLayout.cursor_state_update - ~f:(fun a b -> (a - 1, b - 1)) - state.cursor; + TextBuffer.length t.text >>= fun textlen -> + t.cursor <- + TextLayout.cursor_move 10 textlen t.cursor; Lwt.return_unit); ] |> adds @@ -1236,71 +982,63 @@ module TextEdit = struct [ Custom (fun () -> - state.cursor <- - TextLayout.cursor_state_update - ~f:(fun a b -> (a - 1, b - 1)) - state.cursor; + TextBuffer.length t.text >>= fun textlen -> + t.cursor <- + TextLayout.cursor_move (-10) textlen t.cursor; + Lwt.return_unit); + ] + |> adds + [ [ Key (Press, Backspace, []) ]; [ Key (Press, Up, []) ] ] + [ + Custom + (fun () -> + TextBuffer.length t.text >>= fun textlen -> + t.cursor <- + TextLayout.cursor_move (-10) textlen t.cursor; Lwt.return_unit); ]; (* WARN XXX TKTK TODO this is probably "breaking" the lwt context and being used in other calls to Lwt_main.run *) (Ui.chrcallback_ref := fun c -> - match state.cursor with - | Some (_a, b) -> - TextBuffer.insert_uchar t.text b.index c >>= fun text -> - t.text <- text; - Lwt.return_unit - | None -> Lwt.return_unit + TextBuffer.insert_uchar t.text t.cursor.index c + >>= fun text -> + t.text <- text; + TextBuffer.length t.text >>= fun textlen -> + t.cursor <- TextLayout.cursor_move 1 textlen t.cursor; + Lwt.return_unit (* This creates a giant stack of calls lol >>= fun () -> !Ui.chrcallback_ref c *)); Lwt.return_unit - let load_state id = - match List.assoc_opt id !state_mem with - | Some state -> state - | None -> - let state = - { - cursor = Some (TextLayout.new_cursor_range (12, 13)); - singleline_offset = 0.0; - last_edit_time = 0.0; - } - in - state_mem := (id, state) :: !state_mem; - state - - type output = { - (* response : Response.t; *) - galley : TextLayout.galley; - galley_pos : Gg.p2; - text_clip_rect : Gg.box2; - state : state; - cursor_range : TextLayout.cursor_range option; - } - - let multiline ?(text_format = TextLayout.text_format_default) + let multiline ui ?(text_format = TextLayout.text_format_default) (text : TextBuffer.t) : t = - { - text; - id = None; - id_source = None; - text_format; - layouter = None; - password = false; - frame = true; - margin = Margin.symmetric 4.0 2.0; - multiline = true; - interactive = true; - desired_width = None; - desired_height_rows = 4; - cursor_at_end = true; - min_size = Gg.V2.zero; - align = Min; - clip_text = false; - char_limit = Int.max_int; - (* return_key = keyboard_shortcut; *) - } + let t = + { + text; + cursor = TextLayout.cursor 0; + id = None; + id_source = None; + text_format; + layouter = None; + password = false; + frame = true; + margin = Margin.symmetric 4.0 2.0; + multiline = true; + interactive = true; + desired_width = None; + desired_height_rows = 4; + cursor_at_end = true; + min_size = Gg.V2.zero; + align = Min; + clip_text = false; + char_limit = Int.max_int; + (* return_key = keyboard_shortcut; *) + } + in + Lwt_main.run (add_bindings t ui); + t + (* let show_content (t : t) (ui : Ui.t) : output = let state = load_state (Option.value ~default:(-1) t.id) in Lwt_main.run (add_bindings t ui state); @@ -1319,33 +1057,6 @@ module TextEdit = struct available_width else Float.min desired_width available_width in - let default_layouter (ui : Ui.t) (text : TextBuffer.t) - (wrap_width : size1) : TextLayout.galley = - let font = - match Gv.Text.find_font ui.gv ~name:"mono" with - | Some gv -> Fonts.{ gv; pixels_per_point = 1.0 } - | None -> failwith "can't find font 'mono'" - in - let layout_job = - if t.multiline then - TextLayout.simple text t.text_format wrap_width - else TextLayout.simple_singleline text t.text_format - in - let layout_job = - TextLayout.with_cursor - (Option.value - ~default:(TextLayout.new_cursor_range (0, 0)) - state.cursor) - layout_job - in - Ui.fonts ui.gv (fun f -> - TextLayout.layout f font layout_job origin) - in - - let layouter = - Option.value ~default:default_layouter t.layouter - in - let galley = layouter ui t.text wrap_width in let galley_size = galley.mesh_bounds in let desired_width = if t.clip_text then wrap_width @@ -1378,8 +1089,7 @@ module TextEdit = struct in (* if Ui.is_rect_visible ui rect then *) - Painter.galley ui.gv galley; - + (* Painter.galley ui.gv galley; *) let _align_offset = rect in { galley; @@ -1388,10 +1098,160 @@ module TextEdit = struct state; cursor_range; } - let show (t : t) ui : output = let _margin = t.margin in let output = show_content t ui in (* let _outer_rect = output.response.rect in *) output + *) +end + +module Layout = struct + open Gg + + type frame = { t : t; mutable size : size } + + and t = + [ `Box of [ `H | `V | `Z ] * frame list + | `String of string + | `Buffer of TextBuffer.t + | `TextEdit of TextEdit.t + | `None ] + + and size = + [ `Fixed of p2 | `Percent (* of container *) of p2 | `Auto ] + + let frame ?(size = `Auto) t : frame = { t; size } + let box d t = frame (`Box (d, t)) + let hbox, vbox, zbox = (box `H, box `V, box `Z) + + let pp_t_frame ppf f = + F.pf ppf "%s" + (match f with + | `Hbox -> "`Hbox" + | `Vbox -> "`Vbox" + | `Buffer -> "`Buffer" + | `TextEdit -> "`TextEdit" + | `S s -> F.str "%s" s + | `None -> "`None") + + let parse_t_frame s = + match s with + | "`Box" -> `Vbox + | "`Buffer" -> `Buffer + | "`TextEdit" -> `TextEdit + | "`None" -> `None + | s -> `S s +end + +module Painter = struct + open Layout + open Gg + + let paint_galley (t : Gv.t) (g : TextLayout.galley) : box2 = + (* F.epr + "Painter.galley (String.length g.job.text)=%d (Array.length \ + g.rows)=%d @." + (Lwt_main.run (TextBuffer.length g.job.text)) + (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; *) + 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); + + ignore + (List.fold_left + (fun x (sec : TextLayout.layout_section) -> + let start, end_ = + ( min + (Lwt_main.run (TextBuffer.length g.job.text) - 1) + (max 0 + (max (fst sec.byte_range) + row.text_row.start_index)), + min + (Lwt_main.run (TextBuffer.length g.job.text) - 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 = + Gv.Text.bounds t ~x ~y:0. ~start ~end_ + (Lwt_main.run (TextBuffer.contents g.job.text)) + 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; + fill t; + + set_fill_color t ~color:sec.format.color; + let w = + Text.text_w t ~x ~y:(Box2.miny row.rect) ~start ~end_ + (Lwt_main.run (TextBuffer.contents g.job.text)) + in + w) + (Box2.minx row.rect) sections); + Box2.(union br row.rect)) + Box2.empty g.rows + + let rec layout (box : box2) (ui : Ui.t) (frame : frame) : box2 = + match frame.t with + | `Box (dir, ll) -> + List.fold_left + (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 + | `TextEdit t -> + let font = + match Gv.Text.find_font ui.gv ~name:"mono" with + | Some gv -> Fonts.{ gv; pixels_per_point = 1.0 } + | None -> failwith "can't find font 'mono'" + in + let layout_job = + if t.multiline then + TextLayout.simple t.text ~format:t.text_format + (Option.value ~default:(Box2.w box) t.desired_width) + else TextLayout.singleline t.text t.text_format + in + let galley = + Ui.fonts ui.gv (fun f -> + TextLayout.layout f font + (TextLayout.with_cursor t.cursor layout_job) + (Box2.o box)) + in + paint_galley ui.gv galley + | _ -> box end diff --git a/oplevel.ml b/oplevel.ml index eda0f02..a45ca70 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -1,6 +1,7 @@ module F = Fmt open Tgles2 module Gv = Graphv_gles2_native +open Ogui module GLFWExtras = struct open Ctypes @@ -106,6 +107,20 @@ let () = Ogui.Ui.chrcallback ui ch)) |> ignore; + F.pr "oplevel.ml: building initial page@."; + let page = + Layout.( + vbox + [ + frame + (`TextEdit + (TextEdit.multiline ui + (TextBuffer.of_repo + ~path:[ "README" ] (*[ ".config"; "init.ml" ] *) + ~repo:rootrepo))); + ]) + in + F.pr "oplevel.ml: entering drawing loop@."; let t = GLFW.getTime () |> ref in @@ -136,17 +151,12 @@ let () = Gl.disable Gl.depth_test; let width, height = (float win_w, float win_h) in - + let box = Gg.(Box2.v V2.zero Size2.(v width height)) in Gv.begin_frame ctx ~width ~height ~device_ratio:1.; Perfgraph.render graph ctx (width -. 205.) 5.; - ignore - Ogui.TextEdit.( - show - (multiline - (Ogui.TextBuffer.of_repo - ~path:[ ".config"; "init.ml" ] - ~repo:rootrepo)) - ui); + (* F.epr "box=%a@." Gg.Box2.pp box; + F.epr "Painter.layout=%a@." Gg.Box2.pp *) + Painter.layout box ui page |> ignore; (* Demo.render_demo ctx mx my win_w win_h now !blowup data; *) Gv.end_frame ctx;