1. with Actions; 
  2.  
  3. pragma Warnings( Off, Actions ); 
  4. pragma Elaborate_All( Actions ); 
  5.  
  6. package Widgets.Buttons is 
  7.  
  8.     type Button_Action is new Action with private; 
  9.     type A_Button_Action is access all Button_Action'Class; 
  10.  
  11.     Press   : constant Action_Id; 
  12.     Held    : constant Action_Id; 
  13.     Release : constant Action_Id; 
  14.     Click   : constant Action_Id; 
  15.  
  16.     ---------------------------------------------------------------------------- 
  17.  
  18.     -- This is the interface to implement in order to listen to button actions. 
  19.     -- When a button action occurs, the listener will be notified of the type of 
  20.     -- action performed and the button that performed the action. 
  21.     type Button_Listener is limited interface and Action_Listener; 
  22.     type A_Button_Listener is access all Button_Listener'Class; 
  23.  
  24.     procedure Handle_Action( this   : access Button_Listener; 
  25.                              action : A_Button_Action ) is abstract; 
  26.  
  27.     type A_Button_Handler is 
  28.         access procedure( action : A_Button_Action ); 
  29.  
  30.     ---------------------------------------------------------------------------- 
  31.  
  32.     type Button is abstract new Widget with private; 
  33.     type A_Button is access all Button'Class; 
  34.  
  35.     procedure Add_Listener( this     : access Button; 
  36.                             listener : not null A_Button_Listener ); 
  37.  
  38.     -- Adds the handler procedure as a simple listener. The listener can't be 
  39.     -- removed and can be added multiple times. 
  40.     procedure Add_Listener( this    : access Button; 
  41.                             handler : not null A_Button_Handler ); 
  42.  
  43.     procedure Contrast_Text( this : not null access Button'Class; enabled : Boolean ); 
  44.  
  45.     function Get_State( this : not null access Button'Class ) return Boolean; 
  46.  
  47.     function Get_Text( this : not null access Button'Class ) return String; 
  48.  
  49.     procedure Remove_Listener( this     : access Button; 
  50.                                listener : not null A_Button_Listener ); 
  51.  
  52.     procedure Set_Align( this : not null access Button'Class; align : Align_Type ); 
  53.  
  54. #if OSX then 
  55.     procedure Set_Color( this    : access Button; 
  56.                          purpose : Color_Purpose; 
  57.                          color   : Color_Type ); 
  58. #end if; 
  59.  
  60.     procedure Set_Icon( this : access Button; icon : String ); 
  61.  
  62.     procedure Set_State( this : access Button; on : Boolean ); 
  63.  
  64.     procedure Set_Text( this : access Button; text : String ); 
  65.  
  66.     procedure Toggle_State( this : access Button ); 
  67.  
  68. private 
  69.  
  70.     SPACING : constant Integer := 2; 
  71.  
  72.     ---------------------------------------------------------------------------- 
  73.  
  74.     type Button_Action is new Action with null record; 
  75.  
  76.     Press   : constant Action_Id := To_Action_Id( "button.press" ); 
  77.     Held    : constant Action_Id := To_Action_Id( "button.held" ); 
  78.     Release : constant Action_Id := To_Action_Id( "button.release" ); 
  79.     Click   : constant Action_Id := To_Action_Id( "button.click" ); 
  80.  
  81.     procedure Delete( this : in out A_Button_Action ); 
  82.     pragma Postcondition( this = null ); 
  83.  
  84.     ---------------------------------------------------------------------------- 
  85.  
  86.     type Simple_Button_Listener is new Simple_Action_Listener and Button_Listener with 
  87.         record 
  88.             handler : A_Button_Handler := null; 
  89.         end record; 
  90.     type A_Simple_Button_Listener is access all Simple_Button_Listener'Class; 
  91.  
  92.     function Create_Listener( handler : not null A_Button_Handler ) return A_Button_Listener; 
  93.     pragma Postcondition( Create_Listener'Result /= null ); 
  94.  
  95.     procedure Construct( this    : access Simple_Button_Listener; 
  96.                          handler : not null A_Button_Handler ); 
  97.  
  98.     procedure Handle_Action( this   : access Simple_Button_Listener; 
  99.                              action : A_Button_Action ); 
  100.  
  101.     ---------------------------------------------------------------------------- 
  102.  
  103.     type Button is abstract new Widget with 
  104.         record 
  105.             text         : Unbounded_String; 
  106.             icon         : Integer := 0; 
  107.             on           : Boolean := False; 
  108.             align        : Align_Type := Align_Center; 
  109.             contrastText : Boolean := False; 
  110.         end record; 
  111.  
  112.     procedure Construct( this : access Button; 
  113.                          view : not null access Game_Views.Game_View'Class; 
  114.                          id   : String; 
  115.                          text : String; 
  116.                          icon : String ); 
  117.     pragma Precondition( id'Length > 0 ); 
  118.  
  119.     procedure Dispatch_Action( this : access Button; id : Action_Id ); 
  120.  
  121.     procedure Draw_Content( this : access Button; dc : Drawing_Context ); 
  122.  
  123.     function Get_Min_Height( this : access Button ) return Natural; 
  124.  
  125.     function Get_Min_Width( this : access Button ) return Natural; 
  126.  
  127. #if WINDOWS then 
  128.     procedure Set_Color( this    : access Button; 
  129.                          purpose : Color_Purpose; 
  130.                          color   : Color_Type ); 
  131. #end if; 
  132.  
  133.     function To_String( this : access Button ) return String; 
  134.  
  135. end Widgets.Buttons;