1. with Entities;                          use Entities; 
  2. with Physics.Clip_Maps;                 use Physics.Clip_Maps; 
  3.  
  4. limited with Physics.Managers; 
  5.  
  6. private with Ada.Containers.Ordered_Maps; 
  7.  
  8. package Physics.Bodies is 
  9.  
  10.     -- A physical representation of an entity, used by the physics manager. 
  11.     type Corpus is tagged limited private; 
  12.     type A_Corpus is access all Corpus'Class; 
  13.  
  14.     -- Creates a new corpus representing entity 'id', for use by 'manager'. 
  15.     function Create_Corpus( id       : Entity_Id; 
  16.                             width, 
  17.                             height   : Natural; 
  18.                             physical : Boolean; 
  19.                             clipped  : Boolean; 
  20.                             manager  : access Physics.Managers.Physics_Manager'Class 
  21.                           ) return A_Corpus; 
  22.  
  23.     -- Performs collision detection and returns True if this corpus is touching 
  24.      -- 'that' corpus. The objects are not modified. 
  25.     function Detect_Collision( this : not null access Corpus'Class; 
  26.                                that : not null A_Corpus ) return Boolean; 
  27.  
  28.     -- Returns the entity id the corpus represents. 
  29.     function Get_Id( this : not null access Corpus'Class ) return Entity_Id; 
  30.  
  31.     -- Returns True if 'that' corpus is in this corpus' touch list. No collision 
  32.     -- detection is performed. 
  33.     function Is_Touching( this : not null access Corpus'Class; 
  34.                           that : not null A_Corpus ) return Boolean; 
  35.  
  36.     -- Marks the contact state between this corpus and 'that'. The corpus' touch 
  37.     -- list will be updated. Set 'inContact' to true if the two corps are in 
  38.     -- contact with each other. Corpus 'that' is not modified. 
  39.     procedure Mark_Contact( this      : not null access Corpus'Class; 
  40.                             that      : not null A_Corpus; 
  41.                             inContact : Boolean ); 
  42.  
  43.     -- Moves the entity to the given location. An Entity_Moved event is queued. 
  44.     -- Clipping is performed so an Entity_Grounded event may also be queued. 
  45.     procedure Move_To( this : not null access Corpus'Class; 
  46.                        map  : not null A_Clip_Map; 
  47.                        x, y : Float ); 
  48.  
  49.     -- Sets the acceleration in the X axis. 
  50.     procedure Set_AX( this : not null access Corpus'Class; ax : Float ); 
  51.  
  52.     -- Sets the acceleration in the Y axis. 
  53.     procedure Set_AY( this : not null access Corpus'Class; ay : Float ); 
  54.  
  55.     -- Sets the clipped attribute of the Corpus. Clipped corps are bounded by 
  56.     -- the wall tiles of the map. 
  57.     procedure Set_Clipped( this    : not null access Corpus'Class; 
  58.                            clipped : Boolean ); 
  59.  
  60.     -- Sets the Corpus' location. No event is queued. 
  61.     procedure Set_Location( this : not null access Corpus'Class; 
  62.                             map  : not null A_Clip_Map; 
  63.                             x, y : Float ); 
  64.  
  65.     -- Sets the physical attribute of the Corpus. Physical corps are affected by 
  66.     -- the forces of gravity and friction. 
  67.     procedure Set_Physical( this     : not null access Corpus'Class; 
  68.                             physical : Boolean ); 
  69.  
  70.     -- Sets the physical size of the Corpus. The Corpus is clipped to 'map' 
  71.     -- immediately. An Entity_Resized event is queued. 
  72.     procedure Set_Size( this   : not null access Corpus'Class; 
  73.                         map    : not null A_Clip_Map; 
  74.                         width, 
  75.                         height : Natural ); 
  76.  
  77.     -- Sets the target velocity in the X axis to accelerate toward. This does 
  78.     -- not have an immediate effect on the velocity. 
  79.     procedure Set_Target_VX( this : not null access Corpus'Class; vx : Float ); 
  80.  
  81.     -- Sets the target velocity in the Y axis to accelerate toward. This does 
  82.     -- not have an immediate effect on the velocity. 
  83.     procedure Set_Target_VY( this : not null access Corpus'Class; vy : Float ); 
  84.  
  85.     -- Sets the Corpus' velocity. 
  86.     procedure Set_Velocity( this : not null access Corpus'Class; vx, vy : Float ); 
  87.  
  88.     -- Ticks the Corpus' changes in velocity and position and performs clipping. 
  89.     -- If 'collide' is returned True then the Corpus location changed and 
  90.     -- collision detection needs to be performed on it. 
  91.     procedure Tick( this    : not null access Corpus'Class; 
  92.                     map     : not null A_Clip_Map; 
  93.                     dt      : Float; 
  94.                     collide : out Boolean ); 
  95.  
  96.     -- Returns a string representation of the Corpus. 
  97.     function To_String( this : access Corpus'Class ) return String; 
  98.  
  99.     -- Deletes the Corpus. 
  100.     procedure Delete( this : in out A_Corpus ); 
  101.     pragma Postcondition( this = null ); 
  102.  
  103. private 
  104.  
  105.     package Corps_Maps is new Ada.Containers.Ordered_Maps( Entity_Id, A_Corpus, "<", "=" ); 
  106.  
  107.     type Corpus is tagged limited 
  108.         record 
  109.             manager    : access Physics.Managers.Physics_Manager'Class := null; 
  110.             eid        : Entity_Id := INVALID_ID; 
  111.             width, 
  112.             height     : Natural := 0; 
  113.             width_2, 
  114.             height_2   : Natural := 0; 
  115.             physical   : Boolean := True;    -- apply gravity and friction 
  116.             clipped    : Boolean := True;    -- collide with the world 
  117.             collide    : Boolean := True;    -- need to check for collisions with other corps 
  118.  
  119.             x, y, 
  120.             oldX, oldY : Float := 0.0;       -- old x,y used only during a Tick 
  121.             vx, vy, 
  122.             tvx, tvy, 
  123.             ax, ay     : Float := 0.0; 
  124.             standing   : Boolean := False; 
  125.             touching   : Corps_Maps.Map; 
  126.         end record; 
  127.  
  128.     procedure Apply_Forces( this : not null access Corpus'Class; dt : Float ); 
  129.  
  130.     procedure Clip( this : not null access Corpus'Class; map : not null A_Clip_Map ); 
  131.  
  132. end Physics.Bodies;