# revisions: 33163,33175,33176,33212,33215,33255,33264,33401,33428,33431,33453,33456,33468,33482,33483,33484,33485,33495,33497,33499,33535,33543,33563,33564,33566,33573,33713

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

.gitattributes

@@ -2552,6 +2552,7 @@ 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/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
 packages/fcl-pdf/tests/fpttf_test.pas svneol=native#text/plain
@@ -2563,6 +2564,8 @@ 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-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain

packages/fcl-pdf/examples/testfppdf.lpr

@@ -1,40 +1,103 @@
-{ This program generatesa multi-page PDF document and tests various
-  functionality on each of the 5 pages. }
-{$mode objfpc}
-{$H+}
+{ This program generates a multi-page PDF document and tests various
+  functionality on each of the 5 pages.
+
+  You can also specify to generate single pages by using the -p <n>
+  command line parameter.
+     eg:   testfppdf -p 1
+           testfppdf -p 2
+
+  Use -h to see more command line parameter options.
+}
 program testfppdf;
 
+{$mode objfpc}{$H+}
+{$codepage utf8}
+
 uses
-  classes, sysutils, fpimage, fpreadjpeg, freetype, fppdf;
+  {$ifdef unix}cwstring,{$endif}  // required for UnicodeString handling.
+  classes,
+  sysutils,
+  custapp,
+  fpimage,
+  fpreadjpeg,
+  fppdf,
+  fpparsettf;
+
+type
+
+  TPDFTestApp = class(TCustomApplication)
+  private
+    Fpg: integer;
+    FRawJPEG,
+    FImageCompression,
+    FTextCompression,
+    FFontCompression: boolean;
+    FDoc: TPDFDocument;
+    function    SetUpDocument: TPDFDocument;
+    procedure   SaveDocument(D: TPDFDocument);
+    procedure   EmptyPage;
+    procedure   SimpleText(D: TPDFDocument; APage: integer);
+    procedure   SimpleLinesRaw(D: TPDFDocument; APage: integer);
+    procedure   SimpleLines(D: TPDFDocument; APage: integer);
+    procedure   SimpleImage(D: TPDFDocument; APage: integer);
+    procedure   SimpleShapes(D: TPDFDocument; APage: integer);
+    procedure   SampleMatrixTransform(D: TPDFDocument; APage: integer);
+  protected
+    procedure   DoRun; override;
+  public
+    procedure   WriteHelp;
+  end;
 
-Function SetUpDocument : TPDFDocument;
-Var
-  P : TPDFPage;
-  S : TPDFSection;
+
+var
+  Application: TPDFTestApp;
+
+
+function TPDFTestApp.SetUpDocument: TPDFDocument;
+var
+  P: TPDFPage;
+  S: TPDFSection;
   i: integer;
+  lPageCount: integer;
+  lOpts: TPDFOptions;
 begin
-  Result:=TPDFDocument.Create(Nil);
-  Result.Infos.Title := 'Test Document';
-  Result.Infos.Author := ApplicationName;
-  Result.Infos.Producer:='fpGUI Toolkit 0.8';
-  Result.Infos.ApplicationName:='pdf_demo';
-  Result.Infos.CreationDate:=Now;
+  Result := TPDFDocument.Create(Nil);
+  Result.Infos.Title := Application.Title;
+  Result.Infos.Author := 'Graeme Geldenhuys';
+  Result.Infos.Producer := 'fpGUI Toolkit 0.8';
+  Result.Infos.ApplicationName := ApplicationName;
+  Result.Infos.CreationDate := Now;
+
+  lOpts := [];
+  if FFontCompression then
+    Include(lOpts, poCompressFonts);
+  if FTextCompression then
+    Include(lOpts,poCompressText);
+  if FImageCompression then
+    Include(lOpts,poCompressImages);
+  if FRawJPEG then
+    Include(lOpts,poUseRawJPEG);
+  Result.Options := lOpts;
+
   Result.StartDocument;
-  S:=Result.Sections.AddSection; // we always need at least one section
-  for i := 1 to 5 do
+  S := Result.Sections.AddSection; // we always need at least one section
+  lPageCount := 6;
+  if Fpg <> -1 then
+    lPageCount := 1;
+  for i := 1 to lPageCount do
   begin
-    P:=Result.Pages.AddPage;
+    P := Result.Pages.AddPage;
     P.PaperType := ptA4;
     P.UnitOfMeasure := uomMillimeters;
-    S.AddPage(P);
+    S.AddPage(P); // Add the Page to the Section
   end;
 end;
 
-Procedure SaveDocument(D : TPDFDocument);
-Var
-  F : TFileStream;
+procedure TPDFTestApp.SaveDocument(D : TPDFDocument);
+var
+  F: TFileStream;
 begin
-  F:=TFileStream.Create('test.pdf',fmCreate);
+  F := TFileStream.Create('test.pdf',fmCreate);
   try
     D.SaveToStream(F);
     Writeln('Document used ',D.ObjectCount,' PDF objects/commands');
@@ -43,11 +106,11 @@ begin
   end;
 end;
 
-Procedure EmptyPage;
-Var
-  D : TPDFDocument;
+procedure TPDFTestApp.EmptyPage;
+var
+  D: TPDFDocument;
 begin
-  D:=SetupDocument;
+  D := SetupDocument;
   try
     SaveDocument(D);
   finally
@@ -55,49 +118,60 @@ begin
   end;
 end;
 
-
 { all units of measure are in millimeters }
-Procedure SimpleText(D: TPDFDocument; APage: integer);
-Var
+procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
+var
   P : TPDFPage;
-  FtTitle, FtText1, FtText2: integer;
-  lPt1: TPDFCoord;
+  FtTitle, FtText1, FtText2, FtText3: integer;
 begin
-  P:=D.Pages[APage];
+  P := D.Pages[APage];
+
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('helvetica-12', clRed);
-  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans-12', clGreen); // TODO: this color value means nothing - not used at all
-  FtText2 := D.AddFont('times-8', clGreen);
+  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
 
   { Page title }
-  P.SetFont(FtTitle,23);
+  P.SetFont(FtTitle, 23);
   P.SetColor(clBlack, false);
-  lPt1 := P.Matrix.Transform(25, 20);
-  P.WriteText(lPt1.X, lPt1.Y, 'Sample Text');
-
-  // Write text using FreeSans font
-  P.SetFont(ftText1,12);
-  P.SetColor(clBlack, false);
-  P.WriteText(25, P.GetPaperHeight-70, '(25mm,70mm) FreeSans: 0oO 1lL - wêreld çèûÎÐð£¢ß');
-  lPt1 := P.Matrix.Transform(25, 76);
-  P.WriteText(lPt1.X, lPt1.Y, '(25mm,76mm) - FreeSans font');
-
-  P.WriteUTF8Text(25, P.GetPaperHeight-200, 'Hello Graeme *'#$E2#$95#$AC'*'#$C3#$A4); // 0xE2 0x95 0xAC is UTF-8 for ╬   and   0xC3 0xA4 is UTF-8 for ä
-  lPt1 := P.Matrix.Transform(25, 210);
-  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'В субботу двадцать третьего мая приезжает твоя любимая теща.');
+  P.WriteText(25, 20, 'Sample Text');
 
-  // Write text using Helvetica font
-  P.SetFont(ftText2,12);
+  // -----------------------------------
+  // Write text using PDF standard fonts
+  P.SetFont(FtTitle, 12);
   P.SetColor(clBlue, false);
-  lPt1 := P.Matrix.Transform(25, 50);
-  P.WriteText(lPt1.X, lPt1.Y, '(25mm,50mm) - Times: 0oO 1lL - wêreld çèûÎÐð£¢ß');
+  P.WriteText(25, 50, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
+
   P.SetFont(ftText2,16);
   P.SetColor($c00000, false);
-  lPt1 := P.Matrix.Transform(75, 100);
-  P.WriteText(lPt1.X, lPt1.Y, '(75mm,100mm) - Big text at absolute position');
+  P.WriteText(60, 100, '(60mm,100mm) Times-BoldItalic: Big text at absolute position');
+
+  // -----------------------------------
+  // TrueType testing purposes
+  P.SetFont(ftText3, 13);
+  P.SetColor(clBlack, false);
+
+  P.WriteText(15, 120, 'Languages: English: Hello, World!');
+  P.WriteText(40, 130, 'Greek: Γειά σου κόσμος');
+  P.WriteText(40, 140, 'Polish: Witaj świecie');
+  P.WriteText(40, 150, 'Portuguese: Olá mundo');
+  P.WriteText(40, 160, 'Russian: Здравствуйте мир');
+  P.WriteText(40, 170, 'Vietnamese: Xin chào thế giới');
+
+  P.SetFont(ftText1, 13);
+  P.WriteText(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
+
+  P.WriteText(15, 200, 'Typography: “What’s wrong?”');
+  P.WriteText(40, 210, '£17.99 vs £17·99');
+  P.WriteText(40, 220, '€17.99 vs €17·99');
+  P.WriteText(40, 230, 'OK then…    (êçèûÎÐð£¢ß)  \\//{}()#<>');
+
+  P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
 end;
 
-Procedure SimpleLinesRaw(D: TPDFDocument; APage: integer);
+procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
 var
   P: TPDFPage;
   FtTitle: integer;
@@ -105,42 +179,41 @@ 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-12', clBlack);
+  FtTitle := D.AddFont('Helvetica', clBlack);
 
   { Page title }
   P.SetFont(FtTitle,23);
-  P.SetColor(clBlack, false);
-  lPt1 := P.Matrix.Transform(25, 20);
-  P.WriteText(lPt1.X, lPt1.Y, 'Sample Line Drawing (DrawLine)');
+  P.SetColor(clBlack, False);
+  P.WriteText(25, 20, 'Sample Line Drawing (DrawLine)');
 
-  P.SetColor(clBlack,False); // clblue
+  P.SetColor(clBlack, True);
   P.SetPenStyle(ppsSolid);
-  lPt1 := P.Matrix.Transform(30, 100);
-  lPt2 := P.Matrix.Transform(150, 150);
+  lPt1.X := 30;   lPt1.Y := 100;
+  lPt2.X := 150;  lPt2.Y := 150;
   P.DrawLine(lPt1, lPt2, 0.2);
-  P.SetColor($0000FF,False); // clblue
+
+  P.SetColor(clBlue, True);
   P.SetPenStyle(ppsDash);
-  lPt1 := P.Matrix.Transform(50, 70);
-  lPt2 := P.Matrix.Transform(180, 100);
+  lPt1.X := 50;   lPt1.Y := 70;
+  lPt2.X := 180;  lPt2.Y := 100;
   P.DrawLine(lPt1, lPt2, 0.1);
-  P.SetColor($FF0000,False); // clRed
+
+  { we can also use coordinates directly, without TPDFCoord variables }
+
+  P.SetColor(clRed, True);
   P.SetPenStyle(ppsDashDot);
-  lPt1 := P.Matrix.Transform(40, 140);
-  lPt2 := P.Matrix.Transform(160, 80);
-  P.DrawLine(lPt1, lPt2, 1);
-  P.SetColor(clBlack,False); // clBlack
+  P.DrawLine(40, 140, 160, 80, 1);
+
+  P.SetColor(clBlack, True);
   P.SetPenStyle(ppsDashDotDot);
-  lPt1 := P.Matrix.Transform(60, 50);
-  lPt2 := P.Matrix.Transform(60, 120);
-  P.DrawLine(lPt1, lPt2, 1.5);
-  P.SetColor(clBlack,False); // clBlack
+  P.DrawLine(60, 50, 60, 120, 1.5);
+
+  P.SetColor(clBlack, True);
   P.SetPenStyle(ppsDot);
-  lPt1 := P.Matrix.Transform(10, 80);
-  lPt2 := P.Matrix.Transform(130, 130);
-  P.DrawLine(lPt1, lPt2, 0.5);
+  P.DrawLine(10, 80, 130, 130, 0.5);
 end;
 
-Procedure SimpleLines(D: TPDFDocument; APage: integer);
+procedure TPDFTestApp.SimpleLines(D: TPDFDocument; APage: integer);
 var
   P: TPDFPage;
   FtTitle: integer;
@@ -149,13 +222,12 @@ 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-12', clRed);
+  FtTitle := D.AddFont('Helvetica', clRed);
 
   { Page title }
   P.SetFont(FtTitle,23);
   P.SetColor(clBlack, false);
-  lPt1 := P.Matrix.Transform(25, 20);
-  P.WriteText(lPt1.X, lPt1.Y, 'Sample Line Drawing (DrawLineStyle)');
+  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);
@@ -164,44 +236,36 @@ begin
   TsThick := D.AddLineStyleDef(1.5, clBlack, ppsDashDotDot);
   TsThinBlackDot := D.AddLineStyleDef(0.5, clBlack, ppsDot);
 
-  lPt1 := P.Matrix.Transform(30, 100);
-  lPt2 := P.Matrix.Transform(150, 150);
+  lPt1.X := 30;   lPt1.Y := 100;
+  lPt2.X := 150;  lPt2.Y := 150;
   P.DrawLineStyle(lPt1, lPt2, tsThinBlack);
 
-  lPt1 := P.Matrix.Transform(50, 70);
-  lPt2 := P.Matrix.Transform(180, 100);
+  lPt1.X := 50;   lPt1.Y := 70;
+  lPt2.X := 180;  lPt2.Y := 100;
   P.DrawLineStyle(lPt1, lPt2, tsThinBlue);
 
-  lPt1 := P.Matrix.Transform(40, 140);
-  lPt2 := P.Matrix.Transform(160, 80);
-  P.DrawLineStyle(lPt1, lPt2, tsThinRed);
-
-  lPt1 := P.Matrix.Transform(60, 50);
-  lPt2 := P.Matrix.Transform(60, 120);
-  P.DrawLineStyle(lPt1, lPt2, tsThick);
+  { we can also use coordinates directly, without TPDFCoord variables }
 
-  lPt1 := P.Matrix.Transform(10, 80);
-  lPt2 := P.Matrix.Transform(130, 130);
-  P.DrawLineStyle(lPt1.X, lPt1.Y, lPt2.X, lPt2.Y, tsThinBlackDot);  { just to test the other overloaded version too. }
+  P.DrawLineStyle(40, 140, 160, 80, tsThinRed);
+  P.DrawLineStyle(60, 50, 60, 120, tsThick);
+  P.DrawLineStyle(10, 80, 130, 130, tsThinBlackDot);
 end;
 
-Procedure SimpleImage(D: TPDFDocument; APage: integer);
+procedure TPDFTestApp.SimpleImage(D: TPDFDocument; APage: integer);
 Var
   P: TPDFPage;
   FtTitle: integer;
   IDX: Integer;
   W, H: Integer;
-  lPt1: 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-12', clBlack);
+  FtTitle := D.AddFont('Helvetica', clBlack);
 
   { Page title }
   P.SetFont(FtTitle,23);
   P.SetColor(clBlack, false);
-  lPt1 := P.Matrix.Transform(25, 20);
-  P.WriteText(lPt1.X, lPt1.Y, 'Sample Image Support');
+  P.WriteText(25, 20, 'Sample Image Support');
 
   P.SetFont(FtTitle,10);
   P.SetColor(clBlack, false);
@@ -209,247 +273,278 @@ begin
   IDX := D.Images.AddFromFile('poppy.jpg',False);
   W := D.Images[IDX].Width;
   H := D.Images[IDX].Height;
-  { scalled down image (small) }
-  lPt1 := P.Matrix.Transform(25, 100); // left-bottom coordinate of image
-  P.DrawImage(lPt1.X, lPt1.Y, W div 2, H div 2, IDX);
-  lPt1 := P.Matrix.Transform(90, 75);
-  P.WriteText(lPt1.X, lPt1.Y, '[Scaled image]');
-
-
-  { large image }
-  lPt1 := P.Matrix.Transform(35, 190);  // left-bottom coordinate of image
-  P.DrawImage(lPt1.X, lPt1.Y, W, H, IDX);
-  lPt1 := P.Matrix.Transform(160, 150);
-  P.WriteText(lPt1.X, lPt1.Y, '[Default size]');
+  { full size image }
+  P.DrawImage(25, 130, W, H, IDX);  // left-bottom coordinate of image
+  P.WriteText(145, 90, '[Full size (defined in pixels)]');
+
+  { half size image }
+  P.DrawImage(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)]');
+
+  { 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]');
 end;
 
-Procedure SimpleShapes(D: TPDFDocument; APage: integer);
-Var
-  P : TPDFPage;
+procedure TPDFTestApp.SimpleShapes(D: TPDFDocument; APage: integer);
+var
+  P: TPDFPage;
   FtTitle: integer;
-//  FtText: integer;
-  lPt1, lPt2, lPt3: TPDFCoord;
+  lPt1: 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-12', clBlack);
+  FtTitle := D.AddFont('Helvetica', clBlack);
 
   { Page title }
   P.SetFont(FtTitle,23);
   P.SetColor(clBlack);
-  lPt1 := P.Matrix.Transform(25, 20);
-  P.WriteText(lPt1.X, lPt1.Y, 'Basic Shapes');
+  P.WriteText(25, 20, 'Basic Shapes');
 
   // ========== Rectangles ============
 
-  { Transform the origin point to the Cartesian coordinate system. }
+  { PDF origin coordinate is Bottom-Left, and we want to use Image Coordinate of Top-Left }
   lPt1.X := 30;
-  { PDF origin coordinate is Bottom-Left, and we want to use Image coordinate of Top-Left }
   lPt1.Y := 60+20; // origin + height
-  lPt2 := P.Matrix.Transform(lPt1);
   P.SetColor(clRed, true);
   P.SetColor($37b344, false); // some green color
-  P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 3, true, true);
+  P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 3, true, true);
 
-  { Transform the origin point to the Cartesian coordinate system. }
   lPt1.X := 20;
-  { we need the Top-Left coordinate }
   lPt1.Y := 50+20; // origin + height
-  lPt2 := P.Matrix.Transform(lPt1);
   P.SetColor(clBlue, true);
   P.SetColor($b737b3, false); // some purple color
-  P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 1, true, true);
+  P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 1, true, true);
 
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 110;
-  { PDF origin coordinate is Bottom-Left, and we want to use Image cooridanet of Top-Left }
-  lPt1.Y := 70+20; // origin + height
-  lPt2 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsDashDot);
   P.SetColor(clBlue, true);
-  P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 1, false, true);
+  P.DrawRect(110, 70+20 {origin+height}, 40, 20, 1, false, true);
 
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 100;
-  { PDF origin coordinate is Bottom-Left, and we want to use Image cooridanet of Top-Left }
-  lPt1.Y := 60+20; // origin + height
-  lPt2 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsDash);
   P.SetColor($37b344, true);  // some green color
-  P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 2, false, true);
+  P.DrawRect(100, 60+20 {origin+height}, 40, 20, 2, false, true);
 
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 90;
-  { we need the Top-Left coordinate }
-  lPt1.Y := 50+20; // origin + height
-  lPt2 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsSolid);
   P.SetColor($b737b3, true);  // some purple color
-  P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 4, false, true);
+  P.DrawRect(90, 50+20 {origin+height}, 40, 20, 4, false, true);
 
 
   // ========== Ellipses ============
 
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt2 := P.Matrix.Transform(60, 150);
   P.SetPenStyle(ppsSolid);
   P.SetColor($c00000, True);
-  P.DrawEllipse(lPt2.X, lPt2.Y, -40, 20, 3, False, True);
+  P.DrawEllipse(60, 150, -40, 20, 3, False, True);
 
+  lPt1.X := 60;
+  lPt1.Y := 150;
   P.SetColor(clBlue, true);
   P.SetColor($b737b3, false); // some purple color
-  P.DrawEllipse(lPt2, 10, 10, 1, True, True);
-(*
-  P.DrawRect(mmToPDF(lPt2.X), mmToPDF(lPt2.Y), 2, 2, 1, False, True);
-  FtText := D.AddFont('helvetica-8', clBlack);
-  P.SetFont(ftText,8);
-  P.SetColor(clblack);
-  P.WriteText(mmtoPDF(100), GetPaperHeight-mmToPDF(105),'^---(origin point)');
-*)
-
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt2 := P.Matrix.Transform(140, 150);
+  P.DrawEllipse(lPt1, 10, 10, 1, True, True);
+
   P.SetPenStyle(ppsDashDot);
   P.SetColor($b737b3, True);
-  P.DrawEllipse(lPt2, 35, 20, 1, False, True);
+  P.DrawEllipse(140, 150, 35, 20, 1, False, True);
 
 
   // ========== Lines Pen Styles ============
 
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 30;
-  lPt1.Y := 200;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 70;
-  lPt1.Y := 200;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsSolid);
   P.SetColor(clBlack, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
+  P.DrawLine(30, 200, 70, 200, 1);
 
-  lPt1.X := 30;
-  lPt1.Y := 210;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 70;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsDash);
   P.SetColor(clBlack, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
+  P.DrawLine(30, 210, 70, 210, 1);
 
-  lPt1.X := 30;
-  lPt1.Y := 220;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 70;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsDot);
   P.SetColor(clBlack, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
+  P.DrawLine(30, 220, 70, 220, 1);
 
-  lPt1.X := 30;
-  lPt1.Y := 230;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 70;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsDashDot);
   P.SetColor(clBlack, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
+  P.DrawLine(30, 230, 70, 230, 1);
 
-  lPt1.X := 30;
-  lPt1.Y := 240;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 70;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsDashDotDot);
   P.SetColor(clBlack, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
+  P.DrawLine(30, 240, 70, 240, 1);
 
 
   // ========== Line Attribute ============
 
-
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 100;
-  lPt1.Y := 170;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetPenStyle(ppsSolid);
   P.SetColor(clBlack, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 0.2);
-
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 100;
-  lPt1.Y := 180;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 0.3);
-
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 100;
-  lPt1.Y := 190;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 0.5);
-
-  { Transform the origin point to the Cartesian coordinate system. }
-  lPt1.X := 100;
-  lPt1.Y := 200;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
-
-  lPt1.X := 100;
-  lPt1.Y := 210;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
+  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.SetColor(clRed, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 2);
+  P.DrawLine(100, 210, 140, 210, 2);
 
-  lPt1.X := 100;
-  lPt1.Y := 220;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetColor($37b344, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 3);
+  P.DrawLine(100, 220, 140, 220, 3);
 
-  lPt1.X := 100;
-  lPt1.Y := 230;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetColor(clBlue, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 4);
+  P.DrawLine(100, 230, 140, 230, 4);
 
-  lPt1.X := 100;
-  lPt1.Y := 240;
-  lPt2 := P.Matrix.Transform(lPt1);
-  lPt1.X := 140;
-  lPt3 := P.Matrix.Transform(lPt1);
   P.SetColor($b737b3, True);
-  P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 5);
+  P.DrawLine(100, 240, 140, 240, 5);
 end;
 
-Var
-  D: TPDFDocument;
+procedure TPDFTestApp.SampleMatrixTransform(D: TPDFDocument; APage: integer);
+var
+  P: TPDFPage;
+  FtTitle: integer;
+
+  procedure OutputSample;
+  var
+    b: boolean;
+  begin
+    b := P.Matrix._11 = -1;
+    P.SetFont(FtTitle, 10);
+    P.WriteText(10, 10, 'Matrix transform: ' + BoolToStr(b, True));
+    P.DrawLine(0, 0, 100, 100, 1);
+    P.WriteText(100, 100, '(line end point)');
+  end;
+
 begin
-  D := SetupDocument;
-  try
-    D.FontDirectory := ExtractFIlePath(Paramstr(0))+'fonts'+PathDelim;
+  P:=D.Pages[APage];
+  // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
+  FtTitle := D.AddFont('Helvetica', clBlack);
 
-    SimpleText(D, 0);
-    SimpleShapes(D, 1);
-    SimpleLines(D, 2);
-    SimpleLinesRaw(D, 3);
-    SimpleImage(D, 4);
+  { Page title }
+  P.SetFont(FtTitle,23);
+  P.SetColor(clBlack);
+  P.WriteText(75, 20, 'Matrix Transform');
 
-    SaveDocument(D);
+  OutputSample;
+
+  // enables Cartesian coordinate system for the page
+  P.Matrix.SetYScalation(1);
+  P.Matrix.SetYTranslation(0);
+
+  OutputSample;
+end;
+
+{ TPDFTestApp }
+
+procedure TPDFTestApp.DoRun;
+
+  Function BoolFlag(C : Char;ADefault : Boolean) : Boolean;
+
+  Var
+    V : Integer;
+
+  begin
+    Result:=ADefault;
+    if HasOption(C, '') then
+      begin
+      v := StrToIntDef(GetOptionValue(C,''),-1);
+      if Not (V in [0,1]) then
+        Raise Exception.Create('Error in -'+C+' parameter. Valid range is 0-1.');
+      Result:=(v=1);
+      end
+  end;
+
+var
+  ErrorMsg: String;
+
+begin
+  StopOnException:=True;
+  inherited DoRun;
+  // quick check parameters
+  ErrorMsg := CheckOptions('hp:f:t:i:j:', '');
+  if ErrorMsg <> '' then
+  begin
+    WriteLn('ERROR:  ' + ErrorMsg);
+    Writeln('');
+    Terminate;
+    Exit;
+  end;
+
+  // parse parameters
+  if HasOption('h', '') then
+  begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+
+  Fpg := -1;
+  if HasOption('p', '') then
+  begin
+    Fpg := StrToInt(GetOptionValue('p', ''));
+    if (Fpg < 1) or (Fpg > 5) then
+    begin
+      Writeln('Error in -p parameter. Valid range is 1-5.');
+      Writeln('');
+      Terminate;
+      Exit;
+    end;
+  end;
+
+  FFontCompression := BoolFlag('f',true);
+  FTextCompression := BoolFlag('t',False);
+  FImageCompression := BoolFlag('i',False);
+  FRawJPEG:=BoolFlag('j',False);
+
+  FDoc := SetupDocument;
+  try
+    FDoc.FontDirectory := 'fonts';
+
+    if Fpg = -1 then
+    begin
+      SimpleText(FDoc, 0);
+      SimpleShapes(FDoc, 1);
+      SimpleLines(FDoc, 2);
+      SimpleLinesRaw(FDoc, 3);
+      SimpleImage(FDoc, 4);
+      SampleMatrixTransform(FDoc, 5);
+    end
+    else
+    begin
+      case Fpg 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);
+      end;
+    end;
+
+    SaveDocument(FDoc);
   finally
-    D.Free;
+    FDoc.Free;
   end;
-end.
 
+  // stop program loop
+  Terminate;
+end;
+
+procedure TPDFTestApp.WriteHelp;
+begin
+  writeln('Usage:');
+  writeln('    -h          Show this help.');
+  writeln('    -p <n>      Generate only one page. Valid range is 1-5.' + LineEnding +
+          '                If this option is not specified, then all 5 pages are' + LineEnding +
+          '                generated.');
+  writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
+          '                disables compression. A value of 1 enables compression.');
+  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 +
+          '                disables compression. A value of 1 enables compression.');
+  writeln('    -j <0|1>    Toggle use of JPEG. A value of 0' + LineEnding +
+          '                disables use of JPEG images. A value of 1 writes jpeg file as-is');
+  writeln('');
+end;
+
+
+
+begin
+  Application := TPDFTestApp.Create(nil);
+  Application.Title := 'fpPDF Test Application';
+  Application.Run;
+  Application.Free;
+end.

packages/fcl-pdf/fpmake.pp

@@ -23,7 +23,7 @@ begin
     P.Email := '';
     P.Description := 'PDF generating and TTF file info library';
     P.NeedLibC:= false;
-    P.OSes:=P.OSes-[embedded,win16];
+    P.OSes:=P.OSes-[embedded,msdos,nativent];
     P.Dependencies.Add('rtl-objpas');
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-image');

packages/fcl-pdf/readme.txt

@@ -17,6 +17,7 @@ The PDF generator has the following features:
 - Support for multiple units.
 - Rotation matrix system.
 - PDF creator information.
+- Output validates by several PDF validators.
 
 Todo:
 - Implement TFPCustomCanvas descendent (TPDFCanvas) that draws on a PDF.
@@ -27,3 +28,4 @@ Optionally:
 - PDF Forms.
 - Archive format.
 - Signature.
+- File attachments.

packages/fcl-pdf/src/fpparsettf.pp

@@ -31,28 +31,8 @@ type
   // Tables recognized in this unit.
   TTTFTableType = (ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost);
 
-  TPDFFontDefinition = Record
-    FontType : String;
-    FontName : String;
-    Ascender : Integer;
-    Descender : Integer;
-    CapHeight : Integer;
-    Flags : Integer;
-    BBox : Array[0..3] of Integer;
-    ItalicAngle : Integer;
-    StemV : Integer;
-    MissingWidth : integer;
-    FontUp : Integer;
-    FontUt : Integer;
-    Encoding : String;
-    FontFile : String;
-    Diffs : String;
-    CharWidths : String;
-    OriginalSize : integer;
-  end;
-
-  TSmallintArray = Packed Array of Smallint;
-  TWordArray = Packed Array of Smallint;
+  TSmallintArray = Packed Array of Int16;
+  TWordArray = Packed Array of UInt16;
 
   TFixedVersionRec = packed record
     case Integer of
@@ -253,10 +233,11 @@ Type
     FWidths: TLongHorMetrics; // hmtx data
     // Needed to create PDF font def.
     FOriginalSize : Cardinal;
-    MissingWidth: Integer;
+    FMissingWidth: Integer;
     FNameEntries: TNameEntries;
     { This only applies to TFixedVersionRec values. }
     function FixMinorVersion(const AMinor: word): word;
+    function GetMissingWidth: integer;
   Protected
     // Stream reading functions.
     Function IsNativeData : Boolean; virtual;
@@ -273,25 +254,10 @@ Type
     procedure ParseOS2(AStream : TStream); virtual;
     procedure ParsePost(AStream : TStream); virtual;
     // Make differences for postscript fonts
-    procedure PrepareEncoding(Const AEnCoding : String);
+    procedure PrepareEncoding(Const AEncoding : String);
     function MakeDifferences: String; virtual;
     // Utility function to convert FShort to natural units
     Function ToNatural(AUnit: Smallint) : Smallint;
-    // Some utility functions to create the PDF font definition
-    Procedure MakePDFFontDefinitionFile(Const FontFile,Section,AEncoding: string); virtual;
-    Function Flags : Integer;
-    Function Bold: Boolean;
-    Function StemV: SmallInt;
-    Function Embeddable : Boolean;
-    Function Ascender: SmallInt;
-    Function Descender: SmallInt;
-    { Also know as the linegap. "Leading" is the gap between two lines. }
-    Function Leading: SmallInt;
-    Function CapHeight: SmallInt;
-    { Returns the Glyph Index value in the TTF file, where AValue is the ordinal value of a character. }
-    function GetGlyphIndex(AValue: word): word;
-    { Returns the glyph advance width, based on the AIndex (glyph index) value. The result is in font units. }
-    function GetAdvanceWidth(AIndex: word): word;
   public
     Chars: TWordArray;
     CharWidth: array[0..255] of SmallInt;
@@ -301,20 +267,37 @@ Type
     PostScriptName: string;
     FamilyName: string;
     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;
     // Load a TTF file from file or stream.
     Procedure LoadFromFile(const AFileName : String);
     Procedure LoadFromStream(AStream: TStream); virtual;
-    // Checks if Embedded is allowed, and also prepares CharWidths array
+    // Checks if Embedded is allowed, and also prepares CharWidths array. NOTE: this is possibly not needed any more.
     procedure PrepareFontDefinition(const Encoding:string; Embed: Boolean);
-    // Fill record with PDF Font definition data.
-    Procedure FillPDFFontDefinition(Out ADef: TPDFFontDefinition; Const AFontFile,AEncoding : String);
-    // Write Font Definition data to a file named FontFile.
-    procedure MakePDFFontDef(const FontFile: string; const Encoding: string; Embed: Boolean);
+
     // The following are only valid after the file was succesfully read.
-    // Font file header info.
+
+    Function Flags : Integer;
+    Function Bold: Boolean;
+    Function StemV: SmallInt;
+    Function Embeddable : Boolean;
+    Function Ascender: SmallInt;
+    Function Descender: SmallInt;
+    { Also know as the linegap. "Leading" is the gap between two lines. }
+    Function Leading: SmallInt;
+    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;
+    { max glyph bounding box values - as space separated values }
+    function BBox: string;
+    property MissingWidth: Integer read GetMissingWidth;
+    { original font file size }
+    property OriginalSize: Cardinal read FOriginalSize;
+    property Filename: string read FFilename;
     Property Directory : TTableDirectory Read FTableDir;
     Property Tables : TTableDirectoryEntries Read FTables;
-    // The various tables as present in the font file.
+
     Property Head : THead Read FHead;
     Property HHead : THHead Read FHHead;
     property CmapH : TCMapHeader Read FCmapH;
@@ -338,12 +321,9 @@ type
 
 // Convert string to known table type
 Function GetTableType(Const AName : String) : TTTFTableType;
-// Utility functions for text encoding conversions
-function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt; Src: PChar; SrcCharCount: SizeUInt;
-                            Options: TConvertOptions; out ActualWideCharCount: SizeUInt): TConvertResult;
-function UTF8ToUTF16(const P: PChar; ByteCnt: SizeUInt): UnicodeString;
-function UTF8ToUTF16(const S: AnsiString): UnicodeString;
 function StrToUTF16Hex(const AValue: UnicodeString; AIncludeBOM: boolean = True): AnsiString;
+{ To overcome the annoying compiler hint: "Local variable does not seem to be initialized" }
+procedure FillMem(Dest: pointer; Size: longint; Data: Byte );
 
 
 Const
@@ -373,8 +353,6 @@ Const
 
 implementation
 
-uses
-  inifiles;
 
 resourcestring
   rsFontEmbeddingNotAllowed = 'Font licence does not allow embedding';
@@ -386,222 +364,6 @@ begin
     Result:=Pred(Result);
 end;
 
-{------------------------------------------------------------------------------
-  Name:    ConvertUTF8ToUTF16
-  Params:  Dest                - Pointer to destination string
-           DestWideCharCount   - Wide char count allocated in destination string
-           Src                 - Pointer to source string
-           SrcCharCount        - Char count allocated in source string
-           Options             - Conversion options, if none is set, both
-             invalid and unfinished source chars are skipped
-
-             toInvalidCharError       - Stop on invalid source char and report
-                                      error
-             toInvalidCharToSymbol    - Replace invalid source chars with '?'
-             toUnfinishedCharError    - Stop on unfinished source char and
-                                      report error
-             toUnfinishedCharToSymbol - Replace unfinished source char with '?'
-
-           ActualWideCharCount - Actual wide char count converted from source
-                               string to destination string
-  Returns:
-    trNoError        - The string was successfully converted without
-                     any error
-    trNullSrc        - Pointer to source string is nil
-    trNullDest       - Pointer to destination string is nil
-    trDestExhausted  - Destination buffer size is not big enough to hold
-                     converted string
-    trInvalidChar    - Invalid source char has occured
-    trUnfinishedChar - Unfinished source char has occured
-
-  Converts the specified UTF-8 encoded string to UTF-16 encoded (system endian)
- ------------------------------------------------------------------------------}
-function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt;
-  Src: PChar; SrcCharCount: SizeUInt; Options: TConvertOptions;
-  out ActualWideCharCount: SizeUInt): TConvertResult;
-var
-  DestI, SrcI: SizeUInt;
-  B1, B2, B3, B4: Byte;
-  W: Word;
-  C: Cardinal;
-
-  function UnfinishedCharError: Boolean;
-  begin
-    if toUnfinishedCharToSymbol in Options then
-    begin
-      Dest[DestI] := System.WideChar('?');
-      Inc(DestI);
-      Result := False;
-    end
-    else
-      if toUnfinishedCharError in Options then
-      begin
-        ConvertUTF8ToUTF16 := trUnfinishedChar;
-        Result := True;
-      end
-      else Result := False;
-  end;
-
-  function InvalidCharError(Count: SizeUInt): Boolean; inline;
-  begin
-    if not (toInvalidCharError in Options) then
-    begin
-      if toInvalidCharToSymbol in Options then
-      begin
-        Dest[DestI] := System.WideChar('?');
-        Inc(DestI);
-      end;
-
-      Dec(SrcI, Count);
-
-      // skip trailing UTF-8 char bytes
-      while (Count > 0) do
-      begin
-        if (Byte(Src[SrcI]) and %11000000) <> %10000000 then Break;
-        Inc(SrcI);
-        Dec(Count);
-      end;
-
-      Result := False;
-    end
-    else
-      if toInvalidCharError in Options then
-      begin
-        ConvertUTF8ToUTF16 := trUnfinishedChar;
-        Result := True;
-      end;
-  end;
-
-begin
-  ActualWideCharCount := 0;
-
-  if not Assigned(Src) then
-  begin
-    Result := trNullSrc;
-    Exit;
-  end;
-
-  if not Assigned(Dest) then
-  begin
-    Result := trNullDest;
-    Exit;
-  end;
-  SrcI := 0;
-  DestI := 0;
-
-  while (DestI < DestWideCharCount) and (SrcI < SrcCharCount) do
-  begin
-    B1 := Byte(Src[SrcI]);
-    Inc(SrcI);
-
-    if B1 < 128 then // single byte UTF-8 char
-    begin
-      Dest[DestI] := System.WideChar(B1);
-      Inc(DestI);
-    end
-    else
-    begin
-      if SrcI >= SrcCharCount then
-        if UnfinishedCharError then Exit(trInvalidChar)
-        else Break;
-
-      B2 := Byte(Src[SrcI]);
-      Inc(SrcI);
-
-      if (B1 and %11100000) = %11000000 then // double byte UTF-8 char
-      begin
-        if (B2 and %11000000) = %10000000 then
-        begin
-          Dest[DestI] := System.WideChar(((B1 and %00011111) shl 6) or (B2 and %00111111));
-          Inc(DestI);
-        end
-        else // invalid character, assume single byte UTF-8 char
-          if InvalidCharError(1) then Exit(trInvalidChar);
-      end
-      else
-      begin
-        if SrcI >= SrcCharCount then
-          if UnfinishedCharError then Exit(trInvalidChar)
-          else Break;
-
-        B3 := Byte(Src[SrcI]);
-        Inc(SrcI);
-
-        if (B1 and %11110000) = %11100000 then // triple byte UTF-8 char
-        begin
-          if ((B2 and %11000000) = %10000000) and ((B3 and %11000000) = %10000000) then
-          begin
-            W := ((B1 and %00011111) shl 12) or ((B2 and %00111111) shl 6) or (B3 and %00111111);
-            if (W < $D800) or (W > $DFFF) then // to single wide char UTF-16 char
-            begin
-              Dest[DestI] := System.WideChar(W);
-              Inc(DestI);
-            end
-            else // invalid UTF-16 character, assume double byte UTF-8 char
-              if InvalidCharError(2) then Exit(trInvalidChar);
-          end
-          else // invalid character, assume double byte UTF-8 char
-            if InvalidCharError(2) then Exit(trInvalidChar);
-        end
-        else
-        begin
-          if SrcI >= SrcCharCount then
-            if UnfinishedCharError then Exit(trInvalidChar)
-            else Break;
-
-          B4 := Byte(Src[SrcI]);
-          Inc(SrcI);
-
-          if ((B1 and %11111000) = %11110000) and ((B2 and %11000000) = %10000000)
-            and ((B3 and %11000000) = %10000000) and ((B4 and %11000000) = %10000000) then
-          begin // 4 byte UTF-8 char
-            C := ((B1 and %00011111) shl 18) or ((B2 and %00111111) shl 12)
-              or ((B3 and %00111111) shl 6)  or (B4 and %00111111);
-            // to double wide char UTF-16 char
-            Dest[DestI] := System.WideChar($D800 or ((C - $10000) shr 10));
-            Inc(DestI);
-            if DestI >= DestWideCharCount then Break;
-            Dest[DestI] := System.WideChar($DC00 or ((C - $10000) and %0000001111111111));
-            Inc(DestI);
-          end
-          else // invalid character, assume triple byte UTF-8 char
-            if InvalidCharError(3) then Exit(trInvalidChar);
-        end;
-      end;
-    end;
-  end;
-
-  if DestI >= DestWideCharCount then
-  begin
-    DestI := DestWideCharCount - 1;
-    Result := trDestExhausted;
-  end
-  else
-    Result := trNoError;
-
-  Dest[DestI] := #0;
-  ActualWideCharCount := DestI + 1;
-end;
-
-function UTF8ToUTF16(const P: PChar; ByteCnt: SizeUInt): UnicodeString;
-var
-  L: SizeUInt;
-begin
-  if ByteCnt=0 then
-    exit('');
-  SetLength(Result, ByteCnt);
-  // wide chars of UTF-16 <= bytes of UTF-8 string
-  if ConvertUTF8ToUTF16(PWideChar(Result), Length(Result) + 1, P, ByteCnt,
-    [toInvalidCharToSymbol], L) = trNoError
-  then SetLength(Result, L - 1)
-  else Result := '';
-end;
-
-function UTF8ToUTF16(const S: AnsiString): UnicodeString;
-begin
-  Result:=UTF8ToUTF16(PChar(S),length(S));
-end;
-
 function StrToUTF16Hex(const AValue: UnicodeString; AIncludeBOM: boolean = True): AnsiString;
 var
   pc: ^Word;
@@ -618,6 +380,11 @@ begin
   end;
 end;
 
+procedure FillMem(Dest: pointer; Size: longint; Data: Byte );
+begin
+  FillChar(Dest^, Size, Data);
+end;
+
 function TTFFileInfo.ReadULong(AStream: TStream): Longword;inline;
 begin
   Result:=0;
@@ -653,16 +420,16 @@ begin
   FHead.Created := BEtoN(FHead.Created);
   FHead.Modified := BEtoN(FHead.Modified);
   For i:=0 to 3 do
-    FHead.BBox[i]:=betOn(FHead.BBox[i]);
-  FHead.CheckSumAdjustment:=beton(FHead.CheckSumAdjustment);
-  FHead.MagicNumber:=beton(FHead.MagicNumber);
-  FHead.Flags:=Beton(FHead.Flags);
-  FHead.UnitsPerEm:=beton(FHead.UnitsPerEm);
-  FHead.MacStyle:=Beton(FHead.MacStyle);
-  FHead.LowestRecPPEM:=Beton(FHead.LowestRecPPEM);
-  FHead.FontDirectionHint:=Beton(FHead.FontDirectionHint);
-  FHead.IndexToLocFormat:=Beton(FHead.IndexToLocFormat);
-  FHead.glyphDataFormat:=Beton(FHead.glyphDataFormat);
+    FHead.BBox[i]:=BEtoN(FHead.BBox[i]);
+  FHead.CheckSumAdjustment:=BEtoN(FHead.CheckSumAdjustment);
+  FHead.MagicNumber:=BEtoN(FHead.MagicNumber);
+  FHead.Flags:=BEtoN(FHead.Flags);
+  FHead.UnitsPerEm:=BEtoN(FHead.UnitsPerEm);
+  FHead.MacStyle:=BEtoN(FHead.MacStyle);
+  FHead.LowestRecPPEM:=BEtoN(FHead.LowestRecPPEM);
+  FHead.FontDirectionHint:=BEtoN(FHead.FontDirectionHint);
+  FHead.IndexToLocFormat:=BEtoN(FHead.IndexToLocFormat);
+  FHead.glyphDataFormat:=BEtoN(FHead.glyphDataFormat);
 end;
 
 procedure TTFFileInfo.ParseHhea(AStream : TStream);
@@ -671,19 +438,19 @@ begin
   AStream.ReadBuffer(FHHEad,SizeOf(FHHEad));
   if IsNativeData then
     exit;
-  FHHEad.TableVersion.Version := BeToN(FHHEad.TableVersion.Version);
+  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.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.metricDataFormat:=BeToN(FHHEad.metricDataFormat);
-  FHHEad.numberOfHMetrics:=BeToN(FHHEad.numberOfHMetrics);
-  FHHead.AdvanceWidthMax := BeToN(FHHead.AdvanceWidthMax);
+  FHHEad.Ascender:=BEToN(FHHEad.Ascender);
+  FHHEad.Descender:=BEToN(FHHEad.Descender);
+  FHHEad.LineGap:=BEToN(FHHEad.LineGap);
+  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.metricDataFormat:=BEToN(FHHEad.metricDataFormat);
+  FHHEad.numberOfHMetrics:=BEToN(FHHEad.numberOfHMetrics);
+  FHHead.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
 end;
 
 procedure TTFFileInfo.ParseMaxp(AStream : TStream);
@@ -696,20 +463,20 @@ begin
     begin
     VersionNumber.Version := BEtoN(VersionNumber.Version);
     VersionNumber.Minor := FixMinorVersion(VersionNumber.Minor);
-    numGlyphs:=Beton(numGlyphs);
-    maxPoints:=Beton(maxPoints);
-    maxContours:=Beton(maxContours);
-    maxCompositePoints :=BeToN(maxCompositePoints);
-    maxCompositeContours :=BeToN(maxCompositeContours);
-    maxZones :=BeToN(maxZones);
-    maxTwilightPoints :=BeToN(maxTwilightPoints);
-    maxStorage :=BeToN(maxStorage);
-    maxFunctionDefs :=BeToN(maxFunctionDefs);
-    maxInstructionDefs :=BeToN(maxInstructionDefs);
-    maxStackElements :=BeToN(maxStackElements);
-    maxSizeOfInstructions :=BeToN(maxSizeOfInstructions);
-    maxComponentElements :=BeToN(maxComponentElements);
-    maxComponentDepth :=BeToN(maxComponentDepth);
+    numGlyphs:=BEtoN(numGlyphs);
+    maxPoints:=BEtoN(maxPoints);
+    maxContours:=BEtoN(maxContours);
+    maxCompositePoints :=BEtoN(maxCompositePoints);
+    maxCompositeContours :=BEtoN(maxCompositeContours);
+    maxZones :=BEtoN(maxZones);
+    maxTwilightPoints :=BEtoN(maxTwilightPoints);
+    maxStorage :=BEtoN(maxStorage);
+    maxFunctionDefs :=BEtoN(maxFunctionDefs);
+    maxInstructionDefs :=BEtoN(maxInstructionDefs);
+    maxStackElements :=BEtoN(maxStackElements);
+    maxSizeOfInstructions :=BEtoN(maxSizeOfInstructions);
+    maxComponentElements :=BEtoN(maxComponentElements);
+    maxComponentDepth :=BEtoN(maxComponentDepth);
     end;
 end;
 
@@ -725,8 +492,8 @@ begin
     exit;
   for I:=0 to FHHead.NumberOfHMetrics-1 do
     begin
-    FWidths[I].AdvanceWidth:=beton(FWidths[I].AdvanceWidth);
-    FWidths[I].LSB:=beton(FWidths[I].LSB);
+    FWidths[I].AdvanceWidth:=BEtoN(FWidths[I].AdvanceWidth);
+    FWidths[I].LSB:=BEtoN(FWidths[I].LSB);
     end;
 end;
 
@@ -755,7 +522,7 @@ begin
   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');
+    Raise ETTF.Create('No Format 4 map (unicode) table found <'+FFileName + ' - ' + PostScriptName+'>');
   TT:=TableStartPos+FSubtables[UE].Offset;
   AStream.Position:=TT;
   FUnicodeMap.Format:= ReadUShort(AStream);               // 2 bytes - Format of subtable
@@ -765,7 +532,7 @@ begin
   S:=TMemoryStream.Create;
   try
     // Speed up the process, read everything in a single mem block.
-    S.CopyFrom(AStream,FUnicodeMap.Length-4);
+    S.CopyFrom(AStream,Int64(FUnicodeMap.Length)-4);
     S.Position:=0;
     FUnicodeMap.LanguageID:=ReadUShort(S);
     FUnicodeMap.SegmentCount2:=ReadUShort(S);            // 2 bytes - Segments count
@@ -828,18 +595,18 @@ var
   TableStartPos: LongWord;
   S : AnsiString;
   W : Widestring;
-  FMT : Word;
   N : TNameRecord;
   E : TNameEntries;
   WA : Array of word;
 
 begin
   TableStartPos:= AStream.Position;                   // memorize Table start position
-  Fmt:=ReadUShort(AStream);                  // skip 2 bytes - Format
+  ReadUShort(AStream);                  // skip 2 bytes - Format
   Count:=ReadUShort(AStream);                        // 2 bytes
   StringOffset:=ReadUShort(AStream);                 // 2 bytes
   E := FNameEntries;
   SetLength(E,Count);
+  FillMem(@N, SizeOf(TNameRecord), 0);
   //  Read Descriptors
   for I:=0 to Count-1 do
   begin
@@ -855,7 +622,7 @@ begin
   //  Read Values
   for I:=0 to Count-1 do
   begin
-    AStream.Position:=TableStartPos+StringOffset+E[i].Info.StringOffset;
+    AStream.Position:=Int64(TableStartPos)+StringOffset+E[i].Info.StringOffset;
     if E[i].Info.EncodingID=1 then
     begin
       SetLength(WA,E[i].Info.StringLength div 2);
@@ -863,7 +630,7 @@ begin
       AStream.Read(WA[0],SizeOf(Word)*Length(W));    // 1 byte
       For J:=0 to Length(WA)-1 do
         W[J+1]:=WideChar(Beton(WA[J]));
-      E[i].Value:=W;
+      E[i].Value:=string(W);
     end
     else
     begin
@@ -974,7 +741,7 @@ Var
   AStream: TFileStream;
 begin
   FFilename := AFilename;
-  AStream:= TFileStream.Create(AFileName,fmOpenRead);
+  AStream:= TFileStream.Create(AFileName,fmOpenRead or fmShareDenyNone);
   try
     LoadFromStream(AStream);
   finally
@@ -1023,7 +790,7 @@ begin
         ttcmap: ParseCmap(AStream);
         ttname: ParseName(AStream);
         ttos2 : ParseOS2(AStream);
-        ttPost: ParsePost(AStream);                                  // lecture table "Post"
+        ttPost: ParsePost(AStream);
       end;
       end;
     end;
@@ -1037,52 +804,18 @@ begin
     raise ETTF.Create(rsFontEmbeddingNotAllowed);
   PrepareEncoding(Encoding);
 //  MissingWidth:=ToNatural(Widths[Chars[CharCodes^[32]]].AdvanceWidth);  // Char(32) - Space character
-  MissingWidth:=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
-    if (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then
+    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]:= MissingWidth;
+      CharWidth[I]:= FMissingWidth;
     end;
 end;
 
-procedure TTFFileInfo.FillPDFFontDefinition(out ADef: TPDFFontDefinition; const AFontFile, AEncoding: String);
-
-Var
-  I : Integer;
-  S : String;
-
-begin
-  ADef.FontType:='TrueType';  // DON'T LOCALIZE
-  ADef.FontName:=PostScriptName;
-  ADef.Ascender:=Ascender;
-  ADef.Descender:=Descender;
-  ADef.CapHeight:=Capheight;
-  ADef.Flags:=Flags;
-  For I:=0 to 3 do
-    ADef.BBox[i]:=ToNatural(FHead.BBox[I]);
-  ADef.ItalicAngle:=FPostScript.ItalicAngle;
-  ADef.StemV:=StemV;
-  ADef.MissingWidth:=MissingWidth;
-  ADef.FontUp:=ToNatural(FPostScript.UnderlinePosition);
-  ADef.FontUt:=ToNatural(FPostScript.UnderlineThickness);
-  ADef.Encoding:=AEncoding;
-  ADef.OriginalSize:=FOriginalSize;
-  ADef.FontFile:=ChangeFileExt(AFontFile,'.z');
-  if (Lowercase(AEncoding)<>'cp1252') then
-    ADef.Diffs:=MakeDifferences;
-  S:='';
-  for I:=32 to 255 do
-    begin
-    if I>32 then
-      S:=S+' ';
-    S:=S+IntToStr(CharWidth[I]);
-    end;
-  ADef.CharWidths:=S;
-end;
-
-procedure TTFFileInfo.PrepareEncoding(const AEnCoding: String);
+procedure TTFFileInfo.PrepareEncoding(const AEncoding: String);
 var
   TE : TTTFEncoding;
   V : PTTFEncodingValues;
@@ -1090,53 +823,10 @@ begin
   TE:=GetEncoding(AEncoding);
   if (TE<>teUnknown) then
     GetEncodingTables(Te,CharNames,CharCodes);
-  // Needed to mak difference
+  // Needed to make difference
   GetEncodingTables(Te,CharBase,V);
 end;
 
-procedure TTFFileInfo.MakePDFFontDefinitionFile(const FontFile, Section, AEncoding: string);
-
-var
-  Ini : TMemIniFile;
-  S: String;
-  I : Integer;
-  Def : TPDFFontDefinition;
-
-begin
-  FillPDFFontDefinition(Def,FontFile,AEncoding);
-  Ini:=TMemIniFile.Create(FontFile);
-  With Ini Do
-    try
-      WriteString(Section,'FontType',Def.FontType);
-      WriteString(Section,'FontName',Def.FontName);
-      WriteInteger(Section,'Ascent',Def.Ascender);
-      WriteInteger(Section,'Descent',Def.Descender);
-      WriteInteger(Section,'CapHeight',Def.CapHeight);
-      WriteInteger(Section,'Flags',Def.Flags);
-      S:='';
-      for i:=0 to 3 do
-        begin
-        if I>0 then
-          S:=S+' ';
-        S:=S+IntToStr(Def.BBox[I]);
-        end;
-      WriteString(Section,'FontBBox',S);
-      WriteInteger(Section,'ItalicAngle',Def.ItalicAngle);
-      WriteInteger(Section,'StemV',Def.StemV);
-      WriteInteger(Section,'MissingWidth',Def.MissingWidth);
-      WriteInteger(Section,'FontUp',Def.FontUp);
-      WriteInteger(Section,'FontUt',Def.FontUt);
-      WriteString(Section,'Encoding',Def.Encoding);
-      WriteString(Section,'FontFile',Def.FontFile);
-      WriteInteger(Section,'OriginalSize',Def.OriginalSize);
-      WriteString(Section,'Diffs',Def.Diffs);
-      WriteString(Section,'CharWidth',Def.CharWidths);
-      UpdateFile;
-    finally
-      Ini.Free;
-    end;
-end;
-
 function TTFFileInfo.MakeDifferences: String;
 var
   i,l: Integer;
@@ -1174,17 +864,17 @@ end;
 
 function TTFFileInfo.Ascender: SmallInt;
 begin
-  Result:=ToNatural(FOS2Data.sTypoAscender);         // 2 bytes
+  Result:=FOS2Data.sTypoAscender;
 end;
 
 function TTFFileInfo.Descender: SmallInt;
 begin
-  Result := ToNatural(FOS2Data.sTypoDescender);        // 2 bytes
+  Result := FOS2Data.sTypoDescender;
 end;
 
 function TTFFileInfo.Leading: SmallInt;
 begin
-  Result := ToNatural(FOS2Data.sTypoLineGap);
+  Result := FOS2Data.sTypoLineGap;
 end;
 
 function TTFFileInfo.CapHeight: SmallInt;
@@ -1192,7 +882,7 @@ begin
   With FOS2Data do
     begin
     if Version>= 2 then
-      Result:=ToNatural(sCapHeight)
+      Result:=sCapHeight
     else
       Result:=Ascender;
     end;
@@ -1208,6 +898,24 @@ begin
   Result := Widths[AIndex].AdvanceWidth;
 end;
 
+function TTFFileInfo.ItalicAngle: LongWord;
+begin
+  Result := FPostScript.ItalicAngle;
+end;
+
+function TTFFileInfo.BBox: string;
+var
+  i: integer;
+begin
+  Result := '';
+  for i := 0 to 3 do
+  begin
+    if i > 0 then
+      Result := Result + ' ';
+    Result := Result + IntToStr(ToNatural(FHead.BBox[I]));
+  end;
+end;
+
 destructor TTFFileInfo.Destroy;
 begin
   SetLength(FNameEntries, 0);
@@ -1224,6 +932,15 @@ begin
   Result := round(d*10000);
 end;
 
+function TTFFileInfo.GetMissingWidth: integer;
+begin
+  if FMissingWidth = 0 then
+  begin
+    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // Char(32) - Space character
+  end;
+  Result := FMissingWidth;
+end;
+
 function TTFFileInfo.IsNativeData: Boolean;
 begin
   Result:=False;
@@ -1239,19 +956,11 @@ end;
 
 function TTFFileInfo.Flags: Integer;
 begin
-  Result:=32;
+  Result := 32;
   if FPostScript.IsFixedPitch<>0 then
-    Result:=Result+1;
+    Result := Result+1;
   if FPostScript.ItalicAngle<>0 then
-    Flags:= Flags+64;
-end;
-
-procedure TTFFileInfo.MakePDFFontDef(const FontFile: string; const Encoding:string; Embed: Boolean);
-begin
-  PrepareFontDefinition(Encoding, Embed);
-  MakePDFFontDefinitionFile(FontFile,PostScriptName,Encoding);
+    Result := Result+64;
 end;
 
-
 end.
-

packages/fcl-pdf/src/fpttf.pp

@@ -20,20 +20,12 @@ uses
   contnrs,
   fpparsettf;
 
-const
-  { constants to query FontCacheItem.StyleFlags with. }
-  FP_FONT_STYLE_REGULAR = 1 shl 0;     { Regular, Plain, Book }
-  FP_FONT_STYLE_ITALIC = 1 shl 1;      { Italic }
-  FP_FONT_STYLE_BOLD = 1 shl 2;        { Bold }
-  FP_FONT_STYLE_CONDENSED = 1 shl 3;   { Condensed }
-  FP_FONT_STYLE_EXTRALIGHT = 1 shl 4;  { ExtraLight }
-  FP_FONT_STYLE_LIGHT = 1 shl 5;       { Light }
-  FP_FONT_STYLE_SEMIBOLD = 1 shl 6;    { Semibold }
-  FP_FONT_STYLE_MEDIUM = 1 shl 7;      { Medium }
-  FP_FONT_STYLE_BLACK = 1 shl 8;       { Black }
-  FP_FONT_STYLE_FIXEDWIDTH = 1 shl 9;  { Fixedwidth }
-
 type
+
+  TTrueTypeFontStyle = (fsRegular, fsItalic, fsBold, fsCondensed, fsExtraLight, fsLight, fsSemibold, fsMedium, fsBlack, fsFixedWidth);
+  TTrueTypeFontStyles = set of TTrueTypeFontStyle;
+
+
   { Forward declaration }
   TFPFontCacheList = class;
 
@@ -42,31 +34,34 @@ type
   private
     FFamilyName: String;
     FFileName: String;
-    FStyleFlags: LongWord;
+    FStyleFlags: TTrueTypeFontStyles;
+    FFileInfo: TTFFileInfo;
     FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
+    FPostScriptName: string;
+    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;
-    procedure   SetIsBold(AValue: boolean);
-    procedure   SetIsFixedWidth(AValue: boolean);
-    procedure   SetIsItalic(AValue: boolean);
-    procedure   SetIsRegular(AValue: boolean);
   public
     constructor Create(const AFilename: String);
-    { Returns the actual TTF font file information. Caller needs to free the returned instance. }
-    function    GetFontData: TTFFileInfo;
+    destructor  Destroy; override;
+    { Result is in pixels }
+    function    TextWidth(const AStr: utf8string; const APointSize: single): single;
     { Result is in pixels }
-    function    TextWidth(AStr: string; APointSize: single): single;
-    property    FileName: String read FFileName write FFileName;
-    property    FamilyName: String read FFamilyName write FFamilyName;
+    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;
     { A bitmasked value describing the full font style }
-    property    StyleFlags: LongWord read FStyleFlags write FStyleFlags;
+    property    StyleFlags: TTrueTypeFontStyles read FStyleFlags;
     { IsXXX properties are convenience properties, internally querying StyleFlags. }
-    property    IsFixedWidth: boolean read GetIsFixedWidth write SetIsFixedWidth;
-    property    IsRegular: boolean read GetIsRegular write SetIsRegular;
-    property    IsItalic: boolean read GetIsItalic write SetIsItalic;
-    property    IsBold: boolean read GetIsBold write SetIsBold;
+    property    IsFixedWidth: boolean read GetIsFixedWidth;
+    property    IsRegular: boolean read GetIsRegular;
+    property    IsItalic: boolean read GetIsItalic;
+    property    IsBold: boolean read GetIsBold;
   end;
 
 
@@ -75,9 +70,7 @@ type
     FList: TObjectList;
     FSearchPath: TStringList;
     FDPI: integer;
-    procedure   SearchForFont(const AFontPath: String);
-    function    BuildFontCacheItem(const AFontFile: String): TFPFontCacheItem;
-    procedure   SetStyleIfExists(var AText: string; var AStyleFlags: integer; const AStyleName: String; const AStyleBit: integer);
+    procedure   SearchForFonts(const AFontPath: String);
     procedure   SetDPI(AValue: integer);
   protected
     function    GetCount: integer; virtual;
@@ -88,12 +81,14 @@ type
     destructor  Destroy; override;
     procedure   BuildFontCache;
     function    Add(const AObject: TFPFontCacheItem): integer;
+    procedure   AssignFontList(const AStrings: TStrings);
     procedure   Clear;
     property    Count: integer read GetCount;
     function    IndexOf(const AObject: TFPFontCacheItem): integer;
-    function    Find(const AFontCacheItem: TFPFontCacheItem): integer;
-    function    Find(const AFamilyName: string; ABold: boolean = False; AItalic: boolean = False): TFPFontCacheItem;
-    { not used: utility function doing a conversion for use. }
+    function    Find(const AFontCacheItem: TFPFontCacheItem): integer; overload;
+    function    Find(const AFamilyName: string; ABold: boolean; AItalic: boolean): TFPFontCacheItem; overload;
+    function    Find(const APostScriptName: string): TFPFontCacheItem; overload;
+    { not used: utility function doing a conversion for us. }
     function    PointSizeInPixels(const APointSize: single): single;
     property    Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
     property    SearchPath: TStringList read FSearchPath;
@@ -108,10 +103,7 @@ implementation
 resourcestring
   rsNoSearchPathDefined = 'No search path was defined';
   rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.';
-
-type
-  { so we can get access to protected methods }
-  TFriendTTFFileInfo = class(TTFFileInfo);
+  rsCharAboveWord = 'TextWidth doesn''t support characters higher then High(Word) - %d.';
 
 var
   uFontCacheList: TFPFontCacheList;
@@ -129,86 +121,94 @@ end;
 
 function TFPFontCacheItem.GetIsBold: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_BOLD) <> 0;
+  Result := fsBold in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsFixedWidth: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_FIXEDWIDTH) <> 0;
+  Result := fsFixedWidth in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsItalic: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_ITALIC) <> 0;
+  Result := fsItalic in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsRegular: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_REGULAR) <> 0;
+  Result := fsRegular in FStyleFlags;
 end;
 
-procedure TFPFontCacheItem.SetIsBold(AValue: boolean);
-begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_BOLD
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_BOLD);
-end;
-
-procedure TFPFontCacheItem.SetIsFixedWidth(AValue: boolean);
-begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_FIXEDWIDTH
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_FIXEDWIDTH);
-
-  // if we are FixedWidth, then Regular can't apply
-  FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_REGULAR);
-end;
-
-procedure TFPFontCacheItem.SetIsItalic(AValue: boolean);
+procedure TFPFontCacheItem.BuildFontCacheItem;
+var
+  s: string;
 begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_ITALIC
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_ITALIC);
+  s := FFileInfo.PostScriptName;
+  FPostScriptName := s;
+  FFamilyName := FFileInfo.FamilyName;
+  if Pos(s, FFamilyName) = 1 then
+    Delete(s, 1, Length(FFamilyName));
+
+  FStyleFlags := [fsRegular];
+
+  // extract simple styles first
+  if FFileInfo.PostScript.isFixedPitch > 0 then
+    FStyleFlags := [fsFixedWidth]; // this should overwrite Regular style
+
+  if FFileInfo.PostScript.ItalicAngle <> 0 then
+    FStyleFlags := FStyleFlags + [fsItalic];
+
+  // Now to more complex styles stored in StyleName field. eg: 'Condensed Medium'
+  SetStyleIfExists(s, FStyleFlags, 'Bold', fsBold);
+  SetStyleIfExists(s, FStyleFlags, 'Condensed', fsCondensed);
+  SetStyleIfExists(s, FStyleFlags, 'ExtraLight', fsExtraLight);
+  SetStyleIfExists(s, FStyleFlags, 'Light', fsLight);
+  SetStyleIfExists(s, FStyleFlags, 'Semibold', fsSemibold);
+  SetStyleIfExists(s, FStyleFlags, 'Medium', fsMedium);
+  SetStyleIfExists(s, FStyleFlags, 'Black', fsBlack);
+  SetStyleIfExists(s, FStyleFlags, 'Oblique', fsItalic);
 end;
 
-procedure TFPFontCacheItem.SetIsRegular(AValue: boolean);
+procedure TFPFontCacheItem.SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles;
+  const AStyleName: String; const AStyle: TTrueTypeFontStyle);
+var
+  i: integer;
 begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_REGULAR
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_REGULAR);
-
-  // if we are Regular, then FixedWidth can't apply
-  FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_FIXEDWIDTH);
+  i := Pos(AStyleName, AText);
+  if i > 0 then
+  begin
+    AStyleFlags := AStyleFlags + [AStyle];
+    Delete(AText, i, Length(AStyleName));
+  end;
 end;
 
 constructor TFPFontCacheItem.Create(const AFilename: String);
 begin
   inherited Create;
   FFileName := AFilename;
-  FStyleFlags := FP_FONT_STYLE_REGULAR;
-end;
+  FStyleFlags := [fsRegular];
 
-function TFPFontCacheItem.GetFontData: TTFFileInfo;
-begin
-  if FileName = '' then
+  if AFileName = '' then
     raise ETTF.Create(rsNoFontFileName);
-  if FileExists(FileName) then
+
+  if FileExists(AFilename) then
   begin
-    Result := TTFFileInfo.Create;
-    Result.LoadFromFile(FileName);
-  end
-  else
-    Result := nil;
+    FFileInfo := TTFFileInfo.Create;
+    FFileInfo.LoadFromFile(AFilename);
+    BuildFontCacheItem;
+  end;
+end;
+
+destructor TFPFontCacheItem.Destroy;
+begin
+  FFileInfo.Free;
+  inherited Destroy;
 end;
 
 { TextWidth returns with width of the text. If APointSize = 0.0, then it returns
   the text width in Font Units. If APointSize > 0 then it returns the text width
   in Pixels. }
-function TFPFontCacheItem.TextWidth(AStr: string; APointSize: single): single;
+function TFPFontCacheItem.TextWidth(const AStr: utf8string; const APointSize: single): single;
 {
     From Microsoft's Typography website:
     Converting FUnits (font units) to pixels
@@ -229,11 +229,10 @@ function TFPFontCacheItem.TextWidth(AStr: string; APointSize: single): single;
     550 * 18 * 72 / ( 72 * 2048 ) = 4.83
 }
 var
-  lFntInfo: TFriendTTFFileInfo;
   i: integer;
   lWidth: integer;
   lGIndex: integer;
-  c: Char;
+  us: UnicodeString;
   {$IFDEF ttfdebug}
   sl: TStringList;
   s: string;
@@ -243,8 +242,7 @@ begin
   if Length(AStr) = 0 then
     Exit;
 
-  lFntInfo := TFriendTTFFileInfo(GetFontData);
-  if not Assigned(lFntInfo) then
+  if not Assigned(FFileInfo) then
     Exit;
 
   {$IFDEF ttfdebug}
@@ -252,41 +250,43 @@ begin
     s := '';
     for i := 0 to 255 do
     begin
-      lGIndex := lFntInfo.GetGlyphIndex(i);
-      lWidth := lFntInfo.GetAdvanceWidth(lGIndex);
+      lGIndex := FFileInfo.GetGlyphIndex(i);
+      lWidth := FFileInfo.GetAdvanceWidth(lGIndex);
       s := s + ',' + IntToStr(lWidth);
     end;
     sl.Add(s);
-    sl.Add('UnitsPerEm = ' + IntToStr(lFntInfo.Head.UnitsPerEm));
-    sl.SaveToFile('/tmp/' + lFntInfo.PostScriptName + '.txt');
+    sl.Add('UnitsPerEm = ' + IntToStr(FFileInfo.Head.UnitsPerEm));
+    sl.SaveToFile(GetTempDir(True) + FFileInfo.PostScriptName + '.txt');
     sl.Free;
   {$ENDIF}
 
-  try
-    lWidth := 0;
-    for i := 1 to Length(AStr) do
-    begin
-      c := AStr[i];
-      lGIndex := lFntInfo.GetGlyphIndex(Ord(c));
-      lWidth := lWidth + lFntInfo.GetAdvanceWidth(lGIndex);
-    end;
-
-    if APointSize = 0.0 then
-      Result := lWidth
-    else
-    begin
-      { Converting Font Units to Pixels. The formula is:
-        pixels = glyph_units * pointSize * resolution / ( 72 points per inch * THead.UnitsPerEm )  }
-      Result := lWidth * APointSize * FOwner.DPI / (72 * lFntInfo.Head.UnitsPerEm);
-    end;
-  finally
-    lFntInfo.Free;
+  lWidth := 0;
+  us := UTF8Decode(AStr);
+  for i := 1 to Length(us) do
+  begin
+    lGIndex := FFileInfo.GetGlyphIndex(Word(us[i]));
+    lWidth := lWidth + FFileInfo.GetAdvanceWidth(lGIndex);
+  end;
+  if APointSize = 0.0 then
+    Result := lWidth
+  else
+  begin
+    { Converting Font Units to Pixels. The formula is:
+      pixels = glyph_units * pointSize * resolution / ( 72 points per inch * THead.UnitsPerEm )  }
+    Result := lWidth * APointSize * FOwner.DPI / (72 * FFileInfo.Head.UnitsPerEm);
   end;
 end;
 
+function TFPFontCacheItem.TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single;
+begin
+  { 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);
+end;
+
 { TFPFontCacheList }
 
-procedure TFPFontCacheList.SearchForFont(const AFontPath: String);
+procedure TFPFontCacheList.SearchForFonts(const AFontPath: String);
 var
   sr: TSearchRec;
   lFont: TFPFontCacheItem;
@@ -301,13 +301,13 @@ begin
       // We got something, so lets continue
       s := sr.Name;
       if (sr.Attr and faDirectory) <> 0 then // found a directory
-        SearchForFont(IncludeTrailingPathDelimiter(AFontPath + s))
+        SearchForFonts(IncludeTrailingPathDelimiter(AFontPath + s))
       else
       begin // we have a file
         if (lowercase(ExtractFileExt(s)) = '.ttf') or
            (lowercase(ExtractFileExt(s)) = '.otf') then
         begin
-          lFont := BuildFontCacheItem(AFontPath + s);
+          lFont := TFPFontCacheItem.Create(AFontPath + s);
           Add(lFont);
         end;
       end;
@@ -316,55 +316,6 @@ begin
   FindClose(sr);
 end;
 
-function TFPFontCacheList.BuildFontCacheItem(const AFontFile: String): TFPFontCacheItem;
-var
-  lFontInfo: TTFFileInfo;
-  s: string;
-  flags: integer;
-begin
-  lFontInfo := TTFFileInfo.Create;
-  try
-    lFontInfo.LoadFromFile(AFontFile);
-
-    Result := TFPFontCacheItem.Create(AFontFile);
-    s := lFontInfo.PostScriptName;
-    Result.FamilyName := lFontInfo.FamilyName;
-
-    // extract simple styles first
-    if lFontInfo.PostScript.isFixedPitch > 0 then
-      Result.StyleFlags := FP_FONT_STYLE_FIXEDWIDTH; // this should overwrite Regular style
-
-    if lFontInfo.PostScript.ItalicAngle <> 0 then
-      Result.StyleFlags := Result.StyleFlags or FP_FONT_STYLE_ITALIC;
-
-    // Now to more complex styles stored in StyleName field. eg: 'Condensed Medium'
-    flags := Result.StyleFlags;
-    SetStyleIfExists(s, flags, 'Bold', FP_FONT_STYLE_BOLD);
-    SetStyleIfExists(s, flags, 'Condensed', FP_FONT_STYLE_CONDENSED);
-    SetStyleIfExists(s, flags, 'ExtraLight', FP_FONT_STYLE_EXTRALIGHT);
-    SetStyleIfExists(s, flags, 'Light', FP_FONT_STYLE_LIGHT);
-    SetStyleIfExists(s, flags, 'Semibold', FP_FONT_STYLE_SEMIBOLD);
-    SetStyleIfExists(s, flags, 'Medium', FP_FONT_STYLE_MEDIUM);
-    SetStyleIfExists(s, flags, 'Black', FP_FONT_STYLE_BLACK);
-    Result.StyleFlags := flags;
-  finally
-    lFontInfo.Free;
-  end;
-end;
-
-procedure TFPFontCacheList.SetStyleIfExists(var AText: string; var AStyleFlags: integer; const AStyleName: String;
-  const AStyleBit: integer);
-var
-  i: integer;
-begin
-  i := Pos(AStyleName, AText);
-  if i > 0 then
-  begin
-    AStyleFlags := AStyleFlags or AStyleBit;
-    Delete(AText, Length(AStyleName), i);
-  end;
-end;
-
 procedure TFPFontCacheList.SetDPI(AValue: integer);
 begin
   if FDPI = AValue then Exit;
@@ -412,7 +363,8 @@ begin
   for i := 0 to FSearchPath.Count-1 do
   begin
     lPath := FSearchPath[i];
-    SearchForFont(IncludeTrailingPathDelimiter(lPath));
+    if DirectoryExists(lPath) then
+      SearchForFonts(IncludeTrailingPathDelimiter(lPath));
   end;
 end;
 
@@ -422,6 +374,17 @@ begin
   AObject.FOwner := self;
 end;
 
+procedure TFPFontCacheList.AssignFontList(const AStrings: TStrings);
+var
+  i: integer;
+begin
+  if not Assigned(AStrings) then
+    Exit;
+  AStrings.Clear;
+  for i := 0 to FList.Count-1 do
+    AStrings.Add(TFPFontCacheItem(FList.Items[i]).PostScriptName);
+end;
+
 procedure TFPFontCacheList.Clear;
 begin
   FList.Clear;
@@ -452,16 +415,28 @@ function TFPFontCacheList.Find(const AFamilyName: string; ABold: boolean; AItali
 var
   i: integer;
 begin
-  Result := nil;
   for i := 0 to Count-1 do
   begin
-    if (Items[i].FamilyName = AFamilyName) and (items[i].IsItalic = AItalic)
-        and (items[i].IsBold = ABold) then
-    begin
-      Result := Items[i];
+    Result := Items[i];
+    if (Result.FamilyName = AFamilyName) and (Result.IsItalic = AItalic)
+        and (Result.IsBold = ABold)
+    then
       exit;
-    end;
   end;
+  Result := nil;
+end;
+
+function TFPFontCacheList.Find(const APostScriptName: string): TFPFontCacheItem;
+var
+  i: integer;
+begin
+  for i := 0 to Count-1 do
+  begin
+    Result := Items[i];
+    if (Result.PostScriptName = APostScriptName) then
+      Exit;
+  end;
+  Result := nil;
 end;
 
 function TFPFontCacheList.PointSizeInPixels(const APointSize: single): single;

packages/fcl-pdf/tests/fonts/README.txt

@@ -0,0 +1,95 @@
+These sets of unit tests requires four font files of specific versions
+each. Here is what the tests were designed against.
+
+ Font File                  |  Size (bytes)   |  Version
+----------------------------+-----------------+-----------------
+DejaVuSans.ttf              |    622,280      |    2.30
+FreeSans.ttf                |  1,563,256      |  412.2268
+LiberationSans-Regular.ttf  |    350,200      |    2.00.1
+Ubuntu-R.ttf                |    353,824      |    0.80
+
+
+Details of the above font files and download locations are as follows.
+
+
+DejaVu Sans
+===========
+Official website:
+    http://dejavu-fonts.org/wiki/Main_Page
+
+Download URL:
+    http://sourceforge.net/projects/dejavu/files/dejavu/2.30/dejavu-fonts-ttf-2.30.tar.bz2
+
+Description:
+    The DejaVu fonts are a font family based on the Vera Fonts. Its purpose is
+    to provide a wider range of characters while maintaining the original look
+    and feel through the process of collaborative development (see authors),
+    under a Free license.
+
+
+FreeSans
+========
+Official website:
+    http://savannah.gnu.org/projects/freefont/
+
+Download URL:
+    http://ftp.gnu.org/gnu/freefont/freefont-ttf-20120503.zip
+
+Description:
+    We aim to provide a useful set of free outline (i.e. OpenType) fonts
+    covering as much as possible of the Unicode character set. The set consists
+    of three typefaces: one monospaced and two proportional (one with uniform
+    and one with modulated stroke).
+
+License:
+    GNU General Public License v3 or later
+
+
+Liberation
+==========
+Official website: 
+    https://fedorahosted.org/liberation-fonts/
+
+Download URL:
+    https://fedorahosted.org/releases/l/i/liberation-fonts/liberation-fonts-ttf-2.00.1.tar.gz
+
+Description:
+    The Liberation(tm) Fonts is a font family which aims at metric compatibility
+    with Arial, Times New Roman, and Courier New. It is sponsored by Red Hat.
+
+License:
+    * The Liberation(tm) version 2.00.0 onward are Licensed under the SIL Open 
+      Font License, Version 1.1.
+    * Older versions of the Liberation(tm) Fonts is released as open source under
+      the GNU General Public License version 2 with exceptions. ​
+      https://fedoraproject.org/wiki/Licensing/LiberationFontLicense 
+
+
+Ubuntu
+======
+Official website:
+    http://font.ubuntu.com/
+
+Download URL:
+    http://font.ubuntu.com/download/ubuntu-font-family-0.80.zip
+
+Description:
+    The Ubuntu typeface has been specially created to complement the Ubuntu
+    tone of voice. It has a contemporary style and contains characteristics
+    unique to the Ubuntu brand that convey a precise, reliable and free
+    attitude.
+
+License:
+    Ubuntu Font Licence. This licence allows the licensed fonts to be used,
+    studied, modified and redistributed freely.
+
+
+TTF Dump output
+===============
+I used the Microsoft "ttfdump.exe" tool to generate the
+file dump output for the Liberation Sans Regular font. I then used that to verify
+the results of the TTF unit tests.
+
+  http://www.microsoft.com/typography/tools/tools.aspx
+
+

packages/fcl-pdf/tests/fpparsettf_test.pas

@@ -9,7 +9,7 @@ uses
   {$ifdef fptest}
   ,TestFramework
   {$else}
-  ,fpcunit, testutils, testregistry
+  ,fpcunit, testregistry
   {$endif}
   ,fpparsettf
   ;
@@ -190,10 +190,6 @@ type
     procedure TestPostScript_minMemType1;
     procedure TestPostScript_maxMemType1;
 
-    { PDF Font Definition }
-    procedure TestPDFFontDefinition;
-    procedure TestMakePDFFontDefinition;
-
     { Utility functions }
     procedure TestGetGlyphIndex;
     procedure TestGetAdvanceWidth;
@@ -353,10 +349,6 @@ type
     procedure TestPostScript_maxMemType42;
     procedure TestPostScript_minMemType1;
     procedure TestPostScript_maxMemType1;
-
-    { PDF Font Definition }
-    procedure TestPDFFontDefinition;
-    procedure TestMakePDFFontDefinition;
   end;
 
 implementation
@@ -364,7 +356,6 @@ implementation
 uses
   dateutils
   ,strutils
-  ,IniFiles
   ;
 
 const
@@ -1124,78 +1115,6 @@ begin
   AssertEquals('Failed on 1', 0, FI.PostScript.maxMemType1);
 end;
 
-procedure TTestLiberationFont.TestPDFFontDefinition;
-var
-  Def: TPDFFontDefinition;
-  s: string;
-begin
-  FI.FillPDFFontDefinition(Def, cFont1, 'cp1252');
-  AssertEquals('Failed on 1', 'TrueType', Def.FontType);
-  AssertEquals('Failed on 2', 'LiberationSans', Def.FontName);
-  AssertEquals('Failed on 3', 728, Def.Ascender);
-  AssertEquals('Failed on 4', -210, Def.Descender);
-  AssertEquals('Failed on 5', 688, Def.CapHeight);
-  AssertEquals('Failed on 6', 32, Def.Flags);
-
-  s := IntToStr(Def.BBox[0]) + ' ' + IntToStr(Def.BBox[1]) + ' ' +
-        IntToStr(Def.BBox[2]) + ' ' + IntToStr(Def.BBox[3]);
-  AssertEquals('Failed on 7', '-544 -303 1302 980', s);
-
-  AssertEquals('Failed on 8', 0, Def.ItalicAngle);
-  AssertEquals('Failed on 9', 70, Def.StemV);
-  AssertEquals('Failed on 10', 0, Def.MissingWidth);
-  AssertEquals('Failed on 11', -106, Def.FontUp);
-  AssertEquals('Failed on 12', 73, Def.FontUt);
-  AssertEquals('Failed on 13', 'cp1252', Def.Encoding);
-  AssertEquals('Failed on 14', ReplaceStr(cFont1, '.ttf', '.z'), Def.FontFile); // 'fonts/LiberationSans-Regular.z'
-  AssertEquals('Failed on 15', '', Def.Diffs);
-
-  { CharWidths is only valid if we called MakePDFFontDef }
-//  AssertEquals('Failed on 16', '', Def.CharWidths);
-
-  AssertEquals('Failed on 17', 350200, Def.OriginalSize);
-end;
-
-procedure TTestLiberationFont.TestMakePDFFontDefinition;
-const
-  cSection = 'LiberationSans';
-var
-  lFile: string;
-  ini: TINIFile;
-begin
-  lFile := ChangeFileExt(GetTempFileName, '.ini');
-//  writeln( lFile);
-  AssertTrue('Failed on 1', FileExists(lFile) = False);
-  try
-    FI.MakePDFFontDef(lFile, 'cp1252', True);
-    AssertTrue('Failed on 2', FileExists(lFile) = True);
-    ini := TINIFile.Create(lFile);
-    try
-      AssertEquals('Failed on 3', 'TrueType', ini.ReadString(cSection, 'FontType', ''));
-      AssertEquals('Failed on 4', 'LiberationSans', ini.ReadString(cSection, 'FontName', ''));
-      AssertEquals('Failed on 5', 728, ini.ReadInteger(cSection, 'Ascent', 0));
-      AssertEquals('Failed on 6', -210, ini.ReadInteger(cSection, 'Descent', 0));
-      AssertEquals('Failed on 7', 688, ini.ReadInteger(cSection, 'CapHeight', 0));
-      AssertEquals('Failed on 8', 32, ini.ReadInteger(cSection, 'Flags', 0));
-      AssertEquals('Failed on 9', '-544 -303 1302 980', ini.ReadString(cSection, 'FontBBox', ''));
-      AssertEquals('Failed on 10', 0, ini.ReadInteger(cSection, 'ItalicAngle', 0));
-      AssertEquals('Failed on 11', 70, ini.ReadInteger(cSection, 'StemV', 0));
-      AssertEquals('Failed on 12', 569, ini.ReadInteger(cSection, 'MissingWidth', 0));
-      AssertEquals('Failed on 13', -106, ini.ReadInteger(cSection, 'FontUp', 0));
-      AssertEquals('Failed on 14', 73, ini.ReadInteger(cSection, 'FontUt', 0));
-      AssertEquals('Failed on 15', 'cp1252', ini.ReadString(cSection, 'Encoding', ''));
-      AssertEquals('Failed on 16', ReplaceStr(lFile, '.ini', '.z'), ini.ReadString(cSection, 'FontFile', ''));
-      AssertEquals('Failed on 17', '', ini.ReadString(cSection, 'Diffs', ''));
-      AssertTrue('Failed on 18', ini.ReadString(cSection, 'CharWidth', '') <> '');
-      AssertEquals('Failed on 19', 350200, ini.ReadInteger(cSection, 'OriginalSize', 0));
-    finally
-      ini.Free;
-    end;
-  finally
-    DeleteFile(lFile);
-  end
-end;
-
 procedure TTestLiberationFont.TestGetGlyphIndex;
 begin
   AssertEquals('Failed on 1.1', 67, Ord('C'));
@@ -1976,85 +1895,11 @@ begin
   AssertEquals('Failed on 1', 0, FI.PostScript.maxMemType1);
 end;
 
-procedure TTestFreeSansFont.TestPDFFontDefinition;
-var
-  Def: TPDFFontDefinition;
-  s: string;
-begin
-  FI.FillPDFFontDefinition(Def, cFont1, 'cp1252');
-  AssertEquals('Failed on 1', 'TrueType', Def.FontType);
-  AssertEquals('Failed on 2', 'FreeSans', Def.FontName);
-  AssertEquals('Failed on 3', 800, Def.Ascender);
-  AssertEquals('Failed on 4', -200, Def.Descender);
-  AssertEquals('Failed on 5', 729, Def.CapHeight);
-  AssertEquals('Failed on 6', 32, Def.Flags);
-
-  s := IntToStr(Def.BBox[0]) + ' ' + IntToStr(Def.BBox[1]) + ' ' +
-        IntToStr(Def.BBox[2]) + ' ' + IntToStr(Def.BBox[3]);
-  AssertEquals('Failed on 7', '-1166 -638 2260 1050', s);
-
-  AssertEquals('Failed on 8', 0, Def.ItalicAngle);
-  AssertEquals('Failed on 9', 70, Def.StemV);
-  AssertEquals('Failed on 10', 0, Def.MissingWidth);
-  AssertEquals('Failed on 11', -176, Def.FontUp);
-  AssertEquals('Failed on 12', 50, Def.FontUt);
-  AssertEquals('Failed on 13', 'cp1252', Def.Encoding);
-  AssertEquals('Failed on 14', ReplaceStr(cFont1, '.ttf', '.z'), Def.FontFile); // 'fonts/LiberationSans-Regular.z'
-  AssertEquals('Failed on 15', '', Def.Diffs);
-
-  { CharWidths is only valid if we called MakePDFFontDef }
-//  AssertEquals('Failed on 16', '', Def.CharWidths);
-
-  AssertEquals('Failed on 17', 1563256, Def.OriginalSize);
-end;
-
-procedure TTestFreeSansFont.TestMakePDFFontDefinition;
-const
-  cSection = 'FreeSans';
-var
-  lFile: string;
-  ini: TINIFile;
-begin
-  lFile := ChangeFileExt(GetTempFileName, '.ini');
-//  writeln( lFile);
-  AssertTrue('Failed on 1', FileExists(lFile) = False);
-  try
-    FI.MakePDFFontDef(lFile, 'cp1252', True);
-    AssertTrue('Failed on 2', FileExists(lFile) = True);
-    ini := TINIFile.Create(lFile);
-    try
-      AssertEquals('Failed on 3', 'TrueType', ini.ReadString(cSection, 'FontType', ''));
-      AssertEquals('Failed on 4', 'FreeSans', ini.ReadString(cSection, 'FontName', ''));
-      AssertEquals('Failed on 5', 800, ini.ReadInteger(cSection, 'Ascent', 0));
-      AssertEquals('Failed on 6', -200, ini.ReadInteger(cSection, 'Descent', 0));
-      AssertEquals('Failed on 7', 729, ini.ReadInteger(cSection, 'CapHeight', 0));
-      AssertEquals('Failed on 8', 32, ini.ReadInteger(cSection, 'Flags', 0));
-      AssertEquals('Failed on 9', '-1166 -638 2260 1050', ini.ReadString(cSection, 'FontBBox', ''));
-      AssertEquals('Failed on 10', 0, ini.ReadInteger(cSection, 'ItalicAngle', 0));
-      AssertEquals('Failed on 11', 70, ini.ReadInteger(cSection, 'StemV', 0));
-      AssertEquals('Failed on 12', 250, ini.ReadInteger(cSection, 'MissingWidth', 0));
-      AssertEquals('Failed on 13', -176, ini.ReadInteger(cSection, 'FontUp', 0));
-      AssertEquals('Failed on 14', 50, ini.ReadInteger(cSection, 'FontUt', 0));
-      AssertEquals('Failed on 15', 'cp1252', ini.ReadString(cSection, 'Encoding', ''));
-      AssertEquals('Failed on 16', ReplaceStr(lFile, '.ini', '.z'), ini.ReadString(cSection, 'FontFile', ''));
-      AssertEquals('Failed on 17', '', ini.ReadString(cSection, 'Diffs', ''));
-      AssertTrue('Failed on 18', ini.ReadString(cSection, 'CharWidth', '') <> '');
-      AssertEquals('Failed on 19', 1563256, ini.ReadInteger(cSection, 'OriginalSize', 0));
-    finally
-      ini.Free;
-    end;
-  finally
-    DeleteFile(lFile);
-  end
-end;
-
-
-
 
 initialization
-  RegisterTest(TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestLiberationFont{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestFreeSansFont{$ifdef fptest}.Suite{$endif});
+  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});
 
 end.
 

packages/fcl-pdf/tests/fppdf_test.pas

@@ -1,6 +1,7 @@
 unit fppdf_test;
 
 {$mode objfpc}{$H+}
+{$codepage utf8}
 
 interface
 
@@ -9,7 +10,7 @@ uses
   {$ifdef fptest}
   ,TestFramework
   {$else}
-  ,fpcunit, testutils, testregistry
+  ,fpcunit, testregistry
   {$endif}
   ,fppdf
   ;
@@ -29,6 +30,12 @@ type
   end;
 
 
+  TGeneralPDFTests = class(TTestCase)
+  published
+    procedure   TestPDFCoord;
+  end;
+
+
   TTestPDFObject = class(TBasePDFTest)
   published
     procedure   TestFloatStr;
@@ -73,6 +80,13 @@ type
     procedure   TestWrite;
     procedure   TestValidNames1;
     procedure   TestValidNames2;
+    procedure   TestValidNames3;
+  end;
+
+
+  TTestPDFAbstractString = class(TBasePDFTest)
+  published
+    procedure   TestInsertEscape;
   end;
 
 
@@ -84,6 +98,13 @@ type
   end;
 
 
+  TTestPDFUTF8String = class(TBasePDFTest)
+  published
+    procedure   TestWrite;
+    procedure   TestWriteEscaped;
+  end;
+
+
   TTestPDFArray = class(TBasePDFTest)
   published
     procedure   TestWrite;
@@ -167,6 +188,8 @@ type
   TTestPDFImage = class(TBasePDFTest)
   published
     procedure   TestWrite;
+    procedure   TestPageDrawImage_Pixels;
+    procedure   TestPageDrawImage_UnitsOfMeasure;
   end;
 
 
@@ -227,7 +250,8 @@ type
 
   TTestTPDFImageItem = class(TTestCase)
   published
-    procedure TestCreateStreamedData;
+    procedure TestCreateStreamedData_Compressed;
+    procedure TestCreateStreamedData_Uncompressed;
   end;
 
 implementation
@@ -235,6 +259,9 @@ implementation
 uses
   FPImage;
 
+const
+  cFont1 = 'fonts' + PathDelim + 'LiberationSans-Regular.ttf';
+
 type
   // so we can access Protected methods in the tests
   TMockPDFObject = class(TPDFObject);
@@ -245,6 +272,7 @@ type
   TMockPDFReference = class(TPDFReference);
   TMockPDFName = class(TPDFName);
   TMockPDFString = class(TPDFString);
+  TMockPDFUTF8String = class(TPDFUTF8String);
   TMockPDFArray = class(TPDFArray);
   TMockPDFStream = class(TPDFStream);
   TMockPDFEmbeddedFont = class(TPDFEmbeddedFont);
@@ -281,14 +309,54 @@ begin
   inherited TearDown;
 end;
 
+{ TGeneralPDFTests }
+
+procedure TGeneralPDFTests.TestPDFCoord;
+var
+  c: TPDFCoord;
+begin
+  c.x := 0;
+  c.y := 0;
+  AssertEquals('Failed on 1', 0, c.x);
+  AssertEquals('Failed on 2', 0, c.y);
+  c := PDFCoord(10, 20);
+  AssertEquals('Failed on 3', 10, c.x);
+  AssertEquals('Failed on 4', 20, c.y);
+end;
+
+
 { TTestPDFObject }
 
 procedure TTestPDFObject.TestFloatStr;
+
+Var
+  C : Char;
+
 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 3', '12.3', TMockPDFObject.FloatStr(TPDFFLoat(12.30)));
+  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)));
+  AssertEquals('Failed on 6', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.455)));
+  AssertEquals('Failed on 7', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.456)));
+  AssertEquals('Failed on 8', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
+  // Set DecimalSeparator
+  C:=FormatSettings.DecimalSeparator;
+  FormatSettings.DecimalSeparator:=',';
+  try
+    AssertEquals('Failed on 9', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
+  finally
+    FormatSettings.DecimalSeparator:=C;
+  end;
+  // Set ThousandSeparator
+  C:=FormatSettings.ThousandSeparator;
+  FormatSettings.ThousandSeparator:=' ';
+  try
+    AssertEquals('Failed on 10', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
+  finally
+    FormatSettings.ThousandSeparator:=C;
+  end;
 end;
 
 procedure TTestPDFObject.TestWriteString;
@@ -315,23 +383,23 @@ begin
     o.SetWidth(TPDFFloat(300.5), S);
     AssertEquals('Failed on 1',
       '1 J'+CRLF+
-      '300.5 w'+CRLF,             // line width
+      '300.50 w'+CRLF,             // line width
       s.DataString);
 
     // this shouldn't cause any change
     o.SetWidth(TPDFFloat(300.5), S);
-    AssertEquals('Failed on 1',
+    AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '300.5 w'+CRLF,             // line width
+      '300.50 w'+CRLF,             // line width
       s.DataString);
 
     // but this will
     o.SetWidth(TPDFFloat(123), S);
-    AssertEquals('Failed on 1',
+    AssertEquals('Failed on 3',
       '1 J'+CRLF+
-      '300.5 w'+CRLF+           // line width 300.5
+      '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;
@@ -378,7 +446,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;
@@ -395,7 +463,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;
@@ -480,6 +548,20 @@ var
   o: TPDFName;
 begin
   o := TPDFName.Create(PDF, 'Adobe Green');
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    TMockPDFName(o).Write(S);
+    AssertEquals('Failed on 2', '/Adobe#20Green', S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
+procedure TTestPDFName.TestValidNames3;
+var
+  o: TPDFName;
+begin
+  o := TPDFName.Create(PDF, 'Adobe Green', False);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFName(o).Write(S);
@@ -490,6 +572,23 @@ begin
 end;
 
 
+{ TTestPDFAbstractString }
+
+procedure TTestPDFAbstractString.TestInsertEscape;
+var
+  o: TPDFAbstractString;
+begin
+  o := TPDFAbstractString.Create(PDF);
+  try
+    AssertEquals('Failed on 1', 'abcdefg', TMockPDFString(o).InsertEscape('abcdefg'));
+    AssertEquals('Failed on 2', 'a\\b/cdefg', TMockPDFString(o).InsertEscape('a\b/cdefg'));
+    AssertEquals('Failed on 3', 'a\(b\)cdefg', TMockPDFString(o).InsertEscape('a(b)cdefg'));
+    AssertEquals('Failed on 4', 'a\(b\)c\\def/g', TMockPDFString(o).InsertEscape('a(b)c\def/g'));
+  finally
+    o.Free;
+  end;
+end;
+
 { TTestPDFString }
 
 procedure TTestPDFString.TestWrite;
@@ -506,11 +605,13 @@ begin
     o.Free;
   end;
 
+  S.Size := 0;  // empty out the Stream data
+
   { Length1 seems to be a special case? }
   o := TPDFString.Create(PDF, #$C2#$A3+#$C2#$BB); //  UTF-8 text of "£»"
   try
     TMockPDFString(o).Write(S);  // write will convert UTF-8 to ANSI
-    AssertEquals('Failed on 3', '(Test)('+#163#187+')', S.DataString);
+    AssertEquals('Failed on 3', '('+#163#187+')', S.DataString);
   finally
     o.Free;
   end;
@@ -545,6 +646,57 @@ begin
   end;
 end;
 
+{ TTestPDFUTF8String }
+
+procedure TTestPDFUTF8String.TestWrite;
+var
+  o: TPDFUTF8String;
+  fnt: integer;
+  s8: UTF8String;
+begin
+  PDF.Options := []; // disable all compression
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  o := TPDFUTF8String.Create(PDF, 'TestT', fnt);
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    TMockPDFUTF8String(o).Write(S);
+    //                             T | e | s | t | T |
+    AssertEquals('Failed on 2', '<00370048005600570037>', S.DataString);
+  finally
+    o.Free;
+  end;
+
+  S.Size := 0;  // empty out the Stream data
+
+  { Length1 seems to be a special case? }
+  s8 := #$C2#$A3+#$C2#$BB;
+  o := TPDFUTF8String.Create(PDF, s8, fnt); //  UTF-8 text of "£»"
+  try
+    TMockPDFUTF8String(o).Write(S);
+    //                             £ | » |
+    AssertEquals('Failed on 3', '<0065007D>', S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
+procedure TTestPDFUTF8String.TestWriteEscaped;
+var
+  o: TPDFUTF8String;
+  fnt: integer;
+begin
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  o := TPDFUTF8String.Create(PDF, 'a(b)c\def/g', fnt);
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    TMockPDFUTF8String(o).Write(S);
+    //                              a| ( | b | ) | c | \ | d | e | f | / | g |
+    AssertEquals('Failed on 2', '<0044000B0045000C0046003F0047004800490012004A>', S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
 { TTestPDFArray }
 
 procedure TTestPDFArray.TestWrite;
@@ -633,13 +785,13 @@ var
 begin
   x := 10.5;
   y := 20.0;
-  o := TPDFText.Create(PDF, x, y, 'Hello World!');
+  o := TPDFText.Create(PDF, x, y, 'Hello World!', 0);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFText(o).Write(S);
     AssertEquals('Failed on 2',
       'BT'+CRLF+
-      '10.5 20 TD'+CRLF+
+      '10.50   20 TD'+CRLF+
       '(Hello World!) Tj'+CRLF+
       'ET'+CRLF,
       S.DataString);
@@ -656,7 +808,7 @@ var
 begin
   pos.X := 10.0;
   pos.Y := 55.5;
-  AssertEquals('Failed on 1', '10 55.5 l'+CRLF, TPDFLineSegment.Command(pos));
+  AssertEquals('Failed on 1', '  10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
 end;
 
 procedure TTestPDFLineSegment.TestWrite;
@@ -675,9 +827,9 @@ begin
     TMockPDFLineSegment(o).Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+             // line width
-      '10 15.5 m'+CRLF+       // moveto command
-      '50 55.5 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
@@ -702,7 +854,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;
@@ -725,8 +877,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
@@ -750,8 +902,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
@@ -774,7 +926,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
@@ -798,7 +950,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;
@@ -822,8 +974,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
@@ -851,7 +1003,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;
@@ -878,8 +1030,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
@@ -904,7 +1056,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;
@@ -931,8 +1083,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
@@ -957,7 +1109,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;
@@ -982,15 +1134,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 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF,
+      '  55  270   10 213.75   10  145 c'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1013,15 +1165,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 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF+
+      '  55  270   10 213.75   10  145 c'+CRLF+
       'f'+CRLF,
       S.DataString);
   finally
@@ -1045,17 +1197,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 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF+
+      '  55  270   10 213.75   10  145 c'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1079,17 +1231,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 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF+
+      '  55  270   10 213.75   10  145 c'+CRLF+
       'b'+CRLF,
       S.DataString);
   finally
@@ -1118,11 +1270,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);
@@ -1151,11 +1303,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
@@ -1183,11 +1335,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
@@ -1201,7 +1353,6 @@ end;
 procedure TTestPDFImage.TestWrite;
 var
   o: TMockPDFImage;
-  ar: TPDFCoordArray;
   x, y: TPDFFLoat;
 begin
   x := 100;
@@ -1213,17 +1364,104 @@ 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,
       S.DataString);
   finally
-    SetLength(ar, 0);
     o.Free;
   end;
 end;
 
+procedure TTestPDFImage.TestPageDrawImage_Pixels;
+var
+  p: TPDFPage;
+  img: TMockPDFImage;
+begin
+  p := PDF.Pages.AddPage;
+  p.UnitOfMeasure := uomMillimeters;
+  AssertEquals('Failed on 1', 0, p.ObjectCount);
+  p.DrawImage(10, 20, 200, 100, 1);
+  AssertEquals('Failed on 2', 1, p.ObjectCount);
+  img := TMockPDFImage(p.Objects[0]);
+  AssertTrue('Failed on 3', img <> nil);
+  AssertEquals('Failed on 4', '', S.DataString);
+  img.Write(S);
+  AssertEquals('Failed on 5',
+    // save graphics state
+    'q'+CRLF+
+    '200 0 0 100 28.35 785.31 cm'+CRLF+
+    '/I1 Do'+CRLF+
+    // restore graphics state
+    'Q'+CRLF,
+    S.DataString);
+
+  S.Size := 0;  // clear the stream data
+
+  p := PDF.Pages.AddPage;
+  p.UnitOfMeasure := uomCentimeters;
+  AssertEquals('Failed on 6', 0, p.ObjectCount);
+  p.DrawImage(10, 20, 200, 100, 1);
+  AssertEquals('Failed on 7', 1, p.ObjectCount);
+  img := TMockPDFImage(p.Objects[0]);
+  AssertTrue('Failed on 8', img <> nil);
+  AssertEquals('Failed on 9', '', S.DataString);
+  img.Write(S);
+  AssertEquals('Failed on 10',
+    // save graphics state
+    'q'+CRLF+
+    '200 0 0 100 283.46 275.07 cm'+CRLF+
+    '/I1 Do'+CRLF+
+    // restore graphics state
+    'Q'+CRLF,
+    S.DataString);
+end;
+
+procedure TTestPDFImage.TestPageDrawImage_UnitsOfMeasure;
+var
+  p: TPDFPage;
+  img: TMockPDFImage;
+begin
+  p := PDF.Pages.AddPage;
+  p.UnitOfMeasure := uomMillimeters;
+  AssertEquals('Failed on 1', 0, p.ObjectCount);
+  p.DrawImage(10, 20, 20.0, 10.0, 1);
+  AssertEquals('Failed on 2', 1, p.ObjectCount);
+  img := TMockPDFImage(p.Objects[0]);
+  AssertTrue('Failed on 3', img <> nil);
+  AssertEquals('Failed on 4', '', S.DataString);
+  img.Write(S);
+  AssertEquals('Failed on 5',
+    // save graphics state
+    'q'+CRLF+
+    '57 0 0 28 28.35 785.31 cm'+CRLF+
+    '/I1 Do'+CRLF+
+    // restore graphics state
+    'Q'+CRLF,
+    S.DataString);
+
+  S.Size := 0;  // clear the stream data
+
+  p := PDF.Pages.AddPage;
+  p.UnitOfMeasure := uomCentimeters;
+  AssertEquals('Failed on 6', 0, p.ObjectCount);
+  p.DrawImage(10, 20, 20.0, 10.0, 1);
+  AssertEquals('Failed on 7', 1, p.ObjectCount);
+  img := TMockPDFImage(p.Objects[0]);
+  AssertTrue('Failed on 8', img <> nil);
+  AssertEquals('Failed on 9', '', S.DataString);
+  img.Write(S);
+  AssertEquals('Failed on 10',
+    // save graphics state
+    'q'+CRLF+
+    '567 0 0 283 283.46 275.07 cm'+CRLF+
+    '/I1 Do'+CRLF+
+    // restore graphics state
+    'Q'+CRLF,
+    S.DataString);
+end;
+
 { TTestPDFLineStyle }
 
 procedure TTestPDFLineStyle.TestWrite_ppsSolid;
@@ -1317,7 +1555,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '0.66 0.73 0.8 RG'+CRLF,
+      '0.66 0.73 0.80 RG'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1333,7 +1571,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '0.66 0.73 0.8 rg'+CRLF,
+      '0.66 0.73 0.80 rg'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1586,70 +1824,123 @@ end;
 
 { TTestTPDFImageItem }
 
-procedure TTestTPDFImageItem.TestCreateStreamedData;
+procedure TTestTPDFImageItem.TestCreateStreamedData_Compressed;
 var
+  list: TPDFImages;
   itm: TPDFImageItem;
   img: TFPMemoryImage;
   b: TBytes;
 begin
-  itm := TPDFImageItem.Create(nil);
+  list := TPDFImages.Create(nil, TPDFImageItem);
   try
-    itm.OwnsImage := True;
-    img := TFPMemoryImage.Create(5, 5);
-    itm.Image := img;
-    b := itm.StreamedData;
-    AssertEquals('Failed on 1', 75 {5*5*3}, Length(b));
+    itm := list.AddImageItem;
+    try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(5, 5);
+      itm.Image := img;
+      b := itm.StreamedData;
+      AssertEquals('Failed on 1', 12, Length(b));
+    finally
+      itm.Free;
+    end;
+
+    itm := list.AddImageItem;
+    try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(10, 20);
+      itm.Image := img;
+      { this try..except is to prove that we had a bug before, but fixed it. }
+      try
+        b := itm.StreamedData;
+      except
+        Fail('Failed on 2 - itm.StreamedData raised an exception');
+      end;
+      AssertEquals('Failed on 3', 15, Length(b));
+    finally
+      itm.Free;
+    end;
   finally
-    itm.Free;
+    list.Free;
   end;
+end;
 
-  itm := TPDFImageItem.Create(nil);
+procedure TTestTPDFImageItem.TestCreateStreamedData_Uncompressed;
+var
+  pdf: TPDFDocument;
+  list: TPDFImages;
+  itm: TPDFImageItem;
+  img: TFPMemoryImage;
+  b: TBytes;
+begin
+  pdf := TPDFDocument.Create(nil);
+  pdf.Options := [];  // disables the default image compression
+  list := TPDFImages.Create(pdf, TPDFImageItem);
   try
-    itm.OwnsImage := True;
-    img := TFPMemoryImage.Create(10, 20);
-    itm.Image := img;
-    { this try..except as to prove that we had a bug before we fixed it. }
+    itm := list.AddImageItem;
     try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(5, 5);
+      itm.Image := img;
       b := itm.StreamedData;
-    except
-      Fail('Failed on 2 - itm.StreamedData raised an exception');
+      AssertEquals('Failed on 1', 75 {5*5*3}, Length(b));
+    finally
+      itm.Free;
+    end;
+
+    itm := list.AddImageItem;
+    try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(10, 20);
+      itm.Image := img;
+      { this try..except is to prove that we had a bug before, but fixed it. }
+      try
+        b := itm.StreamedData;
+      except
+        Fail('Failed on 2 - itm.StreamedData raised an exception');
+      end;
+      AssertEquals('Failed on 3', 600 {10*20*3}, Length(b));
+    finally
+      itm.Free;
     end;
-    AssertEquals('Failed on 3', 600 {10*20*3}, Length(b));
   finally
-    itm.Free;
+    pdf.Free;
+    list.Free;
   end;
 end;
 
 
 initialization
-  RegisterTest(TTestPDFObject{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestTPDFDocumentObject{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFBoolean{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFMoveTo{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFInteger{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFReference{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFName{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFString{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFArray{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFStream{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFEmbeddedFont{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFText{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFLineSegment{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestTPDFRectangle{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFCurveC{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFCurveV{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFCurveY{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFEllipse{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFSurface{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFImage{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFLineStyle{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFColor{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFDictionaryItem{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFDictionary{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFXRef{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFPage{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestCompressionDecompression{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestTPDFImageItem{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TGeneralPDFTests{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFObject{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFDocumentObject{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFBoolean{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFMoveTo{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFInteger{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFReference{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFName{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFAbstractString{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFString{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFUTF8String{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFArray{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFStream{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEmbeddedFont{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFText{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineSegment{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFRectangle{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveC{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveV{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveY{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEllipse{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFSurface{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFImage{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineStyle{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFColor{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionaryItem{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionary{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFXRef{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFPage{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestCompressionDecompression{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFImageItem{$ifdef fptest}.Suite{$endif});
 
 end.
 

packages/fcl-pdf/tests/fpttf_test.pas

@@ -9,7 +9,7 @@ uses
   {$ifdef fptest}
   ,TestFramework
   {$else}
-  ,fpcunit, testutils, testregistry
+  ,fpcunit, testregistry
   {$endif}
   ,fpttf
   ;
@@ -47,8 +47,11 @@ type
   published
     procedure TestCount;
     procedure TestBuildFontCache;
+    procedure TestBuildFontCache_tests_for_bug;
     procedure TestClear;
     procedure TestFind_FamilyName;
+    procedure TestFind_PostscriptName;
+    procedure TestAssignFontList;
   end;
 
 implementation
@@ -56,6 +59,9 @@ implementation
 uses
   fpparsettf;
 
+resourcestring
+  cErrFontCountWrong =   ' - make sure you only have the 4 test fonts in the "fonts" directory.';
+
 { TFPFontCacheItemTest }
 
 procedure TFPFontCacheItemTest.SetUp;
@@ -72,87 +78,36 @@ end;
 
 procedure TFPFontCacheItemTest.TestIsRegular;
 begin
-  CheckEquals(True, CI.IsRegular, 'Failed on 1');
-  CI.IsRegular := True;
-  CI.IsRegular := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsRegular, 'Failed on 2');
-  CI.IsItalic := True;
-  CheckEquals(True, CI.IsRegular, 'Failed on 3');
-  CI.IsRegular := False;
-  CheckEquals(False, CI.IsRegular, 'Failed on 4');
-  CI.IsRegular := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsRegular, 'Failed on 5');
+  { regular should be the default flag set }
+  AssertEquals('Failed on 1', True, CI.IsRegular);
 end;
 
 procedure TFPFontCacheItemTest.TestIsBold;
 begin
-  CheckEquals(False, CI.IsBold, 'Failed on 1');
-  CI.IsBold := True;
-  CI.IsBold := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsBold, 'Failed on 2');
-  CI.IsBold := True;
-  CI.IsItalic := True;
-  CheckEquals(True, CI.IsBold, 'Failed on 3');
-  CI.IsBold := False;
-  CheckEquals(False, CI.IsBold, 'Failed on 4');
-  CI.IsBold := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsBold, 'Failed on 5');
+  AssertEquals('Failed on 1', False, CI.IsBold);
 end;
 
 procedure TFPFontCacheItemTest.TestIsItalic;
 begin
-  CheckEquals(False, CI.IsItalic, 'Failed on 1');
-  CI.IsItalic := True;
-  CI.IsItalic := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsItalic, 'Failed on 2');
-  CI.IsBold := True;
-  CI.IsItalic := True;
-  CheckEquals(True, CI.IsItalic, 'Failed on 3');
-  CI.IsItalic := False;
-  CheckEquals(False, CI.IsItalic, 'Failed on 4');
-  CI.IsItalic := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsItalic, 'Failed on 5');
+  AssertEquals('Failed on 1', False, CI.IsItalic);
 end;
 
 procedure TFPFontCacheItemTest.TestIsFixedWidth;
 begin
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 1');
-  CI.IsFixedWidth := True;
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 2');
-  CI.IsFixedWidth := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 3');
-  CI.IsItalic := True;  // changing another bitmask doesn't affect IsFixedWidth
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 4');
-  CI.IsFixedWidth := False;
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 5');
-  CI.IsFixedWidth := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 6');
+  AssertEquals('Failed on 1', False, CI.IsFixedWidth);
 end;
 
 procedure TFPFontCacheItemTest.TestRegularVsFixedWidth;
 begin
-  CheckEquals(True, CI.IsRegular, 'Failed on 1');
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 2');
-  CI.IsFixedWidth := True;  // this should toggle IsRegular's value
-  CheckEquals(False, CI.IsRegular, 'Failed on 3');
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 4');
-  CI.IsRegular := True;  // this should toggle IsFixedWidth's value
-  CheckEquals(True, CI.IsRegular, 'Failed on 5');
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 6');
+  AssertEquals('Failed on 1', True, CI.IsRegular);
+  AssertEquals('Failed on 2', False, CI.IsFixedWidth);
 end;
 
 procedure TFPFontCacheItemTest.TestFileName;
 begin
-  CI.FileName := '';
-  try
-    CI.GetFontData;
-    Fail('Failed on 1. GetFontData should work if FileName is empty.');
-  except
-    on e: Exception do
-      begin
-        CheckEquals(E.ClassName, 'ETTF', 'Failed on 2.');
-      end;
-  end;
+  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);
 end;
 
 procedure TFPFontCacheItemTest.TestTextWidth_FontUnits;
@@ -165,10 +120,10 @@ begin
     lFC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
     lFC.BuildFontCache;
 
-    lCI := lFC.Find('Liberation Sans');
+    lCI := lFC.Find('LiberationSans');
     AssertEquals('Failed on 1', 14684, round(lCI.TextWidth('Country Ppml01', 0.0)));
 
-    lCI := lFC.Find('DejaVu Sans');
+    lCI := lFC.Find('DejaVuSans');
     AssertEquals('Failed on 2', 16492, round(lCI.TextWidth('Country Ppml01', 0.0)));
 
     lCI := lFC.Find('Ubuntu'); // 7333 is the raw glyph width, but with kerning it is 7339
@@ -189,7 +144,7 @@ begin
     lFC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
     lFC.BuildFontCache;
 
-    lCI := lFC.Find('Liberation Sans');
+    lCI := lFC.Find('LiberationSans');
     px := 14684 * 10 * 96 / (72 * 2048);  // 95.599px
     AssertEquals('Failed on 1', px, lCI.TextWidth('Country Ppml01', 10.0));
     px := 14684 * 12 * 96 / (72 * 2048);  // 114.7188px
@@ -197,7 +152,7 @@ begin
     px := 14684 * 24 * 96 / (72 * 2048);  // 229.4375px
     AssertEquals('Failed on 3', px, lCI.TextWidth('Country Ppml01', 24.0));
 
-    lCI := lFC.Find('DejaVu Sans');
+    lCI := lFC.Find('DejaVuSans');
     px := 16492 * 10 * 96 / (72 * 2048);  // 107.369px
     AssertEquals('Failed on 4', px, lCI.TextWidth('Country Ppml01', 10.0));
     px := 16492 * 12 * 96 / (72 * 2048);  // 128.8438px
@@ -233,40 +188,48 @@ end;
 
 procedure TFPFontCacheListTest.TestCount;
 begin
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
-  CheckEquals(0, FC.Count, 'Failed on 2');
+  AssertEquals('Failed on 2', 0, FC.Count);
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 3');
+  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestBuildFontCache;
 begin
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   try
     FC.BuildFontCache;
     Fail('Failed on 2. We don''t have font paths, so BuildFontCache shouldn''t run.');
   except
     on e: Exception do
       begin
-        CheckEquals(E.ClassName, 'ETTF', 'Failed on 3.');
+        AssertEquals('Failed on 3', E.ClassName, 'ETTF');
       end;
   end;
 
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
-  CheckEquals(0, FC.Count, 'Failed on 4');
+  AssertEquals('Failed on 4', 0, FC.Count);
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 5');
+  AssertEquals('Failed on 5' + cErrFontCountWrong, 4, FC.Count);
+end;
+
+procedure TFPFontCacheListTest.TestBuildFontCache_tests_for_bug;
+begin
+  AssertEquals('Failed on 1', 0, FC.Count);
+  FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'path_doesnt_exist');
+  FC.BuildFontCache;
+  AssertEquals('Failed on 2', 0, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestClear;
 begin
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 2');
+  AssertEquals('Failed on 2', 4, FC.Count);
   FC.Clear;
-  CheckEquals(0, FC.Count, 'Failed on 3');
+  AssertEquals('Failed on 3', 0, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestFind_FamilyName;
@@ -274,35 +237,82 @@ var
   lCI: TFPFontCacheItem;
 begin
   lCI := nil;
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   lCI := FC.Find('Ubuntu');
-  CheckTrue(lCI = nil, 'Failed on 2');
+  AssertTrue('Failed on 2', lCI = nil);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 3');
+  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
   lCI := FC.Find('Ubuntu');
-  CheckTrue(Assigned(lCI), 'Failed on 4');
+  AssertTrue('Failed on 4', Assigned(lCI));
 
   { TODO: We should try and extend this to make font paths user configure
            thus the tests could be more flexible. }
 
-  lCI := FC.Find('Ubuntu', True); // bold font
-  CheckTrue(lCI = nil, 'Failed on 5');
+  lCI := FC.Find('Ubuntu', True, False); // bold font
+  AssertTrue('Failed on 5', lCI = nil);
   lCI := FC.Find('Ubuntu', False, True); // italic font
-  CheckTrue(lCI = nil, 'Failed on 6');
+  AssertTrue('Failed on 6', lCI = nil);
   lCI := FC.Find('Ubuntu', True, True); // bold+italic font
-  CheckTrue(lCI = nil, 'Failed on 7');
+  AssertTrue('Failed on 7', lCI = nil);
+
+  lCI := FC.Find('DejaVu Sans', False, False);
+  AssertTrue('Failed on 8', Assigned(lCI));
+  lCI := FC.Find('DejaVu Sans', True, False);
+  AssertTrue('Failed on 9', lCI = nil);
+end;
 
-  lCI := FC.Find('DejaVu Sans');
-  CheckTrue(Assigned(lCI), 'Failed on 8');
-  lCI := FC.Find('DejaVu Sans Bold');
-  CheckTrue(lCI = nil, 'Failed on 9');
+procedure TFPFontCacheListTest.TestFind_PostscriptName;
+var
+  lCI: TFPFontCacheItem;
+begin
+  lCI := nil;
+  AssertEquals('Failed on 1', 0, FC.Count);
+  lCI := FC.Find('Ubuntu');
+  AssertTrue('Failed on 2', lCI = nil);
+  FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
+  FC.BuildFontCache;
+  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
+  lCI := FC.Find('Ubuntu');
+  AssertTrue('Failed on 4', Assigned(lCI));
+
+  { TODO: We should try and extend this to make font paths user configure
+           thus the tests could be more flexible. }
+
+  lCI := FC.Find('Ubuntu-Bold');
+  AssertTrue('Failed on 5', lCI = nil);
+  lCI := FC.Find('Ubuntu-Italic');
+  AssertTrue('Failed on 6', lCI = nil);
+  lCI := FC.Find('Ubuntu-BoldItalic');
+  AssertTrue('Failed on 7', lCI = nil);
+
+  lCI := FC.Find('DejaVuSans');
+  AssertTrue('Failed on 8', Assigned(lCI));
+  lCI := FC.Find('DejaVuSans-Bold');
+  AssertTrue('Failed on 9', lCI = nil);
+end;
+
+procedure TFPFontCacheListTest.TestAssignFontList;
+var
+  sl: TStringList;
+begin
+  sl := TStringList.Create;
+  try
+    AssertEquals('Failed on 1', 0, FC.Count);
+    FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
+    FC.BuildFontCache;
+    AssertEquals('Failed on 2', 4, FC.Count);
+    FC.AssignFontList(sl);
+    AssertEquals('Failed on 3', 4, sl.Count);
+  finally
+    sl.Free;
+  end;
 end;
 
 
 initialization
-  RegisterTest(TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TFPFontCacheListTest{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpTTF', {$endif}TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpTTF', {$endif}TFPFontCacheListTest{$ifdef fptest}.Suite{$endif});
 
 end.
 

packages/fcl-pdf/utils/ttfdump.lpi

@@ -0,0 +1,73 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="My Application"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <MacroValues Count="2">
+      <Macro1 Name="tiopf" Value="/data/devel/tiopf/"/>
+      <Macro2 Name="fpgui" Value="/data/devel/fpgui/"/>
+    </MacroValues>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+      <SharedMatrixOptions Count="2">
+        <Item1 ID="158525129490" Modes="default" Type="IDEMacro" MacroName="tiopf" Value="/data/devel/tiopf/"/>
+        <Item2 ID="147714877372" Modes="default" Type="IDEMacro" MacroName="fpgui" Value="/data/devel/fpgui/"/>
+      </SharedMatrixOptions>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="ttfdump.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="ttfdump"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <AllowLabel Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+  </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/ttfdump.lpr

@@ -0,0 +1,239 @@
+program ttfdump;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cwstrings,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, CustApp,
+  fpparsettf, contnrs;
+
+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
+    FFontFile: TTFFileInfo;
+    procedure   DumpGlyphIndex;
+    function    GetGlyphIndicesString(const AText: UnicodeString): AnsiString; overload;
+    function    GetGlyphIndices(const AText: UnicodeString): TTextMappingList; overload;
+  protected
+    procedure   DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor  Destroy; override;
+    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
+  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 }
+
+procedure TMyApplication.DumpGlyphIndex;
+begin
+  Writeln('FHHead.numberOfHMetrics = ', FFontFile.HHead.numberOfHMetrics);
+  Writeln('Length(Chars[]) = ', Length(FFontFile.Chars));
+
+  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('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));
+end;
+
+function TMyApplication.GetGlyphIndices(const AText: UnicodeString): TTextMappingList;
+var
+  i: integer;
+  c: uint16;
+begin
+  if AText = '' then
+    Exit;
+  Result := TTextMappingList.Create;
+  for i := 1 to Length(AText) do
+  begin
+    c := uint16(AText[i]);
+    Result.Add(c, FFontFile.Chars[c]);
+  end;
+end;
+
+function TMyApplication.GetGlyphIndicesString(const AText: UnicodeString): AnsiString;
+var
+  i: integer;
+  c: word;
+begin
+  Result := '';
+  for i := 1 to Length(AText) do
+  begin
+    c := Word(AText[i]);
+    if i > 1 then
+      Result := Result + ',';
+    Result := Result + IntToHex(FFontFile.Chars[c], 4);
+  end;
+end;
+
+procedure TMyApplication.DoRun;
+var
+  ErrorMsg: String;
+  s: UnicodeString;
+  lst: TTextMappingList;
+  i: integer;
+begin
+  // quick check parameters
+  ErrorMsg := CheckOptions('hf:', 'help');
+  if ErrorMsg <> '' then
+  begin
+    ShowException(Exception.Create(ErrorMsg));
+    Terminate;
+    Exit;
+  end;
+
+  // parse parameters
+  if (ParamCount = 0) or HasOption('h', 'help') then
+  begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+
+  FFontFile.LoadFromFile(self.GetOptionValue('f'));
+  DumpGlyphIndex;
+
+  s := 'Hello, World!';
+  Writeln('');
+  lst := GetGlyphIndices(s);
+  Writeln(Format('%d Glyph indices for: "%s"', [lst.Count, s]));
+  for i := 0 to lst.Count-1 do
+    Writeln(Format(#9'%s'#9'%s', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)]));
+
+  // stop program loop
+  Terminate;
+end;
+
+constructor TMyApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException := True;
+  FFontFile := TTFFileInfo.Create;
+end;
+
+destructor TMyApplication.Destroy;
+begin
+  FFontFile.Free;
+  inherited Destroy;
+end;
+
+procedure TMyApplication.WriteHelp;
+begin
+  writeln('Usage: ', ExeName, ' -h');
+  writeln('   -h            Show this help.');
+  writeln('   -f <ttf>      Load TTF font file.');
+end;
+
+var
+  Application: TMyApplication;
+
+begin
+  Application := TMyApplication.Create(nil);
+  Application.Title := 'TTF Font Dump';
+  Application.Run;
+  Application.Free;
+end.
+

rtl/nativent/Makefile.fpc

@@ -120,6 +120,9 @@ objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) buildrtl$(PPUEXT)
         $(COMPILER) $(INC)/macpas.pp $(REDIR)
 
+extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(INC)/extpas.pp
+
 buildrtl$(PPUEXT): buildrtl.pp system$(PPUEXT) objpas$(PPUEXT)
         $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(OBJPASDIR)/classes -Fu$(PROCINC) -I$(OBJPASDIR) -Fi$(DDKINC) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl
 

rtl/nativent/sysutils.pp

@@ -1192,17 +1192,39 @@ begin
 end;
 
 
-function ExecuteProcess(const Path: AnsiString; const ComLine: AnsiString;
+function ExecuteProcess(const Path: RawByteString; const ComLine: RawByteString;
   Flags: TExecuteFlags = []): Integer;
 begin
   { TODO : implement }
   Result := 0;
 end;
 
-function ExecuteProcess(const Path: AnsiString;
-  const ComLine: Array of AnsiString; Flags:TExecuteFlags = []): Integer;
+function ExecuteProcess(const Path: RawByteString;
+  const ComLine: Array of RawByteString; Flags:TExecuteFlags = []): Integer;
 var
-  CommandLine: AnsiString;
+  CommandLine: RawByteString;
+  I: integer;
+begin
+  Commandline := '';
+  for I := 0 to High (ComLine) do
+   if Pos (' ', ComLine [I]) <> 0 then
+    CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+   else
+    CommandLine := CommandLine + ' ' + Comline [I];
+  ExecuteProcess := ExecuteProcess (Path, CommandLine,Flags);
+end;
+
+function ExecuteProcess(const Path: UnicodeString; const ComLine: UnicodeString;
+  Flags: TExecuteFlags = []): Integer;
+begin
+  { TODO : implement }
+  Result := 0;
+end;
+
+function ExecuteProcess(const Path: UnicodeString;
+  const ComLine: Array of UnicodeString; Flags:TExecuteFlags = []): Integer;
+var
+  CommandLine: UnicodeString;
   I: integer;
 begin
   Commandline := '';