1#=======================================================================
2#    ____  ____  _____              _    ____ ___   ____
3#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
4#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
5#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
6#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
7#
8#   A Perl Module Chain to faciliate the Creation and Modification
9#   of High-Quality "Portable Document Format (PDF)" Files.
10#
11#   Copyright 1999-2005 Alfred Reibenschuh <areibens@cpan.org>.
12#
13#=======================================================================
14#
15#   This library is free software; you can redistribute it and/or
16#   modify it under the terms of the GNU Lesser General Public
17#   License as published by the Free Software Foundation; either
18#   version 2 of the License, or (at your option) any later version.
19#
20#   This library is distributed in the hope that it will be useful,
21#   but WITHOUT ANY WARRANTY; without even the implied warranty of
22#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23#   Lesser General Public License for more details.
24#
25#   You should have received a copy of the GNU Lesser General Public
26#   License along with this library; if not, write to the
27#   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28#   Boston, MA 02111-1307, USA.
29#
30#   $Id: BdFont.pm,v 2.0 2005/11/16 02:18:14 areibens Exp $
31#
32#=======================================================================
33package PDF::API3::Compat::API2::Resource::Font::BdFont;
34
35BEGIN {
36
37    use utf8;
38    use Encode qw(:all);
39
40    use vars qw( @ISA $VERSION $BmpNum);
41    use PDF::API3::Compat::API2::Resource::Font;
42    use PDF::API3::Compat::API2::Util;
43    use PDF::API3::Compat::API2::Basic::PDF::Utils;
44    use Math::Trig;
45    use Unicode::UCD 'charinfo';
46
47    @ISA=qw(PDF::API3::Compat::API2::Resource::Font);
48
49    ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.0 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2005/11/16 02:18:14 $
50
51    $BmpNum=0;
52
53}
54no warnings qw[ deprecated recursion uninitialized ];
55
56=head1 NAME
57
58PDF::API3::Compat::API2::Resource::Font::BdFont - Module for using bitmapped Fonts.
59
60=head1 SYNOPSIS
61
62    #
63    use PDF::API3::Compat::API2;
64    #
65    $pdf = PDF::API3::Compat::API2->new;
66    $sft = $pdf->bdfont($file);
67    #
68
69=head1 METHODS
70
71=over 4
72
73=cut
74
75=item $font = PDF::API3::Compat::API2::Resource::Font::BdFont->new $pdf, $font, %options
76
77Returns a BmpFont object.
78
79=cut
80
81=pod
82
83Valid %options are:
84
85I<-encode>
86... changes the encoding of the font from its default.
87See I<perl's Encode> for the supported values.
88
89I<-pdfname> ... changes the reference-name of the font from its default.
90The reference-name is normally generated automatically and can be
91retrived via $pdfname=$font->name.
92
93=cut
94
95sub new {
96    my ($class,$pdf,$file,@opts) = @_;
97    my ($self,$data);
98    my %opts=@opts;
99
100    $class = ref $class if ref $class;
101    $self = $class->SUPER::new($pdf, sprintf('%s+Bdf%02i',pdfkey(),++$BmpNum).'~'.time());
102    $pdf->new_obj($self) unless($self->is_obj($pdf));
103
104    # adobe bitmap distribution font
105    $self->{' data'}=$self->readBDF($file);
106
107    my $first=1;
108    my $last=255;
109
110    $self->{'Subtype'} = PDFName('Type3');
111    $self->{'FirstChar'} = PDFNum($first);
112    $self->{'LastChar'} = PDFNum($last);
113    $self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } ( 0.001, 0, 0, 0.001, 0, 0 ) );
114    $self->{'FontBBox'} = PDFArray(map { PDFNum($_) } ( $self->fontbbox ) );
115
116    my $xo=PDFDict();
117    $self->{'Encoding'}=$xo;
118    $xo->{Type}=PDFName('Encoding');
119    $xo->{BaseEncoding}=PDFName('WinAnsiEncoding');
120    $xo->{Differences}=PDFArray(PDFNum('0'),(map { PDFName($_||'.notdef') } @{$self->data->{char}}));
121
122    my $procs=PDFDict();
123    $pdf->new_obj($procs);
124    $self->{'CharProcs'} = $procs;
125
126    $self->{Resources}=PDFDict();
127    $self->{Resources}->{ProcSet}=PDFArray(map { PDFName($_) } qw(PDF Text ImageB ImageC ImageI));
128    foreach my $w ($first..$last) {
129        $self->data->{uni}->[$w]=uniByName($self->data->{char}->[$w]);
130        $self->data->{u2e}->{$self->data->{uni}->[$w]}=$w;
131    }
132    my @widths=();
133    foreach my $w (@{$self->data->{char2}}) {
134        $widths[$w->{ENCODING}]=$self->data->{wx}->{$w->{NAME}};
135        my @bbx=@{$w->{BBX}};
136        my $stream=pack('H*',$w->{hex});
137        my $y=$bbx[1];
138        my $char=PDFDict();
139        $char->{Filter}=PDFArray(PDFName('FlateDecode'));
140        ## $char->{' stream'}=$widths[$w->{ENCODING}]." 0 ".join(' ',map { int($_) } $self->fontbbox)." d1\n";
141        $char->{' stream'}=$widths[$w->{ENCODING}]." 0 d0\n";
142        $char->{Comment}=PDFStr("N='$w->{NAME}' C=($w->{ENCODING})");
143        $procs->{$w->{NAME}}=$char;
144        @bbx=map { $_*1000/$self->data->{upm} } @bbx;
145        if($y==0) {
146            $char->{' stream'}.="q Q\n";
147        } else {
148            my $x=8*length($stream)/$y; # q $x 0 0 $y 50 50 cm
149            my $img=qq|BI\n/Interpolate true/Mask[0 0.1]/Decode[1 0]/H $y/W $x/BPC 1/CS/G\nID $stream\nEI\n|;
150            $procs->{$self->data->{char}->[$w]}=$char;
151            $char->{' stream'}.="$bbx[0] 0 0 $bbx[1] $bbx[2] $bbx[3] cm\n$img\n";
152        }
153        $pdf->new_obj($char);
154    }
155    $procs->{'.notdef'}=$procs->{$self->data->{char}->[32]};
156    delete $procs->{''};
157    $self->{Widths}=PDFArray(map { PDFNum($widths[$_]||0) } ($first..$last));
158    $self->data->{e2n}=$self->data->{char};
159    $self->data->{e2u}=$self->data->{uni};
160
161    $self->data->{u2c}={};
162    $self->data->{u2e}={};
163    $self->data->{u2n}={};
164    $self->data->{n2c}={};
165    $self->data->{n2e}={};
166    $self->data->{n2u}={};
167
168    foreach my $n (reverse 0..255) {
169        $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'});
170        $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'});
171
172        $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'}=$self->data->{e2u}->[$n] unless(defined $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'});
173        $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'}=$self->data->{uni}->[$n] unless(defined $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'});
174
175        $self->data->{u2c}->{$self->data->{uni}->[$n]}=$n unless(defined $self->data->{u2c}->{$self->data->{uni}->[$n]});
176        $self->data->{u2e}->{$self->data->{e2u}->[$n]}=$n unless(defined $self->data->{u2e}->{$self->data->{e2u}->[$n]});
177
178        $self->data->{u2n}->{$self->data->{e2u}->[$n]}=($self->data->{e2n}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{e2u}->[$n]});
179        $self->data->{u2n}->{$self->data->{uni}->[$n]}=($self->data->{char}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{uni}->[$n]});
180    }
181
182    return($self);
183}
184
185
186=item $font = PDF::API3::Compat::API2::Resource::Font::BdFont->new_api $api, %options
187
188Returns a BdFont object. This method is different from 'new' that
189it needs an PDF::API3::Compat::API2-object rather than a PDF::API3::Compat::API2::PDF::File-object.
190
191=cut
192
193sub new_api {
194  my ($class,$api,@opts)=@_;
195
196  my $obj=$class->new($api->{pdf},@opts);
197
198  $api->{pdf}->new_obj($obj) unless($obj->is_obj($api->{pdf}));
199
200  $api->{pdf}->out_obj($api->{pages});
201  return($obj);
202}
203
204sub readBDF {
205    my ($self,$file)=@_;
206    my $data={};
207    $data->{char}=[];
208    $data->{char2}=[];
209    $data->{wx}={};
210
211    if(! -e $file) {die "file='$file' not existant.";}
212    open(AFMF, $file) or die "Can't find the BDF file for $file";
213    local($/, $_) = ("\n", undef);  # ensure correct $INPUT_RECORD_SEPARATOR
214    while ($_=<AFMF>) {
215        chomp($_);
216        if (/^STARTCHAR/ .. /^ENDCHAR/) {
217            if (/^STARTCHAR\s+(\S+)/) {
218                my $name=$1;
219                $name=~s|^(\d+.*)$|X_$1|;
220                push @{$data->{char2}},{'NAME'=>$name};
221            } elsif (/^BITMAP/ .. /^ENDCHAR/) {
222                next if(/^BITMAP/);
223                if(/^ENDCHAR/){
224                    $data->{char2}->[-1]->{NAME}||='E_'.$data->{char2}->[-1]->{ENCODING};
225                    $data->{char}->[$data->{char2}->[-1]->{ENCODING}]=$data->{char2}->[-1]->{NAME};
226                    ($data->{wx}->{$data->{char2}->[-1]->{NAME}})=split(/\s+/,$data->{char2}->[-1]->{SWIDTH});
227                    $data->{char2}->[-1]->{BBX}=[split(/\s+/,$data->{char2}->[-1]->{BBX})];
228                } else {
229                    $data->{char2}->[-1]->{hex}.=$_;
230                }
231            } else {
232                m|^(\S+)\s+(.+)$|;
233                $data->{char2}->[-1]->{uc($1)}.=$2;
234            }
235        ## } elsif(/^STARTPROPERTIES/ .. /^ENDPROPERTIES/) {
236        } else {
237                m|^(\S+)\s+(.+)$|;
238                $data->{uc($1)}.=$2;
239        }
240    }
241    close(AFMF);
242    unless (exists $data->{wx}->{'.notdef'}) {
243        $data->{wx}->{'.notdef'} = 0;
244        $data->{bbox}{'.notdef'} = [0, 0, 0, 0];
245    }
246
247    $data->{fontname}=pdfkey().pdfkey().'~'.time();
248    $data->{apiname}=$data->{fontname};
249    $data->{flags} = 34;
250    $data->{fontbbox} = [ split(/\s+/,$data->{FONTBOUNDINGBOX}) ];
251    $data->{upm}=$data->{PIXEL_SIZE} || ($data->{fontbbox}->[1] - $data->{fontbbox}->[3]);
252    @{$data->{fontbbox}} = map { int($_*1000/$data->{upm}) } @{$data->{fontbbox}};
253
254    foreach my $n (0..255) {
255        $data->{char}->[$n]||='.notdef';
256    #    $data->{wx}->{$data->{char}->[$n]}=int($data->{wx}->{$data->{char}->[$n]}*1000/$data->{upm});
257    }
258
259    $data->{uni}||=[];
260    foreach my $n (0..255) {
261        $data->{uni}->[$n]=uniByName($data->{char}->[$n] || '.notdef') || 0;
262    }
263    $data->{ascender}=$data->{RAW_ASCENT}
264        || int($data->{FONT_ASCENT}*1000/$data->{upm});
265    $data->{descender}=$data->{RAW_DESCENT}
266        || int($data->{FONT_DESCENT}*1000/$data->{upm});
267
268    $data->{type}='Type3';
269    $data->{capheight}=1000;
270    $data->{iscore}=0;
271    $data->{issymbol} = 0;
272    $data->{isfixedpitch}=0;
273    $data->{italicangle}=0;
274    $data->{missingwidth}=$data->{AVERAGE_WIDTH}
275        || int($data->{FONT_AVERAGE_WIDTH}*1000/$data->{upm})
276        || $data->{RAW_AVERAGE_WIDTH}
277        || 500;
278    $data->{underlineposition}=-200;
279    $data->{underlinethickness}=10;
280    $data->{xheight}=$data->{RAW_XHEIGHT}
281        || int($data->{FONT_XHEIGHT}*1000/$data->{upm})
282        || int($data->{ascender}/2);
283    $data->{firstchar}=1;
284    $data->{lastchar}=255;
285
286    delete $data->{wx}->{''};
287
288    return($data);
289}
290
2911;
292
293__END__
294
295=back
296
297=head1 AUTHOR
298
299alfred reibenschuh
300
301=head1 HISTORY
302
303    $Log: BdFont.pm,v $
304    Revision 2.0  2005/11/16 02:18:14  areibens
305    revision workaround for SF cvs import not to screw up CPAN
306
307    Revision 1.2  2005/11/16 01:27:50  areibens
308    genesis2
309
310    Revision 1.1  2005/11/16 01:19:27  areibens
311    genesis
312
313    Revision 1.7  2005/10/01 22:41:07  fredo
314    fixed font-naming race condition for multiple document updates
315
316    Revision 1.6  2005/06/17 19:44:03  fredo
317    fixed CPAN modulefile versioning (again)
318
319    Revision 1.5  2005/06/17 18:53:34  fredo
320    fixed CPAN modulefile versioning (dislikes cvs)
321
322    Revision 1.4  2005/03/14 22:01:27  fredo
323    upd 2005
324
325    Revision 1.3  2004/12/16 00:30:54  fredo
326    added no warn for recursion
327
328    Revision 1.2  2004/07/24 23:33:35  fredo
329    added compression
330
331    Revision 1.1  2004/07/24 23:08:57  fredo
332    genesis
333
334    Revision 1.9  2004/06/15 09:14:53  fredo
335    removed cr+lf
336
337    Revision 1.8  2004/06/07 19:44:43  fredo
338    cleaned out cr+lf for lf
339
340    Revision 1.7  2004/02/10 15:55:42  fredo
341    fixed glyph generation for .notdef glyphs
342
343    Revision 1.6  2004/02/01 22:06:26  fredo
344    beautified caps generation
345
346    Revision 1.5  2004/02/01 19:27:18  fredo
347    fixed width calc for caps
348
349    Revision 1.4  2004/02/01 19:04:31  fredo
350    added caps capability
351
352    Revision 1.3  2003/12/08 13:06:01  Administrator
353    corrected to proper licencing statement
354
355    Revision 1.2  2003/11/30 17:32:48  Administrator
356    merged into default
357
358    Revision 1.1.1.1.2.2  2003/11/30 16:57:05  Administrator
359    merged into default
360
361    Revision 1.1.1.1.2.1  2003/11/30 14:45:23  Administrator
362    added CVS id/log
363
364
365=cut
366
367