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 Actions; 
  10.  
  11. pragma Warnings( Off, Actions ); 
  12. pragma Elaborate_All( Actions ); 
  13.  
  14. package Widgets.Menu_Items is 
  15.  
  16.     -- Represents an action involving an item in a pulldown menu. 
  17.     type Menu_Action is new Action with private; 
  18.     type A_Menu_Action is access all Menu_Action'Class; 
  19.  
  20.     Menu_Selected   : constant Action_Id;    -- an item chosen/toggled on 
  21.     Menu_Unselected : constant Action_Id;    -- an item toggled off 
  22.  
  23.     ---------------------------------------------------------------------------- 
  24.  
  25.     -- This is the interface to implement in order to listen to menu actions. 
  26.     -- When a menu action occurs, the listener will be notified of the type of 
  27.     -- action performed and the menu item that performed the action. 
  28.     type Menu_Listener is limited interface and Action_Listener; 
  29.     type A_Menu_Listener is access all Menu_Listener'Class; 
  30.  
  31.     -- Handles 'action' from a menu item. 
  32.     procedure Handle_Action( this   : access Menu_Listener; 
  33.                              action : A_Menu_Action ) is abstract; 
  34.  
  35.     ---------------------------------------------------------------------------- 
  36.  
  37.     -- A Menu_Item is a selection in a pulldown menu. Menu items can only be 
  38.     -- placed within a pulldown menu and they fire a Menu_Action when clicked. 
  39.     type Menu_Item is new Widget with private; 
  40.     type A_Menu_Item is access all Menu_Item'Class; 
  41.  
  42.     -- Creates a new Menu_Item within 'view' with 'id'. 'text' is the text of 
  43.     -- the item in the menu. 
  44.     function Create_Menu_Item( view : not null access Game_Views.Game_View'Class; 
  45.                                id   : String; 
  46.                                text : String ) return A_Menu_Item; 
  47.     pragma Precondition( id'Length > 0 ); 
  48.     pragma Postcondition( Create_Menu_Item'Result /= null ); 
  49.  
  50.     -- Registers 'listener' as a receiver of menu actions originating from this 
  51.     -- menu item. 
  52.     procedure Add_Listener( this     : not null access Menu_Item'Class; 
  53.                             listener : not null A_Menu_Listener ); 
  54.  
  55.     -- Removes 'listener' as a receiver of menu actions originating from this 
  56.     -- menu item. 
  57.     procedure Remove_Listener( this     : not null access Menu_Item'Class; 
  58.                                listener : not null A_Menu_Listener ); 
  59.  
  60. private 
  61.  
  62.     -- height of a menu item as a multiple of font height 
  63.     HEIGHT_MULTIPLIER : constant Float := 1.5; 
  64.  
  65.     -- the character to use the width of for horizontal padding 
  66.     PADCHAR : constant String := "a"; 
  67.  
  68.     -- spacing between checkbox and text 
  69.     SPACING : constant := 2; 
  70.  
  71.     ---------------------------------------------------------------------------- 
  72.  
  73.     type Menu_Action is new Action with null record; 
  74.  
  75.     Menu_Selected   : constant Action_Id := To_Action_Id( "menu.selected" ); 
  76.     Menu_Unselected : constant Action_Id := To_Action_Id( "menu.unselected" ); 
  77.  
  78.     ---------------------------------------------------------------------------- 
  79.  
  80.     type Menu_Item is new Widget with 
  81.         record 
  82.             text : Unbounded_String; 
  83.         end record; 
  84.  
  85.     procedure Construct( this : access Menu_Item; 
  86.                          view : not null access Game_Views.Game_View'Class; 
  87.                          id   : String; 
  88.                          text : String); 
  89.     pragma Precondition( id'Length > 0 ); 
  90.  
  91.     -- Returns the size in pixels of a checkbox drawn on the menu item. Not all 
  92.     -- menu items have a checkbox, but if they did, this would be the width of 
  93.     -- it based on the widget's font size and maximum checkbox size. 
  94.     function Box_Size( this : not null access Menu_Item'Class ) return Natural; 
  95.  
  96.     -- Dispatches a menu action from this widget with Action_Id 'id' to all 
  97.     -- registered Menu_Listners. 
  98.     procedure Dispatch_Action( this : not null access Menu_Item'Class; id : Action_Id ); 
  99.  
  100.     -- Draws the menu item. 
  101.     procedure Draw_Content( this : access Menu_Item; dc : Drawing_Context ); 
  102.  
  103.     -- Returns the background color of the widget, depending on the mouse- if 
  104.     -- it's hovering, pressed down on the item, etc. 
  105.     function Get_Background( this : not null access Menu_Item'Class ) return Color_Type; 
  106.  
  107.     -- Returns the widget's minimum height. 
  108.     function Get_Min_Height( this : access Menu_Item ) return Natural; 
  109.  
  110.     -- Returns the widget's minimum width. 
  111.     function Get_Min_Width( this : access Menu_Item ) return Natural; 
  112.  
  113.     -- Selects the menu item if the right mouse button is released on the widget. 
  114.     procedure Handle_Mouse_Release( this : access Menu_Item; 
  115.                                     evt  : not null A_Mouse_Button_Event ); 
  116.  
  117.     -- Adds 'listener' to the front of the Menu_Action listener list. 
  118.     procedure Prepend_Listener( this     : not null access Menu_Item'Class; 
  119.                                 listener : not null A_Menu_Listener ); 
  120.  
  121.     -- Returns a string representation of the menu item for debugging purposes. 
  122.     function To_String( this : access Menu_Item ) return String; 
  123.  
  124. end Widgets.Menu_Items;