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