PascalType.Tables.OpenType.Substitution.Ligature.pas

unit PascalType.Tables.OpenType.Substitution.Ligature;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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,
  Generics.Defaults,
  Classes,
  PascalType.Classes,
  PascalType.Types,
  PascalType.GlyphString,
  PascalType.Tables.OpenType.Lookup,
  PascalType.Tables.OpenType.Substitution;


//------------------------------------------------------------------------------
//
//              TOpenTypeSubstitutionLookupTableLigature
//
//------------------------------------------------------------------------------
// LookupType 4: Ligature Substitution
//------------------------------------------------------------------------------
// https://learn.microsoft.com/en-us/typography/opentype/spec/gsub#LS
//------------------------------------------------------------------------------
type
  TOpenTypeSubstitutionLookupTableLigature = class(TCustomOpenTypeSubstitutionLookupTable)
  public type
    TGlyphLigatureSubstitution = (
      glsInvalid        = 0,
      glsList           = 1
    );
  protected
    function GetSubTableClass(ASubFormat: Word): TOpenTypeLookupSubTableClass; override;
  public
  end;


//------------------------------------------------------------------------------
//
//              TOpenTypeSubstitutionSubTableLigatureList
//
//------------------------------------------------------------------------------
// Subtype 1: Ligature Substitution List
//------------------------------------------------------------------------------
// https://learn.microsoft.com/en-us/typography/opentype/spec/gsub#41-ligature-substitution-format-1
//------------------------------------------------------------------------------
type
  TOpenTypeSubstitutionSubTableLigatureList = class(TCustomOpenTypeSubstitutionSubTable)
  private type
    TGlyphLigature = record
      Glyph: Word;
      Components: TGlyphString;
    end;
    TGlyphLigatures = TList<TGlyphLigature>;

  private
    FLigatures: TGlyphLigatures;
    FLigatureIndex: array of integer;

  protected
    procedure DoSaveToStream(Stream: TStream); override;

  public
    constructor Create(AParent: TCustomPascalTypeTable); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    procedure LoadFromStream(Stream: TStream; Size: Cardinal = 0); override;

    function Apply(var AGlyphIterator: TPascalTypeGlyphIterator): boolean; override;

    property Ligatures: TGlyphLigatures read FLigatures;
  end;


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

implementation

uses
  System.Math,
  System.SysUtils,
  PascalType.Unicode,
  PascalType.ResourceStrings;

//------------------------------------------------------------------------------
//
//              TOpenTypeSubstitutionLookupTableLigature
//
//------------------------------------------------------------------------------
function TOpenTypeSubstitutionLookupTableLigature.GetSubTableClass(ASubFormat: Word): TOpenTypeLookupSubTableClass;
begin
  case TGlyphLigatureSubstitution(ASubFormat) of

    glsList:
      Result := TOpenTypeSubstitutionSubTableLigatureList;

  else
    Result := nil;
  end;
end;


//------------------------------------------------------------------------------
//
//              TOpenTypeSubstitutionSubTableLigatureList
//
//------------------------------------------------------------------------------
constructor TOpenTypeSubstitutionSubTableLigatureList.Create(AParent: TCustomPascalTypeTable);
begin
  inherited;
  FLigatures := TGlyphLigatures.Create;
end;

destructor TOpenTypeSubstitutionSubTableLigatureList.Destroy;
begin
  FLigatures.Free;
  inherited;
end;

procedure TOpenTypeSubstitutionSubTableLigatureList.Assign(Source: TPersistent);
var
  Ligature: TGlyphLigature;
  NewLigature: TGlyphLigature;
begin
  inherited;
  if Source is TOpenTypeSubstitutionSubTableLigatureList then
  begin
    FLigatures.Clear;

    for Ligature in TOpenTypeSubstitutionSubTableLigatureList(Source).FLigatures do
      // TGlyphLigature is a record; Add() makes a copy.
    begin
      NewLigature := Ligature;
      NewLigature.Components := Copy(Ligature.Components);
      FLigatures.Add(NewLigature);
    end;
  end;
end;

procedure TOpenTypeSubstitutionSubTableLigatureList.LoadFromStream(Stream: TStream; Size: Cardinal);
var
  StartPos: Int64;
  SavePos: Int64;
  i, j, k: integer;
  OffsetListOffsets: array of Word;
  LigatureOffsets: array of Word;
  Ligature: TGlyphLigature;
begin

  // +----------+-----------------------+--------------------------------------------+
  // | Type     | Name                  | Description                                |
  // +==========+=======================+============================================+
  // | uint16   | substFormat           | Format identifier: format = 1.             |
  // +----------+-----------------------+--------------------------------------------+
  // | Offset16 | coverageOffset        | Offset to Coverage table.                  |
  // +----------+-----------------------+--------------------------------------------+
  // | uint16   | ligSetCount           | Number of LigatureSet tables.              |
  // +----------+-----------------------+--------------------------------------------+
  // | Offset16 | ligSetOffsets[count]  | Array of offsets to LigatureSet tables.    |
  // +----------+-----------------------+--------------------------------------------+

  // ligatureSetTable: LigatureSet table.
  // +----------+-----------------------+--------------------------------------------+
  // | Type     | Name                  | Description                                |
  // +==========+=======================+============================================+
  // | uint16   | ligatureCount         | Number of Ligature tables.                 |
  // +----------+-----------------------+--------------------------------------------+
  // | Offset16 | ligatureOffsets[count]| Array of offsets to Ligature tables.       |
  // +----------+-----------------------+--------------------------------------------+

  // ligatureTable: Ligature table.
  // +----------+---------------------------+--------------------------------------------+
  // | Type     | Name                      | Description                                |
  // +==========+===========================+============================================+
  // | uint16   | ligatureGlyph             | Glyph ID of ligature to substitute.        |
  // +----------+---------------------------+--------------------------------------------+
  // | uint16   | componentCount            | Number of components in the ligature.      |
  // +----------+---------------------------+--------------------------------------------+
  // | uint16   | componentGlyphIDs[count-1]| Array of component glyph IDs.              |
  // +----------+---------------------------+--------------------------------------------+

  FLigatures.Clear;

  StartPos := Stream.Position;

  inherited;

  // check (minimum) table size
  if Stream.Position + SizeOf(Word) > Stream.Size then
    raise EPascalTypeError.Create(RCStrTableIncomplete);

  // Read list of offsets to list of offsets to ligatures
  SetLength(OffsetListOffsets, BigEndianValue.ReadWord(Stream));
  for i := 0 to High(OffsetListOffsets) do
    OffsetListOffsets[i] := BigEndianValue.ReadWord(Stream);

  SavePos := Stream.Position;

  SetLength(FLigatureIndex, Length(OffsetListOffsets));
  for i := 0 to High(OffsetListOffsets) do
  begin

    Stream.Position := StartPos + OffsetListOffsets[i];

    FLigatureIndex[i] := FLigatures.Count; // Save index to first ligature with this start component

    // Read list of offsets to ligatures,
    // Offsets are from beginning of ligatureSet table
    SetLength(LigatureOffsets, BigEndianValue.ReadWord(Stream));
    for j := 0 to High(LigatureOffsets) do
      LigatureOffsets[j] := BigEndianValue.ReadWord(Stream);

    // Read list of ligature definitions
    for j := 0 to High(LigatureOffsets) do
    begin
      Stream.Position := StartPos + OffsetListOffsets[i] + LigatureOffsets[j];

      // Read ligature glyph
      Ligature.Glyph := BigEndianValue.ReadWord(Stream);

      SetLength(Ligature.Components, BigEndianValue.ReadWord(Stream));

      if (Length(Ligature.Components) = 0) then
        // This shouldn't happen
        continue;

      // First component isn't used
      Ligature.Components[0] := 0;

      // Read remaining from ligature component list
      for k := 1 to High(Ligature.Components) do
        Ligature.Components[k] := BigEndianValue.ReadWord(Stream);

      FLigatures.Add(Ligature);
    end;

  end;

  Stream.Position := SavePos;
end;

procedure TOpenTypeSubstitutionSubTableLigatureList.DoSaveToStream(Stream: TStream);
var
  StartPos: Int64;
  OffsetListPos: Int64;
  SavePos: Int64;
  i, j, k: integer;
  OffsetListOffsets: array of Word;
  LigatureSetOffsets: array of Word;
  Ligature: TGlyphLigature;
begin
  StartPos := Stream.Position;

  inherited;

  // Number of ligature sets (should match coverage table count)
  SetLength(OffsetListOffsets, Length(FLigatureIndex));
  BigEndianValue.WriteWord(Stream, Length(OffsetListOffsets));

  OffsetListPos := Stream.Position;
  // Placeholder for OffsetListOffsets
  Stream.Seek(Length(OffsetListOffsets) * SizeOf(Word), soFromCurrent);

  for i := 0 to High(OffsetListOffsets) do
  begin
    OffsetListOffsets[i] := Stream.Position - StartPos;

    // LigatureSet table
    var StartIndex := FLigatureIndex[i];
    var EndIndex: integer;
    if (i < High(FLigatureIndex)) then
      EndIndex := FLigatureIndex[i + 1] - 1
    else
      EndIndex := FLigatures.Count - 1;

    var LigatureCount := EndIndex - StartIndex + 1;
    BigEndianValue.WriteWord(Stream, LigatureCount);

    var LigatureSetStartPos := Stream.Position - 2; // Offset from beginning of LigatureSet table
    var LigatureSetOffsetPos := Stream.Position;
    SetLength(LigatureSetOffsets, LigatureCount);

    // Placeholder for LigatureSetOffsets
    Stream.Seek(LigatureCount * SizeOf(Word), soFromCurrent);

    for j := 0 to LigatureCount - 1 do
    begin
      LigatureSetOffsets[j] := Stream.Position - LigatureSetStartPos;
      Ligature := FLigatures[StartIndex + j];

      BigEndianValue.WriteWord(Stream, Ligature.Glyph);
      BigEndianValue.WriteWord(Stream, Length(Ligature.Components));
      for k := 1 to High(Ligature.Components) do
        BigEndianValue.WriteWord(Stream, Ligature.Components[k]);
    end;

    // Save LigatureSetOffsets
    SavePos := Stream.Position;
    Stream.Position := LigatureSetOffsetPos;
    for j := 0 to High(LigatureSetOffsets) do
      BigEndianValue.WriteWord(Stream, LigatureSetOffsets[j]);
    Stream.Position := SavePos;
  end;

  SavePos := Stream.Position;

  // Save OffsetListOffsets
  Stream.Position := OffsetListPos;
  for i := 0 to High(OffsetListOffsets) do
    BigEndianValue.WriteWord(Stream, OffsetListOffsets[i]);

  Stream.Position := SavePos;
end;

function TOpenTypeSubstitutionSubTableLigatureList.Apply(var AGlyphIterator: TPascalTypeGlyphIterator): boolean;

  procedure UpdateLigatureState(Glyph: TPascalTypeGlyph; const MatchedIndices: TArray<integer>);
  var
    IsBaseLigature: boolean;
    IsMarkLigature: boolean;
    IsLigature: boolean;
    i: integer;
    NewLigatureID: integer;
    LastLigatureID: integer;
    LastComponentCount: integer;
    ComponentCount: integer;
    MatchIndex: integer;
    GlyphLigatureComponent: integer;
    LigatureComponent: integer;
  begin
    // Note: This is based on the corresponding code in Harfbuzz. The code in
    // FontKit is a bit different, and slightly less complex, but buggy.

    // From Harfbuzz:
    // - If it *is* a mark ligature, we don't allocate a new ligature id, and leave
    //   the ligature to keep its old ligature id.  This will allow it to attach to
    //   a base ligature in GPOS.  Eg. if the sequence is: LAM,LAM,SHADDA,FATHA,HEH,
    //   and LAM,LAM,HEH for a ligature, they will leave SHADDA and FATHA with a
    //   ligature id and component value of 2.  Then if SHADDA,FATHA form a ligature
    //   later, we don't want them to lose their ligature id/component, otherwise
    //   GPOS will fail to correctly position the mark ligature on top of the
    //   LAM,LAM,HEH ligature. See https://bugzilla.gnome.org/show_bug.cgi?id=676343
    //
    // - If a ligature is formed of components, some of which are also ligatures
    //   themselves, and those ligature components had marks attached to *their*
    //   components, we have to attach the marks to the new ligature component
    //   positions!  Now *that*'s tricky!  And these marks may be following the
    //   last component of the whole sequence, so we should loop forward looking
    //   for them and update them.
    //
    //   Eg. the sequence is LAM,LAM,SHADDA,FATHA,HEH, and the font first forms a
    //   'calt' ligature of LAM,HEH, leaving the SHADDA and FATHA with a ligature
    //   id and component == 1.  Now, during 'liga', the LAM and the LAM-HEH ligature
    //   form a LAM-LAM-HEH ligature.  We need to reassign the SHADDA and FATHA to
    //   the new ligature with a component value of 2.
    //
    //   This in fact happened to a font...  See https://bugzilla.gnome.org/show_bug.cgi?id=437633

    IsBaseLigature := AGlyphIterator.GlyphString[MatchedIndices[0]].IsMark;
    IsMarkLigature := True;
    for MatchIndex in MatchedIndices do
    begin
      IsMarkLigature := AGlyphIterator.GlyphString[MatchIndex].IsMark;
      if (not IsMarkLigature) then
      begin
        IsBaseLigature := False;
        break;
      end;
    end;

    IsLigature := (not IsBaseLigature) and (not IsMarkLigature);

    if (IsLigature) then
      NewLigatureID := AGlyphIterator.GlyphString.GetNextLigatureID
    else
      NewLigatureID := -1;

    LastLigatureID := Glyph.LigatureID;
    LastComponentCount := Length(Glyph.CodePoints);
    ComponentCount := LastComponentCount;

    if (IsLigature) then
      Glyph.LigatureID := NewLigatureID;

    // Note: The following code assumes that we are using an iterator that skips certain glyphs
    // (which is what Harfbuzz and FontKit does). I'm not doing that (yet) so the operation
    // is pretty pointless. However, I've chosed to include the code in case we later introduce
    // an iterator.
    // Hurray! We're now using a skipping iterator.

    // Set LigatureID and LigatureComponent on glyphs that were skipped in the matched sequence.
    // This allows GPOS to attach marks to the correct ligature components.
    var Iterator := AGlyphIterator.Clone;
    Iterator.Step;

    for i := 1 to High(MatchedIndices) do
    begin
      MatchIndex := MatchedIndices[i];

      while (Iterator.Index < MatchIndex) and (not Iterator.EOF) do
      begin
        // Don't assign new ligature components for mark ligatures (see above)
        if (IsLigature) then
        begin
          GlyphLigatureComponent := Iterator.Glyph.LigatureComponent;
          if (GlyphLigatureComponent = -1) then
            GlyphLigatureComponent := LastComponentCount;

          LigatureComponent := ComponentCount - LastComponentCount + Min(GlyphLigatureComponent, LastComponentCount);

          Iterator.Glyph.LigatureID := NewLigatureID;
          Iterator.Glyph.LigatureComponent := LigatureComponent;
        end;

        Iterator.Step;
        // We're stepping, not skipping
        // Iterator.Next;
      end;


      if (Iterator.EOF) then
        // Is this an error condition? We surely can't continue the loop since Iterator.Glyph=nil
        break;

      LastLigatureID := Iterator.Glyph.LigatureID;
      LastComponentCount := Length(Iterator.Glyph.CodePoints);
      ComponentCount := ComponentCount + LastComponentCount;

      Iterator.Step; // Skip base glyph
    end;

    // Adjust ligature components for any marks following
    if (LastLigatureID <> -1) and (not IsMarkLigature) then
      while (not Iterator.EOF) do
      begin
        if (Iterator.Glyph.LigatureID <> LastLigatureID) then
          break;

        GlyphLigatureComponent := Iterator.Glyph.LigatureComponent;
        if (GlyphLigatureComponent = -1) then
          break;

        LigatureComponent := ComponentCount - LastComponentCount + Min(GlyphLigatureComponent, LastComponentCount);
        Iterator.Glyph.LigatureComponent := LigatureComponent;

        Iterator.Step;
      end;
  end;

begin
  // Test with :
  // - Segoe Script: ffl
  // - Arabic typesetting: ff
  // - Palatino Linotype Italic: ff

  // The coverage table contains the index of the first character of the ligature component string.
  var SubstitutionIndex := CoverageTable.IndexOfGlyph(AGlyphIterator.Glyph.GlyphID);

  if (SubstitutionIndex = -1) then
    Exit(False);

  // Ligature strings are grouped by starting character so all members of a group
  // has the same start character. The FLigatureIndex[] array contains the index
  // of the first entry in the group.

  // We found the index of the first string in the group above via the coverage table.
  // The index of the last ligature string is either...
  var LastSameStartCharIndex: integer;
  if (SubstitutionIndex < High(FLigatureIndex)) then
    // ... the index right before the first in the next group or...
    LastSameStartCharIndex := FLigatureIndex[SubstitutionIndex+1]-1
  else
    // ... the last possible index if there are no next group.
    LastSameStartCharIndex := FLigatures.Count-1;

  // Keep this outside the loop so we can reuse the allocation
  var MatchedIndices: TMatchedIndices;

  // For each ligature string...
  for var i := FLigatureIndex[SubstitutionIndex] to LastSameStartCharIndex do
  begin
    // Short-circuit: If the end of this ligature string is past our source string then there can be no match
    if (AGlyphIterator.Index + Length(FLigatures[i].Components) > AGlyphIterator.GlyphString.Count) then
      continue;

    // Compare each character in the ligature string to the source string.
    // We have already matched the first character via the coverage table so skip that.
    if (AGlyphIterator.GlyphString.Match(AGlyphIterator, FLigatures[i].Components, MatchedIndices, [moSkipFirst])) then
    begin
      // We have a match. Replace the source character with the ligature string

      var Glyph := AGlyphIterator.Glyph;

      // Save a list of the codepoints we're replacing
      var Count := 0;
      var CodePoints: TPascalTypeCodePoints;
      SetLength(CodePoints, Length(MatchedIndices));
      for var j := 0 to High(MatchedIndices) do
      begin
        var MatchedGlyph := AGlyphIterator.GlyphString[MatchedIndices[j]];

        // CodePoints might be empty if we are substituting an already substituted glyph.
        // See: TOpenTypeSubstitutionSubTableMultipleList.Apply
        if (Length(MatchedGlyph.CodePoints) > 0) then
        begin
          if (Count + Length(MatchedGlyph.CodePoints) > Length(CodePoints)) then
            SetLength(CodePoints, Count + Length(MatchedGlyph.CodePoints) * 2); // * 2 = allocate more than we need in order to reduce reallocations

          Move(MatchedGlyph.CodePoints[0], CodePoints[Count],
            Length(MatchedGlyph.CodePoints) * SizeOf(TPascalTypeCodePoint));

          Inc(Count, Length(MatchedGlyph.CodePoints));
        end;
      end;
      SetLength(CodePoints, Count);

      Glyph.IsLigated := True;
      Glyph.IsSubstituted := True;

      // Preserve metadata from the first component of the ligature
      Glyph.AssignMetadata(AGlyphIterator.GlyphString[MatchedIndices[0]]);

      // Merge clusters of components we just processed, including any we skipped
      AGlyphIterator.GlyphString.MergeClusters(MatchedIndices[0], MatchedIndices[High(MatchedIndices)]);

      UpdateLigatureState(Glyph, MatchedIndices);

      // First entry in glyph string is reused...
      Glyph.GlyphID := FLigatures[i].Glyph;
      Glyph.CodePoints := CodePoints;

      // Move bypassed ignorables (Default Ignorables) to follow the ligature.
      // We move from the last gap to the first, and from the end of each gap.
      for var k := High(MatchedIndices) - 1 downto 0 do
      begin
        var GapStart := MatchedIndices[k] + 1;
        var GapEnd := MatchedIndices[k+1] - 1;

        for var m := GapEnd downto GapStart do
        begin
          // Only move Default Ignorables (GSUB skippables)
          if AGlyphIterator.GlyphString[m].IsGSUBSkippable() then
          begin
            var Target := MatchedIndices[High(MatchedIndices)];
            AGlyphIterator.GlyphString.Move(m, Target);

            // Adjust subsequent matched indices
            for var n := 0 to High(MatchedIndices) do
              if (MatchedIndices[n] > m) and (MatchedIndices[n] <= Target) then
                Dec(MatchedIndices[n]);
          end;
        end;
      end;

      // ...Remaining matched components are deleted.
      for var j := High(MatchedIndices) downto 1 do
        AGlyphIterator.GlyphString.Delete(MatchedIndices[j], 1);

      // Advance past the ligature glyph. The moved ignorables now follow it.
      AGlyphIterator.Index := MatchedIndices[0] + 1;

      Exit(True);
    end;
  end;

  Result := False;
end;

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

initialization
  TCustomOpenTypeSubstitutionLookupTable.RegisterSubstitutionFormat(gsLigature, TOpenTypeSubstitutionLookupTableLigature);
end.