package GLOBE_3D is
package REF is new Ada.Numerics.Generic_Elementary_Functions (Real);
package RIO is new Ada.Text_IO.Float_IO (Real);
package Visuals_Mapping is new Ada.Containers.Hashed_Maps (Key_Type => Ada.Strings.Unbounded.Unbounded_String, Element_Type => p_Visual, Hash => Ada.Strings.Unbounded.Hash, Equivalent_Keys => Ada.Strings.Unbounded."=");
type Camera is tagged record Clipper : Clipping_data := (Eye_Position => (0.0, 0.0, 5.0), view_direction => (0.0, 0.0, -1.0), max_dot_product => 0.0, main_clipping => (0, 0, 0, 0)); World_Rotation : Matrix_33 := Id_33; Speed : Vector_3D := (0.0, 0.0, 0.0); rotation_Speed : Vector_3D := (0.0, 0.0, 0.0); compose_rotations : Boolean := True; -- True : apply successive rotations from rotation_Speed directly -- to world_Rotation. Good for totally free 3D movement, no gravity. -- Drawback : rotations around x axis, then y, then x, .. . induce a -- rotation around z (the nose) which is x rotated around y. -- False : world_Rotation is set as XYZ_rotation of the rotation vector below; -- x, y, z keep separate. -- Cf implementation in the package Actors rotation : Vector_3D := (0.0, 0.0, 0.0); -- ^ this vector is updated, whatever the state of 'compose_rotations' FOVy : Real := default_field_of_view_Angle; -- field of view angle (deg) in the y direction Aspect : Real; -- x/y aspect ratio near_plane_Distance : Real := 1.0; -- distance to the near clipping plane near_plane_Width : Real; near_plane_Height : Real; far_plane_Distance : Real := fairly_Far; -- distance to the far clipping plane far_plane_Width : Real; far_plane_Height : Real; Projection_Matrix : Matrix_44; frustum_Planes : GL.Frustums.plane_Array; end record;
type Visual is abstract tagged record ID : Ident := "-Nameless- "; -- 1234567890123456789012345678901234567890 Centre : Point_3D := (0.0, 0.0, 0.0); -- vertex coords are relative to the centre. Centre_Camera_Space : Point_3D; -- the visuals 'centre' in camera space. rotation : Matrix_33 := Id_33; is_Terrain : Boolean := False; end record;
type Window is abstract tagged record Camera : aliased GLOBE_3D.Camera; end record;
subtype Ident is String (1 .. 40);
type Image_ID is new Integer range -1 .. Integer'Last;
subtype Real is GL.Double;
subtype Vector_3D is GL.Double_Vector_3D;
type Vector_4D is array (0 .. 3) of Real;
subtype Point_3D is Vector_3D;
type Matrix is array (Positive range <>, Positive range <>) of aliased Real;
type Matrix_33 is new Matrix (1 .. 3, 1 .. 3);
type Matrix_44 is new Matrix (1 .. 4, 1 .. 4);
type Point_3D_array is array (Positive range <>) of aliased Point_3D;
type p_Point_3D_array is access Point_3D_array;
type Vector_3D_array is array (Natural range <>) of Vector_3D;
type Natural_Index_array is array (Natural range <>) of aliased Natural;
type Rectangle is record X1, Y1, X2, Y2 : Integer; end record;
subtype Clipping_area is Rectangle;
type Clipping_data is record Eye_Position : aliased Point_3D; view_direction : Vector_3D; max_dot_product : Real; -- depends on the field of view main_clipping : Clipping_area; end record;
type p_Visual is access all Visual'Class;
type Visual_array is array (Positive range <>) of p_Visual;
type Map_of_Visuals is private;
type Object_3D (Max_points, Max_faces : Integer) is new Visual with record Point : Point_3D_array (1 .. Max_points); -- vertices edge_vector : Vector_3D_array (1 .. Max_points); -- normals for lighting face : Face_array (1 .. Max_faces); sub_objects : p_Object_3D_list := null; -- List of objects to be drawn AFTER the -- object itself e.g., things inside a room pre_calculated : Boolean := False; List_Status : List_Cases := Generate_List; -- private: List_Id : List_Ids; Face_Invariant : Face_invariant_array (1 .. Max_faces); Bounds : GL.Geometry.Bounds_record; transparent : Boolean := False; end record;
type p_Object_3D is access all Object_3D'Class;
type Skin_Type is (texture_only, colour_only, coloured_texture, material_only, material_texture, invisible);
type Set_of_Skin is array (Skin_Type) of Boolean;
subtype Idx_3_array is Natural_Index_array (1 .. 3);
subtype Idx_4_array is Natural_Index_array (1 .. 4);
type Idx_4_array_array is array (Positive range <>) of Idx_4_array;
type Map_idx_pair is record U, V : aliased GL.Double; end record;
type Map_idx_pair_array is array (Natural range <>) of Map_idx_pair;
subtype Map_idx_pair_4_array is Map_idx_pair_array (1 .. 4);
type Face_type is record P : Idx_4_array; -- indices of the edges (anticlockwise) -- one of them can be 0 (triangle); then the -- "missing" edge indicates how to put texture -- *** Portals : connecting : p_Object_3D := null; -- object behind - if there is one -- *** Surface skin : Skin_Type; mirror : Boolean := False; -- mirror just behind the skin ? alpha : GL.Double := 1.0; -- alpha in [0;1] for blending colours and textures. -- NB : when this value (or all of material colours) is equal to -- one, the blending for transparency is switched off to gain -- speed; GLOBE_3D can switch on the blending again when loading -- a texture that has an alpha layer -- *** > colour part (data ignored when irrelevant): colour : GL.RGB_Color; -- *** > material part (data ignored when irrelevant): material : GL.Materials.Material_type := GL.Materials.neutral_material; -- *** > texture - mapping part (data ignored when irrelevant): texture : Image_ID := null_image; -- Alternative to setting an Image_id, if it is not known at -- time of building the object : use Texture_name_hint, then -- Rebuild_links -- -- Whole texture or part of one ? whole_texture : Boolean := True; -- - in case of a whole texture, automatic mapping, we just need -- to know how many times is it tiled: repeat_U, repeat_V : Positive := 1; -- - in case of a partial texture (e.g. for a texture spread -- across several faces), we need a deterministic mapping: texture_edge_map : Map_idx_pair_4_array; end record;
type Face_array is array (Natural range <>) of aliased Face_type;
type p_Face_array is access Face_array;
subtype Edge_count is Positive range 3 .. 4;
type Face_invariant_type is private;
type Face_invariant_array is array (Natural range <>) of Face_invariant_type;
type Object_3D_list;
type p_Object_3D_list is access Object_3D_list;
type Object_3D_array is array (Positive range <>) of p_Object_3D;
type p_Object_3D_array is access Object_3D_array;
type p_Window is access all Window'Class;
subtype Light_count is Natural range 0 .. 8;
subtype Light_ident is Light_count range 1 .. Light_count'Last;
type Light_definition is record position, ambient, diffuse, specular : GL.Light_Float_vector; end record;
empty : constant Ident := (others => ' ');
data_file_not_found : exception;
null_image : constant Image_ID := -1;
Id_33 : constant Matrix_33 := ((1.0, 0.0, 0.0), (0.0, 1.0, 0.0), (0.0, 0.0, 1.0));
null_Visuals : constant Visual_array (1 .. 0) := (others => null);
Duplicate_name : exception;
is_textured : constant Set_of_Skin := (texture_only | coloured_texture | material_texture => True, others => False);
null_colour : constant GL.Material_Float_vector := (0.0, 0.0, 0.0, 0.0);
Portal_connection_failed : exception;
zero_summed_normal : exception;
info_b_real1, info_b_real2 : Real := 123.0;
info_b_vect : Vector_3D := (others => 123.0);
info_b_bool2 : Boolean := False;
info_b_clip : Clipping_area := (0, 0, 0, 0);
info_b_pnt : array (0 .. 4) of Point_3D := (others => (others => 123.0));
info_b_ntl3 : Natural := 0;
info_b_str1 : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.Null_Unbounded_String;
level_data_name : Ada.Strings.Unbounded.Unbounded_String := Ada.Strings.Unbounded.To_Unbounded_String ("*undefined_level_data*");
global_data_name : Ada.Strings.Unbounded.Unbounded_String := Ada.Strings.Unbounded.To_Unbounded_String ("*undefined_global_data*");
zif_level, zif_global : Zip.Zip_info;
zif_global : Zip.Zip_info;
procedure Set_level_data_name
( | s | : String) renames Set_local_data_name; |
procedure Destroy
( | o | : in out Visual) is abstract; |
procedure Free
( | o | : in out p_Visual); |
procedure Pre_calculate
( | o | : in out Visual) is abstract; |
function is_Transparent
( | o | : Visual) return Boolean is abstract; |
function face_Count
( | o | : Visual) return Natural is abstract; |
function Bounds
( | o | : Visual) return GL.Geometry.Bounds_record is abstract; |
function skinned_Geometrys
( | o | : Visual) return GL.Skinned_Geometry.skinned_Geometrys; |
procedure Display
( | o | : in out Visual; |
clip | : Clipping_data) is abstract; |
procedure Set_name
( | o | : in out Visual'class; |
new_name | : String); |
function Get_name
( | o | : Visual'class) return String; |
procedure render
( | the_Visuals | : Visual_array; |
the_Camera | : Camera); |
function empty_map return Map_of_Visuals;
procedure Add
( | to_map | : in out Map_of_Visuals; |
what | : p_Visual); |
function Map_of
( | va | : Visual_array) return Map_of_Visuals; |
overriding procedure Destroy
( | o | : in out Object_3D); |
overriding function is_Transparent
( | o | : Object_3D) return Boolean; |
overriding function face_Count
( | o | : Object_3D) return Natural; |
overriding function Bounds
( | o | : Object_3D) return GL.Geometry.Bounds_record; |
procedure Check_object
( | o | : Object_3D); |
procedure Texture_name_hint
( | o | : in out Object_3D; |
face | : Positive; | |
name | : String ); |
procedure Portal_name_hint
( | o | : in out Object_3D; |
face | : Positive; | |
name | : String ); |
procedure Rebuild_links
( | o | : in out Object_3D'Class; |
-- object to be relinked neighbouring | : Map_of_Visuals; | |
-- neighbourhood tolerant_obj | : Boolean; | |
-- tolerant on missing objects tolerant_tex | : Boolean -- tolerant on missing textures ); |
overriding procedure Pre_calculate
( | o | : in out Object_3D); |
overriding procedure Display
( | o | : in out Object_3D; |
clip | : Clipping_data ); |
procedure Display_one
( | o | : in out Object_3D); |
procedure Enable
( | Self | : in out Window) is abstract; |
procedure Freshen
( | Self | : in out Window; |
time_Step | : GLOBE_3D.Real; | |
Extras | : GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals) is abstract; |
procedure Define
( | which | : Light_ident; |
as | : Light_definition); |
procedure Switch_light
( | which | : Light_ident; |
on | : Boolean); |
procedure Reverse_light_switch
( | which | : Light_ident); |
function Is_light_switched
( | which | : Light_ident) return Boolean; |
function Image
( | r | : Real) return String; |
function Coords
( | p | : Point_3D) return String; |
procedure Angles_modulo_360
( | v | : in out Vector_3D); |
procedure Dispose is new Ada.Unchecked_Deallocation
( | Point_3D_array, p_Point_3D_array); |
procedure Dispose is new Ada.Unchecked_Deallocation
( | Face_array, p_Face_array); |
procedure Load_if_needed
( | zif | : in out Zip.Zip_info; |
name | : String); |
function Is_to_blend
( | m | : GL.Double) return Boolean; |
function Is_to_blend
( | m | : GL.C_Float) return Boolean; |
function Is_to_blend
( | m | : GL.Material_Float_vector) return Boolean; |
function Is_to_blend
( | m | : GL.Materials.Material_type) return Boolean; |
procedure Set_Material
( | m | : GL.Materials.Material_type); |