(*[@@@ocaml.warning "-6-9-26-27"] *) open Lwt.Infix module F = Fmt module Store = Irmin_unix.Git.FS.KV(Irmin.Contents.String) (* Store.set_exn t ~info:(info "Adding a new entry") log_file logs) *) module Topmain = struct open Ocaml_common open Ocaml_toplevel module Compenv = Ocaml_common.Compenv let preload_objects = ref [] let prepare ppf = Toploop.set_paths (); try let res = let objects = List.rev (!preload_objects @ !Compenv.first_objfiles) in List.for_all (Topdirs.load_file ppf) objects in Toploop.run_hooks Toploop.Startup; res with x -> try Location.report_exception ppf x; false with x -> Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x); false let read_interactive_input = ref (fun _ _ -> 0) let refill_lexbuf buffer len = !read_interactive_input buffer len exception PPerror (* Phase buffer that stores the last toplevel phrase (see [Location.input_phrase_buffer]). *) let phrase_buffer = Buffer.create 1024 type evalenv = Format.formatter -> string -> unit let eval lb ppf (text:string) = F.epr "Topmain.eval: \n"; read_interactive_input := (fun buffer _ -> Bytes.blit_string text 0 buffer 0 (String.length text); Buffer.add_string phrase_buffer text; (* Also populate the phrase buffer as new characters are added. *) String.length text); let snap = Btype.snapshot () in try Buffer.reset phrase_buffer; (* Reset the phrase buffer, then flush the lexing buffer. *) Lexing.flush_input lb; Location.reset(); Warnings.reset_fatal (); 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 -> 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"; 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 module Display = struct open Tgles2 open Tsdl open Gg open CamomileLibrary let (>>=) x f = match x with | Ok a -> f a | Error _ as result -> result let get_result = function | Ok x -> x | Error (`Msg msg) -> failwith msg type key = { char:char; uchar:CamomileLibrary.UChar.t; keycode:Sdl.keycode; scancode:Sdl.scancode; shift:bool; ctrl:bool; meta:bool; fn:bool; } type mouse = (int * int) type event = [ `Key_down of key | `Key_up of key | `Mouse of mouse | `Quit | `Fullscreen of bool | `None ] let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0); keycode=0; scancode=0; shift=false; ctrl=false; meta=false; fn=false} let event_of_sdlevent ev = match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with | `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 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" 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 "") (if k.fn then " fn" else ""); (match w with `Key_down -> `Key_down k | `Key_up -> `Key_up k) | `Mouse_motion -> let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy | `Quit -> F.epr "Quit Event\n"; `Quit | _ -> F.epr "Unknown Event@." ; `None let str_of_scancode = Sdl.get_key_name let key_shift_map = [('1','!');('2','@');('3','#');('4','$');('5','%'); ('6','^');('7','&');('8','*');('9','(');('0',')'); ('`','~');('-','_');('+','+');('[','{');(']','}'); ('\\','|');(';',':');('\'','"');(',','<');('.','>'); ('/','?')] 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 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; } type image = (box2 * Wall.image) (* the box2 here is cannonically the place the returner drew (the Wall.image extents) *) type pane = state -> (state * image) type frame = { sdl_win: Sdl.window; gl: Sdl.gl_context; wall: Wall.renderer; mutable quit: bool; mutable fullscreen: bool; } let ticks () = (Int32.to_float (Sdl.get_ticks ())) /. 1000.0 let on_failure ~cleanup result = begin match result with | Ok _ -> () | Error _ -> cleanup () end; result let video_initialized = lazy (Sdl.init Sdl.Init.video) let make_frame ?(title="komm") ~w ~h = Lazy.force video_initialized >>= fun () -> Sdl.create_window ~w ~h title 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); on_failure ( Sdl.gl_create_context sdl_win >>= fun gl -> let wall = Wall.Renderer.create ~antialias:true ~stencil_strokes:true () in Ok { sdl_win; gl; wall; quit = false; fullscreen = false } ) ~cleanup:(fun () -> Sdl.destroy_window sdl_win) let display_frame frame render = (* create and fill event list *) let tstart = ticks () in let ev = Sdl.Event.create () in let el = ref [`None] in while Sdl.wait_event_timeout (Some ev) 50 (* HACK *) do let e = event_of_sdlevent ev in if e != `None then el := !el @ [e] (* HACK? *) done; (* Filter the events *) el := List.filter_map (function | `Quit -> frame.quit <- true; None | `Fullscreen a -> if a then ( frame.fullscreen <- not frame.fullscreen; ignore (Sdl.show_cursor (not frame.fullscreen) : _ result); ignore (Sdl.set_window_fullscreen frame.sdl_win (if frame.fullscreen then Sdl.Window.fullscreen_desktop else Sdl.Window.windowed) : _ result)); None | `Key_up a -> Some (`Key_up a) | `Key_down _ -> (*Some (`Key_up a)*) None | `Mouse a -> Some (`Mouse a) | _ -> 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 = 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 = 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)); Gl.enable Gl.blend; Gl.blend_func_separate Gl.one Gl.src_alpha Gl.one Gl.one_minus_src_alpha; Gl.enable Gl.cull_face_enum; Gl.disable Gl.depth_test; 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.2fms?\n" (ticks () -. tstart); Ok () end else Ok () let run frame render () = let frame = get_result frame in Sdl.show_window frame.sdl_win; while not frame.quit do ignore (display_frame frame render) done; print_endline "quit"; Sdl.hide_window frame.sdl_win; () let gray ?(a=1.0) v = Color.v v v v a end open Wall open Gg module I = Image module P = Path module Text = Wall_text let load_font name = let ic = open_in_bin name in let dim = in_channel_length ic in let fd = Unix.descr_of_in_channel ic in let buffer = Unix.map_file fd Bigarray.int8_unsigned Bigarray.c_layout false [|dim|] |> Bigarray.array1_of_genarray in let offset = List.hd (Stb_truetype.enum buffer) in match Stb_truetype.init buffer offset with | None -> assert false | Some font -> font let font_icons = lazy (load_font "entypo.ttf") let font_sans = lazy (load_font "Roboto-Regular.ttf") let font_sans_bold = lazy (load_font "Roboto-Bold.ttf") let font_emoji = lazy (load_font "NotoEmoji-Regular.ttf") let str_of_pnt p = Printf.sprintf "(x:%0.1f y:%0.1f)" (P2.x p) (P2.y p) let str_of_box b = Printf.sprintf "(ox:%0.1f oy:%0.1f ex%0.1f ey%0.1f)" (Box2.ox b) (Box2.oy b) (Box2.maxx b) (Box2.maxy b) let draw_label text b = let f = Text.Font.make ~size:(Box2.h b) (Lazy.force font_sans) in ((Box2.v (Box2.o b) (P2.v (Text.Font.text_width f text) (Box2.h b))), (I.paint (Paint.color (Display.gray ~a:0.5 1.0)) Text.(simple_text f ~valign:`BASELINE ~halign:`LEFT ~x:(Box2.ox b) ~y:((Box2.oy b)+.(Box2.h b)*.0.75) text))) let fill_box c b (s:Display.state) = (s, (b, I.paint (Paint.color c) (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 ~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 ~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) = let sr, (br, ir) = List.fold_left (fun (sp, (_, ip)) (pane:Display.pane) -> let sr, (br, ir) = pane sp in F.epr "pane_vbox: %s\n" (str_of_box br); let _, (_, sir) = path_box (Color.v 0.125 0.125 1.0 0.125) br sp in ({sr with box = (Box2.of_pts (Box2.tl_pt br) (Box2.max sp.box))}, (br, Image.seq [ ip; sir; ir]))) (so, (so.box, Image.empty)) subpanes in let b = Box2.of_pts (Box2.o so.box) (Box2.max br) in let _,(_, i_redbox) = path_box (Color.v 0.5 0.125 0.125 1.0) b sr in (sr, (b, (Image.stack i_redbox ir))) (* draws second item to right if there's room *) let pane_hbox (subpanes:Display.pane list) (so:Display.state) = let sr, (br, ir) = List.fold_left (fun (sp, (_, ip)) (pane:Display.pane) -> let sr, (br, ir) = pane sp in let _, (_, sir) = path_box (Color.v 0.125 0.125 1.0 0.125) br sp in ({sr with box = (Box2.of_pts (Box2.br_pt br) (Box2.max sp.box))}, (br, Image.seq [ ip; sir; ir]))) (so, (so.box, Image.empty)) subpanes in let b = Box2.of_pts (Box2.o so.box) (Box2.max br) in let _,(_, i_redbox) = path_box (Color.v 0.5 0.125 0.125 1.0) b sr in (sr, (b, (Image.stack i_redbox ir))) let pane_label text height ~subpanes (s:Display.state) = let label_box, label_image = draw_label text (Box2.v (Box2.o s.box) (P2.v (Box2.w s.box) height)) in Box2.pp Format.std_formatter label_box; (label_box, Image.seq [ List.fold_left (fun image pane -> Image.seq [image; (pane s)]) Image.empty subpanes; 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 ~x:(Box2.ox s.box) ~y:(Box2.oy s.box) ~w:(Box2.w s.box) ~h:height); label_image; ]) let simple_text f text (s:Display.state) = let fm = Text.Font.font_metrics f in let font_height = fm.ascent -. fm.descent +. fm.line_gap in let tm = Text.Font.text_measure f text in let br_pt = (P2.v ((Box2.ox s.box) +. tm.width) ((Box2.oy s.box) +. font_height)) in let bextent = (Box2.of_pts (Box2.o s.box) br_pt) in let (_, (_, redbox)) = path_box (Color.v 0.5 0.125 0.125 1.0) bextent s in ({s with box = (Box2.of_pts (Box2.br_pt bextent) (Box2.max s.box))}, (bextent, (I.stack redbox (I.paint (Paint.color (Display.gray ~a:0.5 1.0)) Text.(simple_text f ~valign:`BASELINE ~halign:`LEFT ~x:(Box2.ox s.box) ~y:((Box2.oy s.box) +. fm.ascent) text))))) type Format.stag += Color_bg of Wall.color type Format.stag += Color_fg of Wall.color type Format.stag += Cursor of Wall.color let draw_pp height fpp (s:Display.state) = F.epr "draw_pp: %s\n" (str_of_box s.box); let node, sc, box = ref I.empty, ref s, ref Box2.zero in let push (s, (b, i)) = node := I.stack !node i; sc := s; box := b in let f = Text.Font.make ~size:height (Lazy.force font_sans) in let fm = Text.Font.font_metrics f in let font_height = fm.ascent -. fm.descent +. fm.line_gap in let max_x = ref 0. in let out_string text o l = let text = String.sub text o l in let sp = !sc in push @@ simple_text f text !sc; max_x := max !max_x (Box2.maxx !box); sc := {!sc with box = (Box2.of_pts (P2.v (Box2.maxx !box) (Box2.oy sp.box)) (Box2.max sp.box))}; in let out_flush () = () in let out_newline () = sc := {!sc with box = Box2.of_pts (P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height)) (Box2.max s.box)}; in let out_spaces n = let wpx = Text.Font.text_width f " " in if ((Box2.ox !sc.box) +. ((float n) *. wpx)) > (Box2.maxx !sc.box) then (* WRAP *) begin F.epr "out_spaces: ===== WRAP =======@."; out_newline () end; 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 _ -> 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 let out_indent n = let p = (min ((Box2.w !sc.box)-.1.) (height *. 2.0 *. (float n))) in sc := {!sc with box = Box2.of_pts (P2.v ((Box2.ox !sc.box) +. p) (Box2.oy !sc.box)) (Box2.max !sc.box)}; in let pp = Format.formatter_of_out_functions {out_string; out_flush; out_newline; out_spaces; out_indent;} in Format.pp_set_formatter_stag_functions pp { mark_open_stag = (fun s -> (match s with | Cursor c -> push @@ fill_box c (Box2.v (Box2.o !sc.box) (P2.v (height *. 0.333) height)) !sc | Color_bg c -> push @@ fill_box c !box !sc | _ -> ()); ""); mark_close_stag = (function | _ -> (); ""); print_open_stag = (fun _ -> (*""*) ()); (* TKTKTKTK XXX IT SHOULD BE USING THESE print ONES *) print_close_stag = (fun _ -> (*""*) ()); }; Format.pp_set_tags pp true; let margin = int_of_float ((Box2.w s.box) /. (Text.Font.text_width f " ")) in let max_indent = margin in Format.pp_safe_set_geometry pp ~max_indent ~margin; fpp pp; Format.pp_force_newline pp (); !sc, ((Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box))), !node) (*let draw_spp height fpp (s:Display.state) = let node, sc, box = ref I.empty, ref s, ref Box2.zero in let push (s, (b, i)) = node := I.stack !node i; sc := s; box := b in let f = Text.Font.make ~size:height (Lazy.force font_sans) in let fm = Text.Font.font_metrics f in let font_height = fm.ascent -. fm.descent +. fm.line_gap in let sob = Format.make_symbolic_output_buffer () in let pp = Format.formatter_of_symbolic_output_buffer sob in Format.flush_symbolic_output_buffer sob; fpp pp; !sc, ((Box2.of_pts (Box2.o s.box) (Box2.max !sc.box)), !node)*) type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t} let make_textedit () = let z = Zed_edit.create () in {ze = z; zc = Zed_edit.new_cursor z;} let draw_textedit (te:textedit) height (s:Display.state) = let ctx = Zed_edit.context te.ze te.zc in 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 | _ -> 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 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 Format.pp_open_hvbox pp 0; F.text pp before_cursor; Format.pp_open_stag pp (Cursor (Wall.Color.v 0.99 0.99 0.125 0.3)); F.pf pp ""; Format.pp_close_stag pp (); F.text pp after_cursor; F.pf pp "@."; Format.pp_close_box pp (); ) s let str_of_textedit (te:textedit) = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text te.ze)) 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 indent = ref 0 in let rec draw_levels (tree:(string * Store.tree) list) pp = indent := !indent + 1; List.iter (fun (step, node) -> Format.pp_open_vbox pp 0; Format.pp_open_hbox pp (); for _ = 0 to !indent do Format.pp_print_space pp () done; Format.fprintf pp "%d-%s@." !indent step; Format.pp_close_box pp (); let subtree = Lwt_main.run (Store.Tree.list node []) in draw_levels subtree pp; Format.pp_close_box pp () ) tree; indent := !indent - 1 in let root = Lwt_main.run (Store.get_tree r.s r.path >>= (fun n -> Store.Tree.list n [])) in draw_pp height (draw_levels root) s type top = {te: textedit; res: Buffer.t; mutable eval: Topmain.evalenv option; path: string list; storeview: storeview} let make_top storepath ?(branch="current") () = let t = {te=make_textedit (); res=Buffer.create 1024; eval=None; path=["init"]; storeview=make_storeview storepath branch ()} in let zctx = Zed_edit.context t.te.ze t.te.zc in Zed_edit.insert zctx (Zed_rope.of_string (Zed_string.of_utf8 (Lwt_main.run (Store.get t.storeview.s t.path)))); t let draw_top (t:top) 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; 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)))); ignore (Lwt_main.run (Store.set_exn t.storeview.s ~info:(Irmin_unix.info "executed") t.path (str_of_textedit t.te))) | _ -> ()); pane_vbox [ draw_textedit t.te height; draw_pp height (fun pp -> Format.pp_open_hvbox pp 0; F.text pp (Buffer.contents t.res); F.pf pp "@."; Format.pp_close_box pp (); F.flush pp () ); draw_storeview t.storeview height; ] s let top_1 = make_top "../../rootstore" () 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 Some (`Mouse a) -> mouse_state := a | _ -> (); 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 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)) let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900) draw_komm) ()