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

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

37
3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb
View File

@@ -129,6 +129,8 @@ is
name => +Attribute_3_Name_ptr); name => +Attribute_3_Name_ptr);
Errors.log; Errors.log;
end; end;
textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
end if; end if;
Self.Program_is (the_Program.all'Access); Self.Program_is (the_Program.all'Access);
@@ -182,6 +184,7 @@ is
end Vertices_are; end Vertices_are;
overriding overriding
procedure Indices_are (Self : in out Item; Now : in Indices; procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive) for_Facia : in Positive)
@@ -191,23 +194,23 @@ is
end Indices_are; end Indices_are;
overriding -- overriding
procedure enable_Textures (Self : in out Item) -- procedure enable_Textures (Self : in out Item)
is -- is
use GL, -- use GL,
GL.Binding, -- GL.Binding,
openGL.Texture; -- openGL.Texture;
begin -- begin
Tasks.check; -- Tasks.check;
--
glActiveTexture (gl.GL_TEXTURE0); -- glActiveTexture (gl.GL_TEXTURE0);
Errors.log; -- Errors.log;
--
if Self.Texture = openGL.Texture.null_Object -- if Self.Texture = openGL.Texture.null_Object
then enable (white_Texture); -- then enable (white_Texture);
else enable (Self.Texture); -- else enable (Self.Texture);
end if; -- end if;
end enable_Textures; -- end enable_Textures;
end openGL.Geometry.colored_textured; end openGL.Geometry.colored_textured;

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

@@ -1,3 +1,12 @@
with
openGL.texture_Set;
private
with
openGL.Geometry.texturing;
package openGL.Geometry.colored_textured package openGL.Geometry.colored_textured
-- --
-- Supports per-vertex site, color and texture. -- Supports per-vertex site, color and texture.
@@ -36,13 +45,22 @@ is
private private
type Item is new Geometry.item with package textured_Geometry is new texturing.Mixin;
type Item is new textured_Geometry.item with
record record
null; null;
end record; end record;
overriding -- type Item is new Geometry.item with
procedure enable_Textures (Self : in out Item); -- record
-- null;
-- end record;
--
--
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.colored_textured; end openGL.Geometry.colored_textured;

130
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb
View File

@@ -180,6 +180,12 @@ is
Index => the_Program.Program.Attribute (named => Name_5).gl_Location, Index => the_Program.Program.Attribute (named => Name_5).gl_Location,
Name => +Attribute_5_Name_ptr); Name => +Attribute_5_Name_ptr);
Errors.log; 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; end define;
Self : constant Geometry_view := new Geometry.lit_colored_textured.item; Self : constant Geometry_view := new Geometry.lit_colored_textured.item;
@@ -281,68 +287,68 @@ is
--- Texturing --- Texturing
-- --
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; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
is -- is
begin -- begin
Self.Textures.Textures (Which).Fade := Now; -- Self.Textures.Textures (Which).Fade := Now;
end Fade_is; -- end Fade_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) return texture_Set.fade_Level
is -- is
begin -- begin
return Self.Textures.Textures (Which).Fade; -- return Self.Textures.Textures (Which).Fade;
end Fade; -- end Fade;
--
--
--
--
--
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) -- procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is -- is
begin -- begin
Texture_is (in_Set => Self.Textures, -- Texture_is (in_Set => Self.Textures,
Which => Which, -- Which => Which,
Now => Now); -- Now => Now);
end Texture_is; -- end Texture_is;
--
--
--
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object -- function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is -- is
begin -- begin
return openGL.texture_Set.Texture (in_Set => Self.Textures, -- return openGL.texture_Set.Texture (in_Set => Self.Textures,
which => Which); -- which => Which);
end Texture; -- end Texture;
--
--
--
overriding -- overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is -- is
begin -- begin
Texture_is (in_Set => Self.Textures, -- Texture_is (in_Set => Self.Textures,
Now => Now); -- Now => Now);
end Texture_is; -- end Texture_is;
--
--
overriding -- overriding
function Texture (Self : in Item) return openGL.Texture.Object -- function Texture (Self : in Item) return openGL.Texture.Object
is -- is
begin -- begin
return openGL.texture_Set.Texture (in_Set => Self.Textures, -- return openGL.texture_Set.Texture (in_Set => Self.Textures,
which => 1); -- which => 1);
end Texture; -- end Texture;
--
--
--
overriding -- overriding
procedure enable_Textures (Self : in out Item) -- procedure enable_Textures (Self : in out Item)
is -- is
begin -- begin
enable (Self.Textures, Self.Program); -- enable (Self.Textures, Self.Program);
end enable_Textures; -- end enable_Textures;
--
-- overriding -- overriding

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

@@ -1,6 +1,10 @@
with with
openGL.texture_Set; openGL.texture_Set;
private
with
openGL.Geometry.texturing;
package openGL.Geometry.lit_colored_textured package openGL.Geometry.lit_colored_textured
-- --
@@ -42,30 +46,41 @@ is
--- Texturing. --- Texturing.
-- --
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;
function Fade (Self : in Item; Which : texture_Set.texture_ID) return 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;
-- 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);
function Texture (Self : in Item; Which : texture_Set.texture_ID) return openGL.Texture.Object; --
-- overriding
overriding -- function Texture (Self : in Item) return openGL.Texture.Object;
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
overriding
function Texture (Self : in Item) return openGL.Texture.Object;
private private
type Item is new Geometry.item with package textured_Geometry is new texturing.Mixin;
type Item is new textured_Geometry.item with
record record
Textures : texture_Set.Item; null;
end record; end record;
overriding -- type Item is new Geometry.item with
procedure enable_Textures (Self : in out Item); -- record
-- Textures : texture_Set.Item;
-- end record;
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.lit_colored_textured; end openGL.Geometry.lit_colored_textured;

58
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb
View File

@@ -287,35 +287,35 @@ is
overriding -- overriding
procedure enable_Textures (Self : in out Item) -- procedure enable_Textures (Self : in out Item)
is -- is
use GL, -- use GL,
GL.Binding, -- GL.Binding,
openGL.Texture; -- openGL.Texture;
begin -- begin
Tasks.check; -- Tasks.check;
--
glActiveTexture (gl.GL_TEXTURE0); -- glActiveTexture (gl.GL_TEXTURE0);
Errors.log; -- Errors.log;
--
if Self.Texture = openGL.Texture.null_Object -- if Self.Texture = openGL.Texture.null_Object
then -- then
if not white_Texture.is_Defined -- if not white_Texture.is_Defined
then -- then
declare -- declare
use Palette; -- use Palette;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; -- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin -- begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image); -- white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
end; -- end;
end if; -- end if;
--
white_Texture.enable; -- white_Texture.enable;
else -- else
Self.Texture.enable; -- Self.Texture.enable;
end if; -- end if;
end enable_Textures; -- end enable_Textures;
end openGL.Geometry.lit_colored_textured_skinned; end openGL.Geometry.lit_colored_textured_skinned;

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

@@ -1,5 +1,12 @@
with 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 package openGL.Geometry.lit_colored_textured_skinned
@@ -50,9 +57,18 @@ is
private 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; end openGL.Geometry.lit_colored_textured_skinned;

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

@@ -69,11 +69,9 @@ private
package textured_Geometry is new texturing.Mixin; package textured_Geometry is new texturing.Mixin;
-- type Item is new Geometry.item with
type Item is new textured_Geometry.item with type Item is new textured_Geometry.item with
record record
null; null;
-- texture_Set : openGL.texture_Set.Item;
end record; end record;

58
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb
View File

@@ -261,35 +261,35 @@ is
overriding -- overriding
procedure enable_Textures (Self : in out Item) -- procedure enable_Textures (Self : in out Item)
is -- is
use GL, -- use GL,
GL.Binding, -- GL.Binding,
openGL.Texture; -- openGL.Texture;
begin -- begin
Tasks.check; -- Tasks.check;
--
glActiveTexture (gl.GL_TEXTURE0); -- glActiveTexture (gl.GL_TEXTURE0);
Errors.log; -- Errors.log;
--
if Self.Texture = openGL.Texture.null_Object -- if Self.Texture = openGL.Texture.null_Object
then -- then
if not white_Texture.is_Defined -- if not white_Texture.is_Defined
then -- then
declare -- declare
use Palette; -- use Palette;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; -- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin -- begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image); -- white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
end; -- end;
end if; -- end if;
--
white_Texture.enable; -- white_Texture.enable;
else -- else
Self.Texture.enable; -- Self.Texture.enable;
end if; -- end if;
end enable_Textures; -- end enable_Textures;
end openGL.Geometry.lit_textured_skinned; end openGL.Geometry.lit_textured_skinned;

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

@@ -1,5 +1,10 @@
with 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 package openGL.Geometry.lit_textured_skinned
@@ -49,9 +54,18 @@ is
private 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; end openGL.Geometry.lit_textured_skinned;

128
3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb
View File

@@ -110,6 +110,8 @@ is
glBindAttribLocation (program => the_Program.gl_Program, glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_2).gl_Location, index => the_Program.Attribute (named => Name_2).gl_Location,
name => +Attribute_2_Name_ptr); name => +Attribute_2_Name_ptr);
textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
end; end;
end if; end if;
@@ -137,6 +139,7 @@ is
Element => Vertex, Element => Vertex,
Element_Array => Vertex_array); Element_Array => Vertex_array);
procedure Vertices_are (Self : in out Item; Now : in Vertex_array) procedure Vertices_are (Self : in out Item; Now : in Vertex_array)
is is
use openGL_Buffer_of_geometry_Vertices.Forge; use openGL_Buffer_of_geometry_Vertices.Forge;
@@ -156,12 +159,13 @@ is
end Vertices_are; end Vertices_are;
overriding overriding
procedure Indices_are (Self : in out Item; Now : in Indices; procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive) for_Facia : in Positive)
is is
begin begin
raise Error with "opengl gemoetry textured - 'Indices_are' ~ TODO"; raise Error with "opengl geometry textured - 'Indices_are' ~ TODO";
end Indices_are; end Indices_are;
@@ -169,67 +173,67 @@ is
--- Texturing --- Texturing
-- --
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; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
is -- is
begin -- begin
Self.Textures.Textures (Which).Fade := Now; -- Self.Textures.Textures (Which).Fade := Now;
end Fade_is; -- end Fade_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) return texture_Set.fade_Level
is -- is
begin -- begin
return Self.Textures.Textures (Which).Fade; -- return Self.Textures.Textures (Which).Fade;
end Fade; -- end Fade;
--
--
--
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) -- procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is -- is
begin -- begin
Texture_is (in_Set => Self.Textures, -- Texture_is (in_Set => Self.Textures,
Which => Which, -- Which => Which,
Now => Now); -- Now => Now);
end Texture_is; -- end Texture_is;
--
--
--
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object -- function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is -- is
begin -- begin
return openGL.texture_Set.Texture (in_Set => Self.Textures, -- return openGL.texture_Set.Texture (in_Set => Self.Textures,
Which => Which); -- Which => Which);
end Texture; -- end Texture;
--
--
--
overriding -- overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is -- is
begin -- begin
Texture_is (in_Set => Self.Textures, -- Texture_is (in_Set => Self.Textures,
Now => Now); -- Now => Now);
end Texture_is; -- end Texture_is;
--
--
--
overriding -- overriding
function Texture (Self : in Item) return openGL.Texture.Object -- function Texture (Self : in Item) return openGL.Texture.Object
is -- is
begin -- begin
return openGL.texture_Set.Texture (in_Set => Self.Textures, -- return openGL.texture_Set.Texture (in_Set => Self.Textures,
which => 1); -- which => 1);
end Texture; -- end Texture;
--
--
--
overriding -- overriding
procedure enable_Textures (Self : in out Item) -- procedure enable_Textures (Self : in out Item)
is -- is
begin -- begin
enable (Self.Textures, Self.Program); -- enable (Self.Textures, Self.Program);
end enable_Textures; -- end enable_Textures;

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

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

49
3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb
View File

@@ -120,12 +120,9 @@ is
overriding overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_ID; procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
Now : in texture_Set.fade_Level) Which : in texture_Set.texture_ID := 1)
is is
begin begin
Self.texture_Set.Textures (which).Fade := Now; Self.texture_Set.Textures (which).Fade := Now;
@@ -134,7 +131,7 @@ is
overriding 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 is
begin begin
return Self.texture_Set.Textures (which).Fade; return Self.texture_Set.Textures (which).Fade;
@@ -143,8 +140,8 @@ is
overriding overriding
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_ID; procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
Now : in openGL.Texture.Object) Which : in texture_Set.texture_ID := 1)
is is
begin begin
Texture_is (in_Set => Self.texture_Set, Texture_is (in_Set => Self.texture_Set,
@@ -155,7 +152,7 @@ is
overriding 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 is
begin begin
return openGL.texture_Set.Texture (in_Set => Self.texture_Set, return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
@@ -164,23 +161,23 @@ is
overriding -- overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is -- is
begin -- begin
Texture_is (in_Set => Self.texture_Set, -- Texture_is (in_Set => Self.texture_Set,
Now => Now); -- Now => Now);
end Texture_is; -- end Texture_is;
--
--
--
overriding -- overriding
function Texture (Self : in Item) return openGL.Texture.Object -- function Texture (Self : in Item) return openGL.Texture.Object
is -- is
begin -- begin
return texture_Set.Texture (in_Set => Self.texture_Set, -- return texture_Set.Texture (in_Set => Self.texture_Set,
Which => 1); -- Which => 1);
end Texture; -- end Texture;

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

@@ -66,21 +66,23 @@ is
overriding 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 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 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 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 -- overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
--
overriding -- overriding
function Texture (Self : in Item) return openGL.Texture.Object; -- function Texture (Self : in Item) return openGL.Texture.Object;
overriding overriding

16
3-mid/opengl/source/lean/geometry/opengl-geometry.adb
View File

@@ -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 is
begin begin
raise program_Error with "Geometry has no texture."; raise program_Error with "Geometry has no texture.";
@@ -112,16 +112,16 @@ is
function Texture (Self : in Item) return openGL.Texture.Object -- function Texture (Self : in Item) return openGL.Texture.Object
is -- is
begin -- begin
raise program_Error with "Geometry has no texture."; -- raise program_Error with "Geometry has no texture.";
return openGL.Texture.null_Object; -- return openGL.Texture.null_Object;
end Texture; -- 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 is
begin begin
raise program_Error with "Geometry has no texture."; raise program_Error with "Geometry has no texture.";

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

@@ -54,14 +54,16 @@ is
--- Texturing --- Texturing
-- --
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_ID; Now : in texture_Set.fade_Level) is null; procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
function Fade (Self : in Item; Which : in texture_Set.texture_ID) return 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; procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
function Texture (Self : in Item; Which : in texture_Set.texture_ID) return 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; -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null;
function Texture (Self : in Item) return openGL.Texture.Object; -- function Texture (Self : in Item) return openGL.Texture.Object;