sdl window init

src/import.ml

@@ -0,0 +1,20 @@
+exception Sdl of string
+
+module Sdl = struct
+  include Tsdl.Sdl
+
+  exception Error of string
+
+  let or_exn = function
+    | Ok x -> x
+    | Error (`Msg e) -> raise (Sdl e)
+
+  let create_window_exn t ~w ~h fl = create_window t ~w ~h fl |> or_exn
+  let gl_create_context_exn w = gl_create_context w |> or_exn
+  let gl_make_current_exn w gl = gl_make_current w gl |> or_exn
+  let gl_set_swap_interval_exn i = gl_set_swap_interval i |> or_exn
+end
+
+module Gl = struct
+  include Tgl4.Gl
+end

src/main.ml

@@ -1,5 +1,51 @@
-include (val Ohlog.logs "Gm")
+open! Import
+
+include (val Ohlog.logs "main")
+
+exception Quit
+
+let main () =
+  info (fun m -> m "initializing");
+
+  let flags = Sdl.Window.(shown + opengl + resizable) in
+  let window =
+    Sdl.create_window_exn
+      ~w:1024 ~h:800
+      "Geometra"
+      flags
+  in
+  let event = Sdl.Event.create () in
+  let some_event = Some event in
+
+  let ogl = Sdl.gl_create_context_exn window in
+  Sdl.gl_make_current_exn window ogl;
+  Sdl.gl_set_swap_interval_exn 1;
+
+  begin
+    Gl.clear_color 1. 0. 1. 1.;
+  end;
+
+  info (fun m -> m "initialized");
+  try
+    while true do
+      while Sdl.poll_event some_event do
+        match Sdl.Event.(get event typ |> enum) with
+        | `Quit -> raise_notrace Quit
+        | _ ->
+          trace (fun m -> m "uncaught event (%d)" (Sdl.Event.(get event typ)));
+          ()
+      done;
+
+      (* let time = Sdl.get_ticks () |> Int32.to_int in *)
+      Gl.clear Gl.color_buffer_bit;
+      Sdl.gl_swap_window window;
+    done
+  with Quit ->
+    ()
+
 
 let () =
-  Ohlog.init () ~min_level:TRACE;
-  info (fun m -> m "init")
+  Ohlog.init () ~min_level:DEBUG;
+  try main () with
+  | Sdl.Error msg -> error (fun m -> m "%s" msg)
+  | Failure msg -> error (fun m -> m "failure: %s" msg)