move everything to s2 library
This commit is contained in:
parent
192074f7eb
commit
ceafd98d63
5
src/dune
5
src/dune
|
@ -4,7 +4,6 @@
|
||||||
(public_name geometra)
|
(public_name geometra)
|
||||||
(libraries
|
(libraries
|
||||||
adam
|
adam
|
||||||
|
s2
|
||||||
|
|
||||||
ohlog
|
ohlog))
|
||||||
tsdl
|
|
||||||
tgls.tgl4))
|
|
||||||
|
|
|
@ -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")
|
|
41
src/main.ml
41
src/main.ml
|
@ -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;
|
||||||
|
|
|
@ -0,0 +1,9 @@
|
||||||
|
(library
|
||||||
|
(name s2)
|
||||||
|
(package geometra)
|
||||||
|
(libraries
|
||||||
|
adam
|
||||||
|
|
||||||
|
ohlog
|
||||||
|
tsdl
|
||||||
|
tgls.tgl4))
|
|
@ -0,0 +1,4 @@
|
||||||
|
include Adam
|
||||||
|
module Array1 = Bigarray.Array1
|
||||||
|
|
||||||
|
include (val Ohlog.logs "S2")
|
|
@ -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
|
|
|
@ -0,0 +1,5 @@
|
||||||
|
module Window = Window
|
||||||
|
module Asset = Asset
|
||||||
|
module Renderer = Renderer
|
||||||
|
module Sdl = Sdl
|
||||||
|
module Gl = Gl
|
|
@ -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
|
||||||
|
|
|
@ -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 ->
|
||||||
|
()
|
Loading…
Reference in New Issue