File Coverage

blib/lib/PDF/API2/Resource/Font/SynFont.pm
Criterion Covered Total %
statement 21 141 14.8
branch 0 46 0.0
condition 0 70 0.0
subroutine 7 8 87.5
pod 1 1 100.0
total 29 266 10.9


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::Font::SynFont;
2              
3 1     1   1049 use base 'PDF::API2::Resource::Font';
  1         2  
  1         109  
4              
5 1     1   9 use strict;
  1         3  
  1         22  
6 1     1   5 use warnings;
  1         2  
  1         40  
7              
8             our $VERSION = '2.044'; # VERSION
9              
10 1     1   6 use Math::Trig;
  1         3  
  1         232  
11 1     1   9 use Unicode::UCD 'charinfo';
  1         3  
  1         116  
12              
13 1     1   7 use PDF::API2::Util;
  1         3  
  1         134  
14 1     1   9 use PDF::API2::Basic::PDF::Utils;
  1         3  
  1         1763  
15              
16             =head1 NAME
17              
18             PDF::API2::Resource::Font::SynFont - Module for creating synthetic Fonts.
19              
20             =head1 SYNOPSIS
21              
22             my $pdf = PDF::API2->new();
23             my $base_font = $pdf->font('Helvetica');
24              
25             # Create a condensed synthetic font
26             my $condensed = $pdf->synthetic_font($base_font, hscale => 80);
27              
28             # Compare the two fonts
29             my $text = $pdf->page->text();
30              
31             $text->font($base_font, 18);
32             $text->distance(72, 720);
33             $text->text('Hello World!');
34              
35             $text->font($condensed, 18);
36             $text->distance(0, -36);
37             $text->text('Hello World!');
38              
39             $pdf->save('sample.pdf');
40              
41             =head1 DESCRIPTION
42              
43             This module allows you to create a custom font based on an existing font,
44             adjusting the scale, stroke thickness, angle, and other properties of each
45             glyph.
46              
47             =head1 FONT OPTIONS
48              
49             =head2 hscale
50              
51             A percentage to condense (less than 100) or expand (greater than 100) the glyphs
52             horizontally.
53              
54             =head2 angle
55              
56             A number of degrees to lean the glyphs to the left (negative angle) or to the
57             right (positive angle).
58              
59             =head2 bold
60              
61             A stroke width, in thousandths of a text unit, to add to the glyph's outline,
62             creating a bold effect.
63              
64             =head2 smallcaps
65              
66             Set to true to replace lower-case characters with small versions of their
67             upper-case glyphs.
68              
69             =head2 space
70              
71             Additional space, in thousandths of a text unit, to add between glyphs.
72              
73             =cut
74              
75             sub new {
76 0     0 1   my ($class, $pdf, $font, %opts) = @_;
77 0           my $first = 1;
78 0           my $last = 255;
79              
80             # Deprecated options
81 0 0         if (exists $opts{'-bold'}) {
82 0   0       $opts{'bold'} //= (delete $opts{'-bold'}) * 10;
83             }
84 0 0         if (exists $opts{'-caps'}) {
85 0   0       $opts{'smallcaps'} //= delete $opts{'-caps'};
86             }
87 0 0         if (exists $opts{'-oblique'}) {
88 0   0       $opts{'angle'} //= delete $opts{'-oblique'};
89             }
90 0 0         if (exists $opts{'-slant'}) {
91 0   0       $opts{'hscale'} //= (delete $opts{'-slant'}) * 100;
92             }
93 0 0         if (exists $opts{'-space'}) {
94 0   0       $opts{'space'} //= delete $opts{'-space'};
95             }
96              
97 0   0       my $angle = $opts{'angle'} // 0;
98 0   0       my $bold = ($opts{'bold'} // 0);
99 0   0       my $hscale = ($opts{'hscale'} // 100) / 100;
100 0   0       my $space = $opts{'space'} // 0;
101              
102 0 0         $font->encodeByName($opts{'-encode'}) if $opts{'-encode'};
103              
104 0 0         $class = ref($class) if ref($class);
105 0   0       my $key = $opts{'name'} // 'Syn' . $font->name() . pdfkey();
106 0           my $self = $class->SUPER::new($pdf, $key);
107 0 0         $pdf->new_obj($self) unless $self->is_obj($pdf);
108 0           $self->{' font'} = $font;
109 0           $self->{' data'} = {
110             'type' => 'Type3',
111             'ascender' => $font->ascender(),
112             'capheight' => $font->capheight(),
113             'descender' => $font->descender(),
114             'iscore' => '0',
115             'isfixedpitch' => $font->isfixedpitch(),
116             'italicangle' => $font->italicangle() + $angle,
117             'missingwidth' => $font->missingwidth() * $hscale,
118             'underlineposition' => $font->underlineposition(),
119             'underlinethickness' => $font->underlinethickness(),
120             'xheight' => $font->xheight(),
121             'firstchar' => $first,
122             'lastchar' => $last,
123             'char' => [ '.notdef' ],
124             'uni' => [ 0 ],
125             'u2e' => { 0 => 0 },
126             'fontbbox' => '',
127             'wx' => { 'space' => '600' },
128             };
129              
130 0           my $data = $self->data();
131 0 0         if (ref($font->fontbbox())) {
132 0           $data->{'fontbbox'} = [ @{$font->fontbbox()} ];
  0            
133             }
134             else {
135 0           $data->{'fontbbox'} = [ $font->fontbbox() ];
136             }
137 0           $data->{'fontbbox'}->[0] *= $hscale;
138 0           $data->{'fontbbox'}->[2] *= $hscale;
139              
140 0           $self->{'Subtype'} = PDFName('Type3');
141 0           $self->{'FirstChar'} = PDFNum($first);
142 0           $self->{'LastChar'} = PDFNum($last);
143 0           $self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } (0.001, 0, 0, 0.001, 0, 0));
  0            
144 0           $self->{'FontBBox'} = PDFArray(map { PDFNum($_) } $self->fontbbox());
  0            
145              
146 0           my $procs = PDFDict();
147 0           $pdf->new_obj($procs);
148 0           $self->{'CharProcs'} = $procs;
149              
150 0           $self->{'Resources'} = PDFDict();
151 0           $self->{'Resources'}->{'ProcSet'} = PDFArray(map { PDFName($_) }
  0            
152             qw(PDF Text ImageB ImageC ImageI));
153 0           my $xo = PDFDict();
154 0           $self->{'Resources'}->{'Font'} = $xo;
155 0           $self->{'Resources'}->{'Font'}->{'FSN'} = $font;
156 0           foreach my $w ($first .. $last) {
157 0           $data->{'char'}->[$w] = $font->glyphByEnc($w);
158 0           $data->{'uni'}->[$w] = uniByName($data->{'char'}->[$w]);
159 0 0         if (defined $data->{'uni'}->[$w]) {
160 0           $data->{'u2e'}->{$data->{'uni'}->[$w]} = $w;
161             }
162             }
163              
164 0 0         if ($font->isa('PDF::API2::Resource::CIDFont')) {
165 0           $self->{'Encoding'} = PDFDict();
166 0           $self->{'Encoding'}->{'Type'} = PDFName('Encoding');
167 0           $self->{'Encoding'}->{'Differences'} = PDFArray();
168 0           foreach my $w ($first .. $last) {
169 0           my $char = $data->{'char'}->[$w];
170 0 0 0       if (defined $char and $char ne '.notdef') {
171 0           $self->{'Encoding'}->{'Differences'}->add_elements(PDFNum($w),
172             PDFName($char));
173             }
174             }
175             }
176             else {
177 0           $self->{'Encoding'} = $font->{'Encoding'};
178             }
179              
180 0           my @widths;
181 0           foreach my $w ($first .. $last) {
182 0 0         if ($data->{'char'}->[$w] eq '.notdef') {
183 0           push @widths, $self->missingwidth();
184 0           next;
185             }
186 0           my $char = PDFDict();
187              
188 0           my $uni = $data->{'uni'}->[$w];
189 0           my $wth = int($font->width(chr($uni)) * 1000 * $hscale + 2 * $space);
190              
191 0           $procs->{$font->glyphByEnc($w)} = $char;
192             #$char->{'Filter'} = PDFArray(PDFName('FlateDecode'));
193 0           $char->{' stream'} = $wth . ' 0 ' . join(' ', map { int($_) } $self->fontbbox()) . " d1\n";
  0            
194 0           $char->{' stream'} .= "BT\n";
195 0 0         if ($angle) {
196 0           my @matrix = (1, 0, tan(deg2rad($angle)), 1, 0, 0);
197 0           $char->{' stream'} .= join(' ', @matrix) . " Tm\n";
198             }
199 0 0         $char->{' stream'} .= "2 Tr " . $bold . " w\n" if $bold;
200 0           my $ci = {};
201 0 0         if ($data->{'uni'}->[$w] ne '') {
202 0           $ci = charinfo($data->{'uni'}->[$w]);
203             }
204 0 0 0       if ($opts{'smallcaps'} and $ci->{'upper'}) {
205 0           $char->{' stream'} .= "/FSN 800 Tf\n";
206 0           $char->{' stream'} .= ($hscale * 110) . " Tz\n";
207 0 0         $char->{' stream'} .= " [ -$space ] TJ\n" if $space;
208 0           $wth = int($font->width(uc chr($uni)) * 800 * $hscale * 1.1 + 2 * $space);
209 0           $char->{' stream'} .= $font->text(uc chr($uni));
210             }
211             else {
212 0           $char->{' stream'} .= "/FSN 1000 Tf\n";
213 0 0         $char->{' stream'} .= ($hscale * 100) . " Tz\n" if $hscale != 1;
214 0 0         $char->{' stream'} .= " [ -$space ] TJ\n" if $space;
215 0           $char->{' stream'} .= $font->text(chr($uni));
216             }
217 0           $char->{' stream'} .= " Tj\nET\n";
218 0           push @widths, $wth;
219 0           $data->{'wx'}->{$font->glyphByEnc($w)} = $wth;
220 0           $pdf->new_obj($char);
221             }
222              
223 0   0       $procs->{'.notdef'} = $procs->{$font->data->{'char'}->[32] // 0};
224 0           $self->{'Widths'} = PDFArray(map { PDFNum($_) } @widths);
  0            
225 0           $data->{'e2n'} = $data->{'char'};
226 0           $data->{'e2u'} = $data->{'uni'};
227              
228 0           $data->{'u2c'} = {};
229 0           $data->{'u2e'} = {};
230 0           $data->{'u2n'} = {};
231 0           $data->{'n2c'} = {};
232 0           $data->{'n2e'} = {};
233 0           $data->{'n2u'} = {};
234              
235 0           foreach my $n (reverse 0 .. 255) {
236 0   0       $data->{'n2c'}->{$data->{'char'}->[$n] // '.notdef'} //= $n;
      0        
237 0   0       $data->{'n2e'}->{$data->{'e2n'}->[$n] // '.notdef'} //= $n;
      0        
238              
239 0   0       $data->{'n2u'}->{$data->{'e2n'}->[$n] // '.notdef'} //= $data->{'e2u'}->[$n];
      0        
240 0   0       $data->{'n2u'}->{$data->{'char'}->[$n] // '.notdef'} //= $data->{'uni'}->[$n];
      0        
241              
242 0 0         if (defined $data->{'uni'}->[$n]) {
243 0   0       $data->{'u2c'}->{$data->{'uni'}->[$n]} //= $n;
244             }
245 0 0         if (defined $data->{'e2u'}->[$n]) {
246 0   0       $data->{'u2e'}->{$data->{'e2u'}->[$n]} //= $n;
247              
248 0   0       my $value = ($data->{'e2n'}->[$n] // '.notdef');
249 0   0       $data->{'u2n'}->{$data->{'e2u'}->[$n]} //= $value;
250             }
251 0 0         if (defined $data->{'uni'}->[$n]) {
252 0   0       my $value = ($data->{'char'}->[$n] // '.notdef');
253 0   0       $data->{'u2n'}->{$data->{'uni'}->[$n]} //= $value;
254             }
255             }
256              
257 0           return $self;
258             }
259              
260             1;