line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::Builder::Resource::Font::BdFont; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
2576
|
use base 'PDF::Builder::Resource::Font'; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
254
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
12
|
use strict; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
46
|
|
6
|
1
|
|
|
1
|
|
9
|
use warnings; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
114
|
|
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
|
|
8
|
use PDF::Builder::Util; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
278
|
|
13
|
1
|
|
|
1
|
|
14
|
use PDF::Builder::Basic::PDF::Utils; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
4549
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $BmpNum = 0; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
PDF::Builder::Resource::Font::BdFont - Module for using bitmapped Fonts. |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
use PDF::Builder; |
25
|
|
|
|
|
|
|
# |
26
|
|
|
|
|
|
|
$pdf = PDF::Builder->new(); |
27
|
|
|
|
|
|
|
$sft = $pdf->bdfont($file); |
28
|
|
|
|
|
|
|
# |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
This creates a bitmapped font from a .bdf (bitmap distribution font) file. |
31
|
|
|
|
|
|
|
The default is to use square elements, and the style can be changed to use |
32
|
|
|
|
|
|
|
filled dots (looking more like a dot-matrix printer). The font will be |
33
|
|
|
|
|
|
|
embedded in the PDF file. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Bitmapped fonts are quite rough, low resolution, and difficult to read, so |
36
|
|
|
|
|
|
|
unless you're a sadist who wants to force readers back to the good old days of |
37
|
|
|
|
|
|
|
dot-matrix printers and bitmapped X terminals, try to limit the use of such a |
38
|
|
|
|
|
|
|
font to decorative or novelty effects, such as chapter titles and major |
39
|
|
|
|
|
|
|
headings. Have mercy on your readers and use a real font (TrueType, etc.) |
40
|
|
|
|
|
|
|
for body text! |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 METHODS |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=over 4 |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=cut |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=item $font = PDF::Builder::Resource::Font::BdFont->new($pdf, $font, %options) |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=item $font = PDF::Builder::Resource::Font::BdFont->new($pdf, $font) |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Returns a BmpFont object. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=cut |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
#I<-encode> |
57
|
|
|
|
|
|
|
#... changes the encoding of the font from its default. |
58
|
|
|
|
|
|
|
#See I for the supported values. |
59
|
|
|
|
|
|
|
# |
60
|
|
|
|
|
|
|
=pod |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Valid %options are: |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
I<-pdfname> ... changes the reference-name of the font from its default. |
65
|
|
|
|
|
|
|
The reference-name is normally generated automatically and can be |
66
|
|
|
|
|
|
|
retrieved via C<$pdfname=$font->name()>. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
I<-style> ... a value of 'block' (default) assembles a character from |
69
|
|
|
|
|
|
|
contiguous square blocks. A value of 'dot' assembles a character from |
70
|
|
|
|
|
|
|
overlapping filled circles, in the style of a dot matrix printer. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=cut |
73
|
|
|
|
|
|
|
# -style => 'image' doesn't seem to want to work (see examples/024_bdffonts |
74
|
|
|
|
|
|
|
# for code). it's not clear whether a 1000 x 1000 pixel bitmap needs to be |
75
|
|
|
|
|
|
|
# generated, to be scaled down to the text size. if so, that's very wasteful. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub new { |
78
|
0
|
|
|
0
|
1
|
|
my ($class, $pdf, $file, %opts) = @_; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
my ($self, $data); |
81
|
0
|
|
|
|
|
|
my $dot_ratio = 1.2; # diameter of a dot (dot style) relative to |
82
|
|
|
|
|
|
|
# a block's side. note that if exceeds 1.0, max |
83
|
|
|
|
|
|
|
# extents of dot will actually slightly exceed |
84
|
|
|
|
|
|
|
# extents of block. TBD might need to have different |
85
|
|
|
|
|
|
|
# calculations of max extents for block and dot. |
86
|
|
|
|
|
|
|
|
87
|
0
|
0
|
|
|
|
|
$class = ref $class if ref $class; |
88
|
0
|
|
|
|
|
|
$self = $class->SUPER::new($pdf, sprintf('%s+Bdf%02i', pdfkey(), ++$BmpNum)); |
89
|
0
|
0
|
|
|
|
|
$pdf->new_obj($self) unless $self->is_obj($pdf); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# Adobe bitmap distribution format |
92
|
0
|
|
|
|
|
|
$self->{' data'} = $self->readBDF($file); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# character coordinate units for block and dots styles (cell sizes) |
95
|
0
|
|
|
|
|
|
my ($csizeH, $csizeV); |
96
|
|
|
|
|
|
|
# at this point we need to find the actual cell bounds (after adding |
97
|
|
|
|
|
|
|
# in right and up offsets), in order to define 1000 units vertical |
98
|
|
|
|
|
|
|
# $self->{' data'}->{'FONTBOUNDINGBOX'} is a string |
99
|
0
|
|
|
|
|
|
my ($minX, $minY, $maxX, $maxY); # for final 'fontbbox' numbers |
100
|
0
|
|
|
|
|
|
$minX = $minY = 10000; |
101
|
0
|
|
|
|
|
|
$maxX = $maxY = -10000; |
102
|
0
|
|
|
|
|
|
foreach my $w (@{$self->data()->{'char2'}}) { |
|
0
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
my @bbx = @{$w->{'BBX'}}; |
|
0
|
|
|
|
|
|
|
104
|
0
|
|
|
|
|
|
my $LLx = $bbx[2]; |
105
|
0
|
|
|
|
|
|
my $LLy = $bbx[3]; |
106
|
0
|
|
|
|
|
|
my $URx = $bbx[0]+$bbx[2]; |
107
|
0
|
|
|
|
|
|
my $URy = $bbx[1]+$bbx[3]; |
108
|
0
|
0
|
|
|
|
|
if ($LLx < $minX) { $minX = $LLx; } |
|
0
|
|
|
|
|
|
|
109
|
0
|
0
|
|
|
|
|
if ($LLx > $maxX) { $maxX = $LLx; } |
|
0
|
|
|
|
|
|
|
110
|
0
|
0
|
|
|
|
|
if ($URx < $minX) { $minX = $URx; } |
|
0
|
|
|
|
|
|
|
111
|
0
|
0
|
|
|
|
|
if ($URx > $maxX) { $maxX = $URx; } |
|
0
|
|
|
|
|
|
|
112
|
0
|
0
|
|
|
|
|
if ($LLy < $minY) { $minY = $LLy; } |
|
0
|
|
|
|
|
|
|
113
|
0
|
0
|
|
|
|
|
if ($LLy > $maxY) { $maxY = $LLy; } |
|
0
|
|
|
|
|
|
|
114
|
0
|
0
|
|
|
|
|
if ($URy < $minY) { $minY = $URy; } |
|
0
|
|
|
|
|
|
|
115
|
0
|
0
|
|
|
|
|
if ($URy > $maxY) { $maxY = $URy; } |
|
0
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
# for now, same cell dimensions in X and Y |
118
|
0
|
|
|
|
|
|
$csizeH = $csizeV = int(0.5 + 1000/($maxY + 1)); |
119
|
|
|
|
|
|
|
|
120
|
0
|
|
|
|
|
|
my $first = 0; # we'll always do the full single byte encoding |
121
|
0
|
|
|
|
|
|
my $last = 255; |
122
|
0
|
0
|
|
|
|
|
$opts{'-style'} = 'block' unless defined $opts{'-style'}; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
$self->{'Subtype'} = PDFName('Type3'); |
125
|
0
|
|
|
|
|
|
$self->{'FirstChar'} = PDFNum($first); |
126
|
0
|
|
|
|
|
|
$self->{'LastChar'} = PDFNum($last); |
127
|
|
|
|
|
|
|
# define glyph drawings on 1000x1000 grid, divide by 1000, multiply by |
128
|
|
|
|
|
|
|
# font size in points |
129
|
0
|
|
|
|
|
|
$self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } (0.001, 0, 0, 0.001, 0, 0) ); |
|
0
|
|
|
|
|
|
|
130
|
0
|
0
|
|
|
|
|
if (defined $self->{' data'}->{'FONT'}) { |
131
|
0
|
|
|
|
|
|
$self->{'Comment'} = PDFString("FontName=" . $self->{' data'}->{'FONT'}, 'x'); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
my $xo = PDFDict(); |
135
|
0
|
|
|
|
|
|
$self->{'Encoding'} = $xo; |
136
|
0
|
|
|
|
|
|
$xo->{'Type'} = PDFName('Encoding'); |
137
|
0
|
|
|
|
|
|
$xo->{'BaseEncoding'} = PDFName('WinAnsiEncoding'); |
138
|
|
|
|
|
|
|
# assign .notdef "char" to anything not found in the .bdf file |
139
|
0
|
|
0
|
|
|
|
$xo->{'Differences'} = PDFArray(PDFNum($first), (map { PDFName($_ || '.notdef') } @{$self->data()->{'char'}})); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
|
my $procs = PDFDict(); |
142
|
0
|
|
|
|
|
|
$pdf->new_obj($procs); |
143
|
0
|
|
|
|
|
|
$self->{'CharProcs'} = $procs; |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
$self->{'Resources'} = PDFDict(); |
146
|
0
|
|
|
|
|
|
$self->{'Resources'}->{'ProcSet'} = PDFArray(map { PDFName($_) } qw(PDF Text ImageB ImageC ImageI)); |
|
0
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
foreach my $w ($first .. $last) { |
148
|
|
|
|
|
|
|
# if not a standard glyph name, use $w as the value |
149
|
0
|
|
0
|
|
|
|
$self->data()->{'uni'}->[$w] = (uniByName($self->data()->{'char'}->[$w]))||$w; |
150
|
0
|
|
|
|
|
|
$self->data()->{'u2e'}->{$self->data()->{'uni'}->[$w]} = $w; |
151
|
|
|
|
|
|
|
} |
152
|
0
|
|
|
|
|
|
my @widths = (); |
153
|
0
|
|
|
|
|
|
foreach my $w (@{$self->data()->{'char2'}}) { |
|
0
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# some .bdf files have a grid that is 10000 wide, not 1000. want to |
155
|
|
|
|
|
|
|
# end up with a fraction (typically less than 1.0) of font size |
156
|
|
|
|
|
|
|
# after scaling in FontMatrix (/1000). |
157
|
0
|
0
|
|
|
|
|
if ($self->data()->{'wx'}->{$w->{'NAME'}} > 2500) { |
158
|
0
|
|
|
|
|
|
$self->data()->{'wx'}->{$w->{'NAME'}} /= 10; |
159
|
|
|
|
|
|
|
} |
160
|
0
|
0
|
|
|
|
|
if ($self->data()->{'wx'}->{$w->{'NAME'}} == 0) { |
161
|
0
|
|
0
|
|
|
|
$self->data()->{'wx'}->{$w->{'NAME'}} = $self->{'missingwidth'} || 100; |
162
|
|
|
|
|
|
|
} |
163
|
0
|
|
|
|
|
|
$widths[$w->{'ENCODING'}] = $self->data()->{'wx'}->{$w->{'NAME'}}; |
164
|
0
|
|
|
|
|
|
my @bbx = @{ $w->{'BBX'} }; |
|
0
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
my @BBX = @bbx; |
166
|
|
|
|
|
|
|
# if no pattern (e.g., space) give a 0000 pattern to avoid pack problem |
167
|
0
|
0
|
|
|
|
|
$w->{'hex'} = '0000' if !defined $w->{'hex'}; |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
|
my $char = PDFDict(); |
170
|
|
|
|
|
|
|
# [0] width 1000*fraction wide (approx) = aspect ratio |
171
|
|
|
|
|
|
|
# [1] 0 y +/- move to next character? |
172
|
|
|
|
|
|
|
# [2..3] lower left extent of glyph, can be to left of origin point |
173
|
|
|
|
|
|
|
# [4..5] upper right extent of glyph + trailing space |
174
|
|
|
|
|
|
|
# make sure width is at least 105% of max x |
175
|
0
|
0
|
|
|
|
|
if ($widths[$w->{'ENCODING'}] < 1.05*($bbx[0]+$bbx[2])*$csizeH) { |
176
|
0
|
|
|
|
|
|
$widths[$w->{'ENCODING'}] = int(0.5 + 1.05*($bbx[0]+$bbx[2])*$csizeH); |
177
|
|
|
|
|
|
|
} |
178
|
0
|
|
|
|
|
|
my $LLx = int($bbx[2]*$csizeH + 0.5); |
179
|
0
|
|
|
|
|
|
my $LLy = int($bbx[3]*$csizeV + 0.5); |
180
|
0
|
|
|
|
|
|
my $URx = int(($bbx[0]+$bbx[2])*$csizeH + 0.5); |
181
|
0
|
|
|
|
|
|
my $URy = int(($bbx[1]+$bbx[3])*$csizeV + 0.5); |
182
|
0
|
|
|
|
|
|
$char->{' stream'} = $widths[$w->{'ENCODING'}] . " 0 $LLx $LLy $URx $URy d1\n"; |
183
|
0
|
|
|
|
|
|
$char->{'Comment'} = PDFString("N='" . $w->{'NAME'} . "' C=" . $w->{'ENCODING'}, 'x'); |
184
|
0
|
|
|
|
|
|
$procs->{$w->{'NAME'}} = $char; |
185
|
0
|
|
|
|
|
|
@bbx = map { $_ * 1000 / $self->data()->{'upm'} } @bbx; |
|
0
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# Reader will save graphics state (q) and restore (Q) around each |
188
|
|
|
|
|
|
|
# glyph's drawing commands |
189
|
0
|
0
|
|
|
|
|
if ($opts{'-style'} eq 'image') { |
190
|
|
|
|
|
|
|
# note that each character presented as an image |
191
|
|
|
|
|
|
|
# CAUTION: using this image code for a font doesn't seem to work |
192
|
|
|
|
|
|
|
# well. block and dot look quite nice, so for now, use one of those. |
193
|
0
|
|
|
|
|
|
my $stream = pack('H*', $w->{'hex'}); |
194
|
0
|
|
|
|
|
|
my $y = $BBX[1]; # vertical dimension of character (pixels) |
195
|
|
|
|
|
|
|
|
196
|
0
|
0
|
|
|
|
|
if ($y == 0) { |
197
|
0
|
|
|
|
|
|
$char->{' stream'} .= " "; |
198
|
|
|
|
|
|
|
} else { |
199
|
0
|
|
|
|
|
|
my $x = 8 * length($stream) / $y; |
200
|
0
|
|
|
|
|
|
my $img = qq|BI\n/Interpolate false/Decode [1 0]/H $y/W $x/BPC 1/CS/G\nID $stream\nEI|; |
201
|
0
|
|
|
|
|
|
$procs->{$self->data()->{'char'}->[$w]} = $char; |
202
|
|
|
|
|
|
|
# BBX.0 is character width in pixels, BBX.1 is height in pixels |
203
|
|
|
|
|
|
|
# BBX.2 is offset to right in pixels, BBX.3 is offset up in pixels |
204
|
0
|
|
|
|
|
|
$char->{' stream'} .= "q $BBX[0] 0 0 $BBX[1] $BBX[2] $BBX[3] cm\n$img\nQ"; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
# entered as Type 3 font character |
207
|
|
|
|
|
|
|
# n 0 obj << /Length nn >> stream |
208
|
|
|
|
|
|
|
# width 0 d0 # mils |
209
|
|
|
|
|
|
|
# q xsize 0 0 ysize xoffset yoffset cm |
210
|
|
|
|
|
|
|
# BI |
211
|
|
|
|
|
|
|
# /Interpolate false/Decode[1 0]/H pixh/W pixw/BPC 1/CS/G |
212
|
|
|
|
|
|
|
# ID binary_data stream |
213
|
|
|
|
|
|
|
# EI |
214
|
|
|
|
|
|
|
# Q |
215
|
|
|
|
|
|
|
# endstream endobj |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
} else { |
218
|
|
|
|
|
|
|
# common code for dot and block styles |
219
|
0
|
0
|
|
|
|
|
if ($BBX[1] == 0) { |
220
|
|
|
|
|
|
|
# empty character, such as a space |
221
|
0
|
|
|
|
|
|
$char->{' stream'} .= " "; |
222
|
|
|
|
|
|
|
} else { |
223
|
0
|
|
|
|
|
|
my @dots = (); # rows of pixels [0] at bottom (min y), |
224
|
|
|
|
|
|
|
# each row is array of pixels across |
225
|
|
|
|
|
|
|
# BBX[1] is number of chunks in 'hex', each 2, 4, 6 nybbles |
226
|
|
|
|
|
|
|
# (not sure if can exceed 8 pixels across...) |
227
|
|
|
|
|
|
|
# BBX[0] is width in pixels (8 to a byte) across 'hex' |
228
|
0
|
|
|
|
|
|
my $bytesPerRow = int(($BBX[0]+7)/8); # 2 nybbles each |
229
|
0
|
|
|
|
|
|
for (my $row=0; $row<$BBX[1]; $row++) { |
230
|
0
|
|
|
|
|
|
unshift @dots, [ split //, substr(unpack('B*', pack('H*', substr($w->{'hex'}, $row*2, $bytesPerRow*2))), 0, $BBX[0]) ]; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
# dots[r][c] is 1 if want pixel there (0,0 at bottom/left) |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
for (my $row=0; $row<$BBX[1]; $row++) { |
235
|
0
|
|
|
|
|
|
for (my $col=0; $col<$BBX[0]; $col++) { |
236
|
0
|
0
|
|
|
|
|
if (!$dots[$row][$col]) { next; } |
|
0
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
|
238
|
0
|
0
|
|
|
|
|
if ($opts{'-style'} eq 'block') { |
239
|
|
|
|
|
|
|
# TBD merge neighbors to form larger rectangles |
240
|
0
|
|
|
|
|
|
$char->{' stream'} .= int(($col+$BBX[2])*$csizeH+0.5).' '. |
241
|
|
|
|
|
|
|
int(($row+$BBX[3])*$csizeV+0.5).' '. |
242
|
|
|
|
|
|
|
int($csizeH+0.5).' '. |
243
|
|
|
|
|
|
|
int($csizeV+0.5).' '. |
244
|
|
|
|
|
|
|
're f '; |
245
|
|
|
|
|
|
|
} else { |
246
|
|
|
|
|
|
|
# dots |
247
|
0
|
|
|
|
|
|
$char->{' stream'} .= filled_circle( |
248
|
|
|
|
|
|
|
($col+$BBX[2]+0.5)*$csizeH, # Xc |
249
|
|
|
|
|
|
|
($row+$BBX[3]+0.5)*$csizeV, # Yc |
250
|
|
|
|
|
|
|
$csizeH*$dot_ratio/2 ); # r |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
} |
253
|
0
|
|
|
|
|
|
$char->{' stream'} .= "\n"; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} # block and dot styles |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$pdf->new_obj($char); |
259
|
|
|
|
|
|
|
# .notdef is treated as a space |
260
|
0
|
|
|
|
|
|
$procs->{'.notdef'} = $procs->{$self->data()->{'char'}->[32]}; |
261
|
0
|
|
|
|
|
|
delete $procs->{''}; |
262
|
|
|
|
|
|
|
} # loop through all defined characters in BDF file |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# correct global fontbbox and output after seeing all glyph 'd1' LL UR limits |
265
|
0
|
|
|
|
|
|
my @fbb = ( $self->fontbbox() ); |
266
|
0
|
|
|
|
|
|
$fbb[0] = $minX*$csizeH; |
267
|
0
|
|
|
|
|
|
$fbb[1] = $minY*$csizeV; |
268
|
0
|
|
|
|
|
|
$fbb[2] = $maxX*$csizeH; |
269
|
0
|
|
|
|
|
|
$fbb[3] = $maxY*$csizeV; |
270
|
0
|
|
|
|
|
|
$self->{'FontBBox'} = PDFArray(map { PDFNum($_) } @fbb ); |
|
0
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
0
|
|
0
|
|
|
|
$self->{'Widths'} = PDFArray(map { PDFNum($widths[$_] || $self->{' data'}->{'missingwidth'} || 100) } ($first .. $last)); |
|
0
|
|
|
|
|
|
|
273
|
0
|
|
|
|
|
|
$self->data()->{'e2n'} = $self->data()->{'char'}; |
274
|
0
|
|
|
|
|
|
$self->data()->{'e2u'} = $self->data()->{'uni'}; |
275
|
|
|
|
|
|
|
|
276
|
0
|
|
|
|
|
|
$self->data()->{'u2c'} = {}; |
277
|
0
|
|
|
|
|
|
$self->data()->{'u2e'} = {}; |
278
|
0
|
|
|
|
|
|
$self->data()->{'u2n'} = {}; |
279
|
0
|
|
|
|
|
|
$self->data()->{'n2c'} = {}; |
280
|
0
|
|
|
|
|
|
$self->data()->{'n2e'} = {}; |
281
|
0
|
|
|
|
|
|
$self->data()->{'n2u'} = {}; |
282
|
|
|
|
|
|
|
|
283
|
0
|
|
|
|
|
|
foreach my $n (reverse 0 .. 255) { |
284
|
0
|
0
|
0
|
|
|
|
$self->data()->{'n2c'}->{$self->data()->{'char'}->[$n] || '.notdef'} = $n unless defined $self->data()->{'n2c'}->{$self->data()->{'char'}->[$n] || '.notdef'}; |
|
|
|
0
|
|
|
|
|
285
|
0
|
0
|
0
|
|
|
|
$self->data()->{'n2e'}->{$self->data()->{'e2n'}->[$n] || '.notdef'} = $n unless defined $self->data()->{'n2e'}->{$self->data()->{'e2n'}->[$n] || '.notdef'}; |
|
|
|
0
|
|
|
|
|
286
|
|
|
|
|
|
|
|
287
|
0
|
0
|
0
|
|
|
|
$self->data()->{'n2u'}->{$self->data()->{'e2n'}->[$n] || '.notdef'} = $self->data()->{'e2u'}->[$n] unless defined $self->data()->{'n2u'}->{$self->data()->{'e2n'}->[$n] || '.notdef'}; |
|
|
|
0
|
|
|
|
|
288
|
0
|
0
|
0
|
|
|
|
$self->data()->{'n2u'}->{$self->data()->{'char'}->[$n] || '.notdef'} = $self->data()->{'uni'}->[$n] unless defined $self->data()->{'n2u'}->{$self->data()->{'char'}->[$n] || '.notdef'}; |
|
|
|
0
|
|
|
|
|
289
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
|
$self->data()->{'u2c'}->{$self->data()->{'uni'}->[$n]} = $n unless defined $self->data()->{'u2c'}->{$self->data()->{'uni'}->[$n]}; |
291
|
0
|
0
|
|
|
|
|
$self->data()->{'u2e'}->{$self->data()->{'e2u'}->[$n]} = $n unless defined $self->data()->{'u2e'}->{$self->data()->{'e2u'}->[$n]}; |
292
|
|
|
|
|
|
|
|
293
|
0
|
0
|
0
|
|
|
|
$self->data()->{'u2n'}->{$self->data()->{'e2u'}->[$n]} = ($self->data()->{'e2n'}->[$n] || '.notdef') unless(defined $self->data()->{'u2n'}->{$self->data()->{'e2u'}->[$n]}); |
294
|
0
|
0
|
0
|
|
|
|
$self->data()->{'u2n'}->{$self->data()->{'uni'}->[$n]}=($self->data()->{'char'}->[$n] || '.notdef') unless(defined $self->data()->{'u2n'}->{$self->data()->{'uni'}->[$n]}); |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
return $self; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub readBDF { |
301
|
0
|
|
|
0
|
0
|
|
my ($self, $file) = @_; |
302
|
0
|
|
|
|
|
|
my $data = {}; |
303
|
0
|
|
|
|
|
|
$data->{'char'} = []; # ENCODING is NAME from char2 |
304
|
0
|
|
|
|
|
|
$data->{'char2'} = []; # NAME from STARTCHAR record, E_encoding# default |
305
|
|
|
|
|
|
|
# hex from BITMAP records as one long string, |
306
|
|
|
|
|
|
|
# can be empty (such as space x20) |
307
|
|
|
|
|
|
|
# BBX arrayref from BBX record |
308
|
0
|
|
|
|
|
|
$data->{'wx'} = {}; # width (by name) from char2 SWIDTH record |
309
|
|
|
|
|
|
|
|
310
|
0
|
0
|
|
|
|
|
if (! -e $file) { |
311
|
0
|
|
|
|
|
|
die "BDF file='$file' not found."; |
312
|
|
|
|
|
|
|
} |
313
|
0
|
0
|
|
|
|
|
open(my $afmf, "<", $file) or die "Can't open the BDF file for $file"; |
314
|
0
|
|
|
|
|
|
local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR |
315
|
0
|
|
|
|
|
|
while ($_ = <$afmf>) { |
316
|
0
|
|
|
|
|
|
chomp($_); |
317
|
0
|
0
|
|
|
|
|
if (/^STARTCHAR/ .. /^ENDCHAR/) { |
318
|
0
|
0
|
|
|
|
|
if (/^STARTCHAR\s+(\S+)/) { # start of one glyph |
|
|
0
|
|
|
|
|
|
319
|
0
|
|
|
|
|
|
my $name = $1; |
320
|
0
|
|
|
|
|
|
$name =~ s|^(\d+.*)$|X_$1|; |
321
|
0
|
|
|
|
|
|
push @{$data->{'char2'}}, {'NAME' => $name}; |
|
0
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
} elsif (/^BITMAP/ .. /^ENDCHAR/) { # bitmap itself |
323
|
0
|
0
|
|
|
|
|
next if(/^BITMAP/); |
324
|
0
|
0
|
|
|
|
|
if (/^ENDCHAR/) { # done reading, finalize |
325
|
|
|
|
|
|
|
# fallback NAME is E_ |
326
|
0
|
|
0
|
|
|
|
$data->{'char2'}->[-1]->{'NAME'} ||= 'E_'.$data->{'char2'}->[-1]->{'ENCODING'}; |
327
|
0
|
|
|
|
|
|
my $charName = $data->{'char2'}->[-1]->{'NAME'}; |
328
|
|
|
|
|
|
|
# char ENCODING is char2's NAME |
329
|
0
|
|
|
|
|
|
$data->{'char'}->[$data->{'char2'}->[-1]->{'ENCODING'}] = $charName; |
330
|
|
|
|
|
|
|
# width (2 element vector) from char2 SWIDTH |
331
|
0
|
|
|
|
|
|
($data->{'wx'}->{$charName}) = split(/\s+/, $data->{'char2'}->[-1]->{'SWIDTH'}); |
332
|
|
|
|
|
|
|
# bounding box (4 element vector) from char2 BBX |
333
|
0
|
|
|
|
|
|
$data->{'char2'}->[-1]->{'BBX'} = [split(/\s+/, $data->{'char2'}->[-1]->{'BBX'})]; |
334
|
|
|
|
|
|
|
} else { # the bitmap data record appended |
335
|
0
|
|
|
|
|
|
$data->{'char2'}->[-1]->{'hex'} .= $_; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} else { |
338
|
|
|
|
|
|
|
# a few fields (records) here, just grab pairs |
339
|
0
|
0
|
|
|
|
|
if (m|^(\S+)\s+(.+)$|) { |
340
|
0
|
|
|
|
|
|
$data->{'char2'}->[-1]->{uc($1)} .= $2; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
## } elsif (/^STARTPROPERTIES/ .. /^ENDPROPERTIES/) { not implemented |
344
|
|
|
|
|
|
|
} else { |
345
|
|
|
|
|
|
|
# all sorts of random stuff here, STARTFONT, START/END |
346
|
|
|
|
|
|
|
# PROPERTIES, etc. just grab anything that looks like a |
347
|
|
|
|
|
|
|
# record |
348
|
0
|
0
|
|
|
|
|
if (m|^(\S+)\s+(.+)$|) { |
349
|
0
|
|
|
|
|
|
$data->{uc($1)} .= $2; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
0
|
|
|
|
|
|
close($afmf); |
354
|
0
|
0
|
|
|
|
|
unless (exists $data->{'wx'}->{'.notdef'}) { |
355
|
0
|
|
0
|
|
|
|
$data->{'wx'}->{'.notdef'} = $data->{'missingwidth'} || 100; |
356
|
0
|
|
|
|
|
|
$data->{'bbox'}{'.notdef'} = [0, 0, 0, 0]; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
$data->{'fontname'} = "BdfF+" . pdfkey(); |
360
|
0
|
|
|
|
|
|
$data->{'apiname'} = $data->{'fontname'}; |
361
|
0
|
|
|
|
|
|
$data->{'flags'} = 34; |
362
|
|
|
|
|
|
|
# initial value of fontbbox is FONTBOUNDINGBOX entry, e.g., 6 13 0 -3 |
363
|
|
|
|
|
|
|
# equals 6 columns, 13 rows, 0 min right offset, -3 min up offset |
364
|
0
|
|
|
|
|
|
$data->{'fontbbox'} = [split(/\s+/, $data->{'FONTBOUNDINGBOX'})]; |
365
|
|
|
|
|
|
|
# upm e.g., 15 (if not set, rows-min up offset 13-(-3) = 16) |
366
|
|
|
|
|
|
|
# I don't think this is screen px, but count of vertical elements in glyph |
367
|
0
|
|
0
|
|
|
|
$data->{'upm'} = $data->{'PIXEL_SIZE'} || ($data->{'fontbbox'}->[1] - $data->{'fontbbox'}->[3]); |
368
|
|
|
|
|
|
|
# not sure what this is trying to do. 1000/vertical cell count would be |
369
|
|
|
|
|
|
|
# vertical (and horizontal) cell size, within 1000 grid? multiply cell |
370
|
|
|
|
|
|
|
# locations by cell size to get grid locations? |
371
|
0
|
|
|
|
|
|
@{$data->{'fontbbox'}} = map { int($_*1000/$data->{'upm'}) } @{$data->{'fontbbox'}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# at this point, fontbbox is scaled cols/rows and min right/up. what goes |
373
|
|
|
|
|
|
|
# in /FontBBox should be LL UR scaled values (including offsets) |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
|
foreach my $n (0 .. 255) { |
376
|
0
|
|
0
|
|
|
|
$data->{'char'}->[$n] ||= '.notdef'; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
0
|
|
0
|
|
|
|
$data->{'uni'} ||= []; |
380
|
0
|
|
|
|
|
|
foreach my $n (0 .. 255) { |
381
|
0
|
|
0
|
|
|
|
$data->{'uni'}->[$n] = uniByName($data->{'char'}->[$n] || '.notdef') || 0; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
$data->{'ascender'} = $data->{'RAW_ASCENT'} |
384
|
0
|
|
0
|
|
|
|
|| int($data->{'FONT_ASCENT'} * 1000 / $data->{'upm'}); |
385
|
|
|
|
|
|
|
$data->{'descender'} = $data->{'RAW_DESCENT'} |
386
|
0
|
|
0
|
|
|
|
|| int($data->{'FONT_DESCENT'} * 1000 / $data->{'upm'}); |
387
|
|
|
|
|
|
|
|
388
|
0
|
|
|
|
|
|
$data->{'type'} = 'Type3'; |
389
|
0
|
|
|
|
|
|
$data->{'capheight'} = 1000; |
390
|
0
|
|
|
|
|
|
$data->{'iscore'} = 0; |
391
|
0
|
|
|
|
|
|
$data->{'issymbol'} = 0; |
392
|
0
|
|
|
|
|
|
$data->{'isfixedpitch'} = 0; |
393
|
0
|
|
|
|
|
|
$data->{'italicangle'} = 0; |
394
|
|
|
|
|
|
|
$data->{'missingwidth'} = $data->{'AVERAGE_WIDTH'} |
395
|
|
|
|
|
|
|
|| int($data->{'FONT_AVERAGE_WIDTH'} * 1000 / $data->{'upm'}) |
396
|
0
|
|
0
|
|
|
|
|| $data->{'RAW_AVERAGE_WIDTH'} |
397
|
|
|
|
|
|
|
|| 500; |
398
|
0
|
|
|
|
|
|
$data->{'underlineposition'} = -200; |
399
|
0
|
|
|
|
|
|
$data->{'underlinethickness'} = 10; |
400
|
|
|
|
|
|
|
$data->{'xheight'} = $data->{'RAW_XHEIGHT'} |
401
|
|
|
|
|
|
|
|| int(($data->{'FONT_XHEIGHT'}||0) * 1000 / $data->{'upm'}) |
402
|
0
|
|
0
|
|
|
|
|| int($data->{'ascender'} / 2); |
403
|
0
|
|
|
|
|
|
$data->{'firstchar'} = 0; |
404
|
0
|
|
|
|
|
|
$data->{'lastchar'} = 255; |
405
|
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
|
delete $data->{'wx'}->{''}; |
407
|
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
|
return $data; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# draw a filled circle centered at $Xc,$Yc, of radius $r |
412
|
|
|
|
|
|
|
# returns string of PDF primitives |
413
|
|
|
|
|
|
|
sub filled_circle { |
414
|
|
|
|
|
|
|
# this algorithm from stackoverflow by Marius (questions/1960786) |
415
|
0
|
|
|
0
|
0
|
|
my ($Xc, $Yc, $r) = @_; |
416
|
0
|
|
|
|
|
|
my $out = ''; # output string |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# line thickness 2 x radius |
419
|
0
|
|
|
|
|
|
$out .= " " . (2*$r) . " w"; |
420
|
|
|
|
|
|
|
# line cap round |
421
|
0
|
|
|
|
|
|
$out .= " 1 J"; |
422
|
|
|
|
|
|
|
# draw 0-length line at center |
423
|
0
|
|
|
|
|
|
$out .= " $Xc $Yc m $Xc $Yc l"; |
424
|
|
|
|
|
|
|
# stroke line |
425
|
0
|
|
|
|
|
|
$out .= " S"; |
426
|
|
|
|
|
|
|
|
427
|
0
|
|
|
|
|
|
return $out; |
428
|
|
|
|
|
|
|
} # end filled_circle() |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
1; |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
__END__ |