diff --git a/packages/fcl-pdf/examples/testfppdf.lpr b/packages/fcl-pdf/examples/testfppdf.lpr index b3da161e00..652ea16d13 100644 --- a/packages/fcl-pdf/examples/testfppdf.lpr +++ b/packages/fcl-pdf/examples/testfppdf.lpr @@ -188,7 +188,7 @@ begin P.SetColor(clBlack, false); 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, 150, 'Portuguese: Olá mundo'); P.WriteText(40, 160, 'Russian: Здравствуйте мир'); diff --git a/packages/fcl-pdf/src/fppdf.pp b/packages/fcl-pdf/src/fppdf.pp index f30187c9f6..09cb314a76 100644 --- a/packages/fcl-pdf/src/fppdf.pp +++ b/packages/fcl-pdf/src/fppdf.pp @@ -1435,15 +1435,11 @@ begin for i := 1 to Length(AText) do begin c := Word(AText[i]); - //Result := Result + IntToHex(FTrueTypeFile.GetGlyphIndex(c), 4); for n := 0 to FTextMappingList.Count-1 do begin if FTextMappingList[n].CharID = c then begin - //if poSubsetFont in Document.Options then - // result := Result + IntToHex(FTextMappingList[n].NewGlyphID, 4); - //else - result := Result + IntToHex(FTextMappingList[n].GlyphID, 4); + result := Result + IntToHex(FTextMappingList[n].GlyphID, 4); break; end; end; @@ -4072,32 +4068,20 @@ begin if poSubsetFont in Document.Options then 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 - WriteString(Format('%d beginbfrange', [lst.Count-1])+CRLF, AStream); 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('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> <0000>'+CRLF, AStream); -//WriteString('endbfrange'+CRLF, AStream); - end else begin diff --git a/packages/fcl-pdf/src/fpttfsubsetter.pp b/packages/fcl-pdf/src/fpttfsubsetter.pp index 2be015f24c..d44465ac87 100644 --- a/packages/fcl-pdf/src/fpttfsubsetter.pp +++ b/packages/fcl-pdf/src/fpttfsubsetter.pp @@ -28,6 +28,7 @@ interface uses Classes, SysUtils, + contnrs, fpparsettf, FPFontTextMapping; @@ -36,6 +37,10 @@ type TArrayUInt32 = array of UInt32; + // forward declaration + TGIDList = class; + TGIDListEnumerator = class; + TFontSubsetter = class(TObject) private @@ -46,6 +51,7 @@ type FGlyphIDList: TTextMappingList; FStream: TFileStream; // original TTF file FGlyphLocations: array of UInt32; + FGlyphIDs: TGIDList; function Int32HighestOneBit(const AValue: integer): integer; function Int32Log2(const AValue: integer): integer; function ToUInt32(const AHigh, ALow: UInt32): UInt32; @@ -53,7 +59,9 @@ type function GetRawTable(const ATableName: AnsiString): TMemoryStream; function WriteFileHeader(AOutStream: TStream; const nTables: integer): uint32; 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 UpdateOrigGlyphIDList; // AGlyphID is the original GlyphID in the original TTF file function GetCharIDfromGlyphID(const AGlyphID: uint32): uint32; { Copy glyph data as-is for a specific glyphID. } @@ -61,8 +69,9 @@ type procedure LoadLocations; // Stream writing functions. 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 WriteInt32(AStream: TStream; const AValue: Int32); inline; + procedure WriteUInt32(AStream: TStream; const AValue: UInt32); inline; function ReadInt16(AStream: TStream): Int16; inline; function ReadUInt32(AStream: TStream): UInt32; inline; function ReadUInt16(AStream: TStream): UInt16; inline; @@ -91,6 +100,56 @@ type 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 @@ -221,6 +280,21 @@ begin Result := ToUInt32(ATag) + checksum + checksum + AOffset + AData.Size; 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); var i: integer; @@ -246,6 +320,27 @@ begin 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; var i: integer; @@ -343,16 +438,21 @@ begin AStream.WriteBuffer(NtoBE(AValue), 2); end; -procedure TFontSubsetter.WriteUInt32(AStream: TStream; const AValue: UInt32); -begin - AStream.WriteDWord(NtoBE(AValue)); -end; - procedure TFontSubsetter.WriteUInt16(AStream: TStream; const AValue: UInt16); begin AStream.WriteWord(NtoBE(AValue)); 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; begin Result:=Int16(ReadUInt16(AStream)); @@ -381,12 +481,11 @@ var i: integer; flags: uint16; glyphIndex: uint16; - cid: uint16; hasNested: boolean; begin - if FhasAddedCompoundReferences then + if FHasAddedCompoundReferences then Exit; - FhasAddedCompoundReferences := True; + FHasAddedCompoundReferences := True; LoadLocations; @@ -395,31 +494,32 @@ begin GlyphIDsToAdd.Duplicates := dupIgnore; GlyphIDsToAdd.Sorted := True; - for n := 0 to FGlyphIDList.Count-1 do + for n := 0 to FGlyphIDs.Count-1 do begin - if not Assigned(FGlyphIDList[n].GlyphData) then - FGlyphIDList[n].GlyphData := GetRawGlyphData(FGlyphIDList[n].GlyphID); - gs := TMemoryStream(FGlyphIDList[n].GlyphData); + if not Assigned(FGlyphIDs[n].GlyphData) then + FGlyphIDs[n].GlyphData := GetRawGlyphData(FGlyphIDs[n].GID); + gs := FGlyphIDs[n].GlyphData; gs.Position := 0; if gs.Size > 0 then begin FillMem(@buf, SizeOf(TGlyphHeader), 0); gs.ReadBuffer(buf, SizeOf(Buf)); + {$IFDEF gDEBUG} + writeln(' glyph data size: ', gs.Size); + {$ENDIF} if buf.numberOfContours = -1 then begin - FGlyphIDList[n].IsCompoundGlyph := True; + FGlyphIDs[n].IsCompoundGlyph := True; {$IFDEF gDEBUG} - writeln('char: ', IntToHex(FGlyphIDList[n].CharID, 4)); - writeln(' glyph data size: ', gs.Size); writeln(' numberOfContours: ', buf.numberOfContours); {$ENDIF} repeat flags := ReadUInt16(gs); glyphIndex := ReadUInt16(gs); - // find compound glyph ID's and add them to the GlyphIDsToAdd list - if not FGlyphIDList.Contains(glyphIndex) then + // find compound glyph IDs and add them to the GlyphIDsToAdd list + if not FGlyphIDs.Contains(glyphIndex) then begin {$IFDEF gDEBUG} writeln(Format(' glyphIndex: %.4x (%0:d) ', [glyphIndex])); @@ -451,18 +551,21 @@ begin until (flags and (1 shl 5)) = 0; // MORE_COMPONENTS end; { if buf.numberOfContours = -1 } end; { if gs.Size > 0 } - end; { for n ... FGlyphIDList.Count-1 } + end; { for n ... FGlyphIDs.Count-1 } if GlyphIDsToAdd.Count > 0 then begin for i := 0 to GlyphIDsToAdd.Count-1 do begin glyphIndex := StrToInt(GlyphIDsToAdd[i]); - cid := GetCharIDfromGlyphID(glyphIndex); // lookup original charID - FGlyphIDList.Add(cid, glyphIndex); + FGlyphIDs.Add(glyphIndex); end; end; hasNested := GlyphIDsToAdd.Count > 0; + {$IFDEF gDEBUG} + if hasNested then + writeln('------------------'); + {$ENDIF} FreeAndNil(GlyphIDsToAdd); until (hasNested = false); end; @@ -521,8 +624,8 @@ begin rec.metricDataFormat := NtoBE(t.metricDataFormat); // rec.numberOfHMetrics := NtoBE(t.numberOfHMetrics); - hmetrics := FGlyphIDList.Count; - if (FGlyphIDList.Items[FGlyphIDList.Count-1].GlyphID >= t.numberOfHMetrics) and (not FGlyphIDList.Contains(t.numberOfHMetrics-1)) then + hmetrics := FGlyphIDs.Count; + if (FGlyphIDs.Items[FGlyphIDs.Count-1].GID >= t.numberOfHMetrics) and (not FGlyphIDs.Contains(t.numberOfHMetrics-1)) then inc(hmetrics); rec.numberOfHMetrics := NtoBE(hmetrics); @@ -541,7 +644,7 @@ begin FillMem(@rec, SizeOf(TMaxP), 0); rec.VersionNumber.Version := NtoBE(t.VersionNumber.Version); - lCount := FGlyphIDList.Count; + lCount := FGlyphIDs.Count; rec.numGlyphs := NtoBE(lCount); rec.maxPoints := NtoBE(t.maxPoints); @@ -594,19 +697,23 @@ begin LoadLocations; { - Assign new glyph indexes - - Retrieve glyph data in 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 FGlyphIDList.Count-1 do + - Retrieve glyph data if it doesn't yet exist (retrieved from original TTF file) } + for n := 0 to FGlyphIDs.Count-1 do begin - FGlyphIDList[n].NewGlyphID := n; - if not Assigned(FGlyphIDList[n].GlyphData) then - FGlyphIDList[n].GlyphData := GetRawGlyphData(FGlyphIDList[n].GlyphID); - if not FGlyphIDList[n].IsCompoundGlyph then + FGlyphIDs[n].NewGID := n; + if not Assigned(FGlyphIDs[n].GlyphData) then + FGlyphIDs[n].GlyphData := GetRawGlyphData(FGlyphIDs[n].GID); + 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; {$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} - gs := TMemoryStream(FGlyphIDList[n].GlyphData); + gs := TMemoryStream(FGlyphIDs[n].GlyphData); gs.Position := 0; if gs.Size > 0 then @@ -622,7 +729,7 @@ begin glyphIndex := ReadUInt16(gs); // now write new GlyphID in it's place. gs.Position := lOffset; - glyphIndex := FGlyphIDList.GetNewGlyphID(GetCharIDfromGlyphID(glyphIndex)); + glyphIndex := FGlyphIDs.GetNewGlyphID(glyphIndex); WriteUInt16(gs, glyphIndex); // ARG_1_AND_2_ARE_WORDS @@ -654,12 +761,12 @@ begin // write all glyph data to resulting data stream lOffset := 0; - for n := 0 to FGlyphIDList.Count-1 do + for n := 0 to FGlyphIDs.Count-1 do begin newOffsets[n] := lOffset; - lOffset := lOffset + FGlyphIDList[n].GlyphData.Size; - FGlyphIDList[n].GlyphData.Position := 0; - Result.CopyFrom(FGlyphIDList[n].GlyphData, FGlyphIDList[n].GlyphData.Size); + lOffset := lOffset + FGlyphIDs[n].GlyphData.Size; + FGlyphIDs[n].GlyphData.Position := 0; + Result.CopyFrom(FGlyphIDs[n].GlyphData, FGlyphIDs[n].GlyphData.Size); // 4-byte alignment if (lOffset mod 4) <> 0 then begin @@ -717,6 +824,7 @@ var lastChar: integer; prevChar: integer; lastGid: integer; + curGid: integer; itm: TTextMapping; begin Result := TMemoryStream.Create; @@ -736,7 +844,7 @@ begin // build Format 4 subtable (Unicode BMP) lastChar := 0; prevChar := lastChar; - lastGid := FGlyphIDList[0].NewGlyphID; + lastGid := GetNewGlyphId(FGlyphIDList[0].GlyphID); segCount := 0; for i := 0 to FGlyphIDList.Count-1 do @@ -744,8 +852,9 @@ begin itm := FGlyphIDList[i]; if itm.CharID > $FFFF then 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 if (lastGid <> 0) then begin @@ -763,7 +872,7 @@ begin idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID; inc(segCount); end; - lastGid := itm.NewGlyphID; + lastGid := curGid; lastChar := i; end; prevChar := i; @@ -829,16 +938,21 @@ begin end; constructor TFontSubsetter.Create(const AFont: TTFFileInfo; const AGlyphIDList: TTextMappingList); +var + i: integer; begin FFontInfo := AFont; if not Assigned(FFontInfo) then raise ETTFSubsetter.Create(rsErrFontInfoNotAssigned); FGlyphIDList := AGlyphIDList; + FGlyphIDs := TGIDList.Create; + // always copy GID 0 + FGlyphIDs.Add(0); + FKeepTables := TStringList.Create; FHasAddedCompoundReferences := False; FPrefix := ''; - FhasAddedCompoundReferences := False; // create a default list FKeepTables.Add('head'); @@ -853,7 +967,11 @@ begin FKeepTables.Add('glyf'); if Assigned(FGlyphIDList) then + begin FGlyphIDList.Sort; + for i := 0 to FGlyphIDList.Count-1 do + FGlyphIDs.Add(FGlyphIDList[i].GlyphID); + end; if FFontInfo.Filename <> '' then FStream := TFileStream.Create(FFontInfo.FileName, fmOpenRead or fmShareDenyNone) @@ -875,6 +993,7 @@ begin FGlyphIDList[i].GlyphData.Free; FStream.Free; FKeepTables.Free; + FreeAndNil(FGlyphIDs); inherited Destroy; end; @@ -911,6 +1030,8 @@ var p: uint64; lPadding: byte; begin + FGlyphIDs.Sort; + // resolve compound glyph references AddCompoundReferences; @@ -918,16 +1039,16 @@ begin FGlyphIDList.Add(0, 0); FGlyphIDList.Sort; - SetLength(newLoca, FGlyphIDList.Count+1); + SetLength(newLoca, FGlyphIDs.Count+1); - head := buildHeadTable(); // done - hhea := buildHheaTable(); // done - maxp := buildMaxpTable(); // done - fpgm := buildFpgmTable(); // done - prep := buildPrepTable(); // done - cvt := buildCvtTable(); // done - glyf := buildGlyfTable(newLoca); // done - loca := buildLocaTable(newLoca); // done + head := buildHeadTable(); + hhea := buildHheaTable(); + maxp := buildMaxpTable(); + fpgm := buildFpgmTable(); + prep := buildPrepTable(); + cvt := buildCvtTable(); + glyf := buildGlyfTable(newLoca); + loca := buildLocaTable(newLoca); cmap := buildCmapTable(); hmtx := buildHmtxTable(); @@ -971,7 +1092,7 @@ begin // update head.ChecksumAdjustment field head.Seek(8, soBeginning); - WriteUInt32(head, checksum); + WriteInt32(head, checksum); // write table bodies WriteTableBodies(AStream, tables); @@ -979,6 +1100,8 @@ begin for i := 0 to tables.Count-1 do TStream(tables.Objects[i]).Free; tables.Free; + + UpdateOrigGlyphIDList; end; procedure TFontSubsetter.Add(const ACodePoint: uint32); @@ -987,7 +1110,148 @@ var begin gid := FFontInfo.Chars[ACodePoint]; if gid <> 0 then + begin 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; diff --git a/packages/fcl-pdf/utils/ttfdump.lpi b/packages/fcl-pdf/utils/ttfdump.lpi index 2adbfed8d1..9969635656 100644 --- a/packages/fcl-pdf/utils/ttfdump.lpi +++ b/packages/fcl-pdf/utils/ttfdump.lpi @@ -57,6 +57,12 @@ + + + + + +