diff --git a/src/dune b/src/dune index 20d2be8..0f23324 100644 --- a/src/dune +++ b/src/dune @@ -4,7 +4,6 @@ (public_name geometra) (libraries adam + s2 - ohlog - tsdl - tgls.tgl4)) + ohlog)) diff --git a/src/import.ml b/src/import.ml deleted file mode 100644 index bb2b077..0000000 --- a/src/import.ml +++ /dev/null @@ -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") diff --git a/src/main.ml b/src/main.ml index e233df0..f6dfef1 100644 --- a/src/main.ml +++ b/src/main.ml @@ -1,36 +1,15 @@ -open! Import -include (val Ohlog.sublogs logger "Main") - -exception Quit +open S2 +open Adam +include (val Ohlog.logs "Main") let main () = debug (fun m -> m "initializing"); - let flags = Sdl.Window.(opengl + resizable - shown) in - let window = - Sdl.create_window_exn - ~w:1024 ~h:800 - "GEOMETRA" - flags - in + let window = Window.make ~title:"GEOMETRA" 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 - - 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 render () = + begin (* let time = Sdl.get_ticks () |> Int32.to_int in *) Renderer.pre_draw ren; Renderer.clear ren (rgb24 0x000000); @@ -39,12 +18,10 @@ let main () = ~bb:(aabb (-5.0) (-10.0) 50.0 200.0) ~fill:(rgb24 0xff0000); Renderer.post_draw ren; - done - with Quit -> - begin - info (fun m -> m "quitting"); end - + in + Window.event_loop window ~render; + info (fun m -> m "quitting") let () = Ohlog.init () ~min_level:DEBUG; diff --git a/src/asset.ml b/src/s2/asset.ml similarity index 100% rename from src/asset.ml rename to src/s2/asset.ml diff --git a/src/s2/dune b/src/s2/dune new file mode 100644 index 0000000..e3bc01e --- /dev/null +++ b/src/s2/dune @@ -0,0 +1,9 @@ +(library + (name s2) + (package geometra) + (libraries + adam + + ohlog + tsdl + tgls.tgl4)) diff --git a/src/gl.ml b/src/s2/gl.ml similarity index 100% rename from src/gl.ml rename to src/s2/gl.ml diff --git a/src/s2/import.ml b/src/s2/import.ml new file mode 100644 index 0000000..9ea848d --- /dev/null +++ b/src/s2/import.ml @@ -0,0 +1,4 @@ +include Adam +module Array1 = Bigarray.Array1 + +include (val Ohlog.logs "S2") diff --git a/src/renderer.ml b/src/s2/renderer.ml similarity index 95% rename from src/renderer.ml rename to src/s2/renderer.ml index a9e9f85..b2d3ce9 100644 --- a/src/renderer.ml +++ b/src/s2/renderer.ml @@ -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_mat2a : mat2a set_fn = - let _mat3x3 = Array1.create Float32 C_layout 9 in - _mat3x3.{6} <- 0.0; - _mat3x3.{7} <- 0.0; - _mat3x3.{8} <- 1.0; + let mat3 = Array1.create Float32 C_layout 9 in + mat3.{6} <- 0.0; + mat3.{7} <- 0.0; + mat3.{8} <- 1.0; fun (U l) mat -> - _mat3x3.{0} <- mat.a0; - _mat3x3.{1} <- mat.a1; - _mat3x3.{2} <- mat.a2; - _mat3x3.{3} <- mat.a3; - _mat3x3.{4} <- mat.a4; - _mat3x3.{5} <- mat.a5; - Gl.uniform_matrix3fv l 1 true _mat3x3 + mat3.{0} <- mat.a0; + mat3.{1} <- mat.a1; + mat3.{2} <- mat.a2; + mat3.{3} <- mat.a3; + mat3.{4} <- mat.a4; + mat3.{5} <- mat.a5; + Gl.uniform_matrix3fv l 1 true mat3 (* Geometry *) @@ -275,6 +275,11 @@ let pre_draw t = set_ivec2 (uniform t.polygon "Viewport") viewport; end +let post_draw t = + begin + Sdl.gl_swap_window t.window; + end + let clear _t (bg : color) = begin 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; draw_geometry t.rect; end - -let post_draw t = - begin - Sdl.gl_swap_window t.window; - end diff --git a/src/s2/s2.ml b/src/s2/s2.ml new file mode 100644 index 0000000..87a688c --- /dev/null +++ b/src/s2/s2.ml @@ -0,0 +1,5 @@ +module Window = Window +module Asset = Asset +module Renderer = Renderer +module Sdl = Sdl +module Gl = Gl diff --git a/src/s2/sdl.ml b/src/s2/sdl.ml new file mode 100644 index 0000000..df32bcd --- /dev/null +++ b/src/s2/sdl.ml @@ -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 + diff --git a/src/s2/window.ml b/src/s2/window.ml new file mode 100644 index 0000000..569bd5f --- /dev/null +++ b/src/s2/window.ml @@ -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 -> + ()