remove Texture public interface from S2
This commit is contained in:
parent
5f31d1eb7f
commit
61d4e590b2
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ->
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue