435 lines
11 KiB
Ada
435 lines
11 KiB
Ada
with
|
|
GL,
|
|
|
|
float_Math.Algebra.linear.d2,
|
|
float_Math.Algebra.linear.d3,
|
|
float_Math.Geometry.d2,
|
|
float_Math.Geometry.d3,
|
|
|
|
ada.Containers;
|
|
|
|
|
|
package openGL
|
|
--
|
|
-- Provides a namespace and set of core types.
|
|
--
|
|
is
|
|
pragma Pure;
|
|
|
|
Error : exception;
|
|
|
|
|
|
------------
|
|
-- Profiles
|
|
--
|
|
|
|
type profile_Kind is (Safe, Lean, Desk);
|
|
|
|
function Profile return profile_Kind;
|
|
|
|
|
|
----------
|
|
-- Models
|
|
--
|
|
|
|
Model_too_complex : exception;
|
|
max_Models : constant := 2**32 - 1;
|
|
|
|
type model_Id is range 0 .. max_Models;
|
|
|
|
null_model_Id : constant model_Id;
|
|
|
|
|
|
-----------
|
|
-- Indices
|
|
--
|
|
|
|
type short_Index_t is range 0 .. 2**8 - 1;
|
|
type Index_t is range 0 .. 2**16 - 1;
|
|
type long_Index_t is range 0 .. 2**32 - 1;
|
|
|
|
type short_Indices is array (long_Index_t range <>) of short_Index_t;
|
|
type Indices is array (long_Index_t range <>) of Index_t;
|
|
type long_Indices is array (long_Index_t range <>) of long_Index_t;
|
|
|
|
|
|
--------
|
|
-- Math
|
|
--
|
|
|
|
package Math renames float_Math;
|
|
use Math;
|
|
|
|
package linear_Algebra renames float_Math.Algebra.linear;
|
|
package linear_Algebra_2d renames float_Math.Algebra.linear.d2;
|
|
package linear_Algebra_3d renames float_Math.Algebra.linear.d3;
|
|
package Geometry_2d renames float_Math.Geometry.d2;
|
|
package Geometry_3d renames float_Math.Geometry.d3;
|
|
|
|
|
|
--------
|
|
-- Real
|
|
--
|
|
subtype Real is math.Real;
|
|
|
|
package real_Functions renames math.Functions;
|
|
|
|
|
|
-------------
|
|
-- Safe Real
|
|
--
|
|
protected
|
|
type safe_Real
|
|
is
|
|
procedure Value_is (Now : in Real);
|
|
function Value return Real;
|
|
private
|
|
the_Value : Real;
|
|
end safe_Real;
|
|
|
|
|
|
-----------
|
|
-- Extents
|
|
--
|
|
type Extent_2D is
|
|
record
|
|
Width : Natural;
|
|
Height : Natural;
|
|
end record;
|
|
|
|
|
|
-----------
|
|
-- Vectors
|
|
--
|
|
subtype Vector is math.Vector;
|
|
|
|
subtype Vector_2 is math.Vector_2;
|
|
subtype Vector_3 is math.Vector_3;
|
|
subtype Vector_4 is math.Vector_4;
|
|
|
|
type Vector_2_array is array (Positive range <>) of Vector_2;
|
|
type Vector_3_array is array ( Index_t range <>) of aliased Vector_3;
|
|
type Vector_3_large_array is array (long_Index_t range <>) of aliased Vector_3;
|
|
|
|
function Scaled (Self : in Vector_3; By : in Vector_3) return Vector_3;
|
|
function Scaled (Self : in Vector_3_array; By : in Vector_3) return Vector_3_array;
|
|
|
|
function to_Vector_3_array (Self : in Vector_2_array) return Vector_3_array;
|
|
|
|
|
|
------------
|
|
-- Matrices
|
|
--
|
|
subtype Matrix is math.Matrix;
|
|
|
|
subtype Matrix_2x2 is math.Matrix_2x2;
|
|
subtype Matrix_3x3 is math.Matrix_3x3;
|
|
subtype Matrix_4x4 is math.Matrix_4x4;
|
|
|
|
|
|
---------------
|
|
-- Height Maps
|
|
--
|
|
type height_Map is array (Index_t range <>,
|
|
Index_t range <>) of aliased Real;
|
|
|
|
function Scaled (Self : in height_Map; By : in Real) return height_Map;
|
|
procedure scale (Self : in out height_Map; By : in Real);
|
|
|
|
function height_Extent (Self : in height_Map) return Vector_2;
|
|
--
|
|
-- Returns the min and max height.
|
|
|
|
|
|
type index_Pair is array (1 .. 2) of Index_t;
|
|
|
|
function Region (Self : in height_Map; Rows, Cols : in index_Pair) return height_Map;
|
|
--
|
|
-- Returns the submatrix indicated via Rows & Cols.
|
|
|
|
|
|
------------
|
|
-- Geometry
|
|
--
|
|
subtype Site is Vector_3; -- A position in 3d space.
|
|
subtype Sites is Vector_3_array;
|
|
subtype many_Sites is Vector_3_large_array;
|
|
|
|
subtype Normal is Vector_3; -- A normal in 3d space.
|
|
subtype Normals is Vector_3_array;
|
|
subtype many_Normals is Vector_3_large_array;
|
|
|
|
type Bounds is
|
|
record
|
|
Ball : Real; -- Sphere radius.
|
|
Box : Geometry_3d.bounding_Box;
|
|
end record;
|
|
|
|
null_Bounds : constant Bounds;
|
|
|
|
function bounding_Box_of (Self : Sites) return Bounds;
|
|
procedure set_Ball_from_Box (Self : in out Bounds);
|
|
|
|
|
|
---------
|
|
-- Color
|
|
--
|
|
|
|
-- RGB
|
|
--
|
|
subtype grey_Value is gl.GLubyte;
|
|
subtype color_Value is gl.GLubyte;
|
|
|
|
type rgb_Color is
|
|
record
|
|
Red : aliased color_Value;
|
|
Green : color_Value;
|
|
Blue : color_Value;
|
|
end record;
|
|
|
|
|
|
type rgba_Color is
|
|
record
|
|
Primary : rgb_Color;
|
|
Alpha : color_Value;
|
|
end record;
|
|
|
|
|
|
-- Primary
|
|
--
|
|
null_Primary : constant := Real'Adjacent (0.0, -1.0);
|
|
|
|
type Primary is new Real range null_Primary .. 1.0;
|
|
|
|
type Color is
|
|
record
|
|
Red : Primary;
|
|
Green : Primary;
|
|
Blue : Primary;
|
|
end record;
|
|
|
|
type Colors is array (Index_t range <>) of Color;
|
|
|
|
|
|
type Opaqueness is new Real range 0.0 .. 1.0;
|
|
|
|
Opaque : constant Opaqueness;
|
|
Lucid : constant Opaqueness;
|
|
|
|
|
|
type lucid_Color is
|
|
record
|
|
Primary : Color;
|
|
Opacity : Opaqueness;
|
|
end record;
|
|
|
|
type lucid_Colors is array (Index_t range <>) of lucid_Color;
|
|
|
|
|
|
no_Color : constant Color;
|
|
no_lucid_Color : constant lucid_Color;
|
|
|
|
|
|
function to_Color (From : in rgb_Color) return Color;
|
|
|
|
|
|
-- Shine
|
|
--
|
|
subtype Shine is Real range 1.0 .. Real'Last;
|
|
|
|
no_Shine : constant Shine;
|
|
default_Shine : constant Shine; -- Defaults to no shine.
|
|
|
|
|
|
|
|
----------
|
|
-- Images
|
|
--
|
|
type grey_Image is array (Index_t range <>, Index_t range <>) of aliased grey_Value;
|
|
type Image is array (Index_t range <>, Index_t range <>) of aliased rgb_Color;
|
|
type lucid_Image is array (Index_t range <>, Index_t range <>) of aliased rgba_Color;
|
|
|
|
function to_Image (From : in lucid_Image) return Image;
|
|
|
|
|
|
|
|
-----------
|
|
-- Texture
|
|
--
|
|
|
|
-- Coordinates
|
|
--
|
|
|
|
type Coordinate_1D is
|
|
record
|
|
S : aliased Real;
|
|
end record;
|
|
|
|
type Coordinate_2D is
|
|
record
|
|
S, T : aliased Real;
|
|
end record;
|
|
|
|
type Coordinate_3D is
|
|
record
|
|
S, T, R : aliased Real;
|
|
end record;
|
|
|
|
type Coordinate_4D is
|
|
record
|
|
S, T, R, Q : aliased Real;
|
|
end record;
|
|
|
|
type Coordinates_1D is array (Index_t range <>) of aliased Coordinate_1D;
|
|
type Coordinates_2D is array (Index_t range <>) of aliased Coordinate_2D;
|
|
type Coordinates_3D is array (Index_t range <>) of aliased Coordinate_3D;
|
|
type Coordinates_4D is array (Index_t range <>) of aliased Coordinate_4D;
|
|
|
|
type many_Coordinates_1D is array (long_Index_t range <>) of aliased Coordinate_1D;
|
|
type many_Coordinates_2D is array (long_Index_t range <>) of aliased Coordinate_2D;
|
|
type many_Coordinates_3D is array (long_Index_t range <>) of aliased Coordinate_3D;
|
|
type many_Coordinates_4D is array (long_Index_t range <>) of aliased Coordinate_4D;
|
|
|
|
|
|
-- Transforms
|
|
--
|
|
|
|
type texture_Transform is
|
|
record
|
|
Offset : Real;
|
|
Scale : Real;
|
|
end record;
|
|
|
|
type texture_Transform_1D is
|
|
record
|
|
S : texture_Transform;
|
|
end record;
|
|
|
|
type texture_Transform_2D is
|
|
record
|
|
S : texture_Transform;
|
|
T : texture_Transform;
|
|
end record;
|
|
|
|
type texture_Transform_3D is
|
|
record
|
|
S : texture_Transform;
|
|
T : texture_Transform;
|
|
R : texture_Transform;
|
|
end record;
|
|
|
|
type texture_Transform_4D is
|
|
record
|
|
S : texture_Transform;
|
|
T : texture_Transform;
|
|
R : texture_Transform;
|
|
Q : texture_Transform;
|
|
end record;
|
|
|
|
|
|
----------
|
|
-- Assets
|
|
--
|
|
|
|
type asset_Name is new String (1 .. 128);
|
|
--
|
|
-- Name of a file containing textures, images, fonts, shaders, shader_snippets or other resources.
|
|
|
|
type asset_Names is array (Positive range <>) of asset_Name;
|
|
|
|
|
|
null_Asset : constant asset_Name;
|
|
|
|
function to_Asset (Self : in String) return asset_Name;
|
|
function to_String (Self : in asset_Name) return String;
|
|
function Hash (Self : in asset_Name) return ada.Containers.Hash_type;
|
|
|
|
|
|
-----------------------------
|
|
-- Shader Program Parameters
|
|
--
|
|
type Parameters is tagged limited private;
|
|
|
|
|
|
|
|
---------------
|
|
-- Task Safety
|
|
--
|
|
type safe_Boolean is new Boolean;
|
|
pragma Atomic (safe_Boolean);
|
|
|
|
|
|
|
|
private
|
|
|
|
-- NB: Packing these arrays forces compiler to use the correct size for the element type, rather than the most efficient size. -- TODO: Use 'Size' aspect clauses, instead of 'Pack'.
|
|
--
|
|
pragma Pack (short_Indices);
|
|
pragma Pack ( Indices);
|
|
pragma Pack ( long_Indices);
|
|
|
|
pragma Assert (GL.GLfloat'Size = Real'Size);
|
|
|
|
|
|
null_Asset : constant asset_Name := (others => ' ');
|
|
null_model_Id : constant model_Id := 0;
|
|
null_Bounds : constant Bounds := (ball => 0.0,
|
|
box => (lower => [Real'Last, Real'Last, Real'Last],
|
|
upper => [Real'First, Real'First, Real'First]));
|
|
-----------
|
|
-- Opacity
|
|
--
|
|
Opaque : constant Opaqueness := 1.0;
|
|
Lucid : constant Opaqueness := 0.0;
|
|
|
|
opaque_Value : constant color_Value := color_Value'Last;
|
|
lucid_Value : constant color_Value := color_Value'First;
|
|
|
|
|
|
---------
|
|
-- Color
|
|
--
|
|
no_Color : constant Color := (Red => null_Primary,
|
|
Green => null_Primary,
|
|
Blue => null_Primary);
|
|
|
|
no_lucid_Color : constant lucid_Color := (Primary => (Red => null_Primary,
|
|
Green => null_Primary,
|
|
Blue => null_Primary),
|
|
Opacity => Opaqueness'First);
|
|
-- RGB
|
|
--
|
|
type rgb_Colors is array (Index_t range <>) of rgb_Color;
|
|
type rgba_Colors is array (Index_t range <>) of rgba_Color;
|
|
|
|
|
|
-- Shine
|
|
--
|
|
no_Shine : constant Shine := Shine'Last;
|
|
default_Shine : constant Shine := no_Shine;
|
|
|
|
|
|
|
|
-- Conversions
|
|
--
|
|
function to_Color (Red, Green, Blue : in Primary) return rgb_Color;
|
|
|
|
function to_color_Value (Self : in Primary) return color_Value;
|
|
function to_Primary (Self : in color_Value) return Primary;
|
|
|
|
function to_lucid_Color (From : in rgba_Color) return lucid_Color;
|
|
function to_rgba_Color (From : in lucid_Color) return rgba_Color;
|
|
function to_rgb_Color (From : in Color) return rgb_Color;
|
|
|
|
function "+" (From : in rgb_Color) return Color renames to_Color;
|
|
function "+" (From : in lucid_Color) return rgba_Color renames to_rgba_Color;
|
|
function "+" (From : in Color) return rgb_Color renames to_rgb_Color;
|
|
|
|
|
|
----------------------------
|
|
-- Shader Program Parameters
|
|
--
|
|
type Parameters is tagged limited null record;
|
|
|
|
end openGL;
|