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 Associations;                      use Associations; 
  10. with Directions;                        use Directions; 
  11. with Events; 
  12. with Entities;                          use Entities; 
  13. with Hashed_Strings;                    use Hashed_Strings; 
  14. with Values;                            use Values; 
  15.  
  16. pragma Elaborate_All( Events ); 
  17.  
  18. package Events.Entities is 
  19.  
  20.     -- An abstract event involving an entity. 
  21.     type Entity_Event is abstract new Event with private; 
  22.  
  23.     -- Returns the Entity_Id of the entity involved in the event. 
  24.     function Get_Id( this : not null access Entity_Event'Class ) return Entity_Id; 
  25.  
  26.     ---------------------------------------------------------------------------- 
  27.  
  28.     -- An abstract event involving the interaction of two entities. 
  29.     type Entities_Event is abstract new Event with private; 
  30.  
  31.     -- Returns the Entity_Id of the first entity involved in the interaction, 
  32.     -- deemed entity A. 
  33.     function Get_A( this : not null access Entities_Event'Class ) return Entity_Id; 
  34.  
  35.     -- Returns the Entity_Id of the second entity involved in the interaction, 
  36.     -- deemed entity B. 
  37.     function Get_B( this : not null access Entities_Event'Class ) return Entity_Id; 
  38.  
  39.     ---------------------------------------------------------------------------- 
  40.  
  41.     ACCELERATE_ID : constant Event_Id := To_Event_Id( "Accelerate" ); 
  42.  
  43.     -- A command to change the acceleration of an entity by Entity_Id. 
  44.     type Accelerate_Event is new Entity_Event with private; 
  45.     type A_Accelerate_Event is access all Accelerate_Event'Class; 
  46.  
  47.     function Get_Acceleration( this : not null access Accelerate_Event'Class ) return Float; 
  48.     pragma Postcondition( Get_Acceleration'Result >= 0.0 ); 
  49.  
  50.     function Get_Direction( this : not null access Accelerate_Event'Class ) return Cardinal_Direction; 
  51.  
  52.     function Get_Velocity( this : not null access Accelerate_Event'Class ) return Float; 
  53.     pragma Postcondition( Get_Velocity'Result >= 0.0 ); 
  54.  
  55.     ---------------------------------------------------------------------------- 
  56.  
  57.     DELETE_ENTITY_ID : constant Event_Id := To_Event_Id( "Delete_Entity" ); 
  58.  
  59.     -- A command to delete an entity by Entity_Id. 
  60.     type Delete_Entity_Event is new Entity_Event with private; 
  61.     type A_Delete_Entity_Event is access all Delete_Entity_Event'Class; 
  62.  
  63.     ---------------------------------------------------------------------------- 
  64.  
  65.     ENTITIES_COLLIDED_ID: constant Event_Id := To_Event_Id( "Entities_Collided" ); 
  66.  
  67.     -- A notification that two entities collided (began touching). 
  68.     type Entities_Collided_Event is new Entities_Event with private; 
  69.     type A_Entities_Collided_Event is access all Entities_Collided_Event'Class; 
  70.  
  71.     ---------------------------------------------------------------------------- 
  72.  
  73.     ENTITIES_SEPARATED_ID: constant Event_Id := To_Event_Id( "Entities_Separated" ); 
  74.  
  75.     -- A notification that two entities separated (are no longer touching). 
  76.     type Entities_Separated_Event is new Entities_Event with private; 
  77.     type A_Entities_Separated_Event is access all Entities_Separated_Event'Class; 
  78.  
  79.     ---------------------------------------------------------------------------- 
  80.  
  81.     -- An abstract event involving an entity attribute. 
  82.     type Entity_Attribute_Event is new Entity_Event with private; 
  83.  
  84.     -- Returns a copy of the attribute value. The caller is responsible for 
  85.     -- deleting the object. 
  86.     procedure Copy_Value( this : access Entity_Attribute_Event; 
  87.                           val  : in out A_Value ); 
  88.     pragma Precondition( val = null ); 
  89.  
  90.     -- Returns the attribute name. 
  91.     function Get_Attribute( this : access Entity_Attribute_Event ) return String; 
  92.     pragma Postcondition( Get_Attribute'Result'Length > 0 ); 
  93.  
  94.     ---------------------------------------------------------------------------- 
  95.  
  96.     ENTITY_ATTRIBUTE_CHANGED_ID : constant Event_Id := To_Event_Id( "Entity_Attribute_Changed" ); 
  97.  
  98.     -- A notification that an entity attribute has changed. 
  99.     type Entity_Attribute_Changed_Event is new Entity_Attribute_Event with private; 
  100.     type A_Entity_Attribute_Changed_Event is access all Entity_Attribute_Changed_Event; 
  101.  
  102.     ---------------------------------------------------------------------------- 
  103.  
  104.     ENTITY_CREATED_ID : constant Event_Id := To_Event_Id( "Entity_Created" ); 
  105.  
  106.     -- A notification that a new entity has been created. 
  107.     type Entity_Created_Event is new Entity_Event with private; 
  108.     type A_Entity_Created_Event is access all Entity_Created_Event'Class; 
  109.  
  110.     -- Returns a copy of the entity's attributes as an association. 
  111.     procedure Copy_Attributes( this       : not null access Entity_Created_Event'Class; 
  112.                                attributes : in out A_Association ); 
  113.     pragma Precondition( attributes = null ); 
  114.     pragma Postcondition( attributes /= null ); 
  115.  
  116.     -- Returns the entity's class name. 
  117.     function Get_Class( this : not null access Entity_Created_Event'Class ) return String; 
  118.     pragma Postcondition( Get_Class'Result'Length > 0 ); 
  119.  
  120.     -- Returns the entity's current display frame or 0 for none. 
  121.     function Get_Frame( this : not null access Entity_Created_Event'Class ) return Natural; 
  122.  
  123.     -- Returns the physical height of the entity in world units. 
  124.     function Get_Height( this : not null access Entity_Created_Event'Class ) return Natural; 
  125.  
  126.     -- Returns the name of the library that contains the entity's frames. 
  127.     function Get_Lib_Name( this : not null access Entity_Created_Event'Class ) return String; 
  128.  
  129.     -- Returns the physical width of the entity in world units. 
  130.     function Get_Width( this : not null access Entity_Created_Event'Class ) return Natural; 
  131.  
  132.     -- Returns the X coordinate of the entity in world coordinates. 
  133.     function Get_X( this : not null access Entity_Created_Event'Class ) return Float; 
  134.  
  135.     -- Returns the X velocity of the entity in world units per second. 
  136.     function Get_XV( this : not null access Entity_Created_Event'Class ) return Float; 
  137.  
  138.     -- Returns the Y coordinate of the entity in world coordinates. 
  139.     function Get_Y( this : not null access Entity_Created_Event'Class ) return Float; 
  140.  
  141.     -- Returns the Y velocity of the entity in world units per second. 
  142.     function Get_YV( this : not null access Entity_Created_Event'Class ) return Float; 
  143.  
  144.     -- Returns True if the entity is clipped to the solid walls in the world. 
  145.     function Is_Clipped( this : not null access Entity_Created_Event'Class ) return Boolean; 
  146.  
  147.     -- Returns True if the entity is invisible, existing metaphysically like a 
  148.     -- Trigger. 
  149.     function Is_Metaphysical( this : not null access Entity_Created_Event'Class ) return Boolean; 
  150.  
  151.     -- Returns True if physics apply to the entity, ie: gravity. 
  152.     function Is_Physical( this : not null access Entity_Created_Event'Class ) return Boolean; 
  153.  
  154.     ---------------------------------------------------------------------------- 
  155.  
  156.     ENTITY_DELETED_ID : constant Event_Id := To_Event_Id( "Entity_Deleted" ); 
  157.  
  158.     -- A notification that an entity was deleted. 
  159.     type Entity_Deleted_Event is new Entity_Event with private; 
  160.     type A_Entity_Deleted_Event is access all Entity_Deleted_Event'Class; 
  161.  
  162.     ---------------------------------------------------------------------------- 
  163.  
  164.     -- An abstract event involving the interaction of an entity with a tile. 
  165.     type Entity_Tile_Event is abstract new Entity_Event with private; 
  166.  
  167.     -- Returns the X location in tile coordinates. 
  168.     function Get_X( this : not null access Entity_Tile_Event'Class ) return Natural; 
  169.  
  170.     -- Returns the Y location in tile coordinates. 
  171.     function Get_Y( this : not null access Entity_Tile_Event'Class ) return Natural; 
  172.  
  173.     ---------------------------------------------------------------------------- 
  174.  
  175.     ENTITY_ENTERED_TILE_ID : constant Event_Id := To_Event_Id( "Entity_Entered_Tile" ); 
  176.  
  177.     -- A notification that part of an entity's bounding rectangle entered a tile. 
  178.     type Entity_Entered_Tile_Event is new Entity_Tile_Event with private; 
  179.     type A_Entity_Entered_Tile_Event is access all Entity_Entered_Tile_Event'Class; 
  180.  
  181.     ---------------------------------------------------------------------------- 
  182.  
  183.     ENTITY_EXITED_TILE_ID : constant Event_Id := To_Event_Id( "Entity_Exited_Tile" ); 
  184.  
  185.     -- A notification that no part of an entity's bounding rectangle is now 
  186.     -- touching a tile. 
  187.     type Entity_Exited_Tile_Event is new Entity_Tile_Event with private; 
  188.     type A_Entity_Exited_Tile_Event is access all Entity_Exited_Tile_Event'Class; 
  189.  
  190.     ---------------------------------------------------------------------------- 
  191.  
  192.     ENTITY_FACE_ID : constant Event_Id := To_Event_Id( "Entity_Face" ); 
  193.  
  194.     -- A command to set the direction than an entity should face. 
  195.     type Entity_Face_Event is new Entity_Event with private; 
  196.     type A_Entity_Face_Event is access all Entity_Face_Event'Class; 
  197.  
  198.     -- Returns the direction for the entity to face. 
  199.     function Get_Direction( this : not null access Entity_Face_Event'Class ) return Direction_Type; 
  200.  
  201.     ---------------------------------------------------------------------------- 
  202.  
  203.     ENTITY_GROUNDED_ID : constant Event_Id := To_Event_Id( "Entity_Grounded" ); 
  204.  
  205.     -- A notification that an entity has landed on/left the ground. 
  206.     type Entity_Grounded_Event is new Entity_Event with private; 
  207.     type A_Entity_Grounded_Event is access all Entity_Grounded_Event'Class; 
  208.  
  209.     -- Returns True if the entity landed on the ground or False if the entity 
  210.     -- left the ground. 
  211.     function Is_Grounded( this : not null access Entity_Grounded_Event'Class ) return Boolean; 
  212.  
  213.     ---------------------------------------------------------------------------- 
  214.  
  215.     ENTITY_HIT_WALL_ID : constant Event_Id := To_Event_Id( "Entity_Hit_Wall" ); 
  216.  
  217.     -- A notification that a clipped entity collided with a wall and was stopped. 
  218.     type Entity_Hit_Wall_Event is new Entity_Event with private; 
  219.     type A_Entity_Hit_Wall_Event is access all Entity_Hit_Wall_Event'Class; 
  220.  
  221.     -- Returns the direction that the entity was travelling when it hit the wall. 
  222.     function Get_Direction( this : not null access Entity_Hit_Wall_Event'Class ) return Cardinal_Direction; 
  223.  
  224.     -- Returns True if this is the entity's first contact with the wall in that 
  225.     -- direction. If the entity hits the wall and continues accelerating into 
  226.     -- it, pressing against it, then this will return False until the entity 
  227.     -- moves away from the wall and hits it again. 
  228.     function Is_First_Contact( this : not null access Entity_Hit_Wall_Event'Class ) return Boolean; 
  229.  
  230.     ---------------------------------------------------------------------------- 
  231.  
  232.     ENTITY_MOVED_ID : constant Event_Id := To_Event_Id( "Entity_Moved" ); 
  233.  
  234.     -- A notification that an entity moved. 
  235.     type Entity_Moved_Event is new Entity_Event with private; 
  236.     type A_Entity_Moved_Event is access all Entity_Moved_Event'Class; 
  237.  
  238.     -- Returns the entity's new X coordinate in world units. 
  239.     function Get_X( this : not null access Entity_Moved_Event'Class ) return Float; 
  240.  
  241.     -- Returns the entity's X velocity in world units per second. 
  242.     function Get_XV( this : not null access Entity_Moved_Event'Class ) return Float; 
  243.  
  244.     -- Returns the entity's new Y coordinate in world units. 
  245.     function Get_Y( this : not null access Entity_Moved_Event'Class ) return Float; 
  246.  
  247.     -- Returns the entity's Y velocity in world units per second. 
  248.     function Get_YV( this : not null access Entity_Moved_Event'Class ) return Float; 
  249.  
  250.     ---------------------------------------------------------------------------- 
  251.  
  252.     ENTITY_RESIZED_ID : constant Event_Id := To_Event_Id( "Entity_Resized" ); 
  253.  
  254.     -- A notification that an entity's physical size changed. 
  255.     type Entity_Resized_Event is new Entity_Event with private; 
  256.     type A_Entity_Resized_Event is access all Entity_Resized_Event'Class; 
  257.  
  258.     -- Returns the entity's new height in world units. 
  259.     function Get_Height( this : not null access Entity_Resized_Event'Class ) return Natural; 
  260.  
  261.     -- Returns the entity's new width in world units. 
  262.     function Get_Width( this : not null access Entity_Resized_Event'Class ) return Natural; 
  263.  
  264.     ---------------------------------------------------------------------------- 
  265.  
  266.     FOLLOW_ENTITY_ID : constant Event_Id := To_Event_Id( "Follow_Entity" ); 
  267.  
  268.     -- A command to the game view follow an entity with the view's viewport. 
  269.     type Follow_Entity_Event is new Entity_Event with private; 
  270.     type A_Follow_Entity_Event is access all Follow_Entity_Event'Class; 
  271.  
  272.     ---------------------------------------------------------------------------- 
  273.  
  274.     FRAME_CHANGED_ID : constant Event_Id := To_Event_Id( "Frame_Changed" ); 
  275.  
  276.     -- A notification that an entity's display frame has changed. 
  277.     type Frame_Changed_Event is new Entity_Event with private; 
  278.     type A_Frame_Changed_Event is access all Frame_Changed_Event'Class; 
  279.  
  280.     -- Returns the id of the new display frame or 0 for none. 
  281.     function Get_Frame( this : not null access Frame_Changed_Event'Class ) return Natural; 
  282.  
  283.     ---------------------------------------------------------------------------- 
  284.  
  285.     IMPULSE_ID : constant Event_Id := To_Event_Id( "Impulse" ); 
  286.  
  287.     -- A command sent to an entity. The entity may choose to respond to the 
  288.     -- impulse depending on its current state and the impulse (command) given. 
  289.     type Impulse_Event is new Entity_Event with private; 
  290.     type A_Impulse_Event is access all Impulse_Event'Class; 
  291.  
  292.     -- Returns the name of the impulse being sent to the entity. 
  293.     function Get_Impulse_Name( this : not null access Impulse_Event'Class ) return Hashed_String; 
  294.  
  295.     ---------------------------------------------------------------------------- 
  296.  
  297.     MOVE_ENTITY_ID : constant Event_Id := To_Event_Id( "Move_Entity" ); 
  298.  
  299.     -- A command to move an entity. 
  300.     type Move_Entity_Event is new Entity_Event with private; 
  301.     type A_Move_Entity_Event is access all Move_Entity_Event'Class; 
  302.  
  303.     -- Returns the new X coordinate for the entity in world units. 
  304.     function Get_X( this : not null access Move_Entity_Event'Class ) return Float; 
  305.  
  306.     -- Returns the new Y coordinate for the entity in world units. 
  307.     function Get_Y( this : not null access Move_Entity_Event'Class ) return Float; 
  308.  
  309.     ---------------------------------------------------------------------------- 
  310.  
  311.     RESIZE_ENTITY_ID : constant Event_Id := To_Event_Id( "Resize_Entity" ); 
  312.  
  313.     -- A command to change the physical size of an entity. 
  314.     type Resize_Entity_Event is new Entity_Event with private; 
  315.     type A_Resize_Entity_Event is access all Resize_Entity_Event'Class; 
  316.  
  317.     -- Returns the new height for the entity in world units. 
  318.     function Get_Height( this : not null access Resize_Entity_Event'Class ) return Natural; 
  319.  
  320.     -- Returns the new width for the entity in world units. 
  321.     function Get_Width( this : not null access Resize_Entity_Event'Class ) return Natural; 
  322.  
  323.     ---------------------------------------------------------------------------- 
  324.  
  325.     SET_ENTITY_ATTRIBUTE_ID : constant Event_Id := To_Event_Id( "Set_Entity_Attribute" ); 
  326.  
  327.     -- A command to set an attribute of an entity. 
  328.     type Set_Entity_Attribute_Event is new Entity_Attribute_Event with private; 
  329.     type A_Set_Entity_Attribute_Event is access all Set_Entity_Attribute_Event; 
  330.  
  331.     ---------------------------------------------------------------------------- 
  332.  
  333.     SPAWN_ENTITY_ID : constant Event_Id := To_Event_Id( "Spawn_Entity" ); 
  334.  
  335.     -- A command to create a new entity. 
  336.     type Spawn_Entity_Event is new Event with private; 
  337.     type A_Spawn_Entity_Event is access all Spawn_Entity_Event; 
  338.  
  339.     -- Returns the physical height for the entity in world units. 
  340.     function Get_Height( this : access Spawn_Entity_Event ) return Integer; 
  341.  
  342.     -- Returns class id of the entity to create. 
  343.     function Get_Id( this : access Spawn_Entity_Event ) return String; 
  344.  
  345.     -- Returns the physical width for the entity in world units. 
  346.     function Get_Width( this : access Spawn_Entity_Event ) return Integer; 
  347.  
  348.     -- Returns the X coordinate for the entity in world units. 
  349.     function Get_X( this : access Spawn_Entity_Event ) return Float; 
  350.  
  351.     -- Returns the X velocity for the entity in world units per second. 
  352.     function Get_XV( this : access Spawn_Entity_Event ) return Float; 
  353.  
  354.     -- Returns the Y coordinate for the entity in world units. 
  355.     function Get_Y( this : access Spawn_Entity_Event ) return Float; 
  356.  
  357.     -- Returns the Y velocity for the entity in world units per second. 
  358.     function Get_YV( this : access Spawn_Entity_Event ) return Float; 
  359.  
  360.     ---------------------------------------------------------------------------- 
  361.  
  362.     -- Queues an Accelerate_Event. 
  363.     procedure Queue_Accelerate( id  : Entity_Id; 
  364.                                 dir : Cardinal_Direction; 
  365.                                 vel : Float; 
  366.                                 acc : Float ); 
  367.     pragma Precondition( vel >= 0.0 ); 
  368.     pragma Precondition( acc >= 0.0 ); 
  369.  
  370.     -- Queues a Delete_Entity_Event. 
  371.     procedure Queue_Delete_Entity( id : Entity_Id ); 
  372.  
  373.     -- Queues an Entities_Collided_Event. 
  374.     procedure Queue_Entities_Collided( a, b : Entity_Id ); 
  375.  
  376.     -- Queues an Entities_Separated_Event. 
  377.     procedure Queue_Entities_Separated( a, b : Entity_Id ); 
  378.  
  379.     -- Queues an Entity_Attribute_Changed_Event. 
  380.     procedure Queue_Entity_Attribute_Changed( id        : Entity_Id; 
  381.                                               attribute : String; 
  382.                                               val       : in out A_Value ); 
  383.     pragma Precondition( attribute'Length > 0 ); 
  384.     pragma Postcondition( val = null ); 
  385.  
  386.     -- Queues an Entity_Created_Event. Argument 'attributes' is copied and not 
  387.     -- modified. 
  388.     procedure Queue_Entity_Created( id           : Entity_Id; 
  389.                                     class        : String; 
  390.                                     physical, 
  391.                                     metaphysical, 
  392.                                     clipped      : Boolean; 
  393.                                     width, 
  394.                                     height       : Natural; 
  395.                                     x, y         : Float; 
  396.                                     xv, yv       : Float; 
  397.                                     libName      : String; 
  398.                                     frame        : Natural; 
  399.                                     attributes   : not null A_Association ); 
  400.     pragma Precondition( class'Length > 0 ); 
  401.  
  402.     -- Queues an Entity_Deleted_Event. 
  403.     procedure Queue_Entity_Deleted( id : Entity_Id ); 
  404.  
  405.     -- Queues an Entity_Entered_Tile_Event. 
  406.     procedure Queue_Entity_Entered_Tile( id : Entity_Id; x, y : Natural ); 
  407.  
  408.     -- Queues an Entity_Exited_Tile_Event. 
  409.     procedure Queue_Entity_Exited_Tile( id : Entity_Id; x, y : Natural ); 
  410.  
  411.     -- Queues an Entity_Face_Event. 
  412.     procedure Queue_Entity_Face( id : Entity_Id; dir : Direction_Type ); 
  413.  
  414.     -- Queues an Entity_Grounded_Event. 
  415.     procedure Queue_Entity_Grounded( id : Entity_Id; grounded : Boolean ); 
  416.  
  417.     -- Queues an Entity_Hit_Wall_Event. Set 'firstContact' True if the entity 
  418.     -- bumped into the wall, or False if the entity already made contact with 
  419.     -- the wall and is pressing itself against it. 
  420.     procedure Queue_Entity_Hit_Wall( id           : Entity_Id; 
  421.                                      dir          : Cardinal_Direction; 
  422.                                      firstContact : Boolean ); 
  423.  
  424.     -- Queues an Entity_Moved_Event. 
  425.     procedure Queue_Entity_Moved( id : Entity_Id; x, y, xv, yv : Float ); 
  426.  
  427.     -- Queues an Entity_Resized_Event. 
  428.     procedure Queue_Entity_Resized( id : Entity_Id; width, height : Natural ); 
  429.  
  430.     -- Queues an Impulse_Event. 
  431.     procedure Queue_Impulse( id : Entity_Id; name : Hashed_String ); 
  432.  
  433.     -- Queues a Follow_Entity_Event. 
  434.     procedure Queue_Follow_Entity( id : Entity_Id ); 
  435.  
  436.     -- Queues a Frame_Changed_Event. 
  437.     procedure Queue_Frame_Changed( id : Entity_Id; frame : Natural ); 
  438.  
  439.     -- Queues a Move_Entity_Event. 
  440.     procedure Queue_Move_Entity( id : Entity_Id; x, y : Float ); 
  441.  
  442.     -- Queues a Resize_Entity_Event. 
  443.     procedure Queue_Resize_Entity( id : Entity_Id; width, height : Natural ); 
  444.  
  445.     -- Queues a Set_Entity_Attribute_Event with a value of any type. 
  446.     procedure Queue_Set_Entity_Attribute( id        : Entity_Id; 
  447.                                           attribute : String; 
  448.                                           val       : in out A_Value ); 
  449.     pragma Precondition( attribute'Length > 0 ); 
  450.     pragma Postcondition( val = null ); 
  451.  
  452.     -- Queues a Set_Entity_Attribute_Event with a boolean value. 
  453.     procedure Queue_Set_Entity_Attribute( id        : Entity_Id; 
  454.                                           attribute : String; 
  455.                                           val       : Boolean ); 
  456.     pragma Precondition( attribute'Length > 0 ); 
  457.  
  458.     -- Queues a Spawn_Entity_Event. 
  459.     procedure Queue_Spawn_Entity( id     : String; 
  460.                                   x, y   : Float; 
  461.                                   width, 
  462.                                   height : Natural := 0; 
  463.                                   xv, yv : Float := 0.0 ); 
  464.     pragma Precondition( id'Length > 0 ); 
  465.  
  466. private 
  467.  
  468.     type Entity_Event is abstract new Event with 
  469.         record 
  470.             id : Entity_Id := INVALID_ID; 
  471.         end record; 
  472.  
  473.     procedure Construct( this : access Entity_Event; name : String; id : Entity_Id ); 
  474.     pragma Precondition( name'Length > 0 ); 
  475.  
  476.     function To_String( this : access Entity_Event ) return String; 
  477.  
  478.     ---------------------------------------------------------------------------- 
  479.  
  480.     type Entities_Event is abstract new Event with 
  481.         record 
  482.             a, b : Entity_Id := INVALID_ID; 
  483.         end record; 
  484.  
  485.     procedure Construct( this : access Entities_Event; name : String; a, b : Entity_Id ); 
  486.     pragma Precondition( name'Length > 0 ); 
  487.  
  488.     function To_String( this : access Entities_Event ) return String; 
  489.  
  490.     ---------------------------------------------------------------------------- 
  491.  
  492.     type Accelerate_Event is new Entity_Event with 
  493.         record 
  494.             dir : Cardinal_Direction := Left; 
  495.             vel : Float := 0.0; 
  496.             acc : Float := 0.0; 
  497.         end record; 
  498.  
  499.     procedure Construct( this : access Accelerate_Event; 
  500.                          id   : Entity_Id; 
  501.                          dir  : Cardinal_Direction; 
  502.                          vel  : Float; 
  503.                          acc  : Float ); 
  504.  
  505.     ---------------------------------------------------------------------------- 
  506.  
  507.     type Delete_Entity_Event is new Entity_Event with null record; 
  508.  
  509.     procedure Construct( this : access Delete_Entity_Event; id : Entity_Id ); 
  510.  
  511.     ---------------------------------------------------------------------------- 
  512.  
  513.     type Entities_Collided_Event is new Entities_Event with null record; 
  514.  
  515.     procedure Construct( this : access Entities_Collided_Event; a, b : Entity_Id ); 
  516.  
  517.     ---------------------------------------------------------------------------- 
  518.  
  519.     type Entities_Separated_Event is new Entities_Event with null record; 
  520.  
  521.     procedure Construct( this : access Entities_Separated_Event; a, b : Entity_Id ); 
  522.  
  523.     ---------------------------------------------------------------------------- 
  524.  
  525.     type Entity_Attribute_Event is new Entity_Event with 
  526.         record 
  527.             attribute : Unbounded_String; 
  528.             val       : A_Value := null; 
  529.         end record; 
  530.  
  531.     procedure Adjust( this : access Entity_Attribute_Event ); 
  532.  
  533.     -- 'name' is event name 
  534.     -- 'attribute' is the name of the attribute 
  535.     -- 'val' is the value of the attribute 
  536.     procedure Construct( this      : access Entity_Attribute_Event; 
  537.                          name      : String; 
  538.                          id        : Entity_Id; 
  539.                          attribute : String; 
  540.                          val       : in out A_Value ); 
  541.     pragma Precondition( name'Length > 0 ); 
  542.     pragma Precondition( attribute'Length > 0 ); 
  543.     pragma Postcondition( val = null ); 
  544.  
  545.     procedure Delete( this : in out Entity_Attribute_Event ); 
  546.  
  547.     ---------------------------------------------------------------------------- 
  548.  
  549.     type Entity_Attribute_Changed_Event is new Entity_Attribute_Event with null record; 
  550.  
  551.     procedure Construct( this      : access Entity_Attribute_Changed_Event; 
  552.                          id        : Entity_Id; 
  553.                          attribute : String; 
  554.                          val       : in out A_Value ); 
  555.     pragma Precondition( attribute'Length > 0 ); 
  556.     pragma Postcondition( val = null ); 
  557.  
  558.     ---------------------------------------------------------------------------- 
  559.  
  560.     type Entity_Created_Event is new Entity_Event with 
  561.         record 
  562.             class        : Unbounded_String; 
  563.             physical     : Boolean := True; 
  564.             metaphysical : Boolean := False; 
  565.             clipped      : Boolean := True; 
  566.             width, 
  567.             height       : Natural := 0; 
  568.             x, y         : Float := 0.0; 
  569.             xv, yv       : Float := 0.0; 
  570.             libName      : Unbounded_String; 
  571.             frame        : Natural := 0; 
  572.             attributes   : A_Association := null; 
  573.         end record; 
  574.  
  575.     procedure Adjust( this : access Entity_Created_Event ); 
  576.  
  577.     procedure Construct( this         : access Entity_Created_Event; 
  578.                          id           : Entity_Id; 
  579.                          class        : String; 
  580.                          physical, 
  581.                          metaphysical, 
  582.                          clipped      : Boolean; 
  583.                          width, 
  584.                          height       : Natural; 
  585.                          x, y         : Float; 
  586.                          xv, yv       : Float; 
  587.                          libName      : String; 
  588.                          frame        : Natural; 
  589.                          attributes   : not null A_Association ); 
  590.  
  591.     procedure Delete( this : in out Entity_Created_Event ); 
  592.  
  593.     function To_String( this : access Entity_Created_Event ) return String; 
  594.  
  595.     ---------------------------------------------------------------------------- 
  596.  
  597.     type Entity_Deleted_Event is new Entity_Event with null record; 
  598.  
  599.     procedure Construct( this : access Entity_Deleted_Event; id : Entity_Id ); 
  600.  
  601.     ---------------------------------------------------------------------------- 
  602.  
  603.     type Entity_Tile_Event is new Entity_Event with 
  604.         record 
  605.             x, y : Natural; 
  606.         end record; 
  607.  
  608.     procedure Construct( this : access Entity_Tile_Event; 
  609.                          name : String; 
  610.                          id   : Entity_Id; 
  611.                          x, y : Natural ); 
  612.  
  613.     ---------------------------------------------------------------------------- 
  614.  
  615.     type Entity_Entered_Tile_Event is new Entity_Tile_Event with null record; 
  616.  
  617.     procedure Construct( this : access Entity_Entered_Tile_Event; 
  618.                          id   : Entity_Id; 
  619.                          x, y : Natural ); 
  620.  
  621.     ---------------------------------------------------------------------------- 
  622.  
  623.     type Entity_Exited_Tile_Event is new Entity_Tile_Event with null record; 
  624.  
  625.     procedure Construct( this : access Entity_Exited_Tile_Event; 
  626.                          id   : Entity_Id; 
  627.                          x, y : Natural ); 
  628.  
  629.     ---------------------------------------------------------------------------- 
  630.  
  631.     type Entity_Face_Event is new Entity_Event with 
  632.         record 
  633.             dir : Direction_Type := Dir_Left; 
  634.         end record; 
  635.  
  636.     procedure Construct( this : access Entity_Face_Event; 
  637.                          id   : Entity_Id; 
  638.                          dir  : Direction_Type ); 
  639.  
  640.     ---------------------------------------------------------------------------- 
  641.  
  642.     type Entity_Grounded_Event is new Entity_Event with 
  643.         record 
  644.             grounded : Boolean := False; 
  645.         end record; 
  646.  
  647.     procedure Construct( this     : access Entity_Grounded_Event; 
  648.                          id       : Entity_Id; 
  649.                          grounded : Boolean ); 
  650.  
  651.     ---------------------------------------------------------------------------- 
  652.  
  653.     type Entity_Hit_Wall_Event is new Entity_Event with 
  654.         record 
  655.             dir          : Cardinal_Direction; 
  656.             firstContact : Boolean; 
  657.         end record; 
  658.  
  659.     procedure Construct( this         : access Entity_Hit_Wall_Event; 
  660.                          id           : Entity_Id; 
  661.                          dir          : Cardinal_Direction; 
  662.                          firstContact : Boolean ); 
  663.  
  664.     ---------------------------------------------------------------------------- 
  665.  
  666.     type Entity_Moved_Event is new Entity_Event with 
  667.         record 
  668.             x, y   : Float := 0.0; 
  669.             xv, yv : Float := 0.0; 
  670.         end record; 
  671.  
  672.     procedure Construct( this   : access Entity_Moved_Event; 
  673.                          id     : Entity_Id; 
  674.                          x, y   : Float; 
  675.                          xv, yv : Float ); 
  676.  
  677.     ---------------------------------------------------------------------------- 
  678.  
  679.     type Entity_Resized_Event is new Entity_Event with 
  680.         record 
  681.             width, height : Natural := 0; 
  682.         end record; 
  683.  
  684.     procedure Construct( this   : access Entity_Resized_Event; 
  685.                          id     : Entity_Id; 
  686.                          width, 
  687.                          height : Natural ); 
  688.  
  689.     ---------------------------------------------------------------------------- 
  690.  
  691.     type Follow_Entity_Event is new Entity_Event with null record; 
  692.  
  693.     procedure Construct( this : access Follow_Entity_Event; id : Entity_Id ); 
  694.  
  695.     ---------------------------------------------------------------------------- 
  696.  
  697.     type Frame_Changed_Event is new Entity_Event with 
  698.         record 
  699.             frame : Natural; 
  700.         end record; 
  701.  
  702.     procedure Construct( this  : access Frame_Changed_Event; 
  703.                          id    : Entity_Id; 
  704.                          frame : Natural ); 
  705.  
  706.     ---------------------------------------------------------------------------- 
  707.  
  708.     type Impulse_Event is new Entity_Event with 
  709.         record 
  710.             name : Hashed_String; 
  711.         end record; 
  712.  
  713.     procedure Construct( this : access Impulse_Event; 
  714.                          id   : Entity_Id; 
  715.                          name : Hashed_String ); 
  716.  
  717.     function To_String( this : access Impulse_Event ) return String; 
  718.  
  719.     ---------------------------------------------------------------------------- 
  720.  
  721.     type Move_Entity_Event is new Entity_Event with 
  722.         record 
  723.             x, y : Float := 0.0; 
  724.         end record; 
  725.  
  726.     procedure Construct( this : access Move_Entity_Event; 
  727.                          id   : Entity_Id; 
  728.                          x, y : Float ); 
  729.  
  730.     ---------------------------------------------------------------------------- 
  731.  
  732.     type Resize_Entity_Event is new Entity_Event with 
  733.         record 
  734.             width, height : Natural := 0; 
  735.         end record; 
  736.  
  737.     procedure Construct( this   : access Resize_Entity_Event; 
  738.                          id     : Entity_Id; 
  739.                          width, 
  740.                          height : Natural ); 
  741.  
  742.     ---------------------------------------------------------------------------- 
  743.  
  744.     type Set_Entity_Attribute_Event is new Entity_Attribute_Event with null record; 
  745.  
  746.     procedure Construct( this      : access Set_Entity_Attribute_Event; 
  747.                          id        : Entity_Id; 
  748.                          attribute : String; 
  749.                          val       : in out A_Value ); 
  750.     pragma Precondition( attribute'Length > 0 ); 
  751.     pragma Postcondition( val = null ); 
  752.  
  753.     ---------------------------------------------------------------------------- 
  754.  
  755.     type Spawn_Entity_Event is new Event with 
  756.         record 
  757.             id     : Unbounded_String; 
  758.             x, y   : Float; 
  759.             width, 
  760.             height : Natural; 
  761.             xv, yv : Float; 
  762.         end record; 
  763.  
  764.     procedure Construct( this   : access Spawn_Entity_Event; 
  765.                          id     : String; 
  766.                          x, y   : Float; 
  767.                          width, 
  768.                          height : Natural; 
  769.                          xv, yv : Float ); 
  770.     pragma Precondition( id'Length > 0 ); 
  771.  
  772.     function To_String( this : access Spawn_Entity_Event ) return String; 
  773.  
  774. end Events.Entities;