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

7
3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb
View File

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

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

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

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

@@ -1,14 +1,11 @@
with with
openGL.Program.lit, openGL.Program.lit,
openGL.Palette,
openGL.Shader, openGL.Shader,
openGL.Buffer.general, openGL.Buffer.general,
openGL.Attribute, openGL.Attribute,
openGL.Texture,
openGL.Tasks, openGL.Tasks,
openGL.Errors, openGL.Errors,
GL.Binding,
GL.lean, GL.lean,
GL.Pointers, GL.Pointers,
@@ -18,8 +15,7 @@ with
package body openGL.Geometry.lit_colored_textured package body openGL.Geometry.lit_colored_textured
is is
use openGL.texture_Set, use GL.lean,
GL.lean,
GL.Pointers, GL.Pointers,
Interfaces, Interfaces,
System; 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_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); 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; procedure define (the_Program : access Program;
use_fragment_Shader : in String) use_fragment_Shader : in String)
is is
use openGL.Palette, use Attribute.Forge,
Attribute.Forge,
system.Storage_Elements; system.Storage_Elements;
Sample : Vertex; Sample : Vertex;
@@ -93,10 +87,7 @@ is
Attribute_4 : openGL.Attribute.view; Attribute_4 : openGL.Attribute.view;
Attribute_5 : openGL.Attribute.view; Attribute_5 : openGL.Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
the_Program.Program := new openGL.Program.lit.item; the_Program.Program := new openGL.Program.lit.item;
the_Program.vertex_Shader.define (Shader.Vertex, "assets/opengl/shader/lit_colored_textured.vert"); the_Program.vertex_Shader.define (Shader.Vertex, "assets/opengl/shader/lit_colored_textured.vert");
@@ -288,6 +279,7 @@ is
end Vertices_are; end Vertices_are;
overriding overriding
procedure Indices_are (Self : in out Item; Now : in Indices; procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive) for_Facia : in Positive)
@@ -297,93 +289,4 @@ is
end Indices_are; 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; end openGL.Geometry.lit_colored_textured;

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

@@ -1,7 +1,3 @@
with
openGL.texture_Set;
-- private
with with
openGL.Geometry.texturing; openGL.Geometry.texturing;
@@ -47,25 +43,6 @@ is
procedure Indices_are (Self : in out Item; Now : in Indices; procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive); for_Facia : in Positive);
--- 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 private
@@ -75,13 +52,4 @@ private
end record; 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; end openGL.Geometry.lit_colored_textured;

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

@@ -2,12 +2,9 @@ with
openGL.Shader, openGL.Shader,
openGL.Attribute, openGL.Attribute,
openGL.Buffer.general, openGL.Buffer.general,
openGL.Texture,
openGL.Palette,
openGL.Tasks, openGL.Tasks,
openGL.Errors, openGL.Errors,
GL.Binding,
GL.lean, GL.lean,
GL.Pointers, 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_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); 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 procedure define_Program
is is
use Palette, use Attribute.Forge,
Attribute.Forge,
GL.lean, GL.lean,
GL.Pointers, GL.Pointers,
System.storage_Elements; System.storage_Elements;
@@ -109,8 +104,6 @@ is
Attribute_6 : openGL.Attribute.view; Attribute_6 : openGL.Attribute.view;
Attribute_7 : openGL.Attribute.view; Attribute_7 : openGL.Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin begin
Tasks.check; Tasks.check;
@@ -123,8 +116,6 @@ is
-- Define the shaders and program. -- 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"); 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"), fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/lighting-frag.snippet"), 2 => to_Asset ("assets/opengl/shader/lighting-frag.snippet"),
@@ -242,6 +233,7 @@ is
end define_Program; end define_Program;
-------------- --------------
-- Attributes -- Attributes
-- --

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

@@ -1,6 +1,5 @@
with with
openGL.Program.lit.colored_textured_skinned, openGL.Program.lit.colored_textured_skinned;
openGL.texture_Set;
private private
@@ -8,7 +7,6 @@ with
openGL.Geometry.texturing; openGL.Geometry.texturing;
package openGL.Geometry.lit_colored_textured_skinned package openGL.Geometry.lit_colored_textured_skinned
-- --
-- Supports 'per-vertex' site, color, texture, lighting and skinning. -- Supports 'per-vertex' site, color, texture, lighting and skinning.
@@ -67,9 +65,4 @@ private
end record; 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; end openGL.Geometry.lit_colored_textured_skinned;

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

@@ -1,30 +1,22 @@
with with
openGL.Geometry.texturing,
openGL.Buffer.general, openGL.Buffer.general,
openGL.Model,
openGL.Shader, openGL.Shader,
openGL.Program.lit, openGL.Program.lit,
openGL.Attribute, openGL.Attribute,
openGL.Texture,
openGL.Palette,
openGL.Tasks, openGL.Tasks,
openGL.Errors, openGL.Errors,
GL.lean, GL.lean,
GL.Pointers, GL.Pointers,
ada.Strings.fixed,
Interfaces.C.Strings, Interfaces.C.Strings,
System.storage_Elements; System.storage_Elements;
-- with ada.Text_IO; use ada.Text_IO;
package body openGL.Geometry.lit_textured package body openGL.Geometry.lit_textured
is is
use GL.lean, use GL.lean,
GL.Pointers, GL.Pointers,
openGL.texture_Set,
Interfaces; Interfaces;
----------- -----------
@@ -34,8 +26,7 @@ is
vertex_Shader : aliased Shader.item; vertex_Shader : aliased Shader.item;
fragment_Shader : aliased Shader.item; fragment_Shader : aliased Shader.item;
the_Program : openGL.Program.lit.view; the_Program : openGL.Program.lit.view;
white_Texture : openGL.Texture.Object;
Name_1 : constant String := "Site"; Name_1 : constant String := "Site";
Name_2 : constant String := "Normal"; 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_3_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_3_Name'Access);
Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access); Attribute_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 procedure create_Program
is is
use Palette, use Attribute.Forge,
Attribute.Forge,
System.storage_Elements; System.storage_Elements;
use type system.Address; use type system.Address;
@@ -75,11 +63,7 @@ is
Attribute_3 : Attribute.view; Attribute_3 : Attribute.view;
Attribute_4 : Attribute.view; Attribute_4 : Attribute.view;
white_Image : constant Image := [1 .. 2 => [1 .. 2 => +White]];
begin begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured.vert"); 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"), fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"), 2 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
@@ -150,27 +134,6 @@ is
name => +Attribute_4_Name_ptr); name => +Attribute_4_Name_ptr);
Errors.log; 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); textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
end create_Program; end create_Program;
@@ -291,75 +254,4 @@ is
end Indices_are; 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; end openGL.Geometry.lit_textured;

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

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

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

@@ -2,12 +2,9 @@ with
openGL.Shader, openGL.Shader,
openGL.Attribute, openGL.Attribute,
openGL.Buffer.general, openGL.Buffer.general,
openGL.Texture,
openGL.Palette,
openGL.Tasks, openGL.Tasks,
openGL.Errors, openGL.Errors,
GL.Binding,
GL.lean, GL.lean,
GL.Pointers, 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_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); 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 procedure define_Program
is is
use Palette, use Attribute.Forge,
Attribute.Forge,
GL.lean, GL.lean,
GL.Pointers, GL.Pointers,
System.storage_Elements; System.storage_Elements;
@@ -98,8 +93,6 @@ is
Attribute_5 : openGL.Attribute.view; Attribute_5 : openGL.Attribute.view;
Attribute_6 : openGL.Attribute.view; Attribute_6 : openGL.Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin begin
Tasks.check; Tasks.check;
@@ -112,8 +105,6 @@ is
-- Define the shaders and program. -- 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"); 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, "assets/opengl/shader/lit_textured_skinned.frag");
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"), fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),

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

@@ -1,6 +1,5 @@
with with
openGL.Program.lit.textured_skinned, openGL.Program.lit.textured_skinned;
openGL.texture_Set;
private private
with with
@@ -65,9 +64,4 @@ private
end record; 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; end openGL.Geometry.lit_textured_skinned;

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

@@ -2,9 +2,7 @@ with
openGL.Buffer.general, openGL.Buffer.general,
openGL.Shader, openGL.Shader,
openGL.Program, openGL.Program,
openGL.Palette,
openGL.Attribute, openGL.Attribute,
openGL.Texture,
openGL.Tasks, openGL.Tasks,
GL.lean, GL.lean,
GL.Pointers, GL.Pointers,
@@ -19,8 +17,6 @@ is
use GL.lean, use GL.lean,
GL.Pointers, GL.Pointers,
openGL.texture_Set,
Interfaces, Interfaces,
System; System;
@@ -33,7 +29,6 @@ is
fragment_Shader : aliased Shader.item; fragment_Shader : aliased Shader.item;
the_Program : openGL.Program.view; the_Program : openGL.Program.view;
white_Texture : openGL.Texture.Object;
Name_1 : constant String := "Site"; Name_1 : constant String := "Site";
Name_2 : constant String := "Coords"; Name_2 : constant String := "Coords";
@@ -61,8 +56,7 @@ is
if the_Program = null if the_Program = null
then -- Define the shaders and program. then -- Define the shaders and program.
declare declare
use Palette, use Attribute.Forge,
Attribute.Forge,
system.Storage_Elements; system.Storage_Elements;
Sample : Vertex; Sample : Vertex;
@@ -70,11 +64,7 @@ is
Attribute_1 : Attribute.view; Attribute_1 : Attribute.view;
Attribute_2 : Attribute.view; Attribute_2 : Attribute.view;
white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
begin begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.vertex, "assets/opengl/shader/textured.vert"); 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"), fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"), 2 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
@@ -170,91 +160,4 @@ is
end Indices_are; 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; end openGL.Geometry.textured;

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

@@ -1,7 +1,3 @@
with
openGL.texture_Set;
private private
with with
openGL.Geometry.texturing; openGL.Geometry.texturing;
@@ -45,24 +41,6 @@ is
for_Facia : in Positive); 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 private
package textured_Geometry is new texturing.Mixin; package textured_Geometry is new texturing.Mixin;
@@ -74,13 +52,4 @@ private
end record; 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; end openGL.Geometry.textured;

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

@@ -4,8 +4,6 @@ with
GL.Binding, GL.Binding,
ada.Strings.fixed; ada.Strings.fixed;
with ada.Text_IO;
package body openGL.Geometry.texturing package body openGL.Geometry.texturing
is is
@@ -14,7 +12,7 @@ is
type texture_Units is array (texture_Set.texture_Id) of GLenum; 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_TEXTURE1,
GL_TEXTURE2, GL_TEXTURE2,
GL_TEXTURE3, GL_TEXTURE3,
@@ -29,7 +27,7 @@ is
GL_TEXTURE12, GL_TEXTURE12,
GL_TEXTURE13, GL_TEXTURE13,
GL_TEXTURE14, GL_TEXTURE14,
GL_TEXTURE15); GL_TEXTURE15];
-- GL_TEXTURE16, -- GL_TEXTURE16,
-- GL_TEXTURE17, -- GL_TEXTURE17,
-- GL_TEXTURE18, -- GL_TEXTURE18,

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) procedure set_side_Bits (Self : in out Item)
is is
use linear_Algebra_3d;
End_1 : Vector_3 renames Self.Vertices (1).Site; End_1 : Vector_3 renames Self.Vertices (1).Site;
End_2 : Vector_3 renames Self.Vertices (2).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. -- Models a colored, textured billboard.
-- --
is 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 textured_Model.textured_item with private;
-- type Item is new Model.billboard.item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -51,7 +49,6 @@ is
private private
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
-- type Item is new Model.billboard.item with
record record
Color : lucid_Color := (Palette.White, Opaque); 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; 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; 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); 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 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 View is access all Item'Class;
type Image_view is access Image; type Image_view is access Image;
@@ -51,28 +50,9 @@ is
procedure Image_is (Self : in out Item; Now : in lucid_Image); 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 private
-- type Item (Lucid : Boolean) is new Model.billboard.item with
type Item (Lucid : Boolean) is new textured_Model.textured_item with type Item (Lucid : Boolean) is new textured_Model.textured_item with
record record
texture_Name : asset_Name := null_Asset; 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 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), := [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), 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)]; 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 begin
front_Face := new_Face (Vertices => the_Vertices'Access); 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 is
package textured_Model is new texturing.Mixin (openGL.Model.box.item); 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 Item is new textured_Model.textured_item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -48,7 +47,6 @@ is
private private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Faces : lit_colored_textured.Faces; 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 is
package textured_Model is new texturing.Mixin (openGL.Model.box.item); 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 Item is new textured_Model.textured_item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -48,7 +47,6 @@ is
private private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Faces : lit_colored_textured_x1.Faces; 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; 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; 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); 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 textured_Model.textured_item with private;
-- type Item is new Model.box.item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -45,31 +44,12 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views; Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in 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 private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Faces : lit_textured.Faces; Faces : lit_textured.Faces;
end record; end record;
end openGL.Model.Box.lit_textured; 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 --- Forge
-- --
function new_Box (Size : in Vector_3; function new_Box (Size : in Vector_3;
Faces : in textured.Faces; Faces : in textured.Faces;
texture_Details : in texture_Set.Details; texture_Details : in texture_Set.Details;
is_Skybox : in Boolean := False) return View is_Skybox : in Boolean := False) return View
is is
Self : constant View := new Item; Self : constant View := new Item;
begin begin
@@ -200,46 +200,4 @@ is
end to_GL_Geometries; 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; 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); 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 textured_Model.textured_item with private;
-- type Item is new Model.box.item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -31,10 +30,10 @@ is
--- Forge --- Forge
-- --
function new_Box (Size : in Vector_3; function new_Box (Size : in Vector_3;
Faces : in textured.Faces; Faces : in textured.Faces;
texture_Details : in texture_Set.Details; 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; function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views; Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in 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 private
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Faces : textured.Faces; Faces : textured.Faces;
is_Skybox : Boolean := False; is_Skybox : Boolean := False;
end record; end record;
end openGL.Model.Box.textured; 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 is
package textured_Model is new texturing.Mixin (openGL.Model.capsule.item); 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 Item is new textured_Model.textured_item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -36,8 +35,6 @@ is
private private
-- type Item is new Model.capsule.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Radius : Real; Radius : Real;
@@ -47,4 +44,5 @@ private
Image : asset_Name := null_Asset; Image : asset_Name := null_Asset;
end record; end record;
end openGL.Model.capsule.lit_colored_textured; 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 --- Attributes
-- --
-- type Geometry_view is access all Geometry.lit_textured.item'Class;
overriding overriding
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views Fonts : in Font.font_id_Map_of_font) return Geometry.views
@@ -407,45 +404,4 @@ is
end to_GL_Geometries; 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; 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); 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 textured_Model.textured_item with private;
-- type Item is new Model.capsule.item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -33,28 +32,8 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views; Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in 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 private
-- type Item is new Model.capsule.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Radius : Real; Radius : Real;
@@ -63,4 +42,5 @@ private
Image : asset_Name := null_Asset; Image : asset_Name := null_Asset;
end record; end record;
end openGL.Model.capsule.lit_textured; 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. -- Models a textured capsule.
-- --
is is
-- type Item is new Model.capsule.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.capsule.item); 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; type Item is new textured_Model.textured_item with private; type View is access all Item'Class;
@@ -35,7 +34,6 @@ is
private private
-- type Item is new Model.capsule.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Radius : Real; Radius : Real;
@@ -44,4 +42,5 @@ private
Image : asset_Name := null_Asset; Image : asset_Name := null_Asset;
end record; end record;
end openGL.Model.capsule.textured; 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; type Item is new textured_Model.textured_Item with null record;
end openGL.Model.circle.lit_textured; 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; Texture;
the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius);
the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); the_Indices : aliased constant Indices := [1, 2, 3, 4, 5, 6, 7, 2];
function new_Face (Vertices : in geometry.lit_colored_textured.Vertex_array) return Geometry_view function new_Face (Vertices : in geometry.lit_colored_textured.Vertex_array) return Geometry_view
@@ -66,13 +66,13 @@ is
-- --
declare declare
the_Vertices : constant Geometry.lit_colored_textured.Vertex_array 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), 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), 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), 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), 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), 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 begin
upper_Face := new_Face (Vertices => the_Vertices); upper_Face := new_Face (Vertices => the_Vertices);
@@ -82,7 +82,7 @@ is
end if; end if;
end; end;
return (1 => upper_Face.all'Access); return [1 => upper_Face.all'Access];
end to_GL_Geometries; 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 with
openGL.Geometry, openGL.Geometry,
openGL.Texture; openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon.lit_colored_textured 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. -- Models a lit, colored and textured hexagon.
-- --
is 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 View is access all Item'Class;
type Face is type Face is
record record
center_Color : lucid_Color; -- The color at the center of the hex. 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. 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; end record;
@@ -38,7 +41,7 @@ is
private private
type Item is new Model.hexagon.item with type Item is new textured_Model.textured_Item with
record record
Face : lit_colored_textured.Face; Face : lit_colored_textured.Face;
end record; end record;

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

@@ -121,7 +121,7 @@ is
Texture; Texture;
the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius);
the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); the_Indices : aliased constant Indices := [1, 2, 3, 4, 5, 6, 7, 2];
function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
@@ -166,19 +166,19 @@ is
-- --
declare declare
the_Vertices : constant Geometry.lit_textured.Vertex_array 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. 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. 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. 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. 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. 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 begin
upper_Face := new_Face (Vertices => the_Vertices); upper_Face := new_Face (Vertices => the_Vertices);
end; end;
return (1 => upper_Face.all'Access); return [1 => upper_Face.all'Access];
end to_GL_Geometries; end to_GL_Geometries;

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

@@ -1,6 +1,7 @@
with with
openGL.texture_Set, openGL.texture_Set,
openGL.Texture; openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon.lit_textured package openGL.Model.hexagon.lit_textured
@@ -8,26 +9,18 @@ package openGL.Model.hexagon.lit_textured
-- Models a lit and textured hexagon. -- Models a lit and textured hexagon.
-- --
is 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 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 --- Forge
-- --
function new_Hexagon (Radius : in Real; 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; function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views; Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in 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 private
type Item is new Model.hexagon.item with type Item is new textured_Model.textured_Item with null record;
record
Face : lit_textured.Face;
end record;
end openGL.Model.hexagon.lit_textured; 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 with
openGL.Geometry, openGL.Geometry,
openGL.Texture; openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon_Column.lit_colored_textured_faceted 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. -- Models a lit, colored and textured column with 6 faceted shaft sides.
-- --
is 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; type View is access all Item'Class;
@@ -51,7 +55,7 @@ is
private private
type Item is new Model.hexagon_Column.item with type Item is new textured_Model.textured_Item with
record record
upper_Face, upper_Face,
lower_Face : hex_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 loop
Id := texture_Id (i); Id := texture_Id (i);
the_Geometry.Fade_is (which => Id, the_Geometry.Fade_is (Which => Id,
now => Self.texture_Details.Fades (Id)); Now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (which => Id, the_Geometry.Texture_is (Which => Id,
now => Textures.fetch (Self.texture_Details.Textures (i))); Now => Textures.fetch (Self.texture_Details.Textures (i)));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent); the_Geometry.is_Transparent (Now => the_Geometry.Texture.is_Transparent);
end loop; end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly. 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; 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; 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); 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 textured_Model.textured_item with private;
-- type Item is new Model.sphere.item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -31,28 +30,8 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views; Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in 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 private
-- type Item is new Model.sphere.item with -- TODO: Add 'Color' component.
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Color : openGL.lucid_Color; 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 --- Forge
-- --
function new_Sphere (Radius : in Real; function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count; lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count; long_Count : in Positive := default_longitude_Count;
texture_Details : in texture_Set.Details; texture_Details : in texture_Set.Details;
Image : in asset_Name := null_Asset) return View Image : in asset_Name := null_Asset) return View
is is
Self : constant View := new Item; Self : constant View := new Item;
begin begin
@@ -194,47 +194,4 @@ is
end to_GL_Geometries; 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; 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); 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 textured_Model.textured_item with private;
-- type Item is new Model.sphere.item with private;
type View is access all Item'Class; type View is access all Item'Class;
function new_Sphere (Radius : in Real; function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count; lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count; long_Count : in Positive := default_longitude_Count;
texture_Details : in texture_Set.Details; texture_Details : in texture_Set.Details;
Image : in asset_Name := null_Asset) return View; Image : in asset_Name := null_Asset) return View;
overriding overriding
@@ -31,28 +29,8 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views; Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
-- overriding
-- function Fade (Self : in Item; Which : in 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 private
-- type Item is new Model.sphere.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere. 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); 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 textured_Model.textured_item with private;
-- type Item is new Model.sphere.item with private;
type View is access all Item'Class; type View is access all Item'Class;
@@ -38,11 +37,11 @@ is
private private
-- type Item is new Model.sphere.item with
type Item is new textured_Model.textured_item with type Item is new textured_Model.textured_item with
record record
Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere. Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere.
is_Skysphere : Boolean := False; is_Skysphere : Boolean := False;
end record; end record;
end openGL.Model.sphere.textured; 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 package body openGL.Model.texturing
is is
use GL;
------------- -------------
--- Mixin --- --- Mixin ---

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

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

3
3-mid/opengl/source/lean/renderer/opengl-culler-frustum.ads
View File

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

13
3-mid/opengl/source/lean/shader/opengl-shader.adb
View File

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

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

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

1
3-mid/opengl/source/platform/egl/opengl-surface.adb
View File

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