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 Ada.Real_Time;                     use Ada.Real_Time; 
  10.  
  11. private with Values.Lists; 
  12.  
  13. package Widgets.Labels is 
  14.  
  15.     -- A Label widget is a simple text string with an optional icon to the left 
  16.     -- of the text. A label is intended for displaying static strings and isn't 
  17.     -- editable by the interface user. 
  18.     type Label is new Widget and Animated with private; 
  19.     type A_Label is access all Label'Class; 
  20.  
  21.     -- Creates a new Label within 'view' with id 'id'. Both 'text' and 'icon' 
  22.     -- are optional. 'icon' is the name of a frame in the Theme's tile library. 
  23.     -- The icon image can have an alpha channel for transparency. 
  24.     function Create_Label( view : not null access Game_Views.Game_View'Class; 
  25.                            id   : String; 
  26.                            text : String := ""; 
  27.                            icon : String := "" ) return A_Label; 
  28.     pragma Precondition( id'Length > 0 ); 
  29.     pragma Postcondition( Create_Label'Result /= null ); 
  30.  
  31.     -- Returns the label's text. 
  32.     function Get_Text( this : not null access Label'Class ) return String; 
  33.  
  34.     -- Sets the label's text alignment. Both the text and icon will be aligned 
  35.     -- according to 'align'. 
  36.     procedure Set_Align( this : not null access Label'Class; align : Align_Type ); 
  37.  
  38.     -- Sets the color for a particular purpose when drawing the label. To remove 
  39.     -- the color behind the icon text, set the Foreground color to transparent. 
  40.     procedure Set_Color( this    : access Label; 
  41.                          purpose : Color_Purpose; 
  42.                          color   : Allegro_Color ); 
  43.  
  44.     -- Sets the label's icon. Pass an empty string to remove it. 
  45.     procedure Set_Icon( this : not null access Label'Class; icon : String ); 
  46.  
  47.     -- Sets the label's text. 
  48.     procedure Set_Text( this : not null access Label'Class; text : String ); 
  49.  
  50. private 
  51.  
  52.     use Values.Lists; 
  53.  
  54.     type Label is new Widget and Animated with 
  55.         record 
  56.             align          : Align_Type := Align_Left; 
  57.             text           : Unbounded_String; 
  58.             icon           : Natural := 0;     -- the icon that was set 
  59.  
  60.             -- for icon animation -- 
  61.             iconStart      : Time_Span;        -- start time of the animation 
  62.             iconFrame      : Natural := 0;     -- current image being displayed 
  63.             iconFrameDelay : Time_Span;        -- delay between frames 
  64.             iconFrameLoop  : List_Ptr;         -- list of frames in loop 
  65.         end record; 
  66.  
  67.     procedure Construct( this : access Label; 
  68.                          view : not null access Game_Views.Game_View'Class; 
  69.                          id   : String; 
  70.                          text : String; 
  71.                          icon : String ); 
  72.  
  73.     procedure Draw_Content( this : access Label ); 
  74.  
  75.     -- Returns the label's minimum height. 
  76.     function Get_Min_Height( this : access Label ) return Natural; 
  77.  
  78.     -- Returns the label's minimum width. 
  79.     function Get_Min_Width( this : access Label ) return Natural; 
  80.  
  81.     -- Updates the label's icon, if it's animated. 
  82.     procedure Tick( this : access Label; time : Tick_Time ); 
  83.  
  84. end Widgets.Labels;