remove Texture public interface from S2

This commit is contained in:
tali 2024-01-19 19:08:18 -05:00
parent 5f31d1eb7f
commit 61d4e590b2
5 changed files with 13 additions and 29 deletions

View File

@ -196,14 +196,12 @@ let draw_geometry ?(instances = 1) { vao; draw_mode; indices } =
type texture = {
tid : int;
tsize : ivec2;
}
} [@@unboxed]
type pixel_array = (float, Bigarray.float32_elt, Bigarray.c_layout) Array1.t
let make_texture width height fmt (pixels : pixel_array) =
Gl.gen_textures 1 Gl._i32;
let tid = Int32.to_int Gl._i32.{0} in
let tid = Gl.gen_textures 1 Gl._i32; Int32.to_int Gl._i32.{0} in
Gl.bind_texture Gl.texture_2d tid;
(* TODO: configurable *)
Gl.tex_parameteri Gl.texture_2d Gl.texture_wrap_s Gl.clamp_to_edge;
@ -213,10 +211,10 @@ let make_texture width height fmt (pixels : pixel_array) =
Gl.tex_image2d Gl.texture_2d 0 fmt width height 0 fmt Gl.float (`Data pixels);
Gl.generate_mipmap Gl.texture_2d;
Gl.bind_texture Gl.texture_2d 0;
{ tid; tsize = width, height }
{tid}
let set_tex : texture set_fn =
fun (U l) { tid; _ } ->
fun (U l) {tid} ->
(* TODO: in order to allow multiple textures, there should something like a LRU cache of
which texture unit each is bound to. *)
Gl.bind_texture Gl.texture_2d tid;

View File

@ -1,5 +1,4 @@
module Window = Window
module Texture = Texture
module Sprite = Sprite
module Renderer = struct
include Renderer
@ -7,7 +6,6 @@ module Renderer = struct
end
module Asset = struct
include Asset
include Texture.Asset
include Sprite.Asset
end
module Sdl = Sdl

View File

@ -14,12 +14,6 @@ module Window : sig
val event_loop : t -> render:(float -> unit) -> unit
end
module Texture : sig
type t
val width : t -> int
val height : t -> int
end
module Sprite : sig
type t
type map
@ -47,6 +41,5 @@ module Asset : sig
val load_file : string -> string
val load_sexp_conv : string -> (Sexp.t -> 'a) -> 'a
val load_texture : string -> Texture.t
val load_sprite_map : ?dpi:int -> string -> Sprite.map
end

View File

@ -74,7 +74,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.Asset.load_texture tex_path in
let texture = Texture.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 ->

View File

@ -3,9 +3,6 @@ include (val Ohlog.sublogs logger "Texture")
type t = Renderer.texture
let width (t : t) = fst t.tsize
let height (t : t) = snd t.tsize
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
@ -63,13 +60,11 @@ let of_surface_free srf =
with e ->
Sdl.free_surface srf; raise e
module Asset = struct
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))
end
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))