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