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

1
bin/dune
View File

@ -1,6 +1,7 @@
(executables (executables
(names main example lumppile) (names main example lumppile)
(modes byte) (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)) (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))

117
bin/main.ml
View File

@ -98,67 +98,63 @@ module Display = struct
| Ok x -> x | Ok x -> x
| Error (`Msg msg) -> failwith msg | Error (`Msg msg) -> failwith msg
type keymod = Shift | Ctrl | Meta | Fn
type key = { type key = {
char:char; char:char;
uchar:CamomileLibrary.UChar.t; uchar:CamomileLibrary.UChar.t;
keycode:Sdl.keycode; keycode:Sdl.keycode;
scancode:Sdl.scancode; scancode:Sdl.scancode;
shift:bool; mods:keymod list}
ctrl:bool;
meta:bool;
fn:bool; }
type mouse = (int * int) type mouse = (int * int)
type event = [ `Key_down of key type event = [ `Key_down of key
| `Key_up of key | `Key_up of key
| `Text_editing of string
| `Text_input of string
| `Mouse of mouse | `Mouse of mouse
| `Quit | `Quit
| `Fullscreen of bool | `Fullscreen of bool
| `None ] | `None ]
let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0); let str_of_key k = Printf.sprintf "(char=%C;uchar=%C;keycode=%x;scancode=%x;name=%s;(%s%s%s%s))"
keycode=0; scancode=0; k.char (CamomileLibrary.UChar.char_of k.uchar) k.keycode k.scancode
shift=false; ctrl=false; meta=false; fn=false} (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 = let event_of_sdlevent ev =
match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with 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 -> | `Key_down | `Key_up as w ->
let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in
let keycode = Sdl.Event.get ev Sdl.Event.keyboard_keycode 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 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; let k = { char=(UChar.char_of uchar); uchar; keycode;
scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode; scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode; mods} in
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
(match w with `Key_down -> F.epr "key_down: " | `Key_up -> F.epr "key_up: "); (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 F.epr "%s@." (str_of_key k);
(CamomileLibrary.UChar.char_of k.uchar) k.scancode let repeat = (Sdl.Event.get ev Sdl.Event.keyboard_repeat) in
(Sdl.get_key_name keycode) F.epr "\tkeyboard_repeat=%d\n" repeat ;
(if k.shift then " shift" else "") if repeat < 1 then (match w with `Key_down -> `Key_down k | `Key_up -> `Key_up k) else `None
(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)
| `Mouse_motion -> | `Mouse_motion ->
let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy
| `Quit -> F.epr "Quit Event\n"; `Quit | `Quit -> F.epr "Quit Event\n"; `Quit
| _ -> F.epr "Unknown Event@." ; `None | _ -> F.epr "Unknown Event@." ; `None
let str_of_scancode = Sdl.get_key_name let key_up : Sdl.keycode = 0x40000052
let key_shift_map = let key_down : Sdl.keycode = 0x40000051
[('1','!');('2','@');('3','#');('4','$');('5','%'); let key_left : Sdl.keycode = 0x40000050
('6','^');('7','&');('8','*');('9','(');('0',')'); 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 let handle_keyevents (el:event list) f = List.iter f el
(* current window state to be passed to window renderer *) (* current window state to be passed to window renderer *)
@ -177,7 +173,7 @@ module Display = struct
mutable quit: bool; mutable quit: bool;
mutable fullscreen: 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 let on_failure ~cleanup result = begin
match result with match result with
@ -192,6 +188,7 @@ module Display = struct
Sdl.create_window ~w ~h title Sdl.create_window ~w ~h title
Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*)) Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*))
>>= fun sdl_win -> >>= fun sdl_win ->
Sdl.set_window_title sdl_win title;
ignore (Sdl.gl_set_swap_interval (-1)); ignore (Sdl.gl_set_swap_interval (-1));
ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1); ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1);
on_failure ( on_failure (
@ -223,9 +220,9 @@ module Display = struct
else Sdl.Window.windowed) else Sdl.Window.windowed)
: _ result)); None : _ result)); None
| `Key_up a -> Some (`Key_up a) | `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) | `Mouse a -> Some (`Mouse a)
| _ -> None | a -> Some a
(*| a -> Some a*)) !el; (*| a -> Some a*)) !el;
if (List.length !el) > 0 then begin if (List.length !el) > 0 then begin
F.epr "Passing in %d events\n" (List.length !el); 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 let width = float width and height = float height in
Wall.Renderer.render frame.wall ~width ~height image; Wall.Renderer.render frame.wall ~width ~height image;
Sdl.gl_swap_window frame.sdl_win; 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 () else Ok ()
let run frame render () = let run frame render () =
@ -314,7 +311,6 @@ let pane_vbox (subpanes:Display.pane list) (so:Display.state) =
List.fold_left List.fold_left
(fun (sp, (_, ip)) (pane:Display.pane) -> (fun (sp, (_, ip)) (pane:Display.pane) ->
let sr, (br, ir) = pane sp in 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 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]))) ({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 (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 += Color_fg of Wall.color
type Format.stag += Cursor of Wall.color type Format.stag += Cursor of Wall.color
let draw_pp height fpp (s:Display.state) = 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 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 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 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 draw_textedit (te:textedit) height (s:Display.state) =
let ctx = Zed_edit.context te.ze te.zc in let ctx = Zed_edit.context te.ze te.zc in
List.iter (function List.iter (function
| `Key_up (k:Display.key) -> | `Key_down (k:Display.key) ->
(match k with (match k with
| {keycode=0x40000052; _}(*up*) -> ignore (Zed_edit.prev_line ctx) | {keycode=kc;mods=[]; _} when kc = Display.key_up -> Zed_edit.prev_line ctx
| {keycode=0x40000051; _}(*down*) -> ignore (Zed_edit.next_line ctx) | {keycode=kc;mods=[]; _} when kc = Display.key_down -> Zed_edit.next_line ctx
| {keycode=0x40000050; _}(*left*) -> ignore (Zed_edit.prev_char ctx) | {keycode=kc;mods=[]; _} when kc = Display.key_left -> Zed_edit.prev_char ctx
| {keycode=0x4000004f; _}(*right*)-> ignore (Zed_edit.next_char ctx) | {keycode=kc;mods=[]; _} when kc = Display.key_right-> Zed_edit.next_char ctx
| {char='\r'; ctrl=false; shift=false; meta=false; fn=false; _} -> Zed_edit.newline ctx | {char='\r'; mods=[]; _} -> Zed_edit.newline ctx
| {char='b'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.prev_char ctx | {char='b'; mods=[Ctrl]; _} -> Zed_edit.prev_char ctx
| {char='f'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.next_char ctx | {char='f'; mods=[Ctrl]; _} -> Zed_edit.next_char ctx
| {char='a'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.goto_bol ctx | {char='a'; mods=[Ctrl]; _} -> Zed_edit.goto_bol ctx
| {char='e'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.goto_eol ctx | {char='e'; mods=[Ctrl]; _} -> Zed_edit.goto_eol ctx
| {char='d'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.remove_next ctx 1 | {char='d'; mods=[Ctrl]; _} -> Zed_edit.remove_next ctx 1
| {char='d'; ctrl=false; shift=false; meta=true; fn=false; _} -> Zed_edit.kill_next_word ctx | {char='d'; mods=[Meta]; _} -> Zed_edit.kill_next_word ctx
| {char='\b'; ctrl=false; shift=false; meta=false; fn=false; _} -> Zed_edit.remove_prev ctx 1 | {char='\b'; mods=[]; _} -> Zed_edit.remove_prev ctx 1
| {char='\b'; ctrl=false; shift=false; meta=true; fn=false; _} -> Zed_edit.kill_prev_word ctx | {char='\b'; mods=[Meta]; _} -> 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='\t'; mods=[]; _} -> 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 | {char='k'; mods=[Ctrl]; _} -> Zed_edit.kill_next_line ctx
| _ -> | _ -> ())
let c = Display.key_to_uchar k in | `Key_up _ -> ()
if Zed_char.is_printable c then Zed_edit.insert_char ctx (Display.key_to_uchar k); ()) | `Text_input s -> F.epr "draw_textedit: `Text_input %s@." s;
| `Key_down _ -> () Zed_edit.insert ctx (Zed_rope.of_string (Zed_string.of_utf8 s)); ()
| _ -> ()) s.events; | _ -> ()) s.events;
draw_pp height (fun pp -> draw_pp height (fun pp ->
let zrb, zra = Zed_rope.break (Zed_edit.text te.ze) (Zed_cursor.get_position te.zc) in 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 | Some e -> e in
Display.handle_keyevents s.events Display.handle_keyevents s.events
(function (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); 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 -> ignore (Lwt_main.run (Store.tree t.storeview.s >>= (fun tree ->
Store.Tree.add tree t.path (str_of_textedit t.te)))); Store.Tree.add tree t.path (str_of_textedit t.te))));