rearranged files

bin/dune

@@ -1,6 +1,7 @@
 (executables
- (names main example lumppile)
+ (names main)
  (modes byte)
+ (link_flags (-linkall))
  (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))
 
 

bin/example.ml

@@ -1,119 +0,0 @@
-open Tsdl
-
-open Wall
-module I = Image
-module P = Path
-module Text = Wall_text
-
-let gray ?(a=1.0) v = Color.v v v v a
-
-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 w = 1000
-let h = 600
-let f = (try float_of_string Sys.argv.(1) with _ -> 1.0)
-let fw = int_of_float (f *. float w)
-let fh = int_of_float (f *. float h)
-
-let draw_label text x y h =
-  I.paint (Paint.color (gray ~a:0.5 1.0))
-    Text.(simple_text
-                 (Font.make ~size:18.0 (Lazy.force font_sans))
-                 ~valign:`MIDDLE ~halign:`LEFT
-                 ~x ~y:(y+.h*.0.5) text)
-
-let draw_demo mx my w t =
-  let node = ref I.empty in
-  let push n = node := I.stack !node n in
-  let x = 0.0 and y = 0.0 in
-  push @@ draw_label "hello world" x y 20.0;
-  !node
-
-let counter = Performance_counter.make ()
-let dump_perf =
-  let t0 = ref 0 in
-  fun t ->
-    let t = int_of_float t in
-    if t <> !t0 then (
-      t0 := t;
-      prerr_endline (Performance_counter.report counter);
-      Performance_counter.reset counter
-    )
-
-let render context sw sh t =
-  let lw = float w in
-  let lh = float h in
-  let width = lw *. f *. sw in
-  let height = lh *. f *. sh in
-  let _, (x, y) = Sdl.get_mouse_state () in
-  let x = float x /. f and y = float y /. f in
-  Renderer.render context ~width ~height ~performance_counter:counter
-    (I.seq [
-         draw_demo x y lw t;
-    ]);
-  dump_perf t
-
-open Tgles2
-
-let main () =
-  Printexc.record_backtrace true;
-  match Sdl.init Sdl.Init.video with
-  | Error (`Msg e) -> Sdl.log "Init error: %s" e; exit 1
-  | Ok () ->
-    ignore (Sdl.gl_set_attribute Sdl.Gl.depth_size 24 : _ result);
-    ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 8 : _ result);
-    match
-      Sdl.create_window ~w:fw ~h:fh "SDL OpenGL"
-        Sdl.Window.(opengl + allow_highdpi)
-    with
-    | Error (`Msg e) -> Sdl.log "Create window error: %s" e; exit 1
-    | Ok w ->
-      ignore (Sdl.gl_set_swap_interval (-1));
-      let ow, oh = Sdl.gl_get_drawable_size w in
-      Sdl.log "window size: %d,%d\topengl drawable size: %d,%d" fw fh ow oh;
-      let sw = float ow /. float fw and sh = float oh /. float fh in
-      ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1);
-      match Sdl.gl_create_context w with
-      | Error (`Msg e) -> Sdl.log "Create context error: %s" e; exit 1
-      | Ok ctx ->
-        let context = Renderer.create ~antialias:true () in
-        let quit = ref false in
-        let event = Sdl.Event.create () in
-        while not !quit do
-          while Sdl.poll_event (Some event) do
-            match Sdl.Event.enum (Sdl.Event.get event Sdl.Event.typ) with
-            | `Quit -> quit := true
-            | _ -> ()
-          done;
-          Gl.viewport 0 0 ow oh;
-          Gl.clear_color 0.3 0.3 0.32 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;
-          render context sw sh (Int32.to_float (Sdl.get_ticks ()) /. 1000.0);
-          Sdl.gl_swap_window w;
-        done;
-        Sdl.gl_delete_context ctx;
-        Sdl.destroy_window w;
-        Sdl.quit ();
-        exit 0
-
-let () = main ()

bin/lump.ml

@@ -1 +0,0 @@
-(* lump is module *)

bin/lumppile.ml

@@ -1,30 +0,0 @@
-(* pile of lumps *)
-
-open Lwt.Infix
-
-module Git_store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
-
-let git_config = Irmin_git.config ~bare:true "./kommpile"
-let git_repo = Git_store.Repo.v git_config
-
-
-let beginning config =
-  Git_store.Repo.v config >>= Git_store.master
-
-let branch config name =
-    Git_store.Repo.v config >>= fun repo ->
-    Git_store.of_branch repo name
-
-
-let info message = Irmin_unix.info "%s" message
-
-
-let main =
-    Git_store.Repo.v git_config >>= Git_store.master >>= fun t ->
-    (* Set a/b/c to "Hello, Irmin!" *)
-    Git_store.set_exn t ["a"; "b"; "c"] "Hello, Irmin!" ~info:(info "my first commit") >>= fun () ->
-    (* Get a/b/c *)
-    Git_store.get t ["a"; "b"; "c"] >|= fun s ->
-    assert (s = "Hello, Irmin!")
-
-let () = Lwt_main.run main

bin/lumpstore.ml

@@ -1,19 +0,0 @@
-module Lump : sig
-  include Irmin.Type.S
-  val v : string -> t
-  val timestamp : t -> int
-end = struct
-  type t = { names : string list; value : string }
-  let compare x y = compare x.names y.names
-  let v names value = { names ; value }
-  let names t = t.names
-  let pp ppf { names; message } = Fmt.pf ppf "%04d: %s" timestamp message
-  let t =
-    let open Irmin.Type in
-    record "entry" (fun t32 message ->
-        { timestamp = Int32.to_int t32; message })
-    |+ field "timestamp" int32 (fun t -> Int32.of_int t.timestamp)
-    |+ field "message" string (fun t -> t.message)
-    |> sealr
-  let t = Irmin.Type.like ~cli:(pp, of_string) ~compare t
-end

bin/main.ml

@@ -98,66 +98,62 @@ module Display = struct
     | Ok x -> x
     | Error (`Msg msg) -> failwith msg
 
+
+  type keymod = Shift | Ctrl | Meta | Fn
   type key = {
       char:char;
       uchar:CamomileLibrary.UChar.t;
       keycode:Sdl.keycode;
       scancode:Sdl.scancode;
-      shift:bool;
+      mods:keymod list}
-      ctrl:bool;
+  
-      meta:bool;
-      fn:bool; }
   type mouse = (int * int)
   type event = [ `Key_down of key
                | `Key_up of key
+               | `Text_editing of string
+               | `Text_input of string
                | `Mouse of mouse
                | `Quit
                | `Fullscreen of bool
                | `None ]
 
-  let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0);
+  let str_of_key k = Printf.sprintf "(char=%C;uchar=%C;keycode=%x;scancode=%x;name=%s;(%s%s%s%s))"
-                      keycode=0; scancode=0;
+                       k.char (CamomileLibrary.UChar.char_of k.uchar) k.keycode k.scancode
-                      shift=false; ctrl=false; meta=false; fn=false}
+                       (Sdl.get_key_name k.keycode) (if List.mem Shift k.mods then "shift" else "")
+                       (if List.mem Ctrl k.mods then "ctrl" else "") (if List.mem Meta k.mods then "meta" else "")
+                       (if List.mem Fn k.mods then " fn" else "")
+  
   let event_of_sdlevent ev =
     match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with
+    | `Text_editing -> F.epr "event_of_sdlevent: `Text_editing\n\twindow_id=%d\n\ttext=%s\n\tstart=%d\n\tlength=%d@."
+                              (Sdl.Event.get ev Sdl.Event.text_editing_window_id)
+                              (Sdl.Event.get ev Sdl.Event.text_editing_text)
+                              (Sdl.Event.get ev Sdl.Event.text_editing_start)
+                              (Sdl.Event.get ev Sdl.Event.text_editing_length); `None
+  
+    | `Text_input -> `Text_input (Sdl.Event.get ev Sdl.Event.text_input_text)
     | `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 mods = List.filter_map (fun (m, v) -> if (km land m)>0 then Some v else None)
+                    Sdl.Kmod.[(shift, Shift); (ctrl, Ctrl); (alt, Meta); (gui, Fn);] in
        let k = { char=(UChar.char_of uchar); uchar; keycode;
-                 scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode;
+                 scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode; mods} in
-                 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
+       F.epr "%s@." (str_of_key k);
-         (CamomileLibrary.UChar.char_of k.uchar) k.scancode
+       let repeat = (Sdl.Event.get ev Sdl.Event.keyboard_repeat) in
-         (Sdl.get_key_name keycode)
+       F.epr "\tkeyboard_repeat=%d\n" repeat ;
-         (if k.shift then " shift" else "")
+       if repeat < 1 then (match w with `Key_down -> `Key_down k | `Key_up -> `Key_up k) else `None
-         (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_up : Sdl.keycode = 0x40000052
-  let key_shift_map =
+  let key_down : Sdl.keycode = 0x40000051
-    [('1','!');('2','@');('3','#');('4','$');('5','%');
+  let key_left : Sdl.keycode = 0x40000050
-     ('6','^');('7','&');('8','*');('9','(');('0',')');
+  let key_right : Sdl.keycode = 0x4000004f
-     ('`','~');('-','_');('+','+');('[','{');(']','}');
-     ('\\','|');(';',':');('\'','"');(',','<');('.','>');
-     ('/','?')]
-
-  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
 
@@ -177,7 +173,7 @@ module Display = struct
                  mutable quit: bool;
                  mutable fullscreen: bool; }
 
-  let ticks () = (Int32.to_float (Sdl.get_ticks ())) /. 1000.0
+  let ticks () = (Int32.to_float (Sdl.get_ticks ())) /. 1000.
   
   let on_failure ~cleanup result = begin
       match result with
@@ -192,6 +188,7 @@ module Display = struct
     Sdl.create_window ~w ~h title
       Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*))
     >>= fun sdl_win ->
+    Sdl.set_window_title sdl_win title;
     ignore (Sdl.gl_set_swap_interval (-1));
     ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1);
     on_failure (
@@ -223,9 +220,9 @@ module Display = struct
                              else Sdl.Window.windowed)
                           : _ result)); None
              | `Key_up a -> Some (`Key_up a)
-             | `Key_down _ -> (*Some (`Key_up a)*) None
+             | `Key_down a -> Some (`Key_down a)
              | `Mouse a -> Some (`Mouse a)
-             | _ ->  None
+             | a -> Some a
             (*| a -> Some a*)) !el;
     if (List.length !el) > 0 then begin
         F.epr "Passing in %d events\n" (List.length !el);    
@@ -245,7 +242,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.2fms?\n" (ticks () -. tstart); Ok () end
+        F.epr "event loop took %0.6f seconds\n" (ticks () -. tstart); Ok () end
     else Ok ()
   
   let run frame render () =
@@ -279,10 +276,11 @@ let load_font name =
   | None -> assert false
   | Some font -> font
 
-let font_icons = lazy (load_font "entypo.ttf")
+let font_icons = lazy (load_font "fonts/entypo.ttf")
-let font_sans = lazy (load_font "Roboto-Regular.ttf")
+let font_sans = lazy (load_font "fonts/Roboto-Regular.ttf")
-let font_sans_bold = lazy (load_font "Roboto-Bold.ttf")
+let font_sans_bold = lazy (load_font "fonts/Roboto-Bold.ttf")
-let font_emoji = lazy (load_font "NotoEmoji-Regular.ttf")
+let font_sans_light = lazy (load_font "fonts/Roboto-Light.ttf")
+let font_emoji = lazy (load_font "fonts/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)
@@ -314,7 +312,6 @@ let pane_vbox (subpanes:Display.pane list) (so:Display.state) =
     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
@@ -370,7 +367,6 @@ 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
@@ -442,27 +438,27 @@ let make_textedit () = let z = Zed_edit.create () in {ze = z; zc = Zed_edit.new_
 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) ->
+      | `Key_down (k:Display.key) ->
          (match k with
-          | {keycode=0x40000052; _}(*up*)   -> ignore (Zed_edit.prev_line ctx) 
+          | {keycode=kc;mods=[]; _} when kc = Display.key_up -> Zed_edit.prev_line ctx
-          | {keycode=0x40000051; _}(*down*) -> ignore (Zed_edit.next_line ctx)
+          | {keycode=kc;mods=[]; _} when kc = Display.key_down -> Zed_edit.next_line ctx
-          | {keycode=0x40000050; _}(*left*) -> ignore (Zed_edit.prev_char ctx)
+          | {keycode=kc;mods=[]; _} when kc = Display.key_left -> Zed_edit.prev_char ctx
-          | {keycode=0x4000004f; _}(*right*)-> ignore (Zed_edit.next_char ctx)
+          | {keycode=kc;mods=[]; _} when kc = Display.key_right-> Zed_edit.next_char ctx
-          | {char='\r'; ctrl=false; shift=false; meta=false; fn=false; _} -> Zed_edit.newline ctx
+          | {char='\r'; mods=[]; _} -> Zed_edit.newline ctx
-          | {char='b';  ctrl=true;  shift=false; meta=false; fn=false; _} -> Zed_edit.prev_char ctx
+          | {char='b';  mods=[Ctrl]; _} -> Zed_edit.prev_char ctx
-          | {char='f';  ctrl=true;  shift=false; meta=false; fn=false; _} -> Zed_edit.next_char ctx
+          | {char='f';  mods=[Ctrl]; _} -> Zed_edit.next_char ctx
-          | {char='a';  ctrl=true;  shift=false; meta=false; fn=false; _} -> Zed_edit.goto_bol ctx
+          | {char='a';  mods=[Ctrl]; _} -> Zed_edit.goto_bol ctx
-          | {char='e';  ctrl=true;  shift=false; meta=false; fn=false; _} -> Zed_edit.goto_eol ctx
+          | {char='e';  mods=[Ctrl]; _} -> Zed_edit.goto_eol ctx
-          | {char='d';  ctrl=true;  shift=false; meta=false; fn=false; _} -> Zed_edit.remove_next ctx 1
+          | {char='d';  mods=[Ctrl]; _} -> Zed_edit.remove_next ctx 1
-          | {char='d';  ctrl=false; shift=false; meta=true;  fn=false; _} -> Zed_edit.kill_next_word ctx
+          | {char='d';  mods=[Meta]; _} -> Zed_edit.kill_next_word ctx
-          | {char='\b'; ctrl=false; shift=false; meta=false; fn=false; _} -> Zed_edit.remove_prev ctx 1
+          | {char='\b'; mods=[];     _} -> Zed_edit.remove_prev ctx 1
-          | {char='\b'; ctrl=false; shift=false; meta=true;  fn=false; _} -> Zed_edit.kill_prev_word ctx
+          | {char='\b'; mods=[Meta]; _} -> 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'; mods=[]; _} -> 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';  mods=[Ctrl]; _} -> Zed_edit.kill_next_line ctx
-          | _ ->
+          | _ -> ())
-             let c = Display.key_to_uchar k in
+      | `Key_up _ -> ()
-             if Zed_char.is_printable c then Zed_edit.insert_char ctx (Display.key_to_uchar k); ())
+      | `Text_input s -> F.epr "draw_textedit: `Text_input %s@." s;
-      | `Key_down _ -> ()
+                         Zed_edit.insert ctx (Zed_rope.of_string (Zed_string.of_utf8 s)); ()
       | _ -> ()) 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
@@ -518,7 +514,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'; mods=[Ctrl]; _} -> 
         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))));

bin/old_main.ml

@@ -1,155 +0,0 @@
-open Lwt.Infix
-
-(* komm / konsole / tafel *)
-
-module Lump = struct
-  module Pile = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
-  type t = { conf : Irmin.config;
-             repo : Pile.Repo.t;
-             branch : Pile.branch;
-             path : string list;
-           }
-
-  let branch repo_loc branch =
-    let repo = Lwt_main.run (Pile.Repo.v (Irmin_git.config repo_loc)) in
-    Lwt_main.run (Pile.of_branch repo branch)
-    
-  let get repo_loc branch path =
-    let repo = Lwt_main.run (Pile.Repo.v (Irmin_git.config repo_loc)) in
-    let branch = Lwt_main.run (Pile.of_branch repo branch) in
-    let node = Pile.get branch path in
-    Lwt_main.run node
-  
-(*  val pile_conf path = Irmin_git.config path
-  val pile_repo conf = Pile.Repo.v conf
-  val pile_branch conf name = pile_repo conf*)
-end
-
-(*let pos = ref (Lump.get "./kommstore" "current" ["init"])*)
-(* magic position [ref Lump.t]*)
-
-
-
-open Tsdl
-
-open Wall
-module I = Image
-module P = Path
-module Text = Wall_text
-
-let gray ?(a=1.0) v = Color.v v v v a
-
-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 w = 1000
-let h = 600
-let f = try float_of_string Sys.argv.(1) with _ -> 1.0
-let fw = int_of_float (f *. float w)
-let fh = int_of_float (f *. float h)
-
-let draw_label text x y w h =
-  I.paint (Paint.color (gray ~a:0.5 1.0))
-    Text.(simple_text
-            (Font.make ~size:18.0 (Lazy.force font_sans))
-            ~valign:`MIDDLE ~halign:`LEFT
-            ~x ~y:(y+.h*.0.5) text)
-
-let draw_demo x y w h t = (
-  let node = ref I.empty in
-  let push n = node := I.stack !node n in
-  push @@ draw_label "hello world" x y 280.0 20.0;
-  !node
-)
-
-let draw_lumptree x y w h t = (
-  let node = ref I.empty in
-  let push n = node := I.stack !node n in
-  let pile = Lump.branch "./kommpile" "current" in
-  let lumplist = Lwt_main.run (Lump.Pile.list pile []) in
-  Printf.printf "Lumplist length: %d\n" (List.length lumplist);
-  List.iter (fun (step, tree) ->
-      let path = step (*List.fold_left (fun s e -> s ^ e) "" step*) in
-      print_endline ("Path: " ^ path);
-      push @@ draw_label path x y 280.0 20.0; ()
-    ) lumplist;
-  !node
-)
-
-let render context sw sh t =
-  let lw = float w in
-  let lh = float h in
-  let pw = lw *. f *. sw in
-  let ph = lh *. f *. sh in
-  Renderer.render context ~width:pw ~height:ph
-    (Image.seq [
-         draw_lumptree 100. 200. lw lh t;
-         draw_demo 100. 100. lw lh t;
-       ]
-    )
-
-open Tgles2
-
-let main () =
-  print_endline "komm main.ml";
-  Printexc.record_backtrace true;
-  match Sdl.init Sdl.Init.video with
-  | Error (`Msg e) -> Sdl.log "Init error: %s" e; exit 1
-  | Ok () ->
-    ignore (Sdl.gl_set_attribute Sdl.Gl.depth_size 24 : _ result);
-    ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 8 : _ result);
-    match
-      Sdl.create_window ~w:fw ~h:fh "SDL OpenGL"
-        Sdl.Window.(opengl + allow_highdpi)
-    with
-    | Error (`Msg e) -> Sdl.log "Create window error: %s" e; exit 1
-    | Ok w ->
-      ignore (Sdl.gl_set_swap_interval (-1));
-      let ow, oh = Sdl.gl_get_drawable_size w in
-      Sdl.log "window size: %d,%d\topengl drawable size: %d,%d" fw fh ow oh;
-      let sw = float ow /. float fw and sh = float oh /. float fh in
-      (* GL3 initialization: *)
-      ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1);
-      match Sdl.gl_create_context w with
-      | Error (`Msg e) -> Sdl.log "Create context error: %s" e; exit 1
-      | Ok ctx ->
-        let context = Renderer.create ~antialias:true ~stencil_strokes:true () in
-        let quit = ref false in
-        let event = Sdl.Event.create () in
-        while not !quit do
-          while Sdl.poll_event (Some event) do
-            match Sdl.Event.enum (Sdl.Event.get event Sdl.Event.typ) with
-            | `Quit -> quit := true
-            | _ -> ()
-          done;
-          Gl.viewport 0 0 fw fh;
-          Gl.clear_color 0.3 0.3 0.32 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;
-          render context sw sh (Int32.to_float (Sdl.get_ticks ()) /. 1000.0);
-          Sdl.gl_swap_window w;
-        done;
-        Sdl.gl_delete_context ctx;
-        Sdl.destroy_window w;
-        Sdl.quit ();
-        exit 0
-
-let () = () (* lol i forget *)

bin/ui_linux_sdl.ml

@@ -1,202 +0,0 @@
-[@@@ocaml.warning "-6-9-27"]
-open Tsdl
-open Tgles2
-
-let (>>=) x f = match x with
-  | Ok a -> f a
-  | Error x as result -> result
-
-let on_failure ~cleanup result =
-  begin match result with
-    | Ok _ -> ()
-    | Error _ -> cleanup ()
-  end;
-  result
-
-let get_result = function
-  | Ok x -> x
-  | Error (`Msg msg) -> failwith msg
-
-let initialized = lazy (Sdl.init Sdl.Init.video)
-
-type state = {
-  time: float;
-  wall: Wall.renderer;
-}
-
-type slide = state -> Wall.image list
-
-let ticks () =
-  Int32.to_int (Sdl.get_ticks ())
-
-type window = {
-  win: Sdl.window;
-  gl: Sdl.gl_context;
-  wall: Wall.renderer;
-  event: Sdl.event;
-  mutable quit: bool;
-  mutable running_since: int option;
-  mutable prev_slides : slide list;
-  mutable next_slides : slide list;
-  mutable time_acc: float;
-  mutable fullscreen: bool;
-}
-
-let make_window ~w ~h =
-  Lazy.force initialized >>= fun () ->
-  Sdl.create_window ~w ~h "Slideshow"
-    Sdl.Window.(opengl + allow_highdpi + resizable + hidden)
-  >>= fun win ->
-  ignore (Sdl.gl_set_swap_interval (-1));
-  ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1);
-  on_failure (
-    Sdl.gl_create_context win >>= fun gl ->
-    let wall = Wall.Renderer.create ~antialias:true ~stencil_strokes:true () in
-    Ok { win; gl; wall; event = Sdl.Event.create ();
-         prev_slides = []; next_slides = [];
-         quit = false; running_since = None; time_acc = 0.0; fullscreen = false }
-  ) ~cleanup:(fun () -> Sdl.destroy_window win)
-
-let get_time t =
-  match t.running_since with
-  | None -> t.time_acc
-  | Some tick0 -> t.time_acc +. float (ticks () - tick0) /. 1000.0
-
-let set_pause t pause =
-  if pause then (
-    t.time_acc <- get_time t;
-    t.running_since <- None;
-  ) else (
-    t.running_since <- Some (ticks ())
-  )
-
-let reset_time t =
-  t.time_acc <- 0.0;
-  set_pause t false
-
-let set_slides t slides =
-  let rec select_slides acc prevs nexts =
-    match prevs, nexts with
-    | (_ :: prevs'), (next :: nexts') ->
-      select_slides (next :: acc) prevs' nexts'
-    | _, _ -> acc, nexts
-  in
-  let prev_slides, next_slides = select_slides [] t.prev_slides slides in
-  t.prev_slides <- prev_slides;
-  t.next_slides <- next_slides
-
-let render_slide t slide =
-  Sdl.gl_make_current t.win t.gl >>= fun () ->
-  let (width, height) as physical_size = Sdl.gl_get_drawable_size t.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
-  let transform =
-    let r = 1024.0 /. 768.0 in
-    let r' = width /. height in
-    let r =
-      if r' > r then
-        (height /. 768.0)
-      else
-        (width /. 1024.0)
-    in
-    let x = (width -. 1024.0 *. r) /. 2.0 in
-    let y = (height -. 768.0 *. r) /. 2.0 in
-    Wall.Transform.rescale r r
-      (Wall.Transform.translation x y)
-    (*Wall.Transform.translate ~x ~y (Wall.Transform.scale r r)*)
-  in
-  Wall.Renderer.render t.wall ~width ~height
-    (Wall.Image.transform transform slide);
-  Sdl.gl_swap_window t.win;
-  Ok ()
-
-let process_events t =
-  while Sdl.poll_event (Some t.event) do
-    let run_action = function
-      | `Quit -> t.quit <- true
-      | `Prev ->
-        begin match t.prev_slides with
-          | x :: xs ->
-            t.next_slides <- x :: t.next_slides;
-            t.prev_slides <- xs;
-            reset_time t
-          | [] -> ()
-        end
-      | `Next ->
-        begin match t.next_slides with
-          | x :: xs ->
-            t.prev_slides <- x :: t.prev_slides;
-            t.next_slides <- xs;
-            reset_time t
-          | [] -> ()
-        end
-      | `Pause -> set_pause t (t.running_since <> None)
-      | `Fullscreen ->
-        t.fullscreen <- not t.fullscreen;
-        ignore (Sdl.show_cursor (not t.fullscreen) : _ result);
-        ignore (Sdl.set_window_fullscreen t.win
-                  (if t.fullscreen
-                   then Sdl.Window.fullscreen_desktop
-                   else Sdl.Window.windowed)
-                  : _ result)
-    in
-    let bindings = [
-      (Sdl.K.[q], `Quit);
-      (Sdl.K.[p], `Pause);
-      (Sdl.K.[left; up], `Prev);
-      (Sdl.K.[right; down], `Next);
-      (Sdl.K.[f], `Fullscreen);
-    ]
-    in
-    match Sdl.Event.enum (Sdl.Event.get t.event Sdl.Event.typ) with
-    | `Key_up ->
-      let key = Sdl.Event.get t.event Sdl.Event.keyboard_keycode in
-      begin match List.find (fun (keys, _) -> List.mem key keys) bindings with
-        | exception Not_found -> ()
-        | (_, action) -> run_action action
-      end
-    | `Quit -> run_action `Quit
-    | _ -> ()
-  done;
-  let slide = match t.next_slides with
-    | slide :: _ -> Wall.Image.seq (slide {time = get_time t; wall = t.wall})
-    | [] -> Wall.Image.empty
-  in
-  match render_slide t slide with
-  | Result.Ok () -> ()
-  | Result.Error (`Msg msg) ->
-    prerr_endline ("Render error?: " ^ msg)
-
-let destroy_window { win; gl; wall } =
-  Wall.Renderer.delete wall;
-  Sdl.gl_delete_context gl;
-  Sdl.destroy_window win
-
-let window =
-  get_result (make_window ~w:1024 ~h:768)
-
-let () = (window.quit <- true)
-
-let unix_stat fname =
-  match Unix.stat fname with
-  | stat -> {stat with Unix.st_atime = stat.Unix.st_mtime}
-  | exception (Unix.Unix_error (Unix.ENOENT, _, _)) ->
-    raise Not_found
-
-let rec main () =
-  Sdl.show_window window.win;
-  if window.quit then (
-    Sdl.hide_window window.win;
-    Lwt.return_unit
-  ) else (
-    process_events window;
-    Lwt.bind (Lwt_unix.sleep 0.01) main
-  )
-
-let () = Lwt.async main