* Fix from Graeme adding Font subset embedding and underline/strikethrough

git-svn-id: trunk@35083 -

.gitattributes

@@ -2595,6 +2595,7 @@ packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain
 packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain
 packages/fcl-pdf/fpmake.pp svneol=native#text/plain
 packages/fcl-pdf/readme.txt svneol=native#text/plain
+packages/fcl-pdf/src/fontmetrics_stdpdf.inc svneol=native#text/plain
 packages/fcl-pdf/src/fpparsettf.pp svneol=native#text/plain
 packages/fcl-pdf/src/fppdf.pp svneol=native#text/plain
 packages/fcl-pdf/src/fpttf.pp svneol=native#text/plain

packages/fcl-pdf/examples/testfppdf.lpr

@@ -35,6 +35,7 @@ type
     FTextCompression,
     FFontCompression: boolean;
     FNoFontEmbedding: boolean;
+    FSubsetFontEmbedding: boolean;
     FDoc: TPDFDocument;
     function    SetUpDocument: TPDFDocument;
     procedure   SaveDocument(D: TPDFDocument);
@@ -77,8 +78,13 @@ begin
   Result.Infos.CreationDate := Now;
 
   lOpts := [poPageOriginAtTop];
+  if FSubsetFontEmbedding then
+    Include(lOpts, poSubsetFont);
   if FNoFontEmbedding then
+  begin
     Include(lOpts, poNoEmbeddedFonts);
+    Exclude(lOpts, poSubsetFont);
+  end;
   if FFontCompression then
     Include(lOpts, poCompressFonts);
   if FTextCompression then
@@ -132,7 +138,8 @@ end;
 procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
 var
   P : TPDFPage;
-  FtTitle, FtText1, FtText2, FtText3: integer;
+  FtTitle, FtText1, FtText2: integer;
+  FtWaterMark: integer;
 begin
   P := D.Pages[APage];
 
@@ -140,14 +147,16 @@ begin
   FtTitle := D.AddFont('Helvetica');
   FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans');
   FtText2 := D.AddFont('Times-BoldItalic');
-  // FtText3 := D.AddFont('arial.ttf', 'Arial');
-  FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
+  FtWaterMark := D.AddFont('Helvetica-Bold');
 
   { Page title }
   P.SetFont(FtTitle, 23);
   P.SetColor(clBlack, false);
   P.WriteText(25, 20, 'Sample Text');
 
+  P.SetFont(FtWaterMark, 120);
+  P.SetColor(clWaterMark, false);
+  P.WriteText(55, 190, 'Sample', 45);
 
   // -----------------------------------
   // Write text using PDF standard fonts
@@ -158,6 +167,12 @@ begin
   P.WriteText(25, 57, 'Click the URL:  http://www.freepascal.org');
   P.AddExternalLink(54, 58, 49, 5, 'http://www.freepascal.org', false);
 
+  // strike-through text
+  P.WriteText(25, 64, 'Strike-Through text', 0, false, true);
+
+  // strike-through text
+  P.WriteText(65, 64, 'Underlined text', 0, true);
+
   // rotated text
   P.SetColor(clBlue, false);
   P.WriteText(25, 100, 'Rotated text at 30 degrees', 30);
@@ -169,17 +184,16 @@ begin
 
   // -----------------------------------
   // TrueType testing purposes
-  P.SetFont(ftText3, 13);
+  P.SetFont(FtText1, 13);
   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: Здравствуйте мир');
   P.WriteText(40, 170, 'Vietnamese: Xin chào thế giới');
 
-  P.SetFont(ftText1, 13);
   P.WriteText(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
 
   P.WriteText(15, 200, 'Typography: “What’s wrong?”');
@@ -213,30 +227,30 @@ begin
   P.WriteText(25, 20, 'Sample Line Drawing (DrawLine)');
 
   P.SetColor(clBlack, True);
-  P.SetPenStyle(ppsSolid);
+  P.SetPenStyle(ppsSolid, 1);
   lPt1.X := 30;   lPt1.Y := 100;
   lPt2.X := 150;  lPt2.Y := 150;
-  P.DrawLine(lPt1, lPt2, 0.2);
+  P.DrawLine(lPt1, lPt2, 1);
 
   P.SetColor(clBlue, True);
-  P.SetPenStyle(ppsDash);
+  P.SetPenStyle(ppsDash, 1);
   lPt1.X := 50;   lPt1.Y := 70;
   lPt2.X := 180;  lPt2.Y := 100;
-  P.DrawLine(lPt1, lPt2, 0.1);
+  P.DrawLine(lPt1, lPt2, 1);
 
   { we can also use coordinates directly, without TPDFCoord variables }
 
   P.SetColor(clRed, True);
-  P.SetPenStyle(ppsDashDot);
+  P.SetPenStyle(ppsDashDot, 1);
   P.DrawLine(40, 140, 160, 80, 1);
 
   P.SetColor(clBlack, True);
-  P.SetPenStyle(ppsDashDotDot);
-  P.DrawLine(60, 50, 60, 120, 1.5);
+  P.SetPenStyle(ppsDashDotDot, 1);
+  P.DrawLine(60, 50, 60, 120, 1);
 
   P.SetColor(clBlack, True);
-  P.SetPenStyle(ppsDot);
-  P.DrawLine(10, 80, 130, 130, 0.5);
+  P.SetPenStyle(ppsDot, 1);
+  P.DrawLine(10, 80, 130, 130, 1);
 end;
 
 procedure TPDFTestApp.SimpleLines(D: TPDFDocument; APage: integer);
@@ -256,11 +270,11 @@ begin
   P.WriteText(25, 20, 'Sample Line Drawing (DrawLineStyle)');
 
   // write the text at position 100 mm from left and 120 mm from top
-  TsThinBlack := D.AddLineStyleDef(0.2, clBlack, ppsSolid);
-  TsThinBlue := D.AddLineStyleDef(0.1, clBlue, ppsDash);
+  TsThinBlack := D.AddLineStyleDef(1, clBlack, ppsSolid);
+  TsThinBlue := D.AddLineStyleDef(1, clBlue, ppsDash);
   TsThinRed := D.AddLineStyleDef(1, clRed, ppsDashDot);
-  TsThick := D.AddLineStyleDef(1.5, clBlack, ppsDashDotDot);
-  TsThinBlackDot := D.AddLineStyleDef(0.5, clBlack, ppsDot);
+  TsThick := D.AddLineStyleDef(1, clBlack, ppsDashDotDot);
+  TsThinBlackDot := D.AddLineStyleDef(1, clBlack, ppsDot);
 
   lPt1.X := 30;   lPt1.Y := 100;
   lPt2.X := 150;  lPt2.Y := 150;
@@ -697,6 +711,7 @@ var
   lFontIdx: integer;
   lFC: TFPFontCacheItem;
   lHeight: single;
+  lDescenderHeight: single;
   lTextHeightInMM: single;
   lWidth: single;
   lTextWidthInMM: single;
@@ -719,21 +734,15 @@ begin
   if not Assigned(lFC) then
     raise Exception.Create(AFontName + ' font not found');
 
-  { result is in pixels }
-  lHeight := lFC.FontData.CapHeight * APointSize * gTTFontCache.DPI / (72 * lFC.FontData.Head.UnitsPerEm);
-  { convert pixels to mm as our PDFPage.UnitOfMeasure is set to mm. }
-  lTextHeightInMM :=  (lHeight * 25.4) / gTTFontCache.DPI;
+  lHeight := lFC.TextHeight(AText, APointSize, lDescenderHeight);
+  { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. }
+  lTextHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI;
+  lDescenderHeightInMM := (lDescenderHeight * 25.4) / gTTFontCache.DPI;
 
   lWidth := lFC.TextWidth(AText, APointSize);
-  { convert the Font Units to Millimeters }
+  { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. }
   lTextWidthInMM := (lWidth * 25.4) / gTTFontCache.DPI;
 
-  { result is in pixels }
-  lHeight := Abs(lFC.FontData.Descender) * APointSize * gTTFontCache.DPI /
-      (72 * lFC.FontData.Head.UnitsPerEm);
-  { convert pixels to mm as you PDFPage.UnitOfMeasure is set to mm. }
-  lDescenderHeightInMM :=  (lHeight * 25.4) / gTTFontCache.DPI;
-
   { adjust the Y coordinate for the font Descender, because
     WriteText() draws on the baseline. Also adjust the TextHeight
     because CapHeight doesn't take into account the Descender. }
@@ -766,7 +775,7 @@ begin
   StopOnException:=True;
   inherited DoRun;
   // quick check parameters
-  ErrorMsg := CheckOptions('hp:f:t:i:j:n', '');
+  ErrorMsg := CheckOptions('hp:f:t:i:j:ns', '');
   if ErrorMsg <> '' then
   begin
     WriteLn('ERROR:  ' + ErrorMsg);
@@ -797,6 +806,7 @@ begin
   end;
 
   FNoFontEmbedding := HasOption('n', '');
+  FSubsetFontEmbedding := HasOption('s', '');
   FFontCompression := BoolFlag('f',true);
   FTextCompression := BoolFlag('t',False);
   FImageCompression := BoolFlag('i',False);
@@ -852,6 +862,7 @@ begin
           '                If this option is not specified, then all %0:d pages are' + LineEnding +
           '                generated.', [cPageCount]));
   writeln('    -n          If specified, no fonts will be embedded.');
+  writeln('    -s          If specified, subset TTF font embedding will occur.');
   writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
           '                disables compression. A value of 1 enables compression.' + LineEnding +
           '                If -n is specified, this option is ignored.');

packages/fcl-pdf/fpmake.pp

@@ -28,6 +28,7 @@ begin
     P.Dependencies.Add('rtl-objpas');
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-image');
+    P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('paszlib');
     P.Version:='3.1.1';
     T:=P.Targets.AddUnit('src/fpttfencodings.pp');

packages/fcl-pdf/src/fontmetrics_stdpdf.inc

@@ -0,0 +1,222 @@
+const
+
+  // helvetica  (used metric equivalent Liberation Sans as substitute)
+  FONT_HELVETICA_ARIAL: array[0..255] of integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,569,727,1139,1139,1821,1366,391,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,569,569,1196,1196,1196,1139,2079,1366,
+    1366,1479,1479,1366,1251,1593,1479,569,1024,1366,1139,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,569,569,569,961,1139,682,1139,1139,
+    1024,1139,1139,569,1139,1139,455,455,1024,455,1706,1139,1139,1139,1139,682,1024,
+    569,1139,1024,1479,1024,1024,1024,684,532,684,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,1139,
+    532,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1100,682,
+    682,682,748,1139,1708,1708,1708,1251,1366,1366,1366,1366,1366,1366,2048,1479,1366,
+    1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,1479,
+    1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1024,1139,1139,
+    1139,1139,569,569,569,569,1139,1139,1139,1139,1139,1139,1139,1124,1251,1139,1139,
+    1139,1139,1024,1139,1024 );
+  FONT_HELVETICA_ARIAL_CAPHEIGHT = 1409;
+  FONT_HELVETICA_ARIAL_DESCENDER = 431;
+
+  // helveticaB  (used metric equivalent Liberation Sans Bold as substitute)
+  FONT_HELVETICA_ARIAL_BOLD: array[0..255] of integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,682,971,1139,1139,1821,1479,487,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,682,682,1196,1196,1196,1251,1997,1479,
+    1479,1479,1479,1366,1251,1593,1479,569,1139,1479,1251,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,682,569,682,1196,1139,682,1139,1251,
+    1139,1251,1139,682,1251,1251,569,569,1139,569,1821,1251,1251,1251,1251,797,1139,
+    682,1251,1139,1593,1139,1139,1024,797,573,797,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,1139,
+    573,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1139,682,
+    682,682,748,1139,1708,1708,1708,1251,1479,1479,1479,1479,1479,1479,2048,1479,1366,
+    1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,1479,
+    1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1139,1139,1139,
+    1139,1139,569,569,569,569,1251,1251,1251,1251,1251,1251,1251,1124,1251,1251,1251,
+    1251,1251,1139,1251,1139 );
+  FONT_HELVETICA_ARIAL_BOLD_CAPHEIGHT = 688;
+  FONT_HELVETICA_ARIAL_BOLD_DESCENDER = 210;
+
+  // helveticaI  (used metric equivalent Liberation Sans Italic as substitute)
+  FONT_HELVETICA_ARIAL_ITALIC: array[0..255] of Integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,569,727,1139,1139,1821,1366,391,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,569,569,1196,1196,1196,1139,2079,1366,
+    1366,1479,1479,1366,1251,1593,1479,569,1024,1366,1139,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,569,569,569,961,1139,682,1139,1139,
+    1024,1139,1139,569,1139,1139,455,455,1024,455,1706,1139,1139,1139,1139,682,1024,
+    569,1139,1024,1479,1024,1024,1024,684,532,684,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,
+    1139,532,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1100,
+    682,682,682,748,1139,1708,1708,1708,1251,1366,1366,1366,1366,1366,1366,2048,1479,
+    1366,1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,
+    1479,1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1024,1139,
+    1139,1139,1139,569,569,569,569,1139,1139,1139,1139,1139,1139,1139,1124,1251,1139,
+    1139,1139,1139,1024,1139,1024 );
+  FONT_HELVETICA_ARIAL_ITALIC_CAPHEIGHT = 688;
+  FONT_HELVETICA_ARIAL_ITALIC_DESCENDER = 208;
+
+  // helveticaBI  (used metric equivalent Liberation Sans Bold Italic as substitute)
+  FONT_HELVETICA_ARIAL_BOLD_ITALIC: array[0..255] of Integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,682,971,1139,1139,1821,1479,487,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,682,682,1196,1196,1196,1251,1997,1479,
+    1479,1479,1479,1366,1251,1593,1479,569,1139,1479,1251,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,682,569,682,1196,1139,682,1139,1251,
+    1139,1251,1139,682,1251,1251,569,569,1139,569,1821,1251,1251,1251,1251,797,1139,
+    682,1251,1139,1593,1139,1139,1024,797,573,797,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,
+    1139,573,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1139,
+    682,682,682,748,1139,1708,1708,1708,1251,1479,1479,1479,1479,1479,1479,2048,1479,
+    1366,1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,
+    1479,1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1139,1139,
+    1139,1139,1139,569,569,569,569,1251,1251,1251,1251,1251,1251,1251,1124,1251,1251,
+    1251,1251,1251,1139,1251,1139 );
+  FONT_HELVETICA_ARIAL_BOLD_ITALIC_CAPHEIGHT = 688;
+  FONT_HELVETICA_ARIAL_BOLD_ITALIC_DESCENDER = 210;
+
+  // times  (used metric equivalent Liberation Serif as substitute)
+  FONT_TIMES: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,682,836,1024,1024,1706,1593,369,682,682,1024,1155,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,569,569,1155,1155,1155,909,1886,1479,1366,
+    1366,1479,1251,1139,1479,1479,682,797,1479,1251,1821,1479,1479,1139,1479,1366,
+    1139,1251,1479,1479,1933,1479,1479,1251,682,569,682,961,1024,682,909,1024,909,
+    1024,909,682,1024,1024,569,569,1024,569,1593,1024,1024,1024,1024,682,797,569,
+    1024,1024,1479,1024,1024,909,983,410,983,1108,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,682,1024,1024,1024,1024,
+    410,1024,682,1556,565,1024,1155,682,1556,1024,819,1124,614,614,682,1180,928,682,
+    682,614,635,1024,1536,1536,1536,909,1479,1479,1479,1479,1479,1479,1821,1366,1251,
+    1251,1251,1251,682,682,682,682,1479,1479,1479,1479,1479,1479,1479,1155,1479,1479,
+    1479,1479,1479,1479,1139,1024,909,909,909,909,909,909,1366,909,909,909,909,909,
+    569,569,569,569,1024,1024,1024,1024,1024,1024,1024,1124,1024,1024,1024,1024,1024,
+    1024,1024,1024 );
+  FONT_TIMES_CAPHEIGHT = 1341;
+  FONT_TIMES_DESCENDER = 442;
+
+  // timesI  (used metric equivalent Liberation Serif Italic as substitute)
+  FONT_TIMES_ITALIC: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,682,860,1024,1024,1706,1593,438,682,682,1024,1382,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,682,682,1382,1382,1382,1024,1884,1251,
+    1251,1366,1479,1251,1251,1479,1479,682,909,1366,1139,1706,1366,1479,1251,1479,
+    1251,1024,1139,1479,1251,1706,1251,1139,1139,797,569,797,864,1024,682,1024,1024,
+    909,1024,909,569,1024,1024,569,569,909,569,1479,1024,1024,1024,1024,797,797,569,
+    1024,909,1366,909,909,797,819,563,819,1108,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,797,1024,1024,1024,1024,
+    563,1024,682,1556,565,1024,1382,682,1556,1024,819,1124,614,614,682,1180,1071,512,
+    682,614,635,1024,1536,1536,1536,1024,1251,1251,1251,1251,1251,1251,1821,1366,1251,
+    1251,1251,1251,682,682,682,682,1479,1366,1479,1479,1479,1479,1479,1382,1479,1479,
+    1479,1479,1479,1139,1251,1024,1024,1024,1024,1024,1024,1024,1366,909,909,909,909,
+    909,569,569,569,569,1024,1024,1024,1024,1024,1024,1024,1124,1024,1024,1024,1024,
+    1024,909,1024,909 );
+  FONT_TIMES_ITALIC_CAPHEIGHT = 655;
+  FONT_TIMES_ITALIC_DESCENDER = 216;
+
+  //timesB  (used metric equivalent Liberation Serif Bold as substitute)
+  FONT_TIMES_BOLD: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,682,1137,1024,1024,2048,1706,569,682,682,1024,1167,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,682,682,1167,1167,1167,1024,1905,1479,
+    1366,1479,1479,1366,1251,1593,1593,797,1024,1593,1366,1933,1479,1593,1251,1593,
+    1479,1139,1366,1479,1479,2048,1479,1479,1366,682,569,682,1190,1024,682,1024,1139,
+    909,1139,909,682,1024,1139,569,682,1139,569,1706,1139,1024,1139,1139,909,797,682,
+    1139,1024,1479,1024,1024,909,807,451,807,1065,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,682,1024,1024,1024,1024,451,
+    1024,682,1530,614,1024,1167,682,1530,1024,819,1124,614,614,682,1180,1106,683,682,
+    614,676,1024,1536,1536,1536,1024,1479,1479,1479,1479,1479,1479,2048,1479,1366,
+    1366,1366,1366,797,797,797,797,1479,1479,1593,1593,1593,1593,1593,1167,1593,1479,
+    1479,1479,1479,1479,1251,1139,1024,1024,1024,1024,1024,1024,1479,909,909,909,909,
+    909,569,569,569,569,1024,1139,1024,1024,1024,1024,1024,1124,1024,1139,1139,1139,
+    1139,1024,1139,1024 );
+  FONT_TIMES_BOLD_CAPHEIGHT = 655;
+  FONT_TIMES_BOLD_DESCENDER = 216;
+
+  // timesBI  (used metric equivalent Liberation Serif Bold Italic as substitute)
+  FONT_TIMES_BOLD_ITALIC: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,797,1137,1024,1024,1706,1593,569,682,682,1024,1167,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,682,682,1167,1167,1167,1024,1704,1366,
+    1366,1366,1479,1366,1366,1479,1593,797,1024,1366,1251,1821,1479,1479,1251,1479,
+    1366,1139,1251,1479,1366,1821,1366,1251,1251,682,569,682,1167,1024,682,1024,1024,
+    909,1024,909,682,1024,1139,569,569,1024,569,1593,1139,1024,1024,1024,797,797,569,
+    1139,909,1366,1024,909,797,713,451,713,1167,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,797,1024,1024,1024,1024,451,
+    1024,682,1530,545,1024,1241,682,1530,1024,819,1124,614,614,682,1180,1024,512,682,
+    614,614,1024,1536,1536,1536,1024,1366,1366,1366,1366,1366,1366,1933,1366,1366,
+    1366,1366,1366,797,797,797,797,1479,1479,1479,1479,1479,1479,1479,1167,1479,1479,
+    1479,1479,1479,1251,1251,1024,1024,1024,1024,1024,1024,1024,1479,909,909,909,909,
+    909,569,569,569,569,1024,1139,1024,1024,1024,1024,1024,1124,1024,1139,1139,1139,
+    1139,909,1024,909 );
+  FONT_TIMES_BOLD_ITALIC_CAPHEIGHT = 655;
+  FONT_TIMES_BOLD_ITALIC_DESCENDER = 216;
+
+  // courier courierB courierI courierBI
+  FONT_COURIER_FULL: array[0..255] of Integer = (
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229 );
+  FONT_TIMES_COURIER_CAPHEIGHT = 613;
+  FONT_TIMES_COURIER_DESCENDER = 386;
+
+  // symbol
+  FONT_SYMBOL: array[0..255] of Integer = (
+  250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,
+  250,250,250,250,250,250,250,250,250,250,250,333,713,500,549,833,778,439,333,333,500,549,
+  250,549,250,278,500,500,500,500,500,500,500,500,500,500,278,278,549,549,549,444,549,722,
+  667,722,612,611,763,603,722,333,631,722,686,889,722,722,768,741,556,592,611,690,439,768,
+  645,795,611,333,863,333,658,500,500,631,549,549,494,439,521,411,603,329,603,549,549,576,
+  521,549,549,521,549,603,439,576,713,686,493,686,494,480,200,480,549,0,0,0,0,0,
+  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+  0,0,0,0,0,0,750,620,247,549,167,713,500,753,753,753,753,1042,987,603,987,603,
+  400,549,411,549,549,713,494,460,549,549,549,549,1000,603,1000,658,823,686,795,987,768,768,
+  823,768,768,713,713,713,713,713,713,713,768,713,790,790,890,823,549,250,713,603,603,1042,
+  987,603,987,603,494,329,790,790,786,713,384,384,384,384,384,384,494,494,494,494,0,329,
+  274,686,686,686,384,384,384,384,384,384,494,494,494,0);
+
+  // zapfdingbats
+  FONT_ZAPFDINGBATS: array[0..255] of Integer = (
+  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+  0,0,0,0,0,0,0,0,0,0,278,974,961,974,980,719,789,790,791,690,960,939,
+  549,855,911,933,911,945,974,755,846,762,761,571,677,763,760,759,754,494,552,537,577,692,
+  786,788,788,790,793,794,816,823,789,841,823,833,816,831,923,744,723,749,790,792,695,776,
+  768,792,759,707,708,682,701,826,815,789,789,707,687,696,689,786,787,713,791,785,791,873,
+  761,762,762,759,759,892,892,788,784,438,138,277,415,392,392,668,668,0,390,390,317,317,
+  276,276,509,509,410,410,234,234,334,334,0,0,0,0,0,0,0,0,0,0,0,0,
+  0,0,0,0,0,0,0,732,544,544,910,667,760,760,776,595,694,626,788,788,788,788,
+  788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,
+  788,788,788,788,788,788,788,788,788,788,788,788,788,788,894,838,1016,458,748,924,748,918,
+  927,928,928,834,873,828,924,924,917,930,931,463,883,836,836,867,867,696,696,874,0,874,
+  760,946,771,865,771,888,967,888,831,873,927,970,918,0);
+
+

packages/fcl-pdf/src/fpparsettf.pp

@@ -23,16 +23,22 @@ unit fpparsettf;
 interface
 
 uses
-  Classes, SysUtils, fpttfencodings;
+  Classes,
+  SysUtils,
+  fpttfencodings;
 
 type
   ETTF = Class(Exception);
 
   // Tables recognized in this unit.
-  TTTFTableType = (ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost {,ttglyph});
+  TTTFTableType = (
+    // these are for general font information
+    ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost,
+    // these are used for font subsetting
+    ttglyf,ttloca,ttcvt,ttprep,ttfpgm);
 
   TSmallintArray = Packed Array of Int16;
-  TWordArray = Packed Array of UInt16;
+  TWordArray = Packed Array of UInt16;    // redefined because the one in SysUtils is not a packed array
 
   { Signed Fixed 16.16 Float }
   TF16Dot16 = type Int32;
@@ -43,6 +49,7 @@ type
       1:  (Version: UInt32);
   end;
 
+  { The file header record that starts at byte 0 of a TTF file }
   TTableDirectory = Packed Record
     FontVersion : TFixedVersionRec; { UInt32}
     Numtables : UInt16;
@@ -63,7 +70,7 @@ type
     AdvanceWidth : UInt16;
     LSB: Int16;              { leftSideBearing }
   end;
-  TLongHorMetrics = Packed Array of TLongHorMetric;
+  TLongHorMetricArray = Packed Array of TLongHorMetric;
 
 Type
   TPostScript = Packed Record
@@ -166,7 +173,8 @@ Type
     XMaxExtent : Int16;
     CaretSlopeRise : Int16;
     CaretSlopeRun : Int16;
-    Reserved : Array[0..4] of Int16;
+    caretOffset: Int16; // reserved field
+    Reserved : Array[0..3] of Int16;
     metricDataFormat : Int16;
     numberOfHMetrics : UInt16;
   end;
@@ -219,6 +227,19 @@ Type
   TNameEntries = Array of TNameEntry;
 
 
+  TGlyphHeader = packed record
+    numberOfContours: int16;
+    xMin: uint16;
+    yMin: uint16;
+    xMax: uint16;
+    yMax: uint16;
+  end;
+
+
+  { As per the TTF specification document...
+      https://www.microsoft.com/typography/tt/ttf_spec/ttch02.doc
+    ...all TTF files are always stored in Big-Endian byte ordering (pg.31 Data Types).
+  }
   TTFFileInfo = class(TObject)
   private
     FFilename: string;
@@ -233,7 +254,7 @@ Type
     FHHEad : THHead;
     FOS2Data : TOS2Data;
     FPostScript : TPostScript;
-    FWidths: TLongHorMetrics; // hmtx data
+    FWidths: TLongHorMetricArray; // hmtx data
     // Needed to create PDF font def.
     FOriginalSize : Cardinal;
     FMissingWidth: Integer;
@@ -242,7 +263,6 @@ Type
     function FixMinorVersion(const AMinor: word): word;
     function GetMissingWidth: integer;
   Protected
-    Function IsNativeData : Boolean; virtual;
     // Stream reading functions.
     function ReadInt16(AStream: TStream): Int16; inline;
     function ReadUInt32(AStream: TStream): UInt32; inline;
@@ -272,6 +292,7 @@ Type
     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;
+    function  GetTableDirEntry(const ATableName: string; var AEntry: TTableDirectoryEntry): boolean;
     // Load a TTF file from file or stream.
     Procedure LoadFromFile(const AFileName : String);
     Procedure LoadFromStream(AStream: TStream); virtual;
@@ -307,7 +328,7 @@ Type
     property CmapSubtables : TCmapSubTables Read FSubtables;
     property CmapUnicodeMap : TCmapFmt4 Read FUnicodeMap;
     property CmapUnicodeMapSegments : TUnicodeMapSegmentArray Read FUnicodeMapSegments;
-    Property Widths : TLongHorMetrics Read FWidths;
+    Property Widths : TLongHorMetricArray Read FWidths;
     Property MaxP : TMaxP Read FMaxP;
     Property OS2Data : TOS2Data Read FOS2Data;
     Property PostScript : TPostScript Read FPostScript;
@@ -331,7 +352,8 @@ procedure FillMem(Dest: pointer; Size: longint; Data: Byte );
 
 Const
   TTFTableNames : Array[TTTFTableType] of String
-                 = ('','head','hhea','maxp','hmtx','cmap','name','OS/2','post');
+                 = ('','head','hhea','maxp','hmtx','cmap','name','OS/2','post',
+                 'glyf', 'loca', 'cvt ', 'prep', 'fpgm');
 
 
 Const
@@ -393,16 +415,14 @@ function TTFFileInfo.ReadUInt32(AStream: TStream): UInt32;
 begin
   Result:=0;
   AStream.ReadBuffer(Result,SizeOf(Result));
-  if Not IsNativeData then
-    Result:=BEtoN(Result);
+  Result:=BEtoN(Result);
 end;
 
 function TTFFileInfo.ReadUInt16(AStream: TStream): UInt16;
 begin
   Result:=0;
   AStream.ReadBuffer(Result,SizeOf(Result));
-  if Not IsNativeData then
-    Result:=BEtoN(Result);
+  Result:=BEtoN(Result);
 end;
 
 function TTFFileInfo.ReadInt16(AStream: TStream): Int16;
@@ -415,8 +435,6 @@ var
   i : Integer;
 begin
   AStream.ReadBuffer(FHead,SizeOf(FHead));
-  if IsNativeData then
-    exit;
   FHead.FileVersion.Version := BEtoN(FHead.FileVersion.Version);
   FHead.FileVersion.Minor := FixMinorVersion(FHead.FileVersion.Minor);
   FHead.FontRevision.Version := BEtoN(FHead.FontRevision.Version);
@@ -437,34 +455,29 @@ begin
 end;
 
 procedure TTFFileInfo.ParseHhea(AStream : TStream);
-
 begin
   AStream.ReadBuffer(FHHEad,SizeOf(FHHEad));
-  if IsNativeData then
-    exit;
   FHHEad.TableVersion.Version := BEToN(FHHEad.TableVersion.Version);
   FHHEad.TableVersion.Minor := FixMinorVersion(FHHEad.TableVersion.Minor);
   FHHEad.Ascender:=BEToN(FHHEad.Ascender);
   FHHEad.Descender:=BEToN(FHHEad.Descender);
   FHHEad.LineGap:=BEToN(FHHEad.LineGap);
+  FHHead.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
   FHHEad.MinLeftSideBearing:=BEToN(FHHEad.MinLeftSideBearing);
   FHHEad.MinRightSideBearing:=BEToN(FHHEad.MinRightSideBearing);
   FHHEad.XMaxExtent:=BEToN(FHHEad.XMaxExtent);
   FHHEad.CaretSlopeRise:=BEToN(FHHEad.CaretSlopeRise);
   FHHEad.CaretSlopeRun:=BEToN(FHHEad.CaretSlopeRun);
+  FHHEad.caretOffset := BEToN(FHHEad.caretOffset);
   FHHEad.metricDataFormat:=BEToN(FHHEad.metricDataFormat);
   FHHEad.numberOfHMetrics:=BEToN(FHHEad.numberOfHMetrics);
-  FHHead.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
 end;
 
 procedure TTFFileInfo.ParseMaxp(AStream : TStream);
-
 begin
   AStream.ReadBuffer(FMaxP,SizeOf(TMaxP));
-  if IsNativeData then
-    exit;
   With FMaxP do
-    begin
+  begin
     VersionNumber.Version := BEtoN(VersionNumber.Version);
     VersionNumber.Minor := FixMinorVersion(VersionNumber.Minor);
     numGlyphs:=BEtoN(numGlyphs);
@@ -481,24 +494,20 @@ begin
     maxSizeOfInstructions :=BEtoN(maxSizeOfInstructions);
     maxComponentElements :=BEtoN(maxComponentElements);
     maxComponentDepth :=BEtoN(maxComponentDepth);
-    end;
+  end;
 end;
 
 procedure TTFFileInfo.ParseHmtx(AStream : TStream);
-
 var
   i : Integer;
-
 begin
   SetLength(FWidths,FHHead.numberOfHMetrics);
   AStream.ReadBuffer(FWidths[0],SizeOf(TLongHorMetric)*Length(FWidths));
-  if IsNativeData then
-    exit;
   for I:=0 to FHHead.NumberOfHMetrics-1 do
-    begin
+  begin
     FWidths[I].AdvanceWidth:=BEtoN(FWidths[I].AdvanceWidth);
     FWidths[I].LSB:=BEtoN(FWidths[I].LSB);
-    end;
+  end;
 end;
 
 
@@ -510,7 +519,6 @@ var
   Segm : TUnicodeMapSegment;
   GlyphIDArray : Array of word;
   S : TStream;
-
 begin
   TableStartPos:=AStream.Position;
   FCMapH.Version:=ReadUInt16(AStream);
@@ -670,80 +678,76 @@ begin
   FillWord(FOS2Data,SizeOf(TOS2Data) div 2,0);
   // -18, so version 1 will not overflow
   AStream.ReadBuffer(FOS2Data,SizeOf(TOS2Data)-18);
-  if Not isNativeData then
-    With FOS2Data do
-      begin
-      version:=BeToN(version);
-      xAvgCharWidth:=BeToN(xAvgCharWidth);
-      usWeightClass:=BeToN(usWeightClass);
-      usWidthClass:=BeToN(usWidthClass);
-      fsType:=BeToN(fsType);
-      ySubscriptXSize:=BeToN(ySubscriptXSize);
-      ySubscriptYSize:=BeToN(ySubscriptYSize);
-      ySubscriptXOffset:=BeToN(ySubscriptXOffset);
-      ySubscriptYOffset:=BeToN(ySubscriptYOffset);
-      ySuperscriptXSize:=BeToN(ySuperscriptXSize);
-      ySuperscriptYSize:=BeToN(ySuperscriptYSize);
-      ySuperscriptXOffset:=BeToN(ySuperscriptXOffset);
-      ySuperscriptYOffset:=BeToN(ySuperscriptYOffset);
-      yStrikeoutSize:=BeToN(yStrikeoutSize);
-      yStrikeoutPosition:=BeToN(yStrikeoutPosition);
-      sFamilyClass:=BeToN(sFamilyClass);
-      ulUnicodeRange1:=BeToN(ulUnicodeRange1);
-      ulUnicodeRange2:=BeToN(ulUnicodeRange2);
-      ulUnicodeRange3:=BeToN(ulUnicodeRange3);
-      ulUnicodeRange4:=BeToN(ulUnicodeRange4);
-      fsSelection:=BeToN(fsSelection);
-      usFirstCharIndex:=BeToN(usFirstCharIndex);
-      usLastCharIndex:=BeToN(usLastCharIndex);
-      sTypoAscender:=BeToN(sTypoAscender);
-      sTypoDescender:=BeToN(sTypoDescender);
-      sTypoLineGap:=BeToN(sTypoLineGap);
-      usWinAscent:=BeToN(usWinAscent);
-      usWinDescent:=BeToN(usWinDescent);
-      // We miss 7 fields
-      end;
   With FOS2Data do
-    begin
+  begin
+    version:=BeToN(version);
+    xAvgCharWidth:=BeToN(xAvgCharWidth);
+    usWeightClass:=BeToN(usWeightClass);
+    usWidthClass:=BeToN(usWidthClass);
+    fsType:=BeToN(fsType);
+    ySubscriptXSize:=BeToN(ySubscriptXSize);
+    ySubscriptYSize:=BeToN(ySubscriptYSize);
+    ySubscriptXOffset:=BeToN(ySubscriptXOffset);
+    ySubscriptYOffset:=BeToN(ySubscriptYOffset);
+    ySuperscriptXSize:=BeToN(ySuperscriptXSize);
+    ySuperscriptYSize:=BeToN(ySuperscriptYSize);
+    ySuperscriptXOffset:=BeToN(ySuperscriptXOffset);
+    ySuperscriptYOffset:=BeToN(ySuperscriptYOffset);
+    yStrikeoutSize:=BeToN(yStrikeoutSize);
+    yStrikeoutPosition:=BeToN(yStrikeoutPosition);
+    sFamilyClass:=BeToN(sFamilyClass);
+    ulUnicodeRange1:=BeToN(ulUnicodeRange1);
+    ulUnicodeRange2:=BeToN(ulUnicodeRange2);
+    ulUnicodeRange3:=BeToN(ulUnicodeRange3);
+    ulUnicodeRange4:=BeToN(ulUnicodeRange4);
+    fsSelection:=BeToN(fsSelection);
+    usFirstCharIndex:=BeToN(usFirstCharIndex);
+    usLastCharIndex:=BeToN(usLastCharIndex);
+    sTypoAscender:=BeToN(sTypoAscender);
+    sTypoDescender:=BeToN(sTypoDescender);
+    sTypoLineGap:=BeToN(sTypoLineGap);
+    usWinAscent:=BeToN(usWinAscent);
+    usWinDescent:=BeToN(usWinDescent);
+    // We miss 7 fields
+  end;
+  With FOS2Data do
+  begin
     // Read remaining 7 fields' data depending on version
     if Version>=1 then
-      begin
+    begin
       ulCodePageRange1:=ReadUInt32(AStream);
       ulCodePageRange2:=ReadUInt32(AStream);
-      end;
+    end;
     if Version>=2 then
-      begin
+    begin
       sxHeight:=ReadInt16(AStream);
       sCapHeight:=ReadInt16(AStream);
       usDefaultChar:=ReadUInt16(AStream);
       usBreakChar:=ReadUInt16(AStream);
       usMaxContext:=ReadUInt16(AStream);
-      end;
     end;
+  end;
 end;
 
 procedure TTFFileInfo.ParsePost(AStream : TStream);
-
 begin
   AStream.ReadBuffer(FPostScript,SizeOf(TPostScript));
-  if not IsNativeData then
-    With FPostScript do
-      begin
-      Format.Version := BEtoN(Format.Version);
-      Format.Minor := FixMinorVersion(Format.Minor);
-      ItalicAngle:=BeToN(ItalicAngle);
-      UnderlinePosition:=BeToN(UnderlinePosition);
-      underlineThickness:=BeToN(underlineThickness);
-      isFixedPitch:=BeToN(isFixedPitch);
-      minMemType42:=BeToN(minMemType42);
-      maxMemType42:=BeToN(maxMemType42);
-      minMemType1:=BeToN(minMemType1);
-      maxMemType1:=BeToN(maxMemType1);
-      end;
+  With FPostScript do
+  begin
+    Format.Version := BEtoN(Format.Version);
+    Format.Minor := FixMinorVersion(Format.Minor);
+    ItalicAngle:=BeToN(ItalicAngle);
+    UnderlinePosition:=BeToN(UnderlinePosition);
+    underlineThickness:=BeToN(underlineThickness);
+    isFixedPitch:=BeToN(isFixedPitch);
+    minMemType42:=BeToN(minMemType42);
+    maxMemType42:=BeToN(maxMemType42);
+    minMemType1:=BeToN(minMemType1);
+    maxMemType1:=BeToN(maxMemType1);
+  end;
 end;
 
 procedure TTFFileInfo.LoadFromFile(const AFileName: String);
-
 Var
   AStream: TFileStream;
 begin
@@ -763,31 +767,30 @@ var
 begin
   FOriginalSize:= AStream.Size;
   AStream.ReadBuffer(FTableDir,Sizeof(TTableDirectory));
-  if not isNativeData then
-    With FTableDir do
-      begin
-      FontVersion.Version := BEtoN(FontVersion.Version);
-      FontVersion.Minor := FixMinorVersion(FontVersion.Minor);
-      Numtables:=BeToN(Numtables);
-      SearchRange:=BeToN(SearchRange);
-      EntrySelector:=BeToN(EntrySelector);
-      RangeShift:=BeToN(RangeShift);
-      end;
+  With FTableDir do
+  begin
+    FontVersion.Version := BEtoN(FontVersion.Version);
+    FontVersion.Minor := FixMinorVersion(FontVersion.Minor);
+    Numtables:=BeToN(Numtables);
+    SearchRange:=BeToN(SearchRange);
+    EntrySelector:=BeToN(EntrySelector);
+    RangeShift:=BeToN(RangeShift);
+  end;
   SetLength(FTables,FTableDir.Numtables);
   AStream.ReadBuffer(FTables[0],FTableDir.NumTables*Sizeof(TTableDirectoryEntry));
-  if Not IsNativeData then
-    For I:=0 to Length(FTables)-1 do
-      With FTables[I] do
-        begin
-        checkSum:=BeToN(checkSum);
-        offset:=BeToN(offset);
-        Length:=BeToN(Length);
-        end;
-  for I:=0 to FTableDir.NumTables-1 do
+  For I:=0 to Length(FTables)-1 do
+    With FTables[I] do
     begin
+      // note: Tag field doesn't require BEtoN processing.
+      checkSum:=BeToN(checkSum);
+      offset:=BeToN(offset);
+      Length:=BeToN(Length);
+    end;
+  for I:=0 to FTableDir.NumTables-1 do
+  begin
     TT:=GetTableType(FTables[I].Tag);
     if (TT<>ttUnknown) then
-      begin
+    begin
       AStream.Position:=FTables[i].Offset;
       Case TT of
         tthead: ParseHead(AStream);
@@ -799,8 +802,8 @@ begin
         ttos2 : ParseOS2(AStream);
         ttPost: ParsePost(AStream);
       end;
-      end;
     end;
+  end;
 end;
 
 procedure TTFFileInfo.PrepareFontDefinition(const Encoding: string; Embed: Boolean);
@@ -813,13 +816,13 @@ begin
 //  MissingWidth:=ToNatural(Widths[Chars[CharCodes^[32]]].AdvanceWidth);  // Char(32) - Space character
   FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // Char(32) - Space character
   for I:=0 to 255 do
-    begin
+  begin
     if (CharCodes^[i]>=0) and (CharCodes^[i]<=High(Chars))
     and (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then
       CharWidth[I]:= ToNatural(Widths[Chars[CharCodes^[I]]].AdvanceWidth)
     else
       CharWidth[I]:= FMissingWidth;
-    end;
+  end;
 end;
 
 procedure TTFFileInfo.PrepareEncoding(const AEncoding: String);
@@ -842,12 +845,12 @@ begin
   L:= 0;
   for i:=32 to 255 do
     if CharNames^[i]<>CharBase^[i]  then
-      begin
+    begin
       if (i<>l+1) then
         Result:= Result+IntToStr(i)+' ';
       l:=i;
       Result:= Result+'/'+CharNames^[i]+' ';
-      end;
+    end;
 end;
 
 function TTFFileInfo.Bold: Boolean;
@@ -900,6 +903,23 @@ begin
   result := Chars[AValue];
 end;
 
+function TTFFileInfo.GetTableDirEntry(const ATableName: string; var AEntry: TTableDirectoryEntry): boolean;
+var
+  i: integer;
+begin
+  FillMem(@AEntry, SizeOf(TTableDirectoryEntry), 0);
+  Result := False;
+  for i := Low(Tables) to High(Tables) do
+  begin
+    if CompareStr(Tables[i].Tag, ATableName) = 0 then
+    begin
+      Result := True;
+      AEntry := Tables[i];
+      Exit;
+    end;
+  end;
+end;
+
 function TTFFileInfo.GetAdvanceWidth(AIndex: word): word;
 begin
   Result := Widths[AIndex].AdvanceWidth;
@@ -948,11 +968,6 @@ begin
   Result := FMissingWidth;
 end;
 
-function TTFFileInfo.IsNativeData: Boolean;
-begin
-  Result:=False;
-end;
-
 function TTFFileInfo.ToNatural(AUnit: Smallint): Smallint;
 begin
   if FHead.UnitsPerEm=0 then

packages/fcl-pdf/src/fpttf.pp

@@ -49,12 +49,17 @@ type
     FFileInfo: TTFFileInfo;
     FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
     FPostScriptName: string;
+    procedure   DoLoadFileInfo;
+    procedure   LoadFileInfo;
     procedure   BuildFontCacheItem;
     procedure   SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles; const AStyleName: String; const AStyle: TTrueTypeFontStyle);
     function    GetIsBold: boolean;
     function    GetIsFixedWidth: boolean;
     function    GetIsItalic: boolean;
     function    GetIsRegular: boolean;
+    function    GetFamilyName: String;
+    function    GetPostScriptName: string;
+    function    GetFileInfo: TTFFileInfo;
   public
     constructor Create(const AFilename: String);
     destructor  Destroy; override;
@@ -63,9 +68,9 @@ type
     { Result is in pixels }
     function    TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single;
     property    FileName: String read FFileName;
-    property    FamilyName: String read FFamilyName;
-    property    PostScriptName: string read FPostScriptName;
-    property    FontData: TTFFileInfo read FFileInfo;
+    property    FamilyName: String read GetFamilyName;
+    property    PostScriptName: string read GetPostScriptName;
+    property    FontData: TTFFileInfo read GetFileInfo;
     { A bitmasked value describing the full font style }
     property    StyleFlags: TTrueTypeFontStyles read FStyleFlags;
     { IsXXX properties are convenience properties, internally querying StyleFlags. }
@@ -78,7 +83,7 @@ type
 
   TFPFontCacheList = class(TObject)
   private
-    FBuildFontFacheIgnoresErrors: Boolean;
+    FBuildFontCacheIgnoresErrors: Boolean;
     FList: TObjectList;
     FSearchPath: TStringList;
     FDPI: integer;
@@ -97,6 +102,8 @@ type
     function    Add(const AObject: TFPFontCacheItem): integer;
     procedure   AssignFontList(const AStrings: TStrings);
     procedure   Clear;
+    procedure   LoadFromFile(const AFilename: string);
+    procedure   ReadStandardFonts;
     property    Count: integer read GetCount;
     function    IndexOf(const AObject: TFPFontCacheItem): integer;
     function    Find(const AFontCacheItem: TFPFontCacheItem): integer; overload;
@@ -107,7 +114,7 @@ type
     property    Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
     property    SearchPath: TStringList read FSearchPath;
     property    DPI: integer read FDPI write SetDPI;
-    Property    BuildFontFacheIgnoresErrors : Boolean Read FBuildFontFacheIgnoresErrors Write FBuildFontFacheIgnoresErrors;
+    Property    BuildFontCacheIgnoresErrors : Boolean Read FBuildFontCacheIgnoresErrors Write FBuildFontCacheIgnoresErrors;
   end;
 
 
@@ -115,10 +122,18 @@ function gTTFontCache: TFPFontCacheList;
 
 implementation
 
+uses
+  DOM
+  ,XMLRead
+  {$ifdef mswindows}
+  ,Windows  // for SHGetFolderPath API call used by gTTFontCache.ReadStandardFonts() method
+  {$endif}
+  ;
+
 resourcestring
   rsNoSearchPathDefined = 'No search path was defined';
   rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.';
-  rsCharAboveWord = 'TextWidth doesn''t support characters higher then High(Word) - %d.';
+  rsMissingFontFile = 'The font file <%s> can''t be found.';
 
 var
   uFontCacheList: TFPFontCacheList;
@@ -134,26 +149,66 @@ end;
 
 { TFPFontCacheItem }
 
+procedure TFPFontCacheItem.DoLoadFileInfo;
+begin
+  if not Assigned(FFileInfo) then
+    LoadFileInfo;
+end;
+
+procedure TFPFontCacheItem.LoadFileInfo;
+begin
+  if FileExists(FFilename) then
+  begin
+    FFileInfo := TTFFileInfo.Create;
+    FFileInfo.LoadFromFile(FFilename);
+    BuildFontCacheItem;
+  end
+  else
+    raise ETTF.CreateFmt(rsMissingFontFile, [FFilename]);
+end;
+
 function TFPFontCacheItem.GetIsBold: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsBold in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsFixedWidth: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsFixedWidth in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsItalic: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsItalic in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsRegular: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsRegular in FStyleFlags;
 end;
 
+function TFPFontCacheItem.GetFamilyName: String;
+begin
+  DoLoadFileInfo;
+  Result := FFamilyName;
+end;
+
+function TFPFontCacheItem.GetPostScriptName: string;
+begin
+  DoLoadFileInfo;
+  Result := FPostScriptName;
+end;
+
+function TFPFontCacheItem.GetFileInfo: TTFFileInfo;
+begin
+  DoLoadFileInfo;
+  Result := FFileInfo;
+end;
+
 procedure TFPFontCacheItem.BuildFontCacheItem;
 var
   s: string;
@@ -205,13 +260,6 @@ begin
 
   if AFileName = '' then
     raise ETTF.Create(rsNoFontFileName);
-
-  if FileExists(AFilename) then
-  begin
-    FFileInfo := TTFFileInfo.Create;
-    FFileInfo.LoadFromFile(AFilename);
-    BuildFontCacheItem;
-  end;
 end;
 
 destructor TFPFontCacheItem.Destroy;
@@ -253,6 +301,7 @@ var
   s: string;
   {$ENDIF}
 begin
+  DoLoadFileInfo;
   Result := 0;
   if Length(AStr) = 0 then
     Exit;
@@ -294,6 +343,7 @@ end;
 
 function TFPFontCacheItem.TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single;
 begin
+  DoLoadFileInfo;
   { Both lHeight and lDescenderHeight are in pixels }
   Result := FFileInfo.CapHeight * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm);
   ADescender := Abs(FFileInfo.Descender) * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm);
@@ -307,7 +357,7 @@ var
   lFont: TFPFontCacheItem;
   s: String;
 begin
-  if FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then
+  if SysUtils.FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then
   begin
     repeat
       // check if special files to skip
@@ -326,14 +376,14 @@ begin
             lFont := TFPFontCacheItem.Create(AFontPath + s);
             Add(lFont);
           except
-            if not FBuildFontFacheIgnoresErrors then
+            if not FBuildFontCacheIgnoresErrors then
               Raise;
           end;
         end;
       end;
-    until FindNext(sr) <> 0;
+    until SysUtils.FindNext(sr) <> 0;
   end;
-  FindClose(sr);
+  SysUtils.FindClose(sr);
 end;
 
 procedure TFPFontCacheList.SetDPI(AValue: integer);
@@ -419,6 +469,96 @@ begin
   FList.Clear;
 end;
 
+procedure TFPFontCacheList.LoadFromFile(const AFilename: string);
+var
+  sl: TStringList;
+  i: integer;
+begin
+  sl := TStringList.Create;
+  try
+    sl.LoadFromFile(AFilename);
+    for i := 0 to sl.Count-1 do
+      Add(TFPFontCacheItem.Create(sl[i]));
+  finally
+    sl.Free;
+  end;
+end;
+
+{ This is operating system dependent. Our default implementation only supports
+  Linux, FreeBSD, Windows and OSX. On other platforms, no fonts will be loaded,
+  until a implementation is created.
+
+  NOTE:
+    This is definitely not a perfect solution, especially due to the inconsistent
+    implementations and locations of files under various Linux distros. But it's
+    the best we can do for now. }
+procedure TFPFontCacheList.ReadStandardFonts;
+
+  {$ifdef linux}
+    {$define HasFontsConf}
+    const
+      cFontsConf = '/etc/fonts/fonts.conf';
+  {$endif}
+
+  {$ifdef freebsd}
+    {$define HasFontsConf}
+    const
+      cFontsConf = '/usr/local/etc/fonts/fonts.conf';
+  {$endif}
+
+  {$ifdef mswindows}
+  function GetWinDir: string;
+  var
+    dir: array [0..MAX_PATH] of Char;
+  begin
+    GetWindowsDirectory(dir, MAX_PATH);
+    Result := StrPas(dir);
+  end;
+  {$endif}
+
+{$ifdef HasFontsConf}
+var
+  doc: TXMLDocument;
+  lChild: TDOMNode;
+  lDir: string;
+{$endif}
+begin
+  {$ifdef HasFontsConf} // Linux & FreeBSD
+  ReadXMLFile(doc, cFontsConf);
+  try
+    lChild := doc.DocumentElement.FirstChild;
+    while Assigned(lChild) do
+    begin
+      if lChild.NodeName = 'dir' then
+      begin
+        if lChild.FirstChild.NodeValue = '~/.fonts' then
+          lDir := ExpandFilename(lChild.FirstChild.NodeValue)
+        else
+          lDir := lChild.FirstChild.NodeValue;
+        SearchPath.Add(lDir);
+//        writeln(lDir);
+      end;
+      lChild := lChild.NextSibling;
+    end;
+  finally
+    doc.Free;
+  end;
+  {$endif}
+
+  {$ifdef mswindows}
+  SearchPath.Add(GetWinDir);
+  {$endif}
+
+  {$ifdef darwin} // OSX
+  { As per Apple Support page: https://support.apple.com/en-us/HT201722 }
+  SearchPath.Add('/System/Library/Fonts/');
+  SearchPath.Add('/Library/Fonts/');
+  SearchPath.Add(ExpandFilename('~/Library/Fonts/'));
+  {$endif}
+
+  BuildFontCache;
+end;
+
 function TFPFontCacheList.IndexOf(const AObject: TFPFontCacheItem): integer;
 begin
   Result := FList.IndexOf(AObject);

packages/fcl-pdf/tests/fpparsettf_test.pas

@@ -971,7 +971,7 @@ end;
 
 procedure TTestLiberationFont.TestOS2Data_ulUnicodeRange1;
 begin
-  AssertEquals('Failed on 1', '1110 0000 0000 0000 0000 1010 1111 1111', IntToBin(FI.OS2Data.ulUnicodeRange1, 32, 4));
+//  AssertEquals('Failed on 1', '1110 0000 0000 0000 0000 1010 1111 1111', IntToBin(FI.OS2Data.ulUnicodeRange1, 32, 4));
   AssertEquals('Failed on 2', 'E0000AFF', IntToHex(FI.OS2Data.ulUnicodeRange1, 8));
 end;
 

packages/fcl-pdf/tests/fppdf_test.pas

@@ -21,6 +21,7 @@ type
   private
     FPDF: TPDFDocument;
     FStream: TStringStream;
+    procedure   CreatePages(const ACount: integer);
   protected
     procedure   SetUp; override;
     procedure   TearDown; override;
@@ -200,6 +201,7 @@ type
     procedure   TestWrite_ppsDot;
     procedure   TestWrite_ppsDashDot;
     procedure   TestWrite_ppsDashDotDot;
+    procedure   TestLocalisationChanges;
   end;
 
 
@@ -232,7 +234,8 @@ type
   published
     procedure   TestPageDocument;
     procedure   TestPageDefaultUnitOfMeasure;
-    procedure   TestMatrix;
+    procedure   TestMatrixOn;
+    procedure   TestMatrixOff;
     procedure   TestUnitOfMeasure_MM;
     procedure   TestUnitOfMeasure_Inches;
     procedure   TestUnitOfMeasure_CM;
@@ -295,6 +298,23 @@ type
 
 { TBasePDFTest }
 
+procedure TBasePDFTest.CreatePages(const ACount: integer);
+var
+  page: TPDFPage;
+  sec: TPDFSection;
+  i: integer;
+begin
+  if FPDF.Sections.Count = 0 then
+    sec := FPDF.Sections.AddSection
+  else
+    sec := FPDF.Sections[0];
+  for i := 1 to ACount do
+  begin
+    page := FPDF.Pages.AddPage;
+    sec.AddPage(page);
+  end;
+end;
+
 procedure TBasePDFTest.SetUp;
 begin
   inherited SetUp;
@@ -334,7 +354,7 @@ Var
 
 begin
   AssertEquals('Failed on 1', '0.12', TMockPDFObject.FloatStr(TPDFFLoat(0.12)));
-  AssertEquals('Failed on 2', '  12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
+  AssertEquals('Failed on 2', '12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
   AssertEquals('Failed on 3', '12.30', TMockPDFObject.FloatStr(TPDFFLoat(12.30)));
   AssertEquals('Failed on 4', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
   AssertEquals('Failed on 5', '123.45', TMockPDFObject.FloatStr(TPDFFLoat(123.45)));
@@ -399,7 +419,7 @@ begin
       '1 J'+CRLF+
       '300.50 w'+CRLF+           // line width 300.5
       '1 J'+CRLF+
-      ' 123 w'+CRLF,             // line width 123
+      '123 w'+CRLF,             // line width 123
       s.DataString);
   finally
     o.Free;
@@ -446,7 +466,7 @@ begin
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFMoveTo(o).Write(S);
-    AssertEquals('Failed on 2', '  10   20 m'+CRLF, S.DataString);
+    AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
   finally
     o.Free;
   end;
@@ -463,7 +483,7 @@ begin
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFMoveTo(o).Write(S);
-    AssertEquals('Failed on 2', '  10   20 m'+CRLF, S.DataString);
+    AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
   finally
     o.Free;
   end;
@@ -743,8 +763,11 @@ end;
 procedure TTestPDFEmbeddedFont.TestWrite;
 var
   o: TPDFEmbeddedFont;
+  p: TPDFPage;
 begin
-  o := TPDFEmbeddedFont.Create(PDF, 1, '16');
+  CreatePages(1);
+  p := PDF.Pages[0];
+  o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFEmbeddedFont(o).Write(S);
@@ -759,10 +782,13 @@ var
   o: TPDFEmbeddedFont;
   lStream: TMemoryStream;
   str: String;
+  p: TPDFPage;
 begin
   PDF.Options := []; // disable compressed fonts
   str := 'Hello World';
-  o := TPDFEmbeddedFont.Create(PDF, 1, '16');
+  CreatePages(1);
+  p := PDF.Pages[0];
+  o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
   try
     AssertEquals('Failed on 1', '', S.DataString);
     lStream := TMemoryStream.Create;
@@ -785,13 +811,13 @@ var
 begin
   x := 10.5;
   y := 20.0;
-  o := TPDFText.Create(PDF, x, y, 'Hello World!', 0);
+  o := TPDFText.Create(PDF, x, y, 'Hello World!', nil, 0, false, false);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFText(o).Write(S);
     AssertEquals('Failed on 2',
       'BT'+CRLF+
-      '10.50   20 TD'+CRLF+
+      '10.50 20 TD'+CRLF+
       '(Hello World!) Tj'+CRLF+
       'ET'+CRLF,
       S.DataString);
@@ -808,7 +834,7 @@ var
 begin
   pos.X := 10.0;
   pos.Y := 55.5;
-  AssertEquals('Failed on 1', '  10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
+  AssertEquals('Failed on 1', '10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
 end;
 
 procedure TTestPDFLineSegment.TestWrite;
@@ -827,9 +853,9 @@ begin
     TMockPDFLineSegment(o).Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+             // line width
-      '  10 15.50 m'+CRLF+       // moveto command
-      '  50 55.50 l'+CRLF+       // line segment
+      '2 w'+CRLF+             // line width
+      '10 15.50 m'+CRLF+      // moveto command
+      '50 55.50 l'+CRLF+      // line segment
       'S'+CRLF,               // end line segment
       S.DataString);
   finally
@@ -854,7 +880,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '  10   11  100  200 re'+CRLF,
+      '10 11 100 200 re'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -877,8 +903,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      '  10   11  100  200 re'+CRLF+
+      '2 w'+CRLF+
+      '10 11 100 200 re'+CRLF+
       'b'+CRLF,
       S.DataString);
   finally
@@ -902,8 +928,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      '  10   11  100  200 re'+CRLF+
+      '2 w'+CRLF+
+      '10 11 100 200 re'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -926,7 +952,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '  10   11  100  200 re'+CRLF+
+      '10 11 100 200 re'+CRLF+
       'f'+CRLF,
       S.DataString);
   finally
@@ -950,7 +976,7 @@ begin
   X3 := 200;
   Y3 := 250;
   s1 := TMockPDFCurveC.Command(x1, y1, x2, y2, x3, y3);
-  AssertEquals('Failed on 1', '  10   11  100    9  200  250 c'+CRLF, s1);
+  AssertEquals('Failed on 1', '10 11 100 9 200 250 c'+CRLF, s1);
 end;
 
 procedure TTestPDFCurveC.TestWrite_Stroke;
@@ -974,8 +1000,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      '  10   11  100    9  200  250 c'+CRLF+
+      '2 w'+CRLF+
+      '10 11 100 9 200 250 c'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1003,7 +1029,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '  10   11  100    9  200  250 c'+CRLF,
+      '10 11 100 9 200 250 c'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1030,8 +1056,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      ' 100    9  200  250 v'+CRLF+
+      '2 w'+CRLF+
+      '100 9 200 250 v'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1056,7 +1082,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      ' 100    9  200  250 v'+CRLF,
+      '100 9 200 250 v'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1083,8 +1109,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      ' 100    9  200  250 y'+CRLF+
+      '2 w'+CRLF+
+      '100 9 200 250 y'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1109,7 +1135,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      ' 100    9  200  250 y'+CRLF,
+      '100 9 200 250 y'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1134,15 +1160,15 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF,
+      '54.77 270 10 214.04 10 145 c'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1165,15 +1191,15 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF+
+      '54.77 270 10 214.04 10 145 c'+CRLF+
       'f'+CRLF,
       S.DataString);
   finally
@@ -1197,17 +1223,17 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
+      '2 w'+CRLF+
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF+
+      '54.77 270 10 214.04 10 145 c'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1231,17 +1257,17 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
+      '2 w'+CRLF+
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF+
+      '54.77 270 10 214.04 10 145 c'+CRLF+
       'b'+CRLF,
       S.DataString);
   finally
@@ -1270,11 +1296,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '  10   20 m'+CRLF+
+      '10 20 m'+CRLF+
       // line segment - p1
-      '  30   40 l'+CRLF+
+      '30 40 l'+CRLF+
       // line segment - p2
-      '  50   60 l'+CRLF+
+      '50 60 l'+CRLF+
       'h'+CRLF+   // close
       'f'+CRLF,   // fill
       S.DataString);
@@ -1303,11 +1329,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '  10   20 m'+CRLF+
+      '10 20 m'+CRLF+
       // line segment - p1
-      '  30   40 l'+CRLF+
+      '30 40 l'+CRLF+
       // line segment - p2
-      '  50   60 l'+CRLF+
+      '50 60 l'+CRLF+
       'h'+CRLF,   // close
       S.DataString);
   finally
@@ -1335,11 +1361,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '  10   20 m'+CRLF+
+      '10 20 m'+CRLF+
       // line segment - p1
-      '  30   40 l'+CRLF+
+      '30 40 l'+CRLF+
       // line segment - p2
-      '  50   60 l'+CRLF+
+      '50 60 l'+CRLF+
       'f'+CRLF,   // fill
       S.DataString);
   finally
@@ -1364,7 +1390,7 @@ begin
     AssertEquals('Failed on 2',
       // save graphics state
       'q'+CRLF+
-      ' 150 0 0   75  100  200 cm'+CRLF+
+      '150 0 0 75 100 200 cm'+CRLF+
       '/I1 Do'+CRLF+
       // restore graphics state
       'Q'+CRLF,
@@ -1379,6 +1405,7 @@ var
   p: TPDFPage;
   img: TMockPDFImage;
 begin
+  PDF.Options := [poPageOriginAtTop];
   p := PDF.Pages.AddPage;
   p.UnitOfMeasure := uomMillimeters;
   AssertEquals('Failed on 1', 0, p.ObjectCount);
@@ -1391,7 +1418,7 @@ begin
   AssertEquals('Failed on 5',
     // save graphics state
     'q'+CRLF+
-    ' 200 0 0  100 28.35 785.31 cm'+CRLF+
+    '200 0 0 100 28.35 785.31 cm'+CRLF+
     '/I1 Do'+CRLF+
     // restore graphics state
     'Q'+CRLF,
@@ -1411,7 +1438,7 @@ begin
   AssertEquals('Failed on 10',
     // save graphics state
     'q'+CRLF+
-    ' 200 0 0  100 283.46 275.07 cm'+CRLF+
+    '200 0 0 100 283.46 275.07 cm'+CRLF+
     '/I1 Do'+CRLF+
     // restore graphics state
     'Q'+CRLF,
@@ -1423,6 +1450,7 @@ var
   p: TPDFPage;
   img: TMockPDFImage;
 begin
+  PDF.Options := [poPageOriginAtTop];
   p := PDF.Pages.AddPage;
   p.UnitOfMeasure := uomMillimeters;
   AssertEquals('Failed on 1', 0, p.ObjectCount);
@@ -1468,7 +1496,7 @@ procedure TTestPDFLineStyle.TestWrite_ppsSolid;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1);
+  o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
@@ -1484,12 +1512,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDash;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDash, 2);
+  o := TMockPDFLineStyle.Create(PDF, ppsDash, 2, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[5 3] 2 d'+CRLF,
+      '[5 5] 2 d'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1500,12 +1528,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDot;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDot, 3);
+  o := TMockPDFLineStyle.Create(PDF, ppsDot, 3, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[1 3] 3 d'+CRLF,
+      '[0.80 4] 3 d'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1516,12 +1544,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDashDot;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4);
+  o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[5 3 1 3] 4 d'+CRLF,
+      '[5 3 0.80 3] 4 d'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1532,16 +1560,36 @@ procedure TTestPDFLineStyle.TestWrite_ppsDashDotDot;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1);
+  o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    o.Write(S);
+    AssertEquals('Failed on 2',
+      '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
+      S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
+procedure TTestPDFLineStyle.TestLocalisationChanges;
+var
+  o: TMockPDFLineStyle;
+  d: char;
+begin
+  d :=  DefaultFormatSettings.DecimalSeparator;
+  DefaultFormatSettings.DecimalSeparator := Char('~');
+  o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[5 3 1 3 1 3] 1 d'+CRLF,
+      '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
       S.DataString);
   finally
     o.Free;
   end;
+  DefaultFormatSettings.DecimalSeparator := d;
 end;
 
 { TTestPDFColor }
@@ -1673,11 +1721,13 @@ begin
   AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
 end;
 
-procedure TTestPDFPage.TestMatrix;
+// (0,0) origin is at top-left of page
+procedure TTestPDFPage.TestMatrixOn;
 var
   p: TPDFPage;
   pt1, pt2: TPDFCoord;
 begin
+  PDF.Options := [poPageOriginAtTop];
   p := PDF.Pages.AddPage;
   AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
   AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), p.Paper.H);
@@ -1693,6 +1743,28 @@ begin
   AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
 end;
 
+// (0,0) origin is at bottom-left of page
+procedure TTestPDFPage.TestMatrixOff;
+var
+  p: TPDFPage;
+  pt1, pt2: TPDFCoord;
+begin
+  PDF.Options := [];
+  p := PDF.Pages.AddPage;
+  AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
+  AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), 0);
+
+  pt1.X := 10;
+  pt1.Y := 20;
+  pt2 := p.Matrix.Transform(pt1);
+  AssertEquals('Failed on 3', 10, pt2.X);
+  AssertEquals('Failed on 4', 20, pt2.Y, 0.1);
+
+  pt1 := p.Matrix.ReverseTransform(pt2);
+  AssertEquals('Failed on 5', 10, pt1.X);
+  AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
+end;
+
 procedure TTestPDFPage.TestUnitOfMeasure_MM;
 var
   p: TPDFPage;

packages/fcl-pdf/tests/fpttf_test.pas

@@ -12,25 +12,39 @@ uses
   ,fpcunit, testregistry
   {$endif}
   ,fpttf
+  ,fpparsettf
   ;
 
 type
 
+  TMyTestFPFontCacheItem = class(TFPFontCacheItem)
+  protected
+    FFileInfo: TTFFileInfo;
+  end;
+
+
   TFPFontCacheItemTest = class(TTestCase)
   private
-    FCacheItem: TFPFontCacheItem;
+    FCacheItem: TMyTestFPFontCacheItem;
+    procedure SetupRealFont;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
   public
-    property CI: TFPFontCacheItem read FCacheItem;
+    property CI: TMyTestFPFontCacheItem read FCacheItem;
   published
+    procedure TestIsRegularCantFind;
+    procedure TestIsBoldCantFind;
+    procedure TestIsItalicCantFind;
+    procedure TestIsFixedWidthCantFind;
+    procedure TestFileInfoCantFind;
     procedure TestIsRegular;
     procedure TestIsBold;
     procedure TestIsItalic;
     procedure TestIsFixedWidth;
     procedure TestRegularVsFixedWidth;
     procedure TestFileName;
+    procedure TestFontInfoAfterCreate;
     procedure TestTextWidth_FontUnits;
     procedure TestTextWidth_Pixels;
   end;
@@ -52,25 +66,31 @@ type
     procedure TestFind_FamilyName;
     procedure TestFind_PostscriptName;
     procedure TestAssignFontList;
+    procedure TestLoadFromFile;
+    procedure TestReadStandardFonts;
   end;
 
 implementation
 
-uses
-  fpparsettf;
-
 const
   cFontCount = 5;
 
 resourcestring
   cErrFontCountWrong =   ' - make sure you only have the 5 test fonts in the "fonts" directory.';
 
+
 { TFPFontCacheItemTest }
 
+procedure TFPFontCacheItemTest.SetupRealFont;
+begin
+  FCacheItem.Free;
+  FCacheItem := TMyTestFPFontCacheItem.Create('fonts' + PathDelim + 'DejaVuSans.ttf');
+end;
+
 procedure TFPFontCacheItemTest.SetUp;
 begin
   inherited SetUp;
-  FCacheItem := TFPFontCacheItem.Create('mytest.ttf');
+  FCacheItem := TMyTestFPFontCacheItem.Create('mytest.ttf');
 end;
 
 procedure TFPFontCacheItemTest.TearDown;
@@ -79,29 +99,103 @@ begin
   inherited TearDown;
 end;
 
+procedure TFPFontCacheItemTest.TestIsRegularCantFind;
+begin
+  try
+    AssertFalse(CI.IsRegular);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsBoldCantFind;
+begin
+  try
+    AssertFalse(CI.IsBold);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsItalicCantFind;
+begin
+  try
+    AssertFalse(CI.IsItalic);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsFixedWidthCantFind;
+begin
+  try
+    AssertFalse(CI.IsFixedWidth);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;end;
+
+procedure TFPFontCacheItemTest.TestFileInfoCantFind;
+begin
+  try
+    AssertFalse(CI.FontData <> nil);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
 procedure TFPFontCacheItemTest.TestIsRegular;
 begin
+  SetupRealFont;
   { regular should be the default flag set }
   AssertEquals('Failed on 1', True, CI.IsRegular);
 end;
 
 procedure TFPFontCacheItemTest.TestIsBold;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', False, CI.IsBold);
 end;
 
 procedure TFPFontCacheItemTest.TestIsItalic;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', False, CI.IsItalic);
 end;
 
 procedure TFPFontCacheItemTest.TestIsFixedWidth;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', False, CI.IsFixedWidth);
 end;
 
 procedure TFPFontCacheItemTest.TestRegularVsFixedWidth;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', True, CI.IsRegular);
   AssertEquals('Failed on 2', False, CI.IsFixedWidth);
 end;
@@ -109,8 +203,14 @@ end;
 procedure TFPFontCacheItemTest.TestFileName;
 begin
   AssertTrue('Failed on 1', CI.FileName <> '');
-  { FileName is a non-existing file though, so FontData should be nil }
-  AssertTrue('Failed on 2', CI.FontData = nil);
+  { The Filename property doesn't trigger the loading of font info data }
+  AssertTrue('Failed on 2', CI.FFileInfo = nil);
+end;
+
+procedure TFPFontCacheItemTest.TestFontInfoAfterCreate;
+begin
+  { Font info isn't loaded in the constructor any more - it is now loaded on demand }
+  AssertTrue('Failed on 1', CI.FFileInfo = nil);
 end;
 
 procedure TFPFontCacheItemTest.TestTextWidth_FontUnits;
@@ -312,6 +412,38 @@ begin
   end;
 end;
 
+procedure TFPFontCacheListTest.TestLoadFromFile;
+const
+  cFontListFile = 'fontlist.txt';
+var
+  s: string;
+  lCI: TFPFontCacheItem;
+begin
+  s := ExtractFilePath(ParamStr(0)) + cFontListFile;
+  AssertEquals('Failed on 1', 0, FC.Count);
+  FC.LoadFromFile(s);
+  AssertEquals('Failed on 2', 3, FC.Count);
+
+  lCI := FC.Find('DejaVuSans');
+  AssertTrue('Failed on 3', Assigned(lCI));
+  lCI := nil;
+
+  lCI := FC.Find('FreeSans');
+  AssertTrue('Failed on 4', Assigned(lCI));
+  lCI := nil;
+
+  lCI := FC.Find('LiberationSans-Italic');
+  AssertTrue('Failed on 5', Assigned(lCI));
+  lCI := nil;
+end;
+
+procedure TFPFontCacheListTest.TestReadStandardFonts;
+begin
+  AssertEquals('Failed on 1', 0, FC.Count);
+  FC.ReadStandardFonts;
+  AssertTrue('Failed on 2', FC.Count > 1);
+end;
+
 
 initialization
   RegisterTest({$ifdef fptest}'fpTTF', {$endif}TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});

packages/fcl-pdf/utils/ttfdump.lpi

@@ -32,6 +32,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <CommandLineParams Value="-f ../tests/fonts/FreeSans.ttf -s"/>
       </local>
     </RunParams>
     <Units Count="1">
@@ -56,6 +57,11 @@
         <AllowLabel Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/fcl-pdf/utils/ttfdump.lpr

@@ -1,46 +1,18 @@
 program ttfdump;
 
 {$mode objfpc}{$H+}
+{$codepage utf8}
 
 uses
-  {$IFDEF UNIX}{$IFDEF UseCThreads}
-  cwstrings,
-  {$ENDIF}{$ENDIF}
-  Classes, SysUtils, CustApp,
-  fpparsettf, contnrs;
+  {$ifdef unix}cwstring,{$endif}  // required for UnicodeString handling.
+  Classes,
+  SysUtils,
+  CustApp,
+  fpparsettf,
+  FPFontTextMapping,
+  fpTTFSubsetter;
 
 type
-  // forward declarations
-  TTextMapping = class;
-
-
-  TTextMappingList = class(TObject)
-  private
-    FList: TFPObjectList;
-    function GetCount: Integer;
-  protected
-    function    GetItem(AIndex: Integer): TTextMapping; reintroduce;
-    procedure   SetItem(AIndex: Integer; AValue: TTextMapping); reintroduce;
-  public
-    constructor Create;
-    destructor  Destroy; override;
-    function    Add(AObject: TTextMapping): Integer; overload;
-    function    Add(const ACharID, AGlyphID: uint16): Integer; overload;
-    property    Count: Integer read GetCount;
-    property    Items[Index: Integer]: TTextMapping read GetItem write SetItem; default;
-  end;
-
-
-  TTextMapping = class(TObject)
-  private
-    FCharID: uint16;
-    FGlyphID: uint16;
-  public
-    class function NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
-    property    CharID: uint16 read FCharID write FCharID;
-    property    GlyphID: uint16 read FGlyphID write FGlyphID;
-  end;
-
 
   TMyApplication = class(TCustomApplication)
   private
@@ -48,6 +20,7 @@ type
     procedure   DumpGlyphIndex;
     function    GetGlyphIndicesString(const AText: UnicodeString): AnsiString; overload;
     function    GetGlyphIndices(const AText: UnicodeString): TTextMappingList; overload;
+    procedure   CreateSubsetFontFile(const AList: TTextMappingList);
   protected
     procedure   DoRun; override;
   public
@@ -56,70 +29,10 @@ type
     procedure   WriteHelp; virtual;
   end;
 
-  TFriendClass = class(TTFFileInfo)
-  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;
-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
+  TFriendClass = class(TTFFileInfo)
   end;
-  Result := FList.Add(AObject);
-end;
-
-function TTextMappingList.Add(const ACharID, AGlyphID: uint16): Integer;
-var
-  o: TTextMapping;
-begin
-  o := TTextMapping.Create;
-  o.CharID := ACharID;
-  o.GlyphID := AGlyphID;
-  Result := Add(o);
-  if Result = -1 then
-    o.Free;
-end;
 
-{ TTextMapping }
-
-class function TTextMapping.NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
-begin
-  Result := TTextMapping.Create;
-  Result.CharID := ACharID;
-  Result.GlyphID := AGlyphID;
-end;
 
 { TMyApplication }
 
@@ -127,16 +40,16 @@ procedure TMyApplication.DumpGlyphIndex;
 begin
   Writeln('FHHead.numberOfHMetrics = ', FFontFile.HHead.numberOfHMetrics);
   Writeln('Length(Chars[]) = ', Length(FFontFile.Chars));
-
+  writeln;
   writeln('Glyph Index values:');
-  Writeln('U+0020 (space) = ', FFontFile.Chars[$0020]);
-  Writeln('U+0021 (!) = ', FFontFile.Chars[$0021]);
-  Writeln('U+0048 (H) = ', FFontFile.Chars[$0048]);
-
+  Writeln('  U+0020 (space) = ', Format('%d  (%0:4.4x)', [FFontFile.Chars[$0020]]));
+  Writeln('  U+0021 (!) = ', Format('%d  (%0:4.4x)', [FFontFile.Chars[$0021]]));
+  Writeln('  U+0048 (H) = ', Format('%d  (%0:4.4x)', [FFontFile.Chars[$0048]]));
+  writeln;
   Writeln('Glyph widths:');
-  Writeln('3 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0020]].AdvanceWidth));
-  Writeln('4 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0021]].AdvanceWidth));
-  Writeln('H = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0048]].AdvanceWidth));
+  Writeln('  3 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0020]].AdvanceWidth));
+  Writeln('  4 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0021]].AdvanceWidth));
+  Writeln('  H = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0048]].AdvanceWidth));
 end;
 
 function TMyApplication.GetGlyphIndices(const AText: UnicodeString): TTextMappingList;
@@ -154,6 +67,20 @@ begin
   end;
 end;
 
+procedure TMyApplication.CreateSubsetFontFile(const AList: TTextMappingList);
+var
+  lSubset: TFontSubsetter;
+begin
+  writeln;
+  writeln('called CreateSubsetFontFile...');
+  lSubset := TFontSubsetter.Create(FFontFile, AList);
+  try
+    lSubSet.SaveToFile(ExtractFileName(GetOptionValue('f'))+'.subset.ttf');
+  finally
+    FreeAndNil(lSubSet);
+  end;
+end;
+
 function TMyApplication.GetGlyphIndicesString(const AText: UnicodeString): AnsiString;
 var
   i: integer;
@@ -177,7 +104,7 @@ var
   i: integer;
 begin
   // quick check parameters
-  ErrorMsg := CheckOptions('hf:', 'help');
+  ErrorMsg := CheckOptions('hf:s', 'help');
   if ErrorMsg <> '' then
   begin
     ShowException(Exception.Create(ErrorMsg));
@@ -196,13 +123,25 @@ begin
   FFontFile.LoadFromFile(self.GetOptionValue('f'));
   DumpGlyphIndex;
 
-  s := 'Hello, World!';
+  // test #1
+//  s := 'Hello, World!';
+  // test #2
+  s := 'Typography: “What’s wrong?”';
+
   Writeln('');
   lst := GetGlyphIndices(s);
   Writeln(Format('%d Glyph indices for: "%s"', [lst.Count, s]));
+  writeln(#9'GID'#9'CharID');
+  writeln(#9'---'#9'------');
   for i := 0 to lst.Count-1 do
-    Writeln(Format(#9'%s'#9'%s', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)]));
+    Writeln(Format(#9'%s'#9'%s'#9'%s', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4), Char(lst[i].CharID)]));
+
+  if HasOption('s','') then
+    CreateSubsetFontFile(lst);
+  lst.Free;
 
+  writeln;
+  writeln;
   // stop program loop
   Terminate;
 end;
@@ -225,11 +164,13 @@ begin
   writeln('Usage: ', ExeName, ' -h');
   writeln('   -h            Show this help.');
   writeln('   -f <ttf>      Load TTF font file.');
+  writeln('   -s            Generate a subset TTF file.');
 end;
 
+
+
 var
   Application: TMyApplication;
-
 begin
   Application := TMyApplication.Create(nil);
   Application.Title := 'TTF Font Dump';