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.     -- A notification of a keyboard-based event. 
  10.     type Key_Event is abstract new Event with private; 
  11.     type A_Key_Event is access all Key_Event'Class; 
  12.  
  13.     -- Returns a character of the key involved, if it's a readable character. 
  14.     -- Check the result of Is_Readable first. 
  15.     function Get_Char( this : not null access Key_Event'Class ) return Character; 
  16.  
  17.     -- Returns the Allegro key code of the key involved. 
  18.     function Get_Key( this : not null access Key_Event'Class ) return Positive; 
  19.  
  20.     -- Returns a boolean array of modifier keys that were pressed/not pressed at 
  21.     -- the time of the event. 
  22.     procedure Get_Modifiers( this      : not null access Key_Event'Class; 
  23.                              modifiers : out Modifiers_Array ); 
  24.  
  25.     -- Returns True if no modifier keys were pressed at the time of the event. 
  26.     function No_Modifiers( this : not null access Key_Event'Class ) return Boolean; 
  27.  
  28.     -- Returns True if the Alt key was the only pressed modifier at the time of 
  29.     -- the event. 
  30.     function Only_Alt( this : not null access Key_Event'Class ) return Boolean; 
  31.  
  32.     -- Returns True if the Ctrl key was the only pressed modifier at the time of 
  33.     -- the event. 
  34.     function Only_Ctrl( this : not null access Key_Event'Class ) return Boolean; 
  35.  
  36.     -- Returns True if the Shift key was the only pressed modifier at the time 
  37.     -- of the event. 
  38.     function Only_Shift( this : not null access Key_Event'Class ) return Boolean; 
  39.  
  40.     -- Returns True if the key is a human readable character and not a control 
  41.     -- key. If this function returns False then the key is a control key of some 
  42.     -- kind. 
  43.     function Is_Readable( this : not null access Key_Event'Class ) return Boolean; 
  44.  
  45.     ---------------------------------------------------------------------------- 
  46.  
  47.     KEY_HELD_ID    : constant Event_Id := To_Event_Id( "Key_Held" ); 
  48.     KEY_PRESS_ID   : constant Event_Id := To_Event_Id( "Key_Press" ); 
  49.     KEY_RELEASE_ID : constant Event_Id := To_Event_Id( "Key_Release" ); 
  50.  
  51.     -- A notification that a key was held down for the key repeat rate delay. 
  52.     type Key_Held_Event is new Key_Event with private; 
  53.  
  54.     -- A notification that a key was pressed. 
  55.     type Key_Press_Event is new Key_Event with private; 
  56.  
  57.     -- A notification that a key was released. 
  58.     type Key_Release_Event is new Key_Event with private; 
  59.  
  60.     ---------------------------------------------------------------------------- 
  61.  
  62.     -- A notification of a mouse-based event. 
  63.     type Mouse_Event is abstract new Event with private; 
  64.     type A_Mouse_Event is access all Mouse_Event'Class; 
  65.  
  66.     -- Returns the X location of the mouse at the time of the event. 
  67.     function Get_X( this : not null access Mouse_Event'Class ) return Integer; 
  68.  
  69.     -- Returns the Y location of the mouse within the window at the time of the 
  70.     -- event. 
  71.     function Get_Y( this : not null access Mouse_Event'Class ) return Integer; 
  72.  
  73.     -- Sets the location of the mouse at the time of the event. This can be 
  74.     -- called by an event handler to filter the mouse even location for later 
  75.     -- mouse event handlers, to make the event location relative to some widget. 
  76.     procedure Set_XY( this : not null access Mouse_Event'Class; x, y : Integer ); 
  77.  
  78.     ---------------------------------------------------------------------------- 
  79.  
  80.     MOUSE_MOVE_ID : constant Event_Id := To_Event_Id( "Mouse_Move" ); 
  81.  
  82.     -- A notification that the mouse moved. 
  83.     type Mouse_Move_Event is new Mouse_Event with private; 
  84.  
  85.     ---------------------------------------------------------------------------- 
  86.  
  87.     MOUSE_SCROLL_ID : constant Event_Id := To_Event_Id( "Mouse_Scroll" ); 
  88.  
  89.     -- A notification that the mouse wheel was scrolled. 
  90.     type Mouse_Scroll_Event is new Mouse_Event with private; 
  91.     type A_Mouse_Scroll_Event is access all Mouse_Scroll_Event'Class; 
  92.  
  93.     -- Returns the amount that the mouse wheel was scrolled. 
  94.     function Get_Amount( this : not null access Mouse_Scroll_Event'Class ) return Integer; 
  95.     pragma Postcondition( Get_Amount'Result /= 0 ); 
  96.  
  97.     ---------------------------------------------------------------------------- 
  98.  
  99.     -- A notification of a mouse button-based event. 
  100.     type Mouse_Button_Event is abstract new Mouse_Event with private; 
  101.     type A_Mouse_Button_Event is access all Mouse_Button_Event'Class; 
  102.  
  103.     -- Returns the mouse button involved in the event. 
  104.     function Get_Button( this : not null access Mouse_Button_Event'Class ) return Mouse_Button; 
  105.  
  106.     -- Returns a boolean array of keyboard modifiers that were pressed at the 
  107.     -- time of the event. 
  108.     function Get_Modifiers( this : not null access Mouse_Button_Event'Class ) return Modifiers_Array; 
  109.  
  110.     ---------------------------------------------------------------------------- 
  111.  
  112.     MOUSE_CLICK_ID       : constant Event_Id := To_Event_Id( "Mouse_Click" ); 
  113.     MOUSE_DOUBLECLICK_ID : constant Event_Id := To_Event_Id( "Mouse_Doubleclick" ); 
  114.     MOUSE_HELD_ID        : constant Event_Id := To_Event_Id( "Mouse_Held" ); 
  115.     MOUSE_PRESS_ID       : constant Event_Id := To_Event_Id( "Mouse_Press" ); 
  116.     MOUSE_RELEASE_ID     : constant Event_Id := To_Event_Id( "Mouse_Release" ); 
  117.  
  118.     -- A notification that a mouse button was clicked (pressed and released rapidly). 
  119.     type Mouse_Click_Event is new Mouse_Button_Event with private; 
  120.  
  121.     -- A notification that a mouse button was double-clicked (clicked twice, rapidly). 
  122.     type Mouse_Doubleclick_Event is new Mouse_Button_Event with private; 
  123.  
  124.     -- A notification that a mouse button was held down for the mouse button 
  125.     -- repeat rate delay. 
  126.     type Mouse_Held_Event is new Mouse_Button_Event with private; 
  127.  
  128.     -- A notification that a mouse button was pressed. 
  129.     type Mouse_Press_Event is new Mouse_Button_Event with private; 
  130.  
  131.     -- A notification that a mouse button was released. 
  132.     type Mouse_Release_Event is new Mouse_Button_Event with private; 
  133.  
  134.     ---------------------------------------------------------------------------- 
  135.  
  136.     -- Queues a Key_Held_Event. 
  137.     procedure Queue_Key_Held( key       : Positive; 
  138.                               modifiers : Modifiers_Array; 
  139.                               capslock  : Boolean ); 
  140.  
  141.     -- Queues a Key_Held_Event. 
  142.     procedure Queue_Key_Press( key       : Positive; 
  143.                                modifiers : Modifiers_Array; 
  144.                                capslock  : Boolean ); 
  145.  
  146.     -- Queues a Key_Held_Event. 
  147.     procedure Queue_Key_Release( key       : Positive; 
  148.                                  modifiers : Modifiers_Array; 
  149.                                  capslock  : Boolean ); 
  150.  
  151.     -- Queues a Key_Held_Event. 
  152.     procedure Queue_Mouse_Click( x, y : Integer; btn : Mouse_Button ); 
  153.  
  154.     -- Queues a Key_Held_Event. 
  155.     procedure Queue_Mouse_Doubleclick( x, y : Integer; btn : Mouse_Button ); 
  156.  
  157.     -- Queues a Key_Held_Event. 
  158.     procedure Queue_Mouse_Held( x, y : Integer; btn : Mouse_Button ); 
  159.  
  160.     -- Queues a Key_Held_Event. 
  161.     procedure Queue_Mouse_Move( x, y : Integer ); 
  162.  
  163.     -- Queues a Mouse_Press_Event. 
  164.     procedure Queue_Mouse_Press( x, y      : Integer; 
  165.                                  btn       : Mouse_Button; 
  166.                                  modifiers : Modifiers_Array ); 
  167.  
  168.     -- Queues a Mouse_Release_Event. 
  169.     procedure Queue_Mouse_Release( x, y : Integer; btn : Mouse_Button ); 
  170.  
  171.     -- Creates a Mouse_Release_Event instance without queueing it. This is used 
  172.     -- only for a special case in the Window widget. The event is never queued; 
  173.     -- it's passed directly to a handler procedure to simulate an event. 
  174.     function Create_Mouse_Release( x, y : Integer; 
  175.                                    btn  : Mouse_Button ) return A_Mouse_Button_Event; 
  176.  
  177.     -- Queues a Mouse_Scroll_Event. 
  178.     procedure Queue_Mouse_Scroll( x, y, amount : Integer ); 
  179.     pragma Precondition( amount /= 0 ); 
  180.  
  181. private 
  182.  
  183.     type Key_Event is abstract new Event with 
  184.         record 
  185.             key       : Positive := 1; 
  186.             char      : Character := ASCII.NUL; 
  187.             modifiers : Modifiers_Array := (others => False); 
  188.         end record; 
  189.  
  190.     procedure Construct( this      : access Key_Event; 
  191.                          evtName   : String; 
  192.                          key       : Positive; 
  193.                          char      : Character; 
  194.                          modifiers : Modifiers_Array ); 
  195.  
  196.     function To_String( this : access Key_Event ) return String; 
  197.  
  198.     ---------------------------------------------------------------------------- 
  199.  
  200.     type Key_Held_Event is new Key_Event with null record; 
  201.     type Key_Press_Event is new Key_Event with null record; 
  202.     type Key_Release_Event is new Key_Event with null record; 
  203.  
  204.     ---------------------------------------------------------------------------- 
  205.  
  206.     type Mouse_Event is abstract new Event with 
  207.         record 
  208.             x, y : Integer := 0; 
  209.         end record; 
  210.  
  211.     procedure Construct( this    : access Mouse_Event; 
  212.                          evtName : String; 
  213.                          x, y    : Integer ); 
  214.  
  215.     function To_String( this : access Mouse_Event ) return String; 
  216.  
  217.     ---------------------------------------------------------------------------- 
  218.  
  219.     type Mouse_Move_Event is new Mouse_Event with null record; 
  220.  
  221.     ---------------------------------------------------------------------------- 
  222.  
  223.     type Mouse_Scroll_Event is new Mouse_Event with 
  224.         record 
  225.             amount : Integer := 0; 
  226.         end record; 
  227.  
  228.     procedure Construct( this    : access Mouse_Scroll_Event; 
  229.                          evtName : String; 
  230.                          x, y    : Integer; 
  231.                          amount  : Integer ); 
  232.     pragma Precondition( amount /= 0 ); 
  233.  
  234.     ---------------------------------------------------------------------------- 
  235.  
  236.     type Mouse_Button_Event is abstract new Mouse_Event with 
  237.         record 
  238.             btn       : Mouse_Button := Mouse_Left; 
  239.             modifiers : Modifiers_Array := Modifiers_Array'(others=>False); 
  240.         end record; 
  241.  
  242.     procedure Construct( this      : access Mouse_Button_Event; 
  243.                          evtName   : String; 
  244.                          x, y      : Integer; 
  245.                          btn       : Mouse_Button; 
  246.                          modifiers : Modifiers_Array ); 
  247.  
  248.     function To_String( this : access Mouse_Button_Event ) return String; 
  249.  
  250.     ---------------------------------------------------------------------------- 
  251.  
  252.     type Mouse_Click_Event       is new Mouse_Button_Event with null record; 
  253.     type Mouse_Doubleclick_Event is new Mouse_Button_Event with null record; 
  254.     type Mouse_Held_Event        is new Mouse_Button_Event with null record; 
  255.     type Mouse_Press_Event       is new Mouse_Button_Event with null record; 
  256.     type Mouse_Release_Event     is new Mouse_Button_Event with null record; 
  257.  
  258. end Events.Input;