diff --git a/main.ml b/main.ml index 32ed7e9..66b8071 100644 --- a/main.ml +++ b/main.ml @@ -59,7 +59,9 @@ module Input = struct module Bind = struct module S = Zed_input.Make(Key) include S - type action = Custom of (unit -> unit) | Zed of Zed_edit.action + type action = Custom of (unit -> unit) + | Zed of Zed_edit.action + (* stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *) let bindings = ref empty @@ -167,8 +169,30 @@ module Event = struct | `Mouse of mouse | `Quit | `Fullscreen of bool + | `Unknown of string | `None ] + let string_of_event = function + | `Key_down _ -> "`Key_down" + | `Key_up _ -> "`Key_up" + | `Text_editing _ -> "`Text_editing" + | `Text_input _ -> "`Text_input" + | `Mouse _ -> "`Mouse" + | `Quit -> "`Quit" + | `Fullscreen _ -> "`Fullscreen" + | `Unknown _ -> "`Unknown" + | `None -> "`None" + + let to_string ev = + let p = (match ev with + | `Key_down k | `Key_up k -> Input.to_string k + | `Text_editing s | `Text_input s -> s + | `Mouse _ -> "" + | `Fullscreen b -> Format.sprintf "%b" b + | `Unknown s -> s + | `Quit | `None -> "") in + (string_of_event ev) ^ " " ^ p + let event_of_sdlevent ev = let key_of_sdlkey ev = let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in @@ -202,14 +226,52 @@ module Event = struct Sdl.Kmod.[ (shift, Shift); (ctrl, Ctrl); (alt, Meta); (gui, Fn) ] in { code = c; mods = Input.Keymod.of_list mods; } in let repeat = Sdl.Event.get ev Sdl.Event.keyboard_repeat in - match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with - | `Text_editing -> `None + let r = (match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with + | `Text_editing -> `Unknown (Format.sprintf "`Text_editing %s" (Sdl.Event.get ev Sdl.Event.text_editing_text)) | `Text_input -> `Text_input (Sdl.Event.get ev Sdl.Event.text_input_text) | `Key_down -> if repeat < 1 then `Key_down (key_of_sdlkey ev) else `None | `Key_up -> if repeat < 1 then `Key_up (key_of_sdlkey ev) else `None | `Mouse_motion -> let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy | `Quit -> `Quit - | _ -> (*F.epr "Unknown Event@." ; *) `None + (* Unhandled events *) + | `App_did_enter_background -> `Unknown "`App_did_enter_background" + | `App_did_enter_foreground -> `Unknown "`App_did_enter_foreground " + | `App_low_memory -> `Unknown "`App_low_memory " + | `App_terminating -> `Unknown "`App_terminating " + | `App_will_enter_background -> `Unknown "`App_will_enter_background " + | `App_will_enter_foreground -> `Unknown "`App_will_enter_foreground " + | `Clipboard_update -> `Unknown "`Clipboard_update " + | `Controller_axis_motion -> `Unknown "`Controller_axis_motion " + | `Controller_button_down -> `Unknown "`Controller_button_down " + | `Controller_button_up -> `Unknown "`Controller_button_up " + | `Controller_device_added -> `Unknown "`Controller_device_added " + | `Controller_device_remapped -> `Unknown "`Controller_device_remapped " + | `Controller_device_removed -> `Unknown "`Controller_device_removed " + | `Dollar_gesture -> `Unknown "`Dollar_gesture " + | `Dollar_record -> `Unknown "`Dollar_record " + | `Drop_file -> `Unknown "`Drop_file " + | `Finger_down -> `Unknown "`Finger_down" + | `Finger_motion -> `Unknown "`Finger_motion " + | `Finger_up -> `Unknown "`Finger_up " + | `Joy_axis_motion -> `Unknown "`Joy_axis_motion " + | `Joy_ball_motion -> `Unknown "`Joy_ball_motion " + | `Joy_button_down -> `Unknown "`Joy_button_down " + | `Joy_button_up -> `Unknown "`Joy_button_up " + | `Joy_device_added -> `Unknown "`Joy_device_added " + | `Joy_device_removed -> `Unknown "`Joy_device_removed " + | `Joy_hat_motion -> `Unknown "`Joy_hat_motion " + | `Mouse_button_down -> `Unknown "`Mouse_button_down " + | `Mouse_button_up -> `Unknown "`Mouse_button_up" + | `Mouse_wheel -> `Unknown "`Mouse_wheel " + | `Multi_gesture -> `Unknown "`Multi_gesture" + | `Sys_wm_event -> `Unknown "`Sys_wm_event " + | `Unknown e -> `Unknown (Format.sprintf "`Unknown %d " e) + | `User_event -> `Unknown "`User_event " + | `Window_event -> `Unknown "`Window_event " + | `Display_event -> `Unknown "`Display_event " + | `Sensor_update -> `Unknown "`Sensor_update ") in + F.epr "event_of_sdlevent: %s@." (to_string r); + r let key_up : Sdl.keycode = 0x40000052 @@ -616,7 +678,9 @@ let default_bindings = add [{ mods = m [Meta]; code = Delete }] [Zed Kill_prev_word]; add [{ mods = m [Ctrl]; code = Delete }] [Zed Kill_next_word]; add [{ mods = m [Meta]; code = Char(UChar.of_char 'd') }] [Zed Kill_next_word]; - add [{ mods = m [Ctrl]; code = Char(UChar.of_char '_') }] [Zed Undo]; + add [{ mods = m [Ctrl]; code = Char(UChar.of_char '/') }] [Zed Undo]; + add [{ mods = m [Ctrl]; code = Char(UChar.of_char 'x')}; + {mods = m []; code = Char(UChar.of_char 'u')}] [Zed Undo]; !b type textedit = { ze : unit Zed_edit.t; @@ -654,10 +718,7 @@ let draw_textedit (te : textedit) height (s : Display.state) = | Continue _ -> () | Rejected -> ()) | `Key_up _ -> () - | `Text_input s -> - let zs = (Zed_string.of_utf8 s) in - F.epr "draw_textedit: `Text_input %s@." (Zed_string.to_utf8 zs); - Zed_edit.insert ctx (Zed_rope.of_string zs) + | `Text_input s -> Zed_edit.insert ctx (Zed_rope.of_string (Zed_string.of_utf8 s)) | _ -> ()) s.events; draw_pp height (fun pp -> @@ -835,4 +896,3 @@ let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) !draw_komm) () (* Implement the "window management" as just toplevel defined functions that manipulate the window tree *) -