From 88f734b7d94896d6ac867d686aa2aa8324977940 Mon Sep 17 00:00:00 2001 From: cqc Date: Thu, 15 Jul 2021 20:46:46 -0500 Subject: [PATCH] no more warnings --- bin/dune | 1 - bin/main.ml | 117 ++++++++++++++++++++-------------------------------- 2 files changed, 44 insertions(+), 74 deletions(-) diff --git a/bin/dune b/bin/dune index 4c4e7da..31f1ae6 100644 --- a/bin/dune +++ b/bin/dune @@ -1,7 +1,6 @@ (executables (names main example lumppile) (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)) diff --git a/bin/main.ml b/bin/main.ml index e57da40..6cfc2df 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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))