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

opengl: Work on multi-texturing.

Browse Source
This commit is contained in:
Rod Kay
2023-05-15 15:01:32 +10:00
parent 1beb8e1140
commit 139cb01643
12 changed files with 405 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb
View File

@@ -95,6 +95,9 @@ begin
if Epoch mod 20 = 0 if Epoch mod 20 = 0
then then
-- the_textured_hexagon_Model.Fade_is (which => 1, now => Fade);
-- the_textured_hexagon_Model.Fade_is (which => 2, now => 1.0 - Fade);
the_textured_hexagon_Model.Fade_1_is (Fade); the_textured_hexagon_Model.Fade_1_is (Fade);
the_textured_hexagon_Model.Fade_2_is (1.0 - Fade); the_textured_hexagon_Model.Fade_2_is (1.0 - Fade);
-- the_textured_hexagon_Model.needs_Rebuild; -- the_textured_hexagon_Model.needs_Rebuild;

4
3-mid/opengl/source/demo/opengl-demo.adb
View File

@@ -186,7 +186,9 @@ is
the_textured_hexagon_Model : constant Model.hexagon.lit_textured.view the_textured_hexagon_Model : constant Model.hexagon.lit_textured.view
:= Model.hexagon.lit_textured.new_Hexagon (Radius => 0.5, := Model.hexagon.lit_textured.new_Hexagon (Radius => 0.5,
Face => (Texture => the_Texture)); Face => (Fades => (1 => 0.0, others => <>),
Textures => (1 => the_Texture, others => <>),
texture_Count => 1));
the_faceted_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_faceted.view the_faceted_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_faceted.view
:= Model.hexagon_Column.lit_colored_faceted.new_hexagon_Column := Model.hexagon_Column.lit_colored_faceted.new_hexagon_Column

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

@@ -1,7 +1,9 @@
with with
openGL.Buffer.general, openGL.Buffer.general,
openGL.Model,
openGL.Shader, openGL.Shader,
openGL.Program.lit, openGL.Program.lit,
openGL.Variable.uniform,
openGL.Attribute, openGL.Attribute,
openGL.Texture, openGL.Texture,
openGL.Palette, openGL.Palette,
@@ -9,8 +11,10 @@ with
openGL.Errors, openGL.Errors,
GL.lean, GL.lean,
GL.Binding,
GL.Pointers, GL.Pointers,
ada.Strings.fixed,
Interfaces.C.Strings, Interfaces.C.Strings,
System.storage_Elements; System.storage_Elements;
@@ -27,21 +31,21 @@ is
-- Globals -- Globals
-- --
vertex_Shader : aliased Shader.item; vertex_Shader : aliased Shader.item;
fragment_Shader : aliased Shader.item; fragment_Shader : aliased Shader.item;
the_Program : openGL.Program.lit.view; the_Program : openGL.Program.lit.view;
white_Texture : openGL.Texture.Object; white_Texture : openGL.Texture.Object;
Name_1 : constant String := "Site"; Name_1 : constant String := "Site";
Name_2 : constant String := "Normal"; Name_2 : constant String := "Normal";
Name_3 : constant String := "Coords"; Name_3 : constant String := "Coords";
Name_4 : constant String := "Shine"; Name_4 : constant String := "Shine";
Attribute_1_Name : aliased C.char_array := C.to_C (Name_1); Attribute_1_Name : aliased C.char_array := C.to_C (Name_1);
Attribute_2_Name : aliased C.char_array := C.to_C (Name_2); Attribute_2_Name : aliased C.char_array := C.to_C (Name_2);
Attribute_3_Name : aliased C.char_array := C.to_C (Name_3); Attribute_3_Name : aliased C.char_array := C.to_C (Name_3);
Attribute_4_Name : aliased C.char_array := C.to_C (Name_4); Attribute_4_Name : aliased C.char_array := C.to_C (Name_4);
Attribute_1_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_1_Name'Access); Attribute_1_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_1_Name'Access);
Attribute_2_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_2_Name'Access); Attribute_2_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_2_Name'Access);
@@ -49,117 +53,158 @@ is
Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access); Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access);
--- Uniforms
--
type texture_Uniforms is
record
texture_Uniform : openGL.Variable.uniform.sampler2D;
fade_Uniform : openGL.Variable.uniform.float;
end record;
the_Textures : array (texture_Id range 1 .. max_Textures) of texture_Uniforms;
the_texture_count_Uniform : openGL.Variable.uniform.int;
--------- ---------
-- Forge -- Forge
-- --
procedure create_Program
is
use Palette,
Attribute.Forge,
System.storage_Elements;
use type system.Address;
Sample : Vertex;
Attribute_1 : Attribute.view;
Attribute_2 : Attribute.view;
Attribute_3 : Attribute.view;
Attribute_4 : Attribute.view;
white_Image : constant Image := [1 .. 2 => [1 .. 2 => +White]];
begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured.vert");
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/texturing.frag"),
3 => to_Asset ("assets/opengl/shader/lit_textured.frag"))));
the_Program := new openGL.Program.lit.item;
the_Program.define ( vertex_Shader'Access,
fragment_Shader'Access);
the_Program.enable;
Attribute_1 := new_Attribute (Name => Name_1,
gl_Location => the_Program.attribute_Location (Name_1),
Size => 3,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => 0,
Normalized => False);
Attribute_2 := new_Attribute (Name => Name_2,
gl_Location => the_Program.attribute_Location (Name_2),
Size => 3,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => Sample.Normal (1)'Address
- Sample.Site (1)'Address,
Normalized => False);
Attribute_3 := new_Attribute (Name => Name_3,
gl_Location => the_Program.attribute_Location (Name_3),
Size => 2,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => Sample.Coords.S'Address
- Sample.Site (1)'Address,
Normalized => False);
Attribute_4 := new_Attribute (Name => Name_4,
gl_Location => the_Program.attribute_Location (Name_4),
Size => 1,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => Sample.Shine 'Address
- Sample.Site (1)'Address,
Normalized => False);
the_Program.add (Attribute_1);
the_Program.add (Attribute_2);
the_Program.add (Attribute_3);
the_Program.add (Attribute_4);
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_1).gl_Location,
name => +Attribute_1_Name_ptr);
Errors.log;
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_2).gl_Location,
name => +Attribute_2_Name_ptr);
Errors.log;
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_3).gl_Location,
name => +Attribute_3_Name_ptr);
Errors.log;
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_4).gl_Location,
name => +Attribute_4_Name_ptr);
Errors.log;
--- Set up the texturing uniforms.
--
for Id in texture_Id'Range
loop
declare
use ada.Strings,
ada.Strings.fixed;
i : constant Positive := Positive (Id);
texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]";
fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]";
begin
the_Textures (Id).texture_Uniform := the_Program.uniform_Variable (named => texture_uniform_Name);
the_Textures (Id). fade_Uniform := the_Program.uniform_Variable (named => fade_uniform_Name);
end;
end loop;
the_texture_count_Uniform := the_Program.uniform_Variable ("texture_Count");
end create_Program;
function new_Geometry return View function new_Geometry return View
is is
use System,
System.storage_Elements;
use type openGL.Program.lit.view; use type openGL.Program.lit.view;
Self : constant View := new Geometry.lit_textured.item; Self : constant View := new Geometry.lit_textured.item;
begin begin
Tasks.check; Tasks.check;
if the_Program = null if the_Program = null
then -- Define the shaders and program. then
declare create_Program; -- Define the shaders and program.
use Palette,
Attribute.Forge;
Sample : Vertex;
Attribute_1 : Attribute.view;
Attribute_2 : Attribute.view;
Attribute_3 : Attribute.view;
Attribute_4 : Attribute.view;
white_Image : constant Image := [1 .. 2 => [1 .. 2 => +White]];
begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured.vert");
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/texturing.frag"),
3 => to_Asset ("assets/opengl/shader/lit_textured.frag"))));
the_Program := new openGL.Program.lit.item;
the_Program.define ( vertex_Shader'Access,
fragment_Shader'Access);
the_Program.enable;
Attribute_1 := new_Attribute (Name => Name_1,
gl_Location => the_Program.attribute_Location (Name_1),
Size => 3,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => 0,
Normalized => False);
Attribute_2 := new_Attribute (Name => Name_2,
gl_Location => the_Program.attribute_Location (Name_2),
Size => 3,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => Sample.Normal (1)'Address
- Sample.Site (1)'Address,
Normalized => False);
Attribute_3 := new_Attribute (Name => Name_3,
gl_Location => the_Program.attribute_Location (Name_3),
Size => 2,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => Sample.Coords.S'Address
- Sample.Site (1)'Address,
Normalized => False);
Attribute_4 := new_Attribute (Name => Name_4,
gl_Location => the_Program.attribute_Location (Name_4),
Size => 1,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured.Vertex'Size / 8,
Offset => Sample.Shine 'Address
- Sample.Site (1)'Address,
Normalized => False);
the_Program.add (Attribute_1);
the_Program.add (Attribute_2);
the_Program.add (Attribute_3);
the_Program.add (Attribute_4);
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_1).gl_Location,
name => +Attribute_1_Name_ptr);
Errors.log;
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_2).gl_Location,
name => +Attribute_2_Name_ptr);
Errors.log;
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_3).gl_Location,
name => +Attribute_3_Name_ptr);
Errors.log;
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_4).gl_Location,
name => +Attribute_4_Name_ptr);
Errors.log;
end;
end if; end if;
Self.Program_is (the_Program.all'Access);
Self.Program_is (the_Program.all'Access);
return Self; return Self;
end new_Geometry; end new_Geometry;
---------- ----------
-- Vertex -- Vertex
-- --
@@ -181,6 +226,8 @@ is
end is_Transparent; end is_Transparent;
-------------- --------------
-- Attributes -- Attributes
-- --
@@ -218,6 +265,7 @@ is
procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array) procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array)
is is
use openGL_large_Buffer_of_geometry_Vertices.Forge; use openGL_large_Buffer_of_geometry_Vertices.Forge;
@@ -240,6 +288,7 @@ is
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)
@@ -258,14 +307,15 @@ is
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 Geometry.texturing.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_ID) return Geometry.texturing.fade_Level function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
is is
begin begin
return Self.Textures.Textures (Which).Fade; return Self.Textures.Textures (which).Fade;
end Fade; end Fade;
@@ -300,6 +350,7 @@ is
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
@@ -310,12 +361,64 @@ is
use GL,
GL.Binding;
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);
overriding overriding
procedure enable_Texture (Self : in out Item) procedure enable_Texture (Self : in out Item)
is is
use openGL.Geometry.texturing;
begin begin
enable (Self.Textures, Self.Program); for i in 1 .. texture_Id (Self.Model.texture_Count)
loop
the_Textures (i).fade_Uniform.Value_is (Real (Self.Model.Fade (i)));
glUniform1i (the_Textures (i).texture_Uniform.gl_Variable,
GLint (i) - 1);
glActiveTexture (all_texture_Units (i));
glBindTexture (GL_TEXTURE_2D,
Self.Textures.Textures (i).Object.Name);
end loop;
the_texture_count_Uniform.Value_is (Self.Textures.Count);
end enable_Texture; end enable_Texture;

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

@@ -298,6 +298,7 @@ is
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
@@ -313,8 +314,8 @@ is
is is
use openGL.Geometry.texturing; use openGL.Geometry.texturing;
begin begin
Self.Textures.Textures (1).Fade := Self.Model.Fade_1; Self.Textures.Textures (1).Fade := Self.Model.Fade (which => 1);
Self.Textures.Textures (2).Fade := Self.Model.Fade_2; Self.Textures.Textures (2).Fade := Self.Model.Fade (which => 2);
enable (Self.Textures, Self.Program); enable (Self.Textures, Self.Program);

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

@@ -17,8 +17,8 @@ is
begin begin
in_Set.Textures (Which) := (0.0, in_Set.Textures (Which) := (0.0,
Now, Now,
textures_Uniform => <>, texture_Uniform => <>,
fade_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;
@@ -30,6 +30,8 @@ is
end Texture_is; end Texture_is;
function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object
is is
begin begin
@@ -46,6 +48,8 @@ is
end Texture; end Texture;
procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object) procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object)
is is
begin begin
@@ -81,17 +85,19 @@ is
Id : constant texture_Id := texture_Id (i); Id : constant texture_Id := texture_Id (i);
begin begin
null;
declare declare
uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]"; uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]";
begin begin
the_Textures.Textures (Id).textures_Uniform := Program.uniform_Variable (Named => uniform_Name); the_Textures.Textures (Id).texture_Uniform := Program.uniform_Variable (Named => uniform_Name);
end; end;
declare -- declare
uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; -- uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]";
begin -- begin
the_Textures.Textures (Id).fade_Uniform := Program.uniform_Variable (Named => uniform_Name); -- the_Textures.Textures (Id).fade_Uniform := Program.uniform_Variable (Named => uniform_Name);
end; -- end;
end; end;
end loop; end loop;
@@ -143,7 +149,8 @@ is
Id : constant texture_Id := texture_Id (i); Id : constant texture_Id := texture_Id (i);
begin begin
glUniform1i (the_Textures.Textures (Id).textures_Uniform.gl_Variable, null;
glUniform1i (the_Textures.Textures (Id).texture_Uniform.gl_Variable,
GLint (i) - 1); GLint (i) - 1);
glActiveTexture (all_texture_Units (Id)); glActiveTexture (all_texture_Units (Id));
glBindTexture (GL_TEXTURE_2D, glBindTexture (GL_TEXTURE_2D,
@@ -151,25 +158,28 @@ is
end; end;
declare -- declare
use ada.Strings, -- use ada.Strings,
ada.Strings.fixed; -- ada.Strings.fixed;
--
uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; -- uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]";
Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name); -- Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name);
begin -- Id : constant texture_Id := texture_Id (i);
-- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image); -- begin
-- -- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image);
Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); --
end; -- -- 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; end loop;
declare -- declare
the_texture_count_Uniform : constant openGL.Variable.uniform.int := Program.uniform_Variable ("texture_Count"); -- the_texture_count_Uniform : constant openGL.Variable.uniform.int := Program.uniform_Variable ("texture_Count");
begin -- begin
the_texture_count_Uniform.Value_is (the_Textures.Count); -- the_texture_count_Uniform.Value_is (the_Textures.Count);
end; -- end;
end enable; end enable;

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

@@ -10,14 +10,16 @@ package openGL.Geometry.texturing
-- --
is 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 fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible).
type fade_Levels is array (texture_Id range <>) of fade_Level;
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;
textures_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;
type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;

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

@@ -23,30 +23,66 @@ is
-------------- ------------------
--- Attributes --- Attributes ---
------------------
------------
-- Texturing
-- --
procedure Texture_is (Self : in out Item; Now : in openGL.asset_Name) overriding
procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level)
is is
begin begin
Self.Face.Texture := Now; Self.Face.Fades (which) := Now;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level
is
begin
return Self.Face.Fades (which);
end Fade;
procedure Texture_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in openGL.asset_Name)
is
begin
Self.Face.Textures (Positive (which)) := Now;
end Texture_is; end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return Self.Face.texture_Count;
end texture_Count;
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
is is
pragma unreferenced (Fonts); pragma unreferenced (Fonts);
use Geometry.lit_textured, use Geometry,
Geometry.lit_textured,
Texture; Texture;
the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius);
the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2);
function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
@@ -58,17 +94,25 @@ is
the_Primitive : constant Primitive.indexed.view the_Primitive : constant Primitive.indexed.view
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
Id : texture_Id;
begin begin
the_Geometry.Vertices_are (Vertices); the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive)); the_Geometry.add (Primitive.view (the_Primitive));
if Self.Face.Texture /= null_Asset for i in 1 .. Self.Face.texture_Count
then loop
the_Geometry.Texture_is (Textures.fetch (Self.Face.Texture)); Id := texture_Id (i);
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
end if;
the_Geometry.is_Transparent (True); the_Geometry.Fade_is (which => Id,
now => Self.Face.Fades (Id));
the_Geometry.Texture_is (which => Id,
now => Textures.fetch (Self.Face.Textures (i)));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
return the_Geometry; return the_Geometry;
end new_Face; end new_Face;
@@ -93,6 +137,8 @@ is
upper_Face := new_Face (Vertices => the_Vertices); upper_Face := new_Face (Vertices => the_Vertices);
end; end;
upper_Face.Model_is (Self.all'unchecked_Access);
return (1 => upper_Face.all'Access); return (1 => upper_Face.all'Access);
end to_GL_Geometries; end to_GL_Geometries;

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

@@ -1,5 +1,5 @@
with with
openGL.Geometry, openGL.Geometry.texturing,
openGL.Texture; openGL.Texture;
@@ -13,7 +13,9 @@ is
type Face is type Face is
record record
Texture : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. 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.
texture_Count : Natural := 0;
end record; end record;
@@ -29,13 +31,27 @@ is
--- Attributes --- Attributes
-- --
procedure Texture_is (Self : in out Item; Now : in openGL.asset_Name);
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;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level);
procedure Texture_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in openGL.asset_Name);
function texture_Count (Self : in Item) return Natural;
private private

8
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb
View File

@@ -127,7 +127,7 @@ is
overriding -- overriding
procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level)
is is
begin begin
@@ -135,7 +135,7 @@ is
end Fade_1_is; end Fade_1_is;
overriding -- overriding
procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level)
is is
begin begin
@@ -144,7 +144,7 @@ is
overriding -- overriding
function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level
is is
begin begin
@@ -152,7 +152,7 @@ is
end Fade_1; end Fade_1;
overriding -- overriding
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level
is is
begin begin

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

@@ -45,17 +45,17 @@ is
procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name); procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name);
overriding -- overriding
procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level);
overriding -- overriding
procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level);
overriding -- overriding
function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level;
overriding -- overriding
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level; function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;

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

@@ -218,37 +218,67 @@ is
-- Texturing -- Texturing
-- --
procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level)
is is
begin begin
raise program_Error with "Model does not support texturing."; raise program_Error with "Model does not support texturing.";
end Fade_1_is; end Fade_is;
procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) function Fade (Self : in Item; Which : in Geometry.texture_Id) return 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 is
begin begin
raise program_Error with "Model does not support texturing."; raise program_Error with "Model does not support texturing.";
return 0.0; return 0.0;
end Fade_1; end Fade;
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level function texture_Count (Self : in Item) return Natural
is is
begin begin
raise program_Error with "Model does not support texturing."; raise program_Error with "Model does not support texturing.";
return 0.0; return 0;
end Fade_2; end texture_Count;
-- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level)
-- is
-- begin
-- raise program_Error with "Model does not support texturing.";
-- end Fade_1_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;

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

@@ -73,11 +73,18 @@ is
-- Texturing -- Texturing
-- --
procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level;
procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id;
Now : in Geometry.Texturing.fade_Level);
function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; function texture_Count (Self : in Item) return Natural;
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;
-- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level);
-- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level);
--
-- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level;
-- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;