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

needs more shortcuts

Browse Source
This commit is contained in:
cqc
2021-07-15 00:15:19 -05:00
parent ca5ea42759
commit 51788b8a6a
1 changed files with 109 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files

189
bin/main.ml
View File

@ -70,22 +70,35 @@ module Display = struct
open Sdl.K open Sdl.K
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
(* | `App_did_enter_background | `App_did_enter_foreground | `App_low_memory | `App_terminating
| `App_will_enter_background | `App_will_enter_foreground | `Clipboard_update
| `Dollar_gesture | `Dollar_record
| `Mouse_button_down | `Mouse_button_up | `Mouse_motion | `Mouse_wheel | `Multi_gesture
| `Sys_wm_event | `Text_editing | `Text_input | `User_event | `Window_event | `Display_event
| `Sensor_update | `Drop_file | `Finger_down | `Finger_motion | `Finger_up -> None (* LOG *)
| `Unknown a -> None (* LOG *)
| `Controller_axis_motion | `Controller_button_down | `Controller_button_up | `Controller_device_added
| `Controller_device_remapped | `Controller_device_removed
| `Joy_axis_motion | `Joy_ball_motion | `Joy_button_down | `Joy_button_up | `Joy_device_added
| `Joy_device_removed | `Joy_hat_motion -> None
*)
| `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 kc = 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 kc land Sdl.K.scancode_mask > 0 then 0 else kc) in let uchar = CamomileLibrary.UChar.of_int (if keycode land Sdl.K.scancode_mask > 0 then 0 else keycode) in
let k = { let k = { char=(UChar.char_of uchar); uchar; keycode;
char=(UChar.char_of uchar);
uchar=uchar;
keycode=kc;
scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode; scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode;
shift = (km land Sdl.Kmod.shift)>0; shift = (km land Sdl.Kmod.shift)>0;
ctrl = (km land Sdl.Kmod.ctrl)>0; ctrl = (km land Sdl.Kmod.ctrl)>0;
meta = (km land Sdl.Kmod.alt)>0; meta = (km land Sdl.Kmod.alt)>0;
fn = (km land Sdl.Kmod.gui)>0; } in 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" kc (CamomileLibrary.UChar.char_of k.uchar) k.scancode F.epr "keycode=%x uchar=%C scancode=%x keyname=%s (%s %s %s %s)\n" keycode
(Sdl.get_key_name kc) (CamomileLibrary.UChar.char_of k.uchar) k.scancode
(Sdl.get_key_name keycode)
(if k.shift then " shift" else "") (if k.shift then " shift" else "")
(if k.ctrl then " ctrl" else "") (if k.ctrl then " ctrl" else "")
(if k.meta then " meta" else "") (if k.meta then " meta" else "")
@ -94,7 +107,7 @@ module Display = struct
| `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
| _ -> `None | _ -> F.epr "Unknown Event@." ; `None
let str_of_scancode = Sdl.get_key_name let str_of_scancode = Sdl.get_key_name
let key_shift_map = let key_shift_map =
@ -148,7 +161,7 @@ module Display = struct
let make_frame ?(title="komm") ~w ~h = let make_frame ?(title="komm") ~w ~h =
Lazy.force video_initialized >>= fun () -> Lazy.force video_initialized >>= fun () ->
Sdl.create_window ~w ~h title Sdl.create_window ~w ~h title
Sdl.Window.(opengl + allow_highdpi + input_grabbed) Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*))
>>= fun sdl_win -> >>= fun sdl_win ->
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);
@ -163,12 +176,11 @@ module Display = struct
let tstart = ticks () in let tstart = ticks () in
let ev = Sdl.Event.create () in let ev = Sdl.Event.create () in
let el = ref [`None] in let el = ref [`None] in
while Sdl.poll_event (Some ev) do while Sdl.wait_event_timeout (Some ev) 50 (* HACK *) do
let e = event_of_sdlevent ev in let e = event_of_sdlevent ev in
if e != `None then el := e :: !el if e != `None then el := !el @ [e] (* HACK? *)
done; done;
(* Filter the events *)
(* Handle some of the events *)
el := List.filter_map el := List.filter_map
(function (function
| `Quit -> frame.quit <- true; None | `Quit -> frame.quit <- true; None
@ -182,8 +194,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 a -> (*Some (`Key_up a)*) None
| `Mouse a -> Some (`Mouse a) | `Mouse a -> Some (`Mouse a)
| _ -> None | e -> None
(*| 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);
@ -204,7 +217,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.2fsec\n" (ticks () -. tstart); Ok () end F.epr "event loop took %0.2fms?\n" (ticks () -. tstart); Ok () end
else Ok () else Ok ()
let run frame render () = let run frame render () =
@ -505,11 +518,8 @@ module Topmain = struct
Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
let first_line = ref true let first_line = ref true
let got_eof = ref false let read_interactive_input = ref (fun _ _ _ -> (0, false))
let refill_lexbuf buffer len = let refill_lexbuf buffer len =
F.pr "refill_lexbuf: \n";
if !got_eof then (got_eof := false; 0) else begin
let prompt = let prompt =
if !Clflags.noprompt then "" if !Clflags.noprompt then ""
else if !first_line then "# " else if !first_line then "# "
@ -518,66 +528,21 @@ module Topmain = struct
else " " else " "
in in
first_line := false; first_line := false;
let (len, eof) = !Toploop.read_interactive_input prompt buffer len in let (len, eof) = !read_interactive_input prompt buffer len in
if eof then begin (* F.epr "refill_lexbuf: %s %b \n" (Bytes.sub_string buffer 0 len) eof ; *)
Location.echo_eof (); if eof then Location.echo_eof ();
if len > 0 then got_eof := true;
len len
end else
len
end
exception PPerror exception PPerror
(* Phase buffer that stores the last toplevel phrase (see (* Phase buffer that stores the last toplevel phrase (see
[Location.input_phrase_buffer]). *) [Location.input_phrase_buffer]). *)
let phrase_buffer = Buffer.create 1024 let phrase_buffer = Buffer.create 1024
let loop ppf = type evalenv = Format.formatter -> string -> unit
F.pr "Toploop.loop: \n"; let eval lb ppf (text:string) =
Clflags.debug := true; F.epr "Topmain.eval: \n";
Location.formatter_for_warnings := ppf; read_interactive_input := (
if not !Clflags.noversion then
F.pf ppf " OCaml version %s@.@." Config.version;
begin
try Toploop.initialize_toplevel_env ()
with Env.Error _ | Typetexp.Error _ as exn ->
Location.report_exception ppf exn; raise Exit
end;
let lb = Lexing.from_function refill_lexbuf in
Location.init lb "//toplevel//";
Location.input_name := "//toplevel//";
Location.input_lexbuf := Some lb;
Location.input_phrase_buffer := Some phrase_buffer;
Sys.catch_break true;
Toploop.run_hooks Toploop.After_setup;
(*Toploop.load_ocamlinit ppf;*)
let snap = Btype.snapshot () in
try
Lexing.flush_input lb;
(* Reset the phrase buffer when we flush the lexing buffer. *)
Buffer.reset phrase_buffer;
Location.reset();
Warnings.reset_fatal ();
first_line := true;
let phr = try !Toploop.parse_toplevel_phrase lb with Exit -> raise PPerror in
let phr = Toploop.preprocess_phrase ppf phr in
Env.reset_cache_toplevel ();
ignore(Toploop.execute_phrase true ppf phr)
with
| End_of_file -> raise Exit
| Sys.Break -> F.pf ppf "Interrupted.@."; Btype.backtrack snap
| PPerror -> ()
| x -> Location.report_exception ppf x; Btype.backtrack snap
let main ppf (text:string) () =
Compenv.readenv ppf Before_args;
Compenv.readenv ppf Before_link;
Compmisc.read_clflags_from_env ();
if not (prepare ppf) then raise Exit;
Compmisc.init_path ();
Toploop.read_interactive_input := (
fun prompt buffer len -> fun prompt buffer len ->
F.epr "Topmain.eval: read_interactive_input \n";
F.text ppf prompt; F.flush ppf (); F.text ppf prompt; F.flush ppf ();
let i = ref 0 in let i = ref 0 in
try try
@ -592,16 +557,54 @@ module Topmain = struct
(!i, true) (!i, true)
| Exit -> | Exit ->
(!i, false)); (!i, false));
loop ppf let snap = Btype.snapshot () in
try
Buffer.reset phrase_buffer; (* Reset the phrase buffer, then flush the lexing buffer. *)
Lexing.flush_input lb;
F.epr "eval: 1. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
Location.reset();
Warnings.reset_fatal ();
first_line := true;
let phr = try !Toploop.parse_toplevel_phrase lb with Exit -> raise PPerror in
F.epr "eval: 2. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
let phr = Toploop.preprocess_phrase ppf phr in
Env.reset_cache_toplevel ();
F.epr "eval: 3. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
ignore(Toploop.execute_phrase true ppf phr);
F.epr "eval: 4. phrase_buffer=%s\n" (Buffer.contents phrase_buffer)
with
| End_of_file -> F.epr "Topmain.eval End_of_file exception\n"; Btype.backtrack snap
| Sys.Break -> F.epr "Topmain.eval Sys.Break exception\n"; F.pf ppf "Interrupted.@."; Btype.backtrack snap
| PPerror -> F.epr "Topmain.eval PPerror exception\n"; ()
| x -> F.epr "Topmain.eval unknown exception\n"; Location.report_exception ppf x; Btype.backtrack snap
(*done*)
let init ppf =
F.epr "Topmain.init: \n";
(* how to handle an exception: Compenv.readenv ppf Before_args;
let main p = Compenv.readenv ppf Before_link;
match main p () with Compmisc.read_clflags_from_env ();
| exception Exit -> () if not (prepare ppf) then raise Exit;
| () -> () Compmisc.init_path ();
*) Clflags.debug := true;
Location.formatter_for_warnings := ppf;
if not !Clflags.noversion then
F.pf ppf "OCaml version %s@.@." Config.version;
begin
try Toploop.initialize_toplevel_env ()
with Env.Error _ | Typetexp.Error _ as exn ->
Location.report_exception ppf exn; raise Exit
end;
let lb = Lexing.from_function refill_lexbuf in
Location.init lb "//toplevel//";
Location.input_name := "//toplevel//";
Location.input_lexbuf := Some lb;
Location.input_phrase_buffer := Some phrase_buffer;
Sys.catch_break true;
Toploop.run_hooks Toploop.After_setup;
(*Toploop.load_ocamlinit ppf;*)
(*while true do*)
eval lb
end end
type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t} type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t}
@ -616,9 +619,12 @@ let draw_textedit (te:textedit) height (s:Display.state) =
| {keycode=0x40000050}(*left*) -> ignore (Zed_edit.prev_char ctx) | {keycode=0x40000050}(*left*) -> ignore (Zed_edit.prev_char ctx)
| {keycode=0x4000004f}(*right*)-> ignore (Zed_edit.next_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='\r'; ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.newline ctx
| {char='\b';} -> Zed_edit.remove_prev ctx 1 | {char='b'; ctrl=true; shift=false; meta=false; fn=false} -> Zed_edit.prev_char ctx
| {char='\t'} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t') | {char='\b'; ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.remove_prev ctx 1
| _ -> Zed_edit.insert_char ctx (Display.key_to_uchar k); ()) | {char='\t'; ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t')
| _ ->
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 _ -> () | `Key_down _ -> ()
| _ -> ()) s.events; | _ -> ()) s.events;
draw_pp 30. (fun pp -> draw_pp 30. (fun pp ->
@ -636,14 +642,17 @@ let draw_textedit (te:textedit) height (s:Display.state) =
F.pf pp "@.@.";) s F.pf pp "@.@.";) s
let str_of_textedit (te:textedit) = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text te.ze)) let str_of_textedit (te:textedit) = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text te.ze))
type top_instance = {te: textedit; res: Buffer.t} type top_instance = {te: textedit; res: Buffer.t; mutable eval: Topmain.evalenv option}
let make_top () = {te = (make_textedit ()); res = Buffer.create 1024} let make_top () = {te=(make_textedit ()); res=Buffer.create 1024;eval=None}
let draw_top (t:top_instance) height (s:Display.state) = let draw_top (t:top_instance) height (s:Display.state) =
let eval = match t.eval with
None -> let e = (Topmain.init (Format.formatter_of_buffer t.res)) in t.eval <- Some e; e
| 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'; ctrl=true; shift=false; meta=false; fn=false} ->
Buffer.clear t.res; Buffer.clear t.res;
Topmain.main (Format.formatter_of_buffer t.res) (str_of_textedit t.te) (); () eval (Format.formatter_of_buffer t.res) (str_of_textedit t.te); ()
| _ -> ()); | _ -> ());
pane_vbox [ pane_vbox [
draw_textedit t.te 30.; draw_textedit t.te 30.;
@ -661,7 +670,7 @@ let mouse_state = ref (0,0)
let draw_komm (s:Display.state) = let draw_komm (s:Display.state) =
let node, state, box = ref I.empty, ref s, ref s.box in let node, state, box = ref I.empty, ref s, ref s.box in
let push (s, (b, i)) = node := I.stack !node i; state := s; box := b in let push (s, (b, i)) = node := I.stack !node i; state := s; box := b in
begin match List.find_opt (function `Mouse a -> true | _ -> false) (List.rev s.events) with begin match List.find_opt (function `Mouse a -> true | _ -> false) s.events with
Some (`Mouse a) -> mouse_state := a Some (`Mouse a) -> mouse_state := a
| _ -> (); end; | _ -> (); end;
let mouse_x, mouse_y = !mouse_state in let mouse_x, mouse_y = !mouse_state in
@ -683,7 +692,7 @@ let draw_komm (s:Display.state) =
Format.fprintf pp "@[%s@ %d@]@." "x =" 1; Format.fprintf pp "@[%s@ %d@]@." "x =" 1;
Format.pp_close_box pp (); Format.pp_close_box pp ();
Format.pp_print_flush pp ())*) Format.pp_print_flush pp ())*)
] {s with box = (Box2.v P2.o (Size2.v (float mouse_x) (float mouse_y)))}; ] {s with box = !state.box (*(Box2.v P2.o (Size2.v (float mouse_x) (float mouse_y)))*)};
(!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node)) (!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node))
let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900) draw_komm) () let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900) draw_komm) ()