interpret scene description from sexp file
This commit is contained in:
parent
781b822597
commit
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)))))
|
29
src/main.ml
29
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,7 @@ 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
|
Mat2A.set (TG.model root.transform) ~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))
|
||||||
|
|
132
src/n2/n2.ml
132
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;
|
||||||
|
@ -141,3 +142,130 @@ 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 sg ~tf ~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.rect);
|
||||||
|
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 =
|
||||||
|
Hashtbl.find t.objs name
|
||||||
|
end
|
||||||
|
|
Loading…
Reference in New Issue