1. with Events; 
  2. with Keyboard;                          use Keyboard; 
  3. with Tools;                             use Tools; 
  4.  
  5. pragma Elaborate_All( Events ); 
  6.  
  7. package Events.Ked is 
  8.  
  9.     APPLY_TOOL_MAP_ID : constant Event_Id := To_Event_Id( "Apply_Tool_Map" ); 
  10.     IMPORT_WORLD_ID   : constant Event_Id := To_Event_Id( "Import_World" ); 
  11.     SAVE_WORLD_ID     : constant Event_Id := To_Event_Id( "Save_World" ); 
  12.     SET_TOOL_ID       : constant Event_Id := To_Event_Id( "Set_Tool" ); 
  13.  
  14.     ---------------------------------------------------------------------------- 
  15.  
  16.     type Apply_Tool_Map_Event is new Event with private; 
  17.     type A_Apply_Tool_Map_Event is access all Apply_Tool_Map_Event'Class; 
  18.  
  19.     function Get_Function( this : not null access Apply_Tool_Map_Event'Class ) return Function_Type; 
  20.  
  21.     function Get_Layer( this : not null access Apply_Tool_Map_Event'Class ) return Integer; 
  22.  
  23.     function Get_Modifiers( this : not null access Apply_Tool_Map_Event'Class ) return Modifiers_Array; 
  24.  
  25.     function Get_X( this : not null access Apply_Tool_Map_Event'Class ) return Integer; 
  26.  
  27.     function Get_Y( this : not null access Apply_Tool_Map_Event'Class ) return Integer; 
  28.  
  29.     function Is_First( this : not null access Apply_Tool_Map_Event'Class ) return Boolean; 
  30.  
  31.     ---------------------------------------------------------------------------- 
  32.  
  33.     type Import_World_Event is new Event with private; 
  34.     type A_Import_World_Event is access all Import_World_Event'Class; 
  35.  
  36.     function Get_Domain( this : not null access Import_World_Event'Class ) return String; 
  37.     pragma Postcondition( Get_Domain'Result'Length > 0 ); 
  38.  
  39.     function Get_Filename( this : not null access Import_World_Event'Class ) return String; 
  40.     pragma Postcondition( Get_Filename'Result'Length > 0 ); 
  41.  
  42.     function Get_Library_Name( this : not null access Import_World_Event'Class ) return String; 
  43.     pragma Postcondition( Get_Library_Name'Result'Length > 0 ); 
  44.  
  45.     function Get_Tolerance( this : not null access Import_World_Event'Class ) return Natural; 
  46.  
  47.     ---------------------------------------------------------------------------- 
  48.  
  49.     type Save_World_Event is new Event with private; 
  50.     type A_Save_World_Event is access all Save_World_Event'Class; 
  51.  
  52.     function Get_Filename( this : not null access Save_World_Event'Class ) return String; 
  53.     pragma Postcondition( Get_Filename'Result'Length > 0 ); 
  54.  
  55.     ---------------------------------------------------------------------------- 
  56.  
  57.     type Set_Tool_Event is new Event with private; 
  58.     type A_Set_Tool_Event is access all Set_Tool_Event'Class; 
  59.  
  60.     function Get_Tool( this : not null access Set_Tool_Event'Class ) return A_Tool; 
  61.  
  62.     ---------------------------------------------------------------------------- 
  63.  
  64.     procedure Queue_Apply_Tool_Map( func      : Function_Type; 
  65.                                     modifiers : Modifiers_Array; 
  66.                                     first     : Boolean; 
  67.                                     x, y      : Integer; 
  68.                                     layer     : Integer ); 
  69.  
  70.     procedure Trigger_Import_World( filename  : String; 
  71.                                     libName   : String; 
  72.                                     domain    : String; 
  73.                                     tolerance : Natural ); 
  74.     pragma Precondition( filename'Length > 0 ); 
  75.     pragma Precondition( libName'Length > 0 ); 
  76.     pragma Precondition( domain'Length > 0 ); 
  77.  
  78.     -- Raises exception on failure. 
  79.     procedure Trigger_Save_World( filename : String ); 
  80.     pragma Postcondition( filename'Length > 0 ); 
  81.  
  82.     procedure Queue_Set_Tool( tool : not null A_Tool ); 
  83.  
  84. private 
  85.  
  86.     type Apply_Tool_Map_Event is new Event with 
  87.         record 
  88.             func      : Function_Type := Primary; 
  89.             modifiers : Modifiers_Array := Modifiers_Array'(others=>False); 
  90.             first     : Boolean := False; 
  91.             x, y, 
  92.             layer     : Integer := 0; 
  93.         end record; 
  94.  
  95.     procedure Construct( this      : access Apply_Tool_Map_Event; 
  96.                          func      : Function_Type; 
  97.                          modifiers : Modifiers_Array; 
  98.                          first     : Boolean; 
  99.                          x, y      : Integer; 
  100.                          layer     : Integer ); 
  101.  
  102.     ---------------------------------------------------------------------------- 
  103.  
  104.     type Import_World_Event is new Event with 
  105.         record 
  106.             filename  : Unbounded_String; 
  107.             libName   : Unbounded_String; 
  108.             domain    : Unbounded_String; 
  109.             tolerance : Natural := 0; 
  110.         end record; 
  111.  
  112.     procedure Construct( this      : access Import_World_Event; 
  113.                          filename  : String; 
  114.                          libName   : String; 
  115.                          domain    : String; 
  116.                          tolerance : Natural ); 
  117.     pragma Precondition( filename'Length > 0 ); 
  118.     pragma Precondition( libName'Length > 0 ); 
  119.     pragma Precondition( domain'Length > 0 ); 
  120.  
  121.     ---------------------------------------------------------------------------- 
  122.  
  123.     type Save_World_Event is new Event with 
  124.         record 
  125.             filename : Unbounded_String; 
  126.         end record; 
  127.  
  128.     procedure Construct( this : access Save_World_Event; filename : String ); 
  129.     pragma Precondition( filename'Length > 0 ); 
  130.  
  131.     ---------------------------------------------------------------------------- 
  132.  
  133.     type Set_Tool_Event is new Event with 
  134.         record 
  135.             tool : A_Tool := null; 
  136.         end record; 
  137.  
  138.     procedure Adjust( this : access Set_Tool_Event ); 
  139.  
  140.     procedure Construct( this : access Set_Tool_Event; tool : not null A_Tool ); 
  141.  
  142.     procedure Delete( this : in out Set_Tool_Event ); 
  143.  
  144. end Events.Ked;