--
-- 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.Color; use Allegro.Color;
with Objects; use Objects;
private with Allegro.Fonts;
private with Resources;
package Fonts is
-- A Font represents a specific font of a specific size. Two Font instances
-- are required to work with the same font in two different font sizes.
type Font is abstract new Limited_Object with private;
type A_Font is access all Font'Class;
-- Loads a font from disk at a specific size. The file format will be
-- automatically detected; it must be a supported font format. An exception
-- will be raised on error.
function Load_Font( filename : String; size : Positive ) return A_Font;
pragma Precondition( filename'Length > 0 );
-- Renders a string onto the drawing target.
procedure Draw_String( this : not null access Font'Class;
str : String;
x, y : Float;
color : Allegro_Color );
-- Returns the height in pixels of a string rendered with the font.
function Text_Height( this : not null access Font'Class ) return Positive;
-- Returns the length in pixels of a string rendered with the font.
function Text_Length( this : not null access Font'Class;
str : String ) return Natural;
-- Deletes a font.
procedure Delete( this : in out A_Font );
pragma Postcondition( this = null );
-- Raised by Initialize on error, or on failure to load a font. Check the
-- exception's message for details.
FONT_EXCEPTION : exception;
private
use Allegro.Fonts;
use Resources;
type Font is new Limited_Object with
record
ptr : A_Allegro_Font := null;
size : Positive := 1;
res : A_Resource_File := null; -- backs the Allegro file
-- that backs the Allegro font
-- the drawn flag is a workaround to ensure that the font is
-- loaded on the drawing thread being being drawn. if the font has
-- not been drawn yet, it will be reloaded by the Textout procedure
-- immediately before drawing the first time.
drawn : Boolean := False;
end record;
-- Raises an exception on error loading 'filename'.
procedure Construct( this : access Font;
filename : String;
size : Positive );
procedure Delete( this : in out Font );
end Fonts;