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

opengl.geometry: Add/use texturing support.

Browse Source
This commit is contained in:
Rod Kay
2023-05-05 03:13:07 +10:00
parent b9064c43c8
commit 2ac6d57a53
7 changed files with 254 additions and 357 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -267,14 +267,14 @@ is
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in fade_Level)
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level)
is
begin
Self.Textures.Textures (Which).Fade := Now;
end Fade_is;
function Fade (Self : in Item; Which : texture_ID) return fade_Level
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
is
begin
return Self.Textures.Textures (Which).Fade;
@@ -284,8 +284,9 @@ is
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
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
@@ -294,29 +295,31 @@ 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
begin
return Texture (in_Set => Self.Textures,
Which => Which);
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => Which);
end Texture;
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
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
end Texture_is;
overriding
function Texture (Self : in Item) return openGL.Texture.Object
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return Texture (in_Set => Self.Textures,
Which => 1);
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => 1);
end Texture;
@@ -324,80 +327,9 @@ is
overriding
procedure enable_Texture (Self : in out Item)
is
-- check_is_OK : constant Boolean := openGL.Tasks.Check
-- with unreferenced;
use openGL.Geometry.texturing;
begin
enable (Self.Textures, Self.Program);
-- Tasks.check;
-- for i in 1 .. Self.Textures.Count
-- loop
-- declare
-- use ada.Strings,
-- ada.Strings.fixed;
--
-- use type GL.GLint;
--
-- -- "bone_Matrices[" & Trim (Integer'Image (i - 1), Left) & "]");
--
-- 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);
--
-- uniform_Name : aliased C.char_array := C.to_C ("Textures[" & Trim (Integer'Image (i - 1), Left) & "]");
-- uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access);
-- loc : constant GL.GLint := glGetUniformLocation (Self.Program.gl_Program, +uniform_Name_ptr);
-- begin
-- -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image);
--
-- glUniform1i (loc,
-- GLint (i) - 1);
--
-- glActiveTexture (all_texture_Units (texture_Id (i)));
-- glBindTexture (GL_TEXTURE_2D,
-- Self.Textures.Textures (texture_Id (i)).Object.Name);
-- end;
--
--
-- declare
-- the_texture_count_Uniform : constant openGL.Variable.uniform.int := Self.Program.uniform_Variable ("texture_Count");
-- begin
-- the_texture_count_Uniform.Value_is (Self.Textures.Count);
-- end;
-- end loop;
end enable_Texture;

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

@@ -1,3 +1,7 @@
with
openGL.Geometry.texturing;
package openGL.Geometry.lit_textured_x2
--
-- Supports per-vertex site texture and lighting.
@@ -37,8 +41,8 @@ is
procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive);
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in fade_Level);
function Fade (Self : in Item; Which : texture_ID) return fade_Level;
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 Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object);
@@ -56,7 +60,7 @@ private
type Item is new Geometry.item with
record
Textures : texture_Set;
Textures : Geometry.texturing.texture_Set;
end record;

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

@@ -0,0 +1,172 @@
with
openGL.Tasks,
GL.Binding,
GL.lean,
ada.Strings.fixed;
package body openGL.Geometry.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,
textures_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
declare
uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]";
begin
the_Textures.Textures (Id).textures_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
glUniform1i (the_Textures.Textures (Id).textures_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);
begin
Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade));
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.Geometry.texturing;

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

@@ -0,0 +1,45 @@
with
openGL.Program,
openGL.Texture,
openGL.Variable.uniform;
package openGL.Geometry.texturing
--
-- Facilitates texturing of geometries.
--
is
type fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible).
type fadeable_Texture is
record
Fade : fade_Level := 0.0;
Object : openGL.Texture.Object := openGL.Texture.null_Object;
textures_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.Geometry.texturing;

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

@@ -1,12 +1,6 @@
with
openGL.Primitive.indexed,
openGL.Primitive.long_indexed,
openGL.Tasks,
GL.Binding,
GL.lean,
ada.Strings.fixed,
ada.unchecked_Deallocation;
@@ -50,6 +44,8 @@ is
end free_Primitives;
--------------
-- Attributes
--
@@ -98,34 +94,6 @@ is
-- procedure Texture_is (Self : in out Item'Class; Which : texture_ID; Now : in openGL.Texture.Object)
-- is
-- begin
-- Self.Textures.Textures (Which) := (0.0, Now);
-- Self.is_Transparent := Self.is_Transparent
-- or Now .is_Transparent;
--
-- if Natural (Which) > Self.Textures.Count
-- then
-- Self.Textures.Count := Natural (Which);
-- end if;
-- end Texture_is;
--
--
-- function Texture (Self : in Item'Class; Which : texture_ID) return openGL.Texture.Object
-- is
-- begin
-- return Self.Textures.Textures (Which).Object;
-- end Texture;
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
@@ -134,71 +102,6 @@ is
end Texture;
-- procedure Texture_is (Self : in out Item'Class; Now : in openGL.Texture.Object)
-- is
-- begin
-- Self.Textures.Textures (1).Object := Now;
-- Self.is_Transparent := Self.is_Transparent
-- or Now .is_Transparent;
--
-- if Self.Textures.Count = 0
-- then
-- Self.Textures.Count := 1;
-- end if;
-- end Texture_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,
textures_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 Program_is (Self : in out Item; Now : in openGL.Program.view)
is
@@ -249,6 +152,8 @@ is
end is_Transparent;
--------------
-- Operations
--
@@ -282,6 +187,8 @@ is
end render;
-----------
-- Normals
--
@@ -442,6 +349,8 @@ is
pragma Unreferenced (Facets_of);
-----------
-- Normals
--
@@ -561,129 +470,6 @@ is
-----------
-- Textures
--
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
declare
uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]";
begin
the_Textures.Textures (Id).textures_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
-- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image);
glUniform1i (the_Textures.Textures (Id).textures_Uniform.gl_Variable, -- loc,
GLint (i) - 1);
-- glUniform1i (the_Textures.Textures (Id).textures_uniform_Location, -- loc,
-- 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);
begin
Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade));
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;
---------
-- Bounds
--
@@ -706,6 +492,8 @@ is
end get_Bounds;
---------------
-- Transparency
--

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

@@ -2,8 +2,7 @@ with
openGL.Primitive,
openGL.Buffer,
openGL.Program,
openGL.Texture,
openGL.Variable.uniform;
openGL.Texture;
private
@@ -49,52 +48,9 @@ is
type texture_Id is range 1 .. max_Textures;
-- procedure Texture_is (Self : in out Item'Class; Which : texture_ID; Now : in Texture.Object);
-- function Texture (Self : in Item'Class; Which : texture_ID) return 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;
-- *************************************************************************
-- TODO: Move all texture code to a new 'openGL.Geometry.texturing' package.
type fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible).
type fadeable_Texture is
record
Fade : fade_Level := 0.0;
Object : openGL.Texture.Object := openGL.Texture.null_Object;
textures_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;
procedure Bounds_are (Self : in out Item'Class; Now : in Bounds);
function Bounds (self : in Item'Class) return Bounds; -- Returns the bounds in object space.

10
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads
View File

@@ -1,5 +1,5 @@
with
openGL.Geometry,
openGL.Geometry.texturing,
openGL.Texture;
@@ -13,10 +13,10 @@ is
type Face is
record
Texture_1 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex.
Texture_2 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex.
Fade_1 : openGL.Geometry.fade_Level := 0.5;
Fade_2 : openGL.Geometry.fade_Level := 0.5;
Texture_1 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex.
Texture_2 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex.
Fade_1 : openGL.Geometry.texturing.fade_Level := 0.5;
Fade_2 : openGL.Geometry.texturing.fade_Level := 0.5;
end record;