rework sprites and labels so the nodes own the instance buffer

src/n2/n2.ml

@@ -76,7 +76,7 @@ module Sprite_graph = struct
   include (val Ohlog.sublogs logger "SG")
 
   type t = {
-    sprite_maps : (string, Sprite.map) Hashtbl.t;
+    sprite_maps : (string, Sprite_map.t) Hashtbl.t;
     fonts : (string, Font.t) Hashtbl.t;
     mutable list_rev : node list;
     mutable list : node list;
@@ -85,14 +85,14 @@ module Sprite_graph = struct
   and node =
     | Sprites of {
         tf : mat2a;
-        map : Sprite.map;
+        map : Sprite_map.t;
-        (* mutable *)sprites : (Sprite.t * vec2) array;
+        frames : Floatbuffer.t;
         (* tint : color *)
       }
     | Label of {
         tf : mat2a;
         font : Font.t;
-        (* mutable *)text : string;
+        glyphs : Floatbuffer.t;
         fg : color;
       }
 
@@ -124,22 +124,28 @@ module Sprite_graph = struct
     end
 
   let add_sprites t ~tf ~map ~sprites =
-    let node = Sprites { tf; map; sprites } in
+    let frames = Floatbuffer.make (List.length sprites * 8) in
+    List.iter (fun (frame, pos) -> Sprite_map.emit_sprite map frames ~frame ~pos) sprites;
+    let node = Sprites { tf; map; frames } in
     push t node;
     node
 
   let add_label t ~tf ~font ~text ~fg =
-    let node = Label { tf; font; text; fg } in
+    let glyphs = Floatbuffer.make (String.length text * 10) in
+    Font.emit_glyphs font glyphs ~text;
+    let node = Label { tf; font; glyphs; fg } in
     push t node;
     node
 
+  let _white = Color.white ()
+
   let rec render_rec ren = function
     | [] -> ()
-    | Sprites { tf; map; sprites } :: nodes ->
+    | Sprites { tf; map; frames } :: nodes ->
-      Renderer.draw_sprites ren map sprites ~tf;
+      Renderer.draw_sprites ren map frames ~tf ~tint:_white;
       render_rec ren nodes
-    | Label { tf; font; text; fg } :: nodes ->
+    | Label { tf; font; glyphs; fg } :: nodes ->
-      Renderer.draw_text ren font text ~tf ~fg;
+      Renderer.draw_text ren font glyphs ~tf ~fg;
       render_rec ren nodes
 
   let render t ~ren =
@@ -148,34 +154,6 @@ module Sprite_graph = struct
     render_rec ren t.list
 end
 
-(*
-module Entity = struct
-  include (val Ohlog.sublogs logger "Entity")
-
-  type t = {
-    name : string option;
-    id : int;
-  }
-
-  let _next_id = ref (-1)
-
-  let make ?name () = {
-    name;
-    id = (incr _next_id; !_next_id);
-  }
-
-  let pp ppf t =
-    Format.fprintf ppf "<%s@%d>"
-      (Option.value t.name ~default:"")
-      t.id
-
-  let make ?name () =
-    let ent = make ?name () in
-    trace (fun m -> m "new entity %a" pp ent);
-    ent
-end
-*)
-
 module Scene = struct
   module Sexp = Sexplib0.Sexp
   open Sexplib0.Sexp_conv
@@ -210,20 +188,18 @@ module Scene = struct
       of_sexp_error "bad argument to transform" sexp
 
   let parse_sprite_arg ~map = function
-    | Sexp.List [Atom sprite; x; y] ->
+    | Sexp.List [Atom frame; x; y] ->
-      let sprite = Sprite.get map sprite in
       let pos = vec2 (float_of_sexp x) (float_of_sexp y) in
-      sprite, pos
+      frame, pos
-    | Atom sprite ->
+    | Atom frame ->
-      let sprite = Sprite.get map sprite in
+      frame, vec2 0.0 0.0
-      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) ->
       let map = Sprite_graph.get_sprite_map sg map in
-      let sprites = List.map (parse_sprite_arg ~map) args |> Array.of_list in
+      let sprites = List.map (parse_sprite_arg ~map) args in
       Sprite_graph.add_sprites sg ~tf ~map ~sprites |> ignore
     | sexp ->
       of_sexp_error "invalid sprites" sexp

src/n2/n2.mli

@@ -19,7 +19,7 @@ module Sprite_graph : sig
   type node
 
   val make : unit -> t
-  val register_sprite_map : t -> string -> Sprite.map -> unit
+  val register_sprite_map : t -> string -> Sprite_map.t -> unit
   val register_font : t -> string -> Font.t -> unit
   val render : t -> ren:Renderer.t -> unit
 end

src/s2/font.ml

@@ -14,26 +14,24 @@ type t = {
 
 let empty = aabb 1.0 1.0 0.0 0.0
 
-module Renderer = struct
+let emit_glyphs t ~text buffer =
-  let offset = vec2 0.0 0.0
+  let offset = vec2 0.0 0.0 in
+  for i = 0 to String.length text - 1 do
+    (* TODO: line breaks *)
+    let { advance; atlas; plane } = Hashtbl.find t.glyphs text.[i] in
+    if not (AABB.is_empty atlas) then
+      Renderer.emit_glyph_geometry buffer ~offset ~atlas ~plane;
+    offset.x <- offset.x +. advance;
+  done
 
-  let draw_text ren ~tf ~fg { msdf; glyphs } str =
+module Renderer = struct
-    begin
+  let draw_text ren ~tf ~fg font buffer =
-      offset.x <- 0.0;
+    Renderer.draw_text ren font.msdf buffer ~tf ~fg
-      offset.y <- 0.0;
-      Renderer.begin_glyph_batch ren msdf ~tf ~fill:fg;
-      for i = 0 to String.length str - 1 do
-        (* TODO: line breaks *)
-        let { advance; atlas; plane } = Hashtbl.find glyphs str.[i] in
-        if not (AABB.is_empty atlas) then
-          Renderer.draw_glyph ren ~offset ~atlas ~plane;
-        offset.x <- offset.x +. advance;
-      done;
-      Renderer.end_glyph_batch ren;
-    end
 end
 
 
+(* sexp conv *)
+
 let bounds_of_sexp = function
   | Sexp.List [x0; y0; x1; y1] ->
     AABB.make

src/s2/renderer.ml

@@ -231,7 +231,7 @@ let set_tex : texture set_fn =
 type t = {
   window : Sdl.window;
   gl_ctx : Sdl.gl_context;
-  buffer : Floatbuffer.t;
+  (* buffer : Floatbuffer.t; *)
 
   polygon : shader;
   polygon_rect_g : geometry;
@@ -339,7 +339,6 @@ let make ~(wnd : Sdl.window) : t =
   {
     window = wnd;
     gl_ctx;
-    buffer = Floatbuffer.make 128;
     polygon;
     polygon_rect_g;
     sprite;
@@ -385,45 +384,35 @@ let draw_rect t ~tf ~fill rect =
     draw_geometry t.polygon_rect_g 1;
   end
 
-let begin_sprite_batch t tex ~tf ~tint =
+let draw_sprites t tex buffer ~tf ~tint =
   begin
     use t.sprite;
     set_mat2a (uniform t.sprite "Transform") tf;
     set_tex   (uniform t.sprite "Texture") tex;
     set_color (uniform t.sprite "Tint") tint;
-    Floatbuffer.clear t.buffer;
+    update_vertex_buffer t.sprite_instances buffer;
+    draw_geometry t.sprite_g (Floatbuffer.length buffer / 8);
   end
 
-let draw_sprite t ~rect ~clip =
+let emit_sprite_geometry buffer ~rect ~clip = 
   begin
-    Floatbuffer.add_aabb t.buffer rect;
+    Floatbuffer.add_aabb buffer rect;
-    Floatbuffer.add_aabb t.buffer clip;
+    Floatbuffer.add_aabb buffer clip;
   end
 
-let end_sprite_batch t =
+let draw_text t tex buffer ~tf ~fg =
-  begin
-    update_vertex_buffer t.sprite_instances t.buffer;
-    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;
+    set_color (uniform t.msdf "Fill") fg;
-    Floatbuffer.clear t.buffer;
+    update_vertex_buffer t.msdf_instances buffer;
+    draw_geometry t.msdf_glyph_g (Floatbuffer.length buffer / 10);
   end
 
-let draw_glyph t ~offset ~atlas ~plane =
+let emit_glyph_geometry buffer ~offset ~atlas ~plane =
   begin
-    Floatbuffer.add_vec2 t.buffer offset;
+    Floatbuffer.add_vec2 buffer offset;
-    Floatbuffer.add_aabb t.buffer atlas;
+    Floatbuffer.add_aabb buffer atlas;
-    Floatbuffer.add_aabb t.buffer plane;
+    Floatbuffer.add_aabb 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/s2.ml

@@ -1,14 +1,14 @@
 module Window = Window
-module Sprite = Sprite
+module Sprite_map = Sprite_map
 module Font = Font
 module Renderer = struct
   include Renderer
-  include Sprite.Renderer
+  include Sprite_map.Renderer
   include Font.Renderer
 end
 module Asset = struct
   include Asset
-  include Sprite.Asset
+  include Sprite_map.Asset
   include Font.Asset
 end
 module Sdl = Sdl

src/s2/s2.mli

@@ -14,14 +14,18 @@ module Window : sig
   val event_loop : t -> render:(float -> unit) -> unit
 end
 
-module Sprite : sig
+module Sprite_map : sig
+  open Adam
+
   type t
-  type map
+  val emit_sprite : t -> frame:string -> pos:vec2 -> Floatbuffer.t -> unit
-  val get : map -> string -> t
 end
 
 module Font : sig
+  open Adam
+
   type t
+  val emit_glyphs : t -> text:string -> Floatbuffer.t -> unit
 end
 
 module Renderer : sig
@@ -35,8 +39,8 @@ 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_sprites : t -> tf:mat2a -> ?tint:color -> Sprite.map -> (Sprite.t * vec2) array -> unit
+  val draw_sprites : t -> tf:mat2a -> tint:color -> Sprite_map.t -> Floatbuffer.t -> unit
-  val draw_text : t -> tf:mat2a -> fg:color -> Font.t -> string -> unit
+  val draw_text : t -> tf:mat2a -> fg:color -> Font.t -> Floatbuffer.t -> unit
 end
 
 module Asset : sig
@@ -49,6 +53,6 @@ module Asset : sig
   val load_string : string -> string
   val load_file : string -> (bigstring -> 'a) -> 'a
   val load_sexp_conv : string -> (Sexp.t -> 'a) -> 'a
-  val load_sprite_map : ?dpi:int -> string -> Sprite.map
+  val load_sprite_map : ?dpi:int -> string -> Sprite_map.t
   val load_font : string -> Font.t
 end

src/s2/sprite_map.ml

@@ -4,11 +4,21 @@ include (val Ohlog.sublogs logger "Sprite")
 (* TODO: spritemap has one texture shared by all the sprites *)
 
 type t = {
+  texture : Texture.t;
+  frames : (string, frame) Hashtbl.t;
+}
+
+and frame = {
   clip : aabb;
   offs : aabb;
 }
 
-let make ~pdf ~x ~y ~w ~h ~ox ~oy =
+let make ~texture ~frames = {
+  texture;
+  frames = Hashtbl.of_seq frames;
+}
+
+let make_frame ~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
@@ -22,41 +32,31 @@ let make ~pdf ~x ~y ~w ~h ~ox ~oy =
     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 emit_sprite t ~frame ~pos buffer =
-  let _white = Color.white ()
+  let rect = aabb 0.0 0.0 0.0 0.0 in
-  let rect = aabb 0.0 0.0 0.0 0.0
+  let { clip; offs } = Hashtbl.find t.frames frame in
+  rect.x0 <- offs.x0 +. (pos : vec2).x;
+  rect.y0 <- offs.y0 +. (pos : vec2).y;
+  rect.x1 <- offs.x1 +. (pos : vec2).x;
+  rect.y1 <- offs.y1 +. (pos : vec2).y;
+  Renderer.emit_sprite_geometry buffer ~rect ~clip
 
-  let draw_sprites ren ~tf ?(tint = _white) { texture; _ } frames =
+module Renderer = struct
-    Renderer.begin_sprite_batch ren texture ~tf ~tint;
+  let draw_sprites ren ~tf ~tint t buffer =
-    for i = 0 to Array.length frames - 1 do
+    Renderer.draw_sprites ren t.texture buffer ~tf ~tint
-      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_sprite ren ~rect ~clip;
-    done;
-    Renderer.end_sprite_batch ren
 end
 
-let sprite_of_sexp ~pdf = function
+
+(* sexp conv *)
+
+let frame_of_sexp ~pdf = function
   | Sexp.List [Atom name; x; y; w; h; ox; oy] ->
-    name, make ~pdf
+    name, make_frame ~pdf
             ~x:(Sexp_conv.int_of_sexp x)
             ~y:(Sexp_conv.int_of_sexp y)
             ~w:(Sexp_conv.int_of_sexp w)
@@ -72,8 +72,8 @@ let of_sexp ~texture ?dpi = function
       | Some dpi -> Float.of_int dpi /. 96.0
       | None -> 1.0
     in
-    make_map ~texture
+    let frames = List.to_seq args |> Seq.map (frame_of_sexp ~pdf) in
-      ~frames:(List.to_seq args |> Seq.map (sprite_of_sexp ~pdf))
+    make ~texture ~frames
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite map" sexp