1. with Allegro.Bitmaps;                   use Allegro.Bitmaps; 
  2. with Allegro.Truecolor;                 use Allegro.Truecolor; 
  3. with Drawing_Contexts;                  use Drawing_Contexts; 
  4. with Font_API;                          use Font_API; 
  5. with Objects;                           use Objects; 
  6. with Scaling;                           use Scaling; 
  7.  
  8. private with Ada.Containers.Indefinite_Ordered_Maps; 
  9.  
  10. package Themes is 
  11.  
  12.     type Align_Type is ( Align_Left, Align_Center, Align_Right ); 
  13.  
  14.     type Border_Type is ( Border_None, Border_Raised, Border_Sunk, Border_Line ); 
  15.  
  16.     type Color_Purpose is ( Background, 
  17.                             Foreground, 
  18.                             Selected, 
  19.                             Selected_Text, 
  20.                             Text ); 
  21.  
  22.     type Colors_Array is array (Color_Purpose) of Color_Type; 
  23.  
  24.     DEFAULT_FONT_NAME : constant String := "standard"; 
  25.     DEFAULT_FONT_SIZE : constant Positive := 14; 
  26.  
  27.     ---------------------------------------------------------------------------- 
  28.  
  29.     type Theme is abstract new Limited_Object with private; 
  30.     type A_Theme is access all Theme'Class; 
  31.  
  32.     -- Raises an exception on error, such as failure to load resources. 
  33.     function Create_Theme return A_Theme; 
  34.     pragma Postcondition( Create_Theme'Result /= null ); 
  35.  
  36.     function Border_Width( this : access Theme ) return Natural; 
  37.  
  38.     function Color( this : access Theme; purpose : Color_Purpose ) return Color_Type; 
  39.  
  40.     procedure Draw_Border( this   : access Theme; 
  41.                            dc     : Drawing_Context; 
  42.                            border : Border_Type; 
  43.                            x1, y1, 
  44.                            x2, y2 : Integer; 
  45.                            color  : Color_Type ); 
  46.  
  47.     procedure Draw_Box( this   : access Theme; 
  48.                         dc     : Drawing_Context; 
  49.                         x1, y1, 
  50.                         x2, y2 : Integer; 
  51.                         color  : Color_Type; 
  52.                         border : Border_Type := Border_None ); 
  53.  
  54.     -- Draws a label composed of the given icon, some horizontal spacing, and 
  55.     -- the given text. If the icon or the text is ommitted, the spacing that 
  56.     -- would separate the two will also be ommitted. The 'smooth' argument 
  57.     -- enables text anti-aliasing. The 'align' argument determines the alignment 
  58.     -- for the icon and text as a group within the width of the area given for 
  59.     -- the label by x1 and x2. The label will be centered vertically between 
  60.     -- y1 and y2. 
  61.     procedure Draw_Label( this     : access Theme; 
  62.                           dc       : Drawing_Context; 
  63.                           x1, y1, 
  64.                           x2, y2   : Integer; 
  65.                           icon     : A_Bitmap; 
  66.                           text     : String; 
  67.                           fontName : String; 
  68.                           fontSize : Positive; 
  69.                           color    : Color_Type; 
  70.                           align    : Align_Type; 
  71.                           smooth   : Boolean := False ); 
  72.     pragma Precondition( fontName'Length > 0 ); 
  73.  
  74.     -- Synchronously retrieves a bitmap by tile id. 
  75.     function Get_Bitmap( this : access Theme; 
  76.                          id   : Natural ) return A_Bitmap is abstract; 
  77.  
  78.     -- Returns a reference to a previously loaded font. If the font by this name 
  79.     -- and in this size has not been loaded previously, it will be reloaded in 
  80.     -- the new size 'size'. If the font 'name' is unknown or it can't be 
  81.     -- reloaded in the requested size, an exception will be raised. 
  82.     function Get_Font( this : not null access Theme'Class; 
  83.                        name : String; 
  84.                        size : Positive ) return Font_Type; 
  85.     pragma Precondition( name'Length > 0 ); 
  86.  
  87.     -- Returns the height in pixels of any text drawn in the given font. Zero is 
  88.     -- returned if the font hasn't been loaded. 
  89.     function Get_Text_Height( this     : not null access Theme'Class; 
  90.                               fontName : String; 
  91.                               fontSize : Positive ) return Natural; 
  92.     pragma Precondition( fontName'Length > 0 ); 
  93.  
  94.     -- Returns the id number of a tile referenced by name in the theme's tile 
  95.     -- library. 
  96.     function Get_ID( this : access Theme; name : String ) return Natural is abstract; 
  97.  
  98.     -- Returns the theme's current scaling filter type. 
  99.     function Get_Scaling_Filter( this : not null access Theme'Class ) return Filter_Type; 
  100.  
  101.     -- Returns the width in pixels of 'text' in the given font. Zero is returned 
  102.     -- if the font hasn't been loaded. 
  103.     function Get_Text_Width( this     : not null access Theme'Class; 
  104.                              text     : String; 
  105.                              fontName : String; 
  106.                              fontSize : Positive ) return Natural; 
  107.     pragma Precondition( fontName'Length > 0 ); 
  108.  
  109.     -- Returns the minimum height in pixels required to draw a label with the 
  110.     -- given icon and text. If Draw_Label is overridden, this function should 
  111.     -- also be appropriately overridden to return the correct height. 
  112.     function Label_Height( this     : access Theme; 
  113.                            icon     : A_Bitmap; 
  114.                            text     : String; 
  115.                            fontName : String; 
  116.                            fontSize : Positive ) return Natural; 
  117.     pragma Precondition( fontName'Length > 0 ); 
  118.  
  119.     -- Returns the minimum width in pixels required to draw a label with the 
  120.     -- given icon and text. If Draw_Label is overridden, this function should 
  121.     -- also be appropriately overridden to return the correct width. 
  122.     function Label_Width( this     : access Theme; 
  123.                           icon     : A_Bitmap; 
  124.                           text     : String; 
  125.                           fontName : String; 
  126.                           fontSize : Positive ) return Natural; 
  127.     pragma Precondition( fontName'Length > 0 ); 
  128.  
  129.     -- Registers a font file with a font name. The font will be loaded first at 
  130.     -- size DEFAULT_FONT_SIZE. If the file at 'path' can't be loaded, a 
  131.     -- Resource_Error exception will be raised. 
  132.     procedure Register_Font( this : not null access Theme'Class; 
  133.                              path : String; 
  134.                              name : String ); 
  135.  
  136.     -- Sets the theme's current scaling filter type. 
  137.     procedure Set_Scaling_Filter( this   : not null access Theme'Class; 
  138.                                   filter : Filter_Type ); 
  139.  
  140.     -- Deletes the theme. 
  141.     procedure Delete( this : in out A_Theme ); 
  142.     pragma Postcondition( this = null ); 
  143.  
  144. private 
  145.  
  146.     package Font_Maps is new Ada.Containers.Indefinite_Ordered_Maps( String, 
  147.                                                                      Font_Type, 
  148.                                                                      "<", 
  149.                                                                      "=" ); 
  150.  
  151.     package Font_Paths is new Ada.Containers.Indefinite_Ordered_Maps( String, 
  152.                                                                       String, 
  153.                                                                       "<", 
  154.                                                                       "=" ); 
  155.  
  156.     type Theme is abstract new Limited_Object with 
  157.         record 
  158.             colors    : Colors_Array := Colors_Array'(others => 0); 
  159.             fonts     : Font_Maps.Map; 
  160.             fontPaths : Font_Paths.Map; 
  161.             filter    : Filter_Type := Filter_Nearest; 
  162.         end record; 
  163.  
  164.     procedure Construct( this : access Theme ); 
  165.  
  166.     procedure Delete( this : in out Theme ); 
  167.  
  168.     -- 'path' is either the name of the font file to load (the path will be 
  169.     -- resolved using the Resources package), or an absolute path to the file. 
  170.     -- 'name' is the simple name of the font for later reference (name is case 
  171.     -- insensitive). An exception will be raised on error. 
  172.     function Load_Font( this : not null access Theme'Class; 
  173.                         path : String; 
  174.                         name : String; 
  175.                         size : Positive ) return Font_Type; 
  176.     pragma Precondition( name'Length > 0 ); 
  177.  
  178.     ---------------------------------------------------------------------------- 
  179.  
  180.     type Allocator is access function return A_Theme; 
  181.  
  182.     procedure Register_Allocator( allocate : not null Allocator ); 
  183.  
  184. end Themes;