package Widgets.Menu_Items is
type Menu_Action is new Action with private;
type A_Menu_Action is access all Menu_Action'Class;
Menu_Selected : constant Action_Id;
Menu_Unselected : constant Action_Id;
type Menu_Listener is limited interface and Action_Listener;
type A_Menu_Listener is access all Menu_Listener'Class;
procedure Handle_Action( this : access Menu_Listener;
action : A_Menu_Action ) is abstract;
type A_Menu_Handler is
access procedure( action : A_Menu_Action );
type Menu_Item is new Widget with private;
type A_Menu_Item is access all Menu_Item'Class;
function Create_Menu_Item( view : not null access Game_Views.Game_View'Class;
id : String;
text : String ) return A_Menu_Item;
pragma Precondition( id'Length > 0 );
pragma Postcondition( Create_Menu_Item'Result /= null );
procedure Add_Listener( this : not null access Menu_Item'Class;
listener : not null A_Menu_Listener );
procedure Add_Listener( this : not null access Menu_Item'Class;
handler : not null A_Menu_Handler );
procedure Remove_Listener( this : not null access Menu_Item'Class;
listener : not null A_Menu_Listener );
private
HEIGHT_MULTIPLIER : constant Float := 1.5;
PADCHAR : constant String := "a";
SPACING : constant := 2;
type Menu_Action is new Action with null record;
Menu_Selected : constant Action_Id := To_Action_Id( "menu.selected" );
Menu_Unselected : constant Action_Id := To_Action_Id( "menu.unselected" );
procedure Delete( this : in out A_Menu_Action );
pragma Postcondition( this = null );
type Simple_Menu_Listener is new Simple_Action_Listener and Menu_Listener with
record
handler : A_Menu_Handler := null;
end record;
type A_Simple_Menu_Listener is access all Simple_Menu_Listener'Class;
function Create_Listener( handler : not null A_Menu_Handler ) return A_Menu_Listener;
pragma Postcondition( Create_Listener'Result /= null );
procedure Handle_Action( this : access Simple_Menu_Listener;
action : A_Menu_Action );
package Simple_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Menu_Listener, "=" );
type Menu_Item is new Widget with
record
text : Unbounded_String;
handlers : Simple_Listeners.List;
end record;
procedure Construct( this : access Menu_Item;
view : not null access Game_Views.Game_View'Class;
id : String;
text : String);
pragma Precondition( id'Length > 0 );
function Box_Size( this : not null access Menu_Item'Class ) return Natural;
procedure Dispatch_Action( this : not null access Menu_Item'Class; id : Action_Id );
procedure Draw_Content( this : access Menu_Item; dc : Drawing_Context );
function Get_Background( this : not null access Menu_Item'Class ) return Color_Type;
function Get_Min_Height( this : access Menu_Item ) return Natural;
function Get_Min_Width( this : access Menu_Item ) return Natural;
procedure Handle_Mouse_Release( this : access Menu_Item;
evt : not null A_Mouse_Button_Event );
procedure Prepend_Listener( this : not null access Menu_Item'Class;
listener : not null A_Menu_Listener );
function To_String( this : access Menu_Item ) return String;
end Widgets.Menu_Items;