lace_opengl_0.1.0_672a6415/source/lean/renderer/opengl-renderer-lean.adb

with
     openGL.Viewport,
     openGL.Program,
     openGL.Camera,
     openGL.Palette,
     openGL.Model.billboard.textured,
     openGL.Geometry.        lit_textured_skinned,
     openGL.Geometry.lit_colored_textured_skinned,
     openGL.Font.texture,
     openGL.Server,
     openGL.Tasks,
     openGL.IO,
     openGL.Errors,

     GL.Binding,
     GL.lean,

     Interfaces.C,
     gnat.heap_Sort,
     System,

     ada.Text_IO,
     ada.Exceptions,
     ada.Task_Identification,
     ada.unchecked_Deallocation;


package body openGL.Renderer.lean
is
   use GL,
       Program,
       Interfaces.C,
       ada.Text_IO;

   ---------
   --- Forge
   --

   procedure define (Self : access Item)
   is
   begin
      Self.safe_Camera_updates_Map.define;
   end define;



   procedure destroy (Self : in out Item)
   is
      use Texture;
   begin
      Self.stop_Engine;

      while not Self.Engine'Terminated
      loop
         delay Duration'Small;
      end loop;

      Self.safe_Camera_updates_Map.destruct;

      declare
         procedure free is new ada.unchecked_Deallocation (visual_geometry_Couples,
                                                           visual_geometry_Couples_view);
      begin
         free (Self.all_opaque_Couples);
         free (Self.all_lucid_Couples);
      end;

      vacuum  (Self.texture_Pool);
      destroy (Self.texture_Pool);
   end destroy;



   procedure free (Self : in out View)
   is
      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
   begin
      Self.destroy;
      deallocate (Self);
   end free;


   --------------
   --- Attributes
   --

   procedure Context_is (Self : in out Item;   Now : in Context.view)
   is
   begin
      Self.Context := Now;
   end Context_is;


   procedure Context_Setter_is (Self : in out Item;   Now : in context_Setter)
   is
   begin
      Self.context_Setter := Now;
   end Context_Setter_is;


   procedure Swapper_is (Self : in out Item;   Now : in Swapper)
   is
   begin
      Self.Swapper := Now;
   end Swapper_is;



   procedure queue_Impostor_updates (Self : in out Item;    the_Updates : in     impostor_Updates;
                                                            the_Camera  : access Camera.item'Class)
   is
   begin
      Self.safe_Camera_updates_Map.add (the_Updates,
                                        Camera_view (the_Camera));
   end queue_Impostor_updates;



   procedure queue_Visuals (Self : in out Item;    the_Visuals : in     Visual.views;
                                                   the_Camera  : access Camera.item'Class)
   is
   begin
      Self.safe_Camera_updates_Map.add (the_Visuals,
                                        Camera_view (the_Camera));
   end queue_Visuals;



   procedure update_Impostors_and_draw_Visuals (Self : in out Item;   all_Updates : in camera_updates_Couples)
   is
   begin
      for i in all_Updates'Range
      loop
         declare
            the_Camera  : constant Camera_view             := all_Updates (i).Camera;
            the_Updates : constant updates_for_Camera_view := all_Updates (i).Updates;
         begin
            Viewport.Extent_is ((the_Camera.Viewport.Max (1),
                                 the_Camera.Viewport.Max (2)));

            Self.update_Impostors (the_Updates.impostor_Updates (1 .. the_Updates.impostor_updates_Last),
                                   camera_world_Transform => the_Camera.World_Transform,
                                   view_Transform         => the_Camera.view_Transform,
                                   perspective_Transform  => the_Camera.projection_Transform);

            the_Updates.impostor_updates_Last := 0;
         end;
      end loop;

      Self.swap_Required := False;

      for i in all_Updates'Range
      loop
         declare
            the_Camera  : constant Camera_view             := all_Updates (i).Camera;
            the_Updates : constant updates_for_Camera_view := all_Updates (i).Updates;
            clear_Frame : constant Boolean                 := i = all_Updates'First;
         begin
            Viewport.Extent_is ((the_Camera.Viewport.Max (1),
                                 the_Camera.Viewport.Max (2)));

            Self.draw (the_Visuals            => the_Updates.Visuals (1 .. the_Updates.visuals_Last),
                       camera_world_Transform => the_Camera.World_Transform,
                       view_Transform         => the_Camera.view_Transform,
                       perspective_Transform  => the_Camera.projection_Transform,
                       clear_Frame            => clear_Frame,
                       to_Surface             => null);

            the_Updates.visuals_Last := 0;
            Self.swap_Required       := True;
         end;
      end loop;
   end update_Impostors_and_draw_Visuals;



   procedure free_old_Models (Self : in out Item)
   is
      use Model;

      free_Models : graphics_Models;
      Last        : Natural;
   begin
      Self.obsolete_Models.fetch (free_Models, Last);

      for i in 1 .. Last
      loop
         free (free_Models (i));
      end loop;
   end free_old_Models;



   procedure free_old_Impostors (Self : in out Item)
   is
      use Impostor;

      free_Impostors : Impostor_Set;
      Last           : Natural;
   begin
      Self.obsolete_Impostors.fetch (free_Impostors, Last);

      for i in 1 .. Last
      loop
         free (free_Impostors (i));
      end loop;
   end free_old_Impostors;


   ---------
   -- Engine
   --

   task body Engine
   is
      the_Context : Context.view with unreferenced;
      Done        : Boolean := False;

   begin
      select
         accept start (Context : openGL.Context.view)
         do
            the_Context := Context;     -- TODO: This is not used.
         end start;

         openGL.Tasks.Renderer_Task := ada.Task_Identification.current_Task;
         Self.context_Setter.all;

         put_Line ("openGL Server version: " & Server.Version);

      or
         accept Stop
         do
            Done := True;
         end Stop;
      end select;

      openGL.Geometry.        lit_textured_skinned.define_Program;
      openGL.Geometry.lit_colored_textured_skinned.define_Program;


      while not Done
      loop
         declare
            all_Updates        : camera_updates_Couples (1 .. 100);     -- Caters for 100 cameras.
            Length             : Natural;

            new_font_Name      : asset_Name := null_Asset;
            new_font_Size      : Integer;

            new_snapshot_Name  : asset_Name := null_Asset;
            snapshot_has_Alpha : Boolean;

         begin
            select
               accept render
               do
                  Self.is_Busy := True;
                  Self.safe_Camera_updates_Map.fetch_all_Updates (all_Updates, Length);
               end render;

            or accept add_Font (font_Id : in Font.font_Id)
               do
                  new_font_Name := font_Id.Name;
                  new_font_Size := font_Id.Size;
               end add_Font;

            or accept Screenshot (Filename   : in String;
                                  with_Alpha : in Boolean := False)
               do
                  new_snapshot_Name  := to_Asset (Filename);
                  snapshot_has_Alpha := with_Alpha;
               end Screenshot;

            or accept Stop
               do
                  Done := True;
               end Stop;
            end select;

            exit when Done;


            if new_font_Name /= null_Asset
            then
               Self.Fonts.insert ((new_font_Name,
                                   new_font_Size),
                                   Font.texture.new_Font_texture (to_String (new_font_Name)).all'Access);

            elsif new_snapshot_Name /= null_Asset
            then
               IO.Screenshot (Filename   => to_String (new_snapshot_Name),
                              with_Alpha => snapshot_has_Alpha);
            else
               Self.update_Impostors_and_draw_Visuals (all_Updates (1 .. Length));

               Self.free_old_Models;
               Self.free_old_Impostors;

               Self.is_Busy := False;

               if    Self.Swapper /= null
                 and Self.swap_Required
               then
                  Self.Swapper.all;
               end if;
            end if;
         end;
      end loop;

      Self.free_old_Models;
      Self.free_old_Impostors;

      -- Free any fonts.
      --
      while not Self.Fonts.is_Empty
      loop
         declare
            use Font,
                Font.font_id_Maps_of_font;
            the_Cursor : Cursor    := Self.Fonts.First;
            the_Font   : Font.view := Element (the_Cursor);
         begin
            free (the_Font);
            Self.Fonts.delete (the_Cursor);
         end;
      end loop;

   exception
      when E : others =>
         new_Line;
         put_Line ("Unhandled exception in openGL Renderer engine !");
         put_Line (ada.Exceptions.Exception_Information (E));
   end Engine;


   --------------
   --- Operations
   --

   procedure start_Engine (Self : in out Item)
   is
   begin
      Self.Engine.start (null);
   end start_Engine;


   procedure stop_Engine (Self : in out Item)
   is
   begin
      Self.Engine.stop;
   end stop_Engine;



   procedure render (Self : in out Item;   to_Surface : in Surface.view := null)
   is
      pragma unreferenced (to_Surface);
   begin
      Self.Engine.render;
   end render;


   procedure add_Font (Self : in out Item;   font_Id : in Font.font_Id)
   is
   begin
      Self.Engine.add_Font (font_Id);
   end add_Font;



   procedure Screenshot (Self : in out Item;   Filename   : in String;
                                               with_Alpha : in Boolean := False)
   is
   begin
      Self.Engine.Screenshot (Filename, with_Alpha);
   end Screenshot;



   function is_Busy (Self : in Item) return Boolean
   is
   begin
      return Self.is_Busy;
   end is_Busy;



   procedure update_Impostors (Self : in out Item;   the_Updates            : in impostor_Updates;
                                                     camera_world_Transform : in Matrix_4x4;
                                                     view_Transform         : in Matrix_4x4;
                                                     perspective_Transform  : in Matrix_4x4)
   is
      use linear_Algebra_3D;

      light_Site : constant Vector_3 := (10_000.0, -10_000.0, 10_000.0);
      the_Light  : openGL.Light.item;

   begin
      Tasks.check;

      the_Light. Site_is (light_Site);
      the_Light.Color_is (Palette.White);

      for i in the_Updates'Range
      loop
         declare
            use Texture,
                Visual,
                GL.Binding;

            the_Update     : impostor_Update renames the_Updates (i);
            the_Impostor   : Impostor.view   renames the_Update.Impostor;

            texture_Width  : constant gl.glSizei := power_of_2_Ceiling (Natural (the_Update.current_Width_pixels ));
            texture_Height : constant gl.glSizei := power_of_2_Ceiling (Natural (the_Update.current_Height_pixels));

            the_Model      : constant openGL.Model.billboard.textured.view
                                                 := openGL.Model.billboard.textured.view (the_Impostor.Visual.Model);
         begin
            the_Impostor.Visual.Scale_is         (the_Impostor.Target.Scale);
            the_Impostor.Visual.is_Terrain       (the_Impostor.Target.is_Terrain);
            the_Impostor.Visual.face_Count_is    (the_Impostor.Target.face_Count);
            the_Impostor.Visual.apparent_Size_is (the_Impostor.Target.apparent_Size);

            -- Render the target after clearing openGL buffers.
            --
            glClearColor (0.0, 0.0, 0.0,  0.0);
            glClear      (   GL_COLOR_BUFFER_BIT
                          or GL_DEPTH_BUFFER_BIT);

            declare
               new_view_Transform : Matrix_4x4 := camera_world_Transform;
            begin
               set_Rotation (new_view_Transform, the_Update.current_Camera_look_at_Rotation);
               new_view_Transform := inverse_Transform (new_view_Transform);

               -- Render the target for subsequent copy to impostor texture.
               --
               Self.draw (the_Visuals            => (1 => the_Impostor.Target),
                          camera_world_Transform => camera_world_Transform,
                          view_Transform         => new_view_Transform,
                          perspective_Transform  => perspective_Transform,
                          clear_Frame            => False,
                          to_Surface             => null);
            end;

            -- Get a new sized texture, if needed.
            --
            if        Natural (the_Update.current_Width_pixels)  /= the_Model.Texture.Size.Width
              or else Natural (the_Update.current_Height_pixels) /= the_Model.Texture.Size.Height
            then
               free (Self.texture_Pool, the_Model.Texture);
               the_Model.Texture_is (new_Texture (From => Self.texture_Pool'Access,
                                                  Size => (Natural (texture_Width),
                                                           Natural (texture_Height))));
            end if;

            -- Set texture coordinates.
            --
            declare
               X_first : constant Real := the_Impostor.expand_X;
               Y_first : constant Real := the_Impostor.expand_Y;
               X_last  : constant Real := Real (the_Update.current_Width_pixels)  / Real (texture_Width)  - X_First;
               Y_last  : constant Real := Real (the_Update.current_Height_pixels) / Real (texture_Height) - Y_First;
            begin
               the_Model.Texture_Coords_are ((1 => (S => X_first, T => Y_first),
                                              2 => (S => X_last,  T => Y_first),
                                              3 => (S => X_last,  T => Y_last),
                                              4 => (S => X_first, T => Y_last)));
            end;

            the_Model.Texture.enable;

            GL.lean.glCopyTexSubImage2D (gl.GL_TEXTURE_2D,                 0,
                                         the_Update.current_copy_x_Offset, the_Update.current_copy_y_Offset,
                                         the_Update.current_copy_X,        the_Update.current_copy_Y,
                                         the_Update.current_copy_Width,    the_Update.current_copy_Height);
            Errors.log;
         end;
      end loop;

      Errors.log;
   end update_Impostors;



   procedure draw (Self : in out Item;   the_Visuals            : in Visual.views;
                                         camera_world_Transform : in Matrix_4x4;
                                         view_Transform         : in Matrix_4x4;
                                         perspective_Transform  : in Matrix_4x4;
                                         clear_Frame            : in Boolean;
                                         to_Surface             : in Surface.view := null)
   is
      pragma unreferenced (to_Surface);

      use linear_Algebra_3D;

      opaque_Count : math.Index := 0;
      lucid_Count  : math.Index := 0;

      view_and_perspective_Transform : constant Matrix_4x4 := view_Transform * perspective_Transform;


      function get_on_Lights return openGL.Light.items
      is
         all_Lights : constant openGL.Light.items := Self.Lights.fetch;
         lit_Lights :          openGL.Light.items (all_Lights'Range);
         Count      :          Natural            := 0;
      begin
         for i in all_Lights'Range
         loop
            if all_Lights (i).is_On
            then
               Count              := Count + 1;
               lit_Lights (Count) := all_Lights (i);
            end if;
         end loop;

         return lit_Lights (1 .. Count);
      end get_on_Lights;

      Lights : constant openGL.Light.items := get_on_Lights;

   begin
      Tasks.check;

      if clear_Frame then
         Self.clear_Frame;
      end if;

      ---------------------
      --- Draw the visuals.
      --

      --  Collect opaque geometry (for state sorting) and collect lucid geometry (for depth sorting).
      --
      for Each in the_Visuals'Range
      loop
         declare
            use type Model.view,
                     Model.access_Geometry_views;

            the_Visual : Visual.view renames the_Visuals (Each);

         begin
            if    the_Visual.Model.needs_Rebuild
               or (    the_Visual.Model.opaque_Geometries = null
                   and the_Visual.Model. lucid_Geometries = null)
            then
               the_Visual.Model.create_GL_Geometries (Self.Textures'Access, Self.Fonts);

            elsif the_Visual.Model.is_Modified
            then
               the_Visual.Model.modify;
            end if;

            declare
               opaque_Geometries : Model.access_Geometry_views renames the_Visual.Model.opaque_Geometries;
               lucid_Geometries  : Model.access_Geometry_views renames the_Visual.Model. lucid_Geometries;
            begin
               the_Visual.mvp_Transform_is (the_Visual.Transform * view_and_perspective_Transform);

               if opaque_Geometries /= null
               then
                  for i in opaque_Geometries'Range
                  loop
                     opaque_Count                           := opaque_Count + 1;
                     Self.all_opaque_Couples (opaque_Count) := (visual   => the_Visual,
                                                                Geometry => opaque_Geometries (i));
                  end loop;
               end if;

               if lucid_Geometries /= null
               then
                  for i in lucid_Geometries'Range
                  loop
                     lucid_Count                          := lucid_Count + 1;
                     Self.all_lucid_Couples (lucid_Count) := (visual   => the_Visual,
                                                              Geometry => lucid_Geometries (i));
                  end loop;
               end if;

            end;
         end;
      end loop;

      Errors.log;

      --  State sort opaque geometries and render them.
      --
      declare
         use GL.Binding;

         procedure Heap_swap (Left, Right : in Natural)
         is
            Pad : constant visual_geometry_Couple := Self.all_opaque_Couples (Left);
         begin
            Self.all_opaque_Couples (Left)  := Self.all_opaque_Couples (Right);
            Self.all_opaque_Couples (Right) := Pad;
         end Heap_swap;


         function Heap_less_than (Left, Right : in Natural) return Boolean
         is
            use System;
            L_Geometry : openGL.Geometry.view renames Self.all_opaque_Couples (Left) .Geometry;
            R_Geometry : openGL.Geometry.view renames Self.all_opaque_Couples (Right).Geometry;
         begin
            if L_Geometry.Program.gl_Program = R_Geometry.Program.gl_Program
            then
               return L_Geometry.all'Address < R_Geometry.all'Address;
            end if;

            return L_Geometry.Program.gl_Program < R_Geometry.Program.gl_Program;
         end Heap_less_than;

         the_Couple      : visual_geometry_Couple;
         current_Program : openGL.Program.view;

      begin
         if opaque_Count > 1
         then
            gnat.heap_Sort.sort (opaque_Count,
                                 Heap_swap     'unrestricted_Access,
                                 Heap_less_than'unrestricted_Access);
         end if;

         glDisable   (GL_BLEND);
         glEnable    (GL_DEPTH_TEST);
         glDepthMask (gl_TRUE);           -- Make depth buffer read/write.

         for Each in 1 .. opaque_Count
         loop
            the_Couple := Self.all_opaque_Couples (Each);

            if the_Couple.Geometry.Program /= current_Program
            then
               current_Program := the_Couple.Geometry.Program;
            end if;

            current_Program.enable;                                               -- TODO: Only need to do this when program changes ?
            current_Program.mvp_Transform_is (the_Couple.Visual.mvp_Transform);
            current_Program.model_Matrix_is  (the_Couple.Visual.Transform);
            current_Program.camera_Site_is   (get_Translation (camera_world_Transform));
            current_Program.Lights_are       (Lights);
            current_Program.Scale_is         (the_Couple.Visual.Scale);

            if the_Couple.Visual.program_Parameters /= null then
               the_Couple.Visual.program_Parameters.enable;
            end if;

            the_Couple.Geometry.render;
         end loop;
      end;

      Errors.log;

      --  Depth sort lucid geometries and render them.
      --
      declare
         use GL.Binding;

         procedure Heap_swap (Left, Right : in Natural)
         is
            Pad : constant visual_geometry_Couple := Self.all_lucid_Couples (Left);
         begin
            Self.all_lucid_Couples (Left)  := Self.all_lucid_Couples (Right);
            Self.all_lucid_Couples (Right) := Pad;
         end Heap_swap;


         function Heap_less_than (Left, Right : in Natural) return Boolean
         is
         begin
            return   Self.all_lucid_Couples (Left) .Visual.Transform (4, 3)   -- Depth_in_camera_space   -- NB: In camera space, negative Z is
                   < Self.all_lucid_Couples (Right).Visual.Transform (4, 3);  --                                forward, so use '<'.
         end Heap_less_than;

         the_Couple      : visual_geometry_Couple;
         current_Program : openGL.Program.view;

      begin
         if lucid_Count > 1
         then
            gnat.heap_Sort.sort (lucid_Count,
                                 Heap_swap     'unrestricted_Access,
                                 Heap_less_than'unrestricted_Access);
         end if;

         glDepthMask  (gl_False);     -- Make depth buffer read-only, for correct transparency.

         glEnable     (GL_BLEND);
         gl.lean.glBlendEquation (gl.lean.GL_FUNC_ADD);

         glBlendFunc (GL_SRC_ALPHA,
                      GL_ONE_MINUS_SRC_ALPHA);

         for Each in 1 .. lucid_Count
         loop
            the_Couple := Self.all_lucid_Couples (Each);

            current_Program := the_Couple.Geometry.Program;     -- TODO: Only do this when program changes (as is done above with opaques) ?
            current_Program.enable;
            current_Program.mvp_Transform_is (the_Couple.Visual.mvp_Transform);
            current_Program.camera_Site_is   (get_Translation (camera_world_Transform));
            current_Program.model_Matrix_is  (the_Couple.Visual.Transform);
            current_Program.Lights_are       (Lights);
            current_Program.Scale_is         (the_Couple.Visual.Scale);

            if the_Couple.Visual.program_Parameters /= null then
               the_Couple.Visual.program_Parameters.enable;
            end if;

            the_Couple.Geometry.render;
         end loop;

         glDepthMask (gl_True);
      end;

      Errors.log;
   end draw;



   -----------------------------
   -- safe_camera_Map_of_updates
   --

   protected
   body safe_camera_Map_of_updates
   is
      procedure define
      is
      begin
         current_Map := Map_1'Unchecked_Access;
      end define;


      procedure destruct
      is
         use camera_Maps_of_updates;
         procedure deallocate is new ada.unchecked_Deallocation (updates_for_Camera,
                                                                 updates_for_Camera_view);

         the_Updates : updates_for_Camera_view;
         Cursor      : camera_Maps_of_updates.Cursor := Map_1.First;

      begin
         while has_Element (Cursor)
         loop
            the_Updates := Element (Cursor);
            deallocate (the_Updates);

            next (Cursor);
         end loop;

         Cursor := Map_2.First;

         while has_Element (Cursor)
         loop
            the_Updates := Element (Cursor);
            deallocate (the_Updates);

            next (Cursor);
         end loop;

         current_Map := null;
      end destruct;


      procedure add (the_Updates : in impostor_Updates;
                     the_Camera  : in Camera_view)
      is
         the_camera_Updates : updates_for_Camera_view;
         our_Camera         : constant Camera_view   := the_Camera;

      begin
         begin
            the_camera_Updates := current_Map.Element (our_Camera);
         exception
            when constraint_Error =>     -- No element exists for this camera yet.
               the_camera_Updates := new updates_for_Camera;
               current_Map.insert (our_Camera, the_camera_Updates);
         end;

         declare
            First : constant Integer := the_camera_Updates.impostor_updates_Last + 1;
            Last  : constant Integer := the_camera_Updates.impostor_updates_Last + the_Updates'Length;
         begin
            the_camera_Updates.Impostor_updates (First .. Last) := the_Updates;
            the_camera_Updates.impostor_updates_Last            := Last;
         end;
      end add;


      procedure add (the_Visuals : in Visual.views;
                     the_Camera  : in Camera_view)
      is
         the_camera_Updates : updates_for_Camera_view;
         our_Camera         : constant Camera_view   := the_Camera;

      begin
         begin
            the_camera_Updates := current_Map.Element (our_Camera);
         exception
            when constraint_Error =>     -- No element exists for this camera yet.
               the_camera_Updates := new updates_for_Camera;
               current_Map.Insert (our_Camera, the_camera_Updates);
         end;

         declare
            First : constant Integer := the_camera_Updates.visuals_Last + 1;
            Last  : constant Integer := the_camera_Updates.visuals_Last + the_Visuals'Length;
         begin
            the_camera_Updates.Visuals (First .. Last) := the_Visuals;
            the_camera_Updates.visuals_Last            := Last;
         end;
      end add;


      procedure fetch_all_Updates (the_Updates : out camera_updates_Couples;
                                   Length      : out Natural)
      is
         use camera_Maps_of_updates;

         the_Couples : camera_updates_Couples (1 .. Integer (current_Map.Length));
         Cursor      : camera_Maps_of_updates.Cursor := current_Map.First;

      begin
         for i in the_Couples'Range
         loop
            the_Couples (i).Camera  := Key     (Cursor);
            the_Couples (i).Updates := Element (Cursor);

            next (Cursor);
         end loop;

         if current_Map = Map_1'unrestricted_Access
         then   current_Map := Map_2'unchecked_Access;
         else   current_Map := Map_1'unchecked_Access;
         end if;

         the_Updates (1 .. the_Couples'Length) := the_Couples;
         Length                                := the_Couples'Length;
      end fetch_all_Updates;

   end safe_camera_Map_of_updates;



   --------------
   -- safe_Models
   --

   protected
   body safe_Models
   is
      procedure add (the_Model : in Model.view)
      is
      begin
         my_Count             := my_Count + 1;
         my_Models (my_Count) := the_Model;
      end add;

      procedure fetch (the_Models : out graphics_Models;
                       Count      : out Natural)
      is
      begin
         the_Models (1 .. my_Count) := my_Models (1 .. my_Count);
         Count                      := my_Count;
         my_Count                   := 0;
      end fetch;
   end safe_Models;



   procedure free (Self : in out Item;   the_Model : in Model.view)
   is
   begin
      Self.obsolete_Models.add (the_Model);
   end free;


   -----------------
   -- safe_Impostors
   --

   protected
   body safe_Impostors
   is
      procedure add (the_Impostor : in Impostor.view)
      is
      begin
         the_Count                 := the_Count + 1;
         the_Impostors (the_Count) := the_Impostor;
      end add;

      procedure fetch (Impostors : out Impostor_Set;
                       Count     : out Natural)
      is
      begin
         Impostors (1 .. the_Count) := the_Impostors (1 .. the_Count);
         Count                      := the_Count;
         the_Count                  := 0;
      end fetch;
   end safe_Impostors;



   procedure free (Self : in out Item;   the_Impostor : in Impostor.view)
   is
   begin
      Self.obsolete_Impostors.add (the_Impostor);
   end free;


   ---------
   -- Lights
   --

   function Hash (Id : in openGL.Light.Id_t) return ada.Containers.Hash_type
   is
   begin
      return ada.Containers.Hash_type (Id);
   end Hash;


   protected
   body safe_Lights
   is
      procedure add (Light : in openGL.Light.item)
      is
      begin
         the_Lights.insert (Light.Id,
                            Light);
      end add;


      procedure set (Light : in openGL.Light.item)
      is
      begin
         the_Lights.replace (Light.Id,
                             Light);
      end set;


      procedure rid (Light : in openGL.Light.item)
      is
      begin
         the_Lights.delete (Light.Id);
      end rid;


      function get (Id : in openGL.Light.Id_t) return openGL.Light.item
      is
      begin
         return the_Lights.Element (Id);
      end get;


      function fetch return openGL.Light.items
      is
         all_Lights : openGL.Light.items (1 .. Natural (the_Lights.Length));
         i          : Natural := 0;
      begin
         for Each of the_Lights
         loop
            i              := i + 1;
            all_Lights (i) := Each;
         end loop;

         return all_Lights;
      end fetch;

   end safe_Lights;



   function new_Light (Self : in out Item) return openGL.Light.item
   is
      the_Light : openGL.Light.item;
   begin
      Self.prior_Light_Id := Self.prior_Light_Id + 1;
      the_Light.Id_is (Self.prior_Light_Id);
      Self.Lights.add (the_Light);

      return the_Light;
   end new_Light;


   procedure set (Self : in out Item;   the_Light : in openGL.Light.item)
   is
   begin
      Self.Lights.set (the_Light);
   end set;


   procedure rid (Self : in out Item;   the_Light : in openGL.Light.item)
   is
   begin
      Self.Lights.rid (the_Light);
   end rid;


   function Light (Self : in out Item;   Id : in openGL.light.Id_t) return openGL.Light.item
   is
   begin
      return Self.Lights.get (Id);
   end Light;


   function fetch (Self : in out Item) return openGL.Light.items
   is
   begin
      return Self.Lights.fetch;
   end fetch;


end openGL.Renderer.lean;