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/adam/adam.ml

@@ -49,8 +49,7 @@ module Vec2 = struct
   let pp ppf { x; y } =
     Format.fprintf ppf "[%.1f; %.1f]" x y
 
-  let[@inline] make (x : float) (y : float) : t =
+  let[@inline] make x y = { x; y }
-    { x; y }
 
   let[@inline] set ~x ~y t =
     begin
@@ -84,19 +83,17 @@ module Mat2A = struct
   let pp ppf { a0; a1; a2; a3; a4; a5 } =
     Format.fprintf ppf "[%.1f %.1f %.1f; %.1f %.1f %.1f]" a0 a1 a2 a3 a4 a5
 
-  let[@inline] make (tx : float) (ty : float) (sx : float) (sy : float) : t =
+  (* TODO: skew/rotation *)
-    { a0 = sx; a1 = 0.0; a2 = tx; a3 = 0.0; a4 = sy; a5 = ty }
 
-  (* TODO: rotation *)
+  let[@inline] make ?(tx = 0.0) ?(ty = 0.0) ?(sx = 1.0) ?(sy = 1.0) () = {
+    a0 = sx;  a1 = 0.0; a2 = tx;
+    a3 = 0.0; a4 = sy;  a5 = ty;
+  }
 
   let[@inline] set ~tx ~ty ~sx ~sy t =
     begin
-      t.a0 <- sx;
+      t.a0 <- sx;  t.a1 <- 0.0; t.a2 <- tx;
-      t.a1 <- 0.0;
+      t.a3 <- 0.0; t.a4 <- sy;  t.a5 <- ty;
-      t.a2 <- tx;
-      t.a3 <- 0.0;
-      t.a4 <- sy;
-      t.a5 <- ty;
     end
 
   let[@inline] copy ~src dst =
@@ -109,61 +106,15 @@ module Mat2A = struct
       dst.a5 <- src.a5;
     end
 
-  let[@inline] multiply (dst : t) (lhs : t) (rhs : t) : unit =
+  let[@inline] multiply dst lhs rhs =
+    assert (dst != lhs && dst != rhs);
     begin
-      dst.a0 <- (lhs.a0 * rhs.a0) + (lhs.a1 * rhs.a3);
+      dst.a0 <- lhs.a0 * rhs.a0 + lhs.a1 * rhs.a3;
-      dst.a1 <- (lhs.a0 * rhs.a1) + (lhs.a1 * rhs.a4);
+      dst.a1 <- lhs.a0 * rhs.a1 + lhs.a1 * rhs.a4;
-      dst.a2 <- (lhs.a0 * rhs.a2) + (lhs.a1 * rhs.a5) + lhs.a2;
+      dst.a2 <- lhs.a0 * rhs.a2 + lhs.a1 * rhs.a5 + lhs.a2;
-      dst.a3 <- (lhs.a3 * rhs.a0) + (lhs.a4 * rhs.a3);
+      dst.a3 <- lhs.a3 * rhs.a0 + lhs.a4 * rhs.a3;
-      dst.a4 <- (lhs.a3 * rhs.a1) + (lhs.a4 * rhs.a4);
+      dst.a4 <- lhs.a3 * rhs.a1 + lhs.a4 * rhs.a4;
-      dst.a5 <- (lhs.a3 * rhs.a2) + (lhs.a4 * rhs.a5) + lhs.a5;
+      dst.a5 <- lhs.a3 * rhs.a2 + lhs.a4 * rhs.a5 + lhs.a5;
-    end
-
-  (*
-  let[@inline] tra (dst : t) ~(tx : float) ~(ty : float) =
-    begin
-      dst.a2 <- (dst.a0 * tx) + (dst.a1 * ty) + dst.a2;
-      dst.a5 <- (dst.a3 * tx) + (dst.a4 * ty) + dst.a5;
-    end
-
-  let[@inline] sca (dst : t) ~(sx : float) ~(sy : float) =
-    begin
-      dst.a0 <- dst.a0 * sx;
-      dst.a1 <- dst.a1 * sy;
-      dst.a3 <- dst.a3 * sx;
-      dst.a4 <- dst.a4 * sy;
-    end
-
-  let inv (dst : t) (src : t) =
-    begin
-      let { a0; a1; a2; a3; a4; a5 } = src in
-      let b2 = (a1 * a5) - (a2 * a4) in
-      let b5 = (a2 * a3) - (a0 * a5) in
-      let det = (a0 * a4) - (a1 * a3) in
-      dst.a0 <- a4 / det;
-      dst.a1 <- a1 / -det;
-      dst.a2 <- b2 / det;
-      dst.a3 <- a3 / -det;
-      dst.a4 <- a0 / det;
-      dst.a5 <- b5 / det;
-    end
-*)
-
-  let apply (t : t) (v : vec2) =
-    let Vec2.{ x; y } = v in
-    begin
-      v.x <- (t.a0 * x) + (t.a1 * y) + t.a2;
-      v.y <- (t.a3 * x) + (t.a4 * y) + t.a5;
-    end
-
-  let apply_inv (t : t) (v : vec2) =
-    let Vec2.{ x; y } = v in
-    let b2 = (t.a1 * t.a5) - (t.a2 * t.a4) in
-    let b5 = (t.a2 * t.a3) - (t.a0 * t.a5) in
-    let det = (t.a0 * t.a4) - (t.a1 * t.a3) in
-    begin
-      v.x <- ((t.a4 * x) - (t.a1 * y) + b2) / det;
-      v.y <- ((t.a0 * y) - (t.a3 * x) + b5) / det;
     end
 end
 
@@ -235,7 +186,7 @@ module Color = struct
     set_rgb24 dst v ~a;
     dst
 
-  let[@inline] mul ?(r = 1.) ?(g = 1.) ?(b = 1.) ?(a = 1.) (t : t) =
+  let[@inline] multiply ?(r = 1.) ?(g = 1.) ?(b = 1.) ?(a = 1.) (t : t) =
     begin
       t.r <- t.r * r * a;
       t.g <- t.g * g * a;

src/n2/n2.ml

@@ -36,11 +36,11 @@ module Transform_graph = struct
     t.size <- t.size + 1
 
   let add t parent =
-    let model_tf = mat2a 0.0 0.0 1.0 1.0 in
+    let model_tf = mat2a () in
     let parent_tf, world_tf =
       match parent with
       | Null -> None, model_tf
-      | Node p -> Some p.world_tf, mat2a 0.0 0.0 1.0 1.0
+      | Node p -> Some p.world_tf, mat2a ()
     in
     let node =
       Node {
@@ -83,10 +83,10 @@ module Sprite_graph = struct
   }
 
   and node =
-    | Sprite of {
+    | Sprites of {
         tf : mat2a;
-        pos : vec2;
+        map : Sprite.map;
-        sprite : Sprite.t;
+        (* 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 get_sprite_map t name =
-    let map = try Hashtbl.find t.sprite_maps map_name
+    try Hashtbl.find t.sprite_maps name with
-      with Not_found -> Format.kasprintf failwith "no sprite map %S" map_name
+      Not_found -> Format.kasprintf failwith "no sprite map %S" name
-    in
-    Sprite.get map sprite_name
 
   let get_font t name =
-    try Hashtbl.find t.fonts name
+    try Hashtbl.find t.fonts name with
-    with Not_found -> Format.kasprintf failwith "no font %S" name
+      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 add_sprites t ~tf ~map ~sprites =
-    let node = Sprite { tf; pos; sprite } in
+    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 ->
+    | Sprites { tf; map; sprites } :: nodes ->
-      Renderer.draw_sprite ren sprite ~tf ~pos;
+      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
+      sprite, pos
-    | Sexp.List [Atom sprite] | Atom sprite ->
+    | Atom sprite ->
-      let sprite = Sprite_graph.get_sprite sg map sprite in
+      let sprite = Sprite.get map sprite in
-      let pos = vec2 0.0 0.0 in
+      sprite, vec2 0.0 0.0
-      Sprite_graph.add_sprite sg ~tf ~pos ~sprite |> ignore
     | 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 } =
+  let draw_sprites ren ~tf ?(tint = _white) {texture; _} frames =
-    rect.x0 <- offs.x0 +. pos.x;
+    for i = 0 to Array.length frames - 1 do
-    rect.y0 <- offs.y0 +. pos.y;
+      let { clip; offs }, (pos : vec2) = frames.(i) in
-    rect.x1 <- offs.x1 +. pos.x;
+      rect.x0 <- offs.x0 +. pos.x;
-    rect.y1 <- offs.y1 +. pos.y;
+      rect.y0 <- offs.y0 +. pos.y;
-    Renderer.draw_texture ren ~tf ~rect ~clip ~tint texture
+      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 sprite_of_sexp ~pdf = function
-
-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
   | Sexp.List [Atom name; x; y; w; h; ox; oy] ->
-    let sprite =
+    name, make ~pdf
-      make ~texture ~pdf
+            ~x:(Sexp_conv.int_of_sexp x)
-        ~x:(Sexp_conv.int_of_sexp x)
+            ~y:(Sexp_conv.int_of_sexp y)
-        ~y:(Sexp_conv.int_of_sexp y)
+            ~w:(Sexp_conv.int_of_sexp w)
-        ~w:(Sexp_conv.int_of_sexp w)
+            ~h:(Sexp_conv.int_of_sexp h)
-        ~h:(Sexp_conv.int_of_sexp h)
+            ~ox:(Sexp_conv.int_of_sexp ox)
-        ~ox:(Sexp_conv.int_of_sexp ox)
+            ~oy:(Sexp_conv.int_of_sexp oy)
-        ~oy:(Sexp_conv.int_of_sexp oy)
-    in
-    Hashtbl.replace map name sprite
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite" sexp
 
 let of_sexp ~texture ?dpi = function
-  | Sexp.List (Atom "map" :: sprite_args) ->
+  | Sexp.List (Atom "map" :: args) ->
-    let map = Hashtbl.create (List.length sprite_args * 2) in
     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;
+    make_map ~texture
-    map
+      ~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