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

no more warnings

Browse Source
This commit is contained in:
cqc
2021-07-15 20:46:46 -05:00
parent 23d25aaa86
commit 88f734b7d9
2 changed files with 44 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
bin/main.ml
View File

@ -1,4 +1,4 @@
[@@@ocaml.warning "-6-9-26-27"]
(*[@@@ocaml.warning "-6-9-26-27"] *)
open Lwt.Infix
module F = Fmt
@ -86,8 +86,8 @@ module Topmain = struct
Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
let first_line = ref true
let read_interactive_input = ref (fun _ _ _ -> (0, false))
let refill_lexbuf buffer len =
let read_interactive_input = ref (fun _ _ -> (0, false))
let refill_lexbuf buffer _ =
let prompt =
if !Clflags.noprompt then ""
else if !first_line then "# "
@ -96,7 +96,7 @@ module Topmain = struct
else " "
in
first_line := false;
let (len, eof) = !read_interactive_input prompt buffer len in
let (len, eof) = !read_interactive_input prompt buffer in
(* F.epr "refill_lexbuf: %s %b \n" (Bytes.sub_string buffer 0 len) eof ; *)
if eof then Location.echo_eof ();
len
@ -109,7 +109,7 @@ module Topmain = struct
let eval lb ppf (text:string) =
F.epr "Topmain.eval: \n";
read_interactive_input := (
fun prompt buffer len ->
fun prompt buffer ->
F.epr "Topmain.eval: read_interactive_input \n";
F.text ppf prompt; F.flush ppf ();
let i = ref 0 in
@ -176,14 +176,13 @@ module Topmain = struct
end
module Display = struct
open Wall
open Tgles2
open Tsdl
open Gg
open CamomileLibrary
let (>>=) x f = match x with
| Ok a -> f a
| Error x as result -> result
| Error _ as result -> result
let get_result = function
| Ok x -> x
@ -209,24 +208,8 @@ module Display = struct
let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0);
keycode=0; scancode=0;
shift=false; ctrl=false; meta=false; fn=false}
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 keycode = Sdl.Event.get ev Sdl.Event.keyboard_keycode in
@ -261,24 +244,18 @@ module Display = struct
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
| _, {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 *)
type state = { box: box2; (* This is cannonically box within which the next element should draw *)
time: float;
events: event list;
wall: Wall.renderer;
}
wall: Wall.renderer; }
type image = (box2 * Wall.image) (* the box2 here is cannonically the place the returner drew
(the Wall.image extents) *)
@ -336,19 +313,18 @@ module Display = struct
else Sdl.Window.windowed)
: _ result)); None
| `Key_up a -> Some (`Key_up a)
| `Key_down a -> (*Some (`Key_up a)*) None
| `Key_down _ -> (*Some (`Key_up a)*) None
| `Mouse a -> Some (`Mouse a)
| e -> None
| _ -> None
(*| a -> Some a*)) !el;
if (List.length !el) > 0 then begin
F.epr "Passing in %d events\n" (List.length !el);
let (width, height) as physical_size = Sdl.gl_get_drawable_size frame.sdl_win in
let width = float width and height = float height in
let (state, (box, image)) = render { box = (Box2.v (P2.v 0. 0.) (P2.v width height));
let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
let _, (_, image) = render { box = (Box2.v (P2.v 0. 0.) (P2.v (float width) (float height)));
time = ticks (); events = !el; wall = frame.wall} in
Sdl.gl_make_current frame.sdl_win frame.gl >>= fun () ->
let (width, height) as physical_size = Sdl.gl_get_drawable_size frame.sdl_win in
let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
Gl.viewport 0 0 width height;
Gl.clear_color 0.0 0.0 0.0 1.0;
Gl.(clear (color_buffer_bit lor depth_buffer_bit lor stencil_buffer_bit));
@ -410,21 +386,17 @@ let draw_label text b =
let fill_box c b (s:Display.state) =
(s, (b, I.paint (Paint.color c)
(I.fill_path @@ fun t -> P.rect t (Box2.ox b) (Box2.oy b) (Box2.w b) (Box2.h b))))
(I.fill_path @@ fun t -> P.rect t ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b) ~h:(Box2.h b))))
let path_box c b (s:Display.state) =
(s, (b, I.paint (Paint.color c)
(I.stroke_path
(Outline.make ()) @@ fun t -> P.rect t (Box2.ox b) (Box2.oy b) (Box2.w b) (Box2.h b))))
(Outline.make ()) @@ fun t -> P.rect t ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b) ~h:(Box2.h b))))
let path_circle c b (s:Display.state) =
(s, (b, I.paint (Paint.color c)
(I.stroke_path
(Outline.make ()) @@ fun t -> P.circle t (Box2.midx b) (Box2.midy b) ((Box2.w b) /. 2.))))
let layout_hor v () = []
let layout_ver v () = []
(Outline.make ()) @@ fun t -> P.circle t ~cx:(Box2.midx b) ~cy:(Box2.midy b) ~r:((Box2.w b) /. 2.))))
(* draws the second item below if there's room *)
let pane_vbox (subpanes:Display.pane list) (so:Display.state) =
@ -466,7 +438,7 @@ let pane_label text height ~subpanes (s:Display.state) =
I.paint (* red box *)
(Paint.color (Color.v 0.5 0.125 0.125 1.0))
(I.stroke_path (Outline.make ()) @@
fun t -> P.rect t (Box2.ox s.box) (Box2.oy s.box) (Box2.w s.box) height);
fun t -> P.rect t ~x:(Box2.ox s.box) ~y:(Box2.oy s.box) ~w:(Box2.w s.box) ~h:height);
label_image; ])
@ -513,7 +485,7 @@ let draw_pp height fpp (s:Display.state) =
let so = !sc in
let bo = Box2.v (Box2.o !sc.box) (P2.v ((float n) *. wpx) height) in
let bsp = (Box2.v (Box2.br_pt !box) (P2.v wpx height)) in
push @@ pane_hbox (List.init n (fun n -> path_circle (Color.v 0.125 1.0 0.125 0.125) bsp)) !sc;
push @@ pane_hbox (List.init n (fun _ -> path_circle (Color.v 0.125 1.0 0.125 0.125) bsp)) !sc;
box := bo;
sc := {!sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box)};
in
@ -562,27 +534,27 @@ let draw_textedit (te:textedit) height (s:Display.state) =
List.iter (function
| `Key_up (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
| {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 _ -> ()
| _ -> ()) s.events;
draw_pp 30. (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 before_cursor = Zed_string.to_utf8 (Zed_rope.to_string zrb) in
let after_cursor = Zed_string.to_utf8 (Zed_rope.to_string zra) in
@ -601,7 +573,6 @@ type storeview = {s:Store.t; path:string list}
let make_storeview storepath branch ?(path=[]) () =
{s=Lwt_main.run (Store.of_branch (Lwt_main.run (Store.Repo.v (Irmin_git.config storepath))) branch) ;path}
let draw_storeview (r:storeview) height (s:Display.state) =
let from = [] in (* future optional arg *)
let indent = ref 0 in
let rec draw_levels (tree:(string * Store.tree) list) pp =
indent := !indent + 1;
@ -637,7 +608,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'; ctrl=true; shift=false; meta=false; fn=false; _} ->
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))));
@ -646,7 +617,7 @@ let draw_top (t:top) height (s:Display.state) =
| _ -> ());
pane_vbox [
draw_textedit t.te height;
draw_pp 30. (fun pp ->
draw_pp height (fun pp ->
Format.pp_open_hvbox pp 0;
F.text pp (Buffer.contents t.res);
F.pf pp "@.";
@ -661,13 +632,13 @@ 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) 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
| _ -> (); end;*)
(* let mouse_x, mouse_y = !mouse_state in *)
push @@ fill_box (Display.gray 0.125) s.box !state; (* gray bg *)
push @@ pane_vbox [
draw_top top_1 20.;
draw_top top_1 25.;
] {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))