119 lines
2.8 KiB
OCaml
119 lines
2.8 KiB
OCaml
module Sexp = Sexplib.Sexp
|
|
|
|
type clip = {
|
|
name : string;
|
|
x : int;
|
|
y : int;
|
|
w : int;
|
|
h : int;
|
|
ox : int;
|
|
oy : int;
|
|
}
|
|
|
|
let sexp_of_clip c =
|
|
Sexp.List (
|
|
Atom c.name ::
|
|
List.map Sexplib.Conv.sexp_of_int
|
|
[c.x; c.y; c.w; c.h; c.ox; c.oy])
|
|
|
|
let sexp_of_sprite_map clips =
|
|
Sexp.List (
|
|
Atom "map" ::
|
|
(List.sort (fun a b -> compare b.name a.name) clips |>
|
|
List.rev_map sexp_of_clip))
|
|
|
|
let svg v = ("http://www.w3.org/2000/svg", v)
|
|
let ink v = ("http://www.inkscape.org/namespaces/inkscape", v)
|
|
let sodi v = ("http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd", v)
|
|
|
|
type s = {
|
|
mutable depth : int;
|
|
mutable height : int;
|
|
mutable origins : (string * (int * int)) list;
|
|
mutable clips : clip list;
|
|
mutable clips_g : int;
|
|
}
|
|
|
|
let extract_clips xml =
|
|
let s = {
|
|
depth = 0;
|
|
height = 0;
|
|
origins = [];
|
|
clips = [];
|
|
clips_g = Int.max_int;
|
|
} in
|
|
|
|
let el_start tag atrs =
|
|
s.depth <- s.depth + 1;
|
|
|
|
if tag = svg "svg" then
|
|
begin
|
|
let height = List.assoc ("", "height") atrs |> int_of_string in
|
|
s.height <- height
|
|
end;
|
|
|
|
if tag = svg "g" then
|
|
begin
|
|
let label = List.assoc_opt (ink "label") atrs in
|
|
if label = Some "clips" then
|
|
s.clips_g <- min s.clips_g s.depth
|
|
end;
|
|
|
|
if tag = sodi "guide" then
|
|
begin
|
|
let label = List.assoc_opt (ink "label") atrs in
|
|
match label with
|
|
| None | Some "" -> ()
|
|
| Some name ->
|
|
let pos = List.assoc ("", "position") atrs in
|
|
let[@warning "-8"] [ x; y ] = String.split_on_char ',' pos in
|
|
let x = int_of_string x in
|
|
let y = s.height - int_of_string y in
|
|
s.origins <- (name, (x, y)) :: s.origins
|
|
end;
|
|
|
|
if s.clips_g < s.depth &&
|
|
tag = svg "rect" &&
|
|
List.mem_assoc (ink "label") atrs
|
|
then
|
|
begin
|
|
let name = List.assoc (ink "label") atrs in
|
|
let x = List.assoc ("", "x") atrs |> int_of_string in
|
|
let y = List.assoc ("", "y") atrs |> int_of_string in
|
|
let w = List.assoc ("", "width") atrs |> int_of_string in
|
|
let h = List.assoc ("", "height") atrs |> int_of_string in
|
|
let ox, oy = try List.assoc name s.origins
|
|
with Not_found -> (x, y)
|
|
in
|
|
s.clips <- { name; x; y; w; h; ox; oy } :: s.clips
|
|
end;
|
|
|
|
true
|
|
in
|
|
|
|
let el_end () =
|
|
s.depth <- s.depth - 1;
|
|
if s.depth < s.clips_g then s.clips_g <- Int.max_int;
|
|
s.depth > 0
|
|
in
|
|
|
|
while
|
|
match Xmlm.input xml with
|
|
| `Dtd _ | `Data _ -> true
|
|
| `El_start (tag, atrs) -> el_start tag atrs
|
|
| `El_end -> el_end ()
|
|
do () done;
|
|
|
|
s.clips
|
|
|
|
let gen_sprite_map ic oc =
|
|
let sprite_map =
|
|
Xmlm.make_input (`Channel ic) |>
|
|
extract_clips
|
|
in
|
|
Format.kasprintf (output_string oc) "%a\n"
|
|
Sexp.pp_hum (sexp_of_sprite_map sprite_map)
|
|
|
|
let () =
|
|
gen_sprite_map stdin stdout
|