opengl: Fix simple warnings and cosmetics.

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

View File

@@ -3,9 +3,7 @@ with
openGL.Visual,
openGL.Light,
openGL.Palette,
openGL.Demo,
ada.Text_IO;
openGL.Demo;
procedure launch_render_Models
@@ -16,8 +14,7 @@ is
use openGL,
openGL.Math,
openGL.linear_Algebra_3D,
openGL.Palette,
ada.Text_IO;
openGL.Palette;
begin
Demo.print_Usage ("Use space ' ' to cycle through models.");

View File

@@ -1,6 +1,5 @@
with openGL.Model.texturing;
with openGL.texture_Set;
with
openGL.texture_Set,
openGL.Palette,
openGL.Font,
openGL.IO,

View File

@@ -1,14 +1,11 @@
with
openGL.Program.lit,
openGL.Palette,
openGL.Shader,
openGL.Buffer.general,
openGL.Attribute,
openGL.Texture,
openGL.Tasks,
openGL.Errors,
GL.Binding,
GL.lean,
GL.Pointers,
@@ -18,8 +15,7 @@ with
package body openGL.Geometry.lit_colored_textured
is
use openGL.texture_Set,
GL.lean,
use GL.lean,
GL.Pointers,
Interfaces,
System;
@@ -64,7 +60,6 @@ is
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);
white_Texture : openGL.Texture.Object;
---------
@@ -81,8 +76,7 @@ is
procedure define (the_Program : access Program;
use_fragment_Shader : in String)
is
use openGL.Palette,
Attribute.Forge,
use Attribute.Forge,
system.Storage_Elements;
Sample : Vertex;
@@ -93,10 +87,7 @@ is
Attribute_4 : openGL.Attribute.view;
Attribute_5 : openGL.Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
the_Program.Program := new openGL.Program.lit.item;
the_Program.vertex_Shader.define (Shader.Vertex, "assets/opengl/shader/lit_colored_textured.vert");
@@ -288,6 +279,7 @@ is
end Vertices_are;
overriding
procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive)
@@ -297,93 +289,4 @@ is
end Indices_are;
--- Texturing
--
-- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
-- is
-- begin
-- Self.Textures.Textures (Which).Fade := Now;
-- end Fade_is;
--
--
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.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 openGL.texture_Set.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 openGL.texture_Set.Texture (in_Set => Self.Textures,
-- which => 1);
-- end Texture;
--
--
--
-- overriding
-- procedure enable_Textures (Self : in out Item)
-- is
-- begin
-- enable (Self.Textures, Self.Program);
-- end enable_Textures;
--
-- overriding
-- procedure enable_Texture (Self : in out Item)
-- is
-- use GL,
-- GL.Binding,
-- openGL.Texture;
-- begin
-- Tasks.check;
--
-- glActiveTexture (gl.GL_TEXTURE0);
-- Errors.log;
--
-- if Self.Texture = openGL.Texture.null_Object
-- then enable (white_Texture);
-- else enable (Self.Texture);
-- end if;
-- end enable_Texture;
end openGL.Geometry.lit_colored_textured;

View File

@@ -1,7 +1,3 @@
with
openGL.texture_Set;
-- private
with
openGL.Geometry.texturing;
@@ -47,25 +43,6 @@ is
procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive);
--- Texturing.
--
-- procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
-- Which : in texture_Set.texture_ID := 1);
-- function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level;
--
--
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object;
-- Which : in texture_Set.texture_ID);
-- function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) 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
@@ -75,13 +52,4 @@ private
end record;
-- type Item is new Geometry.item with
-- record
-- Textures : texture_Set.Item;
-- end record;
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.lit_colored_textured;

View File

@@ -2,12 +2,9 @@ with
openGL.Shader,
openGL.Attribute,
openGL.Buffer.general,
openGL.Texture,
openGL.Palette,
openGL.Tasks,
openGL.Errors,
GL.Binding,
GL.lean,
GL.Pointers,
@@ -51,7 +48,6 @@ is
Attribute_6_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_6_Name'Access);
Attribute_7_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_7_Name'Access);
white_Texture : openGL.Texture.Object;
----------
@@ -93,8 +89,7 @@ is
procedure define_Program
is
use Palette,
Attribute.Forge,
use Attribute.Forge,
GL.lean,
GL.Pointers,
System.storage_Elements;
@@ -109,8 +104,6 @@ is
Attribute_6 : openGL.Attribute.view;
Attribute_7 : openGL.Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin
Tasks.check;
@@ -123,8 +116,6 @@ is
-- Define the shaders and program.
--
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_colored_textured_skinned.vert");
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/lighting-frag.snippet"),
@@ -242,6 +233,7 @@ is
end define_Program;
--------------
-- Attributes
--

View File

@@ -1,6 +1,5 @@
with
openGL.Program.lit.colored_textured_skinned,
openGL.texture_Set;
openGL.Program.lit.colored_textured_skinned;
private
@@ -8,7 +7,6 @@ with
openGL.Geometry.texturing;
package openGL.Geometry.lit_colored_textured_skinned
--
-- Supports 'per-vertex' site, color, texture, lighting and skinning.
@@ -67,9 +65,4 @@ private
end record;
-- type Item is new Geometry.item with null record;
--
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.lit_colored_textured_skinned;

View File

@@ -1,30 +1,22 @@
with
openGL.Geometry.texturing,
openGL.Buffer.general,
openGL.Model,
openGL.Shader,
openGL.Program.lit,
openGL.Attribute,
openGL.Texture,
openGL.Palette,
openGL.Tasks,
openGL.Errors,
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
is
use GL.lean,
GL.Pointers,
openGL.texture_Set,
Interfaces;
-----------
@@ -35,7 +27,6 @@ is
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";
@@ -52,8 +43,6 @@ is
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);
-- texture_Uniforms : texturing.Uniforms;
---------
@@ -62,8 +51,7 @@ is
procedure create_Program
is
use Palette,
Attribute.Forge,
use Attribute.Forge,
System.storage_Elements;
use type system.Address;
@@ -75,11 +63,7 @@ is
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.snippet"),
@@ -150,27 +134,6 @@ is
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
-- texture_Uniforms.Textures (Id).texture_Uniform := the_Program.uniform_Variable (named => texture_uniform_Name);
-- texture_Uniforms.Textures (Id). fade_Uniform := the_Program.uniform_Variable (named => fade_uniform_Name);
-- end;
-- end loop;
--
-- texture_Uniforms.Count := the_Program.uniform_Variable ("texture_Count");
textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
end create_Program;
@@ -291,75 +254,4 @@ is
end Indices_are;
--- Texturing
--
-- procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in texture_Set.fade_Level)
-- is
-- begin
-- Self.texture_Set.Textures (which).Fade := Now;
-- end Fade_is;
--
--
--
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level
-- is
-- begin
-- return Self.texture_Set.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.texture_Set,
-- Which => Which,
-- Now => Now);
-- end Texture_is;
--
--
--
-- function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
-- is
-- begin
-- return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
-- Which => Which);
-- end Texture;
--
--
--
-- overriding
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
-- is
-- begin
-- Texture_is (in_Set => Self.texture_Set,
-- Now => Now);
-- end Texture_is;
--
--
--
-- overriding
-- function Texture (Self : in Item) return openGL.Texture.Object
-- is
-- begin
-- return texture_Set.Texture (in_Set => Self.texture_Set,
-- Which => 1);
-- end Texture;
-- overriding
-- 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);
-- end enable_Textures;
end openGL.Geometry.lit_textured;

View File

@@ -1,6 +1,3 @@
with
openGL.texture_Set;
private
with
openGL.Geometry.texturing;
@@ -46,24 +43,6 @@ is
for_Facia : in Positive);
--- Texturing.
--
-- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level);
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level;
--
--
-- procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object);
-- function Texture (Self : in Item; Which : texture_Set.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
package textured_Geometry is new texturing.Mixin;
@@ -75,7 +54,4 @@ private
end record;
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.lit_textured;

View File

@@ -2,12 +2,9 @@ with
openGL.Shader,
openGL.Attribute,
openGL.Buffer.general,
openGL.Texture,
openGL.Palette,
openGL.Tasks,
openGL.Errors,
GL.Binding,
GL.lean,
GL.Pointers,
@@ -49,7 +46,6 @@ is
Attribute_5_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_5_Name'Access);
Attribute_6_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_6_Name'Access);
white_Texture : openGL.Texture.Object;
----------
@@ -83,8 +79,7 @@ is
procedure define_Program
is
use Palette,
Attribute.Forge,
use Attribute.Forge,
GL.lean,
GL.Pointers,
System.storage_Elements;
@@ -98,8 +93,6 @@ is
Attribute_5 : openGL.Attribute.view;
Attribute_6 : openGL.Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin
Tasks.check;
@@ -112,8 +105,6 @@ is
-- Define the shaders and program.
--
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured_skinned.vert");
-- fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured_skinned.frag");
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),

View File

@@ -1,6 +1,5 @@
with
openGL.Program.lit.textured_skinned,
openGL.texture_Set;
openGL.Program.lit.textured_skinned;
private
with
@@ -65,9 +64,4 @@ private
end record;
-- type Item is new Geometry.item with null record;
--
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.lit_textured_skinned;

View File

@@ -2,9 +2,7 @@ with
openGL.Buffer.general,
openGL.Shader,
openGL.Program,
openGL.Palette,
openGL.Attribute,
openGL.Texture,
openGL.Tasks,
GL.lean,
GL.Pointers,
@@ -19,8 +17,6 @@ is
use GL.lean,
GL.Pointers,
openGL.texture_Set,
Interfaces,
System;
@@ -33,7 +29,6 @@ is
fragment_Shader : aliased Shader.item;
the_Program : openGL.Program.view;
white_Texture : openGL.Texture.Object;
Name_1 : constant String := "Site";
Name_2 : constant String := "Coords";
@@ -61,8 +56,7 @@ is
if the_Program = null
then -- Define the shaders and program.
declare
use Palette,
Attribute.Forge,
use Attribute.Forge,
system.Storage_Elements;
Sample : Vertex;
@@ -70,11 +64,7 @@ is
Attribute_1 : Attribute.view;
Attribute_2 : Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.vertex, "assets/opengl/shader/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.snippet"),
@@ -170,91 +160,4 @@ is
end Indices_are;
--- Texturing
--
-- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level)
-- is
-- begin
-- Self.Textures.Textures (Which).Fade := Now;
-- end Fade_is;
--
--
--
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.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 openGL.texture_Set.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 openGL.texture_Set.Texture (in_Set => Self.Textures,
-- which => 1);
-- end Texture;
--
--
--
-- overriding
-- procedure enable_Textures (Self : in out Item)
-- is
-- begin
-- enable (Self.Textures, Self.Program);
-- end enable_Textures;
-- overriding
-- procedure enable_Texture (Self : in out Item)
-- is
-- use GL,
-- GL.Binding,
-- openGL.Texture;
-- begin
-- Tasks.check;
--
-- glActiveTexture (gl.GL_TEXTURE0);
-- Errors.log;
--
-- if Self.Texture = openGL.Texture.null_Object
-- then white_Texture.enable;
-- else Self.Texture .enable;
-- end if;
-- end enable_Texture;
end openGL.Geometry.textured;

View File

@@ -1,7 +1,3 @@
with
openGL.texture_Set;
private
with
openGL.Geometry.texturing;
@@ -45,24 +41,6 @@ is
for_Facia : in Positive);
--- Texturing.
--
-- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level);
-- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level;
--
--
-- procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object);
-- function Texture (Self : in Item; Which : texture_Set.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
package textured_Geometry is new texturing.Mixin;
@@ -74,13 +52,4 @@ private
end record;
-- type Item is new Geometry.item with
-- record
-- Textures : texture_Set.Item;
-- end record;
--
--
-- overriding
-- procedure enable_Textures (Self : in out Item);
end openGL.Geometry.textured;

View File

@@ -4,8 +4,6 @@ with
GL.Binding,
ada.Strings.fixed;
with ada.Text_IO;
package body openGL.Geometry.texturing
is
@@ -14,7 +12,7 @@ is
type texture_Units is array (texture_Set.texture_Id) of GLenum;
all_texture_Units : constant texture_Units := (GL_TEXTURE0,
all_texture_Units : constant texture_Units := [GL_TEXTURE0,
GL_TEXTURE1,
GL_TEXTURE2,
GL_TEXTURE3,
@@ -29,7 +27,7 @@ is
GL_TEXTURE12,
GL_TEXTURE13,
GL_TEXTURE14,
GL_TEXTURE15);
GL_TEXTURE15];
-- GL_TEXTURE16,
-- GL_TEXTURE17,
-- GL_TEXTURE18,

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;

View File

@@ -14,8 +14,6 @@ is
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);

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;

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;

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);

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;

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;

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;

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;

View File

@@ -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;

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,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;

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;

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;

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;

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;

View File

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

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;

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;

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;

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;
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;

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;

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.

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;

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;

View File

@@ -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;

View File

@@ -14,8 +14,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 +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.

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;

View File

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

View File

@@ -9,8 +9,6 @@ with
ada.unchecked_Deallocation;
with ada.Text_IO;
package body openGL.Texture
is
@@ -159,8 +157,7 @@ is
procedure set_Image (Self : in out Object; To : in Image;
use_Mipmaps : in Boolean := True)
is
use GL.Binding,
ada.Text_IO;
use GL.Binding;
the_Image : Image renames To;
min_Width : constant Positive := the_Image'Length (2);

View File

@@ -1,6 +1,3 @@
with
ada.unchecked_Conversion;
package openGL.Culler.frustum
--
-- Provides a frustrum culler.

View File

@@ -116,7 +116,6 @@ is
-- and False
then
declare
use ada.Text_IO;
compile_Log : constant String := Self.shader_info_Log;
begin
new_Line;
@@ -149,8 +148,7 @@ is
procedure define (Self : in out Item; Kind : in Shader.Kind;
shader_Snippets : in asset_Names)
is
use ada.Text_IO,
interfaces.C;
use interfaces.C;
the_Source : aliased constant C.char_array := to_C_char_array (shader_Snippets);
begin
@@ -251,8 +249,7 @@ is
function read_text_File (Filename : in String) return C.char_array
is
use ada.Text_IO,
ada.Strings.unbounded;
use ada.Strings.unbounded;
use type interfaces.C.size_t;

View File

@@ -1,6 +1,6 @@
with
ada.Strings.Hash,
ada.unchecked_Conversion;
ada.Strings.Hash;
package body openGL
is

View File

@@ -3,7 +3,6 @@ with
opengl.Display .privvy,
eGL.Binding,
interfaces.c.Strings,
System;