opengl.geometry.texturing: Use 'Mixin' generic.

This commit is contained in:
Rod Kay
2023-05-31 11:39:01 +10:00
parent ec4a9b357a
commit ce41c9afef
15 changed files with 381 additions and 292 deletions

View File

@@ -2,6 +2,11 @@ with
openGL.texture_Set;
private
with
openGL.Geometry.texturing;
package openGL.Geometry.textured
--
-- Supports per-vertex site and texture.
@@ -42,30 +47,39 @@ is
--- Texturing.
--
procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level);
function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level;
procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texture_Set.texture_ID) return openGL.Texture.Object;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
overriding
function Texture (Self : in Item) return openGL.Texture.Object;
-- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level);
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level;
--
--
-- procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object);
-- function Texture (Self : in Item; Which : texture_Set.texture_ID) return openGL.Texture.Object;
--
-- overriding
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
--
-- overriding
-- function Texture (Self : in Item) return openGL.Texture.Object;
private
type Item is new Geometry.item with
package textured_Geometry is new texturing.Mixin;
type Item is new textured_Geometry.item with
record
Textures : texture_Set.Item;
null;
end record;
overriding
procedure enable_Textures (Self : in out Item);
-- type Item is new Geometry.item with
-- record
-- Textures : texture_Set.Item;
-- end record;
--
--
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.textured;