geometra/src/s2/font.ml

73 lines
1.9 KiB
OCaml

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