paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-28 08:39:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix by Graeme Geldenhuys for bug ID #31092

Browse Source 
git-svn-id: trunk@35126 -
This commit is contained in:
michael 2016-12-14 17:42:57 +00:00
parent 12dba952f0
commit d90738c784
4 changed files with 333 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-pdf/examples/testfppdf.lpr
View File

@ -188,7 +188,7 @@ begin
P.SetColor(clBlack, false); P.SetColor(clBlack, false);
P.WriteText(15, 120, 'Languages: English: Hello, World!'); P.WriteText(15, 120, 'Languages: English: Hello, World!');
P.WriteText(40, 130, 'Greek: Γεια σου κόσμος'); P.WriteText(40, 130, 'Greek: Γειά σου κόσμος');
P.WriteText(40, 140, 'Polish: Witaj świecie'); P.WriteText(40, 140, 'Polish: Witaj świecie');
P.WriteText(40, 150, 'Portuguese: Olá mundo'); P.WriteText(40, 150, 'Portuguese: Olá mundo');
P.WriteText(40, 160, 'Russian: Здравствуйте мир'); P.WriteText(40, 160, 'Russian: Здравствуйте мир');

36
packages/fcl-pdf/src/fppdf.pp
View File

@ -1435,15 +1435,11 @@ begin
for i := 1 to Length(AText) do for i := 1 to Length(AText) do
begin begin
c := Word(AText[i]); c := Word(AText[i]);
//Result := Result + IntToHex(FTrueTypeFile.GetGlyphIndex(c), 4);
for n := 0 to FTextMappingList.Count-1 do for n := 0 to FTextMappingList.Count-1 do
begin begin
if FTextMappingList[n].CharID = c then if FTextMappingList[n].CharID = c then
begin begin
//if poSubsetFont in Document.Options then result := Result + IntToHex(FTextMappingList[n].GlyphID, 4);
// result := Result + IntToHex(FTextMappingList[n].NewGlyphID, 4);
//else
result := Result + IntToHex(FTextMappingList[n].GlyphID, 4);
break; break;
end; end;
end; end;
@ -4072,32 +4068,20 @@ begin
if poSubsetFont in Document.Options then if poSubsetFont in Document.Options then
begin begin
{ TODO: Future Improvement - We can reduce the entries in the beginbfrange
by actually using ranges for consecutive numbers.
eg:
<0051> <0053> <006E>
vs
<0051> <0051> <006E>
<0052> <0052> <006F>
<0053> <0053> <0070>
}
// use hex values in the output // use hex values in the output
WriteString(Format('%d beginbfrange', [lst.Count-1])+CRLF, AStream); WriteString(Format('%d beginbfrange', [lst.Count-1])+CRLF, AStream);
for i := 1 to lst.Count-1 do for i := 1 to lst.Count-1 do
WriteString(Format('<%s> <%0:s> <%s>', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)])+CRLF, AStream); WriteString(Format('<%s> <%0:s> <%s>', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)])+CRLF, AStream);
WriteString('endbfrange'+CRLF, AStream); WriteString('endbfrange'+CRLF, AStream);
//WriteString('12 beginbfrange'+CRLF, AStream);
//WriteString('<0003> <0004> <0020>'+CRLF, AStream);
//WriteString('<0011> <0011> <002E>'+CRLF, AStream);
//WriteString('<002A> <002B> <0047>'+CRLF, AStream);
//WriteString('<0037> <0037> <0054>'+CRLF, AStream);
//WriteString('<003A> <003A> <0057>'+CRLF, AStream);
//WriteString('<0044> <0044> <0061>'+CRLF, AStream);
//WriteString('<0047> <0048> <0064>'+CRLF, AStream);
//WriteString('<004B> <004C> <0068>'+CRLF, AStream);
//WriteString('<004F> <0052> <006C>'+CRLF, AStream);
//WriteString('<0055> <0056> <0072>'+CRLF, AStream);
//WriteString('<0058> <0058> <0075>'+CRLF, AStream);
//WriteString('<005C> <005C> <0079>'+CRLF, AStream);
//WriteString('endbfrange'+CRLF, AStream);
//WriteString('1 beginbfrange'+CRLF, AStream);
//WriteString('<0000> <FFFF> <0000>'+CRLF, AStream);
//WriteString('endbfrange'+CRLF, AStream);
end end
else else
begin begin

368
packages/fcl-pdf/src/fpttfsubsetter.pp
View File

@ -28,6 +28,7 @@ interface
uses uses
Classes, Classes,
SysUtils, SysUtils,
contnrs,
fpparsettf, fpparsettf,
FPFontTextMapping; FPFontTextMapping;
@ -36,6 +37,10 @@ type
TArrayUInt32 = array of UInt32; TArrayUInt32 = array of UInt32;
// forward declaration
TGIDList = class;
TGIDListEnumerator = class;
TFontSubsetter = class(TObject) TFontSubsetter = class(TObject)
private private
@ -46,6 +51,7 @@ type
FGlyphIDList: TTextMappingList; FGlyphIDList: TTextMappingList;
FStream: TFileStream; // original TTF file FStream: TFileStream; // original TTF file
FGlyphLocations: array of UInt32; FGlyphLocations: array of UInt32;
FGlyphIDs: TGIDList;
function Int32HighestOneBit(const AValue: integer): integer; function Int32HighestOneBit(const AValue: integer): integer;
function Int32Log2(const AValue: integer): integer; function Int32Log2(const AValue: integer): integer;
function ToUInt32(const AHigh, ALow: UInt32): UInt32; function ToUInt32(const AHigh, ALow: UInt32): UInt32;
@ -53,7 +59,9 @@ type
function GetRawTable(const ATableName: AnsiString): TMemoryStream; function GetRawTable(const ATableName: AnsiString): TMemoryStream;
function WriteFileHeader(AOutStream: TStream; const nTables: integer): uint32; function WriteFileHeader(AOutStream: TStream; const nTables: integer): uint32;
function WriteTableHeader(AOutStream: TStream; const ATag: AnsiString; const AOffset: UInt32; const AData: TStream): int64; function WriteTableHeader(AOutStream: TStream; const ATag: AnsiString; const AOffset: UInt32; const AData: TStream): int64;
function GetNewGlyphId(const OldGid: integer): Integer;
procedure WriteTableBodies(AOutStream: TStream; const ATables: TStringList); procedure WriteTableBodies(AOutStream: TStream; const ATables: TStringList);
procedure UpdateOrigGlyphIDList;
// AGlyphID is the original GlyphID in the original TTF file // AGlyphID is the original GlyphID in the original TTF file
function GetCharIDfromGlyphID(const AGlyphID: uint32): uint32; function GetCharIDfromGlyphID(const AGlyphID: uint32): uint32;
{ Copy glyph data as-is for a specific glyphID. } { Copy glyph data as-is for a specific glyphID. }
@ -61,8 +69,9 @@ type
procedure LoadLocations; procedure LoadLocations;
// Stream writing functions. // Stream writing functions.
procedure WriteInt16(AStream: TStream; const AValue: Int16); inline; procedure WriteInt16(AStream: TStream; const AValue: Int16); inline;
procedure WriteUInt32(AStream: TStream; const AValue: UInt32); inline;
procedure WriteUInt16(AStream: TStream; const AValue: UInt16); inline; procedure WriteUInt16(AStream: TStream; const AValue: UInt16); inline;
procedure WriteInt32(AStream: TStream; const AValue: Int32); inline;
procedure WriteUInt32(AStream: TStream; const AValue: UInt32); inline;
function ReadInt16(AStream: TStream): Int16; inline; function ReadInt16(AStream: TStream): Int16; inline;
function ReadUInt32(AStream: TStream): UInt32; inline; function ReadUInt32(AStream: TStream): UInt32; inline;
function ReadUInt16(AStream: TStream): UInt16; inline; function ReadUInt16(AStream: TStream): UInt16; inline;
@ -91,6 +100,56 @@ type
end; end;
TGIDItem = class(TObject)
private
FGID: integer;
FGlyphData: TMemoryStream;
FIsCompoundGlyph: boolean;
FNewGID: integer;
public
constructor Create;
destructor Destroy; override;
property IsCompoundGlyph: boolean read FIsCompoundGlyph write FIsCompoundGlyph;
property GID: integer read FGID write FGID;
property GlyphData: TMemoryStream read FGlyphData write FGlyphData;
property NewGID: integer read FNewGID write FNewGID;
end;
TGIDList = class(TObject)
private
FList: TFPObjectList;
function GetCount: integer;
function GetItems(i: integer): TGIDItem;
procedure SetItems(i: integer; const AValue: TGIDItem);
public
constructor Create;
destructor Destroy; override;
function Add(const GID: Integer): integer; overload;
function Add(const AObject: TGIDItem): integer; overload;
procedure Clear;
function Contains(const GID: integer): boolean;
function GetEnumerator: TGIDListEnumerator;
function GetNewGlyphID(const OriginalGID: integer): integer;
procedure Sort;
property Count: integer read GetCount;
property Items[i: integer]: TGIDItem read GetItems write SetItems; default;
end;
TGIDListEnumerator = class(TObject)
private
FIndex: Integer;
FList: TGIDList;
public
constructor Create(AList: TGIDList);
function GetCurrent: TGIDItem;
function MoveNext: Boolean;
property Current: TGIDItem read GetCurrent;
end;
implementation implementation
@ -221,6 +280,21 @@ begin
Result := ToUInt32(ATag) + checksum + checksum + AOffset + AData.Size; Result := ToUInt32(ATag) + checksum + checksum + AOffset + AData.Size;
end; end;
function TFontSubsetter.GetNewGlyphId(const OldGid: integer): Integer;
var
itm: TGIDItem;
begin
result := -1;
for itm in FGlyphIDs do
begin
if itm.GID = OldGID then
begin
Result := itm.NewGID;
exit;
end;
end;
end;
procedure TFontSubsetter.WriteTableBodies(AOutStream: TStream; const ATables: TStringList); procedure TFontSubsetter.WriteTableBodies(AOutStream: TStream; const ATables: TStringList);
var var
i: integer; i: integer;
@ -246,6 +320,27 @@ begin
end; end;
end; end;
{ This updates the original GlyphIDList passed in to the constructor - normally
done by fcl-pdf. This allows fcl-pdf to use the NewGlyphID values in its
generated PDF output. }
procedure TFontSubsetter.UpdateOrigGlyphIDList;
var
i: integer;
itm: TGIDItem;
begin
for itm in FGlyphIDs do
begin
for i := 0 to FGlyphIDList.Count-1 do
begin
if FGlyphIDList[i].GlyphID = itm.GID then
begin
FGlyphIDList[i].NewGlyphID := itm.NewGID;
break;
end;
end;
end;
end;
function TFontSubsetter.GetCharIDfromGlyphID(const AGlyphID: uint32): uint32; function TFontSubsetter.GetCharIDfromGlyphID(const AGlyphID: uint32): uint32;
var var
i: integer; i: integer;
@ -343,16 +438,21 @@ begin
AStream.WriteBuffer(NtoBE(AValue), 2); AStream.WriteBuffer(NtoBE(AValue), 2);
end; end;
procedure TFontSubsetter.WriteUInt32(AStream: TStream; const AValue: UInt32);
begin
AStream.WriteDWord(NtoBE(AValue));
end;
procedure TFontSubsetter.WriteUInt16(AStream: TStream; const AValue: UInt16); procedure TFontSubsetter.WriteUInt16(AStream: TStream; const AValue: UInt16);
begin begin
AStream.WriteWord(NtoBE(AValue)); AStream.WriteWord(NtoBE(AValue));
end; end;
procedure TFontSubsetter.WriteInt32(AStream: TStream; const AValue: Int32);
begin
AStream.WriteBuffer(NtoBE(AValue), 4);
end;
procedure TFontSubsetter.WriteUInt32(AStream: TStream; const AValue: UInt32);
begin
AStream.WriteDWord(NtoBE(AValue));
end;
function TFontSubsetter.ReadInt16(AStream: TStream): Int16; function TFontSubsetter.ReadInt16(AStream: TStream): Int16;
begin begin
Result:=Int16(ReadUInt16(AStream)); Result:=Int16(ReadUInt16(AStream));
@ -381,12 +481,11 @@ var
i: integer; i: integer;
flags: uint16; flags: uint16;
glyphIndex: uint16; glyphIndex: uint16;
cid: uint16;
hasNested: boolean; hasNested: boolean;
begin begin
if FhasAddedCompoundReferences then if FHasAddedCompoundReferences then
Exit; Exit;
FhasAddedCompoundReferences := True; FHasAddedCompoundReferences := True;
LoadLocations; LoadLocations;
@ -395,31 +494,32 @@ begin
GlyphIDsToAdd.Duplicates := dupIgnore; GlyphIDsToAdd.Duplicates := dupIgnore;
GlyphIDsToAdd.Sorted := True; GlyphIDsToAdd.Sorted := True;
for n := 0 to FGlyphIDList.Count-1 do for n := 0 to FGlyphIDs.Count-1 do
begin begin
if not Assigned(FGlyphIDList[n].GlyphData) then if not Assigned(FGlyphIDs[n].GlyphData) then
FGlyphIDList[n].GlyphData := GetRawGlyphData(FGlyphIDList[n].GlyphID); FGlyphIDs[n].GlyphData := GetRawGlyphData(FGlyphIDs[n].GID);
gs := TMemoryStream(FGlyphIDList[n].GlyphData); gs := FGlyphIDs[n].GlyphData;
gs.Position := 0; gs.Position := 0;
if gs.Size > 0 then if gs.Size > 0 then
begin begin
FillMem(@buf, SizeOf(TGlyphHeader), 0); FillMem(@buf, SizeOf(TGlyphHeader), 0);
gs.ReadBuffer(buf, SizeOf(Buf)); gs.ReadBuffer(buf, SizeOf(Buf));
{$IFDEF gDEBUG}
writeln(' glyph data size: ', gs.Size);
{$ENDIF}
if buf.numberOfContours = -1 then if buf.numberOfContours = -1 then
begin begin
FGlyphIDList[n].IsCompoundGlyph := True; FGlyphIDs[n].IsCompoundGlyph := True;
{$IFDEF gDEBUG} {$IFDEF gDEBUG}
writeln('char: ', IntToHex(FGlyphIDList[n].CharID, 4));
writeln(' glyph data size: ', gs.Size);
writeln(' numberOfContours: ', buf.numberOfContours); writeln(' numberOfContours: ', buf.numberOfContours);
{$ENDIF} {$ENDIF}
repeat repeat
flags := ReadUInt16(gs); flags := ReadUInt16(gs);
glyphIndex := ReadUInt16(gs); glyphIndex := ReadUInt16(gs);
// find compound glyph ID's and add them to the GlyphIDsToAdd list // find compound glyph IDs and add them to the GlyphIDsToAdd list
if not FGlyphIDList.Contains(glyphIndex) then if not FGlyphIDs.Contains(glyphIndex) then
begin begin
{$IFDEF gDEBUG} {$IFDEF gDEBUG}
writeln(Format(' glyphIndex: %.4x (%0:d) ', [glyphIndex])); writeln(Format(' glyphIndex: %.4x (%0:d) ', [glyphIndex]));
@ -451,18 +551,21 @@ begin
until (flags and (1 shl 5)) = 0; // MORE_COMPONENTS until (flags and (1 shl 5)) = 0; // MORE_COMPONENTS
end; { if buf.numberOfContours = -1 } end; { if buf.numberOfContours = -1 }
end; { if gs.Size > 0 } end; { if gs.Size > 0 }
end; { for n ... FGlyphIDList.Count-1 } end; { for n ... FGlyphIDs.Count-1 }
if GlyphIDsToAdd.Count > 0 then if GlyphIDsToAdd.Count > 0 then
begin begin
for i := 0 to GlyphIDsToAdd.Count-1 do for i := 0 to GlyphIDsToAdd.Count-1 do
begin begin
glyphIndex := StrToInt(GlyphIDsToAdd[i]); glyphIndex := StrToInt(GlyphIDsToAdd[i]);
cid := GetCharIDfromGlyphID(glyphIndex); // lookup original charID FGlyphIDs.Add(glyphIndex);
FGlyphIDList.Add(cid, glyphIndex);
end; end;
end; end;
hasNested := GlyphIDsToAdd.Count > 0; hasNested := GlyphIDsToAdd.Count > 0;
{$IFDEF gDEBUG}
if hasNested then
writeln('------------------');
{$ENDIF}
FreeAndNil(GlyphIDsToAdd); FreeAndNil(GlyphIDsToAdd);
until (hasNested = false); until (hasNested = false);
end; end;
@ -521,8 +624,8 @@ begin
rec.metricDataFormat := NtoBE(t.metricDataFormat); rec.metricDataFormat := NtoBE(t.metricDataFormat);
// rec.numberOfHMetrics := NtoBE(t.numberOfHMetrics); // rec.numberOfHMetrics := NtoBE(t.numberOfHMetrics);
hmetrics := FGlyphIDList.Count; hmetrics := FGlyphIDs.Count;
if (FGlyphIDList.Items[FGlyphIDList.Count-1].GlyphID >= t.numberOfHMetrics) and (not FGlyphIDList.Contains(t.numberOfHMetrics-1)) then if (FGlyphIDs.Items[FGlyphIDs.Count-1].GID >= t.numberOfHMetrics) and (not FGlyphIDs.Contains(t.numberOfHMetrics-1)) then
inc(hmetrics); inc(hmetrics);
rec.numberOfHMetrics := NtoBE(hmetrics); rec.numberOfHMetrics := NtoBE(hmetrics);
@ -541,7 +644,7 @@ begin
FillMem(@rec, SizeOf(TMaxP), 0); FillMem(@rec, SizeOf(TMaxP), 0);
rec.VersionNumber.Version := NtoBE(t.VersionNumber.Version); rec.VersionNumber.Version := NtoBE(t.VersionNumber.Version);
lCount := FGlyphIDList.Count; lCount := FGlyphIDs.Count;
rec.numGlyphs := NtoBE(lCount); rec.numGlyphs := NtoBE(lCount);
rec.maxPoints := NtoBE(t.maxPoints); rec.maxPoints := NtoBE(t.maxPoints);
@ -594,19 +697,23 @@ begin
LoadLocations; LoadLocations;
{ - Assign new glyph indexes { - Assign new glyph indexes
- Retrieve glyph data in it doesn't yet exist (retrieved from original TTF file) - Retrieve glyph data if it doesn't yet exist (retrieved from original TTF file) }
- Now fix GlyphID references in Compound Glyphs to point to new GlyphIDs } for n := 0 to FGlyphIDs.Count-1 do
for n := 0 to FGlyphIDList.Count-1 do
begin begin
FGlyphIDList[n].NewGlyphID := n; FGlyphIDs[n].NewGID := n;
if not Assigned(FGlyphIDList[n].GlyphData) then if not Assigned(FGlyphIDs[n].GlyphData) then
FGlyphIDList[n].GlyphData := GetRawGlyphData(FGlyphIDList[n].GlyphID); FGlyphIDs[n].GlyphData := GetRawGlyphData(FGlyphIDs[n].GID);
if not FGlyphIDList[n].IsCompoundGlyph then end;
{ - Now fix GlyphID references in Compound Glyphs to point to new GlyphIDs }
for n := 0 to FGlyphIDs.Count-1 do
begin
if not FGlyphIDs[n].IsCompoundGlyph then
Continue; Continue;
{$IFDEF gDEBUG} {$IFDEF gDEBUG}
writeln(Format('found compound glyph: %.4x glyphID: %d', [FGlyphIDList[n].CharID, FGlyphIDList[n].GlyphID])); writeln(Format('found compound glyph: %.4x glyphID: %d', [0, FGlyphIDs[n].GID]));
{$ENDIF} {$ENDIF}
gs := TMemoryStream(FGlyphIDList[n].GlyphData); gs := TMemoryStream(FGlyphIDs[n].GlyphData);
gs.Position := 0; gs.Position := 0;
if gs.Size > 0 then if gs.Size > 0 then
@ -622,7 +729,7 @@ begin
glyphIndex := ReadUInt16(gs); glyphIndex := ReadUInt16(gs);
// now write new GlyphID in it's place. // now write new GlyphID in it's place.
gs.Position := lOffset; gs.Position := lOffset;
glyphIndex := FGlyphIDList.GetNewGlyphID(GetCharIDfromGlyphID(glyphIndex)); glyphIndex := FGlyphIDs.GetNewGlyphID(glyphIndex);
WriteUInt16(gs, glyphIndex); WriteUInt16(gs, glyphIndex);
// ARG_1_AND_2_ARE_WORDS // ARG_1_AND_2_ARE_WORDS
@ -654,12 +761,12 @@ begin
// write all glyph data to resulting data stream // write all glyph data to resulting data stream
lOffset := 0; lOffset := 0;
for n := 0 to FGlyphIDList.Count-1 do for n := 0 to FGlyphIDs.Count-1 do
begin begin
newOffsets[n] := lOffset; newOffsets[n] := lOffset;
lOffset := lOffset + FGlyphIDList[n].GlyphData.Size; lOffset := lOffset + FGlyphIDs[n].GlyphData.Size;
FGlyphIDList[n].GlyphData.Position := 0; FGlyphIDs[n].GlyphData.Position := 0;
Result.CopyFrom(FGlyphIDList[n].GlyphData, FGlyphIDList[n].GlyphData.Size); Result.CopyFrom(FGlyphIDs[n].GlyphData, FGlyphIDs[n].GlyphData.Size);
// 4-byte alignment // 4-byte alignment
if (lOffset mod 4) <> 0 then if (lOffset mod 4) <> 0 then
begin begin
@ -717,6 +824,7 @@ var
lastChar: integer; lastChar: integer;
prevChar: integer; prevChar: integer;
lastGid: integer; lastGid: integer;
curGid: integer;
itm: TTextMapping; itm: TTextMapping;
begin begin
Result := TMemoryStream.Create; Result := TMemoryStream.Create;
@ -736,7 +844,7 @@ begin
// build Format 4 subtable (Unicode BMP) // build Format 4 subtable (Unicode BMP)
lastChar := 0; lastChar := 0;
prevChar := lastChar; prevChar := lastChar;
lastGid := FGlyphIDList[0].NewGlyphID; lastGid := GetNewGlyphId(FGlyphIDList[0].GlyphID);
segCount := 0; segCount := 0;
for i := 0 to FGlyphIDList.Count-1 do for i := 0 to FGlyphIDList.Count-1 do
@ -744,8 +852,9 @@ begin
itm := FGlyphIDList[i]; itm := FGlyphIDList[i];
if itm.CharID > $FFFF then if itm.CharID > $FFFF then
raise Exception.Create('non-BMP Unicode character'); raise Exception.Create('non-BMP Unicode character');
curGid := GetNewGlyphId(itm.GlyphID);
if (itm.CharID <> FGlyphIDList[prevChar].CharID+1) or ((itm.NewGlyphID - lastGid) <> (itm.CharID - FGlyphIDList[lastChar].CharID)) then if (itm.CharID <> FGlyphIDList[prevChar].CharID+1) or ((curGid - lastGid) <> (itm.CharID - FGlyphIDList[lastChar].CharID)) then
begin begin
if (lastGid <> 0) then if (lastGid <> 0) then
begin begin
@ -763,7 +872,7 @@ begin
idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID; idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID;
inc(segCount); inc(segCount);
end; end;
lastGid := itm.NewGlyphID; lastGid := curGid;
lastChar := i; lastChar := i;
end; end;
prevChar := i; prevChar := i;
@ -829,16 +938,21 @@ begin
end; end;
constructor TFontSubsetter.Create(const AFont: TTFFileInfo; const AGlyphIDList: TTextMappingList); constructor TFontSubsetter.Create(const AFont: TTFFileInfo; const AGlyphIDList: TTextMappingList);
var
i: integer;
begin begin
FFontInfo := AFont; FFontInfo := AFont;
if not Assigned(FFontInfo) then if not Assigned(FFontInfo) then
raise ETTFSubsetter.Create(rsErrFontInfoNotAssigned); raise ETTFSubsetter.Create(rsErrFontInfoNotAssigned);
FGlyphIDList := AGlyphIDList; FGlyphIDList := AGlyphIDList;
FGlyphIDs := TGIDList.Create;
// always copy GID 0
FGlyphIDs.Add(0);
FKeepTables := TStringList.Create; FKeepTables := TStringList.Create;
FHasAddedCompoundReferences := False; FHasAddedCompoundReferences := False;
FPrefix := ''; FPrefix := '';
FhasAddedCompoundReferences := False;
// create a default list // create a default list
FKeepTables.Add('head'); FKeepTables.Add('head');
@ -853,7 +967,11 @@ begin
FKeepTables.Add('glyf'); FKeepTables.Add('glyf');
if Assigned(FGlyphIDList) then if Assigned(FGlyphIDList) then
begin
FGlyphIDList.Sort; FGlyphIDList.Sort;
for i := 0 to FGlyphIDList.Count-1 do
FGlyphIDs.Add(FGlyphIDList[i].GlyphID);
end;
if FFontInfo.Filename <> '' then if FFontInfo.Filename <> '' then
FStream := TFileStream.Create(FFontInfo.FileName, fmOpenRead or fmShareDenyNone) FStream := TFileStream.Create(FFontInfo.FileName, fmOpenRead or fmShareDenyNone)
@ -875,6 +993,7 @@ begin
FGlyphIDList[i].GlyphData.Free; FGlyphIDList[i].GlyphData.Free;
FStream.Free; FStream.Free;
FKeepTables.Free; FKeepTables.Free;
FreeAndNil(FGlyphIDs);
inherited Destroy; inherited Destroy;
end; end;
@ -911,6 +1030,8 @@ var
p: uint64; p: uint64;
lPadding: byte; lPadding: byte;
begin begin
FGlyphIDs.Sort;
// resolve compound glyph references // resolve compound glyph references
AddCompoundReferences; AddCompoundReferences;
@ -918,16 +1039,16 @@ begin
FGlyphIDList.Add(0, 0); FGlyphIDList.Add(0, 0);
FGlyphIDList.Sort; FGlyphIDList.Sort;
SetLength(newLoca, FGlyphIDList.Count+1); SetLength(newLoca, FGlyphIDs.Count+1);
head := buildHeadTable(); // done head := buildHeadTable();
hhea := buildHheaTable(); // done hhea := buildHheaTable();
maxp := buildMaxpTable(); // done maxp := buildMaxpTable();
fpgm := buildFpgmTable(); // done fpgm := buildFpgmTable();
prep := buildPrepTable(); // done prep := buildPrepTable();
cvt := buildCvtTable(); // done cvt := buildCvtTable();
glyf := buildGlyfTable(newLoca); // done glyf := buildGlyfTable(newLoca);
loca := buildLocaTable(newLoca); // done loca := buildLocaTable(newLoca);
cmap := buildCmapTable(); cmap := buildCmapTable();
hmtx := buildHmtxTable(); hmtx := buildHmtxTable();
@ -971,7 +1092,7 @@ begin
// update head.ChecksumAdjustment field // update head.ChecksumAdjustment field
head.Seek(8, soBeginning); head.Seek(8, soBeginning);
WriteUInt32(head, checksum); WriteInt32(head, checksum);
// write table bodies // write table bodies
WriteTableBodies(AStream, tables); WriteTableBodies(AStream, tables);
@ -979,6 +1100,8 @@ begin
for i := 0 to tables.Count-1 do for i := 0 to tables.Count-1 do
TStream(tables.Objects[i]).Free; TStream(tables.Objects[i]).Free;
tables.Free; tables.Free;
UpdateOrigGlyphIDList;
end; end;
procedure TFontSubsetter.Add(const ACodePoint: uint32); procedure TFontSubsetter.Add(const ACodePoint: uint32);
@ -987,7 +1110,148 @@ var
begin begin
gid := FFontInfo.Chars[ACodePoint]; gid := FFontInfo.Chars[ACodePoint];
if gid <> 0 then if gid <> 0 then
begin
FGlyphIDList.Add(ACodePoint, FFontInfo.Chars[ACodePoint]); FGlyphIDList.Add(ACodePoint, FFontInfo.Chars[ACodePoint]);
FGlyphIDs.Add(gid);
end;
end;
{ TGIDList }
function TGIDList.GetCount: integer;
begin
Result := FList.Count;
end;
function TGIDList.GetItems(i: integer): TGIDItem;
begin
Result := FList[i] as TGIDItem;
end;
procedure TGIDList.SetItems(i: integer; const AValue: TGIDItem);
begin
FList[i] := AValue;
end;
constructor TGIDList.Create;
begin
FList := TFPObjectList.Create;
end;
destructor TGIDList.Destroy;
begin
FList.Free;
inherited Destroy;
end;
function TGIDList.Add(const GID: Integer): integer;
var
itm: TGIDItem;
begin
itm := TGIDItem.Create;
itm.GID := GID;
result := Add(itm);
end;
function TGIDList.Add(const AObject: TGIDItem): integer;
begin
Result := FList.Add(AObject);
end;
procedure TGIDList.Clear;
begin
FList.Clear;
end;
function TGIDList.Contains(const GID: integer): boolean;
var
itm: TGIDItem;
begin
Result := False;
for itm in self do
begin
if itm.GID = GID then
begin
Result := True;
Exit;
end;
end;
end;
function TGIDList.GetEnumerator: TGIDListEnumerator;
begin
Result := TGIDListEnumerator.Create(self);
end;
function TGIDList.GetNewGlyphID(const OriginalGID: integer): integer;
var
itm: TGIDItem;
begin
Result := -1;
for itm in self do
begin
if itm.GID = OriginalGID then
begin
Result := itm.NewGID;
Exit;
end;
end;
end;
function CompareByGID(A, B: TGIDItem): Integer; inline;
begin
if A.GID < B.GID then
Result := -1
else if A.GID > B.GID then
Result := 1
else
Result := 0;
end;
function CompareByGIDPtr(A, B: Pointer): Integer;
begin
Result := CompareByGID(TGIDItem(A), TGIDItem(B));
end;
procedure TGIDList.Sort;
begin
FList.Sort(@CompareByGIDPtr);
end;
{ TGIDListEnumerator }
constructor TGIDListEnumerator.Create(AList: TGIDList);
begin
FIndex := -1;
FList := AList;
end;
function TGIDListEnumerator.GetCurrent: TGIDItem;
begin
Result := FList[FIndex];
end;
function TGIDListEnumerator.MoveNext: Boolean;
begin
Result := FIndex < (FList.Count-1);
if Result then
Inc(FIndex);
end;
{ TGIDItem }
constructor TGIDItem.Create;
begin
FGID := -1;
FNewGID := -1;
FGlyphData := nil;
FIsCompoundGlyph := False;
end;
destructor TGIDItem.Destroy;
begin
FreeAndNil(FGlyphData);
inherited Destroy;
end; end;

6
packages/fcl-pdf/utils/ttfdump.lpi
View File

@ -57,6 +57,12 @@
<AllowLabel Value="False"/> <AllowLabel Value="False"/>
</SyntaxOptions> </SyntaxOptions>
</Parsing> </Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>
<UseHeaptrc Value="True"/> <UseHeaptrc Value="True"/>