add N2.mli

This reverts commit 827c5eb0a6.

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,8 @@ let main () =
           )
         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;
 
       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;
@@ -81,7 +82,7 @@ module Sprite_graph = struct
 
   and node = {
     tf : mat2a;
-    rect : aabb;
+    bb : aabb;
     fill : color;
     (* mutable remove : bool; *)
   }
@@ -97,15 +98,15 @@ module Sprite_graph = struct
       t.list <- [];
     end
 
-  let add t ~tf ~rect ~fill =
-    let node = { tf; rect; fill } in
+  let add_rect t ~tf ~bb ~fill =
+    let node = { tf; bb; fill } in
     push t node;
     node
 
   let rec render_rec ren = function
     | [] -> ()
-    | { tf; rect; fill } :: nodes ->
-      S2.Renderer.draw_rect ren ~tf ~rect ~fill;
+    | { tf; bb; fill } :: nodes ->
+      S2.Renderer.draw_rect ren ~tf ~bb ~fill;
       render_rec ren nodes
 
   let render t ~ren =
@@ -141,3 +142,133 @@ 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_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

src/n2/n2.mli

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

src/s2/renderer.ml

@@ -286,13 +286,13 @@ let clear _t (bg : color) =
     Gl.clear Gl.color_buffer_bit;
   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
   begin
     (* TODO: cache/store uniform locations in some way *)
     use sh;
     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_color (uniform sh "Fill") fill;
     draw_geometry t.rect;

src/s2/window.ml

@@ -6,7 +6,7 @@ exception Quit
 type t = Sdl.window
 
 let make ~title =
-  let flags = Sdl.Window.(opengl + resizable - shown) in
+  let flags = Sdl.Window.(opengl + resizable + hidden) in
   let window =
     Sdl.create_window_exn
       ~w:1024 ~h:800