yea bitches

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 *)