sdl window init
This commit is contained in:
parent
02d4fab371
commit
127272f8e6
|
@ -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
|
52
src/main.ml
52
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 () =
|
let () =
|
||||||
Ohlog.init () ~min_level:TRACE;
|
Ohlog.init () ~min_level:DEBUG;
|
||||||
info (fun m -> m "init")
|
try main () with
|
||||||
|
| Sdl.Error msg -> error (fun m -> m "%s" msg)
|
||||||
|
| Failure msg -> error (fun m -> m "failure: %s" msg)
|
||||||
|
|
Loading…
Reference in New Issue