refactor load_image happens in Asset
This commit is contained in:
parent
09a5947a27
commit
466f84eb8e
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
trace (fun m -> Hashtbl.iter
|
||||
(fun name s -> m " %S %a %a" name AABB.pp s.clip AABB.pp s.offs)
|
||||
spritemap);
|
||||
spritemap
|
||||
end
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue