interpret scene description from sexp file

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)))))

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;

src/n2/dune

@@ -4,4 +4,5 @@
  (libraries
    adam
    s2
-   ohlog))
+   ohlog
+   sexplib))

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