freepascal.compiler/packages/fcl-pdf/src/fpfonttextmapping.pp

{
    This file is part of the Free Component Library (FCL)
    Copyright (c) 2016 by Graeme Geldenhuys

    This unit defines classes that manage font glyph IDs and unicode
    character codes.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

{$IFNDEF FPC_DOTTEDUNITS}
unit FPFontTextMapping;
{$ENDIF FPC_DOTTEDUNITS}

{$mode objfpc}{$H+}

interface

{$IFDEF FPC_DOTTEDUNITS}
uses
  System.Classes,
  System.SysUtils,
  System.Contnrs;
{$ELSE FPC_DOTTEDUNITS}
uses
  Classes,
  SysUtils,
  contnrs;
{$ENDIF FPC_DOTTEDUNITS}

type

  TTextMapping = class(TObject)
  private
    FCharID: uint32;
    FGlyphID: uint32;
    FNewGlyphID: uint32;
    FGlyphData: TStream;
    FIsCompoundGlyph: boolean;
  public
    constructor Create;
    class function NewTextMap(const ACharID, AGlyphID: uint32): TTextMapping;
    property    CharID: uint32 read FCharID write FCharID;
    property    GlyphID: uint32 read FGlyphID write FGlyphID;
    property    NewGlyphID: uint32 read FNewGlyphID write FNewGlyphID;
    property    GlyphData: TStream read FGlyphData write FGlyphData;
    property    IsCompoundGlyph: boolean read FIsCompoundGlyph write FIsCompoundGlyph;
  end;


  TTextMappingList = class(TObject)
  private
    FList: TFPObjectList;
    function    GetCount: Integer;
  protected
    function    GetItem(AIndex: Integer): TTextMapping; virtual;
    procedure   SetItem(AIndex: Integer; AValue: TTextMapping); virtual;
  public
    constructor Create;
    destructor  Destroy; override;
    function    Add(AObject: TTextMapping): Integer; overload;
    function    Add(const ACharID, AGlyphID: uint32): Integer; overload;
    function    Contains(const AGlyphID: uint32): boolean;
    function    ContainsCharID(const AID: uint32): boolean;
    function    GetNewGlyphID(const ACharID: uint32): uint32;
    function    GetMaxCharID: uint32;
    function    GetMaxGlyphID: uint32;
    procedure   Insert(const AIndex: integer; const ACharID, AGlyphID: uint32);
    procedure   Sort;
    property    Count: Integer read GetCount;
    property    Items[AIndex: Integer]: TTextMapping read GetItem write SetItem; default;
  end;


implementation

{ TTextMapping }

constructor TTextMapping.Create;
begin
  FGlyphData := nil;
  FCharID := 0;
  FGlyphID := 0;
  FNewGlyphID := 0;
  FIsCompoundGlyph := False;
end;

class function TTextMapping.NewTextMap(const ACharID, AGlyphID: uint32): TTextMapping;
begin
  Result := TTextMapping.Create;
  Result.CharID := ACharID;
  Result.GlyphID := AGlyphID;
end;

{ TTextMappingList }

function TTextMappingList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TTextMappingList.GetItem(AIndex: Integer): TTextMapping;
begin
  Result := TTextMapping(FList.Items[AIndex]);
end;

procedure TTextMappingList.SetItem(AIndex: Integer; AValue: TTextMapping);
begin
  FList.Items[AIndex] := AValue;
end;

constructor TTextMappingList.Create;
begin
  FList := TFPObjectList.Create(True);
end;

destructor TTextMappingList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TTextMappingList.Add(AObject: TTextMapping): Integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to FList.Count-1 do
  begin
    if TTextMapping(FList.Items[i]).CharID = AObject.CharID then
      Exit; // mapping already exists
  end;
  Result := FList.Add(AObject);
end;

function TTextMappingList.Add(const ACharID, AGlyphID: uint32): Integer;
var
  o: TTextMapping;
begin
  o := TTextMapping.Create;
  o.CharID := ACharID;
  o.GlyphID := AGlyphID;
  Result := Add(o);
  if Result = -1 then
    o.Free;
end;

function TTextMappingList.Contains(const AGlyphID: uint32): boolean;
var
  i: integer;
begin
  Result := False;
  for i := 0 to Count-1 do
  begin
    if Items[i].GlyphID = AGlyphID then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

function TTextMappingList.ContainsCharID(const AID: uint32): boolean;
var
  i: integer;
begin
  Result := False;
  for i := 0 to Count-1 do
  begin
    if Items[i].CharID = AID then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

function TTextMappingList.GetNewGlyphID(const ACharID: uint32): uint32;
var
  i: integer;
begin
  for i := 0 to Count-1 do
  begin
    if Items[i].CharID = ACharID then
    begin
      Result := Items[i].NewGlyphID;
      Exit;
    end;
  end;
end;

function TTextMappingList.GetMaxCharID: uint32;
begin
  Sort;
  Result := Items[Count-1].CharID;
end;

function TTextMappingList.GetMaxGlyphID: uint32;
var
  gid: uint32;
  i: integer;
begin
  gid := 0;
  for i := 0 to Count-1 do
  begin
    if Items[i].GlyphID > gid then
      gid := Items[i].GlyphID;
  end;
  result := gid;
end;

procedure TTextMappingList.Insert(const AIndex: integer; const ACharID, AGlyphID: uint32);
var
  o: TTextMapping;
begin
  o := TTextMapping.Create;
  o.CharID := ACharID;
  o.GlyphID := AGlyphID;
  FList.Insert(AIndex, o);
end;

function CompareByCharID(A, B: TTextMapping): Integer; inline;
begin
  if A.CharID < B.CharID then
    Result := -1
  else if A.CharID > B.CharID then
    Result := 1
  else
    Result := 0;
end;

function CompareByCharIDPtr(A, B: Pointer): Integer;
begin
  Result := CompareByCharID(TTextMapping(A), TTextMapping(B));
end;

procedure TTextMappingList.Sort;
begin
  FList.Sort(@CompareByCharIDPtr);
end;

end.