line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::Builder::Resource::Font::Postscript; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1964
|
use base 'PDF::Builder::Resource::Font'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
158
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
26
|
|
6
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
55
|
|
7
|
|
|
|
|
|
|
#no warnings qw[ deprecated recursion uninitialized ]; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '3.023'; # VERSION |
10
|
|
|
|
|
|
|
our $LAST_UPDATE = '3.021'; # manually update whenever code is changed |
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
6
|
use Encode qw(:all); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
307
|
|
13
|
1
|
|
|
1
|
|
9
|
use IO::File qw(); |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
31
|
|
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
6
|
use PDF::Builder::Util; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
150
|
|
16
|
1
|
|
|
1
|
|
9
|
use PDF::Builder::Basic::PDF::Utils; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4151
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
PDF::Builder::Resource::Font::Postscript - support routines for using PostScript fonts. Inherits from L |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=cut |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub new { |
25
|
0
|
|
|
0
|
1
|
|
my ($class, $pdf, $psfile, %opts) = @_; |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
|
my ($self); |
28
|
|
|
|
|
|
|
my ($data); |
29
|
0
|
|
0
|
|
|
|
$opts{'-encode'} ||= 'asis'; # provide default encoding |
30
|
|
|
|
|
|
|
|
31
|
0
|
0
|
|
|
|
|
if (defined $opts{'-afmfile'}) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
$data = $class->readAFM($opts{'-afmfile'}); |
33
|
|
|
|
|
|
|
} elsif (defined $opts{'-pfmfile'}) { |
34
|
0
|
|
|
|
|
|
$data = $class->readPFM($opts{'-pfmfile'}); |
35
|
|
|
|
|
|
|
} elsif (defined $opts{'-xfmfile'}) { |
36
|
0
|
|
|
|
|
|
$data = $class->readXFM($opts{'-xfmfile'}); |
37
|
|
|
|
|
|
|
} else { |
38
|
0
|
|
|
|
|
|
die "No proper font-metrics file specified for PostScript file '$psfile'."; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
0
|
0
|
|
|
|
|
$class = ref $class if ref $class; |
42
|
|
|
|
|
|
|
# $self = $class->SUPER::new($pdf, $data->{'apiname'}.pdfkey().'~'.time()); |
43
|
0
|
|
|
|
|
|
$self = $class->SUPER::new($pdf, $data->{'apiname'}.'PST1f'.pdfkey()); |
44
|
0
|
0
|
|
|
|
|
$pdf->new_obj($self) unless $self->is_obj($pdf); |
45
|
0
|
|
|
|
|
|
$self->{' data'} = $data; |
46
|
|
|
|
|
|
|
|
47
|
0
|
0
|
|
|
|
|
if ($opts{'-pdfname'}) { |
48
|
0
|
|
|
|
|
|
$self->name($opts{'-pdfname'}); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
|
|
|
$self->{'Subtype'} = PDFName("Type1"); |
52
|
0
|
|
|
|
|
|
$self->{'FontDescriptor'} = $self->descrByData(); |
53
|
0
|
0
|
|
|
|
|
if (-f $psfile) { |
54
|
|
|
|
|
|
|
# $self->{'BaseFont'} = PDFName(pdfkey().'+'.$self->fontname().'~'.time()); |
55
|
0
|
|
|
|
|
|
$self->{'BaseFont'} = PDFName(pdfkey().'+'.$self->fontname()); |
56
|
|
|
|
|
|
|
|
57
|
0
|
|
|
|
|
|
my ($l1,$l2,$l3, $stream) = $self->readPFAPFB($psfile); |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
my $s = PDFDict(); |
60
|
0
|
|
|
|
|
|
$self->{'FontDescriptor'}->{'FontFile'} = $s; |
61
|
0
|
|
|
|
|
|
$s->{'Length1'} = PDFNum($l1); |
62
|
0
|
|
|
|
|
|
$s->{'Length2'} = PDFNum($l2); |
63
|
0
|
|
|
|
|
|
$s->{'Length3'} = PDFNum($l3); |
64
|
0
|
|
|
|
|
|
$s->{'Filter'} = PDFArray(PDFName("FlateDecode")); |
65
|
0
|
|
|
|
|
|
$s->{' stream'} = $stream; |
66
|
0
|
0
|
|
|
|
|
if (defined $pdf) { |
67
|
0
|
|
|
|
|
|
$pdf->new_obj($s); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} else { |
70
|
0
|
|
|
|
|
|
$self->{'BaseFont'} = PDFName($self->fontname()); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
0
|
0
|
|
|
|
|
if ($opts{'-encode'} =~ m/^utf/i) { |
74
|
0
|
|
|
|
|
|
die "Invalid multibyte encoding for psfont: $opts{'-encode'}\n"; |
75
|
|
|
|
|
|
|
# probably more encodings to check |
76
|
|
|
|
|
|
|
} |
77
|
0
|
|
|
|
|
|
$self->encodeByData($opts{'-encode'}); |
78
|
|
|
|
|
|
|
|
79
|
0
|
0
|
|
|
|
|
$self->{'-nocomps'} = 1 if $opts{'-nocomps'}; |
80
|
0
|
0
|
|
|
|
|
$self->{'-dokern'} = 1 if $opts{'-dokern'}; |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
return $self; |
83
|
|
|
|
|
|
|
} # end of new() |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub readPFAPFB { |
86
|
0
|
|
|
0
|
0
|
|
my ($self, $file) = @_; |
87
|
0
|
|
|
|
|
|
my ($l1,$l2,$l3, $stream, $t1stream, @lines, $line, $head, $body, $tail); |
88
|
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
|
die "Cannot find PFA/PFB font file '$file' ..." unless -f $file; |
90
|
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
my $l = -s $file; |
92
|
|
|
|
|
|
|
|
93
|
0
|
0
|
|
|
|
|
open(my $inf, "<", $file) or die "$!: $file"; |
94
|
0
|
|
|
|
|
|
binmode($inf,':raw'); |
95
|
0
|
|
|
|
|
|
read($inf, $line, 2); |
96
|
0
|
|
|
|
|
|
@lines = unpack('C*', $line); |
97
|
0
|
0
|
0
|
|
|
|
if ($lines[0] == 0x80 && $lines[1] == 1) { |
|
|
0
|
|
|
|
|
|
98
|
0
|
|
|
|
|
|
read($inf, $line, 4); |
99
|
0
|
|
|
|
|
|
$l1 = unpack('V', $line); |
100
|
0
|
|
|
|
|
|
seek($inf, $l1, 1); |
101
|
0
|
|
|
|
|
|
read($inf, $line, 2); |
102
|
0
|
|
|
|
|
|
@lines = unpack('C*', $line); |
103
|
0
|
0
|
0
|
|
|
|
if ($lines[0] == 0x80 && $lines[1] == 2) { |
104
|
0
|
|
|
|
|
|
read($inf, $line, 4); |
105
|
0
|
|
|
|
|
|
$l2 = unpack('V', $line); |
106
|
|
|
|
|
|
|
} else { |
107
|
0
|
|
|
|
|
|
die "Corrupt PFB in file '$file' at marker='2'."; |
108
|
|
|
|
|
|
|
} |
109
|
0
|
|
|
|
|
|
seek($inf, $l2, 1); |
110
|
0
|
|
|
|
|
|
read($inf, $line, 2); |
111
|
0
|
|
|
|
|
|
@lines = unpack('C*', $line); |
112
|
0
|
0
|
0
|
|
|
|
if ($lines[0] == 0x80 && $lines[1] == 1) { |
113
|
0
|
|
|
|
|
|
read($inf, $line, 4); |
114
|
0
|
|
|
|
|
|
$l3 = unpack('V', $line); |
115
|
|
|
|
|
|
|
} else { |
116
|
0
|
|
|
|
|
|
die "Corrupt PFB in file '$file' at marker='3'."; |
117
|
|
|
|
|
|
|
} |
118
|
0
|
|
|
|
|
|
seek($inf, 0, 0); |
119
|
0
|
|
|
|
|
|
@lines = <$inf>; |
120
|
0
|
|
|
|
|
|
$stream = join('', @lines); |
121
|
0
|
|
|
|
|
|
$t1stream = substr($stream, 6, $l1); |
122
|
0
|
|
|
|
|
|
$t1stream .= substr($stream, 12+$l1, $l2); |
123
|
0
|
|
|
|
|
|
$t1stream .= substr($stream, 18+$l1+$l2, $l3); |
124
|
|
|
|
|
|
|
} elsif ($line eq '%!') { |
125
|
0
|
|
|
|
|
|
seek($inf, 0, 0); |
126
|
0
|
|
|
|
|
|
while ($line = <$inf>) { |
127
|
0
|
0
|
|
|
|
|
if (!$l1) { |
|
|
0
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
$head .= $line; |
129
|
0
|
0
|
|
|
|
|
if ($line=~/eexec$/) { |
130
|
0
|
|
|
|
|
|
chomp($head); |
131
|
0
|
|
|
|
|
|
$head .= "\x0d"; |
132
|
0
|
|
|
|
|
|
$l1 = length($head); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} elsif (!$l2) { |
135
|
0
|
0
|
|
|
|
|
if ($line =~ /^0+$/) { |
136
|
0
|
|
|
|
|
|
$l2 = length($body); |
137
|
0
|
|
|
|
|
|
$tail = $line; |
138
|
|
|
|
|
|
|
} else { |
139
|
0
|
|
|
|
|
|
chomp($line); |
140
|
0
|
|
|
|
|
|
$body .= pack('H*', $line); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
} else { |
143
|
0
|
|
|
|
|
|
$tail .= $line; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
0
|
|
|
|
|
|
$l3 = length($tail); |
147
|
0
|
|
|
|
|
|
$t1stream = "$head$body$tail"; |
148
|
|
|
|
|
|
|
} else { |
149
|
0
|
|
|
|
|
|
die "Unsupported font-format in file '$file' at marker='1'."; |
150
|
|
|
|
|
|
|
} |
151
|
0
|
|
|
|
|
|
close($inf); |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
return($l1,$l2,$l3, $t1stream); |
154
|
|
|
|
|
|
|
} # end of readPFAPFB() |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# $datahashref = $self->readAFM( $afmfile ); |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub readAFM { |
159
|
0
|
|
|
0
|
0
|
|
my ($self, $file) = @_; |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
|
my $data = {}; |
162
|
0
|
|
|
|
|
|
$data->{'wx'} = {}; |
163
|
0
|
|
|
|
|
|
$data->{'bbox'} = {}; |
164
|
0
|
|
|
|
|
|
$data->{'char'} = []; |
165
|
0
|
|
|
|
|
|
$data->{'firstchar'} = 255; |
166
|
0
|
|
|
|
|
|
$data->{'lastchar'} = 0; |
167
|
|
|
|
|
|
|
|
168
|
0
|
0
|
|
|
|
|
if (! -e $file) { |
169
|
0
|
|
|
|
|
|
die "File='$file' not found."; |
170
|
|
|
|
|
|
|
} |
171
|
0
|
0
|
|
|
|
|
open(my $afmf, "<", $file) or die "Can't find the AFM file for $file"; |
172
|
0
|
|
|
|
|
|
local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR |
173
|
0
|
|
|
|
|
|
while ($_ = <$afmf>) { |
174
|
0
|
0
|
|
|
|
|
if (/^StartCharMetrics/ .. /^EndCharMetrics/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# only lines that start with "C" or "CH" are parsed |
176
|
0
|
0
|
|
|
|
|
next unless $_ =~ /^CH?\s/; |
177
|
0
|
|
|
|
|
|
my ($ch) = $_ =~ /^CH?\s+(\d+)\s*;/; |
178
|
0
|
|
0
|
|
|
|
$ch = $ch || 0; |
179
|
0
|
|
|
|
|
|
my ($name) = $_ =~ /\bN\s+(\.?\w+)\s*;/; |
180
|
0
|
|
|
|
|
|
my ($wx) = $_ =~ /\bWX\s+(\d+)\s*;/; |
181
|
0
|
|
|
|
|
|
my ($bbox) = $_ =~ /\bB\s+([^;]+);/; |
182
|
0
|
|
|
|
|
|
$bbox =~ s/\s+$//; |
183
|
|
|
|
|
|
|
# Should also parse ligature data (format: L successor ligature) |
184
|
0
|
|
|
|
|
|
$data->{'avgwidth2'} += $wx ; |
185
|
0
|
0
|
0
|
|
|
|
$data->{'maxwidth'} = ($data->{'maxwidth'}||0) < $wx? $wx: $data->{'maxwidth'}||0; |
|
|
|
0
|
|
|
|
|
186
|
0
|
|
|
|
|
|
$data->{'wx'}->{$name} = $wx; |
187
|
0
|
|
|
|
|
|
$data->{'bbox'}->{$name} = [split(/\s+/,$bbox)]; |
188
|
0
|
0
|
|
|
|
|
if ($ch > 0) { |
189
|
0
|
|
|
|
|
|
$data->{'char'}->[$ch] = $name; |
190
|
|
|
|
|
|
|
} |
191
|
0
|
0
|
|
|
|
|
$data->{'lastchar'} = $data->{'lastchar'} < $ch? $ch: $data->{'lastchar'}; |
192
|
0
|
0
|
|
|
|
|
$data->{'firstchar'} = $data->{'firstchar'} > $ch? $ch: $data->{'firstchar'}; |
193
|
0
|
|
|
|
|
|
next; |
194
|
|
|
|
|
|
|
} elsif (/^StartKernData/ .. /^EndKernData/) { |
195
|
0
|
|
0
|
|
|
|
$data->{'kern'} ||= {}; |
196
|
0
|
0
|
|
|
|
|
if ($_ =~ m|^KPX\s+(\S+)\s+(\S+)\s+(\S+)\s*$|i) { |
197
|
0
|
|
|
|
|
|
$data->{'kern'}->{"$1:$2"} = $3; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
} elsif (/^StartComposites/ .. /^EndComposites/) { |
200
|
0
|
|
0
|
|
|
|
$data->{'comps'} ||= {}; |
201
|
0
|
0
|
|
|
|
|
if ($_ =~ m|^CC\s+(\S+)\s+(\S+)\s+;|i) { |
202
|
0
|
|
|
|
|
|
my ($name, $comp) = ($1, $2); |
203
|
0
|
|
|
|
|
|
my @cv = split(/;/, $_); |
204
|
0
|
|
|
|
|
|
shift @cv; |
205
|
0
|
|
|
|
|
|
my $rng = []; |
206
|
0
|
|
|
|
|
|
foreach (1..$comp) { |
207
|
0
|
|
|
|
|
|
my @c1 = split(/\s+/,shift @cv); |
208
|
0
|
|
|
|
|
|
push @{$rng}, $c1[1],$c1[2],$c1[3]; |
|
0
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
} |
210
|
0
|
|
|
|
|
|
$data->{'comps'}->{$name} = $rng; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
} |
213
|
0
|
0
|
|
|
|
|
last if $_ =~ /^EndFontMetrics/; |
214
|
0
|
0
|
|
|
|
|
if (/(^\w+)\s+(.*)/) { |
215
|
0
|
|
|
|
|
|
my($key, $val) = ($1, $2); |
216
|
0
|
|
|
|
|
|
$key = lc($key); |
217
|
0
|
0
|
|
|
|
|
if (defined $data->{$key}) { |
218
|
|
|
|
|
|
|
# $data->{$key} = [ $data->{$key} ] unless ref $data->{$key}; |
219
|
|
|
|
|
|
|
# push(@{$data->{$key}}, $val); |
220
|
|
|
|
|
|
|
} else { |
221
|
0
|
|
|
|
|
|
$val =~ s/[\x00\x1f]+//g; |
222
|
0
|
|
|
|
|
|
$data->{$key} = $val; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} else { |
225
|
|
|
|
|
|
|
## print STDERR "Can't parse: $_"; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
0
|
|
|
|
|
|
close($afmf); |
229
|
0
|
0
|
|
|
|
|
unless (exists $data->{'wx'}->{'.notdef'}) { |
230
|
0
|
|
|
|
|
|
$data->{'wx'}->{'.notdef'} = 0; |
231
|
0
|
|
|
|
|
|
$data->{'bbox'}{'.notdef'} = [0, 0, 0, 0]; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
$data->{'avgwidth2'} /= scalar keys %{$data->{'bbox'}} ; |
|
0
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
$data->{'avgwidth2'} = int($data->{'avgwidth2'}); |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
|
$data->{'fontname'} =~ s/[\x00-\x20]+//og; |
238
|
|
|
|
|
|
|
## $data->{'fontname'} =~ s/[^A-Za-z0-9]+//og; |
239
|
|
|
|
|
|
|
|
240
|
0
|
0
|
|
|
|
|
if (defined $data->{'fullname'}) { |
241
|
0
|
|
|
|
|
|
$data->{'altname'} = $data->{'fullname'}; |
242
|
|
|
|
|
|
|
} else { |
243
|
0
|
|
|
|
|
|
$data->{'altname'} = $data->{'familyname'}; |
244
|
0
|
0
|
|
|
|
|
$data->{'altname'} .= ' Italic' if $data->{'italicangle'} < 0; |
245
|
0
|
0
|
|
|
|
|
$data->{'altname'} .= ' Oblique' if $data->{'italicangle'} > 0; |
246
|
0
|
|
|
|
|
|
$data->{'altname'} .= ' '.$data->{'weight'}; |
247
|
|
|
|
|
|
|
} |
248
|
0
|
|
|
|
|
|
$data->{'apiname'} = $data->{'altname'}; |
249
|
0
|
|
|
|
|
|
$data->{'altname'} =~ s/[^A-Za-z0-9]+//og; |
250
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
|
$data->{'subname'} = $data->{'weight'}; |
252
|
0
|
0
|
|
|
|
|
$data->{'subname'} .= ' Italic' if $data->{'italicangle'} < 0; |
253
|
0
|
0
|
|
|
|
|
$data->{'subname'} .= ' Oblique' if $data->{'italicangle'} > 0; |
254
|
0
|
|
|
|
|
|
$data->{'subname'} =~ s/[^A-Za-z0-9]+//og; |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
0
|
|
|
|
$data->{'missingwidth'} ||= $data->{'avgwidth2'}; |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$data->{'issymbol'} = 0; |
259
|
0
|
|
|
|
|
|
$data->{'fontbbox'} = [ split(/\s+/,$data->{'fontbbox'}) ]; |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
|
$data->{'apiname'} = join('', map { ucfirst(lc(substr($_, 0, 2))) } split m/[^A-Za-z0-9\s]+/, $data->{'apiname'}); |
|
0
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
|
263
|
0
|
|
|
|
|
|
$data->{'flags'} = 34; |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
0
|
|
|
|
$data->{'uni'} ||= []; |
266
|
0
|
|
|
|
|
|
foreach my $n (0..255) { |
267
|
0
|
|
0
|
|
|
|
$data->{'uni'}->[$n] = uniByName($data->{'char'}->[$n] || '.notdef') || 0; |
268
|
|
|
|
|
|
|
} |
269
|
0
|
|
|
|
|
|
delete $data->{'bbox'}; |
270
|
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
return $data; |
272
|
|
|
|
|
|
|
} # end of readAFM() |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub readPFM { |
275
|
0
|
|
|
0
|
0
|
|
my ($self, $file) = @_; |
276
|
|
|
|
|
|
|
|
277
|
0
|
0
|
|
|
|
|
if (! -e $file) { |
278
|
0
|
|
|
|
|
|
die "pfmfile='$file' not found."; |
279
|
|
|
|
|
|
|
} |
280
|
0
|
|
|
|
|
|
my $fh = IO::File->new(); |
281
|
0
|
|
|
|
|
|
my $data = {}; |
282
|
|
|
|
|
|
|
|
283
|
0
|
|
|
|
|
|
$data->{'issymbol'} = 0; |
284
|
|
|
|
|
|
|
|
285
|
0
|
|
|
|
|
|
$data->{'wx'} = {}; |
286
|
0
|
|
|
|
|
|
$data->{'bbox'} = {}; |
287
|
0
|
|
|
|
|
|
$data->{'kern'} = {}; |
288
|
0
|
|
|
|
|
|
$data->{'char'} = []; |
289
|
|
|
|
|
|
|
|
290
|
0
|
|
|
|
|
|
my $buf; |
291
|
0
|
0
|
|
|
|
|
open($fh, "<", $file) || return; |
292
|
0
|
|
|
|
|
|
binmode($fh, ':raw'); |
293
|
0
|
|
|
|
|
|
read($fh, $buf, 117 + 30); |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
my %df; |
296
|
|
|
|
|
|
|
# Packing structure for PFM Header |
297
|
|
|
|
|
|
|
( $df{'Version'}, |
298
|
|
|
|
|
|
|
$df{'Size'}, |
299
|
|
|
|
|
|
|
$df{'Copyright'}, |
300
|
|
|
|
|
|
|
$df{'Type'}, |
301
|
|
|
|
|
|
|
$df{'Point'}, |
302
|
|
|
|
|
|
|
$df{'VertRes'}, |
303
|
|
|
|
|
|
|
$df{'HorizRes'}, |
304
|
|
|
|
|
|
|
$df{'Ascent'}, |
305
|
|
|
|
|
|
|
$df{'InternalLeading'}, |
306
|
|
|
|
|
|
|
$df{'ExternalLeading'}, |
307
|
|
|
|
|
|
|
$df{'Italic'}, |
308
|
|
|
|
|
|
|
$df{'Underline'}, |
309
|
|
|
|
|
|
|
$df{'StrikeOut'}, |
310
|
|
|
|
|
|
|
$df{'Weight'}, |
311
|
|
|
|
|
|
|
#define FW_DONTCARE 0 |
312
|
|
|
|
|
|
|
#define FW_THIN 100 |
313
|
|
|
|
|
|
|
#define FW_EXTRALIGHT 200 |
314
|
|
|
|
|
|
|
#define FW_ULTRALIGHT FW_EXTRALIGHT |
315
|
|
|
|
|
|
|
#define FW_LIGHT 300 |
316
|
|
|
|
|
|
|
#define FW_NORMAL 400 |
317
|
|
|
|
|
|
|
#define FW_REGULAR 400 |
318
|
|
|
|
|
|
|
#define FW_MEDIUM 500 |
319
|
|
|
|
|
|
|
#define FW_SEMIBOLD 600 |
320
|
|
|
|
|
|
|
#define FW_DEMIBOLD FW_SEMIBOLD |
321
|
|
|
|
|
|
|
#define FW_BOLD 700 |
322
|
|
|
|
|
|
|
#define FW_EXTRABOLD 800 |
323
|
|
|
|
|
|
|
#define FW_ULTRABOLD FW_EXTRABOLD |
324
|
|
|
|
|
|
|
#define FW_HEAVY 900 |
325
|
|
|
|
|
|
|
#define FW_BLACK FW_HEAVY |
326
|
|
|
|
|
|
|
$df{'CharSet'}, |
327
|
|
|
|
|
|
|
#define ANSI_CHARSET 0 |
328
|
|
|
|
|
|
|
#define DEFAULT_CHARSET 1 |
329
|
|
|
|
|
|
|
#define SYMBOL_CHARSET 2 |
330
|
|
|
|
|
|
|
#define SHIFTJIS_CHARSET 128 |
331
|
|
|
|
|
|
|
#define HANGEUL_CHARSET 129 |
332
|
|
|
|
|
|
|
#define HANGUL_CHARSET 129 |
333
|
|
|
|
|
|
|
#define GB2312_CHARSET 134 |
334
|
|
|
|
|
|
|
#define CHINESEBIG5_CHARSET 136 |
335
|
|
|
|
|
|
|
#define GREEK_CHARSET 161 |
336
|
|
|
|
|
|
|
#define TURKISH_CHARSET 162 |
337
|
|
|
|
|
|
|
#define HEBREW_CHARSET 177 |
338
|
|
|
|
|
|
|
#define ARABIC_CHARSET 178 |
339
|
|
|
|
|
|
|
#define BALTIC_CHARSET 186 |
340
|
|
|
|
|
|
|
#define RUSSIAN_CHARSET 204 |
341
|
|
|
|
|
|
|
#define THAI_CHARSET 222 |
342
|
|
|
|
|
|
|
#define EASTEUROPE_CHARSET 238 |
343
|
|
|
|
|
|
|
#define OEM_CHARSET 255 |
344
|
|
|
|
|
|
|
#define JOHAB_CHARSET 130 |
345
|
|
|
|
|
|
|
#define VIETNAMESE_CHARSET 163 |
346
|
|
|
|
|
|
|
#define MAC_CHARSET 77 |
347
|
|
|
|
|
|
|
#define BALTIC_CHARSET 186 |
348
|
|
|
|
|
|
|
#define JOHAB_CHARSET 130 |
349
|
|
|
|
|
|
|
#define VIETNAMESE_CHARSET 163 |
350
|
|
|
|
|
|
|
$df{'PixWidth'}, |
351
|
|
|
|
|
|
|
$df{'PixHeight'}, |
352
|
|
|
|
|
|
|
$df{'PitchAndFamily'}, |
353
|
|
|
|
|
|
|
#define DEFAULT_PITCH 0 |
354
|
|
|
|
|
|
|
#define FIXED_PITCH 1 |
355
|
|
|
|
|
|
|
#define VARIABLE_PITCH 2 |
356
|
|
|
|
|
|
|
#define MONO_FONT 8 |
357
|
|
|
|
|
|
|
#define FF_DECORATIVE 80 |
358
|
|
|
|
|
|
|
#define FF_DONTCARE 0 |
359
|
|
|
|
|
|
|
#define FF_MODERN 48 |
360
|
|
|
|
|
|
|
#define FF_ROMAN 16 |
361
|
|
|
|
|
|
|
#define FF_SCRIPT 64 |
362
|
|
|
|
|
|
|
#define FF_SWISS 32 |
363
|
|
|
|
|
|
|
$df{'AvgWidth'}, |
364
|
|
|
|
|
|
|
$df{'MaxWidth'}, |
365
|
|
|
|
|
|
|
$df{'FirstChar'}, |
366
|
|
|
|
|
|
|
$df{'LastChar'}, |
367
|
|
|
|
|
|
|
$df{'DefaultChar'}, |
368
|
|
|
|
|
|
|
$df{'BreakChar'}, |
369
|
|
|
|
|
|
|
$df{'WidthBytes'}, |
370
|
|
|
|
|
|
|
$df{'Device'}, |
371
|
|
|
|
|
|
|
$df{'Face'}, |
372
|
|
|
|
|
|
|
$df{'BitsPointer'}, |
373
|
|
|
|
|
|
|
$df{'BitsOffset'}, |
374
|
|
|
|
|
|
|
$df{'SizeFields'}, # Two bytes, the size of extension section |
375
|
|
|
|
|
|
|
$df{'ExtMetricsOffset'}, # Four bytes, offset value to the 'Extended Text Metrics' section |
376
|
|
|
|
|
|
|
$df{'ExtentTable'}, # Four bytes Offset value to the Extent Table |
377
|
|
|
|
|
|
|
$df{'OriginTable'}, # Four bytes 0 |
378
|
|
|
|
|
|
|
$df{'PairKernTable'}, # Four bytes 0 |
379
|
|
|
|
|
|
|
$df{'TrackKernTable'}, # Four bytes 0 |
380
|
|
|
|
|
|
|
$df{'DriverInfo'}, # Four bytes Offset value to the PostScript font name string |
381
|
0
|
|
|
|
|
|
$df{'Reserved'}, # Four bytes 0 |
382
|
|
|
|
|
|
|
) = unpack("vVa60vvvvvvvCCCvCvvCvvCCCCvVVVV vVVVVVVV",$buf); # PFM Header + Ext |
383
|
|
|
|
|
|
|
|
384
|
0
|
|
|
|
|
|
seek($fh, $df{Device}, 0); |
385
|
0
|
|
|
|
|
|
read($fh, $buf, 250); |
386
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
($df{'postScript'}) = unpack("Z*", $buf); |
388
|
0
|
|
|
|
|
|
$buf = substr($buf, length($df{'postScript'})+1, 250); |
389
|
0
|
|
|
|
|
|
($df{'windowsName'}) = unpack("Z*", $buf); |
390
|
0
|
|
|
|
|
|
$buf = substr($buf, length($df{'windowsName'})+1, 250); |
391
|
0
|
|
|
|
|
|
($df{'psName'}) = unpack("Z*", $buf); |
392
|
|
|
|
|
|
|
|
393
|
0
|
|
|
|
|
|
seek($fh, $df{'ExtMetricsOffset'}, 0); |
394
|
0
|
|
|
|
|
|
read($fh, $buf, 52); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
( $df{'etmSize'}, |
397
|
|
|
|
|
|
|
$df{'PointSize'}, |
398
|
|
|
|
|
|
|
$df{'Orientation'}, |
399
|
|
|
|
|
|
|
$df{'MasterHeight'}, |
400
|
|
|
|
|
|
|
$df{'MinScale'}, |
401
|
|
|
|
|
|
|
$df{'MaxScale'}, |
402
|
|
|
|
|
|
|
$df{'MasterUnits'}, |
403
|
|
|
|
|
|
|
$df{'CapHeight'}, |
404
|
|
|
|
|
|
|
$df{'xHeight'}, |
405
|
|
|
|
|
|
|
$df{'LowerCaseAscent'}, |
406
|
|
|
|
|
|
|
$df{'LowerCaseDescent'}, |
407
|
|
|
|
|
|
|
$df{'Slant'}, |
408
|
|
|
|
|
|
|
$df{'SuperScript'}, |
409
|
|
|
|
|
|
|
$df{'SubScript'}, |
410
|
|
|
|
|
|
|
$df{'SuperScriptSize'}, |
411
|
|
|
|
|
|
|
$df{'SubScriptSize'}, |
412
|
|
|
|
|
|
|
$df{'UnderlineOffset'}, |
413
|
|
|
|
|
|
|
$df{'UnderlineWidth'}, |
414
|
|
|
|
|
|
|
$df{'DoubleUpperUnderlineOffset'}, |
415
|
|
|
|
|
|
|
$df{'DoubleLowerUnderlineOffset'}, |
416
|
|
|
|
|
|
|
$df{'DoubleUpperUnderlineWidth'}, |
417
|
|
|
|
|
|
|
$df{'DoubleLowerUnderlineWidth'}, |
418
|
|
|
|
|
|
|
$df{'StrikeOutOffset'}, |
419
|
|
|
|
|
|
|
$df{'StrikeOutWidth'}, |
420
|
|
|
|
|
|
|
$df{'KernPairs'}, |
421
|
0
|
|
|
|
|
|
$df{'KernTracks'} ) = unpack('v*', $buf); |
422
|
|
|
|
|
|
|
|
423
|
0
|
|
|
|
|
|
$data->{'fontname'} = $df{'psName'}; |
424
|
0
|
|
|
|
|
|
$data->{'fontname'} =~ s/[^A-Za-z0-9]+//og; |
425
|
0
|
|
|
|
|
|
$data->{'apiname'} = join('', map { ucfirst(lc(substr($_, 0, 2))) } split m/[^A-Za-z0-9\s]+/, $df{'windowsName'}); |
|
0
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
|
427
|
0
|
|
|
|
|
|
$data->{'upem'} = 1000; |
428
|
|
|
|
|
|
|
|
429
|
0
|
|
|
|
|
|
$data->{'fontbbox'} = [-100,-100, $df{'MaxWidth'},$df{'Ascent'}]; |
430
|
|
|
|
|
|
|
|
431
|
0
|
|
|
|
|
|
$data->{'stemv'} = 0; |
432
|
0
|
|
|
|
|
|
$data->{'stemh'} = 0; |
433
|
|
|
|
|
|
|
|
434
|
0
|
|
0
|
|
|
|
$data->{'lastchar'} = $df{'LastChar'}||0; # running max |
435
|
0
|
|
0
|
|
|
|
$data->{'firstchar'} = $df{'FirstChar'}||255; # running min |
436
|
|
|
|
|
|
|
|
437
|
0
|
|
|
|
|
|
$data->{'missingwidth'} = $df{'AvgWidth'}; |
438
|
0
|
|
|
|
|
|
$data->{'maxwidth'} = $df{'MaxWidth'}; |
439
|
0
|
|
|
|
|
|
$data->{'ascender'} = $df{'Ascent'}; |
440
|
0
|
|
|
|
|
|
$data->{'descender'} = -$df{'LowerCaseDescent'}; |
441
|
|
|
|
|
|
|
|
442
|
0
|
|
|
|
|
|
$data->{'flags'} = 0; |
443
|
|
|
|
|
|
|
# FixedPitch 1 |
444
|
0
|
0
|
0
|
|
|
|
$data->{'flags'} |= 1 if (($df{'PitchAndFamily'} & 1) || ($df{'PitchAndFamily'} & 8)) && !($df{'PitchAndFamily'} & 2); |
|
|
|
0
|
|
|
|
|
445
|
|
|
|
|
|
|
# Serif 2 |
446
|
0
|
0
|
0
|
|
|
|
$data->{'flags'} |= 2 if ($df{'PitchAndFamily'} & 16) && !($df{'PitchAndFamily'} & 32); |
447
|
|
|
|
|
|
|
# Symbolic 4 |
448
|
0
|
0
|
|
|
|
|
$data->{'flags'} |= 4 if $df{'PitchAndFamily'} & 80; |
449
|
|
|
|
|
|
|
# Script 8 |
450
|
0
|
0
|
|
|
|
|
$data->{'flags'} |= 8 if $df{'PitchAndFamily'} & 64; |
451
|
|
|
|
|
|
|
# Nonsymbolic 32 |
452
|
0
|
0
|
|
|
|
|
$data->{'flags'} |= 32 unless $df{'PitchAndFamily'} & 80; |
453
|
|
|
|
|
|
|
# Italic 64 |
454
|
0
|
0
|
|
|
|
|
$data->{'flags'} |= 64 if $df{'Italic'}; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
#bit 17 AllCap |
457
|
|
|
|
|
|
|
#bit 18 SmallCap |
458
|
|
|
|
|
|
|
#bit 19 ForceBold |
459
|
|
|
|
|
|
|
|
460
|
0
|
|
|
|
|
|
$data->{'capheight'} = $df{'CapHeight'}; |
461
|
0
|
|
|
|
|
|
$data->{'xheight'} = $df{'xHeight'}; |
462
|
|
|
|
|
|
|
|
463
|
0
|
|
|
|
|
|
$data->{'uni'} = [ unpack('U*', decode('cp1252', pack('C*',(0..255)))) ]; |
464
|
0
|
0
|
|
|
|
|
$data->{'char'} = [ map { nameByUni($_) || '.notdef' } @{$data->{'uni'}} ]; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
|
466
|
0
|
|
|
|
|
|
$data->{'italicangle'} = -12*$df{'Italic'}; |
467
|
0
|
|
0
|
|
|
|
$data->{'isfixedpitch'} = ($df{'PitchAndFamily'} & 8) || ($df{'PitchAndFamily'} & 1); |
468
|
0
|
|
|
|
|
|
$data->{'underlineposition'} = -$df{'UnderlineOffset'}; |
469
|
0
|
|
|
|
|
|
$data->{'underlinethickness'} = $df{'UnderlineWidth'}; |
470
|
|
|
|
|
|
|
|
471
|
0
|
|
|
|
|
|
seek($fh, $df{'ExtentTable'}, 0); |
472
|
|
|
|
|
|
|
|
473
|
0
|
|
|
|
|
|
foreach my $k ($df{'FirstChar'} .. $df{'LastChar'}) { |
474
|
0
|
|
|
|
|
|
read($fh, $buf, 2); |
475
|
0
|
|
|
|
|
|
my ($wx) = unpack('v', $buf); |
476
|
0
|
|
|
|
|
|
$data->{'wx'}->{$data->{'char'}->[$k]} = $wx; |
477
|
|
|
|
|
|
|
# print STDERR "e: c=$k n='".$data->{'char'}->[$k]."' wx='$wx'\n"; |
478
|
|
|
|
|
|
|
} |
479
|
0
|
|
|
|
|
|
$data->{'pfm'} = \%df; |
480
|
0
|
|
|
|
|
|
close($fh); |
481
|
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
|
return $data; |
483
|
|
|
|
|
|
|
} # end of readPFM() |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
sub readXFM { |
486
|
0
|
|
|
0
|
0
|
|
my ($class, $xfmfile) = @_; |
487
|
|
|
|
|
|
|
|
488
|
0
|
0
|
|
|
|
|
die "Cannot find font '$xfmfile' ..." unless -f $xfmfile; |
489
|
|
|
|
|
|
|
|
490
|
0
|
|
|
|
|
|
my $data = {}; |
491
|
|
|
|
|
|
|
|
492
|
0
|
|
|
|
|
|
return $data; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
1; |