yea bitches

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