124 lines
3.4 KiB
OCaml
124 lines
3.4 KiB
OCaml
[@@@warning "-32-69"]
|
|
|
|
module Sexp = Sexplib.Sexp
|
|
module Json = Yojson.Basic
|
|
|
|
type atlas = {
|
|
size : int;
|
|
width : int;
|
|
height : int;
|
|
y_origin : [`bottom | `top];
|
|
}
|
|
|
|
(* type metrics = { *)
|
|
(* line_height : float; *)
|
|
(* ascender : float; *)
|
|
(* descender : float; *)
|
|
(* underline_y : float; *)
|
|
(* } *)
|
|
|
|
type bounds = {
|
|
left : float;
|
|
bottom : float;
|
|
right : float;
|
|
top : float;
|
|
}
|
|
|
|
type glyph = {
|
|
unicode : int;
|
|
advance : float;
|
|
plane_bounds : bounds option;
|
|
atlas_bounds : bounds option;
|
|
}
|
|
|
|
type msdf = {
|
|
atlas : atlas;
|
|
glyphs : glyph list;
|
|
}
|
|
|
|
let invalid_json f x =
|
|
invalid_arg (f ^ ": unexpected json: " ^ Json.to_string x)
|
|
|
|
let int_of_json = function `Int i -> i |
|
|
x -> invalid_json "int_of_json" x
|
|
let float_of_json = function `Int i -> float_of_int i | `Float f -> f |
|
|
x -> invalid_json "float_of_json" x
|
|
let string_of_json = function `String s -> s |
|
|
x -> invalid_json "string_of_json" x
|
|
let list_of_json = function `List l -> l |
|
|
x -> invalid_json "list_of_json" x
|
|
let json_assoc_opt k = function
|
|
| `Assoc kv -> List.assoc_opt k kv
|
|
| x -> invalid_json "json_assoc" x
|
|
let json_assoc k js = match json_assoc_opt k js with
|
|
| Some v -> v
|
|
| None -> invalid_arg ("no key " ^ k)
|
|
|
|
let atlas_of_json = function
|
|
| `Assoc kv ->
|
|
let size = int_of_json (List.assoc "size" kv) in
|
|
let width = int_of_json (List.assoc "width" kv) in
|
|
let height = int_of_json (List.assoc "height" kv) in
|
|
let y_origin = match List.assoc "yOrigin" kv with
|
|
| `String "bottom" -> `bottom
|
|
| `String "top" -> `top
|
|
| x -> invalid_json "yOrigin" x
|
|
in
|
|
{ size; width; height; y_origin }
|
|
| x -> invalid_json "atlas_of_json" x
|
|
|
|
let bounds_of_json js =
|
|
let left = float_of_json (json_assoc "left" js) in
|
|
let right = float_of_json (json_assoc "right" js) in
|
|
let top = float_of_json (json_assoc "top" js) in
|
|
let bottom = float_of_json (json_assoc "bottom" js) in
|
|
{ left; right; top; bottom }
|
|
|
|
let glyph_of_json js =
|
|
let unicode = int_of_json (json_assoc "unicode" js) in
|
|
let advance = float_of_json (json_assoc "advance" js) in
|
|
let plane_bounds = Option.map bounds_of_json (json_assoc_opt "planeBounds" js) in
|
|
let atlas_bounds = Option.map bounds_of_json (json_assoc_opt "atlasBounds" js) in
|
|
{ unicode; advance; plane_bounds; atlas_bounds }
|
|
|
|
let msdf_of_json js =
|
|
let atlas = atlas_of_json (json_assoc "atlas" js) in
|
|
let glyphs = List.map glyph_of_json (list_of_json (json_assoc "glyphs" js)) in
|
|
{ atlas; glyphs }
|
|
|
|
let sexp_of_bounds b =
|
|
Sexp.List [
|
|
Atom (Printf.sprintf "%.4f" b.left);
|
|
Atom (Printf.sprintf "%.4f" b.top);
|
|
Atom (Printf.sprintf "%.4f" b.right);
|
|
Atom (Printf.sprintf "%.4f" b.bottom);
|
|
]
|
|
|
|
let sexp_of_glyph g =
|
|
let chr = Char.chr g.unicode in
|
|
Sexp.List (
|
|
Atom "glyph" ::
|
|
Atom (String.make 1 chr) ::
|
|
List [Atom "advance"; Atom (Printf.sprintf "%.4f" g.advance)] ::
|
|
(
|
|
(g.plane_bounds |> Option.map sexp_of_bounds |> Option.to_list) @
|
|
(g.atlas_bounds |> Option.map sexp_of_bounds |> Option.to_list)
|
|
)
|
|
)
|
|
|
|
let sexp_of_msdf msdf =
|
|
Sexp.List (
|
|
Atom "msdf" ::
|
|
List.map sexp_of_glyph
|
|
(List.sort (fun a b -> compare a.unicode b.unicode)
|
|
msdf.glyphs)
|
|
)
|
|
|
|
let () =
|
|
let inp = Json.from_channel stdin in
|
|
let msdf = msdf_of_json inp in
|
|
if msdf.atlas.y_origin <> `top then
|
|
failwith "origin must be top";
|
|
Format.printf "%a\n"
|
|
Sexp.pp_hum (sexp_of_msdf msdf)
|