with Actions;
pragma Warnings( Off, Actions );
pragma Elaborate_All( Actions );
package Widgets.Menu_Items is
-- Represents an action involving an item in a pulldown menu.
type Menu_Action is new Action with private;
type A_Menu_Action is access all Menu_Action'Class;
Menu_Selected : constant Action_Id; -- an item chosen/toggled on
Menu_Unselected : constant Action_Id; -- an item toggled off
----------------------------------------------------------------------------
-- This is the interface to implement in order to listen to menu actions.
-- When a menu action occurs, the listener will be notified of the type of
-- action performed and the menu item that performed the action.
type Menu_Listener is limited interface and Action_Listener;
type A_Menu_Listener is access all Menu_Listener'Class;
-- Handles 'action' from a menu item.
procedure Handle_Action( this : access Menu_Listener;
action : A_Menu_Action ) is abstract;
----------------------------------------------------------------------------
-- A simple procedure to handle a menu action, used by Simple_Menu_Listener.
type A_Menu_Handler is
access procedure( action : A_Menu_Action );
----------------------------------------------------------------------------
-- A Menu_Item is a selection in a pulldown menu. Menu items can only be
-- placed within a pulldown menu and they fire a Menu_Action when clicked.
type Menu_Item is new Widget with private;
type A_Menu_Item is access all Menu_Item'Class;
-- Creates a new Menu_Item within 'view' with 'id'. 'text' is the text of
-- the item in the menu.
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 );
-- Registers 'listener' as a receiver of menu actions originating from this
-- menu item.
procedure Add_Listener( this : not null access Menu_Item'Class;
listener : not null A_Menu_Listener );
-- Adds the handler procedure as a simple listener. The listener can't be
-- removed and can be added multiple times.
procedure Add_Listener( this : not null access Menu_Item'Class;
handler : not null A_Menu_Handler );
-- Removes 'listener' as a receiver of menu actions originating from this
-- menu item.
procedure Remove_Listener( this : not null access Menu_Item'Class;
listener : not null A_Menu_Listener );
private
-- height of a menu item as a multiple of font height
HEIGHT_MULTIPLIER : constant Float := 1.5;
-- the character to use the width of for horizontal padding
PADCHAR : constant String := "a";
-- spacing between checkbox and text
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" );
-- Deletes the Menu_Action.
procedure Delete( this : in out A_Menu_Action );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- A Simple_Menu_Listener is an adapter class that listens for Menu_Action
-- events and invokes a callback, A_Menu_Handler, if the action matches
-- criteria provided at construction. This allows callback procedures to
-- handle menu actions instead of requiring an object to do so.
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;
-- Creates a Simple_Menu_Listener that invokes 'handler' when it receives a
-- menu action.
function Create_Listener( handler : not null A_Menu_Handler ) return A_Menu_Listener;
pragma Postcondition( Create_Listener'Result /= null );
-- Invokes the simple menu listener's Menu_Handler procedure when it
-- receives 'action'.
procedure Handle_Action( this : access Simple_Menu_Listener;
action : A_Menu_Action );
-- provides a list of Menu_Listeners.
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 );
-- Returns the size in pixels of a checkbox drawn on the menu item. Not all
-- menu items have a checkbox, but if they did, this would be the width of
-- it based on the widget's font size and maximum checkbox size.
function Box_Size( this : not null access Menu_Item'Class ) return Natural;
-- Dispatches a menu action from this widget with Action_Id 'id' to all
-- registered Menu_Listners.
procedure Dispatch_Action( this : not null access Menu_Item'Class; id : Action_Id );
-- Draws the menu item.
procedure Draw_Content( this : access Menu_Item; dc : Drawing_Context );
-- Returns the background color of the widget, depending on the mouse- if
-- it's hovering, pressed down on the item, etc.
function Get_Background( this : not null access Menu_Item'Class ) return Color_Type;
-- Returns the widget's minimum height.
function Get_Min_Height( this : access Menu_Item ) return Natural;
-- Returns the widget's minimum width.
function Get_Min_Width( this : access Menu_Item ) return Natural;
-- Selects the menu item if the right mouse button is released on the widget.
procedure Handle_Mouse_Release( this : access Menu_Item;
evt : not null A_Mouse_Button_Event );
-- Adds 'listener' to the front of the Menu_Action listener list.
procedure Prepend_Listener( this : not null access Menu_Item'Class;
listener : not null A_Menu_Listener );
-- Returns a string representation of the menu item for debugging purposes.
function To_String( this : access Menu_Item ) return String;
end Widgets.Menu_Items;