PascalType.GlyphString.pas

unit PascalType.GlyphString;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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}

uses
  Generics.Collections,
  PascalType.Classes,
  PascalType.Types,
  PascalType.Unicode,
  PascalType.Tables.OpenType.Common.Anchor,
  PascalType.Tables.OpenType.Common.ValueRecord,
  PascalType.FontFace;

//------------------------------------------------------------------------------
//
//              TPascalTypeGlyph
//
//------------------------------------------------------------------------------
type
  TPascalTypeGlyphString = class;

  TPascalTypeGlyph = class
  private
    FGlyphString: TPascalTypeGlyphString;
    FCodePoints: TPascalTypeCodePoints;
    FGlyphID: TGlyphID;
    FAlternateIndex: integer;
    FIsSubstituted: boolean;
    FIsLigated: boolean;
    FIsBase: boolean;
    FIsMark: boolean;
    FIsLigature: boolean;
    FCluster: integer;
    FXAdvance: integer;
    FYAdvance: integer;
    FXOffset: integer;
    FYOffset: integer;
    FMarkAttachment: integer;
    FMarkAttachmentType: integer;
    FLigatureComponent: integer;
    FCursiveAttachment: integer;
    FLigatureID: integer;
    FUserFeatures: TPascalTypeFeatures;
    FPlanFeatures: TPascalTypeFeatures;
    FIsMultiplied: boolean;

  private
    function GetUserFeatures: PPascalTypeFeatures;
    function GetPlanFeatures: PPascalTypeFeatures;
    function GetIndex: integer;
    procedure SetIndex(const Value: integer);
    procedure SetGlyphID(const Value: TGlyphID);

  protected
    function AllIsMark: boolean;

  public
    constructor Create(AGlyphString: TPascalTypeGlyphString); virtual;

    procedure Assign(Source: TPascalTypeGlyph); virtual;

    procedure ApplyPositioning(const AValueRecord: TOpenTypeValueRecord);
    procedure ApplyPositioningRTL(SecondGlyph: TPascalTypeGlyph; const FirstValue, SecondValue: TOpenTypeValueRecord);
    procedure ApplyAnchor(MarkAnchor, BaseAnchor: TOpenTypeAnchor; BaseIndex: integer);

  protected
    procedure ApplyVariation(const AValueRecord: TOpenTypeValueRecord); virtual; deprecated 'Use TPascalTypeGlyphString.ApplyVariation instead';

  public
    property GlyphString: TPascalTypeGlyphString read FGlyphString;
    property Index: integer read GetIndex write SetIndex;

    property CodePoints: TPascalTypeCodePoints read FCodePoints write FCodePoints;
    property GlyphID: TGlyphID read FGlyphID write SetGlyphID;
    property Cluster: integer read FCluster write FCluster;

    property XAdvance: integer read FXAdvance write FXAdvance;
    property YAdvance: integer read FYAdvance write FYAdvance;
    property XOffset: integer read FXOffset write FXOffset;
    property YOffset: integer read FYOffset write FYOffset;

    // User features; Specified by the user.
    property UserFeatures: PPascalTypeFeatures read GetUserFeatures;

    // Plan features. Populated by the shaper.
    property PlanFeatures: PPascalTypeFeatures read GetPlanFeatures;

    // AlternateIndex: Value to be set after glyph string has been created but
    // before shaping takes place.
    // The user typically selects an "alternate" for a glyph from a list of available
    // alternates. For example "zero without slash" or "zero with slash".
    // The value is zero-based.
    property AlternateIndex: integer read FAlternateIndex write FAlternateIndex;

    // Shaper state
    property LigatureID: integer read FLigatureID write FLigatureID;
    property LigatureComponent: integer read FLigatureComponent write FLigatureComponent; // 0-based
    property MarkAttachment: integer read FMarkAttachment write FMarkAttachment;
    property MarkAttachmentType: integer read FMarkAttachmentType;
    property CursiveAttachment: integer read FCursiveAttachment write FCursiveAttachment;
    property IsLigated: boolean read FIsLigated write FIsLigated;
    property IsSubstituted: boolean read FIsSubstituted write FIsSubstituted;
    property IsMultiplied: boolean read FIsMultiplied write FIsMultiplied;

    // Classification
    property IsBase: boolean read FIsBase;
    property IsMark: boolean read FIsMark;
    property IsLigature: boolean read FIsLigature;
  end;

  TPascalTypeGlyphClass = class of TPascalTypeGlyph;


//------------------------------------------------------------------------------
//
//      TPascalTypeGlyphIterator
//
//------------------------------------------------------------------------------
// Skipping glyphstring iterator
//------------------------------------------------------------------------------
  TPascalTypeGlyphIterator = record
  private
    FGlyphString: TPascalTypeGlyphString;
    FIndex: integer;
    FLookupFlags: Word;
    FMarkAttachmentFilter: integer;
    FMarkFilteringSet: integer;
    FIgnoreDefaultIgnorables: boolean;
    function GetGlyph: TPascalTypeGlyph;
    function GetEOF: boolean;
    function ShouldIgnore(AGlyph: TPascalTypeGlyph; AApplyIgnoreDefaultIgnorables: boolean): boolean;
    procedure SetIndex(const Value: integer);
  public
    constructor Create(const AGlyphString: TPascalTypeGlyphString);

    function Clone: TPascalTypeGlyphIterator;

    procedure ResetFlags(ALookupFlags: Word; AMarkFilteringSet: integer = -1; AMarkAttachmentFilter: integer = -1);
    procedure Reset(ALookupFlags: Word = 0; AMarkFilteringSet: integer = -1);

    // Move forward. Skip glyphs that should be ignored. Return new index.
    function Next(AIncrement: integer = 1; AApplyIgnoreDefaultIgnorables: boolean = True): integer;
    // Move Backward. Skip glyphs that should be ignored. Return new index.
    function Previous(AIncrement: integer = 1; AApplyIgnoreDefaultIgnorables: boolean = True): integer;

    // Move forward/backward. Do not skip. Return new index.
    function Step(AIncrement: integer = 1): integer;

    // Simulate moving forward/backward. Skip glyphs that should be ignored. Return new index.
    function Peek(AIncrement: integer = 1; AApplyIgnoreDefaultIgnorables: boolean = True): integer;
    function PeekGlyph(AIncrement: integer = 1): TPascalTypeGlyph;

    function GetEnumerator: TEnumerator<integer>;

    property Index: integer read FIndex write SetIndex;
    property EOF: boolean read GetEOF;
    // Current glyph. nil if there is no current.
    property Glyph: TPascalTypeGlyph read GetGlyph;

    property GlyphString: TPascalTypeGlyphString read FGlyphString;
    property LookupFlags: Word read FLookupFlags;
    property MarkAttachmentFilter: integer read FMarkAttachmentFilter;
    property IgnoreDefaultIgnorables: boolean read FIgnoreDefaultIgnorables write FIgnoreDefaultIgnorables;
  end;

//------------------------------------------------------------------------------
//
//              TPascalTypeGlyphString
//
//------------------------------------------------------------------------------
  TPascalTypeGlyphString = class
  public type
    TClusterLevel = PascalType.Types.TClusterLevel;
    TGlyphMapperDelegate = reference to function(GlyphID: TGlyphID): integer;

    TMatchOptions = set of (
      moSkipFirst,      // Skip first item in sequence. Does not move the iterator.
      moMoveOnMatch,    // If sequence is matched, iterator is moved past it
      moBackTrack       // Move iterator backwards and match sequence forwards.
    );

  private
    FGlyphs: TList<TPascalTypeGlyph>;
    FLanguage: TTableType;
    FDirection: TPascalTypeDirection;
    FScript: TTableType;
    FFeatures: TPascalTypeFeatures;
    FLigatureID: integer;
    FOptions: TShaperOptions;
    FClusterLevel: TClusterLevel;
    FInvisibleGlyph: TGlyphID;

  private
    function GetGlyph(Index: integer): TPascalTypeGlyph;
    function GetCount: integer;
    function GetDirection: TPascalTypeDirection;
    function GetFeatures: PPascalTypeFeatures;
    procedure AdjustGlyphIndices(Index, Delta: integer);

  protected
    procedure ApplyVariation(AGlyph: TPascalTypeGlyph; const AValueRecord: TOpenTypeValueRecord); virtual;
    function GetGlyphClassID(AGlyph: TPascalTypeGlyph): integer; virtual;
    function GetMarkAttachmentType(AGlyph: TPascalTypeGlyph): integer; virtual;
    function IsInMarkFilteringSet(AGlyph: TPascalTypeGlyph; ASetIndex: integer): boolean; virtual;

  protected
    class function GetGlyphClass: TPascalTypeGlyphClass; virtual;
    function CreateGlyph(AOwner: TPascalTypeGlyphString): TPascalTypeGlyph; virtual;

  public
    constructor Create(const ACodePoints: TPascalTypeCodePoints; AClusterLevel: TClusterLevel);
    destructor Destroy; override;

    function Add: TPascalTypeGlyph; overload;
    function Add(ACluster: integer): TPascalTypeGlyph; overload;
    function Insert(Index: integer): TPascalTypeGlyph; overload;
    function Insert(Index: integer; ACluster: integer): TPascalTypeGlyph; overload;
    procedure Delete(Index: integer; Len: integer = 1);
    procedure Move(OldIndex, NewIndex: integer);
    function IndexOf(AGlyph: TPascalTypeGlyph): integer;
    procedure Reverse;

    function AsString: TGlyphString; overload;
    function AsString(Mapper: TGlyphMapperDelegate): TGlyphString; overload;

    function Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString; AOptions: TMatchOptions): boolean; overload;
    function Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString; out ALastMatchedIndex: integer; AOptions: TMatchOptions): boolean; overload;
    function Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString; Mapper: TGlyphMapperDelegate = nil; AOptions: TMatchOptions = []): boolean; overload;
    function Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString; out ALastMatchedIndex: integer; Mapper: TGlyphMapperDelegate = nil; AOptions: TMatchOptions = []): boolean; overload;

    procedure ApplyAnchor(MarkAnchor, BaseAnchor: TOpenTypeAnchor; MarkIndex, BaseIndex: integer);
    procedure FixupMarkAttachments;
    procedure FixupCursiveAttachments;
    // MergeClusters: Assign the lowest cluster ID of the glyphs in the range to all the glyphs in the range.
    // This is typically used after substitution has been performed on a sequence; MergeClusters is used to
    // ensure that all glyphs covered by the sequence end up with the same cluster ID.
    procedure MergeClusters(StartIndex, EndIndex: integer);

    procedure SetLength(ALen: integer); deprecated 'Unused';

    function GetNextLigatureID: integer;

    procedure HideDefaultIgnorables; virtual;

    function GetEnumerator: TEnumerator<TPascalTypeGlyph>;
    function CreateIterator: TPascalTypeGlyphIterator; virtual;

    property Count: integer read GetCount;
    property Glyphs[Index: integer]: TPascalTypeGlyph read GetGlyph; default;

    // Context
    property Script: TTableType read FScript write FScript;
    property Language: TTableType read FLanguage write FLanguage;
    property Direction: TPascalTypeDirection read GetDirection write FDirection;
    property Options: TShaperOptions read FOptions write FOptions;
    property ClusterLevel: TClusterLevel read FClusterLevel;
    property InvisibleGlyph: TGlyphID read FInvisibleGlyph write FInvisibleGlyph;

    // Features enabled for the string during shaping. Only used during shaping.
    // Note that the property is a pointer. This is so we can access the feature
    // list by reference instead of by value.
    property PlanFeatures: PPascalTypeFeatures read GetFeatures;
  end;


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

implementation

uses
  System.Math,
  PascalType.Tables.OpenType.Lookup,
  PascalType.Tables.OpenType.ClassDefinition;

//------------------------------------------------------------------------------
//
//              TPascalTypeGlyph
//
//------------------------------------------------------------------------------
constructor TPascalTypeGlyph.Create(AGlyphString: TPascalTypeGlyphString);
begin
  Assert(AGlyphString <> nil);

  inherited Create;

  FGlyphString := AGlyphString;

  FLigatureID := -1;
  FLigatureComponent := -1;
  FMarkAttachment := -1;
  FCursiveAttachment := -1;
  FAlternateIndex := -1;
end;

function TPascalTypeGlyph.GetUserFeatures: PPascalTypeFeatures;
begin
  Result := @FUserFeatures;
end;

function TPascalTypeGlyph.GetPlanFeatures: PPascalTypeFeatures;
begin
  Result := @FPlanFeatures;
end;

function TPascalTypeGlyph.GetIndex: integer;
begin
  Result := FGlyphString.IndexOf(Self);
end;

procedure TPascalTypeGlyph.SetGlyphID(const Value: TGlyphID);
begin
  FIsSubstituted := True;

  if (GlyphID = Value) then
    exit;

  FGlyphID := Value;

  var ClassID := GlyphString.GetGlyphClassID(Self);

  FIsBase := (ClassID = GlyphClassBase);
  FIsLigature := (ClassID = GlyphClassLigature);
  FIsMark := (ClassID = GlyphClassMark);

  FMarkAttachmentType := GlyphString.GetMarkAttachmentType(Self);
end;

procedure TPascalTypeGlyph.SetIndex(const Value: integer);
begin
  FGlyphString.Move(GetIndex, Value);
end;

function TPascalTypeGlyph.AllIsMark: boolean;
var
  CodePoint: TPascalTypeCodePoint;
begin
  // Uses Unicode categorization but is only used by TPascalTypeGlyph itself

  if (Length(FCodePoints) = 0) then
    Exit(False);

  for CodePoint in FCodePoints do
    if (not PascalTypeUnicode.IsGraphemeExtendEx(CodePoint)) then
      Exit(False);

  Result := True;
end;

procedure TPascalTypeGlyph.ApplyAnchor(MarkAnchor, BaseAnchor: TOpenTypeAnchor; BaseIndex: integer);
var
  MarkPos, BasePos: TAnchorPoint;
begin
  MarkPos := MarkAnchor.Position;
  BasePos := BaseAnchor.Position;

  XOffset := BasePos.X - MarkPos.X;
  YOffset := BasePos.Y - MarkPos.Y;

  MarkAttachment := BaseIndex;
end;

procedure TPascalTypeGlyph.ApplyPositioning(const AValueRecord: TOpenTypeValueRecord);
begin
  Inc(FXOffset, AValueRecord.xPlacement);
  Inc(FYOffset, AValueRecord.yPlacement);
  Inc(FXAdvance, AValueRecord.xAdvance);
  Inc(FYAdvance, AValueRecord.yAdvance);

  FGlyphString.ApplyVariation(Self, AValueRecord);
end;

procedure TPascalTypeGlyph.ApplyPositioningRTL(SecondGlyph: TPascalTypeGlyph; const FirstValue, SecondValue: TOpenTypeValueRecord);
begin
  // For RTL, the advance adjustment of the first glyph affects the gap
  // to the preceding glyph visually. To affect the gap between the
  // two glyphs of the pair, we must apply it to the second glyph's advance.
  Inc(FXOffset, FirstValue.xPlacement);
  Inc(FYOffset, FirstValue.yPlacement);
  Inc(FXAdvance, SecondValue.xAdvance);
  Inc(FYAdvance, SecondValue.yAdvance);

  Inc(SecondGlyph.FXOffset, SecondValue.xPlacement);
  Inc(SecondGlyph.FYOffset, SecondValue.yPlacement);
  Inc(SecondGlyph.FXAdvance, FirstValue.xAdvance);
  Inc(SecondGlyph.FYAdvance, FirstValue.yAdvance);

  var TempFirst := FirstValue;
  TempFirst.xAdvVarIndex := SecondValue.xAdvVarIndex;
  TempFirst.yAdvVarIndex := SecondValue.yAdvVarIndex;

  var TempSecond := SecondValue;
  TempSecond.xAdvVarIndex := FirstValue.xAdvVarIndex;
  TempSecond.yAdvVarIndex := FirstValue.yAdvVarIndex;

  FGlyphString.ApplyVariation(Self, TempFirst);
  FGlyphString.ApplyVariation(SecondGlyph, TempSecond);
end;

procedure TPascalTypeGlyph.ApplyVariation(const AValueRecord: TOpenTypeValueRecord);
begin
  // Deprecated. Do nothing.
end;

procedure TPascalTypeGlyph.Assign(Source: TPascalTypeGlyph);
begin
  FCodePoints := Source.FCodePoints;
  FGlyphID := Source.FGlyphID;
  FCluster := Source.Cluster;
end;


//------------------------------------------------------------------------------
//
//              TPascalTypeGlyphString
//
//------------------------------------------------------------------------------
constructor TPascalTypeGlyphString.Create(const ACodePoints: TPascalTypeCodePoints; AClusterLevel: TClusterLevel);
begin
  inherited Create;

  FOptions := PascalTypeDefaultOptions;
  FClusterLevel := AClusterLevel;
  FInvisibleGlyph := GlyphNotDef;

  FGlyphs := TObjectList<TPascalTypeGlyph>.Create;
  FGlyphs.Capacity := Length(ACodePoints);

  var Cluster := 0;
  var LastCodePoint := TPascalTypeCodePoint(0);
  var RICount := 0;

  for var i := 0 to High(ACodePoints) do
  begin
    var CodePoint := ACodePoints[i];

    if (FClusterLevel in [clLevel1, clLevel2]) then
      Cluster := i
    else
    begin
      var ShouldBreak := (i <> 0);

      if (ShouldBreak) then
      begin
        (*
        ** UAX #29
        ** Unicode Text Segmentation
        ** https://www.unicode.org/reports/tr29/
        *)

        // GB3: CR x LF
        if (LastCodePoint = $000D) and (CodePoint = $000A) then
          ShouldBreak := False
        else
        // GB4: (Control | CR | LF) ÷
        if (not PascalTypeUnicode.IsGraphemeExtendEx(LastCodePoint)) and
           (PascalTypeUnicode.IsControl(LastCodePoint) or (LastCodePoint = $000D) or (LastCodePoint = $000A)) then
          ShouldBreak := True
        else
        // GB5: ÷ (Control | CR | LF)
        if (not PascalTypeUnicode.IsGraphemeExtendEx(CodePoint)) and
           (PascalTypeUnicode.IsControl(CodePoint) or (CodePoint = $000D) or (CodePoint = $000A)) then
          ShouldBreak := True
        else
        // GB6: L x (L | V | LV | LVT)
        if (Hangul.IsL(LastCodePoint)) and (Hangul.IsL(CodePoint) or Hangul.IsV(CodePoint) or Hangul.IsHangulLV(CodePoint) or Hangul.IsHangul(CodePoint)) then
          ShouldBreak := False
        else
        // GB7: (LV | V) x (V | T)
        if (Hangul.IsHangulLV(LastCodePoint) or Hangul.IsV(LastCodePoint)) and (Hangul.IsV(CodePoint) or Hangul.IsT(CodePoint)) then
          ShouldBreak := False
        else
        // GB8: (LVT | T) x T
        if ((Hangul.IsHangul(LastCodePoint) and (not Hangul.IsHangulLV(LastCodePoint))) or Hangul.IsT(LastCodePoint)) and (Hangul.IsT(CodePoint)) then
          ShouldBreak := False
        else
        // GB9: x (Extend | ZWJ)
        // GB9a: x SpacingMark
        if (PascalTypeUnicode.IsGraphemeExtendEx(CodePoint)) then
          ShouldBreak := False
        else
        // GB9b: Prepend x
        if (PascalTypeUnicode.IsPrependedQuotationMark(LastCodePoint)) then
          ShouldBreak := False
        else
        // GB11: Emoji ZWJ (simplified)
        if (LastCodePoint = PascalTypeUnicode.cpZWJ) and (PascalTypeUnicode.IsExtendedPictographic(CodePoint)) then
          ShouldBreak := False
        else
        // GB12, GB13: Regional Indicator
        if (PascalTypeUnicode.IsRegionalIndicator(LastCodePoint)) and (PascalTypeUnicode.IsRegionalIndicator(CodePoint)) then
        begin
          if (RICount mod 2 = 1) then
            ShouldBreak := False;
        end;
      end;

      if (ShouldBreak) then
        Cluster := i;

      if (PascalTypeUnicode.IsRegionalIndicator(CodePoint)) then
      begin
        if (ShouldBreak) then
          RICount := 1
        else
          Inc(RICount);
      end else
        RICount := 0;
    end;

    var Glyph := Add(Cluster);
    Glyph.CodePoints := [CodePoint];
    LastCodePoint := CodePoint;
  end;
end;

destructor TPascalTypeGlyphString.Destroy;
begin
  FGlyphs.Free;
  inherited;
end;

function TPascalTypeGlyphString.CreateGlyph(AOwner: TPascalTypeGlyphString): TPascalTypeGlyph;
begin
  Result := GetGlyphClass.Create(AOwner);
end;

function TPascalTypeGlyphString.CreateIterator: TPascalTypeGlyphIterator;
begin
  Result := TPascalTypeGlyphIterator.Create(Self);
end;

class function TPascalTypeGlyphString.GetGlyphClass: TPascalTypeGlyphClass;
begin
  Result := TPascalTypeGlyph;
end;

procedure TPascalTypeGlyphString.ApplyVariation(AGlyph: TPascalTypeGlyph; const AValueRecord: TOpenTypeValueRecord);
begin
  // Placeholder for TFontGlyphString override
end;

function TPascalTypeGlyphString.GetGlyphClassID(AGlyph: TPascalTypeGlyph): integer;
begin
  if (AGlyph.AllIsMark) then
    Result := GlyphClassMark
  else
  if (Length(AGlyph.CodePoints) > 1) then
    Result := GlyphClassLigature
  else
    Result := GlyphClassBase;
end;

function TPascalTypeGlyphString.GetMarkAttachmentType(AGlyph: TPascalTypeGlyph): integer;
begin
  Result := 0;
end;

function TPascalTypeGlyphString.IsInMarkFilteringSet(AGlyph: TPascalTypeGlyph; ASetIndex: integer): boolean;
begin
  Result := True;
end;

function TPascalTypeGlyphString.GetNextLigatureID: integer;
begin
  Inc(FLigatureID); // Increment before assign -> First ID is 1
  Result := FLigatureID;
end;

procedure TPascalTypeGlyphString.HideDefaultIgnorables;
begin
  if (sfRemoveDefaultIgnorables in FOptions) then
  begin
    for var i := Count - 1 downto 0 do
      // Only remove if the glyph has not been substituted.
      if (not Glyphs[i].IsSubstituted) and (Length(Glyphs[i].CodePoints) > 0) and (PascalTypeUnicode.IsDefaultIgnorableEx(Glyphs[i].CodePoints[0])) then
        Delete(i);
  end;
end;

function TPascalTypeGlyphString.Add: TPascalTypeGlyph;
begin
  Result := CreateGlyph(Self);
  FGlyphs.Add(Result);
end;

function TPascalTypeGlyphString.Add(ACluster: integer): TPascalTypeGlyph;
begin
  Result := Add;
  Result.Cluster := ACluster;
end;

procedure TPascalTypeGlyphString.Delete(Index, Len: integer);
begin
  var Count := 0;
  while (Len > 0) and (Index < FGlyphs.Count) do
  begin
    FGlyphs.Delete(Index);
    Dec(Len);
    Dec(Count);
  end;

  if (Count < 0) then
    AdjustGlyphIndices(Index, Count);
end;

procedure TPascalTypeGlyphString.AdjustGlyphIndices(Index, Delta: integer);
begin
  if (Delta = 0) then
    exit;

  for var Glyph in FGlyphs do
  begin
    if (Delta < 0) then
    begin

      // Deletion of glyphs in range [Index..Index + Abs(Delta))
      if (Glyph.MarkAttachment >= Index) and (Glyph.MarkAttachment < Index - Delta) then
        Glyph.MarkAttachment := -1
      else
      if (Glyph.MarkAttachment >= Index - Delta) then
        Glyph.MarkAttachment := Glyph.MarkAttachment + Delta;

      if (Glyph.CursiveAttachment >= Index) and (Glyph.CursiveAttachment < Index - Delta) then
        Glyph.CursiveAttachment := -1
      else
      if (Glyph.CursiveAttachment >= Index - Delta) then
        Glyph.CursiveAttachment := Glyph.CursiveAttachment + Delta;

    end else
    if (Delta > 0) then
    begin

      // Insertion of glyphs at Index
      if (Glyph.MarkAttachment >= Index) then
        Glyph.MarkAttachment := Glyph.MarkAttachment + Delta;

      if (Glyph.CursiveAttachment >= Index) then
        Glyph.CursiveAttachment := Glyph.CursiveAttachment + Delta;

    end;
  end;
end;

function TPascalTypeGlyphString.IndexOf(AGlyph: TPascalTypeGlyph): integer;
begin
  Result := FGlyphs.IndexOf(AGlyph);
end;

function TPascalTypeGlyphString.Insert(Index: integer): TPascalTypeGlyph;
begin
  if (Index > FGlyphs.Count) then
    ErrorArgumentOutOfRange(Index, FGlyphs.Count, FGlyphs);

  AdjustGlyphIndices(Index, 1);

  Result := CreateGlyph(Self);
  FGlyphs.Insert(Index, Result);
end;

function TPascalTypeGlyphString.Insert(Index: integer; ACluster: integer): TPascalTypeGlyph;
begin
  Result := Insert(Index);
  Result.Cluster := ACluster;
end;

function TPascalTypeGlyphString.Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString;
  out ALastMatchedIndex: integer; Mapper: TGlyphMapperDelegate; AOptions: TMatchOptions): boolean;
var
  Iterator: TPascalTypeGlyphIterator;
  Index: integer;
begin
  ALastMatchedIndex := -1;

  if (AIterator.EOF) then
    Exit(False);

  if (Length(ASequence) = 0) then
    Exit(True);

  Iterator := AIterator.Clone;

  // Note that offset is always in logical direction; moBackTrack does not reverse it
  if (AOffset <> 0) then
    if (Iterator.Next(AOffset) = -1) then
      Exit(False);

  if (moBackTrack in AOptions) then
  begin
    // If the start of the sequence is past the start of our string then there can be no match
    if (AIterator.Index - Length(ASequence) + 1 < 0) then
      Exit(False);
  end else
  begin
    // If the end of the sequence is past the end of our string then there can be no match
    if (AIterator.Index + Length(ASequence) > FGlyphs.Count) then
      Exit(False);
  end;

  for Index := 0 to High(ASequence) do
  begin
    if (moSkipFirst in AOptions) then
    begin
      Exclude(AOptions, moSkipFirst);
      continue;
    end;

    if (Iterator.Glyph = nil) then
      Exit(False);

    var GlyphID := Iterator.Glyph.GlyphID;
    if (Assigned(Mapper)) then
      GlyphID := Mapper(GlyphID);

    if (GlyphID <> ASequence[Index]) then
      Exit(False);

    ALastMatchedIndex := Iterator.Index;

    if (moBackTrack in AOptions) then
      Iterator.Previous
    else
      Iterator.Next;
  end;

  if (moMoveOnMatch in AOptions) then
    AIterator.Index := Iterator.Index;

  Result := True;
end;

function TPascalTypeGlyphString.Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString;
  Mapper: TGlyphMapperDelegate; AOptions: TMatchOptions): boolean;
var
  LastMatchedIndex: integer;
begin
  Result := Match(AIterator, AOffset, ASequence, LastMatchedIndex, Mapper, AOptions);
end;

function TPascalTypeGlyphString.Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString;
  AOptions: TMatchOptions): boolean;
var
  LastMatchedIndex: integer;
begin
  Result := Match(AIterator, AOffset, ASequence, LastMatchedIndex, nil, AOptions);
end;

function TPascalTypeGlyphString.Match(var AIterator: TPascalTypeGlyphIterator; AOffset: integer; const ASequence: TGlyphString;
  out ALastMatchedIndex: integer; AOptions: TMatchOptions): boolean;
begin
  Result := Match(AIterator, AOffset, ASequence, ALastMatchedIndex, nil, AOptions);
end;

procedure TPascalTypeGlyphString.Move(OldIndex, NewIndex: integer);

  function AdjustedIndex(Index: integer): integer;
  begin
    if (Index = -1) then
      Exit(-1);

    if (Index = OldIndex) then
      Exit(NewIndex);

    if (OldIndex < NewIndex) then
    begin
      if (Index > OldIndex) and (Index < NewIndex) then
        Result := Index-1
      else
        Result := Index;
    end else
    begin
      if (Index > NewIndex) and (Index < OldIndex) then
        Result := Index+1
      else
        Result := Index;
    end;
  end;

begin
  if (OldIndex = NewIndex) then
    exit;

  for var Glyph in FGlyphs do
  begin
    Glyph.MarkAttachment := AdjustedIndex(Glyph.MarkAttachment);
    Glyph.CursiveAttachment := AdjustedIndex(Glyph.CursiveAttachment);
  end;

  FGlyphs.Move(OldIndex, NewIndex);
end;

procedure TPascalTypeGlyphString.Reverse;

  procedure AdjustGlyph(Glyph: TPascalTypeGlyph);
  begin
    // Adjust glyph indices
    if (Glyph.FMarkAttachment <> -1) then
      Glyph.FMarkAttachment := FGlyphs.Count - Glyph.FMarkAttachment - 1;

    if (Glyph.FCursiveAttachment <> -1) then
      Glyph.FCursiveAttachment := FGlyphs.Count - Glyph.FCursiveAttachment - 1;
  end;

begin
  for var OldIndex := 0 to FGlyphs.Count div 2 - 1 do
  begin
    var NewIndex := FGlyphs.Count-OldIndex-1;
    FGlyphs.Exchange(OldIndex, NewIndex);
  end;

  for var Glyph in FGlyphs do
    AdjustGlyph(Glyph);
end;

function TPascalTypeGlyphString.GetEnumerator: TEnumerator<TPascalTypeGlyph>;
begin
  Result := FGlyphs.GetEnumerator;
end;

function TPascalTypeGlyphString.GetFeatures: PPascalTypeFeatures;
begin
  Result := @FFeatures;
end;

function TPascalTypeGlyphString.GetGlyph(Index: integer): TPascalTypeGlyph;
begin
  if (Index >= 0) then
    Result := FGlyphs[Index]
  else
    // Iterator returns -1 on EOF, so we return nil. That way the caller
    // can either test the iterator index against -1 or test the glyph
    // against nil.
    Result := nil;
end;

function TPascalTypeGlyphString.GetCount: integer;
begin
  Result := FGlyphs.Count;
end;

function TPascalTypeGlyphString.GetDirection: TPascalTypeDirection;
var
  UnicodeScript: TUnicodeScript;
begin
  Result := FDirection;

  if (Result = dirDefault) then
  begin
    UnicodeScript := PascalTypeUnicode.ISO15924ToScript(FScript.AsString);

    if PascalTypeUnicode.IsRightToLeft(UnicodeScript) then
      Result := dirRightToLeft
    else
      Result := dirLeftToRight;
  end;
end;

procedure TPascalTypeGlyphString.SetLength(ALen: integer);
begin
  while (FGlyphs.Count > ALen) do
    FGlyphs.Delete(FGlyphs.Count-1);

  while (FGlyphs.Count < ALen) do
    Add;
end;

function TPascalTypeGlyphString.AsString: TGlyphString;
begin
  System.SetLength(Result, FGlyphs.Count);
  for var i := 0 to FGlyphs.Count-1 do
    Result[i] := FGlyphs[i].GlyphID;
end;

function TPascalTypeGlyphString.AsString(Mapper: TGlyphMapperDelegate): TGlyphString;
begin
  System.SetLength(Result, FGlyphs.Count);
  for var i := 0 to FGlyphs.Count-1 do
    Result[i] := Mapper(FGlyphs[i].GlyphID);
end;

procedure TPascalTypeGlyphString.ApplyAnchor(MarkAnchor, BaseAnchor: TOpenTypeAnchor; MarkIndex, BaseIndex: integer);
begin
  FGlyphs[MarkIndex].ApplyAnchor(MarkAnchor, BaseAnchor, BaseIndex);
end;

procedure TPascalTypeGlyphString.FixupMarkAttachments;
begin
  for var i := 0 to Count - 1 do
  begin
    var Glyph := GetGlyph(i);

    if (Glyph.MarkAttachment = -1) then
      continue;

    var MarkAttachmentGlyph := GetGlyph(Glyph.MarkAttachment);

    Glyph.XOffset := Glyph.XOffset + MarkAttachmentGlyph.XOffset;
    Glyph.YOffset := Glyph.YOffset + MarkAttachmentGlyph.YOffset;

    if (Direction <> dirRightToLeft) then
    begin
      for var j := Glyph.MarkAttachment to i - 1 do
      begin
        Glyph.XOffset := Glyph.XOffset - GetGlyph(j).XAdvance;
        Glyph.YOffset := Glyph.YOffset - GetGlyph(j).YAdvance;
      end;
    end else
    begin
      for var j := Glyph.MarkAttachment + 1 to i do
      begin
        Glyph.XOffset := Glyph.XOffset + GetGlyph(j).XAdvance;
        Glyph.YOffset := Glyph.YOffset + GetGlyph(j).YAdvance;
      end;
    end;

    Glyph.MarkAttachment := -1; // Mark it handled so it doesn't get processed again
  end;
end;

procedure TPascalTypeGlyphString.FixupCursiveAttachments;

  procedure FixupCursiveAttachment(Glyph: TPascalTypeGlyph; Depth: integer);
  const
    // Guard against endless fixups (e.g., A attached to B, B attached to A)
    MaxCursiveRecursions = 10;
  begin
    if (Glyph.CursiveAttachment = -1) or (Depth > MaxCursiveRecursions) then
      exit;

    var CursiveAttachmentGlyph := GetGlyph(Glyph.CursiveAttachment);
    Glyph.CursiveAttachment := -1; // Mark it handled so it doesn't get processed again in the next stage

    FixupCursiveAttachment(CursiveAttachmentGlyph, Depth + 1);

    Glyph.XOffset := Glyph.XOffset + CursiveAttachmentGlyph.XOffset;
    Glyph.YOffset := Glyph.YOffset + CursiveAttachmentGlyph.YOffset;
  end;

begin
  for var Glyph in Self do
    FixupCursiveAttachment(Glyph, 0);
end;

procedure TPascalTypeGlyphString.MergeClusters(StartIndex, EndIndex: integer);
begin
  if (FClusterLevel in [clLevel2, clLevel3]) then
    exit;

  if (StartIndex >= EndIndex) or (StartIndex < 0) or (EndIndex >= FGlyphs.Count) then
    exit;

  // 1. Find the min/max cluster IDs in the initial range
  var MinCluster := FGlyphs[StartIndex].Cluster;
  var MaxCluster := MinCluster;
  for var i := StartIndex + 1 to EndIndex do
  begin
    if (FGlyphs[i].Cluster < MinCluster) then
      MinCluster := FGlyphs[i].Cluster;

    if (FGlyphs[i].Cluster > MaxCluster) then
      MaxCluster := FGlyphs[i].Cluster;
  end;

  if (MinCluster = MaxCluster) then
    exit;

  // 2. Extend start to include all glyphs sharing the same cluster ID as the first glyph
  var StartCluster := FGlyphs[StartIndex].Cluster;
  while (StartIndex > 0) and (FGlyphs[StartIndex - 1].Cluster = StartCluster) do
    Dec(StartIndex);

  // 3. Extend end to include all glyphs sharing the same cluster ID as the last glyph
  var EndCluster := FGlyphs[EndIndex].Cluster;
  while (EndIndex < FGlyphs.Count - 1) and (FGlyphs[EndIndex + 1].Cluster = EndCluster) do
    Inc(EndIndex);

  // 4. Set the cluster ID of all glyphs in the expanded range to the minimum
  for var i := StartIndex to EndIndex do
    FGlyphs[i].Cluster := MinCluster;
end;

//------------------------------------------------------------------------------
//
//              TPascalTypeGlyphIterator
//
//------------------------------------------------------------------------------
constructor TPascalTypeGlyphIterator.Create(const AGlyphString: TPascalTypeGlyphString);
begin
  FGlyphString := AGlyphString;
  Reset;
end;

function TPascalTypeGlyphIterator.Clone: TPascalTypeGlyphIterator;
begin
  Result := TPascalTypeGlyphIterator.Create(FGlyphString);
  Result.FIndex := FIndex;
  Result.FIgnoreDefaultIgnorables := FIgnoreDefaultIgnorables;
  Result.ResetFlags(FLookupFlags, FMarkFilteringSet, FMarkAttachmentFilter);
end;

function TPascalTypeGlyphIterator.GetEnumerator: TEnumerator<integer>;
begin
  Result := nil; // TODO
end;

function TPascalTypeGlyphIterator.GetEOF: boolean;
begin
  Result := (FIndex = -1) or (FIndex >= FGlyphString.Count); // Check Count in case string was modified
end;

function TPascalTypeGlyphIterator.GetGlyph: TPascalTypeGlyph;
begin
  if (FIndex <> -1) and (FIndex < FGlyphString.Count) then // Check Count in case string was modified
    Result := FGlyphString[FIndex]
  else
    Result := nil;
end;

function TPascalTypeGlyphIterator.Next(AIncrement: integer; AApplyIgnoreDefaultIgnorables: boolean): integer;
begin
  Result := Peek(AIncrement, AApplyIgnoreDefaultIgnorables);
  FIndex := Result;
end;

function TPascalTypeGlyphIterator.Peek(AIncrement: integer; AApplyIgnoreDefaultIgnorables: boolean): integer;
var
  Direction: integer;
begin
  if (FIndex >= FGlyphString.Count) then // Check Count in case string was modified
    FIndex := -1;

  Result := FIndex;

  if (AIncrement = 0) then
    Exit;

  if (AIncrement > 0) then
    Direction := 1
  else
    Direction := -1;

  while (AIncrement <> 0) and (Result >= 0) and (Result < FGlyphString.Count) do
  begin
    Inc(Result, Direction);
    while (Result >= 0) and (Result < FGlyphString.Count) and ShouldIgnore(FGlyphString[Result], AApplyIgnoreDefaultIgnorables) do
      Inc(Result, Direction);

    Dec(AIncrement, Direction);
  end;

  if (Result < 0) or (Result >= FGlyphString.Count) then
    Result := -1;
end;

function TPascalTypeGlyphIterator.PeekGlyph(AIncrement: integer): TPascalTypeGlyph;
var
  Index: integer;
begin
  Index := Peek(AIncrement);
  if (Index <> -1) then
    Result := FGlyphString[Index]
  else
    Result := nil;
end;

function TPascalTypeGlyphIterator.Previous(AIncrement: integer; AApplyIgnoreDefaultIgnorables: boolean): integer;
begin
  Result := Peek(-AIncrement, AApplyIgnoreDefaultIgnorables);
  FIndex := Result;
end;

procedure TPascalTypeGlyphIterator.Reset(ALookupFlags: Word; AMarkFilteringSet: integer);
begin
  SetIndex(0);
  ResetFlags(ALookupFlags, AMarkFilteringSet);
end;

procedure TPascalTypeGlyphIterator.ResetFlags(ALookupFlags: Word; AMarkFilteringSet, AMarkAttachmentFilter: integer);
begin
  FLookupFlags := ALookupFlags;
  FMarkFilteringSet := AMarkFilteringSet;

  if (AMarkAttachmentFilter = -1) and ((FLookupFlags and TCustomOpenTypeLookupTable.MARK_ATTACHMENT_TYPE_MASK) <> 0) then
  begin
    FMarkAttachmentFilter := (FLookupFlags and TCustomOpenTypeLookupTable.MARK_ATTACHMENT_TYPE_MASK) shr 8;
    if (FMarkAttachmentFilter = 0) then // We just checked for this above but whatever
      FMarkAttachmentFilter := -1;
  end else
    FMarkAttachmentFilter := AMarkAttachmentFilter;
end;

procedure TPascalTypeGlyphIterator.SetIndex(const Value: integer);
begin
  if (Value >= 0) and (Value < FGlyphString.Count) then
    FIndex := Value
  else
    FIndex := -1;
end;

function TPascalTypeGlyphIterator.ShouldIgnore(AGlyph: TPascalTypeGlyph; AApplyIgnoreDefaultIgnorables: boolean): boolean;
begin
  Result :=
    ((FLookupFlags and TCustomOpenTypeLookupTable.IGNORE_BASE_GLYPHS <> 0) and (AGlyph.IsBase)) or
    ((FLookupFlags and TCustomOpenTypeLookupTable.IGNORE_LIGATURES <> 0) and (AGlyph.IsLigature)) or
    ((FLookupFlags and TCustomOpenTypeLookupTable.IGNORE_MARKS <> 0) and (AGlyph.IsMark));

  if (not Result) then
  begin
    if (AApplyIgnoreDefaultIgnorables) and (FIgnoreDefaultIgnorables) and (Length(AGlyph.CodePoints) > 0) then
    begin
      var CodePoint := AGlyph.CodePoints[0];

      // In GPOS we ignore all default ignorables
      if (PascalTypeUnicode.IsDefaultIgnorableEx(CodePoint)) then
        Exit(True);

      // Note: We do NOT ignore join control characters (ZWJ/ZWNJ) by default
      // in GSUB anymore. They must be visible to lookups that might want
      // to substitute them (e.g. 'rlig' substituting ZWJ).
      // HarfBuzz also tries every position and only skips them during
      // matching if they are not the target of the match.
    end;

    if (AGlyph.IsMark) then
    begin
      // Check Mark Filtering Set
      if (FLookupFlags and TCustomOpenTypeLookupTable.USE_MARK_FILTERING_SET <> 0) and (FMarkFilteringSet <> -1) then
        Result := not FGlyphString.IsInMarkFilteringSet(AGlyph, FMarkFilteringSet)
      else
      // Check Mark Attachment Class
      if (FMarkAttachmentFilter <> -1) then
        Result := (FMarkAttachmentFilter <> AGlyph.MarkAttachmentType);
    end;
  end;
end;

function TPascalTypeGlyphIterator.Step(AIncrement: integer): integer;
begin
  if (FIndex <> -1) then
  begin
    Inc(FIndex, AIncrement);

    if (FIndex < 0) or (FIndex >= FGlyphString.Count) then
      FIndex := -1;
  end;
  Result := FIndex;
end;

end.