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: SynFont.pm,v 2.2 2008/08/10 14:43:08 areibens Exp $ 31# 32#======================================================================= 33package PDF::API3::Compat::API2::Resource::Font::SynFont; 34 35BEGIN { 36 37 use utf8; 38 use Encode qw(:all); 39 40 use vars qw( @ISA $VERSION ); 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.2 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2008/08/10 14:43:08 $ 50 51} 52no warnings qw[ deprecated recursion uninitialized ]; 53 54=head1 NAME 55 56PDF::API3::Compat::API2::Resource::Font::SynFont - Module for using synthetic Fonts. 57 58=head1 SYNOPSIS 59 60 # 61 use PDF::API3::Compat::API2; 62 # 63 $pdf = PDF::API3::Compat::API2->new; 64 $sft = $pdf->synfont($cft); 65 # 66 67=head1 METHODS 68 69=over 4 70 71=cut 72 73=item $font = PDF::API3::Compat::API2::Resource::Font::SynFont->new $pdf, $fontobj, %options 74 75Returns a synfont object. 76 77=cut 78 79=pod 80 81Valid %options are: 82 83I<-encode> 84... changes the encoding of the font from its default. 85See I<perl's Encode> for the supported values. 86 87I<-pdfname> 88... changes the reference-name of the font from its default. 89The reference-name is normally generated automatically and can be 90retrived via $pdfname=$font->name. 91 92I<-slant> 93... slant/expansion factor (0.1-0.9 = slant, 1.1+ = expansion). 94 95I<-oblique> 96... italic angle (+/-) 97 98I<-bold> 99... embolding factor (0.1+, bold=1, heavy=2, ...). 100 101I<-space> 102... additional charspacing in em (0-1000). 103 104I<-caps> 105... create synthetic small-caps. 106 107=cut 108 109sub new 110{ 111 my ($class,$pdf,$font,@opts) = @_; 112 my ($self,$data); 113 my %opts=@opts; 114 my $first=1; 115 my $last=255; 116 my $slant=$opts{-slant}||1; 117 my $oblique=$opts{-oblique}||0; 118 my $space=$opts{-space}||'0'; 119 my $bold=($opts{-bold}||0)*10; # convert to em 120 121 $self->{' slant'}=$slant; 122 $self->{' oblique'}=$oblique; 123 $self->{' bold'}=$bold; 124 $self->{' boldmove'}=0.001; 125 $self->{' space'}=$space; 126 127 $class = ref $class if ref $class; 128 $self = $class->SUPER::new($pdf, 129 pdfkey() 130 .'+'.($font->name) 131 .($opts{-caps} ? '+Caps' : '') 132 .($opts{-vname} ? '+'.$opts{-vname} : '') 133 ); 134 $pdf->new_obj($self) unless($self->is_obj($pdf)); 135 $self->{' font'}=$font; 136 $self->{' data'}={ 137 'type' => 'Type3', 138 'ascender' => $font->ascender, 139 'capheight' => $font->capheight, 140 'descender' => $font->descender, 141 'iscore' => '0', 142 'isfixedpitch' => $font->isfixedpitch, 143 'italicangle' => $font->italicangle + $oblique, 144 'missingwidth' => $font->missingwidth * $slant, 145 'underlineposition' => $font->underlineposition, 146 'underlinethickness' => $font->underlinethickness, 147 'xheight' => $font->xheight, 148 'firstchar' => $first, 149 'lastchar' => $last, 150 'char' => [ '.notdef' ], 151 'uni' => [ 0 ], 152 'u2e' => { 0 => 0 }, 153 'fontbbox' => '', 154 'wx' => { 'space' => '600' }, 155 }; 156 157 if(ref($font->fontbbox)) 158 { 159 $self->data->{fontbbox}=[ @{$font->fontbbox} ]; 160 } 161 else 162 { 163 $self->data->{fontbbox}=[ $font->fontbbox ]; 164 } 165 $self->data->{fontbbox}->[0]*=$slant; 166 $self->data->{fontbbox}->[2]*=$slant; 167 168 $self->{'Subtype'} = PDFName('Type3'); 169 $self->{'FirstChar'} = PDFNum($first); 170 $self->{'LastChar'} = PDFNum($last); 171 $self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } ( 0.001, 0, 0, 0.001, 0, 0 ) ); 172 $self->{'FontBBox'} = PDFArray(map { PDFNum($_) } ( $self->fontbbox ) ); 173 174 my $procs=PDFDict(); 175 $pdf->new_obj($procs); 176 $self->{'CharProcs'} = $procs; 177 178 $self->{Resources}=PDFDict(); 179 $self->{Resources}->{ProcSet}=PDFArray(map { PDFName($_) } qw[ PDF Text ImageB ImageC ImageI ]); 180 my $xo=PDFDict(); 181 $self->{Resources}->{Font}=$xo; 182 $self->{Resources}->{Font}->{FSN}=$font; 183 foreach my $w ($first..$last) 184 { 185 $self->data->{char}->[$w]=$font->glyphByEnc($w); 186 $self->data->{uni}->[$w]=uniByName($self->data->{char}->[$w]); 187 $self->data->{u2e}->{$self->data->{uni}->[$w]}=$w; 188 } 189 190 if($font->isa('PDF::API3::Compat::API2::Resource::CIDFont')) 191 { 192 $self->{'Encoding'}=PDFDict(); 193 $self->{'Encoding'}->{Type}=PDFName('Encoding'); 194 $self->{'Encoding'}->{Differences}=PDFArray(); 195 foreach my $w ($first..$last) 196 { 197 if(defined $self->data->{char}->[$w] && $self->data->{char}->[$w] ne '.notdef') 198 { 199 $self->{'Encoding'}->{Differences}->add_elements(PDFNum($w),PDFName($self->data->{char}->[$w])); 200 } 201 } 202 } 203 else 204 { 205 $self->{'Encoding'}=$font->{Encoding}; 206 } 207 208 #use Data::Dumper; 209 #print Dumper($self->data); 210 my @widths=(); 211 foreach my $w ($first..$last) 212 { 213 if($self->data->{char}->[$w] eq '.notdef') 214 { 215 push @widths,$self->missingwidth; 216 next; 217 } 218 my $char=PDFDict(); 219 my $wth=int($font->width(chr($w))*1000*$slant+2*$space); 220 $procs->{$font->glyphByEnc($w)}=$char; 221 #$char->{Filter}=PDFArray(PDFName('FlateDecode')); 222 $char->{' stream'}=$wth." 0 ".join(' ',map { int($_) } $self->fontbbox)." d1\n"; 223 $char->{' stream'}.="BT\n"; 224 $char->{' stream'}.=join(' ',1,0,tan(deg2rad($oblique)),1,0,0)." Tm\n" if($oblique); 225 $char->{' stream'}.="2 Tr ".($bold)." w\n" if($bold); 226 # my $ci = charinfo($self->data->{uni}->[$w]); 227 my $ci={}; 228 if ($self->data->{uni}->[$w] ne '') 229 { 230 $ci = charinfo($self->data->{uni}->[$w]); 231 } 232 if($opts{-caps} && $ci->{upper}) 233 { 234 $char->{' stream'}.="/FSN 800 Tf\n"; 235 $char->{' stream'}.=($slant*110)." Tz\n"; 236 $char->{' stream'}.=" [ -$space ] TJ\n" if($space); 237 my $ch=$self->encByUni(hex($ci->{upper})); 238 $wth=int($font->width(chr($ch))*800*$slant*1.1+2*$space); 239 $char->{' stream'}.=$font->text(chr($ch)); 240 } 241 else 242 { 243 $char->{' stream'}.="/FSN 1000 Tf\n"; 244 $char->{' stream'}.=($slant*100)." Tz\n" if($slant!=1); 245 $char->{' stream'}.=" [ -$space ] TJ\n" if($space); 246 $char->{' stream'}.=$font->text(chr($w)); 247 } 248 $char->{' stream'}.=" Tj\nET\n"; 249 push @widths,$wth; 250 $self->data->{wx}->{$font->glyphByEnc($w)}=$wth; 251 $pdf->new_obj($char); 252 } 253 254 $procs->{'.notdef'}=$procs->{$font->data->{char}->[32]}; 255 $self->{Widths}=PDFArray(map { PDFNum($_) } @widths); 256 $self->data->{e2n}=$self->data->{char}; 257 $self->data->{e2u}=$self->data->{uni}; 258 259 $self->data->{u2c}={}; 260 $self->data->{u2e}={}; 261 $self->data->{u2n}={}; 262 $self->data->{n2c}={}; 263 $self->data->{n2e}={}; 264 $self->data->{n2u}={}; 265 266 foreach my $n (reverse 0..255) 267 { 268 $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'}); 269 $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'}); 270 271 $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'}=$self->data->{e2u}->[$n] unless(defined $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'}); 272 $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'}=$self->data->{uni}->[$n] unless(defined $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'}); 273 274 $self->data->{u2c}->{$self->data->{uni}->[$n]}=$n unless(defined $self->data->{u2c}->{$self->data->{uni}->[$n]}); 275 $self->data->{u2e}->{$self->data->{e2u}->[$n]}=$n unless(defined $self->data->{u2e}->{$self->data->{e2u}->[$n]}); 276 277 $self->data->{u2n}->{$self->data->{e2u}->[$n]}=($self->data->{e2n}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{e2u}->[$n]}); 278 $self->data->{u2n}->{$self->data->{uni}->[$n]}=($self->data->{char}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{uni}->[$n]}); 279 } 280 281 return($self); 282} 283 284 285=item $font = PDF::API3::Compat::API2::Resource::Font::SynFont->new_api $api, $fontobj, %options 286 287Returns a synfont object. This method is different from 'new' that 288it needs an PDF::API3::Compat::API2-object rather than a PDF::API3::Compat::API2::PDF::File-object. 289 290=cut 291 292sub new_api 293{ 294 my ($class,$api,@opts)=@_; 295 296 my $obj=$class->new($api->{pdf},@opts); 297 298 $api->{pdf}->new_obj($obj) unless($obj->is_obj($api->{pdf})); 299 300 $api->{pdf}->out_obj($api->{pages}); 301 return($obj); 302} 303 3041; 305 306__END__ 307 308=back 309 310=head1 AUTHOR 311 312alfred reibenschuh 313 314=head1 HISTORY 315 316 $Log: SynFont.pm,v $ 317 Revision 2.2 2008/08/10 14:43:08 areibens 318 update dejavu to 2.25 319 320 Revision 2.1 2007/04/18 05:26:48 areibens 321 fixed unicode caos handling for some broken fonts having no unicode for a glyph 322 323 Revision 2.0 2005/11/16 02:18:14 areibens 324 revision workaround for SF cvs import not to screw up CPAN 325 326 Revision 1.2 2005/11/16 01:27:50 areibens 327 genesis2 328 329 Revision 1.1 2005/11/16 01:19:27 areibens 330 genesis 331 332 Revision 1.17 2005/06/17 19:44:03 fredo 333 fixed CPAN modulefile versioning (again) 334 335 Revision 1.16 2005/06/17 18:53:34 fredo 336 fixed CPAN modulefile versioning (dislikes cvs) 337 338 Revision 1.14 2004/12/29 01:13:21 fredo 339 documented -caps option 340 341 Revision 1.13 2004/12/16 00:30:54 fredo 342 added no warn for recursion 343 344 Revision 1.12 2004/11/29 10:00:54 fredo 345 added charspacer docs 346 347 Revision 1.11 2004/11/26 15:14:59 fredo 348 fixed docs 349 350 Revision 1.10 2004/11/26 15:10:38 fredo 351 added spacer mod option 352 353 Revision 1.9 2004/06/15 09:14:53 fredo 354 removed cr+lf 355 356 Revision 1.8 2004/06/07 19:44:43 fredo 357 cleaned out cr+lf for lf 358 359 Revision 1.7 2004/02/10 15:55:42 fredo 360 fixed glyph generation for .notdef glyphs 361 362 Revision 1.6 2004/02/01 22:06:26 fredo 363 beautified caps generation 364 365 Revision 1.5 2004/02/01 19:27:18 fredo 366 fixed width calc for caps 367 368 Revision 1.4 2004/02/01 19:04:31 fredo 369 added caps capability 370 371 Revision 1.3 2003/12/08 13:06:01 Administrator 372 corrected to proper licencing statement 373 374 Revision 1.2 2003/11/30 17:32:48 Administrator 375 merged into default 376 377 Revision 1.1.1.1.2.2 2003/11/30 16:57:05 Administrator 378 merged into default 379 380 Revision 1.1.1.1.2.1 2003/11/30 14:45:23 Administrator 381 added CVS id/log 382 383 384=cut 385 386