Add initial prototype.

3-mid/opengl/source/lean/renderer/opengl-culler-frustum.adb

@@ -0,0 +1,129 @@
+with
+     openGL.Frustum;
+
+package body openGL.Culler.frustum
+is
+   ---------
+   --- Forge
+   --
+
+   procedure define (Self : in out Item)
+   is
+   begin
+      Self.vanish_point_size_Min.Value_is (0.00_12);
+   end define;
+
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   procedure add (Self : in out Item;   the_Visual : in Visual.view)
+   is
+   begin
+      null;
+   end add;
+
+
+   overriding
+   procedure rid (Self : in out Item;   the_Visual : in Visual.view)
+   is
+   begin
+      null;
+   end rid;
+
+
+
+   overriding
+   function object_Count (Self : in Item) return Natural
+   is
+      pragma unreferenced (Self);
+   begin
+      return 0;
+   end object_Count;
+
+
+
+   function vanish_point_size_Min (Self : in Item'Class) return Real
+   is
+   begin
+      return Self.vanish_point_size_Min.Value;
+   end vanish_point_size_Min;
+
+
+   procedure vanish_point_size_Min_is (Self : in out Item'Class;   Now : in Real)
+   is
+   begin
+      Self.vanish_point_size_Min.Value_is (Now);
+   end vanish_point_size_Min_is;
+
+
+
+   overriding
+   function cull (Self : in Item;   the_Visuals    : in Visual.views;
+                                    camera_Frustum : in openGL.frustum.Plane_array;
+                                    camera_Site    : in Vector_3) return Visual.views
+   is
+      visible_Objects : Visual.views (the_Visuals'Range);
+      Last            : Natural := 0;
+
+      the_Object      : Visual.view;
+
+      the_vanish_point_size_Min : constant Real := Self.vanish_point_size_Min.Value;
+
+   begin
+      -- Apply 'frustum' and 'apparent size' culling.
+      --
+      for i in the_Visuals'Range
+      loop
+         the_Object := the_Visuals (i);
+
+         declare
+            use openGL.Frustum,
+                Visual;
+
+            the_Size      : constant Real := the_Object.Model.Bounds.Ball;
+            the_Distance  : constant Real := abs (camera_Site - Site_of (the_Object.all));
+            apparent_Size :          Real;
+
+
+            function is_visible_for_Plane (Which : in openGL.frustum.plane_Id) return Boolean
+            is
+               the_Site       : Vector_3 renames Site_of (the_Object.all);
+               plane_Distance : constant Real :=   camera_Frustum (Which) (1) * the_Site (1)
+                                                 + camera_Frustum (Which) (2) * the_Site (2)
+                                                 + camera_Frustum (Which) (3) * the_Site (3)
+                                                 + camera_Frustum (Which) (4);
+            begin
+               return plane_Distance + the_Size > 0.0;
+            end is_visible_for_plane;
+
+         begin
+            if    the_Distance /= 0.0        -- The visual is on same site as camera.
+              and the_Size     /= 0.0        -- The visual bounds are known.
+            then
+               apparent_Size := the_Size / the_Distance;
+            else
+               apparent_Size := Real'Last;
+            end if;
+
+            if    apparent_Size > the_vanish_point_size_Min
+              and is_visible_for_Plane (Left)
+              and is_visible_for_Plane (Right)
+              and is_visible_for_Plane (High)
+              and is_visible_for_Plane (Low)
+            then
+               Last                   := Last + 1;
+               visible_Objects (Last) := the_Object;
+               the_Object.apparent_Size_is (apparent_Size);
+            end if;
+         end;
+      end loop;
+
+      return visible_Objects (1 .. Last);
+   end cull;
+
+
+end openGL.Culler.frustum;