create initial opengl renderer

This commit is contained in:
tali 2024-01-15 13:02:40 -05:00
parent 0379c8c2e2
commit 8ce34a1a4b
3 changed files with 62 additions and 26 deletions

View File

@ -15,6 +15,4 @@ module Sdl = struct
let gl_set_swap_interval_exn i = gl_set_swap_interval i |> or_exn
end
module Gl = struct
include Tgl4.Gl
end
include (val Ohlog.logs "Geom")

View File

@ -1,51 +1,51 @@
open! Import
include (val Ohlog.logs "main")
include (val Ohlog.sublogs logger "Main")
exception Quit
let main () =
info (fun m -> m "initializing");
let flags = Sdl.Window.(shown + opengl + resizable) in
debug (fun m -> m "initializing");
let flags = Sdl.Window.(opengl + resizable - shown) in
let window =
Sdl.create_window_exn
~w:1024 ~h:800
"Geometra"
"GEOMETRA"
flags
in
info (fun m -> m "window initialized");
let ren = Renderer.make ~window in
info (fun m -> m "renderer initialized");
try
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;
Sdl.show_window window;
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)));
()
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;
Renderer.pre_draw ren;
Renderer.clear ren (rgb24 0xff8833);
Renderer.post_draw ren;
done
with Quit ->
()
begin
info (fun m -> m "quitting");
end
let () =
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)
| Failure msg -> error (fun m -> m "%s" msg)
| Sdl.Error msg -> error (fun m -> m "SDL error: %s" msg)
| Asset.Error (path, msg) -> error (fun m -> m "failed to load %S: %s" path msg)

38
src/renderer.ml Normal file
View File

@ -0,0 +1,38 @@
open! Import
include (val Ohlog.sublogs logger "Ren")
type t = {
window : Sdl.window;
gl_ctx : Sdl.gl_context;
}
let make ~(window : Sdl.window) : t =
debug (fun m -> m "initializing");
let gl_ctx = Sdl.gl_create_context_exn window in
Sdl.gl_make_current_exn window gl_ctx;
Sdl.gl_set_swap_interval_exn 1;
{
window;
gl_ctx;
}
let destroy t =
Sdl.gl_delete_context t.gl_ctx
let pre_draw t =
begin
Sdl.gl_make_current_exn t.window t.gl_ctx;
(* let size = Sdl.get_window_size t.window in *)
end
let clear (_t : t) (bg : color) =
begin
Gl.clear_color bg.r bg.g bg.b bg.a;
Gl.clear Gl.color_buffer_bit;
end
let post_draw t =
begin
Sdl.gl_swap_window t.window;
end