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