spritemap generation utils

.gitignore

@@ -1,3 +1,7 @@
 /_build
 /_opam
 /.dir-locals.el
+
+*.png
+*.jpg
+*.map

gen_sprites.sh

@@ -0,0 +1,32 @@
+#!/usr/bin/env bash
+
+if [[ $# < 1 ]]; then
+    echo 'expected source assets directory'
+    exit 1
+fi
+
+src_dir=$1
+out_dir=assets/sprite/
+dpi=192
+
+svg_to_png="inkscape -C"
+gen_sprite_map="dune exec --no-print-directory --display=quiet src/bin/gen_sprite_map.exe"
+
+mkdir -p $out_dir
+
+function gen() {
+    name=$1
+    dpi=${2:-92}
+
+    echo "$name..."
+
+    src=$src_dir/$name.svg
+    dst_png=$out_dir/$name.png
+    dst_map=$out_dir/$name.map
+
+    $svg_to_png $src -o $dst_png -d $dpi || exit 1
+    $gen_sprite_map < $src > $dst_map || exit 1
+}
+
+gen blocks 192
+gen hud

src/bin/dune

@@ -0,0 +1,3 @@
+(executable
+ (name gen_sprite_map)
+ (libraries xmlm sexplib))

src/bin/gen_sprite_map.ml

@@ -0,0 +1,114 @@
+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 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;
+
+  List.sort
+    (fun a b -> String.compare a.name b.name)
+    s.clips
+
+let gen_sprite_map ic oc =
+  Xmlm.make_input (`Channel ic) |>
+  extract_clips  |>
+  List.iter (fun clip ->
+              Format.kasprintf (output_string oc)
+                "%a\n" Sexp.pp (sexp_of_clip clip))
+
+
+let () =
+  gen_sprite_map stdin stdout