give Font/Sprite_map names internally

src/main.ml

@@ -12,10 +12,10 @@ let main () =
   info (fun m -> m "renderer initialized");
 
   let ctx = Scene.make_context () in
-  Scene.register_sprite_map ctx "blocks" (Asset.load_sprite_map "blocks" ~dpi:192);
-  Scene.register_sprite_map ctx "hud" (Asset.load_sprite_map "hud");
-  Scene.register_font ctx "roman-md" (Asset.load_font "roman-md");
-  Scene.register_font ctx "mono-sm" (Asset.load_font "mono-sm");
+  Scene.register_sprite_map ctx (Asset.load_sprite_map "blocks" ~dpi:192);
+  Scene.register_sprite_map ctx (Asset.load_sprite_map "hud");
+  Scene.register_font ctx (Asset.load_font "roman-md");
+  Scene.register_font ctx (Asset.load_font "mono-sm");
   let scene = Scene.load "main" in
   let root = build ctx scene in
   debug (fun m -> m "loaded scene");

src/n2/n2.mli

@@ -15,8 +15,8 @@ module Scene : sig
 
   type context
   val make_context : unit -> context
-  val register_sprite_map : context -> string -> Sprite_map.t -> unit
-  val register_font : context -> string -> Font.t -> unit
+  val register_sprite_map : context -> Sprite_map.t -> unit
+  val register_font : context -> Font.t -> unit
 end
 
 module Trans : sig

src/n2/scene.ml

@@ -15,11 +15,11 @@ let make_context () = {
   trans_parent = None;
 }
 
-let register_sprite_map cx k v = Hashtbl.replace cx.sprite_maps k v
+let register_sprite_map cx s = Hashtbl.replace cx.sprite_maps (Sprite_map.name s) s
 let get_sprite_map cx k = try Hashtbl.find cx.sprite_maps k
   with Not_found -> Format.kasprintf failwith "no such sprite map %S" k
 
-let register_font cx k v = Hashtbl.replace cx.fonts k v
+let register_font cx f = Hashtbl.replace cx.fonts (Font.name f) f
 let get_font cx k = try Hashtbl.find cx.fonts k
   with Not_found -> Format.kasprintf failwith "no such font %S" k
 

src/s2/font.ml

@@ -8,11 +8,15 @@ type glyph = {
 }
 
 type t = {
+  name : string;
   msdf : Texture.t;
   glyphs : (char, glyph) Hashtbl.t;
 }
 
-let empty = aabb 1.0 1.0 0.0 0.0
+let make ~name ~msdf ~glyphs =
+  { name; msdf; glyphs }
+
+let name t = t.name
 
 let emit_glyphs t ~text buffer =
   let offset = vec2 0.0 0.0 in
@@ -41,6 +45,8 @@ let bounds_of_sexp = function
       (Sexp_conv.float_of_sexp y1)
   | sexp -> Sexp_conv.of_sexp_error "bad msdf glyph bounds" sexp
 
+let empty = aabb 1.0 1.0 0.0 0.0
+
 let glyph_of_sexp = function
   | Sexp.List (Atom "glyph" :: Atom chr :: args) ->
     let advance, args = match args with
@@ -59,7 +65,7 @@ let glyph_of_sexp = function
     chr.[0], { advance; atlas; plane }
   | sexp -> Sexp_conv.of_sexp_error "bad msdf glyph" sexp
 
-let of_sexp ~msdf = function
+let of_sexp ~name ~msdf = function
   | Sexp.List (Atom "msdf" :: glyphs) ->
     let glyphs =
       List.to_seq glyphs |>
@@ -67,7 +73,7 @@ let of_sexp ~msdf = function
       Hashtbl.of_seq
     in
     trace (fun m -> m "%S" (String.of_seq (Hashtbl.to_seq_keys glyphs)));
-    { msdf; glyphs }
+    make ~name ~msdf ~glyphs
   | sexp -> Sexp_conv.of_sexp_error "invalid msdf" sexp
 
 module Asset = struct
@@ -75,7 +81,7 @@ module Asset = struct
     let tex_path = Format.sprintf "fonts/%s.png" name in
     let map_path = Format.sprintf "fonts/%s.map" name in
     let msdf = Texture.Asset.load_texture tex_path ~premultiply_alpha:false in
-    let font = Asset.load_sexp_conv map_path (of_sexp ~msdf) in
+    let font = Asset.load_sexp_conv map_path (of_sexp ~name ~msdf) in
     debug (fun m -> m "loaded font %S" name);
     font
 end

src/s2/s2.mli

@@ -18,6 +18,7 @@ module Sprite_map : sig
   open Adam
 
   type t
+  val name : t -> string
   val emit_sprite : t -> frame:string -> pos:vec2 -> Floatbuffer.t -> unit
 end
 
@@ -25,6 +26,7 @@ module Font : sig
   open Adam
 
   type t
+  val name : t -> string
   val emit_glyphs : t -> text:string -> Floatbuffer.t -> unit
 end
 

src/s2/sprite_map.ml

@@ -1,23 +1,11 @@
 open! Import
 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 = {
+type frame = {
   clip : aabb;
   offs : aabb;
 }
 
-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
@@ -32,10 +20,22 @@ let make_frame ~pdf ~x ~y ~w ~h ~ox ~oy =
     offs = aabb ox0 oy0 ox1 oy1;
   }
 
-let get map name =
-  try Hashtbl.find map.frames name
-  with Not_found ->
-    Format.ksprintf failwith "no sprite %S in sprite map" name
+type t = {
+  name : string;
+  texture : Texture.t;
+  frames : (string, frame) Hashtbl.t;
+}
+
+let make ~name ~texture ~frames = {
+  name;
+  texture;
+  frames = Hashtbl.of_seq frames;
+}
+
+let name t = t.name
+
+let get map fn = try Hashtbl.find map.frames fn
+  with Not_found -> Format.kasprintf failwith "no sprite %S in sprite map" fn
 
 let emit_sprite t ~frame ~pos buffer =
   let rect = aabb 0.0 0.0 0.0 0.0 in
@@ -66,14 +66,14 @@ let frame_of_sexp ~pdf = function
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite" sexp
 
-let of_sexp ~texture ?dpi = function
+let of_sexp ~name ~texture ?dpi = function
   | Sexp.List (Atom "map" :: args) ->
     let pdf = match dpi with
       | Some dpi -> Float.of_int dpi /. 96.0
       | None -> 1.0
     in
     let frames = List.to_seq args |> Seq.map (frame_of_sexp ~pdf) in
-    make ~texture ~frames
+    make ~name ~texture ~frames
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite map" sexp
 
@@ -82,7 +82,7 @@ module Asset = struct
     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 ?dpi) in
+    let spritemap = Asset.load_sexp_conv map_path (of_sexp ~name ~texture ?dpi) in
     debug (fun m -> m "loaded sprite map %S" name);
     spritemap
 end