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

This commit is contained in:
Rod Kay
2023-05-31 10:54:59 +10:00
parent bb6df0ba31
commit ec4a9b357a
6 changed files with 282 additions and 92 deletions

View File

@@ -1,6 +1,10 @@
with
openGL.texture_Set;
private
with
openGL.Geometry.texturing;
package openGL.Geometry.lit_textured
--
@@ -45,30 +49,35 @@ 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 Geometry.item with
type Item is new textured_Geometry.item with
record
texture_Set : openGL.texture_Set.Item;
null;
-- texture_Set : openGL.texture_Set.Item;
end record;
overriding
procedure enable_Textures (Self : in out Item);
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.lit_textured;