with Actions;
pragma Warnings( Off, Actions );
pragma Elaborate_All( Actions );
package Widgets.Buttons is
-- Represents a widget action involving a Button, like a press or release.
type Button_Action is new Action with private;
type A_Button_Action is access all Button_Action'Class;
Press : constant Action_Id; -- button is pressed down
Held : constant Action_Id; -- button is held down for the repeat delay
Release : constant Action_Id; -- button is released
Click : constant Action_Id; -- button is pressed and released quickly
----------------------------------------------------------------------------
-- This is the interface to implement in order to listen to button actions.
-- When a button action occurs, the listener will be notified of the type of
-- action performed and the button that performed the action.
type Button_Listener is limited interface and Action_Listener;
type A_Button_Listener is access all Button_Listener'Class;
-- Handles the button action 'action'.
procedure Handle_Action( this : access Button_Listener;
action : A_Button_Action ) is abstract;
-- A simple procedure to handle a button action, used by Simple_Button_Listener.
type A_Button_Handler is
access procedure( action : A_Button_Action );
----------------------------------------------------------------------------
-- A Button is a simple control widget with two states: on and off. A button
-- notifies listeners of each event, so that a listener can know when a
-- button is pressed by the user, release, held down for a period of time,
-- or clicked.
--
-- This abstract class is intended to be extended by a subclass that
-- implements a specific behavior, like toggling, or a button that goes back
-- to Off as soon as the mouse is released.
type Button is abstract new Widget with private;
type A_Button is access all Button'Class;
-- Registers 'listener' as an Button_Action listener.
procedure Add_Listener( this : access Button;
listener : not null A_Button_Listener );
-- Registers 'handler' to be invoked when a Button_Action occurs. 'handler'
-- can be added multiple times and can't be removed.
procedure Add_Listener( this : access Button;
handler : not null A_Button_Handler );
-- If contasting text is enabled, the text of the button will be displayed
-- as either white or black, whichever contrasts most with the button's
-- foreground color.
procedure Contrast_Text( this : not null access Button'Class; enabled : Boolean );
-- Returns the state of the button: True if it's on and False if it's off.
function Get_State( this : not null access Button'Class ) return Boolean;
-- Returns the button's text.
function Get_Text( this : not null access Button'Class ) return String;
-- Unregisters 'listener' as an Button_Action listener.
procedure Remove_Listener( this : access Button;
listener : not null A_Button_Listener );
-- Sets the horizontal alignment for the button's icon and text.
procedure Set_Align( this : not null access Button'Class; align : Align_Type );
-- Sets the color to be used for a specific purpose. Setting the Foreground
-- color to Transparent will cause the button to become transparent.
procedure Set_Color( this : access Button;
purpose : Color_Purpose;
color : Color_Type );
-- Sets the button's icon by filename.
procedure Set_Icon( this : access Button; icon : String );
-- Sets the shade applied to the button's foreground color when it is
-- disabled. Use 1.0 for no shading, < 1.0 to darken and > 1.0 to lighten.
procedure Set_Shade_Disabled( this : not null access Button'Class; shade : Float );
-- Sets the shade applied to the button's foreground color when its state
-- is On / Pressed down. Use 1.0 for no shading, < 1.0 to darken and > 1.0
-- to lighten.
procedure Set_Shade_On(this : not null access Button'Class; shade : Float );
-- Sets the shade applied to the button's foreground color when the mouse
-- hovers over it. Use 1.0 for no shading, < 1.0 to darken and > 1.0 to
-- lighten.
procedure Set_Shade_Hover( this : not null access Button'Class; shade : Float );
-- Sets the state of the button. If the state changes, a Press or Release
-- action will occur as appopriate.
procedure Set_State( this : access Button; on : Boolean );
-- Sets the button's text.
procedure Set_Text( this : access Button; text : String );
-- Toggles the state of the button to the opposite of the current state. A
-- Press or Release action will occur as appopriate.
procedure Toggle_State( this : access Button );
private
SPACING : constant Integer := 2;
----------------------------------------------------------------------------
type Button_Action is new Action with null record;
Press : constant Action_Id := To_Action_Id( "button.press" );
Held : constant Action_Id := To_Action_Id( "button.held" );
Release : constant Action_Id := To_Action_Id( "button.release" );
Click : constant Action_Id := To_Action_Id( "button.click" );
-- Deletes the Button_Action.
procedure Delete( this : in out A_Button_Action );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- A Simple_Button_Listener is an adapter class that listens for
-- Button_Action events and invokes a callback, A_Button_Handler. This
-- allows callback procedures to handle input actions instead of requiring
-- an object to do so.
type Simple_Button_Listener is new Simple_Action_Listener and Button_Listener with
record
handler : A_Button_Handler := null;
end record;
type A_Simple_Button_Listener is access all Simple_Button_Listener'Class;
-- Creates a Simple_Button_Listener that invokes 'handler' when it receives
-- a button action.
function Create_Listener( handler : not null A_Button_Handler ) return A_Button_Listener;
pragma Postcondition( Create_Listener'Result /= null );
procedure Construct( this : access Simple_Button_Listener;
handler : not null A_Button_Handler );
-- Invokes the simple button listener's Button_Handler procedure.
procedure Handle_Action( this : access Simple_Button_Listener;
action : A_Button_Action );
----------------------------------------------------------------------------
type Button is abstract new Widget with
record
text : Unbounded_String;
icon : Integer := 0;
on : Boolean := False;
align : Align_Type := Align_Center;
contrastText : Boolean := False;
shadeDisabled : Float := 0.9;
shadeHover : Float := 1.1;
shadeOn : Float := 0.85;
end record;
procedure Construct( this : access Button;
view : not null access Game_Views.Game_View'Class;
id : String;
text : String;
icon : String );
pragma Precondition( id'Length > 0 );
-- Dispatches Action_Id 'id' to all registered Button_Action listeners.
procedure Dispatch_Action( this : access Button; id : Action_Id );
-- Draws the button.
procedure Draw_Content( this : access Button; dc : Drawing_Context );
-- Returns the minimum height of the button, based on its icon and text.
function Get_Min_Height( this : access Button ) return Natural;
-- Returns the minimum width of the button, based on its icon and text.
function Get_Min_Width( this : access Button ) return Natural;
-- Returns a string representation of the widget for debugging purposes.
function To_String( this : access Button ) return String;
end Widgets.Buttons;