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
|
||||
module TG = N2.Transform_graph
|
||||
module SG = N2.Sprite_graph
|
||||
module Scene = N2.Scene
|
||||
|
||||
include (val Ohlog.logs "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");
|
||||
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");
|
||||
|
||||
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 () =
|
||||
begin
|
||||
(* Update *)
|
||||
|
|
@ -45,7 +32,7 @@ let main () =
|
|||
)
|
||||
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;
|
||||
|
||||
Renderer.pre_draw ren;
|
||||
|
|
|
|||
|
|
@ -4,4 +4,5 @@
|
|||
(libraries
|
||||
adam
|
||||
s2
|
||||
ohlog))
|
||||
ohlog
|
||||
sexplib))
|
||||
|
|
|
|||
132
src/n2/n2.ml
132
src/n2/n2.ml
|
|
@ -1,9 +1,10 @@
|
|||
open Adam
|
||||
module Sexp = Sexplib0.Sexp
|
||||
|
||||
include (val Ohlog.logs "N2")
|
||||
|
||||
module Transform_graph = struct
|
||||
include (val Ohlog.logs "TG")
|
||||
include (val Ohlog.sublogs logger "TG")
|
||||
|
||||
type t = {
|
||||
mutable buffer : node array;
|
||||
|
|
@ -72,7 +73,7 @@ module Transform_graph = struct
|
|||
end
|
||||
|
||||
module Sprite_graph = struct
|
||||
include (val Ohlog.logs "SG")
|
||||
include (val Ohlog.sublogs logger "SG")
|
||||
|
||||
type t = {
|
||||
mutable list_rev : node list;
|
||||
|
|
@ -141,3 +142,130 @@ module Entity = struct
|
|||
ent
|
||||
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