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 ->
|
with exn ->
|
||||||
Unix.close fd; raise 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 string_of_bigarray ba =
|
||||||
let len = Array1.dim ba in
|
let len = Array1.dim ba in
|
||||||
let str = Bytes.create len in
|
let str = Bytes.create len in
|
||||||
|
|
|
@ -1,6 +1,4 @@
|
||||||
open! Import
|
open! Import
|
||||||
module Sexp = Sexplib.Sexp
|
|
||||||
module Sexp_conv = Sexplib.Conv
|
|
||||||
include (val Ohlog.sublogs logger "Sprite")
|
include (val Ohlog.sublogs logger "Sprite")
|
||||||
|
|
||||||
(* TODO: spritemap has one texture shared by all the sprites *)
|
(* 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 texture = Texture.Asset.load_texture tex_path in
|
||||||
let spritemap = Asset.load_sexp_conv map_path (of_sexp ~texture ?dpi) in
|
let spritemap = Asset.load_sexp_conv map_path (of_sexp ~texture ?dpi) in
|
||||||
debug (fun m -> m "loaded sprite map %S" name);
|
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 ->
|
|
||||||
m " %S %a %a" name
|
|
||||||
AABB.pp s.clip
|
|
||||||
AABB.pp s.offs)
|
|
||||||
spritemap);
|
spritemap);
|
||||||
spritemap
|
spritemap
|
||||||
end
|
end
|
||||||
|
|
|
@ -73,20 +73,8 @@ let of_surface ?(premultiply_alpha = true) srf =
|
||||||
let dst, fmt = conv src width height in
|
let dst, fmt = conv src width height in
|
||||||
Renderer.make_texture width height fmt dst
|
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
|
module Asset = struct
|
||||||
let load_texture ?premultiply_alpha path =
|
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
|
end
|
||||||
|
|
Loading…
Reference in New Issue