--- Merging r33998 into '.':

U    packages/fcl-pdf/examples/testfppdf.lpr
U    packages/fcl-pdf/src/fpttf.pp
U    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r33998 into '.':
 U   .
--- Merging r34037 into '.':
D    packages/fcl-pdf/utils/mkpdffontdef.lpi
D    packages/fcl-pdf/utils/mkpdffontdef.pp
--- Recording mergeinfo for merge of r34037 into '.':
 G   .
--- Merging r34060 into '.':
U    packages/fcl-pdf/tests/fpttf_test.pas
U    packages/fcl-pdf/tests/fpparsettf_test.pas
U    packages/fcl-pdf/src/fpparsettf.pp
G    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r34060 into '.':
 G   .
--- Merging r34543 into '.':
G    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r34543 into '.':
 G   .
--- Merging r34563 into '.':
G    packages/fcl-pdf/examples/testfppdf.lpr
U    packages/fcl-pdf/tests/fppdf_test.pas
G    packages/fcl-pdf/src/fpparsettf.pp
G    packages/fcl-pdf/src/fppdf.pp
G    packages/fcl-pdf/src/fpttf.pp
--- Recording mergeinfo for merge of r34563 into '.':
 G   .
--- Merging r34767 into '.':
G    packages/fcl-pdf/examples/testfppdf.lpr
G    packages/fcl-pdf/tests/fpparsettf_test.pas
G    packages/fcl-pdf/src/fpparsettf.pp
G    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r34767 into '.':
 G   .
--- Merging r34778 into '.':
G    packages/fcl-pdf/src/fppdf.pp
G    packages/fcl-pdf/examples/testfppdf.lpr
--- Recording mergeinfo for merge of r34778 into '.':
 G   .
--- Merging r34779 into '.':
G    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r34779 into '.':
 G   .
--- Merging r34780 into '.':
G    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r34780 into '.':
 G   .
--- Merging r34781 into '.':
G    packages/fcl-pdf/examples/testfppdf.lpr
G    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r34781 into '.':
 G   .
--- Merging r34804 into '.':
G    packages/fcl-pdf/src/fppdf.pp
--- Recording mergeinfo for merge of r34804 into '.':
 G   .
--- Merging r35083 into '.':
G    packages/fcl-pdf/examples/testfppdf.lpr
U    packages/fcl-pdf/utils/ttfdump.lpr
U    packages/fcl-pdf/utils/ttfdump.lpi
U    packages/fcl-pdf/fpmake.pp
G    packages/fcl-pdf/tests/fpparsettf_test.pas
G    packages/fcl-pdf/tests/fppdf_test.pas
G    packages/fcl-pdf/tests/fpttf_test.pas
A    packages/fcl-pdf/src/fontmetrics_stdpdf.inc
G    packages/fcl-pdf/src/fpparsettf.pp
G    packages/fcl-pdf/src/fppdf.pp
G    packages/fcl-pdf/src/fpttf.pp
--- Recording mergeinfo for merge of r35083 into '.':
 G   .
--- Merging r35084 into '.':
A    packages/fcl-pdf/src/fpttfsubsetter.pp
G    packages/fcl-pdf/fpmake.pp
--- Recording mergeinfo for merge of r35084 into '.':
 G   .
--- Merging r35090 into '.':
G    packages/fcl-pdf/fpmake.pp
A    packages/fcl-pdf/src/fpfonttextmapping.pp
--- Recording mergeinfo for merge of r35090 into '.':
 G   .
--- Merging r35094 into '.':
U    packages/fcl-pdf/src/fpttfsubsetter.pp
--- Recording mergeinfo for merge of r35094 into '.':
 G   .
--- Merging r35126 into '.':
G    packages/fcl-pdf/utils/ttfdump.lpi
G    packages/fcl-pdf/src/fppdf.pp
G    packages/fcl-pdf/src/fpttfsubsetter.pp
G    packages/fcl-pdf/examples/testfppdf.lpr
--- Recording mergeinfo for merge of r35126 into '.':
 G   .
--- Merging r35131 into '.':
G    packages/fcl-pdf/src/fppdf.pp
G    packages/fcl-pdf/src/fpttfsubsetter.pp
--- Recording mergeinfo for merge of r35131 into '.':
 G   .
--- Merging r35519 into '.':
G    packages/fcl-pdf/src/fpttfsubsetter.pp
--- Recording mergeinfo for merge of r35519 into '.':
 G   .

# revisions: 33998,34037,34060,34543,34563,34767,34778,34779,34780,34781,34804,35083,35084,35090,35094,35126,35131,35519

git-svn-id: branches/fixes_3_0@36010 -

.gitattributes

@@ -2560,10 +2560,13 @@ 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/fpfonttextmapping.pp 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/src/fpttfencodings.pp svneol=native#text/plain
+packages/fcl-pdf/src/fpttfsubsetter.pp 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
@@ -2574,8 +2577,6 @@ packages/fcl-pdf/tests/unittests_console.lpi svneol=native#text/plain
 packages/fcl-pdf/tests/unittests_console.lpr svneol=native#text/plain
 packages/fcl-pdf/tests/unittests_gui.lpi svneol=native#text/plain
 packages/fcl-pdf/tests/unittests_gui.lpr svneol=native#text/plain
-packages/fcl-pdf/utils/mkpdffontdef.lpi svneol=native#text/plain
-packages/fcl-pdf/utils/mkpdffontdef.pp svneol=native#text/plain
 packages/fcl-pdf/utils/ttfdump.lpi svneol=native#text/plain
 packages/fcl-pdf/utils/ttfdump.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain

packages/fcl-pdf/examples/testfppdf.lpr

@@ -1,5 +1,5 @@
 { This program generates a multi-page PDF document and tests various
-  functionality on each of the 5 pages.
+  functionality on each of the pages.
 
   You can also specify to generate single pages by using the -p <n>
   command line parameter.
@@ -22,17 +22,20 @@ uses
   fpreadjpeg,
   fppdf,
   fpparsettf,
+  fpttf,
   typinfo;
 
 type
 
   TPDFTestApp = class(TCustomApplication)
   private
-    Fpg: integer;
+    FPage: integer;
     FRawJPEG,
     FImageCompression,
     FTextCompression,
     FFontCompression: boolean;
+    FNoFontEmbedding: boolean;
+    FSubsetFontEmbedding: boolean;
     FDoc: TPDFDocument;
     function    SetUpDocument: TPDFDocument;
     procedure   SaveDocument(D: TPDFDocument);
@@ -42,8 +45,10 @@ type
     procedure   SimpleLines(D: TPDFDocument; APage: integer);
     procedure   SimpleImage(D: TPDFDocument; APage: integer);
     procedure   SimpleShapes(D: TPDFDocument; APage: integer);
+    procedure   AdvancedShapes(D: TPDFDocument; APage: integer);
     procedure   SampleMatrixTransform(D: TPDFDocument; APage: integer);
     procedure   SampleLandscape(D: TPDFDocument; APage: integer);
+    procedure   TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer; const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
   protected
     procedure   DoRun; override;
   public
@@ -54,6 +59,8 @@ type
 var
   Application: TPDFTestApp;
 
+const
+  cPageCount: integer = 8;
 
 function TPDFTestApp.SetUpDocument: TPDFDocument;
 var
@@ -66,11 +73,18 @@ begin
   Result := TPDFDocument.Create(Nil);
   Result.Infos.Title := Application.Title;
   Result.Infos.Author := 'Graeme Geldenhuys';
-  Result.Infos.Producer := 'fpGUI Toolkit 0.8';
+  Result.Infos.Producer := 'fpGUI Toolkit 1.4.1';
   Result.Infos.ApplicationName := ApplicationName;
   Result.Infos.CreationDate := Now;
 
-  lOpts := [];
+  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
@@ -83,8 +97,8 @@ begin
 
   Result.StartDocument;
   S := Result.Sections.AddSection; // we always need at least one section
-  lPageCount := 7;
-  if Fpg <> -1 then
+  lPageCount := cPageCount;
+  if FPage <> -1 then
     lPageCount := 1;
   for i := 1 to lPageCount do
   begin
@@ -124,35 +138,53 @@ 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];
 
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clRed);
-  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans', clGreen); // TODO: this color value means nothing - not used at all
-  FtText2 := D.AddFont('Times-BoldItalic', clBlack);
-  // FtText3 := D.AddFont('arial.ttf', 'Arial', clBlack);
-  FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
+  FtTitle := D.AddFont('Helvetica');
+  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans');
+  FtText2 := D.AddFont('Times-BoldItalic');
+  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
   P.SetFont(FtTitle, 12);
   P.SetColor(clBlue, false);
   P.WriteText(25, 50, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
+  P.SetColor(clBlack, false);
+  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);
 
   P.SetFont(ftText2,16);
-  P.SetColor($c00000, false);
-  P.WriteText(60, 100, '(60mm,100mm) Times-BoldItalic: Big text at absolute position');
+  P.SetColor($C00000, false);
+  P.WriteText(50, 100, '(50mm,100mm) Times-BoldItalic: Big text at absolute position');
+
 
   // -----------------------------------
   // TrueType testing purposes
-  P.SetFont(ftText3, 13);
+  P.SetFont(FtText1, 13);
   P.SetColor(clBlack, false);
 
   P.WriteText(15, 120, 'Languages: English: Hello, World!');
@@ -162,7 +194,6 @@ begin
   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?”');
@@ -171,6 +202,13 @@ begin
   P.WriteText(40, 230, 'OK then…    (êçèûÎÐð£¢ß)  \\//{}()#<>');
 
   P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
+
+  { draw a rectangle around the text }
+  TextInABox(P, 25, 255, 23, clRed, 'FreeSans', '“Text in a Box gyj?”');
+
+  { lets make a hyperlink more prominent }
+  TextInABox(P, 100, 255, 12, clMagenta, 'FreeSans', 'http://www.freepascal.org');
+  P.AddExternalLink(99, 255, 49, 5, 'http://www.freepascal.org', false);
 end;
 
 procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
@@ -181,7 +219,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -189,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);
@@ -224,7 +262,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clRed);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -232,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;
@@ -262,7 +300,7 @@ Var
 begin
   P := D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -279,13 +317,17 @@ begin
   P.DrawImageRawSize(25, 130, W, H, IDX);  // left-bottom coordinate of image
   P.WriteText(145, 90, '[Full size (defined in pixels)]');
 
-  { half size image }
+  { quarter size image }
   P.DrawImageRawSize(25, 190, W shr 1, H shr 1, IDX); // could also have used: Integer(W div 2), Integer(H div 2)
-  P.WriteText(90, 165, '[Quarter size (defined in pixels)]');
+  P.WriteText(85, 180, '[Quarter size (defined in pixels)]');
+  { rotated image }
+  P.DrawImageRawSize(150, 190, W shr 1, H shr 1, IDX, 30);
 
   { scalled image to 2x2 centimeters }
   P.DrawImage(25, 230, 20.0, 20.0, IDX); // left-bottom coordinate of image
   P.WriteText(50, 220, '[2x2 cm scaled image]');
+  { rotatedd image }
+  P.DrawImage(120, 230, 20.0, 20.0, IDX, 30);
 end;
 
 procedure TPDFTestApp.SimpleShapes(D: TPDFDocument; APage: integer);
@@ -293,10 +335,13 @@ var
   P: TPDFPage;
   FtTitle: integer;
   lPt1: TPDFCoord;
+  lPoints: array of TPDFCoord;
+  i: integer;
+  lLineWidth: TPDFFloat;
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -305,30 +350,64 @@ begin
 
   // ========== Rectangles ============
 
-  { PDF origin coordinate is Bottom-Left, and we want to use Image Coordinate of Top-Left }
+  { PDF origin coordinate is Bottom-Left. }
   lPt1.X := 30;
-  lPt1.Y := 60+20; // origin + height
-  P.SetColor(clRed, true);
-  P.SetColor($37b344, false); // some green color
+  lPt1.Y := 75;
+  P.SetColor($c00000, true);
+  P.SetColor(clLtGray, false);
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 3, true, true);
 
   lPt1.X := 20;
-  lPt1.Y := 50+20; // origin + height
+  lPt1.Y := 65;
   P.SetColor(clBlue, true);
-  P.SetColor($b737b3, false); // some purple color
+  P.SetColor($ffff80, false); // pastel yellow
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 1, true, true);
 
   P.SetPenStyle(ppsDashDot);
   P.SetColor(clBlue, true);
-  P.DrawRect(110, 70+20 {origin+height}, 40, 20, 1, false, true);
+  P.DrawRect(110, 75, 40, 20, 1, false, true);
+
+  P.SetPenStyle(ppsDash);
+  P.SetColor($37b344, true);  // some green color
+  P.DrawRect(100, 70, 40, 20, 2, false, true);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor($c00000, true);
+  P.DrawRect(90, 65, 40, 20, 4, false, true);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(170, 75, 30, 15, 1, false, true, 30);
+
+
+  // ========== Rounded Rectangle ===========
+  lPt1.X := 30;
+  lPt1.Y := 120;
+  P.SetColor($c00000, true);
+  P.SetColor(clLtGray, false);
+  P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 5, 2, true, true);
+
+  lPt1.X := 20;
+  lPt1.Y := 110;
+  P.SetColor(clBlue, true);
+  P.SetColor($ffff80, false); // pastel yellow
+  P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 2.4, 1, true, true);
+
+  P.SetPenStyle(ppsDashDot);
+  P.SetColor(clBlue, true);
+  P.DrawRoundedRect(110, 120, 40, 20, 1.5, 1, false, true);
 
   P.SetPenStyle(ppsDash);
   P.SetColor($37b344, true);  // some green color
-  P.DrawRect(100, 60+20 {origin+height}, 40, 20, 2, false, true);
+  P.DrawRoundedRect(100, 115, 40, 20, 3, 2, false, true);
 
   P.SetPenStyle(ppsSolid);
-  P.SetColor($b737b3, true);  // some purple color
-  P.DrawRect(90, 50+20 {origin+height}, 40, 20, 4, false, true);
+  P.SetColor($c00000, true);
+  P.DrawRoundedRect(90, 110, 40, 20, 5, 3, false, true);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRoundedRect(170, 120, 30, 15, 5, 1, false, true, 30);
 
 
   // ========== Ellipses ============
@@ -340,35 +419,40 @@ begin
   lPt1.X := 60;
   lPt1.Y := 150;
   P.SetColor(clBlue, true);
-  P.SetColor($b737b3, false); // some purple color
+  P.SetColor($ffff80, false); // pastel yellow
   P.DrawEllipse(lPt1, 10, 10, 1, True, True);
 
   P.SetPenStyle(ppsDashDot);
   P.SetColor($b737b3, True);
-  P.DrawEllipse(140, 150, 35, 20, 1, False, True);
+  P.DrawEllipse(73, 150, 10, 20, 1, False, True);
 
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, True);
+  P.DrawEllipse(170, 150, 30, 15, 1, False, True, 30);
 
   // ========== Lines Pen Styles ============
 
-  P.SetPenStyle(ppsSolid);
+  lLineWidth := 1;
+
+  P.SetPenStyle(ppsSolid, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 200, 70, 200, 1);
+  P.DrawLine(30, 170, 70, 170, lLineWidth);
 
-  P.SetPenStyle(ppsDash);
+  P.SetPenStyle(ppsDash, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 210, 70, 210, 1);
+  P.DrawLine(30, 175, 70, 175, lLineWidth);
 
-  P.SetPenStyle(ppsDot);
+  P.SetPenStyle(ppsDot, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 220, 70, 220, 1);
+  P.DrawLine(30, 180, 70, 180, lLineWidth);
 
-  P.SetPenStyle(ppsDashDot);
+  P.SetPenStyle(ppsDashDot, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 230, 70, 230, 1);
+  P.DrawLine(30, 185, 70, 185, lLineWidth);
 
-  P.SetPenStyle(ppsDashDotDot);
+  P.SetPenStyle(ppsDashDotDot, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 240, 70, 240, 1);
+  P.DrawLine(30, 190, 70, 190, lLineWidth);
 
 
   // ========== Line Attribute ============
@@ -376,21 +460,178 @@ begin
   P.SetPenStyle(ppsSolid);
   P.SetColor(clBlack, True);
   P.DrawLine(100, 170, 140, 170, 0.2);
-  P.DrawLine(100, 180, 140, 180, 0.3);
-  P.DrawLine(100, 190, 140, 190, 0.5);
-  P.DrawLine(100, 200, 140, 200, 1);
+  P.DrawLine(100, 175, 140, 175, 0.3);
+  P.DrawLine(100, 180, 140, 180, 0.5);
+  P.DrawLine(100, 185, 140, 185, 1);
 
   P.SetColor(clRed, True);
-  P.DrawLine(100, 210, 140, 210, 2);
+  P.DrawLine(100, 190, 140, 190, 2);
 
   P.SetColor($37b344, True);
-  P.DrawLine(100, 220, 140, 220, 3);
+  P.DrawLine(100, 195, 140, 195, 3);
 
   P.SetColor(clBlue, True);
-  P.DrawLine(100, 230, 140, 230, 4);
+  P.DrawLine(100, 200, 140, 200, 4);
 
   P.SetColor($b737b3, True);
-  P.DrawLine(100, 240, 140, 240, 5);
+  P.DrawLine(100, 205, 140, 205, 5);
+
+
+  // ========== PolyLines and Polygons ============
+  P.Matrix.SetYTranslation(70);
+  P.Matrix.SetXTranslation(20);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(0, 10, 50, -50, 1, false, true);
+
+  P.SetColor($c00000, true);
+  P.ResetPath;
+  SetLength(lPoints, 10);
+  for i := 0 to 9 do
+  begin
+    lPoints[i].X := Random(50);
+    lPoints[i].Y := Random(50) + 10.5;
+  end;
+  P.DrawPolyLine(lPoints, 1);
+  P.StrokePath;
+
+
+  P.Matrix.SetXTranslation(80);
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(0, 10, 50, -50, 1, false, true);
+
+  P.SetColor($ffff80, false); // pastel yellow
+  P.SetColor(clBlue, true);
+  P.ResetPath;
+  P.DrawPolygon(lPoints, 1);
+  P.FillStrokePath;
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle, 8);
+  P.SetColor(clBlack, false);
+  P.WriteText(0, 8, 'Fill using the nonzero winding number rule');
+
+
+  P.Matrix.SetXTranslation(140);
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(0, 10, 50, -50, 1, false, true);
+
+  P.SetColor($ffff80, false); // pastel yellow
+  P.SetColor(clBlue, true);
+  P.ResetPath;
+  P.DrawPolygon(lPoints, 1);
+  P.FillEvenOddStrokePath;
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle, 8);
+  P.SetColor(clBlack, false);
+  P.WriteText(0, 8, 'Fill using the even-odd rule');
+end;
+
+{ Each curve uses the exact same four coordinates, just with different CubicCurveToXXX
+  method calls. I also use the page Maxtix Y-Translation to adjust the coordinate
+  system before I draw each curve. I could also refactor each curves drawing
+  code into a single parametised procedure - simply to show that each of the
+  curves really do use the same code and coordinates. }
+procedure TPDFTestApp.AdvancedShapes(D: TPDFDocument; APage: integer);
+var
+  P: TPDFPage;
+  FtTitle: integer;
+  lPt1, lPt2, lPt3, lPt4: TPDFCoord;
+begin
+  P:=D.Pages[APage];
+  // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
+  FtTitle := D.AddFont('Helvetica');
+
+  { Page title }
+  P.SetFont(FtTitle,23);
+  P.SetColor(clBlack);
+  P.WriteText(25, 20, 'Advanced Drawing');
+
+  // ========== Cubic Bezier curve ===========
+
+  // PDF c operator curve ===========
+  lPt1 := PDFCoord(75, 70);
+  lPt2 := PDFCoord(78, 40);
+  lPt3 := PDFCoord(100, 35);
+  lPt4 := PDFCoord(140, 60);
+
+  p.SetColor(clBlack, true);
+  p.SetPenStyle(ppsSolid);
+  p.MoveTo(lPt1);
+  p.CubicCurveTo(lPt2, lPt3, lPt4, 1);
+  // for fun, lets draw the control points as well
+  P.SetColor(clLtGray, True);
+  P.SetColor(clLtGray, false);
+  P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
+  P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
+  P.SetPenStyle(ppsDot);
+  P.DrawLine(lPt1, lPt2, 1);
+  P.DrawLine(lPt3, lPt4, 1);
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle, 8);
+  P.SetColor(clBlack, false);
+  P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
+  p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
+  p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
+  p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
+
+  P.SetFont(FtTitle, 10);
+  P.WriteText(20, 50, 'CubicCurveTo(...)');
+
+
+  // PDF v operator curve ===========
+  P.Matrix.SetYTranslation(220);
+
+  p.SetColor(clBlack, true);
+  p.SetPenStyle(ppsSolid);
+  p.MoveTo(lPt1);
+  p.CubicCurveToV(lPt3, lPt4, 1);
+  // for fun, lets draw the control points as well
+  P.SetColor(clLtGray, True);
+  P.SetColor(clLtGray, false);
+  P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
+  P.SetPenStyle(ppsDot);
+  P.DrawLine(lPt3, lPt4, 1);
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle,8);
+  P.SetColor(clBlack, false);
+  P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
+  p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
+  p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
+
+  P.SetFont(FtTitle, 10);
+  P.WriteText(20, 50, 'CubicCurveToV(...)');
+
+
+  // PDF y operator curve ===========
+  P.Matrix.SetYTranslation(140);
+
+  p.SetColor(clBlack, true);
+  p.SetPenStyle(ppsSolid);
+  p.MoveTo(lPt1);
+  p.CubicCurveToY(lPt2, lPt4, 1);
+  // for fun, lets draw the control points as well
+  P.SetColor(clLtGray, True);
+  P.SetColor(clLtGray, false);
+  P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
+  P.SetPenStyle(ppsDot);
+  P.DrawLine(lPt1, lPt2, 1);
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle,8);
+  P.SetColor(clBlack, false);
+  P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
+  p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
+  p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
+
+  P.SetFont(FtTitle, 10);
+  P.WriteText(20, 50, 'CubicCurveToY(...)');
 end;
 
 procedure TPDFTestApp.SampleMatrixTransform(D: TPDFDocument; APage: integer);
@@ -412,7 +653,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -448,7 +689,7 @@ begin
   P.Orientation := ppoLandscape;
 
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -464,15 +705,59 @@ begin
   P.WriteText(145, 95, Format('%d x %d  (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
 end;
 
+procedure TPDFTestApp.TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer;
+    const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
+var
+  lFontIdx: integer;
+  lFC: TFPFontCacheItem;
+  lHeight: single;
+  lDescenderHeight: single;
+  lTextHeightInMM: single;
+  lWidth: single;
+  lTextWidthInMM: single;
+  lDescenderHeightInMM: single;
+  i: integer;
+begin
+  for i := 0 to APage.Document.Fonts.Count-1 do
+  begin
+    if APage.Document.Fonts[i].Name = AFontName then
+    begin
+      lFontIdx := i;
+      break;
+    end;
+  end;
+  APage.SetFont(lFontIdx, APointSize);
+  APage.SetColor(clBlack, false);
+  APage.WriteText(AX, AY, AText);
+
+  lFC := gTTFontCache.Find(AFontName, False, False);
+  if not Assigned(lFC) then
+    raise Exception.Create(AFontName + ' font not found');
+
+  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 mm as our PDFPage.UnitOfMeasure is set to mm. }
+  lTextWidthInMM := (lWidth * 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. }
+  APage.SetColor(ABoxColor, true);
+  APage.DrawRect(AX, AY+lDescenderHeightInMM, lTextWidthInMM,
+      lTextHeightInMM+lDescenderHeightInMM, 1, false, true);
+end;
+
 { TPDFTestApp }
 
 procedure TPDFTestApp.DoRun;
 
   Function BoolFlag(C : Char;ADefault : Boolean) : Boolean;
-
   Var
     V : Integer;
-
   begin
     Result:=ADefault;
     if HasOption(C, '') then
@@ -486,12 +771,11 @@ procedure TPDFTestApp.DoRun;
 
 var
   ErrorMsg: String;
-
 begin
   StopOnException:=True;
   inherited DoRun;
   // quick check parameters
-  ErrorMsg := CheckOptions('hp:f:t:i:j:', '');
+  ErrorMsg := CheckOptions('hp:f:t:i:j:ns', '');
   if ErrorMsg <> '' then
   begin
     WriteLn('ERROR:  ' + ErrorMsg);
@@ -508,48 +792,55 @@ begin
     Exit;
   end;
 
-  Fpg := -1;
+  FPage := -1;
   if HasOption('p', '') then
   begin
-    Fpg := StrToInt(GetOptionValue('p', ''));
-    if (Fpg < 1) or (Fpg > 7) then
+    FPage := StrToInt(GetOptionValue('p', ''));
+    if (FPage < 1) or (FPage > cPageCount) then
     begin
-      Writeln('Error in -p parameter. Valid range is 1-7.');
+      Writeln(Format('Error in -p parameter. Valid range is 1-%d.', [cPageCount]));
       Writeln('');
       Terminate;
       Exit;
     end;
   end;
 
+  FNoFontEmbedding := HasOption('n', '');
+  FSubsetFontEmbedding := HasOption('s', '');
   FFontCompression := BoolFlag('f',true);
   FTextCompression := BoolFlag('t',False);
   FImageCompression := BoolFlag('i',False);
   FRawJPEG:=BoolFlag('j',False);
 
+  gTTFontCache.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
+  gTTFontCache.BuildFontCache;
+
   FDoc := SetupDocument;
   try
     FDoc.FontDirectory := 'fonts';
 
-    if Fpg = -1 then
+    if FPage = -1 then
     begin
       SimpleText(FDoc, 0);
       SimpleShapes(FDoc, 1);
-      SimpleLines(FDoc, 2);
-      SimpleLinesRaw(FDoc, 3);
-      SimpleImage(FDoc, 4);
-      SampleMatrixTransform(FDoc, 5);
-      SampleLandscape(FDoc, 6);
+      AdvancedShapes(FDoc, 2);
+      SimpleLines(FDoc, 3);
+      SimpleLinesRaw(FDoc, 4);
+      SimpleImage(FDoc, 5);
+      SampleMatrixTransform(FDoc, 6);
+      SampleLandscape(FDoc, 7);
     end
     else
     begin
-      case Fpg of
+      case FPage of
         1:  SimpleText(FDoc, 0);
         2:  SimpleShapes(FDoc, 0);
-        3:  SimpleLines(FDoc, 0);
-        4:  SimpleLinesRaw(FDoc, 0);
-        5:  SimpleImage(FDoc, 0);
-        6:  SampleMatrixTransform(FDoc, 0);
-        7:  SampleLandscape(FDoc, 0);
+        3:  AdvancedShapes(FDoc, 0);
+        4:  SimpleLines(FDoc, 0);
+        5:  SimpleLinesRaw(FDoc, 0);
+        6:  SimpleImage(FDoc, 0);
+        7:  SampleMatrixTransform(FDoc, 0);
+        8:  SampleLandscape(FDoc, 0);
       end;
     end;
 
@@ -566,11 +857,15 @@ procedure TPDFTestApp.WriteHelp;
 begin
   writeln('Usage:');
   writeln('    -h          Show this help.');
-  writeln('    -p <n>      Generate only one page. Valid range is 1-7.' + LineEnding +
-          '                If this option is not specified, then all 7 pages are' + LineEnding +
-          '                generated.');
+  writeln(Format(
+          '    -p <n>      Generate only one page. Valid range is 1-%d.' + LineEnding +
+          '                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.');
+          '                disables compression. A value of 1 enables compression.' + LineEnding +
+          '                If -n is specified, this option is ignored.');
   writeln('    -t <0|1>    Toggle text compression. A value of 0' + LineEnding +
           '                disables compression. A value of 1 enables compression.');
   writeln('    -i <0|1>    Toggle image compression. A value of 0' + LineEnding +
@@ -581,8 +876,8 @@ begin
 end;
 
 
-
 begin
+  Randomize;
   Application := TPDFTestApp.Create(nil);
   Application.Title := 'fpPDF Test Application';
   Application.Run;

packages/fcl-pdf/fpmake.pp

@@ -28,17 +28,26 @@ 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.0.3';
     T:=P.Targets.AddUnit('src/fpttfencodings.pp');
     T:=P.Targets.AddUnit('src/fpparsettf.pp');
+    T:=P.Targets.AddUnit('src/fpfonttextmapping.pp');
     With T do
       Dependencies.AddUnit('fpttfencodings');
+    T:=P.Targets.AddUnit('src/fpttfsubsetter.pp');
+    With T do
+      begin
+      Dependencies.AddUnit('fpparsettf');
+      Dependencies.AddUnit('fpfonttextmapping');
+      end;
     T:=P.Targets.AddUnit('src/fpttf.pp');
     T:=P.Targets.AddUnit('src/fppdf.pp');
     With T do
       begin
       Dependencies.AddUnit('fpparsettf');
+      Dependencies.AddUnit('fpttfsubsetter');
       end;
     
     // md5.ref

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/fpfonttextmapping.pp

@@ -0,0 +1,239 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 by Graeme Geldenhuys
+
+    This unit defines classes that manage font glyph IDs and unicode
+    character codes.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit FPFontTextMapping;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  contnrs;
+
+type
+
+  TTextMapping = class(TObject)
+  private
+    FCharID: uint32;
+    FGlyphID: uint32;
+    FNewGlyphID: uint32;
+    FGlyphData: TStream;
+    FIsCompoundGlyph: boolean;
+  public
+    constructor Create;
+    class function NewTextMap(const ACharID, AGlyphID: uint32): TTextMapping;
+    property    CharID: uint32 read FCharID write FCharID;
+    property    GlyphID: uint32 read FGlyphID write FGlyphID;
+    property    NewGlyphID: uint32 read FNewGlyphID write FNewGlyphID;
+    property    GlyphData: TStream read FGlyphData write FGlyphData;
+    property    IsCompoundGlyph: boolean read FIsCompoundGlyph write FIsCompoundGlyph;
+  end;
+
+
+  TTextMappingList = class(TObject)
+  private
+    FList: TFPObjectList;
+    function    GetCount: Integer;
+  protected
+    function    GetItem(AIndex: Integer): TTextMapping; virtual;
+    procedure   SetItem(AIndex: Integer; AValue: TTextMapping); virtual;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    function    Add(AObject: TTextMapping): Integer; overload;
+    function    Add(const ACharID, AGlyphID: uint32): Integer; overload;
+    function    Contains(const AGlyphID: uint32): boolean;
+    function    ContainsCharID(const AID: uint32): boolean;
+    function    GetNewGlyphID(const ACharID: uint32): uint32;
+    function    GetMaxCharID: uint32;
+    function    GetMaxGlyphID: uint32;
+    procedure   Insert(const AIndex: integer; const ACharID, AGlyphID: uint32);
+    procedure   Sort;
+    property    Count: Integer read GetCount;
+    property    Items[AIndex: Integer]: TTextMapping read GetItem write SetItem; default;
+  end;
+
+
+implementation
+
+{ TTextMapping }
+
+constructor TTextMapping.Create;
+begin
+  FGlyphData := nil;
+  FCharID := 0;
+  FGlyphID := 0;
+  FNewGlyphID := 0;
+  FIsCompoundGlyph := False;
+end;
+
+class function TTextMapping.NewTextMap(const ACharID, AGlyphID: uint32): TTextMapping;
+begin
+  Result := TTextMapping.Create;
+  Result.CharID := ACharID;
+  Result.GlyphID := AGlyphID;
+end;
+
+{ TTextMappingList }
+
+function TTextMappingList.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TTextMappingList.GetItem(AIndex: Integer): TTextMapping;
+begin
+  Result := TTextMapping(FList.Items[AIndex]);
+end;
+
+procedure TTextMappingList.SetItem(AIndex: Integer; AValue: TTextMapping);
+begin
+  FList.Items[AIndex] := AValue;
+end;
+
+constructor TTextMappingList.Create;
+begin
+  FList := TFPObjectList.Create(True);
+end;
+
+destructor TTextMappingList.Destroy;
+begin
+  FList.Free;
+  inherited Destroy;
+end;
+
+function TTextMappingList.Add(AObject: TTextMapping): Integer;
+var
+  i: integer;
+begin
+  Result := -1;
+  for i := 0 to FList.Count-1 do
+  begin
+    if TTextMapping(FList.Items[i]).CharID = AObject.CharID then
+      Exit; // mapping already exists
+  end;
+  Result := FList.Add(AObject);
+end;
+
+function TTextMappingList.Add(const ACharID, AGlyphID: uint32): Integer;
+var
+  o: TTextMapping;
+begin
+  o := TTextMapping.Create;
+  o.CharID := ACharID;
+  o.GlyphID := AGlyphID;
+  Result := Add(o);
+  if Result = -1 then
+    o.Free;
+end;
+
+function TTextMappingList.Contains(const AGlyphID: uint32): boolean;
+var
+  i: integer;
+begin
+  Result := False;
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].GlyphID = AGlyphID then
+    begin
+      Result := True;
+      Exit;
+    end;
+  end;
+end;
+
+function TTextMappingList.ContainsCharID(const AID: uint32): boolean;
+var
+  i: integer;
+begin
+  Result := False;
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].CharID = AID then
+    begin
+      Result := True;
+      Exit;
+    end;
+  end;
+end;
+
+function TTextMappingList.GetNewGlyphID(const ACharID: uint32): uint32;
+var
+  i: integer;
+begin
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].CharID = ACharID then
+    begin
+      Result := Items[i].NewGlyphID;
+      Exit;
+    end;
+  end;
+end;
+
+function TTextMappingList.GetMaxCharID: uint32;
+begin
+  Sort;
+  Result := Items[Count-1].CharID;
+end;
+
+function TTextMappingList.GetMaxGlyphID: uint32;
+var
+  gid: uint32;
+  i: integer;
+begin
+  gid := 0;
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].GlyphID > gid then
+      gid := Items[i].GlyphID;
+  end;
+  result := gid;
+end;
+
+procedure TTextMappingList.Insert(const AIndex: integer; const ACharID, AGlyphID: uint32);
+var
+  o: TTextMapping;
+begin
+  o := TTextMapping.Create;
+  o.CharID := ACharID;
+  o.GlyphID := AGlyphID;
+  FList.Insert(AIndex, o);
+end;
+
+function CompareByCharID(A, B: TTextMapping): Integer; inline;
+begin
+  if A.CharID < B.CharID then
+    Result := -1
+  else if A.CharID > B.CharID then
+    Result := 1
+  else
+    Result := 0;
+end;
+
+function CompareByCharIDPtr(A, B: Pointer): Integer;
+begin
+  Result := CompareByCharID(TTextMapping(A), TTextMapping(B));
+end;
+
+procedure TTextMappingList.Sort;
+begin
+  FList.Sort(@CompareByCharIDPtr);
+end;
+
+end.

packages/fcl-pdf/src/fpparsettf.pp

@@ -23,190 +23,201 @@ 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);
+  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;
 
   TFixedVersionRec = packed record
     case Integer of
-      0:  (Minor, Major: Word);
-      1:  (Version: Cardinal);
+      0:  (Minor, Major: UInt16);
+      1:  (Version: UInt32);
   end;
 
+  { The file header record that starts at byte 0 of a TTF file }
   TTableDirectory = Packed Record
-    FontVersion : TFixedVersionRec;
-    Numtables : Word;
-    SearchRange : Word;
-    EntrySelector : Word;
-    RangeShift : Word;
+    FontVersion : TFixedVersionRec; { UInt32}
+    Numtables : UInt16;
+    SearchRange : UInt16;
+    EntrySelector : UInt16;
+    RangeShift : UInt16;
   end;
 
   TTableDirectoryEntry = Packed Record
-    Tag: Array[1..4] of char;
-    checkSum : Cardinal;
-    offset : Cardinal;
-    Length : Cardinal;
+    Tag: Array[1..4] of AnsiChar;
+    checkSum : UInt32;
+    offset : UInt32;
+    Length : UInt32;
   end;
   TTableDirectoryEntries = Array of TTableDirectoryEntry;
 
   TLongHorMetric = Packed record
-    AdvanceWidth : Word;
-    LSB: Smallint;              { leftSideBearing }
+    AdvanceWidth : UInt16;
+    LSB: Int16;              { leftSideBearing }
   end;
-  TLongHorMetrics = Packed Array of TLongHorMetric;
+  TLongHorMetricArray = Packed Array of TLongHorMetric;
 
 Type
   TPostScript = Packed Record
-    Format : TFixedVersionRec;
-    ItalicAngle : LongWord;
-    UnderlinePosition : SmallInt;
-    underlineThickness : SmallInt;
-    isFixedPitch : Cardinal;
-    minMemType42 : Cardinal;
-    maxMemType42 : Cardinal;
-    minMemType1 : Cardinal;
-    maxMemType1 : Cardinal;
+    Format : TFixedVersionRec;  { UInt32 }
+    ItalicAngle : TF16Dot16;  { Int32 }
+    UnderlinePosition : Int16;
+    underlineThickness : Int16;
+    isFixedPitch : UInt32;
+    minMemType42 : UInt32;
+    maxMemType42 : UInt32;
+    minMemType1 : UInt32;
+    maxMemType1 : UInt32;
   end;
 
   TMaxP = Packed Record
-    VersionNumber : TFixedVersionRec;
-    numGlyphs : Word;
-    maxPoints : Word;
-    maxContours : Word;
-    maxCompositePoints : word;
-    maxCompositeContours : word;
-    maxZones : Word;
-    maxTwilightPoints : word;
-    maxStorage : Word;
-    maxFunctionDefs : Word;
-    maxInstructionDefs : Word;
-    maxStackElements : Word;
-    maxSizeOfInstructions : word;
-    maxComponentElements : Word;
-    maxComponentDepth : Word;
+    VersionNumber : TFixedVersionRec;  { UInt32 }
+    numGlyphs : UInt16;
+    maxPoints : UInt16;
+    maxContours : UInt16;
+    maxCompositePoints : UInt16;
+    maxCompositeContours : UInt16;
+    maxZones : UInt16;
+    maxTwilightPoints : UInt16;
+    maxStorage : UInt16;
+    maxFunctionDefs : UInt16;
+    maxInstructionDefs : UInt16;
+    maxStackElements : UInt16;
+    maxSizeOfInstructions : UInt16;
+    maxComponentElements : UInt16;
+    maxComponentDepth : UInt16;
   end;
 
   TOS2Data = Packed Record
-    version : Word;
-    xAvgCharWidth : SmallInt;
-    usWeightClass : Word;
-    usWidthClass : Word;
-    fsType : SmallInt;
-    ySubscriptXSize : SmallInt;
-    ySubscriptYSize : SmallInt;
-    ySubscriptXOffset : SmallInt;
-    ySubscriptYOffset : Smallint;
-    ySuperscriptXSize : Smallint;
-    ySuperscriptYSize : Smallint;
-    ySuperscriptXOffset : Smallint;
-    ySuperscriptYOffset : Smallint;
-    yStrikeoutSize : SmallInt;
-    yStrikeoutPosition : Smallint;
-    sFamilyClass : SmallInt;    // we could split this into a record of Class & SubClass values.
+    version : UInt16;
+    xAvgCharWidth : Int16;
+    usWeightClass : UInt16;
+    usWidthClass : UInt16;
+    fsType : Int16;
+    ySubscriptXSize : Int16;
+    ySubscriptYSize : Int16;
+    ySubscriptXOffset : Int16;
+    ySubscriptYOffset : Int16;
+    ySuperscriptXSize : Int16;
+    ySuperscriptYSize : Int16;
+    ySuperscriptXOffset : Int16;
+    ySuperscriptYOffset : Int16;
+    yStrikeoutSize : Int16;
+    yStrikeoutPosition : Int16;
+    sFamilyClass : Int16;    // we could split this into a record of Class & SubClass values.
     panose : Array[0..9] of byte;
-    ulUnicodeRange1 : Cardinal;
-    ulUnicodeRange2 : Cardinal;
-    ulUnicodeRange3 : Cardinal;
-    ulUnicodeRange4 : Cardinal;
-    achVendID : Array[0..3] of char;
-    fsSelection : word;
-    usFirstCharIndex : Word;
-    usLastCharIndex : Word;
-    sTypoAscender: Smallint;
-    sTypoDescender : Smallint;
-    sTypoLineGap : Smallint;
-    usWinAscent : Word;
-    usWinDescent : Word;
-    ulCodePageRange1 : Cardinal;
-    ulCodePageRange2 : Cardinal;
-    sxHeight : smallint;
-    sCapHeight : smallint;
-    usDefaultChar : word;
-    usBreakChar : word;
-    usMaxContext  : word;
+    ulUnicodeRange1 : UInt32;
+    ulUnicodeRange2 : UInt32;
+    ulUnicodeRange3 : UInt32;
+    ulUnicodeRange4 : UInt32;
+    achVendID : Array[0..3] of AnsiChar;
+    fsSelection : UInt16;
+    usFirstCharIndex : UInt16;
+    usLastCharIndex : UInt16;
+    sTypoAscender: Int16;
+    sTypoDescender : Int16;
+    sTypoLineGap : Int16;
+    usWinAscent : UInt16;
+    usWinDescent : UInt16;
+    ulCodePageRange1 : UInt32;
+    ulCodePageRange2 : UInt32;
+    sxHeight : Int16;
+    sCapHeight : Int16;
+    usDefaultChar : UInt16;
+    usBreakChar : UInt16;
+    usMaxContext  : UInt16;
   end;
 
   { Nicely described at [https://www.microsoft.com/typography/otspec/head.htm] }
   THead = Packed record
-    FileVersion : TFixedVersionRec;
-    FontRevision : TFixedVersionRec;
-    CheckSumAdjustment : Cardinal;
-    MagicNumber : Cardinal;
-    Flags : Word;
-    UnitsPerEm: word;
+    FileVersion : TFixedVersionRec;  { UInt32 }
+    FontRevision : TFixedVersionRec;  { UInt32 }
+    CheckSumAdjustment : UInt32;
+    MagicNumber : UInt32;
+    Flags : UInt16;
+    UnitsPerEm: UInt16;
     Created : Int64;
     Modified : Int64;
-    BBox: Packed array[0..3] of Smallint;
-    MacStyle : word;
-    LowestRecPPEM : word;
-    FontDirectionHint : smallint;
-    IndexToLocFormat : Smallint;
-    glyphDataFormat : Smallint;
+    BBox: Packed array[0..3] of Int16;
+    MacStyle : UInt16;
+    LowestRecPPEM : UInt16;
+    FontDirectionHint : Int16;
+    IndexToLocFormat : Int16;
+    glyphDataFormat : Int16;
   end;
 
   { structure described at [https://www.microsoft.com/typography/otspec/hhea.htm] }
   THHead = packed record
-    TableVersion : TFixedVersionRec;
-    Ascender : Smallint;
-    Descender : Smallint;
-    LineGap : Smallint;
-    AdvanceWidthMax : Word;
-    MinLeftSideBearing : Smallint;
-    MinRightSideBearing : Smallint;
-    XMaxExtent : Smallint;
-    CaretSlopeRise : Smallint;
-    CaretSlopeRun : Smallint;
-    Reserved : Array[0..4] of Smallint;
-    metricDataFormat : Smallint;
-    numberOfHMetrics : Word;
+    TableVersion : TFixedVersionRec;  { UInt32 }
+    Ascender : Int16;
+    Descender : Int16;
+    LineGap : Int16;
+    AdvanceWidthMax : UInt16;
+    MinLeftSideBearing : Int16;
+    MinRightSideBearing : Int16;
+    XMaxExtent : Int16;
+    CaretSlopeRise : Int16;
+    CaretSlopeRun : Int16;
+    caretOffset: Int16; // reserved field
+    Reserved : Array[0..3] of Int16;
+    metricDataFormat : Int16;
+    numberOfHMetrics : UInt16;
   end;
 
   { Character to glyph mapping
     Structure described at [https://www.microsoft.com/typography/otspec/cmap.htm] }
   TCmapHeader = packed record
-    Version: word;
-    SubTableCount: word;
+    Version: UInt16;
+    SubTableCount: UInt16;
   end;
 
   TCmapSubTableEntry = packed record
-    PlatformID: word;
-    EncodingID: word;
-    Offset: Cardinal;
+    PlatformID: UInt16;
+    EncodingID: UInt16;
+    Offset: UInt32;
   end;
   TCmapSubTables = Array of TCmapSubTableEntry;
 
   TCmapFmt4 = packed record
-    Format: word;
-    Length: word;
-    LanguageID: word;
-    SegmentCount2: word;
-    SearchRange: word;
-    EntrySelector: word;
-    RangeShift: word;
+    Format: UInt16;
+    Length: UInt16;
+    LanguageID: UInt16;
+    SegmentCount2: UInt16;
+    SearchRange: UInt16;
+    EntrySelector: UInt16;
+    RangeShift: UInt16;
   end;
 
   TUnicodeMapSegment = Packed Record
-    StartCode : Word;
-    EndCode : Word;
-    IDDelta : Smallint;
-    IDRangeOffset : Word;
+    StartCode : UInt16;
+    EndCode : UInt16;
+    IDDelta : Int16;
+    IDRangeOffset : UInt16;
   end;
   TUnicodeMapSegmentArray = Array of TUnicodeMapSegment;
 
   TNameRecord = Packed Record
-    PlatformID : Word;
-    EncodingID : Word;
-    LanguageID : Word;
-    NameID : Word;
-    StringLength : Word;
-    StringOffset : Word;
+    PlatformID : UInt16;
+    EncodingID : UInt16;
+    LanguageID : UInt16;
+    NameID : UInt16;
+    StringLength : UInt16;
+    StringOffset : UInt16;
   end;
 
   TNameEntry = Packed Record
@@ -216,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;
@@ -230,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;
@@ -240,10 +264,9 @@ Type
     function GetMissingWidth: integer;
   Protected
     // Stream reading functions.
-    Function IsNativeData : Boolean; virtual;
-    function ReadShort(AStream: TStream): Smallint; inline;
-    function ReadULong(AStream: TStream): Longword; inline;
-    function ReadUShort(AStream: TStream): Word; inline;
+    function ReadInt16(AStream: TStream): Int16; inline;
+    function ReadUInt32(AStream: TStream): UInt32; inline;
+    function ReadUInt16(AStream: TStream): UInt16; inline;
     // Parse the various well-known tables
     procedure ParseHead(AStream : TStream); virtual;
     procedure ParseHhea(AStream : TStream); virtual;
@@ -269,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;
@@ -288,7 +312,7 @@ Type
     Function CapHeight: SmallInt;
     { Returns the glyph advance width, based on the AIndex (glyph index) value. The result is in font units. }
     function GetAdvanceWidth(AIndex: word): word;
-    function ItalicAngle: LongWord;
+    function ItalicAngle: single;
     { max glyph bounding box values - as space separated values }
     function BBox: string;
     property MissingWidth: Integer read GetMissingWidth;
@@ -304,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;
@@ -328,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
@@ -356,6 +381,7 @@ implementation
 
 resourcestring
   rsFontEmbeddingNotAllowed = 'Font licence does not allow embedding';
+  rsErrUnexpectedUnicodeSubtable = 'Unexpected unicode subtable format, expected 4, got %s';
 
 Function GetTableType(Const AName : String) : TTTFTableType;
 begin
@@ -385,25 +411,23 @@ begin
   FillChar(Dest^, Size, Data);
 end;
 
-function TTFFileInfo.ReadULong(AStream: TStream): Longword;inline;
+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.ReadUShort(AStream: TStream): Word;inline;
+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.ReadShort(AStream: TStream): Smallint;inline;
+function TTFFileInfo.ReadInt16(AStream: TStream): Int16;
 begin
-  Result:=SmallInt(ReadUShort(AStream));
+  Result:=Int16(ReadUInt16(AStream));
 end;
 
 procedure TTFFileInfo.ParseHead(AStream : TStream);
@@ -411,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);
@@ -433,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);
@@ -477,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;
 
 
@@ -506,55 +519,57 @@ var
   Segm : TUnicodeMapSegment;
   GlyphIDArray : Array of word;
   S : TStream;
-
 begin
   TableStartPos:=AStream.Position;
-  FCMapH.Version:=ReadUShort(AStream);
-  FCMapH.SubtableCount:=ReadUShort(AStream);
+  FCMapH.Version:=ReadUInt16(AStream);
+  FCMapH.SubtableCount:=ReadUInt16(AStream);
   SetLength(FSubtables,CMapH.SubtableCount);
   for I:= 0 to FCMapH.SubtableCount-1 do
     begin
-    FSubtables[i].PlatformID:=ReadUShort(AStream);
-    FSubtables[i].EncodingID:=ReadUShort(AStream);
-    FSubtables[i].Offset:=ReadULong(AStream); // 4 bytes - Offset of subtable
+    FSubtables[i].PlatformID:=ReadUInt16(AStream);
+    FSubtables[i].EncodingID:=ReadUInt16(AStream);
+    FSubtables[i].Offset:=ReadUInt32(AStream); // 4 bytes - Offset of subtable
     end;
   UE:=FCMapH.SubtableCount-1;
+  if UE=0 then
+    // No CMap subtable entries, this is not an error, just exit.
+    exit;
   While (UE>=0) and ((FSubtables[UE].PlatformID<>3) or (FSubtables[UE].EncodingID<> 1)) do
     Dec(UE);
   if (UE=-1) then
-    Raise ETTF.Create('No Format 4 map (unicode) table found <'+FFileName + ' - ' + PostScriptName+'>');
+    exit;
   TT:=TableStartPos+FSubtables[UE].Offset;
   AStream.Position:=TT;
-  FUnicodeMap.Format:= ReadUShort(AStream);               // 2 bytes - Format of subtable
+  FUnicodeMap.Format:= ReadUInt16(AStream);               // 2 bytes - Format of subtable
   if (FUnicodeMap.Format<>4) then
-    Raise ETTF.CreateFmt('Unexpected unicode subtable format, expected 4, got %s',[FUnicodeMap.Format]);
-  FUnicodeMap.Length:=ReadUShort(AStream);
+    Raise ETTF.CreateFmt(rsErrUnexpectedUnicodeSubtable, [FUnicodeMap.Format]);
+  FUnicodeMap.Length:=ReadUInt16(AStream);
   S:=TMemoryStream.Create;
   try
     // Speed up the process, read everything in a single mem block.
     S.CopyFrom(AStream,Int64(FUnicodeMap.Length)-4);
     S.Position:=0;
-    FUnicodeMap.LanguageID:=ReadUShort(S);
-    FUnicodeMap.SegmentCount2:=ReadUShort(S);            // 2 bytes - Segments count
-    FUnicodeMap.SearchRange:=ReadUShort(S);
-    FUnicodeMap.EntrySelector:=ReadUShort(S);
-    FUnicodeMap.RangeShift:=ReadUShort(S);
+    FUnicodeMap.LanguageID:=ReadUInt16(S);
+    FUnicodeMap.SegmentCount2:=ReadUInt16(S);            // 2 bytes - Segments count
+    FUnicodeMap.SearchRange:=ReadUInt16(S);
+    FUnicodeMap.EntrySelector:=ReadUInt16(S);
+    FUnicodeMap.RangeShift:=ReadUInt16(S);
     SegCount:=FUnicodeMap.SegmentCount2 div 2;
     SetLength(FUnicodeMapSegments,SegCount);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].EndCode:=ReadUShort(S);
-    ReadUShort(S);
+      FUnicodeMapSegments[i].EndCode:=ReadUInt16(S);
+    ReadUInt16(S);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].StartCode:=ReadUShort(S);
+      FUnicodeMapSegments[i].StartCode:=ReadUInt16(S);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].IDDelta:=ReadShort(S);
+      FUnicodeMapSegments[i].IDDelta:=ReadInt16(S);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].IDRangeOffset:=ReadUShort(S);
+      FUnicodeMapSegments[i].IDRangeOffset:=ReadUInt16(S);
     UE:=S.Position;
     UE:=(S.Size-UE) div 2;
     SetLength(GlyphIDArray,UE);
     For J:=0 to UE-1 do
-      GlyphIDArray[J]:=ReadUShort(S);
+      GlyphIDArray[J]:=ReadUInt16(S);
     J:=0;
     for i:=0 to SegCount-1 do
       With FUnicodeMapSegments[i] do
@@ -601,9 +616,9 @@ var
 
 begin
   TableStartPos:= AStream.Position;                   // memorize Table start position
-  ReadUShort(AStream);                  // skip 2 bytes - Format
-  Count:=ReadUShort(AStream);                        // 2 bytes
-  StringOffset:=ReadUShort(AStream);                 // 2 bytes
+  ReadUInt16(AStream);                  // skip 2 bytes - Format
+  Count:=ReadUInt16(AStream);                        // 2 bytes
+  StringOffset:=ReadUInt16(AStream);                 // 2 bytes
   E := FNameEntries;
   SetLength(E,Count);
   FillMem(@N, SizeOf(TNameRecord), 0);
@@ -663,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
-      ulCodePageRange1:=ReadULong(AStream);
-      ulCodePageRange2:=ReadULong(AStream);
-      end;
+    begin
+      ulCodePageRange1:=ReadUInt32(AStream);
+      ulCodePageRange2:=ReadUInt32(AStream);
+    end;
     if Version>=2 then
-      begin
-      sxHeight:=ReadShort(AStream);
-      sCapHeight:=ReadShort(AStream);
-      usDefaultChar:=ReadUShort(AStream);
-      usBreakChar:=ReadUShort(AStream);
-      usMaxContext:=ReadUShort(AStream);
-      end;
+    begin
+      sxHeight:=ReadInt16(AStream);
+      sCapHeight:=ReadInt16(AStream);
+      usDefaultChar:=ReadUInt16(AStream);
+      usBreakChar:=ReadUInt16(AStream);
+      usMaxContext:=ReadUInt16(AStream);
     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
@@ -756,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);
@@ -792,8 +802,8 @@ begin
         ttos2 : ParseOS2(AStream);
         ttPost: ParsePost(AStream);
       end;
-      end;
     end;
+  end;
 end;
 
 procedure TTFFileInfo.PrepareFontDefinition(const Encoding: string; Embed: Boolean);
@@ -806,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);
@@ -835,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;
@@ -893,14 +903,31 @@ 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;
 end;
 
-function TTFFileInfo.ItalicAngle: LongWord;
+function TTFFileInfo.ItalicAngle: single;
 begin
-  Result := FPostScript.ItalicAngle;
+  Result := FPostScript.ItalicAngle / 65536.0;
 end;
 
 function TTFFileInfo.BBox: string;
@@ -936,16 +963,11 @@ function TTFFileInfo.GetMissingWidth: integer;
 begin
   if FMissingWidth = 0 then
   begin
-    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // Char(32) - Space character
+    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // 32 is in reference to the Space character
   end;
   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

@@ -1,11 +1,22 @@
 {
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 by Graeme Geldenhuys
+
     Description:
       This is a homegrown font cache. The fpReport reports can reference
       a font by its name. The job of the font cache is to look through
       its cached fonts to match the font name, and which *.ttf file it
       relates too. The reporting code can then extract font details
       correctly (eg: font width, height etc).
-}
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 unit fpTTF;
 
 {$mode objfpc}{$H+}
@@ -38,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;
@@ -52,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. }
@@ -67,6 +83,7 @@ type
 
   TFPFontCacheList = class(TObject)
   private
+    FBuildFontCacheIgnoresErrors: Boolean;
     FList: TObjectList;
     FSearchPath: TStringList;
     FDPI: integer;
@@ -85,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;
@@ -95,6 +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    BuildFontCacheIgnoresErrors : Boolean Read FBuildFontCacheIgnoresErrors Write FBuildFontCacheIgnoresErrors;
   end;
 
 
@@ -102,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;
@@ -121,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;
@@ -192,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;
@@ -240,6 +301,7 @@ var
   s: string;
   {$ENDIF}
 begin
+  DoLoadFileInfo;
   Result := 0;
   if Length(AStr) = 0 then
     Exit;
@@ -281,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);
@@ -294,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
@@ -309,13 +372,18 @@ begin
         if (lowercase(ExtractFileExt(s)) = '.ttf') or
            (lowercase(ExtractFileExt(s)) = '.otf') then
         begin
-          lFont := TFPFontCacheItem.Create(AFontPath + s);
-          Add(lFont);
+          try
+            lFont := TFPFontCacheItem.Create(AFontPath + s);
+            Add(lFont);
+          except
+            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);
@@ -401,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/src/fpttfsubsetter.pp

@@ -0,0 +1,1259 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 by Graeme Geldenhuys
+
+    This unit creates a new TTF subset font file, reducing the file
+    size in the process. This is primarily so the new font file can
+    be embedded in PDF documents.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpTTFSubsetter;
+
+{$mode objfpc}{$H+}
+
+{ $R+}
+
+// enable this define for more verbose output
+{.$define gdebug}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  contnrs,
+  fpparsettf,
+  FPFontTextMapping;
+
+type
+  ETTFSubsetter = class(Exception);
+
+  TArrayUInt32 = array of UInt32;
+
+  // forward declaration
+  TGIDList = class;
+  TGIDListEnumerator = class;
+
+
+  TFontSubsetter = class(TObject)
+  private
+    FPrefix: string;
+    FHasAddedCompoundReferences: boolean;  // one glyph made up of multiple glyphs
+    FKeepTables: TStrings;
+    FFontInfo: TTFFileInfo;
+    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;
+    function    ToUInt32(const ABytes: AnsiString): UInt32;
+    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. }
+    function    GetRawGlyphData(const AGlyphID: UInt16): TMemoryStream;
+    procedure   LoadLocations;
+    // Stream writing functions.
+    procedure   WriteInt16(AStream: TStream; const AValue: Int16); 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;
+
+    procedure   AddCompoundReferences;
+    function    buildHeadTable: TStream;
+    function    buildHheaTable: TStream;
+    function    buildMaxpTable: TStream;
+    function    buildFpgmTable: TStream;
+    function    buildPrepTable: TStream;
+    function    buildCvtTable: TStream;
+    function    buildGlyfTable(var newOffsets: TArrayUInt32): TStream;
+    function    buildLocaTable(var newOffsets: TArrayUInt32): TStream;
+    function    buildCmapTable: TStream;
+    function    buildHmtxTable: TStream;
+  public
+    constructor Create(const AFont: TTFFileInfo; const AGlyphIDList: TTextMappingList);
+    constructor Create(const AFont: TTFFileInfo);
+    destructor  Destroy; override;
+    procedure   SaveToFile(const AFileName: String);
+    procedure   SaveToStream(const AStream: TStream);
+    // Add the given Unicode codepoint to the subset.
+    procedure   Add(const ACodePoint: uint32);
+    // The prefix to add to the font's PostScript name.
+    property    Prefix: string read FPrefix write FPrefix;
+  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
+
+uses
+  math;
+
+resourcestring
+  rsErrFontInfoNotAssigned = 'FontInfo was not assigned';
+  rsErrFailedToReadFromStream = 'Failed to read from file stream';
+  rsErrCantFindFontFile = 'Can''t find the actual TTF font file.';
+  rsErrGlyphLocationsNotLoaded = 'Glyph Location data has not been loaded yet.';
+
+const
+  PAD_BUF: array[ 1..3 ] of Byte = ( $0, $0, $0 );
+
+
+{ TFontSubsetter }
+
+{ The method simply returns the int value with a single one-bit, in the position
+  of the highest-order one-bit in the specified value, or zero if the specified
+  value is itself equal to zero. }
+function TFontSubsetter.Int32HighestOneBit(const AValue: integer): integer;
+var
+  i: integer;
+begin
+  i := AValue;
+  i := i or (i shr 1);
+  i := i or (i shr 2);
+  i := i or (i shr 4);
+  i := i or (i shr 8);
+  i := i or (i shr 16);
+//  i := i or (i shr 32);
+  Result := i - (i shr 1);
+end;
+
+function TFontSubsetter.Int32Log2(const AValue: integer): integer;
+begin
+  if AValue <= 0 then
+    raise Exception.Create('Illegal argument');
+//  Result :=  31 - Integer.numberOfLeadingZeros(n);
+
+  Result := Floor(Log10(AValue) / Log10(2));
+end;
+
+function TFontSubsetter.ToUInt32(const AHigh, ALow: UInt32): UInt32;
+begin
+  result := ((AHigh and $FFFF) shl 16) or (ALow and $FFFF);
+end;
+
+function TFontSubsetter.ToUInt32(const ABytes: AnsiString): UInt32;
+var
+  b: array of Byte absolute ABytes;
+begin
+  Result := (b[0] and $FF) shl 24
+           or (b[1] and $FF) shl 16
+           or (b[2] and $FF) shl 8
+           or (b[3] and $FF);
+end;
+
+function TFontSubsetter.GetRawTable(const ATableName: AnsiString): TMemoryStream;
+var
+  lEntry: TTableDirectoryEntry;
+begin
+  Result := nil;
+  FillMem(@lEntry, SizeOf(TTableDirectoryEntry), 0);
+  if not FFontInfo.GetTableDirEntry(ATableName, lEntry) then
+    Exit;
+
+  Result := TMemoryStream.Create;
+  FStream.Seek(lEntry.offset, soFromBeginning);
+  if Result.CopyFrom(FStream, lEntry.Length) <> lEntry.Length then
+    raise ETTF.Create('GetRawTable: ' + rsErrFailedToReadFromStream);
+end;
+
+{ AOutStream: the data output stream.
+  nTables: the number of font tables.
+  result: the file offset of the first TTF table to write. }
+function TFontSubsetter.WriteFileHeader(AOutStream: TStream; const nTables: integer): uint32;
+var
+  mask: integer;
+  searchRange: integer;
+  entrySelector: integer;
+  rangeShift: integer;
+begin
+  WriteUInt32(AOutStream, $00010000);
+  WriteUInt16(AOutStream, nTables);
+
+  mask := Int32HighestOneBit(nTables);
+  searchRange := mask * 16;
+  WriteUInt16(AOutStream, searchRange);
+
+  entrySelector := Int32Log2(mask);
+  WriteUInt16(AOutStream, entrySelector);
+
+  rangeShift := 16 * nTables - searchRange;
+  WriteUInt16(AOutStream, rangeShift);
+
+  result := $00010000 + ToUInt32(nTables, searchRange) + ToUInt32(entrySelector, rangeShift);
+end;
+
+function TFontSubsetter.WriteTableHeader(AOutStream: TStream; const ATag: AnsiString; const AOffset: UInt32;
+  const AData: TStream): int64;
+var
+  checksum: Int64;
+  n: integer;
+  lByte: Byte;
+begin
+  AData.Position := 0;
+  checksum := 0;
+
+  for n := 0 to AData.Size-1 do
+  begin
+    lByte := AData.ReadByte;
+    checksum := checksum + (((lByte and $FF) shl 24) - n mod 4 * 8);
+  end;
+  checksum := checksum and $FFFFFFFF;
+
+  AOutStream.WriteBuffer(Pointer(ATag)^, 4); // Tag is always 4 bytes - written as-is, no NtoBE() required
+  WriteUInt32(AOutStream, checksum);
+  WriteUInt32(AOutStream, AOffset);
+  WriteUInt32(AOutStream, AData.Size);
+
+  {$ifdef gdebug}
+  writeln(Format('tag: "%s"  CRC: %8.8x  offset: %8.8x (%2:7d bytes)  size: %8.8x (%3:7d bytes)', [ATag, checksum, AOffset, AData.Size]));
+  {$endif}
+
+  // account for the checksum twice, once for the header field, once for the content itself
+  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;
+  n: uint64;
+  lData: TStream;
+begin
+  for i := 0 to ATables.Count-1 do
+  begin
+    lData := TStream(ATables.Objects[i]);
+    if lData <> nil then
+    begin
+      lData.Position := 0;
+      n := lData.Size;
+      AOutStream.CopyFrom(lData, lData.Size);
+    end;
+    if (n mod 4) <> 0 then
+    begin
+      {$ifdef gdebug}
+      writeln('Padding applied at the end of ', ATables[i], ': ', 4 - (n mod 4), ' byte(s)');
+      {$endif}
+      AOutStream.WriteBuffer(PAD_BUF, 4 - (n mod 4));
+    end;
+  end;
+end;
+
+{ This updates the original GlyphIDList passed in to the constructor - normally
+  done by fcl-pdf. This allows fcl-pdf to use the NewGlyphID values in its
+  generated PDF output. }
+procedure TFontSubsetter.UpdateOrigGlyphIDList;
+var
+  i: integer;
+  itm: TGIDItem;
+begin
+  for itm in FGlyphIDs do
+  begin
+    for i := 0 to FGlyphIDList.Count-1 do
+    begin
+      if FGlyphIDList[i].GlyphID = itm.GID then
+      begin
+        FGlyphIDList[i].NewGlyphID := itm.NewGID;
+        break;
+      end;
+    end;
+  end;
+end;
+
+function TFontSubsetter.GetCharIDfromGlyphID(const AGlyphID: uint32): uint32;
+var
+  i: integer;
+begin
+  Result := 0;
+  for i := 0 to Length(FFontInfo.Chars)-1 do
+    if FFontInfo.Chars[i] = AGlyphID then
+    begin
+      Result := i;
+      Exit;
+    end;
+end;
+
+function TFontSubsetter.GetRawGlyphData(const AGlyphID: UInt16): TMemoryStream;
+var
+  lGlyf: TTableDirectoryEntry;
+  lSize: UInt16;
+begin
+  Result := nil;
+  if Length(FGlyphLocations) < 2 then
+    raise ETTF.Create(rsErrGlyphLocationsNotLoaded);
+  FillMem(@lGlyf, SizeOf(TTableDirectoryEntry), 0);
+  FFontInfo.GetTableDirEntry(TTFTableNames[ttglyf], lGlyf);
+
+  lSize := FGlyphLocations[AGlyphID+1] - FGlyphLocations[AGlyphID];
+  Result := TMemoryStream.Create;
+  if lSize > 0 then
+  begin
+    FStream.Seek(lGlyf.offset + FGlyphLocations[AGlyphID], soFromBeginning);
+    if Result.CopyFrom(FStream, lSize) <> lSize then
+      raise ETTF.Create('GetRawGlyphData: ' + rsErrFailedToReadFromStream)
+    else
+      Result.Position := 0;
+  end;
+end;
+
+procedure TFontSubsetter.LoadLocations;
+var
+  lLocaEntry: TTableDirectoryEntry;
+  lGlyf: TTableDirectoryEntry;
+  ms: TMemoryStream;
+  numLocations: integer;
+  n: integer;
+begin
+  FillMem(@lGlyf, SizeOf(TTableDirectoryEntry), 0);
+  FillMem(@lLocaEntry, SizeOf(TTableDirectoryEntry), 0);
+
+  FFontInfo.GetTableDirEntry(TTFTableNames[ttglyf], lGlyf);
+  if FFontInfo.GetTableDirEntry(TTFTableNames[ttloca], lLocaEntry) then
+  begin
+    ms := TMemoryStream.Create;
+    try
+      FStream.Seek(lLocaEntry.offset, soFromBeginning);
+      if ms.CopyFrom(FStream, lLocaEntry.Length) <> lLocaEntry.Length then
+        raise ETTF.Create('LoadLocations: ' + rsErrFailedToReadFromStream)
+      else
+        ms.Position := 0;
+
+      if FFontInfo.Head.IndexToLocFormat = 0 then
+      begin
+        // Short offsets
+        numLocations := lLocaEntry.Length shr 1;
+        {$IFDEF gDEBUG}
+        Writeln('Number of Glyph locations ( 16 bits offsets ): ', numLocations );
+        {$ENDIF}
+        SetLength(FGlyphLocations, numLocations);
+        for n := 0 to numLocations-1 do
+          FGlyphLocations[n] := BEtoN(ms.ReadWord) * 2;
+      end
+      else
+      begin
+        // Long offsets
+        numLocations := lLocaEntry.Length shr 2;
+        {$IFDEF gDEBUG}
+        Writeln('Number of Glyph locations ( 32 bits offsets ): ', numLocations );
+        {$ENDIF}
+        SetLength(FGlyphLocations, numLocations);
+        for n := 0 to numLocations-1 do
+          FGlyphLocations[n] := BEtoN(ms.ReadDWord);
+      end;
+    finally
+      ms.Free;
+    end;
+  end
+  else
+  begin
+    {$ifdef gDEBUG}
+    Writeln('WARNING: ''loca'' table is not found.');
+    {$endif}
+  end;
+end;
+
+procedure TFontSubsetter.WriteInt16(AStream: TStream; const AValue: Int16);
+begin
+  AStream.WriteBuffer(NtoBE(AValue), 2);
+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));
+end;
+
+function TFontSubsetter.ReadUInt32(AStream: TStream): UInt32;
+begin
+  Result:=0;
+  AStream.ReadBuffer(Result,SizeOf(Result));
+  Result:=BEtoN(Result);
+end;
+
+function TFontSubsetter.ReadUInt16(AStream: TStream): UInt16;
+begin
+  Result:=0;
+  AStream.ReadBuffer(Result,SizeOf(Result));
+  Result:=BEtoN(Result);
+end;
+
+procedure TFontSubsetter.AddCompoundReferences;
+var
+  GlyphIDsToAdd: TStringList;
+  n: integer;
+  gs: TMemoryStream;
+  buf: TGlyphHeader;
+  i: integer;
+  flags: uint16;
+  glyphIndex: uint16;
+  hasNested: boolean;
+begin
+  if FHasAddedCompoundReferences then
+    Exit;
+  FHasAddedCompoundReferences := True;
+
+  LoadLocations;
+
+  repeat
+    GlyphIDsToAdd := TStringList.Create;
+    GlyphIDsToAdd.Duplicates := dupIgnore;
+    GlyphIDsToAdd.Sorted := True;
+
+    for n := 0 to FGlyphIDs.Count-1 do
+    begin
+      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
+          FGlyphIDs[n].IsCompoundGlyph := True;
+          {$IFDEF gDEBUG}
+          writeln('   numberOfContours: ', buf.numberOfContours);
+          {$ENDIF}
+          repeat
+            flags := ReadUInt16(gs);
+            glyphIndex := ReadUInt16(gs);
+            // 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]));
+              {$ENDIF}
+              GlyphIDsToAdd.Add(IntToStr(glyphIndex));
+            end;
+            // ARG_1_AND_2_ARE_WORDS
+            if (flags and (1 shl 0)) <> 0 then
+              ReadUInt32(gs)
+            else
+              ReadUInt16(gs);
+            // WE_HAVE_A_TWO_BY_TWO
+            if (flags and (1 shl 7)) <> 0 then
+            begin
+              ReadUInt32(gs);
+              ReadUInt32(gs);
+            end
+            // WE_HAVE_AN_X_AND_Y_SCALE
+            else if (flags and (1 shl 6)) <> 0 then
+            begin
+              ReadUInt32(gs);
+            end
+            // WE_HAVE_A_SCALE
+            else if (flags and (1 shl 3)) <> 0 then
+            begin
+              ReadUInt16(gs);
+            end;
+
+          until (flags and (1 shl 5)) = 0;   // MORE_COMPONENTS
+        end;  { if buf.numberOfContours = -1 }
+      end;  { if gs.Size > 0 }
+    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]);
+        FGlyphIDs.Add(glyphIndex);
+      end;
+    end;
+    hasNested := GlyphIDsToAdd.Count > 0;
+    {$IFDEF gDEBUG}
+    if hasNested then
+      writeln('------------------');
+    {$ENDIF}
+    FreeAndNil(GlyphIDsToAdd);
+  until (hasNested = false);
+end;
+
+function TFontSubsetter.buildHeadTable: TStream;
+var
+  t: THead;
+  rec: THead;
+  i: Integer;
+begin
+  Result := TMemoryStream.Create;
+
+  t := FFontInfo.Head;
+  FillMem(@rec, SizeOf(THead), 0);
+  rec.FileVersion.Version := NtoBE(t.FileVersion.Version);
+  rec.FontRevision.Version := NtoBE(t.FontRevision.Version);
+  rec.CheckSumAdjustment := 0;
+  rec.MagicNumber := NtoBE(t.MagicNumber);
+  rec.Flags := NtoBE(t.Flags);
+  rec.UnitsPerEm := NtoBE(t.UnitsPerEm);
+  rec.Created := NtoBE(t.Created);
+  rec.Modified := NtoBE(t.Modified);
+  For i := 0 to 3 do
+    rec.BBox[i] := NtoBE(t.BBox[i]);
+  rec.MacStyle := NtoBE(t.MacStyle);
+  rec.LowestRecPPEM := NtoBE(t.LowestRecPPEM);
+  rec.FontDirectionHint := NtoBE(t.FontDirectionHint);
+  // force long format of 'loca' table. ie: 'loca' table offsets are in 4-Bytes each, not Words.
+  rec.IndexToLocFormat := NtoBE(Int16(1)); //NtoBE(t.IndexToLocFormat);
+  rec.glyphDataFormat := NtoBE(t.glyphDataFormat);
+
+  Result.WriteBuffer(rec, SizeOf(THead));
+end;
+
+function TFontSubsetter.buildHheaTable: TStream;
+var
+  t: THHead;
+  rec: THHead;
+  hmetrics: UInt16;
+begin
+  Result := TMemoryStream.Create;
+
+  t := FFontInfo.HHead;
+  FillMem(@rec, SizeOf(THHead), 0);
+  rec.TableVersion.Version := NtoBE(t.TableVersion.Version);
+  rec.Ascender := NtoBE(t.Ascender);
+  rec.Descender := NtoBE(t.Descender);
+  rec.LineGap := NtoBE(t.LineGap);
+  rec.AdvanceWidthMax := NtoBE(t.AdvanceWidthMax);
+  rec.MinLeftSideBearing := NtoBE(t.MinLeftSideBearing);
+  rec.MinRightSideBearing := NtoBE(t.MinRightSideBearing);
+  rec.XMaxExtent := NtoBE(t.XMaxExtent);
+  rec.CaretSlopeRise := NtoBE(t.CaretSlopeRise);
+  rec.CaretSlopeRun := NtoBE(t.CaretSlopeRun);
+  rec.caretOffset := NtoBE(t.caretOffset);
+  rec.metricDataFormat := NtoBE(t.metricDataFormat);
+//  rec.numberOfHMetrics := NtoBE(t.numberOfHMetrics);
+
+  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);
+
+  Result.WriteBuffer(rec, SizeOf(THHead));
+end;
+
+function TFontSubsetter.buildMaxpTable: TStream;
+var
+  t: TMaxP;
+  rec: TMaxP;
+  lCount: word;
+begin
+  Result := TMemoryStream.Create;
+
+  t := FFontInfo.MaxP;
+  FillMem(@rec, SizeOf(TMaxP), 0);
+  rec.VersionNumber.Version := NtoBE(t.VersionNumber.Version);
+
+  lCount := FGlyphIDs.Count;
+  rec.numGlyphs := NtoBE(lCount);
+
+  rec.maxPoints := NtoBE(t.maxPoints);
+  rec.maxContours := NtoBE(t.maxContours);
+  rec.maxCompositePoints := NtoBE(t.maxCompositePoints);
+  rec.maxCompositeContours := NtoBE(t.maxCompositeContours);
+  rec.maxZones := NtoBE(t.maxZones);
+  rec.maxTwilightPoints := NtoBE(t.maxTwilightPoints);
+  rec.maxStorage := NtoBE(t.maxStorage);
+  rec.maxFunctionDefs := NtoBE(t.maxFunctionDefs);
+  rec.maxInstructionDefs := NtoBE(t.maxInstructionDefs);
+  rec.maxStackElements := NtoBE(t.maxStackElements);
+  rec.maxSizeOfInstructions := NtoBE(t.maxSizeOfInstructions);
+  rec.maxComponentElements := NtoBE(t.maxComponentElements);
+  rec.maxComponentDepth := NtoBE(t.maxComponentDepth);
+
+  Result.WriteBuffer(rec, SizeOf(TMaxP));
+end;
+
+function TFontSubsetter.buildFpgmTable: TStream;
+begin
+  Result := GetRawTable('fpgm');
+  Result.Position := 0;
+end;
+
+function TFontSubsetter.buildPrepTable: TStream;
+begin
+  Result := GetRawTable('prep');
+  Result.Position := 0;
+end;
+
+function TFontSubsetter.buildCvtTable: TStream;
+begin
+  Result := GetRawTable('cvt ');
+  Result.Position := 0;
+end;
+
+function TFontSubsetter.buildGlyfTable(var newOffsets: TArrayUInt32): TStream;
+var
+  n: integer;
+  lOffset: uint32;
+  lLen: uint32;
+  gs: TMemoryStream;
+  buf: TGlyphHeader;
+  flags: uint16;
+  glyphIndex: uint16;
+begin
+  lOffset := 0;
+  Result := TMemoryStream.Create;
+  LoadLocations;
+
+  {  - Assign new glyph indexes
+     - Retrieve glyph data if it doesn't yet exist (retrieved from original TTF file) }
+  for n := 0 to FGlyphIDs.Count-1 do
+  begin
+    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', [0, FGlyphIDs[n].GID]));
+    {$ENDIF}
+    gs := TMemoryStream(FGlyphIDs[n].GlyphData);
+    gs.Position := 0;
+
+    if gs.Size > 0 then
+    begin
+      FillMem(@buf, SizeOf(TGlyphHeader), 0);
+      gs.ReadBuffer(buf, SizeOf(Buf));
+
+      if buf.numberOfContours = -1 then
+      begin
+        repeat
+          flags := ReadUInt16(gs);
+          lOffset := gs.Position;
+          glyphIndex := ReadUInt16(gs);
+          // now write new GlyphID in it's place.
+          gs.Position := lOffset;
+          glyphIndex := FGlyphIDs.GetNewGlyphID(glyphIndex);
+          WriteUInt16(gs, glyphIndex);
+
+          // ARG_1_AND_2_ARE_WORDS
+          if (flags and (1 shl 0)) <> 0 then
+            ReadUInt32(gs)
+          else
+            ReadUInt16(gs);
+          // WE_HAVE_A_TWO_BY_TWO
+          if (flags and (1 shl 7)) <> 0 then
+          begin
+            ReadUInt32(gs);
+            ReadUInt32(gs);
+          end
+          // WE_HAVE_AN_X_AND_Y_SCALE
+          else if (flags and (1 shl 6)) <> 0 then
+          begin
+            ReadUInt32(gs);
+          end
+          // WE_HAVE_A_SCALE
+          else if (flags and (1 shl 3)) <> 0 then
+          begin
+            ReadUInt16(gs);
+          end;
+
+        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 }
+
+  // write all glyph data to resulting data stream
+  lOffset := 0;
+  for n := 0 to FGlyphIDs.Count-1 do
+  begin
+    newOffsets[n] := lOffset;
+    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
+      lLen := 4 - (lOffset mod 4);
+      Result.WriteBuffer(PAD_BUF, lLen);
+      lOffset := lOffset + lLen;
+    end;
+  end;
+  newOffsets[n+1] := lOffset;
+end;
+
+// write as UInt32 as defined in head.indexToLocFormat field (long format).
+function TFontSubsetter.buildLocaTable(var newOffsets: TArrayUInt32): TStream;
+var
+  i: integer;
+begin
+  Result := TMemoryStream.Create;
+  for i := 0 to Length(newOffsets)-1 do
+    WriteUInt32(Result, newOffsets[i]);
+end;
+
+function TFontSubsetter.buildCmapTable: TStream;
+const
+    // platform
+    PLATFORM_UNICODE = 0;
+    PLATFORM_MACINTOSH = 1;
+    // value 2 is reserved; do not use
+    PLATFORM_WINDOWS = 3;
+
+    // Mac encodings
+    ENCODING_MAC_ROMAN = 0;
+
+    // Windows encodings
+    ENCODING_WIN_SYMBOL = 0; // Unicode, non-standard character set
+    ENCODING_WIN_UNICODE_BMP = 1; // Unicode BMP (UCS-2)
+    ENCODING_WIN_SHIFT_JIS = 2;
+    ENCODING_WIN_BIG5 = 3;
+    ENCODING_WIN_PRC = 4;
+    ENCODING_WIN_WANSUNG = 5;
+    ENCODING_WIN_JOHAB = 6;
+    ENCODING_WIN_UNICODE_FULL = 10; // Unicode Full (UCS-4)
+
+    // Unicode encodings
+    ENCODING_UNICODE_1_0 = 0;
+    ENCODING_UNICODE_1_1 = 1;
+    ENCODING_UNICODE_2_0_BMP = 3;
+    ENCODING_UNICODE_2_0_FULL = 4;
+var
+  segCount: UInt16;
+  searchRange: UInt16;
+  i: integer;
+  startCode: Array of Integer;
+  endCode: Array of Integer;
+  idDelta: Array of Integer;
+  lastChar: integer;
+  prevChar: integer;
+  lastGid: integer;
+  curGid: integer;
+  itm: TTextMapping;
+begin
+  Result := TMemoryStream.Create;
+  SetLength(startCode, FGlyphIDList.Count);
+  SetLength(endCode, FGlyphIDList.Count);
+  SetLength(idDelta, FGlyphIDList.Count);
+
+  // cmap header
+  WriteUInt16(Result, 0);  // version
+  WriteUInt16(Result, 1);  // numberSubTables
+
+  // encoding record
+  WriteUInt16(Result, PLATFORM_WINDOWS);  // platformID
+  WriteUInt16(Result, ENCODING_WIN_UNICODE_BMP);  // platformSpecificID
+  WriteUInt32(Result, 4 * 2 + 4); // offset
+
+  // build Format 4 subtable (Unicode BMP)
+  lastChar := 0;
+  prevChar := lastChar;
+  lastGid  := GetNewGlyphId(FGlyphIDList[0].GlyphID);
+  segCount := 0;
+
+  for i := 0 to FGlyphIDList.Count-1 do
+  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 ((curGid - lastGid) <> (itm.CharID - FGlyphIDList[lastChar].CharID)) then
+    begin
+      if (lastGid <> 0) then
+      begin
+        { don't emit ranges, which map to GID 0, the undef glyph is emitted at the very last segment }
+        startCode[segCount] := FGlyphIDList[lastChar].CharID;
+        endCode[segCount] := FGlyphIDList[prevChar].CharID;
+        idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID;
+        inc(segCount);
+      end
+      else if not (FGlyphIDList[lastChar].CharID = FGlyphIDList[prevChar].CharID) then
+      begin
+        { shorten ranges which start with GID 0 by one }
+        startCode[segCount] := FGlyphIDList[lastChar].CharID + 1;
+        endCode[segCount] := FGlyphIDList[prevChar].CharID;
+        idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID;
+        inc(segCount);
+      end;
+      lastGid := curGid;
+      lastChar := i;
+    end;
+    prevChar := i;
+  end;
+
+  // trailing segment
+  startCode[segCount] := FGlyphIDList[lastChar].CharID;
+  endCode[segCount] := FGlyphIDList[prevChar].CharID;
+  idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID;
+  inc(segCount);
+
+  // GID 0
+  startCode[segCount] := $FFFF;
+  endCode[segCount] := $FFFF;
+  idDelta[segCount] := 1;
+  inc(segCount);
+
+  // write format 4 subtable
+  searchRange := trunc(2 * Power(2, Floor(Log2(segCount))));
+  WriteUInt16(Result, 4); // format
+  WriteUInt16(Result, 8 * 2 + segCount * 4*2); // length
+  WriteUInt16(Result, 0); // language
+  WriteUInt16(Result, segCount * 2); // segCountX2
+  WriteUInt16(Result, searchRange); // searchRange
+  WriteUInt16(Result, trunc(log2(searchRange / 2))); // entrySelector
+  WriteUInt16(Result, 2 * segCount - searchRange); // rangeShift
+
+  // write endCode
+  for i := 0 to segCount-1 do
+    WriteUInt16(Result, endCode[i]);
+
+  // reservedPad
+  WriteUInt16(Result, 0);
+
+  // startCode
+  for i := 0 to segCount-1 do
+    WriteUInt16(Result, startCode[i]);
+
+  // idDelta
+  for i := 0 to segCount-1 do
+  begin
+    {$IFDEF gDEBUG}
+    writeln(Format(' idDelta[%d] = %d', [i, idDelta[i]]));
+    {$ENDIF}
+    WriteInt16(Result, idDelta[i]);
+  end;
+
+  // idRangeOffset
+  for i := 0 to segCount-1 do
+    WriteUInt16(Result, 0);
+end;
+
+function TFontSubsetter.buildHmtxTable: TStream;
+var
+  n: integer;
+begin
+  Result := TMemoryStream.Create;
+  for n := 0 to FGlyphIDs.Count-1 do
+  begin
+    WriteUInt16(Result, FFontInfo.Widths[FGlyphIDs[n].GID].AdvanceWidth);
+    WriteInt16(Result, FFontInfo.Widths[FGlyphIDs[n].GID].LSB);
+  end;
+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 := '';
+
+  // create a default list
+  FKeepTables.Add('head');
+  FKeepTables.Add('hhea');
+  FKeepTables.Add('maxp');
+  FKeepTables.Add('hmtx');
+  FKeepTables.Add('cmap');
+  FKeepTables.Add('fpgm');
+  FKeepTables.Add('prep');
+  FKeepTables.Add('cvt ');
+  FKeepTables.Add('loca');
+  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)
+  else
+    raise ETTF.Create(rsErrCantFindFontFile);
+end;
+
+constructor TFontSubsetter.Create(const AFont: TTFFileInfo);
+begin
+  Create(AFont, nil);
+end;
+
+destructor TFontSubsetter.Destroy;
+var
+  i: integer;
+begin
+  // the owner of FGlyphIDList doesn't need the GlyphData information
+  for i := 0 to FGlyphIDList.Count-1 do
+    FGlyphIDList[i].GlyphData.Free;
+  FStream.Free;
+  FKeepTables.Free;
+  FreeAndNil(FGlyphIDs);
+  inherited Destroy;
+end;
+
+procedure TFontSubsetter.SaveToFile(const AFileName: String);
+var
+  fs: TFileStream;
+begin
+  fs := TFileStream.Create(AFileName, fmCreate);
+  try
+    SaveToStream(fs);
+  finally
+    FreeAndNil(fs);
+  end;
+end;
+
+procedure TFontSubsetter.SaveToStream(const AStream: TStream);
+var
+  checksum: int64;
+  offset: int64;
+  head: TStream;
+  hhea: TStream;
+  maxp: TStream;
+  hmtx: TStream;
+  cmap: TStream;
+  fpgm: TStream;
+  prep: TStream;
+  cvt: TStream;
+  loca: TStream;
+  glyf: TStream;
+  newLoca: TArrayUInt32;
+  tables: TStringList;
+  i: integer;
+  o: uint64;
+  p: uint64;
+  lPadding: byte;
+begin
+  FGlyphIDs.Sort;
+
+  // resolve compound glyph references
+  AddCompoundReferences;
+
+  // always copy GID 0
+  FGlyphIDList.Add(0, 0);
+  FGlyphIDList.Sort;
+
+  SetLength(newLoca, FGlyphIDs.Count+1);
+
+  head := buildHeadTable();
+  hhea := buildHheaTable();
+  maxp := buildMaxpTable();
+  fpgm := buildFpgmTable();
+  prep := buildPrepTable();
+  cvt  := buildCvtTable();
+  glyf := buildGlyfTable(newLoca);
+  loca := buildLocaTable(newLoca);
+  cmap := buildCmapTable();
+  hmtx := buildHmtxTable();
+
+  tables := TStringList.Create;
+  tables.CaseSensitive := True;
+  if Assigned(cmap) then
+    tables.AddObject('cmap', cmap);
+  if Assigned(glyf) then
+    tables.AddObject('glyf', glyf);
+  tables.AddObject('head', head);
+  tables.AddObject('hhea', hhea);
+  tables.AddObject('hmtx', hmtx);
+  if Assigned(loca) then
+    tables.AddObject('loca', loca);
+  tables.AddObject('maxp', maxp);
+  tables.AddObject('fpgm', fpgm);
+  tables.AddObject('prep', prep);
+  tables.AddObject('cvt ', cvt);
+  tables.Sort;
+
+  // calculate checksum
+  checksum := writeFileHeader(AStream, tables.Count);
+  offset := 12 + (16 * tables.Count);
+  lPadding := 0;
+  for i := 0 to tables.Count-1 do
+  begin
+    if tables.Objects[i] <> nil then
+    begin
+      checksum := checksum + WriteTableHeader(AStream, tables.Strings[i], offset, TStream(tables.Objects[i]));
+      p := TStream(tables.Objects[i]).Size;
+      // table bodies must be 4-byte aligned - calculate the padding so the tableHeader.Offset field can reflect that.
+      if (p mod 4) = 0 then
+        lPadding := 0
+      else
+        lPadding := 4 - (p mod 4);
+      o := p + lPadding;
+      offset := offset + o;
+    end;
+  end;
+  checksum := $B1B0AFBA - (checksum and $ffffffff);
+
+  // update head.ChecksumAdjustment field
+  head.Seek(8, soBeginning);
+  WriteInt32(head, Int32(checksum));
+
+  // write table bodies
+  WriteTableBodies(AStream, tables);
+
+  for i := 0 to tables.Count-1 do
+    TStream(tables.Objects[i]).Free;
+  tables.Free;
+
+  UpdateOrigGlyphIDList;
+end;
+
+procedure TFontSubsetter.Add(const ACodePoint: uint32);
+var
+  gid: uint32;
+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;
+
+
+end.
+

packages/fcl-pdf/tests/fpparsettf_test.pas

@@ -196,6 +196,15 @@ type
   end;
 
 
+  TTestLiberationItalicFont = class(TBaseTestParseTTF)
+  protected
+    procedure SetUp; override;
+  published
+    { PostScript data structure }
+    procedure TestPostScript_ItalicAngle;
+  end;
+
+
   TTestFreeSansFont = class(TBaseTestParseTTF)
   protected
     procedure SetUp; override;
@@ -361,6 +370,7 @@ uses
 const
   cFont1 = 'fonts' + PathDelim + 'LiberationSans-Regular.ttf';
   cFont2 = 'fonts' + PathDelim + 'FreeSans.ttf';
+  cFont3 = 'fonts' + PathDelim + 'LiberationSans-Italic.ttf';
 
 { TTestEmptyParseTTF }
 
@@ -468,22 +478,17 @@ var
 begin
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
-  //dt := EncodeDateTime(1904, 1, 1, 0, 0, 0, 0);
-  //s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  //AssertEquals('Failed on 1', '1904-01-01 00:00:00', s);
 
-  //dt := IncSecond(dt, FI.Head.Created);
-
-  // The above code equates to using MacToDateTime()
   dt := MacToDateTime(FI.Head.Created);
 
-  // We don't use this AssertEquals() because it shows a huge Double data-type
-  // value as the result.
-  //AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 20, 2, 31, 0), dt);
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //    created:             Thu Oct 04 11:02:31 2012
+  //    modified:            Thu Oct 04 11:02:31 2012
+  AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 11, 2, 31, 0), dt);
 
   // Instead we use this - which shows human readable dates.
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-10-04 20:02:31', s);
+  AssertEquals('Failed on 2', '2012-10-04 11:02:31', s);
 end;
 
 procedure TTestLiberationFont.TestHead_Modified;
@@ -491,9 +496,13 @@ var
   dt: TDateTime;
   s: string;
 begin
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //    created:             Thu Oct 04 11:02:31 2012
+  //    modified:            Thu Oct 04 11:02:31 2012
+
   dt := MacToDateTime(FI.Head.Modified);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-10-04 20:02:31', s);
+  AssertEquals('Failed on 2', '2012-10-04 11:02:31', s);
 end;
 
 procedure TTestLiberationFont.TestHead_BBox_xMin;
@@ -962,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;
 
@@ -1150,6 +1159,23 @@ begin
   AssertEquals('Failed on 12', 1139, FI.GetAdvanceWidth(20));  // '1'
 end;
 
+{ TTestLiberationItalicFont }
+
+procedure TTestLiberationItalicFont.SetUp;
+begin
+  inherited SetUp;
+  AssertTrue('Failed to find TTF font file <' + cFont3 + '>' + LineEnding +
+    'You can download it from [https://fedorahosted.org/releases/l/i/liberation-fonts/liberation-fonts-ttf-2.00.1.tar.gz]',
+    FileExists(cFont3) = True);
+  LoadFont(cFont3);
+end;
+
+procedure TTestLiberationItalicFont.TestPostScript_ItalicAngle;
+begin
+  AssertEquals('Failed on 1', -12.0, FI.PostScript.ItalicAngle / 65536.0);
+  AssertEquals('Failed on 2', -12.0, FI.ItalicAngle);
+end;
+
 { TTestFreeSansFont }
 
 procedure TTestFreeSansFont.SetUp;
@@ -1232,22 +1258,20 @@ var
 begin
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
-  //dt := EncodeDateTime(1904, 1, 1, 0, 0, 0, 0);
-  //s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  //AssertEquals('Failed on 1', '1904-01-01 00:00:00', s);
 
-  //dt := IncSecond(dt, FI.Head.Created);
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //  created:             Thu May 03 13:34:25 2012
+  //  modified:            Thu May 03 13:34:25 2012
 
-  // The above code equates to using MacToDateTime()
   dt := MacToDateTime(FI.Head.Created);
 
   // We don't use this AssertEquals() because it shows a huge Double data-type
   // value as the result.
-  //AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 20, 2, 31, 0), dt);
+  AssertEquals('Failed on 1', EncodeDateTime(2012, 5, 3, 13, 34, 25, 0), dt);
 
   // Instead we use this - which shows human readable dates.
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-05-02 22:34:25', s);
+  AssertEquals('Failed on 2', '2012-05-03 13:34:25', s);
 end;
 
 procedure TTestFreeSansFont.TestHead_Modified;
@@ -1255,9 +1279,12 @@ var
   dt: TDateTime;
   s: string;
 begin
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //  created:             Thu May 03 13:34:25 2012
+  //  modified:            Thu May 03 13:34:25 2012
   dt := MacToDateTime(FI.Head.Modified);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-05-02 22:34:25', s);
+  AssertEquals('Failed on 2', '2012-05-03 13:34:25', s);
 end;
 
 procedure TTestFreeSansFont.TestHead_BBox_xMin;
@@ -1900,6 +1927,7 @@ initialization
   RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestLiberationFont{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestFreeSansFont{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestLiberationItalicFont{$ifdef fptest}.Suite{$endif});
 
 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;
@@ -655,7 +675,7 @@ var
   s8: UTF8String;
 begin
   PDF.Options := []; // disable all compression
-  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans');
   o := TPDFUTF8String.Create(PDF, 'TestT', fnt);
   try
     AssertEquals('Failed on 1', '', S.DataString);
@@ -685,7 +705,7 @@ var
   o: TPDFUTF8String;
   fnt: integer;
 begin
-  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans');
   o := TPDFUTF8String.Create(PDF, 'a(b)c\def/g', fnt);
   try
     AssertEquals('Failed on 1', '', S.DataString);
@@ -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,22 +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 4 test fonts in the "fonts" directory.';
+  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;
@@ -76,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;
@@ -106,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;
@@ -192,7 +295,7 @@ begin
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   AssertEquals('Failed on 2', 0, FC.Count);
   FC.BuildFontCache;
-  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, cFontCount, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestBuildFontCache;
@@ -211,7 +314,7 @@ begin
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   AssertEquals('Failed on 4', 0, FC.Count);
   FC.BuildFontCache;
-  AssertEquals('Failed on 5' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 5' + cErrFontCountWrong, cFontCount, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestBuildFontCache_tests_for_bug;
@@ -227,7 +330,7 @@ begin
   AssertEquals('Failed on 1', 0, FC.Count);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  AssertEquals('Failed on 2', 4, FC.Count);
+  AssertEquals('Failed on 2' + cErrFontCountWrong, cFontCount, FC.Count);
   FC.Clear;
   AssertEquals('Failed on 3', 0, FC.Count);
 end;
@@ -242,7 +345,7 @@ begin
   AssertTrue('Failed on 2', lCI = nil);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, cFontCount, FC.Count);
   lCI := FC.Find('Ubuntu');
   AssertTrue('Failed on 4', Assigned(lCI));
 
@@ -272,7 +375,7 @@ begin
   AssertTrue('Failed on 2', lCI = nil);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, cFontCount, FC.Count);
   lCI := FC.Find('Ubuntu');
   AssertTrue('Failed on 4', Assigned(lCI));
 
@@ -301,14 +404,46 @@ begin
     AssertEquals('Failed on 1', 0, FC.Count);
     FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
     FC.BuildFontCache;
-    AssertEquals('Failed on 2', 4, FC.Count);
+    AssertEquals('Failed on 2' + cErrFontCountWrong, cFontCount, FC.Count);
     FC.AssignFontList(sl);
-    AssertEquals('Failed on 3', 4, sl.Count);
+    AssertEquals('Failed on 3', cFontCount, sl.Count);
   finally
     sl.Free;
   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/mkpdffontdef.lpi

@@ -1,83 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<CONFIG>
-  <ProjectOptions>
-    <Version Value="9"/>
-    <General>
-      <Flags>
-        <MainUnitHasCreateFormStatements Value="False"/>
-        <MainUnitHasTitleStatement Value="False"/>
-      </Flags>
-      <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
-      <Title Value="mkpdffontdef"/>
-      <UseAppBundle Value="False"/>
-      <ResourceType Value="res"/>
-    </General>
-    <i18n>
-      <EnableI18N LFM="False"/>
-    </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
-    <BuildModes Count="1">
-      <Item1 Name="Default" Default="True"/>
-    </BuildModes>
-    <PublishOptions>
-      <Version Value="2"/>
-    </PublishOptions>
-    <RunParams>
-      <local>
-        <FormatVersion Value="1"/>
-        <CommandLineParams Value="/usr/share/fonts/truetype/msttcorefonts/arial.ttf cp1252 arial.fnt"/>
-      </local>
-    </RunParams>
-    <Units Count="3">
-      <Unit0>
-        <Filename Value="mkpdffontdef.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit0>
-      <Unit1>
-        <Filename Value="fpttfencodings.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit1>
-      <Unit2>
-        <Filename Value="fpparsettf.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit2>
-    </Units>
-  </ProjectOptions>
-  <CompilerOptions>
-    <Version Value="11"/>
-    <Target>
-      <Filename Value="mkpdffontdef"/>
-    </Target>
-    <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src"/>
-      <UnitOutputDirectory Value="units/"/>
-    </SearchPaths>
-    <Parsing>
-      <SyntaxOptions>
-        <UseAnsiStrings Value="False"/>
-      </SyntaxOptions>
-    </Parsing>
-    <Linking>
-      <Debugging>
-        <UseHeaptrc Value="True"/>
-      </Debugging>
-    </Linking>
-  </CompilerOptions>
-  <Debugging>
-    <Exceptions Count="3">
-      <Item1>
-        <Name Value="EAbort"/>
-      </Item1>
-      <Item2>
-        <Name Value="ECodetoolError"/>
-      </Item2>
-      <Item3>
-        <Name Value="EFOpenError"/>
-      </Item3>
-    </Exceptions>
-  </Debugging>
-</CONFIG>

packages/fcl-pdf/utils/mkpdffontdef.pp

@@ -1,36 +0,0 @@
-{
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 2014 by Michael Van Canneyt
-
-    This small program reads a TTF font file and creates a definition in a .ini file for later use
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{$mode objfpc}
-{$h+}
-
-program mkpdffontdef;
-
-uses sysutils, fpttfencodings, fpparsettf;
-
-begin
-  if (ParamCount<3) then
-    begin
-    writeln('Usage : ',ExtractFileName(paramstr(0)),' ttffilename encoding fntfilename');
-    Halt(1);
-    end;
-  With TTFFileInfo.Create do
-    try
-      LoadFromFile(ParamStr(1));
-      MakePDFFontDef(Paramstr(3),Paramstr(2),False)
-    finally
-      Free;
-    end;
-end.
-

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,17 @@
         <AllowLabel Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+      </Checks>
+    </CodeGeneration>
+    <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';