315 lines
6.8 KiB
Ada
315 lines
6.8 KiB
Ada
with
|
|
ada.Strings.Hash,
|
|
ada.unchecked_Conversion;
|
|
|
|
package body openGL
|
|
is
|
|
------------
|
|
-- Profiles
|
|
--
|
|
|
|
function Profile return profile_Kind
|
|
is separate;
|
|
|
|
|
|
-----------
|
|
-- Vectors
|
|
--
|
|
|
|
function Scaled (Self : in Vector_3; By : in Vector_3) return Vector_3
|
|
is
|
|
begin
|
|
return [Self (1) * By (1),
|
|
Self (2) * By (2),
|
|
Self (3) * By (3)];
|
|
end Scaled;
|
|
|
|
|
|
|
|
function Scaled (Self : in Vector_3_array; By : in Vector_3) return Vector_3_array
|
|
is
|
|
Result : Vector_3_array (Self'Range);
|
|
begin
|
|
for i in Result'Range
|
|
loop
|
|
Result (i) := Scaled (Self (i), By);
|
|
end loop;
|
|
|
|
return Result;
|
|
end Scaled;
|
|
|
|
|
|
|
|
function to_Vector_3_array (Self : Vector_2_array) return Vector_3_array
|
|
is
|
|
the_Array : Vector_3_array (1 .. Self'Length);
|
|
begin
|
|
for i in Self'Range
|
|
loop
|
|
the_Array (Index_t (i)) := Vector_3 (Self (i) & 0.0);
|
|
end loop;
|
|
|
|
return the_Array;
|
|
end to_Vector_3_array;
|
|
|
|
|
|
----------
|
|
-- Colors
|
|
--
|
|
|
|
function to_color_Value (Self : in Primary) return color_Value
|
|
is
|
|
Value : constant Real := Real'Rounding (Real (Self) * 255.0);
|
|
begin
|
|
return color_Value (Value);
|
|
end to_color_Value;
|
|
|
|
|
|
|
|
function to_Primary (Self : in color_Value) return Primary
|
|
is
|
|
begin
|
|
return Primary (Real (Self) / 255.0);
|
|
end to_Primary;
|
|
|
|
|
|
|
|
function to_Color (Red, Green, Blue : in Primary) return rgb_Color
|
|
is
|
|
begin
|
|
return (to_color_Value (Red),
|
|
to_color_Value (Green),
|
|
to_color_Value (Blue));
|
|
end to_Color;
|
|
|
|
|
|
|
|
function to_lucid_Color (From : in rgba_Color) return lucid_Color
|
|
is
|
|
begin
|
|
return (Primary => (to_Primary (From.Primary.Red),
|
|
to_Primary (From.Primary.Green),
|
|
to_Primary (From.Primary.Blue)),
|
|
Opacity => Opaqueness (to_Primary (From.Alpha)));
|
|
end to_lucid_Color;
|
|
|
|
|
|
|
|
function to_rgba_Color (From : in lucid_Color) return rgba_Color
|
|
is
|
|
begin
|
|
return (Primary => (to_color_Value (From.Primary.Red),
|
|
to_color_Value (From.Primary.Green),
|
|
to_color_Value (From.Primary.Blue)),
|
|
Alpha => to_color_Value (Primary (From.Opacity)));
|
|
end to_rgba_Color;
|
|
|
|
|
|
|
|
function to_Color (From : in rgb_Color) return Color
|
|
is
|
|
begin
|
|
return (to_Primary (From.Red),
|
|
to_Primary (From.Green),
|
|
to_Primary (From.Blue));
|
|
end to_Color;
|
|
|
|
|
|
|
|
function to_rgb_Color (From : in Color) return rgb_Color
|
|
is
|
|
begin
|
|
return (to_color_Value (From.Red),
|
|
to_color_Value (From.Green),
|
|
to_color_Value (From.Blue));
|
|
end to_rgb_Color;
|
|
|
|
|
|
|
|
|
|
-------------
|
|
-- Heightmap
|
|
--
|
|
|
|
function Scaled (Self : in height_Map; By : in Real) return height_Map
|
|
is
|
|
begin
|
|
return Result : height_Map := Self
|
|
do
|
|
scale (Result, By);
|
|
end return;
|
|
end scaled;
|
|
|
|
|
|
|
|
procedure scale (Self : in out height_Map; By : in Real)
|
|
is
|
|
begin
|
|
for Row in Self'Range (1)
|
|
loop
|
|
for Col in Self'Range (1)
|
|
loop
|
|
Self (Row, Col) := Self (Row, Col) * By;
|
|
end loop;
|
|
end loop;
|
|
end scale;
|
|
|
|
|
|
|
|
function height_Extent (Self : in height_Map) return Vector_2
|
|
is
|
|
Min : Real := Real'Last;
|
|
Max : Real := Real'First;
|
|
begin
|
|
for Row in Self'Range (1)
|
|
loop
|
|
for Col in Self'Range (2)
|
|
loop
|
|
Min := Real'Min (Min, Self (Row, Col));
|
|
Max := Real'Max (Max, Self (Row, Col));
|
|
end loop;
|
|
end loop;
|
|
|
|
return [Min, Max];
|
|
end height_Extent;
|
|
|
|
|
|
|
|
function Region (Self : in height_Map; Rows, Cols : in index_Pair) return height_Map
|
|
is
|
|
Width : constant Index_t := Index_t (Rows (2) - Rows (1));
|
|
Height : constant Index_t := Index_t (Cols (2) - Cols (1));
|
|
|
|
the_Region : openGL.height_Map (1 .. Width + 1,
|
|
1 .. Height + 1);
|
|
begin
|
|
for Row in the_Region'Range (1)
|
|
loop
|
|
for Col in the_Region'Range (2)
|
|
loop
|
|
the_Region (Row, Col) := Self (Row + Rows (1) - 1,
|
|
Col + Cols (1) - 1);
|
|
end loop;
|
|
end loop;
|
|
|
|
return the_Region;
|
|
end Region;
|
|
|
|
|
|
----------
|
|
-- Assets
|
|
--
|
|
|
|
function to_Asset (Self : in String) return asset_Name
|
|
is
|
|
the_Name : String (asset_Name'Range);
|
|
begin
|
|
the_Name (1 .. Self'Length) := Self;
|
|
the_Name (Self'Length + 1 .. the_Name'Last) := [others => ' '];
|
|
|
|
return asset_Name (the_Name);
|
|
end to_Asset;
|
|
|
|
|
|
|
|
function to_String (Self : in asset_Name) return String
|
|
is
|
|
begin
|
|
for Each in reverse Self'Range
|
|
loop
|
|
if Self (Each) /= ' '
|
|
then
|
|
return String (Self (1 .. Each));
|
|
end if;
|
|
end loop;
|
|
|
|
return "";
|
|
end to_String;
|
|
|
|
|
|
|
|
function Hash (Self : in asset_Name) return ada.Containers.Hash_type
|
|
is
|
|
begin
|
|
return ada.Strings.Hash (to_String (Self));
|
|
end Hash;
|
|
|
|
|
|
---------
|
|
-- Bounds
|
|
--
|
|
|
|
function bounding_Box_of (Self : Sites) return Bounds
|
|
is
|
|
Result : Bounds := null_Bounds;
|
|
begin
|
|
for Each in Self'Range
|
|
loop
|
|
Result.Box.Lower (1) := Real'Min (Result.Box.Lower (1), Self (Each)(1));
|
|
Result.Box.Lower (2) := Real'Min (Result.Box.Lower (2), Self (Each)(2));
|
|
Result.Box.Lower (3) := Real'Min (Result.Box.Lower (3), Self (Each)(3));
|
|
|
|
Result.Box.Upper (1) := Real'Max (Result.Box.Upper (1), Self (Each)(1));
|
|
Result.Box.Upper (2) := Real'Max (Result.Box.Upper (2), Self (Each)(2));
|
|
Result.Box.Upper (3) := Real'Max (Result.Box.Upper (3), Self (Each)(3));
|
|
|
|
Result.Ball := Real'Max (Result.Ball,
|
|
abs Self (Each));
|
|
end loop;
|
|
|
|
return Result;
|
|
end bounding_Box_of;
|
|
|
|
|
|
|
|
procedure set_Ball_from_Box (Self : in out Bounds)
|
|
is
|
|
begin
|
|
Self.Ball := Real'Max (abs Self.Box.Lower,
|
|
abs Self.Box.Upper);
|
|
end set_Ball_from_Box;
|
|
|
|
|
|
---------
|
|
-- Images
|
|
--
|
|
|
|
function to_Image (From : in lucid_Image) return Image
|
|
is
|
|
the_Image : Image (From'Range (1),
|
|
From'Range (2));
|
|
begin
|
|
for Row in From'Range (1)
|
|
loop
|
|
for Col in From'Range (2)
|
|
loop
|
|
the_Image (Row, Col) := From (Row, Col).Primary;
|
|
end loop;
|
|
end loop;
|
|
|
|
return the_Image;
|
|
end to_Image;
|
|
|
|
|
|
------------
|
|
-- safe_Real
|
|
--
|
|
|
|
protected
|
|
body safe_Real
|
|
is
|
|
procedure Value_is (Now : in Real)
|
|
is
|
|
begin
|
|
the_Value := Now;
|
|
end Value_is;
|
|
|
|
function Value return Real
|
|
is
|
|
begin
|
|
return the_Value;
|
|
end Value;
|
|
end safe_Real;
|
|
|
|
end openGL;
|