with
     gel.Events,

     physics.Object,
     physics.Forge,

     openGL.Renderer.lean,

     lace.Response,
     lace.Text.Forge,

     ada.Text_IO,
     ada.Exceptions,
     ada.unchecked_Deallocation,
     ada.Containers.hashed_Sets;


package body gel.World
is
   use gel.Sprite,
       linear_Algebra_3D,

       --  lace.Event,

       ada.Exceptions,
       ada.Text_IO;


   procedure log (Message : in String) renames ada.Text_IO.put_Line;


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

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

   procedure free is new ada.unchecked_Deallocation (lace.Any.limited_item'Class, Any_limited_view);


   procedure define (Self : in out Item'Class;   Name       : in     String;
                                                 Id         : in     world_Id;
                                                 space_Kind : in     physics.space_Kind;
                                                 Renderer   : access openGL.Renderer.lean.item'Class);

   overriding
   procedure destroy (Self : in out Item)
   is
   begin
      --  Free record components.
      --
      physics.Space.free (Self.physics_Space);

      lace.Subject_and_deferred_Observer.item (Self).destroy;     -- Destroy base class.
      lace.Subject_and_deferred_Observer.free (Self.local_Subject_and_deferred_Observer);
   end destroy;



   function local_Observer (Self : in Item) return lace.Observer.view
   is
   begin
      return lace.Observer.view (Self.local_Subject_and_deferred_Observer);
   end local_Observer;



   function local_Subject (Self : in Item) return lace.Subject.view
   is
   begin
      return lace.Subject.view (Self.local_Subject_and_deferred_Observer);
   end local_Subject;



   function Id (Self : in Item) return world_Id
   is
   begin
      return Self.Id;
   end Id;



   function to_Sprite (the_Pair            : in remote.World.sprite_model_Pair;
                       the_graphics_Models : in id_Maps_of_graphics_model        .Map;
                       the_physics_Models  : in Id_Maps_of_physics_Model.Map;
                       the_World           : in gel.World.view) return gel.Sprite.view
   is
      the_graphics_Model : access openGL .Model.item'Class;
      the_physics_Model  : access physics.Model.item'Class;
      the_Sprite         :        gel.Sprite.view;

      use openGL;
   begin
      log ("gel.world.to_Sprite");

      the_graphics_Model := openGL .Model.view (the_graphics_Models.Element (the_Pair.graphics_Model_Id));
      the_physics_Model  := physics.Model.view ( the_physics_Models.Element (the_Pair. physics_Model_Id));

      the_Sprite := gel.Sprite.forge.new_Sprite ("1Sprite" & the_Pair.sprite_Id'Image,
                                                 sprite.World_view (the_World),
                                                 get_Translation (the_Pair.Transform),
                                                 the_graphics_Model,
                                                 the_physics_Model,
                                                 owns_Graphics => False,
                                                 owns_Physics  => False,
                                                 is_Kinematic  => the_Pair.Mass /= 0.0);

      the_Sprite.Id_is      (Now => the_Pair.sprite_Id);
      the_Sprite.is_Visible (Now => the_Pair.is_Visible);

      the_Sprite.Site_is    (get_Translation (the_Pair.Transform));
      the_Sprite.Spin_is    (get_Rotation    (the_Pair.Transform));

      the_Sprite.desired_Dynamics_are (Site => the_Sprite.Site,
                                       Spin => to_Quaternion (get_Rotation (the_Sprite.Transform)));
      return the_Sprite;
   end to_Sprite;



   --------------------------------
   --- 'create_new_Sprite' Response
   --

   type create_new_Sprite is new lace.Response.item with
      record
         World           :        gel.World.view;
         graphics_Models : access id_Maps_of_graphics_model.Map;
         physics_Models  : access id_Maps_of_physics_model .Map;
      end record;


   overriding
   function Name (Self : in create_new_Sprite) return String;



   overriding
   procedure respond (Self : in out create_new_Sprite;   to_Event : in lace.Event.item'Class)
   is
   begin
      raise Program_Error with "JJJ";
      --  declare
      --     the_Event  : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event);
      --     the_Sprite : constant gel.Sprite.view             := to_Sprite (the_Event.Pair,
      --                                                                     Self.graphics_Models.all,
      --                                                                     Self. physics_Models.all,
      --                                                                     Self.World);
      --  begin
      --     Self.World.add (the_Sprite, and_children => False);
      --  end;
   end respond;



   procedure define (Self : in out create_new_Sprite;    World           : in     gel.World.view;
                                                         graphics_Models : access id_Maps_of_graphics_model.Map)
   is
   begin
      Self.World           := World;
      Self.graphics_Models := graphics_Models;
   end define;



   overriding
   function Name (Self : in create_new_Sprite) return String
   is
      pragma Unreferenced (Self);
   begin
      return "create_new_Sprite";
   end Name;


   ----------
   --- Define
   --

   procedure define (Self : in out Item'Class;   Name       : in     String;
                                                 Id         : in     world_Id;
                                                 space_Kind : in     physics.space_Kind;
                                                 Renderer   : access openGL.Renderer.lean.Item'Class)
   is
      use lace.Subject_and_deferred_Observer.Forge;
   begin
      Self.local_Subject_and_deferred_Observer := new_Subject_and_Observer (name => Name & " world" & Id'Image);

      Self.Id            := Id;
      Self.space_Kind    := space_Kind;
      Self.Renderer      := Renderer;
      Self.physics_Space := physics.Forge.new_Space (space_Kind);
   end define;


   -------------------------
   --- all_sprite_Transforms
   --

   function to_Integer is new ada.unchecked_Conversion (gel.Sprite.view, Integer);


   protected
   body all_sprite_Transforms
   is
      procedure add (the_Sprite : in Sprite.view;
                     Transform  : in Matrix_4x4)
      is
      begin
         sprite_Map_of_transforms.insert (the_Sprite, Transform);
      end add;


      procedure set (To : in sprite_Maps_of_transforms.Map)
      is
      begin
         sprite_Map_of_transforms := To;
      end set;


      function fetch return sprite_Maps_of_transforms.Map
      is
      begin
         return sprite_Map_of_transforms;
      end Fetch;

   end all_sprite_Transforms;


   -----------------
   --- Duration_safe
   --

   protected
   body Duration_safe
   is
      procedure Duration_is (Now : in standard.Duration)
      is
      begin
         the_Duration := Now;
      end Duration_is;

      function Duration return standard.Duration
      is
      begin
         return the_Duration;
      end Duration;

   end Duration_safe;


   --------------------
   --- Breakable Joints
   --

   protected body safe_joint_Set
   is
      function is_Empty return Boolean
      is
      begin
         return the_Count = 0;
      end is_Empty;


      procedure add (the_Joint : in gel.Joint.view)
      is
      begin
         the_Count       := the_Count + 1;
         Set (the_Count) := the_Joint;
      end add;


      procedure fetch (To    : out safe_Joints;
                       Count : out Natural)
      is
      begin
         To (1 .. the_Count) := Set (1 .. the_Count);
         Count               := the_Count;
         the_Count           := 0;
      end Fetch;

   end safe_joint_Set;


   --------------
   --- Collisions
   --

   task
   type impact_Responder
   is
      entry start (the_World      : in gel.World.view;
                   Filter         : in impact_Filter;
                   Response       : in impact_Response;
                   responses_Done : in Signal_Object_view);
      entry stop;
      entry respond;     -- Filter and do responses.
   end impact_Responder;


   type impact_Responder_view is access all impact_Responder;

   procedure free (Self : in out impact_Responder_view)
   is
      procedure deallocate is new ada.unchecked_Deallocation (impact_Responder, impact_Responder_view);
   begin
      deallocate (Self);
   end free;



   type filtered_impact_Response is
      record
         Filter    : impact_Filter;
         Response  : impact_Response;

         Responder : impact_Responder_view;

         responses_Done : signal_Object_view := new Signal_Object;
      end record;

   function Hash (Self : in filtered_impact_Response) return ada.Containers.Hash_type;

   package filtered_impact_Response_Sets is new ada.Containers.hashed_Sets (filtered_impact_Response,
                                                                            Hash,  "=");


   protected body Signal_Object
   is
      entry Wait
        when Open
      is
      begin
         Open := False;
      end Wait;

      procedure Signal
      is
      begin
         Open := True;
      end Signal;
   end Signal_Object;



   function local_graphics_Models (Self : in Item) return id_Maps_of_graphics_model.Map
   is
   begin
      return Self.graphics_Models;
   end local_graphics_Models;



   function local_physics_Models (Self : in Item) return id_Maps_of_physics_model.Map
   is
   begin
      return Self.physics_Models;
   end local_physics_Models;


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

   function space_Kind (Self : in Item) return physics.space_Kind
   is
   begin
      return Self.space_Kind;
   end space_Kind;



   function Space (Self : in Item) return physics.Space.view
   is
   begin
      return Self.physics_Space;
   end Space;



   procedure update_Bounds (Self : in out Item;   of_Sprite : in gel.Sprite.view)
   is
   begin
      null;     -- TODO
      --  Self.physics_Engine.update_Bounds (of_Sprite.Solid);
   end update_Bounds;



   procedure update_Site (Self : in out Item;   of_Sprite : in gel.Sprite.view;   -- TODO: Probably obsolete.
                                                To        : in Vector_3)
   is
   begin
      of_Sprite.Solid.Site_is (To);

      --      Self.physics_Engine.update_Site (of_Sprite.Solid, To);
   end update_Site;



   procedure set_Speed (Self : in out Item;   of_Sprite : in gel.Sprite.view;     -- TODO: Probably obsolete.
                                              To        : in Vector_3)
   is
   begin
      null;
      --  Self.physics_Engine.set_Speed (of_Sprite.Solid, To);
   end set_Speed;



   procedure set_xy_Spin (Self : in out Item;   of_Sprite : in gel.Sprite.view;     -- TODO: Probably obsolete.
                                                To        : in Radians)
   is
   begin
      of_Sprite.Solid.xy_Spin_is (To);

      --  Self.physics_Engine.set_xy_Spin (of_Sprite.Solid, To);
   end set_xy_Spin;



   procedure update_Scale (Self : in out Item;   of_Sprite : in gel.Sprite.view;     -- TODO: Probably obsolete.
                                                 To        : in Vector_3)
   is
   begin
      null;
      --  Self.physics_Engine.update_Scale (of_Sprite.Solid, To);

--        Self.physics_Engine.add (std_Physics.Engine.Command' (Kind   => scale_Object,
--                                                              Sprite => the_Command.Sprite.Solid,
--                                                              Scale  => the_Command.Scale));
   end update_Scale;



   procedure apply_Force (Self : in out Item;   to_Sprite : in gel.Sprite.view;     -- TODO: Probably obsolete.
                                                Force     : in Vector_3)
   is
   begin
      to_Sprite.apply_Force (Force);
      --  Self.physics_Engine.apply_Force (to_Sprite.Solid, Force);
   end apply_Force;



   function Age (Self : in Item) return Duration
   is
   begin
      return Self.Age;
   end Age;



   procedure Age_is (Self : in out Item;   Now : in Duration)
   is
   begin
      Self.Age := Now;
   end Age_is;




   procedure Gravity_is (Self : in out Item;   Now : in Vector_3)
   is
   begin
      Self.physics_Space.Gravity_is (Now);
   end Gravity_is;




   function cast_Ray (Self : in Item;   From, To : in Vector_3) return ray_Collision
   is
      use type physics.Object.view;

      physics_Collision : constant physics.Space.ray_Collision := Self.physics_Space.cast_Ray (From, To);

   begin
      if physics_Collision.near_Object = null
      then
         return ray_Collision' (near_Sprite => null,
                                others      => <>);
      else
         return ray_Collision' (to_GEL (physics_Collision.near_Object),
                                    physics_Collision.hit_Fraction,
                                    physics_Collision.Normal_world,
                                    physics_Collision.  Site_world);
      end if;
   end cast_Ray;




   function cast_Point (Self : in Item;   Point : in Vector_3) return point_Collision
   is
      use type physics.Object.view;

      physics_Collision : constant physics.Space.point_Collision := Self.physics_Space.cast_Point (Point);

   begin
      if physics_Collision.near_Object = null
      then
         return point_Collision' (near_Sprite => null,
                                  others      => <>);
      else
         return point_Collision' (to_GEL (physics_Collision.near_Object),
                                  physics_Collision.Site_world);
      end if;
   end cast_Point;




   --------------
   --- Collisions
   --

   function manifold_Count (Self : in Item) return Natural
   is
   begin
      return Self.manifold_Count;
   end manifold_Count;



   function Manifold (Self : in Item;   Index : in Positive) return a_Manifold
   is
   begin
      return Self.Manifolds (Index);
   end Manifold;



   function Manifolds (Self : in Item) return Manifold_array
   is
   begin
      return Self.Manifolds (1 .. Self.manifold_Count);
   end Manifolds;


   -----------
   --- Sprites
   --

   function new_sprite_Id (Self : access Item) return sprite_Id
   is
   begin
      Self.last_used_sprite_Id := Self.last_used_sprite_Id + 1;

      return Self.last_used_sprite_Id;
   end new_sprite_Id;



   procedure destroy (Self : in out Item;   the_Sprite : in gel.Sprite.view)
   is
   begin
      null;     -- TODO
      --  Self.Commands.add ((Kind   => destroy_Sprite,
      --                      Sprite => the_Sprite));
   end destroy;



   function free_sprite_Set (Self : access Item) return gel.Sprite.views
   is
      prior_set_Index : Integer;
   begin
      if Self.current_free_Set = 1
      then   prior_set_Index := 2;
      else   prior_set_Index := 1;
      end if;

      declare
         the_Set : constant gel.Sprite.views
           := Self.free_Sets (prior_set_Index).Sprites (1 .. Self.free_Sets (prior_set_Index).Count);
      begin
         Self.free_Sets (prior_set_Index).Count := 0;
         Self.current_free_Set := prior_set_Index;

         return the_Set;
      end;
   end free_sprite_Set;



   function fetch_Sprite (Self : in out Item'Class;   Id : in sprite_Id) return gel.Sprite.view
   is
   begin
      return Self.all_Sprites.fetch.Element (Id);
   end fetch_Sprite;



   procedure set_Scale (Self : in out Item;   for_Sprite : in gel.Sprite.view;
                                              To         : in Vector_3)
   is
      Pad : constant Vector_3 := for_Sprite.Site;
   begin
      Self.rid (for_Sprite, and_children => False);
      for_Sprite.Scale_is (To);
      Self.add (for_Sprite, and_children => False);

      for_Sprite.Site_is (Pad);   -- TODO: Fix this hack !
   end set_Scale;



   function sprite_Transforms (Self : in out Item'Class) return sprite_transform_Pairs
   is
      use id_Maps_of_sprite;

      all_Sprites : constant  id_Maps_of_sprite.Map    := Self.all_Sprites.fetch;
      Cursor      :           id_Maps_of_sprite.Cursor := all_Sprites.First;

      the_sprite_Transforms : sprite_transform_Pairs (1 .. Natural (all_Sprites.Length)) := (others => <>);
      Count                 : Natural := 0;

      the_Sprite : Sprite.view;

   begin
      while has_Element (Cursor)
      loop
         the_Sprite := Element (Cursor);

         if not the_Sprite.is_Destroyed
         then
            Count                         := Count + 1;
            the_sprite_Transforms (Count) := (Sprite    => the_Sprite,
                                              Transform => the_Sprite.Transform);
         end if;

         next (Cursor);
      end loop;

      return the_sprite_Transforms (1 .. Count);
   end sprite_Transforms;


   ----------
   --- Joints
   --

   procedure destroy (Self : in out Item;   the_Joint : in gel.Joint.view)
   is
   begin
      null;     -- TODO
      --  Self.Commands.add ((kind   => free_Joint,
      --                      sprite => null,
      --                      joint  => the_Joint));
   end destroy;



   procedure set_local_Anchor_on_A (Self : in out Item;   for_Joint : in gel.Joint.view;
                                                          To        : in Vector_3)
   is
   begin
      null;     -- TODO
      --  Self.physics_Engine.set_local_Anchor (for_Joint.Physics.all'Access,
      --                                        to          => To,
      --                                        is_Anchor_A => True);

--        the_World.physics_Space.set_Joint_local_Anchor (the_Command.anchor_Joint.Physics.all'Access,
--                                                        the_Command.is_Anchor_A,
--                                                        the_Command.local_Anchor);
--
--
--        Self.Commands.add ((Kind         => set_Joint_local_Anchor,
--                            Sprite       => null,
--                            anchor_Joint => for_Joint,
--                            is_Anchor_A  => True,
--                            local_Anchor => To));
   end set_local_Anchor_on_A;



   procedure set_local_Anchor_on_B (Self : in out Item;   for_Joint : in gel.Joint.view;
                                                          To        : in Vector_3)
   is
   begin
      null;     -- TODO
      --  Self.physics_Engine.set_local_Anchor (for_Joint.Physics.all'Access,
      --                                        To          => To,
      --                                        is_Anchor_A => False);

--        Self.Commands.add ((Kind         => set_Joint_local_Anchor,
--                            Sprite       => null,
--                            anchor_Joint => for_Joint,
--                            is_Anchor_A  => False,
--                            local_Anchor => To));
   end set_local_anchor_on_B;



--     type graphics_Model_iface_view is access all openGL.remote_Model.item'Class;
--     type graphics_Model_view       is access all openGL.       Model.item'Class;
--
--     type physics_Model_iface_view is access all Standard.physics.remote.Model.item'Class;
--     type physics_Model_view       is access all Standard.physics.Model       .item'Class;


   procedure add (Self : access Item;   the_Sprite   : in gel.Sprite.view;
                                        and_Children : in Boolean := False)
   is
      procedure add_single_Sprite (Single : in out Sprite.item'Class)
      is
      begin
         if Single.Id = null_sprite_Id
         then
            raise Error with "Null sprite detected.";
         end if;

         Self.add (Single.graphics_Model);
         Self.add (Single. physics_Model);

         Single.Solid.user_Data_is (Single'Access);
         Single.Solid.    Model_is (Single.physics_Model);

         if Single.physics_Model.is_Tangible
         then
            Self.physics_Space.add (physics.Object.view (Single.Solid));
         end if;

         Item'Class (Self.all).all_Sprites.add (Single'unchecked_Access);
      end add_single_Sprite;

   begin
      pragma assert (the_Sprite.World = Self, "Trying to add sprite to the wrong world.");     -- TODO: Use an exception.

      if and_Children
      then
         declare
            procedure add_the_Joint (the_Sprite : in out Sprite.item'Class)
            is
               use type gel.Joint.view;
               the_Joint : constant gel.Joint.view := the_Sprite.parent_Joint;
            begin
               if the_Joint /= null
               then
                  Self.physics_Space.add         (the_Joint.Physics.all'Access);
                  the_Joint.Physics.user_Data_is (the_Joint);
               end if;
            end add_the_Joint;

         begin
            the_Sprite.apply (add_single_Sprite'unrestricted_Access);
            the_Sprite.apply (add_the_Joint    'unrestricted_Access);
         end;
      else
         add_single_Sprite (the_Sprite.all);
      end if;
   end add;



   procedure rid (Self : in out Item'Class;   the_Sprite   : in gel.Sprite.view;
                                              and_Children : in Boolean := False)
   is
      procedure rid_single_Sprite (Single : in out Sprite.item'Class)
      is
      begin
         --  Self.Commands.add ((Kind         => rid_Sprite,
         --                      Sprite       => the_Sprite'unchecked_Access,
         --                      rid_Children => False));

         Self.all_Sprites.rid (Single'unchecked_Access);     -- TODO: Handle grandchildren and so on.
      end rid_single_Sprite;

   begin
      if and_Children
      then
         the_Sprite.apply (rid_single_Sprite'unrestricted_Access);
      else
         rid_single_Sprite (the_Sprite.all);
      end if;
   end rid;



   procedure add (Self : in out Item;   the_Model : in openGL.Model.view)
   is
   begin
      --  log ("gel.World.add (the opengl Model) ~ the_Model.Id:" & the_Model.Id'Image);


      if the_Model.Id = null_graphics_model_Id
      then
         Self.last_used_model_Id := Self.last_used_model_Id + 1;
         the_Model.Id_is (Self.last_used_model_Id);
      end if;

      if not Self.graphics_Models.contains (the_Model.Id)
      then
         Self.graphics_Models.insert (the_Model.Id, the_Model);

         --  Emit a new model event.
         --

         --  log ("gel.World.add ~ emit new graphics model event");

         declare
            the_Event : remote.World.new_graphics_model_Event;
         begin
            the_Event.Model := the_Model;
            Self.emit (the_Event);
         end;
      end if;
   end add;



   procedure add (Self : in out Item;   the_Model : in physics.Model.view)
   is
   begin
      if the_Model.Id = Physics.null_model_Id
      then
         Self.last_used_physics_model_Id := Self.last_used_physics_model_Id + 1;
         the_Model.Id_is (Self.last_used_physics_model_Id);
      end if;

      if not Self.physics_Models.contains (the_Model.Id)
      then
         Self.physics_Models.insert (the_Model.Id, the_Model);

         --  Emit a new model event.
         --
         --  log ("gel.World.add ~ emit new physics model event");
         declare
            the_Event : remote.World.new_physics_model_Event;
         begin
            the_Event.Model := the_Model;
            Self.emit (the_Event);
         end;
      end if;
   end add;



   procedure add (Self : in out Item;   the_Joint : in gel.Joint.view)
   is
   begin
      Self.physics_Space.add         (the_Joint.Physics.all'Access);
      the_Joint.Physics.user_Data_is (the_Joint);
   end add;



   procedure rid (Self : in out Item;   the_Joint : in gel.Joint.view)
   is
   begin
      null;     -- TODO
      --  Self.physics_Engine.rid (the_Joint.Physics.all'Access);

--        Self.Commands.add ((kind   => rid_Joint,
--                            sprite => null,
--                            joint  => the_Joint));
   end rid;



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

   procedure start (Self : access Item)
   is
   begin
      null;
   end start;


   --------------------
   ---  World Mirroring
   --

   overriding
   procedure   register (Self : access Item;   the_Mirror         : in remote.World.view;
                                               Mirror_as_observer : in lace.Observer.view) is null;
   overriding
   procedure deregister (Self : access Item;   the_Mirror         : in remote.World.view) is null;

   overriding
   procedure motion_Updates_are (Self : in Item;   seq_Id : in remote.World.sequence_Id;
                                                   Now    : in remote.World.motion_Updates) is null;


   ----------
   --- Joints
   --

   procedure allow_broken_Joints (Self : out Item)
   is
   begin
      Self.broken_joints_Allowed := True;
   end allow_broken_Joints;



   procedure handle_broken_Joints (Self : in out Item;   the_Joints :in Joint.views)
   is
   begin
      for i in the_Joints'Range
      loop
         begin
            if         (    the_Joints (i).Sprite_A /= null
                        and the_Joints (i).Sprite_B /= null)
              and then (    not the_Joints (i).Sprite_A.is_Destroyed
                        and not the_Joints (i).Sprite_B.is_Destroyed)
            then
               begin
                  the_Joints (i).Sprite_A.detach (the_Joints (i).Sprite_B);
               exception
                  when no_such_Child =>
                     put_Line ("handle_broken_Joints: Cannot detach sprite:  no_such_Child." );
               end;
            end if;

         exception
            when storage_Error =>
               put_Line ("handle_broken_Joints: Cannot tell if sprite exists:  storage_Error." );
         end;
      end loop;
   end handle_broken_Joints;



   procedure evolve (Self : in out Item)
   is
   begin
      Self.Age := Self.Age + evolve_Period;

      --  Evolve the physics.
      --
      Self.physics_Space.evolve (evolve_Period);     -- Evolve the physics space.

      --  Handle evnts.
      --
      Self.respond;
      Self.local_Subject_and_deferred_Observer.respond;

      -- Broken joints.
      --
      declare
         the_Joints : safe_Joints;
         Count      : Natural;
      begin
         Self.broken_Joints.fetch  (the_Joints, Count);
         Self.handle_broken_Joints (the_Joints (1 .. Count));
      end;

      --  Perform responses to events for all sprites.
      --
      declare
         use id_Maps_of_sprite;

         all_Sprites : constant id_Maps_of_sprite.Map    := Item'Class (Self).all_Sprites.fetch;
         Cursor      :          id_Maps_of_sprite.Cursor := all_Sprites.First;
         the_Sprite  :          Sprite.view;
      begin
         while has_Element (Cursor)
         loop
            the_Sprite := Element (Cursor);

            begin
               if not the_Sprite.is_Destroyed
               then
                  the_Sprite.respond;
               end if;

            exception
               when E : others =>
                  new_Line (2);
                  put_Line ("Error in 'gel.World.evolve' sprite response.");
                  new_Line;
                  put_Line (ada.Exceptions.exception_Information (E));
                  new_Line (2);
            end;

            next (Cursor);
         end loop;
      end;

   end evolve;



   overriding
   function graphics_Models (Self : in Item) return remote.World.id_Map_of_graphics_model
   is
      use id_Maps_of_graphics_model;

      the_Models  : remote.World.id_Map_of_graphics_model;
      Cursor      : id_Maps_of_graphics_model.Cursor := Self.graphics_Models.First;
   begin
      while has_Element (Cursor)
      loop
         the_Models.include (Element (Cursor).Id,
                             Element (Cursor).all);
         next (Cursor);
      end loop;

      return the_Models;
   end graphics_Models;



   overriding
   function physics_Models (Self : in Item) return remote.World.id_Map_of_physics_model
   is
      use id_Maps_of_physics_model;

      the_Models  : remote.World.id_Map_of_physics_model;
      Cursor      : id_Maps_of_physics_model.Cursor := Self.physics_Models.First;
   begin
      while has_Element (Cursor)
      loop
         the_Models.include (Element (Cursor).Id,
                             Element (Cursor).all);
         next (Cursor);
      end loop;

      return the_Models;
   end physics_Models;



   overriding
   function Sprites (Self : in out Item) return remote.World.sprite_model_Pairs
   is
      use id_Maps_of_sprite,
          lace.Text;

      all_Sprites : constant id_Maps_of_sprite.Map    := Item'Class (Self).all_Sprites.fetch;
      Cursor      :          id_Maps_of_sprite.Cursor := all_Sprites.First;
      the_Pairs   :          remote.World.sprite_model_Pairs (1 .. Natural (all_Sprites.Length));
      the_Sprite  :          Sprite.view;
      i           :          Natural := 0;
   begin
      while has_Element (Cursor)
      loop
         i          := i + 1;
         the_Sprite := Element (Cursor);

         the_Pairs (i) := (sprite_Id         => the_Sprite.Id,
                           sprite_Name       => lace.Text.forge.to_Text_64 (the_Sprite.Name),
                           graphics_model_Id => the_Sprite.graphics_Model.Id,
                           physics_model_Id  => the_Sprite. physics_Model.Id,
                           Mass              => the_Sprite.Mass,
                           Transform         => the_Sprite.Transform,
                           is_Visible        => the_Sprite.is_Visible);
         next (Cursor);
      end loop;

      return the_Pairs;
   end Sprites;



   --------------
   --- Collisions
   --

   function Hash (Self : in filtered_impact_Response) return ada.Containers.Hash_type
   is
      use type ada.Containers.Hash_type;

      function to_Hash is new ada.unchecked_Conversion (impact_Filter,   ada.Containers.Hash_type);
      function to_Hash is new ada.unchecked_Conversion (impact_Response, ada.Containers.Hash_type);
   begin
      return   to_Hash (Self.Filter)
             + to_Hash (Self.Response);
   end Hash;



   procedure add_impact_Response (Self : in out Item;   Filter   : in impact_Filter;
                                                        Response : in impact_Response)
   is
   begin
      null;   -- TODO
      --  Self.Commands.add ((new_impact_Response,
      --                      null,
      --                      Filter,
      --                      Response));
   end add_impact_Response;



   task body impact_Responder
   is
      the_World : gel.World.view;
      Done      : Boolean := False;

      Filters_through : impact_Filter;
      the_Response    : impact_Response;

      the_responses_Done : access Signal_Object;

   begin
      accept start (the_World      : in gel.World.view;
                    Filter         : in impact_Filter;
                    Response       : in impact_Response;
                    responses_Done : in Signal_Object_view)
      do
         impact_Responder.the_World := the_World;
         Filters_through            := Filter;
         the_Response               := Response;
         the_responses_Done         := responses_Done;
      end start;

      loop
         begin
            select
               accept stop
               do
                  Done := True;
               end stop;
            or
               accept respond;
            end select;

            exit when Done;

            --  Filter and call response.
            --
            for i in 1 .. the_World.manifold_Count
            loop
               if         not the_World.Manifolds (i).Sprites (1).is_Destroyed
                 and then not the_World.Manifolds (i).Sprites (2).is_Destroyed
                 and then     Filters_through (the_World.Manifolds (i))
               then
                  the_Response (the_World.Manifolds (i),
                                the_World);
               end if;
            end loop;

            the_responses_Done.signal;

         exception
            when E : others =>
               put_Line ("Exception in impact_Responder.");
               put_Line (Exception_Information (E));
               the_responses_Done.signal;
         end;
      end loop;

   end impact_Responder;




   -------
   --- Ids
   --

   procedure reserve_Ids (Self : in out Item;   Before : in long_Integer)
   is
   begin
      Self.last_used_sprite_Id        :=         sprite_Id (Before - 1);
      Self.last_used_model_Id         := graphics_model_Id (Before - 1);
      Self.last_used_physics_model_Id := physics .model_Id (Before - 1);
   end reserve_Ids;



   -----------
   --  Testing
   --

   overriding
   procedure kick_Sprite (Self : in out Item;   sprite_Id : in gel.sprite_Id)
   is
      the_Sprite : constant gel.Sprite.view := Item'Class (Self).all_Sprites.fetch.Element (sprite_Id);
   begin
      log ("KICK");
      the_Sprite.Speed_is ([0.0, 0.1, 0.0]);
   end kick_Sprite;


end gel.World;





-- Old engine code left for reference ...

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

   --  task body Engine
   --  is
   --     use type gel.Joint.view,
   --              ada.Containers.Count_type;
   --
   --     Stopped          : Boolean                   := True;
   --     Cycle            : ada.Containers.Count_type := 0;
   --     next_render_Time : ada.Calendar.Time;
   --
   --     the_filtered_impact_Response_Set : filtered_impact_Response_Sets.Set;
   --
   --     max_joint_Force,
   --     max_joint_Torque : Real := 0.0;


      --  procedure free_Sprites
      --  is
      --     the_free_Sprites : gel.Sprite.views := the_World.free_sprite_Set;
      --  begin
      --     for i in the_free_Sprites'Range
      --     loop
      --        log ("Engine is freeing sprite id:" & the_free_Sprites (i).Id'Image);
      --
      --        if the_free_Sprites (i).owns_Graphics
      --        then
      --           the_World.Renderer.free (the_free_Sprites (i).Visual.Model);
      --        end if;
      --
      --        gel.Sprite.free (the_free_Sprites (i));
      --     end loop;
      --  end free_Sprites;



      --  procedure free_graphics_Models
      --  is
      --     use id_Maps_of_graphics_model;
      --     Cursor : id_Maps_of_graphics_model.Cursor := the_World.graphics_Models.First;
      --  begin
      --     while has_Element (Cursor)
      --     loop
      --        the_World.Renderer.free (Element (Cursor));
      --        next (Cursor);
      --     end loop;
      --  end free_graphics_Models;



      --  procedure evolve
      --  is
      --     the_sprite_Transforms : sprite_Maps_of_transforms.Map := the_World.all_sprite_Transforms.Fetch;
      --  begin
      --     Cycle := Cycle + 1;

         --  do_engine_Commands:
         --  declare
            --  the_Commands  : World.Commands;
            --  Count         : Natural;
            --  command_Count : array (command_Kind) of Natural := (others => 0);

         --  begin
            --  the_World.Commands.fetch (the_Commands, Count);

            --  for Each in 1 .. Count
            --  loop
            --     declare
            --        use Physics.Engine;
                  --  the_Command : World.Command renames the_Commands (Each);
               --  begin
                  --  command_Count (the_Command.Kind) := command_Count (the_Command.Kind) + 1;

                  --  case the_Command.Kind
                  --  is
--                       when scale_Sprite =>
--                          the_World.physics_Engine.add (std_Physics.Engine.Command' (Kind   => scale_Object,
--                                                                                     Sprite => the_Command.Sprite.Solid,
--                                                                                     Scale  => the_Command.Scale));
--                          the_Command.Sprite.Solid.activate;
--                          the_Command.Sprite.Shape.Scale_is (the_Command.Scale);
--                          the_Command.Sprite.Solid.Scale_is (the_Command.Scale);
--
--                          the_World.physics_Space.update_Bounds (std_physics.Object.view (the_Command.Sprite.Solid));


--                       when update_Bounds =>
--                          the_World.physics_Space.update_Bounds (std_physics.Object.view (the_Command.Sprite.Solid));


                     --  when update_Site =>
                     --     the_World.physics_Engine.update_Site (the_Command.Sprite.Solid,
                     --                                           the_Command.Site);
--                          std_physics.Object.view (the_Command.Sprite.Solid).Site_is (the_Command.Site);


--                       when set_Speed =>
--                          std_physics.Object.view (the_Command.Sprite.Solid).Speed_is (the_Command.Speed);


--                       when set_xy_Spin =>
--                          std_physics.Object.view (the_Command.Sprite.Solid).xy_Spin_is (the_Command.xy_Spin);


                     --  when add_Sprite =>
                     --     declare
                     --        procedure add (the_Sprite : in Sprite.view)
                     --        is
                     --        begin
                     --           if the_Sprite.Id = null_sprite_Id
                     --           then
                     --              raise Program_Error;
                     --           end if;
                     --
                     --           the_World.add (the_Sprite.graphics_Model);
                     --           the_World.add (the_Sprite. physics_Model);
                     --
                     --           the_sprite_Transforms.insert  (the_Sprite, Identity_4x4);
                     --
                     --           the_Sprite.Solid.user_Data_is (the_Sprite);
                     --           the_Sprite.Solid.Model_is (the_Sprite.physics_Model);
                     --
                     --           if the_Sprite.physics_Model.is_Tangible
                     --           then
                     --              the_World.physics_Engine.add (physics.Object.view (the_Sprite.Solid));
                     --           end if;
                     --
                     --           the_World.sprite_Count                     := the_World.sprite_Count + 1;
                     --           the_World.Sprites (the_World.sprite_Count) := the_Sprite;
                     --        end add;
                     --
                     --     begin
                     --        add (the_Command.Sprite);
                     --     end;


                     --  when rid_Sprite =>
                     --     declare
                     --        function find (the_Sprite : in Sprite.view) return Index
                     --        is
                     --        begin
                     --           for i in 1 .. the_World.sprite_Count
                     --           loop
                     --              if the_World.Sprites (i) = the_Sprite
                     --              then
                     --                 return i;
                     --              end if;
                     --           end loop;
                     --
                     --           raise constraint_Error with "No such sprite in world.";
                     --           return 0;
                     --        end find;
                     --
                     --
                     --        procedure rid (the_Sprite : in Sprite.view)
                     --        is
                     --           use type physics.Object.view;
                     --        begin
                     --           if the_Sprite.Solid /= null
                     --           then
                     --              if the_Sprite.physics_Model.is_Tangible
                     --              then
                     --                 the_World.physics_Engine.rid (the_Sprite.Solid);
                     --              end if;
                     --
                     --              if the_sprite_Transforms.contains (the_Sprite) then
                     --                 the_sprite_Transforms.delete   (the_Sprite);
                     --              end if;
                     --
                     --           else
                     --              raise program_Error;
                     --           end if;
                     --
                     --           declare
                     --              Id : Index;
                     --           begin
                     --              Id := find (the_Sprite);
                     --
                     --              if Id <= the_World.sprite_Count
                     --              then
                     --                 the_World.Sprites (1 .. the_World.sprite_Count - 1)
                     --                   :=   the_World.Sprites (     1 .. Id - 1)
                     --                      & the_World.Sprites (Id + 1 .. the_World.sprite_Count);
                     --              end if;
                     --
                     --              the_World.sprite_Count := the_World.sprite_Count - 1;
                     --           end;
                     --        end rid;
                     --
                     --     begin
                     --        rid (the_Command.Sprite);
                     --     end;


--                       when apply_Force =>
--                          the_Command.Sprite.Solid.apply_Force (the_Command.Force);


                     --  when destroy_Sprite =>
                     --     declare
                     --        the_free_Set : free_Set renames the_World.free_Sets (the_World.current_free_Set);
                     --     begin
                     --        the_free_Set.Count                        := the_free_Set.Count + 1;
                     --        the_free_Set.Sprites (the_free_Set.Count) := the_Command.Sprite;
                     --     end;


--                       when add_Joint =>
--                          the_World.physics_Space.add            (the_Command.Joint.Physics.all'Access);
--                          the_Command.Joint.Physics.user_Data_is (the_Command.Joint);


--                       when rid_Joint =>
--                          the_World.physics_Space.rid (the_Command.Joint.Physics.all'Access);


--                       when set_Joint_local_Anchor =>
--                          the_World.physics_Space.set_Joint_local_Anchor (the_Command.anchor_Joint.Physics.all'Access,
--                                                                          the_Command.is_Anchor_A,
--                                                                          the_Command.local_Anchor);

                     --  when free_Joint =>
                     --     gel.Joint.free (the_Command.Joint);


                     --  when cast_Ray =>
                     --     declare
                     --        function cast_Ray (Self : in Item'Class;   From, To : in Vector_3) return ray_Collision
                     --        is
                     --           use type physics.Object.view;
                     --
                     --           physics_Collision : constant physics.Space.ray_Collision := Self.physics_Space.cast_Ray (From, To);
                     --        begin
                     --           if physics_Collision.near_Object = null
                     --           then
                     --              return ray_Collision' (near_Sprite => null,
                     --                                     others      => <>);
                     --           else
                     --              return ray_Collision' (to_GEL (physics_Collision.near_Object),
                     --                                     physics_Collision.hit_Fraction,
                     --                                     physics_Collision.Normal_world,
                     --                                     physics_Collision.  Site_world);
                     --           end if;
                     --        end cast_Ray;
                     --
                     --        the_Collision : constant ray_Collision := cast_Ray (the_World.all,
                     --                                                            the_Command.From,
                     --                                                            the_Command.To);
                     --     begin
                     --        if        the_Collision.near_Sprite = null
                     --          or else the_Collision.near_Sprite.is_Destroyed
                     --        then
                     --           free (the_Command.Context);
                     --
                     --        else
                     --           declare
                     --              no_Params : aliased no_Parameters;
                     --              the_Event :         raycast_collision_Event'Class
                     --                := raycast_collision_Event_dispatching_Constructor (the_Command.event_Kind,
                     --                                                                    no_Params'Access);
                     --           begin
                     --              the_Event.Context     := the_Command.Context;
                     --              the_Event.near_Sprite := the_Collision.near_Sprite;
                     --              the_Event.Site_world  := the_Collision.Site_world;
                     --
                     --              the_Command.Observer.receive (the_Event, from_Subject => the_World.Name);
                     --           end;
                     --        end if;
                     --     end;


                     --  when new_impact_Response =>
                     --     declare
                     --        the_impact_Responder      : constant impact_Responder_view := new impact_Responder;
                     --        the_responses_done_Signal : constant Signal_Object_view    := new signal_Object;
                     --     begin
                     --        the_filtered_impact_Response_Set.insert ((the_Command.Filter,
                     --                                                  the_Command.Response,
                     --                                                  the_impact_Responder,
                     --                                                  the_responses_done_Signal));
                     --        the_impact_Responder.start (the_World,
                     --                                    the_Command.Filter,
                     --                                    the_Command.Response,
                     --                                    the_responses_done_Signal);
                     --     end;


--                       when set_Gravity =>
--                          the_World.physics_Space.Gravity_is (the_Command.Gravity);
                  --  end case;
               --  end;
            --  end loop;
         --  end do_engine_Commands;


         --  Evolve the physics.
         --
--           if not the_World.is_a_Mirror
--           then
--              the_World.physics_Space.evolve (by => 1.0 / 60.0);     -- Evolve the world.
--           end if;


         --  --  Contact Manifolds
         --  --
         --  declare
         --     Count : Natural := 0;
         --  begin
         --     for i in 1 .. the_World.physics_Space.manifold_Count
         --     loop
         --        declare
         --           function to_Integer is new ada.unchecked_Conversion (physics_Object_view, Integer);
         --
         --           the_physics_Manifold : constant physics.Space.a_Manifold
         --             := the_World.physics_Space.Manifold (i);
         --        begin
         --           Count                       := Count + 1;
         --           the_World.Manifolds (Count) := (sprites => (to_GEL (the_physics_Manifold.Objects (1)),
         --                                                       to_GEL (the_physics_Manifold.Objects (2))),
         --                                           contact => (Site => the_physics_Manifold.Contact.Site));
         --        exception
         --           when others =>
         --              put_Line ("Error in 'gel.world.Engine.evolve' contact manifolds.");
         --              Count := Count - 1;
         --        end;
         --     end loop;
         --
         --     the_World.manifold_Count := the_World.physics_Space.manifold_Count;
         --
         --  exception
         --     when E : others =>
         --        put_Line ("'gel.World.local.Engine.Contact Manifolds' has an unhandled exception ...");
         --        put_Line (exception_Information (E));
         --  end;


         --  --  For each registered impact response, tell the associated responder task to respond.
         --  --
         --  declare
         --     use filtered_impact_Response_Sets;
         --     Cursor : filtered_impact_Response_Sets.Cursor := the_filtered_impact_Response_Set.First;
         --
         --  begin
         --     while has_Element (Cursor)
         --     loop
         --        Element (Cursor).Responder.respond;
         --        next (Cursor);
         --     end loop;
         --
         --     --  Wait for all responders to complete.
         --     --
         --     Cursor := the_filtered_impact_Response_Set.First;
         --
         --     while has_Element (Cursor)
         --     loop
         --        select
         --           Element (Cursor).responses_Done.wait;
         --        or
         --           delay Duration'Last;
         --        end select;
         --
         --        next (Cursor);
         --     end loop;
         --
         --  exception
         --     when E : others =>
         --        put_Line ("'gel.World.local.Engine.impact response' has an unhandled exception ...");
         --        put_Line (exception_Information (E));
         --  end;


         --  --  Update sprite transforms.
         --  --
         --  declare
         --     use sprite_Maps_of_transforms;
         --
         --     Cursor     : sprite_Maps_of_transforms.Cursor := the_sprite_Transforms.First;
         --     the_Sprite : gel.Sprite.view;
         --  begin
         --     while has_Element (Cursor)
         --     loop
         --        the_Sprite := Key (Cursor);
         --        declare
         --           the_Transform : constant Matrix_4x4 := the_Sprite.Solid.get_Dynamics;
         --        begin
         --           the_sprite_Transforms.replace_Element (Cursor, the_Transform);
         --        end;
         --        next (Cursor);
         --     end loop;
         --  end;
         --
         --  the_World.all_sprite_Transforms.set (To => the_sprite_Transforms);
         --
         --  free_Sprites;
      --  end evolve;


      --  use type physics.Space.view;
      --
   --  begin
   --     accept start (space_Kind : in physics.space_Kind)
   --     do
   --        Stopped                 := False;
   --        the_World.physics_Space := physics.Forge.new_Space (space_Kind);
   --     end start;

      --  next_render_Time := ada.Calendar.Clock;

      --  loop
      --     select
      --        accept stop
      --        do
      --           Stopped := True;
      --
      --           -- Add 'destroy' commands for all sprites.
      --           --
      --           declare
      --              the_Sprites : Sprite.views renames the_World.Sprites;
      --           begin
      --              for i in 1 .. the_World.sprite_Count
      --              loop
      --                 the_Sprites (i).destroy (and_Children => False);
      --              end loop;
      --           end;

               -- Evolve the world til there are no commands left.
               --
               --  while not the_World.Commands.is_Empty
               --  loop
               --     evolve;
               --  end loop;

               --  Stop all impact responders tasks.
               --
               --  declare
               --     use filtered_impact_Response_Sets;
               --
               --     procedure free is new ada.unchecked_Deallocation (Signal_Object,
               --                                                       Signal_Object_view);
               --
               --     Cursor        : filtered_impact_Response_Sets.Cursor := the_filtered_impact_Response_Set.First;
               --
               --     the_Responder : impact_Responder_view;
               --     the_Signal    : Signal_Object_view;
               --
               --  begin
               --     while has_Element (Cursor)
               --     loop
               --        the_Signal    := Element (Cursor).responses_Done;
               --        the_Responder := Element (Cursor).Responder;
               --        the_Responder.stop;
               --
               --        while not the_Responder.all'Terminated
               --        loop
               --           delay 0.01;
               --        end loop;
               --
               --        free (the_Responder);
               --        free (the_Signal);
               --
               --        next (Cursor);
               --     end loop;
               --  end;

               -- Free both sets of freeable sprites.
               --
               --  free_Sprites;
               --  free_Sprites;
            --  end stop;

            --  exit when Stopped;
            --
         --  or
         --     accept reset_Age
         --     do
         --        the_World.Age_is (0.0);
         --     end reset_Age;
         --
         --  else
         --     null;
         --  end select;
         --
         --
         --  if not the_World.is_a_Mirror
         --  then
         --     evolve;
         --  end if;
         --
         --
         --  the_World.new_sprite_transforms_Available.signal;
         --  the_World.evolver_Done                   .signal;
         --
         --
         --  -- Check for joint breakage.
         --  --
         --  if the_World.broken_joints_Allowed
         --  then
         --     declare
         --        use gel.Joint,
         --            physics.Space;
         --
         --        the_Joint       : gel.Joint.view;
         --        reaction_Force,
         --        reaction_Torque : Real;
         --
         --        Cursor          : physics.Space.joint_Cursor'Class := the_World.physics_Space.first_Joint;
         --     begin
         --        while has_Element (Cursor)
         --        loop
         --           the_Joint := to_GEL (Element (Cursor));
         --
         --           if the_Joint /= null
         --           then
         --              reaction_Force  := abs (the_Joint.reaction_Force);
         --              reaction_Torque := abs (the_Joint.reaction_Torque);
         --
         --              if   reaction_Force  >  50.0 / 8.0
         --                or reaction_Torque > 100.0 / 8.0
         --              then
         --                 begin
         --                    the_World.physics_Space      .rid (the_Joint.Physics.all'Access);
         --                    the_World.broken_Joints.add (the_Joint);
         --
         --                 exception
         --                    when no_such_Child =>
         --                       put_Line ("Error when breaking joint due to reaction Force:  no_such_Child.");
         --                 end;
         --              end if;
         --
         --              if reaction_Force > max_joint_Force
         --              then
         --                 max_joint_Force := reaction_Force;
         --              end if;
         --
         --              if reaction_Torque > max_joint_Torque
         --              then
         --                 max_joint_Torque := reaction_Torque;
         --              end if;
         --           end if;
         --
         --           next (Cursor);
         --        end loop;
         --     end;
         --  end if;
         --
         --  next_render_Time := next_render_Time + Duration (1.0 / 60.0);
      --  end loop;
      --
   --  exception
   --     when E : others =>
   --        new_Line (2);
   --        put_Line ("Error in gel.World.Engine");
   --        new_Line;
   --        put_Line (exception_Information (E));
   --        put_Line ("Engine has terminated !");
   --        new_Line (2);
   --  end Engine;
