add premultiply_alpha bool to load_texture

This commit is contained in:
tali 2024-01-20 12:20:39 -05:00
parent d0f4f6a6c4
commit a898d1c38a
2 changed files with 35 additions and 13 deletions

View File

@ -77,7 +77,7 @@ module Asset = struct
let load_sprite_map ?dpi name = let load_sprite_map ?dpi name =
let tex_path = Format.sprintf "sprites/%s.png" name in let tex_path = Format.sprintf "sprites/%s.png" name in
let map_path = Format.sprintf "sprites/%s.map" name in let map_path = Format.sprintf "sprites/%s.map" name in
let texture = Texture.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 ->

View File

@ -3,6 +3,22 @@ include (val Ohlog.sublogs logger "Texture")
type t = Renderer.texture type t = Renderer.texture
let conv_alpha_no_multiply ofs_r ofs_g ofs_b ofs_a src width height =
let dst = Array3.create Float32 C_layout height width 4 in
for y = 0 to height - 1 do
for x = 0 to width - 1 do
let sr = src.{y, x, ofs_r} in
let sg = src.{y, x, ofs_g} in
let sb = src.{y, x, ofs_b} in
let sa = src.{y, x, ofs_a} in
dst.{y, x, 0} <- Float.of_int sr /. 255.;
dst.{y, x, 1} <- Float.of_int sg /. 255.;
dst.{y, x, 2} <- Float.of_int sb /. 255.;
dst.{y, x, 3} <- Float.of_int sa /. 255.;
done
done;
reshape_1 (genarray_of_array3 dst) (height * width * 4), Gl.rgba
let conv_alpha_premultiply ofs_r ofs_g ofs_b ofs_a src width height = let conv_alpha_premultiply ofs_r ofs_g ofs_b ofs_a src width height =
let dst = Array3.create Float32 C_layout height width 4 in let dst = Array3.create Float32 C_layout height width 4 in
for y = 0 to height - 1 do for y = 0 to height - 1 do
@ -19,6 +35,10 @@ let conv_alpha_premultiply ofs_r ofs_g ofs_b ofs_a src width height =
done; done;
reshape_1 (genarray_of_array3 dst) (height * width * 4), Gl.rgba reshape_1 (genarray_of_array3 dst) (height * width * 4), Gl.rgba
let conv_alpha premul ofs_r ofs_g ofs_b ofs_a src width height =
if premul then conv_alpha_premultiply ofs_r ofs_g ofs_b ofs_a src width height
else conv_alpha_no_multiply ofs_r ofs_g ofs_b ofs_a src width height
let conv_noalpha ofs_r ofs_g ofs_b src width height = let conv_noalpha ofs_r ofs_g ofs_b src width height =
let dst = Array3.create Float32 C_layout height width 3 in let dst = Array3.create Float32 C_layout height width 3 in
for y = 0 to height - 1 do for y = 0 to height - 1 do
@ -35,14 +55,14 @@ let conv_noalpha ofs_r ofs_g ofs_b src width height =
let pp_pixfmt ppf x = Format.pp_print_string ppf (Sdl.get_pixel_format_name x) let pp_pixfmt ppf x = Format.pp_print_string ppf (Sdl.get_pixel_format_name x)
let of_surface srf = let of_surface ?(premultiply_alpha = true) srf =
let pixfmt = Sdl.get_surface_format_enum srf in let pixfmt = Sdl.get_surface_format_enum srf in
let width, height = Sdl.get_surface_size srf in let width, height = Sdl.get_surface_size srf in
trace (fun m -> m "converting %dx%d texture from %a" width height pp_pixfmt pixfmt); trace (fun m -> m "converting %dx%d texture from %a" width height pp_pixfmt pixfmt);
let pitch = Sdl.get_surface_pitch srf in let pitch = Sdl.get_surface_pitch srf in
let stride, conv = let stride, conv =
if Sdl.Pixel.eq pixfmt Sdl.Pixel.format_abgr8888 then if Sdl.Pixel.eq pixfmt Sdl.Pixel.format_abgr8888 then
4, conv_alpha_premultiply 0 1 2 3 4, conv_alpha premultiply_alpha 0 1 2 3
else if Sdl.Pixel.eq pixfmt Sdl.Pixel.format_rgb24 then else if Sdl.Pixel.eq pixfmt Sdl.Pixel.format_rgb24 then
3, conv_noalpha 0 1 2 3, conv_noalpha 0 1 2
else else
@ -53,18 +73,20 @@ let of_surface 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 srf = let of_surface_free ?premultiply_alpha srf =
try try
let tex = of_surface srf in let tex = of_surface srf ?premultiply_alpha in
Sdl.free_surface srf; tex Sdl.free_surface srf; tex
with e -> with e ->
Sdl.free_surface srf; raise e Sdl.free_surface srf; raise e
let load_texture path = module Asset = struct
let load_texture ?premultiply_alpha path =
trace (fun m -> m "open image %S" path); trace (fun m -> m "open image %S" path);
try try
match Sdl.Image.load (Asset.absolute_path path) with match Sdl.Image.load (Asset.absolute_path path) with
| Ok srf -> of_surface_free srf | Ok srf -> of_surface_free ?premultiply_alpha srf
| Error (`Msg msg) -> failwith msg | Error (`Msg msg) -> failwith msg
with with
Failure msg -> raise (Asset.Error (path, msg)) Failure msg -> raise (Asset.Error (path, msg))
end