refactor load_image happens in Asset

This commit is contained in:
tali 2024-01-20 13:42:34 -05:00
parent 09a5947a27
commit 466f84eb8e
3 changed files with 17 additions and 23 deletions

View File

@ -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

View File

@ -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 -> spritemap);
m " %S %a %a" name
AABB.pp s.clip
AABB.pp s.offs)
spritemap);
spritemap spritemap
end end

View File

@ -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