Compare commits
5 Commits
781b822597
...
5ce8d30f89
Author | SHA1 | Date |
---|---|---|
tali | 5ce8d30f89 | |
tali | a691757921 | |
tali | 3714ecb88d | |
tali | d5b7821ec7 | |
tali | a1a460e2e3 |
|
@ -0,0 +1,17 @@
|
||||||
|
(scene
|
||||||
|
(object
|
||||||
|
(name root)
|
||||||
|
|
||||||
|
(object
|
||||||
|
(name box_red)
|
||||||
|
(transform (tx -5) (ty -5))
|
||||||
|
(sprite
|
||||||
|
(rect -50 -50 50 50)
|
||||||
|
(fill 0xff0000)))
|
||||||
|
|
||||||
|
(object
|
||||||
|
(name box_blue)
|
||||||
|
(transform (tx 5) (ty 5))
|
||||||
|
(sprite
|
||||||
|
(rect -50 -50 50 50)
|
||||||
|
(fill 0x0055ff)))))
|
30
src/main.ml
30
src/main.ml
|
@ -2,36 +2,23 @@ open Adam
|
||||||
open S2
|
open S2
|
||||||
module TG = N2.Transform_graph
|
module TG = N2.Transform_graph
|
||||||
module SG = N2.Sprite_graph
|
module SG = N2.Sprite_graph
|
||||||
|
module Scene = N2.Scene
|
||||||
|
|
||||||
include (val Ohlog.logs "Main")
|
include (val Ohlog.logs "Main")
|
||||||
|
|
||||||
let main () =
|
let main () =
|
||||||
let tg = TG.make () in
|
|
||||||
let sg = SG.make () in
|
|
||||||
|
|
||||||
let t_a = TG.add tg in
|
|
||||||
|
|
||||||
let sq = aabb (-50.0) (-50.0) 50.0 50.0 in
|
|
||||||
let t_b = TG.add tg ~parent:t_a in
|
|
||||||
SG.add sg ~tf:(TG.world t_b)
|
|
||||||
~bb:sq
|
|
||||||
~fill:(rgb24 0xff0000);
|
|
||||||
Mat2A.set (TG.model t_b)
|
|
||||||
~tx:(-5.0) ~ty:(-5.0) ~sx:1.0 ~sy:1.0;
|
|
||||||
|
|
||||||
let t_c = TG.add tg ~parent:t_a in
|
|
||||||
SG.add sg ~tf:(TG.world t_c)
|
|
||||||
~bb:sq
|
|
||||||
~fill:(rgb24 0x0055ff);
|
|
||||||
Mat2A.set (TG.model t_c)
|
|
||||||
~tx:(+5.0) ~ty:(+5.0) ~sx:1.0 ~sy:1.0;
|
|
||||||
|
|
||||||
debug (fun m -> m "initializing");
|
debug (fun m -> m "initializing");
|
||||||
let window = Window.make ~title:"GEOMETRA" in
|
let window = Window.make ~title:"GEOMETRA" 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 tg = TG.make () in
|
||||||
|
let sg = SG.make () in
|
||||||
|
|
||||||
|
let scene = Scene.load "main" ~tg ~sg in
|
||||||
|
let root = Scene.get scene "root" in
|
||||||
|
|
||||||
let render () =
|
let render () =
|
||||||
begin
|
begin
|
||||||
(* Update *)
|
(* Update *)
|
||||||
|
@ -45,7 +32,8 @@ let main () =
|
||||||
)
|
)
|
||||||
in
|
in
|
||||||
let ty = 400.0 in
|
let ty = 400.0 in
|
||||||
Mat2A.set (TG.model t_a) ~tx ~ty ~sx:1.0 ~sy:1.0
|
let tf = TG.model (Scene.transform root) in
|
||||||
|
Mat2A.set tf ~tx ~ty ~sx:1.0 ~sy:1.0
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Renderer.pre_draw ren;
|
Renderer.pre_draw ren;
|
||||||
|
|
|
@ -4,4 +4,5 @@
|
||||||
(libraries
|
(libraries
|
||||||
adam
|
adam
|
||||||
s2
|
s2
|
||||||
ohlog))
|
ohlog
|
||||||
|
sexplib))
|
||||||
|
|
145
src/n2/n2.ml
145
src/n2/n2.ml
|
@ -1,9 +1,10 @@
|
||||||
open Adam
|
open Adam
|
||||||
|
module Sexp = Sexplib0.Sexp
|
||||||
|
|
||||||
include (val Ohlog.logs "N2")
|
include (val Ohlog.logs "N2")
|
||||||
|
|
||||||
module Transform_graph = struct
|
module Transform_graph = struct
|
||||||
include (val Ohlog.logs "TG")
|
include (val Ohlog.sublogs logger "TG")
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
mutable buffer : node array;
|
mutable buffer : node array;
|
||||||
|
@ -72,7 +73,7 @@ module Transform_graph = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Sprite_graph = struct
|
module Sprite_graph = struct
|
||||||
include (val Ohlog.logs "SG")
|
include (val Ohlog.sublogs logger "SG")
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
mutable list_rev : node list;
|
mutable list_rev : node list;
|
||||||
|
@ -81,7 +82,7 @@ module Sprite_graph = struct
|
||||||
|
|
||||||
and node = {
|
and node = {
|
||||||
tf : mat2a;
|
tf : mat2a;
|
||||||
rect : aabb;
|
bb : aabb;
|
||||||
fill : color;
|
fill : color;
|
||||||
(* mutable remove : bool; *)
|
(* mutable remove : bool; *)
|
||||||
}
|
}
|
||||||
|
@ -97,15 +98,15 @@ module Sprite_graph = struct
|
||||||
t.list <- [];
|
t.list <- [];
|
||||||
end
|
end
|
||||||
|
|
||||||
let add t ~tf ~rect ~fill =
|
let add_rect t ~tf ~bb ~fill =
|
||||||
let node = { tf; rect; fill } in
|
let node = { tf; bb; fill } in
|
||||||
push t node;
|
push t node;
|
||||||
node
|
node
|
||||||
|
|
||||||
let rec render_rec ren = function
|
let rec render_rec ren = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| { tf; rect; fill } :: nodes ->
|
| { tf; bb; fill } :: nodes ->
|
||||||
S2.Renderer.draw_rect ren ~tf ~rect ~fill;
|
S2.Renderer.draw_rect ren ~tf ~bb ~fill;
|
||||||
render_rec ren nodes
|
render_rec ren nodes
|
||||||
|
|
||||||
let render t ~ren =
|
let render t ~ren =
|
||||||
|
@ -141,3 +142,133 @@ module Entity = struct
|
||||||
ent
|
ent
|
||||||
end
|
end
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
module Scene = struct
|
||||||
|
include (val Ohlog.sublogs logger "Scene")
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
objs : (string, obj) Hashtbl.t;
|
||||||
|
}
|
||||||
|
|
||||||
|
and obj = {
|
||||||
|
name : string option;
|
||||||
|
transform : Transform_graph.node;
|
||||||
|
sprites : Sprite_graph.node list;
|
||||||
|
}
|
||||||
|
|
||||||
|
let parse_transform_arg ~(tf : mat2a) = function
|
||||||
|
| Sexp.List [Atom "tx"; arg] ->
|
||||||
|
tf.a2 <- Sexplib.Conv.float_of_sexp arg
|
||||||
|
| Sexp.List [Atom "ty"; arg] ->
|
||||||
|
tf.a5 <- Sexplib.Conv.float_of_sexp arg
|
||||||
|
| Sexp.List [Atom "sx"; arg] ->
|
||||||
|
tf.a0 <- Sexplib.Conv.float_of_sexp arg
|
||||||
|
| Sexp.List [Atom "sy"; arg] ->
|
||||||
|
tf.a4 <- Sexplib.Conv.float_of_sexp arg
|
||||||
|
| sexp ->
|
||||||
|
Sexplib.Conv.of_sexp_error "bad argument to transform" sexp
|
||||||
|
|
||||||
|
let parse_sprite_arg ~(rect : aabb) ~(fill : color) = function
|
||||||
|
| Sexp.List [Atom "rect"; x0; x1; y0; y1] ->
|
||||||
|
AABB.set rect
|
||||||
|
~x0:(Sexplib.Conv.float_of_sexp x0)
|
||||||
|
~y0:(Sexplib.Conv.float_of_sexp x1)
|
||||||
|
~x1:(Sexplib.Conv.float_of_sexp y0)
|
||||||
|
~y1:(Sexplib.Conv.float_of_sexp y1)
|
||||||
|
| Sexp.List [Atom "fill"; rgb] ->
|
||||||
|
Color.set_rgb24 fill
|
||||||
|
(Sexplib.Conv.int_of_sexp rgb)
|
||||||
|
| Sexp.List [Atom "fill"; r; g; b] ->
|
||||||
|
begin
|
||||||
|
fill.r <- Sexplib.Conv.float_of_sexp r;
|
||||||
|
fill.g <- Sexplib.Conv.float_of_sexp g;
|
||||||
|
fill.b <- Sexplib.Conv.float_of_sexp b;
|
||||||
|
end
|
||||||
|
| sexp ->
|
||||||
|
Sexplib.Conv.of_sexp_error "bad argument to sprite" sexp
|
||||||
|
|
||||||
|
let parse_sprite ~sg ~tf = function
|
||||||
|
| Sexp.List (Atom "sprite" :: args) ->
|
||||||
|
let rect = aabb 0.0 0.0 0.0 0.0 in
|
||||||
|
let fill = Color.white () in
|
||||||
|
List.iter (parse_sprite_arg ~rect ~fill) args;
|
||||||
|
Sprite_graph.add_rect sg ~tf ~bb:rect ~fill
|
||||||
|
| sexp ->
|
||||||
|
Sexplib.Conv.of_sexp_error "invalid sprite" sexp
|
||||||
|
|
||||||
|
let rec parse_obj t ~tg ~sg ~parent = function
|
||||||
|
| Sexp.List (Atom "object" :: args) ->
|
||||||
|
trace (fun m -> m "parse_obj");
|
||||||
|
let parent_tf = Option.map (fun o -> o.transform) parent in
|
||||||
|
let transform = Transform_graph.add tg ?parent:parent_tf in
|
||||||
|
let obj = { name = None; transform; sprites = [] } in
|
||||||
|
let obj = parse_obj_args t obj args ~tg ~sg in
|
||||||
|
Option.iter
|
||||||
|
(fun name -> Hashtbl.replace t.objs name obj)
|
||||||
|
obj.name;
|
||||||
|
obj
|
||||||
|
| sexp ->
|
||||||
|
Sexplib.Conv.of_sexp_error "invalid object" sexp
|
||||||
|
|
||||||
|
and parse_obj_args t obj ~tg ~sg = function
|
||||||
|
| [] -> { obj with sprites = List.rev obj.sprites }
|
||||||
|
| arg :: args ->
|
||||||
|
match arg with
|
||||||
|
| Sexp.List [Atom "name"; Atom name] ->
|
||||||
|
trace (fun m -> m "parse_obj_args: name=%S" name);
|
||||||
|
let obj = { obj with name = Some name } in
|
||||||
|
parse_obj_args t obj args ~tg ~sg
|
||||||
|
| Sexp.List (Atom "transform" :: tf_args) ->
|
||||||
|
let tf = Transform_graph.model obj.transform in
|
||||||
|
List.iter (parse_transform_arg ~tf) tf_args;
|
||||||
|
trace (fun m -> m "parse_obj_args: tf=%a" Mat2A.pp tf);
|
||||||
|
parse_obj_args t obj args ~tg ~sg
|
||||||
|
| Sexp.List (Atom "sprite" :: _) ->
|
||||||
|
let tf = Transform_graph.world obj.transform in
|
||||||
|
let spr = parse_sprite arg ~sg ~tf in
|
||||||
|
let obj = { obj with sprites = spr :: obj.sprites } in
|
||||||
|
trace (fun m -> m "parse_obj_args: sprite %a %a"
|
||||||
|
Color.pp spr.fill
|
||||||
|
AABB.pp spr.bb);
|
||||||
|
parse_obj_args t obj args ~tg ~sg
|
||||||
|
| Sexp.List (Atom "object" :: _) ->
|
||||||
|
trace (fun m -> m "parse_obj_args: begin object");
|
||||||
|
let _child = parse_obj t arg ~tg ~sg ~parent:(Some obj) in
|
||||||
|
trace (fun m -> m "parse_obj_args: end object");
|
||||||
|
parse_obj_args t obj args ~tg ~sg
|
||||||
|
| sexp ->
|
||||||
|
Sexplib.Conv.of_sexp_error "bad argument to object" sexp
|
||||||
|
|
||||||
|
let of_sexp ~tg ~sg = function
|
||||||
|
| Sexp.List [Atom "scene"; root] ->
|
||||||
|
let t = {
|
||||||
|
objs = Hashtbl.create 128;
|
||||||
|
} in
|
||||||
|
let _root = parse_obj t root ~tg ~sg ~parent:None in
|
||||||
|
t
|
||||||
|
|
||||||
|
| sexp ->
|
||||||
|
Sexplib.Conv.of_sexp_error "invalid scene" sexp
|
||||||
|
|
||||||
|
let load name ~tg ~sg =
|
||||||
|
let path = Format.sprintf "%s.scene" name in
|
||||||
|
match Sexplib.Sexp.of_string_conv
|
||||||
|
(S2.Asset.load_file path)
|
||||||
|
(of_sexp ~tg ~sg)
|
||||||
|
with
|
||||||
|
| `Result v ->
|
||||||
|
debug (fun m -> m "loaded scene %S" name);
|
||||||
|
v
|
||||||
|
| `Error (exn, _) ->
|
||||||
|
let msg = match exn with
|
||||||
|
| Failure msg -> msg
|
||||||
|
| exn -> Printexc.to_string exn
|
||||||
|
in
|
||||||
|
raise (S2.Asset.Error (path, "parse error: " ^ msg))
|
||||||
|
|
||||||
|
let get t name =
|
||||||
|
try Hashtbl.find t.objs name
|
||||||
|
with Not_found -> Format.ksprintf failwith "no node %S in scene" name
|
||||||
|
|
||||||
|
let transform obj = obj.transform
|
||||||
|
end
|
||||||
|
|
|
@ -0,0 +1,38 @@
|
||||||
|
open Adam
|
||||||
|
open S2
|
||||||
|
module Sexp = Sexplib0.Sexp
|
||||||
|
|
||||||
|
module Transform_graph : sig
|
||||||
|
type t
|
||||||
|
type node
|
||||||
|
|
||||||
|
val make : unit -> t
|
||||||
|
val update : t -> unit
|
||||||
|
|
||||||
|
val add : ?parent:node -> t -> node
|
||||||
|
val model : node -> mat2a
|
||||||
|
val world : node -> mat2a
|
||||||
|
end
|
||||||
|
|
||||||
|
module Sprite_graph : sig
|
||||||
|
type t
|
||||||
|
type node
|
||||||
|
|
||||||
|
val make : unit -> t
|
||||||
|
val render : t -> ren:Renderer.t -> unit
|
||||||
|
|
||||||
|
val add_rect : t -> tf:mat2a -> bb:aabb -> fill:color -> node
|
||||||
|
end
|
||||||
|
|
||||||
|
module Scene : sig
|
||||||
|
type t
|
||||||
|
type obj
|
||||||
|
|
||||||
|
val load : string ->
|
||||||
|
tg:Transform_graph.t ->
|
||||||
|
sg:Sprite_graph.t ->
|
||||||
|
t
|
||||||
|
|
||||||
|
val get : t -> string -> obj
|
||||||
|
val transform : obj -> Transform_graph.node
|
||||||
|
end
|
|
@ -286,13 +286,13 @@ let clear _t (bg : color) =
|
||||||
Gl.clear Gl.color_buffer_bit;
|
Gl.clear Gl.color_buffer_bit;
|
||||||
end
|
end
|
||||||
|
|
||||||
let draw_rect t ~(tf : mat2a) ~(rect : aabb) ~(fill : color) =
|
let draw_rect t ~(tf : mat2a) ~(bb : aabb) ~(fill : color) =
|
||||||
let sh = t.polygon in
|
let sh = t.polygon in
|
||||||
begin
|
begin
|
||||||
(* TODO: cache/store uniform locations in some way *)
|
(* TODO: cache/store uniform locations in some way *)
|
||||||
use sh;
|
use sh;
|
||||||
set_mat2a (uniform sh "Transform") tf;
|
set_mat2a (uniform sh "Transform") tf;
|
||||||
set_aabb (uniform sh "BoundingBox") rect;
|
set_aabb (uniform sh "BoundingBox") bb;
|
||||||
set_int (uniform sh "Border") 0;
|
set_int (uniform sh "Border") 0;
|
||||||
set_color (uniform sh "Fill") fill;
|
set_color (uniform sh "Fill") fill;
|
||||||
draw_geometry t.rect;
|
draw_geometry t.rect;
|
||||||
|
|
|
@ -6,7 +6,7 @@ exception Quit
|
||||||
type t = Sdl.window
|
type t = Sdl.window
|
||||||
|
|
||||||
let make ~title =
|
let make ~title =
|
||||||
let flags = Sdl.Window.(opengl + resizable - shown) in
|
let flags = Sdl.Window.(opengl + resizable + hidden) in
|
||||||
let window =
|
let window =
|
||||||
Sdl.create_window_exn
|
Sdl.create_window_exn
|
||||||
~w:1024 ~h:800
|
~w:1024 ~h:800
|
||||||
|
|
Loading…
Reference in New Issue