PascalType.Tables.OpenType.PostScript.CharStrings.pas

unit PascalType.Tables.OpenType.PostScript.CharStrings;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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
  Classes,
  SysUtils,
  Generics.Collections,
  PascalType.Types,
  PascalType.Classes,
  PascalType.Tables.OpenType.PostScript,
  PascalType.Tables.OpenType.Common.Variation;

type
  EPascalTypePostscriptInterpreter = class(EPascalTypeError);
  EPascalTypePostscriptStackOverflow = class(EPascalTypePostscriptInterpreter);
  EPascalTypePostscriptStackUnderflow = class(EPascalTypePostscriptInterpreter);
  EPascalTypePostscriptMaxRecursion = class(EPascalTypePostscriptInterpreter);
  EPascalTypePostscriptHintMaskOverflow = class(EPascalTypePostscriptInterpreter);

type
  TPascalTypePostscriptCharStringInterpreter = class
  private
    FStack: TList<Single>;
    FPath: TList<TPascalTypeContour>;
    FCurrentContour: TList<TContourPoint>;
    FCurrentX, FCurrentY: Single;
    FWidth: Single;
    FHasWidth: Boolean;
    FHasCheckedWidth: Boolean;
    FDefaultWidthX: Single;
    FNominalWidthX: Single;
    FIsCFF2: Boolean;
    FGlobalSubrs: TPascalTypePostscriptCharStringIndexTable;
    FLocalSubrs: TPascalTypePostscriptCharStringIndexTable;
    FItemVariationStore: TItemVariationStore;
    FNormalizedCoords: TArray<TFixedPoint>;
    FVsIndex: Integer;
    FNumStems: Integer;
    FTransientArray: array[0..31] of Single;

    procedure Clear;
    procedure NewContour;
    procedure AddPoint(X, Y: Single; Flags: Byte);
    procedure ClosePath;

    procedure Push(Value: Single);
    function Pop: Single;
    procedure ClearStack;

    procedure Interpret(const ACharString: TArray<Byte>; ADepth: Integer = 0);
    function GetSubr(Index: Integer; Global: Boolean): TArray<Byte>;
    function GetBias(Count: Integer): Integer;

    procedure OpMoveTo(Horizontal: Boolean = False; Vertical: Boolean = False);
    procedure OpLineTo(Horizontal: Boolean = False; Vertical: Boolean = False);
    procedure OpCurveTo;
    procedure OpCurveLine;
    procedure OpLineCurve;
    procedure OpVVurveTo;
    procedure OpHHurveTo;
    procedure OpVHCurveTo;
    procedure OpHVCurveTo;
    procedure OpFlex;
    procedure OpHFlex;
    procedure OpHFlex1;
    procedure OpFlex1;

    procedure CheckWidth(NumExpected: Integer);
    procedure Require(NumExpected: Integer);
  public
    constructor Create;
    destructor Destroy; override;

    function Execute(const ACharString: TArray<Byte>;
      const AGlobalSubrs, ALocalSubrs: TPascalTypePostscriptCharStringIndexTable;
      const ADefaultWidthX, ANominalWidthX: Single;
      AIsCFF2: Boolean = False;
      const AItemVariationStore: TItemVariationStore = nil;
      const ANormalizedCoords: TArray<TFixedPoint> = nil): TPascalTypePath;

    property Width: Single read FWidth;
  end;

const
  // https://learn.microsoft.com/en-us/typography/opentype/otspec190/cff2charstr#appendix_CommandCodes
  // CFF: 48, CFF2: 513
  CFFMaxStackDepth = 513;

implementation

uses
  Math,
  PascalType.ResourceStrings;

const
  // Type 2 CharString Opcodes (1-byte)
  cOpcodeReserved_00= 0;
  cOpcodeHStem      = 1;
  cOpcodeReserved_02= 2;
  cOpcodeVStem      = 3;
  cOpcodeVMoveTo    = 4;
  cOpcodeRLineto    = 5;
  cOpcodeHLineto    = 6;
  cOpcodeVLineto    = 7;
  cOpcodeRRCurveto  = 8;
  cOpcodeReserved_09= 9;
  cOpcodeCallSubr   = 10;
  cOpcodeReturn     = 11;
  cOpcodeEscape     = 12;
  cOpcodeReserved_0D= 13;
  cOpcodeEndChar    = 14;
  cOpcodeVsIndex    = 15;
  cOpcodeBlend      = 16;
  cOpcodeReserved_11= 17;
  cOpcodeHStemHM    = 18;
  cOpcodeHintMask   = 19;
  cOpcodeCntrMask   = 20;
  cOpcodeRMoveTo    = 21;
  cOpcodeHMoveTo    = 22;
  cOpcodeVStemHM    = 23;
  cOpcodeRCurveLine = 24;
  cOpcodeRLineCurve = 25;
  cOpcodeVVCurveto  = 26;
  cOpcodeHHCurveto  = 27;
  cOpcodeShortInt   = 28;
  cOpcodeCallGSubr  = 29;
  cOpcodeVHCurveto  = 30;
  cOpcodeHVCurveto  = 31;
  cOpcodeFixed      = 255;

  // 2-byte operators (preceded by cOpcodeEscape)
  cOpcodeAnd        = 3;
  cOpcodeOr         = 4;
  cOpcodeNot        = 5;
  cOpcodeAbs        = 9;
  cOpcodeAdd        = 10;
  cOpcodeSub        = 11;
  cOpcodeDiv        = 12;
  cOpcodeNeg        = 14;
  cOpcodeEq         = 15;
  cOpcodeDrop       = 18;
  cOpcodePut        = 20;
  cOpcodeGet        = 21;
  cOpcodeIfElse     = 22;
  cOpcodeRandom     = 23;
  cOpcodeMul        = 24;
  cOpcodeSqrt       = 26;
  cOpcodeDup        = 27;
  cOpcodeExch       = 28;
  cOpcodeIndex      = 29;
  cOpcodeRoll       = 30;
  cOpcodeHFlex      = 34;
  cOpcodeFlex       = 35;
  cOpcodeHFlex1     = 36;
  cOpcodeFlex1      = 37;

{ TPascalTypePostscriptCharStringInterpreter }

constructor TPascalTypePostscriptCharStringInterpreter.Create;
begin
  FStack := TList<Single>.Create;
  FPath := TList<TPascalTypeContour>.Create;
  FCurrentContour := TList<TContourPoint>.Create;
end;

destructor TPascalTypePostscriptCharStringInterpreter.Destroy;
begin
  FCurrentContour.Free;
  FPath.Free;
  FStack.Free;
  inherited;
end;

procedure TPascalTypePostscriptCharStringInterpreter.Clear;
begin
  FStack.Clear;
  FPath.Clear;
  FCurrentContour.Clear;
  FCurrentX := 0;
  FCurrentY := 0;
  FWidth := 0;
  FHasWidth := False;
  FHasCheckedWidth := False;
  FVsIndex := 0;
  FNumStems := 0;
  FillChar(FTransientArray, SizeOf(FTransientArray), 0);
end;

procedure TPascalTypePostscriptCharStringInterpreter.NewContour;
begin
  if FCurrentContour.Count > 0 then
  begin
    FPath.Add(FCurrentContour.ToArray);
    FCurrentContour.Clear;
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.AddPoint(X, Y: Single; Flags: Byte);
begin
  var Point: TContourPoint;
  Point.XPos := X;
  Point.YPos := Y;
  Point.Flags := Flags;
  FCurrentContour.Add(Point);
  FCurrentX := X;
  FCurrentY := Y;
end;

procedure TPascalTypePostscriptCharStringInterpreter.ClosePath;
begin
  NewContour;
end;

procedure TPascalTypePostscriptCharStringInterpreter.Push(Value: Single);
begin
  if FStack.Count >= CFFMaxStackDepth then
    raise EPascalTypePostscriptStackOverflow.Create('Operand stack overflow');
  FStack.Add(Value);
end;

function TPascalTypePostscriptCharStringInterpreter.Pop: Single;
begin
  if FStack.Count = 0 then
    raise EPascalTypePostscriptStackUnderflow.Create(RCStrCFFStackUnderflow);
  Result := FStack[FStack.Count - 1];
  FStack.Delete(FStack.Count - 1);
end;

procedure TPascalTypePostscriptCharStringInterpreter.ClearStack;
begin
  FStack.Clear;
end;

function TPascalTypePostscriptCharStringInterpreter.GetBias(Count: Integer): Integer;
const
  CBiasSmall  = 107;
  CBiasMedium = 1131;
  CBiasLarge  = 32768;
begin
  if Count < 1240 then
    Result := CBiasSmall
  else
  if Count < 33900 then
    Result := CBiasMedium
  else
    Result := CBiasLarge;
end;

function TPascalTypePostscriptCharStringInterpreter.GetSubr(Index: Integer; Global: Boolean): TArray<Byte>;
begin
  var Table: TPascalTypePostscriptCharStringIndexTable;
  if Global then
    Table := FGlobalSubrs
  else
    Table := FLocalSubrs;

  if (Table = nil) or (Table.Count = 0) then
    raise EPascalTypePostscriptInterpreter.Create('Subroutine table missing or empty');

  var ActualIndex := Index + GetBias(Table.Count);
  Result := Table.CharString[ActualIndex];
end;

procedure TPascalTypePostscriptCharStringInterpreter.Require(NumExpected: Integer);
begin
  if (FStack.Count < NumExpected) then
    raise EPascalTypeError.Create(RCStrCFFStackUnderflow);
end;

procedure TPascalTypePostscriptCharStringInterpreter.CheckWidth(NumExpected: Integer);
begin
  (*

  Adobe Technical Note #5117 ("The Type 2 CharString Format"), Section 3.2 "Glyph Widths".

  - The first stack-clearing operator in a CharString (one of hstem, hstemhm,
    vstem, vstemhm, rmoveto, hmoveto, or vmoveto) can be preceded by an optional
    number that specifies the glyph's width.

  - The width is present if the number of arguments on the stack is one more
    than the number of arguments required for the operator.

  Operators with an even number of operands: hstem, vstem, rmoveto
  Operators with an odd number of operands: hmoveto, vmoveto

  *)

  // CFF2 CharStrings do not contain a value for width.
  // https://learn.microsoft.com/en-us/typography/opentype/otspec190/cff2charstr#appendix-c-changes-from-type-2-charstrings
  if FIsCFF2 or FHasCheckedWidth or FHasWidth then
    exit;

  FHasCheckedWidth := True;

  if (FStack.Count > NumExpected) then
  begin
    FWidth := FNominalWidthX + FStack[0];
    FStack.Delete(0);
    FHasWidth := True;
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.Interpret(const ACharString: TArray<Byte>; ADepth: Integer);
const
  CMaxRecursionDepth = 32; // Spec says 10
var
  i: Integer;
begin
  if ADepth > CMaxRecursionDepth then
    raise EPascalTypePostscriptMaxRecursion.Create('Maximum subroutine recursion depth exceeded');

  i := 0;
  while i < Length(ACharString) do
  begin
    var Opcode := ACharString[i];
    Inc(i);

    case Opcode of
      cOpcodeHStem..cOpcodeReturn,
      cOpcodeEndChar..cOpcodeHStemHM,
      cOpcodeRMoveTo..cOpcodeHHCurveto,
      cOpcodeCallGSubr..cOpcodeHVCurveto: // 1-byte operators
        begin
          case Opcode of
            cOpcodeHStem, cOpcodeVStem, cOpcodeHStemHM, cOpcodeVStemHM:
              begin
                CheckWidth(FStack.Count and $FFFE);
                FNumStems := FNumStems + FStack.Count div 2;
              end;

            cOpcodeVMoveTo: OpMoveTo(False, True);
            cOpcodeHMoveTo: OpMoveTo(True, False);
            cOpcodeRMoveTo: OpMoveTo;

            cOpcodeRLineto: OpLineTo;
            cOpcodeHLineto: OpLineTo(True, False);
            cOpcodeVLineto: OpLineTo(False, True);

            cOpcodeRRCurveto: OpCurveTo;
            cOpcodeRCurveLine: OpCurveLine;
            cOpcodeRLineCurve: OpLineCurve;
            cOpcodeVVCurveto: OpVVurveTo;
            cOpcodeHHCurveto: OpHHurveTo;
            cOpcodeVHCurveto: OpVHCurveTo;
            cOpcodeHVCurveto: OpHVCurveTo;

            cOpcodeCallSubr:
              Interpret(GetSubr(Round(Pop), False), ADepth + 1);

            cOpcodeCallGSubr:
              Interpret(GetSubr(Round(Pop), True), ADepth + 1);

            cOpcodeReturn:
              if not FIsCFF2 then
                Exit;

            cOpcodeEndChar:
              begin
                CheckWidth(0);
                ClosePath;
                Exit;
              end;

            cOpcodeVsIndex:
              if FIsCFF2 then
              begin
                FVsIndex := Round(Pop);
              end;

            cOpcodeBlend:
              if FIsCFF2 then
              begin
                if (FItemVariationStore = nil) then
                  raise EPascalTypePostscriptInterpreter.Create('Item Variation Store missing for blend');

                var n := Round(Pop);
                if (FVsIndex < 0) or (FVsIndex >= FItemVariationStore.DataSetCount) then
                  raise EPascalTypePostscriptInterpreter.Create('Invalid vsindex for blend');

                var DataSet := FItemVariationStore.DataSets[FVsIndex];
                var RegionCount := DataSet.RegionIndexCount;
                // We already popped n, so we need n * RegionCount more.
                if FStack.Count < n * RegionCount + n then
                  raise EPascalTypePostscriptStackUnderflow.Create(RCStrCFFStackUnderflow);

                // Temporarily store deltas and values
                var Values: TArray<Single>;
                SetLength(Values, n);
                var RegionList := FItemVariationStore.RegionList;

                var DeltaIndex := FStack.Count - n * RegionCount;
                var ValIndex := DeltaIndex - n;

                for var k := 0 to n - 1 do
                  Values[k] := FStack[ValIndex + k];

                for var k := 0 to n - 1 do
                begin
                  for var j := 0 to RegionCount - 1 do
                  begin
                    var Delta := FStack[DeltaIndex + k * RegionCount + j];
                    Values[k] := Values[k] + Delta * RegionList.CalculateScalar(DataSet.RegionIndices[j], FNormalizedCoords);
                  end;
                end;

                // Remove operands from stack
                for var k := 1 to n * (RegionCount + 1) do
                  FStack.Delete(ValIndex);

                // Push results
                for var k := 0 to n - 1 do
                  Push(Values[k]);
              end;
          end;
        end;

      cOpcodeEscape: // 2-byte operators
        begin
          if i >= Length(ACharString) then
            break;

          var Opcode2 := ACharString[i];
          Inc(i);

          case Opcode2 of
            cOpcodeAnd:
              begin
                var v2 := Pop;
                var v1 := Pop;
                if (v1 <> 0) and (v2 <> 0) then
                  Push(1)
                else
                  Push(0);
              end;

            cOpcodeOr:
              begin
                var v2 := Pop;
                var v1 := Pop;
                if (v1 <> 0) or (v2 <> 0) then
                  Push(1)
                else
                  Push(0);
              end;

            cOpcodeNot:
              if Pop <> 0 then
                Push(0)
              else
                Push(1);

            cOpcodeAbs:
              Push(Abs(Pop));

            cOpcodeAdd:
              begin
                var v2 := Pop;
                var v1 := Pop;
                Push(v1 + v2);
              end;

            cOpcodeSub:
              begin
                var v2 := Pop;
                var v1 := Pop;
                Push(v1 - v2);
              end;

            cOpcodeDiv:
              begin
                var v2 := Pop;
                var v1 := Pop;
                if v2 <> 0 then
                  Push(v1 / v2)
                else
                  Push(0);
              end;

            cOpcodeNeg:
              Push(-Pop);

            cOpcodeEq:
              begin
                var v2 := Pop;
                var v1 := Pop;
                if v1 = v2 then
                  Push(1)
                else
                  Push(0);
              end;

            cOpcodeDrop:
              Pop;

            cOpcodePut:
              begin
                var idx := Round(Pop);
                var val := Pop;
                if (idx >= 0) and (idx <= High(FTransientArray)) then
                  FTransientArray[idx] := val;
              end;

            cOpcodeGet:
              begin
                var idx := Round(Pop);
                if (idx >= 0) and (idx <= High(FTransientArray)) then
                  Push(FTransientArray[idx])
                else
                  Push(0);
              end;

            cOpcodeIfElse:
              begin
                var v4 := Pop;
                var v3 := Pop;
                var v2 := Pop;
                var v1 := Pop;
                if v3 <= v4 then
                  Push(v1)
                else
                  Push(v2);
              end;

            cOpcodeRandom:
              Push(1.0 - Random); // range (0, 1]

            cOpcodeMul:
              begin
                var v2 := Pop;
                var v1 := Pop;
                Push(v1 * v2);
              end;

            cOpcodeSqrt:
              Push(Sqrt(Abs(Pop)));

            cOpcodeDup:
              begin
                var val := Pop;
                Push(val);
                Push(val);
              end;

            cOpcodeExch:
              begin
                var v2 := Pop;
                var v1 := Pop;
                Push(v2);
                Push(v1);
              end;

            cOpcodeIndex:
              begin
                var idx := Round(Pop);
                if (idx < 0) or (idx >= FStack.Count) then
                  raise EPascalTypePostscriptStackUnderflow.Create(RCStrCFFStackUnderflow);
                Push(FStack[FStack.Count - 1 - idx]);
              end;

            cOpcodeRoll:
              begin
                var j := Round(Pop);
                var n := Round(Pop);
                if (n > 1) and (n <= FStack.Count) then
                begin
                  j := j mod n;
                  if j < 0 then
                    j := j + n;
                  if j <> 0 then
                  begin
                    var temp: TArray<Single>;
                    SetLength(temp, n);
                    for var k := 0 to n - 1 do
                      temp[k] := FStack[FStack.Count - n + k];
                    for var k := 0 to n - 1 do
                      FStack[FStack.Count - n + (k + j) mod n] := temp[k];
                  end;
                end;
              end;

            cOpcodeHFlex: OpHFlex;
            cOpcodeFlex: OpFlex;
            cOpcodeHFlex1: OpHFlex1;
            cOpcodeFlex1: OpFlex1;

          else
            ClearStack;
          end;

          // Stack clearing 2-byte commands
          case Opcode2 of
            cOpcodeHFlex, cOpcodeFlex, cOpcodeHFlex1, cOpcodeFlex1:
              ClearStack;
          end;

        end;

      cOpcodeHintMask, cOpcodeCntrMask:
        begin
          CheckWidth(FStack.Count and $FFFE);
          FNumStems := FNumStems + FStack.Count div 2;
          var MaskSize := (FNumStems + 7) div 8;
          if i + MaskSize > Length(ACharString) then
            raise EPascalTypePostscriptHintMaskOverflow.Create('Hint mask extends beyond CharString bounds');
          i := i + MaskSize;
        end;

      cOpcodeShortInt:
        begin
          if i + 1 >= Length(ACharString) then
            Break;
          var s1 := SmallInt((ACharString[i] shl 8) or ACharString[i+1]);
          Inc(i, 2);
          Push(s1);
        end;

      32..246:
        Push(Opcode - 139);

      247..250:
        begin
          if i >= Length(ACharString) then
            Break;
          var v := (Opcode - 247) shl 8 + ACharString[i] + 108;
          Inc(i);
          Push(v);
        end;

      251..254:
        begin
          if i >= Length(ACharString) then
            Break;
          var v := -((Opcode - 251) shl 8) - ACharString[i] - 108;
          Inc(i);
          Push(v);
        end;

      cOpcodeFixed: // fixed 16.16
        begin
          if i + 3 >= Length(ACharString) then
            Break;
          var v := integer((ACharString[i] shl 24) or (ACharString[i+1] shl 16) or (ACharString[i+2] shl 8) or ACharString[i+3]);
          Inc(i, 4);
          Push(v / 65536.0);
        end;

    else
      // Invalid
      ClearStack;
    end;

    // Stack clearing commands
    case Opcode of
      cOpcodeHStem, cOpcodeVStem, cOpcodeHStemHM, cOpcodeVStemHM,
      cOpcodeVMoveTo, cOpcodeHMoveTo, cOpcodeRMoveTo,
      cOpcodeHintMask, cOpcodeCntrMask:
        ClearStack;

      cOpcodeRLineto, cOpcodeHLineto, cOpcodeVLineto,
      cOpcodeRRCurveto, cOpcodeRCurveLine, cOpcodeRLineCurve,
      cOpcodeVVCurveto, cOpcodeHHCurveto, cOpcodeVHCurveto, cOpcodeHVCurveto:
        ClearStack;
    end;

    // If the charstring has a width other than that of defaultWidthX
    // (see Technical Note #5176, [...]), it must be specified as the
    // first number in the charstring, and encoded as the difference
    // from nominalWidthX.
    FHasCheckedWidth := True;
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpMoveTo(Horizontal, Vertical: Boolean);
begin
  if Horizontal or Vertical then
  begin
    CheckWidth(1);
    Require(1);
  end else
  begin
    CheckWidth(2);
    Require(2);
  end;

  NewContour;

  if Horizontal then
    AddPoint(FCurrentX + FStack[0], FCurrentY, PT_ON_CURVE)
  else
  if Vertical then
    AddPoint(FCurrentX, FCurrentY + FStack[0], PT_ON_CURVE)
  else
    AddPoint(FCurrentX + FStack[0], FCurrentY + FStack[1], PT_ON_CURVE);
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpLineTo(Horizontal, Vertical: Boolean);
begin
  var i := 0;

  if Horizontal then
  begin
    // Alternating horizontal and vertical lines starting with horizontal (hlineto)
    var IsHorizontal := True;
    while i < FStack.Count do
    begin
      if IsHorizontal then
        AddPoint(FCurrentX + FStack[i], FCurrentY, PT_ON_CURVE)
      else
        AddPoint(FCurrentX, FCurrentY + FStack[i], PT_ON_CURVE);

      IsHorizontal := not IsHorizontal;
      Inc(i);
    end;
  end else
  if Vertical then
  begin
    // Alternating vertical and horizontal lines starting with vertical (vlineto)
    var IsHorizontal := False;
    while i < FStack.Count do
    begin
      if IsHorizontal then
        AddPoint(FCurrentX + FStack[i], FCurrentY, PT_ON_CURVE)
      else
        AddPoint(FCurrentX, FCurrentY + FStack[i], PT_ON_CURVE);

      IsHorizontal := not IsHorizontal;
      Inc(i);
    end;
  end else
  begin
    // Sequence of relative lines (dx, dy)
    while i + 1 < FStack.Count do
    begin
      AddPoint(FCurrentX + FStack[i], FCurrentY + FStack[i+1], PT_ON_CURVE);
      Inc(i, 2);
    end;
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpCurveTo;
begin
  var i := 0;
  // Sequence of relative cubic curves (dx1, dy1, dx2, dy2, dx3, dy3)
  while i + 5 < FStack.Count do
  begin
    AddPoint(FCurrentX + FStack[i],   FCurrentY + FStack[i+1], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+2], FCurrentY + FStack[i+3], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+4], FCurrentY + FStack[i+5], PT_ON_CURVE);

    Inc(i, 6);
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpCurveLine;
begin
  var i := 0;
  // Sequence of curves followed by one final line
  while i + 5 < FStack.Count - 2 do
  begin
    AddPoint(FCurrentX + FStack[i],   FCurrentY + FStack[i+1], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+2], FCurrentY + FStack[i+3], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+4], FCurrentY + FStack[i+5], PT_ON_CURVE);

    Inc(i, 6);
  end;

  if i + 1 < FStack.Count then
    AddPoint(FCurrentX + FStack[i], FCurrentY + FStack[i+1], PT_ON_CURVE);
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpLineCurve;
begin
  var i := 0;
  // Sequence of lines followed by one final curve
  while i + 1 < FStack.Count - 6 do
  begin
    AddPoint(FCurrentX + FStack[i], FCurrentY + FStack[i+1], PT_ON_CURVE);

    Inc(i, 2);
  end;

  if i + 5 < FStack.Count then
  begin
    AddPoint(FCurrentX + FStack[i],   FCurrentY + FStack[i+1], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+2], FCurrentY + FStack[i+3], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+4], FCurrentY + FStack[i+5], PT_ON_CURVE);
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpVVurveTo;
begin
  var i := 0;
  var dx: Single := 0;
  // Vertical curve: dxa is optionally 1st operand, then blocks of (dy1, dx2, dy2, dy3)
  if (FStack.Count mod 4 <> 0) then
  begin
    dx := FStack[0];
    Inc(i);
  end;

  while i + 3 < FStack.Count do
  begin
    var BaselineX := FCurrentX + dx;
    AddPoint(BaselineX,               FCurrentY + FStack[i],   PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+1], FCurrentY + FStack[i+2], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX,               FCurrentY + FStack[i+3], PT_ON_CURVE);

    Inc(i, 4);
    dx := 0;
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpHHurveTo;
begin
  var i := 0;
  var dy: Single := 0;
  // Horizontal curve: dya is optionally 1st operand, then blocks of (dx1, dx2, dy2, dx3)
  if (FStack.Count mod 4 <> 0) then
  begin
    dy := FStack[0];
    Inc(i);
  end;

  while i + 3 < FStack.Count do
  begin
    var BaselineY := FCurrentY + dy;
    AddPoint(FCurrentX + FStack[i],   BaselineY,               PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+1], FCurrentY + FStack[i+2], PT_CUBIC_CONTROL);
    AddPoint(FCurrentX + FStack[i+3], FCurrentY,               PT_ON_CURVE);

    Inc(i, 4);
    dy := 0;
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpVHCurveTo;
begin
  var i := 0;
  var IsVertical := True;
  // Alternating vertical-horizontal and horizontal-vertical curves (vhcurveto)
  while i + 3 < FStack.Count do
  begin
    var d1 := FStack[i];
    var d2 := FStack[i+1];
    var d3 := FStack[i+2];
    var d4 := FStack[i+3];
    Inc(i, 4);

    // If an odd number of operands is provided, the last operand is a 5th coordinate
    var d5: Single;
    if i = FStack.Count - 1 then
    begin
      d5 := FStack[i];
      Inc(i);
    end else
      d5 := 0;

    if IsVertical then
    begin
      // Vertical-Horizontal: d1=dy1, d2=dx2, d3=dy2, d4=dx3, d5=dy3
      AddPoint(FCurrentX,      FCurrentY + d1, PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d2, FCurrentY + d3, PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d4, FCurrentY + d5, PT_ON_CURVE);
    end else
    begin
      // Horizontal-Vertical: d1=dxa, d2=dxb, d3=dyb, d4=dyc, d5=dxd
      AddPoint(FCurrentX + d1, FCurrentY,      PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d2, FCurrentY + d3, PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d5, FCurrentY + d4, PT_ON_CURVE);
    end;
    IsVertical := not IsVertical;
  end;
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpFlex;
begin
  Require(12);

  // Flex sequence (dx1, dy1, dx2, dy2, dx3, dy3, dx4, dy4, dx5, dy5, dx6, dy6)
  AddPoint(FCurrentX + FStack[0], FCurrentY + FStack[1], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[2], FCurrentY + FStack[3], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[4], FCurrentY + FStack[5], PT_ON_CURVE);
  AddPoint(FCurrentX + FStack[6], FCurrentY + FStack[7], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[8], FCurrentY + FStack[9], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[10], FCurrentY + FStack[11], PT_ON_CURVE);
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpHFlex;
begin
  Require(7);

  // Horizontal flex: (dx1, 0, dx2, dy2, dx3, 0, dx4, 0, dx5, -dy2, dx6, 0)
  AddPoint(FCurrentX + FStack[0], FCurrentY,             PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[1], FCurrentY + FStack[2], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[3], FCurrentY,             PT_ON_CURVE);
  AddPoint(FCurrentX + FStack[4], FCurrentY,             PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[5], FCurrentY - FStack[2], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[6], FCurrentY,             PT_ON_CURVE);
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpHFlex1;
begin
  Require(9);

  // Horizontal flex variant: (dx1, dy1, dx2, dy2, dx3, 0, dx4, 0, dx5, dy5, dx6, 0)
  AddPoint(FCurrentX + FStack[0], FCurrentY + FStack[1], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[2], FCurrentY + FStack[3], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[4], FCurrentY,             PT_ON_CURVE);
  AddPoint(FCurrentX + FStack[5], FCurrentY,             PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[6], FCurrentY + FStack[7], PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + FStack[8], FCurrentY,             PT_ON_CURVE);
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpFlex1;
begin
  Require(11);

  // Flex sequence is dx1 dy1 dx2 dy2 dx3 dy3 dx4 dy4 dx5 dy5 d6
  var dx1 := FStack[0]; var dy1 := FStack[1];
  var dx2 := FStack[2]; var dy2 := FStack[3];
  var dx3 := FStack[4]; var dy3 := FStack[5];
  var dx4 := FStack[6]; var dy4 := FStack[7];
  var dx5 := FStack[8]; var dy5 := FStack[9];
  var d6  := FStack[10];

  // start_x/y is current point at beginning of flex sequence
  var start_x := FCurrentX;
  var start_y := FCurrentY;

  // First curve: (dx1, dy1), (dx2, dy2), (dx3, dy3) relative
  AddPoint(start_x + dx1, start_y + dy1, PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + dx2, FCurrentY + dy2, PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + dx3, FCurrentY + dy3, PT_ON_CURVE);

  // Second curve: (dx4, dy4), (dx5, dy5), (d6, 0 or 0, d6) relative
  AddPoint(FCurrentX + dx4, FCurrentY + dy4, PT_CUBIC_CONTROL);
  AddPoint(FCurrentX + dx5, FCurrentY + dy5, PT_CUBIC_CONTROL);

  var sum_dx := FCurrentX - start_x;
  var sum_dy := FCurrentY - start_y;

  // The last curve point is either d6 on the major axis or 0 on the minor axis
  if Abs(sum_dx) > Abs(sum_dy) then
    AddPoint(start_x + d6, start_y, PT_ON_CURVE)
  else
    AddPoint(start_x, start_y + d6, PT_ON_CURVE);
end;

procedure TPascalTypePostscriptCharStringInterpreter.OpHVCurveTo;
begin
  var i := 0;
  var IsHorizontal := True;
  // Alternating horizontal-vertical and vertical-horizontal curves (hvcurveto)
  while i + 3 < FStack.Count do
  begin
    var d1 := FStack[i];
    var d2 := FStack[i+1];
    var d3 := FStack[i+2];
    var d4 := FStack[i+3];
    Inc(i, 4);

    // If an odd number of operands is provided, the last operand is a 5th coordinate
    var d5: Single;
    if i = FStack.Count - 1 then
    begin
      d5 := FStack[i];
      Inc(i);
    end else
      d5 := 0;

    if IsHorizontal then
    begin
      // Horizontal-Vertical: d1=dx1, d2=dx2, d3=dy2, d4=dy3, d5=dx3
      AddPoint(FCurrentX + d1, FCurrentY,      PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d2, FCurrentY + d3, PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d5, FCurrentY + d4, PT_ON_CURVE);
    end else
    begin
      // Vertical-Horizontal: d1=dya, d2=dxb, d3=dyb, d4=dxc, d5=dyc
      AddPoint(FCurrentX,      FCurrentY + d1, PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d2, FCurrentY + d3, PT_CUBIC_CONTROL);
      AddPoint(FCurrentX + d4, FCurrentY + d5, PT_ON_CURVE);
    end;
    IsHorizontal := not IsHorizontal;
  end;
end;

function TPascalTypePostscriptCharStringInterpreter.Execute(
  const ACharString: TArray<Byte>;
  const AGlobalSubrs, ALocalSubrs: TPascalTypePostscriptCharStringIndexTable;
  const ADefaultWidthX, ANominalWidthX: Single;
  AIsCFF2: Boolean;
  const AItemVariationStore: TItemVariationStore;
  const ANormalizedCoords: TArray<TFixedPoint>): TPascalTypePath;
begin
  Clear;
  FGlobalSubrs := AGlobalSubrs;
  FLocalSubrs := ALocalSubrs;
  FItemVariationStore := AItemVariationStore;
  FNormalizedCoords := ANormalizedCoords;
  FDefaultWidthX := ADefaultWidthX;
  FNominalWidthX := ANominalWidthX;
  FIsCFF2 := AIsCFF2;

  try

    Interpret(ACharString);

  except
    on E: EPascalTypeWarning do
    begin
{$IFDEF WarningExceptions}
      raise;
{$ENDIF}
    end;
  end;

  NewContour; // Ensure last contour is added

  if not FHasWidth then
    FWidth := FDefaultWidthX;

  Result := FPath.ToArray;
end;

end.