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