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

opengl.model.polygon.lit_textured: Use model texturing mixin.

Browse Source
This commit is contained in:
Rod Kay
2025-09-07 06:27:46 +10:00
parent eb12d98f65
commit b766155987
6 changed files with 243 additions and 216 deletions
Download Patch File Download Diff File Expand all files Collapse all files

130
3-mid/opengl/source/lean/model/opengl-model-texturing.adb
View File

@@ -29,23 +29,23 @@ is
GL_TEXTURE12,
GL_TEXTURE13,
GL_TEXTURE14,
GL_TEXTURE15,
GL_TEXTURE16,
GL_TEXTURE17,
GL_TEXTURE18,
GL_TEXTURE19,
GL_TEXTURE20,
GL_TEXTURE21,
GL_TEXTURE22,
GL_TEXTURE23,
GL_TEXTURE24,
GL_TEXTURE25,
GL_TEXTURE26,
GL_TEXTURE27,
GL_TEXTURE28,
GL_TEXTURE29,
GL_TEXTURE30,
GL_TEXTURE31];
GL_TEXTURE15];
-- GL_TEXTURE16,
-- GL_TEXTURE17,
-- GL_TEXTURE18,
-- GL_TEXTURE19,
-- GL_TEXTURE20,
-- GL_TEXTURE21,
-- GL_TEXTURE22,
-- GL_TEXTURE23,
-- GL_TEXTURE24,
-- GL_TEXTURE25,
-- GL_TEXTURE26,
-- GL_TEXTURE27,
-- GL_TEXTURE28,
-- GL_TEXTURE29,
-- GL_TEXTURE30,
-- GL_TEXTURE31];
@@ -106,90 +106,94 @@ is
--- Mixin ---
-------------
-- generic
package body Mixin
is
use openGL.texture_Set;
texture_Uniforms : texturing.Uniforms;
procedure create_Uniforms (for_Program : in openGL.Program.view)
is
begin
create (texture_Uniforms, for_Program);
end create_Uniforms;
overriding
procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
Which : in texture_Set.texture_ID := 1)
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
Self.texture_Set.Textures (Which).Fade := Now;
Self.texture_Details.Fades (which) := Now;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return Self.texture_Set.Textures (Which).Fade;
return Self.texture_Details.Fades (which);
end Fade;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
Which : in texture_Set.texture_ID := 1)
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
Texture_is (in_Set => Self.texture_Set,
Which => Which,
Now => Now);
Self.texture_Details.Textures (Positive (which)) := Now;
end Texture_is;
overriding
function Texture (Self : in Item; Which : texture_Set.texture_ID := 1) return openGL.Texture.Object
function texture_Count (Self : in Item) return Natural
is
begin
return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
Which => Which);
end Texture;
return Self.texture_Details.texture_Count;
end texture_Count;
overriding
procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
Which : in texture_Set.texture_ID := 1)
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
is
begin
Self.texture_Set.Textures (Which).Applied := Now;
end texture_Applied_is;
overriding
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
is
begin
return Self.texture_Set.Textures (Which).Applied;
return Self.texture_Details.texture_Applies (Which);
end texture_Applied;
overriding
procedure enable_Textures (Self : in out Item)
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in Boolean)
is
begin
texturing.enable (for_Model => Self.Model.all'Access,
Uniforms => texture_Uniforms,
texture_Set => Self.texture_Set);
end enable_Textures;
Self.texture_Details.texture_Applies (Which) := Now;
end texture_Applied_is;
overriding
procedure animate (Self : in out Item)
is
use type texture_Set.Animation_view;
begin
if Self.texture_Details.Animation = null
then
return;
end if;
texture_Set.animate (Self.texture_Details.Animation.all,
Self.texture_Details.texture_Applies);
end animate;
function texture_Details (Self : in Item) return openGL.texture_Set.Details
is
begin
return Self.texture_Details;
end texture_Details;
procedure texture_Details_is (Self : in out Item; Now : in openGL.texture_Set.Details)
is
begin
Self.texture_Details := Now;
end texture_Details_is;
end Mixin;