opengl: Fix simple warnings and cosmetics.
This commit is contained in:
@@ -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.");
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
with openGL.Model.texturing;
|
||||
with openGL.texture_Set;
|
||||
with
|
||||
openGL.texture_Set,
|
||||
openGL.Palette,
|
||||
openGL.Font,
|
||||
openGL.IO,
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
|
||||
--
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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"),
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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;
|
||||
|
||||
|
||||
@@ -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);
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -37,4 +37,5 @@ private
|
||||
|
||||
type Item is new textured_Model.textured_Item with null record;
|
||||
|
||||
|
||||
end openGL.Model.circle.lit_textured;
|
||||
|
||||
@@ -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;
|
||||
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -1,13 +1,5 @@
|
||||
with
|
||||
GL.lean,
|
||||
GL.Binding,
|
||||
ada.Strings.fixed;
|
||||
|
||||
|
||||
package body openGL.Model.texturing
|
||||
is
|
||||
use GL;
|
||||
|
||||
|
||||
-------------
|
||||
--- Mixin ---
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -1,6 +1,3 @@
|
||||
with
|
||||
ada.unchecked_Conversion;
|
||||
|
||||
package openGL.Culler.frustum
|
||||
--
|
||||
-- Provides a frustrum culler.
|
||||
|
||||
@@ -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;
|
||||
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
with
|
||||
ada.Strings.Hash,
|
||||
ada.unchecked_Conversion;
|
||||
ada.Strings.Hash;
|
||||
|
||||
|
||||
package body openGL
|
||||
is
|
||||
|
||||
@@ -3,7 +3,6 @@ with
|
||||
opengl.Display .privvy,
|
||||
|
||||
eGL.Binding,
|
||||
interfaces.c.Strings,
|
||||
System;
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user