diff --git a/.gitattributes b/.gitattributes index 4bb7b954d6..785dda3bce 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2569,6 +2569,7 @@ packages/fcl-pdf/src/fppdf.pp svneol=native#text/plain packages/fcl-pdf/src/fpttf.pp svneol=native#text/plain packages/fcl-pdf/src/fpttfencodings.pp svneol=native#text/plain packages/fcl-pdf/src/fpttfsubsetter.pp svneol=native#text/plain +packages/fcl-pdf/tests/fontlist.txt svneol=native#text/plain packages/fcl-pdf/tests/fonts/README.txt svneol=native#text/plain packages/fcl-pdf/tests/fpparsettf_test.pas svneol=native#text/plain packages/fcl-pdf/tests/fppdf_test.pas svneol=native#text/plain diff --git a/packages/fcl-pdf/src/fpparsettf.pp b/packages/fcl-pdf/src/fpparsettf.pp index 9680a6337a..d033a15af1 100644 --- a/packages/fcl-pdf/src/fpparsettf.pp +++ b/packages/fcl-pdf/src/fpparsettf.pp @@ -289,6 +289,7 @@ Type CharBase: PTTFEncodingNames; PostScriptName: string; FamilyName: string; + HumanFriendlyName: string; // aka FullName destructor Destroy; override; { Returns the Glyph Index value in the TTF file, where AValue is the ordinal value of a character. } function GetGlyphIndex(AValue: word): word; @@ -660,15 +661,23 @@ begin writeln('NameID = ', E[i].Info.NameID); writeln('Value = ', E[i].Value); {$ENDIF} + if (PostScriptName='') and (E[i].Info.NameID=NameIDPostScriptName) and (E[i].Info.EncodingID=NameMSEncodingUGL) then PostScriptName:=E[i].Value; + if (FamilyName = '') and (E[i].Info.NameID = NameIDFontFamily) and (E[i].Info.LanguageID = 1033) and (E[i].Info.EncodingID = 1) then FamilyName := E[i].Value; + + if (HumanFriendlyName = '') + and (E[i].Info.NameID = NameIDFullFontName) + and (E[i].Info.LanguageID = 1033) + and (E[i].Info.EncodingID = 1) then + HumanFriendlyName := E[i].Value; end; { for i ... } end; diff --git a/packages/fcl-pdf/src/fpttf.pp b/packages/fcl-pdf/src/fpttf.pp index d4ca15dcd9..418de79732 100644 --- a/packages/fcl-pdf/src/fpttf.pp +++ b/packages/fcl-pdf/src/fpttf.pp @@ -49,6 +49,7 @@ type FFileInfo: TTFFileInfo; FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance FPostScriptName: string; + FHumanFriendlyName: string; // aka FullName procedure DoLoadFileInfo; procedure LoadFileInfo; procedure BuildFontCacheItem; @@ -59,6 +60,7 @@ type function GetIsRegular: boolean; function GetFamilyName: String; function GetPostScriptName: string; + function GetHumanFriendlyName: string; function GetFileInfo: TTFFileInfo; public constructor Create(const AFilename: String); @@ -70,6 +72,7 @@ type property FileName: String read FFileName; property FamilyName: String read GetFamilyName; property PostScriptName: string read GetPostScriptName; + property HumanFriendlyName: string read GetHumanFriendlyName; property FontData: TTFFileInfo read GetFileInfo; { A bitmasked value describing the full font style } property StyleFlags: TTrueTypeFontStyles read FStyleFlags; @@ -203,6 +206,12 @@ begin Result := FPostScriptName; end; +function TFPFontCacheItem.GetHumanFriendlyName: string; +begin + DoLoadFileInfo; + Result := FHumanFriendlyName; +end; + function TFPFontCacheItem.GetFileInfo: TTFFileInfo; begin DoLoadFileInfo; @@ -218,6 +227,7 @@ begin FFamilyName := FFileInfo.FamilyName; if Pos(s, FFamilyName) = 1 then Delete(s, 1, Length(FFamilyName)); + FHumanFriendlyName := FFileInfo.HumanFriendlyName; FStyleFlags := [fsRegular]; diff --git a/packages/fcl-pdf/tests/fontlist.txt b/packages/fcl-pdf/tests/fontlist.txt new file mode 100644 index 0000000000..0432d674f9 --- /dev/null +++ b/packages/fcl-pdf/tests/fontlist.txt @@ -0,0 +1,3 @@ +fonts/DejaVuSans.ttf +fonts/FreeSans.ttf +fonts/LiberationSans-Italic.ttf \ No newline at end of file diff --git a/packages/fcl-pdf/tests/fonts/README.txt b/packages/fcl-pdf/tests/fonts/README.txt index a8592d38b0..0587afb2ad 100644 --- a/packages/fcl-pdf/tests/fonts/README.txt +++ b/packages/fcl-pdf/tests/fonts/README.txt @@ -1,4 +1,4 @@ -These sets of unit tests requires four font files of specific versions +These sets of unit tests requires 5 font files of specific versions each. Here is what the tests were designed against. Font File | Size (bytes) | Version @@ -6,6 +6,7 @@ each. Here is what the tests were designed against. DejaVuSans.ttf | 622,280 | 2.30 FreeSans.ttf | 1,563,256 | 412.2268 LiberationSans-Regular.ttf | 350,200 | 2.00.1 +LiberationSans-Italic.ttf | 355,608 | 2.00.1 Ubuntu-R.ttf | 353,824 | 0.80 diff --git a/packages/fcl-pdf/tests/fpparsettf_test.pas b/packages/fcl-pdf/tests/fpparsettf_test.pas index d47e223c73..a8878ed3be 100644 --- a/packages/fcl-pdf/tests/fpparsettf_test.pas +++ b/packages/fcl-pdf/tests/fpparsettf_test.pas @@ -193,6 +193,11 @@ type { Utility functions } procedure TestGetGlyphIndex; procedure TestGetAdvanceWidth; + + { General info } + procedure TestPostScriptName; + procedure TestFamilyName; + procedure TestHumanFriendlyName; end; @@ -202,6 +207,11 @@ type published { PostScript data structure } procedure TestPostScript_ItalicAngle; + + { General info } + procedure TestPostScriptName; + procedure TestFamilyName; + procedure TestHumanFriendlyName; end; @@ -358,6 +368,11 @@ type procedure TestPostScript_maxMemType42; procedure TestPostScript_minMemType1; procedure TestPostScript_maxMemType1; + + { General info } + procedure TestPostScriptName; + procedure TestFamilyName; + procedure TestHumanFriendlyName; end; implementation @@ -1159,6 +1174,21 @@ begin AssertEquals('Failed on 12', 1139, FI.GetAdvanceWidth(20)); // '1' end; +procedure TTestLiberationFont.TestPostScriptName; +begin + AssertEquals('Failed on 1', 'LiberationSans', FI.PostScriptName); +end; + +procedure TTestLiberationFont.TestFamilyName; +begin + AssertEquals('Failed on 1', 'Liberation Sans', FI.FamilyName); +end; + +procedure TTestLiberationFont.TestHumanFriendlyName; +begin + AssertEquals('Failed on 1', 'Liberation Sans', FI.HumanFriendlyName); +end; + { TTestLiberationItalicFont } procedure TTestLiberationItalicFont.SetUp; @@ -1176,6 +1206,21 @@ begin AssertEquals('Failed on 2', -12.0, FI.ItalicAngle); end; +procedure TTestLiberationItalicFont.TestPostScriptName; +begin + AssertEquals('Failed on 1', 'LiberationSans-Italic', FI.PostScriptName); +end; + +procedure TTestLiberationItalicFont.TestFamilyName; +begin + AssertEquals('Failed on 1', 'Liberation Sans', FI.FamilyName); +end; + +procedure TTestLiberationItalicFont.TestHumanFriendlyName; +begin + AssertEquals('Failed on 1', 'Liberation Sans Italic', FI.HumanFriendlyName); +end; + { TTestFreeSansFont } procedure TTestFreeSansFont.SetUp; @@ -1922,6 +1967,21 @@ begin AssertEquals('Failed on 1', 0, FI.PostScript.maxMemType1); end; +procedure TTestFreeSansFont.TestPostScriptName; +begin + AssertEquals('Failed on 1', 'FreeSans', FI.PostScriptName); +end; + +procedure TTestFreeSansFont.TestFamilyName; +begin + AssertEquals('Failed on 1', 'FreeSans', FI.FamilyName); +end; + +procedure TTestFreeSansFont.TestHumanFriendlyName; +begin + AssertEquals('Failed on 1', 'FreeSans', FI.HumanFriendlyName); +end; + initialization RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif}); diff --git a/packages/fcl-pdf/tests/fpttf_test.pas b/packages/fcl-pdf/tests/fpttf_test.pas index ff96fbbdbd..508b849e0b 100644 --- a/packages/fcl-pdf/tests/fpttf_test.pas +++ b/packages/fcl-pdf/tests/fpttf_test.pas @@ -412,6 +412,8 @@ begin end; end; +{ The fontlist file contains 3 font names, instead of the 5 that should + be available. This tests that we only load info of fonts that we need. } procedure TFPFontCacheListTest.TestLoadFromFile; const cFontListFile = 'fontlist.txt'; diff --git a/packages/fcl-pdf/tests/unittests_console.lpi b/packages/fcl-pdf/tests/unittests_console.lpi index 22105d690f..8a3b807e27 100644 --- a/packages/fcl-pdf/tests/unittests_console.lpi +++ b/packages/fcl-pdf/tests/unittests_console.lpi @@ -1,7 +1,7 @@ - + @@ -13,7 +13,6 @@ -