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