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