1. with Actions; 
  2.  
  3. pragma Warnings( Off, Actions ); 
  4. pragma Elaborate_All( Actions ); 
  5.  
  6. package Widgets.Menu_Items is 
  7.  
  8.     -- Represents an action involving an item in a pulldown menu. 
  9.     type Menu_Action is new Action with private; 
  10.     type A_Menu_Action is access all Menu_Action'Class; 
  11.  
  12.     Menu_Selected   : constant Action_Id;    -- an item chosen/toggled on 
  13.     Menu_Unselected : constant Action_Id;    -- an item toggled off 
  14.  
  15.     ---------------------------------------------------------------------------- 
  16.  
  17.     -- This is the interface to implement in order to listen to menu actions. 
  18.     -- When a menu action occurs, the listener will be notified of the type of 
  19.     -- action performed and the menu item that performed the action. 
  20.     type Menu_Listener is limited interface and Action_Listener; 
  21.     type A_Menu_Listener is access all Menu_Listener'Class; 
  22.  
  23.     -- Handles 'action' from a menu item. 
  24.     procedure Handle_Action( this   : access Menu_Listener; 
  25.                              action : A_Menu_Action ) is abstract; 
  26.  
  27.     ---------------------------------------------------------------------------- 
  28.  
  29.     -- A simple procedure to handle a menu action, used by Simple_Menu_Listener. 
  30.     type A_Menu_Handler is 
  31.         access procedure( action : A_Menu_Action ); 
  32.  
  33.     ---------------------------------------------------------------------------- 
  34.  
  35.     -- A Menu_Item is a selection in a pulldown menu. Menu items can only be 
  36.     -- placed within a pulldown menu and they fire a Menu_Action when clicked. 
  37.     type Menu_Item is new Widget with private; 
  38.     type A_Menu_Item is access all Menu_Item'Class; 
  39.  
  40.     -- Creates a new Menu_Item within 'view' with 'id'. 'text' is the text of 
  41.     -- the item in the menu. 
  42.     function Create_Menu_Item( view : not null access Game_Views.Game_View'Class; 
  43.                                id   : String; 
  44.                                text : String ) return A_Menu_Item; 
  45.     pragma Precondition( id'Length > 0 ); 
  46.     pragma Postcondition( Create_Menu_Item'Result /= null ); 
  47.  
  48.     -- Registers 'listener' as a receiver of menu actions originating from this 
  49.     -- menu item. 
  50.     procedure Add_Listener( this     : not null access Menu_Item'Class; 
  51.                             listener : not null A_Menu_Listener ); 
  52.  
  53.     -- Adds the handler procedure as a simple listener. The listener can't be 
  54.     -- removed and can be added multiple times. 
  55.     procedure Add_Listener( this    : not null access Menu_Item'Class; 
  56.                             handler : not null A_Menu_Handler ); 
  57.  
  58.     -- Removes 'listener' as a receiver of menu actions originating from this 
  59.     -- menu item. 
  60.     procedure Remove_Listener( this     : not null access Menu_Item'Class; 
  61.                                listener : not null A_Menu_Listener ); 
  62.  
  63. private 
  64.  
  65.     -- height of a menu item as a multiple of font height 
  66.     HEIGHT_MULTIPLIER : constant Float := 1.5; 
  67.  
  68.     -- the character to use the width of for horizontal padding 
  69.     PADCHAR : constant String := "a"; 
  70.  
  71.     -- spacing between checkbox and text 
  72.     SPACING : constant := 2; 
  73.  
  74.     ---------------------------------------------------------------------------- 
  75.  
  76.     type Menu_Action is new Action with null record; 
  77.  
  78.     Menu_Selected   : constant Action_Id := To_Action_Id( "menu.selected" ); 
  79.     Menu_Unselected : constant Action_Id := To_Action_Id( "menu.unselected" ); 
  80.  
  81.     -- Deletes the Menu_Action. 
  82.     procedure Delete( this : in out A_Menu_Action ); 
  83.     pragma Postcondition( this = null ); 
  84.  
  85.     ---------------------------------------------------------------------------- 
  86.  
  87.     -- A Simple_Menu_Listener is an adapter class that listens for Menu_Action 
  88.     -- events and invokes a callback, A_Menu_Handler, if the action matches 
  89.     -- criteria provided at construction. This allows callback procedures to 
  90.     -- handle menu actions instead of requiring an object to do so. 
  91.     type Simple_Menu_Listener is new Simple_Action_Listener and Menu_Listener with 
  92.         record 
  93.             handler : A_Menu_Handler := null; 
  94.         end record; 
  95.     type A_Simple_Menu_Listener is access all Simple_Menu_Listener'Class; 
  96.  
  97.     -- Creates a Simple_Menu_Listener that invokes 'handler' when it receives a 
  98.     -- menu action. 
  99.     function Create_Listener( handler : not null A_Menu_Handler ) return A_Menu_Listener; 
  100.     pragma Postcondition( Create_Listener'Result /= null ); 
  101.  
  102.     -- Invokes the simple menu listener's Menu_Handler procedure when it 
  103.     -- receives 'action'. 
  104.     procedure Handle_Action( this   : access Simple_Menu_Listener; 
  105.                              action : A_Menu_Action ); 
  106.  
  107.     -- provides a list of Menu_Listeners. 
  108.     package Simple_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Menu_Listener, "=" ); 
  109.  
  110.     ---------------------------------------------------------------------------- 
  111.  
  112.     type Menu_Item is new Widget with 
  113.         record 
  114.             text     : Unbounded_String; 
  115.             handlers : Simple_Listeners.List; 
  116.         end record; 
  117.  
  118.     procedure Construct( this : access Menu_Item; 
  119.                          view : not null access Game_Views.Game_View'Class; 
  120.                          id   : String; 
  121.                          text : String); 
  122.     pragma Precondition( id'Length > 0 ); 
  123.  
  124.     -- Returns the size in pixels of a checkbox drawn on the menu item. Not all 
  125.     -- menu items have a checkbox, but if they did, this would be the width of 
  126.     -- it based on the widget's font size and maximum checkbox size. 
  127.     function Box_Size( this : not null access Menu_Item'Class ) return Natural; 
  128.  
  129.     -- Dispatches a menu action from this widget with Action_Id 'id' to all 
  130.     -- registered Menu_Listners. 
  131.     procedure Dispatch_Action( this : not null access Menu_Item'Class; id : Action_Id ); 
  132.  
  133.     -- Draws the menu item. 
  134.     procedure Draw_Content( this : access Menu_Item; dc : Drawing_Context ); 
  135.  
  136.     -- Returns the background color of the widget, depending on the mouse- if 
  137.     -- it's hovering, pressed down on the item, etc. 
  138.     function Get_Background( this : not null access Menu_Item'Class ) return Color_Type; 
  139.  
  140.     -- Returns the widget's minimum height. 
  141.     function Get_Min_Height( this : access Menu_Item ) return Natural; 
  142.  
  143.     -- Returns the widget's minimum width. 
  144.     function Get_Min_Width( this : access Menu_Item ) return Natural; 
  145.  
  146.     -- Selects the menu item if the right mouse button is released on the widget. 
  147.     procedure Handle_Mouse_Release( this : access Menu_Item; 
  148.                                     evt  : not null A_Mouse_Button_Event ); 
  149.  
  150.     -- Adds 'listener' to the front of the Menu_Action listener list. 
  151.     procedure Prepend_Listener( this     : not null access Menu_Item'Class; 
  152.                                 listener : not null A_Menu_Listener ); 
  153.  
  154.     -- Returns a string representation of the menu item for debugging purposes. 
  155.     function To_String( this : access Menu_Item ) return String; 
  156.  
  157. end Widgets.Menu_Items;