PascalType.Tables.OpenType.ClassDefinition.pas

unit PascalType.Tables.OpenType.ClassDefinition;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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.Types,
  PascalType.Classes,
  PascalType.Tables;


type
  TClassDefinitionFormat = (
    cdfList = 1,
    cdfRange = 2
  );

type
{$SCOPEDENUMS ON}
  TOpenTypeGlyphClass = (
    Default             = 0,    // Unassigned
    Base                = 1,    // Single character, spacing glyph
    Ligature            = 2,    // Multiple character, spacing glyph
    Mark                = 3,    // Non-spacing combining glyph
    Component           = 4     // Part of single character, spacing glyph
  );
{$SCOPEDENUMS OFF}

const
  GlyphClassDefault     = 0;    // Unassigned
  GlyphClassBase        = 1;    // Single character, spacing glyph
  GlyphClassLigature    = 2;    // Multiple character, spacing glyph
  GlyphClassMark        = 3;    // Non-spacing combining glyph
  GlyphClassComponent   = 4;    // Part of single character, spacing glyph

//------------------------------------------------------------------------------
//
//              TCustomOpenTypeClassDefinitionTable
//
//------------------------------------------------------------------------------
// https://learn.microsoft.com/en-us/typography/opentype/spec/chapter2#class-definition-table
//------------------------------------------------------------------------------
type
  TCustomOpenTypeClassDefinitionTable = class;
  TOpenTypeClassDefinitionTableClass = class of TCustomOpenTypeClassDefinitionTable;

  TCustomOpenTypeClassDefinitionTable = class abstract(TCustomPascalTypeTable)
  protected
    class function GetClassFormat: TClassDefinitionFormat; virtual; abstract;
  public
    procedure Assign(Source: TPersistent); override;

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

    function ClassByGlyphID(AGlyphID: Word): integer; virtual; abstract;

    class function ClassByFormat(AClassFormat: TClassDefinitionFormat): TOpenTypeClassDefinitionTableClass;

    property ClassFormat: TClassDefinitionFormat read GetClassFormat;
  end;


//------------------------------------------------------------------------------
//
//              TOpenTypeClassDefinitionListTable
//
//------------------------------------------------------------------------------
// Class definition table, format 1: List of Class IDs
//------------------------------------------------------------------------------
// https://learn.microsoft.com/en-us/typography/opentype/spec/chapter2#class-definition-table-format-1
//------------------------------------------------------------------------------
type
  TOpenTypeClassDefinitionListTable = class(TCustomOpenTypeClassDefinitionTable)
  private
    FStartGlyphID: Word; // First GlyphID in the list
    FClassIDArray: TArray<Word>; // Array of class IDs

  private
    function GetClassID(Index: Integer): Word;
    function GetClassCount: Integer;

  protected
    class function GetClassFormat: TClassDefinitionFormat; override;

  public
    procedure Assign(Source: TPersistent); override;

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

    function ClassByGlyphID(AGlyphID: Word): integer; override;

    property StartGlyphID: Word read FStartGlyphID write FStartGlyphID;
    property ClassCount: Integer read GetClassCount;
    property ClassID[Index: Integer]: Word read GetClassID;
  end;

  TOpenTypeClassDefinitionFormat1Table = TOpenTypeClassDefinitionListTable deprecated 'Use TOpenTypeClassDefinitionListTable instead';


//------------------------------------------------------------------------------
//
//              TOpenTypeClassDefinitionRangeTable
//
//------------------------------------------------------------------------------
// Class definition table, format 2: List of ClassID ID ranges
//------------------------------------------------------------------------------
// https://learn.microsoft.com/en-us/typography/opentype/spec/chapter2#class-definition-table-format-2
//------------------------------------------------------------------------------
type
  TOpenTypeClassDefinitionRangeTable = class(TCustomOpenTypeClassDefinitionTable)
  public type
    TClassDefinitionRangeRecord = record
      StartGlyphID: Word;       // First GlyphID in the range
      EndGlyphID: Word;         // Last GlyphID in the range
      ClassID: Word;            // Class ID of first GlyphID in range
    end;

  private class var
    FComparer: IComparer<TClassDefinitionRangeRecord>;

  private
    class destructor Destroy;

  private
    FRangeArray: TArray<TClassDefinitionRangeRecord>;

  private
    function GetRange(Index: Integer): TClassDefinitionRangeRecord;
    function GetRangeCount: Integer;

  protected
    class function GetClassFormat: TClassDefinitionFormat; override;

  public
    procedure Assign(Source: TPersistent); override;

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

    function ClassByGlyphID(AGlyphID: Word): integer; override;

    property RangeCount: Integer read GetRangeCount;
    property Range[Index: Integer]: TClassDefinitionRangeRecord read GetRange;
  end;

  TOpenTypeClassDefinitionFormat2Table = TOpenTypeClassDefinitionRangeTable deprecated 'Use TOpenTypeClassDefinitionRangeTable instead';


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

implementation

uses
  SysUtils,
  PascalType.ResourceStrings;

//------------------------------------------------------------------------------
//
//              TCustomOpenTypeClassDefinitionTable
//
//------------------------------------------------------------------------------
procedure TCustomOpenTypeClassDefinitionTable.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TCustomOpenTypeClassDefinitionTable then
    Assert(ClassFormat = TCustomOpenTypeClassDefinitionTable(Source).ClassFormat);
end;

procedure TCustomOpenTypeClassDefinitionTable.LoadFromStream(Stream: TStream; Size: Cardinal);
begin
  inherited;

  // +--------+-------------+--------------------------------------------+
  // | Type   | Name        | Description                                |
  // +========+=============+============================================+
  // | uint16 | classFormat | Format identifier.                         |
  // +--------+-------------+--------------------------------------------+

  if (TClassDefinitionFormat(BigEndianValue.ReadWord(Stream)) <> ClassFormat) then
    raise EPascalTypeError.Create('Class definition format mismatch');
end;

procedure TCustomOpenTypeClassDefinitionTable.SaveToStream(Stream: TStream);
begin
  inherited;

  BigEndianValue.WriteWord(Stream, Ord(ClassFormat));
end;

class function TCustomOpenTypeClassDefinitionTable.ClassByFormat(AClassFormat: TClassDefinitionFormat): TOpenTypeClassDefinitionTableClass;
begin
  case AClassFormat of
    cdfList:
      Result := TOpenTypeClassDefinitionListTable;

    cdfRange:
      Result := TOpenTypeClassDefinitionRangeTable;
  else
    Result := nil;
  end;
end;


//------------------------------------------------------------------------------
//
//              TOpenTypeClassDefinitionListTable
//
//------------------------------------------------------------------------------
class function TOpenTypeClassDefinitionListTable.GetClassFormat: TClassDefinitionFormat;
begin
  Result := cdfList;
end;

procedure TOpenTypeClassDefinitionListTable.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TOpenTypeClassDefinitionListTable then
  begin
    FStartGlyphID := TOpenTypeClassDefinitionListTable(Source).FStartGlyphID;
    FClassIDArray := Copy(TOpenTypeClassDefinitionListTable(Source).FClassIDArray);
  end;
end;

function TOpenTypeClassDefinitionListTable.ClassByGlyphID(AGlyphID: Word): integer;
var
  Index: integer;
begin
  Index := AGlyphID - FStartGlyphID;
  if (Index >= 0) and (Index <= High(FClassIDArray)) then
    Result := FClassIDArray[Index]
  else
    Result := GlyphClassDefault; // Glyphs not in table belong to class #0
end;

function TOpenTypeClassDefinitionListTable.GetClassID(Index: Integer): Word;
begin
  if (Index < 0) or (Index > High(FClassIDArray)) then
    raise EPascalTypeError.CreateFmt(RCStrIndexOutOfBounds, [Index]);
  Result := FClassIDArray[Index];
end;

function TOpenTypeClassDefinitionListTable.GetClassCount: Integer;
begin
  Result := Length(FClassIDArray);
end;

procedure TOpenTypeClassDefinitionListTable.LoadFromStream(Stream: TStream; Size: Cardinal);
begin
  inherited;

  // +--------+----------------------------+--------------------------------------------+
  // | Type   | Name                       | Description                                |
  // +========+============================+============================================+
  // | uint16 | classFormat                | Format identifier: format = 1.             |
  // +--------+----------------------------+--------------------------------------------+
  // | uint16 | startGlyphID               | First glyph ID in the classValueArray.     |
  // +--------+----------------------------+--------------------------------------------+
  // | uint16 | glyphCount                 | Number of glyph IDs in the classValueArray.|
  // +--------+----------------------------+--------------------------------------------+
  // | uint16 | classValueArray[glyphCount]| Array of Class IDs.                        |
  // +--------+----------------------------+--------------------------------------------+

  if Stream.Position + 4 > Stream.Size then
    raise EPascalTypeError.Create(RCStrTableIncomplete);

  FStartGlyphID := BigEndianValue.ReadWord(Stream);

  SetLength(FClassIDArray, BigEndianValue.ReadWord(Stream));

  for var i := 0 to High(FClassIDArray) do
    FClassIDArray[i] := BigEndianValue.ReadWord(Stream);
end;

procedure TOpenTypeClassDefinitionListTable.SaveToStream(Stream: TStream);
begin
  inherited;

  BigEndianValue.WriteWord(Stream, FStartGlyphID);
  BigEndianValue.WriteWord(Stream, Length(FClassIDArray));

  for var i := 0 to High(FClassIDArray) do
    BigEndianValue.WriteWord(Stream, FClassIDArray[i]);
end;


//------------------------------------------------------------------------------
//
//              TOpenTypeClassDefinitionRangeTable
//
//------------------------------------------------------------------------------
class destructor TOpenTypeClassDefinitionRangeTable.Destroy;
begin
  FComparer := nil;
end;

class function TOpenTypeClassDefinitionRangeTable.GetClassFormat: TClassDefinitionFormat;
begin
  Result := cdfRange;
end;

procedure TOpenTypeClassDefinitionRangeTable.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TOpenTypeClassDefinitionRangeTable then
    FRangeArray := Copy(TOpenTypeClassDefinitionRangeTable(Source).FRangeArray);
end;

function TOpenTypeClassDefinitionRangeTable.GetRange(Index: Integer): TClassDefinitionRangeRecord;
begin
  if (Index < 0) or (Index > High(FRangeArray)) then
    raise EPascalTypeError.CreateFmt(RCStrIndexOutOfBounds, [Index]);
  Result := FRangeArray[Index];
end;

function TOpenTypeClassDefinitionRangeTable.GetRangeCount: Integer;
begin
  Result := Length(FRangeArray);
end;

function TOpenTypeClassDefinitionRangeTable.ClassByGlyphID(AGlyphID: Word): integer;
begin
  if (FComparer = nil) then
    FComparer := TComparer<TClassDefinitionRangeRecord>.Construct(
      function(const ATableItem, ASearchItem: TClassDefinitionRangeRecord): integer
      begin
        Result := integer(ATableItem.EndGlyphID) - integer(ASearchItem.EndGlyphID);
        if (Result > 0) then
        begin
          Result := integer(ATableItem.StartGlyphID) - integer(ASearchItem.StartGlyphID);
          if (Result < 0) then
            Result := GlyphClassDefault;
        end;
      end);

  var SearchItem: TClassDefinitionRangeRecord;
  SearchItem.StartGlyphID := AGlyphID;
  SearchItem.EndGlyphID := AGlyphID;
  var Index: integer;

  if (TArray.BinarySearch<TClassDefinitionRangeRecord>(FRangeArray, SearchItem, Index, FComparer)) then
    Result := FRangeArray[Index].ClassID
  else
    Result := GlyphClassDefault; // Glyphs not in table belong to class #0
end;

procedure TOpenTypeClassDefinitionRangeTable.LoadFromStream(Stream: TStream; Size: Cardinal);
begin
  inherited;

  // +--------+----------------------------+--------------------------------------------+
  // | Type   | Name                       | Description                                |
  // +========+============================+============================================+
  // | uint16 | classFormat                | Format identifier: format = 2.             |
  // +--------+----------------------------+--------------------------------------------+
  // | uint16 | classRangeCount            | Number of ClassRangeRecords.               |
  // +--------+----------------------------+--------------------------------------------+
  // | record | classRangeRecords[count]   | Array of ClassRangeRecords-ordered by      |
  // |        |                            | startGlyphID.                              |
  // +--------+----------------------------+--------------------------------------------+
  // | record | classRangeRecord           | ClassRangeRecord.                          |
  // +========+============================+============================================+
  // | uint16 | startGlyphID               | First glyph ID in the range.               |
  // +--------+----------------------------+--------------------------------------------+
  // | uint16 | endGlyphID                 | Last glyph ID in the range.                |
  // +--------+----------------------------+--------------------------------------------+
  // | uint16 | classID                    | Applied to all glyphs in the range.        |
  // +--------+----------------------------+--------------------------------------------+

  if Stream.Position + SizeOf(Word) > Stream.Size then
    raise EPascalTypeError.Create(RCStrTableIncomplete);

  SetLength(FRangeArray, BigEndianValue.ReadWord(Stream));

  for var i := 0 to High(FRangeArray) do
  begin
    FRangeArray[i].StartGlyphID := BigEndianValue.ReadWord(Stream);
    FRangeArray[i].EndGlyphID := BigEndianValue.ReadWord(Stream);
    FRangeArray[i].ClassID := BigEndianValue.ReadWord(Stream);
  end;
end;

procedure TOpenTypeClassDefinitionRangeTable.SaveToStream(Stream: TStream);
begin
  inherited;

  BigEndianValue.WriteWord(Stream, Length(FRangeArray));

  for var i := 0 to High(FRangeArray) do
  begin
    BigEndianValue.WriteWord(Stream, FRangeArray[i].StartGlyphID);
    BigEndianValue.WriteWord(Stream, FRangeArray[i].EndGlyphID);
    BigEndianValue.WriteWord(Stream, FRangeArray[i].ClassID);
  end;
end;

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

end.