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 = { type texture = {
tid : int; tid : int;
tsize : ivec2; } [@@unboxed]
}
type pixel_array = (float, Bigarray.float32_elt, Bigarray.c_layout) Array1.t type pixel_array = (float, Bigarray.float32_elt, Bigarray.c_layout) Array1.t
let make_texture width height fmt (pixels : pixel_array) = let make_texture width height fmt (pixels : pixel_array) =
Gl.gen_textures 1 Gl._i32; let tid = Gl.gen_textures 1 Gl._i32; Int32.to_int Gl._i32.{0} in
let tid = Int32.to_int Gl._i32.{0} in
Gl.bind_texture Gl.texture_2d tid; Gl.bind_texture Gl.texture_2d tid;
(* TODO: configurable *) (* TODO: configurable *)
Gl.tex_parameteri Gl.texture_2d Gl.texture_wrap_s Gl.clamp_to_edge; 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.tex_image2d Gl.texture_2d 0 fmt width height 0 fmt Gl.float (`Data pixels);
Gl.generate_mipmap Gl.texture_2d; Gl.generate_mipmap Gl.texture_2d;
Gl.bind_texture Gl.texture_2d 0; Gl.bind_texture Gl.texture_2d 0;
{ tid; tsize = width, height } {tid}
let set_tex : texture set_fn = 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 (* TODO: in order to allow multiple textures, there should something like a LRU cache of
which texture unit each is bound to. *) which texture unit each is bound to. *)
Gl.bind_texture Gl.texture_2d tid; Gl.bind_texture Gl.texture_2d tid;

View File

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

View File

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

View File

@ -74,7 +74,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.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 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,9 +3,6 @@ include (val Ohlog.sublogs logger "Texture")
type t = Renderer.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 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
@ -63,7 +60,6 @@ let of_surface_free srf =
with e -> with e ->
Sdl.free_surface srf; raise e Sdl.free_surface srf; raise e
module Asset = struct
let load_texture path = let load_texture path =
trace (fun m -> m "open image %S" path); trace (fun m -> m "open image %S" path);
try try
@ -72,4 +68,3 @@ module Asset = struct
| 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