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

openGL: Add preliminary multi-texturing code.

Browse Source
This commit is contained in:
Rod Kay
2023-05-01 21:17:12 +10:00
parent 2209ac7ca8
commit 86721ca2db
11 changed files with 1227 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -0,0 +1,87 @@
with
openGL.Model.hexagon.lit_textured_x2,
openGL.Visual,
openGL.Light,
openGL.Palette,
-- openGL.IO,
openGL.Demo;
procedure launch_render_two_Textures
--
-- Renders a hexagon grid.
--
is
use openGL,
openGL.Math,
openGL.linear_Algebra_3D,
openGL.Palette,
openGL.Light;
--------------
-- The model.
--
the_1st_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/blobber_floor.png");
the_2nd_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/crawl_blob-1.png");
the_textured_hexagon_Model : constant Model.hexagon.lit_textured_x2.view
:= Model.hexagon.lit_textured_x2.new_Hexagon (Radius => 0.5,
Face => (Texture_1 => the_1st_Texture,
Texture_2 => the_2nd_Texture,
Fade_1 => 0.5,
Fade_2 => 0.5));
----------------
--- The visual.
--
use openGL.Visual.Forge;
the_Hex : constant openGL.Visual.view := new_Visual (the_textured_hexagon_Model.all'Access);
--------------
--- The light.
--
the_Light : openGL.Light.item := Demo.Renderer.new_Light;
light_Site : constant openGL.Vector_3 := [0.0, 0.0, 15.0];
cone_Direction : constant openGL.Vector_3 := [0.0, 0.0, -1.0];
begin
Demo.print_Usage;
Demo.define ("openGL 'render two Textures' Demo",
Width => 1_000,
Height =>1_000);
Demo.Camera.Position_is ([0.0, 2.0, 0.0],
x_Rotation_from (to_Radians (90.0)));
-- Set up the light.
--
the_Light. Kind_is (Diffuse);
the_Light. Site_is (light_Site);
the_Light. Color_is (White);
the_Light.ambient_Coefficient_is (0.8);
the_Light. cone_Angle_is (5.0);
the_Light. cone_Direction_is (cone_Direction);
Demo.Renderer.set (the_Light);
-- Main loop.
--
while not Demo.Done
loop
Demo.Dolly.evolve;
Demo.Done := Demo.Dolly.quit_Requested;
Demo.Camera.render ([1 => the_Hex]);
while not Demo.Camera.cull_Completed
loop
delay Duration'Small;
end loop;
Demo.Renderer.render;
Demo.FPS_Counter.increment; -- Frames per second display.
end loop;
Demo.destroy;
end launch_render_two_Textures;

16
3-mid/opengl/applet/demo/textures/render_two_textures/render_two_textures.gpr Normal file
View File

@@ -0,0 +1,16 @@
with
"opengl_demo",
"lace_shared";
project render_two_Textures
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_render_two_textures.adb");
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Binder renames Lace_shared.Binder;
end render_two_Textures;

142
3-mid/opengl/assets/shader/lit_textured_x2.frag Normal file
View File

@@ -0,0 +1,142 @@
#version 140
struct light
{
vec4 Site;
vec3 Color;
float Attenuation;
float ambient_Coefficient;
float cone_Angle;
vec3 cone_Direction;
};
uniform mat4 model_Transform;
uniform mat3 inverse_model_Rotation;
uniform vec3 camera_Site;
uniform vec3 specular_Color; // The materials specular color.
uniform int texture_Count;
uniform sampler2D Textures [32];
uniform float Fade [32];
uniform int light_Count;
uniform light Lights [10];
in vec3 frag_Site;
in vec3 frag_Normal;
in vec2 frag_Coords;
in float frag_Shine;
out vec4 final_Color;
vec3
apply_Light (light Light,
vec3 surface_Color,
vec3 Normal,
vec3 surface_Site,
vec3 Surface_to_Camera)
{
vec3 Surface_to_Light;
float Attenuation = 1.0;
if (Light.Site.w == 0.0)
{
// Directional light.
//
Surface_to_Light = normalize (-Light.Site.xyz);
Attenuation = 1.0; // No attenuation for directional lights.
}
else
{
// Point light.
//
vec3 Surface_to_Light_vector = Light.Site.xyz - surface_Site;
float Distance_to_Light = length (Surface_to_Light_vector);
Surface_to_Light = normalize (Surface_to_Light_vector);
Attenuation = 1.0
/ ( 1.0
+ Light.Attenuation
* pow (Distance_to_Light, 2));
// Cone restrictions which affects attenuation.
//
float Light_to_Surface_Angle = degrees (acos (dot (-Surface_to_Light,
normalize (Light.cone_Direction))));
if (Light_to_Surface_Angle > Light.cone_Angle)
{
Attenuation = 0.0;
}
}
vec3 lit_surface_Color = surface_Color * Light.Color;
vec3 Ambient = Light.ambient_Coefficient * lit_surface_Color;
float diffuse_Coefficient = max (0.0,
dot (Normal,
Surface_to_Light));
vec3 Diffuse = diffuse_Coefficient * lit_surface_Color;
float specular_Coefficient = 0.0;
if (diffuse_Coefficient > 0.0)
specular_Coefficient = pow (max (0.0,
dot (Surface_to_Camera,
reflect (-Surface_to_Light,
Normal))),
frag_Shine);
vec3 Specular = specular_Coefficient * specular_Color * Light.Color;
return Ambient + Attenuation * (Diffuse + Specular); // Linear color (before gamma correction).
}
void
main()
{
vec3 surface_Site = vec3 ( model_Transform
* vec4 (frag_Site, 1));
vec4 surface_Color = vec4 (0);
for (int i = 0; i < texture_Count; ++i)
{
// surface_Color += texture (Textures [i],
// frag_Coords);
surface_Color.rgb += texture (Textures [i],
frag_Coords).rgb * (1.0 - Fade [i]);
surface_Color.a = max (surface_Color.a, texture (Textures [i],
frag_Coords).a);
}
surface_Color = surface_Color; // / texture_Count;
vec3 Surface_to_Camera = normalize (camera_Site - surface_Site);
vec3 Normal = normalize ( frag_Normal
* inverse_model_Rotation);
// Combine color from all the lights.
//
vec3 linear_Color = vec3 (0);
for (int i = 0; i < light_Count; ++i)
{
linear_Color += apply_Light (Lights [i],
surface_Color.rgb,
Normal,
surface_Site,
Surface_to_Camera);
}
vec3 Gamma = vec3 (1.0 / 2.2);
final_Color = vec4 (pow (linear_Color, // Final color (after gamma correction).
Gamma),
surface_Color.a);
}

29
3-mid/opengl/assets/shader/lit_textured_x2.vert Normal file
View File

@@ -0,0 +1,29 @@
#version 140
uniform mat4 mvp_Transform;
uniform vec3 Scale;
in vec3 Site;
in vec3 Normal;
in vec2 Coords;
in float Shine;
out vec3 frag_Site;
out vec3 frag_Normal;
out vec2 frag_Coords;
out float frag_Shine;
void main()
{
// Pass some variables to the fragment shader.
//
frag_Site = Site;
frag_Normal = Normal;
frag_Coords = Coords;
frag_Shine = Shine;
// Apply all matrix transformations to 'Site'.
//
gl_Position = mvp_Transform * vec4 (Site * Scale, 1);
}

406
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb Normal file
View File

@@ -0,0 +1,406 @@
with
openGL.Buffer.general,
openGL.Shader,
openGL.Program.lit,
openGL.Attribute,
openGL.Variable.uniform,
openGL.Texture,
openGL.Palette,
openGL.Tasks,
openGL.Errors,
GL.Binding,
GL.lean,
GL.Pointers,
ada.Strings.fixed,
Interfaces.C.Strings,
System.storage_Elements;
with ada.Text_IO; use ada.Text_IO;
package body openGL.Geometry.lit_textured_x2
is
use GL.lean,
GL.Pointers,
Interfaces;
-----------
-- Globals
--
vertex_Shader : aliased Shader.item;
fragment_Shader : aliased Shader.item;
the_Program : openGL.Program.lit.view;
white_Texture : openGL.Texture.Object;
Name_1 : constant String := "Site";
Name_2 : constant String := "Normal";
Name_3 : constant String := "Coords";
-- Name_4 : constant String := "Coords_2";
Name_5 : constant String := "Shine";
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_3_Name : aliased C.char_array := C.to_C (Name_3);
-- Attribute_4_Name : aliased C.char_array := C.to_C (Name_4);
Attribute_5_Name : aliased C.char_array := C.to_C (Name_5);
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_3_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_3_Name'Access);
-- Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access);
Attribute_5_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_5_Name'Access);
---------
-- Forge
--
function new_Geometry return View
is
use System,
System.storage_Elements;
use type openGL.Program.lit.view;
Self : constant View := new Geometry.lit_textured_x2.item;
begin
Tasks.check;
if the_Program = null
then -- Define the shaders and program.
declare
use Palette,
Attribute.Forge;
Sample : Vertex;
Attribute_1 : Attribute.view;
Attribute_2 : Attribute.view;
Attribute_3 : Attribute.view;
-- Attribute_4 : Attribute.view;
Attribute_5 : 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_x2.vert");
fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured_x2.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_x2.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_x2.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_x2.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 => 2,
-- data_Kind => attribute.GL_FLOAT,
-- Stride => lit_textured_x2.Vertex'Size / 8,
-- Offset => Sample.Coords_2.S'Address
-- - Sample.Site (1)'Address,
-- Normalized => False);
Attribute_5 := new_Attribute (Name => Name_5,
gl_Location => the_Program.attribute_Location (Name_5),
Size => 1,
data_Kind => attribute.GL_FLOAT,
Stride => lit_textured_x2.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);
the_Program.add (Attribute_5);
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;
glBindAttribLocation (program => the_Program.gl_Program,
index => the_Program.Attribute (named => Name_5).gl_Location,
name => +Attribute_5_Name_ptr);
Errors.log;
end;
end if;
Self.Program_is (the_Program.all'Access);
return Self;
end new_Geometry;
----------
-- Vertex
--
function is_Transparent (Self : in Vertex_array) return Boolean -- TODO: Do these properly.
is
pragma Unreferenced (Self);
begin
return False;
end is_Transparent;
function is_Transparent (Self : in Vertex_large_array) return Boolean
is
pragma Unreferenced (Self);
begin
return False;
end is_Transparent;
--------------
-- Attributes
--
package openGL_Buffer_of_geometry_Vertices is new Buffer.general (base_Object => Buffer.array_Object,
Index => Index_t,
Element => Vertex,
Element_Array => Vertex_array);
package openGL_large_Buffer_of_geometry_Vertices is new Buffer.general (base_Object => Buffer.array_Object,
Index => long_Index_t,
Element => Vertex,
Element_Array => Vertex_large_array);
procedure Vertices_are (Self : in out Item; Now : in Vertex_array)
is
use openGL_Buffer_of_geometry_Vertices.Forge;
begin
Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now,
usage => Buffer.static_Draw));
Self.is_Transparent := is_Transparent (Now);
-- Set the bounds.
--
declare
function get_Site (Index : in Index_t) return Vector_3
is (Now (Index).Site);
function bounding_Box is new get_Bounds (Index_t, get_Site);
begin
Self.Bounds_are (bounding_Box (Count => Now'Length));
end;
end Vertices_are;
procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array)
is
use openGL_large_Buffer_of_geometry_Vertices.Forge;
begin
Self.Vertices := new openGL_large_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now,
usage => Buffer.static_Draw));
Self.is_Transparent := is_Transparent (Now);
-- Set the bounds.
--
declare
function get_Site (Index : in long_Index_t) return Vector_3
is (Now (Index).Site);
function bounding_Box is new get_Bounds (long_Index_t, get_Site);
begin
Self.Bounds_are (bounding_Box (Count => Now'Length));
end;
end Vertices_are;
overriding
procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive)
is
begin
raise Error with "TODO";
end Indices_are;
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in fade_Level)
is
begin
Self.Textures.Textures (Which).Fade := Now;
end Fade_is;
function Fade (Self : in Item; Which : texture_ID) return fade_Level
is
begin
return Self.Textures.Textures (Which).Fade;
end Fade;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
Now => Now);
end Texture_is;
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is
begin
return Texture (in_Set => Self.Textures,
Which => Which);
end Texture;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
end Texture_is;
overriding
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return Texture (in_Set => Self.Textures,
Which => 1);
end Texture;
overriding
procedure enable_Texture (Self : in Item)
is
-- check_is_OK : constant Boolean := openGL.Tasks.Check
-- with unreferenced;
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;
end openGL.Geometry.lit_textured_x2;

66
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads Normal file
View File

@@ -0,0 +1,66 @@
package openGL.Geometry.lit_textured_x2
--
-- Supports per-vertex site texture and lighting.
--
is
type Item is new openGL.Geometry.item with private;
type View is access all Item'Class;
function new_Geometry return View;
----------
-- Vertex
--
type Vertex is
record
Site : Vector_3;
Normal : Vector_3;
Coords : Coordinate_2D;
Shine : Real;
end record;
type Vertex_array is array ( Index_t range <>) of aliased Vertex;
type Vertex_large_array is array (long_Index_t range <>) of aliased Vertex;
--------------
-- Attributes
--
procedure Vertices_are (Self : in out Item; Now : in Vertex_array);
procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array);
overriding
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 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;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
overriding
function Texture (Self : in Item) return openGL.Texture.Object;
private
type Item is new Geometry.item with
record
Textures : texture_Set;
end record;
overriding
procedure enable_Texture (Self : in Item);
end openGL.Geometry.lit_textured_x2;

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

@@ -1,9 +1,19 @@
with with
openGL.Primitive.indexed, openGL.Primitive.indexed,
openGL.Primitive.long_indexed, openGL.Primitive.long_indexed,
openGL.Variable.uniform,
openGL.Tasks,
GL.Binding,
GL.lean,
GL.Pointers,
ada.Strings.fixed,
ada.unchecked_Deallocation, ada.unchecked_Deallocation,
ada.unchecked_Conversion; ada.unchecked_Conversion,
interfaces.C.Strings;
package body openGL.Geometry package body openGL.Geometry
is is
@@ -93,22 +103,103 @@ is
function Texture (Self : in Item'Class) return openGL.Texture.Object
-- 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 is
begin begin
return Self.Texture; raise program_Error with "Geometry has no texture.";
return openGL.Texture.null_Object;
end Texture; end Texture;
procedure Texture_is (Self : in out Item'Class; Now : in openGL.Texture.Object) -- 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 is
begin begin
Self.Texture := Now; in_Set.Textures (Which) := (0.0, Now);
Self.is_Transparent := Self.is_Transparent in_Set.is_Transparent := in_Set.is_Transparent
or Now .is_Transparent; or Now .is_Transparent;
if Natural (Which) > in_Set.Count
then
in_Set.Count := Natural (Which);
end if;
end Texture_is; 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) procedure Program_is (Self : in out Item; Now : in openGL.Program.view)
is is
@@ -143,8 +234,12 @@ is
function is_Transparent (Self : in Item) return Boolean function is_Transparent (Self : in Item) return Boolean
is is
begin begin
return Self.is_Transparent return Self.is_Transparent;
or Self.Texture.is_Transparent; -- or Self.Textures.Textures (1).Object.is_Transparent
-- or Self.Textures.Textures (2).Object.is_Transparent; -- TODO: Loop over all textures.
-- -- return Self.is_Transparent
-- -- or Self.Texture_1.is_Transparent
-- -- or Self.Texture_2.is_Transparent;
end is_Transparent; end is_Transparent;
@@ -465,6 +560,110 @@ is
end Normals_of; end Normals_of;
-----------
-- Textures
--
procedure enable (the_Textures : in texture_Set;
Program : in openGL.Program.view)
is
use GL,
GL.Binding,
openGL.Texture;
-- check_is_OK : constant Boolean := openGL.Tasks.Check
-- with unreferenced;
begin
Tasks.check;
for i in 1 .. the_Textures.Count
loop
declare
use GL.lean,
GL.Pointers,
ada.Strings,
ada.Strings.fixed,
Interfaces;
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);
uniform_Name : aliased C.char_array := C.to_C ("Textures[" & Trim (Natural'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 (Program.gl_Program, +uniform_Name_ptr);
Id : constant texture_Id := texture_Id (i);
begin
-- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image);
glUniform1i (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 -- Bounds
-- --

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

@@ -39,8 +39,53 @@ is
procedure Label_is (Self : in out Item'Class; Now : in String); procedure Label_is (Self : in out Item'Class; Now : in String);
function Label (Self : in Item'Class) return String; function Label (Self : in Item'Class) return String;
procedure Texture_is (Self : in out Item'Class; Now : in Texture.Object);
function Texture (Self : in Item'Class) return Texture.Object;
max_Textures : constant := 32;
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;
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.
end record;
procedure enable (the_Textures : in 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); 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. function Bounds (self : in Item'Class) return Bounds; -- Returns the bounds in object space.
@@ -84,11 +129,14 @@ is
private private
use ada.Strings.unbounded; use ada.Strings.unbounded;
type Textures is array (texture_Id) of openGL.Texture.Object;
type Item is abstract tagged limited type Item is abstract tagged limited
record record
Label : unbounded_String; Label : unbounded_String;
Texture : openGL.Texture.Object := openGL.Texture.null_Object;
Program : openGL.Program.view; Program : openGL.Program.view;
Vertices : Buffer.view; Vertices : Buffer.view;
@@ -100,6 +148,7 @@ private
end record; end record;
generic generic
type any_Index_t is range <>; type any_Index_t is range <>;
with function get_Site (Index : in any_Index_t) return Vector_3; with function get_Site (Index : in any_Index_t) return Vector_3;

123
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb Normal file
View File

@@ -0,0 +1,123 @@
with
openGL.Geometry.lit_textured_x2,
openGL.Primitive.indexed;
package body openGL.Model.hexagon.lit_textured_x2
is
---------
--- Forge
--
function new_Hexagon (Radius : in Real;
Face : in lit_textured_x2.Face) return View
is
Self : constant View := new Item;
begin
Self.Radius := Radius;
Self.Face := Face;
return Self;
end new_Hexagon;
--------------
--- Attributes
--
procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name)
is
begin
Self.Face.Texture_1 := Now;
end Texture_1_is;
procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name)
is
begin
Self.Face.Texture_2 := Now;
end Texture_2_is;
overriding
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
is
pragma unreferenced (Fonts);
use Geometry.lit_textured_x2,
Texture;
the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius);
the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2);
function new_Face (Vertices : in geometry.lit_textured_x2.Vertex_array) return Geometry.lit_textured_x2.view
is
use Primitive;
the_Geometry : constant Geometry.lit_textured_x2.view
:= Geometry.lit_textured_x2.new_Geometry;
the_Primitive : constant Primitive.indexed.view
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
begin
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
if Self.Face.Texture_1 /= null_Asset
then
the_Geometry.Texture_is (Textures.fetch (Self.Face.Texture_1));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
the_Geometry.Fade_is (which => 1,
now => Self.Face.Fade_1);
else
raise Program_Error;
end if;
if Self.Face.Texture_2 /= null_Asset
then
the_Geometry.Texture_is (which => 2,
Now => Textures.fetch (Self.Face.Texture_2));
-- the_Geometry.Texture_2_is (Which => 2, Now => Textures.fetch (Self.Face.Texture_2));
-- the_Geometry.is_Transparent (now => the_Geometry.Texture_2.is_Transparent);
the_Geometry.Fade_is (which => 2,
now => Self.Face.Fade_2);
end if;
return the_Geometry;
end new_Face;
upper_Face : Geometry.lit_textured_x2.view;
begin
-- Upper Face
--
declare
the_Vertices : constant Geometry.lit_textured_x2.Vertex_array
:= (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Coords => (0.50, 0.50), Shine => default_Shine), -- Center.
2 => (Site => the_Sites (1), Normal => Normal, Coords => (1.00, 0.50), Shine => default_Shine), -- Mid right.
3 => (Site => the_Sites (2), Normal => Normal, Coords => (0.75, 1.00), Shine => default_Shine), -- Bottom right.
4 => (Site => the_Sites (3), Normal => Normal, Coords => (0.25, 1.00), Shine => default_Shine), -- Bottom left.
5 => (Site => the_Sites (4), Normal => Normal, Coords => (0.00, 0.50), Shine => default_Shine), -- Mid left.
6 => (Site => the_Sites (5), Normal => Normal, Coords => (0.25, 0.00), Shine => default_Shine), -- Top left.
7 => (Site => the_Sites (6), Normal => Normal, Coords => (0.75, 0.00), Shine => default_Shine)); -- Top right.
begin
upper_Face := new_Face (Vertices => the_Vertices);
end;
return (1 => upper_Face.all'Access);
end to_GL_Geometries;
end openGL.Model.hexagon.lit_textured_x2;

51
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads Normal file
View File

@@ -0,0 +1,51 @@
with
openGL.Geometry,
openGL.Texture;
package openGL.Model.hexagon.lit_textured_x2
--
-- Models a lit, colored and textured hexagon.
--
is
type Item is new Model.item with private;
type View is access all Item'Class;
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;
end record;
---------
--- Forge
--
function new_Hexagon (Radius : in Real;
Face : in lit_textured_x2.Face) return View;
--------------
--- Attributes
--
procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name);
procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name);
overriding
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;
private
type Item is new Model.hexagon.item with
record
Face : lit_textured_x2.Face;
end record;
end openGL.Model.hexagon.lit_textured_x2;

47
3-mid/opengl/source/lean/shader/opengl-program-lit.adb
View File

@@ -1,6 +1,12 @@
with with
openGL.Conversions, openGL.Conversions,
ada.Strings.fixed; GL.lean,
GL.Binding,
GL.Pointers,
ada.Strings.fixed,
Interfaces.C.Strings;
with ada.text_io; use ada.text_io;
package body openGL.Program.lit package body openGL.Program.lit
@@ -93,6 +99,45 @@ is
cone_direction_Uniform .Value_is ( Light.cone_Direction); cone_direction_Uniform .Value_is ( Light.cone_Direction);
end; end;
end loop; end loop;
-- declare
-- use GL,
-- GL.lean,
-- GL.Binding,
-- GL.Pointers,
-- Interfaces;
--
-- uniform_Name : aliased C.char_array := C.to_C ("Texture_1[0]");
-- uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access);
-- loc : GL.GLint := glGetUniformLocation (Self.gl_Program, +uniform_Name_ptr);
-- begin
-- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image);
--
-- glUniform1i (loc, 0);
-- glActiveTexture (GL_TEXTURE0);
-- glBindTexture (GL_TEXTURE_2D, 4);
-- end;
--
--
-- declare
-- use GL,
-- GL.lean,
-- GL.Binding,
-- GL.Pointers,
-- Interfaces;
--
-- uniform_Name : aliased C.char_array := C.to_C ("Texture_1[1]");
-- uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access);
-- loc : GL.GLint := glGetUniformLocation (Self.gl_Program, +uniform_Name_ptr);
-- begin
-- put_Line ("2-openGL.Program.lit.set_Uniforms:" & loc'Image);
--
-- glUniform1i (loc, 1);
-- glActiveTexture (GL_TEXTURE1);
-- glBindTexture (GL_TEXTURE_2D, 5);
-- end;
end set_Uniforms; end set_Uniforms;