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.     -- Adds 'listener' to the front of the Menu_Action listener list. 
  56.     procedure Prepend_Listener( this     : not null access Menu_Item'Class; 
  57.                                 listener : not null A_Menu_Listener ); 
  58.  
  59.     -- Removes 'listener' as a receiver of menu actions originating from this 
  60.     -- menu item. 
  61.     procedure Remove_Listener( this     : not null access Menu_Item'Class; 
  62.                                listener : not null A_Menu_Listener ); 
  63.  
  64. private 
  65.  
  66.     -- height of a menu item as a multiple of font height 
  67.     HEIGHT_MULTIPLIER : constant Float := 1.5; 
  68.  
  69.     -- the character to use the width of for horizontal padding 
  70.     PADCHAR : constant String := "a"; 
  71.  
  72.     -- spacing between checkbox and text 
  73.     SPACING : constant := 2; 
  74.  
  75.     ---------------------------------------------------------------------------- 
  76.  
  77.     type Menu_Action is new Action with null record; 
  78.  
  79.     Menu_Selected   : constant Action_Id := To_Action_Id( "menu.selected" ); 
  80.     Menu_Unselected : constant Action_Id := To_Action_Id( "menu.unselected" ); 
  81.  
  82.     ---------------------------------------------------------------------------- 
  83.  
  84.     type Menu_Item is new Widget with 
  85.         record 
  86.             text : Unbounded_String; 
  87.         end record; 
  88.  
  89.     procedure Construct( this : access Menu_Item; 
  90.                          view : not null access Game_Views.Game_View'Class; 
  91.                          id   : String; 
  92.                          text : String); 
  93.     pragma Precondition( id'Length > 0 ); 
  94.  
  95.     -- Returns the size in pixels of a checkbox drawn on the menu item. Not all 
  96.     -- menu items have a checkbox, but if they did, this would be the width of 
  97.     -- it based on the widget's font size and maximum checkbox size. 
  98.     function Box_Size( this : not null access Menu_Item'Class ) return Natural; 
  99.  
  100.     -- Dispatches a menu action from this widget with Action_Id 'id' to all 
  101.     -- registered Menu_Listners. 
  102.     procedure Dispatch_Action( this : not null access Menu_Item'Class; id : Action_Id ); 
  103.  
  104.     -- Draws the menu item. 
  105.     procedure Draw_Content( this : access Menu_Item ); 
  106.  
  107.     -- Returns the background color of the widget, depending on the mouse- if 
  108.     -- it's hovering, pressed down on the item, etc. 
  109.     function Get_Background( this : not null access Menu_Item'Class ) return Allegro_Color; 
  110.  
  111.     -- Returns the widget's minimum height. 
  112.     function Get_Min_Height( this : access Menu_Item ) return Natural; 
  113.  
  114.     -- Returns the widget's minimum width. 
  115.     function Get_Min_Width( this : access Menu_Item ) return Natural; 
  116.  
  117.     -- Selects the menu item if the right mouse button is released on the widget. 
  118.     procedure On_Mouse_Release( this : access Menu_Item; 
  119.                                 evt  : not null A_Mouse_Button_Event ); 
  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;