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

opengl: Fix simple warnings and cosmetics.

Browse Source
This commit is contained in:
Rod Kay
2025-09-20 12:31:05 +10:00
parent b679ac4bf5
commit f8cdf27998
46 changed files with 83 additions and 949 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -99,8 +99,6 @@ is
procedure set_side_Bits (Self : in out Item)
is
use linear_Algebra_3d;
End_1 : Vector_3 renames Self.Vertices (1).Site;
End_2 : Vector_3 renames Self.Vertices (2).Site;

5
3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.ads
View File

@@ -11,11 +11,9 @@ package openGL.Model.billboard.colored_textured
-- Models a colored, textured billboard.
--
is
package textured_Model is new texturing.Mixin (openGL.Model.billboard.item);
package textured_Model is new texturing.Mixin (openGL.Model.billboard.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.billboard.item with private;
type View is access all Item'Class;
@@ -51,7 +49,6 @@ is
private
type Item is new textured_Model.textured_item with
-- type Item is new Model.billboard.item with
record
Color : lucid_Color := (Palette.White, Opaque);

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

@@ -200,47 +200,4 @@ is
end Image_is;
------------
-- 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.billboard.textured;

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

@@ -12,7 +12,6 @@ is
package textured_Model is new texturing.Mixin (openGL.Model.billboard.item);
type Item (Lucid : Boolean) is new textured_Model.textured_item with private;
-- type Item (Lucid : Boolean) is new Model.billboard.item with private;
type View is access all Item'Class;
type Image_view is access Image;
@@ -51,28 +50,9 @@ is
procedure Image_is (Self : in out Item; Now : in lucid_Image);
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level);
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in asset_Name);
--
-- overriding
-- function texture_Count (Self : in Item) return Natural;
private
-- type Item (Lucid : Boolean) is new Model.billboard.item with
type Item (Lucid : Boolean) is new textured_Model.textured_item with
record
texture_Name : asset_Name := null_Asset;

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

@@ -73,7 +73,7 @@ is
the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
:= [1 => (Site => the_Sites ( Left_Lower_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
2 => (Site => the_Sites (Right_Lower_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
3 => (Site => the_Sites (right_upper_front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
3 => (Site => the_Sites (Right_Upper_front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
4 => (Site => the_Sites ( Left_Upper_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine)];
begin
front_Face := new_Face (Vertices => the_Vertices'Access);

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

@@ -15,7 +15,6 @@ package openGL.Model.Box.lit_colored_textured
is
package textured_Model is new texturing.Mixin (openGL.Model.box.item);
-- type Item is new Model.box.item with private;
type Item is new textured_Model.textured_item with private;
type View is access all Item'Class;
@@ -48,7 +47,6 @@ is
private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with
record
Faces : lit_colored_textured.Faces;

2
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.ads
View File

@@ -15,7 +15,6 @@ package openGL.Model.Box.lit_colored_textured_x1
is
package textured_Model is new texturing.Mixin (openGL.Model.box.item);
-- type Item is new Model.box.item with private;
type Item is new textured_Model.textured_item with private;
type View is access all Item'Class;
@@ -48,7 +47,6 @@ is
private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with
record
Faces : lit_colored_textured_x1.Faces;

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

@@ -194,48 +194,4 @@ is
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.box.lit_textured;

22
3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.ads
View File

@@ -15,7 +15,6 @@ is
package textured_Model is new texturing.Mixin (openGL.Model.box.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.box.item with private;
type View is access all Item'Class;
@@ -45,31 +44,12 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level);
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in asset_Name);
--
-- overriding
-- function texture_Count (Self : in Item) return Natural;
private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with
record
Faces : lit_textured.Faces;
end record;
end openGL.Model.Box.lit_textured;

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

@@ -9,10 +9,10 @@ is
--- Forge
--
function new_Box (Size : in Vector_3;
Faces : in textured.Faces;
function new_Box (Size : in Vector_3;
Faces : in textured.Faces;
texture_Details : in texture_Set.Details;
is_Skybox : in Boolean := False) return View
is_Skybox : in Boolean := False) return View
is
Self : constant View := new Item;
begin
@@ -200,46 +200,4 @@ is
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.box.textured;

27
3-mid/opengl/source/lean/model/opengl-model-box-textured.ads
View File

@@ -15,7 +15,6 @@ is
package textured_Model is new texturing.Mixin (openGL.Model.box.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.box.item with private;
type View is access all Item'Class;
@@ -31,10 +30,10 @@ is
--- Forge
--
function new_Box (Size : in Vector_3;
Faces : in textured.Faces;
function new_Box (Size : in Vector_3;
Faces : in textured.Faces;
texture_Details : in texture_Set.Details;
is_Skybox : in Boolean := False) return View;
is_Skybox : in Boolean := False) return View;
--------------
@@ -45,32 +44,14 @@ is
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;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level);
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in asset_Name);
--
-- overriding
-- function texture_Count (Self : in Item) return Natural;
private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with
record
Faces : textured.Faces;
is_Skybox : Boolean := False;
end record;
end openGL.Model.Box.textured;

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

@@ -10,7 +10,6 @@ package openGL.Model.capsule.lit_colored_textured
is
package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
-- type Item is new Model.capsule.item with private;
type Item is new textured_Model.textured_item with private;
type View is access all Item'Class;
@@ -36,8 +35,6 @@ is
private
-- type Item is new Model.capsule.item with
type Item is new textured_Model.textured_item with
record
Radius : Real;
@@ -47,4 +44,5 @@ private
Image : asset_Name := null_Asset;
end record;
end openGL.Model.capsule.lit_colored_textured;

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

@@ -32,9 +32,6 @@ is
--- Attributes
--
-- type Geometry_view is access all Geometry.lit_textured.item'Class;
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
@@ -407,45 +404,4 @@ is
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.capsule.lit_textured;

22
3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.ads
View File

@@ -11,7 +11,6 @@ is
package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.capsule.item with private;
type View is access all Item'Class;
@@ -33,28 +32,8 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level);
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in asset_Name);
--
-- overriding
-- function texture_Count (Self : in Item) return Natural;
private
-- type Item is new Model.capsule.item with
type Item is new textured_Model.textured_item with
record
Radius : Real;
@@ -63,4 +42,5 @@ private
Image : asset_Name := null_Asset;
end record;
end openGL.Model.capsule.lit_textured;

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

@@ -8,7 +8,6 @@ package openGL.Model.capsule.textured
-- Models a textured capsule.
--
is
-- type Item is new Model.capsule.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
type Item is new textured_Model.textured_item with private; type View is access all Item'Class;
@@ -35,7 +34,6 @@ is
private
-- type Item is new Model.capsule.item with
type Item is new textured_Model.textured_item with
record
Radius : Real;
@@ -44,4 +42,5 @@ private
Image : asset_Name := null_Asset;
end record;
end openGL.Model.capsule.textured;

1
3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads
View File

@@ -37,4 +37,5 @@ private
type Item is new textured_Model.textured_Item with null record;
end openGL.Model.circle.lit_textured;

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

@@ -39,7 +39,7 @@ is
Texture;
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_colored_textured.Vertex_array) return Geometry_view
@@ -66,13 +66,13 @@ is
--
declare
the_Vertices : constant Geometry.lit_colored_textured.Vertex_array
:= (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Color => +Self.Face.center_Color, Coords => (0.0, 0.0), Shine => default_Shine),
:= [1 => (Site => [0.0, 0.0, 0.0], Normal => Normal, Color => +Self.Face.center_Color, Coords => (0.0, 0.0), Shine => default_Shine),
2 => (Site => the_Sites (1), Normal => Normal, Color => +Self.Face.Colors (1), Coords => (0.0, 0.0), Shine => default_Shine),
3 => (Site => the_Sites (2), Normal => Normal, Color => +Self.Face.Colors (2), Coords => (1.0, 0.0), Shine => default_Shine),
4 => (Site => the_Sites (3), Normal => Normal, Color => +Self.Face.Colors (3), Coords => (1.0, 1.0), Shine => default_Shine),
5 => (Site => the_Sites (4), Normal => Normal, Color => +Self.Face.Colors (4), Coords => (0.0, 1.0), Shine => default_Shine),
6 => (Site => the_Sites (5), Normal => Normal, color => +Self.Face.Colors (5), Coords => (0.0, 1.0), Shine => default_Shine),
7 => (Site => the_Sites (6), Normal => Normal, Color => +Self.Face.Colors (6), Coords => (0.0, 1.0), Shine => default_Shine));
7 => (Site => the_Sites (6), Normal => Normal, Color => +Self.Face.Colors (6), Coords => (0.0, 1.0), Shine => default_Shine)];
begin
upper_Face := new_Face (Vertices => the_Vertices);
@@ -82,7 +82,7 @@ is
end if;
end;
return (1 => upper_Face.all'Access);
return [1 => upper_Face.all'Access];
end to_GL_Geometries;

11
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Texture;
openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon.lit_colored_textured
@@ -8,14 +9,16 @@ package openGL.Model.hexagon.lit_colored_textured
-- Models a lit, colored and textured hexagon.
--
is
type Item is new Model.item with private;
package textured_Model is new texturing.Mixin (Model.hexagon.item);
type Item is new textured_Model.textured_Item with private;
type View is access all Item'Class;
type Face is
record
center_Color : lucid_Color; -- The color at the center of the hex.
Colors : lucid_Colors (1 .. 6); -- The color at each of the hexes 6 vertices.
Texture : openGL.Texture.Object := openGL.Texture.null_Object; -- The texture to be applied to the hex..
Texture : openGL.Texture.Object := openGL.Texture.null_Object; -- The texture to be applied to the hex.
end record;
@@ -38,7 +41,7 @@ is
private
type Item is new Model.hexagon.item with
type Item is new textured_Model.textured_Item with
record
Face : lit_colored_textured.Face;
end record;

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

@@ -121,7 +121,7 @@ is
Texture;
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
@@ -166,19 +166,19 @@ is
--
declare
the_Vertices : constant Geometry.lit_textured.Vertex_array
:= (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Coords => (0.50, 0.50), Shine => default_Shine), -- Center.
:= [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.
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);
return [1 => upper_Face.all'Access];
end to_GL_Geometries;

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

@@ -1,6 +1,7 @@
with
openGL.texture_Set,
openGL.Texture;
openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon.lit_textured
@@ -8,26 +9,18 @@ package openGL.Model.hexagon.lit_textured
-- Models a lit and textured hexagon.
--
is
type Item is new Model.item with private;
package textured_Model is new texturing.Mixin (Model.hexagon.item);
type Item is new textured_Model.textured_Item with private;
type View is access all Item'Class;
type Face is
record
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
texture_Count : Natural := 0;
texture_Applies : texture_Set.texture_Apply_array := [others => True];
Animation : texture_Set.Animation_view;
end record;
---------
--- Forge
--
function new_Hexagon (Radius : in Real;
Face : in lit_textured.Face) return View;
function new_Hexagon (Radius : in Real;
texture_Details : in texture_Set.Details) return View;
--------------
@@ -38,41 +31,10 @@ is
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;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
overriding
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean;
overriding
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in Boolean);
overriding
procedure animate (Self : in out Item);
private
type Item is new Model.hexagon.item with
record
Face : lit_textured.Face;
end record;
type Item is new textured_Model.textured_Item with null record;
end openGL.Model.hexagon.lit_textured;

10
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Texture;
openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon_Column.lit_colored_textured_faceted
@@ -8,7 +9,10 @@ package openGL.Model.hexagon_Column.lit_colored_textured_faceted
-- Models a lit, colored and textured column with 6 faceted shaft sides.
--
is
type Item is new Model.hexagon_Column.Item with private;
package textured_Model is new texturing.Mixin (Model.hexagon_Column.item);
type Item is new textured_Model.textured_Item with private;
type View is access all Item'Class;
@@ -51,7 +55,7 @@ is
private
type Item is new Model.hexagon_Column.item with
type Item is new textured_Model.textured_Item with
record
upper_Face,
lower_Face : hex_Face;

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

@@ -77,12 +77,12 @@ 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)));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
the_Geometry.Texture_is (Which => Id,
Now => Textures.fetch (Self.texture_Details.Textures (i)));
the_Geometry.is_Transparent (Now => the_Geometry.Texture.is_Transparent);
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.

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

@@ -207,46 +207,4 @@ is
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
-- Self.Image := Now;
-- end Texture_is;
--
--
--
-- overriding
-- function texture_Count (Self : in Item) return Natural
-- is
-- begin
-- return 1;
-- end texture_Count;
end openGL.Model.sphere.lit_colored_textured;

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

@@ -13,7 +13,6 @@ is
package textured_Model is new texturing.Mixin (openGL.Model.sphere.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.sphere.item with private;
type View is access all Item'Class;
@@ -31,28 +30,8 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level);
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in asset_Name);
--
-- overriding
-- function texture_Count (Self : in Item) return Natural;
private
-- type Item is new Model.sphere.item with -- TODO: Add 'Color' component.
type Item is new textured_Model.textured_item with
record
Color : openGL.lucid_Color;

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

@@ -9,11 +9,11 @@ is
--- Forge
--
function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count;
function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count;
texture_Details : in texture_Set.Details;
Image : in asset_Name := null_Asset) return View
Image : in asset_Name := null_Asset) return View
is
Self : constant View := new Item;
begin
@@ -194,47 +194,4 @@ is
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
-- Self.Image := Now;
-- end Texture_is;
--
--
--
-- overriding
-- function texture_Count (Self : in Item) return Natural
-- is
-- begin
-- return 1;
-- end texture_Count;
end openGL.Model.sphere.lit_textured;

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

@@ -14,16 +14,14 @@ is
package textured_Model is new texturing.Mixin (openGL.Model.sphere.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.sphere.item with private;
type View is access all Item'Class;
function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count;
function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count;
texture_Details : in texture_Set.Details;
Image : in asset_Name := null_Asset) return View;
Image : in asset_Name := null_Asset) return View;
overriding
@@ -31,28 +29,8 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level);
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in asset_Name);
--
-- overriding
-- function texture_Count (Self : in Item) return Natural;
private
-- type Item is new Model.sphere.item with
type Item is new textured_Model.textured_item with
record
Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere.

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

@@ -12,7 +12,6 @@ is
package textured_Model is new texturing.Mixin (openGL.Model.sphere.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.sphere.item with private;
type View is access all Item'Class;
@@ -38,11 +37,11 @@ is
private
-- type Item is new Model.sphere.item with
type Item is new textured_Model.textured_item with
record
Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere.
is_Skysphere : Boolean := False;
end record;
end openGL.Model.sphere.textured;

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

@@ -1,13 +1,5 @@
with
GL.lean,
GL.Binding,
ada.Strings.fixed;
package body openGL.Model.texturing
is
use GL;
-------------
--- Mixin ---