553 lines
20 KiB
Ada
553 lines
20 KiB
Ada
with
|
|
openGL.Geometry.colored,
|
|
openGL.Primitive.indexed,
|
|
|
|
float_Math.Geometry.d2.Hexagon,
|
|
|
|
ada.Containers.hashed_Maps,
|
|
ada.unchecked_Deallocation;
|
|
|
|
|
|
package body openGL.Model.hex_grid
|
|
is
|
|
--------
|
|
-- Forge
|
|
--
|
|
|
|
function new_Grid (heights_Asset : in asset_Name;
|
|
Heights : in height_Map_view;
|
|
Color : in lucid_Color := (palette.White,
|
|
Opaque)) return View
|
|
is
|
|
the_Model : constant View := new Item' (Model.item with
|
|
heights_Asset => heights_Asset,
|
|
Heights => Heights,
|
|
Color => +Color);
|
|
begin
|
|
the_Model.set_Bounds;
|
|
return the_Model;
|
|
end new_Grid;
|
|
|
|
|
|
|
|
overriding
|
|
procedure destroy (Self : in out Item)
|
|
is
|
|
procedure deallocate is new ada.unchecked_Deallocation (height_Map,
|
|
height_Map_view);
|
|
begin
|
|
destroy (Model.item (Self));
|
|
deallocate (Self.Heights);
|
|
end destroy;
|
|
|
|
|
|
|
|
-------------
|
|
-- Attributes
|
|
--
|
|
|
|
package hexagon_Geometry renames Geometry_2d.Hexagon;
|
|
|
|
|
|
-- site_Map_of_vertex_Id
|
|
--
|
|
|
|
function Hash (From : in Geometry_2d.Site) return ada.Containers.Hash_type
|
|
is
|
|
use ada.Containers;
|
|
|
|
type Fix is delta 0.00_1 range 0.0 .. 1000.0;
|
|
|
|
cell_Size : constant Fix := 0.5;
|
|
grid_Width : constant := 10;
|
|
begin
|
|
return Hash_type (Fix (From (1)) / cell_Size)
|
|
+ Hash_type (Fix (From (2)) / cell_Size) * grid_Width;
|
|
end Hash;
|
|
|
|
|
|
|
|
function Equivalent (S1, S2 : Geometry_2d.Site) return Boolean
|
|
is
|
|
Tolerance : constant := 0.1;
|
|
begin
|
|
return abs (S2 (1) - S1 (1)) < Tolerance
|
|
and abs (S2 (2) - S1 (2)) < Tolerance;
|
|
end Equivalent;
|
|
|
|
|
|
|
|
type Coordinates_array is array (Index_t range <>) of hexagon_Geometry.Coordinates;
|
|
|
|
type hex_Vertex is
|
|
record
|
|
shared_Hexes : Coordinates_array (1 .. 3);
|
|
shared_Count : Index_t := 0;
|
|
|
|
Site : Geometry_3d.Site;
|
|
end record;
|
|
|
|
type hex_Vertices is array (Index_t range <>) of hex_Vertex;
|
|
|
|
|
|
|
|
package site_Maps_of_vertex_Id is new ada.Containers.hashed_Maps (Key_type => Geometry_2d.Site,
|
|
Element_type => Index_t,
|
|
Hash => Hash,
|
|
equivalent_Keys => Equivalent,
|
|
"=" => "=");
|
|
|
|
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 (Textures, Fonts);
|
|
|
|
use Geometry,
|
|
Geometry.colored,
|
|
Geometry_2d;
|
|
|
|
site_Map_of_vertex_Id : site_Maps_of_vertex_Id.Map;
|
|
next_free_vertex_Id : Index_t := 0;
|
|
|
|
|
|
function fetch_Id (S : in geometry_2d.Site) return Index_t
|
|
is
|
|
use site_Maps_of_vertex_Id;
|
|
C : constant Cursor := site_Map_of_vertex_Id.Find (S);
|
|
begin
|
|
if has_Element (C)
|
|
then
|
|
return Element (C);
|
|
else
|
|
next_free_vertex_Id := @ + 1;
|
|
site_Map_of_vertex_Id.insert (S, next_free_vertex_Id);
|
|
|
|
return next_free_vertex_Id;
|
|
end if;
|
|
end fetch_Id;
|
|
|
|
|
|
Heights : height_Map_view renames Self.Heights;
|
|
|
|
row_Count : constant Index_t := Heights'Length (1);
|
|
col_Count : constant Index_t := Heights'Length (2);
|
|
|
|
the_Grid : constant hexagon_Geometry.Grid := Hexagon.to_Grid (Rows => Positive (row_Count),
|
|
Cols => Positive (col_Count),
|
|
circumRadius => 1.0);
|
|
zigzag_Count : constant Index_t := col_Count + 1;
|
|
|
|
first_zigzag_vertex_Count : constant Index_t := row_Count * 2 + 1;
|
|
mid_zigzag_vertex_Count : constant Index_t := row_Count * 2 + 2;
|
|
last_zigzag_vertex_Count : constant Index_t := row_Count * 2 + 1;
|
|
|
|
zigzags_vertex_Count : constant Index_t := first_zigzag_vertex_Count
|
|
+ (mid_zigzag_vertex_Count) * (zigzag_Count - 2)
|
|
+ last_zigzag_vertex_Count;
|
|
zigzag_joiner_vertex_Count : constant Index_t := col_Count * 2;
|
|
|
|
|
|
vertex_Count : constant Index_t := zigzags_vertex_Count
|
|
+ zigzag_joiner_vertex_Count;
|
|
|
|
hex_Vertices : hex_Grid.hex_Vertices (1 .. zigzags_vertex_Count);
|
|
|
|
zigzags_indices_Count : constant long_Index_t := long_Index_t (vertex_Count);
|
|
|
|
gl_Vertices : aliased Geometry.colored.Vertex_array (1 .. vertex_Count);
|
|
|
|
hex_Count : constant long_Index_t := long_Index_t (col_Count * row_Count * 2);
|
|
|
|
zigzags_Indices : aliased Indices (1 .. zigzags_indices_Count);
|
|
tops_Indices : aliased Indices (1 .. hex_Count
|
|
+ long_Index_t (col_Count * 2));
|
|
|
|
zigzags_Geometry : constant Geometry.colored.view := Geometry.colored.new_Geometry;
|
|
tops_Geometry : constant Geometry.colored.view := Geometry.colored.new_Geometry;
|
|
|
|
|
|
min_Site : Site := [Real'Last, Real'Last, Real'Last];
|
|
max_Site : Site := [Real'First, Real'First, Real'First];
|
|
|
|
begin
|
|
|
|
find_shared_Hexes_per_Vertex:
|
|
begin
|
|
for Row in 1 .. row_Count
|
|
loop
|
|
|
|
for Col in 1 .. col_Count
|
|
loop
|
|
|
|
for Which in hexagon_Geometry.vertex_Id
|
|
loop
|
|
declare
|
|
use hexagon_Geometry;
|
|
Site : constant Geometry_2d.Site := vertex_Site (the_Grid,
|
|
hex_Id => [Positive (Row),
|
|
Positive (Col)],
|
|
Which => Which);
|
|
|
|
vertex_Id : constant Index_t := fetch_Id (S => Site);
|
|
the_Vertex : hex_Vertex renames hex_Vertices (vertex_Id);
|
|
C : constant Index_t := the_Vertex.shared_Count + 1;
|
|
begin
|
|
the_Vertex.shared_Count := C;
|
|
the_Vertex.shared_Hexes (C) := [Positive (Row),
|
|
Positive (Col)];
|
|
the_Vertex.Site := [Site (1),
|
|
0.0,
|
|
Site (2)];
|
|
end;
|
|
end loop;
|
|
|
|
end loop;
|
|
|
|
end loop;
|
|
end find_shared_Hexes_per_Vertex;
|
|
|
|
|
|
set_Height_for_each_Vertex:
|
|
begin
|
|
for Row in 1 .. row_Count
|
|
loop
|
|
|
|
for Col in 1 .. col_Count
|
|
loop
|
|
|
|
for Which in hexagon_Geometry.vertex_Id
|
|
loop
|
|
declare
|
|
use hexagon_Geometry;
|
|
Site : constant Geometry_2d.Site := vertex_Site (the_Grid,
|
|
hex_Id => [Positive (Row),
|
|
Positive (Col)],
|
|
Which => Which);
|
|
Height : Real := 0.0;
|
|
vertex_Id : constant Index_t := fetch_Id (S => Site);
|
|
the_Vertex : hex_Vertex renames hex_Vertices (vertex_Id);
|
|
begin
|
|
for Each in 1 .. the_Vertex.shared_Count
|
|
loop
|
|
Height := Height + Heights (Row, Col);
|
|
end loop;
|
|
|
|
Height := Height / Real (the_Vertex.shared_Count);
|
|
the_Vertex.Site := [Site (1),
|
|
Height,
|
|
Site (2)];
|
|
|
|
min_Site := [Real'Min (min_Site (1), the_Vertex.Site (1)),
|
|
Real'Min (min_Site (2), the_Vertex.Site (2)),
|
|
Real'Min (min_Site (3), the_Vertex.Site (3))];
|
|
|
|
max_Site := [Real'Max (min_Site (1), the_Vertex.Site (1)),
|
|
Real'Max (min_Site (2), the_Vertex.Site (2)),
|
|
Real'Max (min_Site (3), the_Vertex.Site (3))];
|
|
end;
|
|
end loop;
|
|
|
|
end loop;
|
|
|
|
end loop;
|
|
end set_Height_for_each_Vertex;
|
|
|
|
|
|
set_GL_Vertices:
|
|
declare
|
|
Center : constant Site := [(max_Site (1) - min_Site (1)) / 2.0,
|
|
(max_Site (2) - min_Site (2)) / 2.0,
|
|
(max_Site (3) - min_Site (3)) / 2.0];
|
|
|
|
vertex_Id : Index_t := 0;
|
|
Color : constant rgba_Color := Self.Color;
|
|
begin
|
|
--- Add hex vertices.
|
|
--
|
|
for i in hex_Vertices'Range
|
|
loop
|
|
vertex_Id := vertex_Id + 1;
|
|
|
|
gl_Vertices (vertex_Id).Site := hex_Vertices (vertex_Id).Site - Center;
|
|
gl_Vertices (vertex_Id).Color := Color;
|
|
end loop;
|
|
|
|
--- Add joiner vertices.
|
|
--
|
|
for i in 1 .. col_Count
|
|
loop
|
|
declare
|
|
use hexagon_Geometry;
|
|
|
|
Site : Geometry_2d.Site := vertex_Site (the_Grid,
|
|
hex_Id => [Row => Positive (row_Count),
|
|
Col => Positive (i)],
|
|
Which => 3);
|
|
hex_vertex_Id : Index_t := fetch_Id (Site);
|
|
begin
|
|
vertex_Id := vertex_Id + 1;
|
|
gl_Vertices (vertex_Id) := (Site => hex_Vertices (hex_vertex_Id).Site - Center,
|
|
Color => (Primary => Color.Primary,
|
|
Alpha => 0));
|
|
|
|
Site := vertex_Site (the_Grid,
|
|
hex_Id => [Row => 1,
|
|
Col => Positive (i)],
|
|
Which => 6);
|
|
|
|
hex_vertex_Id := fetch_Id (Site);
|
|
vertex_Id := vertex_Id + 1;
|
|
gl_Vertices (vertex_Id) := (Site => hex_Vertices (hex_vertex_Id).Site - Center,
|
|
Color => (Primary => Color.Primary,
|
|
Alpha => 0));
|
|
end;
|
|
end loop;
|
|
end set_GL_Vertices;
|
|
|
|
|
|
set_zigzags_GL_Indices:
|
|
declare
|
|
Cursor : long_Index_t := 0;
|
|
joiners_vertex_Id : Index_t := zigzags_vertex_Count;
|
|
|
|
|
|
procedure add_zigzag_Vertex (Row, Col : in Positive;
|
|
hex_Vertex : in Hexagon.vertex_Id)
|
|
is
|
|
use hexagon_Geometry;
|
|
|
|
Site : constant Geometry_2d.Site := vertex_Site (the_Grid,
|
|
hex_Id => [Row, Col],
|
|
Which => hex_Vertex);
|
|
begin
|
|
Cursor := Cursor + 1;
|
|
zigzags_Indices (Cursor) := fetch_Id (S => Site);
|
|
end add_zigzag_Vertex;
|
|
|
|
|
|
procedure add_joiner_vertex_Pair
|
|
is
|
|
begin
|
|
Cursor := Cursor + 1;
|
|
joiners_vertex_Id := joiners_vertex_Id + 1;
|
|
zigzags_Indices (Cursor) := joiners_vertex_Id;
|
|
|
|
Cursor := Cursor + 1;
|
|
joiners_vertex_Id := joiners_vertex_Id + 1;
|
|
zigzags_Indices (Cursor) := joiners_vertex_Id;
|
|
end add_joiner_vertex_Pair;
|
|
|
|
|
|
begin
|
|
--- Fist zigzag
|
|
--
|
|
add_zigzag_Vertex (Row => 1, Col => 1, hex_Vertex => 5);
|
|
|
|
for Row in 1 .. Positive (row_Count)
|
|
loop
|
|
add_zigzag_Vertex (Row, Col => 1, hex_Vertex => 4);
|
|
add_zigzag_Vertex (Row, Col => 1, hex_Vertex => 3);
|
|
end loop;
|
|
|
|
add_joiner_vertex_Pair;
|
|
|
|
|
|
--- Middles zigzags
|
|
--
|
|
|
|
for zz in 2 .. Positive (zigzag_Count) - 1
|
|
loop
|
|
declare
|
|
odd_Zigzag : constant Boolean := zz mod 2 = 1;
|
|
begin
|
|
if odd_Zigzag
|
|
then
|
|
add_zigzag_Vertex (Row => 1, Col => Positive (zz), hex_Vertex => 5);
|
|
|
|
else -- Even zigzag.
|
|
add_zigzag_Vertex (Row => 1, Col => Positive (zz - 1), hex_Vertex => 6);
|
|
end if;
|
|
|
|
|
|
for Row in 1 .. Positive (row_Count)
|
|
loop
|
|
if odd_Zigzag
|
|
then
|
|
add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 4);
|
|
add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 3);
|
|
|
|
if Row = Positive (row_Count) -- Last row.
|
|
then
|
|
add_zigzag_Vertex (Row, Col => zz - 1, hex_Vertex => 2);
|
|
end if;
|
|
|
|
else -- Even zigzag.
|
|
add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 5);
|
|
add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 4);
|
|
|
|
if Row = Positive (row_Count) -- Last row.
|
|
then
|
|
add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 3);
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
end;
|
|
|
|
add_joiner_vertex_Pair;
|
|
end loop;
|
|
|
|
|
|
--- Last zigzag
|
|
--
|
|
add_zigzag_Vertex (Row => 1, Col => Positive (col_Count), hex_Vertex => 6);
|
|
|
|
for Row in 1 .. Positive (row_Count)
|
|
loop
|
|
add_zigzag_Vertex (Row, Positive (col_Count), hex_Vertex => 1);
|
|
add_zigzag_Vertex (Row, Positive (col_Count), hex_Vertex => 2);
|
|
end loop;
|
|
|
|
end set_zigzags_GL_Indices;
|
|
|
|
|
|
zigzags_Geometry.is_Transparent (False);
|
|
zigzags_Geometry.Vertices_are (gl_Vertices);
|
|
|
|
|
|
set_tops_GL_Indices:
|
|
declare
|
|
Cursor : long_Index_t := 0;
|
|
begin
|
|
for Col in 1 .. col_Count
|
|
loop
|
|
for Row in 1 .. row_Count
|
|
loop
|
|
declare
|
|
use hexagon_Geometry;
|
|
Site : Geometry_2d.Site := vertex_Site (the_Grid,
|
|
hex_Id => [Positive (Row),
|
|
Positive (Col)],
|
|
Which => 5);
|
|
begin
|
|
Cursor := Cursor + 1;
|
|
tops_Indices (Cursor) := fetch_Id (Site);
|
|
|
|
Site := vertex_Site (the_Grid,
|
|
hex_Id => [Positive (Row),
|
|
Positive (Col)],
|
|
Which => 6);
|
|
|
|
Cursor := Cursor + 1;
|
|
tops_Indices (Cursor) := fetch_Id (Site);
|
|
|
|
if Row = row_Count -- Last row, so do bottoms.
|
|
then
|
|
Site := vertex_Site (the_Grid,
|
|
hex_Id => [Positive (Row),
|
|
Positive (Col)],
|
|
Which => 3);
|
|
|
|
Cursor := Cursor + 1;
|
|
tops_Indices (Cursor) := fetch_Id (Site);
|
|
|
|
Site := vertex_Site (the_Grid,
|
|
hex_Id => [Positive (Row),
|
|
Positive (Col)],
|
|
Which => 2);
|
|
|
|
Cursor := Cursor + 1;
|
|
tops_Indices (Cursor) := fetch_Id (Site);
|
|
end if;
|
|
end;
|
|
end loop;
|
|
end loop;
|
|
end set_tops_GL_Indices;
|
|
|
|
|
|
tops_Geometry.is_Transparent (False);
|
|
tops_Geometry.Vertices_are (gl_Vertices);
|
|
|
|
|
|
add_zigzag_Geometry:
|
|
declare
|
|
the_Primitive : constant Primitive.indexed.view
|
|
:= Primitive.indexed.new_Primitive (Primitive.line_Strip,
|
|
zigzags_Indices);
|
|
begin
|
|
zigzags_Geometry.add (Primitive.view (the_Primitive));
|
|
end add_zigzag_Geometry;
|
|
|
|
|
|
add_tops_Geometry:
|
|
declare
|
|
the_Primitive : constant Primitive.indexed.view
|
|
:= Primitive.indexed.new_Primitive (Primitive.Lines,
|
|
tops_Indices);
|
|
begin
|
|
tops_Geometry.add (Primitive.view (the_Primitive));
|
|
end add_tops_Geometry;
|
|
|
|
|
|
return [1 => Geometry.view (zigzags_Geometry),
|
|
2 => Geometry.view ( tops_Geometry)];
|
|
end to_GL_Geometries;
|
|
|
|
|
|
|
|
-- TODO: This is an approximation based on a rectangular grid.
|
|
-- Do a correct calculation based on the hexagon grid vertices.
|
|
--
|
|
overriding
|
|
procedure set_Bounds (Self : in out Item)
|
|
is
|
|
Heights : height_Map_view renames Self.Heights;
|
|
|
|
row_Count : constant Index_t := Heights'Length (1) - 1;
|
|
col_Count : constant Index_t := Heights'Length (2) - 1;
|
|
|
|
vertex_Count : constant Index_t := Heights'Length (1) * Heights'Length (2);
|
|
|
|
the_Sites : aliased Sites (1 .. vertex_Count);
|
|
|
|
the_Bounds : openGL.Bounds := null_Bounds;
|
|
|
|
begin
|
|
set_Sites:
|
|
declare
|
|
vert_Id : Index_t := 0;
|
|
the_height_Range : constant Vector_2 := height_Extent (Heights.all);
|
|
Middle : constant Real := (the_height_Range (1) + the_height_Range (2))
|
|
/ 2.0;
|
|
begin
|
|
for Row in 1 .. row_Count + 1
|
|
loop
|
|
for Col in 1 .. col_Count + 1
|
|
loop
|
|
vert_Id := vert_Id + 1;
|
|
the_Sites (vert_Id) := [Real (Col) - Real (col_Count) / 2.0 - 1.0,
|
|
Heights (Row, Col) - Middle,
|
|
Real (Row) - Real (row_Count) / 2.0 - 1.0];
|
|
|
|
the_Bounds.Box.Lower (1) := Real'Min (the_Bounds.Box.Lower (1), the_Sites (vert_Id) (1));
|
|
the_Bounds.Box.Lower (2) := Real'Min (the_Bounds.Box.Lower (2), the_Sites (vert_Id) (2));
|
|
the_Bounds.Box.Lower (3) := Real'Min (the_Bounds.Box.Lower (3), the_Sites (vert_Id) (3));
|
|
|
|
the_Bounds.Box.Upper (1) := Real'Max (the_Bounds.Box.Upper (1), the_Sites (vert_Id) (1));
|
|
the_Bounds.Box.Upper (2) := Real'Max (the_Bounds.Box.Upper (2), the_Sites (vert_Id) (2));
|
|
the_Bounds.Box.Upper (3) := Real'Max (the_Bounds.Box.Upper (3), the_Sites (vert_Id) (3));
|
|
|
|
the_Bounds.Ball := Real'Max (the_Bounds.Ball,
|
|
abs (the_Sites (vert_Id)));
|
|
end loop;
|
|
end loop;
|
|
|
|
the_Bounds.Ball := the_Bounds.Ball * 1.1; -- TODO: Why the '* 1.1' ?
|
|
end set_Sites;
|
|
|
|
Self.Bounds := the_Bounds;
|
|
end set_Bounds;
|
|
|
|
|
|
end openGL.Model.hex_grid;
|