console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

cursor lol, but also crashes

Browse Source
This commit is contained in:
cqc
2021-07-12 01:40:46 -05:00
parent 7633df3d8b
commit d7d824b9ba
1 changed files with 44 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
bin/main.ml
View File

@ -346,7 +346,10 @@ let simple_text f text (s:Display.state) =
Text.(simple_text f ~valign:`BASELINE ~halign:`LEFT
~x:(Box2.ox s.box) ~y:((Box2.oy s.box) +. fm.ascent) text)))))
let draw_pp height ppf (s:Display.state) =
type Format.stag += Color_bg of Wall.color
type Format.stag += Color_fg of Wall.color
type Format.stag += Cursor of Wall.color
let draw_pp height fpp (s:Display.state) =
let node, sc, box = ref I.empty, ref s, ref Box2.zero in
let push (s, (b, i)) = node := I.stack !node i; sc := s; box := b in
let f = Text.Font.make ~size:height (Lazy.force font_sans) in
@ -396,13 +399,40 @@ let draw_pp height ppf (s:Display.state) =
(Box2.max !sc.box)};
Printf.printf "out_indent: (n=%d=%0.2fpx) %s\n" n p (str_of_box !sc.box); flush stdout in
let pp = Format.formatter_of_out_functions {out_string; out_flush; out_newline; out_spaces; out_indent;} in
Format.pp_set_tags pp true;
Format.pp_set_formatter_stag_functions pp {
mark_open_stag = (fun s ->
(match s with
| Cursor c -> push @@ fill_box c (Box2.v (Box2.o !sc.box) (P2.v (height *. 0.333) height)) !sc
| Color_bg c -> push @@ fill_box c !box !sc
| _ -> ()); "");
mark_close_stag = (
function
| _ -> ();"");
print_open_stag = (fun _ -> (*"<open_stag>"*) ()); (* TKTKTKTK XXX IT SHOULD BE USING THESE print ONES *)
print_close_stag = (fun _ -> (*"<close_stag>"*) ());
};
let margin = int_of_float ((Box2.w s.box) /. (Text.Font.text_width f " ")) in
let max_indent = margin in
Format.pp_safe_set_geometry pp ~max_indent ~margin;
ppf pp;
fpp pp;
Format.pp_force_newline pp ();
!sc, ((Box2.of_pts (Box2.o s.box) (Box2.max !sc.box)), !node)
(*let draw_spp height fpp (s:Display.state) =
let node, sc, box = ref I.empty, ref s, ref Box2.zero in
let push (s, (b, i)) = node := I.stack !node i; sc := s; box := b in
let f = Text.Font.make ~size:height (Lazy.force font_sans) in
let fm = Text.Font.font_metrics f in
let font_height = fm.ascent -. fm.descent +. fm.line_gap in
let sob = Format.make_symbolic_output_buffer () in
let pp = Format.formatter_of_symbolic_output_buffer sob in
Format.flush_symbolic_output_buffer sob;
fpp pp;
!sc, ((Box2.of_pts (Box2.o s.box) (Box2.max !sc.box)), !node)*)
let draw_lumptree height (s:Display.state) =
let from = [] in (* future optional arg *)
let pile = Lump.branch "./kommpile" "current" in (* future args *)
@ -610,13 +640,19 @@ end
type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t}
let make_textedit () = let z = Zed_edit.create () in {ze = z; zc = Zed_edit.new_cursor z;}
let draw_textedit (te:textedit) height (s:Display.state) =
F.epr "draw_textedit: (Zed_cursor.get_position te.zc)=%d\n" (Zed_cursor.get_position te.zc);
draw_pp 30. (fun pp ->
let text = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text te.ze)) in
F.pf pp "> "; F.text pp text; F.pf pp "@.@.";) s
let zrb, zra = Zed_rope.break (Zed_edit.text te.ze) (Zed_cursor.get_position te.zc) in
let before_cursor = Zed_string.to_utf8 (Zed_rope.to_string zrb) in
let after_cursor = Zed_string.to_utf8 (Zed_rope.to_string zra) in
F.pf pp "> ";
F.text pp before_cursor;
Format.pp_open_stag pp (Cursor (Wall.Color.v 0.1 0.1 0.125 0.5));
F.pf pp "";
Format.pp_close_stag pp ();
F.text pp after_cursor; F.pf pp "@.@.";) s
let str_of_textedit (te:textedit) = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text te.ze))
type top_instance = {te: textedit; res: Buffer.t}
let make_top () = {te = (make_textedit ()); res = Buffer.create 1024}
let draw_top (t:top_instance) height (s:Display.state) =
@ -628,7 +664,8 @@ let draw_top (t:top_instance) height (s:Display.state) =
Topmain.main (Format.formatter_of_buffer t.res) text ();
| _ -> ());
pane_vbox [
draw_textedit t.te 30.;
(fun s ->
draw_textedit t.te 30. s);
draw_pp 30. (fun pp ->
F.pf pp "%s@." (Buffer.contents t.res);
F.flush pp ()