change renderer API to enable batched sprite rendering

assets/main.scene

@@ -11,6 +11,8 @@
      (L 64 0)
      (L 64 -32))))
 
+  ; TODO: put hold/next/icons in the same (sprites) group
+
   (object "hold"
    (transform (tx -272) (ty -272))
    (sprites hud hold))

src/n2/n2.ml

@@ -83,10 +83,10 @@ module Sprite_graph = struct
   }
 
   and node =
-    | Sprite of {
+    | Sprites of {
         tf : mat2a;
-        pos : vec2;
-        sprite : Sprite.t;
+        map : Sprite.map;
+        (* mutable *)sprites : (Sprite.t * vec2) array;
         (* tint : color *)
       }
     | Label of {
@@ -109,15 +109,13 @@ module Sprite_graph = struct
   let register_font t name font =
     Hashtbl.replace t.fonts name font
 
-  let get_sprite t map_name sprite_name =
-    let map = try Hashtbl.find t.sprite_maps map_name
-      with Not_found -> Format.kasprintf failwith "no sprite map %S" map_name
-    in
-    Sprite.get map sprite_name
+  let get_sprite_map t name =
+    try Hashtbl.find t.sprite_maps name with
+      Not_found -> Format.kasprintf failwith "no sprite map %S" name
 
   let get_font t name =
-    try Hashtbl.find t.fonts name
-    with Not_found -> Format.kasprintf failwith "no font %S" name
+    try Hashtbl.find t.fonts name with
+      Not_found -> Format.kasprintf failwith "no font %S" name
 
   let push t node =
     begin
@@ -125,8 +123,8 @@ module Sprite_graph = struct
       t.list <- [];
     end
 
-  let add_sprite t ~tf ~pos ~sprite =
-    let node = Sprite { tf; pos; sprite } in
+  let add_sprites t ~tf ~map ~sprites =
+    let node = Sprites { tf; map; sprites } in
     push t node;
     node
 
@@ -137,8 +135,8 @@ module Sprite_graph = struct
 
   let rec render_rec ren = function
     | [] -> ()
-    | Sprite { tf; pos; sprite } :: nodes ->
-      Renderer.draw_sprite ren sprite ~tf ~pos;
+    | Sprites { tf; map; sprites } :: nodes ->
+      Renderer.draw_sprites ren map sprites ~tf;
       render_rec ren nodes
     | Label { tf; font; text; fg } :: nodes ->
       Renderer.draw_text ren font text ~tf ~fg;
@@ -211,21 +209,22 @@ module Scene = struct
     | sexp ->
       of_sexp_error "bad argument to transform" sexp
 
-  let parse_sprite_arg ~sg ~tf ~map = function
+  let parse_sprite_arg ~map = function
     | Sexp.List [Atom sprite; x; y] ->
-      let sprite = Sprite_graph.get_sprite sg map sprite in
+      let sprite = Sprite.get map sprite in
       let pos = vec2 (float_of_sexp x) (float_of_sexp y) in
-      Sprite_graph.add_sprite sg ~tf ~pos ~sprite |> ignore
-    | Sexp.List [Atom sprite] | Atom sprite ->
-      let sprite = Sprite_graph.get_sprite sg map sprite in
-      let pos = vec2 0.0 0.0 in
-      Sprite_graph.add_sprite sg ~tf ~pos ~sprite |> ignore
+      sprite, pos
+    | Atom sprite ->
+      let sprite = Sprite.get map sprite in
+      sprite, vec2 0.0 0.0
     | sexp ->
       of_sexp_error "bad sprite argument" sexp
 
   let parse_sprites ~sg ~tf = function
     | Sexp.List (Atom "sprites" :: Atom map :: args) ->
-      List.iter (parse_sprite_arg ~sg ~tf ~map) args;
+      let map = Sprite_graph.get_sprite_map sg map in
+      let sprites = List.map (parse_sprite_arg ~map) args |> Array.of_list in
+      Sprite_graph.add_sprites sg ~tf ~map ~sprites |> ignore
     | sexp ->
       of_sexp_error "invalid sprites" sexp
 

src/s2/s2.mli

@@ -35,7 +35,7 @@ module Renderer : sig
   val post_draw : t -> unit
   val clear : t -> color -> unit
   val draw_rect : t -> tf:mat2a -> fill:color -> aabb -> unit
-  val draw_sprite : t -> tf:mat2a -> ?tint:color -> ?pos:vec2 -> Sprite.t -> unit
+  val draw_sprites : t -> tf:mat2a -> ?tint:color -> Sprite.map -> (Sprite.t * vec2) array -> unit
   val draw_text : t -> tf:mat2a -> fg:color -> Font.t -> string -> unit
 end
 

src/s2/sprite.ml

@@ -4,12 +4,11 @@ include (val Ohlog.sublogs logger "Sprite")
 (* TODO: spritemap has one texture shared by all the sprites *)
 
 type t = {
-  texture : Texture.t;
   clip : aabb;
   offs : aabb;
 }
 
-let make ~texture ~pdf ~x ~y ~w ~h ~ox ~oy =
+let make ~pdf ~x ~y ~w ~h ~ox ~oy =
   let x0 = Float.of_int x *. pdf
   and y0 = Float.of_int y *. pdf
   and x1 = Float.of_int (x + w) *. pdf
@@ -19,55 +18,61 @@ let make ~texture ~pdf ~x ~y ~w ~h ~ox ~oy =
   and ox1 = Float.of_int (x - ox + w)
   and oy1 = Float.of_int (y - oy + h)
   in {
-    texture;
     clip = aabb x0 y0 x1 y1;
     offs = aabb ox0 oy0 ox1 oy1;
   }
 
+type map = {
+  texture : Texture.t;
+  frames : (string, t) Hashtbl.t;
+}
+
+let make_map ~texture ~frames = {
+  texture;
+  frames = Hashtbl.of_seq frames;
+}
+
+let get map name =
+  try Hashtbl.find map.frames name
+  with Not_found ->
+    Format.ksprintf failwith "no sprite %S in sprite map" name
+
 module Renderer = struct
   let _white = Color.white ()
   let _zero = vec2 0.0 0.0
   let rect = aabb 0.0 0.0 0.0 0.0
 
-  let draw_sprite ren ~tf ?(tint = _white) ?(pos = _zero) { texture; clip; offs } =
-    rect.x0 <- offs.x0 +. pos.x;
-    rect.y0 <- offs.y0 +. pos.y;
-    rect.x1 <- offs.x1 +. pos.x;
-    rect.y1 <- offs.y1 +. pos.y;
-    Renderer.draw_texture ren ~tf ~rect ~clip ~tint texture
+  let draw_sprites ren ~tf ?(tint = _white) {texture; _} frames =
+    for i = 0 to Array.length frames - 1 do
+      let { clip; offs }, (pos : vec2) = frames.(i) in
+      rect.x0 <- offs.x0 +. pos.x;
+      rect.y0 <- offs.y0 +. pos.y;
+      rect.x1 <- offs.x1 +. pos.x;
+      rect.y1 <- offs.y1 +. pos.y;
+      Renderer.draw_texture ren ~tf ~rect ~clip ~tint texture
+    done
 end
 
-type map = (string, t) Hashtbl.t
-
-let get (map : map) name : t =
-  try Hashtbl.find map name
-  with Not_found ->
-    Format.ksprintf failwith "no sprite %S in sprite map" name
-
-let parse_sprite ~map ~texture ~pdf = function
+let sprite_of_sexp ~pdf = function
   | Sexp.List [Atom name; x; y; w; h; ox; oy] ->
-    let sprite =
-      make ~texture ~pdf
-        ~x:(Sexp_conv.int_of_sexp x)
-        ~y:(Sexp_conv.int_of_sexp y)
-        ~w:(Sexp_conv.int_of_sexp w)
-        ~h:(Sexp_conv.int_of_sexp h)
-        ~ox:(Sexp_conv.int_of_sexp ox)
-        ~oy:(Sexp_conv.int_of_sexp oy)
-    in
-    Hashtbl.replace map name sprite
+    name, make ~pdf
+            ~x:(Sexp_conv.int_of_sexp x)
+            ~y:(Sexp_conv.int_of_sexp y)
+            ~w:(Sexp_conv.int_of_sexp w)
+            ~h:(Sexp_conv.int_of_sexp h)
+            ~ox:(Sexp_conv.int_of_sexp ox)
+            ~oy:(Sexp_conv.int_of_sexp oy)
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite" sexp
 
 let of_sexp ~texture ?dpi = function
-  | Sexp.List (Atom "map" :: sprite_args) ->
-    let map = Hashtbl.create (List.length sprite_args * 2) in
+  | Sexp.List (Atom "map" :: args) ->
     let pdf = match dpi with
       | Some dpi -> Float.of_int dpi /. 96.0
       | None -> 1.0
     in
-    List.iter (parse_sprite ~map ~texture ~pdf) sprite_args;
-    map
+    make_map ~texture
+      ~frames:(List.to_seq args |> Seq.map (sprite_of_sexp ~pdf))
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite map" sexp
 
@@ -78,8 +83,5 @@ module Asset = struct
     let texture = Texture.Asset.load_texture tex_path in
     let spritemap = Asset.load_sexp_conv map_path (of_sexp ~texture ?dpi) in
     debug (fun m -> m "loaded sprite map %S" name);
-    trace (fun m -> Hashtbl.iter
-                      (fun name s -> m "  %S %a %a" name AABB.pp s.clip AABB.pp s.offs)
-                      spritemap);
     spritemap
 end