--
-- 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;
private with Ada.Containers.Doubly_Linked_Lists;
pragma Warnings( Off, Actions );
pragma Elaborate_All( Actions );
package Widgets.Buttons.Groups is
-- Represents a widget action involving a Button_Group.
type Button_Group_Action is new Action with private;
type A_Button_Group_Action is access all Button_Group_Action'Class;
Group_Cleared : constant Action_Id; -- all buttons are off in the group
Group_Set : constant Action_Id; -- one button in the group is on
----------------------------------------------------------------------------
-- This is the interface to implement in order to listen to Button_Group
-- actions. When a Button_Group action occurs, the listener will be notified.
type Button_Group_Listener is limited interface and Action_Listener;
type A_Button_Group_Listener is access all Button_Group_Listener'Class;
-- Handles the action 'action'.
procedure Handle_Action( this : access Button_Group_Listener;
action : A_Button_Group_Action ) is abstract;
----------------------------------------------------------------------------
-- A Button_Group is a logical control object that allows buttons to be
-- linked. A button group is used to create a radio-button-like behavior
-- with two or more toggleable buttons. Button_Group is not actually a
-- widget and an instance must be explicitly owned by another object, like
-- the Game_View, to prevent leaks. The Button_Group object doesn't maintain
-- ownership of any of the buttons added to its membership.
type Button_Group is new Limited_Object and Button_Listener with private;
type A_Button_Group is access all Button_Group'Class;
-- Creates a new, empty button group.
function Create_Button_Group return A_Button_Group;
pragma Postcondition( Create_Button_Group'Result /= null );
-- Adds a button to the group's membership.
procedure Add( this : access Button_Group; button : not null A_Button );
-- Adds a button group listener to be notified of actions. If the listener
-- extends Simple_Action_Listener then it will be automatically deleted with
-- the Button_Group, if it's still registered.
procedure Add_Listener( this : not null access Button_Group'Class;
listener : not null A_Button_Group_Listener );
-- Removes all buttons from the group's membership.
procedure Clear( this : access Button_Group );
-- Removes a button group listener from the listener list. If 'listener'
-- isn't already listening then nothing happens.
procedure Remove_Listener( this : access Button_Group;
listener : not null A_Button_Group_Listener );
-- Changes whether or not the active button in the group is allowed to be
-- unselected. If 'keep' is set True then the active button on a tool group,
-- once pressed, can't be unpressed.
procedure Set_Keep_Selected( this : access Button_Group; keep : Boolean );
-- Unpresses the active button in the group, if there is one. This will have
-- no effect if the 'keep selected' option has been set unless 'force' is
-- set True.
procedure Unset( this : access Button_Group;
force : Boolean := False );
-- Deletes the Button_Group.
procedure Delete( this : in out A_Button_Group );
pragma Postcondition( this = null );
private
-- Provides a list of Button_Group_Listeners.
package Action_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Button_Group_Listener, "=" );
use Action_Listeners;
-- Provides a list of Buttons.
package Button_Collection is new Ada.Containers.Doubly_Linked_Lists( A_Button, "=" );
use Button_Collection;
----------------------------------------------------------------------------
type Button_Group_Action is new Action with null record;
Group_Cleared : constant Action_Id := To_Action_Id( "button_group.cleared" );
Group_Set : constant Action_Id := To_Action_Id( "button_group.set" );
----------------------------------------------------------------------------
type Button_Group is new Limited_Object and Button_Listener with
record
buttons : Button_Collection.List;
pressed : A_Button := null;
keep_selected : Boolean := True; -- force a button to remain selected
listeners : Action_Listeners.List;
end record;
procedure Delete( this : in out Button_Group );
-- Dispatches Action_Id 'id' to all registered Button_Group_Action listeners.
procedure Dispatch_Action( this : access Button_Group;
id : Action_Id;
source : not null A_Widget );
-- Handles actions of buttons within the button group's membership. A
-- Button_Group_Action will occur as necessary.
procedure Handle_Action( this : access Button_Group;
action : A_Button_Action );
-- Returns a string representation of a button group for debugging purposes.
function To_String( this : access Button_Group ) return String;
end Widgets.Buttons.Groups;