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