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

1
bin/dune
View File

@ -1,7 +1,6 @@
(executables (executables
(names main example lumppile) (names main example lumppile)
(modes byte) (modes byte)
(flags :standard -w -3-6-27-33)
(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

@ -1,4 +1,4 @@
[@@@ocaml.warning "-6-9-26-27"] (*[@@@ocaml.warning "-6-9-26-27"] *)
open Lwt.Infix open Lwt.Infix
module F = Fmt module F = Fmt
@ -86,8 +86,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 read_interactive_input = ref (fun _ _ _ -> (0, false)) let read_interactive_input = ref (fun _ _ -> (0, false))
let refill_lexbuf buffer len = let refill_lexbuf buffer _ =
let prompt = let prompt =
if !Clflags.noprompt then "" if !Clflags.noprompt then ""
else if !first_line then "# " else if !first_line then "# "
@ -96,7 +96,7 @@ module Topmain = struct
else " " else " "
in in
first_line := false; 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 ; *) (* F.epr "refill_lexbuf: %s %b \n" (Bytes.sub_string buffer 0 len) eof ; *)
if eof then Location.echo_eof (); if eof then Location.echo_eof ();
len len
@ -109,7 +109,7 @@ module Topmain = struct
let eval lb ppf (text:string) = let eval lb ppf (text:string) =
F.epr "Topmain.eval: \n"; F.epr "Topmain.eval: \n";
read_interactive_input := ( read_interactive_input := (
fun prompt buffer len -> fun prompt buffer ->
F.epr "Topmain.eval: read_interactive_input \n"; 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
@ -176,14 +176,13 @@ module Topmain = struct
end end
module Display = struct module Display = struct
open Wall
open Tgles2 open Tgles2
open Tsdl open Tsdl
open Gg open Gg
open CamomileLibrary open CamomileLibrary
let (>>=) x f = match x with let (>>=) x f = match x with
| Ok a -> f a | Ok a -> f a
| Error x as result -> result | Error _ as result -> result
let get_result = function let get_result = function
| Ok x -> x | Ok x -> x
@ -209,24 +208,8 @@ module Display = struct
let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0); let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0);
keycode=0; scancode=0; keycode=0; scancode=0;
shift=false; ctrl=false; meta=false; fn=false} shift=false; ctrl=false; meta=false; fn=false}
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 keycode = Sdl.Event.get ev Sdl.Event.keyboard_keycode 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 = let key_to_uchar k : UChar.t =
match (List.assoc_opt k.char key_shift_map), k with match (List.assoc_opt k.char key_shift_map), k with
| _, {char='\x00'} -> (UChar.of_char '\x00') | _, {char='\x00'; _} -> (UChar.of_char '\x00')
| Some k, {shift=true} -> (UChar.of_char k) | Some k, {shift=true; _} -> (UChar.of_char k)
| None, {shift=true} -> (UChar.of_char (Char.uppercase_ascii k.char)) | None, {shift=true; _} -> (UChar.of_char (Char.uppercase_ascii k.char))
| _, {shift=false} -> k.uchar | _, {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 *)
type state = { box: box2; (* This is cannonically box within which the next element should draw *) type state = { box: box2; (* This is cannonically box within which the next element should draw *)
time: float; time: float;
events: event list; events: event list;
wall: Wall.renderer; wall: Wall.renderer; }
}
type image = (box2 * Wall.image) (* the box2 here is cannonically the place the returner drew type image = (box2 * Wall.image) (* the box2 here is cannonically the place the returner drew
(the Wall.image extents) *) (the Wall.image extents) *)
@ -336,19 +313,18 @@ 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 | `Key_down _ -> (*Some (`Key_up a)*) None
| `Mouse a -> Some (`Mouse a) | `Mouse a -> Some (`Mouse a)
| e -> None | _ -> 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);
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
let width = float width and height = float height in let _, (_, image) = render { box = (Box2.v (P2.v 0. 0.) (P2.v (float width) (float height)));
let (state, (box, image)) = render { box = (Box2.v (P2.v 0. 0.) (P2.v width height));
time = ticks (); events = !el; wall = frame.wall} in time = ticks (); events = !el; wall = frame.wall} in
Sdl.gl_make_current frame.sdl_win frame.gl >>= fun () -> 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.viewport 0 0 width height;
Gl.clear_color 0.0 0.0 0.0 1.0; Gl.clear_color 0.0 0.0 0.0 1.0;
Gl.(clear (color_buffer_bit lor depth_buffer_bit lor stencil_buffer_bit)); 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) = let fill_box c b (s:Display.state) =
(s, (b, I.paint (Paint.color c) (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) = let path_box c b (s:Display.state) =
(s, (b, I.paint (Paint.color c) (s, (b, I.paint (Paint.color c)
(I.stroke_path (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) = let path_circle c b (s:Display.state) =
(s, (b, I.paint (Paint.color c) (s, (b, I.paint (Paint.color c)
(I.stroke_path (I.stroke_path
(Outline.make ()) @@ fun t -> P.circle t (Box2.midx b) (Box2.midy b) ((Box2.w b) /. 2.)))) (Outline.make ()) @@ fun t -> P.circle t ~cx:(Box2.midx b) ~cy:(Box2.midy b) ~r:((Box2.w b) /. 2.))))
let layout_hor v () = []
let layout_ver v () = []
(* draws the second item below if there's room *) (* draws the second item below if there's room *)
let pane_vbox (subpanes:Display.pane list) (so:Display.state) = 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 *) I.paint (* red box *)
(Paint.color (Color.v 0.5 0.125 0.125 1.0)) (Paint.color (Color.v 0.5 0.125 0.125 1.0))
(I.stroke_path (Outline.make ()) @@ (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; ]) label_image; ])
@ -513,7 +485,7 @@ let draw_pp height fpp (s:Display.state) =
let so = !sc in let so = !sc in
let bo = Box2.v (Box2.o !sc.box) (P2.v ((float n) *. wpx) height) 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 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; box := bo;
sc := {!sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box)}; sc := {!sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box)};
in in
@ -562,27 +534,27 @@ let draw_textedit (te:textedit) height (s:Display.state) =
List.iter (function List.iter (function
| `Key_up (k:Display.key) -> | `Key_up (k:Display.key) ->
(match k with (match k with
| {keycode=0x40000052}(*up*) -> ignore (Zed_edit.prev_line ctx) | {keycode=0x40000052; _}(*up*) -> ignore (Zed_edit.prev_line ctx)
| {keycode=0x40000051}(*down*) -> ignore (Zed_edit.next_line ctx) | {keycode=0x40000051; _}(*down*) -> ignore (Zed_edit.next_line ctx)
| {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'; ctrl=true; shift=false; meta=false; fn=false} -> Zed_edit.prev_char 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='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='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='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=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='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=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='\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='\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 | {char='k'; ctrl=true; shift=false; meta=false; fn=false; _} -> Zed_edit.kill_next_line ctx
| _ -> | _ ->
let c = Display.key_to_uchar k in 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); ()) 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 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
let before_cursor = Zed_string.to_utf8 (Zed_rope.to_string zrb) 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 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=[]) () = 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} {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 draw_storeview (r:storeview) height (s:Display.state) =
let from = [] in (* future optional arg *)
let indent = ref 0 in let indent = ref 0 in
let rec draw_levels (tree:(string * Store.tree) list) pp = let rec draw_levels (tree:(string * Store.tree) list) pp =
indent := !indent + 1; indent := !indent + 1;
@ -637,7 +608,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'; ctrl=true; shift=false; meta=false; fn=false; _} ->
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))));
@ -646,7 +617,7 @@ let draw_top (t:top) height (s:Display.state) =
| _ -> ()); | _ -> ());
pane_vbox [ pane_vbox [
draw_textedit t.te height; draw_textedit t.te height;
draw_pp 30. (fun pp -> draw_pp height (fun pp ->
Format.pp_open_hvbox pp 0; Format.pp_open_hvbox pp 0;
F.text pp (Buffer.contents t.res); F.text pp (Buffer.contents t.res);
F.pf pp "@."; F.pf pp "@.";
@ -661,13 +632,13 @@ 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) 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 *)
push @@ fill_box (Display.gray 0.125) s.box !state; (* gray bg *) push @@ fill_box (Display.gray 0.125) s.box !state; (* gray bg *)
push @@ pane_vbox [ 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)))*)}; ] {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))