refactor load_image happens in Asset

src/s2/asset.ml

@@ -18,6 +18,18 @@ let load_file path of_bigstring =
   with exn ->
     Unix.close fd; raise exn
 
+let load_image path of_surface =
+  trace (fun m -> m "reading image %S" path);
+  let srf = match Sdl.Image.load (absolute_path path) with
+    | Ok srf -> srf
+    | Error (`Msg msg) -> raise (Error (path, msg))
+  in
+  try
+    let res = of_surface srf in
+    Sdl.free_surface srf; res
+  with exn ->
+    Sdl.free_surface srf; raise exn
+
 let string_of_bigarray ba =
   let len = Array1.dim ba in
   let str = Bytes.create len in

src/s2/sprite.ml

@@ -1,6 +1,4 @@
 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 *)
@@ -80,12 +78,8 @@ module Asset = struct
     let texture = Texture.Asset.load_texture tex_path in
     let spritemap = Asset.load_sexp_conv map_path (of_sexp ~texture ?dpi) in
     debug (fun m -> m "loaded sprite map %S" name);
-    trace (fun m ->
+    trace (fun m -> Hashtbl.iter
-            Hashtbl.iter
+                      (fun name s -> m "  %S %a %a" name AABB.pp s.clip AABB.pp s.offs)
-              (fun name s ->
+                      spritemap);
-                 m "  %S %a %a" name
-                   AABB.pp s.clip
-                   AABB.pp s.offs)
-              spritemap);
     spritemap
 end

src/s2/texture.ml

@@ -73,20 +73,8 @@ let of_surface ?(premultiply_alpha = true) srf =
   let dst, fmt = conv src width height in
   Renderer.make_texture width height fmt dst
 
-let of_surface_free ?premultiply_alpha srf =
-  try
-    let tex = of_surface srf ?premultiply_alpha in
-    Sdl.free_surface srf; tex
-  with e ->
-    Sdl.free_surface srf; raise e
-
 module Asset = struct
   let load_texture ?premultiply_alpha path =
-    trace (fun m -> m "open image %S" path);
+    Asset.load_image path
-    try
+      (of_surface ?premultiply_alpha)
-      match Sdl.Image.load (Asset.absolute_path path) with
-      | Ok srf -> of_surface_free ?premultiply_alpha srf
-      | Error (`Msg msg) -> failwith msg
-    with
-      Failure msg -> raise (Asset.Error (path, msg))
 end