PascalType.Renderer.pas

unit PascalType.Renderer;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  Version: MPL 1.1 or LGPL 2.1 with linking exception                       //
//                                                                            //
//  The contents of this file are subject to the Mozilla Public License       //
//  Version 1.1 (the "License"); you may not use this file except in          //
//  compliance with the License. You may obtain a copy of the License at      //
//  http://www.mozilla.org/MPL/                                               //
//                                                                            //
//  Software distributed under the License is distributed on an "AS IS"       //
//  basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the   //
//  License for the specific language governing rights and limitations under  //
//  the License.                                                              //
//                                                                            //
//  Alternatively, the contents of this file may be used under the terms of   //
//  the Free Pascal modified version of the GNU Lesser General Public         //
//  License Version 2.1 (the "FPC modified LGPL License"), in which case the  //
//  provisions of this license are applicable instead of those above.         //
//  Please see the file LICENSE.txt for additional information concerning     //
//  this license.                                                             //
//                                                                            //
//  The code is part of the PascalType Project                                //
//                                                                            //
//  The initial developer of this code is Christian-W. Budde                  //
//                                                                            //
//  Portions created by Christian-W. Budde are Copyright (C) 2010-2017        //
//  by Christian-W. Budde. All Rights Reserved.                               //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////

interface

{$I PT_Compiler.inc}

{-$define DEBUG_CURVE}

uses
  Classes,
  Graphics,
  PascalType.Types,
  PascalType.Types.Color,
  PascalType.Classes,
  PascalType.GlyphString,
  PascalType.Painter,
  PascalType.FontFace,
  PascalType.FontFace.SFNT;

type
  TFontPoint = packed record
    X, Y: TScaleType;
  end;

type
  TGlyphMetric = record
    HorizontalMetric: record
      AdvanceWidth: TScaleType;
      Bearing: TScaleType;
    end;
    VerticalMetric: record
      AdvanceHeight: TScaleType;
      TopSideBearing: TScaleType;
    end;
  end;

//------------------------------------------------------------------------------
//
//      OpenType Typographic metrics
//
//------------------------------------------------------------------------------
// Vertical metrics
//------------------------------------------------------------------------------
//
//                                                           v
//          .............................................................. oooo ..................
//             ^                          Internal leading --|           oo::::oo
//             |                                             |          o:::oo:::o
//          ...|.. FFFFFFFFFFFFFFFFFFFFFF  iiii ........................o::o  o::o................
//             |   F::::::::::::::::::::F i::::i             ^        ^ o:::oo:::o             ^
//             |   F::::::::::::::::::::F  iiii                       |  oo::::oo              |
//             |   FF::::::FFFFFFFFF::::F                             |    oooo            Cap height
//          ...|.... F:::::F ..... FFFFFFiiiiiii .. ggggggggg . ggggg aaaaaaaaaaaaa ........   |
//             |     F:::::F             i:::::i   g:::::::::ggg::::g a::::::::::::a    ^      |
//             |     F::::::FFFFFFFFFF    i::::i  g:::::::::::::::::g aaaaaaaaa:::::a   |      |
//        Ascender   F:::::::::::::::F    i::::i g::::::ggggg::::::gg          a::::a   |      |
//             |     F:::::::::::::::F    i::::i g:::::g     g:::::g    aaaaaaa:::::a   |      |
//             |     F::::::FFFFFFFFFF    i::::i g:::::g     g:::::g  aa::::::::::::a   |      |
//             |     F:::::F              i::::i g:::::g     g:::::g a::::aaaa::::::a x-height |
//             |     F:::::F              i::::i g::::::g    g:::::ga::::a    a:::::a   |      |
//             |   FF:::::::FF           i::::::ig:::::::ggggg:::::ga::::a    a:::::a   |      |
//             |   F::::::::FF           i::::::i g::::::::::::::::ga:::::aaaa::::::a   |      |
//             |   F::::::::FF           i::::::i  gg::::::::::::::g a::::::::::aa:::a  v      v
// Baseline -->*.. FFFFFFFFFFF ......... iiiiiiii    gggggggg::::::g  aaaaaaaaaa  aaaa ...........
//             |                                             g:::::g  |
//             |                                 gggggg      g:::::g  |
//        Descender                              g:::::gg   gg:::::g  |-- em height
//        (negative)                              g::::::ggg:::::::g  |
//             |                                   gg:::::::::::::g   |
//             |                                     ggg::::::ggg     |
//             v                                        gggggg        v
//           .............................................................................
//             ^
//             |  Line gap (leading)
//             v
//           .............................................................................
//
//------------------------------------------------------------------------------
// Horizontal metrics, advances, and bearings
//------------------------------------------------------------------------------
//
//
//                 |<------ Width ---->|        |<----- Width ---->|
//          xMin-->*                   .<--xMax .                  .
//                 .                   .        .                  .
//                 .  ffffffffffffffff .        .                  .
//                 . f::::::::::::::::f         .                  .
//                  f::::::::::::::::::f        .                  .
//                  f::::::fffffff:::::f        .                  . yMax
//                  f:::::f       ffffff        .  ggggggggg   ggggg .*...
//                  f:::::f            .        . g:::::::::ggg::::g  ^
//                 f:::::::ffffff      .         g:::::::::::::::::g  .
//                 f::::::::::::f      .        g::::::ggggg::::::gg  .
//                 f::::::::::::f      .        g:::::g     g:::::g   .
//                 f:::::::ffffff      .        g:::::g     g:::::g   .
//                  f:::::f            .        g:::::g     g:::::g   .
//                  f:::::f            .        g::::::g    g:::::g   .
//                 f:::::::f           .        g:::::::ggggg:::::g  Height
//                 f:::::::f           .         g::::::::::::::::g   .
//                 f:::::::f           .          gg::::::::::::::g   .
//    Origin-->*   fffffffff           .   *        gggggggg::::::g   .
//             .   .                   .   .                g:::::g   .
//             .   .                   .   .    gggggg      g:::::g   .
//             |-->|                   |-->|    g:::::gg   gg:::::g   .
//             . |                       | .     g::::::ggg:::::::g   .
//             . OffsetX/LSB           RSB .      gg:::::::::::::g    .
//             .                           .        ggg::::::ggg      v
//             |-------- AdvanceX -------->|           gggggg ........*..
//                                                                   yMin
//
//            Horizontal layout                    Vertical layout
// ---------+------------------------------------+----------------------------
// LSB      | Positive                           | Negative (mostly: -Width/2)
// RSB      | Positive (AdvanceX-LSB-(xMax-xMin) | 0
// AdvanceX | Positive                           | 0
// AdvanceY | 0                                  | Positive
// ---------+------------------------------------+----------------------------


type
  TPascalTypeFontMetric = record
    Origin: TFloatPoint;                // Offset of origin.
    Baseline: TRenderFloat;             // Baseline.
    Ascender: TRenderFloat;             // Ascender, relative to baseline.
    Descender: TRenderFloat;            // Descender, relative to baseline (negative).
    XHeight: TRenderFloat;              // Height of minors.
    CapHeight: TRenderFloat;            // Height of majors.
    LineGap: TRenderFLoat;              // Line gap.
  end;

type
  TPascalTypeRenderOption = (
    roColor,                            // Enable font color features
    roPoints,                           // Display curve control points
    roFill,                             // Fill shapes
    roStroke,                           // Stroke shapes
    roColorize,                         // Colorize glyphs/graphemes
    roMetrics                           // Display glyph metrics
  );
  TPascalTypeRenderOptions = set of TPascalTypeRenderOption;


(*
** TPascalTypeRenderColorMode
**
** Specifies how colors are assigned when roColorize is applied.
*)
type
  TPascalTypeRenderColorMode = (

    rcmGlyph,                   // Assign color per glyph.

    rcmGrapheme                 // Assign color per grapheme (cluster).

  );


(*
** TPascalTypeVerticalMetricType
**
** The method used to calculate key elements of the FontMetrics structure.
** Specifically Baseline, Ascender, Descender, and LineGap.
*)
type
  TPascalTypeVerticalMetricType = (

    vmtAuto,                    // Automatically select metric type based on
                                // the typographic flag in the OS/2 table.
                                // * This is the default.

    vmtTypographic,             // Use typographic metrics (sTypoAscender,
                                // sTypoDescender, sTypoLineGap).

    vmtWindows                  // Use classic Windows metrics (usWinAscent,
                                // usWinDescent).

  );


(*
** TPascalTypeRenderVerticalOrigin
**
** Specifies the vertical offset that is applied when positioning glyphs.
**
** The offset is basically used to move (usually down) the glyph origin/baseline
** from the user supplied Y coordinate. In other words: It specifies the method
** used to calculate the distance from the supplied Y coordinate to the baseline.
*)
type
  TPascalTypeRenderVerticalOrigin = (

    voZero,                     // No baseline offset.
                                // Top of glyphs will be clipped.

    voBaseline,                 // Offset is that of the normal baseline/ascender.
                                // Top of glyphs might be clipped.

    voAuto,                     // The baseline is adjusted based on glyph path
                                // points.
                                // Clipping will not occur. Performs a linear
                                // scan of the output glyph string to find the
                                // maximum height of their outer bounding box.

    voTight,                    // The baseline is adjusted based on the
                                // font bounding box.
                                // Clipping should not occur.

    voCenter,                   // Same as voBaseline plus half a line gap.

    voWindows,                  // Closely matches the vertical origin of
                                // Windows ExtTextOut.
                                // Uses OS2.WindowsAscent if available. Falls
                                // back to hhea.Ascent and then to head.YMax.
                                // * This is the default.

    voCustom                    // The user supplied VerticalOriginValue offset
                                // value is used.

  );

type
  TPascalTypeRenderHorizontalOrigin = (
    hoZero,                     // First glyph starts at X=0.
                                // Left side of glyphs might be clipped.
                                // * This is the default.

    hoAuto,                     // First glyph is positioned so the leftmost glyph
                                // path point starts at X=0. Left side of glyph
                                // will not be clipped.

    hoTight,                    // First glyph is positioned so left side bearing
                                // starts at X=0. Left side of glyph should not be
                                // clipped.

    hoCustom                    // The user supplied HorizontalOriginValue offset
                                // value is used.
  );


//------------------------------------------------------------------------------
//
//              TPascalTypeRenderer
//
//------------------------------------------------------------------------------
// A class that knows how to render a glyph
//------------------------------------------------------------------------------
type
  TPascalTypeRenderer = class(TInterfacedPersistent, IPascalTypeFontFaceNotification)
  strict private
    class var
      FDebugRectSize: Single;
      FDebugCircleRadius: Single;
      FDebugRectColor: Cardinal;
      FDebugCircleColor: Cardinal;
      FDebugFontMetricsColor: Cardinal;
      FDebugFontMetricsBaselineColor: Cardinal;
      FDebugGlyphMetricsColor: Cardinal;
  public
    class property DebugRectSize: Single read FDebugRectSize write FDebugRectSize;
    class property DebugCircleRadius: Single read FDebugCircleRadius write FDebugCircleRadius;
    class property DebugRectColor: Cardinal read FDebugRectColor write FDebugRectColor;
    class property DebugCircleColor: Cardinal read FDebugCircleColor write FDebugCircleColor;
    class property DebugFontMetricsColor: Cardinal read FDebugFontMetricsColor write FDebugFontMetricsColor;
    class property DebugFontMetricsBaselineColor: Cardinal read FDebugFontMetricsBaselineColor write FDebugFontMetricsBaselineColor;
    class property DebugGlyphMetricsColor: Cardinal read FDebugGlyphMetricsColor write FDebugGlyphMetricsColor;
  strict private type
    TRenderFlags = set of (
      rfHasScalerX,
      rfHasScalerY,
      rfHasMetrics,
      rfHasColor
    );
  strict private
    FOptions: TPascalTypeRenderOptions;
    FColorMode: TPascalTypeRenderColorMode;
    FFlags: TRenderFlags;
    FFontFace: TPascalTypeFontFace;
    FFontHeight: Integer;
    FPixelPerInchX: Integer;
    FPixelPerInchY: Integer;
    FScalerX: TScaleType;
    FScalerY: TScaleType;
    FScalerAbsY: TScaleType;
    FVerticalMetricType: TPascalTypeVerticalMetricType;
    FVerticalOrigin: TPascalTypeRenderVerticalOrigin;
    FHorizontalOrigin: TPascalTypeRenderHorizontalOrigin;
    FFontMetrics: TPascalTypeFontMetric;
    FCustomOrigin: TFloatPoint;
    FColorGlyphLookup: IPascalTypeColorGlyphLookup;
    FColorLookup: IPascalTypeColorLookup;
    procedure SetFontSize(const Value: Integer);
    function GetFontSize: Integer;
    function GetPixelPerInch: Integer;
    procedure SetPixelPerInch(const Value: Integer);
    procedure SetPixelPerInchX(const Value: Integer);
    procedure SetPixelPerInchY(const Value: Integer);
    procedure SetFontHeight(const Value: Integer);
    procedure SetFontFace(const Value: TPascalTypeFontFace);
    procedure SetHorizontalOrigin(const Value: TPascalTypeRenderHorizontalOrigin);
    procedure SetVerticalOrigin(const Value: TPascalTypeRenderVerticalOrigin);
    procedure SetVerticalMetricType(const Value: TPascalTypeVerticalMetricType);
    procedure SetHorizontalOriginValue(const Value: TRenderFloat);
    procedure SetVerticalOriginValue(const Value: TRenderFloat);
    function GetHorizontalOriginValue: TRenderFloat;
    function GetVerticalOriginValue: TRenderFloat;
    function GetScalerX: TScaleType;
    function GetScalerY: TScaleType;
    function GetScalerAbsY: TScaleType;
    function GetFontMetrics: TPascalTypeFontMetric;
  private
    // IPascalTypeFontFaceNotification
    procedure FontFaceNotification(Sender: TCustomPascalTypeFontFacePersistent; Notification: TFontFaceNotification);
  protected
    procedure CalculateScalerX;
    procedure CalculateScalerY;
    procedure CalculateMetrics;

    function GetGlyphMetric(GlyphIndex: Integer): TGlyphMetric;
    function GetAdvanceWidth(GlyphIndex: Integer): TScaleType;
    function GetKerning(Last, Next: Integer): TScaleType;
    function GetGlyphPosition(AGlyph: TPascalTypeGlyph; X, Y: TRenderFloat; ADirection: TPascalTypeDirection): TFloatPoint;
    function IsDrawable(AGlyph: TPascalTypeGlyph): boolean;

    procedure FontHeightChanged; virtual;
    procedure PixelPerInchXChanged; virtual;
    procedure PixelPerInchYChanged; virtual;
    procedure FontChanging;
    procedure FontChanged;

    property ScalerX: TScaleType read GetScalerX;
    property ScalerY: TScaleType read GetScalerY;
    property ScalerAbsY: TScaleType read GetScalerAbsY;
    property FontMetrics: TPascalTypeFontMetric read GetFontMetrics;
  protected
    procedure RenderGlyph(GlyphIndex: Integer; const Painter: IPascalTypePainter; const Cursor: TFloatPoint);
    procedure RenderGlyphPath(const GlyphPath: TPascalTypePath; const Painter: IPascalTypePainter; const Cursor: TFloatPoint);

    procedure RenderDebugCircle(const Painter: IPascalTypePainter; const p: TFloatPoint);
    procedure RenderDebugRect(const Painter: IPascalTypePainter; const p: TFloatPoint);

    class constructor Create;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure RenderText(const Text: string; const Painter: IPascalTypePainter); overload;
    procedure RenderText(const Text: string; const Painter: IPascalTypePainter; var X, Y: TRenderFloat); overload;

    procedure RenderShapedText(ShapedText: TPascalTypeGlyphString; const Painter: IPascalTypePainter); overload;
    procedure RenderShapedText(ShapedText: TPascalTypeGlyphString; const Painter: IPascalTypePainter; var X, Y: TRenderFloat); overload;

    procedure RenderShapedGlyph(AGlyph: TPascalTypeGlyph; const Painter: IPascalTypePainter; X, Y: TRenderFloat; ADirection: TPascalTypeDirection = dirDefault);
    procedure AdvanceGlyphPosition(AGlyph: TPascalTypeGlyph; var X, Y: TRenderFloat);

    property Options: TPascalTypeRenderOptions read FOptions write FOptions;
    property ColorMode: TPascalTypeRenderColorMode read FColorMode write FColorMode;
    property VerticalMetricType: TPascalTypeVerticalMetricType read FVerticalMetricType write SetVerticalMetricType;
    property VerticalOrigin: TPascalTypeRenderVerticalOrigin read FVerticalOrigin write SetVerticalOrigin;
    property HorizontalOrigin: TPascalTypeRenderHorizontalOrigin read FHorizontalOrigin write SetHorizontalOrigin;
    property VerticalOriginValue: TRenderFloat read GetVerticalOriginValue write SetVerticalOriginValue;
    property HorizontalOriginValue: TRenderFloat read GetHorizontalOriginValue write SetHorizontalOriginValue;

    property FontFace: TPascalTypeFontFace read FFontFace write SetFontFace; // TODO : This ought to be TCustomPascalTypeFontFace
    property FontHeight: Integer read FFontHeight write SetFontHeight default -11;
    property FontSize: Integer read GetFontSize write SetFontSize stored False;
    property PixelPerInch: Integer read GetPixelPerInch write SetPixelPerInch default 96;
    property PixelPerInchX: Integer read FPixelPerInchX write SetPixelPerInchX default 96;
    property PixelPerInchY: Integer read FPixelPerInchY write SetPixelPerInchY default 96;
  end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

implementation

uses
  Math,
  SysUtils,
  PascalType.Unicode,
  PascalType.Tables.TrueType.glyf,
  PascalType.Tables.OpenType.COLR,
  PascalType.Tables.OpenType.CPAL,
  PascalType.ResourceStrings;

function ColorHSLtoRGB(H, S, L: Integer): Cardinal;

  function RGB(R, G, B: Byte): Cardinal;
  begin
    Result := $FF000000 or R or (G shl 8) or (B shl 16);
  end;


var
  V, M, M1, M2, VSF: Integer;
begin
  S := EnsureRange(S, 0, 255);
  L := EnsureRange(L, 0, 255);

  if L <= $7F then
    V := L * (256 + S) shr 8
  else
    V := L + S - Round(L * S / 255);

  if V <= 0 then
    Result := RGB(L, L, L)
  else
  begin
    M := L * 2 - V;
    H := H * 6;
    VSF := (V - M) * (H and $FF) shr 8;
    M1 := M + VSF;
    M2 := V - VSF;
    case H shr 8 of
      0: Result := RGB(V, M1, M);
      1: Result := RGB(M2, V, M);
      2: Result := RGB(M, V, M1);
      3: Result := RGB(M, M2, V);
      4: Result := RGB(M1, M, V);
      5: Result := RGB(V, M, M2);
    else
      Result := 0;
    end;
  end;
end;

function ClusterToColor(Index: integer): Cardinal;
const
  Saturation: integer = 150;
  Lightness: integer = 150;//180;
const
  GoldenRatioConjugate = 0.618033988749895 * 255;
begin
  var Hue := Round(Index * GoldenRatioConjugate) mod 256;

  Result := ColorHSLtoRGB(Hue, Saturation, Lightness);
end;


//------------------------------------------------------------------------------
//
//              TPascalTypeRenderer
//
//------------------------------------------------------------------------------
class constructor TPascalTypeRenderer.Create;
begin
  FDebugCircleRadius := 2.0;
  FDebugRectSize := 2.0;
  FDebugCircleColor := Cardinal(clRed) or $A0000000;
  FDebugRectColor := Cardinal(clBlue) or $A0000000;
  FDebugFontMetricsColor := Cardinal(clSkyBlue) or $B0000000;
  FDebugFontMetricsBaselineColor := Cardinal(clRed) or $B07F00FF;
  FDebugGlyphMetricsColor := Cardinal(clGreen) or $B0000000;
end;

constructor TPascalTypeRenderer.Create;
begin
  inherited;

  FPixelPerInchX := 96;
  FPixelPerInchY := 96;

  FFontHeight := -11;
  FVerticalMetricType := vmtAuto;
  FVerticalOrigin := voWindows;
  FHorizontalOrigin := hoTight;
  FOptions := [roFill];
end;

destructor TPascalTypeRenderer.Destroy;
begin
  FontFace := nil; // Unsubscribes
  inherited;
end;

procedure TPascalTypeRenderer.SetFontFace(const Value: TPascalTypeFontFace);
begin
  if (FFontFace = Value) then
    exit;

  if (FFontFace <> nil) then
    FFontFace.Unsubscribe(Self);

  FFontFace := Value;

  if (FFontFace <> nil) then
    FFontFace.Subscribe(Self);

  FontChanged;
end;

procedure TPascalTypeRenderer.PixelPerInchXChanged;
begin
  // nothing in here yet (trigger recalculation of cache here soon!)
end;

procedure TPascalTypeRenderer.PixelPerInchYChanged;
begin
  // nothing in here yet (trigger recalculation of cache here soon!)
end;

procedure TPascalTypeRenderer.RenderDebugCircle(const Painter: IPascalTypePainter; const p: TFloatPoint);
begin
  Painter.BeginPath;
  Painter.SetColor(FDebugCircleColor);
  Painter.Circle(p, DebugCircleRadius);
  Painter.EndPath(True);
end;

procedure TPascalTypeRenderer.RenderDebugRect(const Painter: IPascalTypePainter; const p: TFloatPoint);
var
  r: TFloatRect;
begin
  Painter.BeginPath;
  Painter.SetColor(FDebugRectColor);
  r.TopLeft := p;
  r.BottomRight := p;
  r.Inflate(DebugRectSize, DebugRectSize);
  Painter.Rectangle(r);
  Painter.EndPath(True);
end;

type
  TPointType = (
    ptOnCurve,
    ptQuadControl,
    ptCubicControl
  );

  TPathState = (
    psCurve,            // The previous point was a curve-point.
    psControl,          // The previous point was a quadratic control-point.
    psCubicControl1,    // The previous point was the first cubic control-point.
    psCubicControl2     // The previous point was the second cubic control-point.
  );

  TPathEmit = (
    emitNone,           // Draw nothing.
    emitLine,           // Draw a line.
    emitQuadratic,      // Draw a Quadratic bezier.
    emitHalfway,        // Draw a Quadratic bezier.
                        // The two previous points were control-points; This
                        // implies an implicit curve-point halfway between the
                        // control-points.
    emitCubic           // Draw a Cubic bezier.
  );

  TStateTransition = record
    NextState: TPathState;
    Emit: TPathEmit;
  end;

const
  StateMachine: array[TPointType, TPathState] of TStateTransition = (
    // ptOnCurve
    (
     (NextState: psCurve;       Emit: emitLine),        // psCurve -> ptOnCurve
     (NextState: psCurve;       Emit: emitQuadratic),   // psControl -> ptOnCurve
     (NextState: psCurve;       Emit: emitLine),        // psCubicControl1 -> ptOnCurve (Invalid)
     (NextState: psCurve;       Emit: emitCubic)        // psCubicControl2 -> ptOnCurve
    ),
    // ptQuadControl
    (
     (NextState: psControl;     Emit: emitNone),        // psCurve -> ptQuadControl
     (NextState: psControl;     Emit: emitHalfway),      // psControl -> ptQuadControl
     (NextState: psControl;     Emit: emitNone),        // psCubicControl1 -> ptQuadControl (Invalid)
     (NextState: psControl;     Emit: emitNone)         // psCubicControl2 -> ptQuadControl (Invalid)
    ),
    // ptCubicControl
    (
     (NextState: psCubicControl1; Emit: emitNone),      // psCurve -> ptCubicControl
     (NextState: psCubicControl1; Emit: emitNone),      // psControl -> ptCubicControl (Invalid)
     (NextState: psCubicControl2; Emit: emitNone),      // psCubicControl1 -> ptCubicControl
     (NextState: psCubicControl1; Emit: emitNone)       // psCubicControl2 -> ptCubicControl (Invalid)
    )
  );

procedure TPascalTypeRenderer.RenderGlyphPath(const GlyphPath: TPascalTypePath; const Painter: IPascalTypePainter; const Cursor: TFloatPoint);
var
  Origin: TFloatPoint;
  PointIndex: Integer;
  CurrentPoint: TFloatPoint;
  StartPoint: TFloatPoint;
  ControlPoint: TFloatPoint;
  ControlPoint2: TFloatPoint;
  MidPoint: TFloatPoint;
  PointType: TPointType;
  Contour: TPascalTypeContour;
  PathState: TPathState;
  StateTransition: TStateTransition;
  i: integer;
begin
  if (Length(GlyphPath) = 0) then
    exit;

  Origin.X := Cursor.X + FontMetrics.Origin.X;
  Origin.Y := Cursor.Y + FontMetrics.Origin.Y;

  if (not (roPoints in FOptions)) then
    Painter.BeginGlyph;

  for Contour in GlyphPath do
  begin
    if (Length(Contour) < 2) then
      continue;

    // Determine the starting state and actual move-to point
    CurrentPoint.X := Origin.X + Contour[0].XPos * ScalerX;
    CurrentPoint.Y := Origin.Y + Contour[0].YPos * ScalerY;

    if (Contour[0].Flags and PT_ON_CURVE <> 0) then
      // It's a curve-point
      PathState := psCurve
    else
    begin
      // It's a control-point. See if the prior point in the closed polygon
      // (i.e. last point in the array) is a curve-point.
      ControlPoint := CurrentPoint;
      if (Contour[High(Contour)].Flags and PT_ON_CURVE <> 0) then
      begin
        // Last point was a curve-point. Use it as the current point and use
        // the first point as the control-point.
        // Seen with: Kalinga Bold, small letter "r"
        CurrentPoint.X := Origin.X + Contour[High(Contour)].XPos * ScalerX;
        CurrentPoint.Y := Origin.Y + Contour[High(Contour)].YPos * ScalerY;
      end else
      begin
        // Both first and last points are control-points.
        // Synthesize a curve-point in between the two control-points.
        // Seen with: SimSun-ExtB, small letter "a"
        CurrentPoint.X := Origin.X + (Contour[0].XPos + Contour[High(Contour)].XPos) * 0.5 * ScalerX;
        CurrentPoint.Y := Origin.Y + (Contour[0].YPos + Contour[High(Contour)].YPos) * 0.5 * ScalerY;
      end;
      PathState := psControl;
    end;

    StartPoint := CurrentPoint;
    // Move to the first curve-point (the one we just found above)
    if (not (roPoints in FOptions)) then
      Painter.BeginPath;

    if (roPoints in FOptions) then
      RenderDebugCircle(Painter, CurrentPoint)
    else
      Painter.MoveTo(CurrentPoint);

    // Note that PointIndex wraps around to zero
{$define OLD}
{$ifdef OLD}
    PointIndex := 1;
{$else}
    if (Contour[0].Flags and PT_ON_CURVE <> 0) then
      PointIndex := 1
    else
      PointIndex := 0;
{$endif}

    for i := 0 to High(Contour) do
    begin
      // Get the next point
{$ifdef OLD}
      CurrentPoint.X := Origin.X + Contour[PointIndex].XPos * ScalerX;
      CurrentPoint.Y := Origin.Y + Contour[PointIndex].YPos * ScalerY;

      if (Contour[PointIndex].Flags and PT_CUBIC_CONTROL <> 0) then
        PointType := ptCubicControl
      else
      if (Contour[PointIndex].Flags and PT_ON_CURVE <> 0) then
        PointType := ptOnCurve
      else
        PointType := ptQuadControl;
{$else}
      var Index := (PointIndex + i) mod Length(Contour);
      CurrentPoint.X := Origin.X + Contour[Index].XPos * ScalerX;
      CurrentPoint.Y := Origin.Y + Contour[Index].YPos * ScalerY;

      if (Contour[Index].Flags and PT_CUBIC_CONTROL <> 0) then
        PointType := ptCubicControl
      else
      if (Contour[Index].Flags and PT_ON_CURVE <> 0) then
        PointType := ptOnCurve
      else
        PointType := ptQuadControl;
{$endif}

      StateTransition := StateMachine[PointType, PathState];
      PathState := StateTransition.NextState;

      case StateTransition.Emit of
        emitNone:
          begin
            // Store control points for quadratic/cubic curves
            if (PathState = psCubicControl2) then
              ControlPoint2 := CurrentPoint
            else
              ControlPoint := CurrentPoint;

            if (roPoints in FOptions) then
              RenderDebugRect(Painter, CurrentPoint);
          end;

        emitLine:
          begin
            if (roPoints in FOptions) then
              RenderDebugCircle(Painter, CurrentPoint)
            else
              Painter.LineTo(CurrentPoint);
          end;

        emitQuadratic: // TrueType quadratic curve
          begin 
            if (roPoints in FOptions) then
              RenderDebugCircle(Painter, CurrentPoint)
            else
              Painter.QuadraticBezierTo(ControlPoint, CurrentPoint);
          end;

        emitHalfway: // Implicit on-curve point between two quadratic control points (TrueType)
          begin
            MidPoint.X := (ControlPoint.X + CurrentPoint.X) * 0.5;
            MidPoint.Y := (ControlPoint.Y + CurrentPoint.Y) * 0.5;
            if (roPoints in FOptions) then
            begin
              RenderDebugCircle(Painter, MidPoint);
              RenderDebugRect(Painter, CurrentPoint);
            end else
              Painter.QuadraticBezierTo(ControlPoint, MidPoint);
            ControlPoint := CurrentPoint;
          end;

        emitCubic: // PostScript cubic curve (CFF/CFF2)
          begin
            if (roPoints in FOptions) then
              RenderDebugCircle(Painter, CurrentPoint)
            else
              Painter.CubicBezierTo(ControlPoint, ControlPoint2, CurrentPoint);
          end;
      end;

{$ifdef OLD}
      PointIndex := (PointIndex + 1) mod Length(Contour);
{$endif}
    end;

    if (not (roPoints in FOptions)) then
    begin
      case PathState of
        psControl:
          Painter.QuadraticBezierTo(ControlPoint, StartPoint);

        psCubicControl2:
          Painter.CubicBezierTo(ControlPoint, ControlPoint2, StartPoint);
      end;
      Painter.EndPath(True);
    end;

  end;

  // Handle closing the path if it ends with control points
  if (not (roPoints in FOptions)) then
    Painter.EndGlyph;
end;

procedure TPascalTypeRenderer.RenderGlyph(GlyphIndex: Integer; const Painter: IPascalTypePainter; const Cursor: TFloatPoint);
var
  GlyphPath: TPascalTypePath;
  ColoredGlyphs: TColoredGlyphs;
  i: integer;
  ColorABGR: TPaletteColor;
begin
  var SaveColor := Painter.Color;
  var FillColor := SaveColor;

  if (not (roFill in FOptions)) then
    FillColor := FillColor and $00FFFFFF;

  (*
  var StrokeColor := Painter.StrokeColor;

  if (not (roStroke in FOptions)) then
    StrokeColor := StrokeColor and $00FFFFFF;
  *)

  // Look for a color glyph with the specified GlyphID
  if (roColor in FOptions) and (FColorGlyphLookup <> nil) and FColorGlyphLookup.GetColoredGlyph(GlyphIndex, ColoredGlyphs) then
  begin

    for i := 0 to High(ColoredGlyphs) do
    begin
      if (not ColoredGlyphs[i].IsForegroundColor) and (ColoredGlyphs[i].IsValid) then
      begin
        // Resolve layer color using palette #0
        // TODO : Select palette based on lighness of default color
        ColorABGR := FColorLookup.GetPaletteColor(0, ColoredGlyphs[i].PaletteIndex);
        if (ColorABGR.Alpha = 0) then
          continue;

        Painter.Color := (ColorABGR.ARGB and $FF00FF00) or ((ColorABGR.ARGB and $00FF0000) shr 16) or ((ColorABGR.ARGB and $000000FF) shl 16);
      end else
        // Use default color
        Painter.Color := FillColor;

      // TODO : Recurse? Specs doesn't state if we should do this.
      // RenderGlyph(ColoredGlyphs[i].GlyphID, Painter, Cursor);
      GlyphPath := FontFace.GetGlyphPath(ColoredGlyphs[i].GlyphID);
      RenderGlyphPath(GlyphPath, Painter, Cursor);
    end;

    Painter.Color := SaveColor;
    exit;
  end;

  GlyphPath := FontFace.GetGlyphPath(GlyphIndex);

  Painter.Color := FillColor;
  begin

    RenderGlyphPath(GlyphPath, Painter, Cursor);

  end;
  Painter.Color := SaveColor;
end;

function TPascalTypeRenderer.IsDrawable(AGlyph: TPascalTypeGlyph): boolean;
begin
  // Ignore Emoji variation selector that was substituted to .notdef
  // Works around issue rendering #$263A#$FE0F with Twemoji font.
  Result := (AGlyph.GlyphID <> GlyphNotDef) or (not AGlyph.IsSubstituted) or (Length(AGlyph.CodePoints) <> 1) or
    (not PascalTypeUnicode.IsVariationSelector(AGlyph.CodePoints[0]));
end;

function TPascalTypeRenderer.GetGlyphPosition(AGlyph: TPascalTypeGlyph; X, Y: TRenderFloat; ADirection: TPascalTypeDirection): TFloatPoint;
begin
  // Position glyph relative to cursor
  if (ADirection = dirTopDown) then
  begin
    // For vertical layout, the origin is already adjusted by XOffset/YOffset
    Result.X := X + ScalerX * AGlyph.XOffset - FontMetrics.Origin.X;
    Result.Y := Y + ScalerY * AGlyph.YOffset - FontMetrics.Origin.Y;
  end else
  begin
    Result.X := X + ScalerX * AGlyph.XOffset;
    Result.Y := Y + ScalerY * AGlyph.YOffset;
  end;
end;

procedure TPascalTypeRenderer.AdvanceGlyphPosition(AGlyph: TPascalTypeGlyph; var X, Y: TRenderFloat);
begin
  X := X + ScalerX * AGlyph.XAdvance;
  Y := Y + ScalerY * AGlyph.YAdvance;
end;

procedure TPascalTypeRenderer.RenderShapedGlyph(AGlyph: TPascalTypeGlyph; const Painter: IPascalTypePainter; X, Y: TRenderFloat; ADirection: TPascalTypeDirection);
begin
  if (FontFace = nil) then
    exit;

  if (not IsDrawable(AGlyph)) then
    exit;

  var Cursor := GetGlyphPosition(AGlyph, X, Y, ADirection);

  // Rasterize glyph
  RenderGlyph(AGlyph.GlyphID, Painter, Cursor);
end;

procedure TPascalTypeRenderer.RenderShapedText(ShapedText: TPascalTypeGlyphString; const Painter: IPascalTypePainter);
var
  X, Y: TRenderFloat;
begin
  X := 0;
  Y := 0;
  RenderShapedText(ShapedText, Painter, X, Y);
end;

procedure TPascalTypeRenderer.RenderShapedText(ShapedText: TPascalTypeGlyphString; const Painter: IPascalTypePainter; var X, Y: TRenderFloat);

  function FloatPoint(X, Y: TRenderFloat): TFloatPoint;
  begin
    Result.X := X;
    Result.Y := Y;
  end;

  procedure DrawLineHorizontal(X1, X2, Y: TRenderFloat; const Caption: string = '');
  begin
    Painter.BeginPath;

    Painter.MoveTo(FloatPoint(X1, Y));
    Painter.LineTo(FloatPoint(X2, Y));

    Painter.EndPath(False);
  end;

  procedure DrawLineVertical(X, Y1, Y2: TRenderFloat; const Caption: string = '');
  begin
    Painter.BeginPath;

    Painter.MoveTo(FloatPoint(X, Y1));
    Painter.LineTo(FloatPoint(X, Y2));

    Painter.EndPath(False);
  end;

  function GetAutoOffset: TFloatPoint;
  begin
    Result := Default(TFloatPoint);

    if (not (FHorizontalOrigin in [hoAuto, hoTight])) and (FVerticalOrigin <> voAuto) then
      exit;

    if (FVerticalOrigin <> voAuto) then
    begin
      // hoTight does nothing without HorizontalMetrics
      if (FHorizontalOrigin = hoTight) and (FontFace.HorizontalMetrics = nil) then
        exit;
    end;

    var MinXReach: Single := MaxSingle;
    var MaxYReach: Single := -MaxSingle;
    var CursorX: TRenderFloat := 0.0;
    var CursorY: TRenderFloat := 0.0;
    var HasInk := False;

    for var Glyph in ShapedText do
    begin
      var XMin, YMin, XMax, YMax: SmallInt;

      if FontFace.GetGlyphExtents(Glyph.GlyphID, XMin, YMin, XMax, YMax) then
      begin
        var XPos: TRenderFloat := CursorX + Glyph.XOffset;
        var YPos: TRenderFloat := CursorY + Glyph.YOffset;

        // Only consider glyph if it has "ink".
        // - We qualify this rule to only apply to substituted glyphs so it
        //   will still be possible to have leading explicit white space.
        // - Also, once we have encountered a glyph with ink, we process all
        //   the following glyphs regardless of ink.
        if (HasInk) or (not Glyph.IsSubstituted) or (XMax > XMin) or (YMax > YMin) then
        begin
          HasInk := True;

          case FHorizontalOrigin of
            hoAuto:
              MinXReach := Min(MinXReach, XPos + XMin);

            hoTight:
              begin
                var LSB: Integer;

                if (FontFace.HorizontalMetrics <> nil) then
                begin
                  // If 'hmtx' table contains fewer entries that there are glyphs, then the last
                  // entry repeats.
                  var GlyphID := Min(Glyph.GlyphID, FontFace.HorizontalMetrics.HorizontalMetricCount-1);
                  LSB := FontFace.HorizontalMetrics[GlyphID].Bearing;
                end else
                  LSB := XMin;

                MinXReach := Min(MinXReach, XPos + LSB);
              end;
          end;

          if (FVerticalOrigin = voAuto) then
            MaxYReach := Max(MaxYReach, YPos + YMax);
        end;
      end;

      CursorX := CursorX + Glyph.XAdvance;
      CursorY := CursorY + Glyph.YAdvance;
    end;

    if (FHorizontalOrigin in [hoAuto, hoTight]) and (MinXReach <> MaxSingle) then
      Result.X := - MinXReach * ScalerX;

    if (FVerticalOrigin = voAuto) and (MaxYReach <> -MaxSingle) then
      Result.Y := MaxYReach * ScalerAbsY;
  end;

  procedure DrawGlyphMetrics(const Offset: TFloatPoint);
  begin
    var Cursor: TFloatPoint;

    Cursor.X := X + Offset.X;
    Cursor.Y := Y + Offset.Y;

    // Mirror the Origin adjustment inside RenderGlyphPath
    Cursor.X := Cursor.X + FontMetrics.Origin.X;
    Cursor.Y := Cursor.Y + FontMetrics.Origin.Y;

    for var i := 0 to ShapedText.Count-1 do
    begin
      var Glyph := ShapedText[i];

      if (not IsDrawable(Glyph)) then
        continue;

      var GlyphPos := GetGlyphPosition(Glyph, Cursor.X, Cursor.Y, ShapedText.Direction);

      Painter.BeginPath;
      Painter.MoveTo(FloatPoint(GlyphPos.X, GlyphPos.Y-5));
      Painter.LineTo(GlyphPos);
      Painter.LineTo(FloatPoint(GlyphPos.X+5, GlyphPos.Y));
      Painter.EndPath(False);

      var GlyphData := FontFace.GlyphData[Glyph.GlyphID];
      if (GlyphData <> nil) then
      begin
        GlyphPos.X := GlyphPos.X + ScalerX * (GlyphData.XMax - 0*GlyphData.XMin);
        GlyphPos.Y := GlyphPos.Y - FontMetrics.Ascender;

        Painter.BeginPath;
        Painter.MoveTo(FloatPoint(GlyphPos.X-5, GlyphPos.Y));
        Painter.LineTo(FloatPoint(GlyphPos.X,   GlyphPos.Y));
        Painter.LineTo(FloatPoint(GlyphPos.X,   GlyphPos.Y+5));
        Painter.EndPath(False);
      end;

      AdvanceGlyphPosition(Glyph, Cursor.X, Cursor.Y);
    end;
  end;

var
  Cursor: TFloatPoint;
  ColorGlyphProvider: IPascalTypeColorGlyphProvider;
  ColorProvider: IPascalTypeColorProvider;
begin
  if (FontFace = nil) then
    exit;

  if (ShapedText.Count = 0) then
    exit;

  if (rfHasColor in FFlags) and (FColorGlyphLookup = nil) then
  begin
    var Table := FFontFace.GetTableByTableType('COLR');
    if (Supports(Table, IPascalTypeColorGlyphProvider, ColorGlyphProvider)) then
      FColorGlyphLookup := ColorGlyphProvider.GetColorGlyphLookup;

    if (FColorGlyphLookup <> nil) and (FColorLookup = nil) then
    begin
      Table := FFontFace.GetTableByTableType('CPAL');
      if (Supports(Table, IPascalTypeColorProvider, ColorProvider)) then
        FColorLookup := ColorProvider.GetColorLookup
      else
      begin
        FColorGlyphLookup := nil; // Can't support color glyphs without any colors
        Exclude(FFlags, rfHasColor);
      end;
    end;
  end;

  var Offset := GetAutoOffset;

  Cursor.X := X + Offset.X;
  Cursor.Y := Y + Offset.Y;

  var SaveColor: Cardinal := 0;
  if (roColorize in FOptions) then
    SaveColor := Painter.Color
  else
  if (not (roPoints in FOptions)) then // rmPoints needs to be able to draw each point in a different color
    Painter.BeginUpdate;
  try

    (*
    ** Render loop
    *)
    var CurrentCluster := -1;
    var ColorIndex := 0;
    for var Glyph in ShapedText do
    begin

      if (roColorize in FOptions) then
      begin
        case FColorMode of
          rcmGlyph: // Color glyphs
            begin
              Painter.Color := ClusterToColor(ColorIndex);
              ColorIndex := (ColorIndex + 1) and 255;
            end;

          rcmGrapheme: // Color graphemes/clusters
            if (Glyph.Cluster <> CurrentCluster) then
            begin
              CurrentCluster := Glyph.Cluster;

              Painter.Color := ClusterToColor(ColorIndex);
              ColorIndex := (ColorIndex + 1) and 255;
            end;
        end;
      end;

      RenderShapedGlyph(Glyph, Painter, Cursor.X, Cursor.Y, ShapedText.Direction);

      AdvanceGlyphPosition(Glyph, Cursor.X, Cursor.Y);
    end;

  finally
    if (roColorize in FOptions) then
      Painter.Color := SaveColor
    else
    if (not (roPoints in FOptions)) then
      Painter.EndUpdate;
  end;

  if (roMetrics in FOptions) then
  begin
    var FromX := X + Offset.X;
    var FromY := Y + Offset.Y;

    SaveColor := Painter.Color;
    Painter.Color := 0;
    Painter.StrokeColor := DebugFontMetricsBaselineColor;
//    Painter.BeginUpdate;

    // Baseline
    if (ShapedText.Direction <> dirTopDown) then
      DrawLineHorizontal(FromX, Cursor.X, FromY + FontMetrics.Origin.Y, 'baseline')
    else
      DrawLineVertical(FromX + FontMetrics.Origin.X, FromY, Cursor.Y, 'baseline');

    Painter.StrokeColor := DebugFontMetricsColor;

    // Ascender
    if (ShapedText.Direction <> dirTopDown) then
    begin
      var BaselineY := FromY + FontMetrics.Origin.Y;
      DrawLineHorizontal(X, Cursor.X, BaselineY - FontMetrics.Ascender, 'ascender height');

      // Descender
      DrawLineHorizontal(FromX, Cursor.X, BaselineY + FontMetrics.Descender, 'descender depth');

      // LineGap
      if (FontMetrics.LineGap <> 0) then
        DrawLineHorizontal(FromX, Cursor.X, BaselineY + FontMetrics.LineGap, 'Line gap');

      // Lower- and uppercase heights
      if (FontMetrics.XHeight <> 0) then
        DrawLineHorizontal(FromX, Cursor.X, BaselineY - FontMetrics.XHeight, 'x-height');
      if (FontMetrics.CapHeight <> 0) then
        DrawLineHorizontal(FromX, Cursor.X, BaselineY - FontMetrics.CapHeight, 'cap height');
    end;

    // Glyph metrics
    Painter.StrokeColor := DebugGlyphMetricsColor;
    DrawGlyphMetrics(Offset);

//    Painter.EndUpdate;
    Painter.StrokeColor := 0;
    Painter.Color := SaveColor
  end;

  X := Cursor.X;
  Y := Cursor.Y;
end;

procedure TPascalTypeRenderer.RenderText(const Text: string; const Painter: IPascalTypePainter);
var
  X, Y: TRenderFloat;
begin
  X := 0;
  Y := 0;
  RenderText(Text, Painter, X, Y);
end;

procedure TPascalTypeRenderer.RenderText(const Text: string; const Painter: IPascalTypePainter; var X, Y: TRenderFloat);

  procedure OffsetStartPos(var Cursor: TFloatPoint);
  begin
    if (not (FHorizontalOrigin in [hoAuto, hoTight])) and (FVerticalOrigin <> voAuto) then
      exit;

    if (FVerticalOrigin <> voAuto) then
    begin
      // hoTight does nothing without HorizontalMetrics
      if (FHorizontalOrigin = hoTight) and (FontFace.HorizontalMetrics = nil) then
        exit;
    end;

    var MinXReach: Single := MaxSingle;
    var MaxYReach: Single := -MaxSingle;
    var CursorX: TRenderFloat := 0.0;

    for var Codepoint in Text do
    begin
      if (Codepoint < #32) then
        continue;

      var GlyphIndex := FontFace.GetGlyphByCharacter(Codepoint);
      var XMin, YMin, XMax, YMax: SmallInt;

      if FontFace.GetGlyphExtents(GlyphIndex, XMin, YMin, XMax, YMax) then
      begin

        case FHorizontalOrigin of
          hoAuto:
            MinXReach := Min(MinXReach, CursorX + XMin);

          hoTight:
            begin
              var LSB: Integer;

              if (FontFace.HorizontalMetrics <> nil) then
              begin
                // If 'hmtx' table contains fewer entries that there are glyphs, then the last
                // entry repeats.
                var MetricIndex := Min(GlyphIndex, FontFace.HorizontalMetrics.HorizontalMetricCount-1);
                LSB := FontFace.HorizontalMetrics[MetricIndex].Bearing;
              end else
                LSB := XMin;

              MinXReach := Min(MinXReach, CursorX + LSB);
            end;
        end;

        if (FVerticalOrigin = voAuto) then
          MaxYReach := Max(MaxYReach, YMax);

      end;

      // For horizontal origin we only need the first visible char. For vertical
      // we need all of them.
      if (FVerticalOrigin <> voAuto) then
        break;

      CursorX := CursorX + FontFace.GetAdvanceWidth(GlyphIndex);
    end;

    if (FHorizontalOrigin in [hoAuto, hoTight]) and (MinXReach <> MaxSingle) then
      Cursor.X := Cursor.X - MinXReach * ScalerX;

    if (FVerticalOrigin = voAuto) and (MaxYReach <> -MaxSingle) then
    begin
      var BaselineOffset := MaxYReach * ScalerAbsY;
      Cursor.Y := Cursor.Y + BaselineOffset;
    end;
  end;

var
  CharIndex: Integer;
  GlyphIndex: Integer;
  Cursor: TFloatPoint;
  GlyphMetric: TGlyphMetric;
  SaveColor: Cardinal;
begin
  if (FontFace = nil) or (Text = '') then
    exit;

  Cursor.X := X;
  Cursor.Y := Y;

  OffsetStartPos(Cursor);

  SaveColor := 0;
  if (roColorize in FOptions) then
    SaveColor := Painter.Color
  else
    Painter.BeginUpdate;
  try

    for CharIndex := 1 to Length(Text) do
    begin
      if Text[CharIndex] <= #31 then
      begin
        case Text[CharIndex] of
          #10: ;// handle CR
          #13: ;// handle LF
        end;
        continue;
      end;

      if (roColorize in FOptions) then
        Painter.Color := ClusterToColor(CharIndex);

      // Get glyph index
      GlyphIndex := FontFace.GetGlyphByCharacter(Text[CharIndex]);

      // Rasterize glyph
      RenderGlyph(GlyphIndex, Painter, Cursor);

      // Advance cursor
      GlyphMetric := GetGlyphMetric(GlyphIndex);
      Cursor.X := Cursor.X + GlyphMetric.HorizontalMetric.AdvanceWidth;
    end;

  finally
    if (roColorize in FOptions) then
      Painter.Color := SaveColor
    else
      Painter.EndUpdate;
  end;

  X := Cursor.X;
  Y := Cursor.Y;
end;

procedure TPascalTypeRenderer.FontChanged;
begin
  Exclude(FFlags, rfHasScalerX);
  Exclude(FFlags, rfHasScalerY);
  Exclude(FFlags, rfHasMetrics);

  if (roColor in FOptions) and (FFontFace <> nil) and (FFontFace.ContainsTable('COLR')) then
    Include(FFlags, rfHasColor);
end;

procedure TPascalTypeRenderer.FontChanging;
begin
  Exclude(FFlags, rfHasScalerX);
  Exclude(FFlags, rfHasScalerY);
  Exclude(FFlags, rfHasMetrics);
  Exclude(FFlags, rfHasColor);
  FColorGlyphLookup := nil;
  FColorLookup := nil;
end;

procedure TPascalTypeRenderer.FontFaceNotification(Sender: TCustomPascalTypeFontFacePersistent; Notification: TFontFaceNotification);
begin
  case Notification of
    fnDestroy:
      begin
        FontChanging;
        FontFace := nil;
      end;

    fnClear:
      FontChanging;

    fnChanged:
      FontChanged;
  end;
end;

procedure TPascalTypeRenderer.FontHeightChanged;
begin
  Exclude(FFlags, rfHasScalerX);
  Exclude(FFlags, rfHasScalerY);
  Exclude(FFlags, rfHasMetrics);
end;

procedure TPascalTypeRenderer.CalculateMetrics;
var
  LineGap: TRenderFLoat;
begin
  if (rfHasMetrics in FFlags) then
    exit;
  Include(FFlags, rfHasMetrics);

  FFontMetrics := Default(TPascalTypeFontMetric);
  LineGap := 0;

  if (FontFace = nil) then
    exit;

  if (FontFace.OS2Table <> nil) then
  begin
    var ActualVerticalMetricType := FVerticalMetricType;

    // Resolve auto; If font wants us to use typographic metrics, then we use
    // typographic metrics.
    if (ActualVerticalMetricType = vmtAuto) then
    begin
      if (fsfUseTypoMetrics in FontFace.OS2Table.FontSelectionFlags) then
        ActualVerticalMetricType := vmtTypographic
      else
        ActualVerticalMetricType := vmtWindows;
    end;

    case ActualVerticalMetricType of
      vmtTypographic:
        begin
          FFontMetrics.Ascender := FontFace.OS2Table.TypographicAscender * ScalerAbsY;
          FFontMetrics.Descender := -FontFace.OS2Table.TypographicDescender * ScalerAbsY;
          LineGap := FontFace.OS2Table.TypographicLineGap * ScalerAbsY;
        end;

      vmtWindows:
        begin
          FFontMetrics.Ascender := FontFace.OS2Table.WindowsAscent * ScalerAbsY;
          FFontMetrics.Descender := FontFace.OS2Table.WindowsDescent * ScalerAbsY;
          if (FontFace.HorizontalHeader <> nil) then
            LineGap := FontFace.HorizontalHeader.LineGap * ScalerAbsY
          else
            // Fallback to typographic; Not what user asked for but better than nothing
            LineGap := FontFace.OS2Table.TypographicLineGap * ScalerAbsY;
        end;
    end;

    if (FontFace.OS2Table.AddendumTable <> nil) then
    begin
      FFontMetrics.XHeight := FontFace.OS2Table.AddendumTable.XHeight * ScalerAbsY;
      FFontMetrics.CapHeight := FontFace.OS2Table.AddendumTable.CapHeight * ScalerAbsY;
    end;

  end else
  if (FontFace.HorizontalHeader <> nil) then
  begin
    FFontMetrics.Ascender := FontFace.HorizontalHeader.Ascent * ScalerAbsY;
    FFontMetrics.Descender := -FontFace.HorizontalHeader.Descent * ScalerAbsY;
    LineGap := FontFace.HorizontalHeader.LineGap * ScalerAbsY;
  end else
  if (FontFace.HeaderTable <> nil) then // Font might not have been loaded yet
  begin
    FFontMetrics.Ascender := FontFace.HeaderTable.YMax * ScalerAbsY;
    FFontMetrics.Descender := -FontFace.HeaderTable.YMin * ScalerAbsY;
  end;

  FFontMetrics.Baseline := FFontMetrics.Ascender;
  FFontMetrics.LineGap := FFontMetrics.Descender + LineGap;

  case FVerticalOrigin of
    voZero:
      FFontMetrics.Origin.Y := 0;

    voBaseline:
      FFontMetrics.Origin.Y := FFontMetrics.Baseline;

    voWindows:
      if (FontFace.OS2Table <> nil) then
        FFontMetrics.Origin.Y := FontFace.OS2Table.WindowsAscent * ScalerAbsY
      else
        FFontMetrics.Origin.Y := FFontMetrics.Baseline;

    voTight:
      if (FontFace.HeaderTable <> nil) then
        FFontMetrics.Origin.Y := FontFace.HeaderTable.YMax * ScalerAbsY;

    voCenter:
      // Based on https://glyphsapp.com/learn/vertical-metrics#g-the-webfontstrategy-2019
      FFontMetrics.Origin.Y := FFontMetrics.Baseline + LineGap / 2;

    voCustom:
      FFontMetrics.Origin.Y := FCustomOrigin.Y;

  else
    FFontMetrics.Origin.Y := 0;
  end;

  case FHorizontalOrigin of
    hoCustom:
      FFontMetrics.Origin.X := FCustomOrigin.X;

  else
    FFontMetrics.Origin.X := 0;
  end;
end;

procedure TPascalTypeRenderer.CalculateScalerX;
begin
  Include(FFlags, rfHasScalerX);
{$IFDEF UseFloatingPoint}
  if (FFontFace <> nil) and (FFontFace.HeaderTable <> nil) then // We might get called before font has been assigned/loaded
    FScalerX := Abs(FFontHeight / FFontFace.HeaderTable.UnitsPerEm)
  else
    FScalerX := 1.0;
{$ENDIF}
end;

procedure TPascalTypeRenderer.CalculateScalerY;
begin
  Include(FFlags, rfHasScalerY);

  if (FFontFace <> nil) and (FFontFace.HeaderTable <> nil) then // We might get called before font has been assigned/loaded
    FScalerAbsY := Abs(FFontHeight / FFontFace.HeaderTable.UnitsPerEm)
  else
    FScalerAbsY := -1.0;
{$ifdef Inverse_Y_axis}
  FScalerY := -FScalerAbsY;
{$else Inverse_Y_axis}
  FScalerY := FScalerAbsY;
{$endif Inverse_Y_axis}
end;

function TPascalTypeRenderer.GetAdvanceWidth(GlyphIndex: Integer): TScaleType;
begin
  Result := ScalerX * FontFace.GetAdvanceWidth(GlyphIndex);
end;

function TPascalTypeRenderer.GetFontMetrics: TPascalTypeFontMetric;
begin
  if (not (rfHasMetrics in FFlags)) then
    CalculateMetrics;
  Result := FFontMetrics;
end;

function TPascalTypeRenderer.GetFontSize: Integer;
begin
  Result := -Int64(FFontHeight * 72) div FPixelPerInchY;
end;

function TPascalTypeRenderer.GetGlyphMetric(GlyphIndex: Integer): TGlyphMetric;
var
  TrueTypeGlyphMetric: TTrueTypeGlyphMetric;
begin
  TrueTypeGlyphMetric := FontFace.GetGlyphMetric(GlyphIndex);

  Result.HorizontalMetric.AdvanceWidth := ScalerX * TrueTypeGlyphMetric.HorizontalMetric.AdvanceWidth;
  Result.HorizontalMetric.Bearing := ScalerX * TrueTypeGlyphMetric.HorizontalMetric.Bearing;
  Result.VerticalMetric.AdvanceHeight := ScalerY * TrueTypeGlyphMetric.VerticalMetric.AdvanceHeight;
  Result.VerticalMetric.TopSideBearing := ScalerY * TrueTypeGlyphMetric.VerticalMetric.TopSideBearing;
end;

function TPascalTypeRenderer.GetHorizontalOriginValue: TRenderFloat;
begin
  Result := FontMetrics.Origin.X;
end;

function TPascalTypeRenderer.GetKerning(Last, Next: Integer): TScaleType;
begin
  Result := ScalerX * FontFace.GetKerning(Last, Next);
end;

function TPascalTypeRenderer.GetPixelPerInch: Integer;
begin
  Result := (FPixelPerInchX + FPixelPerInchY) div 2;
end;

function TPascalTypeRenderer.GetScalerX: TScaleType;
begin
  if (not (rfHasScalerX in FFlags)) then
    CalculateScalerX;
  Result := FScalerX;
end;

function TPascalTypeRenderer.GetScalerY: TScaleType;
begin
  if (not (rfHasScalerY in FFlags)) then
    CalculateScalerY;
  Result := FScalerY;
end;

function TPascalTypeRenderer.GetScalerAbsY: TScaleType;
begin
  if (not (rfHasScalerY in FFlags)) then
    CalculateScalerY;
  Result := FScalerAbsY;
end;

function TPascalTypeRenderer.GetVerticalOriginValue: TRenderFloat;
begin
  Result := FontMetrics.Origin.Y;
end;

procedure TPascalTypeRenderer.SetFontSize(const Value: Integer);
begin
  FontHeight := -Int64(Value * FPixelPerInchY) div 72;
end;

procedure TPascalTypeRenderer.SetHorizontalOrigin(const Value: TPascalTypeRenderHorizontalOrigin);
begin
  if (FHorizontalOrigin = Value) then
    exit;
  FHorizontalOrigin := Value;
  Exclude(FFlags, rfHasMetrics);
end;

procedure TPascalTypeRenderer.SetHorizontalOriginValue(const Value: TRenderFloat);
begin
  FCustomOrigin.X := Value;
  FFontMetrics.Origin.X := Value;
  FHorizontalOrigin := hoCustom;
end;

procedure TPascalTypeRenderer.SetFontHeight(const Value: Integer);
begin
  if FFontHeight <> Value then
  begin
    FFontHeight := Value;
    FontHeightChanged;
  end;
end;

procedure TPascalTypeRenderer.SetPixelPerInch(const Value: Integer);
begin
  if (FPixelPerInchX = Value) and (FPixelPerInchY = Value) then
    exit;

  PixelPerInchX := Value;
  PixelPerInchY := Value;
end;

procedure TPascalTypeRenderer.SetPixelPerInchX(const Value: Integer);
begin
  if FPixelPerInchX <> Value then
  begin
    FPixelPerInchX := Value;
    PixelPerInchXChanged;
  end;
end;

procedure TPascalTypeRenderer.SetPixelPerInchY(const Value: Integer);
begin
  if FPixelPerInchY <> Value then
  begin
    FPixelPerInchY := Value;
    PixelPerInchYChanged;
  end;
end;

procedure TPascalTypeRenderer.SetVerticalOrigin(const Value: TPascalTypeRenderVerticalOrigin);
begin
  if (FVerticalOrigin = Value) then
    exit;
  FVerticalOrigin := Value;
  Exclude(FFlags, rfHasMetrics);
end;

procedure TPascalTypeRenderer.SetVerticalMetricType(const Value: TPascalTypeVerticalMetricType);
begin
  if (FVerticalMetricType = Value) then
    exit;
  FVerticalMetricType := Value;
  Exclude(FFlags, rfHasMetrics);
end;

procedure TPascalTypeRenderer.SetVerticalOriginValue(const Value: TRenderFloat);
begin
  FCustomOrigin.Y := Value;
  FFontMetrics.Origin.Y := Value;
  FVerticalOrigin := voCustom;
end;

end.