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