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