diff --git a/bin/main.ml b/bin/main.ml index 8f79b48..5ed6ac2 100644 --- a/bin/main.ml +++ b/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,49 +97,26 @@ 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',')'); ('`','~');('-','_');('+','+');('[','{');(']','}'); ('\\','|');(';',':');('\'','"');(',','<');('.','>'); ('/','?')] + + let key_to_uchar k : UChar.t = + match (List.assoc_opt k.char key_shift_map), k with + | _, {char='\x00'} -> (UChar.of_char '\x00') + | Some k, {shift=true} -> (UChar.of_char k) + | None, {shift=true} -> (UChar.of_char (Char.uppercase_ascii k.char)) + | _, {shift=false} -> k.uchar + + + + let handle_keyevents (el:event list) f = + List.iter f el + - let handle_keyevents (el:event list) (ze:unit Zed_edit.t) (zc:Zed_cursor.t) = - let ctx = Zed_edit.context ze zc in - let res = ref `None in - List.iter (fun ev -> - match ev with - | `Key_up k -> - 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) - | _, {keycode=0x40000050}(*left*) -> ignore (Zed_edit.prev_char ctx) - | _, {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 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 + sc := {!sc with box = Box2.of_pts (P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height)) (Box2.max s.box)}; 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 nl then begin (* WRAP *) - F.epr "out_spaces: ===== WRAP =======@."; - out_newline () - end; + if ((Box2.ox !sc.box) +. ((float n) *. wpx)) > (Box2.maxx !sc.box) then (* WRAP *) + begin 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 ws = (Box2.w !box) /. nf in - for m = 0 to n-1 do - 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; + let bo = Box2.v (Box2.o !sc.box) (P2.v ((float n) *. wpx) height) in + let bsp = (Box2.v (Box2.br_pt !box) (P2.v wpx height)) in + push @@ pane_hbox (List.init n (fun n -> path_circle (Color.v 0.125 1.0 0.125 0.125) bsp)) !sc; 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 - (P2.v ((Box2.ox !sc.box) +. p) (Box2.oy !sc.box)) + sc := {!sc with box = Box2.of_pts (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); - push @@ fill_box c (Box2.v (Box2.o !sc.box) (P2.v (height *. 0.333) height)) !sc + | 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 - | _ -> ();""); + mark_close_stag = (function | _ -> (); ""); print_open_stag = (fun _ -> (*""*) ()); (* TKTKTKTK XXX IT SHOULD BE USING THESE print ONES *) print_close_stag = (fun _ -> (*""*) ()); }; @@ -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 - (match kr with - | `Execute -> - let text = str_of_textedit t.te in - Buffer.clear t.res; - Topmain.main (Format.formatter_of_buffer t.res) text (); - | _ -> ()); + Display.handle_keyevents s.events + (function + | `Key_up {char='\r'; ctrl=true; shift=false; meta=false; fn=false} -> + Buffer.clear t.res; + Topmain.main (Format.formatter_of_buffer t.res) (str_of_textedit t.te) (); () + | _ -> ()); pane_vbox [ - (fun s -> - draw_textedit t.te 30. s); + draw_textedit t.te 30.; 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)