lace_gel_0.1.0_2c333035/source/gel-sprite.adb

with
     gel.hinge_Joint,
     gel.  any_Joint,
     gel.World,

     ada.Tags,
     ada.unchecked_Deallocation,
     ada.unchecked_Conversion;

package body gel.Sprite
is
   use ada.Tags,
       linear_Algebra_3D;


   procedure log (Message : in String)
--                    renames ada.text_IO.put_Line;
   is null;


   ------------------
   --- Initialisation
   --

   procedure rebuild_Shape (Self : in out Item)
   is
      use type physics.Model.shape_Kind,
               physics.Model.View;

      the_Scale : aliased Vector_3;

   begin
--        Self.Shape := Self.World.Space.new_Shape (Self.physics_Model);

      -- Old
      if Self.physics_Model = null then
         return;
      end if;

      the_Scale := Self.physics_Model.Scale;

      case Self.physics_Model.shape_Info.Kind
      is
         when physics.Model.Cube =>
            Self.Shape := physics_Shape_view (Self.World.Space.        new_box_Shape (Self.physics_Model.shape_Info.half_Extents));

         when physics.Model.a_Sphere =>
            Self.Shape := physics_Shape_view (Self.World.Space.     new_sphere_Shape (Self.physics_Model.shape_Info.sphere_Radius));

         when physics.Model.multi_Sphere =>
            Self.Shape := physics_Shape_view (Self.World.Space.new_multisphere_Shape (Self.physics_Model.shape_Info.Sites.all,
                                                                                      Self.physics_Model.shape_Info.Radii.all));
         when physics.Model.Cone =>
            Self.Shape := physics_Shape_view (Self.World.Space.       new_cone_Shape (Radius => Real (Self.physics_Model.Scale (1) / 2.0),
                                                                                      Height => Real (Self.physics_Model.Scale (2))));
         when physics.Model.a_Capsule =>
            Self.Shape := physics_Shape_view (Self.World.Space.    new_capsule_Shape (Self.physics_Model.shape_Info.lower_Radius,
                                                                                      Self.physics_Model.shape_Info.Height));
         when physics.Model.Cylinder =>
            Self.Shape := physics_Shape_view (Self.World.Space.   new_cylinder_Shape (Self.physics_Model.shape_Info.half_Extents));

         when physics.Model.Hull =>
            Self.Shape := physics_Shape_view (Self.World.Space.new_convex_hull_Shape (Self.physics_Model.shape_Info.Points.all));

         when physics.Model.Mesh =>
            Self.Shape := physics_Shape_view (Self.World.Space       .new_mesh_Shape (Self.physics_Model.shape_Info.Model));

         when physics.Model.Plane =>
            Self.Shape := physics_Shape_view (Self.World.Space.      new_plane_Shape (Self.physics_Model.Shape_Info.plane_Normal,
                                                                                      Self.physics_Model.Shape_Info.plane_Offset));
         when physics.Model.Heightfield =>
            Self.Shape := physics_Shape_view (Self.World.Space.new_heightfield_Shape (Self.physics_Model.shape_Info.Heights.all,
                                                                                      Self.physics_Model.Scale));
         when physics.Model.Circle =>
            Self.Shape := physics_Shape_view (Self.World.Space.     new_circle_Shape (Self.physics_Model.shape_Info.circle_Radius));

         when physics.Model.Polygon =>
            Self.Shape := physics_Shape_view (Self.World.Space.    new_polygon_Shape (physics.space.polygon_Vertices (Self.physics_Model.shape_Info.Vertices (1 .. Self.physics_Model.shape_Info.vertex_Count))));
      end case;

   end rebuild_Shape;



   procedure rebuild_Solid (Self : in out Item;   at_Site : Vector_3)
   is
      use Physics.Object;
   begin
      if Self.Solid /= null
      then
         raise Program_Error;
      end if;

      Self.Solid := physics_Object_view (Self.World.Space.new_Object (physics.Shape.view (Self.Shape),
                                                                      Self.physics_Model.Mass,
                                                                      Self.physics_Model.Friction,
                                                                      Self.physics_Model.Restitution,
                                                                      at_Site,
                                                                      Self.is_Kinematic));
   end rebuild_Solid;



   procedure define (Self : access Item;   World          : in     World_view;
                                           at_Site        : in     Vector_3;
                                           graphics_Model : access openGL. Model.item'Class;
                                           physics_Model  : access physics.Model.item'Class;
                                           owns_Graphics  : in     Boolean;
                                           owns_Physics   : in     Boolean;
                                           is_Kinematic   : in     Boolean := False)
   is
      use type physics.Model.view;
   begin
      Self.Id             := World.new_sprite_Id;
      Self.World          := World;

      Self.Visual.Model_is (graphics_Model.all'unchecked_Access);
      Self.physics_Model  := physics.Model.view (physics_Model);
      Self.owns_Graphics  := owns_Graphics;
      Self.owns_Physics   := owns_Physics;

      Self.is_Kinematic   := is_Kinematic;
      --  set_Translation (Self.Transform, To => physics_Model.Site);

      --  Physics
      --
      if Self.physics_Model /= null
      then
         Self.rebuild_Shape;
         Self.rebuild_Solid (at_Site);
         null;
      end if;
   end define;



   procedure destroy (Self : access Item;   and_Children : in Boolean)
   is
      use gel.Joint;
   begin
      if Self.is_Destroyed
      then
         raise Error with "Sprite is already destroyed.";
      end if;

      -- Detach parent, if any.
      --
      if Self.parent_Joint /= null then
         Self.parent_Joint.Sprite_A.detach (Sprite.view (Self));
      end if;

      -- Detach children, if any.
      --
      while not Self.child_Joints.is_Empty
      loop
         declare
            child_Sprite : constant Sprite.view := Self.child_Joints.Last_Element.Sprite_B.all'Access;
         begin
            Self.detach (child_Sprite);

            if and_Children
            then
               destroy (child_Sprite, and_Children);   -- Recurse.
            end if;
         end;
      end loop;

      Self.is_Destroyed := True;
      Self.World.destroy (Sprite.view (Self));

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



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



   procedure free (Self : in out View)
   is
      pragma assert (Self.is_Destroyed);

      use gel.Joint,
          physics.Model,
          physics.Object,
          physics.Shape;

      procedure deallocate is new ada.unchecked_Deallocation (Sprite.item'Class, Sprite.view);
      procedure deallocate is new ada.unchecked_Deallocation (Joint.views,       access_Joint_views);
      pragma Unreferenced (deallocate);

      child_Joint : Joint.view;

   begin
      for Each in 1 .. Integer (Self.child_Joints.Length)
      loop
         child_Joint := Self.child_Joints.Element (Each);
         free (child_Joint);
      end loop;

      if Self.owns_Physics
      then
         free (Self.physics_Model);
      end if;

      free (Self.Shape);
      free (Self.Solid);

      deallocate (Self);
   end free;


   ----------
   --- Forge
   --
   package body Forge
   is

      function to_Sprite (Name           : in     String;
                          World          : in     World_view;
                          at_Site        : in     Vector_3;
                          graphics_Model : access openGL. Model.item'Class;
                          physics_Model  : access physics.Model.item'Class;
                          owns_Graphics  : in     Boolean;
                          owns_Physics   : in     Boolean;
                          is_Kinematic   : in     Boolean := False) return Item
      is
      begin
         return Self : Item := (lace.Subject_and_deferred_Observer.forge.to_Subject_and_Observer (Name)
                                with others => <>)
         do
            Self.define (World, at_Site, graphics_Model, physics_Model, owns_Graphics, owns_Physics, is_Kinematic);
         end return;
      end to_Sprite;



      function new_Sprite (Name           : in     String;
                           World          : in     World_view;
                           at_Site        : in     Vector_3;
                           graphics_Model : access openGL. Model.item'Class;
                           physics_Model  : access physics.Model.item'Class;
                           owns_Graphics  : in     Boolean := True;
                           owns_Physics   : in     Boolean := True;
                           is_Kinematic   : in     Boolean := False) return View
      is
         Self : constant View := new Item' (to_Sprite (Name,
                                                       World,
                                                       at_Site,
                                                       graphics_Model,
                                                       physics_Model,
                                                       owns_Graphics,
                                                       owns_Physics,
                                                       is_Kinematic));
      begin
         return Self;
      end new_Sprite;

   end Forge;


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

   function World (Self : in Item) return access gel.World.item'Class
   is
   begin
      return Self.World;
   end World;



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



   procedure Id_is (Self : in out Item;   Now : in gel.sprite_Id)
   is
   begin
      Self.Id := Now;
   end Id_is;



   function Depth_in_camera_space (Self : in Item) return Real
   is
   begin
      return Self.Depth_in_camera_space;
   end Depth_in_camera_space;



   function Mass (Self : in Item) return Real
   is
   begin
      return Self.physics_Model.Mass;
   end Mass;



   function is_Static (Self : in Item) return Boolean
   is
   begin
      return Self.Mass = 0.0;
   end is_Static;



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



   procedure mvp_Matrix_is (Self : in out Item;   Now : in Matrix_4x4)
   is
   begin
      Self.Visual.mvp_Transform_is (Now);
      Self.Depth_in_camera_space := Now (4, 3);
   end mvp_Matrix_is;



   function mvp_Matrix (Self : in Item) return Matrix_4x4
   is
   begin
      return Self.Visual.mvp_Transform;
   end mvp_Matrix;



   procedure is_Visible (Self : in out Item;   Now : in Boolean)
   is
   begin
      Self.is_Visible := Now;
   end is_Visible;



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



   procedure key_Response_is (Self : in out Item;   Now : in lace.Response.view)
   is
   begin
      Self.key_Response := Now;
   end key_Response_is;



   function key_Response (Self : in Item) return lace.Response.view
   is
   begin
      return Self.key_Response;
   end key_Response;



   function Visual (Self : access Item) return openGL.Visual.view
   is
   begin
      return Self.Visual;
   end Visual;



   function graphics_Model (Self : in Item) return openGL.Model.view
   is
   begin
      return Self.visual.Model;
   end graphics_Model;



   procedure Model_is (Self : in out Item;   Now : in openGL.Model.view)
   is
   begin
      Self.Visual.Model_is (Now);
   end Model_is;



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



   function physics_Model (Self : in Item) return access physics.Model.item'class
   is
   begin
      return Self.physics_Model;
   end physics_Model;



   procedure physics_Model_is (Self : in out Item;   Now : in physics.Model.view)
   is
   begin
      Self.physics_Model := Now;
   end physics_Model_is;



   procedure Scale_is (Self : in out Item;   Now : in math.Vector_3)
   is
   begin
      Self.physics_Model.Scale_is (Now);
      Self.World .update_Scale    (Self'unchecked_Access, +Now);
   end Scale_is;



   function Scale (Self : in Item) return Vector_3
   is
   begin
      return Self.physics_Model.Scale;
   end Scale;



   function Solid (Self : in Item) return physics_Object_view
   is
   begin
      return Self.Solid;
   end Solid;



   procedure Solid_is (Self : in out Item;   Now : in physics_Object_view)
   is
   begin
      Self.Solid := Now;
   end Solid_is;



   function to_GEL (the_Solid : in physics_Object_view) return gel.Sprite.view
   is
   begin
      return gel.Sprite.view (the_Solid.user_Data);
   end to_GEL;



   function Shape (Self : in Item) return physics_Shape_view
   is
   begin
      return Self.Shape;
   end Shape;


   -------------
   --- Dynamics
   --

   --- Bounds
   --

   function Bounds (Self : in Item) return Geometry_3d.bounding_Box
   is
      use Geometry_3d;
   begin
      return Self.graphics_Model.Bounds.Box + Self.Site;
   end Bounds;


   --- Site
   --

   function Site (Self : in Item) return Vector_3
   is
   begin
      return Self.Solid.Site;
   end Site;



   procedure Site_is (Self : in out Item;   Now : in Vector_3)
   is
   begin
      Self.Solid.Site_is (Now);
   end Site_is;



   procedure move (Self : in out Item;   to_Site : in Vector_3)
   is
      the_Offset   : constant Vector_3 := to_Site - Self.Site;
      child_Sprite : Sprite.view;
   begin
      --  Do children.
      --
      for i in 1 .. Integer (Self.child_Joints.Length)
      loop
         child_Sprite := Self.child_Joints.Element (i).Sprite_B;
         child_Sprite.move (to_site => child_Sprite.Site + the_Offset);            -- Recurse.
      end loop;

      Self.Site_is (to_Site);
   end move;



   procedure set_Speed (Self : in out Item;   to_Speed : in Vector_3)
   is
      child_Sprite : Sprite.view;
   begin
      --  Do children.
      --
      for i in 1 .. Integer (Self.child_Joints.Length)
      loop
         child_Sprite := Self.child_Joints.Element (i).Sprite_B;
         child_Sprite.set_Speed (to_Speed);
      end loop;

      Self.Speed_is (to_Speed);
   end set_Speed;



   function Spin (Self : in Item) return Matrix_3x3
   is
   begin
      return Self.Solid.Spin;
   end Spin;



   procedure Spin_is (Self : in out Item;   Now : in Matrix_3x3)
   is
      use type Physics.Object.view;
      --  Transform : Matrix_4x4 := Self.Transform.Value;
   begin
      --  set_Rotation      (Self.Transform, Now);
      --  Self.Transform_is (Transform);

      --  if Self.Solid /= null then
      Self.Solid.Spin_is (Now);
      --  end if;
   end Spin_is;



   function xy_Spin (Self : in Item) return Radians
   is
   begin
      return Self.Solid.xy_Spin;
   end xy_Spin;



   procedure xy_Spin_is (Self : in out Item;   Now : in Radians)
   is
   begin
      Self.World.set_xy_Spin (Self'unchecked_Access, Now);
   end xy_Spin_is;



   procedure rotate (Self : in out Item;   to_Spin : in Matrix_3x3)
   is
      the_spin_Delta : constant Matrix_3x3 := to_Spin * Inverse (Self.Spin);   -- The rotation matrix describing the amount by which Self has rotated.

      procedure spin_Children (the_Sprite : in Sprite.item'class)
      is
      begin
         if the_Sprite.child_Joints.Is_Empty then
            return;
         end if;

         declare
            child_Sprite    : Sprite.view;
            the_site_Offset : Vector_3;
         begin
            for i in 1 .. Integer (the_Sprite.child_Joints.Length)
            loop
               child_Sprite    := the_Sprite.child_Joints.Element (i).Sprite_B;
               the_site_Offset := the_spin_Delta * (child_Sprite.Site - Self.Site) ;

               child_Sprite.Site_is (Self.Site      + the_site_Offset);
               child_Sprite.Spin_is (the_spin_Delta * child_Sprite.Spin);

               spin_Children (child_Sprite.all);     -- Recurse.
            end loop;
         end;
      end spin_Children;

   begin
      spin_Children (Self);      -- Do children.
      Self.Spin_is (to_Spin);
   end rotate;



   function Transform (Self : in Item) return Matrix_4x4
   is
   begin
      --  return Self.Transform.Value;
      return Self.Solid.Transform;
   end Transform;



   procedure Transform_is (Self : in out Item;   Now : in Matrix_4x4)
   is
   begin
      --  Self.Transform.Value_is (Now);
      Self.Solid.Transform_is (Now);
   end Transform_is;



   function Speed (Self : in Item) return Vector_3
   is
   begin
      return Self.Solid.Speed;
   end Speed;



   procedure Speed_is (Self : in out Item;   Now : in Vector_3)
   is
   begin
      Self.World.set_Speed (Self'unchecked_Access, Now);
   end Speed_is;



   function Gyre (Self : in Item) return Vector_3
   is
   begin
      return Self.Solid.Gyre;
   end Gyre;



   procedure Gyre_is (Self : in out Item;   Now : in Vector_3)
   is
   begin
      Self.Solid.Gyre_is (Now);
   end Gyre_is;



   procedure set_Gyre (Self : in out Item;   to_Gyre : in Vector_3)
   is
      child_Sprite : Sprite.view;
   begin
      --  Do children.
      --
      for i in 1 .. Integer (Self.child_Joints.Length)
      loop
         child_Sprite := Self.child_Joints.Element (i).Sprite_B;
         child_Sprite.set_Gyre (to_Gyre);
      end loop;

      Self.Gyre_is (to_Gyre);
   end set_Gyre;


   --- Forces
   --

   procedure apply_Force (Self : in out Item;   Force  : in Vector_3)
   is
      the_Force : aliased constant Vector_3 := Force;
   begin
      Self.World.apply_Force (Self'unchecked_Access, the_Force);
   end apply_Force;



   procedure apply_Torque (Self : in out Item;   Torque : in Vector_3)
   is
      the_Torque : constant Vector_3 := Torque;
   begin
      Self.Solid.apply_Torque (the_Torque);
   end apply_Torque;



   procedure apply_Torque_impulse (Self : in out Item;   Torque : in Vector_3)
   is
      the_Torque : constant Vector_3 := Torque;
   begin
      Self.Solid.apply_Torque_impulse (the_Torque);
   end apply_Torque_impulse;


   --  Mirrored Dynamics
   --

   protected
   body safe_Interpolation
   is
      procedure set (desired_Site : in Vector_3;
                     desired_Spin : in Quaternion)
      is
      begin
         Safe.Site.initial := Safe.Site.desired;
         Safe.Site.desired := desired_Site;

         Safe.Spin.initial := Safe.Spin.desired;
         Safe.Spin.desired := desired_Spin;

         Safe.Percent      := 0.0;
      end set;


      procedure get (Site : out Vector_3;
                     Spin : out Quaternion)
      is
      begin
         Site := Interpolated (Safe.Site.initial,
                               Safe.Site.desired,
                               Safe.Percent);

         Spin := Interpolated (Safe.Spin.initial,
                               Safe.Spin.desired,
                               Safe.Percent);

         if gel.World.interpolation_Steps = 0
         then
            Safe.Percent := 100.0;
         else
            Safe.Percent := Percentage'Min (  Safe.Percent
                                            + to_Percentage (1.0 / Real (gel.World.interpolation_Steps + 1)),
                                              unit_Percentage'Last);
         end if;
      end get;

   end safe_Interpolation;



   procedure desired_Dynamics_are (Self : in out Item;   Site : in Vector_3;
                                                         Spin : in Quaternion)
   is
   begin
      Self.Interpolation.set (desired_Site => Site,
                              desired_Spin => Spin);
   end desired_Dynamics_are;



   procedure interpolate_Motion (Self : in out Item)
   is
   begin
      if Self.is_Static then
         return;
      end if;

      declare
         new_Site : Vector_3;
         new_Spin : Quaternion;
      begin
         Self.Interpolation.get (new_Site,
                                 new_Spin);
         Self.Site_is (new_Site);
         Self.Spin_is (Transpose (to_Matrix (new_Spin)));
      end;
   end interpolate_Motion;



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

   --- Hierachy
   --

   function parent_Joint (Self : in Item) return gel.Joint.view
   is
   begin
      return Self.parent_Joint;
   end parent_Joint;



   function child_Joints (Self : in Item) return gel.Joint.views
   is
      the_Joints : Joint.views (1 .. Integer (Self.child_Joints.Length));
   begin
      for i in the_Joints'Range
      loop
         the_Joints (i) := Self.child_Joints.Element (i);
      end loop;

      return the_Joints;
   end child_Joints;



   function top_Parent (Self : access Item) return gel.Sprite.view
   is
   begin
      if Self.parent_Joint = null
      then   return gel.Sprite.view (Self);
      else   return Self.parent_Joint.Sprite_A.top_Parent;   -- Recurse.
      end if;
   end top_Parent;



   function Parent (Self : in Item) return gel.Sprite.view
   is
   begin
      if Self.parent_Joint = null
      then   return null;
      else   return Self.parent_Joint.Sprite_A;
      end if;
   end Parent;



   function tree_Depth (Self : in Item) return Natural
   is
      Parent : Sprite.view := Self.Parent;
      Depth  : Natural     := 0;
   begin
      while Parent /= null
      loop
         Depth  := Depth + 1;
         Parent := Parent.Parent;
      end loop;

      return Depth;
   end tree_Depth;



   procedure apply (Self : in out Item;   do_Action : Action)
   is
   begin
      do_Action (Self);

      for i in 1 .. Integer (Self.child_Joints.Length)
      loop
         Self.child_Joints.Element (i).Sprite_B.apply (do_Action);
      end loop;
   end apply;



   procedure attach (Self : access Item;   the_Child : in Sprite.view;
                                           the_Joint : in gel.Joint.view)
   is
   begin
      log ("Attaching " & the_Child.Id'Image & " to " & Self.Id'Image);

      Self.child_Joints.append (the_Joint);

      the_Child.parent_Joint := the_Joint;
      the_Child.relay_responseless_Events (To => Self);
   end attach;



   procedure detach (Self : in out Item;   the_Child : gel.Sprite.view)
   is
      childs_Joint : Joint.view;
   begin
      log ("Detaching " & the_Child.Id'Image & " from " & Self.Id'Image);

      for i in 1 .. Integer (Self.child_Joints.Length)
      loop
         if Self.child_Joints.Element (i).Sprite_B = the_Child
         then
            childs_Joint := Self.child_Joints.Element (i);

            Self.child_Joints.delete (i);
            the_Child.parent_Joint := null;
            Self.World.destroy (childs_Joint);

            return;
         end if;
      end loop;

      raise no_such_Child;
   end detach;



   --  Hinge
   --
   procedure attach_via_Hinge (Self : access Item;   the_Child         : in      Sprite.view;
                                                     pivot_Axis        : in      Vector_3;
                                                     Anchor            : in      Vector_3;
                                                     child_Anchor      : in      Vector_3;
                                                     low_Limit         : in      Real;
                                                     high_Limit        : in      Real;
                                                     collide_Connected : in      Boolean;
                                                     new_joint         :     out gel.Joint.view)
   is
      the_Joint : constant gel.hinge_Joint.view := new gel.hinge_Joint.item;
   begin
      the_Joint.define (Self.World.Space,
                        Self,       the_Child,
                        pivot_Axis,
                        Anchor,     child_Anchor,
                        low_Limit,  high_Limit,
                        collide_Connected);

      the_Joint.Limits_are (low_Limit, high_Limit);

      Self.attach (the_Child, the_Joint.all'Access);

      new_Joint := the_Joint.all'Access;
   end attach_via_Hinge;



   procedure attach_via_Hinge (Self : access Item;   the_Child    : in     Sprite.view;
                                                     pivot_Axis   : in     Vector_3;
                                                     pivot_Anchor : in     Vector_3;
                                                     low_Limit    : in     Real;
                                                     high_Limit   : in     Real;
                                                     new_joint    :    out gel.Joint.view)
   is
      the_Joint : constant gel.hinge_Joint.view := new gel.hinge_Joint.item;
   begin
      the_Joint.define (in_Space     => Self.World.Space,
                        Sprite_A     => Self,
                        Sprite_B     => the_Child,
                        pivot_Axis   => pivot_Axis,
                        pivot_Anchor => pivot_Anchor);

      the_Joint.Limits_are (low_Limit, high_Limit);

      Self.attach (the_Child, the_Joint.all'Access);

      new_Joint := the_Joint.all'Access;
   end attach_via_Hinge;



   procedure attach_via_Hinge (Self : access Item;   the_Child  : in     Sprite.view;
                                                     pivot_Axis : in     Vector_3;
                                                     low_Limit  : in     Real;
                                                     high_Limit : in     Real;
                                                     new_joint  :    out gel.Joint.view)
   is
      the_Joint : constant gel.hinge_Joint.view := new gel.hinge_Joint.item;
   begin
      the_Joint.define (in_Space   => Self.World.Space,
                        Sprite_A   => Self,
                        Sprite_B   => the_Child,
                        pivot_Axis => pivot_Axis);

      the_Joint.Limits_are (low_Limit, high_Limit);

      Self.attach (the_Child, the_Joint.all'Access);

      new_Joint := the_Joint.all'Access;
   end attach_via_Hinge;



   procedure attach_via_Hinge (Self : access Item;   the_Child         : in     Sprite.view;
                                                     Frame_in_parent   : in     Matrix_4x4;
                                                     Frame_in_child    : in     Matrix_4x4;
                                                     Limits            : in     DoF_Limits;
                                                     collide_Connected : in     Boolean;
                                                     new_joint         :    out gel.Joint.view)
   is
      the_Joint : constant gel.hinge_Joint.view := new gel.hinge_Joint.item;
   begin
      the_Joint.define (Self.World.Space,
                        Self,             the_Child,
                        Frame_in_parent,  Frame_in_child,
                        Limits.Low,       Limits.High,
                        collide_Connected);

      the_Joint.Limits_are (limits.Low, limits.High);

      Self.attach (the_Child, the_Joint.all'Access);

      new_Joint := the_Joint.all'Access;
   end attach_via_Hinge;


   --  Ball/Socket
   --

   procedure internal_attach_via_ball_Socket (Self : access Item;   the_Child    : in Sprite.view;
                                                                    pitch_Limits : in DoF_Limits;
                                                                    yaw_Limits   : in DoF_Limits;
                                                                    roll_Limits  : in DoF_Limits;
                                                                    the_Joint    : in gel.any_Joint.view)
   is
      use gel.any_Joint;
   begin
      the_Joint.low_Bound_is  (Pitch, pitch_Limits.Low);
      the_Joint.low_Bound_is  (Yaw,   yaw_Limits  .Low);
      the_Joint.low_Bound_is  (Roll,  roll_Limits .Low);

      the_Joint.high_Bound_is (Pitch, pitch_Limits.High);
      the_Joint.high_Bound_is (Yaw,   yaw_Limits  .High);
      the_Joint.high_Bound_is (Roll,  roll_Limits .High);

      Self.attach (the_Child,  the_Joint.all'Access);
   end internal_attach_via_ball_Socket;



   procedure attach_via_ball_Socket (Self : access Item;   the_Child    : in     Sprite.view;
                                                           pivot_Anchor : in     Vector_3;
                                                           pivot_Axis   : in     Matrix_3x3;
                                                           pitch_Limits : in     DoF_Limits;
                                                           yaw_Limits   : in     DoF_Limits;
                                                           roll_Limits  : in     DoF_Limits;
                                                           new_joint    :    out gel.Joint.view)
   is
      the_Joint : constant gel.any_Joint.view := new gel.any_Joint.item;
   begin
      the_Joint.define (Self.World.Space,
                        Self,         the_Child,
                        pivot_Anchor, pivot_Axis);

      Self.internal_attach_via_ball_Socket (the_Child,
                                            pitch_Limits,
                                            yaw_Limits,
                                            roll_Limits,
                                            the_joint);
      new_Joint := the_Joint.all'Access;
   end attach_via_ball_Socket;



   procedure attach_via_ball_Socket (Self : access Item;   the_Child       : in     Sprite.view;
                                                           Frame_in_parent : in     Matrix_4x4;
                                                           Frame_in_child  : in     Matrix_4x4;
                                                           pitch_Limits    : in     DoF_Limits;
                                                           yaw_Limits      : in     DoF_Limits;
                                                           roll_Limits     : in     DoF_Limits;
                                                           new_joint       :    out gel.Joint.view)
   is
      the_Joint : constant gel.any_Joint.view := new gel.any_Joint.item;
   begin
      the_Joint.define (Self.World.Space,
                        Self,             the_Child,
                        Frame_in_parent,  Frame_in_child);

      Self.internal_attach_via_ball_Socket (the_Child,
                                            pitch_Limits,
                                            yaw_Limits,
                                            roll_Limits,
                                            the_joint);
      new_Joint := the_Joint.all'Access;
   end attach_via_ball_Socket;



   ------------
   --- Graphics
   --

   procedure program_Parameters_are  (Self : in out Item;   Now : in opengl.Program.Parameters_view)
   is
   begin
      Self.program_Parameters := Now;
   end program_Parameters_are;



   function program_Parameters (Self : in Item) return opengl.Program.Parameters_view
   is
   begin
      return Self.program_Parameters;
   end program_Parameters;


   -----------
   --- Utility
   --

   function to_Hash (Self : in ada.Tags.Tag) return ada.Containers.Hash_type
   is
      function Converted is new ada.unchecked_Conversion (ada.Tags.Tag, ada.Containers.Hash_type);
   begin
      return Converted (Self);
   end to_Hash;
   pragma Unreferenced (to_Hash);



   --  protected
   --  body safe_Matrix_4x4
   --  is
   --     function Value return Matrix_4x4
   --     is
   --     begin
   --        return the_Value;
   --     end Value;
   --
   --     procedure Value_is (Now : in Matrix_4x4)
   --     is
   --     begin
   --        the_Value := Now;
   --     end Value_is;
   --
   --     procedure Site_is (Now : in Vector_3)
   --     is
   --     begin
   --        the_Value (4, 1) := Now (1);
   --        the_Value (4, 2) := Now (2);
   --        the_Value (4, 3) := Now (3);
   --     end Site_is;
   --  end safe_Matrix_4x4;


end gel.Sprite;