still works

bin/main.ml

@@ -38,6 +38,7 @@ module Display = struct
   open Tgles2
   open Tsdl
   open Gg
+  open CamomileLibrary
   let (>>=) x f = match x with
     | Ok a -> f a
     | Error x as result -> result
@@ -47,7 +48,8 @@ module Display = struct
     | Error (`Msg msg) -> failwith msg
 
   type key = {
-      uchar:Uchar.t;
+      char:char;
+      uchar:CamomileLibrary.UChar.t;
       keycode:Sdl.keycode;
       scancode:Sdl.scancode;
       shift:bool;
@@ -62,15 +64,19 @@ module Display = struct
                | `Fullscreen of bool
                | `None ]
 
-  let prev_key = ref {uchar=(Uchar.of_int 0);keycode=0;scancode=0;shift=false;ctrl=false;meta=false;fn=false}
+  let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0);
+                      keycode=0; scancode=0;
+                      shift=false; ctrl=false; meta=false; fn=false}
   open Sdl.K
   let event_of_sdlevent ev =
     match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with
     | `Key_down | `Key_up as w ->
        let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in
        let kc = Sdl.Event.get ev Sdl.Event.keyboard_keycode in
+       let uchar = CamomileLibrary.UChar.of_int (if kc land Sdl.K.scancode_mask > 0 then 0 else kc) in
        let k = {
-           uchar=Uchar.of_int (if kc land Sdl.K.scancode_mask > 0 then 0 else kc);
+           char=(UChar.char_of uchar);
+           uchar=uchar;
            keycode=kc;
            scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode;
            shift = (km land Sdl.Kmod.shift)>0;
@@ -78,7 +84,7 @@ module Display = struct
            meta = (km land Sdl.Kmod.alt)>0;
            fn = (km land Sdl.Kmod.gui)>0; } in
        (match w with `Key_down -> F.epr "key_down: " | `Key_up -> F.epr "key_up: ");
-       F.epr "keycode=%x uchar=%C scancode=%x keyname=%s (%s %s %s %s)\n" kc (Uchar.to_char k.uchar) k.scancode
+       F.epr "keycode=%x uchar=%C scancode=%x keyname=%s (%s %s %s %s)\n" kc (CamomileLibrary.UChar.char_of k.uchar) k.scancode
          (Sdl.get_key_name kc)
          (if k.shift then " shift" else "")
          (if k.ctrl then " ctrl" else "")
@@ -91,17 +97,6 @@ module Display = struct
     | _ -> `None
   
   let str_of_scancode = Sdl.get_key_name
-
-  type keyevent = {
-      char: Uchar.t;
-      shift : bool;
-      ctrl : bool;
-      meta : bool;
-      fn : bool;
-    }
-
-  type editbuf = keyevent Zed_edit.t
-
   let key_shift_map =
     [('1','!');('2','@');('3','#');('4','$');('5','%');
      ('6','^');('7','&');('8','*');('9','(');('0',')');
@@ -109,31 +104,19 @@ module Display = struct
      ('\\','|');(';',':');('\'','"');(',','<');('.','>');
      ('/','?')]
 
-  let handle_keyevents (el:event list) (ze:unit Zed_edit.t) (zc:Zed_cursor.t) =
+  let key_to_uchar k : UChar.t =
-    let ctx = Zed_edit.context ze zc in
+    match (List.assoc_opt k.char key_shift_map), k with
-    let res = ref `None in
+    | _, {char='\x00'} -> (UChar.of_char '\x00')
-    List.iter (fun ev ->
+    | Some k, {shift=true} -> (UChar.of_char k)
-        match ev with
+    | None, {shift=true} -> (UChar.of_char (Char.uppercase_ascii k.char))
-        | `Key_up k ->
+    | _, {shift=false} -> k.uchar
-           let c = (Uchar.to_char k.uchar) in
+
-           (match c, k with
+
-            | _, {keycode=0x40000052}(*up*)   -> ignore (Zed_edit.prev_line ctx)
+  
-            | _, {keycode=0x40000051}(*down*) -> ignore (Zed_edit.next_line ctx)
+  let handle_keyevents (el:event list) f =
-            | _, {keycode=0x40000050}(*left*) -> ignore (Zed_edit.prev_char ctx)
+    List.iter f el
-            | _, {keycode=0x4000004f}(*right*)-> ignore (Zed_edit.next_char ctx)
+
-            | '\r', {ctrl=true; shift=false; meta=false; fn=false} -> res := `Execute
+  
-            | '\r', {ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.newline ctx
-            | '\b', _ -> Zed_edit.remove_prev ctx 1
-            | '\t', _ -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t')
-            | _ ->
-               if k.uchar != (Uchar.of_int 0) then
-                 Zed_edit.insert_char ctx (
-                     match (List.assoc_opt c key_shift_map), k.shift with
-                     | Some k, true -> (CamomileLibrary.UChar.of_char k)
-                     | None, true -> (CamomileLibrary.UChar.of_char (Char.uppercase_ascii c))
-                     | _, false -> (CamomileLibrary.UChar.of_char c)))
-        | `Key_down a -> ()
-        | _ -> ()) el; !res
   
   (* current window state to be passed to window renderer *)
   type state = { box: box2; (* This is cannonically box within which the next element should draw *)
@@ -360,55 +343,36 @@ let draw_pp height fpp (s:Display.state) =
     let sp = !sc in
     push @@ simple_text f text !sc;
     sc := {!sc with box = (Box2.of_pts (P2.v (Box2.maxx !box) (Box2.oy sp.box)) (Box2.max sp.box))};
-    F.epr "out_string: (\"%s\")\n\tsp.box=%s\n\t!sc.box=%s\n\t!box=%s@."
-      text (str_of_box sp.box) (str_of_box !sc.box) (str_of_box !box)
   in
   let out_flush () =
-    F.epr "out_flush: () %s\n" (str_of_box !sc.box) ; () in
+    (* F.epr "out_flush: () %s\n" (str_of_box !sc.box) ; *)() in
   let out_newline () =
-    let nlp = P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height) in
+    sc := {!sc with box = Box2.of_pts (P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height)) (Box2.max s.box)}; 
-    sc := {!sc with box = Box2.of_pts nlp (Box2.max s.box)}; 
-    Printf.printf "out_newline: (%0.1f %0.1f) %s\n" (P2.x nlp) (P2.y nlp) (str_of_box !sc.box); flush stdout
   in
   let out_spaces n =
-    let nf = float n in 
     let wpx = Text.Font.text_width f " " in
-    let nl =  ((Box2.ox !sc.box) +. (nf *. wpx)) > (Box2.maxx !sc.box) in
+    if ((Box2.ox !sc.box) +. ((float n) *. wpx)) > (Box2.maxx !sc.box) then (* WRAP *)
-    if nl then begin (* WRAP *)
+      begin F.epr "out_spaces: ===== WRAP =======@."; out_newline () end;
-        F.epr "out_spaces: ===== WRAP =======@.";
-        out_newline ()
-      end;
     let so = !sc in
-    let bo = Box2.v (Box2.o !sc.box) (P2.v (nf *. wpx) height) in
+    let bo = Box2.v (Box2.o !sc.box) (P2.v ((float n) *. wpx) height) in
-    let ws = (Box2.w !box) /. nf in
+    let bsp = (Box2.v (Box2.br_pt !box) (P2.v wpx height)) in
-    for m = 0 to n-1 do
+    push @@ pane_hbox (List.init n (fun n -> path_circle (Color.v 0.125 1.0 0.125 0.125) bsp)) !sc;
-      let mf = float m in
-      let bsp = (Box2.v (Box2.br_pt !box) (P2.v wpx height)) in
-      F.epr "out_space(%d): %s -> %s \n" m (str_of_box !box) (str_of_box bsp); 
-      push @@ pane_hbox [path_circle (Color.v 0.125 1.0 0.125 0.125) bsp] !sc;
-    done;
     box := bo;
     sc := {!sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box)};
-    Printf.printf "out_spaces: (n=%d=%0.2fpx, nl=%b) %s\n\tbo=%s\n" n (nf *. wpx) nl (str_of_box !sc.box)
-      (str_of_box bo); flush stdout
   in
   let out_indent n =
     let p = (min ((Box2.w !sc.box)-.1.) (height *. 2.0 *. (float n))) in
-    sc := {!sc with box = Box2.of_pts
+    sc := {!sc with box = Box2.of_pts (P2.v ((Box2.ox !sc.box) +. p) (Box2.oy !sc.box))
-                            (P2.v ((Box2.ox !sc.box) +. p) (Box2.oy !sc.box))
                             (Box2.max !sc.box)};
-    Printf.printf "out_indent: (n=%d=%0.2fpx) %s\n" n p (str_of_box !sc.box); flush stdout in
+  in
   let pp = Format.formatter_of_out_functions {out_string; out_flush; out_newline; out_spaces; out_indent;} in
   Format.pp_set_formatter_stag_functions pp {
       mark_open_stag = (fun s ->
         (match s with
-         | Cursor c -> F.epr "mark_open_stag Cursor: %s\n" (str_of_box !sc.box);
+         | Cursor c -> push @@ fill_box c (Box2.v (Box2.o !sc.box) (P2.v (height *. 0.333) height)) !sc
-                       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 = (
+      mark_close_stag = (function | _ -> (); "");
-        function
-        | _ -> ();"");
       print_open_stag = (fun _ -> (*"<open_stag>"*) ()); (* TKTKTKTK XXX IT SHOULD BE USING THESE print ONES *)
       print_close_stag = (fun _ -> (*"<close_stag>"*) ());
     };
@@ -642,6 +606,21 @@ 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);
+  let ctx = Zed_edit.context te.ze te.zc in
+  List.iter
+    (function
+     | `Key_up (k:Display.key) ->
+        (match k with
+         | {keycode=0x40000052}(*up*)   -> ignore (Zed_edit.prev_line ctx) 
+         | {keycode=0x40000051}(*down*) -> ignore (Zed_edit.next_line ctx)
+         | {keycode=0x40000050}(*left*) -> ignore (Zed_edit.prev_char ctx)
+         | {keycode=0x4000004f}(*right*)-> ignore (Zed_edit.next_char ctx)
+         | {char='\r'; ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.newline ctx
+         | {char='\b';} -> Zed_edit.remove_prev ctx 1
+         | {char='\t'} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t')
+         | _ -> Zed_edit.insert_char ctx (Display.key_to_uchar k); ())
+     | `Key_down _ -> ()
+     | _ -> ()) s.events;
   draw_pp 30. (fun pp ->
       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
@@ -657,23 +636,19 @@ let str_of_textedit (te:textedit) = Zed_string.to_utf8 (Zed_rope.to_string (Zed_
 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) =
-  let kr = Display.handle_keyevents s.events t.te.ze t.te.zc in
+  Display.handle_keyevents s.events
-  (match kr with
+    (function 
-   | `Execute ->
+     | `Key_up {char='\r'; ctrl=true; shift=false; meta=false; fn=false} -> 
-             let text = str_of_textedit t.te in
+         Buffer.clear t.res;
-             Buffer.clear t.res;
+         Topmain.main (Format.formatter_of_buffer t.res) (str_of_textedit t.te) (); ()
-             Topmain.main (Format.formatter_of_buffer t.res) text ();
+      | _ -> ());
-   | _ -> ());
   pane_vbox [
-      (fun s ->
+      draw_textedit t.te 30.;
-        draw_textedit t.te 30. s);
       draw_pp 30. (fun pp ->
           F.pf pp "%s@." (Buffer.contents t.res);
           F.flush pp ()
         );
     ] s
-
-
 let top_1 = make_top ()
 
 let mouse_state = ref (0,0)