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

opengl.geometry: Add/use texturing support.

Browse Source
This commit is contained in:
Rod Kay
2023-05-05 03:13:07 +10:00
parent b9064c43c8
commit 2ac6d57a53
7 changed files with 254 additions and 357 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -2,8 +2,7 @@ with
openGL.Primitive,
openGL.Buffer,
openGL.Program,
openGL.Texture,
openGL.Variable.uniform;
openGL.Texture;
private
@@ -49,52 +48,9 @@ is
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;
textures_Uniform : openGL.Variable.uniform.sampler2D;
fade_Uniform : openGL.Variable.uniform.float;
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.
initialised : Boolean := False;
end record;
procedure enable (the_Textures : in out 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.