cursor lol, but also crashes

bin/main.ml

@@ -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
+      let zrb, zra = Zed_rope.break (Zed_edit.text te.ze) (Zed_cursor.get_position te.zc) in
-      F.pf pp "> "; F.text pp text; F.pf pp "@.@.";) s
+      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 ()