From 51788b8a6ae90de6b0c5f807f19f7fdb0189a9d0 Mon Sep 17 00:00:00 2001 From: cqc Date: Thu, 15 Jul 2021 00:15:19 -0500 Subject: [PATCH] needs more shortcuts --- bin/main.ml | 209 +++++++++++++++++++++++++++------------------------- 1 file changed, 109 insertions(+), 100 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 9f3aeb6..53d35a3 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -70,22 +70,35 @@ module Display = struct open Sdl.K let event_of_sdlevent ev = 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 -> let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in - let kc = 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 k = { - char=(UChar.char_of uchar); - uchar=uchar; - keycode=kc; - 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 + 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 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 (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 - (Sdl.get_key_name kc) + 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 "") @@ -94,7 +107,7 @@ module Display = struct | `Mouse_motion -> let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy | `Quit -> F.epr "Quit Event\n"; `Quit - | _ -> `None + | _ -> F.epr "Unknown Event@." ; `None let str_of_scancode = Sdl.get_key_name let key_shift_map = @@ -148,7 +161,7 @@ module Display = struct let make_frame ?(title="komm") ~w ~h = Lazy.force video_initialized >>= fun () -> Sdl.create_window ~w ~h title - Sdl.Window.(opengl + allow_highdpi + input_grabbed) + Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*)) >>= fun sdl_win -> ignore (Sdl.gl_set_swap_interval (-1)); ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1); @@ -163,14 +176,13 @@ module Display = struct let tstart = ticks () in let ev = Sdl.Event.create () 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 - if e != `None then el := e :: !el + if e != `None then el := !el @ [e] (* HACK? *) done; - - (* Handle some of the events *) + (* Filter the events *) el := List.filter_map - (function + (function | `Quit -> frame.quit <- true; None | `Fullscreen a -> if a then ( @@ -182,8 +194,9 @@ module Display = struct else Sdl.Window.windowed) : _ result)); None | `Key_up a -> Some (`Key_up a) + | `Key_down a -> (*Some (`Key_up a)*) None | `Mouse a -> Some (`Mouse a) - | _ -> None + | e -> None (*| a -> Some a*)) !el; if (List.length !el) > 0 then begin 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 Wall.Renderer.render frame.wall ~width ~height image; 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 () let run frame render () = @@ -505,11 +518,8 @@ module Topmain = struct Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs let first_line = ref true - let got_eof = ref false - - let refill_lexbuf buffer len = - F.pr "refill_lexbuf: \n"; - if !got_eof then (got_eof := false; 0) else begin + let read_interactive_input = ref (fun _ _ _ -> (0, false)) + let refill_lexbuf buffer len = let prompt = if !Clflags.noprompt then "" else if !first_line then "# " @@ -518,66 +528,21 @@ module Topmain = struct else " " in first_line := false; - let (len, eof) = !Toploop.read_interactive_input prompt buffer len in - if eof then begin - Location.echo_eof (); - if len > 0 then got_eof := true; - len - end else - len - end + let (len, eof) = !read_interactive_input prompt buffer len in + (* F.epr "refill_lexbuf: %s %b \n" (Bytes.sub_string buffer 0 len) eof ; *) + if eof then Location.echo_eof (); + len exception PPerror (* Phase buffer that stores the last toplevel phrase (see [Location.input_phrase_buffer]). *) let phrase_buffer = Buffer.create 1024 - let loop ppf = - F.pr "Toploop.loop: \n"; - 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;*) - 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 := ( + type evalenv = Format.formatter -> string -> unit + let eval lb ppf (text:string) = + F.epr "Topmain.eval: \n"; + read_interactive_input := ( fun prompt buffer len -> + F.epr "Topmain.eval: read_interactive_input \n"; F.text ppf prompt; F.flush ppf (); let i = ref 0 in try @@ -592,16 +557,54 @@ module Topmain = struct (!i, true) | Exit -> (!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*) - -(* how to handle an exception: - let main p = - match main p () with - | exception Exit -> () - | () -> () - *) + let init ppf = + F.epr "Topmain.init: \n"; + 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 (); + 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 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=0x4000004f}(*right*)-> ignore (Zed_edit.next_char ctx) | {char='\r'; ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.newline ctx - | {char='\b';} -> Zed_edit.remove_prev ctx 1 - | {char='\t'} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t') - | _ -> Zed_edit.insert_char ctx (Display.key_to_uchar k); ()) + | {char='b'; ctrl=true; shift=false; meta=false; fn=false} -> Zed_edit.prev_char ctx + | {char='\b'; ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.remove_prev ctx 1 + | {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 _ -> () | _ -> ()) s.events; draw_pp 30. (fun pp -> @@ -636,14 +642,17 @@ let draw_textedit (te:textedit) height (s:Display.state) = F.pf pp "@.@.";) s 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} -let make_top () = {te = (make_textedit ()); res = Buffer.create 1024} +type top_instance = {te: textedit; res: Buffer.t; mutable eval: Topmain.evalenv option} +let make_top () = {te=(make_textedit ()); res=Buffer.create 1024;eval=None} 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 (function | `Key_up {char='\r'; ctrl=true; shift=false; meta=false; fn=false} -> 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 [ draw_textedit t.te 30.; @@ -661,7 +670,7 @@ let mouse_state = ref (0,0) let draw_komm (s:Display.state) = 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 - 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 | _ -> (); end; let mouse_x, mouse_y = !mouse_state in @@ -681,9 +690,9 @@ let draw_komm (s:Display.state) = Format.fprintf pp "%f@." 0.2; Format.pp_print_if_newline pp (); Format.fprintf pp "@[%s@ %d@]@." "x =" 1; - Format.pp_close_box pp (); - Format.pp_print_flush pp ())*) - ] {s with box = (Box2.v P2.o (Size2.v (float mouse_x) (float mouse_y)))}; + Format.pp_close_box pp (); + Format.pp_print_flush pp ())*) + ] {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)) let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900) draw_komm) ()