opengl: Allow models with multiple textures to selectively apply/unapply individual textures.
This commit is contained in:
@@ -62,7 +62,8 @@ is
|
|||||||
begin
|
begin
|
||||||
for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
|
for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
|
||||||
loop
|
loop
|
||||||
Uniforms.Textures (i).fade_Uniform.Value_is (Real (for_Model.Fade (i)));
|
Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (i)));
|
||||||
|
Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (i));
|
||||||
|
|
||||||
glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
|
glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
|
||||||
GLint (i) - 1);
|
GLint (i) - 1);
|
||||||
@@ -86,12 +87,14 @@ is
|
|||||||
declare
|
declare
|
||||||
use ada.Strings,
|
use ada.Strings,
|
||||||
ada.Strings.fixed;
|
ada.Strings.fixed;
|
||||||
i : constant Positive := Positive (Id);
|
i : constant Positive := Positive (Id);
|
||||||
texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]";
|
texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]";
|
||||||
fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]";
|
fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]";
|
||||||
|
texture_applies_uniform_Name : constant String := "texture_Applies[" & trim (Natural'Image (i - 1), Left) & "]";
|
||||||
begin
|
begin
|
||||||
Uniforms.Textures (Id).texture_Uniform := for_Program.uniform_Variable (named => texture_uniform_Name);
|
Uniforms.Textures (Id). texture_Uniform := for_Program.uniform_Variable (Named => texture_uniform_Name);
|
||||||
Uniforms.Textures (Id). fade_Uniform := for_Program.uniform_Variable (named => fade_uniform_Name);
|
Uniforms.Textures (Id). fade_Uniform := for_Program.uniform_Variable (Named => fade_uniform_Name);
|
||||||
|
Uniforms.Textures (Id).texture_applied_Uniform := for_Program.uniform_Variable (Named => texture_applies_uniform_Name);
|
||||||
end;
|
end;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
@@ -106,7 +109,6 @@ is
|
|||||||
--- Mixin ---
|
--- Mixin ---
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
-- generic
|
|
||||||
package body Mixin
|
package body Mixin
|
||||||
is
|
is
|
||||||
use openGL.texture_Set;
|
use openGL.texture_Set;
|
||||||
@@ -127,7 +129,7 @@ is
|
|||||||
Which : in texture_Set.texture_ID := 1)
|
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;
|
||||||
end Fade_is;
|
end Fade_is;
|
||||||
|
|
||||||
|
|
||||||
@@ -163,23 +165,22 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- overriding
|
overriding
|
||||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
|
||||||
-- is
|
Which : in texture_Set.texture_ID := 1)
|
||||||
-- begin
|
is
|
||||||
-- Texture_is (in_Set => Self.texture_Set,
|
begin
|
||||||
-- Now => Now);
|
Self.texture_Set.Textures (Which).Applied := Now;
|
||||||
-- end Texture_is;
|
end texture_Applied_is;
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- overriding
|
overriding
|
||||||
-- function Texture (Self : in Item) return openGL.Texture.Object
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
|
||||||
-- is
|
is
|
||||||
-- begin
|
begin
|
||||||
-- return texture_Set.Texture (in_Set => Self.texture_Set,
|
return Self.texture_Set.Textures (which).Applied;
|
||||||
-- Which => 1);
|
end texture_Applied;
|
||||||
-- end Texture;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -20,8 +20,9 @@ is
|
|||||||
|
|
||||||
type texture_fade_Uniform_pair is
|
type texture_fade_Uniform_pair is
|
||||||
record
|
record
|
||||||
texture_Uniform : openGL.Variable.uniform.sampler2D;
|
texture_Uniform : openGL.Variable.uniform.sampler2D;
|
||||||
fade_Uniform : openGL.Variable.uniform.float;
|
fade_Uniform : openGL.Variable.uniform.float;
|
||||||
|
texture_applied_Uniform : openGL.Variable.uniform.bool;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
@@ -78,11 +79,13 @@ is
|
|||||||
overriding
|
overriding
|
||||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) 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
|
||||||
--
|
procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
|
||||||
-- overriding
|
Which : in texture_Set.texture_ID := 1);
|
||||||
-- function Texture (Self : in Item) return openGL.Texture.Object;
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
|
|||||||
@@ -118,15 +118,6 @@ 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; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object
|
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
@@ -136,6 +127,15 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
raise program_Error with "Geometry has no texture.";
|
||||||
|
return False;
|
||||||
|
end texture_Applied;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure Program_is (Self : in out Item; Now : in openGL.Program.view)
|
procedure Program_is (Self : in out Item; Now : in openGL.Program.view)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
|
|||||||
@@ -62,8 +62,9 @@ is
|
|||||||
Which : in texture_Set.texture_ID := 1) is null;
|
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;
|
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_Applied_is (Self : in out Item; Now : in Boolean;
|
||||||
-- function Texture (Self : in Item) return openGL.Texture.Object;
|
Which : in texture_Set.texture_ID := 1) is null;
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -72,6 +72,24 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
return Self.Face.texture_Applies (Which);
|
||||||
|
end texture_Applied;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
|
Now : in Boolean)
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
Self.Face.texture_Applies (Which) := Now;
|
||||||
|
end texture_Applied_is;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
--- openGL Geometries
|
--- openGL Geometries
|
||||||
|
|||||||
@@ -14,9 +14,10 @@ is
|
|||||||
|
|
||||||
type Face is
|
type Face is
|
||||||
record
|
record
|
||||||
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
|
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
|
||||||
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
|
texture_Applies : texture_Set.texture_Apply_array := [others => True];
|
||||||
texture_Count : Natural := 0;
|
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
|
||||||
|
texture_Count : Natural := 0;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
@@ -55,6 +56,13 @@ is
|
|||||||
function texture_Count (Self : in Item) return Natural;
|
function texture_Count (Self : in Item) return Natural;
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean;
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
|
Now : in Boolean);
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
|
|||||||
@@ -37,7 +37,7 @@ is
|
|||||||
Now : in texture_Set.fade_Level)
|
Now : in texture_Set.fade_Level)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
Self.Face.Fades (which) := Now;
|
Self.Face.Fades (Which) := Now;
|
||||||
end Fade_is;
|
end Fade_is;
|
||||||
|
|
||||||
|
|
||||||
@@ -46,7 +46,7 @@ is
|
|||||||
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) return texture_Set.fade_Level
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return Self.Face.Fades (which);
|
return Self.Face.Fades (Which);
|
||||||
end Fade;
|
end Fade;
|
||||||
|
|
||||||
|
|
||||||
@@ -55,7 +55,7 @@ is
|
|||||||
Now : in openGL.asset_Name)
|
Now : in openGL.asset_Name)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
Self.Face.Textures (Positive (which)) := Now;
|
Self.Face.Textures (Positive (Which)) := Now;
|
||||||
end Texture_is;
|
end Texture_is;
|
||||||
|
|
||||||
|
|
||||||
@@ -71,6 +71,26 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
return Self.Face.texture_Applies (Which);
|
||||||
|
end texture_Applied;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
|
Now : in Boolean)
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
Self.Face.texture_Applies (Which) := Now;
|
||||||
|
end texture_Applied_is;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
|
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
|
||||||
Fonts : in Font.font_id_Map_of_font) return Geometry.views
|
Fonts : in Font.font_id_Map_of_font) return Geometry.views
|
||||||
|
|||||||
@@ -14,9 +14,10 @@ is
|
|||||||
|
|
||||||
type Face is
|
type Face is
|
||||||
record
|
record
|
||||||
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
|
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
|
||||||
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
|
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
|
||||||
texture_Count : Natural := 0;
|
texture_Count : Natural := 0;
|
||||||
|
texture_Applies : texture_Set.texture_Apply_array := [others => True];
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
@@ -54,6 +55,13 @@ is
|
|||||||
function texture_Count (Self : in Item) return Natural;
|
function texture_Count (Self : in Item) return Natural;
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean;
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
|
Now : in Boolean);
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
|
|||||||
@@ -6,7 +6,7 @@ is
|
|||||||
use linear_Algebra_3d;
|
use linear_Algebra_3d;
|
||||||
|
|
||||||
the_Site : Vector_3 := [Radius, 0.0, 0.0];
|
the_Site : Vector_3 := [Radius, 0.0, 0.0];
|
||||||
Rotation : constant Matrix_3x3 := y_Rotation_from (to_Radians (60.0));
|
Rotation : constant Matrix_3x3 := z_Rotation_from (to_Radians (60.0));
|
||||||
|
|
||||||
the_Sites : Sites;
|
the_Sites : Sites;
|
||||||
|
|
||||||
|
|||||||
@@ -73,6 +73,30 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
return Self.Face.texture_Applies (Which);
|
||||||
|
end texture_Applied;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
|
Now : in Boolean)
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
Self.Face.texture_Applies (Which) := Now;
|
||||||
|
end texture_Applied_is;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
--------------------
|
||||||
|
--- to_GL_Geometries
|
||||||
|
--
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
|
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
|
||||||
|
|||||||
@@ -14,10 +14,11 @@ is
|
|||||||
|
|
||||||
type Face is
|
type Face is
|
||||||
record
|
record
|
||||||
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
|
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
|
||||||
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
|
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
|
||||||
texture_Count : Natural := 0;
|
texture_Count : Natural := 0;
|
||||||
texture_Tiling : openGL.Real := 1.0; -- The number of times the texture should be wrapped.
|
texture_Tiling : openGL.Real := 1.0; -- The number of times the texture should be wrapped.
|
||||||
|
texture_Applies : texture_Set.texture_Apply_array := [others => True];
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
@@ -55,6 +56,13 @@ is
|
|||||||
function texture_Count (Self : in Item) return Natural;
|
function texture_Count (Self : in Item) return Natural;
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean;
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
|
Now : in Boolean);
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
|
|||||||
@@ -46,10 +46,10 @@ is
|
|||||||
|
|
||||||
overriding
|
overriding
|
||||||
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
Now : in texture_Set.fade_Level);
|
Now : in texture_Set.fade_Level);
|
||||||
|
|
||||||
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
Now : in asset_Name);
|
Now : in asset_Name);
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
function texture_Count (Self : in Item) return Natural;
|
function texture_Count (Self : in Item) return Natural;
|
||||||
|
|||||||
@@ -127,7 +127,7 @@ is
|
|||||||
Which : in texture_Set.texture_ID := 1)
|
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;
|
||||||
end Fade_is;
|
end Fade_is;
|
||||||
|
|
||||||
|
|
||||||
@@ -136,7 +136,7 @@ is
|
|||||||
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 := 1) return texture_Set.fade_Level
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return Self.texture_Set.Textures (which).Fade;
|
return Self.texture_Set.Textures (Which).Fade;
|
||||||
end Fade;
|
end Fade;
|
||||||
|
|
||||||
|
|
||||||
@@ -163,23 +163,22 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- overriding
|
overriding
|
||||||
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
|
procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
|
||||||
-- is
|
Which : in texture_Set.texture_ID := 1)
|
||||||
-- begin
|
is
|
||||||
-- Texture_is (in_Set => Self.texture_Set,
|
begin
|
||||||
-- Now => Now);
|
Self.texture_Set.Textures (Which).Applied := Now;
|
||||||
-- end Texture_is;
|
end texture_Applied_is;
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- overriding
|
overriding
|
||||||
-- function Texture (Self : in Item) return openGL.Texture.Object
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
|
||||||
-- is
|
is
|
||||||
-- begin
|
begin
|
||||||
-- return texture_Set.Texture (in_Set => Self.texture_Set,
|
return Self.texture_Set.Textures (Which).Applied;
|
||||||
-- Which => 1);
|
end texture_Applied;
|
||||||
-- end Texture;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -187,8 +186,6 @@ is
|
|||||||
procedure enable_Textures (Self : in out Item)
|
procedure enable_Textures (Self : in out Item)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
-- ada.Text_IO.put_Line (Self.Model'Image);
|
|
||||||
|
|
||||||
texturing.enable (for_Model => Self.Model.all'Access,
|
texturing.enable (for_Model => Self.Model.all'Access,
|
||||||
Uniforms => texture_Uniforms,
|
Uniforms => texture_Uniforms,
|
||||||
texture_Set => Self.texture_Set);
|
texture_Set => Self.texture_Set);
|
||||||
|
|||||||
@@ -69,7 +69,7 @@ is
|
|||||||
procedure Fade_is (Self : in out Item; 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);
|
Which : in texture_Set.texture_ID := 1);
|
||||||
overriding
|
overriding
|
||||||
function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level;
|
function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level;
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
@@ -78,17 +78,19 @@ is
|
|||||||
overriding
|
overriding
|
||||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) 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
|
||||||
--
|
procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
|
||||||
-- overriding
|
Which : in texture_Set.texture_ID := 1);
|
||||||
-- function Texture (Self : in Item) return openGL.Texture.Object;
|
overriding
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
procedure enable_Textures (Self : in out Item);
|
procedure enable_Textures (Self : in out Item);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Geometry.item with
|
type Item is new Geometry.item with
|
||||||
|
|||||||
@@ -218,8 +218,8 @@ is
|
|||||||
-- Texturing
|
-- Texturing
|
||||||
--
|
--
|
||||||
|
|
||||||
procedure Fade_is (Self : in out Item; which : in texture_Set.texture_Id;
|
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
now : in texture_Set.fade_Level)
|
Now : in texture_Set.fade_Level)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
raise program_Error with "Model does not support texturing.";
|
raise program_Error with "Model does not support texturing.";
|
||||||
@@ -227,7 +227,7 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
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) return texture_Set.fade_Level
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
raise program_Error with "Model does not support texturing.";
|
raise program_Error with "Model does not support texturing.";
|
||||||
@@ -245,40 +245,21 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
raise program_Error with "Model does not support texturing.";
|
||||||
|
return False;
|
||||||
|
end texture_Applied;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level)
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
-- is
|
Now : in Boolean)
|
||||||
-- begin
|
is
|
||||||
-- raise program_Error with "Model does not support texturing.";
|
begin
|
||||||
-- end Fade_1_is;
|
raise program_Error with "Model does not support texturing.";
|
||||||
--
|
end texture_applied_is;
|
||||||
--
|
|
||||||
--
|
|
||||||
-- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level)
|
|
||||||
-- is
|
|
||||||
-- begin
|
|
||||||
-- raise program_Error with "Model does not support texturing.";
|
|
||||||
-- end Fade_2_is;
|
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level
|
|
||||||
-- is
|
|
||||||
-- begin
|
|
||||||
-- raise program_Error with "Model does not support texturing.";
|
|
||||||
-- return 0.0;
|
|
||||||
-- end Fade_1;
|
|
||||||
--
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level
|
|
||||||
-- is
|
|
||||||
-- begin
|
|
||||||
-- raise program_Error with "Model does not support texturing.";
|
|
||||||
-- return 0.0;
|
|
||||||
-- end Fade_2;
|
|
||||||
|
|
||||||
|
|
||||||
end openGL.Model;
|
end openGL.Model;
|
||||||
|
|||||||
@@ -80,12 +80,9 @@ is
|
|||||||
|
|
||||||
function texture_Count (Self : in Item) return Natural;
|
function texture_Count (Self : in Item) return Natural;
|
||||||
|
|
||||||
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean;
|
||||||
-- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level);
|
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
-- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level);
|
Now : in Boolean);
|
||||||
--
|
|
||||||
-- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level;
|
|
||||||
-- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -15,10 +15,7 @@ is
|
|||||||
procedure Texture_is (in_Set : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
|
procedure Texture_is (in_Set : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
in_Set.Textures (Which) := (0.0,
|
in_Set.Textures (Which).Object := Now;
|
||||||
Now); --,
|
|
||||||
-- texture_Uniform => <>,
|
|
||||||
-- fade_Uniform => <>);
|
|
||||||
|
|
||||||
in_Set.is_Transparent := in_Set.is_Transparent
|
in_Set.is_Transparent := in_Set.is_Transparent
|
||||||
or Now .is_Transparent;
|
or Now .is_Transparent;
|
||||||
|
|||||||
@@ -24,10 +24,14 @@ is
|
|||||||
type fade_Levels is array (texture_Id range <>) of fade_Level;
|
type fade_Levels is array (texture_Id range <>) of fade_Level;
|
||||||
|
|
||||||
|
|
||||||
|
type texture_Apply_array is array (texture_Set.texture_Id) of Boolean;
|
||||||
|
|
||||||
|
|
||||||
type fadeable_Texture is
|
type fadeable_Texture is
|
||||||
record
|
record
|
||||||
Fade : fade_Level := 0.0;
|
Fade : fade_Level := 0.0;
|
||||||
Object : openGL.Texture.Object := openGL.Texture.null_Object;
|
Object : openGL.Texture.Object := openGL.Texture.null_Object;
|
||||||
|
Applied : Boolean := True; -- Whether this texture is painted on.
|
||||||
-- texture_Uniform : openGL.Variable.uniform.sampler2D;
|
-- texture_Uniform : openGL.Variable.uniform.sampler2D;
|
||||||
-- fade_Uniform : openGL.Variable.uniform.float;
|
-- fade_Uniform : openGL.Variable.uniform.float;
|
||||||
end record;
|
end record;
|
||||||
|
|||||||
@@ -163,9 +163,10 @@ is
|
|||||||
|
|
||||||
else
|
else
|
||||||
the_graphics_Model := openGL.Model.circle.lit_textured.new_Circle (Radius,
|
the_graphics_Model := openGL.Model.circle.lit_textured.new_Circle (Radius,
|
||||||
Face => (Fades => [1 => 0.0, others => <>],
|
Face => (Fades => [1 => 0.0, others => <>],
|
||||||
Textures => [1 => Texture, others => <>],
|
texture_Applies => [1 => True, others => <>],
|
||||||
texture_Count => 1)).all'Access;
|
Textures => [1 => Texture, others => <>],
|
||||||
|
texture_Count => 1)).all'Access;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
return gel.Sprite.Forge.new_Sprite (Name,
|
return gel.Sprite.Forge.new_Sprite (Name,
|
||||||
@@ -220,10 +221,11 @@ is
|
|||||||
(Color, openGL.Opaque)).all'Access;
|
(Color, openGL.Opaque)).all'Access;
|
||||||
else
|
else
|
||||||
the_graphics_Model := openGL.Model.polygon.lit_textured.new_Polygon (openGL.Vector_2_array (Vertices),
|
the_graphics_Model := openGL.Model.polygon.lit_textured.new_Polygon (openGL.Vector_2_array (Vertices),
|
||||||
Face => (Fades => [1 => 0.0, others => <>],
|
Face => (Fades => [1 => 0.0, others => <>],
|
||||||
Textures => [1 => Texture, others => <>],
|
Textures => [1 => Texture, others => <>],
|
||||||
texture_Count => 1,
|
texture_Count => 1,
|
||||||
texture_Tiling => texture_Tiling)).all'Access;
|
texture_Tiling => texture_Tiling,
|
||||||
|
texture_Applies => [others => <>])).all'Access;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
return gel.Sprite.Forge.new_Sprite (Name,
|
return gel.Sprite.Forge.new_Sprite (Name,
|
||||||
|
|||||||
Reference in New Issue
Block a user