diff --git a/src/s2/sprite.ml b/src/s2/sprite.ml index 82a396d..4c41008 100644 --- a/src/s2/sprite.ml +++ b/src/s2/sprite.ml @@ -77,7 +77,7 @@ module Asset = struct let load_sprite_map ?dpi name = let tex_path = Format.sprintf "sprites/%s.png" 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 debug (fun m -> m "loaded sprite map %S" name); trace (fun m -> diff --git a/src/s2/texture.ml b/src/s2/texture.ml index 0304e61..bbf4419 100644 --- a/src/s2/texture.ml +++ b/src/s2/texture.ml @@ -3,6 +3,22 @@ include (val Ohlog.sublogs logger "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 dst = Array3.create Float32 C_layout height width 4 in 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; 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 dst = Array3.create Float32 C_layout height width 3 in 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 of_surface srf = +let of_surface ?(premultiply_alpha = true) srf = let pixfmt = Sdl.get_surface_format_enum 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); let pitch = Sdl.get_surface_pitch srf in let stride, conv = 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 3, conv_noalpha 0 1 2 else @@ -53,18 +73,20 @@ let of_surface srf = let dst, fmt = conv src width height in Renderer.make_texture width height fmt dst -let of_surface_free srf = +let of_surface_free ?premultiply_alpha srf = try - let tex = of_surface srf in + let tex = of_surface srf ?premultiply_alpha in Sdl.free_surface srf; tex with e -> Sdl.free_surface srf; raise e -let load_texture path = - trace (fun m -> m "open image %S" path); - try - match Sdl.Image.load (Asset.absolute_path path) with - | Ok srf -> of_surface_free srf - | Error (`Msg msg) -> failwith msg - with - Failure msg -> raise (Asset.Error (path, msg)) +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)) +end