PascalType.Tables.OpenType.STAT.pas

unit PascalType.Tables.OpenType.STAT;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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;

type
  TAxisRecord = packed record
    AxisTag: TTableType;
    AxisNameID: Word;
    AxisOrdering: Word;
  end;

  TCustomAxisValueTable = class(TCustomPascalTypeTable)
  private
    FFormat: Word;
    FAxisIndex: Word;
    FFlags: Word;
    FValueNameID: Word;
  protected
    property AxisIndex: Word read FAxisIndex;
  public
    procedure LoadFromStream(Stream: TStream; Size: Cardinal = 0); override;
    property Format: Word read FFormat;
    property Flags: Word read FFlags;
    property ValueNameID: Word read FValueNameID;
  end;

  TAxisValueFormat1Table = class(TCustomAxisValueTable)
  private
    FValue: TFixedPoint;
  public
    procedure LoadFromStream(Stream: TStream; Size: Cardinal = 0); override;
    property AxisIndex;
    property Value: TFixedPoint read FValue;
  end;

  TAxisValueFormat2Table = class(TCustomAxisValueTable)
  private
    FNominalValue: TFixedPoint;
    FRangeMinValue: TFixedPoint;
    FRangeMaxValue: TFixedPoint;
  public
    procedure LoadFromStream(Stream: TStream; Size: Cardinal = 0); override;
    property AxisIndex;
    property NominalValue: TFixedPoint read FNominalValue;
    property RangeMinValue: TFixedPoint read FRangeMinValue;
    property RangeMaxValue: TFixedPoint read FRangeMaxValue;
  end;

  TAxisValueFormat3Table = class(TCustomAxisValueTable)
  private
    FValue: TFixedPoint;
    FLinkedValue: TFixedPoint;
  public
    procedure LoadFromStream(Stream: TStream; Size: Cardinal = 0); override;
    property AxisIndex;
    property Value: TFixedPoint read FValue;
    property LinkedValue: TFixedPoint read FLinkedValue;
  end;

  TAxisValueRecord = record
    AxisIndex: Word;
    Value: TFixedPoint;
  end;

  TAxisValueFormat4Table = class(TCustomAxisValueTable)
  private
    FAxisValues: TArray<TAxisValueRecord>;
  public
    procedure LoadFromStream(Stream: TStream; Size: Cardinal = 0); override;
    property AxisValues: TArray<TAxisValueRecord> read FAxisValues;
  end;

  TPascalTypeStyleAttributesTable = class(TCustomPascalTypeNamedTable)
  private
    FMajorVersion: Word;
    FMinorVersion: Word;
    FDesignAxes: TArray<TAxisRecord>;
    FAxisValueTables: TObjectList<TCustomAxisValueTable>;
    FElidedFallbackNameID: Word;
    function GetAxisValueTableCount: Integer;
    function GetAxisValueTable(Index: Integer): TCustomAxisValueTable;
  public
    constructor Create(AParent: TCustomPascalTypeTable); override;
    destructor Destroy; override;

    class function GetTableType: TTableType; override;

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

    property AxisValueTableCount: Integer read GetAxisValueTableCount;
    property AxisValueTable[Index: Integer]: TCustomAxisValueTable read GetAxisValueTable;
  end;

implementation

uses
  PascalType.ResourceStrings;

{ TCustomAxisValueTable }

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

  FFormat := BigEndianValue.ReadWord(Stream);

  FAxisIndex := BigEndianValue.ReadWord(Stream);
  FFlags := BigEndianValue.ReadWord(Stream);
  FValueNameID := BigEndianValue.ReadWord(Stream);

  // Rest is format-specific
end;

{ TAxisValueFormat1Table }

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

  FValue.Fixed := BigEndianValue.ReadInteger(Stream);
end;

{ TAxisValueFormat2Table }

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

  FNominalValue.Fixed := BigEndianValue.ReadInteger(Stream);
  FRangeMinValue.Fixed := BigEndianValue.ReadInteger(Stream);
  FRangeMaxValue.Fixed := BigEndianValue.ReadInteger(Stream);
end;

{ TAxisValueFormat3Table }

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

  FValue.Fixed := BigEndianValue.ReadInteger(Stream);
  FLinkedValue.Fixed := BigEndianValue.ReadInteger(Stream);
end;

{ TAxisValueFormat4Table }

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

  SetLength(FAxisValues, FAxisIndex);
  for var i := 0 to High(FAxisValues) do
  begin
    FAxisValues[i].AxisIndex := BigEndianValue.ReadWord(Stream);
    FAxisValues[i].Value.Fixed := BigEndianValue.ReadInteger(Stream);
  end;
end;

{ TPascalTypeStyleAttributesTable }

constructor TPascalTypeStyleAttributesTable.Create(AParent: TCustomPascalTypeTable);
begin
  inherited;
  FAxisValueTables := TObjectList<TCustomAxisValueTable>.Create(True);
end;

destructor TPascalTypeStyleAttributesTable.Destroy;
begin
  FAxisValueTables.Free;
  inherited;
end;

function TPascalTypeStyleAttributesTable.GetAxisValueTableCount: Integer;
begin
  Result := FAxisValueTables.Count;
end;

function TPascalTypeStyleAttributesTable.GetAxisValueTable(Index: Integer): TCustomAxisValueTable;
begin
  Result := FAxisValueTables[Index];
end;

class function TPascalTypeStyleAttributesTable.GetTableType: TTableType;
begin
  Result.AsAnsiChar := 'STAT';
end;

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

  FMajorVersion := BigEndianValue.ReadWord(Stream);
  FMinorVersion := BigEndianValue.ReadWord(Stream);
  var DesignAxisSize := BigEndianValue.ReadWord(Stream);
  var DesignAxisCount := BigEndianValue.ReadWord(Stream);
  var DesignAxesOffset := BigEndianValue.ReadCardinal(Stream);
  var AxisValueCount := BigEndianValue.ReadWord(Stream);
  var AxisValueArrayOffset := BigEndianValue.ReadCardinal(Stream);

  if (FMajorVersion >= 1) and (FMinorVersion >= 1) then
    FElidedFallbackNameID := BigEndianValue.ReadWord(Stream)
  else
    FElidedFallbackNameID := 0;

  if DesignAxesOffset <> 0 then
  begin
    Stream.Position := StartPos + DesignAxesOffset;
    SetLength(FDesignAxes, DesignAxisCount);
    for var i := 0 to DesignAxisCount - 1 do
    begin
      Stream.Read(FDesignAxes[i].AxisTag, 4);
      FDesignAxes[i].AxisNameID := BigEndianValue.ReadWord(Stream);
      FDesignAxes[i].AxisOrdering := BigEndianValue.ReadWord(Stream);
      if DesignAxisSize > 8 then
        Stream.Seek(DesignAxisSize - 8, soFromCurrent);
    end;
  end;

  if (AxisValueArrayOffset <> 0) and (AxisValueCount > 0) then
  begin
    Stream.Position := StartPos + AxisValueArrayOffset;
    var Offsets: TArray<Word>;
    SetLength(Offsets, AxisValueCount);
    for var i := 0 to AxisValueCount - 1 do
      Offsets[i] := BigEndianValue.ReadWord(Stream);

    for var i := 0 to AxisValueCount - 1 do
    begin
      Stream.Position := StartPos + AxisValueArrayOffset + Offsets[i];
      var Format := BigEndianValue.ReadWord(Stream);
      var Table: TCustomAxisValueTable := nil;
      case Format of
        1: Table := TAxisValueFormat1Table.Create(Self);
        2: Table := TAxisValueFormat2Table.Create(Self);
        3: Table := TAxisValueFormat3Table.Create(Self);
        4: Table := TAxisValueFormat4Table.Create(Self);
      end;
      if Table <> nil then
      begin
        Table.FFormat := Format;
        Table.LoadFromStream(Stream);
        FAxisValueTables.Add(Table);
      end;
    end;
  end;
end;

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

initialization

  PascalTypeTableClasses.RegisterTables([TPascalTypeStyleAttributesTable]);

end.