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

opengl: Rid 'Texture' and 'Texture_is' for texture_Sets.

Browse Source
This commit is contained in:
Rod Kay
2025-09-25 15:12:14 +10:00
parent 9ccf2d3cb5
commit 5a003202bf
32 changed files with 192 additions and 127 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -48,9 +48,42 @@ is
-- procedure enable (for_Model : in openGL.Model.view;
-- Uniforms : in texturing.Uniforms;
-- texture_Set : in openGL.texture_Set.Item)
-- is
-- use GL.Binding,
-- GL.lean;
--
-- use type GLint;
--
-- begin
-- if for_Model.texture_Count > 0
-- then
-- for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
-- loop
-- Uniforms.Textures (i).tiling_Uniform .Value_is (Vector_2' ((for_Model.Tiling (Which => i).S,
-- for_Model.Tiling (Which => i).T)));
-- Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (Which => i)));
-- Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i));
--
-- glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
-- GLint (i) - 1);
-- glActiveTexture (all_texture_Units (i));
-- glBindTexture (GL_TEXTURE_2D,
-- texture_Set.Textures (i).Object.Name);
-- end loop;
-- end if;
--
-- Uniforms.Count.Value_is (for_Model.texture_Count);
-- end enable;
procedure enable (for_Model : in openGL.Model.view;
Uniforms : in texturing.Uniforms;
texture_Set : in openGL.texture_Set.Item)
Uniforms : in texturing.Uniforms)
-- texture_Set : in openGL.texture_Set.Item)
is
use GL.Binding,
GL.lean;
@@ -71,7 +104,7 @@ is
GLint (i) - 1);
glActiveTexture (all_texture_Units (i));
glBindTexture (GL_TEXTURE_2D,
texture_Set.Textures (i).Object.Name);
for_Model.texture_Object (i).Name);
end loop;
end if;
@@ -134,7 +167,9 @@ is
Which : in texture_Set.texture_ID := 1)
is
begin
Self.texture_Set.Textures (Which).Fade := Now;
-- Self.texture_Set.Textures (Which).Fade := Now;
Self.Model.Fade_is (Which => Which,
Now => Now);
end Fade_is;
@@ -143,7 +178,8 @@ is
function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level
is
begin
return Self.texture_Set.Textures (Which).Fade;
-- return Self.texture_Set.Textures (Which).Fade;
return Self.Model.Fade (Which => Which);
end Fade;
@@ -153,9 +189,11 @@ is
Which : in texture_Set.texture_ID := 1)
is
begin
Texture_is (in_Set => Self.texture_Set,
Which => Which,
Now => Now);
-- Texture_is (in_Set => Self.texture_Set,
-- Which => Which,
-- Now => Now);
Self.Model.texture_Object_is (Which => Which,
Now => Now);
end Texture_is;
@@ -164,8 +202,9 @@ is
function Texture (Self : in Item; Which : texture_Set.texture_ID := 1) return openGL.Texture.Object
is
begin
return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
Which => Which);
-- return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
-- Which => Which);
return Self.Model.texture_Object (Which);
end Texture;
@@ -175,7 +214,8 @@ is
Which : in texture_Set.texture_ID := 1)
is
begin
Self.texture_Set.Textures (Which).Applied := Now;
-- Self.texture_Set.Textures (Which).Applied := Now;
Self.Model.texture_Applied_is (Which, Now);
end texture_Applied_is;
@@ -184,7 +224,8 @@ is
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
is
begin
return Self.texture_Set.Textures (Which).Applied;
-- return Self.texture_Set.Textures (Which).Applied;
return Self.Model.texture_Applied (Which);
end texture_Applied;
@@ -194,7 +235,9 @@ is
Which : in texture_Set.texture_ID := 1)
is
begin
Self.texture_Set.Textures (Which).Tiling := Now;
-- Self.texture_Set.Textures (Which).Tiling := Now;
Self.Model.Tiling_is (Which => Which,
Now => Now);
end Tiling_is;
@@ -203,7 +246,8 @@ is
function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling
is
begin
return Self.texture_Set.Textures (Which).Tiling;
-- return Self.texture_Set.Textures (Which).Tiling;
return Self.Model.Tiling (Which);
end Tiling;
@@ -216,9 +260,11 @@ is
procedure enable_Textures (Self : in out Item)
is
begin
-- texturing.enable (for_Model => Self.Model.all'Access,
-- Uniforms => texture_Uniforms,
-- texture_Set => Self.texture_Set);
texturing.enable (for_Model => Self.Model.all'Access,
Uniforms => texture_Uniforms,
texture_Set => Self.texture_Set);
Uniforms => texture_Uniforms);
end enable_Textures;

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

@@ -40,9 +40,12 @@ is
--- Operations
--
-- procedure enable (for_Model : in openGL.Model.view;
-- Uniforms : in texturing.Uniforms;
-- texture_Set : in openGL.texture_Set.Item);
procedure enable (for_Model : in openGL.Model.view;
Uniforms : in texturing.Uniforms;
texture_Set : in openGL.texture_Set.Item);
Uniforms : in texturing.Uniforms);
@@ -99,7 +102,7 @@ is
type Item is new Geometry.item with
record
texture_Set : openGL.texture_Set.item;
null; --texture_Set : openGL.texture_Set.item;
end record;
end Mixin;

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

@@ -420,6 +420,9 @@ is
deallocate (the_Vertices);
destroy (the_Model);
Self.Geometry.Model_is (Self'unchecked_Access);
-- Set the geometry texture.
--
if Self.Texture /= null_Asset

2
3-mid/opengl/source/lean/model/opengl-model-arrow-colored.adb
View File

@@ -44,7 +44,7 @@ is
--
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 openGL.Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views
is
pragma unreferenced (Textures, Fonts);

2
3-mid/opengl/source/lean/model/opengl-model-arrow-colored.ads
View File

@@ -27,7 +27,7 @@ is
--
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 openGL.Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
procedure end_Site_is (Self : in out Item; Now : in Vector_3;

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

@@ -57,16 +57,16 @@ is
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);
the_Geometry.is_Transparent;
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;
Color : constant rgba_Color := +Self.Color;
the_Face : Geometry_view;
Color : constant rgba_Color := +Self.Color;
the_Face : Geometry_view;
begin
declare

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

@@ -60,6 +60,7 @@ is
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
the_Geometry.is_Transparent;
@@ -113,8 +114,6 @@ is
end if;
end;
the_Face.Model_is (Self.all'unchecked_Access);
return [1 => the_Face.all'Access];
end to_GL_Geometries;

2
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.adb
View File

@@ -51,9 +51,9 @@ is
(triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;

9
3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.adb
View File

@@ -48,8 +48,9 @@ is
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive
(triangle_Fan,
the_Indices).all'Access;
the_Indices).all'unchecked_Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -80,7 +81,6 @@ is
then
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
front_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -100,7 +100,6 @@ is
then
rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
rear_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -120,7 +119,6 @@ is
then
upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
upper_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -140,7 +138,6 @@ is
then
lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
lower_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -160,7 +157,6 @@ is
then
left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
left_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -180,7 +176,6 @@ is
then
right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
right_Face.Model_is (Self.all'unchecked_Access);
end if;
end;

7
3-mid/opengl/source/lean/model/opengl-model-box-textured.adb
View File

@@ -51,6 +51,7 @@ is
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -86,7 +87,6 @@ is
then
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
front_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -106,7 +106,6 @@ is
then
rear_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
rear_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -126,7 +125,6 @@ is
then
upper_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
upper_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -146,7 +144,6 @@ is
then
lower_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
lower_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -166,7 +163,6 @@ is
then
left_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
left_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -186,7 +182,6 @@ is
then
right_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
right_Face.Model_is (Self.all'unchecked_Access);
end if;
end;

9
3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.adb
View File

@@ -80,6 +80,8 @@ is
begin
-- Define capsule shaft,
--
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
declare
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
@@ -197,8 +199,6 @@ is
begin
the_shaft_Geometry.add (Primitive.view (the_Primitive));
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
end;
@@ -234,7 +234,10 @@ is
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
begin
cap_Geometry.Model_is (Self.all'unchecked_Access);
if not is_Fore
then
a := Degrees_360;
@@ -397,8 +400,6 @@ is
end;
end;
cap_Geometry.Model_is (Self.all'unchecked_Access);
return cap_Geometry;
end new_Cap;

8
3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.adb
View File

@@ -77,6 +77,8 @@ is
begin
-- Define capsule shaft,
--
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
declare
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
@@ -190,8 +192,6 @@ is
begin
the_shaft_Geometry.add (Primitive.view (the_Primitive));
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
end;
@@ -228,6 +228,8 @@ is
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
begin
cap_Geometry.Model_is (Self.all'unchecked_Access);
if not is_Fore
then
a := Degrees_360;
@@ -388,8 +390,6 @@ is
end;
end;
cap_Geometry.Model_is (Self.all'unchecked_Access);
return cap_Geometry;
end new_Cap;

11
3-mid/opengl/source/lean/model/opengl-model-capsule-textured.adb
View File

@@ -38,8 +38,7 @@ is
is
pragma unreferenced (Textures, Fonts);
use --Geometry,
Geometry.textured,
use Geometry.textured,
real_Functions;
Length : constant Real := Self.Height;
@@ -77,6 +76,8 @@ is
begin
-- Define capsule shaft,
--
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
declare
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
@@ -209,7 +210,10 @@ is
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
begin
cap_Geometry.Model_is (Self.all'unchecked_Access);
if not is_Fore
then
a := Degrees_360;
@@ -371,9 +375,6 @@ is
cap_2_Geometry := new_Cap (is_Fore => False);
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
cap_1_Geometry .Model_is (Self.all'unchecked_Access);
cap_2_Geometry .Model_is (Self.all'unchecked_Access);
return [1 => the_shaft_Geometry.all'Access,
2 => cap_1_Geometry.all'Access,

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

@@ -80,6 +80,7 @@ is
Id : texture_Set.texture_Id;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
@@ -90,8 +91,8 @@ is
Id := texture_Id (i);
the_Geometry.Fade_is (which => Id,
now => Self.texture_Details.Fades (Id));
-- the_Geometry.Fade_is (which => Id,
-- now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (which => Id,
now => Textures.fetch (Self.texture_Details.Textures (i)));
@@ -99,7 +100,6 @@ is
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Geometry;

1
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.adb
View File

@@ -52,6 +52,7 @@ is
the_Primitive : constant Primitive.indexed.view
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));

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

@@ -58,7 +58,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
Id : texture_Set.texture_Id;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
@@ -66,8 +68,8 @@ is
loop
Id := texture_Id (i);
the_Geometry.Fade_is (Which => Id,
Now => Self.texture_Details.Fades (Id));
-- the_Geometry.Fade_is (Which => Id,
-- Now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (Which => Id,
Now => Textures.fetch (Self.texture_Details.Textures (i)));
@@ -75,7 +77,6 @@ is
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;

4
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_faceted.adb
View File

@@ -70,8 +70,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.add (Primitive.view (the_Primitive));
return the_Geometry;
end new_hexagon_Face;
@@ -90,6 +91,7 @@ is
the_Primitive : constant Primitive.view
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);

4
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.adb
View File

@@ -75,8 +75,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.add (Primitive.view (the_Primitive));
return the_Geometry;
end new_hexagon_Face;
@@ -95,6 +96,7 @@ is
the_Primitive : constant Primitive.view
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);

2
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.adb
View File

@@ -77,6 +77,7 @@ is
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -99,6 +100,7 @@ is
:= Primitive.indexed.new_Primitive (triangle_Strip,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));

4
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.adb
View File

@@ -71,8 +71,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.add (Primitive.view (the_Primitive));
return the_Geometry;
end new_hexagon_Face;
@@ -91,6 +92,7 @@ is
the_Primitive : constant Primitive.view
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);

2
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.adb
View File

@@ -73,6 +73,7 @@ is
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -95,6 +96,7 @@ is
:= Primitive.indexed.new_Primitive (triangle_Strip,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));

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

@@ -70,6 +70,7 @@ is
Id : texture_Set.texture_Id;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
@@ -77,8 +78,8 @@ is
loop
Id := texture_Id (i);
the_Geometry.Fade_is (Which => Id,
Now => Self.texture_Details.Fades (Id));
-- the_Geometry.Fade_is (Which => Id,
-- Now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (Which => Id,
Now => Textures.fetch (Self.texture_Details.Textures (i)));
@@ -86,7 +87,6 @@ is
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Geometry;

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

@@ -73,6 +73,8 @@ is
the_Geometry : constant Geometry_view := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
use linear_Algebra,
@@ -201,7 +203,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

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

@@ -65,6 +65,8 @@ is
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
use linear_Algebra,
@@ -188,7 +190,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

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

@@ -70,6 +70,8 @@ is
the_Geometry : constant Geometry.textured.view := Geometry.textured.new_Geometry;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
use linear_Algebra_3d;
@@ -199,7 +201,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

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

@@ -81,6 +81,8 @@ is
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
vert_Id : Index_t := 0;
@@ -228,8 +230,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

45
3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.adb
View File

@@ -284,59 +284,16 @@ is
the_Primitive := Primitive.indexed .new_Primitive (Triangles, the_Indices);
the_Geometry := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => True);
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.Vertices_are (the_Vertices);
the_Geometry.Texture_is (Texture.Forge.to_Texture (Self.Font.gl_Texture));
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.is_Transparent;
-- the_Geometry.texture_Details_is (openGL.texture_Set.to_Details ([1 => to_Asset ("assets/textures/Face1.bmp")]));
return [1 => Geometry.view (the_Geometry)];
end;
end to_GL_Geometries;
------------
-- Texturing
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level)
-- is
-- begin
-- null;
-- end Fade_is;
--
--
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
-- is
-- begin
-- return 0.0;
-- end Fade;
--
--
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in openGL.asset_Name)
-- is
-- begin
-- null;
-- end Texture_is;
--
--
--
--
-- overriding
-- function texture_Count (Self : in Item) return Natural
-- is
-- begin
-- return 1;
-- end texture_Count;
end openGL.Model.Text.lit_colored;

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

@@ -8,6 +8,26 @@ is
package body Mixin
is
overriding
procedure texture_Object_is (Self : in out textured_Item; Which : in texture_Set.texture_Id;
Now : in openGL.texture.Object)
is
begin
Self.texture_Details.Objects (Integer (Which)) := Now;
end texture_Object_is;
overriding
function texture_Object (Self : in textured_Item; Which : in texture_Set.texture_Id) return openGL.texture.Object
is
begin
return Self.texture_Details.Objects (Integer (Which));
end texture_Object;
overriding
procedure Fade_is (Self : in out textured_Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)

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

@@ -18,6 +18,13 @@ is
is
type textured_Item is abstract new Item with private;
overriding
procedure texture_Object_is (Self : in out textured_Item; Which : in texture_Set.texture_Id;
Now : in openGL.texture.Object);
overriding
function texture_Object (Self : in textured_Item; Which : in texture_Set.texture_Id) return openGL.texture.Object;
overriding
function Fade (Self : in textured_Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;

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

@@ -104,7 +104,7 @@ is
procedure create_GL_Geometries (Self : in out Item'Class; Textures : access Texture.name_Map_of_texture'Class;
procedure create_GL_Geometries (Self : in out Item'Class; Textures : access openGL.Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font)
is
all_Geometries : constant Geometry.views := Self.to_GL_Geometries (Textures, Fonts);
@@ -222,6 +222,24 @@ is
use ada.Tags;
function texture_Object (Self : in Item; Which : in texture_Set.texture_Id) return openGL.texture.Object
is
begin
raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing.";
return openGL.Texture.null_Object;
end texture_Object;
procedure texture_Object_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.texture.Object)
is
begin
raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing.";
end texture_Object_is;
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is

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

@@ -74,6 +74,10 @@ is
-- Texturing
--
function texture_Object (Self : in Item; Which : in texture_Set.texture_Id) return texture.Object;
procedure texture_Object_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture.Object);
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);

25
3-mid/opengl/source/lean/opengl-texture_set.ads
View File

@@ -49,10 +49,10 @@ is
type fadeable_Texture is
record
Fade : fade_Level := 0.0;
-- Fade : fade_Level := 0.0;
Object : openGL.Texture.Object := openGL.Texture.null_Object;
Applied : Boolean := True; -- Whether this texture is painted on or not.
Tiling : texture_Set.Tiling := (1.0, 1.0);
-- Applied : Boolean := True; -- Whether this texture is painted on or not.
-- Tiling : texture_Set.Tiling := (1.0, 1.0);
end record;
type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;
@@ -100,12 +100,13 @@ is
type Details is
record
Fades : fade_Levels (texture_Id) := [others => 0.0];
Textures : asset_Names (1 .. Positive (texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the visual.
texture_Count : Natural := 0;
texture_Tilings : Tilings := [others => (S => 1.0,
T => 1.0)];
texture_Applies : texture_Apply_array := [1 => True, others => False];
Fades : fade_Levels (texture_Id) := [others => 0.0];
Textures : asset_Names (1 .. Positive (texture_Id'Last)) := [others => null_Asset];
Objects : texture.Objects (1 .. Positive (texture_Id'Last)) := [others => texture.null_Object];
texture_Count : Natural := 0;
texture_Tilings : Tilings := [others => (S => 1.0,
T => 1.0)];
texture_Applies : texture_Apply_array := [1 => True, others => False]; -- The textures to be applied to the visual.
Animation : Animation_view;
end record;
@@ -126,12 +127,12 @@ is
Textures : fadeable_Textures;
Count : Natural := 0;
is_Transparent : Boolean := False; -- Any of the textures contains lucid colors.
initialised : Boolean := False;
-- initialised : Boolean := False;
end record;
procedure Texture_is (in_Set : in out Item; Which : texture_ID := 1; Now : in openGL.Texture.Object);
function Texture (in_Set : in Item; Which : texture_ID := 1) return openGL.Texture.Object;
-- procedure Texture_is (in_Set : in out Item; Which : texture_ID := 1; Now : in openGL.Texture.Object);
-- function Texture (in_Set : in Item; Which : texture_ID := 1) return openGL.Texture.Object;