1. with Events; 
  2. with Keyboard;                          use Keyboard; 
  3. with Mouse;                             use Mouse; 
  4.  
  5. pragma Elaborate_All( Events ); 
  6.  
  7. package Events.Input is 
  8.  
  9.     type Key_Event is abstract new Event with private; 
  10.     type A_Key_Event is access all Key_Event'Class; 
  11.  
  12.     function Get_Char( this : not null access Key_Event'Class ) return Character; 
  13.  
  14.     function Get_Key( this : not null access Key_Event'Class ) return Positive; 
  15.  
  16.     procedure Get_Modifiers( this      : not null access Key_Event'Class; 
  17.                              modifiers : out Modifiers_Array ); 
  18.  
  19.     function No_Modifiers( this : not null access Key_Event'Class ) return Boolean; 
  20.  
  21.     function Only_Alt( this : not null access Key_Event'Class ) return Boolean; 
  22.  
  23.     function Only_Ctrl( this : not null access Key_Event'Class ) return Boolean; 
  24.  
  25.     function Only_Shift( this : not null access Key_Event'Class ) return Boolean; 
  26.  
  27.     -- Returns True if the key is a human readable character and not a control 
  28.     -- key. If this function returns False then the key is a control key of some 
  29.     -- kind. 
  30.     function Is_Readable( this : not null access Key_Event'Class ) return Boolean; 
  31.  
  32.     ---------------------------------------------------------------------------- 
  33.  
  34.     type Key_Held_Event is new Key_Event with private; 
  35.     type Key_Press_Event is new Key_Event with private; 
  36.     type Key_Release_Event is new Key_Event with private; 
  37.  
  38.     KEY_HELD_ID    : constant Event_Id := To_Event_Id( "Key_Held" ); 
  39.     KEY_PRESS_ID   : constant Event_Id := To_Event_Id( "Key_Press" ); 
  40.     KEY_RELEASE_ID : constant Event_Id := To_Event_Id( "Key_Release" ); 
  41.  
  42.     ---------------------------------------------------------------------------- 
  43.  
  44.     type Mouse_Event is abstract new Event with private; 
  45.     type A_Mouse_Event is access all Mouse_Event'Class; 
  46.  
  47.     function Get_X( this : not null access Mouse_Event'Class ) return Integer; 
  48.  
  49.     function Get_Y( this : not null access Mouse_Event'Class ) return Integer; 
  50.  
  51.     procedure Set_XY( this : not null access Mouse_Event'Class; x, y : Integer ); 
  52.  
  53.     ---------------------------------------------------------------------------- 
  54.  
  55.     type Mouse_Move_Event is new Mouse_Event with private; 
  56.  
  57.     MOUSE_MOVE_ID : constant Event_Id := To_Event_Id( "Mouse_Move" ); 
  58.  
  59.     ---------------------------------------------------------------------------- 
  60.  
  61.     type Mouse_Scroll_Event is new Mouse_Event with private; 
  62.     type A_Mouse_Scroll_Event is access all Mouse_Scroll_Event'Class; 
  63.  
  64.     function Get_Amount( this : not null access Mouse_Scroll_Event'Class ) return Integer; 
  65.     pragma Postcondition( Get_Amount'Result /= 0 ); 
  66.  
  67.     MOUSE_SCROLL_ID : constant Event_Id := To_Event_Id( "Mouse_Scroll" ); 
  68.  
  69.     ---------------------------------------------------------------------------- 
  70.  
  71.     type Mouse_Button_Event is abstract new Mouse_Event with private; 
  72.     type A_Mouse_Button_Event is access all Mouse_Button_Event'Class; 
  73.  
  74.     function Get_Button( this : not null access Mouse_Button_Event'Class ) return Mouse_Button; 
  75.  
  76.     function Get_Modifiers( this : not null access Mouse_Button_Event'Class ) return Modifiers_Array; 
  77.  
  78.     ---------------------------------------------------------------------------- 
  79.  
  80.     type Mouse_Click_Event is new Mouse_Button_Event with private; 
  81.     type Mouse_Doubleclick_Event is new Mouse_Button_Event with private; 
  82.     type Mouse_Held_Event is new Mouse_Button_Event with private; 
  83.     type Mouse_Press_Event is new Mouse_Button_Event with private; 
  84.     type Mouse_Release_Event is new Mouse_Button_Event with private; 
  85.  
  86.     MOUSE_CLICK_ID       : constant Event_Id := To_Event_Id( "Mouse_Click" ); 
  87.     MOUSE_DOUBLECLICK_ID : constant Event_Id := To_Event_Id( "Mouse_Doubleclick" ); 
  88.     MOUSE_HELD_ID        : constant Event_Id := To_Event_Id( "Mouse_Held" ); 
  89.     MOUSE_PRESS_ID       : constant Event_Id := To_Event_Id( "Mouse_Press" ); 
  90.     MOUSE_RELEASE_ID     : constant Event_Id := To_Event_Id( "Mouse_Release" ); 
  91.  
  92.     ---------------------------------------------------------------------------- 
  93.  
  94.     procedure Queue_Key_Held( key       : Positive; 
  95.                               modifiers : Modifiers_Array; 
  96.                               capslock  : Boolean ); 
  97.  
  98.     procedure Queue_Key_Press( key       : Positive; 
  99.                                modifiers : Modifiers_Array; 
  100.                                capslock  : Boolean ); 
  101.  
  102.     procedure Queue_Key_Release( key       : Positive; 
  103.                                  modifiers : Modifiers_Array; 
  104.                                  capslock  : Boolean ); 
  105.  
  106.     procedure Queue_Mouse_Click( x, y : Integer; btn : Mouse_Button ); 
  107.  
  108.     procedure Queue_Mouse_Doubleclick( x, y : Integer; btn : Mouse_Button ); 
  109.  
  110.     procedure Queue_Mouse_Held( x, y : Integer; btn : Mouse_Button ); 
  111.  
  112.     procedure Queue_Mouse_Move( x, y : Integer ); 
  113.  
  114.     procedure Queue_Mouse_Press( x, y      : Integer; 
  115.                                  btn       : Mouse_Button; 
  116.                                  modifiers : Modifiers_Array ); 
  117.  
  118.     procedure Queue_Mouse_Release( x, y : Integer; btn : Mouse_Button ); 
  119.  
  120.     -- Used only for a special case in the Window widget. The event is never 
  121.     -- queued, it's passed directly to a handler procedure. 
  122.     function Create_Mouse_Release( x, y : Integer; 
  123.                                    btn  : Mouse_Button ) return A_Mouse_Button_Event; 
  124.  
  125.     procedure Queue_Mouse_Scroll( x, y, amount : Integer ); 
  126.     pragma Precondition( amount /= 0 ); 
  127.  
  128. private 
  129.  
  130.     type Key_Event is abstract new Event with 
  131.         record 
  132.             key       : Positive := 1; 
  133.             char      : Character := ASCII.NUL; 
  134.             modifiers : Modifiers_Array := (others => False); 
  135.         end record; 
  136.  
  137.     procedure Construct( this      : access Key_Event; 
  138.                          evtName   : String; 
  139.                          key       : Positive; 
  140.                          char      : Character; 
  141.                          modifiers : Modifiers_Array ); 
  142.  
  143.     function To_String( this : access Key_Event ) return String; 
  144.  
  145.     ---------------------------------------------------------------------------- 
  146.  
  147.     type Key_Held_Event is new Key_Event with null record; 
  148.     type Key_Press_Event is new Key_Event with null record; 
  149.     type Key_Release_Event is new Key_Event with null record; 
  150.  
  151.     ---------------------------------------------------------------------------- 
  152.  
  153.     type Mouse_Event is abstract new Event with 
  154.         record 
  155.             x, y : Integer := 0; 
  156.         end record; 
  157.  
  158.     procedure Construct( this    : access Mouse_Event; 
  159.                          evtName : String; 
  160.                          x, y    : Integer ); 
  161.  
  162.     function To_String( this : access Mouse_Event ) return String; 
  163.  
  164.     ---------------------------------------------------------------------------- 
  165.  
  166.     type Mouse_Move_Event is new Mouse_Event with null record; 
  167.  
  168.     ---------------------------------------------------------------------------- 
  169.  
  170.     type Mouse_Scroll_Event is new Mouse_Event with 
  171.         record 
  172.             amount : Integer := 0; 
  173.         end record; 
  174.  
  175.     procedure Construct( this    : access Mouse_Scroll_Event; 
  176.                          evtName : String; 
  177.                          x, y    : Integer; 
  178.                          amount  : Integer ); 
  179.     pragma Precondition( amount /= 0 ); 
  180.  
  181.     ---------------------------------------------------------------------------- 
  182.  
  183.     type Mouse_Button_Event is abstract new Mouse_Event with 
  184.         record 
  185.             btn       : Mouse_Button := Mouse_Left; 
  186.             modifiers : Modifiers_Array := Modifiers_Array'(others=>False); 
  187.         end record; 
  188.  
  189.     procedure Construct( this      : access Mouse_Button_Event; 
  190.                          evtName   : String; 
  191.                          x, y      : Integer; 
  192.                          btn       : Mouse_Button; 
  193.                          modifiers : Modifiers_Array ); 
  194.  
  195.     function To_String( this : access Mouse_Button_Event ) return String; 
  196.  
  197.     ---------------------------------------------------------------------------- 
  198.  
  199.     type Mouse_Click_Event       is new Mouse_Button_Event with null record; 
  200.     type Mouse_Doubleclick_Event is new Mouse_Button_Event with null record; 
  201.     type Mouse_Held_Event        is new Mouse_Button_Event with null record; 
  202.     type Mouse_Press_Event       is new Mouse_Button_Event with null record; 
  203.     type Mouse_Release_Event     is new Mouse_Button_Event with null record; 
  204.  
  205. end Events.Input;