diff --git a/bin/dune b/bin/dune index 31f1ae6..2de0743 100644 --- a/bin/dune +++ b/bin/dune @@ -1,6 +1,7 @@ (executables (names main example lumppile) (modes byte) + (link_flags (-linkall)) (libraries komm tsdl tgls.tgles2 wall irmin-unix compiler-libs.common compiler-libs.bytecomp compiler-libs.toplevel ocaml-compiler-libs.common ocaml-compiler-libs.toplevel zed)) diff --git a/bin/main.ml b/bin/main.ml index ce120ce..584532e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -98,67 +98,63 @@ module Display = struct | Ok x -> x | Error (`Msg msg) -> failwith msg + + type keymod = Shift | Ctrl | Meta | Fn type key = { char:char; uchar:CamomileLibrary.UChar.t; keycode:Sdl.keycode; scancode:Sdl.scancode; - shift:bool; - ctrl:bool; - meta:bool; - fn:bool; } + mods:keymod list} + type mouse = (int * int) type event = [ `Key_down of key | `Key_up of key + | `Text_editing of string + | `Text_input of string | `Mouse of mouse | `Quit | `Fullscreen of bool | `None ] - let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0); - keycode=0; scancode=0; - shift=false; ctrl=false; meta=false; fn=false} + let str_of_key k = Printf.sprintf "(char=%C;uchar=%C;keycode=%x;scancode=%x;name=%s;(%s%s%s%s))" + k.char (CamomileLibrary.UChar.char_of k.uchar) k.keycode k.scancode + (Sdl.get_key_name k.keycode) (if List.mem Shift k.mods then "shift" else "") + (if List.mem Ctrl k.mods then "ctrl" else "") (if List.mem Meta k.mods then "meta" else "") + (if List.mem Fn k.mods then " fn" else "") + let event_of_sdlevent ev = match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with + | `Text_editing -> F.epr "event_of_sdlevent: `Text_editing\n\twindow_id=%d\n\ttext=%s\n\tstart=%d\n\tlength=%d@." + (Sdl.Event.get ev Sdl.Event.text_editing_window_id) + (Sdl.Event.get ev Sdl.Event.text_editing_text) + (Sdl.Event.get ev Sdl.Event.text_editing_start) + (Sdl.Event.get ev Sdl.Event.text_editing_length); `None + + | `Text_input -> `Text_input (Sdl.Event.get ev Sdl.Event.text_input_text) | `Key_down | `Key_up as w -> let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in let keycode = Sdl.Event.get ev Sdl.Event.keyboard_keycode in let uchar = CamomileLibrary.UChar.of_int (if keycode land Sdl.K.scancode_mask > 0 then 0 else keycode) in + let mods = List.filter_map (fun (m, v) -> if (km land m)>0 then Some v else None) + Sdl.Kmod.[(shift, Shift); (ctrl, Ctrl); (alt, Meta); (gui, Fn);] in let k = { char=(UChar.char_of uchar); uchar; keycode; - scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode; - shift = (km land Sdl.Kmod.shift)>0; - ctrl = (km land Sdl.Kmod.ctrl)>0; - meta = (km land Sdl.Kmod.alt)>0; - fn = (km land Sdl.Kmod.gui)>0; } in + scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode; mods} 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" keycode - (CamomileLibrary.UChar.char_of k.uchar) k.scancode - (Sdl.get_key_name keycode) - (if k.shift then " shift" else "") - (if k.ctrl then " ctrl" else "") - (if k.meta then " meta" else "") - (if k.fn then " fn" else ""); - (match w with `Key_down -> `Key_down k | `Key_up -> `Key_up k) + F.epr "%s@." (str_of_key k); + let repeat = (Sdl.Event.get ev Sdl.Event.keyboard_repeat) in + F.epr "\tkeyboard_repeat=%d\n" repeat ; + if repeat < 1 then (match w with `Key_down -> `Key_down k | `Key_up -> `Key_up k) else `None | `Mouse_motion -> let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy | `Quit -> F.epr "Quit Event\n"; `Quit | _ -> F.epr "Unknown Event@." ; `None - let str_of_scancode = Sdl.get_key_name - let key_shift_map = - [('1','!');('2','@');('3','#');('4','$');('5','%'); - ('6','^');('7','&');('8','*');('9','(');('0',')'); - ('`','~');('-','_');('+','+');('[','{');(']','}'); - ('\\','|');(';',':');('\'','"');(',','<');('.','>'); - ('/','?')] + let key_up : Sdl.keycode = 0x40000052 + let key_down : Sdl.keycode = 0x40000051 + let key_left : Sdl.keycode = 0x40000050 + let key_right : Sdl.keycode = 0x4000004f - 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 (* current window state to be passed to window renderer *) @@ -177,7 +173,7 @@ module Display = struct mutable quit: bool; mutable fullscreen: bool; } - let ticks () = (Int32.to_float (Sdl.get_ticks ())) /. 1000.0 + let ticks () = (Int32.to_float (Sdl.get_ticks ())) /. 1000. let on_failure ~cleanup result = begin match result with @@ -192,6 +188,7 @@ module Display = struct Sdl.create_window ~w ~h title Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*)) >>= fun sdl_win -> + Sdl.set_window_title sdl_win title; ignore (Sdl.gl_set_swap_interval (-1)); ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1); on_failure ( @@ -223,9 +220,9 @@ module Display = struct else Sdl.Window.windowed) : _ result)); None | `Key_up a -> Some (`Key_up a) - | `Key_down _ -> (*Some (`Key_up a)*) None + | `Key_down a -> Some (`Key_down a) | `Mouse a -> Some (`Mouse a) - | _ -> None + | a -> Some a (*| a -> Some a*)) !el; if (List.length !el) > 0 then begin F.epr "Passing in %d events\n" (List.length !el); @@ -245,7 +242,7 @@ module Display = struct let width = float width and height = float height in Wall.Renderer.render frame.wall ~width ~height image; Sdl.gl_swap_window frame.sdl_win; - F.epr "event loop took %0.2fms?\n" (ticks () -. tstart); Ok () end + F.epr "event loop took %0.6f seconds\n" (ticks () -. tstart); Ok () end else Ok () let run frame render () = @@ -314,7 +311,6 @@ let pane_vbox (subpanes:Display.pane list) (so:Display.state) = List.fold_left (fun (sp, (_, ip)) (pane:Display.pane) -> let sr, (br, ir) = pane sp in - F.epr "pane_vbox: %s\n" (str_of_box br); let _, (_, sir) = path_box (Color.v 0.125 0.125 1.0 0.125) br sp in ({sr with box = (Box2.of_pts (Box2.tl_pt br) (Box2.max sp.box))}, (br, Image.seq [ ip; sir; ir]))) (so, (so.box, Image.empty)) subpanes @@ -370,7 +366,6 @@ 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) = - F.epr "draw_pp: %s\n" (str_of_box s.box); 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 @@ -442,27 +437,27 @@ let make_textedit () = let z = Zed_edit.create () in {ze = z; zc = Zed_edit.new_ let draw_textedit (te:textedit) height (s:Display.state) = let ctx = Zed_edit.context te.ze te.zc in List.iter (function - | `Key_up (k:Display.key) -> + | `Key_down (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'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.prev_char ctx - | {char='f'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.next_char ctx - | {char='a'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.goto_bol ctx - | {char='e'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.goto_eol ctx - | {char='d'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.remove_next ctx 1 - | {char='d'; ctrl=false; shift=false; meta=true; fn=false; _} -> Zed_edit.kill_next_word ctx - | {char='\b'; ctrl=false; shift=false; meta=false; fn=false; _} -> Zed_edit.remove_prev ctx 1 - | {char='\b'; ctrl=false; shift=false; meta=true; fn=false; _} -> Zed_edit.kill_prev_word ctx - | {char='\t'; ctrl=false; shift=false; meta=false; fn=false; _} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t') - | {char='k'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.kill_next_line ctx - | _ -> - let c = Display.key_to_uchar k in - if Zed_char.is_printable c then Zed_edit.insert_char ctx (Display.key_to_uchar k); ()) - | `Key_down _ -> () + | {keycode=kc;mods=[]; _} when kc = Display.key_up -> Zed_edit.prev_line ctx + | {keycode=kc;mods=[]; _} when kc = Display.key_down -> Zed_edit.next_line ctx + | {keycode=kc;mods=[]; _} when kc = Display.key_left -> Zed_edit.prev_char ctx + | {keycode=kc;mods=[]; _} when kc = Display.key_right-> Zed_edit.next_char ctx + | {char='\r'; mods=[]; _} -> Zed_edit.newline ctx + | {char='b'; mods=[Ctrl]; _} -> Zed_edit.prev_char ctx + | {char='f'; mods=[Ctrl]; _} -> Zed_edit.next_char ctx + | {char='a'; mods=[Ctrl]; _} -> Zed_edit.goto_bol ctx + | {char='e'; mods=[Ctrl]; _} -> Zed_edit.goto_eol ctx + | {char='d'; mods=[Ctrl]; _} -> Zed_edit.remove_next ctx 1 + | {char='d'; mods=[Meta]; _} -> Zed_edit.kill_next_word ctx + | {char='\b'; mods=[]; _} -> Zed_edit.remove_prev ctx 1 + | {char='\b'; mods=[Meta]; _} -> Zed_edit.kill_prev_word ctx + | {char='\t'; mods=[]; _} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t') + | {char='k'; mods=[Ctrl]; _} -> Zed_edit.kill_next_line ctx + | _ -> ()) + | `Key_up _ -> () + | `Text_input s -> F.epr "draw_textedit: `Text_input %s@." s; + Zed_edit.insert ctx (Zed_rope.of_string (Zed_string.of_utf8 s)); () | _ -> ()) s.events; draw_pp height (fun pp -> let zrb, zra = Zed_rope.break (Zed_edit.text te.ze) (Zed_cursor.get_position te.zc) in @@ -518,7 +513,7 @@ let draw_top (t:top) height (s:Display.state) = | Some e -> e in Display.handle_keyevents s.events (function - | `Key_up {char='\r'; ctrl=true; shift=false; meta=false; fn=false; _} -> + | `Key_up {char='\r'; mods=[Ctrl]; _} -> Buffer.clear t.res; eval (Format.formatter_of_buffer t.res) (str_of_textedit t.te); ignore (Lwt_main.run (Store.tree t.storeview.s >>= (fun tree -> Store.Tree.add tree t.path (str_of_textedit t.te))));