with
     gel.Joint,

     openGL.Model,
     openGL.Visual,
     openGL.Program,

     physics.Model,
     physics.Object,
     physics.Shape,
     physics.Space,

     lace.Subject_and_deferred_Observer,
     lace.Response,
     lace.Any,

     ada.Containers.Vectors;

limited
with
     gel.World;


package gel.Sprite
--
--  Combines a graphics 'visual' and a physics 'solid'.
--
is
   type Item  is limited new lace.Subject_and_deferred_Observer.item with private;
   type View  is access all Item'Class;

   type Items is array (math.Index range <>) of aliased Item;
   type Views is array (math.Index range <>) of View;

   null_Sprites : constant Sprite.views;


   type physics_Space_view is access all physics.Space.item'Class;
   type World_view         is access all gel.World    .item'Class;

   type any_user_Data      is new        lace.Any.limited_item with null record;
   type any_user_Data_view is access all any_user_Data'Class;


   use Math;


   --------------
   --- Containers
   --

   --  pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.

   type Grid       is array (math.Index range <>,
                             math.Index range <>) of Sprite.view;
   type Grid_view  is access all Grid;

   package Vectors is new ada.Containers.Vectors (Positive, Sprite.view);


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

   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;
                                           user_Data      : in     any_user_Data_view := null);

   procedure destroy      (Self : access Item;   and_Children : in Boolean);
   function  is_Destroyed (Self : in     Item) return Boolean;
   procedure free         (Self : in out View);


   package 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;
                           user_Data      : in     any_user_Data_view := null) return Item;

      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;
                           user_Data      : in     any_user_Data_view := null) return View;
   end Forge;


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

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

   function  Id                    (Self : in     Item)     return gel.sprite_Id;
   procedure Id_is                 (Self : in out Item;   Now : in gel.sprite_Id);

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

   function  graphics_Model        (Self : in     Item)     return openGL.Model.view;
   procedure graphics_Model_is     (Self : in out Item;   Now : in openGL.Model.view);
   function  owns_Graphics         (Self : in     Item)           return Boolean;

   function  physics_Model         (Self : in     Item)     return access physics.Model.item'Class;
   procedure physics_Model_is      (Self : in out Item;   Now : in physics.Model.view);

   function  Scale                 (Self : in     Item)     return Vector_3;
   procedure Scale_is              (Self : in out Item;   Now : in Vector_3);

   function  Mass                  (Self : in     Item)     return Real;
   function  is_Static             (Self : in     Item)     return Boolean;
   function  is_Kinematic          (Self : in     Item)     return Boolean;

   function  Depth_in_camera_space (Self : in     Item)     return Real;

   procedure mvp_Matrix_is         (Self : in out Item;   Now : in Matrix_4x4);
   function  mvp_Matrix            (Self : in     Item)     return Matrix_4x4;

   procedure is_Visible            (Self : in out Item;   Now : in Boolean := True);
   function  is_Visible            (Self : in     Item)     return Boolean;

   procedure key_Response_is       (Self : in out Item;   Now : in lace.Response.view);
   function  key_Response          (Self : in     Item)     return lace.Response.view;


   subtype physics_Object_view is physics.Object.view;
   subtype physics_Shape_view  is physics.Shape .view;

   function  Solid                 (Self : in     Item)     return physics_Object_view;
   procedure Solid_is              (Self : in out Item;   Now : in physics_Object_view);

   function  Shape                 (Self : in     Item)     return physics_Shape_view;


   function  to_GEL (the_Solid : in physics_Object_view) return gel.Sprite.view;


   function  user_Data             (Self : in     Item) return any_user_Data_view;
   procedure user_Data_is (Self : in out Item;   Now :      in any_user_Data_view);


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

   --- Bounds
   --

   function Bounds (Self : in Item) return Geometry_3d.bounding_Box;


   --- Site
   --

   function  Site    (Self : in     Item)         return Vector_3;
   procedure Site_is (Self : in out Item;   Now     : in Vector_3);
   procedure move    (Self : in out Item;   to_Site : in Vector_3);
   --
   --  Moves the sprite to a new site and recursively move children such that
   --  relative positions are maintained.


   --- Spin
   --

   function  Spin       (Self : in     Item)         return Matrix_3x3;
   procedure Spin_is    (Self : in out Item;   Now     : in Matrix_3x3);

   function  xy_Spin    (Self : in     Item)         return Radians;
   procedure xy_Spin_is (Self : in out Item;   Now     : in Radians);

   procedure rotate     (Self : in out Item;   to_Spin : in Matrix_3x3);
   --
   --  Rotates the sprite to a new spin and recursively moves and rotates children such that
   --  relative positions/orientations are maintained.


   --- Transform
   --

   function  Transform    (Self : in     Item)     return Matrix_4x4;
   procedure Transform_is (Self : in out Item;   Now : in Matrix_4x4);


   --- Speed
   --

   function  Speed     (Self : in     Item)          return Vector_3;
   procedure Speed_is  (Self : in out Item;   Now      : in Vector_3);

   procedure set_Speed (Self : in out Item;   to_Speed : in Vector_3);
   --
   --  Set Self and all children to given value.


   --- Gyre
   --

   function  Gyre     (Self : in     Item)         return Vector_3;
   procedure Gyre_is  (Self : in out Item;   Now     : in Vector_3);
   procedure set_Gyre (Self : in out Item;   to_Gyre : in Vector_3);
   --
   --  Set Self and all children to given value.


   --- Forces
   --

   procedure apply_Torque         (Self : in out Item;   Torque : in Vector_3);
   procedure apply_Torque_impulse (Self : in out Item;   Torque : in Vector_3);
   procedure apply_Force          (Self : in out Item;   Force  : in Vector_3);


   --- Mirrored Dynamics
   --

   procedure desired_Dynamics_are (Self : in out Item;   Site : in Vector_3;
                                                         Spin : in Quaternion);
   procedure interpolate_Motion   (Self : in out Item);


   --- Hierachy
   --

   type DoF_Limits is
      record
         Low  : math.Real;
         High : math.Real;
      end record;

   function  parent_Joint (Self : in     Item) return gel.Joint.view;
   function  child_Joints (Self : in     Item) return gel.Joint.views;

   function  top_Parent   (Self : access Item) return gel.Sprite.view;
   function  Parent       (Self : in     Item) return gel.Sprite.view;
   function  tree_Depth   (Self : in     Item) return Natural;

   procedure detach       (Self : in out Item;   the_Child : gel.Sprite.view);

   no_such_Child : exception;


   type Action is access procedure (the_Sprite : in out Item'Class);

   procedure apply (Self : in out Item;   do_Action : Action);
   --
   -- Applies an action to a sprite and its children recursively.


   ---  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);


   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);

   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);
   --
   --  Uses midpoint between Self and the_Child sprite as pivot_Anchor.


   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);


   ---  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);

   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);

   --- Graphics
   --
   procedure program_Parameters_are  (Self : in out Item;   Now : in opengl.Program.Parameters_view);
   function  program_Parameters      (Self : in     Item)  return opengl.Program.Parameters_view;


   --- Physics
   --
   procedure rebuild_Shape (Self : in out Item);
   procedure rebuild_Solid (Self : in out Item;   at_Site : in Vector_3);



   -- Motion Updates
   --
   function has_Moved (Self : in out Item;   current_Site : Vector_3;
                                             current_Spin : Matrix_3x3) return Boolean;






private

   type access_Joint_views is access all Joint.views;

   use type Joint.view;
   package joint_Vectors is new ada.Containers.Vectors (Positive, Joint.view);


   --  protected
   --  type safe_Matrix_4x4
   --  is
   --     function  Value       return Matrix_4x4;
   --     procedure Value_is (Now : in Matrix_4x4);
   --     procedure Site_is  (Now : in Vector_3);
   --
   --  private
   --     the_Value : Matrix_4x4 := Identity_4x4;
   --  end safe_Matrix_4x4;


   -----------------
   --- Interpolation
   --

   type site_Interpolation is
      record
         Initial : Vector_3;
         Desired : Vector_3;
      end record;

   type spin_Interpolation is
      record
         Initial : Quaternion;
         Desired : Quaternion;
      end record;

   type Interpolation is
      record
         Site    : site_Interpolation;
         Spin    : spin_Interpolation;
         Percent : unit_Percentage;
      end record;


   protected
   type safe_Interpolation
   is
      procedure set (desired_Site : in Vector_3;
                     desired_Spin : in Quaternion);
      procedure get (Site : out Vector_3;
                     Spin : out Quaternion);
   private
      Safe : Interpolation := (Site    => (Initial => Origin_3D,
                                           Desired => Origin_3D),
                               Spin    => (Initial => (R =>  0.0,
                                                       V => [0.0, 1.0, 0.0]),
                                           Desired => (R =>  0.0,
                                                       V => [0.0, 1.0, 0.0])),
                               Percent => 0.0);
   end safe_Interpolation;


   ---------------
   --- Sprite Item
   --

   type Item is limited new lace.Subject_and_deferred_Observer.item with
      record
         Id                      : gel.sprite_Id := null_sprite_Id;

         Visual                  : openGL.Visual.view := new openGL.Visual.item;
         program_Parameters      : openGL.program.Parameters_view;
         owns_Graphics           : Boolean;

         physics_Model           : physics.Model.view;
         owns_Physics            : Boolean;

         World                   : World_view;
         Shape                   : physics_Shape_view;
         Solid                   : physics_Object_view;
         is_Kinematic            : Boolean;

         Depth_in_camera_space   : Real;

         Interpolation           : safe_Interpolation;

         parent_Joint            : gel.Joint.view;
         child_Joints            : joint_Vectors.Vector;

         is_Visible              : Boolean := True;
         key_Response            : lace.Response.view;
         user_Data               : any_user_Data_view;

         is_Destroyed            : Boolean := False;

         -- Motion Updates
         --
         prior_Site : Vector_3   := Origin_3D;
         prior_Spin : Matrix_3x3 := Identity_3x3;
      end record;


   null_Sprites : constant Sprite.views (1 .. 0) := [others => null];

end gel.Sprite;
