yea bitches

bin/dune

@@ -0,0 +1,6 @@
+(executables
+ (names main example lumppile)
+ (flags :standard -w -3-6-27-33)
+ (libraries komm tsdl tgls.tgles2 wall irmin-unix))
+
+

bin/example.ml

@@ -0,0 +1,119 @@
+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

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

bin/lumppile.ml

@@ -0,0 +1,30 @@
+(* 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

@@ -0,0 +1,19 @@
+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

@@ -0,0 +1,415 @@
+[@@@ocaml.warning "-6-9-26-27"]
+open Lwt.Infix
+module F = Fmt
+
+(* komm / konsole / tafel *)
+(* let f = try float_of_string Sys.argv.(1) with _ -> 1.0 *)
+
+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]*)
+
+
+
+module Display = struct
+  open Wall
+  open Tgles2
+  open Tsdl
+  open Gg
+  let (>>=) x f = match x with
+    | Ok a -> f a
+    | Error x as result -> result
+  
+  let get_result = function
+    | Ok x -> x
+    | Error (`Msg msg) -> failwith msg
+
+  type key = int
+  type mouse = (int * int)
+  type event = [ `Key_down of key
+               | `Key_up of key
+               | `Mouse of mouse
+               | `Quit
+               | `Fullscreen of bool
+               | `None ]
+
+  let event_of_sdlevent ev = 
+    match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with
+    | `Key_up -> F.pr "Key_up\n"; let key = Sdl.Event.get ev Sdl.Event.keyboard_keycode in `Key_up key
+    | `Mouse_button_down | `Mouse_button_up | `Mouse_motion | `Mouse_wheel ->
+       F.pr "Mouse Event\n";
+       let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy
+    | `Quit -> F.pr "Quit Event\n"; `Quit
+    | _ -> `None
+          
+  (* 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 + 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.poll_event (Some ev) do
+      let e = event_of_sdlevent ev in
+      if e != `None then el := e :: !el
+    done;
+    F.pr "Receieved %d handled events" (List.length !el);    
+    
+    (* Handle some of the events *)
+    el := List.filter_map
+            (function 
+             | `Quit -> frame.quit <- true; None
+             | `Fullscreen ->
+                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                           
+             | a -> Some a) !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));
+                                         time = ticks (); events = []; 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
+    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.pr "event loop took %0.2fms\n" (ticks () -. tstart); 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 (Box2.ox b) (Box2.oy b) (Box2.w b) (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))))
+
+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 () = []
+
+(* 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
+        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 (Box2.ox s.box) (Box2.oy s.box) (Box2.w s.box) 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)))))
+
+let draw_pp height ppf (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
+  (* Printf.printf "Font Metrics:\n\tascent:%f\n\tdescent:%f\n\tline_gap:%f\n" fm.ascent fm.descent fm.line_gap; *)
+  let font_height = fm.ascent -. fm.descent +. fm.line_gap in F.pr "font_height: %f\n" font_height;
+  let out_string text o l =
+    let text = String.sub text o l in
+    let sp = !sc in
+    push @@ simple_text f text !sc;
+    sc := {!sc with box = (Box2.of_pts (P2.v (Box2.maxx !box) (Box2.oy sp.box)) (Box2.max sp.box))};
+    F.pr "out_string: (\"%s\")\n\tsp.box=%s\n\t!sc.box=%s\n\t!box=%s@."
+      text (str_of_box sp.box) (str_of_box !sc.box) (str_of_box !box)
+  in
+  let out_flush () =
+    print_endline ("out_flush: () " ^ (str_of_box !sc.box)) ; () in
+  let out_newline () =
+    let nlp = P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height) in
+    sc := {!sc with box = Box2.of_pts nlp (Box2.max s.box)}; 
+    Printf.printf "out_newline: (%0.1f %0.1f) %s\n" (P2.x nlp) (P2.y nlp) (str_of_box !sc.box); flush stdout
+  in
+  let out_spaces n =
+    let nf = float n in 
+    let wpx = Text.Font.text_width f " " in
+    let nl =  ((Box2.ox !sc.box) +. (nf *. wpx)) > (Box2.maxx !sc.box) in
+    if nl then begin (* WRAP *)
+        F.pr "out_spaces: ===== WRAP =======@.";
+        out_newline ()
+      end;
+    let so = !sc in
+    let bo = Box2.v (Box2.o !sc.box) (P2.v (nf *. wpx) height) in
+    let ws = (Box2.w !box) /. nf in
+    for m = 0 to n-1 do
+      let mf = float m in
+      let bsp = (Box2.v (Box2.br_pt !box) (P2.v wpx height)) in
+      F.pr "out_space(%d): %s -> %s \n" m (str_of_box !box) (str_of_box bsp); 
+      push @@ pane_hbox [path_circle (Color.v 0.125 1.0 0.125 0.125) bsp] !sc;
+    done;
+    box := bo;
+    sc := {!sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box)};
+    Printf.printf "out_spaces: (n=%d=%0.2fpx, nl=%b) %s\n\tbo=%s\n" n (nf *. wpx) nl (str_of_box !sc.box)
+      (str_of_box bo); flush stdout
+  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)};
+    Printf.printf "out_indent: (n=%d=%0.2fpx) %s\n" n p (str_of_box !sc.box); flush stdout in
+  let pp = Format.formatter_of_out_functions {out_string; out_flush; out_newline; out_spaces; out_indent;} in
+  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;
+  F.pr "draw_pp-2:\n\t!sc=%s\n" (str_of_box !sc.box);
+  F.pr "pp_margin: %d\n" (Format.pp_get_margin pp ());
+  ppf pp;
+  Format.pp_force_newline pp ();
+  F.pr "draw_pp-1:\n\t!sc=%s\n" (str_of_box !sc.box);
+  F.pr "pp_margin: %d\n" (Format.pp_get_margin pp ());
+  let (sr, (br, ir)) = (!sc, ((Box2.of_pts (Box2.o s.box) (Box2.max !sc.box)), !node)) in
+  F.pr "draw_pp:\n\tso=%s\n\tbr=%s\n\tsr=%s\n" (str_of_box s.box) (str_of_box br) (str_of_box sr.box);
+  (sr, (br, ir))
+
+let draw_sob sob s =
+  let sc = ref s in
+  let items = Format.flush_symbolic_output_buffer sob in
+  List.iter (fun itm ->
+      ()) items;
+  (s, Image.empty)
+
+
+let draw_repl height (s:Display.state) =
+  ()
+
+(* let draw_tree height (s:Display.state) =
+ *   let indent = ref 0 in
+ *   let rec draw_levels (tree:(string) 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 = () in
+ *         draw_levels subtree pp;
+ *         Format.pp_close_box pp ()
+ *       ) tree;
+ *     indent := !indent - 1
+ *   in
+ *   let root = Lwt_main.run
+ *   Printf.printf "Lumplist length: %d\n" (List.length root);
+ *   draw_pp height (draw_levels root) s *)
+
+let draw_lumptree height (s:Display.state) =
+  let from = [] in (* future optional arg *)
+  let pile = Lump.branch "./kommpile" "current" in (* future args *)
+  let indent = ref 0 in
+  let rec draw_levels (tree:(string * Lump.Pile.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 (Lump.Pile.Tree.list node []) in
+        draw_levels subtree pp;
+        Format.pp_close_box pp ()
+      ) tree;
+    indent := !indent - 1
+  in
+  let root = Lwt_main.run (Lump.Pile.get_tree pile from >>= (fun n -> Lump.Pile.Tree.list n [])) in
+  Printf.printf "Lumplist length: %d\n" (List.length root);
+  draw_pp height (draw_levels root) s
+
+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
+  let _, (mouse_x, mouse_y) = Tsdl.Sdl.get_mouse_state () in
+  F.pr "\n\n\t================================================\t vvvvvvvvvvvvvvv\n";
+  push @@ fill_box (Display.gray 0.125) s.box !state; (* gray bg *)
+  push @@ pane_vbox [
+              draw_lumptree 50.;
+              draw_pp 30.
+                  (fun pp ->
+                  Box2.pp pp s.box;
+                  Format.pp_open_box pp 0;
+                  Format.pp_force_newline pp ();
+                  Format.pp_print_string pp "fuck off!";
+                  Format.fprintf pp "@[@[fuck@,-right@]@ off@,!!!@]";
+                  Format.pp_print_newline pp ();
+                  Format.pp_print_flush pp ();
+                  Format.fprintf pp "%f@." 0.2;
+                  Format.pp_print_if_newline pp ();
+                  Format.fprintf pp "@[%s@ %d@]@." "x =" 1;
+                  Format.pp_close_box pp ();
+                  Format.pp_print_flush pp ()
+                  )] {s with 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) ()
+

bin/old_main.ml

@@ -0,0 +1,155 @@
+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

@@ -0,0 +1,202 @@
+[@@@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