add loading font from glyph map

src/s2/font.ml

@@ -0,0 +1,72 @@
+open! Import
+module Sexp = Sexplib.Sexp
+module Sexp_conv = Sexplib.Conv
+include (val Ohlog.sublogs logger "Font")
+
+type glyph = {
+  advance : float;
+  clip : aabb;
+  rect : aabb;
+}
+
+type t = {
+  texture : Texture.t;
+  glyphs : (char, glyph) Hashtbl.t;
+}
+
+let empty = aabb 1.0 1.0 0.0 0.0
+
+module Renderer = struct
+  let draw_text ren ~tf ~fg fnt str =
+    ignore (ren, tf, fg, fnt, str);
+    failwith "TODO: Renderer.draw_text"
+end
+
+
+let bounds_of_sexp = function
+  | Sexp.List [x0; y0; x1; y1] ->
+    AABB.make
+      (Sexp_conv.float_of_sexp x0)
+      (Sexp_conv.float_of_sexp y0)
+      (Sexp_conv.float_of_sexp x1)
+      (Sexp_conv.float_of_sexp y1)
+  | sexp -> Sexp_conv.of_sexp_error "bad msdf glyph bounds" sexp
+
+let glyph_of_sexp = function
+  | Sexp.List (Atom "glyph" :: Atom chr :: args) ->
+    let advance, args = match args with
+      | List [Atom "advance"; advance] :: args ->
+        Sexp_conv.float_of_sexp advance, args
+      | sexp ->
+        Sexp_conv.of_sexp_error "expected glyph advance" (List sexp)
+    in
+    let clip, rect = match args with
+      | clip :: rect :: _ ->
+        bounds_of_sexp clip, bounds_of_sexp rect
+      | clip :: _ ->
+        bounds_of_sexp clip, empty
+      | [] -> empty, empty
+    in
+    chr.[0], { advance; clip; rect }
+  | sexp -> Sexp_conv.of_sexp_error "bad msdf glyph" sexp
+
+let of_sexp ~texture = function
+  | Sexp.List (Atom "msdf" :: glyphs) ->
+    let glyphs =
+      List.to_seq glyphs |>
+      Seq.map glyph_of_sexp |>
+      Hashtbl.of_seq
+    in
+    { texture; glyphs }
+  | sexp -> Sexp_conv.of_sexp_error "invalid msdf" sexp
+
+module Asset = struct
+  let load_font name =
+    let tex_path = Format.sprintf "fonts/%s.png" name in
+    let map_path = Format.sprintf "fonts/%s.map" name in
+    let texture = Texture.load_texture tex_path in
+    let font = Asset.load_sexp_conv map_path (of_sexp ~texture) in
+    debug (fun m -> m "loaded font %S" name);
+    font
+end
+

src/s2/s2.ml

@@ -1,5 +1,6 @@
 module Window = Window
 module Sprite = Sprite
+module Font = Font
 module Renderer = struct
   include Renderer
   include Sprite.Renderer
@@ -7,6 +8,7 @@ end
 module Asset = struct
   include Asset
   include Sprite.Asset
+  include Font.Asset
 end
 module Sdl = Sdl
 module Gl = Gl

src/s2/s2.mli

@@ -20,6 +20,10 @@ module Sprite : sig
   val get : map -> string -> t
 end
 
+module Font : sig
+  type t
+end
+
 module Renderer : sig
   open Adam
 
@@ -42,4 +46,5 @@ module Asset : sig
   val load_file : string -> string
   val load_sexp_conv : string -> (Sexp.t -> 'a) -> 'a
   val load_sprite_map : ?dpi:int -> string -> Sprite.map
+  val load_font : string -> Font.t
 end