--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
with Allegro.Bitmaps; use Allegro.Bitmaps;
with Allegro.Color; use Allegro.Color;
with Fonts; use Fonts;
with Objects; use Objects;
with Tiles; use Tiles;
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 Allegro_Color;
DEFAULT_FONT_NAME : constant String := "standard"; -- default gui font
DEFAULT_FONT_SIZE : constant Positive := 12; -- 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 Allegro_Color;
-- 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;
border : Border_Type;
x1, y1,
x2, y2 : Integer;
color : Allegro_Color );
-- 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;
x1, y1,
x2, y2 : Integer;
color : Allegro_Color;
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 '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;
x1, y1,
x2, y2 : Integer;
icon : A_Allegro_Bitmap;
text : String;
fontName : String;
fontSize : Positive;
color : Allegro_Color;
align : Align_Type );
pragma Precondition( fontName'Length > 0 );
-- Synchronously retrieves a bitmap by tile id.
function Get_Bitmap( this : access Theme;
id : Natural ) return A_Allegro_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 A_Font;
pragma Precondition( name'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 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 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 );
-- Synchronously retrieves a tile from the theme's tile library, or null if
-- the tile does not exist.
function Get_Tile( this : access Theme; id : Natural ) return A_Tile is abstract;
-- 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_Allegro_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_Allegro_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 );
----------------------------------------------------------------------------
-- 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,
A_Font,
"<",
"=" );
package Font_Paths is new Ada.Containers.Indefinite_Ordered_Maps( String,
String,
"<",
"=" );
type Theme is abstract new Limited_Object with
record
colors : Colors_Array;
fonts : Font_Maps.Map;
fontPaths : Font_Paths.Map;
end record;
procedure Construct( this : access Theme );
procedure Delete( this : in out Theme );
-- 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;