From c1f8a4faec20046a767426155564814dcd176ef2 Mon Sep 17 00:00:00 2001
From: tali <iitalics@gmail.com>
Date: Fri, 19 Jan 2024 18:39:14 -0500
Subject: [PATCH] add sprite type and load spritemap file

---
 src/s2/s2.ml     |  2 ++
 src/s2/s2.mli    |  8 ++++++
 src/s2/sprite.ml | 69 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 79 insertions(+)
 create mode 100644 src/s2/sprite.ml

diff --git a/src/s2/s2.ml b/src/s2/s2.ml
index 4cd257e..0d5932f 100644
--- a/src/s2/s2.ml
+++ b/src/s2/s2.ml
@@ -1,9 +1,11 @@
 module Window = Window
 module Renderer = Renderer
 module Texture = Texture
+module Sprite = Sprite
 module Asset = struct
   include Asset
   include Texture.Asset
+  include Sprite.Asset
 end
 module Sdl = Sdl
 module Gl = Gl
diff --git a/src/s2/s2.mli b/src/s2/s2.mli
index 4a6d145..59a0252 100644
--- a/src/s2/s2.mli
+++ b/src/s2/s2.mli
@@ -20,6 +20,12 @@ module Texture : sig
   val height : t -> int
 end
 
+module Sprite : sig
+  type t
+  type map
+  val get : map -> string -> t
+end
+
 module Renderer : sig
   open Adam
 
@@ -32,6 +38,7 @@ module Renderer : sig
   val clear : t -> color -> unit
   val draw_rect : t -> tf:mat2a -> bb:aabb -> fill:color -> unit
   val draw_texture : t -> tf:mat2a -> bb:aabb -> ?tint:color -> Texture.t -> unit
+  (* val draw_sprite : t -> tf:mat2a -> ?tint:color -> ?off:vec2 -> Sprite.t -> unit *)
 end
 
 module Asset : sig
@@ -42,4 +49,5 @@ module Asset : sig
   val load_file : string -> string
   val load_sexp_conv : string -> (Sexp.t -> 'a) -> 'a
   val load_texture : string -> Texture.t
+  val load_sprite_map : string -> Sprite.map
 end
diff --git a/src/s2/sprite.ml b/src/s2/sprite.ml
new file mode 100644
index 0000000..b39257d
--- /dev/null
+++ b/src/s2/sprite.ml
@@ -0,0 +1,69 @@
+open! Import
+module Sexp = Sexplib.Sexp
+module Sexp_conv = Sexplib.Conv
+include (val Ohlog.sublogs logger "Sprite")
+
+(* TODO: spritemap has one texture shared by all the sprites *)
+
+type t = {
+  texture : Texture.t;
+  clip : aabb;
+  origin : vec2;
+}
+
+let make ~texture ~x ~y ~w ~h ~ox ~oy =
+  let x0 = Float.of_int x
+  and y0 = Float.of_int y
+  and x1 = Float.of_int (w - x)
+  and y1 = Float.of_int (h - x)
+  and ox = Float.of_int (ox - x)
+  and oy = Float.of_int (oy - y) in
+  {
+    texture;
+    clip = aabb x0 y0 x1 y1;
+    origin = vec2 ox oy;
+  }
+
+type map = (string, t) Hashtbl.t
+
+let get (map : map) name : t =
+  try Hashtbl.find map name
+  with Not_found ->
+    Format.ksprintf failwith "no sprite %S in sprite map" name
+
+let parse_sprite ~map ~texture = function
+  | Sexp.List [Atom name; x; y; w; h; ox; oy] ->
+    let sprite =
+      make ~texture
+        ~x:(Sexp_conv.int_of_sexp x)
+        ~y:(Sexp_conv.int_of_sexp y)
+        ~w:(Sexp_conv.int_of_sexp w)
+        ~h:(Sexp_conv.int_of_sexp h)
+        ~ox:(Sexp_conv.int_of_sexp ox)
+        ~oy:(Sexp_conv.int_of_sexp oy)
+    in
+    Hashtbl.replace map name sprite
+  | sexp ->
+    Sexp_conv.of_sexp_error "invalid sprite" sexp
+
+let of_sexp ~texture = function
+  | Sexp.List (Atom "map" :: sprite_args) ->
+    let map = Hashtbl.create (List.length sprite_args * 2) in
+    List.iter (parse_sprite ~map ~texture) sprite_args;
+    map
+  | sexp ->
+    Sexp_conv.of_sexp_error "invalid sprite map" sexp
+
+module Asset = struct
+  let load_sprite_map name =
+    let tex_path = Format.sprintf "sprites/%s.png" name in
+    let map_path = Format.sprintf "sprites/%s.map" name in
+    let texture = Texture.Asset.load_texture tex_path in
+    let spritemap = Asset.load_sexp_conv map_path (of_sexp ~texture) in
+    trace (fun m -> m "loaded sprite map %S" name);
+    trace (fun m ->
+            Hashtbl.iter
+              (fun k v -> m "  %S %a %a" k AABB.pp v.clip Vec2.pp v.origin)
+              spritemap);
+    spritemap
+end