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