File Coverage

blib/lib/PDF/Builder/Resource/Font/SynFont.pm
Criterion Covered Total %
statement 21 150 14.0
branch 0 66 0.0
condition 0 39 0.0
subroutine 7 8 87.5
pod 1 1 100.0
total 29 264 10.9


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