line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::API2::Resource::Font::BdFont; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1049
|
use base 'PDF::API2::Resource::Font'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
112
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
24
|
|
6
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
55
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '2.044'; # VERSION |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
6
|
use PDF::API2::Util; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
173
|
|
11
|
1
|
|
|
1
|
|
9
|
use PDF::API2::Basic::PDF::Utils; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2225
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $BmpNum = 0; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 NAME |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
PDF::API2::Resource::Font::BdFont - Module for using bitmapped Fonts. |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# |
22
|
|
|
|
|
|
|
use PDF::API2; |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
$pdf = PDF::API2->new; |
25
|
|
|
|
|
|
|
$sft = $pdf->bdfont($file); |
26
|
|
|
|
|
|
|
# |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 METHODS |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=over 4 |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=cut |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=item $font = PDF::API2::Resource::Font::BdFont->new $pdf, $font, %options |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Returns a BmpFont object. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=cut |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=pod |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Valid %options are: |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
I<-encode> |
45
|
|
|
|
|
|
|
... changes the encoding of the font from its default. |
46
|
|
|
|
|
|
|
See I for the supported values. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
I<-pdfname> ... changes the reference-name of the font from its default. |
49
|
|
|
|
|
|
|
The reference-name is normally generated automatically and can be |
50
|
|
|
|
|
|
|
retrieved via $pdfname=$font->name. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub new { |
55
|
0
|
|
|
0
|
1
|
|
my ($class, $pdf, $file, %opts) = @_; |
56
|
|
|
|
|
|
|
|
57
|
0
|
0
|
|
|
|
|
$class = ref($class) if ref($class); |
58
|
0
|
|
|
|
|
|
my $name = sprintf('%s+Bdf%02i', pdfkey(), ++$BmpNum) . '~' . time(); |
59
|
0
|
|
|
|
|
|
my $self = $class->SUPER::new($pdf, $name); |
60
|
0
|
0
|
|
|
|
|
$pdf->new_obj($self) unless $self->is_obj($pdf); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Adobe Bitmap Distribution Font |
63
|
0
|
|
|
|
|
|
$self->{' data'} = $self->readBDF($file); |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
my $first = 1; |
66
|
0
|
|
|
|
|
|
my $last = 255; |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
$self->{'Subtype'} = PDFName('Type3'); |
69
|
0
|
|
|
|
|
|
$self->{'FirstChar'} = PDFNum($first); |
70
|
0
|
|
|
|
|
|
$self->{'LastChar'} = PDFNum($last); |
71
|
0
|
|
|
|
|
|
$self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } 0.001, 0, 0, 0.001, 0, 0); |
|
0
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
$self->{'FontBBox'} = PDFArray(map { PDFNum($_) } $self->fontbbox()); |
|
0
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
my $xo = PDFDict(); |
75
|
0
|
|
|
|
|
|
$self->{'Encoding'} = $xo; |
76
|
0
|
|
|
|
|
|
$xo->{'Type'} = PDFName('Encoding'); |
77
|
0
|
|
|
|
|
|
$xo->{'BaseEncoding'} = PDFName('WinAnsiEncoding'); |
78
|
|
|
|
|
|
|
$xo->{'Differences'} = PDFArray(PDFNum('0'), |
79
|
0
|
|
0
|
|
|
|
map { PDFName($_ or '.notdef') } |
80
|
0
|
|
|
|
|
|
@{$self->data->{'char'}}); |
|
0
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
my $procs = PDFDict(); |
83
|
0
|
|
|
|
|
|
$pdf->new_obj($procs); |
84
|
0
|
|
|
|
|
|
$self->{'CharProcs'} = $procs; |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
|
$self->{'Resources'} = PDFDict(); |
87
|
0
|
|
|
|
|
|
$self->{'Resources'}->{'ProcSet'} = PDFArray(map { PDFName($_) } |
|
0
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
qw(PDF Text ImageB ImageC ImageI)); |
89
|
0
|
|
|
|
|
|
foreach my $w ($first .. $last) { |
90
|
0
|
|
|
|
|
|
$self->data->{'uni'}->[$w] = uniByName($self->data->{'char'}->[$w]); |
91
|
0
|
|
|
|
|
|
$self->data->{'u2e'}->{$self->data->{'uni'}->[$w]} = $w; |
92
|
|
|
|
|
|
|
} |
93
|
0
|
|
|
|
|
|
my @widths; |
94
|
0
|
|
|
|
|
|
foreach my $w (@{$self->data->{'char2'}}) { |
|
0
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
$widths[$w->{'ENCODING'}] = $self->data->{'wx'}->{$w->{'NAME'}}; |
96
|
0
|
|
|
|
|
|
my @bbx = @{$w->{'BBX'}}; |
|
0
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
my $stream = pack('H*', $w->{'hex'}); |
98
|
0
|
|
|
|
|
|
my $y = $bbx[1]; |
99
|
0
|
|
|
|
|
|
my $char = PDFDict(); |
100
|
0
|
|
|
|
|
|
$char->{'Filter'} = PDFArray(PDFName('FlateDecode')); |
101
|
|
|
|
|
|
|
# $char->{' stream'} = $widths[$w->{'ENCODING'}] . ' 0 ' . join(' ', map { int($_) } $self->fontbbox()) . " d1\n"; |
102
|
0
|
|
|
|
|
|
$char->{' stream'} = $widths[$w->{'ENCODING'}] . " 0 d0\n"; |
103
|
|
|
|
|
|
|
$char->{'Comment'} = PDFStr(join(' ', |
104
|
|
|
|
|
|
|
"N='" . $w->{'NAME'} . "'", |
105
|
0
|
|
|
|
|
|
"C=(" . $w->{'ENCODING'} . ")")); |
106
|
0
|
|
|
|
|
|
$procs->{$w->{'NAME'}} = $char; |
107
|
0
|
|
|
|
|
|
@bbx = map { $_ * 1000 / $self->data->{'upm'} } @bbx; |
|
0
|
|
|
|
|
|
|
108
|
0
|
0
|
|
|
|
|
if ($y == 0) { |
109
|
0
|
|
|
|
|
|
$char->{' stream'} .= "q Q\n"; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
else { |
112
|
0
|
|
|
|
|
|
my $x = 8 * length($stream) / $y; # q $x 0 0 $y 50 50 cm |
113
|
0
|
|
|
|
|
|
my $dict = join('', |
114
|
|
|
|
|
|
|
"/Interpolate true", |
115
|
|
|
|
|
|
|
"/Mask[0 0.1]", |
116
|
|
|
|
|
|
|
"/Decode[1 0]", |
117
|
|
|
|
|
|
|
"/H $y", |
118
|
|
|
|
|
|
|
"/W $x", |
119
|
|
|
|
|
|
|
"/BPC 1", |
120
|
|
|
|
|
|
|
"/CS /G"); |
121
|
0
|
|
|
|
|
|
my $img = qq|BI\n$dict\nID $stream\nEI\n|; |
122
|
0
|
|
|
|
|
|
$procs->{$self->data->{'char'}->[$w]} = $char; |
123
|
0
|
|
|
|
|
|
$char->{' stream'} .= "$bbx[0] 0 0 $bbx[1] $bbx[2] $bbx[3] cm\n"; |
124
|
0
|
|
|
|
|
|
$char->{' stream'} .= $img . "\n"; |
125
|
|
|
|
|
|
|
} |
126
|
0
|
|
|
|
|
|
$pdf->new_obj($char); |
127
|
|
|
|
|
|
|
} |
128
|
0
|
|
|
|
|
|
$procs->{'.notdef'} = $procs->{$self->data->{'char'}->[32]}; |
129
|
0
|
|
|
|
|
|
delete $procs->{''}; |
130
|
0
|
|
0
|
|
|
|
$self->{'Widths'} = PDFArray(map { PDFNum($widths[$_] or 0) } |
|
0
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
$first .. $last); |
132
|
0
|
|
|
|
|
|
$self->data->{'e2n'} = $self->data->{'char'}; |
133
|
0
|
|
|
|
|
|
$self->data->{'e2u'} = $self->data->{'uni'}; |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
$self->data->{'u2c'} = {}; |
136
|
0
|
|
|
|
|
|
$self->data->{'u2e'} = {}; |
137
|
0
|
|
|
|
|
|
$self->data->{'u2n'} = {}; |
138
|
0
|
|
|
|
|
|
$self->data->{'n2c'} = {}; |
139
|
0
|
|
|
|
|
|
$self->data->{'n2e'} = {}; |
140
|
0
|
|
|
|
|
|
$self->data->{'n2u'} = {}; |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my $data = $self->data(); |
143
|
0
|
|
|
|
|
|
foreach my $n (reverse 0 .. 255) { |
144
|
0
|
|
0
|
|
|
|
$data->{'n2c'}->{$data->{'char'}->[$n] or '.notdef'} //= $n; |
|
|
|
0
|
|
|
|
|
145
|
0
|
|
0
|
|
|
|
$data->{'n2e'}->{$data->{'e2n'}->[$n] or '.notdef'} //= $n; |
|
|
|
0
|
|
|
|
|
146
|
|
|
|
|
|
|
|
147
|
0
|
|
0
|
|
|
|
$data->{'n2u'}->{$data->{'e2n'}->[$n] or '.notdef'} //= $data->{'e2u'}->[$n]; |
|
|
|
0
|
|
|
|
|
148
|
0
|
|
0
|
|
|
|
$data->{'n2u'}->{$data->{'char'}->[$n] or '.notdef'} //= $data->{'uni'}->[$n]; |
|
|
|
0
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
0
|
|
0
|
|
|
|
$data->{'u2c'}->{$data->{'uni'}->[$n]} //= $n; |
151
|
0
|
|
0
|
|
|
|
$data->{'u2e'}->{$data->{'e2u'}->[$n]} //= $n; |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
0
|
|
|
|
$data->{'u2n'}->{$data->{'e2u'}->[$n]} //= ($data->{'e2n'}->[$n] or '.notdef'); |
|
|
|
0
|
|
|
|
|
154
|
0
|
|
0
|
|
|
|
$data->{'u2n'}->{$data->{'uni'}->[$n]} //= ($data->{char}->[$n] or '.notdef'); |
|
|
|
0
|
|
|
|
|
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
0
|
|
|
|
|
|
return $self; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub readBDF { |
161
|
0
|
|
|
0
|
0
|
|
my ($self, $file) = @_; |
162
|
0
|
|
|
|
|
|
my $data = {}; |
163
|
0
|
|
|
|
|
|
$data->{'char'} = []; |
164
|
0
|
|
|
|
|
|
$data->{'char2'} = []; |
165
|
0
|
|
|
|
|
|
$data->{'wx'} = {}; |
166
|
|
|
|
|
|
|
|
167
|
0
|
0
|
|
|
|
|
die "file='$file' doesn't exist" unless -e $file; |
168
|
0
|
0
|
|
|
|
|
open(my $afmf, '<', $file) or die "Can't find the BDF file for $file"; |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
|
local $/ = "\n"; # ensure correct $INPUT_RECORD_SEPARATOR |
171
|
0
|
|
|
|
|
|
local $_ = undef; |
172
|
0
|
|
|
|
|
|
while ($_ = <$afmf>) { |
173
|
0
|
|
|
|
|
|
chomp($_); |
174
|
0
|
0
|
|
|
|
|
if (/^STARTCHAR/ .. /^ENDCHAR/) { |
175
|
0
|
0
|
|
|
|
|
if (/^STARTCHAR\s+(\S+)/) { |
|
|
0
|
|
|
|
|
|
176
|
0
|
|
|
|
|
|
my $name = $1; |
177
|
0
|
|
|
|
|
|
$name =~ s/^(\d+.*)$/X_$1/; |
178
|
0
|
|
|
|
|
|
push @{$data->{'char2'}}, { 'NAME' => $name }; |
|
0
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
elsif (/^BITMAP/ .. /^ENDCHAR/) { |
181
|
0
|
0
|
|
|
|
|
next if /^BITMAP/; |
182
|
0
|
0
|
|
|
|
|
if (/^ENDCHAR/) { |
183
|
0
|
|
0
|
|
|
|
$data->{'char2'}->[-1]->{'NAME'} ||= 'E_' . $data->{'char2'}->[-1]->{'ENCODING'}; |
184
|
0
|
|
|
|
|
|
$data->{'char'}->[$data->{'char2'}->[-1]->{'ENCODING'}] = $data->{'char2'}->[-1]->{'NAME'}; |
185
|
0
|
|
|
|
|
|
($data->{'wx'}->{$data->{'char2'}->[-1]->{'NAME'}}) = split(/\s+/, $data->{'char2'}->[-1]->{'SWIDTH'}); |
186
|
0
|
|
|
|
|
|
$data->{'char2'}->[-1]->{'BBX'} = [split(/\s+/, $data->{'char2'}->[-1]->{'BBX'})]; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
else { |
189
|
0
|
|
|
|
|
|
$data->{'char2'}->[-1]->{'hex'} .= $_; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
else { |
193
|
0
|
|
|
|
|
|
m/^(\S+)\s+(.+)$/; |
194
|
0
|
|
|
|
|
|
$data->{'char2'}->[-1]->{uc($1)} .= $2; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
# } elsif (/^STARTPROPERTIES/ .. /^ENDPROPERTIES/) { |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
else { |
199
|
0
|
|
|
|
|
|
m/^(\S+)\s+(.+)$/; |
200
|
0
|
|
|
|
|
|
$data->{uc($1)} .= $2; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
|
close($afmf); |
204
|
0
|
0
|
|
|
|
|
unless (exists $data->{'wx'}->{'.notdef'}) { |
205
|
0
|
|
|
|
|
|
$data->{'wx'}->{'.notdef'} = 0; |
206
|
0
|
|
|
|
|
|
$data->{'bbox'}{'.notdef'} = [0, 0, 0, 0]; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
$data->{'fontname'} = pdfkey() . pdfkey() . '~' . time(); |
210
|
0
|
|
|
|
|
|
$data->{'apiname'} = $data->{'fontname'}; |
211
|
0
|
|
|
|
|
|
$data->{'flags'} = 34; |
212
|
0
|
|
|
|
|
|
$data->{'fontbbox'} = [ split(/\s+/, $data->{'FONTBOUNDINGBOX'}) ]; |
213
|
|
|
|
|
|
|
$data->{'upm'} = ($data->{'PIXEL_SIZE'} |
214
|
0
|
|
0
|
|
|
|
or ($data->{'fontbbox'}->[1] - $data->{'fontbbox'}->[3])); |
215
|
0
|
|
|
|
|
|
@{$data->{'fontbbox'}} = (map { int($_ * 1000 / $data->{'upm'}) } |
|
0
|
|
|
|
|
|
|
216
|
0
|
|
|
|
|
|
@{$data->{'fontbbox'}}); |
|
0
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
0
|
|
|
|
|
|
foreach my $n (0 .. 255) { |
219
|
0
|
|
0
|
|
|
|
$data->{'char'}->[$n] ||= '.notdef'; |
220
|
|
|
|
|
|
|
# $data->{'wx'}->{$data->{'char'}->[$n]} |
221
|
|
|
|
|
|
|
# = int($data->{'wx'}->{$data->{'char'}->[$n]} * 1000 / $data->{'upm'}); |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
0
|
|
0
|
|
|
|
$data->{'uni'} ||= []; |
225
|
0
|
|
|
|
|
|
foreach my $n (0 .. 255) { |
226
|
0
|
|
0
|
|
|
|
$data->{'uni'}->[$n] = uniByName($data->{'char'}->[$n] or '.notdef') || 0; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
$data->{'ascender'} = $data->{'RAW_ASCENT'} |
229
|
0
|
|
0
|
|
|
|
|| int($data->{'FONT_ASCENT'} * 1000 / $data->{'upm'}); |
230
|
|
|
|
|
|
|
$data->{'descender'} = $data->{'RAW_DESCENT'} |
231
|
0
|
|
0
|
|
|
|
|| int($data->{'FONT_DESCENT'} * 1000 / $data->{'upm'}); |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
$data->{'type'} = 'Type3'; |
234
|
0
|
|
|
|
|
|
$data->{'capheight'} = 1000; |
235
|
0
|
|
|
|
|
|
$data->{'iscore'} = 0; |
236
|
0
|
|
|
|
|
|
$data->{'issymbol'} = 0; |
237
|
0
|
|
|
|
|
|
$data->{'isfixedpitch'} = 0; |
238
|
0
|
|
|
|
|
|
$data->{'italicangle'} = 0; |
239
|
|
|
|
|
|
|
$data->{'missingwidth'} = $data->{'AVERAGE_WIDTH'} |
240
|
|
|
|
|
|
|
|| int($data->{'FONT_AVERAGE_WIDTH'} * 1000 / $data->{'upm'}) |
241
|
0
|
|
0
|
|
|
|
|| $data->{'RAW_AVERAGE_WIDTH'} |
242
|
|
|
|
|
|
|
|| 500; |
243
|
0
|
|
|
|
|
|
$data->{'underlineposition'} = -200; |
244
|
0
|
|
|
|
|
|
$data->{'underlinethickness'} = 10; |
245
|
|
|
|
|
|
|
$data->{'xheight'} = $data->{'RAW_XHEIGHT'} |
246
|
|
|
|
|
|
|
|| int($data->{'FONT_XHEIGHT'} * 1000 / $data->{'upm'}) |
247
|
0
|
|
0
|
|
|
|
|| int($data->{'ascender'} / 2); |
248
|
0
|
|
|
|
|
|
$data->{'firstchar'} = 1; |
249
|
0
|
|
|
|
|
|
$data->{'lastchar'} = 255; |
250
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
|
delete $data->{'wx'}->{''}; |
252
|
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
|
return $data; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=back |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=cut |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
1; |