Add initial prototype.
This commit is contained in:
Rod Kay
260
3-mid/opengl/source/lean/opengl-texture.ads
Normal file
260
3-mid/opengl/source/lean/opengl-texture.ads
Normal file
@@ -0,0 +1,260 @@
|
||||
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.
|
||||
|
||||
-- TODO: Move this into a child package ?
|
||||
|
||||
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;
|
||||
Reference in New Issue
Block a user