#======================================================================= # ____ ____ _____ _ ____ ___ ____ # | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \ # | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) | # | __/| |_| | _| _ _ / ___ \| __/| | / __/ # |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____| # # A Perl Module Chain to faciliate the Creation and Modification # of High-Quality "Portable Document Format (PDF)" Files. # # Copyright 1999-2004 Alfred Reibenschuh <areibens@cpan.org>. # #======================================================================= # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # # $Id: BdFont.pm,v 1.3 2004/12/16 00:30:54 fredo Exp $ # #======================================================================= package PDF::API2::Resource::Font::BdFont; BEGIN { use utf8; use Encode qw(:all); use vars qw( @ISA $VERSION $BmpNum); use PDF::API2::Resource::Font; use PDF::API2::Util; use PDF::API2::Basic::PDF::Utils; use Math::Trig; use Unicode::UCD 'charinfo'; @ISA=qw(PDF::API2::Resource::Font); ( $VERSION ) = '$Revision: 1.3 $' =~ /Revision: (\S+)\s/; # $Date: 2004/12/16 00:30:54 $ $BmpNum=0; } no warnings qw[ deprecated recursion uninitialized ]; =head1 NAME PDF::API2::Resource::Font::BdFont - Module for using bitmapped Fonts. =head1 SYNOPSIS # use PDF::API2; # $pdf = PDF::API2->new; $sft = $pdf->bdfont($file); # =head1 METHODS =over 4 =cut =item $font = PDF::API2::Resource::Font::BdFont->new $pdf, $font, %options Returns a BmpFont object. =cut =pod Valid %options are: I<-encode> ... changes the encoding of the font from its default. See I<perl's Encode> for the supported values. I<-pdfname> ... changes the reference-name of the font from its default. The reference-name is normally generated automatically and can be retrived via $pdfname=$font->name. =cut sub new { my ($class,$pdf,$file,@opts) = @_; my ($self,$data); my %opts=@opts; $class = ref $class if ref $class; $self = $class->SUPER::new($pdf, sprintf('%s+Bdf%02i',pdfkey(),++$BmpNum)); $pdf->new_obj($self) unless($self->is_obj($pdf)); # adobe bitmap distribution font $self->{' data'}=$self->readBDF($file); my $first=1; my $last=255; $self->{'Subtype'} = PDFName('Type3'); $self->{'FirstChar'} = PDFNum($first); $self->{'LastChar'} = PDFNum($last); $self->{'FontMatrix'} = PDFArray(map { PDFNum($_) } ( 0.001, 0, 0, 0.001, 0, 0 ) ); $self->{'FontBBox'} = PDFArray(map { PDFNum($_) } ( $self->fontbbox ) ); my $xo=PDFDict(); $self->{'Encoding'}=$xo; $xo->{Type}=PDFName('Encoding'); $xo->{BaseEncoding}=PDFName('WinAnsiEncoding'); $xo->{Differences}=PDFArray(PDFNum('0'),(map { PDFName($_||'.notdef') } @{$self->data->{char}})); my $procs=PDFDict(); $pdf->new_obj($procs); $self->{'CharProcs'} = $procs; $self->{Resources}=PDFDict(); $self->{Resources}->{ProcSet}=PDFArray(map { PDFName($_) } qw(PDF Text ImageB ImageC ImageI)); foreach my $w ($first..$last) { $self->data->{uni}->[$w]=uniByName($self->data->{char}->[$w]); $self->data->{u2e}->{$self->data->{uni}->[$w]}=$w; } my @widths=(); foreach my $w (@{$self->data->{char2}}) { $widths[$w->{ENCODING}]=$self->data->{wx}->{$w->{NAME}}; my @bbx=@{$w->{BBX}}; my $stream=pack('H*',$w->{hex}); my $y=$bbx[1]; my $char=PDFDict(); $char->{Filter}=PDFArray(PDFName('FlateDecode')); ## $char->{' stream'}=$widths[$w->{ENCODING}]." 0 ".join(' ',map { int($_) } $self->fontbbox)." d1\n"; $char->{' stream'}=$widths[$w->{ENCODING}]." 0 d0\n"; $char->{Comment}=PDFStr("N='$w->{NAME}' C=($w->{ENCODING})"); $procs->{$w->{NAME}}=$char; @bbx=map { $_*1000/$self->data->{upm} } @bbx; if($y==0) { $char->{' stream'}.="q Q\n"; } else { my $x=8*length($stream)/$y; # q $x 0 0 $y 50 50 cm 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|; $procs->{$self->data->{char}->[$w]}=$char; $char->{' stream'}.="$bbx[0] 0 0 $bbx[1] $bbx[2] $bbx[3] cm\n$img\n"; } $pdf->new_obj($char); } $procs->{'.notdef'}=$procs->{$self->data->{char}->[32]}; delete $procs->{''}; $self->{Widths}=PDFArray(map { PDFNum($widths[$_]||0) } ($first..$last)); $self->data->{e2n}=$self->data->{char}; $self->data->{e2u}=$self->data->{uni}; $self->data->{u2c}={}; $self->data->{u2e}={}; $self->data->{u2n}={}; $self->data->{n2c}={}; $self->data->{n2e}={}; $self->data->{n2u}={}; foreach my $n (reverse 0..255) { $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2c}->{$self->data->{char}->[$n] || '.notdef'}); $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'}=$n unless(defined $self->data->{n2e}->{$self->data->{e2n}->[$n] || '.notdef'}); $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'}=$self->data->{e2u}->[$n] unless(defined $self->data->{n2u}->{$self->data->{e2n}->[$n] || '.notdef'}); $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'}=$self->data->{uni}->[$n] unless(defined $self->data->{n2u}->{$self->data->{char}->[$n] || '.notdef'}); $self->data->{u2c}->{$self->data->{uni}->[$n]}=$n unless(defined $self->data->{u2c}->{$self->data->{uni}->[$n]}); $self->data->{u2e}->{$self->data->{e2u}->[$n]}=$n unless(defined $self->data->{u2e}->{$self->data->{e2u}->[$n]}); $self->data->{u2n}->{$self->data->{e2u}->[$n]}=($self->data->{e2n}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{e2u}->[$n]}); $self->data->{u2n}->{$self->data->{uni}->[$n]}=($self->data->{char}->[$n] || '.notdef') unless(defined $self->data->{u2n}->{$self->data->{uni}->[$n]}); } return($self); } =item $font = PDF::API2::Resource::Font::BdFont->new_api $api, %options Returns a BdFont object. This method is different from 'new' that it needs an PDF::API2-object rather than a PDF::API2::PDF::File-object. =cut sub new_api { my ($class,$api,@opts)=@_; my $obj=$class->new($api->{pdf},@opts); $api->{pdf}->new_obj($obj) unless($obj->is_obj($api->{pdf})); $api->{pdf}->out_obj($api->{pages}); return($obj); } sub readBDF { my ($self,$file)=@_; my $data={}; $data->{char}=[]; $data->{char2}=[]; $data->{wx}={}; if(! -e $file) {die "file='$file' not existant.";} open(AFMF, $file) or die "Can't find the BDF file for $file"; local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR while ($_=<AFMF>) { chomp($_); if (/^STARTCHAR/ .. /^ENDCHAR/) { if (/^STARTCHAR\s+(\S+)/) { my $name=$1; $name=~s|^(\d+.*)$|X_$1|; push @{$data->{char2}},{'NAME'=>$name}; } elsif (/^BITMAP/ .. /^ENDCHAR/) { next if(/^BITMAP/); if(/^ENDCHAR/){ $data->{char2}->[-1]->{NAME}||='E_'.$data->{char2}->[-1]->{ENCODING}; $data->{char}->[$data->{char2}->[-1]->{ENCODING}]=$data->{char2}->[-1]->{NAME}; ($data->{wx}->{$data->{char2}->[-1]->{NAME}})=split(/\s+/,$data->{char2}->[-1]->{SWIDTH}); $data->{char2}->[-1]->{BBX}=[split(/\s+/,$data->{char2}->[-1]->{BBX})]; } else { $data->{char2}->[-1]->{hex}.=$_; } } else { m|^(\S+)\s+(.+)$|; $data->{char2}->[-1]->{uc($1)}.=$2; } ## } elsif(/^STARTPROPERTIES/ .. /^ENDPROPERTIES/) { } else { m|^(\S+)\s+(.+)$|; $data->{uc($1)}.=$2; } } close(AFMF); unless (exists $data->{wx}->{'.notdef'}) { $data->{wx}->{'.notdef'} = 0; $data->{bbox}{'.notdef'} = [0, 0, 0, 0]; } $data->{fontname}=pdfkey().'+'.time(); $data->{apiname}=$data->{fontname}; $data->{flags} = 34; $data->{fontbbox} = [ split(/\s+/,$data->{FONTBOUNDINGBOX}) ]; $data->{upm}=$data->{PIXEL_SIZE} || ($data->{fontbbox}->[1] - $data->{fontbbox}->[3]); @{$data->{fontbbox}} = map { int($_*1000/$data->{upm}) } @{$data->{fontbbox}}; foreach my $n (0..255) { $data->{char}->[$n]||='.notdef'; # $data->{wx}->{$data->{char}->[$n]}=int($data->{wx}->{$data->{char}->[$n]}*1000/$data->{upm}); } $data->{uni}||=[]; foreach my $n (0..255) { $data->{uni}->[$n]=uniByName($data->{char}->[$n] || '.notdef') || 0; } $data->{ascender}=$data->{RAW_ASCENT} || int($data->{FONT_ASCENT}*1000/$data->{upm}); $data->{descender}=$data->{RAW_DESCENT} || int($data->{FONT_DESCENT}*1000/$data->{upm}); $data->{type}='Type3'; $data->{capheight}=1000; $data->{iscore}=0; $data->{issymbol} = 0; $data->{isfixedpitch}=0; $data->{italicangle}=0; $data->{missingwidth}=$data->{AVERAGE_WIDTH} || int($data->{FONT_AVERAGE_WIDTH}*1000/$data->{upm}) || $data->{RAW_AVERAGE_WIDTH} || 500; $data->{underlineposition}=-200; $data->{underlinethickness}=10; $data->{xheight}=$data->{RAW_XHEIGHT} || int($data->{FONT_XHEIGHT}*1000/$data->{upm}) || int($data->{ascender}/2); $data->{firstchar}=1; $data->{lastchar}=255; delete $data->{wx}->{''}; return($data); } 1; __END__ =back =head1 AUTHOR alfred reibenschuh =head1 HISTORY $Log: BdFont.pm,v $ Revision 1.3 2004/12/16 00:30:54 fredo added no warn for recursion Revision 1.2 2004/07/24 23:33:35 fredo added compression Revision 1.1 2004/07/24 23:08:57 fredo genesis Revision 1.9 2004/06/15 09:14:53 fredo removed cr+lf Revision 1.8 2004/06/07 19:44:43 fredo cleaned out cr+lf for lf Revision 1.7 2004/02/10 15:55:42 fredo fixed glyph generation for .notdef glyphs Revision 1.6 2004/02/01 22:06:26 fredo beautified caps generation Revision 1.5 2004/02/01 19:27:18 fredo fixed width calc for caps Revision 1.4 2004/02/01 19:04:31 fredo added caps capability Revision 1.3 2003/12/08 13:06:01 Administrator corrected to proper licencing statement Revision 1.2 2003/11/30 17:32:48 Administrator merged into default Revision 1.1.1.1.2.2 2003/11/30 16:57:05 Administrator merged into default Revision 1.1.1.1.2.1 2003/11/30 14:45:23 Administrator added CVS id/log =cut