with Allegro.Bitmaps; use Allegro.Bitmaps;
with Allegro.Truecolor; use Allegro.Truecolor;
with Drawing_Contexts; use Drawing_Contexts;
with Font_API; use Font_API;
with Objects; use Objects;
with Scaling; use Scaling;
private with Ada.Containers.Indefinite_Ordered_Maps;
package Themes is
-- enumeration for text/icon alignment
type Align_Type is ( Align_Left, Align_Center, Align_Right );
-- enumeration of border styles
type Border_Type is ( Border_None, Border_Raised, Border_Sunk, Border_Line );
-- enumeration of the different purposes a widget has for user-defined
-- colors. not all widgets use colors for every purpose.
type Color_Purpose is ( Background,
Foreground,
Selected,
Selected_Text,
Text );
-- an array of colors, one for each potential purpose in a widget
type Colors_Array is array (Color_Purpose) of Color_Type;
DEFAULT_FONT_NAME : constant String := "standard"; -- default gui font
DEFAULT_FONT_SIZE : constant Positive := 14; -- default font size
----------------------------------------------------------------------------
-- A Theme is an abstract class used by widgets to provide the GUI's look
-- and feel. The Theme is a singleton object.
type Theme is abstract new Limited_Object with private;
type A_Theme is access all Theme'Class;
-- Returns the width in pixels of borders drawn by the Theme.
function Border_Width( this : access Theme ) return Natural;
-- Returns the Theme's default color for a 'purpose'.
function Color( this : access Theme; purpose : Color_Purpose ) return Color_Type;
-- Draws a rectangular border from x1, y1 to x2, y2 using 'border' as the
-- border type and 'color' as the border's dominant color.
procedure Draw_Border( this : access Theme;
dc : Drawing_Context;
border : Border_Type;
x1, y1,
x2, y2 : Integer;
color : Color_Type );
-- Draws a filled rectangle of 'color' (unless 'color' is transparent) from
-- x1, y1 to x2, y2 and a border of type 'border' with 'color' as the
-- border's dominant color.
procedure Draw_Box( this : access Theme;
dc : Drawing_Context;
x1, y1,
x2, y2 : Integer;
color : Color_Type;
border : Border_Type := Border_None );
-- Draws a label composed of the given icon, some horizontal spacing, and
-- the given text. If the icon or the text is ommitted, the spacing that
-- would separate the two will also be ommitted. The 'smooth' argument
-- enables text anti-aliasing. The 'align' argument determines the alignment
-- for the icon and text as a group within the width of the area given for
-- the label by x1 and x2. The label will be centered vertically between
-- y1 and y2.
procedure Draw_Label( this : access Theme;
dc : Drawing_Context;
x1, y1,
x2, y2 : Integer;
icon : A_Bitmap;
text : String;
fontName : String;
fontSize : Positive;
color : Color_Type;
align : Align_Type;
smooth : Boolean := False );
pragma Precondition( fontName'Length > 0 );
-- Synchronously retrieves a bitmap by tile id.
function Get_Bitmap( this : access Theme;
id : Natural ) return A_Bitmap is abstract;
-- Returns a reference to a previously loaded font. If the font by this name
-- and in this size has not been loaded previously, it will be reloaded in
-- the new size 'size'. If the font 'name' is unknown or it can't be
-- reloaded in the requested size, an exception will be raised.
function Get_Font( this : not null access Theme'Class;
name : String;
size : Positive ) return Font_Type;
pragma Precondition( name'Length > 0 );
-- Returns the height in pixels of any text drawn in the given font. Zero is
-- returned if the font hasn't been loaded.
function Get_Text_Height( this : not null access Theme'Class;
fontName : String;
fontSize : Positive ) return Natural;
pragma Precondition( fontName'Length > 0 );
-- Returns the id number of a tile referenced by name in the theme's tile
-- library.
function Get_ID( this : access Theme; name : String ) return Natural is abstract;
-- Returns the theme's current scaling filter type.
function Get_Scaling_Filter( this : not null access Theme'Class ) return Filter_Type;
-- Returns the width in pixels of 'text' in the given font. Zero is returned
-- if the font hasn't been loaded.
function Get_Text_Width( this : not null access Theme'Class;
text : String;
fontName : String;
fontSize : Positive ) return Natural;
pragma Precondition( fontName'Length > 0 );
-- Returns the minimum height in pixels required to draw a label with the
-- given icon and text. If Draw_Label is overridden, this function should
-- also be appropriately overridden to return the correct height.
function Label_Height( this : access Theme;
icon : A_Bitmap;
text : String;
fontName : String;
fontSize : Positive ) return Natural;
pragma Precondition( fontName'Length > 0 );
-- Returns the minimum width in pixels required to draw a label with the
-- given icon and text. If Draw_Label is overridden, this function should
-- also be appropriately overridden to return the correct width.
function Label_Width( this : access Theme;
icon : A_Bitmap;
text : String;
fontName : String;
fontSize : Positive ) return Natural;
pragma Precondition( fontName'Length > 0 );
-- Registers a font file with a font name. The font will be loaded first at
-- size DEFAULT_FONT_SIZE. If the file at 'path' can't be loaded, a
-- Resource_Error exception will be raised.
procedure Register_Font( this : not null access Theme'Class;
path : String;
name : String );
-- Sets the theme's current scaling filter type.
procedure Set_Scaling_Filter( this : not null access Theme'Class;
filter : Filter_Type );
----------------------------------------------------------------------------
-- Creates the global theme instance. Raises an exception on error.
procedure Create_Theme;
-- Deletes the global theme instance.
procedure Delete_Theme;
-- Returns a reference to the global theme or null, if it has not been
-- created.
function Get return A_Theme;
private
package Font_Maps is new Ada.Containers.Indefinite_Ordered_Maps( String,
Font_Type,
"<",
"=" );
package Font_Paths is new Ada.Containers.Indefinite_Ordered_Maps( String,
String,
"<",
"=" );
type Theme is abstract new Limited_Object with
record
colors : Colors_Array := Colors_Array'(others => 0);
fonts : Font_Maps.Map;
fontPaths : Font_Paths.Map;
filter : Filter_Type := Filter_Nearest;
end record;
procedure Construct( this : access Theme );
procedure Delete( this : in out Theme );
-- 'path' is either the name of the font file to load (the path will be
-- resolved using the Resources package), or an absolute path to the file.
-- 'name' is the simple name of the font for later reference (name is case
-- insensitive). An exception will be raised on error.
function Load_Font( this : not null access Theme'Class;
path : String;
name : String;
size : Positive ) return Font_Type;
pragma Precondition( name'Length > 0 );
-- Deletes the Theme.
procedure Delete( this : in out A_Theme );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- An allocator function for creating Theme instances.
type Allocator is access function return A_Theme;
-- Registers the allocator that will be used to create the global Theme
-- instance. This should be called at elaboration time.
procedure Register_Allocator( allocate : not null Allocator );
end Themes;