Unit FTLib;

interface

{$IFDEF VIRTUAL}
uses
  Use32;
{$ENDIF}

(*-------------------------- TYPES -----------------------------------------*)

  (*********************************************************************)
  (*                                                                   *)
  (*                          Error codes                              *)
  (*                                                                   *)
  (*********************************************************************)

type
  (*****************************************************************)
  (* library error code, see list below                            *)
  (*                                                               *)
  FT_Error  = Integer;

const
  FT_Err_Ok                           = 0;  (* succes is always 0 !! *)
  FT_Err_Divide_By_Zero               = 1;
  FT_Err_DPIs_Must_Be_Over_72         = 2;
  FT_Err_Invalid_Font_Object          = 3;
  FT_Err_Invalid_Font_Resource_Name   = 4;
  FT_Err_Unsupported_Feature          = 5;
  FT_Err_Abstract_Method_Called       = 6;

  (*****************************************************************)
  (*  error classes                                                *)
  (*                                                               *)
  (*  these values are used to separate error between distinct     *)
  (*  levels of the library. e.g. the TrueType class is or-ed to   *)
  (*  the error codes reported by the TT engine                    *)
  (*                                                               *)
  (*  for example, when an error occurs in the TrueType engine     *)
  (*  and cannot be interpreted by the library, the invoked        *)
  (*  function will return ($10000 _or_ "the TrueType error code") *)
  (*                                                               *)
  FT_Error_Class_Library      = 0;       (* library error                   *)
  FT_Error_Class_TrueType     = $10000;  (* error in the TT engine          *)
  FT_Error_Class_Type1        = $20000;  (* error in the T1 engine          *)
  FT_Error_Class_Device       = $30000;  (* error in device while rendering *)

const
  FT_Device_Caps_Accepts_Bitmaps = 1;
  FT_Device_Caps_Accepts_Pixmaps = 2;
  FT_Device_Caps_Accepts_Vectors = 4;

  FT_Outline_Format_Unknown  = 0;  (* indicates an invalid outline *)
  FT_Outline_Format_TrueType = 1;  (* for TrueType outlines        *)
  FT_Outline_Format_Type1    = 2;  (* for Type1 outlines           *)

  FT_Outline_Format_User     = 8;  (* user supplied formats start here *)


  (*********************************************************************)
  (* font weights                                                      *)
  (*                                                                   *)
  (* Note that we copied the mapping from the TrueType specification   *)
  (*                                                                   *)
const
  FT_Weight_Ultra_Light = 1;
  FT_Weight_Extra_Light = 2;
  FT_Weight_Light       = 3;
  FT_Weight_Semi_Light  = 4;
  FT_Weight_Medium      = 5;
  FT_Weight_Semi_Bold   = 6;
  FT_Weight_Bold        = 7;
  FT_Weight_Extra_Bold  = 8;
  FT_Weight_Ultra_Bold  = 9;


  (*********************************************************************)
  (*                                                                   *)
  (*                   Base and important types                        *)
  (*                                                                   *)
  (*********************************************************************)
type
  FT_Font    = Pointer;   (* a font object handle *)

  FT_Device  = ^FT_Device_Class;
  FT_Outline = ^FT_Outline_Class;
  FT_Bitmap  = Pointer;
  FT_Pixmap  = Pointer;

  (*****************************************************************)
  (* a 16.16 fixed float to be used as matrix coefficient or scale *)
  (*                                                               *)
  FT_Fixed = Longint;

  (*****************************************************************)
  (* a 26.6 fixed float pixel coordinate, used for glyph positions *)
  (* and distances                                                 *)
  (*                                                               *)
  FT_Pos = Longint;

  (*****************************************************************)
  (* a simple bounding box structure                               *)
  (*                                                               *)
  FT_BBox = record

      xMin : FT_Pos;
      yMin : FT_Pos;
      xMax : FT_Pos;
      yMax : FT_Pos;
  end;

  (*****************************************************************)
  (* a 2x2 matrix - when applying a matrix to a vector, the        *)
  (* computation will be :                                         *)
  (*                                                               *)
  (*  x' = xx*x + xy*y    i.e. M = [xx xy]                         *)
  (*  y' = yx*x + yy*y             [yx yy]                         *)
  (*                                                               *)
  FT_Matrix = record
      xx, xy : FT_Fixed;
      yx, yy : FT_Fixed;
  end;

  (*****************************************************************)
  (* a linear transform type. This is simply the reunion of a      *)
  (* 2x2 matrix and a translation vector. Note that the matrix is  *)
  (* applied before the translation..                              *)
  (*                                                               *)
  FT_Transform = record

      matrix : FT_Matrix;
      x_ofs  : FT_Pos;
      y_ofs  : FT_Pos;
  end;

  (*****************************************************************)
  (* a glyph width, either in logical or pixel units               *)
  (*                                                               *)
  FT_Width       = Integer;

  FT_Width_Array = array[0..199] of FT_Width;
  FT_Widths      = ^FT_Width_Array;

  (*****************************************************************)
  (* a glyph's ABC widths, either in logical or pixel units        *)
  (* these width are also known as :                               *)
  (*                                                               *)
  (*   the left-side bearing  (A)                                  *)
  (*   the glyph extent       (B)                                  *)
  (*   the right-side bearing (C)                                  *)
  (*                                                               *)
  (* the 'advance width' is the value A+B+C                        *)
  (*                                                               *)
  FT_ABC = record
      A, B, C : Integer;
  end;

  FT_ABC_Array  = array [0..199] of FT_ABC;
  FT_ABC_Widths = ^FT_ABC_Array;

  (*********************************************************************)
  (* glyph metrics                                                     *)
  (*                                                                   *)
  FT_Glyph_Metrics = record

      bbox     : FT_BBox;
      incCellX : integer;
      incCellY : integer;
  end;

  (*********************************************************************)
  (* Output Device abstract class                                      *)
  (*                                                                   *)
  (* this class ecapsulate the concept of a "device context". It       *)
  (* must provide :                                                    *)
  (*                                                                   *)
  (* - a horizontal and vertical resolutions, expressed in integer     *)
  (*   dots per inches. common values are 72x96, 96x96 (for screens)   *)
  (*   or 300x300, 600x600 (for printers)..                            *)
  (*                                                                   *)
  (* - a 'capabilities' field                                          *)
  (*                                                                   *)
  (* - an horizontal and vertical dimensions, expressed in pixels      *)
  (*                                                                   *)
  (* Depending on its abilities, a device class should provide the     *)
  (* following :                                                       *)
  (*                                                                   *)
  (* - a method used to send a monochrome bitmap to the device         *)
  (* - a method used to send a 5-levels 8-bit pixmap to the device     *)
  (* - eventually, but not yet implemented, a vector outline           *)
  (*                                                                   *)
  (* The FT_Device_Class defined here is an abstract one that must be  *)
  (* subclassed by client applications to encapsulate their own        *)
  (* output device. See the example programs to see how to do it.      *)
  (*                                                                   *)
  (* You can add other fields to your own device class, like           *)
  (* current pen position, colour, brushes.. with the exception of     *)
  (* 'current font'. The FreeType library won't access them though..   *)
  (*                                                                   *)
  (* The library never needs to create devices on its own, it is up    *)
  (* to the client application to do so before calling the FreeType    *)
  (* API.                                                              *)
  (*                                                                   *)
  (*********************************************************************)

  FT_Device_Class = object
    (* these fields are read-only, and should be set by the constructor *)

      xResolutionDPI  : integer;  (* device resolutions *)
      yResolutionDPI  : integer;  (* in dots per inches *)

      xDimension      : longint;  (* device output width  *)
      yDimension      : longint;  (* device output height *)

      capabilities    : integer;  (* caps field *)

      function  drawBitmap( x_origin : longint;
                            y_origin : longint;
                            bitmap   : FT_Bitmap ) : integer; virtual;

      function  drawPixmap( x_origin : longint;
                            y_origin : longint;
                            pixmap   : FT_Pixmap ) : integer; virtual;

      function  drawOutline( x_origin : FT_Pos;
                             y_origin : FT_Pos;
                             outline  : FT_Outline ) : integer; virtual;
  end;

  (*********************************************************************)
  (* Outline abstract class                                            *)
  (*                                                                   *)
  (* this class encapsulate the concept of an "outline", i.e. the      *)
  (* vectorial representation of a glyph, made of one or more contours *)
  (*                                                                   *)
  (* because outlines can be stored in very varying structures         *)
  (* according to their original font format (TrueType, Type1, other..)*)
  (*                                                                   *)
  (* this abstract class only provides one field, used to specify      *)
  (* the outline's internal format. Otherwise, virtual methods are     *)
  (* defined to perform common operations and queries.                 *)
  (*                                                                   *)
  (* The various outline formats (only TrueType ones currently) are    *)
  (* defined in the "ftoutln.pas" component, which you can modify      *)
  (* to add the outline type that suits your platform best and         *)
  (* converter functions.                                              *)
  (*                                                                   *)
  (*********************************************************************)

  FT_Outline_Class = object

      format : integer;

      (* query contours number *)
      function getContours : integer;  virtual;

      (* query points number - note that this is format-specific *)
      function getPoints   : integer;  virtual;

      (* translate outline - offsets in 26.6 fixed float format *)
      procedure translate( x, y : FT_Pos ); virtual;

      (* transform outline - matrix coefficients are 16.16 fixed floats *)
      procedure transform( var matrix : FT_Matrix ); virtual;

      (* query bounding box *)
      procedure getExtent( var bbox : FT_BBox ); virtual;

      (* query pixel width *)
      function  getPixelWidth : integer; virtual;

      (* query pixel height *)
      function  getPixelHeight : integer; virtual;

      (* is the outline empty ? *)
      function isEmpty : boolean; virtual;

      (* query bitmap - returns null in case of failure (out of memory) *)
      function  getBitmap : FT_Bitmap; virtual;

      (* query pixmap - returns null in case of failure (out of memory) *)
      function  getPixmap : FT_Pixmap; virtual;

      (* create a new outline and copy the current one into it *)
      (* this function returns an error code (0 = success)     *)
      function clone( var new_outline : FT_Outline ) : FT_Error; virtual;
  end;

  FT_Weight = integer;

  (*********************************************************************)
  (*                                                                   *)
  (*                      FT_Font_Description                          *)
  (*                                                                   *)
  (*     structure used to request the creation of a new font object   *)
  (*                                                                   *)
  (*********************************************************************)

  FT_Font_Description = record

      (* note : the fields read by the font creator depend on the *)
      (*        value of 'queryType'                              *)

      queryType : Integer;   (* query flags - see definitions below *)

      dimY      : Integer;   (* height in pixels or points *)
      dimX      : Integer;   (* widths in pixels or points *)

      resY      : Integer;   (* device resolution in dots per inches  *)
      resX      : Integer;   (* device resolution in dots per inches  *)

      (* note : device resolutions are only needed when 'dimX' and/or *)
      (*        'dimX' are given in point sizes                       *)

      transform : FT_Transform; (* transform to apply to text *)

      facename  : string;    (* face name, or font pathname       *)
      styles    : integer;   (* face style                        *)
      subIndex  : Integer;   (* font index within font containers *)
  end;


const
  (******************************************************************)
  (* the following values are used to create a 'queryType' field in *)
  (* a font description record during a font creation request       *)

  (* when set, the glyph sizes in "dimX" and "dimY" are expressed in *)
  (* integer pixel dimensions. By default, they are expressed in     *)
  (* fixed float (26.6) point sizes, where 1 pt = 1/72 inch          *)
  FT_Flag_Pixel_Sizes = 1;

  (* Must be set when "dimX" and "dimY" differ. By default, the library *)
  (* assumes equal width and height, and ignores "dimX"                 *)
  FT_Flag_Non_Square_Sizes = 2;

  (* Must be set when the output device resolutions "resX" and "resY"  *)
  (* differ. By default, the library assumes square pixels and ignores *)
  (* "resX"                                                            *)
  FT_Flag_Non_Square_Resolutions = 4;

  (* Must be set to query that the "transform" matrix field be applied *)
  (* to this font's outlines. This is useful to perform rotation,      *)
  (* stretching or skewing.. Note that the client application must set *)
  (* up its own transform itself !                                     *)
  (* By default, the 'transform' field is simply ignored               *)
  FT_Flag_Use_Transform = 8;

  (* Must be set, for TrueType fonts only, to notice the TT hinter that  *)
  (* the font will be rotated (either through the supplied transform or  *)
  (* by client-level operations. Will be safely ignored by all other     *)
  (* font types.                                                         *)
  FT_Flag_Rotation = 16;

  (* Must be set, for TrueType fonts only, to notice the TT hinter that   *)
  (* the font will be distorted later, i.e. applied a transform that      *)
  (* doesn't keep distances constant. Skewing and Stretching are examples *)
  (* of distortions. Will be safely ignored by all other font types.      *)
  FT_Flag_Distorsion = 32;

  (* Must be set when the font is to be extracted from a font container   *)
  (* file (like a TrueType collection). In this case, the subIndex field  *)
  (* is used as an index to identify the font in the container            *)
  FT_Flag_Sub_Font = 64;     (* XXX: unimplemented *)

  (* When set, the 'facename' fields contains the pathname to a font file *)
  (* By default, this field contains the font's full typeface name        *)
  FT_Flag_Load_File = 128;   (* XXX: currently the default *)

  (* When set, the 'facename' field only contains the face's family name, *)
  (* and the 'styles' field is used to query certain styles, like italic, *)
  (* bold, etc..                                                          *)
  (* this will probably be useful later when we'll want to be able to     *)
  (* synthetize fonts on the fly. For now, the font creator returns an    *)
  (* error if it doesn't find an exact match to the query                 *)
  FT_Flag_Select_Family_And_Styles = 256;   (* XXX: unimplemented *)

  (*******************************************************************)
  (* the following values are used to define a face style for use    *)
  (* in the 'styles' field, with the 'Select_Family_And_Styles' flag *)
  (* set. You should be able to 'or' them to forge a composity style *)
  (*                                                                 *)

  FT_Style_Regular  = 0;
  FT_Style_Italic   = 1;
  FT_Style_Bold     = 2;
  (* no more styles for the moment..)

  (*********************************************************************)
  (*                                                                   *)
  (*                        FT_Text_Metrics                            *)
  (*                                                                   *)
  (*     the base text metrics, defined for all font formats, like     *)
  (*              bitmaps, truetype, type1, wathever..                 *)
  (*                                                                   *)
  (*********************************************************************)

type
  FT_Text_Metrics = object
      (* note : all fields of type 'FT_Pos' are 26.6 fixed float *)
      (*        distances / values.                              *)

      fontType        : integer;  (* the font's internal format, see below *)

      height          : integer;  (* height in pixels               *)
      width           : integer;  (* width in pixels                *)
      ptSize          : FT_Pos;   (* point size in 26.6 fixed float *)

      (* There are many definitions of the ascender, descender and  *)
      (* line gap values. We present three distinct ones in this    *)
      (* record to allow any user to choose the one it's interested *)
      (* in..                                                       *)

      (* first the typographic values. For TrueType, these are extracted *)
      (* from the OS/2 table, see 'typoAscender', 'typoDescender', etc.. *)
      (* in the TrueType specification.. For Type1, these would get      *)
      (* extracted from the afm file.                                    *)

      ascender        : FT_Pos;   (* typographic ascender in frac. pixels  *)
      descender       : FT_Pos;   (* typographic descender in frac. pixels *)
      linegap         : FT_Pos;   (* typograhic linegap in frac. pixels    *)

      (* Now the windows specific values - taken from the TT OS/2 table    *)
      (*                                                                   *)
      (*  For symbol fonts : ( platform = 3, encoding = 0 )                *)
      (*      This is the yMax of all glyphs found in the font file        *)
      (*                                                                   *)
      (*  For other fonts :                                                *)
      (*      This is the yMax of all glyphs of the Windows ANSI charcode  *)
      (*      ( the font file may contain some non-ANSI glyphs too )       *)
      (*                                                                   *)
      (*  The descender is the '-yMin' for the same glyph sets             *)
      (*                                                                   *)
      (*  These fields will probably be copies of the typographic ones     *)
      (*  if the font isn't a TrueType one (or GX/OpenType)                *)

      winAscender     : FT_Pos;   (* Windows ascender in frac. pixels      *)
      winDescender    : FT_Pos;   (* Windows descender in frac. pixels     *)

      (* The macintosh values - extracted from the font's hhead table      *)
      (*                                                                   *)
      (* I don't have their exact definition in mind sorry..               *)
      (*                                                                   *)
      (*  These fields will probably be copies of the typographic ones     *)
      (*  if the font isn't a TrueType one (or GX/OpenType)                *)

      macAscender     : FT_Pos;   (* Macintosh ascender in frac. pixels    *)
      macDescender    : FT_Pos;   (* Macintosh descender in frac. pixels   *)
      macLineGap      : FT_Pos;   (* Macintosh line gap in frac. pixels    *)

      (* that's it.. now back to 'normal' fields *)

      avgCharWidth    : FT_Pos;   (* average char width in pixels *)
      maxCharWidth    : FT_Pos;   (* maximum char width in pixels *)

      weight          : FT_Weight;
      styles          : integer;  (* styles flag *)

      charSet         : integer;  (* 'common' character sets supported *)
                                  (* currently, only Symbol, ASCII and *)
                                  (* Unicode                           *)

      numGlyphs       : integer;  (* number of glyphs in font *)

      familyName        : string; (* e.g. "Times New Roman"        *)
      styleName         : string; (* e.g. "Italic"                 *)
      fullName          : string; (* e.g. "Times New Roman Italic" *)
  end;

const
  (********************************************************************)
  (* font format :                                                    *)
  (*   bit 0  : bitmap / outline format                               *)
  (*   bit 1  : 'sfnt' file format ( TrueType, GX, OpenType )         *)
  (*   others : format index                                          *)
  (*                                                                  *)
  (* Note : GX and OpenType fonts can be loaded by the library, even  *)
  (*        though it will always report them as 'normal' TrueTypes   *)
  (*        for now..                                                 *)

  FT_Format_Bitmap   = 0;  (* bitmap font format      *)
  FT_Format_Outline  = 1;  (* vectorial font format   *)
  FT_Format_SFNT     = 2;  (* 'sfnt' font file format *)

  FT_Format_FNT      = 0 + 4*0;  (* dummy .fnt format - unsupported       *)
  FT_Format_TrueType = 3 + 4*1;  (* normal (pc) TrueType file format      *)
  FT_Format_Type1    = 1 + 4*2;  (* postscript Type1 format - unsupported *)
  FT_Format_GX       = 3 + 4*3;  (* TrueType GX format - unsupported      *)
  FT_Format_OpenType = 3 + 4*4;  (* OpenType file format - unsupported    *)

  (********************************************************************)
  (* charsets :                                                       *)
  (*   the 'charSet' field is used to indicate which 'common'         *)
  (*   character codes are supported. It doesn't give a full list of  *)
  (*   all the codes supported by the font. An API has to be          *)
  (*   written to do that.                                            *)

  FT_CharSet_Symbol   = 1;  (* this is a symbol font             *)
  FT_CharSet_Unicode  = 2;  (* the font supports Unicode mapping *)
  FT_CharSet_ASCII    = 4;  (* the font supports ASCII   mapping *)
  FT_CharSet_Latin1   = 8;  (* the font supports ISO-8859-1      *)
  (* wathever will come there later *)

  (*********************************************************************)
  (*                                                                   *)
  (*                    FT_Outline_Text_Metrics                        *)
  (*                                                                   *)
  (*     additional fields to describe outline fonts better. applies   *)
  (*           to truetype, type1 or any other vector format           *)
  (*                                                                   *)
  (*********************************************************************)

type
  FT_Outline_Text_Metrics = object( FT_Text_Metrics )

     unitsPerEM        : integer;  (* number of logical units per EM square *)
                                   (* usually 1000 for Type1, 2048 for TT   *)

     typoAscender      : integer;  (* typographic ascender, in EM units  *)
     typoDescender     : integer;  (* typographic descender, in EM units *)
     typoLineGap       : integer;  (* typographic linegap, in EM units   *)

     fontBox           : FT_BBox;  (* font bouding box : should enclose  *)
                                   (* all glyphs. values in EM units     *)

     minimumPpem       : integer;  (* minimum pixel size supported *)

     subscriptSize     : integer;
     subscriptOffset   : integer;
     superscriptSize   : integer;
     superScriptOffset : integer;
     strikeoutSize     : integer;  (* strike-out thickness *)
     strikeoutPosition : integer;
     underlineSize     : integer;  (* underscore thickness *)
     underlinePosition : integer;
  end;

  (******************************************************************)
  (*                                                                *)
  (*                  Base Library Functions                        *)
  (*                                                                *)
  (******************************************************************)


  (*****************************************************)
  (* Initialize library                                *)
  (*                                                   *)
  procedure  FT_Init;

  (*****************************************************)
  (* Finalise library, and release all objects         *)
  (*                                                   *)
  procedure  FT_Done;

  (******************************************************************)
  (*                                                                *)
  (*                       Math functions                           *)
  (*                                                                *)
  (******************************************************************)

  (*****************************************************)
  (* Apply a matrix to a vector. Compute X = M.X       *)
  (*                                                   *)
  procedure  FT_Matrix_Vector( var m : FT_Matrix;
                               var x : FT_Pos;
                               var y : FT_Pos );

  (*****************************************************)
  (* Multiply two matrices, compute C = A.B            *)
  (* a temporary matrix is used, so you can compute    *)
  (*  A = A.B with this function                       *)
  (*                                                   *)
  procedure  FT_Matrix_Multiply( var A, B, C : FT_Matrix );

  (*****************************************************)
  (* Invert a matrix                                   *)
  (*                                                   *)
  (*   returns FT_Err_Divide_By_Zero if inversion      *)
  (*   isn't possible..                                *)
  (*                                                   *)
  function   FT_Matrix_Invert( var M : FT_Matrix ) : FT_Error;

  (******************************************************************)
  (*                                                                *)
  (*                  Font Properties functions                     *)
  (*                                                                *)
  (******************************************************************)

  (*****************************************************)
  (* Add font resource                                 *)
  (*                                                   *)
  function FT_AddFontResource( resourcepathname : string ) : FT_Error;

  (*****************************************************)
  (* Remove font resource                              *)
  (*                                                   *)
  function FT_RemoveFontResource( resourcepath : string ) : FT_Error;

  (*****************************************************)
  (* Create font object                                *)
  (*                                                   *)
  function FT_CreateFont( var descr : FT_Font_Description;
                          var font  : FT_Font ) : FT_Error;

  (*****************************************************)
  (* Delete a font object                              *)
  (*                                                   *)
  function FT_DeleteFont( font : FT_Font ) : FT_Error;

  (*****************************************************)
  (* Query Text Metrics                                *)
  (*                                                   *)
  function FT_GetTextMetrics( font : FT_Font;
                              var metrics : FT_Text_Metrics ) : FT_Error;

  (*****************************************************)
  (* Query Outline Text Metrics                        *)
  (*                                                   *)
  function FT_GetOutlineTextMetrics( font : FT_Font;
                                     var metrics : FT_Outline_Text_Metrics
                                   ) : FT_Error;

  (*****************************************************)
  (* Query glyph widths                                *)
  (*                                                   *)
  function FT_GetGlyphWidths( font       : FT_Font;
                              firstGlyph : integer;
                              lastGlyph  : integer;
                              widths     : FT_Widths ) : FT_Error;

  (*****************************************************)
  (* Get glyphs ABC widths                             *)
  (*                                                   *)
  function FT_GetGlyphABCWidths( font       : FT_Font;
                                 firstGlyph : integer;
                                 lastGlyph  : integer;
                                 widths     : FT_ABC_Widths ) : FT_Error;

  (******************************************************************)
  (*                                                                *)
  (*                       Glyph  functions                         *)
  (*                                                                *)
  (*                                                                *)
  (******************************************************************)

  (*****************************************************)
  (* Get glyph outline                                 *)
  (*                                                   *)
  function FT_GetGlyphOutline( font        : FT_Font;
                               glyphIndex  : integer;
                               var outline : FT_Outline ) : FT_Error;

  (*****************************************************)
  (* Get glyph bitmap                                  *)
  (*                                                   *)
  function FT_GetGlyphBitmap( font       : FT_Font;
                              glyphIndex : integer;
                              var bitmap : FT_Bitmap ) : FT_Error;

  (*****************************************************)
  (* Get glyph pixmap                                  *)
  (*                                                   *)
  function FT_GetGlyphPixmap( font       : FT_Font;
                              glyphIndex : integer;
                              var pixmap : FT_Pixmap ) : FT_Error;

  (*****************************************************)
  (* Get glyph extent                                  *)
  (*                                                   *)
  function FT_GetGlyphMetrics( font        : FT_Font;
                               glyphIndex  : integer;
                               var metrics : FT_Glyph_Metrics ) : FT_Error;

  (******************************************************************)
  (*                                                                *)
  (*                        Text Functions                          *)
  (*                                                                *)
  (*                                                                *)
  (******************************************************************)

implementation

uses
  FreeType,
  TTCalc,
  FTOutln,
  FTObjs;

  procedure Panic( message : string );
  begin
    Writeln( Output, message );
    Halt(1);
  end;

  procedure Check( condition : Boolean;
                   message   : string ); {$IFDEF INLINE} inline; {$ENDIF}
  begin
    if not condition then
      Panic( message );
  end;


  (*********************************************************************)
  (* Output Device abstract class                                      *)
  (*                                                                   *)
  (* unfortunately, the 'abstract' Pascal keyword is only found in     *)
  (* Delphi and Virtual. For the sake of compatibility with BP 7,      *)
  (* we define here dummy methods..                                    *)
  (*                                                                   *)
  (*********************************************************************)

  function  FT_Device_Class.drawBitmap;
  begin
    drawBitmap := FT_Err_Abstract_Method_Called;
  end;

  function  FT_Device_Class.drawPixmap;
  begin
    drawPixmap := FT_Err_Abstract_Method_Called;
  end;

  function  FT_Device_Class.drawOutline;
  begin
    drawOutline := FT_Err_Abstract_Method_Called;
  end;

  (*********************************************************************)
  (* Outline abstract class                                            *)
  (*                                                                   *)
  (* unfortunately, the 'abstract' Pascal keyword is only found in     *)
  (* Delphi and Virtual. For the sake of compatibility with BP 7,      *)
  (* we define here dummy methods..                                    *)
  (*                                                                   *)
  (*********************************************************************)
  {
  FT_Outline_Class = object

      format : integer;

      (* query contours number *)
      function getContours : integer;

      (* query points number - note that this is format-specific *)
      function getPoints   : integer;

      (* translate outline - offsets in 26.6 fixed float format *)
      procedure translate( x, y : FT_Pos );

      (* transform outline - matrix coefficients are 16.16 fixed floats *)
      procedure transform( var matrix : FT_Matrix );

      (* query bounding box *)
      procedure getExtent( var bbox : FT_BBox );

      (* is the outline empty ? *)
      function isEmpty : boolean;
  end;
  }
  function FT_Outline_Class.getContours;
  begin
    getContours := 0;
  end;

  function FT_Outline_Class.getPoints;
  begin
    getPoints := 0;
  end;

  procedure FT_Outline_Class.translate;
  begin
  end;

  procedure FT_Outline_Class.transform;
  begin
  end;

  procedure FT_Outline_Class.getExtent;
  begin
    bbox.xMin := 0; bbox.yMin := 0;
    bbox.xMax := 0; bbox.yMax := 0;
  end;

  function FT_Outline_Class.getPixelWidth;
  begin
    getPixelWidth := 0;
  end;

  function FT_Outline_Class.getPixelHeight;
  begin
    getPixelHeight := 0;
  end;

  function FT_Outline_Class.isEmpty;
  begin
    isEmpty := true;
  end;

  function FT_Outline_Class.getBitmap : FT_Bitmap;
  begin
    getBitmap := nil;
  end;

  function FT_Outline_Class.getPixmap : FT_Pixmap;
  begin
    getPixmap := nil;
  end;

  function FT_Outline_Class.clone;
  begin
    new_outline := nil;
    clone := FT_Err_Abstract_Method_Called;
  end;


  (******************************************************************)
  (*                                                                *)
  (*                  Base Library Functions                        *)
  (*                                                                *)
  (*                                                                *)
  (******************************************************************)

  (*****************************************************)
  (* Initialize library                                *)
  (*                                                   *)
  procedure  FT_Init;
  begin
    TT_Init_FreeType;
    lib.error     := FT_Err_Ok;
    lib.resources := empty_list;
    lib.fontObjs  := empty_list;
  end;

  (*****************************************************)
  (* Finalise library, and release all objects         *)
  (*                                                   *)
  procedure  FT_Done;
  var
    curRes, nextRes : PFontResource;
  begin
    (* destroy all font resources *)
    curRes := PFontResource(lib.resources.head);
    while curRes <> nil do
    begin
      nextRes := PFontResource(curRes^.next);
      Dispose(curRes, Done);
      curRes  := nextRes;
    end;

    TT_Done_FreeType;
  end;

  (******************************************************************)
  (*                                                                *)
  (*                       Math functions                           *)
  (*                                                                *)
  (*                                                                *)
  (******************************************************************)

  (*****************************************************)
  (* Apply a matrix to a vector. Compute X = M.X       *)
  (*                                                   *)
  procedure  FT_Matrix_Vector( var m : FT_Matrix;
                               var x : FT_Pos;
                               var y : FT_Pos );
  var
    nx, ny : longint;
  begin
    nx := MulDiv_Round( m.xx, x, $10000 ) + MulDiv_Round( m.xy, y, $10000 );
    ny := MulDiv_Round( m.yx, x, $10000 ) + MulDiv_Round( m.yy, y, $10000 );
    x  := nx;
    y  := ny;
  end;

  (*****************************************************)
  (* Multiply two matrices, compute C = A.B            *)
  (*                                                   *)
  procedure  FT_Matrix_Multiply( var A, B, C : FT_Matrix );
  var
    Temp : FT_Matrix;
  begin
    Temp := B;
    FT_Matrix_Vector( A, B.xx, B.yx );
    FT_Matrix_Vector( A, B.yx, B.yy );
    C := Temp;
  end;

  (*****************************************************)
  (* Invert a matrix                                   *)
  (*                                                   *)
  function   FT_Matrix_Invert( var M : FT_Matrix ) : FT_Error;
  var
    delta : FT_Fixed;
    x, y  : longint;
  begin
    delta := MulDiv_Round( M.xx, M.yy, $10000 ) -
             MulDiv_Round( M.xy, M.yx, $10000 );

    if abs(delta) > $100 then
    begin
      x    := MulDiv_Round( M.yy, $10000, delta );
      y    := MulDiv_Round( M.xx, $10000, delta );
      M.xx := x;
      M.yy := y;
      M.xy := - MulDiv_Round( M.xy, $10000, delta );
      M.yx := - MulDiv_Round( M.yx, $10000, delta );
      FT_Matrix_Invert := FT_Err_Ok;
    end
      else
        FT_Matrix_Invert := FT_Err_Divide_By_Zero;
  end;

  (******************************************************************)
  (*                                                                *)
  (*                  Font Properties functions                     *)
  (*                                                                *)
  (*                                                                *)
  (******************************************************************)

  (*****************************************************)
  (* Add font resource                                 *)
  (*                                                   *)
  function FT_AddFontResource( resourcepathname : string ) : FT_Error;
  var
    error : FT_Error;
    res   : PFontResource;
  label
    Fail;
  begin
    (* currently, we only open TrueType resources *)
    error := Load_TrueType_File( resourcepathname,(* file pathname          *)
                                 false,           (* don't keep face active *)
                                 res );           (* return resource here   *)
    FT_AddFontResource := error;
  end;

  (*****************************************************)
  (* Remove font resource                              *)
  (*                                                   *)
  function FT_RemoveFontResource( resourcepath : string ) : FT_Error;
  var
    res : PFontResource;
  begin
    res := Find_FontResource_By_Filename( resourcepath );

    FT_RemoveFontResource := FT_Err_Ok;

    if res <> nil then
      res^.decRef
    else
      FT_RemoveFontResource := FT_Err_Invalid_Font_Resource_Name;
  end;

  (*****************************************************)
  (* Create font                                       *)
  (*                                                   *)
  (* Create a font by file name                        *)
  (*                                                   *)
  function FT_CreateFont( var descr : FT_Font_Description;
                          var font  : FT_Font ) : FT_Error;
  var
    fontObj : PFontObject;
    error   : FT_Error;
  begin
    (* XXX : we only create fonts from file now *)
    if descr.queryType and FT_Flag_Load_File = 0 then
      Panic('HLIB can only create fonts from file pathnames for the moment');

    (* XXX : only TrueType files for now *)
    New( fontObj, Init );
    error := fontObj^.Create_TrueType(descr);

    if error = FT_Err_Ok then
      begin
        (* add font object to current list *)
        fontObj^.add( lib.fontObjs );
        font := FT_Font(fontObj);
      end
    else
      Dispose( fontObj, Done );

    FT_CreateFont := error;
  end;

  (*****************************************************)
  (* Delete font                                       *)
  (*                                                   *)
  function FT_DeleteFont( font : FT_Font ) : FT_Error;
  var
    foundFont, curFont : PFontObject;
  begin
    (* look for font object in current list *)
    foundFont := nil;
    curFont   := PFontObject(lib.fontObjs.head);
    while curFont <> nil do
      if Pointer(curFont) = font then
        begin
          foundFont := curFont;
          curFont   := nil;
        end
      else
        curFont := PFontObject(curFont^.next);

    FT_DeleteFont := FT_Err_Ok;

    if foundFont <> nil then
      foundFont^.Remove( lib.fontObjs )
    else
      FT_DeleteFont := FT_Err_Invalid_Font_Object;
  end;

  (*****************************************************)
  (* Query Text Metrics                                *)
  (*                                                   *)
  function FT_GetTextMetrics( font        : FT_Font;
                              var metrics : FT_Text_Metrics ) : FT_Error;
  var
    fontObj : PFontObject;
  begin
    fontObj := PFontObject(font);
    if fontObj <> nil then
      FT_GetTextMetrics :=
        fontObj^.fontsize^.getMetrics( metrics )
    else
      FT_GetTextMetrics := FT_Err_Invalid_Font_Object;
  end;

  (*****************************************************)
  (* Query Outline Text Metrics                        *)
  (*                                                   *)
  function FT_GetOutlineTextMetrics( font        : FT_Font;
                                     var metrics : FT_Outline_Text_Metrics
                                   ) : FT_Error;
  var
    fontObj : PFontObject;
  begin
    fontObj := PFontObject(font);
    if fontObj <> nil then
      FT_GetOutlineTextMetrics :=
        fontObj^.fontsize^.getOutlineMetrics( metrics )
    else
      FT_GetOutlineTextMetrics := FT_Err_Invalid_Font_Object;
  end;

  (*****************************************************)
  (* Get glyphs widths                                 *)
  (*                                                   *)
  function FT_GetGlyphWidths( font       : FT_Font;
                              firstGlyph : integer;
                              lastGlyph  : integer;
                              widths     : FT_Widths ) : FT_Error;
  var
    fontObj : PFontObject;
  begin
    fontObj := PFontObject(font);
    if fontObj <> nil then
      FT_GetGlyphWidths :=
         fontObj^.fontSize^.getWidths( firstGlyph, lastGlyph, widths )
    else
      FT_GetGlyphWidths := FT_Err_Invalid_Font_Object;
  end;

  (*****************************************************)
  (* Get glyphs ABC widths                             *)
  (*                                                   *)
  function FT_GetGlyphABCWidths( font       : FT_Font;
                                 firstGlyph : integer;
                                 lastGlyph  : integer;
                                 widths     : FT_ABC_Widths ) : FT_Error;
  var
    fontObj : PFontObject;
  begin
    fontObj := PFontObject(font);
    if fontObj <> nil then
      FT_GetGlyphABCWidths :=
         fontObj^.fontSize^.getABCWidths( firstGlyph, lastGlyph, widths )
    else
      FT_GetGlyphABCWidths := FT_Err_Invalid_Font_Object;
  end;

  (******************************************************************)
  (*                                                                *)
  (*                       Glyph  functions                         *)
  (*                                                                *)
  (*                                                                *)
  (******************************************************************)

  (*****************************************************)
  (* Get glyph outline                                 *)
  (*                                                   *)
  function FT_GetGlyphOutline( font        : FT_Font;
                               glyphIndex  : integer;
                               var outline : FT_Outline ) : FT_Error;
  var
    fontObj    : PFontObject;
    curOutline : FT_Outline;
    error      : FT_Error;
  label
    Fail;
  begin
    fontObj := PFontObject(font);
    if fontObj <> nil then
      begin
        error := fontObj^.fontsize^.getOutline( glyphIndex, curOutline );
        if error <> FT_Err_Ok then
          begin
            FT_GetGlyphOutline := error;
            goto Fail;
          end;

        curOutline^.clone( outline );
        if outline^.isEmpty then
          begin

          end;

        (* apply transform to outline if necessary *)
        if fontObj^.flags and FT_Flag_Use_Transform <> 0 then
          begin
            outline^.transform( fontObj^.transform.matrix );
            outline^.translate( fontObj^.transform.x_ofs,
                                fontObj^.transform.y_ofs );
          end;

        FT_GetGlyphOutline := FT_Err_Ok;
      end
    else
      FT_GetGlyphOutline := FT_Err_Invalid_Font_Object;
    exit;

  Fail:
    outline := nil;
  end;

  (*****************************************************)
  (* Get glyph bitmap                                  *)
  (*                                                   *)
  function FT_GetGlyphBitmap( font       : FT_Font;
                              glyphIndex : integer;
                              var bitmap : FT_Bitmap ) : FT_Error;
  begin
    FT_GetGlyphBitmap := FT_Err_Unsupported_Feature;
  end;

  (*****************************************************)
  (* Get glyph pixmap                                  *)
  (*                                                   *)
  function FT_GetGlyphPixmap( font       : FT_Font;
                              glyphIndex : integer;
                              var pixmap : FT_Pixmap ) : FT_Error;
  begin
    FT_GetGlyphPixmap := FT_Err_Unsupported_Feature;
  end;

  (*****************************************************)
  (* Get glyph extent                                  *)
  (*                                                   *)
  function FT_GetGlyphMetrics( font        : FT_Font;
                               glyphIndex  : integer;
                               var metrics : FT_Glyph_Metrics ) : FT_Error;
  begin
    FT_GetGlyphMetrics := FT_Err_Unsupported_Feature;
  end;

  (******************************************************************)
  (*                                                                *)
  (*                        Text Functions                          *)
  (*                                                                *)
  (*                                                                *)
  (******************************************************************)

var
  fontobj : PFontObject;
  descr   : FT_Font_Description;
  error   : FT_Error;

begin
  FT_Init;
  New( fontObj, Init );

  descr.queryType := 0;
  descr.dimY      := 10*64;
  descr.resY      := 96;
  descr.facename  := 'e:/ttf/arial.ttf';

  error := fontObj^.Create_TrueType(descr);
  Dispose( fontObj, Done );

  FT_Done;


end.
