(****************************************************************************)
(*                                                                          *)
(* FTOutln.pas                                                          1.0 *)
(*                                                                          *)
(*   outline class definition and implementation, as used by the            *)
(*   FreeType high-level library.                                           *)
(*                                                                          *)
(*   Rather than defining a common outline type that will be used to        *)
(*   store all kinds of paths ( segments, conic and cubic beziers ),        *)
(*   we define here a base class and an interface which implementation      *)
(*   is hidden to the rest of the library.                                  *)
(*                                                                          *)
(****************************************************************************)

Unit FTOutln;

interface

uses FTLib, FreeType;

type
  (*********************************************************************)
  (*                                                                   *)
  (*                  The TrueType Outline Definition                  *)
  (*                                                                   *)
  (*********************************************************************)

  FT_TT_Outline       = ^FT_TT_Outline_Class;
  FT_TT_Outline_Class = object( FT_Outline_Class )

      tt_outline : TT_Glyph_Outline;  (* truetype outline *)

      updated    : Boolean;   (* False when the bbox no longer reflects   *)
                              (* the outline, typically after a transform *)
      tt_bbox    : FT_BBox;   (* outline un-grid-fitted bound box         *)

      high_precision : Boolean; (* use high precision to render bitmap *)
      scan_mode      : Byte;    (* drop-out scanline control mode      *)

      constructor init( glyph : TT_Glyph );

      function   getPoints   : integer; virtual;
      function   getContours : integer; virtual;

      procedure  translate( x, y       : FT_Pos ); virtual;
      procedure  transform( var matrix : FT_Matrix ); virtual;

      procedure  getExtent( var bbox   : FT_BBox ); virtual;

      function   isEmpty : boolean; virtual;

      function   getBitmap : FT_Bitmap; virtual;
      function   getPixmap : FT_Pixmap; virtual;

      function   clone( var new_outline : FT_Outline ) : FT_Error; virtual;

      destructor  done; virtual;
  end;

  (********************************************************************)
  (*  Create an outline from a TrueType glyph container.              *)
  (*  -- this function is called by the HLIB, don't use it in your    *)
  (*  -- own code, as it may disappear or change later..              *)
  (*                                                                  *)
  procedure FT_Create_TT_Outline( glyph   : TT_Glyph;
                                  var out : FT_Outline );

implementation

uses FTBitmap;

  (*********************************************************************)
  (*                                                                   *)
  (*                  TrueType outline implementation                  *)
  (*                                                                   *)
  (*********************************************************************)

  (*************************************************************)
  (*  return the outline's number of points                    *)
  (*                                                           *)
  function FT_TT_Outline_Class.getPoints;
  begin
    getPoints := tt_outline.points;
  end;

  (*************************************************************)
  (*  return the outline's number of contours                  *)
  (*                                                           *)
  function FT_TT_Outline_Class.getContours;
  begin
    getContours := tt_outline.contours;
  end;

  (*************************************************************)
  (*  translate the outline                                    *)
  (*                                                           *)
  procedure FT_TT_Outline_Class.translate;
  begin
    (*  XXXXX                                                    *)
    (*  the high-level library and the truetype engine use the   *)
    (*  same coordinates format (i.e. 26.6 fixed float). There   *)
    (*  is thus no need to translate the parameters. In C, this  *)
    (*  could be done with a macro                               *)
    (*                                                           *)
    TT_Apply_Outline_Translation( tt_outline, x, y );

    (* update bbox, as this is easy *)
    if updated then
    begin
      inc( tt_bbox.xMin, x );
      inc( tt_bbox.yMin, y );
      inc( tt_bbox.xMax, x );
      inc( tt_bbox.yMax, y );
    end;
  end;

  (*************************************************************)
  (*  apply a 2x2 transform to an outline                      *)
  (*                                                           *)
  procedure FT_TT_Outline_Class.transform;
  begin
    (*                                                           *)
    (*  the TT_Matrix and FT_Matrix types are equivalent, which  *)
    (*  means there is currently no need to translate from one   *)
    (*  to the other..                                           *)
    (*                                                           *)
    TT_Apply_Outline_Transform( tt_outline, TT_Matrix(matrix) );

    (* updating the bbox isn't easy, set the flag to false *)
    updated := false;
  end;

  (*************************************************************)
  (*  get an outline's bounding box                            *)
  (*                                                           *)
  procedure FT_TT_Outline_Class.getExtent( var bbox : FT_Bbox );
  var
    n : integer; x, y : FT_Pos;
  begin
    (* if the bbox field is valid, simply copy it *)
    if updated then
      begin
        bbox := tt_bbox;
        exit;
      end;

    (*  XXXX :                                                   *)
    (*  Right now, we limit ourselves to a box bounding the      *)
    (*  outline's control points. The real bbox is slightly      *)
    (*  tighter, but I don't want to care with it for now..      *)
    (*                                                           *)
    if tt_outline.points = 0 then
    begin
      bbox.xMin := 0;
      bbox.yMin := 0;
      bbox.xMax := 0;
      bbox.yMax := 0;
      exit;
    end;

    bbox.xMin := tt_outline.xCoord^[0];
    bbox.yMin := tt_outline.yCoord^[0];
    bbox.xMax := bbox.xMin;
    bbox.yMax := bbox.yMin;

    for n := 1 to tt_outline.points-1 do
    begin
      x := tt_outline.xCoord^[n];
      if x < bbox.xMin then bbox.xMin := x;
      if x > bbox.xMax then bbox.xMax := x;
      y := tt_outline.yCoord^[n];
      if y < bbox.yMin then bbox.yMin := y;
      if y > bbox.yMax then bbox.yMax := y;
    end;

    tt_bbox := bbox;
    updated := true;
  end;

  (***************************************************************)
  (*  is the outline empty ?                                     *)
  (*                                                             *)
  function FT_TT_Outline_Class.isEmpty : boolean;
  begin
    isEmpty := ( tt_outline.points   <= 0 ) or
               ( tt_outline.contours <= 0 );
  end;

  (*************************************************************)
  (*  create and return an outline's bitmap                    *)
  (*                                                           *)
  function  FT_TT_Outline_Class.getBitmap : FT_Bitmap;
  var
    bbox  : FT_BBox;
    bmap  : TT_Raster_Map;
    error : TT_Error;
    x, y  : TT_F26Dot6;

    bitmap : FT_Bitmap;
  label
    Fail, Fail_Render;
  begin
    getExtent(bbox);

    (* we must grid-fit the bbox to get actual pixel sizes *)
    bbox.xMin := bbox.xMin and -64;
    bbox.yMin := bbox.yMin and -64;
    bbox.xMax := (bbox.xMax+63) and -64;
    bbox.yMax := (bbox.yMax+63) and -64;

    (* allocate TT raster map *)
    bmap.rows  := (bbox.yMax-bbox.yMin) div 64;
    bmap.width := (bbox.xMax-bbox.xMax) div 64;

    (* bytes per line - padded to 32 bits *)
    bmap.cols  := (((bmap.width+7) shr 3)+3) and -4;

    (* XXX : we only use a downwards flow *)
    bmap.flow  := TT_Flow_Down;

    bmap.size := bmap.cols * bmap.width;
    GetMem( bmap.buffer, bmap.size );

    (* fit curve into bitmap - note that the offsets must be    *)
    (* integer fractional pixel distances, i.e. multiples of 64 *)
    (* if you don't want to ruin the glyph hinting              *)
    TT_Apply_Outline_Translation( tt_outline, -bbox.xMin, -bbox.yMin );

    (* render bitmap into TT_Raster_Map *)
    error := TT_Get_Outline_Bitmap( tt_outline, bmap, true );

    (* reset outline to original coordinates *)
    TT_Apply_Outline_translation( tt_outline, +bbox.xMin, +bbox.yMin );

    if error <> TT_Err_Ok then goto Fail_Render;

    (* copy TT bitmap into bitmap *)
    case FT_Convert_TT_Bitmap( bmap, bitmap ) of
      0 : (* conversion performed without copying - don't do anything  *) ;

      1 : (* conversion performed with copying - release bitmap buffer *)
          FreeMem( bmap.buffer, bmap.size );
    else
      (* error during conversion *)
       bitmap := nil;
    end;
    exit;

  Fail_Render:
    FreeMem( bmap.buffer, bmap.size );
  Fail:
    bitmap := nil;
  end;


  (*************************************************************)
  (*  create and return an outline's pixmap                    *)
  (*                                                           *)
  function  FT_TT_Outline_Class.getPixmap : FT_Pixmap;
  var
    bbox   : FT_BBox;
    bmap   : TT_Raster_Map;
    error  : TT_Error;
    x, y   : TT_F26Dot6;
    pixmap : FT_Pixmap;
  label
    Fail, Fail_Render;
  begin
    getExtent(bbox);

    (* we must grid-fit the bbox to get actual pixel sizes *)
    bbox.xMin := bbox.xMin and -64;
    bbox.yMin := bbox.yMin and -64;
    bbox.xMax := (bbox.xMax+63) and -64;
    bbox.yMax := (bbox.yMax+63) and -64;

    (* allocate TT map *)
    bmap.rows  := 2*(1 + (bbox.yMax-bbox.yMin) div 64);
    bmap.width := 2*(1 + (bbox.xMax-bbox.xMax) div 64);
    bmap.cols  := (bmap.width + 3) and -4;

    (* XXX : we use a downwards flow only *)
    bmap.flow  := TT_Flow_Down;

    bmap.size  := bmap.cols * bmap.width;
    GetMem( bmap.buffer, bmap.size );

    (* fit curve into bitmap *)
    TT_Apply_Outline_Translation( tt_outline, -bbox.xMin, -bbox.yMin );

    (* double coordinates *)

    (* render bitmap *)
    error := TT_Get_Outline_Pixmap( tt_outline, bmap, true );

    (* reset outline to original coordinates *)
    TT_Apply_Outline_translation( tt_outline, +bbox.xMin, +bbox.yMin );

    if error <> TT_Err_Ok then goto Fail_Render;

    (* copy TT bitmap into bitmap *)
    case FT_Convert_TT_Pixmap( bmap, pixmap ) of
      0 : (* conversion performed without copying - don't do anything  *) ;

      1 : (* conversion performed with copying - release pixmap buffer *)
          FreeMem( bmap.buffer, bmap.size );
    else
      (* error during conversion *)
       pixmap := nil;
    end;
    exit;

  Fail_Render:
    FreeMem( bmap.buffer, bmap.size );
  Fail:
    pixmap := nil;
  end;

  (***************************************************************)
  (*  Create a new TrueType outline from a glyph container       *)
  (*                                                             *)
  constructor FT_TT_Outline_Class.init( glyph : TT_Glyph );
  var
    origin  : TT_Glyph_Outline;
    metrics : TT_Glyph_Metrics;
  begin
    TT_Get_Glyph_Metrics( glyph, metrics );
    TT_Get_Glyph_Outline( glyph, origin  );

    tt_bbox.xMin := metrics.xMin;
    tt_bbox.yMin := metrics.yMin;
    tt_bbox.xMax := metrics.xMax;
    tt_bbox.yMax := metrics.yMax;
    updated      := true;

    (* XXX : should get these fields from the glyph itself *)
    high_precision := true;
    scan_mode      := 2;

    TT_Clone_Outline( origin, tt_outline );
  end;

  (***************************************************************)
  (*  Clone a TrueType outline                                   *)
  (*                                                             *)
  function   FT_TT_Outline_Class.clone(
                      var new_outline : FT_Outline ) : FT_Error;
  var
    outp  : FT_TT_Outline;
    error : TT_Error;
  begin
    New( outp );

    outp^.tt_bbox  := tt_bbox;
    outp^.updated  := updated;

    outp^.high_precision := high_precision;
    outp^.scan_mode      := scan_mode;

    error := TT_Clone_Outline( tt_outline, outp^.tt_outline );
  end;

  (***************************************************************)
  (*  Destroy a TrueType outline                                 *)
  (*                                                             *)
  destructor FT_TT_Outline_Class.done;
  begin
    TT_Done_Outline( tt_outline );

    updated  := false;

    high_precision := false;
    scan_mode      := 0;
  end;

  (********************************************************************)
  (*  Create an outline from a TrueType glyph container.              *)
  (*  -- this function is called by the HLIB, don't use it in your    *)
  (*  -- own code, as it may disappear or change later..              *)
  (*                                                                  *)
  procedure FT_Create_TT_Outline( glyph   : TT_Glyph;
                                  var out : FT_Outline );
  var
    ttout : FT_TT_Outline;
  begin
    New( ttout, init(glyph) );
    out := FT_Outline(ttout);
  end;

end.
