1. with Events; 
  2. with Maps;                              use Maps; 
  3.  
  4. pragma Elaborate_All( Events ); 
  5.  
  6. package Events.World is 
  7.  
  8.     type Create_World_Event is new Event with private; 
  9.     type A_Create_World_Event is access all Create_World_Event'Class; 
  10.  
  11.     CREATE_WORLD_ID : constant Event_Id := To_Event_Id( "Create_World" ); 
  12.  
  13.     function Get_Domain( this : not null access Create_World_Event'Class ) return String; 
  14.     pragma Postcondition( Get_Domain'Result'Length > 0 ); 
  15.  
  16.     function Get_Height( this : not null access Create_World_Event'Class ) return Positive; 
  17.  
  18.     function Get_Library_Name( this : not null access Create_World_Event'Class ) return String; 
  19.     pragma Postcondition( Get_Library_Name'Result'Length > 0 ); 
  20.  
  21.     function Get_Width( this : not null access Create_World_Event'Class ) return Positive; 
  22.  
  23.     ---------------------------------------------------------------------------- 
  24.  
  25.     type Load_World_Event is new Event with private; 
  26.     type A_Load_World_Event is access all Load_World_Event'Class; 
  27.  
  28.     LOAD_WORLD_ID : constant Event_Id := To_Event_Id( "Load_World" ); 
  29.  
  30.     function Get_Filename( this : not null access Load_World_Event'Class ) return String; 
  31.     pragma Postcondition( Get_Filename'Result'Length > 0 ); 
  32.  
  33.     ---------------------------------------------------------------------------- 
  34.  
  35.     type New_World_Event is new Event with private; 
  36.     type A_New_World_Event is access all New_World_Event'Class; 
  37.  
  38.     NEW_WORLD_ID : constant Event_Id := To_Event_Id( "New_World" ); 
  39.  
  40.     function Get_Height( this : not null access New_World_Event'Class ) return Positive; 
  41.  
  42.     function Get_Layers( this : not null access New_World_Event'Class ) return A_Layer_Array; 
  43.     pragma Postcondition( Get_Layers'Result /= null ); 
  44.  
  45.     function Get_Library_Name( this : not null access New_World_Event'Class ) return String; 
  46.     pragma Postcondition( Get_Library_Name'Result'Length > 0 ); 
  47.  
  48.     function Get_Tile_Width( this : not null access New_World_Event'Class ) return Positive; 
  49.  
  50.     function Get_Width( this : not null access New_World_Event'Class ) return Positive; 
  51.  
  52.     ---------------------------------------------------------------------------- 
  53.  
  54.     type Resize_World_Event is new Event with private; 
  55.     type A_Resize_World_Event is access all Resize_World_Event'Class; 
  56.  
  57.     RESIZE_WORLD_ID : constant Event_Id := To_Event_Id( "Resize_World" ); 
  58.  
  59.     function Get_Height( this : not null access Resize_World_Event'Class ) return Positive; 
  60.  
  61.     function Get_Width( this : not null access Resize_World_Event'Class ) return Positive; 
  62.  
  63.     ---------------------------------------------------------------------------- 
  64.  
  65.     type Set_World_Property_Event is new Event with private; 
  66.     type A_Set_World_Property_Event is access all Set_World_Property_Event'Class; 
  67.  
  68.     SET_WORLD_PROPERTY_ID : constant Event_Id := To_Event_Id( "Set_World_Property" ); 
  69.  
  70.     function Get_Property_Name( this : not null access Set_World_Property_Event'Class ) return String; 
  71.     pragma Postcondition( Get_Property_Name'Result'Length > 0 ); 
  72.  
  73.     function Get_Value( this : not null access Set_World_Property_Event'Class ) return String; 
  74.  
  75.     ---------------------------------------------------------------------------- 
  76.  
  77.     type Tile_Changed_Event is new Event with private; 
  78.     type A_Tile_Changed_Event is access all Tile_Changed_Event'Class; 
  79.  
  80.     TILE_CHANGED_ID : constant Event_Id := To_Event_Id( "Tile_Changed" ); 
  81.  
  82.     function Get_Layer( this : not null access Tile_Changed_Event'Class ) return Integer; 
  83.  
  84.     function Get_Tile_ID( this : not null access Tile_Changed_Event'Class ) return Natural; 
  85.  
  86.     function Get_X( this : not null access Tile_Changed_Event'Class ) return Natural; 
  87.  
  88.     function Get_Y( this : not null access Tile_Changed_Event'Class ) return Natural; 
  89.  
  90.     ---------------------------------------------------------------------------- 
  91.  
  92.     type World_Modified_Event is new Event with private; 
  93.     type A_World_Modified_Event is access all World_Modified_Event'Class; 
  94.  
  95.     WORLD_MODIFIED_ID : constant Event_Id := To_Event_Id( "World_Modified" ); 
  96.  
  97.     ---------------------------------------------------------------------------- 
  98.  
  99.     type World_Property_Changed_Event is new Event with private; 
  100.     type A_World_Property_Changed_Event is access all World_Property_Changed_Event'Class; 
  101.  
  102.     WORLD_PROPERTY_CHANGED_ID : constant Event_Id := To_Event_Id( "World_Property_Changed" ); 
  103.  
  104.     function Get_Property_Name( this : not null access World_Property_Changed_Event'Class ) return String; 
  105.     pragma Postcondition( Get_Property_Name'Result'Length > 0 ); 
  106.  
  107.     function Get_Value( this : not null access World_Property_Changed_Event'Class ) return String; 
  108.  
  109.     ---------------------------------------------------------------------------- 
  110.  
  111.     -- create a new empty world; raises exception on failure 
  112.     procedure Trigger_Create_World( width, 
  113.                                     height : Positive; 
  114.                                     libName, 
  115.                                     domain : String ); 
  116.     pragma Precondition( libName'Length > 0 ); 
  117.     pragma Precondition( domain'Length > 0 ); 
  118.  
  119.     -- Load a world from disk asynchronously. 
  120.     procedure Queue_Load_World( filename : String ); 
  121.     pragma Precondition( filename'Length > 0 ); 
  122.  
  123.     -- Load a world from disk synchronously. An exception is raised on error. 
  124.     procedure Trigger_Load_World( filename : String ); 
  125.     pragma Precondition( filename'Length > 0 ); 
  126.  
  127.     -- The new world data. 
  128.     procedure Queue_New_World( width, 
  129.                                height, 
  130.                                tileWidth : Positive; 
  131.                                layers    : not null A_Layer_Array; 
  132.                                libName   : String ); 
  133.     pragma Precondition( libName'Length > 0 ); 
  134.  
  135.     -- Resizes the world. An exception is raised on failure. 
  136.     -- (ie: parameters rejected) 
  137.     procedure Trigger_Resize_World( width, height : Positive ); 
  138.  
  139.     -- Basic world properties: 
  140.     -- "filename"     : the filename 
  141.     -- "music"        : the background music track name 
  142.     -- "introduction" : the introduction text 
  143.     procedure Queue_Set_World_Property( name, value : String ); 
  144.     pragma Precondition( name'Length > 0 ); 
  145.  
  146.     procedure Queue_Tile_Changed( layer   : Integer; 
  147.                                   x, y    : Natural; 
  148.                                   tile_id : Natural ); 
  149.  
  150.     procedure Queue_World_Modified; 
  151.  
  152.     -- Basic world properties: 
  153.     -- "filename"     : the filename 
  154.     -- "music"        : the background music track name 
  155.     -- "introduction" : the introduction text 
  156.     procedure Queue_World_Property_Changed( name, value : String ); 
  157.     pragma Precondition( name'Length > 0 ); 
  158.  
  159. private 
  160.  
  161.     type Create_World_Event is new Event with 
  162.         record 
  163.             width, 
  164.             height  : Positive := 1; 
  165.             libName : Unbounded_String; 
  166.             domain  : Unbounded_String; 
  167.         end record; 
  168.  
  169.     procedure Construct( this    : access Create_World_Event; 
  170.                          width, 
  171.                          height  : Positive; 
  172.                          libName, 
  173.                          domain  : String ); 
  174.     pragma Precondition( libName'Length > 0 ); 
  175.     pragma Precondition( domain'Length > 0 ); 
  176.  
  177.     ---------------------------------------------------------------------------- 
  178.  
  179.     type Load_World_Event is new Event with 
  180.         record 
  181.             filename : Unbounded_String; 
  182.         end record; 
  183.  
  184.     procedure Construct( this : access Load_World_Event; filename : String ); 
  185.     pragma Precondition( filename'Length > 0 ); 
  186.  
  187.     function To_String( this : access Load_World_Event ) return String; 
  188.  
  189.     ---------------------------------------------------------------------------- 
  190.  
  191.     type New_World_Event is new Event with 
  192.         record 
  193.             width, 
  194.             height, 
  195.             tileWidth : Positive := 1; 
  196.             layers    : A_Layer_Array := null; 
  197.             libName   : Unbounded_String; 
  198.         end record; 
  199.  
  200.     procedure Adjust( this : access New_World_Event ); 
  201.  
  202.     procedure Construct( this      : access New_World_Event; 
  203.                          width, 
  204.                          height, 
  205.                          tileWidth : Positive; 
  206.                          layers    : not null A_Layer_Array; 
  207.                          libName   : String ); 
  208.     pragma Precondition( libName'Length > 0 ); 
  209.  
  210.     procedure Delete( this : in out New_World_Event ); 
  211.  
  212.     ---------------------------------------------------------------------------- 
  213.  
  214.     type Resize_World_Event is new Event with 
  215.         record 
  216.             width, 
  217.             height : Positive := 1; 
  218.         end record; 
  219.  
  220.     procedure Construct( this   : access Resize_World_Event; 
  221.                          width, 
  222.                          height : Positive ); 
  223.  
  224.     ---------------------------------------------------------------------------- 
  225.  
  226.     type Set_World_Property_Event is new Event with 
  227.         record 
  228.             name, 
  229.             value : Unbounded_String; 
  230.         end record; 
  231.  
  232.     procedure Construct( this  : access Set_World_Property_Event; 
  233.                          name, 
  234.                          value : String ); 
  235.     pragma Precondition( name'Length > 0 ); 
  236.  
  237.     function To_String( this : access Set_World_Property_Event ) return String; 
  238.  
  239.     ---------------------------------------------------------------------------- 
  240.  
  241.     type Tile_Changed_Event is new Event with 
  242.         record 
  243.             layer   : Integer := 0; 
  244.             x, y    : Natural := 0; 
  245.             tile_id : Natural := 0; 
  246.         end record; 
  247.  
  248.     procedure Construct( this    : access Tile_Changed_Event; 
  249.                          layer   : Integer; 
  250.                          x, y    : Natural; 
  251.                          tile_id : Natural ); 
  252.  
  253.     ---------------------------------------------------------------------------- 
  254.  
  255.     type World_Modified_Event is new Event with null record; 
  256.  
  257.     ---------------------------------------------------------------------------- 
  258.  
  259.     type World_Property_Changed_Event is new Event with 
  260.         record 
  261.             name, 
  262.             value : Unbounded_String; 
  263.         end record; 
  264.  
  265.     procedure Construct( this  : access World_Property_Changed_Event; 
  266.                          name, 
  267.                          value : String ); 
  268.     pragma Precondition( name'Length > 0 ); 
  269.  
  270.     function To_String( this : access World_Property_Changed_Event ) return String; 
  271.  
  272. end Events.World;