1. with Actions; 
  2.  
  3. pragma Warnings( Off, Actions ); 
  4. pragma Elaborate_All( Actions ); 
  5.  
  6. package Widgets.Menu_Items is 
  7.  
  8.     type Menu_Action is new Action with private; 
  9.     type A_Menu_Action is access all Menu_Action'Class; 
  10.  
  11.     Menu_Selected   : constant Action_Id; 
  12.     Menu_Unselected : constant Action_Id; 
  13.  
  14.     ---------------------------------------------------------------------------- 
  15.  
  16.     -- This is the interface to implement in order to listen to menu actions. 
  17.     -- When a menu action occurs, the listener will be notified of the type of 
  18.     -- action performed and the menu item that performed the action. 
  19.     type Menu_Listener is limited interface and Action_Listener; 
  20.     type A_Menu_Listener is access all Menu_Listener'Class; 
  21.  
  22.     procedure Handle_Action( this   : access Menu_Listener; 
  23.                              action : A_Menu_Action ) is abstract; 
  24.  
  25.     ---------------------------------------------------------------------------- 
  26.  
  27.     type A_Menu_Handler is 
  28.         access procedure( action : A_Menu_Action ); 
  29.  
  30.     ---------------------------------------------------------------------------- 
  31.  
  32.     type Menu_Item is new Widget with private; 
  33.     type A_Menu_Item is access all Menu_Item'Class; 
  34.  
  35.     function Create_Menu_Item( view : not null access Game_Views.Game_View'Class; 
  36.                                id   : String; 
  37.                                text : String ) return A_Menu_Item; 
  38.     pragma Precondition( id'Length > 0 ); 
  39.     pragma Postcondition( Create_Menu_Item'Result /= null ); 
  40.  
  41.     procedure Add_Listener( this     : not null access Menu_Item'Class; 
  42.                             listener : not null A_Menu_Listener ); 
  43.  
  44.     -- Adds the handler procedure as a simple listener. The listener can't be 
  45.     -- removed and can be added multiple times. 
  46.     procedure Add_Listener( this    : not null access Menu_Item'Class; 
  47.                             handler : not null A_Menu_Handler ); 
  48.  
  49.     procedure Remove_Listener( this     : not null access Menu_Item'Class; 
  50.                                listener : not null A_Menu_Listener ); 
  51.  
  52. private 
  53.  
  54.     -- height of a menu item as a multiple of font height 
  55.     HEIGHT_MULTIPLIER : constant Float := 1.5; 
  56.  
  57.     -- the character to use the width of for horizontal padding 
  58.     PADCHAR : constant String := "a"; 
  59.  
  60.     -- spacing between checkbox and text 
  61.     SPACING : constant := 2; 
  62.  
  63.     ---------------------------------------------------------------------------- 
  64.  
  65.     type Menu_Action is new Action with null record; 
  66.  
  67.     Menu_Selected   : constant Action_Id := To_Action_Id( "menu.selected" ); 
  68.     Menu_Unselected : constant Action_Id := To_Action_Id( "menu.unselected" ); 
  69.  
  70.     procedure Delete( this : in out A_Menu_Action ); 
  71.     pragma Postcondition( this = null ); 
  72.  
  73.     ---------------------------------------------------------------------------- 
  74.  
  75.     type Simple_Menu_Listener is new Simple_Action_Listener and Menu_Listener with 
  76.         record 
  77.             handler : A_Menu_Handler := null; 
  78.         end record; 
  79.     type A_Simple_Menu_Listener is access all Simple_Menu_Listener'Class; 
  80.  
  81.     function Create_Listener( handler : not null A_Menu_Handler ) return A_Menu_Listener; 
  82.     pragma Postcondition( Create_Listener'Result /= null ); 
  83.  
  84.     procedure Handle_Action( this   : access Simple_Menu_Listener; 
  85.                              action : A_Menu_Action ); 
  86.  
  87.     package Simple_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Menu_Listener, "=" ); 
  88.  
  89.     ---------------------------------------------------------------------------- 
  90.  
  91.     type Menu_Item is new Widget with 
  92.         record 
  93.             text     : Unbounded_String; 
  94.             handlers : Simple_Listeners.List; 
  95.         end record; 
  96.  
  97.     procedure Construct( this : access Menu_Item; 
  98.                          view : not null access Game_Views.Game_View'Class; 
  99.                          id   : String; 
  100.                          text : String); 
  101.     pragma Precondition( id'Length > 0 ); 
  102.  
  103.     function Box_Size( this : not null access Menu_Item'Class ) return Natural; 
  104.  
  105.     procedure Dispatch_Action( this : not null access Menu_Item'Class; id : Action_Id ); 
  106.  
  107.     procedure Draw_Content( this : access Menu_Item; dc : Drawing_Context ); 
  108.  
  109.     function Get_Background( this : not null access Menu_Item'Class ) return Color_Type; 
  110.  
  111.     function Get_Min_Height( this : access Menu_Item ) return Natural; 
  112.  
  113.     function Get_Min_Width( this : access Menu_Item ) return Natural; 
  114.  
  115.     procedure Handle_Mouse_Release( this : access Menu_Item; 
  116.                                     evt  : not null A_Mouse_Button_Event ); 
  117.  
  118.     procedure Prepend_Listener( this     : not null access Menu_Item'Class; 
  119.                                 listener : not null A_Menu_Listener ); 
  120.  
  121.     function To_String( this : access Menu_Item ) return String; 
  122.  
  123. end Widgets.Menu_Items;