--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
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 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 );
-- 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 : Allegro_Color );
-- 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" );
----------------------------------------------------------------------------
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 );
-- 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;