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

better textedit and other stuff

Browse Source
This commit is contained in:
cqc
2021-07-19 17:48:05 -05:00
parent 793a502816
commit c091f951f4
2 changed files with 57 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
bin/main.ml
View File

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