Add initial prototype.
This commit is contained in:
Rod Kay
552
3-mid/opengl/source/lean/model/opengl-model-hex_grid.adb
Normal file
552
3-mid/opengl/source/lean/model/opengl-model-hex_grid.adb
Normal file
@@ -0,0 +1,552 @@
|
||||
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;
|
||||
Reference in New Issue
Block a user