File Coverage

blib/lib/PDF/Builder/Resource/Font/SynFont.pm
Criterion Covered Total %
statement 21 196 10.7
branch 0 94 0.0
condition 0 109 0.0
subroutine 7 8 87.5
pod 1 1 100.0
total 29 408 7.1


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::Font::SynFont;
2              
3 1     1   907 use base 'PDF::Builder::Resource::Font';
  1         2  
  1         89  
4              
5 1     1   6 use strict;
  1         2  
  1         18  
6 1     1   5 use warnings;
  1         2  
  1         42  
7              
8             our $VERSION = '3.024'; # VERSION
9             our $LAST_UPDATE = '3.024'; # manually update whenever code is changed
10              
11 1     1   6 use Math::Trig; # CAUTION: deg2rad(0) = deg2rad(360) = 0!
  1         1  
  1         190  
12 1     1   7 use Unicode::UCD 'charinfo';
  1         2  
  1         71  
13              
14 1     1   5 use PDF::Builder::Util;
  1         2  
  1         138  
15 1     1   8 use PDF::Builder::Basic::PDF::Utils;
  1         1  
  1         1899  
16              
17             # for noncompatible options, consider '-entry_point' = 'synfont' or
18             # 'synthetic_font' to be picked up and processed correctly per entry point
19            
20             =head1 NAME
21              
22             PDF::Builder::Resource::Font::SynFont - Module for creating temporary synthetic Fonts.
23              
24             =head1 SYNOPSIS
25              
26             This module permits you to create a "new" font (loaded temporarily, but not
27             permanently stored) based on an existing font, where you can modify certain
28             attributes in the original font, such as:
29              
30             * slant/obliqueness
31             * extra weight/boldness (by drawing glyph outlines at various line
32             thicknesses, rather than just filling enclosed areas)
33             * condense/expand (narrower or wider characters)
34             * extra space between characters
35             * small caps (synthesized, not using any provided with a font)
36             * change the encoding
37              
38             $pdf = PDF::Builder->new();
39             $cft = $pdf->font('Times-Roman'); # corefont, ttfont, etc. also works
40             $sft = $pdf->synfont($cft, 'condense' => .75); # condense by 25%
41              
42             This works for I, I, and I; but does not
43             work for I or I.
44             See also L.
45              
46             B C
47              
48             This is for compatibility with recent changes to PDF::API2.
49              
50             =head1 METHODS
51              
52             =over
53              
54             =item $font = PDF::Builder::Resource::Font::SynFont->new($pdf, $fontobj, %opts)
55              
56             Returns a synfont object. C<$fontobj> is a normal font object read in from
57             a file, and C<$font> is the modified output.
58              
59             Valid options %opts are:
60              
61             =over
62              
63             =item I
64              
65             Changes the encoding of the font from its default.
66             See I for the supported values. B only single byte
67             encodings are supported. Multibyte encodings such as UTF-8 are invalid.
68              
69             =item I
70              
71             Changes the reference-name of the font from its default.
72             The reference-name is normally generated automatically and can be
73             retrieved via $pdfname=$font->name().
74              
75             B C (for PDF::API2 compatibility)
76              
77             =item I
78              
79             Condense/expand factor (0.1-0.9 = condense, 1 = normal, 1.1+ = expand).
80             It's the multiplier for character widths vs. normal.
81              
82             B C and C (for PDF::API2 compatibility)
83              
84             The I option is a deprecated name in both PDF::Builder and PDF::API2.
85             Its value is the same as I value (1 = normal, unchanged scale).
86             For the I option, the value is percentage (%), with 100 being normal,
87             and other values 100 times the I value.
88             B
89              
90             =item I
91              
92             Italic angle (+/-) in degrees, where the character box is skewed. While
93             it's unlikely that anyone will want to slant characters at +/-360 degrees, they
94             should be aware that these will be treated as an angle of 0 degrees (deg2rad()
95             wraps around). 0 degrees of italic slant (obliqueness) is the default.
96              
97             B C (for PDF::API2 compatibility)
98              
99             B
100              
101             =item I
102              
103             Embolding factor (0.1+, bold=1, heavy=2, ...). It is additional outline
104             B (B), which expands the character (glyph) outwards (as
105             well as shrinking unfilled enclosed areas such as bowls and counters).
106             Normally, the glyph's outline is not drawn (it is only filled); this adds
107             a thick outline. The units are in 1/100ths of a text unit.
108              
109             If used with the C alternate entry name, the unit is 1/1000th
110             of a text unit, so you will need a value 10 times larger than with the
111             C entry to get the same effect
112              
113             =item I
114              
115             Additional charspacing in thousandths of an em.
116              
117             =item I
118              
119             Create synthetic small-caps. 0 = no, 1 = yes. These are capitals of
120             lowercase letters, at 80% height and 88% width. Note that this is guaranteed
121             to cover ASCII lowercase letters only -- single byte encoded accented
122             characters I work, but we can make no promises on accented characters
123             in general, as well as ligatures!
124              
125             B C (for PDF::API2 compatibility)
126              
127             B
128              
129             =back
130              
131             =back
132              
133             =cut
134              
135             sub new {
136 0     0 1   my ($class, $pdf, $font, %opts) = @_;
137             # copy dashed named options to preferred undashed names
138 0 0 0       if (defined $opts{'-encode'} && !defined $opts{'encode'}) { $opts{'encode'} = delete($opts{'-encode'}); }
  0            
139 0 0 0       if (defined $opts{'-pdfname'} && !defined $opts{'pdfname'}) { $opts{'pdfname'} = delete($opts{'-pdfname'}); }
  0            
140 0 0 0       if (defined $opts{'-name'} && !defined $opts{'name'}) { $opts{'name'} = delete($opts{'-name'}); }
  0            
141 0 0 0       if (defined $opts{'-condense'} && !defined $opts{'condense'}) { $opts{'condense'} = delete($opts{'-condense'}); }
  0            
142 0 0 0       if (defined $opts{'-slant'} && !defined $opts{'slant'}) { $opts{'slant'} = delete($opts{'-slant'}); }
  0            
143 0 0 0       if (defined $opts{'-hscale'} && !defined $opts{'hscale'}) { $opts{'hscale'} = delete($opts{'-hscale'}); }
  0            
144 0 0 0       if (defined $opts{'-oblique'} && !defined $opts{'oblique'}) { $opts{'oblique'} = delete($opts{'-oblique'}); }
  0            
145 0 0 0       if (defined $opts{'-angle'} && !defined $opts{'angle'}) { $opts{'angle'} = delete($opts{'-angle'}); }
  0            
146 0 0 0       if (defined $opts{'-bold'} && !defined $opts{'bold'}) { $opts{'bold'} = delete($opts{'-bold'}); }
  0            
147 0 0 0       if (defined $opts{'-space'} && !defined $opts{'space'}) { $opts{'space'} = delete($opts{'-space'}); }
  0            
148 0 0 0       if (defined $opts{'-caps'} && !defined $opts{'caps'}) { $opts{'caps'} = delete($opts{'-caps'}); }
  0            
149 0 0 0       if (defined $opts{'-smallcaps'} && !defined $opts{'smallcaps'}) { $opts{'smallcaps'} = delete($opts{'-smallcaps'}); }
  0            
150              
151 0           my $entry = "synfont"; # synfont or synthetic_font
152 0 0         if (defined $opts{'-entry_point'}) { $entry = $opts{'-entry_point'}; }
  0            
153              
154             # deal with simple aliases
155 0 0 0       if (defined $opts{'slant'} && !defined $opts{'condense'}) { $opts{'condense'} = delete($opts{'slant'}); }
  0            
156 0 0 0       if (defined $opts{'angle'} && !defined $opts{'oblique'}) { $opts{'oblique'} = delete($opts{'angle'}); }
  0            
157 0 0 0       if (defined $opts{'smallcaps'} && !defined $opts{'caps'}) { $opts{'caps'} = delete($opts{'smallcaps'}); }
  0            
158 0 0 0       if (defined $opts{'name'} && !defined $opts{'pdfname'}) { $opts{'pdfname'} = delete($opts{'name'}); }
  0            
159             # deal with semi-aliases
160 0 0 0       if (defined $opts{'hscale'} && !defined $opts{'condense'}) { $opts{'condense'} = delete($opts{'hscale'})/100; }
  0            
161             # deal with entry point differences
162 0 0 0       if (defined $opts{'bold'} && $entry eq 'synthetic_font') { $opts{'bold'} /= 10; }
  0            
163              
164 0           my ($self);
165 0           my $first = 1;
166 0           my $last = 255;
167 0   0       my $cond = $opts{'condense'} || 1;
168 0   0       my $oblique = $opts{'oblique'} || 0;
169 0   0       my $space = $opts{'space'} || '0';
170 0   0       my $bold = ($opts{'bold'} || 0)*10; # convert to em
171             # caps
172              
173             # 5 elements apparently not used anywhere
174             #$self->{' cond'} = $cond;
175             #$self->{' oblique'} = $oblique;
176             #$self->{' bold'} = $bold;
177             #$self->{' boldmove'} = 0.001;
178             #$self->{' space'} = $space;
179             # only available in TT fonts. besides, multibyte encodings not supported
180 0 0         if (defined $opts{'encode'}) {
181 0 0         if ($opts{'encode'} =~ m/^utf/i) {
182 0           die "Invalid multibyte encoding for synfont: $opts{'encode'}\n";
183             # TBD probably more multibyte encodings to check
184             }
185 0           $font->encodeByName($opts{'encode'});
186             }
187              
188 0 0         $class = ref $class if ref $class;
189             $self = $class->SUPER::new($pdf,
190             # pdfkey()
191             # .('+' . $font->name())
192             # .($opts{'caps'} ? '+Caps' : '')
193             # .($opts{'pdfname'} ? '+'.$opts{'pdfname'} : '')
194 0 0         $opts{'pdfname'}? $opts{'pdfname'}: 'Syn' . $font->name() . pdfkey()
195             );
196 0 0         $pdf->new_obj($self) unless $self->is_obj($pdf);
197 0           $self->{' font'} = $font;
198 0   0       $self->{' data'} = {
199             'type' => 'Type3',
200             'ascender' => $font->ascender(),
201             'capheight' => $font->capheight(),
202             'descender' => $font->descender(),
203             'iscore' => '0',
204             'isfixedpitch' => $font->isfixedpitch(),
205             'italicangle' => $font->italicangle() + $oblique,
206             'missingwidth' => ($font->missingwidth()||300) * $cond,
207             'underlineposition' => $font->underlineposition(),
208             'underlinethickness' => $font->underlinethickness(),
209             'xheight' => $font->xheight(),
210             'firstchar' => $first,
211             'lastchar' => $last,
212             'char' => [ '.notdef' ],
213             'uni' => [ 0 ],
214             'u2e' => { 0 => 0 },
215             'fontbbox' => '',
216             'wx' => { 'space' => '600' },
217             };
218              
219 0           my $data = $self->data();
220 0 0         if (ref($font->fontbbox())) {
221 0           $data->{'fontbbox'} = [ @{$font->fontbbox()} ];
  0            
222             } else {
223 0           $data->{'fontbbox'} = [ $font->fontbbox() ];
224             }
225 0           $data->{'fontbbox'}->[0] *= $cond;
226 0           $data->{'fontbbox'}->[2] *= $cond;
227              
228 0           $self->{'Subtype'} = PDFName('Type3');
229 0           $self->{'FirstChar'} = PDFNum($first);
230 0           $self->{'LastChar'} = PDFNum($last);
231 0           $self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } (0.001, 0, 0, 0.001, 0, 0));
  0            
232 0           $self->{'FontBBox'} = PDFArray(map { PDFNum($_) } $self->fontbbox());
  0            
233              
234 0           my $procs = PDFDict();
235 0           $pdf->new_obj($procs);
236 0           $self->{'CharProcs'} = $procs;
237              
238 0           $self->{'Resources'} = PDFDict();
239 0           $self->{'Resources'}->{'ProcSet'} = PDFArray(map { PDFName($_) }
  0            
240             qw(PDF Text ImageB ImageC ImageI));
241 0           my $xo = PDFDict();
242 0           $self->{'Resources'}->{'Font'} = $xo;
243 0           $self->{'Resources'}->{'Font'}->{'FSN'} = $font;
244 0           foreach my $w ($first .. $last) {
245 0           $data->{'char'}->[$w] = $font->glyphByEnc($w);
246             # possible non-standard name... use $w as Unicode value
247 0   0       $data->{'uni'}->[$w] = (uniByName($data->{'char'}->[$w])) || $w;
248 0 0         if (defined $data->{'uni'}->[$w]) {
249 0           $data->{'u2e'}->{$data->{'uni'}->[$w]} = $w;
250             }
251             }
252              
253 0 0         if ($font->isa('PDF::Builder::Resource::CIDFont')) {
254 0           $self->{'Encoding'} = PDFDict();
255 0           $self->{'Encoding'}->{'Type'} = PDFName('Encoding');
256 0           $self->{'Encoding'}->{'Differences'} = PDFArray();
257 0           foreach my $w ($first .. $last) {
258 0           my $char = $data->{'char'}->[$w];
259 0 0 0       if (defined $char && $char ne '.notdef') {
260 0           $self->{'Encoding'}->{'Differences'}->add_elements(PDFNum($w),
261             PDFName($char));
262             }
263             }
264             } else {
265 0           $self->{'Encoding'} = $font->{'Encoding'};
266             }
267              
268 0           my @widths;
269 0           foreach my $w ($first .. $last) {
270             # $w is the "standard encoding" (similar to Windows-1252) PDF
271             # single byte encoding. first 32 .notdef, 255 = U+00FF ydieresis
272 0 0         if ($data->{'char'}->[$w] eq '.notdef') {
273 0           push @widths, $self->missingwidth();
274 0           next;
275             }
276 0           my $char = PDFDict();
277              
278             #my $wth = int($font->width(chr($w)) * 1000 * $cond + 2 * $space);
279 0           my $uni = $data->{'uni'}->[$w];
280 0           my $wth = int($font->width(chr($uni)) * 1000 * $cond + 2*$space);
281              
282 0           $procs->{$font->glyphByEnc($w)} = $char;
283             #$char->{'Filter'} = PDFArray(PDFName('FlateDecode'));
284 0           $char->{' stream'} = $wth." 0 ".join(' ',map { int($_) } $self->fontbbox())." d1\n";
  0            
285 0           $char->{' stream'} .= "BT\n";
286 0 0         $char->{' stream'} .= join(' ', (1, 0, tan(deg2rad($oblique)), 1, 0, 0))." Tm\n" if $oblique;
287 0 0         $char->{' stream'} .= "2 Tr $bold w\n" if $bold;
288             #my $ci = charinfo($data->{'uni'}->[$w]);
289 0           my $ci = {};
290 0 0         if ($data->{'uni'}->[$w] ne '') {
291 0           $ci = charinfo($data->{'uni'}->[$w]);
292             }
293            
294             # Small Caps
295             #
296             # Most Unicode characters simply don't appear in the synthetic
297             # font, which is limited to 255 "standard" encoding points. encode
298             # still will be single byte.
299             #
300             # SynFont seems to have trouble with some accented characters, even
301             # though 'upper' is correct and they are in the standard encoding,
302             # particularly if the string is decoded to UTF-8. Keep in mind that
303             # synfont() only creates a 255 character "standard" encoding font, so
304             # you need to apply it to each "plane" of the original font.
305             #
306             # Some single characters (eszett within the standard encoding, long s
307             # outside it) don't have 'upper' defined and are left as-is (or
308             # skipped entirely, if outside the encoding) unless first replaced by
309             # ASCII lowercase ('ss' and 's' respectively). While we're at it,
310             # replace certain Unicode ligatures with ASCII equivalents so they
311             # will be small-capped correctly instead of ignored. Don't forget to
312             # set proper width for multi-letter replacements.
313             #
314 0           my $hasUpper = 0; # if no small caps, still need to output something
315 0 0         if ($opts{'caps'}) {
316             # not all characters have an 'upper' equivalent code point. Some
317             # have U+0000 (dummy entry).
318 0           my $ch;
319 0           my $multiChar = 0;
320 0 0 0       $hasUpper = 1 if defined $ci->{'upper'} && $ci->{'upper'};
321            
322 0 0         if ($hasUpper) {
323             # standard upper case character and width spec'd by font
324 0           $ch = $self->encByUni(hex($ci->{'upper'}));
325 0           $wth = int($font->width(chr($ch)) * 800 * $cond * 1.1 + 2* $space);
326             }
327             # let's handle some special cases where !$hasUpper
328             # ($hasUpper set to 1)
329             # only characters to be substituted here, unless there is something
330             # in other encodings to deal with
331             # TBD it does not seem to be possible on non-base planes (plane 1+)
332             # to access ASCII letters to build a substitute for ligatures
333             # (e.g., replace U+FB01 fi ligature with F+I)
334 0 0         if ($uni == 0xDF) { # eszett (German sharp s)
    0          
    0          
335 0           $hasUpper = 1;
336 0           $multiChar = 1;
337             # actually, some fonts have a U+1E9E uppercase Eszett, but
338             # since that won't be in any single byte encoding, we use SS
339 0           $wth = 2*(int($font->width('S') * 800 * $cond*1.1 + 2*$space));
340 0           $ch = $font->text('S').$font->text('S');
341             } elsif ($uni == 0x0131) { # dotless i
342             # standard encoding doesn't see Unicode point
343 0           $hasUpper = 1;
344 0           $multiChar = 1;
345 0           $wth = int($font->width('I') * 800 * $cond*1.1 + 2*$space);
346 0           $ch = $font->text('I');
347             } elsif ($uni == 0x0237) { # dotless j
348             # standard encoding doesn't see Unicode point
349 0           $hasUpper = 1;
350 0           $multiChar = 1;
351 0           $wth = int($font->width('J') * 800 * $cond*1.1 + 2*$space);
352 0           $ch = $font->text('J');
353             }
354              
355 0 0         if ($hasUpper) {
356             # this is a lowercase letter, etc. that has an uppercase version
357             # 80% height x 88% (110% aspect ratio @ 80% font size) width.
358             # slightly wider to thicken stems and make look better.
359             # $ch and $wth already set, either default or special case
360 0           $char->{' stream'} .= "/FSN 800 Tf\n";
361 0           $char->{' stream'} .= ($cond * 110)." Tz\n";
362 0 0         $char->{' stream'} .= " [ -$space ] TJ\n" if $space;
363 0 0         if ($multiChar) {
364 0           $ch =~ s/>
365 0           $ch =~ s/\)\(//g;
366 0           $char->{' stream'} .= "$ch";
367             } else {
368 0           $char->{' stream'} .= $font->text(chr($ch));
369             }
370             # uc chr($uni) supposed to be always equivalent to
371             # chr hex($ci->{'upper'}), according to "futuramedium"
372             # HOWEVER, uc doesn't seem to know what to do with non-ASCII chars
373             #$wth = int($font->width(uc chr($uni)) * 800 * $cond * 1.1 + 2* $space);
374             #$char->{' stream'} .= $font->text(uc chr($uni));
375             #$wth = int($font->width(chr(hex($ci->{'upper'}))) * 800 * $cond * 1.1 + 2* $space);
376             #$char->{' stream'} .= $font->text(chr(hex($ci->{'upper'})));
377             } # else fall through to standard handling below
378             } # small caps requested
379              
380 0 0         if (!$hasUpper) {
381             # Applies to all not small-caps too!
382             # does not have an uppercase ('upper') equivalent, so
383             # output at standard height and aspect ratio
384 0           $char->{' stream'} .= "/FSN 1000 Tf\n";
385 0 0         $char->{' stream'} .= ($cond * 100)." Tz\n" if $cond != 1;
386 0 0         $char->{' stream'} .= " [ -$space ] TJ\n" if $space;
387             #$char->{' stream'} .= $font->text(chr($w));
388 0           $char->{' stream'} .= $font->text(chr($uni));
389             }
390              
391             # finale... all modifications to font have been done
392 0           $char->{' stream'} .= " Tj\nET ";
393 0           push @widths, $wth;
394 0           $data->{'wx'}->{$font->glyphByEnc($w)} = $wth;
395 0           $pdf->new_obj($char);
396             } # loop through 255 standard encoding points
397              
398             # the array as 0 elements at this point! 'space' (among others) IS defined,
399             # so copy that, but TBD what kind of fallback if no such element exists?
400             # $procs->{'.notdef'} = $procs->{$font->data()->{'char'}->[32]};
401 0           $procs->{'.notdef'} = $procs->{'space'};
402              
403 0           $self->{'Widths'} = PDFArray(map { PDFNum($_) } @widths);
  0            
404 0           $data->{'e2n'} = $data->{'char'};
405 0           $data->{'e2u'} = $data->{'uni'};
406              
407 0           $data->{'u2c'} = {};
408 0           $data->{'u2e'} = {};
409 0           $data->{'u2n'} = {};
410 0           $data->{'n2c'} = {};
411 0           $data->{'n2e'} = {};
412 0           $data->{'n2u'} = {};
413              
414 0           foreach my $n (reverse 0 .. 255) {
415 0   0       $data->{'n2c'}->{$data->{'char'}->[$n] // '.notdef'} //= $n;
      0        
416 0   0       $data->{'n2e'}->{$data->{'e2n'}->[$n] // '.notdef'} //= $n;
      0        
417              
418 0   0       $data->{'n2u'}->{$data->{'e2n'}->[$n] // '.notdef'} //= $data->{'e2u'}->[$n];
      0        
419 0   0       $data->{'n2u'}->{$data->{'char'}->[$n] // '.notdef'} //= $data->{'uni'}->[$n];
      0        
420              
421 0 0         if (defined $data->{'uni'}->[$n]) {
422 0   0       $data->{'u2c'}->{$data->{'uni'}->[$n]} //= $n
423             }
424 0 0         if (defined $data->{'e2u'}->[$n]) {
425 0   0       $data->{'u2e'}->{$data->{'e2u'}->[$n]} //= $n;
426 0   0       my $value = $data->{'e2n'}->[$n] // '.notdef';
427 0   0       $data->{'u2n'}->{$data->{'e2u'}->[$n]} //= $value;
428             }
429 0 0         if (defined $data->{'uni'}->[$n]) {
430 0   0       my $value = $data->{'char'}->[$n] // '.notdef';
431 0   0       $data->{'u2n'}->{$data->{'uni'}->[$n]} //= $value;
432             }
433             }
434              
435 0           return $self;
436             }
437              
438             1;