add sprite rendering

assets/shaders/sprite.vert

@@ -2,22 +2,21 @@
 
 uniform ivec2 Viewport;
 uniform mat3  Transform;
-uniform vec4  BoundingBox;
+uniform sampler2D Texture;
+
+/* TODO: instanced */
+uniform vec4  Rect;
+uniform vec4  Clip;
 
 in vec2 Vert;
 
-/* TODO: instances */
-// in vec4 Rect;
-// in vec4 Clip;
-
 out vec2 TextureCoord;
 
 void main() {
-  vec2 vert = mix(BoundingBox.xy, BoundingBox.zw, Vert);
+  vec2 vert = mix(Rect.xy, Rect.zw, Vert);
   vec3 pos = Transform * vec3(vert, 1.0);
 
-  // TextureCoord = mix(Clip.st, Clip.pq, Vert) / textureSize(T, 0);
+  TextureCoord = mix(Clip.st, Clip.pq, Vert) / textureSize(Texture, 0);
-  TextureCoord = Vert;
 
   gl_Position.xy = pos.xy * vec2(2.0, -2.0) / Viewport + vec2(-1.0, 1.0);
   gl_Position.z = 0.0;

src/main.ml

@@ -13,8 +13,7 @@ let main () =
   let ren = Renderer.make ~wnd in
   info (fun m -> m "renderer initialized");
 
-  let tex_cat = Asset.load_texture "catthumbsup.png" in
+  let blocks = Asset.load_sprite_map "blocks" ~dpi:192 in
-  let tex_otters = Asset.load_texture "otters.jpg" in
   debug (fun m -> m "loaded assets");
 
   let tg = TG.make () in
@@ -29,13 +28,9 @@ let main () =
 
       let tf = TG.model (Scene.transform root) in
       begin
-        let tx =
+        let tx = 512.0 in
-          Float_infix.(
-            Float.sin (time * 2.0) * 300.0
-            + 512.0
-          )
-        in
         let ty = 400.0 in
+        let _ = time in
         Mat2A.set tf ~tx ~ty ~sx:1.0 ~sy:1.0
       end;
 
@@ -43,15 +38,16 @@ let main () =
       Renderer.clear ren (rgb24 0x000000);
 
       TG.update tg;
-      SG.render sg ~ren;
+      (* SG.render sg ~ren; *)
 
-      Renderer.draw_texture ren tex_otters
+      Renderer.draw_sprite ren (Sprite.get blocks "L")
-        ~tf
+        ~tf ~pos:(vec2 0.0 0.0);
-        ~bb:(aabb 0.0 (-200.0) (300.0) (200.0));
+      Renderer.draw_sprite ren (Sprite.get blocks "O")
-
+        ~tf ~pos:(vec2 32.0 0.0);
-      Renderer.draw_texture ren tex_cat
+      Renderer.draw_sprite ren (Sprite.get blocks "S")
-        ~tf
+        ~tf ~pos:(vec2 0.0 32.0);
-        ~bb:(aabb (-200.0) (-100.0) 0.0 (100.0));
+      Renderer.draw_sprite ren (Sprite.get blocks "Z")
+        ~tf ~pos:(vec2 32.0 32.0);
 
       Renderer.post_draw ren;
 

src/s2/renderer.ml

@@ -348,14 +348,15 @@ let draw_rect t ~tf ~bb ~fill =
 
 let _white = Color.white ()
 
-let draw_texture t ~tf ~bb ?(tint = _white) tex =
+let draw_texture t ~tf ~rect ~clip ~tint tex =
   let sh = t.sprite in
   begin
     (* TODO: cache/store uniform locations in some way *)
     use sh;
     set_mat2a (uniform sh "Transform") tf;
-    set_aabb  (uniform sh "BoundingBox") bb;
     set_tex   (uniform sh "Texture") tex;
+    set_aabb  (uniform sh "Rect") rect;
+    set_aabb  (uniform sh "Clip") clip;
     set_color (uniform sh "Tint") tint;
     draw_geometry t.sprite_rect;
   end

src/s2/s2.ml

@@ -1,7 +1,10 @@
 module Window = Window
-module Renderer = Renderer
 module Texture = Texture
 module Sprite = Sprite
+module Renderer = struct
+  include Renderer
+  include Sprite.Renderer
+end
 module Asset = struct
   include Asset
   include Texture.Asset

src/s2/s2.mli

@@ -37,8 +37,7 @@ module Renderer : sig
   val post_draw : t -> unit
   val clear : t -> color -> unit
   val draw_rect : t -> tf:mat2a -> bb:aabb -> fill:color -> unit
-  val draw_texture : t -> tf:mat2a -> bb:aabb -> ?tint:color -> Texture.t -> unit
+  val draw_sprite : t -> tf:mat2a -> ?tint:color -> ?pos:vec2 -> Sprite.t -> unit
-  (* val draw_sprite : t -> tf:mat2a -> ?tint:color -> ?off:vec2 -> Sprite.t -> unit *)
 end
 
 module Asset : sig
@@ -49,5 +48,5 @@ module Asset : sig
   val load_file : string -> string
   val load_sexp_conv : string -> (Sexp.t -> 'a) -> 'a
   val load_texture : string -> Texture.t
-  val load_sprite_map : string -> Sprite.map
+  val load_sprite_map : ?dpi:int -> string -> Sprite.map
 end

src/s2/sprite.ml

@@ -8,22 +8,37 @@ include (val Ohlog.sublogs logger "Sprite")
 type t = {
   texture : Texture.t;
   clip : aabb;
-  origin : vec2;
+  offs : aabb;
 }
 
-let make ~texture ~x ~y ~w ~h ~ox ~oy =
+let make ~texture ~pdf ~x ~y ~w ~h ~ox ~oy =
-  let x0 = Float.of_int x
+  let x0 = Float.of_int x *. pdf
-  and y0 = Float.of_int y
+  and y0 = Float.of_int y *. pdf
-  and x1 = Float.of_int (w - x)
+  and x1 = Float.of_int (x + w) *. pdf
-  and y1 = Float.of_int (h - x)
+  and y1 = Float.of_int (y + h) *. pdf
-  and ox = Float.of_int (ox - x)
+  and ox0 = Float.of_int (x - ox)
-  and oy = Float.of_int (oy - y) in
+  and oy0 = Float.of_int (y - oy)
-  {
+  and ox1 = Float.of_int (x - ox + w)
+  and oy1 = Float.of_int (y - oy + w)
+  in {
     texture;
     clip = aabb x0 y0 x1 y1;
-    origin = vec2 ox oy;
+    offs = aabb ox0 oy0 ox1 oy1;
   }
 
+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
+end
+
 type map = (string, t) Hashtbl.t
 
 let get (map : map) name : t =
@@ -31,10 +46,10 @@ let get (map : map) name : t =
   with Not_found ->
     Format.ksprintf failwith "no sprite %S in sprite map" name
 
-let parse_sprite ~map ~texture = function
+let parse_sprite ~map ~texture ~pdf = function
   | Sexp.List [Atom name; x; y; w; h; ox; oy] ->
     let sprite =
-      make ~texture
+      make ~texture ~pdf
         ~x:(Sexp_conv.int_of_sexp x)
         ~y:(Sexp_conv.int_of_sexp y)
         ~w:(Sexp_conv.int_of_sexp w)
@@ -46,24 +61,28 @@ let parse_sprite ~map ~texture = function
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite" sexp
 
-let of_sexp ~texture = function
+let of_sexp ~texture ?(dpi = 96) = function
   | Sexp.List (Atom "map" :: sprite_args) ->
     let map = Hashtbl.create (List.length sprite_args * 2) in
-    List.iter (parse_sprite ~map ~texture) sprite_args;
+    let pdf = Float.of_int dpi /. 96.0 in
+    List.iter (parse_sprite ~map ~texture ~pdf) sprite_args;
     map
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite map" sexp
 
 module Asset = struct
-  let load_sprite_map name =
+  let load_sprite_map ?dpi name =
     let tex_path = Format.sprintf "sprites/%s.png" name in
     let map_path = Format.sprintf "sprites/%s.map" name in
     let texture = Texture.Asset.load_texture tex_path in
-    let spritemap = Asset.load_sexp_conv map_path (of_sexp ~texture) in
+    let spritemap = Asset.load_sexp_conv map_path (of_sexp ~texture ?dpi) in
-    trace (fun m -> m "loaded sprite map %S" name);
+    debug (fun m -> m "loaded sprite map %S" name);
     trace (fun m ->
             Hashtbl.iter
-              (fun k v -> m "  %S %a %a" k AABB.pp v.clip Vec2.pp v.origin)
+              (fun name s ->
+                 m "  %S %a %a" name
+                   AABB.pp s.clip
+                   AABB.pp s.offs)
               spritemap);
     spritemap
 end