260 lines
8.0 KiB
Ada
260 lines
8.0 KiB
Ada
with
|
|
ada.unchecked_Conversion,
|
|
ada.Strings.unbounded.Hash,
|
|
ada.Containers.hashed_Maps;
|
|
|
|
|
|
package openGL.Texture
|
|
--
|
|
-- Provides openGL textures.
|
|
--
|
|
is
|
|
-- Object - an openGL texture 'object'
|
|
--
|
|
|
|
type Object is tagged private;
|
|
type Objects is array (Positive range <>) of Object;
|
|
|
|
null_Object : constant Object;
|
|
|
|
subtype texture_Name is GL.GLuint; -- An openGL texture object 'Name'.
|
|
subtype Dimensions is Extent_2d;
|
|
|
|
|
|
---------
|
|
--- Forge
|
|
--
|
|
|
|
package Forge
|
|
is
|
|
function to_Texture (Name : in texture_Name) return Object;
|
|
function to_Texture (Dimensions : in Texture.Dimensions) return Object;
|
|
function to_Texture (the_Image : in Image;
|
|
use_Mipmaps : in Boolean := True) return Object;
|
|
function to_Texture (the_Image : in lucid_Image;
|
|
use_Mipmaps : in Boolean := True) return Object;
|
|
end Forge;
|
|
|
|
procedure destroy (Self : in out Object);
|
|
procedure free (Self : in out Object);
|
|
|
|
|
|
--------------
|
|
--- Attributes
|
|
--
|
|
|
|
function is_Defined (Self : in Object) return Boolean;
|
|
function is_Transparent (Self : in Object) return Boolean;
|
|
|
|
procedure set_Name (Self : in out Object; To : in texture_Name);
|
|
function Name (Self : in Object) return texture_Name;
|
|
|
|
procedure enable (Self : in Object);
|
|
|
|
procedure set_Image (Self : in out Object; To : in Image;
|
|
use_Mipmaps : in Boolean := True);
|
|
procedure set_Image (Self : in out Object; To : in lucid_Image;
|
|
use_Mipmaps : in Boolean := True);
|
|
|
|
function Size (Self : in Object) return Texture.Dimensions;
|
|
|
|
|
|
-------
|
|
-- Maps
|
|
--
|
|
|
|
type name_Map_of_texture is tagged private;
|
|
|
|
function fetch (From : access name_Map_of_texture'Class;
|
|
texture_Name : in asset_Name) return Object;
|
|
|
|
|
|
--------
|
|
-- Pool
|
|
--
|
|
-- For rapid allocation/deallocation of texture objects.
|
|
|
|
type Pool is private;
|
|
type Pool_view is access all Pool;
|
|
|
|
procedure destroy (the_Pool : in out Pool);
|
|
function new_Texture (From : access Pool; Size : in Dimensions) return Object;
|
|
--
|
|
-- Returns a texture object of the requested size.
|
|
|
|
procedure free (From : in out Pool; the_Texture : in Object);
|
|
--
|
|
-- Frees a texture for future use.
|
|
|
|
procedure vacuum (the_Pool : in out Pool);
|
|
--
|
|
-- Releases any allocated, but unused, texture objects.
|
|
|
|
|
|
|
|
-----------
|
|
-- GL Enums
|
|
--
|
|
|
|
-- TexFormatEnm
|
|
--
|
|
type Format is (ALPHA,
|
|
RGB, RGBA,
|
|
LUMINANCE, LUMINANCE_ALPHA,
|
|
R3_G3_B2,
|
|
ALPHA4, ALPHA8, ALPHA12, ALPHA16,
|
|
LUMINANCE4, LUMINANCE8, LUMINANCE12, LUMINANCE16,
|
|
LUMINANCE4_ALPHA4, LUMINANCE6_ALPHA2, LUMINANCE8_ALPHA8, LUMINANCE12_ALPHA4, LUMINANCE12_ALPHA12, LUMINANCE16_ALPHA16,
|
|
INTENSITY, INTENSITY4, INTENSITY8, INTENSITY12, INTENSITY16,
|
|
RGB4, RGB5, RGB8, RGB10, RGB12, RGB16,
|
|
RGBA2, RGBA4, RGB5_A1, RGBA8, RGB10_A2, RGBA12, RGBA16,
|
|
BGR, BGRA);
|
|
|
|
type pixel_Format is (COLOR_INDEX,
|
|
RED, GREEN, BLUE, ALPHA,
|
|
RGB, RGBA,
|
|
LUMINANCE, LUMINANCE_ALPHA);
|
|
|
|
function to_GL (From : in Format) return GL.GLenum;
|
|
function to_GL (From : in pixel_Format) return GL.GLenum;
|
|
|
|
|
|
|
|
----------
|
|
-- Utility
|
|
--
|
|
|
|
function Power_of_2_Ceiling (From : in Positive) return GL.GLsizei;
|
|
|
|
|
|
|
|
private
|
|
|
|
type Object is tagged
|
|
record
|
|
Name : aliased texture_Name := 0;
|
|
Dimensions : Texture.Dimensions := (0, 0);
|
|
is_Transparent : Boolean := False;
|
|
Pool : access Texture.Pool;
|
|
end record;
|
|
|
|
|
|
-------
|
|
-- Maps
|
|
--
|
|
|
|
use Ada.Strings.unbounded;
|
|
package name_Maps_of_texture_id is new ada.Containers.hashed_Maps (unbounded_String,
|
|
Texture.Object,
|
|
Hash,
|
|
"=");
|
|
type name_Map_of_texture is new name_Maps_of_texture_id.Map with null record;
|
|
|
|
|
|
---------------
|
|
--- Rep Clauses
|
|
--
|
|
|
|
for Format use
|
|
(ALPHA => 16#1906#,
|
|
RGB => 16#1907#,
|
|
RGBA => 16#1908#,
|
|
LUMINANCE => 16#1909#,
|
|
LUMINANCE_ALPHA => 16#190A#,
|
|
R3_G3_B2 => 16#2A10#,
|
|
ALPHA4 => 16#803B#,
|
|
ALPHA8 => 16#803C#,
|
|
ALPHA12 => 16#803D#,
|
|
ALPHA16 => 16#803E#,
|
|
LUMINANCE4 => 16#803F#,
|
|
LUMINANCE8 => 16#8040#,
|
|
LUMINANCE12 => 16#8041#,
|
|
LUMINANCE16 => 16#8042#,
|
|
LUMINANCE4_ALPHA4 => 16#8043#,
|
|
LUMINANCE6_ALPHA2 => 16#8044#,
|
|
LUMINANCE8_ALPHA8 => 16#8045#,
|
|
LUMINANCE12_ALPHA4 => 16#8046#,
|
|
LUMINANCE12_ALPHA12 => 16#8047#,
|
|
LUMINANCE16_ALPHA16 => 16#8048#,
|
|
INTENSITY => 16#8049#,
|
|
INTENSITY4 => 16#804A#,
|
|
INTENSITY8 => 16#804B#,
|
|
INTENSITY12 => 16#804C#,
|
|
INTENSITY16 => 16#804D#,
|
|
RGB4 => 16#804F#,
|
|
RGB5 => 16#8050#,
|
|
RGB8 => 16#8051#,
|
|
RGB10 => 16#8052#,
|
|
RGB12 => 16#8053#,
|
|
RGB16 => 16#8054#,
|
|
RGBA2 => 16#8055#,
|
|
RGBA4 => 16#8056#,
|
|
RGB5_A1 => 16#8057#,
|
|
RGBA8 => 16#8058#,
|
|
RGB10_A2 => 16#8059#,
|
|
RGBA12 => 16#805A#,
|
|
RGBA16 => 16#805B#,
|
|
BGR => 16#80E0#,
|
|
BGRA => 16#80E1#);
|
|
|
|
for Format'Size use GL.GLenum'Size;
|
|
|
|
|
|
for pixel_Format use
|
|
(COLOR_INDEX => 16#1900#,
|
|
RED => 16#1903#,
|
|
GREEN => 16#1904#,
|
|
BLUE => 16#1905#,
|
|
ALPHA => 16#1906#,
|
|
RGB => 16#1907#,
|
|
RGBA => 16#1908#,
|
|
LUMINANCE => 16#1909#,
|
|
LUMINANCE_ALPHA => 16#190A#);
|
|
|
|
for pixel_Format'Size use GL.GLenum'Size;
|
|
|
|
|
|
|
|
--------
|
|
-- Pool
|
|
--
|
|
|
|
type pool_texture_List is
|
|
record
|
|
Textures : Objects (1 .. 5_000);
|
|
Last : Natural := 0;
|
|
end record;
|
|
|
|
type pool_texture_List_view is access all pool_texture_List;
|
|
|
|
|
|
function Hash (the_Dimensions : in Texture.Dimensions) return ada.Containers.Hash_type;
|
|
|
|
package size_Maps_of_pool_texture_List is new ada.Containers.hashed_Maps (Key_Type => Dimensions,
|
|
Element_Type => pool_texture_List_view,
|
|
Hash => Hash,
|
|
Equivalent_Keys => "=");
|
|
type Pool is
|
|
record
|
|
Map : size_Maps_of_pool_texture_List.Map;
|
|
end record;
|
|
|
|
|
|
-------------
|
|
-- Constants
|
|
--
|
|
null_Object : constant Object := (others => <>);
|
|
|
|
|
|
---------------
|
|
-- Conversions
|
|
--
|
|
|
|
function convert_1 is new Ada.Unchecked_Conversion (Format, GL.GLenum);
|
|
function convert_2 is new Ada.Unchecked_Conversion (pixel_Format, GL.GLenum);
|
|
|
|
function to_GL (From : in Format) return GL.GLenum renames convert_1;
|
|
function to_GL (From : in pixel_Format) return GL.GLenum renames convert_2;
|
|
|
|
end openGL.Texture;
|