From 26cf743c7487077057454159c23916ce3626cd67 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 17 Feb 2021 16:35:56 +0000 Subject: * 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 --- packages/fcl-pdf/examples/monospacetext.pp | 56 ++++++++++++++++++++++++++++++ packages/fcl-pdf/src/fpparsettf.pp | 25 +++++++++---- packages/fcl-pdf/src/fpttfsubsetter.pp | 10 ++++-- 3 files changed, 82 insertions(+), 9 deletions(-) create mode 100644 packages/fcl-pdf/examples/monospacetext.pp 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 '); + 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; -- cgit v1.2.1