PascalType.Tables.OpenType.PostScript.CFF2.pas

unit PascalType.Tables.OpenType.PostScript.CFF2;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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 Anders Melander                     //
//                                                                            //
//  Portions created by Anders Melander are Copyright (C) 2025-2026           //
//  by Anders Melander. All Rights Reserved.                                  //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////

interface

{$I PT_Compiler.inc}

uses
  Generics.Collections,
  Classes,
  SysUtils,
  PascalType.Types,
  PascalType.Classes,
  PascalType.Tables,
  PascalType.Tables.OpenType.PostScript,
  PascalType.Tables.OpenType.PostScript.CharStrings,
  PascalType.Tables.OpenType.Common.Variation;

//------------------------------------------------------------------------------
//
//              TPascalTypeCompactFontFormat2Table
//
//------------------------------------------------------------------------------
// CFF2 - Compact Font Format (Version 2)
//------------------------------------------------------------------------------
// https://learn.microsoft.com/en-us/typography/opentype/spec/cff2
//------------------------------------------------------------------------------
// Adobe Technical Note #5176: "The Compact Font Format Specification,":
// http://partners.adobe.com/public/developer/en/font/5176.CFF.pdf
//------------------------------------------------------------------------------
type
  TPascalTypeCompactFontFormat2Table = class(TCustomPascalTypeNamedTable)
  private
    FVersionMajor : Byte; // Format major version (2)
    FVersionMinor : Byte; // Format minor version (0)
    FHeaderSize   : Byte; // Header size
    FTopDictLength: Word; // Top DICT length
    FTopDict      : TPascalTypePostscriptDictDataTable;

    FCharStrings   : TPascalTypePostscriptCharStringIndexTable;
    FGlobalSubrs   : TPascalTypePostscriptCharStringIndexTable;
    FLocalSubrs    : array of TPascalTypePostscriptCharStringIndexTable;
    FPrivateDicts  : array of TPascalTypePostscriptDictDataTable;
    FFDSelect      : TPascalTypePostscriptFDSelect;
    FFDArray       : TPascalTypePostscriptTopDictIndexTable;
    FItemVariationStore: TItemVariationStore;
    FInterpreter   : TPascalTypePostscriptCharStringInterpreter;

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

    class function GetTableType: TTableType; override;

    procedure Assign(Source: TPersistent); override;

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

    function GetGlyphPath(GlyphIndex: Word): TPascalTypePath;

    property VersionMajor: Byte read FVersionMajor write FVersionMajor;
    property VersionMinor: Byte read FVersionMinor write FVersionMinor;
    property TopDict: TPascalTypePostscriptDictDataTable read FTopDict;
    property CharStrings: TPascalTypePostscriptCharStringIndexTable read FCharStrings;
    property GlobalSubrs: TPascalTypePostscriptCharStringIndexTable read FGlobalSubrs;
    property ItemVariationStore: TItemVariationStore read FItemVariationStore;
  end;


implementation

uses
  PascalType.ResourceStrings;

{ TPascalTypeCompactFontFormat2Table }

constructor TPascalTypeCompactFontFormat2Table.Create(AParent: TCustomPascalTypeTable);
begin
  inherited;
  FVersionMajor := 2;
  FTopDict := TPascalTypePostscriptDictDataTable.Create(Self);
  FGlobalSubrs := TPascalTypePostscriptCharStringIndexTable.Create(Self);
end;

destructor TPascalTypeCompactFontFormat2Table.Destroy;
begin
  ClearTables;
  FGlobalSubrs.Free;
  FTopDict.Free;
  inherited;
end;

procedure TPascalTypeCompactFontFormat2Table.ClearTables;
var
  i: Integer;
begin
  FreeAndNil(FCharStrings);
  FreeAndNil(FFDSelect);
  FreeAndNil(FFDArray);
  FreeAndNil(FItemVariationStore);
  if (FInterpreter <> nil) then
    FInterpreter.Free;
  FInterpreter := nil;

  for i := 0 to High(FLocalSubrs) do
    FLocalSubrs[i].Free;
  SetLength(FLocalSubrs, 0);

  for i := 0 to High(FPrivateDicts) do
    FPrivateDicts[i].Free;
  SetLength(FPrivateDicts, 0);
end;

class function TPascalTypeCompactFontFormat2Table.GetTableType: TTableType;
begin
  Result := 'CFF2';
end;

procedure TPascalTypeCompactFontFormat2Table.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TPascalTypeCompactFontFormat2Table then
  begin
    var src := TPascalTypeCompactFontFormat2Table(Source);
    FVersionMajor := src.FVersionMajor;
    FVersionMinor := src.FVersionMinor;
    FHeaderSize := src.FHeaderSize;
    FTopDictLength := src.FTopDictLength;
    FTopDict.Assign(src.FTopDict);
    FGlobalSubrs.Assign(src.FGlobalSubrs);

    if src.FCharStrings <> nil then
    begin
      if FCharStrings = nil then FCharStrings := TPascalTypePostscriptCharStringIndexTable.Create(Self);
      FCharStrings.Assign(src.FCharStrings);
    end else
      FreeAndNil(FCharStrings);

    if src.FFDSelect <> nil then
    begin
      if FFDSelect = nil then FFDSelect := TPascalTypePostscriptFDSelect.Create(Self);
      FFDSelect.Assign(src.FFDSelect);
    end else
      FreeAndNil(FFDSelect);

    if src.FFDArray <> nil then
    begin
      if FFDArray = nil then FFDArray := TPascalTypePostscriptTopDictIndexTable.Create(Self);
      FFDArray.Assign(src.FFDArray);
    end else
      FreeAndNil(FFDArray);

    if src.FItemVariationStore <> nil then
    begin
      if FItemVariationStore = nil then FItemVariationStore := TItemVariationStore.Create(Self);
      FItemVariationStore.Assign(src.FItemVariationStore);
    end else
      FreeAndNil(FItemVariationStore);

    for var i := 0 to High(FLocalSubrs) do FLocalSubrs[i].Free;
    SetLength(FLocalSubrs, Length(src.FLocalSubrs));
    for var i := 0 to High(FLocalSubrs) do
    begin
      FLocalSubrs[i] := TPascalTypePostscriptCharStringIndexTable.Create(Self);
      FLocalSubrs[i].Assign(src.FLocalSubrs[i]);
    end;

    for var i := 0 to High(FPrivateDicts) do FPrivateDicts[i].Free;
    SetLength(FPrivateDicts, Length(src.FPrivateDicts));
    for var i := 0 to High(FPrivateDicts) do
    begin
      FPrivateDicts[i] := TPascalTypePostscriptDictDataTable.Create(Self);
      FPrivateDicts[i].Assign(src.FPrivateDicts[i]);
    end;
  end;
end;

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

  // +----------+---------------+-------------------------------------------------------------------------+
  // | Type     | Name          | Description                                                             |
  // +==========+===============+=========================================================================+
  // | uint8    | major         | Format major version (=2).                                              |
  // +----------+---------------+-------------------------------------------------------------------------+
  // | uint8    | minor         | Format minor version (=0).                                              |
  // +----------+---------------+-------------------------------------------------------------------------+
  // | uint8    | hdrSize       | Header size (bytes).                                                    |
  // +----------+---------------+-------------------------------------------------------------------------+
  // | uint16   | topDictLength | Length of Top DICT structure in bytes.                                  |
  // +----------+---------------+-------------------------------------------------------------------------+

  var StartPos := Stream.Position;

  Stream.Read(FVersionMajor, 1);
  if FVersionMajor <> 2 then
    raise EPascalTypeError.Create(RCStrUnknownVersion);

  Stream.Read(FVersionMinor, 1);
  Stream.Read(FHeaderSize, 1);
  FTopDictLength := BigEndianValue.ReadWord(Stream);

  ClearTables;

  // Top DICT follows header
  FTopDict.LoadFromStream(Stream, FTopDictLength);

  // Global Subrs follows Top DICT
  FGlobalSubrs.LoadFromStream(Stream);

  // Referred tables
  // CharStrings
  var Offset: Integer;
  if FTopDict.TryGetInteger(cffDictOpCharStrings, Offset) then
  begin
    Stream.Position := StartPos + Offset;
    FCharStrings := TPascalTypePostscriptCharStringIndexTable.Create(Self);
    FCharStrings.LoadFromStream(Stream);
  end;

  // FDArray
  if FTopDict.TryGetInteger(cffDictOpEscape, cffDictOpFDArray, Offset) then
  begin
    Stream.Position := StartPos + Offset;
    FFDArray := TPascalTypePostscriptTopDictIndexTable.Create(Self);
    FFDArray.LoadFromStream(Stream);

    SetLength(FPrivateDicts, FFDArray.Count);
    SetLength(FLocalSubrs, FFDArray.Count);
    for var i := 0 to FFDArray.Count - 1 do
    begin
      var PrivateSize, PrivateOffset: Integer;
      if FFDArray.Dict[i].TryGetInteger(cffDictOpPrivate, PrivateSize, 0) and FFDArray.Dict[i].TryGetInteger(cffDictOpPrivate, PrivateOffset, 1) then
      begin
        FPrivateDicts[i] := TPascalTypePostscriptDictDataTable.Create(Self);
        Stream.Position := StartPos + PrivateOffset;
        FPrivateDicts[i].LoadFromStream(Stream, PrivateSize);

        var SubrOffset: Integer;
        if FPrivateDicts[i].TryGetInteger(cffDictOpSubrs, SubrOffset) then
        begin
          FLocalSubrs[i] := TPascalTypePostscriptCharStringIndexTable.Create(Self);
          Stream.Position := StartPos + PrivateOffset + SubrOffset;
          FLocalSubrs[i].LoadFromStream(Stream);
        end;
      end;
    end;
  end;

  // FDSelect
  if FTopDict.TryGetInteger(cffDictOpEscape, cffDictOpFDSelect, Offset) then
  begin
    Stream.Position := StartPos + Offset;
    FFDSelect := TPascalTypePostscriptFDSelect.Create(Self);
    FFDSelect.LoadFromStream(Stream, Cardinal(StartPos + Size - Stream.Position));
  end;

  // vstore
  if FTopDict.TryGetInteger(cffDictOpVStore, Offset) then
  begin
    Stream.Position := StartPos + Offset;
    // CFF2 VariationStore structure consists of a uint16 length field
    // followed by an ItemVariationStore structure.
    var VStoreSize := BigEndianValue.ReadWord(Stream);
    FItemVariationStore := TItemVariationStore.Create(Self);
    FItemVariationStore.LoadFromStream(Stream, VStoreSize);
  end;
end;

function TPascalTypeCompactFontFormat2Table.GetGlyphPath(GlyphIndex: Word): TPascalTypePath;
begin
  if (FCharStrings = nil) or (GlyphIndex >= FCharStrings.Count) then
    Exit(nil);

  var LocalSubrs: TPascalTypePostscriptCharStringIndexTable := nil;

  if FFDSelect <> nil then
  begin
    var FDIndex := FFDSelect.GetFDIndex(GlyphIndex);
    if FDIndex < Length(FLocalSubrs) then
      LocalSubrs := FLocalSubrs[FDIndex];
  end else
  begin
    if Length(FLocalSubrs) > 0 then
      LocalSubrs := FLocalSubrs[0];
  end;

  if FInterpreter = nil then
    FInterpreter := TPascalTypePostscriptCharStringInterpreter.Create;

  var NormalizedCoords: TArray<TFixedPoint> := nil;
  if (FontFace <> nil) and (FontFace.VariationsActive) then
    NormalizedCoords := FontFace.VariationNormalizedCoordinates;

  Result := FInterpreter.Execute(FCharStrings.CharString[GlyphIndex],
    FGlobalSubrs, LocalSubrs, 0, 0, True, FItemVariationStore, NormalizedCoords);
end;

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

  var MS := TMemoryStream.Create;
  try
    FTopDict.SaveToStream(MS);
    FTopDictLength := Word(MS.Size);

    Stream.Write(FVersionMajor, 1);
    Stream.Write(FVersionMinor, 1);
    Stream.Write(FHeaderSize, 1);
    BigEndianValue.WriteWord(Stream, FTopDictLength);

    MS.Position := 0;
    Stream.CopyFrom(MS, MS.Size);
  finally
    MS.Free;
  end;
end;

initialization

  PascalTypeTableClasses.RegisterTables([TPascalTypeCompactFontFormat2Table]);

end.