nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

openGL: Add preliminary multi-texturing code.

Browse Source
This commit is contained in:
Rod Kay
2023-05-01 21:17:12 +10:00
parent 2209ac7ca8
commit 86721ca2db
11 changed files with 1227 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
3-mid/opengl/source/lean/geometry/opengl-geometry.ads
View File

@@ -39,8 +39,53 @@ is
procedure Label_is (Self : in out Item'Class; Now : in String);
function Label (Self : in Item'Class) return String;
procedure Texture_is (Self : in out Item'Class; Now : in Texture.Object);
function Texture (Self : in Item'Class) return Texture.Object;
max_Textures : constant := 32;
type texture_Id is range 1 .. max_Textures;
-- procedure Texture_is (Self : in out Item'Class; Which : texture_ID; Now : in Texture.Object);
-- function Texture (Self : in Item'Class; Which : texture_ID) return Texture.Object;
--
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null;
function Texture (Self : in Item) return openGL.Texture.Object;
-- *************************************************************************
-- TODO: Move all texture code to a new 'openGL.Geometry.texturing' package.
type fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible).
type fadeable_Texture is
record
Fade : fade_Level := 0.0;
Object : openGL.Texture.Object := openGL.Texture.null_Object;
end record;
type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;
type texture_Set is
record
Textures : fadeable_Textures;
Count : Natural := 0;
is_Transparent : Boolean := False; -- Any of the textures contains lucid colors.
end record;
procedure enable (the_Textures : in texture_Set;
Program : in openGL.Program.view);
procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object;
procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object);
function Texture (in_Set : in texture_Set) return openGL.Texture.Object;
procedure Bounds_are (Self : in out Item'Class; Now : in Bounds);
function Bounds (self : in Item'Class) return Bounds; -- Returns the bounds in object space.
@@ -84,11 +129,14 @@ is
private
use ada.Strings.unbounded;
type Textures is array (texture_Id) of openGL.Texture.Object;
type Item is abstract tagged limited
record
Label : unbounded_String;
Texture : openGL.Texture.Object := openGL.Texture.null_Object;
Program : openGL.Program.view;
Vertices : Buffer.view;
@@ -100,6 +148,7 @@ private
end record;
generic
type any_Index_t is range <>;
with function get_Site (Index : in any_Index_t) return Vector_3;