Compare commits
38 Commits
box2d_revo
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
519c388bbd | ||
|
|
a4f1406b4c | ||
|
|
50821bb787 | ||
|
|
3e11a52f5d | ||
|
|
8a2a562a8b | ||
|
|
a827eab12a | ||
|
|
914c096e9f | ||
|
|
5a003202bf | ||
|
|
9ccf2d3cb5 | ||
|
|
4dc7e235f0 | ||
|
|
9469acaf91 | ||
|
|
b02c1a92f7 | ||
|
|
aa5ff988fa | ||
|
|
0f99def0cd | ||
|
|
f8cdf27998 | ||
|
|
b679ac4bf5 | ||
|
|
e950ad5383 | ||
|
|
049793a64c | ||
|
|
8bbb6e496e | ||
|
|
e302518c81 | ||
|
|
242b2d7828 | ||
|
|
52376f5b0a | ||
|
|
5afee0e2e4 | ||
|
|
d357ce109b | ||
|
|
f1d9542ef3 | ||
|
|
5f0e2155be | ||
|
|
76add3f4a2 | ||
|
|
5707b1783f | ||
|
|
65a5e2c6af | ||
|
|
b766155987 | ||
|
|
eb12d98f65 | ||
|
|
62d84b49f6 | ||
|
|
0f95206885 | ||
|
|
92388f065e | ||
|
|
fdebe21c71 | ||
|
|
7c3ba40482 | ||
|
|
61d6e359ae | ||
|
|
59d478511e |
@@ -4,8 +4,6 @@ with
|
|||||||
system.RPC,
|
system.RPC,
|
||||||
ada.unchecked_Deallocation;
|
ada.unchecked_Deallocation;
|
||||||
|
|
||||||
with ada.Text_IO; use ada.Text_IO;
|
|
||||||
|
|
||||||
|
|
||||||
package body lace.event.make_Subject
|
package body lace.event.make_Subject
|
||||||
is
|
is
|
||||||
|
|||||||
@@ -1,8 +1,9 @@
|
|||||||
with
|
with
|
||||||
lace.Observer,
|
lace.Observer,
|
||||||
lace.Event.Containers,
|
|
||||||
lace.Event.utility,
|
lace.Event.utility,
|
||||||
|
lace.event.Containers,
|
||||||
|
|
||||||
|
ada.Containers.indefinite_Holders,
|
||||||
ada.Text_IO,
|
ada.Text_IO,
|
||||||
ada.Exceptions,
|
ada.Exceptions,
|
||||||
ada.unchecked_Deallocation,
|
ada.unchecked_Deallocation,
|
||||||
|
|||||||
@@ -5,8 +5,6 @@ with
|
|||||||
private
|
private
|
||||||
with
|
with
|
||||||
lace.Subject,
|
lace.Subject,
|
||||||
lace.event.Containers,
|
|
||||||
ada.Containers.indefinite_Holders,
|
|
||||||
ada.Containers.indefinite_Vectors;
|
ada.Containers.indefinite_Vectors;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -3,8 +3,6 @@ with
|
|||||||
lace.Event.utility,
|
lace.Event.utility,
|
||||||
ada.unchecked_Deallocation;
|
ada.unchecked_Deallocation;
|
||||||
|
|
||||||
with ada.Text_IO; use ada.Text_IO;
|
|
||||||
|
|
||||||
|
|
||||||
package body lace.event.make_Observer.deferred
|
package body lace.event.make_Observer.deferred
|
||||||
is
|
is
|
||||||
|
|||||||
@@ -2,8 +2,7 @@ with
|
|||||||
ada.Characters.latin_1,
|
ada.Characters.latin_1,
|
||||||
ada.Directories,
|
ada.Directories,
|
||||||
ada.Direct_IO,
|
ada.Direct_IO,
|
||||||
ada.Streams.Stream_IO,
|
ada.Streams.Stream_IO;
|
||||||
ada.Text_IO;
|
|
||||||
|
|
||||||
|
|
||||||
package body lace.Text.forge
|
package body lace.Text.forge
|
||||||
|
|||||||
@@ -1,7 +1,9 @@
|
|||||||
|
with openGL.Model.texturing;
|
||||||
with
|
with
|
||||||
openGL.Light,
|
openGL.Light,
|
||||||
openGL.Visual,
|
openGL.Visual,
|
||||||
openGL.Model.Box.lit_textured,
|
openGL.Model.Box.lit_textured,
|
||||||
|
openGL.texture_Set,
|
||||||
openGL.Palette,
|
openGL.Palette,
|
||||||
openGL.Demo;
|
openGL.Demo;
|
||||||
|
|
||||||
@@ -38,7 +40,8 @@ begin
|
|||||||
Upper => (texture_Name => the_Texture),
|
Upper => (texture_Name => the_Texture),
|
||||||
Lower => (texture_Name => the_Texture),
|
Lower => (texture_Name => the_Texture),
|
||||||
Left => (texture_Name => the_Texture),
|
Left => (texture_Name => the_Texture),
|
||||||
Right => (texture_Name => the_Texture)));
|
Right => (texture_Name => the_Texture)),
|
||||||
|
texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]));
|
||||||
-- The Visual.
|
-- The Visual.
|
||||||
--
|
--
|
||||||
the_Visuals : constant openGL.Visual.views := (1 => new_Visual (the_Box.all'Access));
|
the_Visuals : constant openGL.Visual.views := (1 => new_Visual (the_Box.all'Access));
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ with
|
|||||||
openGL.Visual,
|
openGL.Visual,
|
||||||
openGL.Model.Sphere.lit_colored_textured,
|
openGL.Model.Sphere.lit_colored_textured,
|
||||||
openGL.Model.Sphere.lit_colored,
|
openGL.Model.Sphere.lit_colored,
|
||||||
|
openGL.texture_Set,
|
||||||
openGL.Palette,
|
openGL.Palette,
|
||||||
openGL.Demo;
|
openGL.Demo;
|
||||||
|
|
||||||
@@ -30,6 +31,7 @@ begin
|
|||||||
--
|
--
|
||||||
the_Ball_1_Model : constant Model.Sphere.lit_colored_textured.view
|
the_Ball_1_Model : constant Model.Sphere.lit_colored_textured.view
|
||||||
:= openGL.Model.Sphere.lit_colored_textured.new_Sphere (Radius => 1.0,
|
:= openGL.Model.Sphere.lit_colored_textured.new_Sphere (Radius => 1.0,
|
||||||
|
texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]),
|
||||||
Image => the_Texture);
|
Image => the_Texture);
|
||||||
the_Ball_2_Model : constant Model.Sphere.lit_colored.view
|
the_Ball_2_Model : constant Model.Sphere.lit_colored.view
|
||||||
:= openGL.Model.Sphere.lit_colored.new_Sphere (Radius => 1.0,
|
:= openGL.Model.Sphere.lit_colored.new_Sphere (Radius => 1.0,
|
||||||
|
|||||||
@@ -1,7 +1,8 @@
|
|||||||
with
|
with
|
||||||
openGL.Model.any,
|
openGL.Model.any,
|
||||||
openGL.Visual,
|
openGL.Visual,
|
||||||
openGL.Light.directional,
|
openGL.Light,
|
||||||
|
openGL.texture_Set,
|
||||||
openGL.Demo;
|
openGL.Demo;
|
||||||
|
|
||||||
procedure launch_render_Asteroids
|
procedure launch_render_Asteroids
|
||||||
@@ -16,24 +17,30 @@ is
|
|||||||
begin
|
begin
|
||||||
Demo.define ("openGL 'Render Asteroids' Demo");
|
Demo.define ("openGL 'Render Asteroids' Demo");
|
||||||
Demo.print_Usage ("Use space ' ' to cycle through models.");
|
Demo.print_Usage ("Use space ' ' to cycle through models.");
|
||||||
Demo.Camera.Position_is ((0.0, 0.0, 200.0),
|
Demo.Camera.Position_is ([0.0, 0.0, 200.0],
|
||||||
y_Rotation_from (to_Radians (0.0)));
|
y_Rotation_from (to_Radians (0.0)));
|
||||||
|
|
||||||
declare
|
declare
|
||||||
the_Light : openGL.Light.directional.item := Demo.Renderer.Light (1);
|
the_Light : openGL.Light.item := Demo.Renderer.new_Light;
|
||||||
begin
|
begin
|
||||||
the_Light.Site_is ((5_000.0, 2_000.0, 5_000.0));
|
the_Light.Site_is ([5_000.0, 2_000.0, 5_000.0]);
|
||||||
Demo.Renderer.Light_is (1, the_Light);
|
the_Light.ambient_Coefficient_is (0.05);
|
||||||
|
Demo.Renderer.set (the_Light);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
declare
|
declare
|
||||||
-- The models.
|
-- The models.
|
||||||
--
|
--
|
||||||
|
|
||||||
|
-- gaspra_Model : constant openGL.Model.any.view := openGL.Model.any.new_Model (Model => to_Asset ("assets/gaspra.tab"),
|
||||||
|
-- Texture => null_Asset,
|
||||||
|
-- texture_Details => openGL.texture_Set.no_Details,
|
||||||
|
-- Texture_is_lucid => False);
|
||||||
gaspra_Model : constant openGL.Model.any.view := openGL.Model.any.new_Model (Model => to_Asset ("assets/gaspra.tab"),
|
gaspra_Model : constant openGL.Model.any.view := openGL.Model.any.new_Model (Model => to_Asset ("assets/gaspra.tab"),
|
||||||
Texture => null_Asset,
|
Texture => to_Asset ("./assets/opengl/texture/Face1.bmp"),
|
||||||
|
texture_Details => openGL.texture_Set.to_Details ([1 => to_Asset ("./assets/opengl/texture/Face1.bmp")]),
|
||||||
Texture_is_lucid => False);
|
Texture_is_lucid => False);
|
||||||
the_Models : constant openGL.Model.views := (1 => gaspra_Model.all'unchecked_Access);
|
the_Models : constant openGL.Model.views := [1 => gaspra_Model.all'unchecked_Access];
|
||||||
|
|
||||||
-- The visuals.
|
-- The visuals.
|
||||||
--
|
--
|
||||||
@@ -79,7 +86,7 @@ begin
|
|||||||
|
|
||||||
-- Render all visuals.
|
-- Render all visuals.
|
||||||
--
|
--
|
||||||
Demo.Camera.render ((1 => the_Visuals (Current)));
|
Demo.Camera.render ([1 => the_Visuals (Current)]);
|
||||||
|
|
||||||
while not Demo.Camera.cull_Completed
|
while not Demo.Camera.cull_Completed
|
||||||
loop
|
loop
|
||||||
|
|||||||
@@ -2,6 +2,7 @@ with
|
|||||||
openGL.Visual,
|
openGL.Visual,
|
||||||
openGL.Model.Billboard. textured,
|
openGL.Model.Billboard. textured,
|
||||||
openGL.Model.Billboard.colored_textured,
|
openGL.Model.Billboard.colored_textured,
|
||||||
|
openGL.texture_Set,
|
||||||
openGL.Palette,
|
openGL.Palette,
|
||||||
openGL.Demo;
|
openGL.Demo;
|
||||||
|
|
||||||
@@ -27,21 +28,23 @@ begin
|
|||||||
the_Billboard_Model : constant Model.Billboard.textured.view
|
the_Billboard_Model : constant Model.Billboard.textured.view
|
||||||
:= Model.Billboard.textured.forge.new_Billboard (--Scale => (1.0, 1.0, 1.0),
|
:= Model.Billboard.textured.forge.new_Billboard (--Scale => (1.0, 1.0, 1.0),
|
||||||
Plane => Billboard.xy,
|
Plane => Billboard.xy,
|
||||||
Texture => the_Texture);
|
Texture => the_Texture,
|
||||||
|
texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]));
|
||||||
|
|
||||||
the_colored_Billboard_Model : constant Model.Billboard.colored_textured.view
|
the_colored_Billboard_Model : constant Model.Billboard.colored_textured.view
|
||||||
:= Model.Billboard.colored_textured.new_Billboard (--Scale => (1.0, 1.0, 1.0),
|
:= Model.Billboard.colored_textured.new_Billboard (--Scale => (1.0, 1.0, 1.0),
|
||||||
Plane => Billboard.xy,
|
Plane => Billboard.xy,
|
||||||
Color => (Palette.Green, Opaque),
|
Color => (Palette.Green, Opaque),
|
||||||
Texture => the_Texture);
|
Texture => the_Texture,
|
||||||
|
texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]));
|
||||||
-- The Sprites.
|
-- The Sprites.
|
||||||
--
|
--
|
||||||
use openGL.Visual.Forge;
|
use openGL.Visual.Forge;
|
||||||
|
|
||||||
the_Sprites : constant openGL.Visual.views := [new_Visual ( the_Billboard_Model.all'Access),
|
the_Visuals : constant openGL.Visual.views := [new_Visual ( the_Billboard_Model.all'Access),
|
||||||
new_Visual (the_colored_Billboard_Model.all'Access)];
|
new_Visual (the_colored_Billboard_Model.all'Access)];
|
||||||
begin
|
begin
|
||||||
the_Sprites (2).Site_is ([3.0, 0.0, 0.0]);
|
the_Visuals (2).Site_is ([3.0, 0.0, 0.0]);
|
||||||
|
|
||||||
-- Main loop.
|
-- Main loop.
|
||||||
--
|
--
|
||||||
@@ -54,7 +57,7 @@ begin
|
|||||||
|
|
||||||
-- Render the sprites.
|
-- Render the sprites.
|
||||||
--
|
--
|
||||||
Demo.Camera.render (the_Sprites);
|
Demo.Camera.render (the_Visuals);
|
||||||
|
|
||||||
while not Demo.Camera.cull_Completed
|
while not Demo.Camera.cull_Completed
|
||||||
loop
|
loop
|
||||||
|
|||||||
@@ -1,3 +1,4 @@
|
|||||||
|
with openGL.texture_Set;
|
||||||
with
|
with
|
||||||
openGL.Visual,
|
openGL.Visual,
|
||||||
|
|
||||||
@@ -8,6 +9,7 @@ with
|
|||||||
openGL.Palette,
|
openGL.Palette,
|
||||||
openGL.Demo;
|
openGL.Demo;
|
||||||
|
|
||||||
|
|
||||||
procedure launch_render_Boxes
|
procedure launch_render_Boxes
|
||||||
--
|
--
|
||||||
-- Exercise the rendering of box models.
|
-- Exercise the rendering of box models.
|
||||||
@@ -58,7 +60,8 @@ begin
|
|||||||
Upper => (texture_Name => the_Texture),
|
Upper => (texture_Name => the_Texture),
|
||||||
Lower => (texture_Name => the_Texture),
|
Lower => (texture_Name => the_Texture),
|
||||||
Left => (texture_Name => the_Texture),
|
Left => (texture_Name => the_Texture),
|
||||||
Right => (texture_Name => the_Texture)]);
|
Right => (texture_Name => the_Texture)],
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]));
|
||||||
|
|
||||||
-- The Visuals.
|
-- The Visuals.
|
||||||
--
|
--
|
||||||
|
|||||||
@@ -33,7 +33,7 @@ begin
|
|||||||
the_Capsule_Model : constant Model.Capsule.lit_colored_textured.view
|
the_Capsule_Model : constant Model.Capsule.lit_colored_textured.view
|
||||||
:= Model.Capsule.lit_colored_textured.new_Capsule (Radius => 0.5,
|
:= Model.Capsule.lit_colored_textured.new_Capsule (Radius => 0.5,
|
||||||
Height => 2.0,
|
Height => 2.0,
|
||||||
Color => (White, Opaque),
|
Color => (Green, Opaque),
|
||||||
Image => the_Texture);
|
Image => the_Texture);
|
||||||
-- The Visuals.
|
-- The Visuals.
|
||||||
--
|
--
|
||||||
@@ -42,6 +42,7 @@ begin
|
|||||||
the_Visuals : constant openGL.Visual.views := [1 => new_Visual (the_Capsule_Model.all'Access)];
|
the_Visuals : constant openGL.Visual.views := [1 => new_Visual (the_Capsule_Model.all'Access)];
|
||||||
begin
|
begin
|
||||||
the_Light.Site_is ([0.0, 5.0, 10.0]);
|
the_Light.Site_is ([0.0, 5.0, 10.0]);
|
||||||
|
the_Light.ambient_Coefficient_is (0.05);
|
||||||
Demo.Renderer.set (the_Light);
|
Demo.Renderer.set (the_Light);
|
||||||
|
|
||||||
-- Main loop.
|
-- Main loop.
|
||||||
|
|||||||
@@ -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.");
|
||||||
@@ -41,28 +38,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
-- Set the lights initial position to far behind and far to the left.
|
|
||||||
--
|
|
||||||
-- declare
|
|
||||||
-- use openGL.Palette;
|
|
||||||
--
|
|
||||||
-- initial_Site : constant openGL.Vector_3 := (0.0, 0.0, 15.0);
|
|
||||||
-- cone_Direction : constant openGL.Vector_3 := (0.0, 0.0, -1.0);
|
|
||||||
--
|
|
||||||
-- Light : openGL.Light.diffuse.item := Demo.Renderer.Light (Id => 1);
|
|
||||||
-- begin
|
|
||||||
-- Light.Color_is (Ambient => (Grey, Opaque),
|
|
||||||
-- Diffuse => (White, Opaque));
|
|
||||||
-- -- Specular => (White, Opaque));
|
|
||||||
--
|
|
||||||
-- Light.Position_is (initial_Site);
|
|
||||||
-- Light.cone_Direction_is (cone_Direction);
|
|
||||||
--
|
|
||||||
-- Demo.Renderer.Light_is (Id => 1, Now => Light);
|
|
||||||
-- end;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
declare
|
declare
|
||||||
-- The models.
|
-- The models.
|
||||||
--
|
--
|
||||||
@@ -81,7 +56,7 @@ begin
|
|||||||
the_Visuals (i) := new_Visual (the_Models (i));
|
the_Visuals (i) := new_Visual (the_Models (i));
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
the_Visuals (4).Site_is ([0.0, 0.0, -50.0]);
|
the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]); -- Text visual.
|
||||||
|
|
||||||
|
|
||||||
-- Main loop.
|
-- Main loop.
|
||||||
|
|||||||
@@ -45,6 +45,9 @@ begin
|
|||||||
the_Visuals (i) := new_Visual (the_Models (i));
|
the_Visuals (i) := new_Visual (the_Models (i));
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
|
the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]); -- Text visual.
|
||||||
|
|
||||||
|
|
||||||
-- Main loop.
|
-- Main loop.
|
||||||
--
|
--
|
||||||
while not Demo.Done
|
while not Demo.Done
|
||||||
|
|||||||
@@ -3,8 +3,10 @@ with
|
|||||||
openGL.Palette,
|
openGL.Palette,
|
||||||
openGL.Font,
|
openGL.Font,
|
||||||
openGL.Model.Text.lit_colored,
|
openGL.Model.Text.lit_colored,
|
||||||
|
openGL.texture_Set,
|
||||||
openGL.Demo;
|
openGL.Demo;
|
||||||
|
|
||||||
|
|
||||||
procedure launch_render_Text
|
procedure launch_render_Text
|
||||||
--
|
--
|
||||||
-- Render updated text.
|
-- Render updated text.
|
||||||
@@ -35,16 +37,20 @@ begin
|
|||||||
:= Model.Text.lit_colored.new_Text (Text => "Howdy",
|
:= Model.Text.lit_colored.new_Text (Text => "Howdy",
|
||||||
Font => the_font_Id,
|
Font => the_font_Id,
|
||||||
Color => (Red, Opaque),
|
Color => (Red, Opaque),
|
||||||
|
texture_Details => openGL.texture_Set.to_Set ([1 => openGL.to_Asset ("assets/texture/Face1.bmp")]),
|
||||||
Centered => False);
|
Centered => False);
|
||||||
|
|
||||||
-- The sprites.
|
-- The sprites.
|
||||||
--
|
--
|
||||||
use openGL.Visual.Forge;
|
use openGL.Visual.Forge;
|
||||||
|
|
||||||
the_Sprites : constant openGL.Visual.views := [1 => new_Visual (the_Text_Model.all'Access)];
|
the_Visuals : constant openGL.Visual.views := [1 => new_Visual (the_Text_Model.all'Access)];
|
||||||
Current : constant Integer := the_Sprites'First;
|
Current : constant Integer := the_Visuals'First;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]);
|
||||||
|
|
||||||
|
|
||||||
-- Main loop.
|
-- Main loop.
|
||||||
--
|
--
|
||||||
while not Demo.Done
|
while not Demo.Done
|
||||||
@@ -78,7 +84,7 @@ begin
|
|||||||
|
|
||||||
-- Render all sprites.
|
-- Render all sprites.
|
||||||
--
|
--
|
||||||
Demo.Camera.render ([1 => the_Sprites (Current)]);
|
Demo.Camera.render ([1 => the_Visuals (Current)]);
|
||||||
|
|
||||||
while not Demo.Camera.cull_Completed
|
while not Demo.Camera.cull_Completed
|
||||||
loop
|
loop
|
||||||
|
|||||||
@@ -1,127 +0,0 @@
|
|||||||
with
|
|
||||||
openGL.Model.hexagon.lit_textured_x2,
|
|
||||||
openGL.Visual,
|
|
||||||
openGL.Light,
|
|
||||||
openGL.Palette,
|
|
||||||
openGL.Geometry.texturing,
|
|
||||||
-- openGL.IO,
|
|
||||||
openGL.Demo;
|
|
||||||
|
|
||||||
with Ada.Text_IO; use Ada.Text_IO;
|
|
||||||
|
|
||||||
|
|
||||||
procedure launch_render_two_Textures
|
|
||||||
--
|
|
||||||
-- Renders a hexagon grid.
|
|
||||||
--
|
|
||||||
is
|
|
||||||
use openGL,
|
|
||||||
openGL.Math,
|
|
||||||
openGL.linear_Algebra_3D,
|
|
||||||
openGL.Palette,
|
|
||||||
openGL.Light;
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
|
||||||
-- The model.
|
|
||||||
--
|
|
||||||
-- the_1st_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/blobber_floor.png");
|
|
||||||
the_1st_Texture : constant asset_Name := to_Asset ("assets/crawl-blob-1.png");
|
|
||||||
the_2nd_Texture : constant asset_Name := to_Asset ("assets/crawl-blob-2.png");
|
|
||||||
|
|
||||||
the_textured_hexagon_Model : constant Model.hexagon.lit_textured_x2.view
|
|
||||||
:= Model.hexagon.lit_textured_x2.new_Hexagon (Radius => 0.5,
|
|
||||||
Face => (Texture_1 => the_1st_Texture,
|
|
||||||
Texture_2 => the_2nd_Texture,
|
|
||||||
Fade_1 => 0.5,
|
|
||||||
Fade_2 => 0.5));
|
|
||||||
----------------
|
|
||||||
--- The visual.
|
|
||||||
--
|
|
||||||
use openGL.Visual.Forge;
|
|
||||||
|
|
||||||
the_Hex : constant openGL.Visual.view := new_Visual (the_textured_hexagon_Model.all'Access);
|
|
||||||
|
|
||||||
--------------
|
|
||||||
--- The light.
|
|
||||||
--
|
|
||||||
the_Light : openGL.Light.item := Demo.Renderer.new_Light;
|
|
||||||
light_Site : constant openGL.Vector_3 := [0.0, 0.0, 15.0];
|
|
||||||
cone_Direction : constant openGL.Vector_3 := [0.0, 0.0, -1.0];
|
|
||||||
|
|
||||||
use openGL.Geometry.texturing;
|
|
||||||
Fade : fade_Level := fade_Level'First;
|
|
||||||
increment_Fade : Boolean := True;
|
|
||||||
Epoch : Natural := 0;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Demo.print_Usage;
|
|
||||||
Demo.define ("openGL 'render two Textures' Demo",
|
|
||||||
Width => 1_000,
|
|
||||||
Height =>1_000);
|
|
||||||
|
|
||||||
Demo.Camera.Position_is ([0.0, 2.0, 0.0],
|
|
||||||
x_Rotation_from (to_Radians (90.0)));
|
|
||||||
|
|
||||||
-- Set up the light.
|
|
||||||
--
|
|
||||||
the_Light. Kind_is (Diffuse);
|
|
||||||
the_Light. Site_is (light_Site);
|
|
||||||
the_Light. Color_is (White);
|
|
||||||
the_Light.ambient_Coefficient_is (0.8);
|
|
||||||
the_Light. cone_Angle_is (5.0);
|
|
||||||
the_Light. cone_Direction_is (cone_Direction);
|
|
||||||
|
|
||||||
Demo.Renderer.set (the_Light);
|
|
||||||
|
|
||||||
|
|
||||||
-- Main loop.
|
|
||||||
--
|
|
||||||
while not Demo.Done
|
|
||||||
loop
|
|
||||||
Demo.Dolly.evolve;
|
|
||||||
Demo.Done := Demo.Dolly.quit_Requested;
|
|
||||||
|
|
||||||
Demo.Camera.render ([1 => the_Hex]);
|
|
||||||
|
|
||||||
while not Demo.Camera.cull_Completed
|
|
||||||
loop
|
|
||||||
delay Duration'Small;
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
Demo.Renderer.render;
|
|
||||||
Demo.FPS_Counter.increment; -- Frames per second display.
|
|
||||||
|
|
||||||
|
|
||||||
if Epoch mod 20 = 0
|
|
||||||
then
|
|
||||||
-- the_textured_hexagon_Model.Fade_is (which => 1, now => Fade);
|
|
||||||
-- the_textured_hexagon_Model.Fade_is (which => 2, now => 1.0 - Fade);
|
|
||||||
|
|
||||||
the_textured_hexagon_Model.Fade_1_is (Fade);
|
|
||||||
the_textured_hexagon_Model.Fade_2_is (1.0 - Fade);
|
|
||||||
-- the_textured_hexagon_Model.needs_Rebuild;
|
|
||||||
--
|
|
||||||
-- the_textured_hexagon_Model.Fade_1_is (1.0);
|
|
||||||
-- the_textured_hexagon_Model.Fade_2_is (0.0);
|
|
||||||
|
|
||||||
-- put_Line ("my Fade: " & Fade'Image);
|
|
||||||
|
|
||||||
if increment_Fade
|
|
||||||
then
|
|
||||||
Fade := Fade + fade_Level'Small;
|
|
||||||
else
|
|
||||||
Fade := Fade - fade_Level'Small;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Fade = fade_Level'Last then increment_Fade := False;
|
|
||||||
elsif Fade = fade_Level'First then increment_Fade := True;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Epoch := Epoch + 1;
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
Demo.destroy;
|
|
||||||
end launch_render_two_Textures;
|
|
||||||
@@ -0,0 +1,84 @@
|
|||||||
|
with
|
||||||
|
openGL.Model.polygon.lit_textured,
|
||||||
|
openGL.texture_Set,
|
||||||
|
openGL.Visual,
|
||||||
|
openGL.Light,
|
||||||
|
openGL.Palette,
|
||||||
|
openGL.Demo;
|
||||||
|
|
||||||
|
|
||||||
|
procedure launch_tiling_Demo
|
||||||
|
--
|
||||||
|
-- Exercise the renderer with an example of all the models.
|
||||||
|
--
|
||||||
|
is
|
||||||
|
use openGL,
|
||||||
|
openGL.Math,
|
||||||
|
openGL.linear_Algebra_3D,
|
||||||
|
openGL.Palette;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Demo.print_Usage ("Use space ' ' to cycle through models.");
|
||||||
|
Demo.define ("openGL 'Render Models' Demo");
|
||||||
|
Demo.Camera.Position_is ([0.0, 0.0, 2.0],
|
||||||
|
y_Rotation_from (to_Radians (0.0)));
|
||||||
|
|
||||||
|
declare
|
||||||
|
use openGL.Light;
|
||||||
|
the_Light : openGL.Light.item := Demo.Renderer.new_Light;
|
||||||
|
begin
|
||||||
|
the_Light.Site_is ([0.0, 0.0, 5.0]);
|
||||||
|
the_Light.Color_is (White);
|
||||||
|
|
||||||
|
Demo.Renderer.set (the_Light);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
declare
|
||||||
|
the_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/Face1.bmp");
|
||||||
|
Details : openGL.texture_Set.Details := openGL.texture_Set.to_Details ([1 => the_Texture]);
|
||||||
|
|
||||||
|
the_Model : Model.polygon.lit_textured.view;
|
||||||
|
-- := Model.polygon.lit_textured.new_Polygon (vertex_Sites => [[-1.0, -1.0], [1.0, -1.0], [1.0, 1.0], [-1.0, 1.0]],
|
||||||
|
-- texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]));
|
||||||
|
|
||||||
|
|
||||||
|
-- The visuals.
|
||||||
|
--
|
||||||
|
use openGL.Visual.Forge;
|
||||||
|
|
||||||
|
the_Visual : openGL.Visual.view;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Details.texture_Tilings (1) := (S => 5.0, T => 4.0);
|
||||||
|
|
||||||
|
the_Model := Model.polygon.lit_textured.new_Polygon (vertex_Sites => [[-1.0, -1.0], [1.0, -1.0], [1.0, 1.0], [-1.0, 1.0]],
|
||||||
|
texture_Details => Details);
|
||||||
|
the_Visual := new_Visual (the_Model.all'Access);
|
||||||
|
|
||||||
|
-- Main loop.
|
||||||
|
--
|
||||||
|
while not Demo.Done
|
||||||
|
loop
|
||||||
|
Demo.Dolly.evolve;
|
||||||
|
Demo.Done := Demo.Dolly.quit_Requested;
|
||||||
|
|
||||||
|
|
||||||
|
-- Render all visuals.
|
||||||
|
--
|
||||||
|
Demo.Camera.render ([1 => the_Visual]);
|
||||||
|
|
||||||
|
while not Demo.Camera.cull_Completed
|
||||||
|
loop
|
||||||
|
delay Duration'Small;
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
Demo.Renderer.render;
|
||||||
|
Demo.FPS_Counter.increment; -- Frames per second display.
|
||||||
|
|
||||||
|
delay 1.0 / 60.0;
|
||||||
|
end loop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Demo.destroy;
|
||||||
|
end launch_tiling_Demo;
|
||||||
@@ -2,15 +2,16 @@ with
|
|||||||
"opengl_demo",
|
"opengl_demo",
|
||||||
"lace_shared";
|
"lace_shared";
|
||||||
|
|
||||||
project render_two_Textures
|
|
||||||
|
project tiling_Demo
|
||||||
is
|
is
|
||||||
for Object_Dir use "build";
|
for Object_Dir use "build";
|
||||||
for Exec_Dir use ".";
|
for Exec_Dir use ".";
|
||||||
for Main use ("launch_render_two_textures.adb");
|
for Main use ("launch_tiling_demo.adb");
|
||||||
|
|
||||||
package Ide renames Lace_shared.Ide;
|
package Ide renames Lace_shared.Ide;
|
||||||
package Builder renames Lace_shared.Builder;
|
package Builder renames Lace_shared.Builder;
|
||||||
package Compiler renames Lace_shared.Compiler;
|
package Compiler renames Lace_shared.Compiler;
|
||||||
package Binder renames Lace_shared.Binder;
|
package Binder renames Lace_shared.Binder;
|
||||||
|
|
||||||
end render_two_Textures;
|
end tiling_Demo;
|
||||||
@@ -1,3 +1,4 @@
|
|||||||
|
with openGL.texture_Set;
|
||||||
with
|
with
|
||||||
openGL.Camera,
|
openGL.Camera,
|
||||||
openGL.Palette,
|
openGL.Palette,
|
||||||
@@ -54,7 +55,8 @@ begin
|
|||||||
right => (colors => [others => (Red, Opaque)], texture_name => the_Face)]);
|
right => (colors => [others => (Red, Opaque)], texture_name => the_Face)]);
|
||||||
|
|
||||||
the_ball_Model : constant Model.Sphere.lit_colored_textured.view
|
the_ball_Model : constant Model.Sphere.lit_colored_textured.view
|
||||||
:= Model.Sphere.lit_colored_textured.new_Sphere (radius => 0.5);
|
:= Model.Sphere.lit_colored_textured.new_Sphere (radius => 0.5,
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Face]));
|
||||||
|
|
||||||
-- The Sprites.
|
-- The Sprites.
|
||||||
--
|
--
|
||||||
|
|||||||
@@ -1,15 +1,24 @@
|
|||||||
#version 140
|
// Include 'version.header'.
|
||||||
|
// Include 'texturing-frag.snippet'.
|
||||||
|
|
||||||
uniform sampler2D sTexture;
|
in vec3 frag_Site;
|
||||||
|
in vec4 frag_Color;
|
||||||
|
in vec2 frag_Coords;
|
||||||
|
|
||||||
varying vec4 vColor;
|
out vec4 final_Color;
|
||||||
varying vec2 vCoords;
|
|
||||||
|
|
||||||
|
|
||||||
void main()
|
void
|
||||||
|
main()
|
||||||
{
|
{
|
||||||
gl_FragColor = mix (texture2D (sTexture, vCoords),
|
vec4 surface_Color = mix (apply_Texturing (frag_Coords),
|
||||||
vColor,
|
frag_Color,
|
||||||
0.5);
|
0.5);
|
||||||
}
|
|
||||||
|
|
||||||
|
vec3 Gamma = vec3 (1.0 / 2.2);
|
||||||
|
final_Color = vec4
|
||||||
|
(pow
|
||||||
|
(surface_Color.rgb, // Final color (after gamma correction).
|
||||||
|
Gamma),
|
||||||
|
surface_Color.a);
|
||||||
|
}
|
||||||
@@ -3,17 +3,17 @@
|
|||||||
uniform mat4 mvp_Transform;
|
uniform mat4 mvp_Transform;
|
||||||
uniform vec3 Scale;
|
uniform vec3 Scale;
|
||||||
|
|
||||||
attribute vec3 Site;
|
in vec3 Site;
|
||||||
attribute vec4 Color;
|
in vec4 Color;
|
||||||
attribute vec2 Coords;
|
in vec2 Coords;
|
||||||
|
|
||||||
varying vec4 vColor;
|
out vec4 frag_Color;
|
||||||
varying vec2 vCoords;
|
out vec2 frag_Coords;
|
||||||
|
|
||||||
|
|
||||||
void main()
|
void main()
|
||||||
{
|
{
|
||||||
gl_Position = mvp_Transform * vec4 (Site * Scale, 1.0);
|
gl_Position = mvp_Transform * vec4 (Site * Scale, 1.0);
|
||||||
vColor = Color;
|
frag_Color = Color;
|
||||||
vCoords = Coords;
|
frag_Coords = Coords;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -7,6 +7,8 @@
|
|||||||
uniform int texture_Count;
|
uniform int texture_Count;
|
||||||
uniform sampler2D Textures [16];
|
uniform sampler2D Textures [16];
|
||||||
uniform float Fade [16];
|
uniform float Fade [16];
|
||||||
|
uniform bool texture_Applies [16];
|
||||||
|
uniform vec2 Tiling [16];
|
||||||
|
|
||||||
vec4
|
vec4
|
||||||
apply_Texturing (vec2 Coords)
|
apply_Texturing (vec2 Coords)
|
||||||
@@ -15,12 +17,20 @@ apply_Texturing (vec2 Coords)
|
|||||||
|
|
||||||
for (int i = 0; i < texture_Count; ++i)
|
for (int i = 0; i < texture_Count; ++i)
|
||||||
{
|
{
|
||||||
Color.rgb += texture (Textures [i], Coords).rgb
|
if (texture_Applies [i])
|
||||||
* texture (Textures [i], Coords).a
|
{
|
||||||
|
vec2 tiled_Coords;
|
||||||
|
|
||||||
|
tiled_Coords.s = Coords.s * Tiling [i].s;
|
||||||
|
tiled_Coords.t = Coords.t * Tiling [i].t;
|
||||||
|
|
||||||
|
Color.rgb += texture (Textures [i], tiled_Coords).rgb
|
||||||
|
* texture (Textures [i], tiled_Coords).a
|
||||||
* (1.0 - Fade [i]);
|
* (1.0 - Fade [i]);
|
||||||
|
|
||||||
Color.a = max (Color.a, texture (Textures [i],
|
Color.a = max (Color.a, texture (Textures [i],
|
||||||
Coords).a);
|
tiled_Coords).a);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return Color;
|
return Color;
|
||||||
@@ -154,6 +164,9 @@ main()
|
|||||||
Surface_to_Camera);
|
Surface_to_Camera);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// linear_Color.g = 1.0;
|
||||||
|
linear_Color += surface_Color.rgb;
|
||||||
|
|
||||||
vec3 Gamma = vec3 (1.0 / 2.2);
|
vec3 Gamma = vec3 (1.0 / 2.2);
|
||||||
|
|
||||||
final_Color = vec4 (pow (linear_Color, // Final color (after gamma correction).
|
final_Color = vec4 (pow (linear_Color, // Final color (after gamma correction).
|
||||||
|
|||||||
@@ -2,6 +2,7 @@ uniform int texture_Count;
|
|||||||
uniform sampler2D Textures [16];
|
uniform sampler2D Textures [16];
|
||||||
uniform float Fade [16];
|
uniform float Fade [16];
|
||||||
uniform bool texture_Applies [16];
|
uniform bool texture_Applies [16];
|
||||||
|
uniform vec2 Tiling [16];
|
||||||
|
|
||||||
|
|
||||||
vec4
|
vec4
|
||||||
@@ -14,17 +15,17 @@ apply_Texturing (vec2 Coords)
|
|||||||
{
|
{
|
||||||
if (texture_Applies [i])
|
if (texture_Applies [i])
|
||||||
{
|
{
|
||||||
Color.rgb += texture (Textures [i], Coords).rgb
|
vec2 tiled_Coords;
|
||||||
* texture (Textures [i], Coords).a
|
|
||||||
|
tiled_Coords.s = Coords.s * Tiling [i].s;
|
||||||
|
tiled_Coords.t = Coords.t * Tiling [i].t;
|
||||||
|
|
||||||
|
Color.rgb += texture (Textures [i], tiled_Coords).rgb
|
||||||
|
* texture (Textures [i], tiled_Coords).a
|
||||||
* (1.0 - Fade [i]);
|
* (1.0 - Fade [i]);
|
||||||
|
|
||||||
// Color.a += texture (Textures [i], Coords).a * (1.0 - Fade [1]);
|
|
||||||
|
|
||||||
Color.a = max (Color.a,
|
Color.a = max (Color.a,
|
||||||
texture (Textures [i],Coords).a * (1.0 - Fade [i]));
|
texture (Textures [i], tiled_Coords).a * (1.0 - Fade [i]));
|
||||||
|
|
||||||
// Color.a = max (Color.a,
|
|
||||||
// texture (Textures [i],Coords).a);
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -6,7 +6,6 @@ with
|
|||||||
|
|
||||||
interfaces.C.Strings,
|
interfaces.C.Strings,
|
||||||
|
|
||||||
ada.unchecked_Conversion,
|
|
||||||
ada.unchecked_Deallocation,
|
ada.unchecked_Deallocation,
|
||||||
ada.Finalization;
|
ada.Finalization;
|
||||||
|
|
||||||
@@ -23,7 +22,6 @@ is
|
|||||||
--- Utility
|
--- Utility
|
||||||
--
|
--
|
||||||
|
|
||||||
function to_Flag is new ada.unchecked_Conversion (FT_Kerning_Mode, C.unsigned);
|
|
||||||
procedure deallocate is new ada.Unchecked_Deallocation (float_Array, float_Array_view);
|
procedure deallocate is new ada.Unchecked_Deallocation (float_Array, float_Array_view);
|
||||||
|
|
||||||
|
|
||||||
@@ -248,7 +246,7 @@ is
|
|||||||
Self.Err := FT_Get_Kerning (Self.ftFace,
|
Self.Err := FT_Get_Kerning (Self.ftFace,
|
||||||
C.unsigned (index1),
|
C.unsigned (index1),
|
||||||
C.unsigned (index2),
|
C.unsigned (index2),
|
||||||
to_Flag (ft_Kerning_unfitted),
|
ft_Kerning_unfitted'enum_Rep,
|
||||||
kernAdvance'unchecked_Access);
|
kernAdvance'unchecked_Access);
|
||||||
if Self.Err /= 0
|
if Self.Err /= 0
|
||||||
then
|
then
|
||||||
@@ -323,7 +321,7 @@ is
|
|||||||
loop
|
loop
|
||||||
Self.Err := FT_Get_Kerning (Self.ftFace,
|
Self.Err := FT_Get_Kerning (Self.ftFace,
|
||||||
i, j,
|
i, j,
|
||||||
to_Flag (ft_Kerning_unfitted),
|
ft_Kerning_unfitted'enum_Rep,
|
||||||
kernAdvance'unchecked_Access);
|
kernAdvance'unchecked_Access);
|
||||||
if Self.Err /= 0
|
if Self.Err /= 0
|
||||||
then
|
then
|
||||||
|
|||||||
@@ -1,4 +1,5 @@
|
|||||||
with
|
with
|
||||||
|
openGL.texture_Set,
|
||||||
openGL.Palette,
|
openGL.Palette,
|
||||||
openGL.Font,
|
openGL.Font,
|
||||||
openGL.IO,
|
openGL.IO,
|
||||||
@@ -150,20 +151,27 @@ is
|
|||||||
:= Model.sphere.lit_colored.new_Sphere (Radius => 1.0, Color => (Green, Opaque));
|
:= Model.sphere.lit_colored.new_Sphere (Radius => 1.0, Color => (Green, Opaque));
|
||||||
|
|
||||||
the_ball_3_Model : constant Model.sphere.lit_textured.view
|
the_ball_3_Model : constant Model.sphere.lit_textured.view
|
||||||
:= Model.sphere.lit_textured.new_Sphere (Radius => 1.0, Image => the_Texture);
|
:= Model.sphere.lit_textured.new_Sphere (Radius => 1.0,
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]),
|
||||||
|
Image => the_Texture);
|
||||||
|
|
||||||
the_ball_4_Model : constant Model.sphere.lit_colored_textured.view
|
the_ball_4_Model : constant Model.sphere.lit_colored_textured.view
|
||||||
:= Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0, Image => the_Texture);
|
:= Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0,
|
||||||
|
Color => (Green, Opaque),
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]),
|
||||||
|
Image => the_Texture);
|
||||||
|
|
||||||
the_billboard_Model : constant Model.billboard.textured.view
|
the_billboard_Model : constant Model.billboard.textured.view
|
||||||
:= Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0),
|
:= Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0),
|
||||||
Plane => Billboard.xy,
|
Plane => Billboard.xy,
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]),
|
||||||
Texture => the_Texture);
|
Texture => the_Texture);
|
||||||
|
|
||||||
the_colored_billboard_Model : constant Model.billboard.textured.view -- TODO: Add color.
|
the_colored_billboard_Model : constant Model.billboard.textured.view -- TODO: Add color.
|
||||||
:= Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0),
|
:= Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0),
|
||||||
Plane => Billboard.xy,
|
Plane => Billboard.xy,
|
||||||
Texture => the_Texture);
|
Texture => the_Texture,
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]));
|
||||||
use Model.box;
|
use Model.box;
|
||||||
|
|
||||||
the_box_1_Model : constant Model.box.colored.view
|
the_box_1_Model : constant Model.box.colored.view
|
||||||
@@ -179,23 +187,25 @@ is
|
|||||||
the_box_2_Model : constant Model.box.lit_textured.view
|
the_box_2_Model : constant Model.box.lit_textured.view
|
||||||
:= Model.box.lit_textured.new_Box
|
:= Model.box.lit_textured.new_Box
|
||||||
(Size => [1.0, 2.0, 1.0],
|
(Size => [1.0, 2.0, 1.0],
|
||||||
Faces => [others => (texture_Name => the_Texture)]);
|
Faces => [others => (texture_Name => the_Texture)],
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]));
|
||||||
|
|
||||||
the_box_3_Model : constant Model.box.textured.view
|
the_box_3_Model : constant Model.box.textured.view
|
||||||
:= Model.box.textured.new_Box
|
:= Model.box.textured.new_Box
|
||||||
(Size => [1.0, 2.0, 3.0],
|
(Size => [1.0, 2.0, 3.0],
|
||||||
Faces => [others => (texture_Name => the_Texture)]);
|
Faces => [others => (texture_Name => the_Texture)],
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]));
|
||||||
|
|
||||||
|
|
||||||
the_capsule_Model : constant Model.capsule.lit_textured.view
|
the_capsule_Model : constant Model.capsule.lit_textured.view
|
||||||
:= Model.capsule.lit_textured.new_Capsule (Radius => 0.5,
|
:= Model.capsule.lit_textured.new_Capsule (Radius => 0.5,
|
||||||
Height => 2.0,
|
Height => 2.0,
|
||||||
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]),
|
||||||
Image => the_Texture);
|
Image => the_Texture);
|
||||||
|
|
||||||
the_lit_textured_circle_Model : constant Model.circle.lit_textured.view
|
the_lit_textured_circle_Model : constant Model.circle.lit_textured.view
|
||||||
:= Model.circle.lit_textured.new_Circle (Radius => 1.5,
|
:= Model.circle.lit_textured.new_Circle (Radius => 1.5,
|
||||||
Face => (Fades => (1 => 0.0, others => <>),
|
Texture_Details => (openGL.texture_Set.to_Set ([1 => the_Texture])),
|
||||||
Textures => (1 => the_Texture, others => <>),
|
|
||||||
texture_Count => 1),
|
|
||||||
Sides => 24);
|
Sides => 24);
|
||||||
|
|
||||||
the_grid_Model : constant Model.grid.view
|
the_grid_Model : constant Model.grid.view
|
||||||
@@ -210,9 +220,7 @@ is
|
|||||||
|
|
||||||
the_textured_hexagon_Model : constant Model.hexagon.lit_textured.view
|
the_textured_hexagon_Model : constant Model.hexagon.lit_textured.view
|
||||||
:= Model.hexagon.lit_textured.new_Hexagon (Radius => 0.5,
|
:= Model.hexagon.lit_textured.new_Hexagon (Radius => 0.5,
|
||||||
Face => (Fades => (1 => 0.0, others => <>),
|
texture_Details => texture_Set.to_Set ([1 => the_Texture]));
|
||||||
Textures => (1 => the_Texture, others => <>),
|
|
||||||
texture_Count => 1));
|
|
||||||
|
|
||||||
the_faceted_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_faceted.view
|
the_faceted_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_faceted.view
|
||||||
:= Model.hexagon_Column.lit_colored_faceted.new_hexagon_Column
|
:= Model.hexagon_Column.lit_colored_faceted.new_hexagon_Column
|
||||||
@@ -247,6 +255,7 @@ is
|
|||||||
:= Model.any.new_Model (--Scale => (1.0, 1.0, 1.0),
|
:= Model.any.new_Model (--Scale => (1.0, 1.0, 1.0),
|
||||||
Model => to_Asset ("assets/opengl/model/human.obj"),
|
Model => to_Asset ("assets/opengl/model/human.obj"),
|
||||||
Texture => the_Texture,
|
Texture => the_Texture,
|
||||||
|
texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]),
|
||||||
Texture_is_lucid => False);
|
Texture_is_lucid => False);
|
||||||
|
|
||||||
the_lit_colored_polygon_Model : constant Model.polygon.lit_colored.view
|
the_lit_colored_polygon_Model : constant Model.polygon.lit_colored.view
|
||||||
@@ -255,15 +264,13 @@ is
|
|||||||
|
|
||||||
the_lit_textured_polygon_Model : constant Model.polygon.lit_textured.view
|
the_lit_textured_polygon_Model : constant Model.polygon.lit_textured.view
|
||||||
:= Model.polygon.lit_textured.new_Polygon (vertex_Sites => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]],
|
:= Model.polygon.lit_textured.new_Polygon (vertex_Sites => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]],
|
||||||
Face => (Fades => (1 => 0.0, others => <>),
|
texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]));
|
||||||
Textures => (1 => the_Texture, others => <>),
|
|
||||||
texture_Tiling => <>,
|
|
||||||
texture_Count => 1));
|
|
||||||
|
|
||||||
the_text_Model : constant Model.Text.lit_colored.view
|
the_text_Model : constant Model.Text.lit_colored.view
|
||||||
:= Model.Text.lit_colored.new_Text (Text => "Once upon a midnight dreary ...",
|
:= Model.Text.lit_colored.new_Text (Text => "Once upon a midnight dreary ...",
|
||||||
Font => the_font_Id,
|
Font => the_font_Id,
|
||||||
Color => (Green, Opaque),
|
Color => (Green, Opaque),
|
||||||
|
texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]),
|
||||||
Centered => True);
|
Centered => True);
|
||||||
|
|
||||||
the_segment_line_Model : constant Model.segment_line.view
|
the_segment_line_Model : constant Model.segment_line.view
|
||||||
@@ -284,6 +291,7 @@ is
|
|||||||
Col => 1,
|
Col => 1,
|
||||||
Heights => the_Region.all'Access,
|
Heights => the_Region.all'Access,
|
||||||
Color_Map => texture_File,
|
Color_Map => texture_File,
|
||||||
|
texture_Details => openGL.texture_Set.to_Set ([1 => texture_File]),
|
||||||
Tiling => Tiling);
|
Tiling => Tiling);
|
||||||
begin
|
begin
|
||||||
Demo.Renderer.add_Font (the_font_Id);
|
Demo.Renderer.add_Font (the_font_Id);
|
||||||
@@ -294,10 +302,10 @@ is
|
|||||||
the_segment_line_Model.add_Segment (end_Site => [2.0, 2.0, 0.0]);
|
the_segment_line_Model.add_Segment (end_Site => [2.0, 2.0, 0.0]);
|
||||||
the_segment_line_Model.add_Segment (end_Site => [0.0, 2.0, 0.0]);
|
the_segment_line_Model.add_Segment (end_Site => [0.0, 2.0, 0.0]);
|
||||||
|
|
||||||
return [ the_ground_Model.all'Access,
|
return [ the_text_Model.all'Access,
|
||||||
|
the_ground_Model.all'Access,
|
||||||
the_lit_textured_polygon_Model.all'Access,
|
the_lit_textured_polygon_Model.all'Access,
|
||||||
the_lit_colored_polygon_Model.all'Access,
|
the_lit_colored_polygon_Model.all'Access,
|
||||||
the_text_Model.all'Access,
|
|
||||||
the_arrow_Model.all'Access,
|
the_arrow_Model.all'Access,
|
||||||
the_ball_1_Model.all'Access,
|
the_ball_1_Model.all'Access,
|
||||||
the_ball_2_Model.all'Access,
|
the_ball_2_Model.all'Access,
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ with
|
|||||||
|
|
||||||
GL.Pointers;
|
GL.Pointers;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Buffer.general
|
package body openGL.Buffer.general
|
||||||
is
|
is
|
||||||
--------------------------
|
--------------------------
|
||||||
@@ -53,6 +54,7 @@ is
|
|||||||
From'Size / 8,
|
From'Size / 8,
|
||||||
+From (From'First)'Address,
|
+From (From'First)'Address,
|
||||||
to_GL_Enum (Usage));
|
to_GL_Enum (Usage));
|
||||||
|
Errors.log;
|
||||||
end return;
|
end return;
|
||||||
end to_Buffer;
|
end to_Buffer;
|
||||||
|
|
||||||
@@ -78,6 +80,7 @@ is
|
|||||||
Offset => GLintptr ((Position - 1) * Vertex_Size_in_bits / 8),
|
Offset => GLintptr ((Position - 1) * Vertex_Size_in_bits / 8),
|
||||||
Size => new_Vertices'Size / 8,
|
Size => new_Vertices'Size / 8,
|
||||||
Data => +new_Vertices (new_Vertices'First)'Address);
|
Data => +new_Vertices (new_Vertices'First)'Address);
|
||||||
|
Errors.log;
|
||||||
else
|
else
|
||||||
Self.destroy;
|
Self.destroy;
|
||||||
|
|
||||||
@@ -89,9 +92,8 @@ is
|
|||||||
To'Size / 8,
|
To'Size / 8,
|
||||||
+To (To'First)'Address,
|
+To (To'First)'Address,
|
||||||
to_GL_Enum (Self.Usage));
|
to_GL_Enum (Self.Usage));
|
||||||
end if;
|
|
||||||
|
|
||||||
Errors.log;
|
Errors.log;
|
||||||
|
end if;
|
||||||
end set;
|
end set;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -5,6 +5,7 @@ generic
|
|||||||
type Element is private;
|
type Element is private;
|
||||||
type Element_Array is array (Index range <>) of Element;
|
type Element_Array is array (Index range <>) of Element;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer.general
|
package openGL.Buffer.general
|
||||||
--
|
--
|
||||||
-- A generic for producing various types of openGL vertex buffer objects.
|
-- A generic for producing various types of openGL vertex buffer objects.
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Buffer.general;
|
openGL.Buffer.general;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer.indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
|
package openGL.Buffer.indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
|
||||||
Index => long_Index_t,
|
Index => long_Index_t,
|
||||||
Element => Index_t,
|
Element => Index_t,
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Buffer.general;
|
openGL.Buffer.general;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer.long_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
|
package openGL.Buffer.long_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
|
||||||
Index => long_Index_t,
|
Index => long_Index_t,
|
||||||
Element => long_Index_t,
|
Element => long_Index_t,
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Buffer.general;
|
openGL.Buffer.general;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer.normals is new openGL.Buffer.general (base_Object => Buffer.array_Object,
|
package openGL.Buffer.normals is new openGL.Buffer.general (base_Object => Buffer.array_Object,
|
||||||
Index => Index_t,
|
Index => Index_t,
|
||||||
Element => Normal,
|
Element => Normal,
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Buffer.general;
|
openGL.Buffer.general;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer.short_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
|
package openGL.Buffer.short_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
|
||||||
Index => long_Index_t,
|
Index => long_Index_t,
|
||||||
Element => short_Index_t,
|
Element => short_Index_t,
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Buffer.general;
|
openGL.Buffer.general;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer.texture_coords is new openGL.Buffer.general (base_Object => Buffer.array_Object,
|
package openGL.Buffer.texture_coords is new openGL.Buffer.general (base_Object => Buffer.array_Object,
|
||||||
Index => Index_t,
|
Index => Index_t,
|
||||||
Element => Coordinate_2D,
|
Element => Coordinate_2D,
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Buffer.general;
|
openGL.Buffer.general;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer.vertex is new openGL.Buffer.general (base_Object => Buffer.array_Object,
|
package openGL.Buffer.vertex is new openGL.Buffer.general (base_Object => Buffer.array_Object,
|
||||||
Index => Index_t,
|
Index => Index_t,
|
||||||
Element => Site,
|
Element => Site,
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ with
|
|||||||
openGL.Tasks,
|
openGL.Tasks,
|
||||||
ada.unchecked_Deallocation;
|
ada.unchecked_Deallocation;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Buffer
|
package body openGL.Buffer
|
||||||
is
|
is
|
||||||
use type a_Name;
|
use type a_Name;
|
||||||
@@ -17,7 +18,7 @@ is
|
|||||||
Name : aliased a_Name;
|
Name : aliased a_Name;
|
||||||
begin
|
begin
|
||||||
Tasks.check;
|
Tasks.check;
|
||||||
glGenBuffers (1, Name'unchecked_Access);
|
glGenBuffers (1, Name'unchecked_Access); Errors.log;
|
||||||
return Name;
|
return Name;
|
||||||
end new_vbo_Name;
|
end new_vbo_Name;
|
||||||
|
|
||||||
@@ -28,8 +29,9 @@ is
|
|||||||
Name : aliased a_Name := vbo_Name;
|
Name : aliased a_Name := vbo_Name;
|
||||||
begin
|
begin
|
||||||
Tasks.check;
|
Tasks.check;
|
||||||
glDeleteBuffers (1, Name'unchecked_Access);
|
glDeleteBuffers (1, Name'unchecked_Access); Errors.log;
|
||||||
end free;
|
end free;
|
||||||
|
|
||||||
pragma Unreferenced (free);
|
pragma Unreferenced (free);
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ with
|
|||||||
GL.lean,
|
GL.lean,
|
||||||
ada.unchecked_Conversion;
|
ada.unchecked_Conversion;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Buffer
|
package openGL.Buffer
|
||||||
--
|
--
|
||||||
-- Models a buffer object.
|
-- Models a buffer object.
|
||||||
@@ -11,7 +12,7 @@ is
|
|||||||
--------------
|
--------------
|
||||||
--- Core Types
|
--- Core Types
|
||||||
--
|
--
|
||||||
subtype a_Name is GL.GLuint; -- An openGL vertex buffer 'Name', which is a natural integer.
|
subtype a_Name is GL.GLuint; -- An openGL vertex buffer 'Name'.
|
||||||
type a_Kind is (array_Buffer, element_array_Buffer);
|
type a_Kind is (array_Buffer, element_array_Buffer);
|
||||||
type Usage is (stream_Draw, static_Draw, dynamic_Draw);
|
type Usage is (stream_Draw, static_Draw, dynamic_Draw);
|
||||||
|
|
||||||
@@ -121,4 +122,5 @@ private
|
|||||||
--
|
--
|
||||||
procedure verify_Name (Self : in out Object'Class);
|
procedure verify_Name (Self : in out Object'Class);
|
||||||
|
|
||||||
|
|
||||||
end openGL.Buffer;
|
end openGL.Buffer;
|
||||||
|
|||||||
@@ -12,6 +12,7 @@ with
|
|||||||
Interfaces.C.Strings,
|
Interfaces.C.Strings,
|
||||||
System.storage_Elements;
|
System.storage_Elements;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Geometry.colored
|
package body openGL.Geometry.colored
|
||||||
is
|
is
|
||||||
use GL.lean, GL.Pointers;
|
use GL.lean, GL.Pointers;
|
||||||
|
|||||||
@@ -35,9 +35,7 @@ is
|
|||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Geometry.item with
|
type Item is new Geometry.item with null record;
|
||||||
record
|
|
||||||
null;
|
|
||||||
end record;
|
|
||||||
|
|
||||||
end openGL.Geometry.colored;
|
end openGL.Geometry.colored;
|
||||||
|
|||||||
@@ -3,12 +3,9 @@ with
|
|||||||
openGL.Buffer.general,
|
openGL.Buffer.general,
|
||||||
openGL.Program,
|
openGL.Program,
|
||||||
openGL.Attribute,
|
openGL.Attribute,
|
||||||
openGL.Texture,
|
|
||||||
openGL.Palette,
|
|
||||||
openGL.Tasks,
|
openGL.Tasks,
|
||||||
openGL.Errors,
|
openGL.Errors,
|
||||||
|
|
||||||
GL.Binding,
|
|
||||||
GL.lean,
|
GL.lean,
|
||||||
GL.Pointers,
|
GL.Pointers,
|
||||||
|
|
||||||
@@ -16,6 +13,7 @@ with
|
|||||||
Interfaces.C.Strings,
|
Interfaces.C.Strings,
|
||||||
System.storage_Elements;
|
System.storage_Elements;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Geometry.colored_textured
|
package body openGL.Geometry.colored_textured
|
||||||
is
|
is
|
||||||
use GL.lean,
|
use GL.lean,
|
||||||
@@ -29,7 +27,6 @@ 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.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 := "Color";
|
Name_2 : constant String := "Color";
|
||||||
@@ -64,8 +61,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;
|
|
||||||
|
|
||||||
Sample : Vertex;
|
Sample : Vertex;
|
||||||
|
|
||||||
@@ -73,12 +69,11 @@ is
|
|||||||
Attribute_2 : Attribute.view;
|
Attribute_2 : Attribute.view;
|
||||||
Attribute_3 : Attribute.view;
|
Attribute_3 : 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/colored_textured.vert");
|
vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/colored_textured.vert");
|
||||||
fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/colored_textured.frag");
|
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
|
||||||
|
2 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
|
||||||
|
3 => to_Asset ("assets/opengl/shader/colored_textured.frag"))));
|
||||||
|
|
||||||
the_Program := new openGL.Program.item;
|
the_Program := new openGL.Program.item;
|
||||||
the_Program.define (vertex_Shader 'Access,
|
the_Program.define (vertex_Shader 'Access,
|
||||||
@@ -194,23 +189,4 @@ is
|
|||||||
end Indices_are;
|
end Indices_are;
|
||||||
|
|
||||||
|
|
||||||
-- overriding
|
|
||||||
-- procedure enable_Textures (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_Textures;
|
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry.colored_textured;
|
end openGL.Geometry.colored_textured;
|
||||||
|
|||||||
@@ -1,7 +1,3 @@
|
|||||||
with
|
|
||||||
openGL.texture_Set;
|
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
with
|
with
|
||||||
openGL.Geometry.texturing;
|
openGL.Geometry.texturing;
|
||||||
@@ -47,20 +43,7 @@ private
|
|||||||
|
|
||||||
package textured_Geometry is new texturing.Mixin;
|
package textured_Geometry is new texturing.Mixin;
|
||||||
|
|
||||||
|
type Item is new textured_Geometry.item with null record;
|
||||||
|
|
||||||
type Item is new textured_Geometry.item with
|
|
||||||
record
|
|
||||||
null;
|
|
||||||
end record;
|
|
||||||
|
|
||||||
|
|
||||||
-- type Item is new Geometry.item with
|
|
||||||
-- record
|
|
||||||
-- null;
|
|
||||||
-- end record;
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- overriding
|
|
||||||
-- procedure enable_Textures (Self : in out Item);
|
|
||||||
|
|
||||||
end openGL.Geometry.colored_textured;
|
end openGL.Geometry.colored_textured;
|
||||||
|
|||||||
@@ -37,4 +37,5 @@ private
|
|||||||
|
|
||||||
type Item is new Geometry.item with null record;
|
type Item is new Geometry.item with null record;
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry.lit_colored;
|
end openGL.Geometry.lit_colored;
|
||||||
|
|||||||
@@ -2,7 +2,6 @@ with
|
|||||||
openGL.Shader,
|
openGL.Shader,
|
||||||
openGL.Attribute,
|
openGL.Attribute,
|
||||||
openGL.Buffer.general,
|
openGL.Buffer.general,
|
||||||
openGL.Texture,
|
|
||||||
openGL.Tasks,
|
openGL.Tasks,
|
||||||
openGL.Errors,
|
openGL.Errors,
|
||||||
|
|
||||||
@@ -209,6 +208,7 @@ is
|
|||||||
end define_Program;
|
end define_Program;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
|
|||||||
@@ -1,9 +1,10 @@
|
|||||||
with
|
with
|
||||||
openGL.Program.lit.colored_skinned;
|
openGL.Program.lit.colored_skinned;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Geometry.lit_colored_skinned
|
package openGL.Geometry.lit_colored_skinned
|
||||||
--
|
--
|
||||||
-- Supports per-vertex site color, texture, lighting and skinning.
|
-- Supports per-vertex site color, lighting and skinning.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new openGL.Geometry.item with private;
|
type Item is new openGL.Geometry.item with private;
|
||||||
@@ -28,8 +29,10 @@ is
|
|||||||
bone_Ids : Vector_4;
|
bone_Ids : Vector_4;
|
||||||
bone_Weights : Vector_4;
|
bone_Weights : Vector_4;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
pragma Convention (C, Vertex);
|
pragma Convention (C, Vertex);
|
||||||
|
|
||||||
|
|
||||||
type Vertex_array is array (long_Index_t range <>) of aliased Vertex;
|
type Vertex_array is array (long_Index_t range <>) of aliased Vertex;
|
||||||
|
|
||||||
|
|
||||||
@@ -55,4 +58,5 @@ private
|
|||||||
overriding
|
overriding
|
||||||
procedure enable_Textures (Self : in out Item);
|
procedure enable_Textures (Self : in out Item);
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry.lit_colored_skinned;
|
end openGL.Geometry.lit_colored_skinned;
|
||||||
|
|||||||
@@ -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;
|
|
||||||
|
|
||||||
|
|
||||||
---------
|
---------
|
||||||
@@ -73,6 +68,7 @@ is
|
|||||||
|
|
||||||
type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
|
type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
|
||||||
|
|
||||||
|
|
||||||
function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class
|
function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class
|
||||||
is
|
is
|
||||||
use type openGL.Program.lit.view;
|
use type openGL.Program.lit.view;
|
||||||
@@ -81,8 +77,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 +88,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");
|
||||||
@@ -204,6 +196,7 @@ is
|
|||||||
textured_Geometry.create_Uniforms (for_Program => the_Program.Program.all'Access);
|
textured_Geometry.create_Uniforms (for_Program => the_Program.Program.all'Access);
|
||||||
end define;
|
end define;
|
||||||
|
|
||||||
|
|
||||||
Self : constant Geometry_view := new Geometry.lit_colored_textured.item;
|
Self : constant Geometry_view := new Geometry.lit_colored_textured.item;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@@ -234,6 +227,7 @@ is
|
|||||||
end new_Geometry;
|
end new_Geometry;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
----------
|
----------
|
||||||
-- Vertex
|
-- Vertex
|
||||||
--
|
--
|
||||||
@@ -250,6 +244,7 @@ is
|
|||||||
end is_Transparent;
|
end is_Transparent;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -266,7 +261,7 @@ is
|
|||||||
begin
|
begin
|
||||||
if Self.Vertices = null
|
if Self.Vertices = null
|
||||||
then
|
then
|
||||||
self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (Forge.to_Buffer (Now,
|
Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (Forge.to_Buffer (Now,
|
||||||
usage => Buffer.static_Draw));
|
usage => Buffer.static_Draw));
|
||||||
else
|
else
|
||||||
set (openGL_Buffer_of_geometry_Vertices.Object (Self.Vertices.all),
|
set (openGL_Buffer_of_geometry_Vertices.Object (Self.Vertices.all),
|
||||||
@@ -288,6 +283,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 +293,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;
|
||||||
|
|||||||
@@ -1,7 +1,3 @@
|
|||||||
with
|
|
||||||
openGL.texture_Set;
|
|
||||||
|
|
||||||
private
|
|
||||||
with
|
with
|
||||||
openGL.Geometry.texturing;
|
openGL.Geometry.texturing;
|
||||||
|
|
||||||
@@ -11,7 +7,10 @@ package openGL.Geometry.lit_colored_textured
|
|||||||
-- Supports 'per-vertex' site, color, texture and lighting.
|
-- Supports 'per-vertex' site, color, texture and lighting.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new openGL.Geometry.item with private;
|
package textured_Geometry is new texturing.Mixin;
|
||||||
|
|
||||||
|
|
||||||
|
type Item is new textured_Geometry.item with private;
|
||||||
type View is access all Item'Class;
|
type View is access all Item'Class;
|
||||||
|
|
||||||
function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class;
|
function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class;
|
||||||
@@ -43,44 +42,10 @@ 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
|
||||||
|
|
||||||
package textured_Geometry is new texturing.Mixin;
|
type Item is new textured_Geometry.item with null record;
|
||||||
|
|
||||||
|
|
||||||
type Item is new textured_Geometry.item with
|
|
||||||
record
|
|
||||||
null;
|
|
||||||
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;
|
||||||
|
|||||||
@@ -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;
|
|
||||||
|
|
||||||
|
|
||||||
----------
|
----------
|
||||||
@@ -74,6 +70,7 @@ is
|
|||||||
end is_Transparent;
|
end is_Transparent;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------
|
---------
|
||||||
-- Forge
|
-- Forge
|
||||||
--
|
--
|
||||||
@@ -93,8 +90,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 +105,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 +117,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 +234,7 @@ is
|
|||||||
end define_Program;
|
end define_Program;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -290,36 +283,4 @@ is
|
|||||||
end Vertices_are;
|
end Vertices_are;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- overriding
|
|
||||||
-- procedure enable_Textures (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
|
|
||||||
-- if not white_Texture.is_Defined
|
|
||||||
-- then
|
|
||||||
-- declare
|
|
||||||
-- use Palette;
|
|
||||||
-- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
|
|
||||||
-- begin
|
|
||||||
-- white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
|
|
||||||
-- end;
|
|
||||||
-- end if;
|
|
||||||
--
|
|
||||||
-- white_Texture.enable;
|
|
||||||
-- else
|
|
||||||
-- Self.Texture.enable;
|
|
||||||
-- end if;
|
|
||||||
-- end enable_Textures;
|
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry.lit_colored_textured_skinned;
|
end openGL.Geometry.lit_colored_textured_skinned;
|
||||||
|
|||||||
@@ -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.
|
||||||
@@ -39,6 +37,7 @@ is
|
|||||||
|
|
||||||
pragma Convention (C, Vertex);
|
pragma Convention (C, Vertex);
|
||||||
|
|
||||||
|
|
||||||
type Vertex_array is array (long_Index_t range <>) of aliased Vertex;
|
type Vertex_array is array (long_Index_t range <>) of aliased Vertex;
|
||||||
|
|
||||||
|
|
||||||
@@ -60,16 +59,7 @@ private
|
|||||||
|
|
||||||
package textured_Geometry is new texturing.Mixin;
|
package textured_Geometry is new texturing.Mixin;
|
||||||
|
|
||||||
|
type Item is new textured_Geometry.item with null record;
|
||||||
|
|
||||||
type Item is new textured_Geometry.item with
|
|
||||||
record
|
|
||||||
null;
|
|
||||||
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;
|
||||||
|
|||||||
@@ -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;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
@@ -35,7 +27,6 @@ is
|
|||||||
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;
|
||||||
|
|
||||||
@@ -197,7 +160,6 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
----------
|
----------
|
||||||
-- Vertex
|
-- Vertex
|
||||||
--
|
--
|
||||||
@@ -220,7 +182,6 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -291,75 +252,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;
|
||||||
|
|||||||
@@ -1,6 +1,3 @@
|
|||||||
with
|
|
||||||
openGL.texture_Set;
|
|
||||||
|
|
||||||
private
|
private
|
||||||
with
|
with
|
||||||
openGL.Geometry.texturing;
|
openGL.Geometry.texturing;
|
||||||
@@ -46,36 +43,11 @@ 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;
|
||||||
|
|
||||||
|
type Item is new textured_Geometry.item with null record;
|
||||||
|
|
||||||
type Item is new textured_Geometry.item with
|
|
||||||
record
|
|
||||||
null;
|
|
||||||
end record;
|
|
||||||
|
|
||||||
|
|
||||||
-- overriding
|
|
||||||
-- procedure enable_Textures (Self : in out Item);
|
|
||||||
|
|
||||||
end openGL.Geometry.lit_textured;
|
end openGL.Geometry.lit_textured;
|
||||||
|
|||||||
@@ -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,10 +105,7 @@ 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, (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"),
|
||||||
3 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
|
3 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
|
||||||
@@ -263,36 +253,4 @@ is
|
|||||||
end Vertices_are;
|
end Vertices_are;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- overriding
|
|
||||||
-- procedure enable_Textures (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
|
|
||||||
-- if not white_Texture.is_Defined
|
|
||||||
-- then
|
|
||||||
-- declare
|
|
||||||
-- use Palette;
|
|
||||||
-- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
|
|
||||||
-- begin
|
|
||||||
-- white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
|
|
||||||
-- end;
|
|
||||||
-- end if;
|
|
||||||
--
|
|
||||||
-- white_Texture.enable;
|
|
||||||
-- else
|
|
||||||
-- Self.Texture.enable;
|
|
||||||
-- end if;
|
|
||||||
-- end enable_Textures;
|
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry.lit_textured_skinned;
|
end openGL.Geometry.lit_textured_skinned;
|
||||||
|
|||||||
@@ -1,6 +1,5 @@
|
|||||||
with
|
with
|
||||||
openGL.Program.lit.textured_skinned,
|
openGL.Program.lit.textured_skinned;
|
||||||
openGL.texture_Set;
|
|
||||||
|
|
||||||
private
|
private
|
||||||
with
|
with
|
||||||
@@ -58,16 +57,7 @@ private
|
|||||||
|
|
||||||
package textured_Geometry is new texturing.Mixin;
|
package textured_Geometry is new texturing.Mixin;
|
||||||
|
|
||||||
|
type Item is new textured_Geometry.item with null record;
|
||||||
|
|
||||||
type Item is new textured_Geometry.item with
|
|
||||||
record
|
|
||||||
null;
|
|
||||||
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;
|
||||||
|
|||||||
@@ -2,14 +2,12 @@ with
|
|||||||
openGL.Buffer.general,
|
openGL.Buffer.general,
|
||||||
openGL.Shader,
|
openGL.Shader,
|
||||||
openGL.Program,
|
openGL.Program,
|
||||||
openGL.Palette,
|
|
||||||
openGL.Attribute,
|
openGL.Attribute,
|
||||||
openGL.Texture,
|
openGL.Errors,
|
||||||
openGL.Tasks,
|
openGL.Tasks,
|
||||||
GL.lean,
|
GL.lean,
|
||||||
GL.Pointers,
|
GL.Pointers,
|
||||||
|
|
||||||
System,
|
|
||||||
Interfaces.C.Strings,
|
Interfaces.C.Strings,
|
||||||
System.storage_Elements;
|
System.storage_Elements;
|
||||||
|
|
||||||
@@ -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"),
|
||||||
@@ -107,10 +97,12 @@ is
|
|||||||
glBindAttribLocation (program => the_Program.gl_Program,
|
glBindAttribLocation (program => the_Program.gl_Program,
|
||||||
index => the_Program.Attribute (named => Name_1).gl_Location,
|
index => the_Program.Attribute (named => Name_1).gl_Location,
|
||||||
name => +Attribute_1_Name_ptr);
|
name => +Attribute_1_Name_ptr);
|
||||||
|
Errors.log;
|
||||||
|
|
||||||
glBindAttribLocation (program => the_Program.gl_Program,
|
glBindAttribLocation (program => the_Program.gl_Program,
|
||||||
index => the_Program.Attribute (named => Name_2).gl_Location,
|
index => the_Program.Attribute (named => Name_2).gl_Location,
|
||||||
name => +Attribute_2_Name_ptr);
|
name => +Attribute_2_Name_ptr);
|
||||||
|
Errors.log;
|
||||||
|
|
||||||
textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
|
textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
|
||||||
end;
|
end;
|
||||||
@@ -122,7 +114,6 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -140,13 +131,12 @@ is
|
|||||||
Element => Vertex,
|
Element => Vertex,
|
||||||
Element_Array => Vertex_array);
|
Element_Array => Vertex_array);
|
||||||
|
|
||||||
|
|
||||||
procedure Vertices_are (Self : in out Item; Now : in Vertex_array)
|
procedure Vertices_are (Self : in out Item; Now : in Vertex_array)
|
||||||
is
|
is
|
||||||
use openGL_Buffer_of_geometry_Vertices.Forge;
|
use openGL_Buffer_of_geometry_Vertices.Forge;
|
||||||
begin
|
begin
|
||||||
Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now,
|
Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now,
|
||||||
usage => Buffer.static_Draw));
|
Usage => Buffer.static_Draw));
|
||||||
-- Set the bounds.
|
-- Set the bounds.
|
||||||
--
|
--
|
||||||
declare
|
declare
|
||||||
@@ -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;
|
||||||
|
|||||||
@@ -1,7 +1,3 @@
|
|||||||
with
|
|
||||||
openGL.texture_Set;
|
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
with
|
with
|
||||||
openGL.Geometry.texturing;
|
openGL.Geometry.texturing;
|
||||||
@@ -45,42 +41,11 @@ 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;
|
||||||
|
|
||||||
|
type Item is new textured_Geometry.item with null record;
|
||||||
|
|
||||||
type Item is new textured_Geometry.item with
|
|
||||||
record
|
|
||||||
null;
|
|
||||||
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;
|
||||||
|
|||||||
@@ -1,11 +1,10 @@
|
|||||||
with
|
with
|
||||||
openGL.Model,
|
openGL.Model,
|
||||||
|
openGL.Errors,
|
||||||
GL.lean,
|
GL.lean,
|
||||||
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 +13,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 +28,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,
|
||||||
@@ -49,10 +48,9 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure enable (for_Model : in openGL.Model.view;
|
procedure enable (for_Model : in openGL.Model.view;
|
||||||
Uniforms : in texturing.Uniforms;
|
Uniforms : in texturing.Uniforms)
|
||||||
texture_Set : in openGL.texture_Set.Item)
|
-- texture_Set : in openGL.texture_Set.Item)
|
||||||
is
|
is
|
||||||
use GL.Binding,
|
use GL.Binding,
|
||||||
GL.lean;
|
GL.lean;
|
||||||
@@ -60,17 +58,22 @@ is
|
|||||||
use type GLint;
|
use type GLint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
if for_Model.texture_Count > 0
|
||||||
|
then
|
||||||
for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
|
for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
|
||||||
loop
|
loop
|
||||||
Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (i)));
|
Uniforms.Textures (i).tiling_Uniform .Value_is (Vector_2' ((for_Model.Tiling (Which => i).S,
|
||||||
Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (i));
|
for_Model.Tiling (Which => i).T)));
|
||||||
|
Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (Which => i)));
|
||||||
|
Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i));
|
||||||
|
|
||||||
glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
|
glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
|
||||||
GLint (i) - 1);
|
GLint (i) - 1); Errors.log;
|
||||||
glActiveTexture (all_texture_Units (i));
|
glActiveTexture (all_texture_Units (i)); Errors.log;
|
||||||
glBindTexture (GL_TEXTURE_2D,
|
glBindTexture (GL_TEXTURE_2D,
|
||||||
texture_Set.Textures (i).Object.Name);
|
for_Model.texture_Object (i).Name); Errors.log;
|
||||||
end loop;
|
end loop;
|
||||||
|
end if;
|
||||||
|
|
||||||
Uniforms.Count.Value_is (for_Model.texture_Count);
|
Uniforms.Count.Value_is (for_Model.texture_Count);
|
||||||
end enable;
|
end enable;
|
||||||
@@ -91,10 +94,12 @@ is
|
|||||||
texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]";
|
texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]";
|
||||||
fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]";
|
fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]";
|
||||||
texture_applies_uniform_Name : constant String := "texture_Applies[" & trim (Natural'Image (i - 1), Left) & "]";
|
texture_applies_uniform_Name : constant String := "texture_Applies[" & trim (Natural'Image (i - 1), Left) & "]";
|
||||||
|
tiling_uniform_Name : constant String := "Tiling[" & trim (Natural'Image (i - 1), Left) & "]";
|
||||||
begin
|
begin
|
||||||
Uniforms.Textures (Id). texture_Uniform := for_Program.uniform_Variable (Named => texture_uniform_Name);
|
Uniforms.Textures (Id). texture_Uniform := for_Program.uniform_Variable (Named => texture_uniform_Name);
|
||||||
Uniforms.Textures (Id). fade_Uniform := for_Program.uniform_Variable (Named => fade_uniform_Name);
|
Uniforms.Textures (Id). fade_Uniform := for_Program.uniform_Variable (Named => fade_uniform_Name);
|
||||||
Uniforms.Textures (Id).texture_applied_Uniform := for_Program.uniform_Variable (Named => texture_applies_uniform_Name);
|
Uniforms.Textures (Id).texture_applied_Uniform := for_Program.uniform_Variable (Named => texture_applies_uniform_Name);
|
||||||
|
Uniforms.Textures (Id).tiling_Uniform := for_Program.uniform_Variable (Named => tiling_uniform_Name);
|
||||||
end;
|
end;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
@@ -111,11 +116,9 @@ is
|
|||||||
|
|
||||||
package body Mixin
|
package body Mixin
|
||||||
is
|
is
|
||||||
use openGL.texture_Set;
|
|
||||||
|
|
||||||
|
|
||||||
texture_Uniforms : texturing.Uniforms;
|
texture_Uniforms : texturing.Uniforms;
|
||||||
|
|
||||||
|
|
||||||
procedure create_Uniforms (for_Program : in openGL.Program.view)
|
procedure create_Uniforms (for_Program : in openGL.Program.view)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
@@ -129,7 +132,8 @@ is
|
|||||||
Which : in texture_Set.texture_ID := 1)
|
Which : in texture_Set.texture_ID := 1)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
Self.texture_Set.Textures (Which).Fade := Now;
|
Self.Model.Fade_is (Which => Which,
|
||||||
|
Now => Now);
|
||||||
end Fade_is;
|
end Fade_is;
|
||||||
|
|
||||||
|
|
||||||
@@ -138,7 +142,7 @@ is
|
|||||||
function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level
|
function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return Self.texture_Set.Textures (which).Fade;
|
return Self.Model.Fade (Which => Which);
|
||||||
end Fade;
|
end Fade;
|
||||||
|
|
||||||
|
|
||||||
@@ -148,8 +152,7 @@ is
|
|||||||
Which : in texture_Set.texture_ID := 1)
|
Which : in texture_Set.texture_ID := 1)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
Texture_is (in_Set => Self.texture_Set,
|
Self.Model.texture_Object_is (Which => Which,
|
||||||
Which => Which,
|
|
||||||
Now => Now);
|
Now => Now);
|
||||||
end Texture_is;
|
end Texture_is;
|
||||||
|
|
||||||
@@ -159,8 +162,7 @@ is
|
|||||||
function Texture (Self : in Item; Which : texture_Set.texture_ID := 1) return openGL.Texture.Object
|
function Texture (Self : in Item; Which : texture_Set.texture_ID := 1) return openGL.Texture.Object
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
|
return Self.Model.texture_Object (Which);
|
||||||
Which => Which);
|
|
||||||
end Texture;
|
end Texture;
|
||||||
|
|
||||||
|
|
||||||
@@ -170,7 +172,7 @@ is
|
|||||||
Which : in texture_Set.texture_ID := 1)
|
Which : in texture_Set.texture_ID := 1)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
Self.texture_Set.Textures (Which).Applied := Now;
|
Self.Model.texture_Applied_is (Which, Now);
|
||||||
end texture_Applied_is;
|
end texture_Applied_is;
|
||||||
|
|
||||||
|
|
||||||
@@ -179,25 +181,41 @@ is
|
|||||||
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return Self.texture_Set.Textures (which).Applied;
|
return Self.Model.texture_Applied (Which);
|
||||||
end texture_Applied;
|
end texture_Applied;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure Tiling_is (Self : in out Item; Now : in texture_Set.Tiling;
|
||||||
|
Which : in texture_Set.texture_ID := 1)
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
Self.Model.Tiling_is (Which => Which,
|
||||||
|
Now => Now);
|
||||||
|
end Tiling_is;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overriding
|
||||||
|
function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
return Self.Model.Tiling (Which);
|
||||||
|
end Tiling;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
procedure enable_Textures (Self : in out Item)
|
procedure enable_Textures (Self : in out Item)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
-- ada.Text_IO.put_Line (Self.Model'Image);
|
|
||||||
|
|
||||||
texturing.enable (for_Model => Self.Model.all'Access,
|
texturing.enable (for_Model => Self.Model.all'Access,
|
||||||
Uniforms => texture_Uniforms,
|
Uniforms => texture_Uniforms);
|
||||||
texture_Set => Self.texture_Set);
|
|
||||||
end enable_Textures;
|
end enable_Textures;
|
||||||
|
|
||||||
|
|
||||||
end Mixin;
|
end Mixin;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry.texturing;
|
end openGL.Geometry.texturing;
|
||||||
|
|||||||
@@ -8,7 +8,6 @@ with
|
|||||||
openGL.Model;
|
openGL.Model;
|
||||||
|
|
||||||
|
|
||||||
private
|
|
||||||
package openGL.Geometry.texturing
|
package openGL.Geometry.texturing
|
||||||
--
|
--
|
||||||
-- Provides texturing support for geometries.
|
-- Provides texturing support for geometries.
|
||||||
@@ -23,6 +22,7 @@ is
|
|||||||
texture_Uniform : openGL.Variable.uniform.sampler2D;
|
texture_Uniform : openGL.Variable.uniform.sampler2D;
|
||||||
fade_Uniform : openGL.Variable.uniform.float;
|
fade_Uniform : openGL.Variable.uniform.float;
|
||||||
texture_applied_Uniform : openGL.Variable.uniform.bool;
|
texture_applied_Uniform : openGL.Variable.uniform.bool;
|
||||||
|
tiling_Uniform : openGL.Variable.uniform.vec2;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
@@ -41,17 +41,13 @@ is
|
|||||||
--
|
--
|
||||||
|
|
||||||
procedure enable (for_Model : in openGL.Model.view;
|
procedure enable (for_Model : in openGL.Model.view;
|
||||||
Uniforms : in texturing.Uniforms;
|
Uniforms : in texturing.Uniforms);
|
||||||
texture_Set : in openGL.texture_Set.Item);
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure create (Uniforms : out texturing.Uniforms;
|
procedure create (Uniforms : out texturing.Uniforms;
|
||||||
for_Program : in openGL.Program.view);
|
for_Program : in openGL.Program.view);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
--- Mixin ---
|
--- Mixin ---
|
||||||
-------------
|
-------------
|
||||||
@@ -65,7 +61,6 @@ is
|
|||||||
procedure create_Uniforms (for_Program : in openGL.Program.view);
|
procedure create_Uniforms (for_Program : in openGL.Program.view);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
|
procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
|
||||||
Which : in texture_Set.texture_ID := 1);
|
Which : in texture_Set.texture_ID := 1);
|
||||||
@@ -86,6 +81,11 @@ is
|
|||||||
overriding
|
overriding
|
||||||
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
|
||||||
|
|
||||||
|
overriding
|
||||||
|
procedure Tiling_is (Self : in out Item; Now : in texture_Set.Tiling;
|
||||||
|
Which : in texture_Set.texture_ID := 1);
|
||||||
|
overriding
|
||||||
|
function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling;
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
@@ -94,13 +94,9 @@ is
|
|||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Geometry.item with
|
type Item is new Geometry.item with null record;
|
||||||
record
|
|
||||||
texture_Set : openGL.texture_Set.item;
|
|
||||||
end record;
|
|
||||||
|
|
||||||
end Mixin;
|
end Mixin;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry.texturing;
|
end openGL.Geometry.texturing;
|
||||||
|
|||||||
@@ -45,7 +45,6 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -112,7 +111,7 @@ is
|
|||||||
function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level
|
function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
raise program_Error with "Geometry has no texture.";
|
raise Error with "Geometry has no texture.";
|
||||||
return texture_Set.fade_Level'Last;
|
return texture_Set.fade_Level'Last;
|
||||||
end Fade;
|
end Fade;
|
||||||
|
|
||||||
@@ -121,7 +120,7 @@ is
|
|||||||
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object
|
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
raise program_Error with "Geometry has no texture.";
|
raise Error with "Geometry has no texture.";
|
||||||
return openGL.Texture.null_Object;
|
return openGL.Texture.null_Object;
|
||||||
end Texture;
|
end Texture;
|
||||||
|
|
||||||
@@ -130,12 +129,23 @@ is
|
|||||||
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
raise program_Error with "Geometry has no texture.";
|
raise Error with "Geometry has no texture.";
|
||||||
return False;
|
return False;
|
||||||
end texture_Applied;
|
end texture_Applied;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling
|
||||||
|
is
|
||||||
|
begin
|
||||||
|
raise Error with "Geometry has no texture.";
|
||||||
|
return (S => 0.0,
|
||||||
|
T => 0.0);
|
||||||
|
end Tiling;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure Program_is (Self : in out Item; Now : in openGL.Program.view)
|
procedure Program_is (Self : in out Item; Now : in openGL.Program.view)
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
@@ -151,7 +161,7 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
function Bounds (self : in Item'Class) return openGL.Bounds
|
function Bounds (Self : in Item'Class) return openGL.Bounds
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return Self.Bounds;
|
return Self.Bounds;
|
||||||
@@ -186,7 +196,6 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Operations
|
-- Operations
|
||||||
--
|
--
|
||||||
@@ -221,7 +230,6 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
-- Normals
|
-- Normals
|
||||||
--
|
--
|
||||||
@@ -298,6 +306,7 @@ is
|
|||||||
pragma Unreferenced (facet_Count_in);
|
pragma Unreferenced (facet_Count_in);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
----------
|
----------
|
||||||
-- Facets
|
-- Facets
|
||||||
--
|
--
|
||||||
@@ -318,6 +327,7 @@ is
|
|||||||
-- 'Facets_of' returns all non-redundant facets.
|
-- 'Facets_of' returns all non-redundant facets.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
function any_Facets_of (face_Kind : in primitive.facet_Kind;
|
function any_Facets_of (face_Kind : in primitive.facet_Kind;
|
||||||
Indices : in any_Indices) return access Facets
|
Indices : in any_Indices) return access Facets
|
||||||
is
|
is
|
||||||
@@ -350,9 +360,11 @@ is
|
|||||||
is
|
is
|
||||||
when Triangles
|
when Triangles
|
||||||
| triangle_Fan =>
|
| triangle_Fan =>
|
||||||
|
|
||||||
the_Facets (Count) := [P1, P2, P3];
|
the_Facets (Count) := [P1, P2, P3];
|
||||||
|
|
||||||
when triangle_Strip =>
|
when triangle_Strip =>
|
||||||
|
|
||||||
if Each mod 2 = 0
|
if Each mod 2 = 0
|
||||||
then -- Is an even facet.
|
then -- Is an even facet.
|
||||||
the_Facets (Count) := [P1, P3, P2];
|
the_Facets (Count) := [P1, P3, P2];
|
||||||
@@ -377,6 +389,7 @@ is
|
|||||||
end any_Facets_of;
|
end any_Facets_of;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
function Facets_of is new any_Facets_of (Index_t,
|
function Facets_of is new any_Facets_of (Index_t,
|
||||||
Indices);
|
Indices);
|
||||||
pragma Unreferenced (Facets_of);
|
pragma Unreferenced (Facets_of);
|
||||||
@@ -469,7 +482,7 @@ is
|
|||||||
free (the_Facets);
|
free (the_Facets);
|
||||||
free (the_facet_Normals);
|
free (the_facet_Normals);
|
||||||
|
|
||||||
return the_Normals.all'Unchecked_Access;
|
return the_Normals.all'unchecked_Access;
|
||||||
end any_Normals_of;
|
end any_Normals_of;
|
||||||
|
|
||||||
|
|
||||||
@@ -526,7 +539,6 @@ is
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------
|
---------------
|
||||||
-- Transparency
|
-- Transparency
|
||||||
--
|
--
|
||||||
|
|||||||
@@ -66,6 +66,10 @@ is
|
|||||||
Which : in texture_Set.texture_ID := 1) is null;
|
Which : in texture_Set.texture_ID := 1) is null;
|
||||||
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
|
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
|
||||||
|
|
||||||
|
procedure Tiling_is (Self : in out Item; Now : in texture_Set.Tiling;
|
||||||
|
Which : in texture_Set.texture_ID := 1) is null;
|
||||||
|
function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure Bounds_are (Self : in out Item'Class; Now : in Bounds);
|
procedure Bounds_are (Self : in out Item'Class; Now : in Bounds);
|
||||||
@@ -131,11 +135,15 @@ private
|
|||||||
generic
|
generic
|
||||||
type any_Index_t is range <>;
|
type any_Index_t is range <>;
|
||||||
with function get_Site (Index : in any_Index_t) return Vector_3;
|
with function get_Site (Index : in any_Index_t) return Vector_3;
|
||||||
|
|
||||||
function get_Bounds (Count : in Natural) return openGL.Bounds;
|
function get_Bounds (Count : in Natural) return openGL.Bounds;
|
||||||
|
|
||||||
|
|
||||||
generic
|
generic
|
||||||
type any_Index_t is range <>;
|
type any_Index_t is range <>;
|
||||||
with function get_Color (Index : in any_Index_t) return rgba_Color;
|
with function get_Color (Index : in any_Index_t) return rgba_Color;
|
||||||
|
|
||||||
function get_Transparency (Count : in Natural) return Boolean;
|
function get_Transparency (Count : in Natural) return Boolean;
|
||||||
|
|
||||||
|
|
||||||
end openGL.Geometry;
|
end openGL.Geometry;
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ with
|
|||||||
GL.Binding,
|
GL.Binding,
|
||||||
GL.lean;
|
GL.lean;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Primitive.indexed
|
package body openGL.Primitive.indexed
|
||||||
is
|
is
|
||||||
---------
|
---------
|
||||||
@@ -48,7 +49,7 @@ is
|
|||||||
|
|
||||||
Self.facet_Kind := Kind;
|
Self.facet_Kind := Kind;
|
||||||
Self.Indices := new openGL.Buffer.indices.Object' (to_Buffer (buffer_Indices'Access,
|
Self.Indices := new openGL.Buffer.indices.Object' (to_Buffer (buffer_Indices'Access,
|
||||||
usage => Buffer.static_Draw));
|
Usage => Buffer.static_Draw));
|
||||||
Self.line_Width := line_Width;
|
Self.line_Width := line_Width;
|
||||||
end define;
|
end define;
|
||||||
|
|
||||||
@@ -88,6 +89,7 @@ is
|
|||||||
end destroy;
|
end destroy;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
|
|||||||
@@ -2,6 +2,7 @@ private
|
|||||||
with
|
with
|
||||||
openGL.Buffer.indices;
|
openGL.Buffer.indices;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Primitive.indexed
|
package openGL.Primitive.indexed
|
||||||
--
|
--
|
||||||
-- Provides a class for indexed openGL primitives.
|
-- Provides a class for indexed openGL primitives.
|
||||||
@@ -37,6 +38,7 @@ is
|
|||||||
procedure destroy (Self : in out Item);
|
procedure destroy (Self : in out Item);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -45,6 +47,7 @@ is
|
|||||||
procedure Indices_are (Self : in out Item; Now : in long_Indices);
|
procedure Indices_are (Self : in out Item; Now : in long_Indices);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Operations
|
-- Operations
|
||||||
--
|
--
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ with
|
|||||||
|
|
||||||
ada.unchecked_Deallocation;
|
ada.unchecked_Deallocation;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Primitive.long_indexed
|
package body openGL.Primitive.long_indexed
|
||||||
is
|
is
|
||||||
---------
|
---------
|
||||||
@@ -25,7 +26,7 @@ is
|
|||||||
|
|
||||||
Self.facet_Kind := Kind;
|
Self.facet_Kind := Kind;
|
||||||
Self.Indices := new Buffer.long_indices.Object' (to_Buffer (buffer_Indices'Access,
|
Self.Indices := new Buffer.long_indices.Object' (to_Buffer (buffer_Indices'Access,
|
||||||
usage => Buffer.static_Draw));
|
Usage => Buffer.static_Draw));
|
||||||
end define;
|
end define;
|
||||||
|
|
||||||
|
|
||||||
@@ -52,6 +53,7 @@ is
|
|||||||
end destroy;
|
end destroy;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -70,6 +72,7 @@ is
|
|||||||
end Indices_are;
|
end Indices_are;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Operations
|
-- Operations
|
||||||
--
|
--
|
||||||
|
|||||||
@@ -2,6 +2,7 @@ private
|
|||||||
with
|
with
|
||||||
openGL.Buffer.long_indices;
|
openGL.Buffer.long_indices;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Primitive.long_indexed
|
package openGL.Primitive.long_indexed
|
||||||
--
|
--
|
||||||
-- Provides a class for long indexed openGL primitives.
|
-- Provides a class for long indexed openGL primitives.
|
||||||
@@ -27,6 +28,7 @@ is
|
|||||||
procedure destroy (Self : in out Item);
|
procedure destroy (Self : in out Item);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -34,6 +36,7 @@ is
|
|||||||
procedure Indices_are (Self : in out Item; Now : in long_Indices);
|
procedure Indices_are (Self : in out Item; Now : in long_Indices);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Operations
|
-- Operations
|
||||||
--
|
--
|
||||||
@@ -50,4 +53,5 @@ private
|
|||||||
Indices : Buffer.long_indices.view;
|
Indices : Buffer.long_indices.view;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
end openGL.Primitive.long_indexed;
|
end openGL.Primitive.long_indexed;
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ with
|
|||||||
openGL.Tasks,
|
openGL.Tasks,
|
||||||
GL.Binding;
|
GL.Binding;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Primitive.non_indexed
|
package body openGL.Primitive.non_indexed
|
||||||
is
|
is
|
||||||
---------
|
---------
|
||||||
@@ -29,6 +30,7 @@ is
|
|||||||
end new_Primitive;
|
end new_Primitive;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
overriding
|
||||||
procedure destroy (Self : in out Item) is null;
|
procedure destroy (Self : in out Item) is null;
|
||||||
|
|
||||||
|
|||||||
@@ -10,6 +10,7 @@ is
|
|||||||
type Views is array (Index_t range <>) of View;
|
type Views is array (Index_t range <>) of View;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------
|
---------
|
||||||
-- Forge
|
-- Forge
|
||||||
--
|
--
|
||||||
@@ -23,6 +24,7 @@ is
|
|||||||
function new_Primitive (Kind : in facet_Kind;
|
function new_Primitive (Kind : in facet_Kind;
|
||||||
vertex_Count : in Natural) return Primitive.non_indexed.view;
|
vertex_Count : in Natural) return Primitive.non_indexed.view;
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Operations
|
-- Operations
|
||||||
--
|
--
|
||||||
@@ -39,4 +41,5 @@ private
|
|||||||
vertex_Count : Natural := 0;
|
vertex_Count : Natural := 0;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
end openGL.Primitive.non_indexed;
|
end openGL.Primitive.non_indexed;
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ with
|
|||||||
|
|
||||||
ada.unchecked_Deallocation;
|
ada.unchecked_Deallocation;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Primitive.short_indexed
|
package body openGL.Primitive.short_indexed
|
||||||
is
|
is
|
||||||
---------
|
---------
|
||||||
@@ -25,7 +26,7 @@ is
|
|||||||
|
|
||||||
Self.facet_Kind := Kind;
|
Self.facet_Kind := Kind;
|
||||||
Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
|
Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
|
||||||
usage => Buffer.static_Draw));
|
Usage => Buffer.static_Draw));
|
||||||
end define;
|
end define;
|
||||||
|
|
||||||
|
|
||||||
@@ -43,7 +44,7 @@ is
|
|||||||
|
|
||||||
Self.facet_Kind := Kind;
|
Self.facet_Kind := Kind;
|
||||||
Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
|
Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
|
||||||
usage => Buffer.static_Draw));
|
Usage => Buffer.static_Draw));
|
||||||
end define;
|
end define;
|
||||||
|
|
||||||
|
|
||||||
@@ -61,7 +62,7 @@ is
|
|||||||
|
|
||||||
Self.facet_Kind := Kind;
|
Self.facet_Kind := Kind;
|
||||||
Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
|
Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
|
||||||
usage => Buffer.static_Draw));
|
Usage => Buffer.static_Draw));
|
||||||
end define;
|
end define;
|
||||||
|
|
||||||
|
|
||||||
@@ -110,6 +111,7 @@ is
|
|||||||
end destroy;
|
end destroy;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -118,13 +120,14 @@ is
|
|||||||
is
|
is
|
||||||
use Buffer.short_indices;
|
use Buffer.short_indices;
|
||||||
buffer_Indices : aliased short_Indices := [Now'Range => <>];
|
buffer_Indices : aliased short_Indices := [Now'Range => <>];
|
||||||
|
|
||||||
begin
|
begin
|
||||||
for Each in buffer_Indices'Range
|
for Each in buffer_Indices'Range
|
||||||
loop
|
loop
|
||||||
buffer_Indices (Each) := Now (Each) - 1; -- Adjust indices to zero-based-indexing for GL.
|
buffer_Indices (Each) := Now (Each) - 1; -- Adjust indices to zero-based-indexing for GL.
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
Self.Indices.set (to => buffer_Indices);
|
Self.Indices.set (To => buffer_Indices);
|
||||||
end Indices_are;
|
end Indices_are;
|
||||||
|
|
||||||
|
|
||||||
@@ -133,13 +136,14 @@ is
|
|||||||
is
|
is
|
||||||
use Buffer.short_indices;
|
use Buffer.short_indices;
|
||||||
buffer_Indices : aliased short_Indices := [Now'Range => <>];
|
buffer_Indices : aliased short_Indices := [Now'Range => <>];
|
||||||
|
|
||||||
begin
|
begin
|
||||||
for Each in buffer_Indices'Range
|
for Each in buffer_Indices'Range
|
||||||
loop
|
loop
|
||||||
buffer_Indices (Each) := short_Index_t (Now (Each) - 1); -- Adjust indices to zero-based-indexing for GL.
|
buffer_Indices (Each) := short_Index_t (Now (Each) - 1); -- Adjust indices to zero-based-indexing for GL.
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
Self.Indices.set (to => buffer_Indices);
|
Self.Indices.set (To => buffer_Indices);
|
||||||
end Indices_are;
|
end Indices_are;
|
||||||
|
|
||||||
|
|
||||||
@@ -148,13 +152,14 @@ is
|
|||||||
is
|
is
|
||||||
use Buffer.short_indices;
|
use Buffer.short_indices;
|
||||||
buffer_Indices : aliased short_Indices := [Now'Range => <>];
|
buffer_Indices : aliased short_Indices := [Now'Range => <>];
|
||||||
|
|
||||||
begin
|
begin
|
||||||
for Each in buffer_Indices'Range
|
for Each in buffer_Indices'Range
|
||||||
loop
|
loop
|
||||||
buffer_Indices (Each) := short_Index_t (Now (Each) - 1); -- Adjust indices to zero-based-indexing for GL.
|
buffer_Indices (Each) := short_Index_t (Now (Each) - 1); -- Adjust indices to zero-based-indexing for GL.
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
Self.Indices.set (to => buffer_Indices);
|
Self.Indices.set (To => buffer_Indices);
|
||||||
end Indices_are;
|
end Indices_are;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -2,6 +2,7 @@ private
|
|||||||
with
|
with
|
||||||
openGL.Buffer.short_indices;
|
openGL.Buffer.short_indices;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Primitive.short_indexed
|
package openGL.Primitive.short_indexed
|
||||||
--
|
--
|
||||||
-- Provides a class for short indexed openGL primitives.
|
-- Provides a class for short indexed openGL primitives.
|
||||||
@@ -14,6 +15,7 @@ is
|
|||||||
type Views is array (Index_t range <>) of View;
|
type Views is array (Index_t range <>) of View;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------
|
---------
|
||||||
-- Forge
|
-- Forge
|
||||||
--
|
--
|
||||||
@@ -37,6 +39,7 @@ is
|
|||||||
procedure destroy (Self : in out Item);
|
procedure destroy (Self : in out Item);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Attributes
|
-- Attributes
|
||||||
--
|
--
|
||||||
@@ -46,6 +49,7 @@ is
|
|||||||
procedure Indices_are (Self : in out Item; Now : in long_Indices);
|
procedure Indices_are (Self : in out Item; Now : in long_Indices);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Operations
|
-- Operations
|
||||||
--
|
--
|
||||||
@@ -62,4 +66,5 @@ private
|
|||||||
Indices : Buffer.short_indices.view;
|
Indices : Buffer.short_indices.view;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
|
||||||
end openGL.Primitive.short_indexed;
|
end openGL.Primitive.short_indexed;
|
||||||
|
|||||||
@@ -1,8 +1,10 @@
|
|||||||
with
|
with
|
||||||
openGL.Tasks,
|
openGL.Tasks,
|
||||||
|
openGL.Errors,
|
||||||
GL.Binding,
|
GL.Binding,
|
||||||
ada.unchecked_Deallocation;
|
ada.unchecked_Deallocation;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Primitive
|
package body openGL.Primitive
|
||||||
is
|
is
|
||||||
---------
|
---------
|
||||||
@@ -16,6 +18,7 @@ is
|
|||||||
end define;
|
end define;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure free (Self : in out View)
|
procedure free (Self : in out View)
|
||||||
is
|
is
|
||||||
procedure deallocate is new ada.Unchecked_Deallocation (Primitive.item'Class,
|
procedure deallocate is new ada.Unchecked_Deallocation (Primitive.item'Class,
|
||||||
@@ -88,6 +91,7 @@ is
|
|||||||
if Self.line_Width /= unused_line_Width
|
if Self.line_Width /= unused_line_Width
|
||||||
then
|
then
|
||||||
glLineWidth (glFloat (Self.line_Width));
|
glLineWidth (glFloat (Self.line_Width));
|
||||||
|
Errors.log;
|
||||||
end if;
|
end if;
|
||||||
end render;
|
end render;
|
||||||
|
|
||||||
|
|||||||
@@ -5,6 +5,7 @@ private
|
|||||||
with
|
with
|
||||||
ada.unchecked_Conversion;
|
ada.unchecked_Conversion;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Primitive
|
package openGL.Primitive
|
||||||
--
|
--
|
||||||
-- Provides a base class for openGL primitives.
|
-- Provides a base class for openGL primitives.
|
||||||
|
|||||||
@@ -31,29 +31,34 @@ is
|
|||||||
|
|
||||||
function to_Model (Model : in asset_Name;
|
function to_Model (Model : in asset_Name;
|
||||||
Texture : in asset_Name;
|
Texture : in asset_Name;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
Texture_is_lucid : in Boolean) return openGL.Model.any.item
|
Texture_is_lucid : in Boolean) return openGL.Model.any.item
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return Self : openGL.Model.any.item := (openGL.Model.item with
|
-- return Self : openGL.Model.any. := (openGL.Model.item with
|
||||||
|
return Self : openGL.Model.any.item := (textured_Model.textured_item with
|
||||||
Model,
|
Model,
|
||||||
Texture,
|
Texture,
|
||||||
Texture_is_lucid,
|
Texture_is_lucid,
|
||||||
Geometry => null)
|
Geometry => null)
|
||||||
do
|
do
|
||||||
Self.Bounds.Ball := 1.0;
|
Self.Bounds.Ball := 1.0;
|
||||||
|
Self.texture_Details_is (texture_Details);
|
||||||
end return;
|
end return;
|
||||||
end to_Model;
|
end to_Model;
|
||||||
|
|
||||||
|
|
||||||
function new_Model (Model : in asset_Name;
|
function new_Model (Model : in asset_Name;
|
||||||
Texture : in asset_Name;
|
Texture : in asset_Name;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
Texture_is_lucid : in Boolean) return openGL.Model.any.view
|
Texture_is_lucid : in Boolean) return openGL.Model.any.view
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
return new openGL.Model.any.item' (to_Model (Model, Texture, Texture_is_lucid));
|
return new openGL.Model.any.item' (to_Model (Model, Texture, texture_Details, Texture_is_lucid));
|
||||||
end new_Model;
|
end new_Model;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
--- Attributes
|
--- Attributes
|
||||||
--
|
--
|
||||||
@@ -415,6 +420,9 @@ is
|
|||||||
deallocate (the_Vertices);
|
deallocate (the_Vertices);
|
||||||
destroy (the_Model);
|
destroy (the_Model);
|
||||||
|
|
||||||
|
Self.Geometry.Model_is (Self'unchecked_Access);
|
||||||
|
|
||||||
|
|
||||||
-- Set the geometry texture.
|
-- Set the geometry texture.
|
||||||
--
|
--
|
||||||
if Self.Texture /= null_Asset
|
if Self.Texture /= null_Asset
|
||||||
@@ -501,40 +509,40 @@ is
|
|||||||
-- Texturing
|
-- Texturing
|
||||||
--
|
--
|
||||||
|
|
||||||
overriding
|
-- overriding
|
||||||
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
Now : in texture_Set.fade_Level)
|
-- Now : in texture_Set.fade_Level)
|
||||||
is
|
-- is
|
||||||
begin
|
-- begin
|
||||||
null;
|
-- null;
|
||||||
end Fade_is;
|
-- end Fade_is;
|
||||||
|
--
|
||||||
|
--
|
||||||
|
--
|
||||||
overriding
|
-- overriding
|
||||||
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
|
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
|
||||||
is
|
-- is
|
||||||
begin
|
-- begin
|
||||||
return 0.0;
|
-- return 0.0;
|
||||||
end Fade;
|
-- end Fade;
|
||||||
|
--
|
||||||
|
--
|
||||||
|
--
|
||||||
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
Now : in openGL.asset_Name)
|
-- Now : in openGL.asset_Name)
|
||||||
is
|
-- is
|
||||||
begin
|
-- begin
|
||||||
null;
|
-- null;
|
||||||
end Texture_is;
|
-- end Texture_is;
|
||||||
|
--
|
||||||
|
--
|
||||||
|
--
|
||||||
overriding
|
-- overriding
|
||||||
function texture_Count (Self : in Item) return Natural
|
-- function texture_Count (Self : in Item) return Natural
|
||||||
is
|
-- is
|
||||||
begin
|
-- begin
|
||||||
return 1;
|
-- return 1;
|
||||||
end texture_Count;
|
-- end texture_Count;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry;
|
openGL.Geometry,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.any
|
package openGL.Model.any
|
||||||
@@ -9,7 +10,11 @@ package openGL.Model.any
|
|||||||
-- This model is largely used by the IO importers of various model formats (ie collada, wavefront, etc).
|
-- This model is largely used by the IO importers of various model formats (ie collada, wavefront, etc).
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new Model.item with private;
|
package textured_Model is new texturing.Mixin (openGL.Model.item);
|
||||||
|
|
||||||
|
type Item is new textured_Model.textured_item with private;
|
||||||
|
|
||||||
|
-- type Item is new Model.item with private;
|
||||||
type View is access all Item'Class;
|
type View is access all Item'Class;
|
||||||
|
|
||||||
|
|
||||||
@@ -19,6 +24,7 @@ is
|
|||||||
|
|
||||||
function new_Model (Model : in asset_Name;
|
function new_Model (Model : in asset_Name;
|
||||||
Texture : in asset_Name;
|
Texture : in asset_Name;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
Texture_is_lucid : in Boolean) return openGL.Model.any.view;
|
Texture_is_lucid : in Boolean) return openGL.Model.any.view;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
@@ -43,24 +49,25 @@ is
|
|||||||
-- Texturing
|
-- Texturing
|
||||||
--
|
--
|
||||||
|
|
||||||
overriding
|
-- overriding
|
||||||
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
|
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
|
||||||
|
--
|
||||||
overriding
|
-- overriding
|
||||||
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
Now : in texture_Set.fade_Level);
|
-- Now : in texture_Set.fade_Level);
|
||||||
|
--
|
||||||
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
||||||
Now : in asset_Name);
|
-- Now : in asset_Name);
|
||||||
|
--
|
||||||
overriding
|
-- overriding
|
||||||
function texture_Count (Self : in Item) return Natural;
|
-- function texture_Count (Self : in Item) return Natural;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Model.item with
|
-- type Item is new Model.item with
|
||||||
|
type Item is new textured_Model.textured_item with
|
||||||
record
|
record
|
||||||
Model : asset_Name := null_Asset; -- A wavefront '.obj' or collada '.dae' file. -- TODO: Rename to 'model_Name'.
|
Model : asset_Name := null_Asset; -- A wavefront '.obj' or collada '.dae' file. -- TODO: Rename to 'model_Name'.
|
||||||
|
|
||||||
|
|||||||
@@ -44,7 +44,7 @@ is
|
|||||||
--
|
--
|
||||||
|
|
||||||
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 openGL.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
|
||||||
is
|
is
|
||||||
pragma unreferenced (Textures, Fonts);
|
pragma unreferenced (Textures, Fonts);
|
||||||
@@ -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;
|
||||||
|
|
||||||
|
|||||||
@@ -27,7 +27,7 @@ is
|
|||||||
--
|
--
|
||||||
|
|
||||||
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 openGL.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;
|
||||||
|
|
||||||
procedure end_Site_is (Self : in out Item; Now : in Vector_3;
|
procedure end_Site_is (Self : in out Item; Now : in Vector_3;
|
||||||
|
|||||||
@@ -14,7 +14,8 @@ is
|
|||||||
function new_Billboard (Size : in Size_t := default_Size;
|
function new_Billboard (Size : in Size_t := default_Size;
|
||||||
Plane : in billboard.Plane;
|
Plane : in billboard.Plane;
|
||||||
Color : in lucid_Color;
|
Color : in lucid_Color;
|
||||||
Texture : in asset_Name) return View
|
Texture : in asset_Name;
|
||||||
|
texture_Details : in texture_Set.item) return View
|
||||||
is
|
is
|
||||||
Self : constant View := new Item;
|
Self : constant View := new Item;
|
||||||
begin
|
begin
|
||||||
@@ -23,6 +24,7 @@ is
|
|||||||
Self.Plane := Plane;
|
Self.Plane := Plane;
|
||||||
Self.Color := Color;
|
Self.Color := Color;
|
||||||
Self.Texture_Name := Texture;
|
Self.Texture_Name := Texture;
|
||||||
|
Self.texture_Details_is (texture_Details);
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
end new_Billboard;
|
end new_Billboard;
|
||||||
@@ -55,6 +57,7 @@ is
|
|||||||
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
|
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
|
||||||
the_Indices).all'Access;
|
the_Indices).all'Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
the_Geometry.is_Transparent;
|
the_Geometry.is_Transparent;
|
||||||
@@ -90,6 +93,7 @@ is
|
|||||||
|
|
||||||
Self.Geometry := the_Face;
|
Self.Geometry := the_Face;
|
||||||
|
|
||||||
|
|
||||||
return [1 => Geometry.view (the_Face)];
|
return [1 => Geometry.view (the_Face)];
|
||||||
end to_GL_Geometries;
|
end to_GL_Geometries;
|
||||||
|
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry.colored_textured,
|
openGL.Geometry.colored_textured,
|
||||||
openGL.Texture,
|
openGL.Texture,
|
||||||
|
openGL.Model.texturing,
|
||||||
openGL.Font,
|
openGL.Font,
|
||||||
openGL.Palette;
|
openGL.Palette;
|
||||||
|
|
||||||
@@ -10,7 +11,9 @@ package openGL.Model.billboard.colored_textured
|
|||||||
-- Models a colored, textured billboard.
|
-- Models a colored, textured billboard.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new Model.billboard.item with private;
|
package textured_Model is new texturing.Mixin (openGL.Model.billboard.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;
|
||||||
|
|
||||||
|
|
||||||
@@ -21,7 +24,8 @@ is
|
|||||||
function new_Billboard (Size : in Size_t := default_Size;
|
function new_Billboard (Size : in Size_t := default_Size;
|
||||||
Plane : in billboard.Plane;
|
Plane : in billboard.Plane;
|
||||||
Color : in lucid_Color;
|
Color : in lucid_Color;
|
||||||
Texture : in asset_Name) return View;
|
Texture : in asset_Name;
|
||||||
|
texture_Details : in texture_Set.item) return View;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
--- Attributes
|
--- Attributes
|
||||||
@@ -44,7 +48,7 @@ is
|
|||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Model.billboard.item with
|
type Item is new textured_Model.textured_item with
|
||||||
record
|
record
|
||||||
Color : lucid_Color := (Palette.White, Opaque);
|
Color : lucid_Color := (Palette.White, Opaque);
|
||||||
|
|
||||||
|
|||||||
@@ -17,6 +17,7 @@ is
|
|||||||
function new_Billboard (Size : in Size_t := default_Size;
|
function new_Billboard (Size : in Size_t := default_Size;
|
||||||
Plane : in billboard.Plane;
|
Plane : in billboard.Plane;
|
||||||
Texture : in asset_Name;
|
Texture : in asset_Name;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
Lucid : in Boolean := False) return View
|
Lucid : in Boolean := False) return View
|
||||||
is
|
is
|
||||||
Self : constant View := new Item (Lucid);
|
Self : constant View := new Item (Lucid);
|
||||||
@@ -25,6 +26,8 @@ is
|
|||||||
Self.Texture_Name := Texture;
|
Self.Texture_Name := Texture;
|
||||||
Self.define (Size);
|
Self.define (Size);
|
||||||
|
|
||||||
|
Self.texture_Details_is (texture_Details);
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
end new_Billboard;
|
end new_Billboard;
|
||||||
end Forge;
|
end Forge;
|
||||||
@@ -57,6 +60,7 @@ is
|
|||||||
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
|
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
|
||||||
the_Indices).all'Access;
|
the_Indices).all'Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
the_Geometry.is_Transparent;
|
the_Geometry.is_Transparent;
|
||||||
@@ -110,8 +114,6 @@ is
|
|||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
the_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
|
|
||||||
return [1 => the_Face.all'Access];
|
return [1 => the_Face.all'Access];
|
||||||
end to_GL_Geometries;
|
end to_GL_Geometries;
|
||||||
|
|
||||||
@@ -197,47 +199,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;
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry,
|
openGL.Geometry,
|
||||||
openGL.Texture;
|
openGL.Texture,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.billboard.textured
|
package openGL.Model.billboard.textured
|
||||||
@@ -8,7 +9,9 @@ package openGL.Model.billboard.textured
|
|||||||
-- Models a textured billboard.
|
-- Models a textured billboard.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item (Lucid : Boolean) is new Model.billboard.item with private;
|
package textured_Model is new texturing.Mixin (openGL.Model.billboard.item);
|
||||||
|
|
||||||
|
type Item (Lucid : Boolean) is new textured_Model.textured_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;
|
||||||
@@ -24,6 +27,7 @@ is
|
|||||||
function new_Billboard (Size : in Size_t := default_Size;
|
function new_Billboard (Size : in Size_t := default_Size;
|
||||||
Plane : in billboard.Plane;
|
Plane : in billboard.Plane;
|
||||||
Texture : in asset_Name;
|
Texture : in asset_Name;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
Lucid : in Boolean := False) return View;
|
Lucid : in Boolean := False) return View;
|
||||||
end Forge;
|
end Forge;
|
||||||
|
|
||||||
@@ -46,28 +50,10 @@ 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
|
||||||
record
|
record
|
||||||
texture_Name : asset_Name := null_Asset;
|
texture_Name : asset_Name := null_Asset;
|
||||||
Texture : openGL.Texture.Object := openGL.Texture.null_Object; -- The texture to be applied to the billboard face.
|
Texture : openGL.Texture.Object := openGL.Texture.null_Object; -- The texture to be applied to the billboard face.
|
||||||
|
|||||||
@@ -51,6 +51,7 @@ is
|
|||||||
(triangle_Fan,
|
(triangle_Fan,
|
||||||
the_Indices).all'Access;
|
the_Indices).all'Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
@@ -72,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);
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry,
|
openGL.Geometry,
|
||||||
openGL.Font,
|
openGL.Font,
|
||||||
|
openGL.Model.texturing,
|
||||||
openGL.Texture;
|
openGL.Texture;
|
||||||
|
|
||||||
|
|
||||||
@@ -12,7 +13,9 @@ package openGL.Model.Box.lit_colored_textured
|
|||||||
-- Each face may have a separate texture.
|
-- Each face may have a separate texture.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new Model.box.item with private;
|
package textured_Model is new texturing.Mixin (openGL.Model.box.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;
|
||||||
|
|
||||||
|
|
||||||
@@ -44,7 +47,7 @@ is
|
|||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Model.box.item with
|
type Item is new textured_Model.textured_item with
|
||||||
record
|
record
|
||||||
Faces : lit_colored_textured.Faces;
|
Faces : lit_colored_textured.Faces;
|
||||||
end record;
|
end record;
|
||||||
|
|||||||
@@ -90,6 +90,7 @@ is
|
|||||||
the_Primitive : constant Primitive.view := Primitive.indexed .new_Primitive (Triangles, the_Indices).all'Access;
|
the_Primitive : constant Primitive.view := Primitive.indexed .new_Primitive (Triangles, the_Indices).all'Access;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (the_Vertices);
|
the_Geometry.Vertices_are (the_Vertices);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry,
|
openGL.Geometry,
|
||||||
openGL.Font,
|
openGL.Font,
|
||||||
|
openGL.Model.texturing,
|
||||||
openGL.Texture;
|
openGL.Texture;
|
||||||
|
|
||||||
|
|
||||||
@@ -12,7 +13,9 @@ package openGL.Model.Box.lit_colored_textured_x1
|
|||||||
-- All faces use the same texture.
|
-- All faces use the same texture.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new Model.box.item with private;
|
package textured_Model is new texturing.Mixin (openGL.Model.box.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;
|
||||||
|
|
||||||
|
|
||||||
@@ -44,7 +47,7 @@ is
|
|||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Model.box.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;
|
||||||
texture_Name : asset_Name := null_Asset; -- The texture applied to all faces.
|
texture_Name : asset_Name := null_Asset; -- The texture applied to all faces.
|
||||||
|
|||||||
@@ -10,13 +10,17 @@ is
|
|||||||
--
|
--
|
||||||
|
|
||||||
function new_Box (Size : in Vector_3;
|
function new_Box (Size : in Vector_3;
|
||||||
Faces : in lit_textured.Faces) return View
|
Faces : in lit_textured.Faces;
|
||||||
|
texture_Details : in texture_Set.item := texture_Set.null_Set) return View
|
||||||
|
|
||||||
is
|
is
|
||||||
Self : constant View := new Item;
|
Self : constant View := new Item;
|
||||||
begin
|
begin
|
||||||
Self.Faces := Faces;
|
Self.Faces := Faces;
|
||||||
Self.Size := Size;
|
Self.Size := Size;
|
||||||
|
|
||||||
|
Self.texture_Details_is (texture_Details);
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
end new_Box;
|
end new_Box;
|
||||||
|
|
||||||
@@ -44,8 +48,9 @@ is
|
|||||||
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
|
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
|
||||||
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive
|
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive
|
||||||
(triangle_Fan,
|
(triangle_Fan,
|
||||||
the_Indices).all'Access;
|
the_Indices).all'unchecked_Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
@@ -76,7 +81,6 @@ is
|
|||||||
then
|
then
|
||||||
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
||||||
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
|
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
|
||||||
front_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -96,7 +100,6 @@ is
|
|||||||
then
|
then
|
||||||
rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
|
rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
|
||||||
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
|
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
|
||||||
rear_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -116,7 +119,6 @@ is
|
|||||||
then
|
then
|
||||||
upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
|
upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
|
||||||
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
|
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
|
||||||
upper_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -136,7 +138,6 @@ is
|
|||||||
then
|
then
|
||||||
lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
|
lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
|
||||||
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
|
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
|
||||||
lower_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -156,7 +157,6 @@ is
|
|||||||
then
|
then
|
||||||
left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
|
left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
|
||||||
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
|
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
|
||||||
left_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -176,7 +176,6 @@ is
|
|||||||
then
|
then
|
||||||
right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
|
right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
|
||||||
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
|
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
|
||||||
right_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -190,48 +189,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;
|
||||||
|
|||||||
@@ -1,6 +1,8 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry,
|
openGL.Geometry,
|
||||||
openGL.Font;
|
openGL.Font,
|
||||||
|
openGL.Model.texturing,
|
||||||
|
openGL.texture_Set;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.Box.lit_textured
|
package openGL.Model.Box.lit_textured
|
||||||
@@ -10,7 +12,9 @@ package openGL.Model.Box.lit_textured
|
|||||||
-- Each face may have a separate texture.
|
-- Each face may have a separate texture.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new Model.box.item with private;
|
package textured_Model is new texturing.Mixin (openGL.Model.box.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;
|
||||||
|
|
||||||
|
|
||||||
@@ -27,7 +31,8 @@ is
|
|||||||
--
|
--
|
||||||
|
|
||||||
function new_Box (Size : in Vector_3;
|
function new_Box (Size : in Vector_3;
|
||||||
Faces : in lit_textured.Faces) return View;
|
Faces : in lit_textured.Faces;
|
||||||
|
texture_Details : in texture_Set.item := texture_Set.null_Set) return View;
|
||||||
|
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
@@ -39,30 +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
|
||||||
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;
|
||||||
|
|||||||
@@ -11,6 +11,7 @@ is
|
|||||||
|
|
||||||
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.item;
|
||||||
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;
|
||||||
@@ -19,6 +20,8 @@ is
|
|||||||
Self.is_Skybox := is_Skybox;
|
Self.is_Skybox := is_Skybox;
|
||||||
Self.Size := Size;
|
Self.Size := Size;
|
||||||
|
|
||||||
|
Self.texture_Details_is (texture_Details);
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
end new_Box;
|
end new_Box;
|
||||||
|
|
||||||
@@ -48,6 +51,7 @@ is
|
|||||||
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
|
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
|
||||||
the_Indices).all'Access;
|
the_Indices).all'Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
@@ -83,7 +87,6 @@ is
|
|||||||
then
|
then
|
||||||
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
||||||
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
|
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
|
||||||
front_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -103,7 +106,6 @@ is
|
|||||||
then
|
then
|
||||||
rear_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
rear_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
||||||
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
|
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
|
||||||
rear_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -123,7 +125,6 @@ is
|
|||||||
then
|
then
|
||||||
upper_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
upper_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
||||||
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
|
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
|
||||||
upper_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -143,7 +144,6 @@ is
|
|||||||
then
|
then
|
||||||
lower_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
lower_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
||||||
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
|
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
|
||||||
lower_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -163,7 +163,6 @@ is
|
|||||||
then
|
then
|
||||||
left_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
left_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
||||||
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
|
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
|
||||||
left_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -183,7 +182,6 @@ is
|
|||||||
then
|
then
|
||||||
right_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
right_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
|
||||||
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
|
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
|
||||||
right_Face.Model_is (Self.all'unchecked_Access);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -197,46 +195,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;
|
||||||
|
|||||||
@@ -1,7 +1,8 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry,
|
openGL.Geometry,
|
||||||
openGL.Font,
|
openGL.Font,
|
||||||
openGL.Texture;
|
openGL.Texture,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.Box.textured
|
package openGL.Model.Box.textured
|
||||||
@@ -11,7 +12,9 @@ package openGL.Model.Box.textured
|
|||||||
-- Each face may have a separate texture.
|
-- Each face may have a separate texture.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new Model.box.item with private;
|
package textured_Model is new texturing.Mixin (openGL.Model.box.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;
|
||||||
|
|
||||||
|
|
||||||
@@ -29,6 +32,7 @@ is
|
|||||||
|
|
||||||
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.item;
|
||||||
is_Skybox : in Boolean := False) return View;
|
is_Skybox : in Boolean := False) return View;
|
||||||
|
|
||||||
|
|
||||||
@@ -40,31 +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
|
||||||
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;
|
||||||
|
|||||||
@@ -80,6 +80,8 @@ is
|
|||||||
begin
|
begin
|
||||||
-- Define capsule shaft,
|
-- Define capsule shaft,
|
||||||
--
|
--
|
||||||
|
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
|
|
||||||
declare
|
declare
|
||||||
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
|
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
|
||||||
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
|
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
|
||||||
@@ -232,7 +234,10 @@ is
|
|||||||
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
|
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
|
||||||
|
|
||||||
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
|
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
cap_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
|
|
||||||
if not is_Fore
|
if not is_Fore
|
||||||
then
|
then
|
||||||
a := Degrees_360;
|
a := Degrees_360;
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry;
|
openGL.Geometry,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.capsule.lit_colored_textured
|
package openGL.Model.capsule.lit_colored_textured
|
||||||
@@ -7,7 +8,9 @@ package openGL.Model.capsule.lit_colored_textured
|
|||||||
-- Models a lit, colored and textured capsule.
|
-- Models a lit, colored and textured capsule.
|
||||||
--
|
--
|
||||||
is
|
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;
|
type View is access all Item'Class;
|
||||||
|
|
||||||
|
|
||||||
@@ -32,7 +35,7 @@ is
|
|||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Model.capsule.item with
|
type Item is new textured_Model.textured_item with
|
||||||
record
|
record
|
||||||
Radius : Real;
|
Radius : Real;
|
||||||
Height : Real;
|
Height : Real;
|
||||||
@@ -41,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;
|
||||||
|
|||||||
@@ -13,6 +13,7 @@ is
|
|||||||
|
|
||||||
function new_Capsule (Radius : in Real;
|
function new_Capsule (Radius : in Real;
|
||||||
Height : in Real;
|
Height : in Real;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
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;
|
||||||
@@ -21,6 +22,8 @@ is
|
|||||||
Self.Height := Height;
|
Self.Height := Height;
|
||||||
Self.Image := Image;
|
Self.Image := Image;
|
||||||
|
|
||||||
|
Self.texture_Details_is (texture_Details);
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
end new_Capsule;
|
end new_Capsule;
|
||||||
|
|
||||||
@@ -29,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
|
||||||
@@ -77,6 +77,8 @@ is
|
|||||||
begin
|
begin
|
||||||
-- Define capsule shaft,
|
-- Define capsule shaft,
|
||||||
--
|
--
|
||||||
|
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
|
|
||||||
declare
|
declare
|
||||||
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
|
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
|
||||||
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
|
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
|
||||||
@@ -190,8 +192,6 @@ is
|
|||||||
begin
|
begin
|
||||||
the_shaft_Geometry.add (Primitive.view (the_Primitive));
|
the_shaft_Geometry.add (Primitive.view (the_Primitive));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@@ -228,6 +228,8 @@ is
|
|||||||
|
|
||||||
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
|
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
|
||||||
begin
|
begin
|
||||||
|
cap_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
|
|
||||||
if not is_Fore
|
if not is_Fore
|
||||||
then
|
then
|
||||||
a := Degrees_360;
|
a := Degrees_360;
|
||||||
@@ -388,8 +390,6 @@ is
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
cap_Geometry.Model_is (Self.all'unchecked_Access);
|
|
||||||
|
|
||||||
return cap_Geometry;
|
return cap_Geometry;
|
||||||
end new_Cap;
|
end new_Cap;
|
||||||
|
|
||||||
@@ -404,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;
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry;
|
openGL.Geometry,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.capsule.lit_textured
|
package openGL.Model.capsule.lit_textured
|
||||||
@@ -7,7 +8,9 @@ package openGL.Model.capsule.lit_textured
|
|||||||
-- Models a lit and textured capsule.
|
-- Models a lit and textured capsule.
|
||||||
--
|
--
|
||||||
is
|
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;
|
type View is access all Item'Class;
|
||||||
|
|
||||||
|
|
||||||
@@ -17,6 +20,7 @@ is
|
|||||||
|
|
||||||
function new_Capsule (Radius : in Real;
|
function new_Capsule (Radius : in Real;
|
||||||
Height : in Real;
|
Height : in Real;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
Image : in asset_Name := null_Asset) return View;
|
Image : in asset_Name := null_Asset) return View;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
@@ -28,28 +32,9 @@ 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
|
||||||
record
|
record
|
||||||
Radius : Real;
|
Radius : Real;
|
||||||
Height : Real;
|
Height : Real;
|
||||||
@@ -57,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;
|
||||||
|
|||||||
@@ -13,6 +13,7 @@ is
|
|||||||
|
|
||||||
function new_Capsule (Radius : in Real;
|
function new_Capsule (Radius : in Real;
|
||||||
Height : in Real;
|
Height : in Real;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
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;
|
||||||
@@ -21,6 +22,8 @@ is
|
|||||||
Self.Height := Height;
|
Self.Height := Height;
|
||||||
Self.Image := Image;
|
Self.Image := Image;
|
||||||
|
|
||||||
|
Self.texture_Details_is (texture_Details);
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
end new_Capsule;
|
end new_Capsule;
|
||||||
|
|
||||||
@@ -35,8 +38,7 @@ is
|
|||||||
is
|
is
|
||||||
pragma unreferenced (Textures, Fonts);
|
pragma unreferenced (Textures, Fonts);
|
||||||
|
|
||||||
use --Geometry,
|
use Geometry.textured,
|
||||||
Geometry.textured,
|
|
||||||
real_Functions;
|
real_Functions;
|
||||||
|
|
||||||
Length : constant Real := Self.Height;
|
Length : constant Real := Self.Height;
|
||||||
@@ -74,12 +76,14 @@ is
|
|||||||
begin
|
begin
|
||||||
-- Define capsule shaft,
|
-- Define capsule shaft,
|
||||||
--
|
--
|
||||||
|
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
|
|
||||||
declare
|
declare
|
||||||
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
|
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
|
||||||
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
|
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
|
||||||
|
|
||||||
the_Vertices : aliased Geometry.textured.Vertex_array := (1 .. vertex_Count => <>);
|
the_Vertices : aliased Geometry.textured.Vertex_array := [1 .. vertex_Count => <>];
|
||||||
the_Indices : aliased Indices := (1 .. indices_Count => <>);
|
the_Indices : aliased Indices := [1 .. indices_Count => <>];
|
||||||
|
|
||||||
begin
|
begin
|
||||||
ny := 1.0;
|
ny := 1.0;
|
||||||
@@ -187,14 +191,14 @@ is
|
|||||||
indices_Count : constant long_Index_t := long_Index_t ( (hoop_count - 1) * sides_Count * 2 * 3 -- For each hoop, 2 triangles per side with 3 vertices per triangle
|
indices_Count : constant long_Index_t := long_Index_t ( (hoop_count - 1) * sides_Count * 2 * 3 -- For each hoop, 2 triangles per side with 3 vertices per triangle
|
||||||
+ sides_Count * 3); -- plus the extra indices for the pole triangles.
|
+ sides_Count * 3); -- plus the extra indices for the pole triangles.
|
||||||
|
|
||||||
the_Vertices : aliased Geometry.textured.Vertex_array := (1 .. vertex_Count => <>);
|
the_Vertices : aliased Geometry.textured.Vertex_array := [1 .. vertex_Count => <>];
|
||||||
the_Indices : aliased Indices := (1 .. indices_Count => <>);
|
the_Indices : aliased Indices := [1 .. indices_Count => <>];
|
||||||
|
|
||||||
the_arch_Edges : arch_Edges;
|
the_arch_Edges : arch_Edges;
|
||||||
i : Index_t := 1;
|
i : Index_t := 1;
|
||||||
|
|
||||||
pole_Site : constant Site := (if is_Fore then (0.0, 0.0, L + Radius)
|
pole_Site : constant Site := (if is_Fore then [0.0, 0.0, L + Radius]
|
||||||
else (0.0, 0.0, -L - Radius));
|
else [0.0, 0.0, -L - Radius]);
|
||||||
|
|
||||||
Degrees_90 : constant := Pi / 2.0;
|
Degrees_90 : constant := Pi / 2.0;
|
||||||
Degrees_360 : constant := Pi * 2.0;
|
Degrees_360 : constant := Pi * 2.0;
|
||||||
@@ -206,7 +210,10 @@ is
|
|||||||
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
|
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
|
||||||
|
|
||||||
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
|
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
cap_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
|
|
||||||
if not is_Fore
|
if not is_Fore
|
||||||
then
|
then
|
||||||
a := Degrees_360;
|
a := Degrees_360;
|
||||||
@@ -368,9 +375,10 @@ is
|
|||||||
cap_2_Geometry := new_Cap (is_Fore => False);
|
cap_2_Geometry := new_Cap (is_Fore => False);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
return (1 => the_shaft_Geometry.all'Access,
|
|
||||||
|
return [1 => the_shaft_Geometry.all'Access,
|
||||||
2 => cap_1_Geometry.all'Access,
|
2 => cap_1_Geometry.all'Access,
|
||||||
3 => cap_2_Geometry.all'Access);
|
3 => cap_2_Geometry.all'Access];
|
||||||
end to_GL_Geometries;
|
end to_GL_Geometries;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -1,13 +1,16 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry;
|
openGL.Geometry,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.capsule.textured
|
package openGL.Model.capsule.textured
|
||||||
--
|
--
|
||||||
-- Models a lit and 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);
|
||||||
|
|
||||||
|
type Item is new textured_Model.textured_item with private;
|
||||||
type View is access all Item'Class;
|
type View is access all Item'Class;
|
||||||
|
|
||||||
|
|
||||||
@@ -17,6 +20,7 @@ is
|
|||||||
|
|
||||||
function new_Capsule (Radius : in Real;
|
function new_Capsule (Radius : in Real;
|
||||||
Height : in Real;
|
Height : in Real;
|
||||||
|
texture_Details : in texture_Set.item;
|
||||||
Image : in asset_Name := null_Asset) return View;
|
Image : in asset_Name := null_Asset) return View;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
@@ -31,7 +35,7 @@ is
|
|||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
type Item is new Model.capsule.item with
|
type Item is new textured_Model.textured_item with
|
||||||
record
|
record
|
||||||
Radius : Real;
|
Radius : Real;
|
||||||
Height : Real;
|
Height : Real;
|
||||||
@@ -39,4 +43,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;
|
||||||
|
|||||||
@@ -3,6 +3,8 @@ with
|
|||||||
openGL.Primitive.indexed,
|
openGL.Primitive.indexed,
|
||||||
openGL.Texture.Coordinates;
|
openGL.Texture.Coordinates;
|
||||||
|
|
||||||
|
with ada.Text_IO; use ada.Text_IO;
|
||||||
|
|
||||||
|
|
||||||
package body openGL.Model.circle.lit_textured
|
package body openGL.Model.circle.lit_textured
|
||||||
is
|
is
|
||||||
@@ -11,13 +13,13 @@ is
|
|||||||
--
|
--
|
||||||
|
|
||||||
function new_circle (Radius : in Real;
|
function new_circle (Radius : in Real;
|
||||||
Face : in lit_textured.Face_t;
|
texture_Details : in texture_Set.item;
|
||||||
Sides : in Positive := 24) return View
|
Sides : in Positive := 24) return View
|
||||||
is
|
is
|
||||||
Self : constant View := new Item;
|
Self : constant View := new Item;
|
||||||
begin
|
begin
|
||||||
Self.Radius := Radius;
|
Self.Radius := Radius;
|
||||||
Self.Face := Face;
|
Self.texture_Details_is (texture_Details);
|
||||||
Self.Sides := Sides;
|
Self.Sides := Sides;
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
@@ -29,90 +31,6 @@ is
|
|||||||
--- Attributes ---
|
--- Attributes ---
|
||||||
------------------
|
------------------
|
||||||
|
|
||||||
function Face (Self : in Item) return Face_t
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Self.Face;
|
|
||||||
end Face;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
------------
|
|
||||||
-- Texturing
|
|
||||||
--
|
|
||||||
|
|
||||||
overriding
|
|
||||||
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
|
||||||
Now : in texture_Set.fade_Level)
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
Self.Face.texture_Details.Fades (which) := Now;
|
|
||||||
end Fade_is;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Self.Face.texture_Details.Fades (which);
|
|
||||||
end Fade;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
|
||||||
Now : in openGL.asset_Name)
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
Self.Face.texture_Details.Textures (Positive (which)) := Now;
|
|
||||||
end Texture_is;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
function texture_Count (Self : in Item) return Natural
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Self.Face.texture_Details.texture_Count;
|
|
||||||
end texture_Count;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Self.Face.texture_Details.texture_Applies (Which);
|
|
||||||
end texture_Applied;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
|
||||||
Now : in Boolean)
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
Self.Face.texture_Details.texture_Applies (Which) := Now;
|
|
||||||
end texture_Applied_is;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
procedure animate (Self : in out Item)
|
|
||||||
is
|
|
||||||
use type texture_Set.Animation_view;
|
|
||||||
begin
|
|
||||||
if Self.Face.texture_Details.Animation = null
|
|
||||||
then
|
|
||||||
return;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
texture_Set.animate (Self.Face.texture_Details.Animation.all,
|
|
||||||
Self.Face.texture_Details.texture_Applies);
|
|
||||||
end animate;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
--- openGL Geometries
|
--- openGL Geometries
|
||||||
@@ -162,23 +80,23 @@ is
|
|||||||
|
|
||||||
Id : texture_Set.texture_Id;
|
Id : texture_Set.texture_Id;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (Primitive.view (the_Primitive));
|
the_Geometry.add (Primitive.view (the_Primitive));
|
||||||
|
|
||||||
for i in 1 .. Self.Face.texture_Details.texture_Count
|
for i in 1 .. Self.texture_Details.Count
|
||||||
loop
|
loop
|
||||||
Id := texture_Id (i);
|
Id := texture_Id (i);
|
||||||
|
|
||||||
the_Geometry.Fade_is (which => Id,
|
-- the_Geometry.Fade_is (which => Id,
|
||||||
now => Self.Face.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.Face.texture_Details.Textures (i)));
|
Now => Textures.fetch (Self.texture_Details.Details (i).Texture));
|
||||||
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.
|
||||||
the_Geometry.Model_is (Self.all'unchecked_Access);
|
|
||||||
|
|
||||||
return the_Geometry;
|
return the_Geometry;
|
||||||
end new_Geometry;
|
end new_Geometry;
|
||||||
|
|||||||
@@ -1,29 +1,26 @@
|
|||||||
with
|
with
|
||||||
openGL.texture_Set,
|
openGL.texture_Set,
|
||||||
openGL.Texture;
|
openGL.Texture,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.circle.lit_textured
|
package openGL.Model.circle.lit_textured
|
||||||
--
|
--
|
||||||
-- Models a lit, colored and textured hexagon.
|
-- Models a lit and textured circle.
|
||||||
--
|
--
|
||||||
is
|
is
|
||||||
type Item is new Model.item with private;
|
package textured_Model is new texturing.Mixin (Model.circle.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_t is
|
|
||||||
record
|
|
||||||
texture_Details : texture_Set.Details;
|
|
||||||
end record;
|
|
||||||
|
|
||||||
|
|
||||||
---------
|
---------
|
||||||
--- Forge
|
--- Forge
|
||||||
--
|
--
|
||||||
|
|
||||||
function new_circle (Radius : in Real;
|
function new_circle (Radius : in Real;
|
||||||
Face : in lit_textured.Face_t;
|
texture_Details : in texture_Set.item;
|
||||||
Sides : in Positive := 24) return View;
|
Sides : in Positive := 24) return View;
|
||||||
|
|
||||||
|
|
||||||
@@ -31,48 +28,14 @@ is
|
|||||||
--- Attributes
|
--- Attributes
|
||||||
--
|
--
|
||||||
|
|
||||||
function Face (Self : in Item) return Face_t;
|
|
||||||
|
|
||||||
|
|
||||||
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;
|
||||||
|
|
||||||
------------
|
|
||||||
-- 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.circle.item with
|
type Item is new textured_Model.textured_Item with null record;
|
||||||
record
|
|
||||||
Face : lit_textured.Face_t;
|
|
||||||
end record;
|
|
||||||
|
|
||||||
end openGL.Model.circle.lit_textured;
|
end openGL.Model.circle.lit_textured;
|
||||||
|
|||||||
@@ -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
|
||||||
@@ -52,6 +52,7 @@ is
|
|||||||
the_Primitive : constant Primitive.indexed.view
|
the_Primitive : constant Primitive.indexed.view
|
||||||
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
|
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (Primitive.view (the_Primitive));
|
the_Geometry.add (Primitive.view (the_Primitive));
|
||||||
|
|
||||||
@@ -66,13 +67,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 +83,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;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -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;
|
||||||
|
|||||||
@@ -10,12 +10,12 @@ is
|
|||||||
--
|
--
|
||||||
|
|
||||||
function new_Hexagon (Radius : in Real;
|
function new_Hexagon (Radius : in Real;
|
||||||
Face : in lit_textured.Face) return View
|
texture_Details : in texture_Set.item) return View
|
||||||
is
|
is
|
||||||
Self : constant View := new Item;
|
Self : constant View := new Item;
|
||||||
begin
|
begin
|
||||||
Self.Radius := Radius;
|
Self.Radius := Radius;
|
||||||
Self.Face := Face;
|
Self.texture_Details_is (texture_Details);
|
||||||
|
|
||||||
return Self;
|
return Self;
|
||||||
end new_Hexagon;
|
end new_Hexagon;
|
||||||
@@ -28,84 +28,6 @@ is
|
|||||||
------------------
|
------------------
|
||||||
|
|
||||||
|
|
||||||
------------
|
|
||||||
-- Texturing
|
|
||||||
--
|
|
||||||
|
|
||||||
overriding
|
|
||||||
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
|
||||||
Now : in texture_Set.fade_Level)
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
Self.Face.Fades (Which) := Now;
|
|
||||||
end Fade_is;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Self.Face.Fades (Which);
|
|
||||||
end Fade;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
|
||||||
Now : in openGL.asset_Name)
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
Self.Face.Textures (Positive (Which)) := Now;
|
|
||||||
end Texture_is;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
function texture_Count (Self : in Item) return Natural
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Self.Face.texture_Count;
|
|
||||||
end texture_Count;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
return Self.Face.texture_Applies (Which);
|
|
||||||
end texture_Applied;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
|
|
||||||
Now : in Boolean)
|
|
||||||
is
|
|
||||||
begin
|
|
||||||
Self.Face.texture_Applies (Which) := Now;
|
|
||||||
end texture_Applied_is;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
overriding
|
|
||||||
procedure animate (Self : in out Item)
|
|
||||||
is
|
|
||||||
use type texture_Set.Animation_view;
|
|
||||||
begin
|
|
||||||
if Self.Face.Animation = null
|
|
||||||
then
|
|
||||||
return;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
texture_Set.animate (Self.Face.Animation.all,
|
|
||||||
Self.Face.texture_Applies);
|
|
||||||
end animate;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
--- openGL Geometries
|
--- openGL Geometries
|
||||||
--
|
--
|
||||||
@@ -121,7 +43,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
|
||||||
@@ -136,24 +58,25 @@ is
|
|||||||
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
|
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
|
||||||
|
|
||||||
Id : texture_Set.texture_Id;
|
Id : texture_Set.texture_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (Primitive.view (the_Primitive));
|
the_Geometry.add (Primitive.view (the_Primitive));
|
||||||
|
|
||||||
for i in 1 .. Self.Face.texture_Count
|
for i in 1 .. Self.texture_Details.Count
|
||||||
loop
|
loop
|
||||||
Id := texture_Id (i);
|
Id := texture_Id (i);
|
||||||
|
|
||||||
the_Geometry.Fade_is (which => Id,
|
-- the_Geometry.Fade_is (Which => Id,
|
||||||
now => Self.Face.Fades (Id));
|
-- Now => Self.texture_Details.Fades (Id));
|
||||||
|
|
||||||
the_Geometry.Texture_is (which => Id,
|
the_Geometry.Texture_is (Which => Id,
|
||||||
now => Textures.fetch (Self.Face.Textures (i)));
|
Now => Textures.fetch (Self.texture_Details.Details (i).Texture));
|
||||||
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.
|
||||||
the_Geometry.Model_is (Self.all'unchecked_Access);
|
|
||||||
|
|
||||||
return the_Geometry;
|
return the_Geometry;
|
||||||
end new_Face;
|
end new_Face;
|
||||||
@@ -166,19 +89,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;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -1,33 +1,26 @@
|
|||||||
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
|
||||||
--
|
--
|
||||||
-- Models a lit, colored 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.item) 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;
|
||||||
|
|||||||
@@ -70,6 +70,7 @@ is
|
|||||||
:= Primitive.indexed.new_Primitive (triangle_Fan,
|
:= Primitive.indexed.new_Primitive (triangle_Fan,
|
||||||
the_Indices);
|
the_Indices);
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (Primitive.view (the_Primitive));
|
the_Geometry.add (Primitive.view (the_Primitive));
|
||||||
|
|
||||||
@@ -90,6 +91,7 @@ is
|
|||||||
the_Primitive : constant Primitive.view
|
the_Primitive : constant Primitive.view
|
||||||
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
|
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
|
|||||||
@@ -75,6 +75,7 @@ is
|
|||||||
:= Primitive.indexed.new_Primitive (triangle_Fan,
|
:= Primitive.indexed.new_Primitive (triangle_Fan,
|
||||||
the_Indices);
|
the_Indices);
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (Primitive.view (the_Primitive));
|
the_Geometry.add (Primitive.view (the_Primitive));
|
||||||
|
|
||||||
@@ -95,6 +96,7 @@ is
|
|||||||
the_Primitive : constant Primitive.view
|
the_Primitive : constant Primitive.view
|
||||||
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
|
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
|
|||||||
@@ -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;
|
||||||
|
|||||||
@@ -77,6 +77,7 @@ is
|
|||||||
the_Indices).all'Access;
|
the_Indices).all'Access;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
@@ -99,6 +100,7 @@ is
|
|||||||
:= Primitive.indexed.new_Primitive (triangle_Strip,
|
:= Primitive.indexed.new_Primitive (triangle_Strip,
|
||||||
the_Indices);
|
the_Indices);
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices);
|
the_Geometry.Vertices_are (Vertices);
|
||||||
the_Geometry.add (Primitive.view (the_Primitive));
|
the_Geometry.add (Primitive.view (the_Primitive));
|
||||||
|
|
||||||
|
|||||||
@@ -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_rounded
|
package openGL.Model.hexagon_Column.lit_colored_textured_rounded
|
||||||
@@ -10,7 +11,10 @@ package openGL.Model.hexagon_Column.lit_colored_textured_rounded
|
|||||||
-- The shaft of the column appears rounded, whereas the top and bottom appear as hexagons.
|
-- The shaft of the column appears rounded, whereas the top and bottom appear as hexagons.
|
||||||
--
|
--
|
||||||
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;
|
||||||
|
|
||||||
|
|
||||||
@@ -54,7 +58,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;
|
||||||
|
|||||||
@@ -71,6 +71,7 @@ is
|
|||||||
:= Primitive.indexed.new_Primitive (triangle_Fan,
|
:= Primitive.indexed.new_Primitive (triangle_Fan,
|
||||||
the_Indices);
|
the_Indices);
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (Primitive.view (the_Primitive));
|
the_Geometry.add (Primitive.view (the_Primitive));
|
||||||
|
|
||||||
@@ -91,6 +92,7 @@ is
|
|||||||
the_Primitive : constant Primitive.view
|
the_Primitive : constant Primitive.view
|
||||||
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
|
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
|
||||||
begin
|
begin
|
||||||
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
||||||
the_Geometry.Vertices_are (Vertices.all);
|
the_Geometry.Vertices_are (Vertices.all);
|
||||||
the_Geometry.add (the_Primitive);
|
the_Geometry.add (the_Primitive);
|
||||||
|
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
with
|
with
|
||||||
openGL.Geometry,
|
openGL.Geometry,
|
||||||
openGL.Texture;
|
openGL.Texture,
|
||||||
|
openGL.Model.texturing;
|
||||||
|
|
||||||
|
|
||||||
package openGL.Model.hexagon_Column.lit_textured_faceted
|
package openGL.Model.hexagon_Column.lit_textured_faceted
|
||||||
@@ -8,7 +9,9 @@ package openGL.Model.hexagon_Column.lit_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;
|
||||||
|
|
||||||
|
|
||||||
@@ -48,7 +51,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;
|
||||||
|
|||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user