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

opengl: Rename 'openGL.Geometry.texturing' to 'openGL.texturing'.

Browse Source
This commit is contained in:
Rod Kay
2023-05-16 17:17:28 +10:00
parent 65ac65b204
commit 640c3f4790
15 changed files with 312 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -18,7 +18,8 @@ with
package body openGL.Geometry.lit_colored_textured
is
use GL.lean,
use openGL.texturing,
GL.lean,
GL.Pointers,
Interfaces,
System;
@@ -280,14 +281,14 @@ is
--- Texturing
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level)
procedure Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level)
is
begin
Self.Textures.Textures (Which).Fade := Now;
end Fade_is;
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level
is
begin
return Self.Textures.Textures (Which).Fade;
@@ -299,7 +300,6 @@ is
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
@@ -311,8 +311,8 @@ is
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => Which);
return openGL.texturing.Texture (in_Set => Self.Textures,
which => Which);
end Texture;
@@ -320,7 +320,6 @@ is
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
@@ -331,8 +330,8 @@ is
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => 1);
return openGL.texturing.Texture (in_Set => Self.Textures,
which => 1);
end Texture;
@@ -340,7 +339,6 @@ is
overriding
procedure enable_Texture (Self : in out Item)
is
use openGL.Geometry.texturing;
begin
enable (Self.Textures, Self.Program);
end enable_Texture;

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

@@ -1,5 +1,5 @@
with
openGL.Geometry.texturing;
openGL.texturing;
package openGL.Geometry.lit_colored_textured
@@ -42,12 +42,12 @@ is
--- Texturing.
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level);
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level;
procedure Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level);
function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object;
procedure Texture_is (Self : in out Item; Which : texturing.texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texturing.texture_ID) return openGL.Texture.Object;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
@@ -61,7 +61,7 @@ private
type Item is new Geometry.item with
record
Textures : Geometry.texturing.texture_Set;
Textures : texturing.texture_Set;
end record;

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

@@ -25,6 +25,7 @@ package body openGL.Geometry.lit_textured
is
use GL.lean,
GL.Pointers,
openGL.texturing,
Interfaces;
-----------
@@ -304,7 +305,7 @@ is
--- Texturing
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level)
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in texturing.fade_Level)
is
begin
Self.Textures.Textures (which).Fade := Now;
@@ -312,7 +313,7 @@ is
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level
is
begin
return Self.Textures.Textures (which).Fade;
@@ -322,7 +323,6 @@ is
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
@@ -334,7 +334,7 @@ is
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
return openGL.texturing.Texture (in_Set => Self.Textures,
Which => Which);
end Texture;
@@ -343,7 +343,6 @@ is
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
@@ -355,7 +354,7 @@ is
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
return texturing.Texture (in_Set => Self.Textures,
Which => 1);
end Texture;

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

@@ -1,5 +1,5 @@
with
openGL.Geometry.texturing;
openGL.texturing;
package openGL.Geometry.lit_textured
@@ -45,12 +45,12 @@ is
--- Texturing.
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level);
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level;
procedure Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level);
function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object;
procedure Texture_is (Self : in out Item; Which : texturing.texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texturing.texture_ID) return openGL.Texture.Object;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
@@ -64,7 +64,7 @@ private
type Item is new Geometry.item with
record
Textures : Geometry.texturing.texture_Set;
Textures : texturing.texture_Set;
end record;

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

@@ -19,6 +19,8 @@ is
use GL.lean,
GL.Pointers,
openGL.texturing,
Interfaces,
System;
@@ -167,7 +169,7 @@ is
--- Texturing
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level)
procedure Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level)
is
begin
Self.Textures.Textures (Which).Fade := Now;
@@ -175,7 +177,7 @@ is
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level
is
begin
return Self.Textures.Textures (Which).Fade;
@@ -185,7 +187,6 @@ is
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
@@ -197,7 +198,7 @@ is
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
return openGL.texturing.Texture (in_Set => Self.Textures,
Which => Which);
end Texture;
@@ -206,7 +207,6 @@ is
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
@@ -218,8 +218,8 @@ is
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => 1);
return openGL.texturing.Texture (in_Set => Self.Textures,
which => 1);
end Texture;
@@ -227,7 +227,6 @@ is
overriding
procedure enable_Texture (Self : in out Item)
is
use openGL.Geometry.texturing;
begin
enable (Self.Textures, Self.Program);
end enable_Texture;

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

@@ -1,5 +1,5 @@
with
openGL.Geometry.texturing;
openGL.texturing;
package openGL.Geometry.textured
@@ -42,12 +42,12 @@ is
--- Texturing.
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level);
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level;
procedure Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level);
function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object;
procedure Texture_is (Self : in out Item; Which : texturing.texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texturing.texture_ID) return openGL.Texture.Object;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
@@ -61,7 +61,7 @@ private
type Item is new Geometry.item with
record
Textures : Geometry.texturing.texture_Set;
Textures : texturing.texture_Set;
end record;

0
3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb → 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).adb-1
View File

0
3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads → 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).ads-1
View File

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

@@ -2,7 +2,8 @@ with
openGL.Primitive,
openGL.Buffer,
openGL.Program,
openGL.Texture;
openGL.Texture,
openGL.texturing;
limited
with
@@ -51,11 +52,11 @@ is
max_Textures : constant := 32;
type texture_Id is range 1 .. max_Textures;
-- max_Textures : constant := 32;
--
-- type texture_Id is range 1 .. max_Textures;
--
--
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null;
function Texture (Self : in Item) return openGL.Texture.Object;
@@ -102,7 +103,7 @@ is
private
use ada.Strings.unbounded;
type Textures is array (texture_Id) of openGL.Texture.Object;
type Textures is array (texturing.texture_Id) of openGL.Texture.Object;
type Item is abstract tagged limited

13
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb
View File

@@ -33,8 +33,8 @@ is
--
overriding
procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level)
procedure Fade_is (Self : in out Item; Which : in texturing.texture_Id;
Now : in texturing.fade_Level)
is
begin
Self.Face.Fades (which) := Now;
@@ -43,7 +43,7 @@ is
overriding
function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level
function Fade (Self : in Item; Which : in texturing.texture_Id) return texturing.fade_Level
is
begin
return Self.Face.Fades (which);
@@ -51,7 +51,7 @@ is
procedure Texture_is (Self : in out Item; Which : in Geometry.texture_Id;
procedure Texture_is (Self : in out Item; Which : in texturing.texture_Id;
Now : in openGL.asset_Name)
is
begin
@@ -87,7 +87,8 @@ is
function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
is
use Primitive;
use Primitive,
texturing;
the_Geometry : constant Geometry.lit_textured.view
:= Geometry.lit_textured.new_Geometry;
@@ -95,7 +96,7 @@ is
the_Primitive : constant Primitive.indexed.view
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
Id : texture_Id;
Id : texturing.texture_Id;
begin
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));

16
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads
View File

@@ -1,5 +1,5 @@
with
openGL.Geometry.texturing,
openGL.texturing,
openGL.Texture;
@@ -14,8 +14,8 @@ is
type Face is
record
Fades : Geometry.texturing.fade_Levels (Geometry.texture_Id) := [others => 0.0];
Textures : openGL.asset_Names (1 .. Positive (Geometry.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
Fades : texturing.fade_Levels (texturing.texture_Id) := [others => 0.0];
Textures : openGL.asset_Names (1 .. Positive (texturing.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
texture_Count : Natural := 0;
end record;
@@ -41,14 +41,14 @@ is
--
overriding
function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level;
function Fade (Self : in Item; Which : in texturing.texture_Id) return texturing.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level);
procedure Fade_is (Self : in out Item; Which : in texturing.texture_Id;
Now : in texturing.fade_Level);
procedure Texture_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in openGL.asset_Name);
procedure Texture_is (Self : in out Item; Which : in texturing.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;

6
3-mid/opengl/source/lean/model/opengl-model.adb
View File

@@ -218,8 +218,8 @@ is
-- Texturing
--
procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level)
procedure Fade_is (Self : in out Item; which : in texturing.texture_Id;
now : in texturing.fade_Level)
is
begin
raise program_Error with "Model does not support texturing.";
@@ -227,7 +227,7 @@ is
function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level
function Fade (Self : in Item; which : in texturing.texture_Id) return texturing.fade_Level
is
begin
raise program_Error with "Model does not support texturing.";

9
3-mid/opengl/source/lean/model/opengl-model.ads
View File

@@ -2,7 +2,8 @@ with
openGL.remote_Model,
openGL.Font,
openGL.Texture,
openGL.Geometry.texturing;
openGL.Geometry,
openGL.texturing;
package openGL.Model
@@ -73,9 +74,9 @@ is
-- Texturing
--
function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level;
procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level);
function Fade (Self : in Item; Which : in texturing.texture_Id) return texturing.fade_Level;
procedure Fade_is (Self : in out Item; Which : in texturing.texture_Id;
Now : in texturing.fade_Level);
function texture_Count (Self : in Item) return Natural;

186
3-mid/opengl/source/lean/opengl-texturing.adb Normal file
View File

@@ -0,0 +1,186 @@
with
openGL.Tasks,
GL.Binding,
GL.lean,
ada.Strings.fixed;
with ada.Text_IO; use ada.Text_IO;
package body openGL.texturing
is
procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object)
is
begin
in_Set.Textures (Which) := (0.0,
Now,
texture_Uniform => <>,
fade_Uniform => <>);
in_Set.is_Transparent := in_Set.is_Transparent
or Now .is_Transparent;
if Natural (Which) > in_Set.Count
then
in_Set.Count := Natural (Which);
end if;
end Texture_is;
function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object
is
begin
return in_Set.Textures (Which).Object;
end Texture;
function Texture (in_Set : in texture_Set) return openGL.Texture.Object
is
begin
return in_Set.Textures (1).Object;
end Texture;
procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object)
is
begin
in_Set.Textures (1).Object := Now;
in_Set.is_Transparent := in_Set.is_Transparent
or Now .is_Transparent;
if in_Set.Count = 0
then
in_Set.Count := 1;
end if;
end Texture_is;
procedure enable (the_Textures : in out texture_Set;
Program : in openGL.Program.view)
is
use GL,
GL.Binding,
openGL.Texture;
begin
Tasks.check;
if not the_Textures.initialised
then
for i in 1 .. the_Textures.Count
loop
declare
use ada.Strings,
ada.Strings.fixed;
Id : constant texture_Id := texture_Id (i);
begin
null;
declare
uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]";
begin
the_Textures.Textures (Id).texture_Uniform := Program.uniform_Variable (Named => uniform_Name);
end;
-- declare
-- uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]";
-- begin
-- the_Textures.Textures (Id).fade_Uniform := Program.uniform_Variable (Named => uniform_Name);
-- end;
end;
end loop;
the_Textures.Initialised := True;
end if;
for i in 1 .. the_Textures.Count
loop
declare
use GL.lean;
use type GL.GLint;
type texture_Units is array (texture_Id) of GLenum;
all_texture_Units : constant texture_Units := (GL_TEXTURE0,
GL_TEXTURE1,
GL_TEXTURE2,
GL_TEXTURE3,
GL_TEXTURE4,
GL_TEXTURE5,
GL_TEXTURE6,
GL_TEXTURE7,
GL_TEXTURE8,
GL_TEXTURE9,
GL_TEXTURE10,
GL_TEXTURE11,
GL_TEXTURE12,
GL_TEXTURE13,
GL_TEXTURE14,
GL_TEXTURE15,
GL_TEXTURE16,
GL_TEXTURE17,
GL_TEXTURE18,
GL_TEXTURE19,
GL_TEXTURE20,
GL_TEXTURE21,
GL_TEXTURE22,
GL_TEXTURE23,
GL_TEXTURE24,
GL_TEXTURE25,
GL_TEXTURE26,
GL_TEXTURE27,
GL_TEXTURE28,
GL_TEXTURE29,
GL_TEXTURE30,
GL_TEXTURE31);
Id : constant texture_Id := texture_Id (i);
begin
null;
glUniform1i (the_Textures.Textures (Id).texture_Uniform.gl_Variable,
GLint (i) - 1);
glActiveTexture (all_texture_Units (Id));
glBindTexture (GL_TEXTURE_2D,
the_Textures.Textures (Id).Object.Name);
end;
-- declare
-- use ada.Strings,
-- ada.Strings.fixed;
--
-- uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]";
-- Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name);
-- Id : constant texture_Id := texture_Id (i);
-- begin
-- -- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image);
--
-- -- the_Textures.Textures (Id).fade_Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade));
-- -- Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade));
-- null;
-- end;
end loop;
-- declare
-- the_texture_count_Uniform : constant openGL.Variable.uniform.int := Program.uniform_Variable ("texture_Count");
-- begin
-- the_texture_count_Uniform.Value_is (the_Textures.Count);
-- end;
end enable;
end openGL.texturing;

54
3-mid/opengl/source/lean/opengl-texturing.ads Normal file
View File

@@ -0,0 +1,54 @@
with
openGL.Program,
openGL.Texture,
openGL.Variable.uniform;
package openGL.texturing
--
-- Facilitates texturing of geometries.
--
is
max_Textures : constant := 32;
type texture_Id is range 1 .. max_Textures;
type fade_Level is delta 0.001 range 0.0 .. 1.0 -- '0.0' is no fading, '1.0' is fully faded (ie invisible).
with Atomic;
type fade_Levels is array (texture_Id range <>) of fade_Level;
type fadeable_Texture is
record
Fade : fade_Level := 0.0;
Object : openGL.Texture.Object := openGL.Texture.null_Object;
texture_Uniform : openGL.Variable.uniform.sampler2D;
fade_Uniform : openGL.Variable.uniform.float;
end record;
type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;
type texture_Set is
record
Textures : fadeable_Textures;
Count : Natural := 0;
is_Transparent : Boolean := False; -- Any of the textures contains lucid colors.
initialised : Boolean := False;
end record;
procedure enable (the_Textures : in out texture_Set;
Program : in openGL.Program.view);
procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object;
procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object);
function Texture (in_Set : in texture_Set) return openGL.Texture.Object;
end openGL.texturing;