opengl.geometry.texturing: Use 'Mixin' generic.
This commit is contained in:
@@ -129,6 +129,8 @@ is
|
||||
name => +Attribute_3_Name_ptr);
|
||||
Errors.log;
|
||||
end;
|
||||
|
||||
textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
|
||||
end if;
|
||||
|
||||
Self.Program_is (the_Program.all'Access);
|
||||
@@ -182,6 +184,7 @@ is
|
||||
end Vertices_are;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure Indices_are (Self : in out Item; Now : in Indices;
|
||||
for_Facia : in Positive)
|
||||
@@ -191,23 +194,23 @@ is
|
||||
end Indices_are;
|
||||
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item)
|
||||
is
|
||||
use GL,
|
||||
GL.Binding,
|
||||
openGL.Texture;
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
glActiveTexture (gl.GL_TEXTURE0);
|
||||
Errors.log;
|
||||
|
||||
if Self.Texture = openGL.Texture.null_Object
|
||||
then enable (white_Texture);
|
||||
else enable (Self.Texture);
|
||||
end if;
|
||||
end enable_Textures;
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item)
|
||||
-- is
|
||||
-- use GL,
|
||||
-- GL.Binding,
|
||||
-- openGL.Texture;
|
||||
-- begin
|
||||
-- Tasks.check;
|
||||
--
|
||||
-- glActiveTexture (gl.GL_TEXTURE0);
|
||||
-- Errors.log;
|
||||
--
|
||||
-- if Self.Texture = openGL.Texture.null_Object
|
||||
-- then enable (white_Texture);
|
||||
-- else enable (Self.Texture);
|
||||
-- end if;
|
||||
-- end enable_Textures;
|
||||
|
||||
|
||||
end openGL.Geometry.colored_textured;
|
||||
|
||||
@@ -1,3 +1,12 @@
|
||||
with
|
||||
openGL.texture_Set;
|
||||
|
||||
|
||||
private
|
||||
with
|
||||
openGL.Geometry.texturing;
|
||||
|
||||
|
||||
package openGL.Geometry.colored_textured
|
||||
--
|
||||
-- Supports per-vertex site, color and texture.
|
||||
@@ -36,13 +45,22 @@ is
|
||||
|
||||
private
|
||||
|
||||
type Item is new Geometry.item with
|
||||
package textured_Geometry is new texturing.Mixin;
|
||||
|
||||
|
||||
type Item is new textured_Geometry.item with
|
||||
record
|
||||
null;
|
||||
end record;
|
||||
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item);
|
||||
-- type Item is new Geometry.item with
|
||||
-- record
|
||||
-- null;
|
||||
-- end record;
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item);
|
||||
|
||||
end openGL.Geometry.colored_textured;
|
||||
|
||||
@@ -180,6 +180,12 @@ is
|
||||
Index => the_Program.Program.Attribute (named => Name_5).gl_Location,
|
||||
Name => +Attribute_5_Name_ptr);
|
||||
Errors.log;
|
||||
|
||||
|
||||
|
||||
-- TODO: This will fail. Split this package into 'lit_colored_textured' and 'lit_colored_text'.
|
||||
--
|
||||
textured_Geometry.create_Uniforms (for_Program => the_Program.Program.all'Access);
|
||||
end define;
|
||||
|
||||
Self : constant Geometry_view := new Geometry.lit_colored_textured.item;
|
||||
@@ -281,68 +287,68 @@ is
|
||||
--- Texturing
|
||||
--
|
||||
|
||||
procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
|
||||
is
|
||||
begin
|
||||
Self.Textures.Textures (Which).Fade := Now;
|
||||
end Fade_is;
|
||||
|
||||
|
||||
function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level
|
||||
is
|
||||
begin
|
||||
return Self.Textures.Textures (Which).Fade;
|
||||
end Fade;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
|
||||
is
|
||||
begin
|
||||
Texture_is (in_Set => Self.Textures,
|
||||
Which => Which,
|
||||
Now => Now);
|
||||
end Texture_is;
|
||||
|
||||
|
||||
|
||||
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
which => Which);
|
||||
end Texture;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
||||
is
|
||||
begin
|
||||
Texture_is (in_Set => Self.Textures,
|
||||
Now => Now);
|
||||
end Texture_is;
|
||||
|
||||
|
||||
overriding
|
||||
function Texture (Self : in Item) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
which => 1);
|
||||
end Texture;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item)
|
||||
is
|
||||
begin
|
||||
enable (Self.Textures, Self.Program);
|
||||
end enable_Textures;
|
||||
|
||||
-- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
|
||||
-- is
|
||||
-- begin
|
||||
-- Self.Textures.Textures (Which).Fade := Now;
|
||||
-- end Fade_is;
|
||||
--
|
||||
--
|
||||
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level
|
||||
-- is
|
||||
-- begin
|
||||
-- return Self.Textures.Textures (Which).Fade;
|
||||
-- end Fade;
|
||||
--
|
||||
--
|
||||
--
|
||||
--
|
||||
--
|
||||
-- procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
|
||||
-- is
|
||||
-- begin
|
||||
-- Texture_is (in_Set => Self.Textures,
|
||||
-- Which => Which,
|
||||
-- Now => Now);
|
||||
-- end Texture_is;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
|
||||
-- is
|
||||
-- begin
|
||||
-- return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
-- which => Which);
|
||||
-- end Texture;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
||||
-- is
|
||||
-- begin
|
||||
-- Texture_is (in_Set => Self.Textures,
|
||||
-- Now => Now);
|
||||
-- end Texture_is;
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- function Texture (Self : in Item) return openGL.Texture.Object
|
||||
-- is
|
||||
-- begin
|
||||
-- return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
-- which => 1);
|
||||
-- end Texture;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item)
|
||||
-- is
|
||||
-- begin
|
||||
-- enable (Self.Textures, Self.Program);
|
||||
-- end enable_Textures;
|
||||
--
|
||||
|
||||
|
||||
-- overriding
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
with
|
||||
openGL.texture_Set;
|
||||
|
||||
private
|
||||
with
|
||||
openGL.Geometry.texturing;
|
||||
|
||||
|
||||
package openGL.Geometry.lit_colored_textured
|
||||
--
|
||||
@@ -42,30 +46,41 @@ 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 Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
|
||||
-- Which : in texture_Set.texture_ID := 1);
|
||||
-- function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level;
|
||||
--
|
||||
--
|
||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
|
||||
-- Which : in texture_Set.texture_ID);
|
||||
-- function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object;
|
||||
|
||||
|
||||
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;
|
||||
-- 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.lit_colored_textured;
|
||||
|
||||
@@ -287,35 +287,35 @@ is
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item)
|
||||
is
|
||||
use GL,
|
||||
GL.Binding,
|
||||
openGL.Texture;
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
glActiveTexture (gl.GL_TEXTURE0);
|
||||
Errors.log;
|
||||
|
||||
if Self.Texture = openGL.Texture.null_Object
|
||||
then
|
||||
if not white_Texture.is_Defined
|
||||
then
|
||||
declare
|
||||
use Palette;
|
||||
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
|
||||
begin
|
||||
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
|
||||
end;
|
||||
end if;
|
||||
|
||||
white_Texture.enable;
|
||||
else
|
||||
Self.Texture.enable;
|
||||
end if;
|
||||
end enable_Textures;
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item)
|
||||
-- is
|
||||
-- use GL,
|
||||
-- GL.Binding,
|
||||
-- openGL.Texture;
|
||||
-- begin
|
||||
-- Tasks.check;
|
||||
--
|
||||
-- glActiveTexture (gl.GL_TEXTURE0);
|
||||
-- Errors.log;
|
||||
--
|
||||
-- if Self.Texture = openGL.Texture.null_Object
|
||||
-- then
|
||||
-- if not white_Texture.is_Defined
|
||||
-- then
|
||||
-- declare
|
||||
-- use Palette;
|
||||
-- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
|
||||
-- begin
|
||||
-- white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
|
||||
-- end;
|
||||
-- end if;
|
||||
--
|
||||
-- white_Texture.enable;
|
||||
-- else
|
||||
-- Self.Texture.enable;
|
||||
-- end if;
|
||||
-- end enable_Textures;
|
||||
|
||||
|
||||
end openGL.Geometry.lit_colored_textured_skinned;
|
||||
|
||||
@@ -1,5 +1,12 @@
|
||||
with
|
||||
openGL.Program.lit.colored_textured_skinned;
|
||||
openGL.Program.lit.colored_textured_skinned,
|
||||
openGL.texture_Set;
|
||||
|
||||
|
||||
private
|
||||
with
|
||||
openGL.Geometry.texturing;
|
||||
|
||||
|
||||
|
||||
package openGL.Geometry.lit_colored_textured_skinned
|
||||
@@ -50,9 +57,18 @@ is
|
||||
|
||||
private
|
||||
|
||||
type Item is new Geometry.item with null record;
|
||||
package textured_Geometry is new texturing.Mixin;
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item);
|
||||
|
||||
type Item is new textured_Geometry.item with
|
||||
record
|
||||
null;
|
||||
end record;
|
||||
|
||||
|
||||
-- type Item is new Geometry.item with null record;
|
||||
--
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item);
|
||||
|
||||
end openGL.Geometry.lit_colored_textured_skinned;
|
||||
|
||||
@@ -69,11 +69,9 @@ private
|
||||
package textured_Geometry is new texturing.Mixin;
|
||||
|
||||
|
||||
-- type Item is new Geometry.item with
|
||||
type Item is new textured_Geometry.item with
|
||||
record
|
||||
null;
|
||||
-- texture_Set : openGL.texture_Set.Item;
|
||||
end record;
|
||||
|
||||
|
||||
|
||||
@@ -261,35 +261,35 @@ is
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item)
|
||||
is
|
||||
use GL,
|
||||
GL.Binding,
|
||||
openGL.Texture;
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
glActiveTexture (gl.GL_TEXTURE0);
|
||||
Errors.log;
|
||||
|
||||
if Self.Texture = openGL.Texture.null_Object
|
||||
then
|
||||
if not white_Texture.is_Defined
|
||||
then
|
||||
declare
|
||||
use Palette;
|
||||
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
|
||||
begin
|
||||
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
|
||||
end;
|
||||
end if;
|
||||
|
||||
white_Texture.enable;
|
||||
else
|
||||
Self.Texture.enable;
|
||||
end if;
|
||||
end enable_Textures;
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item)
|
||||
-- is
|
||||
-- use GL,
|
||||
-- GL.Binding,
|
||||
-- openGL.Texture;
|
||||
-- begin
|
||||
-- Tasks.check;
|
||||
--
|
||||
-- glActiveTexture (gl.GL_TEXTURE0);
|
||||
-- Errors.log;
|
||||
--
|
||||
-- if Self.Texture = openGL.Texture.null_Object
|
||||
-- then
|
||||
-- if not white_Texture.is_Defined
|
||||
-- then
|
||||
-- declare
|
||||
-- use Palette;
|
||||
-- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
|
||||
-- begin
|
||||
-- white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
|
||||
-- end;
|
||||
-- end if;
|
||||
--
|
||||
-- white_Texture.enable;
|
||||
-- else
|
||||
-- Self.Texture.enable;
|
||||
-- end if;
|
||||
-- end enable_Textures;
|
||||
|
||||
|
||||
end openGL.Geometry.lit_textured_skinned;
|
||||
|
||||
@@ -1,5 +1,10 @@
|
||||
with
|
||||
openGL.Program.lit.textured_skinned;
|
||||
openGL.Program.lit.textured_skinned,
|
||||
openGL.texture_Set;
|
||||
|
||||
private
|
||||
with
|
||||
openGL.Geometry.texturing;
|
||||
|
||||
|
||||
package openGL.Geometry.lit_textured_skinned
|
||||
@@ -49,9 +54,18 @@ is
|
||||
|
||||
private
|
||||
|
||||
type Item is new Geometry.item with null record;
|
||||
package textured_Geometry is new texturing.Mixin;
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item);
|
||||
|
||||
type Item is new textured_Geometry.item with
|
||||
record
|
||||
null;
|
||||
end record;
|
||||
|
||||
|
||||
-- type Item is new Geometry.item with null record;
|
||||
--
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item);
|
||||
|
||||
end openGL.Geometry.lit_textured_skinned;
|
||||
|
||||
@@ -110,6 +110,8 @@ is
|
||||
glBindAttribLocation (program => the_Program.gl_Program,
|
||||
index => the_Program.Attribute (named => Name_2).gl_Location,
|
||||
name => +Attribute_2_Name_ptr);
|
||||
|
||||
textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
|
||||
end;
|
||||
end if;
|
||||
|
||||
@@ -137,6 +139,7 @@ is
|
||||
Element => Vertex,
|
||||
Element_Array => Vertex_array);
|
||||
|
||||
|
||||
procedure Vertices_are (Self : in out Item; Now : in Vertex_array)
|
||||
is
|
||||
use openGL_Buffer_of_geometry_Vertices.Forge;
|
||||
@@ -156,12 +159,13 @@ is
|
||||
end Vertices_are;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure Indices_are (Self : in out Item; Now : in Indices;
|
||||
for_Facia : in Positive)
|
||||
is
|
||||
begin
|
||||
raise Error with "opengl gemoetry textured - 'Indices_are' ~ TODO";
|
||||
raise Error with "opengl geometry textured - 'Indices_are' ~ TODO";
|
||||
end Indices_are;
|
||||
|
||||
|
||||
@@ -169,67 +173,67 @@ is
|
||||
--- Texturing
|
||||
--
|
||||
|
||||
procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
|
||||
is
|
||||
begin
|
||||
Self.Textures.Textures (Which).Fade := Now;
|
||||
end Fade_is;
|
||||
|
||||
|
||||
|
||||
function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level
|
||||
is
|
||||
begin
|
||||
return Self.Textures.Textures (Which).Fade;
|
||||
end Fade;
|
||||
|
||||
|
||||
|
||||
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
|
||||
is
|
||||
begin
|
||||
Texture_is (in_Set => Self.Textures,
|
||||
Which => Which,
|
||||
Now => Now);
|
||||
end Texture_is;
|
||||
|
||||
|
||||
|
||||
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
Which => Which);
|
||||
end Texture;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
||||
is
|
||||
begin
|
||||
Texture_is (in_Set => Self.Textures,
|
||||
Now => Now);
|
||||
end Texture_is;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
function Texture (Self : in Item) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
which => 1);
|
||||
end Texture;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure enable_Textures (Self : in out Item)
|
||||
is
|
||||
begin
|
||||
enable (Self.Textures, Self.Program);
|
||||
end enable_Textures;
|
||||
-- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
|
||||
-- is
|
||||
-- begin
|
||||
-- Self.Textures.Textures (Which).Fade := Now;
|
||||
-- end Fade_is;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level
|
||||
-- is
|
||||
-- begin
|
||||
-- return Self.Textures.Textures (Which).Fade;
|
||||
-- end Fade;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
|
||||
-- is
|
||||
-- begin
|
||||
-- Texture_is (in_Set => Self.Textures,
|
||||
-- Which => Which,
|
||||
-- Now => Now);
|
||||
-- end Texture_is;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
|
||||
-- is
|
||||
-- begin
|
||||
-- return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
-- Which => Which);
|
||||
-- end Texture;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
||||
-- is
|
||||
-- begin
|
||||
-- Texture_is (in_Set => Self.Textures,
|
||||
-- Now => Now);
|
||||
-- end Texture_is;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- function Texture (Self : in Item) return openGL.Texture.Object
|
||||
-- is
|
||||
-- begin
|
||||
-- return openGL.texture_Set.Texture (in_Set => Self.Textures,
|
||||
-- which => 1);
|
||||
-- end Texture;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- procedure enable_Textures (Self : in out Item)
|
||||
-- is
|
||||
-- begin
|
||||
-- enable (Self.Textures, Self.Program);
|
||||
-- end enable_Textures;
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -120,12 +120,9 @@ is
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_ID;
|
||||
Now : in texture_Set.fade_Level)
|
||||
procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
|
||||
Which : in texture_Set.texture_ID := 1)
|
||||
is
|
||||
begin
|
||||
Self.texture_Set.Textures (which).Fade := Now;
|
||||
@@ -134,7 +131,7 @@ is
|
||||
|
||||
|
||||
overriding
|
||||
function Fade (Self : in Item; Which : in texture_Set.texture_ID) return texture_Set.fade_Level
|
||||
function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level
|
||||
is
|
||||
begin
|
||||
return Self.texture_Set.Textures (which).Fade;
|
||||
@@ -143,8 +140,8 @@ is
|
||||
|
||||
|
||||
overriding
|
||||
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_ID;
|
||||
Now : in openGL.Texture.Object)
|
||||
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
|
||||
Which : in texture_Set.texture_ID := 1)
|
||||
is
|
||||
begin
|
||||
Texture_is (in_Set => Self.texture_Set,
|
||||
@@ -155,7 +152,7 @@ is
|
||||
|
||||
|
||||
overriding
|
||||
function Texture (Self : in Item; Which : texture_Set.texture_ID) return openGL.Texture.Object
|
||||
function Texture (Self : in Item; Which : texture_Set.texture_ID := 1) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
|
||||
@@ -164,23 +161,23 @@ is
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
||||
is
|
||||
begin
|
||||
Texture_is (in_Set => Self.texture_Set,
|
||||
Now => Now);
|
||||
end Texture_is;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
function Texture (Self : in Item) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
return texture_Set.Texture (in_Set => Self.texture_Set,
|
||||
Which => 1);
|
||||
end Texture;
|
||||
-- overriding
|
||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
||||
-- is
|
||||
-- begin
|
||||
-- Texture_is (in_Set => Self.texture_Set,
|
||||
-- Now => Now);
|
||||
-- end Texture_is;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- overriding
|
||||
-- function Texture (Self : in Item) return openGL.Texture.Object
|
||||
-- is
|
||||
-- begin
|
||||
-- return texture_Set.Texture (in_Set => Self.texture_Set,
|
||||
-- Which => 1);
|
||||
-- end Texture;
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -66,21 +66,23 @@ is
|
||||
|
||||
|
||||
overriding
|
||||
procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level);
|
||||
procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
|
||||
Which : in texture_Set.texture_ID := 1);
|
||||
overriding
|
||||
function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level;
|
||||
function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level;
|
||||
|
||||
|
||||
overriding
|
||||
procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object);
|
||||
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
|
||||
Which : in texture_Set.texture_ID := 1);
|
||||
overriding
|
||||
function Texture (Self : in Item; Which : texture_Set.texture_ID) return openGL.Texture.Object;
|
||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) 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;
|
||||
-- overriding
|
||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
|
||||
--
|
||||
-- overriding
|
||||
-- function Texture (Self : in Item) return openGL.Texture.Object;
|
||||
|
||||
|
||||
overriding
|
||||
|
||||
@@ -103,7 +103,7 @@ is
|
||||
|
||||
|
||||
|
||||
function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level
|
||||
function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level
|
||||
is
|
||||
begin
|
||||
raise program_Error with "Geometry has no texture.";
|
||||
@@ -112,16 +112,16 @@ is
|
||||
|
||||
|
||||
|
||||
function Texture (Self : in Item) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
raise program_Error with "Geometry has no texture.";
|
||||
return openGL.Texture.null_Object;
|
||||
end Texture;
|
||||
-- function Texture (Self : in Item) return openGL.Texture.Object
|
||||
-- is
|
||||
-- begin
|
||||
-- raise program_Error with "Geometry has no texture.";
|
||||
-- return openGL.Texture.null_Object;
|
||||
-- end Texture;
|
||||
|
||||
|
||||
|
||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID) return openGL.Texture.Object
|
||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object
|
||||
is
|
||||
begin
|
||||
raise program_Error with "Geometry has no texture.";
|
||||
|
||||
@@ -54,14 +54,16 @@ is
|
||||
--- Texturing
|
||||
--
|
||||
|
||||
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_ID; Now : in texture_Set.fade_Level) is null;
|
||||
function Fade (Self : in Item; Which : in texture_Set.texture_ID) return texture_Set.fade_Level;
|
||||
procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
|
||||
Which : in texture_Set.texture_ID := 1) is null;
|
||||
function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level;
|
||||
|
||||
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_ID; Now : in openGL.Texture.Object) is null;
|
||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID) return openGL.Texture.Object;
|
||||
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
|
||||
Which : in texture_Set.texture_ID := 1) is null;
|
||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.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;
|
||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null;
|
||||
-- function Texture (Self : in Item) return openGL.Texture.Object;
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user