PascalType.Tables.TrueType.gvar.pas

unit PascalType.Tables.TrueType.gvar;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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,
  PascalType.Tables.OpenType.Common.Variation;

type
  TPascalTypeGlyphVariationTable = class(TCustomPascalTypeNamedTable)
  private
    FMajorVersion: Word;
    FMinorVersion: Word;
    FAxisCount: Word;
    FSharedTuples: TArray<TArray<TShortFrac>>;
    FGlyphCount: Word;
    FFlags: Word;
    FGlyphVariationData: TArray<TArray<Byte>>;
  public
    class function GetTableType: TPascalTypeTag; override;

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

    function GetGlyphDeltas(GlyphIndex: Word; const NormalizedCoords: TArray<TFixedPoint>;
      const DefaultPoints: TArray<TFloatPoint>; const ContourEndPoints: TArray<Integer>): TArray<TFloatPoint>;
    procedure IUP(var DeltasX, DeltasY: TArray<Single>; const DefaultPoints: TArray<TFloatPoint>;
      const ContourEndPoints: TArray<Integer>; const VariedX, VariedY: TArray<Boolean>);
  end;

implementation

uses
  PascalType.ResourceStrings;

{ TPascalTypeGlyphVariationTable }

class function TPascalTypeGlyphVariationTable.GetTableType: TPascalTypeTag;
begin
  Result.AsTableName := 'gvar';
end;

procedure TPascalTypeGlyphVariationTable.LoadFromStream(Stream: TStream; Size: Cardinal);
begin
  var StartPos := Stream.Position;

  FMajorVersion := BigEndianValue.ReadWord(Stream);
  FMinorVersion := BigEndianValue.ReadWord(Stream);
  FAxisCount := BigEndianValue.ReadWord(Stream);
  var SharedTupleCount := BigEndianValue.ReadWord(Stream);
  var SharedTuplesOffset := BigEndianValue.ReadCardinal(Stream);
  FGlyphCount := BigEndianValue.ReadWord(Stream);
  FFlags := BigEndianValue.ReadWord(Stream);
  var GlyphVariationDataArrayOffset := BigEndianValue.ReadCardinal(Stream);

  if SharedTuplesOffset <> 0 then
  begin
    Stream.Position := StartPos + SharedTuplesOffset;
    SetLength(FSharedTuples, SharedTupleCount);
    for var i := 0 to SharedTupleCount - 1 do
    begin
      SetLength(FSharedTuples[i], FAxisCount);
      for var j := 0 to FAxisCount - 1 do
        FSharedTuples[i][j] := BigEndianValue.ReadSmallInt(Stream);
    end;
  end;

  Stream.Position := StartPos + 20; // After header
  var Offsets: TArray<Cardinal>;
  SetLength(Offsets, FGlyphCount + 1);
  if (FFlags and 1 = 0) then
  begin
    // Offset16
    for var i := 0 to FGlyphCount do
      Offsets[i] := BigEndianValue.ReadWord(Stream) shl 1;
  end else
  begin
    // Offset32
    for var i := 0 to FGlyphCount do
      Offsets[i] := BigEndianValue.ReadCardinal(Stream);
  end;

  SetLength(FGlyphVariationData, FGlyphCount);
  for var i := 0 to FGlyphCount - 1 do
  begin
    var DataSize := Offsets[i+1] - Offsets[i];
    if DataSize > 0 then
    begin
      Stream.Position := StartPos + GlyphVariationDataArrayOffset + Offsets[i];
      SetLength(FGlyphVariationData[i], DataSize);
      Stream.Read(FGlyphVariationData[i][0], DataSize);
    end;
  end;
end;

procedure TPascalTypeGlyphVariationTable.SaveToStream(Stream: TStream);
begin
  raise EPascalTypeNotImplemented.Create(RCStrNotImplemented);
end;

function TPascalTypeGlyphVariationTable.GetGlyphDeltas(GlyphIndex: Word; const NormalizedCoords: TArray<TFixedPoint>;
  const DefaultPoints: TArray<TFloatPoint>; const ContourEndPoints: TArray<Integer>): TArray<TFloatPoint>;
begin
  var NumPoints := Length(DefaultPoints);
  SetLength(Result, NumPoints);
  if (Length(Result) > 0) then
    FillChar(Result[0], Length(Result) * SizeOf(TFloatPoint), 0);

  if (GlyphIndex >= FGlyphCount) or (Length(FGlyphVariationData[GlyphIndex]) = 0) then
    Exit;

  var Stream := TMemoryStream.Create; // TODO : This is horrible! Wrap a stream around FGlyphVariationData if we absolutely must load via a stream
  try
    Stream.Write(FGlyphVariationData[GlyphIndex][0], Length(FGlyphVariationData[GlyphIndex]));
    Stream.Position := 0;

    var TupleCountWord := BigEndianValue.ReadWord(Stream);
    var TupleCount := TupleCountWord and COUNT_MASK;
    var HasSharedPointNumbers := (TupleCountWord and SHARED_POINT_NUMBERS <> 0);
    var DataOffset := BigEndianValue.ReadWord(Stream);
    var DataStartPos: Int64 := DataOffset;

    var Headers := TObjectList<TTupleVariationHeader>.Create(True);
    try
      for var i := 0 to TupleCount - 1 do
      begin
        var Header := TTupleVariationHeader.Create(Self);
        Headers.Add(Header);
        Header.LoadFromStream(Stream, FAxisCount, FSharedTuples);
      end;

      // All headers have been read. Stream position is now at the start of the first data block.
      Stream.Position := DataStartPos;

      var SharedPoints: TArray<Integer> := nil;
      if HasSharedPointNumbers then
        SharedPoints := DecodePackedPoints(Stream, NumPoints);

      for var i := 0 to Headers.Count - 1 do
      begin
        var Header := Headers[i];
        var Scalar := Header.CalculateScalar(NormalizedCoords);

        if Header.VariationDataSize = 0 then
          continue;

        var NextDataPos := Stream.Position + Header.VariationDataSize;

        if Scalar <> 0 then
        begin
          // Read points
          var Points: TArray<Integer>;
          if (Header.TupleIndex and PRIVATE_POINT_NUMBERS <> 0) then
            Points := DecodePackedPoints(Stream, NumPoints)
          else
            Points := SharedPoints;

          if (Length(Points) = 0) then
          begin
            // All points
            var DeltasX := DecodePackedDeltas(Stream, NumPoints);
            var DeltasY := DecodePackedDeltas(Stream, NumPoints);

            for var j := 0 to NumPoints - 1 do
            begin
              Result[j].X := Result[j].X + DeltasX[j] * Scalar;
              Result[j].Y := Result[j].Y + DeltasY[j] * Scalar;
            end;
          end else
          begin
            // Specified points
            var DeltasX := DecodePackedDeltas(Stream, Length(Points));
            var DeltasY := DecodePackedDeltas(Stream, Length(Points));

            var TupleDeltasX, TupleDeltasY: TArray<Single>;
            var VariedX, VariedY: TArray<Boolean>;
            SetLength(TupleDeltasX, NumPoints);
            SetLength(TupleDeltasY, NumPoints);
            SetLength(VariedX, NumPoints);
            SetLength(VariedY, NumPoints);
            for var j := 0 to NumPoints - 1 do
            begin
              TupleDeltasX[j] := 0;
              TupleDeltasY[j] := 0;
              VariedX[j] := False;
              VariedY[j] := False;
            end;

            for var j := 0 to High(Points) do
            begin
              var k := Points[j];
              if (k < NumPoints) then
              begin
                TupleDeltasX[k] := DeltasX[j];
                TupleDeltasY[k] := DeltasY[j];
                VariedX[k] := True;
                VariedY[k] := True;
              end;
            end;

            if (Length(ContourEndPoints) > 0) then
              IUP(TupleDeltasX, TupleDeltasY, DefaultPoints, ContourEndPoints, VariedX, VariedY);

            for var j := 0 to NumPoints - 1 do
            begin
              Result[j].X := Result[j].X + TupleDeltasX[j] * Scalar;
              Result[j].Y := Result[j].Y + TupleDeltasY[j] * Scalar;
            end;
          end;
        end;

        Stream.Position := NextDataPos;
      end;
    finally
      Headers.Free;
    end;
  finally
    Stream.Free;
  end;
end;

procedure TPascalTypeGlyphVariationTable.IUP(var DeltasX, DeltasY: TArray<Single>;
  const DefaultPoints: TArray<TFloatPoint>; const ContourEndPoints: TArray<Integer>;
  const VariedX, VariedY: TArray<Boolean>);

  procedure IUP_Internal(var Deltas: TArray<Single>; const DefaultCoords: TArray<Single>; StartPoint, EndPoint: Integer; const Varied: TArray<Boolean>);
  var
    i, j: Integer;
    FirstVaried, LastVaried: Integer;
    PrevVaried: Integer;
    c1, c2, cj: Single;
    d1, d2: Single;
    Scale: Single;
  begin
    FirstVaried := -1;
    LastVaried := -1;
    for i := StartPoint to EndPoint do
      if Varied[i] then
      begin
        if FirstVaried = -1 then
          FirstVaried := i;
        LastVaried := i;
      end;

    if FirstVaried = -1 then Exit;

    if FirstVaried = LastVaried then
    begin
      d1 := Deltas[FirstVaried];
      for i := StartPoint to EndPoint do
        if not Varied[i] then
          Deltas[i] := d1;
      Exit;
    end;

    PrevVaried := FirstVaried;
    for i := FirstVaried + 1 to LastVaried do
    begin
      if Varied[i] then
      begin
        if i > PrevVaried + 1 then
        begin
          c1 := DefaultCoords[PrevVaried];
          c2 := DefaultCoords[i];
          d1 := Deltas[PrevVaried];
          d2 := Deltas[i];
          if c1 > c2 then
          begin
            var tc := c1; c1 := c2; c2 := tc;
            var td := d1; d1 := d2; d2 := td;
          end;

          if c1 = c2 then
          begin
            for j := PrevVaried + 1 to i - 1 do
              Deltas[j] := d1;
          end else
          begin
            Scale := (d2 - d1) / (c2 - c1);
            for j := PrevVaried + 1 to i - 1 do
            begin
              cj := DefaultCoords[j];
              if cj <= c1 then
                Deltas[j] := d1
              else
              if cj >= c2 then
                Deltas[j] := d2
              else
                Deltas[j] := d1 + (cj - c1) * Scale;
            end;
          end;
        end;
        PrevVaried := i;
      end;
    end;

    c1 := DefaultCoords[LastVaried];
    c2 := DefaultCoords[FirstVaried];
    d1 := Deltas[LastVaried];
    d2 := Deltas[FirstVaried];
    if c1 > c2 then
    begin
      var tc := c1; c1 := c2; c2 := tc;
      var td := d1; d1 := d2; d2 := td;
    end;

    Scale := 0;
    if c1 <> c2 then
      Scale := (d2 - d1) / (c2 - c1);

    for j := LastVaried + 1 to EndPoint do
    begin
      cj := DefaultCoords[j];
      if c1 = c2 then
        Deltas[j] := d1
      else
      if cj <= c1 then
        Deltas[j] := d1
      else
      if cj >= c2 then
        Deltas[j] := d2
      else
        Deltas[j] := d1 + (cj - c1) * Scale;
    end;

    for j := StartPoint to FirstVaried - 1 do
    begin
      cj := DefaultCoords[j];
      if c1 = c2 then
        Deltas[j] := d1
      else
      if cj <= c1 then
        Deltas[j] := d1
      else
      if cj >= c2 then
        Deltas[j] := d2
      else
        Deltas[j] := d1 + (cj - c1) * Scale;
    end;
  end;

var
  StartPoint, EndPoint: Integer;
  CoordsX, CoordsY: TArray<Single>;
begin
  (*

    This absolute horor of a routine implements the TrueType Interpolate Unvaried Points (IUP) algorithm.

    IUP is actually a font hinting instruction but apparently, even though we don't support hinting,
    we still have to apply the algorithm in order to fully support TrueType Variations (gvar).

    I have so far not been able to find any good documentation for the stuff here, so good luck maintaining it.

    Here's the little documentation I have found:

    - Inferred deltas for un-referenced point numbers
      https://learn.microsoft.com/en-us/typography/opentype/spec/gvar#inferred-deltas-for-un-referenced-point-numbers

      "If deltas are provided for only some point numbers in a glyph outline,
       then delta values for un-referenced points may need to be inferred
       using interpolation. This is additional processing specific to the 'gvar'
       table, and is described below. [...]
       The process of calculating inferred variation deltas is somewhat
       comparable to the TrueType Interpolate Untouched Points (IUP) instruction."

  *)

  if (Length(ContourEndPoints) = 0) then
    Exit;

  SetLength(CoordsX, Length(DefaultPoints));
  SetLength(CoordsY, Length(DefaultPoints));
  for var i := 0 to High(DefaultPoints) do
  begin
    CoordsX[i] := DefaultPoints[i].X;
    CoordsY[i] := DefaultPoints[i].Y;
  end;

  StartPoint := 0;
  for var i := 0 to High(ContourEndPoints) do
  begin
    EndPoint := ContourEndPoints[i];
    if (EndPoint >= StartPoint) and (EndPoint < Length(DeltasX)) then
    begin
      IUP_Internal(DeltasX, CoordsX, StartPoint, EndPoint, VariedX);
      IUP_Internal(DeltasY, CoordsY, StartPoint, EndPoint, VariedY);
    end;
    StartPoint := EndPoint + 1;
  end;
end;

initialization

  PascalTypeTableClasses.RegisterTables([TPascalTypeGlyphVariationTable]);

end.