move everything to s2 library

This commit is contained in:
tali 2024-01-15 17:08:50 -05:00
parent 192074f7eb
commit ceafd98d63
11 changed files with 93 additions and 70 deletions

View File

@ -4,7 +4,6 @@
(public_name geometra) (public_name geometra)
(libraries (libraries
adam adam
s2
ohlog ohlog))
tsdl
tgls.tgl4))

View File

@ -1,19 +0,0 @@
include Adam
module Array1 = Bigarray.Array1
module Sdl = struct
include Tsdl.Sdl
exception Error of string
let or_exn = function
| Ok x -> x
| Error (`Msg e) -> raise (Error 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
include (val Ohlog.logs "Geom")

View File

@ -1,36 +1,15 @@
open! Import open S2
include (val Ohlog.sublogs logger "Main") open Adam
include (val Ohlog.logs "Main")
exception Quit
let main () = let main () =
debug (fun m -> m "initializing"); debug (fun m -> m "initializing");
let flags = Sdl.Window.(opengl + resizable - shown) in let window = Window.make ~title:"GEOMETRA" in
let window =
Sdl.create_window_exn
~w:1024 ~h:800
"GEOMETRA"
flags
in
info (fun m -> m "window initialized"); info (fun m -> m "window initialized");
let ren = Renderer.make ~window in let ren = Renderer.make ~window in
info (fun m -> m "renderer initialized"); info (fun m -> m "renderer initialized");
let render () =
try begin
let event = Sdl.Event.create () in
let some_event = Some event in
Sdl.show_window window;
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 *) (* let time = Sdl.get_ticks () |> Int32.to_int in *)
Renderer.pre_draw ren; Renderer.pre_draw ren;
Renderer.clear ren (rgb24 0x000000); Renderer.clear ren (rgb24 0x000000);
@ -39,12 +18,10 @@ let main () =
~bb:(aabb (-5.0) (-10.0) 50.0 200.0) ~bb:(aabb (-5.0) (-10.0) 50.0 200.0)
~fill:(rgb24 0xff0000); ~fill:(rgb24 0xff0000);
Renderer.post_draw ren; Renderer.post_draw ren;
done
with Quit ->
begin
info (fun m -> m "quitting");
end end
in
Window.event_loop window ~render;
info (fun m -> m "quitting")
let () = let () =
Ohlog.init () ~min_level:DEBUG; Ohlog.init () ~min_level:DEBUG;

9
src/s2/dune Normal file
View File

@ -0,0 +1,9 @@
(library
(name s2)
(package geometra)
(libraries
adam
ohlog
tsdl
tgls.tgl4))

4
src/s2/import.ml Normal file
View File

@ -0,0 +1,4 @@
include Adam
module Array1 = Bigarray.Array1
include (val Ohlog.logs "S2")

View File

@ -134,18 +134,18 @@ let set_color : color set_fn = fun (U l) c -> Gl.uniform4f l c.r c.g c.b c.a
let set_aabb : aabb set_fn = fun (U l) b -> Gl.uniform4f l b.x0 b.y0 b.x1 b.y1 let set_aabb : aabb set_fn = fun (U l) b -> Gl.uniform4f l b.x0 b.y0 b.x1 b.y1
let set_mat2a : mat2a set_fn = let set_mat2a : mat2a set_fn =
let _mat3x3 = Array1.create Float32 C_layout 9 in let mat3 = Array1.create Float32 C_layout 9 in
_mat3x3.{6} <- 0.0; mat3.{6} <- 0.0;
_mat3x3.{7} <- 0.0; mat3.{7} <- 0.0;
_mat3x3.{8} <- 1.0; mat3.{8} <- 1.0;
fun (U l) mat -> fun (U l) mat ->
_mat3x3.{0} <- mat.a0; mat3.{0} <- mat.a0;
_mat3x3.{1} <- mat.a1; mat3.{1} <- mat.a1;
_mat3x3.{2} <- mat.a2; mat3.{2} <- mat.a2;
_mat3x3.{3} <- mat.a3; mat3.{3} <- mat.a3;
_mat3x3.{4} <- mat.a4; mat3.{4} <- mat.a4;
_mat3x3.{5} <- mat.a5; mat3.{5} <- mat.a5;
Gl.uniform_matrix3fv l 1 true _mat3x3 Gl.uniform_matrix3fv l 1 true mat3
(* Geometry *) (* Geometry *)
@ -275,6 +275,11 @@ let pre_draw t =
set_ivec2 (uniform t.polygon "Viewport") viewport; set_ivec2 (uniform t.polygon "Viewport") viewport;
end end
let post_draw t =
begin
Sdl.gl_swap_window t.window;
end
let clear _t (bg : color) = let clear _t (bg : color) =
begin begin
Gl.clear_color bg.r bg.g bg.b bg.a; Gl.clear_color bg.r bg.g bg.b bg.a;
@ -292,8 +297,3 @@ let draw_rect t ~(tf : mat2a) ~(bb : aabb) ~(fill : color) =
set_color (uniform sh "Fill") fill; set_color (uniform sh "Fill") fill;
draw_geometry t.rect; draw_geometry t.rect;
end end
let post_draw t =
begin
Sdl.gl_swap_window t.window;
end

5
src/s2/s2.ml Normal file
View File

@ -0,0 +1,5 @@
module Window = Window
module Asset = Asset
module Renderer = Renderer
module Sdl = Sdl
module Gl = Gl

14
src/s2/sdl.ml Normal file
View File

@ -0,0 +1,14 @@
open! Import
include Tsdl.Sdl
exception Error of string
let or_exn = function
| Ok x -> x
| Error (`Msg e) -> raise (Error 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

34
src/s2/window.ml Normal file
View File

@ -0,0 +1,34 @@
open! Import
include (val Ohlog.sublogs logger "Window")
exception Quit
type t = Sdl.window
let make ~title =
let flags = Sdl.Window.(opengl + resizable - shown) in
let window =
Sdl.create_window_exn
~w:1024 ~h:800
title
flags
in
info (fun m -> m "window initialized");
window
let event_loop window ~render =
let event = Sdl.Event.create () in
let some_event = Some event in
try
Sdl.show_window window;
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;
render ()
done
with Quit ->
()