diff --git a/assets/main.scene b/assets/main.scene new file mode 100644 index 0000000..98c04dc --- /dev/null +++ b/assets/main.scene @@ -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))))) diff --git a/src/main.ml b/src/main.ml index ea827d8..238421f 100644 --- a/src/main.ml +++ b/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; diff --git a/src/n2/dune b/src/n2/dune index 29133e3..7b864af 100644 --- a/src/n2/dune +++ b/src/n2/dune @@ -4,4 +4,5 @@ (libraries adam s2 - ohlog)) + ohlog + sexplib)) diff --git a/src/n2/n2.ml b/src/n2/n2.ml index 74d195f..8ef311b 100644 --- a/src/n2/n2.ml +++ b/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