PascalType.Tables.OpenType.pas

unit PascalType.Tables.OpenType;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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
  System.Generics.Collections,
  System.Generics.Defaults,
  Classes,
  PascalType.Types,
  PascalType.Classes,
  PascalType.Tables,
  PascalType.Tables.OpenType.Coverage;

type
  TTagOffsetRecord = packed record
    Tag: TTableType;
    Offset: Word;
  end;

type
  TCustomOpenTypeNamedTable = class(TCustomPascalTypeNamedTable)
  protected
    class function GetDisplayName: string; virtual; abstract;
  public
    // DisplayName should really be a class property but since that's impossible to
    // implement using a virtual getter, we have made it a class function instead.
    // TODO : Rename GetDisplayName->DisplayName
    // property DisplayName: string read GetDisplayName;
    class function DisplayName: string;
  end;

type
  TCustomOpenTypeVersionedNamedTable = class(TCustomPascalTypeNamedTable)
  private
    FVersion: TFixedPoint;
    procedure SetVersion(const Value: TFixedPoint);
  protected
    procedure VersionChanged; virtual;
  public
    constructor Create(AParent: TCustomPascalTypeTable); override;

    procedure Assign(Source: TPersistent); override;

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

    property Version: TFixedPoint read FVersion write SetVersion;
  end;

type
  // https://learn.microsoft.com/en-us/typography/opentype/spec/gdef#mark-glyph-sets-table
  TOpenTypeMarkGlyphSetTable = class(TCustomPascalTypeTable)
  private type
    TCoverageTables = TObjectList<TCustomOpenTypeCoverageTable>;
  private
    FTableFormat: Word; // Format identifier == 1
    FCoverage   : TCoverageTables;
    function GetCoverage(Index: Integer): TCustomOpenTypeCoverageTable;
    function GetCoverageCount: Integer;
    procedure SetTableFormat(const Value: Word);
  protected
    procedure TableFormatChanged; virtual;
  public
    constructor Create(AParent: TCustomPascalTypeTable); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

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

    function IsInSet(Index: Integer; AGlyphID: Word): boolean;

    property TableFormat: Word read FTableFormat write SetTableFormat;
    property CoverageCount: Integer read GetCoverageCount;
    property Coverage[Index: Integer]: TCustomOpenTypeCoverageTable read GetCoverage;
  end;


implementation

uses
  Math, SysUtils,
  PascalType.ResourceStrings;


{ TCustomOpenTypeVersionedNamedTable }

constructor TCustomOpenTypeVersionedNamedTable.Create(AParent: TCustomPascalTypeTable);
begin
  inherited;
  FVersion := 0;
end;

procedure TCustomOpenTypeVersionedNamedTable.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TCustomOpenTypeVersionedNamedTable then
    FVersion := TCustomOpenTypeVersionedNamedTable(Source).FVersion;
end;

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

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

  // read version
  FVersion.Fixed := BigEndianValue.ReadInteger(Stream);
end;

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

  // write version
  BigEndianValue.WriteCardinal(Stream, Cardinal(Version));
end;

procedure TCustomOpenTypeVersionedNamedTable.SetVersion
  (const Value: TFixedPoint);
begin
  if (FVersion.Fract <> Value.Fract) or (FVersion.Value <> Value.Value) then
  begin
    FVersion := Value;
    VersionChanged;
  end;
end;

procedure TCustomOpenTypeVersionedNamedTable.VersionChanged;
begin
  Changed;
end;


{ TOpenTypeMarkGlyphSetTable }

constructor TOpenTypeMarkGlyphSetTable.Create(AParent: TCustomPascalTypeTable);
begin
  inherited;
  FTableFormat := 1;
  FCoverage := TCoverageTables.Create;
end;

destructor TOpenTypeMarkGlyphSetTable.Destroy;
begin
  FCoverage.Free;
  inherited;
end;

procedure TOpenTypeMarkGlyphSetTable.Assign(Source: TPersistent);
var
  i: integer;
begin
  inherited;
  if Source is TOpenTypeMarkGlyphSetTable then
  begin
    FTableFormat := TOpenTypeMarkGlyphSetTable(Source).FTableFormat;
    FCoverage.Clear;
    for i := 0 to TOpenTypeMarkGlyphSetTable(Source).FCoverage.Count - 1 do
      FCoverage.Add(TOpenTypeMarkGlyphSetTable(Source).FCoverage[i].Clone as TCustomOpenTypeCoverageTable);
  end;
end;

function TOpenTypeMarkGlyphSetTable.GetCoverage(Index: Integer): TCustomOpenTypeCoverageTable;
begin
  Result := FCoverage[Index];
end;

function TOpenTypeMarkGlyphSetTable.GetCoverageCount: Integer;
begin
  Result := FCoverage.Count;
end;

function TOpenTypeMarkGlyphSetTable.IsInSet(Index: Integer; AGlyphID: Word): boolean;
begin
  if (Index >= 0) and (Index < FCoverage.Count) then
    Result := (FCoverage[Index].IndexOfGlyph(AGlyphID) <> -1)
  else
    Result := False;
end;

procedure TOpenTypeMarkGlyphSetTable.LoadFromStream(Stream: TStream; Size: Cardinal);
var
  CoverageIndex: Integer;
  Count: Word;
  Offsets: TArray<Cardinal>;
  StartPos: Int64;
begin
  StartPos := Stream.Position;
  inherited;

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

  // read format
  FTableFormat := BigEndianValue.ReadWord(Stream);

  if FTableFormat > 1 then
    raise EPascalTypeError.Create(RCStrUnknownFormat);

  // read coverage length
  Count := BigEndianValue.ReadWord(Stream);
  SetLength(Offsets, Count);

  // check (minimum) table size
  if Stream.Position + Length(Offsets) * SizeOf(Cardinal) > Stream.Size then
    raise EPascalTypeTableIncomplete.Create(RCStrTableIncomplete);

  // read coverage offsets
  for CoverageIndex := 0 to High(Offsets) do
    Offsets[CoverageIndex] := BigEndianValue.ReadCardinal(Stream);

  FCoverage.Clear;
  for CoverageIndex := 0 to High(Offsets) do
  begin
    Stream.Position := StartPos + Offsets[CoverageIndex];
    FCoverage.Add(TCustomOpenTypeCoverageTable.CreateFromStream(Stream));
  end;
end;

procedure TOpenTypeMarkGlyphSetTable.SaveToStream(Stream: TStream);
var
  CoverageIndex: Integer;
  StartPos: Int64;
  Offsets: TArray<Cardinal>;
begin
  StartPos := Stream.Position;
  inherited;

  // write table format
  BigEndianValue.WriteWord(Stream, FTableFormat);

  // write coverage length
  BigEndianValue.WriteWord(Stream, FCoverage.Count);

  // Skip offsets for now
  SetLength(Offsets, FCoverage.Count);
  Stream.Position := Stream.Position + Length(Offsets) * SizeOf(Cardinal);

  for CoverageIndex := 0 to FCoverage.Count - 1 do
  begin
    Offsets[CoverageIndex] := Stream.Position - StartPos;
    FCoverage[CoverageIndex].SaveToStream(Stream);
  end;

  // write offsets
  Stream.Position := StartPos + SizeOf(Word) + SizeOf(Word);
  for CoverageIndex := 0 to High(Offsets) do
    BigEndianValue.WriteCardinal(Stream, Offsets[CoverageIndex]);
end;

procedure TOpenTypeMarkGlyphSetTable.SetTableFormat(const Value: Word);
begin
  if FTableFormat <> Value then
  begin
    FTableFormat := Value;
    TableFormatChanged;
  end;
end;

procedure TOpenTypeMarkGlyphSetTable.TableFormatChanged;
begin
  Changed;
end;


{ TCustomOpenTypeNamedTable }

class function TCustomOpenTypeNamedTable.DisplayName: string;
begin
  Result := GetDisplayName;
end;

end.