batched rendering for sprites and text

assets/shaders/msdf.vert

@@ -4,12 +4,10 @@ uniform ivec2 Viewport;
 uniform mat3  Transform;
 uniform sampler2D Texture;
 
-/* TODO: instanced */
-uniform vec2 Offset;
-uniform vec4 Atlas;
-uniform vec4 Plane;
-
 in vec2 Vert;
+in vec2 Offset;
+in vec4 Atlas;
+in vec4 Plane;
 
 out vec2 TextureCoord;
 

assets/shaders/sprite.vert

@@ -4,11 +4,9 @@ uniform ivec2 Viewport;
 uniform mat3  Transform;
 uniform sampler2D Texture;
 
-/* TODO: instanced */
-uniform vec4  Rect;
-uniform vec4  Clip;
-
 in vec2 Vert;
+in vec4 Rect;
+in vec4 Clip;
 
 out vec2 TextureCoord;
 

src/adam/adam.ml

@@ -242,3 +242,12 @@ end
 type aabb = AABB.t
 
 let aabb = AABB.make
+
+module Floatbuffer = struct
+  include Floatbuffer
+
+  let add_vec2 t (v : vec2) = unsafe_add_from t (Obj.magic v) 0 2
+  let add_mat2a t (v : mat2a) = unsafe_add_from t (Obj.magic v) 0 6
+  let add_color t (v : color) = unsafe_add_from t (Obj.magic v) 0 4
+  let add_aabb t (v : aabb) = unsafe_add_from t (Obj.magic v) 0 4
+end

src/adam/floatbuffer.ml

@@ -0,0 +1,44 @@
+open Bigarray
+
+type t = {
+  mutable array : (float, float32_elt, c_layout) Array1.t;
+  mutable length : int;
+}
+
+let make capacity = {
+  array = Array1.create Float32 C_layout capacity;
+  length = 0;
+}
+
+let length t = t.length
+let clear t = t.length <- 0
+let contents t = Array1.sub t.array 0 t.length
+
+let reserve t new_len =
+  let capacity = Array1.dim t.array in
+  if capacity < new_len then
+    begin
+      let array = Array1.create Float32 C_layout (capacity * 2) in
+      Array1.blit t.array array;
+      t.array <- array;
+    end;
+  t.length <- new_len;
+  t.array
+
+let add t x =
+  let i = t.length in
+  let dst = reserve t (i + 1) in
+  dst.{i} <- x
+
+let unsafe_add_from t src ofs len =
+  let i = t.length in
+  let dst = reserve t (i + len) in
+  for k = 0 to len - 1 do
+    dst.{i + k} <- Float.Array.unsafe_get src (ofs + k)
+  done
+
+let add_from t src ofs len =
+  if ofs < 0 || len < 0 || Float.Array.length src < ofs + len then
+    invalid_arg "Floatbuffer.add_from: bad range";
+  if len > 0 then
+    unsafe_add_from t src ofs len

src/s2/font.ml

@@ -18,15 +18,19 @@ module Renderer = struct
   let offset = vec2 0.0 0.0
 
   let draw_text ren ~tf ~fg { msdf; glyphs } str =
-    offset.x <- 0.0;
+    begin
-    offset.y <- 0.0;
+      offset.x <- 0.0;
-    for i = 0 to String.length str - 1 do
+      offset.y <- 0.0;
-      (* TODO: line breaks *)
+      Renderer.begin_glyph_batch ren msdf ~tf ~fill:fg;
-      let { advance; atlas; plane } = Hashtbl.find glyphs str.[i] in
+      for i = 0 to String.length str - 1 do
-      if not (AABB.is_empty atlas) then
+        (* TODO: line breaks *)
-        Renderer.draw_glyph ren msdf ~tf ~fg ~offset ~atlas ~plane;
+        let { advance; atlas; plane } = Hashtbl.find glyphs str.[i] in
-      offset.x <- offset.x +. advance;
+        if not (AABB.is_empty atlas) then
-    done
+          Renderer.draw_glyph ren ~offset ~atlas ~plane;
+        offset.x <- offset.x +. advance;
+      done;
+      Renderer.end_glyph_batch ren;
+    end
 end
 
 
@@ -77,4 +81,3 @@ module Asset = struct
     debug (fun m -> m "loaded font %S" name);
     font
 end
-

src/s2/renderer.ml

@@ -30,15 +30,21 @@ let buffer_size_in_bytes { bo } =
 
 type attr = {
   aidx : int;
-  atype : [`float];
+  atype : attr_type;
-  asize : int;
 }
 
+and attr_type = Vec2 | Vec4
+
 let attr_type at = match at.atype with
-  | `float -> Gl.float
+  | Vec2 | Vec4 -> Gl.float
+
+let attr_size at = match at.atype with
+  | Vec2 -> 2
+  | Vec4 -> 4
 
 let attr_size_in_bytes at = match at.atype with
-  | `float -> at.asize * 4
+  | Vec2 -> 2 * 4
+  | Vec4 -> 4 * 4
 
 type vertex_buffer = {
   vbuf : buffer;
@@ -50,9 +56,9 @@ let make_static_vertex_buffer data vats =
   let vbuf = make_buffer () ~data in
   { vbuf; vats; vdiv = 0 }
 
-(* let make_instance_vertex_buffer vats = *)
+let make_dynamic_vertex_buffer vats =
-(*   let vbuf = make_buffer () in *)
+  let vbuf = make_buffer () in
-(*   {vbuf; vats; vdiv = 1} *)
+  { vbuf; vats; vdiv = 1 }
 
 let bind_vertex_buffer { vbuf; vdiv; vats } =
   Gl.bind_buffer Gl.array_buffer vbuf.bo;
@@ -60,15 +66,18 @@ let bind_vertex_buffer { vbuf; vdiv; vats } =
     List.fold_left (fun n at -> n + attr_size_in_bytes at) 0 vats
   in
   let enable ofs at =
-    Gl.vertex_attrib_pointer
+    Gl.vertex_attrib_pointer at.aidx
-      at.aidx at.asize (attr_type at)
+      (attr_size at) (attr_type at) false
-      false stride (`Offset ofs);
+      stride (`Offset ofs);
     Gl.vertex_attrib_divisor at.aidx vdiv;
     Gl.enable_vertex_attrib_array at.aidx;
     ofs + attr_size_in_bytes at
   in
   ignore (List.fold_left enable 0 vats : int)
 
+let update_vertex_buffer { vbuf; _ } flbuf =
+  set_buffer_data vbuf (Floatbuffer.contents flbuf)
+
 
 (* Shaders *)
 
@@ -118,10 +127,10 @@ let load_shader ~name =
 let use {spo} =
   Gl.use_program spo
 
-let attr {spo} aname atype asize =
+let attr {spo} aname atype =
   match Gl.get_attrib_location spo aname with
   | -1 -> Printf.ksprintf failwith "No such attribute %S" aname
-  | aidx -> { aidx; atype; asize }
+  | aidx -> { aidx; atype }
 
 let uniform {spo} name =
   match Gl.get_uniform_location spo name with
@@ -178,7 +187,7 @@ let make_geometry
     indices
   }
 
-let draw_geometry ?(instances = 1) { vao; draw_mode; indices } =
+let draw_geometry { vao; draw_mode; indices } instances =
   Gl.bind_vertex_array vao;
   match indices with
   | `range (ofs, len) ->
@@ -222,17 +231,18 @@ let set_tex : texture set_fn =
 type t = {
   window : Sdl.window;
   gl_ctx : Sdl.gl_context;
+  buffer : Floatbuffer.t;
 
   polygon : shader;
-  rect_g : geometry;
+  polygon_rect_g : geometry;
 
   sprite : shader;
+  sprite_instances : vertex_buffer;
   sprite_g : geometry;
-  (* sprite_instances : vertex_buffer; *)
 
   msdf : shader;
-  text_g : geometry;
+  msdf_instances : vertex_buffer;
-  (* msdf_instances : vertex_buffer; *)
+  msdf_glyph_g : geometry;
 }
 
 let unit_square =
@@ -278,11 +288,11 @@ let make ~(wnd : Sdl.window) : t =
   Gl.check_error "setup";
 
   let polygon = load_shader ~name:"polygon" in
-  let rect_g =
+  let polygon_rect_g =
     make_geometry [
       make_static_vertex_buffer unit_square_with_norm [
-        attr polygon "Vert" `float 2;
+        attr polygon "Vert" Vec2;
-        attr polygon "Norm" `float 2;
+        attr polygon "Norm" Vec2;
       ]
     ]
       ~draw_mode:Gl.triangle_strip
@@ -290,25 +300,38 @@ let make ~(wnd : Sdl.window) : t =
   in
 
   let sprite = load_shader ~name:"sprite" in
-  let sprite_g =
+  let sprite_vertices =
-    make_geometry [
+    make_static_vertex_buffer unit_square [
-      make_static_vertex_buffer unit_square [
+      attr sprite "Vert" Vec2;
-        attr sprite "Vert" `float 2;
-      ]
-      (* sprite_instances *)
     ]
+  in
+  let sprite_instances =
+    make_dynamic_vertex_buffer [
+      attr sprite "Rect" Vec4;
+      attr sprite "Clip" Vec4;
+    ]
+  in
+  let sprite_g =
+    make_geometry [ sprite_vertices; sprite_instances ]
       ~draw_mode:Gl.triangle_strip
       ~count:4
   in
 
   let msdf = load_shader ~name:"msdf" in
-  let text_g =
+  let msdf_vertices =
-    make_geometry [
+    make_static_vertex_buffer unit_square [
-      make_static_vertex_buffer unit_square [
+      attr msdf "Vert" Vec2;
-        attr msdf "Vert" `float 2;
-      ]
-      (* msdf_instances *)
     ]
+  in
+  let msdf_instances =
+    make_dynamic_vertex_buffer [
+      attr msdf "Offset" Vec2;
+      attr msdf "Atlas" Vec4;
+      attr msdf "Plane" Vec4;
+    ]
+  in
+  let msdf_glyph_g =
+    make_geometry [ msdf_vertices; msdf_instances ]
       ~draw_mode:Gl.triangle_strip
       ~count:4
   in
@@ -316,12 +339,15 @@ let make ~(wnd : Sdl.window) : t =
   {
     window = wnd;
     gl_ctx;
+    buffer = Floatbuffer.make 128;
     polygon;
-    rect_g;
+    polygon_rect_g;
     sprite;
+    sprite_instances;
     sprite_g;
     msdf;
-    text_g;
+    msdf_instances;
+    msdf_glyph_g;
   }
 
 let destroy t =
@@ -348,40 +374,56 @@ let clear _t (bg : color) =
   end
 
 (* TODO: store uniforms *)
-(* TODO: instanced rendering *)
 
 let draw_rect t ~tf ~fill rect =
-  let sh = t.polygon and ge = t.rect_g in
   begin
-    use sh;
+    use t.polygon;
-    set_mat2a (uniform sh "Transform") tf;
+    set_mat2a (uniform t.polygon "Transform") tf;
-    set_aabb  (uniform sh "BoundingBox") rect;
+    set_aabb  (uniform t.polygon "BoundingBox") rect;
-    set_int   (uniform sh "Border") 0;
+    set_int   (uniform t.polygon "Border") 0;
-    set_color (uniform sh "Fill") fill;
+    set_color (uniform t.polygon "Fill") fill;
-    draw_geometry ge;
+    draw_geometry t.polygon_rect_g 1;
   end
 
-let draw_texture t ~tf ~rect ~clip ~tint tex =
+let begin_sprite_batch t tex ~tf ~tint =
-  let sh = t.sprite and ge = t.sprite_g in
   begin
-    use sh;
+    use t.sprite;
-    set_mat2a (uniform sh "Transform") tf;
+    set_mat2a (uniform t.sprite "Transform") tf;
-    set_tex   (uniform sh "Texture") tex;
+    set_tex   (uniform t.sprite "Texture") tex;
-    set_aabb  (uniform sh "Rect") rect;
+    set_color (uniform t.sprite "Tint") tint;
-    set_aabb  (uniform sh "Clip") clip;
+    Floatbuffer.clear t.buffer;
-    set_color (uniform sh "Tint") tint;
-    draw_geometry ge;
   end
 
-let draw_glyph t ~tf ~offset ~atlas ~plane ~fg msdf =
+let draw_sprite t ~rect ~clip =
-  let sh = t.msdf and ge = t.text_g in
   begin
-    use sh;
+    Floatbuffer.add_aabb t.buffer rect;
-    set_mat2a (uniform sh "Transform") tf;
+    Floatbuffer.add_aabb t.buffer clip;
-    set_tex   (uniform sh "Texture") msdf;
+  end
-    set_vec2  (uniform sh "Offset") offset;
+
-    set_aabb  (uniform sh "Atlas") atlas;
+let end_sprite_batch t =
-    set_aabb  (uniform sh "Plane") plane;
+  begin
-    set_color (uniform sh "Fill") fg;
+    update_vertex_buffer t.sprite_instances t.buffer;
-    draw_geometry ge;
+    draw_geometry t.sprite_g (Floatbuffer.length t.buffer / 8);
+  end
+
+let begin_glyph_batch t tex ~tf ~fill =
+  begin
+    use t.msdf;
+    set_mat2a (uniform t.msdf "Transform") tf;
+    set_tex   (uniform t.msdf "Texture") tex;
+    set_color (uniform t.msdf "Fill") fill;
+    Floatbuffer.clear t.buffer;
+  end
+
+let draw_glyph t ~offset ~atlas ~plane =
+  begin
+    Floatbuffer.add_vec2 t.buffer offset;
+    Floatbuffer.add_aabb t.buffer atlas;
+    Floatbuffer.add_aabb t.buffer plane;
+  end
+
+let end_glyph_batch t =
+  begin
+    update_vertex_buffer t.msdf_instances t.buffer;
+    draw_geometry t.msdf_glyph_g (Floatbuffer.length t.buffer / 10);
   end

src/s2/sprite.ml

@@ -39,18 +39,19 @@ let get 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_sprites ren ~tf ?(tint = _white) {texture; _} frames =
+  let draw_sprites ren ~tf ?(tint = _white) { texture; _ } frames =
+    Renderer.begin_sprite_batch ren texture ~tf ~tint;
     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
+      Renderer.draw_sprite ren ~rect ~clip;
-    done
+    done;
+    Renderer.end_sprite_batch ren
 end
 
 let sprite_of_sexp ~pdf = function