diff --git a/src/s2/asset.ml b/src/s2/asset.ml index f0e3797..04df535 100644 --- a/src/s2/asset.ml +++ b/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 diff --git a/src/s2/sprite.ml b/src/s2/sprite.ml index 4c41008..6554089 100644 --- a/src/s2/sprite.ml +++ b/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 -> - Hashtbl.iter - (fun name s -> - m " %S %a %a" name - AABB.pp s.clip - AABB.pp s.offs) - spritemap); + trace (fun m -> Hashtbl.iter + (fun name s -> m " %S %a %a" name AABB.pp s.clip AABB.pp s.offs) + spritemap); spritemap end diff --git a/src/s2/texture.ml b/src/s2/texture.ml index bbf4419..065c48b 100644 --- a/src/s2/texture.ml +++ b/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); - try - 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)) + Asset.load_image path + (of_surface ?premultiply_alpha) end