console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

text editing and events

Browse Source
This commit is contained in:
cqc
2021-08-15 15:44:05 -05:00
parent 15efe3efdd
commit 75417c7699
1 changed files with 70 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

80
main.ml
View File

@ -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 *)