1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Actions; 
  10.  
  11. private with Ada.Containers.Doubly_Linked_Lists; 
  12.  
  13. pragma Warnings( Off, Actions ); 
  14. pragma Elaborate_All( Actions ); 
  15.  
  16. package Widgets.Buttons.Groups is 
  17.  
  18.     -- Represents a widget action involving a Button_Group. 
  19.     type Button_Group_Action is new Action with private; 
  20.     type A_Button_Group_Action is access all Button_Group_Action'Class; 
  21.  
  22.     Group_Cleared : constant Action_Id;    -- all buttons are off in the group 
  23.     Group_Set     : constant Action_Id;    -- one button in the group is on 
  24.  
  25.     ---------------------------------------------------------------------------- 
  26.  
  27.     -- This is the interface to implement in order to listen to Button_Group 
  28.     -- actions. When a Button_Group action occurs, the listener will be notified. 
  29.     type Button_Group_Listener is limited interface and Action_Listener; 
  30.     type A_Button_Group_Listener is access all Button_Group_Listener'Class; 
  31.  
  32.     -- Handles the action 'action'. 
  33.     procedure Handle_Action( this   : access Button_Group_Listener; 
  34.                              action : A_Button_Group_Action ) is abstract; 
  35.  
  36.     ---------------------------------------------------------------------------- 
  37.  
  38.     -- A Button_Group is a logical control object that allows buttons to be 
  39.     -- linked. A button group is used to create a radio-button-like behavior 
  40.     -- with two or more toggleable buttons. Button_Group is not actually a 
  41.     -- widget and an instance must be explicitly owned by another object, like 
  42.     -- the Game_View, to prevent leaks. The Button_Group object doesn't maintain 
  43.     -- ownership of any of the buttons added to its membership. 
  44.     type Button_Group is new Limited_Object and Button_Listener with private; 
  45.     type A_Button_Group is access all Button_Group'Class; 
  46.  
  47.     -- Creates a new, empty button group. 
  48.     function Create_Button_Group return A_Button_Group; 
  49.     pragma Postcondition( Create_Button_Group'Result /= null ); 
  50.  
  51.     -- Adds a button to the group's membership. 
  52.     procedure Add( this : access Button_Group; button : not null A_Button ); 
  53.  
  54.     -- Adds a button group listener to be notified of actions. If the listener 
  55.     -- extends Simple_Action_Listener then it will be automatically deleted with 
  56.     -- the Button_Group, if it's still registered. 
  57.     procedure Add_Listener( this     : not null access Button_Group'Class; 
  58.                             listener : not null A_Button_Group_Listener ); 
  59.  
  60.     -- Removes all buttons from the group's membership. 
  61.     procedure Clear( this : access Button_Group ); 
  62.  
  63.     -- Removes a button group listener from the listener list. If 'listener' 
  64.     -- isn't already listening then nothing happens. 
  65.     procedure Remove_Listener( this     : access Button_Group; 
  66.                                listener : not null A_Button_Group_Listener ); 
  67.  
  68.     -- Changes whether or not the active button in the group is allowed to be 
  69.     -- unselected. If 'keep' is set True then the active button on a tool group, 
  70.     -- once pressed, can't be unpressed. 
  71.     procedure Set_Keep_Selected( this : access Button_Group; keep : Boolean ); 
  72.  
  73.     -- Unpresses the active button in the group, if there is one. This will have 
  74.     -- no effect if the 'keep selected' option has been set unless 'force' is 
  75.     -- set True. 
  76.     procedure Unset( this  : access Button_Group; 
  77.                      force : Boolean := False ); 
  78.  
  79.     -- Deletes the Button_Group. 
  80.     procedure Delete( this : in out A_Button_Group ); 
  81.     pragma Postcondition( this = null ); 
  82.  
  83. private 
  84.  
  85.     -- Provides a list of Button_Group_Listeners. 
  86.     package Action_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Button_Group_Listener, "=" ); 
  87.     use Action_Listeners; 
  88.  
  89.     -- Provides a list of Buttons. 
  90.     package Button_Collection is new Ada.Containers.Doubly_Linked_Lists( A_Button, "=" ); 
  91.     use Button_Collection; 
  92.  
  93.     ---------------------------------------------------------------------------- 
  94.  
  95.     type Button_Group_Action is new Action with null record; 
  96.  
  97.     Group_Cleared : constant Action_Id := To_Action_Id( "button_group.cleared" ); 
  98.     Group_Set     : constant Action_Id := To_Action_Id( "button_group.set" ); 
  99.  
  100.     ---------------------------------------------------------------------------- 
  101.  
  102.     type Button_Group is new Limited_Object and Button_Listener with 
  103.         record 
  104.             buttons       : Button_Collection.List; 
  105.             pressed       : A_Button := null; 
  106.             keep_selected : Boolean := True;  -- force a button to remain selected 
  107.             listeners     : Action_Listeners.List; 
  108.         end record; 
  109.  
  110.     procedure Delete( this : in out Button_Group ); 
  111.  
  112.     -- Dispatches Action_Id 'id' to all registered Button_Group_Action listeners. 
  113.     procedure Dispatch_Action( this   : access Button_Group; 
  114.                                id     : Action_Id; 
  115.                                source : not null A_Widget ); 
  116.  
  117.     -- Handles actions of buttons within the button group's membership. A 
  118.     -- Button_Group_Action will occur as necessary. 
  119.     procedure Handle_Action( this   : access Button_Group; 
  120.                              action : A_Button_Action ); 
  121.  
  122.     -- Returns a string representation of a button group for debugging purposes. 
  123.     function To_String( this : access Button_Group ) return String; 
  124.  
  125. end Widgets.Buttons.Groups;