263 lines
12 KiB
Ada
263 lines
12 KiB
Ada
with
|
|
openGL.Primitive.indexed,
|
|
openGL.Geometry.lit_textured,
|
|
openGL.Model.hexagon;
|
|
|
|
|
|
package body openGL.Model.Hexagon_Column.lit_textured_faceted
|
|
is
|
|
---------
|
|
--- Forge
|
|
--
|
|
|
|
function new_hexagon_Column (Radius : in Real;
|
|
Height : in Real;
|
|
Upper,
|
|
Lower : in hex_Face;
|
|
Shaft : in shaft_Face) return View
|
|
is
|
|
Self : constant View := new Item;
|
|
begin
|
|
Self.Radius := Radius;
|
|
Self.Height := Height;
|
|
Self.upper_Face := Upper;
|
|
Self.lower_Face := Lower;
|
|
Self.Shaft := Shaft;
|
|
|
|
return Self;
|
|
end new_hexagon_Column;
|
|
|
|
|
|
--------------
|
|
--- Attributes
|
|
--
|
|
|
|
overriding
|
|
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
|
|
Fonts : in Font.font_id_Map_of_font) return Geometry.views
|
|
is
|
|
pragma unreferenced (Fonts);
|
|
|
|
use Geometry.lit_textured,
|
|
Model.hexagon,
|
|
Texture;
|
|
|
|
shaft_Height : constant Real := Self.Height;
|
|
height_Offset : constant Vector_3 := (0.0, shaft_Height / 2.0, 0.0);
|
|
|
|
mid_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius);
|
|
upper_Sites : hexagon.Sites := mid_Sites;
|
|
lower_Sites : hexagon.Sites := mid_Sites;
|
|
|
|
|
|
function new_hexagon_Face (Vertices : access Geometry.lit_textured.Vertex_array;
|
|
Flip : in Boolean := False) return Geometry.lit_textured.view
|
|
is
|
|
use Primitive;
|
|
|
|
function the_Indices return Indices
|
|
is
|
|
begin
|
|
if Flip
|
|
then return (1, 7, 6, 5, 4, 3, 2, 7);
|
|
else return (1, 2, 3, 4, 5, 6, 7, 2);
|
|
end if;
|
|
end the_Indices;
|
|
|
|
the_Geometry : constant Geometry.lit_textured.view
|
|
:= Geometry.lit_textured.new_Geometry;
|
|
|
|
the_Primitive : constant Primitive.indexed.view
|
|
:= Primitive.indexed.new_Primitive (triangle_Fan,
|
|
the_Indices);
|
|
begin
|
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
|
the_Geometry.Vertices_are (Vertices.all);
|
|
the_Geometry.add (Primitive.view (the_Primitive));
|
|
|
|
return the_Geometry;
|
|
end new_hexagon_Face;
|
|
|
|
|
|
function new_shaft_Face (Vertices : access Geometry.lit_textured.Vertex_array)
|
|
return Geometry.lit_textured.view
|
|
is
|
|
use Primitive;
|
|
|
|
the_Indices : constant Indices := (1, 2, 3, 4);
|
|
|
|
the_Geometry : constant Geometry.lit_textured.view
|
|
:= Geometry.lit_textured.new_Geometry;
|
|
|
|
the_Primitive : constant Primitive.view
|
|
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
|
|
begin
|
|
the_Geometry.Model_is (Self.all'unchecked_Access);
|
|
the_Geometry.Vertices_are (Vertices.all);
|
|
the_Geometry.add (the_Primitive);
|
|
|
|
return the_Geometry;
|
|
end new_shaft_Face;
|
|
|
|
|
|
upper_Face : Geometry.lit_textured.view;
|
|
lower_Face : Geometry.lit_textured.view;
|
|
|
|
shaft_Faces : array (1 .. 6) of Geometry.lit_textured.view;
|
|
|
|
begin
|
|
for Each in mid_Sites'Range
|
|
loop
|
|
upper_Sites (Each) := upper_Sites (Each) + height_Offset;
|
|
lower_Sites (Each) := lower_Sites (Each) - height_Offset;
|
|
end loop;
|
|
|
|
-- Upper
|
|
--
|
|
declare
|
|
the_Vertices : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => height_Offset, Normal => Normal, Coords => (0.0, 0.0), Shine => default_Shine),
|
|
2 => (Site => upper_Sites (1), Normal => Normal, Coords => (0.0, 0.0), Shine => default_Shine),
|
|
3 => (Site => upper_Sites (2), Normal => Normal, Coords => (1.0, 0.0), Shine => default_Shine),
|
|
4 => (Site => upper_Sites (3), Normal => Normal, Coords => (1.0, 1.0), Shine => default_Shine),
|
|
5 => (Site => upper_Sites (4), Normal => Normal, Coords => (0.0, 1.0), Shine => default_Shine),
|
|
6 => (Site => upper_Sites (5), Normal => Normal, Coords => (0.0, 1.0), Shine => default_Shine),
|
|
7 => (Site => upper_Sites (6), Normal => Normal, Coords => (0.0, 1.0), Shine => default_Shine));
|
|
begin
|
|
upper_Face := new_hexagon_Face (Vertices => the_Vertices'Access);
|
|
|
|
if Self.upper_Face.Texture /= null_Asset
|
|
then
|
|
upper_Face.Texture_is (Textures.fetch (Self.upper_Face.Texture));
|
|
end if;
|
|
end;
|
|
|
|
-- Lower
|
|
--
|
|
declare
|
|
the_Vertices : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => -height_Offset, Normal => -Normal, Coords => (0.0, 0.0), Shine => default_Shine),
|
|
2 => (Site => lower_Sites (1), Normal => -Normal, Coords => (0.0, 0.0), Shine => default_Shine),
|
|
3 => (Site => lower_Sites (2), Normal => -Normal, Coords => (1.0, 0.0), Shine => default_Shine),
|
|
4 => (Site => lower_Sites (3), Normal => -Normal, Coords => (1.0, 1.0), Shine => default_Shine),
|
|
5 => (Site => lower_Sites (4), Normal => -Normal, Coords => (0.0, 1.0), Shine => default_Shine),
|
|
6 => (Site => lower_Sites (5), Normal => -Normal, Coords => (0.0, 1.0), Shine => default_Shine),
|
|
7 => (Site => lower_Sites (6), Normal => -Normal, Coords => (0.0, 1.0), Shine => default_Shine));
|
|
begin
|
|
lower_Face := new_hexagon_Face (vertices => the_Vertices'Access,
|
|
flip => True);
|
|
|
|
if Self.upper_Face.Texture /= null_Asset
|
|
then
|
|
lower_Face.Texture_is (Textures.fetch (Self.lower_Face.Texture));
|
|
end if;
|
|
end;
|
|
|
|
|
|
-- Shaft
|
|
--
|
|
declare
|
|
type shaft_Normals is array (1 .. 6) of Vector_3;
|
|
|
|
|
|
function get_Normals return shaft_Normals
|
|
is
|
|
use linear_Algebra_3D;
|
|
|
|
Rotation : constant Matrix_3x3 := y_Rotation_from (to_Radians (60.0));
|
|
the_Normal : Vector_3 := (0.0, 0.0, -1.0);
|
|
Result : shaft_Normals;
|
|
begin
|
|
Result (2) := the_Normal;
|
|
|
|
the_Normal := Rotation * the_Normal;
|
|
Result (3) := the_Normal;
|
|
|
|
the_Normal := Rotation * the_Normal;
|
|
Result (4) := the_Normal;
|
|
|
|
the_Normal := (0.0, 0.0, 1.0);
|
|
Result (5) := the_Normal;
|
|
|
|
the_Normal := Rotation * the_Normal;
|
|
Result (6) := the_Normal;
|
|
|
|
the_Normal := Rotation * the_Normal;
|
|
Result (1) := the_Normal;
|
|
|
|
return Result;
|
|
end get_Normals;
|
|
|
|
|
|
Normals : constant shaft_Normals := get_Normals;
|
|
s_Delta : constant := 1.0 / 6.0;
|
|
|
|
the_Vertices_1 : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => upper_Sites (1), Normal => Normals (1), Coords => (0.0, 1.0), Shine => default_Shine),
|
|
2 => (Site => lower_Sites (1), Normal => Normals (1), Coords => (0.0, 0.0), Shine => default_Shine),
|
|
3 => (Site => upper_Sites (2), Normal => Normals (1), Coords => (s_Delta, 1.0), Shine => default_Shine),
|
|
4 => (Site => lower_Sites (2), Normal => Normals (1), Coords => (s_Delta, 0.0), Shine => default_Shine));
|
|
|
|
the_Vertices_2 : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => upper_Sites (2), Normal => Normals (2), Coords => (s_Delta, 1.0), Shine => default_Shine),
|
|
2 => (Site => lower_Sites (2), Normal => Normals (2), Coords => (s_Delta, 0.0), Shine => default_Shine),
|
|
3 => (Site => upper_Sites (3), Normal => Normals (2), Coords => (s_Delta * 2.0, 1.0), Shine => default_Shine),
|
|
4 => (Site => lower_Sites (3), Normal => Normals (2), Coords => (s_Delta * 2.0, 0.0), Shine => default_Shine));
|
|
|
|
the_Vertices_3 : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => upper_Sites (3), Normal => Normals (3), Coords => (s_Delta * 2.0, 1.0), Shine => default_Shine),
|
|
2 => (Site => lower_Sites (3), Normal => Normals (3), Coords => (s_Delta * 2.0, 0.0), Shine => default_Shine),
|
|
3 => (Site => upper_Sites (4), Normal => Normals (3), Coords => (s_Delta * 3.0, 1.0), Shine => default_Shine),
|
|
4 => (Site => lower_Sites (4), Normal => Normals (3), Coords => (s_Delta * 3.0, 0.0), Shine => default_Shine));
|
|
|
|
the_Vertices_4 : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => upper_Sites (4), Normal => Normals (4), Coords => (s_Delta * 3.0, 1.0), Shine => default_Shine),
|
|
2 => (Site => lower_Sites (4), Normal => Normals (4), Coords => (s_Delta * 3.0, 0.0), Shine => default_Shine),
|
|
3 => (Site => upper_Sites (5), Normal => Normals (4), Coords => (s_Delta * 4.0, 1.0), Shine => default_Shine),
|
|
4 => (Site => lower_Sites (5), Normal => Normals (4), Coords => (s_Delta * 4.0, 0.0), Shine => default_Shine));
|
|
|
|
the_Vertices_5 : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => upper_Sites (5), Normal => Normals (5), Coords => (s_Delta * 4.0, 1.0), Shine => default_Shine),
|
|
2 => (Site => lower_Sites (5), Normal => Normals (5), Coords => (s_Delta * 4.0, 0.0), Shine => default_Shine),
|
|
3 => (Site => upper_Sites (6), Normal => Normals (5), Coords => (s_Delta * 5.0, 1.0), Shine => default_Shine),
|
|
4 => (Site => lower_Sites (6), Normal => Normals (5), Coords => (s_Delta * 5.0, 0.0), Shine => default_Shine));
|
|
|
|
the_Vertices_6 : aliased Geometry.lit_textured.Vertex_array
|
|
:= (1 => (Site => upper_Sites (6), Normal => Normals (6), Coords => (s_Delta * 5.0, 1.0), Shine => default_Shine),
|
|
2 => (Site => lower_Sites (6), Normal => Normals (6), Coords => (s_Delta * 5.0, 0.0), Shine => default_Shine),
|
|
3 => (Site => upper_Sites (1), Normal => Normals (6), Coords => (1.0, 1.0), Shine => default_Shine),
|
|
4 => (Site => lower_Sites (1), Normal => Normals (6), Coords => (1.0, 0.0), Shine => default_Shine));
|
|
|
|
the_Vertices : constant array (1 .. 6) of access Geometry.lit_textured.Vertex_array
|
|
:= (the_Vertices_1'Access,
|
|
the_Vertices_2'Access,
|
|
the_Vertices_3'Access,
|
|
the_Vertices_4'Access,
|
|
the_Vertices_5'Access,
|
|
the_Vertices_6'Access);
|
|
begin
|
|
for i in shaft_Faces'Range
|
|
loop
|
|
shaft_Faces (i) := new_shaft_Face (vertices => the_Vertices (i));
|
|
|
|
if Self.shaft.Texture /= null_Asset
|
|
then
|
|
shaft_Faces (i).Texture_is (Textures.fetch (Self.shaft.Texture));
|
|
end if;
|
|
end loop;
|
|
end;
|
|
|
|
return (1 => upper_Face .all'Access,
|
|
2 => lower_Face .all'Access,
|
|
3 => shaft_Faces (1).all'Access,
|
|
4 => shaft_Faces (2).all'Access,
|
|
5 => shaft_Faces (3).all'Access,
|
|
6 => shaft_Faces (4).all'Access,
|
|
7 => shaft_Faces (5).all'Access,
|
|
8 => shaft_Faces (6).all'Access);
|
|
|
|
end to_GL_Geometries;
|
|
|
|
|
|
end openGL.Model.Hexagon_Column.lit_textured_faceted;
|