1. ------------------------------------------------------------------------- 
  2.  --  GL.Geometry - GL geometry primitives 
  3.  -- 
  4.  --  Copyright (c) Rod Kay 2007 
  5.  --  AUSTRALIA 
  6.  --  Permission granted to use this software, without any warranty, 
  7.  --  for any purpose, provided this copyright note remains attached 
  8.  --  and unmodified if sources are distributed further. 
  9.  ------------------------------------------------------------------------- 
  10.  
  11. with Ada.Unchecked_Deallocation; 
  12. with Interfaces.C.Pointers; 
  13. with Ada.Unchecked_Conversion; 
  14.  
  15. package GL.Geometry is 
  16.  
  17.    -- planes 
  18.    -- 
  19.  
  20.    type Plane is array (0 .. 3) of aliased GL.Double;   -- a general plane in equation form (tbd : use  1 .. 4  ?) 
  21.  
  22.    procedure Normalise (the_Plane  : in out Plane); 
  23.  
  24.    -- bounds 
  25.    -- 
  26.  
  27.    type Extent is 
  28.       record 
  29.          Min, Max  : GL.Double; 
  30.       end record; 
  31.  
  32.    function Max (L, R : Extent) return Extent; 
  33.  
  34.    type Axis_Aligned_Bounding_Box is 
  35.       record 
  36.          X_Extent  : Extent;    -- extents in object space 
  37.          Y_Extent  : Extent; 
  38.          Z_Extent  : Extent; 
  39.       end record; 
  40.  
  41.    function Max (L, R : Axis_Aligned_Bounding_Box) return Axis_Aligned_Bounding_Box; 
  42.  
  43.    type Bounds_record is   -- tbd : better name . .. 'type Bounds' conflicts with 'Bounds' trait function. . .. sphere_box_Bounds ? 
  44.       record 
  45.          Sphere_Radius  : GL.Double; 
  46.          Box            : Axis_Aligned_Bounding_Box; 
  47.       end record; 
  48.  
  49.    null_Bounds  : constant Bounds_record := (Sphere_Radius => 0.0, 
  50.                                              Box           => (X_Extent => (Min => GL.Double'Last, 
  51.                                                                             Max => GL.Double'First), 
  52.                                                                Y_Extent => (Min => GL.Double'Last, 
  53.                                                                             Max => GL.Double'First), 
  54.                                                                Z_Extent => (Min => GL.Double'Last, 
  55.                                                                             Max => GL.Double'First))); 
  56.  
  57.    function Max (L, R : Bounds_record) return Bounds_record; 
  58.  
  59.    -- vertices 
  60.    -- 
  61.  
  62.    -- vertex Id (an index into a vertex_Array) 
  63.    -- 
  64.  
  65.    type   vertex_Id       is new GL.Uint; 
  66.    type p_vertex_Id       is access all vertex_Id; 
  67.  
  68.    type   vertex_Id_array is array (GL.positive_uInt range <>) of aliased vertex_Id; 
  69.    type p_vertex_Id_array is access all vertex_Id_array; 
  70.  
  71.    function to_gl_Pointer is new Ada.Unchecked_Conversion (p_vertex_Id, GL.pointer); 
  72.  
  73.    procedure Increment (Self  : in out vertex_Id_array); 
  74.    procedure Decrement (Self  : in out vertex_Id_array); 
  75.  
  76.    function  to_void_Pointer is new Ada.Unchecked_Conversion   (p_vertex_Id,     GL.pointer); 
  77.    procedure free            is new Ada.Unchecked_Deallocation (vertex_Id_array, p_vertex_Id_array); 
  78.  
  79.    subtype Positive_Vertex_Id is vertex_Id range 1 .. vertex_Id'Last; 
  80.  
  81.    -- vertex 
  82.    -- 
  83.  
  84.    subtype GL_Vertex       is GL.Double_Vector_3D;                             -- tbd : can GL.Double_vector_3D use '1'- based indexing ? 
  85.    type    GL_Vertex_array is array (Positive_Vertex_Id range <>) of aliased GL_Vertex; 
  86.    type  p_Vertex_array is access all GL_Vertex_array; 
  87.  
  88.    package vertex_pointers is new interfaces.C.Pointers (Positive_Vertex_Id, GL_Vertex, GL_Vertex_array, (others => GL.Double'Last)); 
  89.    subtype p_Vertex is vertex_pointers.Pointer; 
  90.  
  91.    function to_p_Vertex is new Ada.Unchecked_Conversion (GL.pointer, p_Vertex); 
  92.    function Image (Self : GL_Vertex) return String; 
  93.  
  94.    null_Vertex  : constant GL_Vertex := (GL.Double'Last, GL.Double'Last, GL.Double'Last); -- tbd : use NAN instead of 'Last ? 
  95.  
  96.    procedure free is new Ada.Unchecked_Deallocation (GL_Vertex_array, p_Vertex_array); 
  97.  
  98.    function Bounds (Self : GL_Vertex_array) return GL.Geometry.Bounds_record; 
  99.    function Image  (Self : GL_Vertex_array) return String; 
  100.  
  101.    function Bounds (Given_Vertices : GL_Vertex_array; Given_Indices : vertex_Id_array) return GL.Geometry.Bounds_record; 
  102.  
  103.    -- lighting normals 
  104.    -- 
  105.  
  106.    subtype GL_Normal            is GL.Double_Vector_3D; 
  107.    type    GL_Normals           is array (Positive           range <>) of aliased GL_Normal; 
  108.    type    GL_Normals_Vertex_Id is array (Positive_Vertex_Id range <>) of aliased GL_Normal;  -- tbd : rename vertex_Normal_array 
  109.  
  110.    -- abstract base geometry class 
  111.    -- 
  112.  
  113.    type Geometry_t is abstract tagged 
  114.       record 
  115.          Bounds  : Bounds_record; 
  116.       end record; 
  117.  
  118.    type p_Geometry is access all Geometry_t'Class; 
  119.  
  120.    function  primitive_Id   (Self : Geometry_t) return GL.ObjectTypeEnm             is abstract; 
  121.  
  122.    function  vertex_Count   (Self : Geometry_t) return GL.Geometry.vertex_Id        is abstract; 
  123.    function  Vertices       (Self : Geometry_t) return GL.Geometry.GL_Vertex_array  is abstract; 
  124.  
  125.    function  indices_Count  (Self : Geometry_t) return GL.positive_uInt             is abstract; 
  126.    function  Indices        (Self : Geometry_t) return GL.Geometry.vertex_Id_array  is abstract; 
  127.  
  128.    function  Bounds         (Self : Geometry_t) return GL.Geometry.Bounds_record    is abstract; 
  129.  
  130.    function  Face_Count     (Self : Geometry_t'Class) return Natural; 
  131.    -- 
  132.    -- for point primitives, each point is considered a 'face'. 
  133.    -- for line  primitives, each line  is considered a 'face'. 
  134.  
  135.    procedure Draw           (Self : Geometry_t)                                     is abstract; 
  136.  
  137.    function  Vertex_Normals (Self : Geometry_t'Class) return GL_Normals_Vertex_Id; 
  138.  
  139.    procedure destroy (Self : in out Geometry_t)                                     is abstract; 
  140.    procedure Free    (Self : in out p_Geometry); 
  141.  
  142. end GL.Geometry;