* Merging revisions 48694,48696,48697 from trunk:

    ------------------------------------------------------------------------
    r48694 | michael | 2021-02-17 14:26:18 +0100 (Wed, 17 Feb 2021) | 1 line
    
    * Fix from Joellin to correctly read monospace fonts
    ------------------------------------------------------------------------
    r48696 | michael | 2021-02-17 14:32:03 +0100 (Wed, 17 Feb 2021) | 1 line
    
    * Fix issue ID 35251 (patch from Rumen Gyurov)
    ------------------------------------------------------------------------
    r48697 | michael | 2021-02-17 14:35:48 +0100 (Wed, 17 Feb 2021) | 1 line
    
    * Example for monospace fonts and subsetting
    ------------------------------------------------------------------------


git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@48698 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 82 insertions, 9 deletions

diff --git a/packages/fcl-pdf/examples/monospacetext.pp b/packages/fcl-pdf/examples/monospacetext.pp
new file mode 100644
index 0000000000..af3d5190e2
--- /dev/null
+++ b/packages/fcl-pdf/examples/monospacetext.pp
@@ -0,0 +1,56 @@
+program monospacetext;
+
+{$mode objfpc}{$H+}
+{$codepage UTF8}
+
+uses
+  Classes, SysUtils,
+  fpPDF;
+
+var
+  PDF: TPDFDocument;
+  Font1, Font2, Font3, Font4: integer;
+begin
+  if ParamCount<1 then
+    begin
+    Writeln(stderr,'Usage : monospacetext <fontdir>');
+    Writeln(stderr,'Needed fonts : cour.ttf, arial.ttf, verdanab.ttf consola.ttf');
+    Halt(1);
+    end;
+  PDF := TPDFDocument.Create(nil);
+  PDF.Infos.Producer := '';
+  PDF.Infos.CreationDate := Now;
+  PDF.Options := [poPageOriginAtTop, {poNoEmbeddedFonts,} poSubsetFont, poCompressFonts, poCompressImages];
+  PDF.DefaultOrientation := ppoPortrait;
+  PDF.DefaultPaperType := ptA4;
+  PDF.DefaultUnitOfMeasure := uomMillimeters;
+  PDF.FontDirectory := paramstr(1);
+  PDF.StartDocument;
+  PDF.Sections.AddSection;
+  PDF.Sections[0].AddPage(PDF.Pages.AddPage);;
+
+  //FontIndex := PDF.AddFont('Courier');
+  Font1 := PDF.AddFont('cour.ttf', 'Courier New');
+  Font2 := PDF.AddFont('arial.ttf', 'Arial');
+  Font3 := PDF.AddFont('verdanab.ttf', 'Verdana');
+  Font4 := PDF.AddFont('consola.ttf', 'Consolas');
+  PDF.Pages[0].SetFont(Font1, 10);
+  PDF.Pages[0].WriteText(10,10,'AEIOU-ÁÉÍÓÚ-ČŠŇŽ');
+  PDF.Pages[0].WriteText(10,15,'----------------');
+
+  PDF.Pages[0].SetFont(Font2, 10);
+  PDF.Pages[0].WriteText(10,30,'AEIOU-ÁÉÍÓÚ-ČŠŇŽ');
+  PDF.Pages[0].WriteText(10,35,'----------------');
+
+  PDF.Pages[0].SetFont(Font3, 10);
+  PDF.Pages[0].WriteText(10,40,'AEIOU-ÁÉÍÓÚ-ČŠŇŽ');
+  PDF.Pages[0].WriteText(10,45,'----------------');
+
+  PDF.Pages[0].SetFont(Font4, 10);
+  PDF.Pages[0].WriteText(10,50,'AEIOU-ÁÉÍÓÚ-ČŠŇŽ');
+  PDF.Pages[0].WriteText(10,55,'----------------');
+
+  PDF.SaveToFile('test.pdf');
+  PDF.Free;
+end.
+
diff --git a/packages/fcl-pdf/src/fpparsettf.pp b/packages/fcl-pdf/src/fpparsettf.pp
index fc7c243b5c..9dc055fca4 100644
--- a/packages/fcl-pdf/src/fpparsettf.pp
+++ b/packages/fcl-pdf/src/fpparsettf.pp
@@ -822,13 +822,13 @@ begin
   if embed and not Embeddable then
     raise ETTF.Create(rsFontEmbeddingNotAllowed);
   PrepareEncoding(Encoding);
-//  MissingWidth:=ToNatural(Widths[Chars[CharCodes^[32]]].AdvanceWidth);  // Char(32) - Space character
-  FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // Char(32) - Space character
+//  MissingWidth:=ToNatural(GetAdvanceWidth(Chars[CharCodes^[32]]));  // Char(32) - Space character
+  FMissingWidth := GetAdvanceWidth(Chars[CharCodes^[32]]);  // Char(32) - Space character
   for I:=0 to 255 do
   begin
     if (CharCodes^[i]>=0) and (CharCodes^[i]<=High(Chars))
-    and (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then
-      CharWidth[I]:= ToNatural(Widths[Chars[CharCodes^[I]]].AdvanceWidth)
+    and (GetAdvanceWidth(Chars[CharCodes^[i]])> 0) and (CharNames^[i]<> '.notdef') then
+      CharWidth[I]:= ToNatural(GetAdvanceWidth(Chars[CharCodes^[I]]))
     else
       CharWidth[I]:= FMissingWidth;
   end;
@@ -930,8 +930,19 @@ begin
 end;
 
 function TTFFileInfo.GetAdvanceWidth(AIndex: word): word;
-begin
-  Result := Widths[AIndex].AdvanceWidth;
+var
+  i: SizeInt;
+begin
+  // There may be more glyphs than elements in the array, in which
+  // case the last entry is to be used.
+  // https://docs.microsoft.com/en-us/typography/opentype/spec/hmtx
+  i := Length(Widths);
+  if AIndex >= i then
+    Dec(i)
+  else
+    i := AIndex;
+
+  Result := Widths[i].AdvanceWidth;
 end;
 
 function TTFFileInfo.ItalicAngle: single;
@@ -972,7 +983,7 @@ function TTFFileInfo.GetMissingWidth: integer;
 begin
   if FMissingWidth = 0 then
   begin
-    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // 32 is in reference to the Space character
+    FMissingWidth := GetAdvanceWidth(Chars[CharCodes^[32]]);  // 32 is in reference to the Space character
   end;
   Result := FMissingWidth;
 end;
diff --git a/packages/fcl-pdf/src/fpttfsubsetter.pp b/packages/fcl-pdf/src/fpttfsubsetter.pp
index df8976c36a..f290a3992d 100644
--- a/packages/fcl-pdf/src/fpttfsubsetter.pp
+++ b/packages/fcl-pdf/src/fpttfsubsetter.pp
@@ -940,12 +940,18 @@ end;
 function TFontSubsetter.buildHmtxTable: TStream;
 var
   n: integer;
+  GID: longint;
+  LastGID: longint;
 begin
   Result := TMemoryStream.Create;
+  LastGID := Length(FFontInfo.Widths)-1;
   for n := 0 to FGlyphIDs.Count-1 do
   begin
-    WriteUInt16(Result, FFontInfo.Widths[FGlyphIDs[n].GID].AdvanceWidth);
-    WriteInt16(Result, FFontInfo.Widths[FGlyphIDs[n].GID].LSB);
+    GID := FGlyphIDs[n].GID;
+    if GID > LastGID then
+      GID := LastGID;
+    WriteUInt16(Result, FFontInfo.Widths[GID].AdvanceWidth);
+    WriteInt16(Result, FFontInfo.Widths[GID].LSB);
   end;
 end;