#=======================================================================
# ____ ____ _____ _ ____ ___ ____
# | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \
# | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) |
# | __/| |_| | _| _ _ / ___ \| __/| | / __/
# |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____|
#
# A Perl Module Chain to faciliate the Creation and Modification
# of High-Quality "Portable Document Format (PDF)" Files.
#
# Copyright 1999-2005 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: CIDFont.pm,v 2.3 2007/03/17 20:38:50 areibens Exp $
#
#=======================================================================
package PDF::API2::Resource::CIDFont;
BEGIN
{
use utf8;
use Encode qw(:all);
use PDF::API2::Util;
use PDF::API2::Basic::PDF::Utils;
use PDF::API2::Resource::BaseFont;
use POSIX;
use vars qw(@ISA $VERSION);
@ISA = qw( PDF::API2::Resource::BaseFont );
( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.3 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2007/03/17 20:38:50 $
}
no warnings qw[ deprecated recursion uninitialized ];
=item $font = PDF::API2::Resource::CIDFont->new $pdf, $name
Returns a cid-font object. base class form all CID based fonts.
=cut
sub new
{
my ($class,$pdf,$name,@opts) = @_;
my %opts=();
%opts=@opts if((scalar @opts)%2 == 0);
$class = ref $class if ref $class;
my $self=$class->SUPER::new($pdf,$name);
$pdf->new_obj($self) if(defined($pdf) && !$self->is_obj($pdf));
$self->{Type} = PDFName('Font');
$self->{'Subtype'} = PDFName('Type0');
$self->{'Encoding'} = PDFName('Identity-H');
my $de=PDFDict();
$pdf->new_obj($de);
$self->{'DescendantFonts'} = PDFArray($de);
$de->{'Type'} = PDFName('Font');
$de->{'CIDSystemInfo'} = PDFDict();
$de->{'CIDSystemInfo'}->{Registry} = PDFStr('Adobe');
$de->{'CIDSystemInfo'}->{Ordering} = PDFStr('Identity');
$de->{'CIDSystemInfo'}->{Supplement} = PDFNum(0);
$de->{'CIDToGIDMap'} = PDFName('Identity');
$self->{' de'} = $de;
return($self);
}
=item $font = PDF::API2::Resource::CIDFont->new_api $api, $name, %options
Returns a cid-font object. This method is different from 'new' that
it needs an PDF::API2-object rather than a Text::PDF::File-object.
=cut
sub new_api
{
my ($class,$api,@opts)=@_;
my $obj=$class->new($api->{pdf},@opts);
$self->{' api'}=$api;
$api->{pdf}->out_obj($api->{pages});
return($obj);
}
sub glyphByCId { return( $_[0]->data->{g2n}->[$_[1]] ); }
sub uniByCId { return( $_[0]->data->{g2u}->[$_[1]] ); }
sub cidByUni { return( $_[0]->data->{u2g}->{$_[1]} ); }
sub cidByEnc { return( $_[0]->data->{e2g}->[$_[1]] ); }
sub wxByCId
{
my $self=shift @_;
my $g=shift @_;
my $w;
if(ref($self->data->{wx}) eq 'ARRAY' && defined $self->data->{wx}->[$g])
{
$w = int($self->data->{wx}->[$g]);
}
elsif(ref($self->data->{wx}) eq 'HASH' && defined $self->data->{wx}->{$g})
{
$w = int($self->data->{wx}->{$g});
}
else
{
$w = $self->missingwidth;
}
return($w);
}
sub wxByUni { return( $_[0]->wxByCId($_[0]->data->{u2g}->{$_[1]}) ); }
sub wxByEnc { return( $_[0]->wxByCId($_[0]->data->{e2g}->[$_[1]]) ); }
sub width
{
my ($self,$text)=@_;
return($self->width_cid($self->cidsByStr($text)));
}
sub width_cid
{
my ($self,$text)=@_;
my $width=0;
my $lastglyph=0;
foreach my $n (unpack('n*',$text))
{
$width+=$self->wxByCId($n);
if($self->{-dokern} && $self->haveKernPairs())
{
if($self->kernPairCid($lastglyph, $n))
{
$width-=$self->kernPairCid($lastglyph, $n);
}
}
$lastglyph=$n;
}
$width/=1000;
return($width);
}
=item $cidstring = $font->cidsByStr $string
Returns the cid-string from string based on the fonts encoding map.
=cut
sub _cidsByStr
{
my ($self,$s)=@_;
$s=pack('n*',map { $self->cidByEnc($_) } unpack('C*',$s));
return($s);
}
sub cidsByStr
{
my ($self,$text)=@_;
if(is_utf8($text) && defined $self->data->{decode} && $self->data->{decode} ne 'ident')
{
$text=encode($self->data->{decode},$text);
}
elsif(is_utf8($text) && $self->data->{decode} eq 'ident')
{
$text=$self->cidsByUtf($text);
}
elsif(!is_utf8($text) && defined $self->data->{encode} && $self->data->{decode} eq 'ident')
{
$text=$self->cidsByUtf(decode($self->data->{encode},$text));
}
elsif(!is_utf8($text) && UNIVERSAL::can($self,'issymbol') && $self->issymbol && $self->data->{decode} eq 'ident')
{
$text=pack('U*',(map { $_+0xf000 } unpack('C*',$text)));
$text=$self->cidsByUtf($text);
}
else
{
$text=$self->_cidsByStr($text);
}
return($text);
}
=item $cidstring = $font->cidsByUtf $utf8string
Returns the cid-encoded string from utf8-string.
=cut
sub cidsByUtf {
my ($self,$s)=@_;
$s=pack('n*',map { $self->cidByUni($_) } (map { $_>0x7f && $_<0xA0 ? uniByName(nameByUni($_)): $_ } unpack('U*',$s)));
utf8::downgrade($s);
return($s);
}
sub textByStr
{
my ($self,$text)=@_;
return($self->text_cid($self->cidsByStr($text)));
}
sub textByStrKern
{
my ($self,$text,$size,$ident)=@_;
return($self->text_cid_kern($self->cidsByStr($text),$size,$ident));
}
sub text
{
my ($self,$text,$size,$ident)=@_;
my $newtext=$self->textByStr($text);
if(defined $size && $self->{-dokern})
{
$newtext=$self->textByStrKern($text,$size,$ident);
return($newtext);
}
elsif(defined $size)
{
if(defined($ident) && $ident!=0)
{
return("[ $ident $newtext ] TJ");
}
else
{
return("$newtext Tj");
}
}
else
{
return($newtext);
}
}
sub text_cid
{
my ($self,$text,$size)=@_;
if(UNIVERSAL::can($self,'fontfile'))
{
foreach my $g (unpack('n*',$text))
{
$self->fontfile->subsetByCId($g);
}
}
my $newtext=unpack('H*',$text);
if(defined $size)
{
return("<$newtext> Tj");
}
else
{
return("<$newtext>");
}
}
sub text_cid_kern
{
my ($self,$text,$size,$ident)=@_;
if(UNIVERSAL::can($self,'fontfile'))
{
foreach my $g (unpack('n*',$text))
{
$self->fontfile->subsetByCId($g);
}
}
if(defined $size && $self->{-dokern} && $self->haveKernPairs())
{
my $newtext=' ';
my $lastglyph=0;
my $tBefore=0;
foreach my $n (unpack('n*',$text))
{
if($self->kernPairCid($lastglyph, $n))
{
$newtext.='> ' if($tBefore);
$newtext.=sprintf('%i ',$self->kernPairCid($lastglyph, $n));
$tBefore=0;
}
$lastglyph=$n;
my $t=sprintf('%04X',$n);
$newtext.='<' if(!$tBefore);
$newtext.=$t;
$tBefore=1;
}
$newtext.='> ' if($tBefore);
if(defined($ident) && $ident!=0)
{
return("[ $ident $newtext ] TJ");
}
else
{
return("[ $newtext ] TJ");
}
}
elsif(defined $size)
{
my $newtext=unpack('H*',$text);
if(defined($ident) && $ident!=0)
{
return("[ $ident <$newtext> ] TJ");
}
else
{
return("<$newtext> Tj");
}
}
else
{
my $newtext=unpack('H*',$text);
return("<$newtext>");
}
}
sub kernPairCid
{
return(0);
}
sub haveKernPairs
{
return(0);
}
sub encodeByName
{
my ($self,$enc) = @_;
return if($self->issymbol);
$self->data->{e2u}=[ map { $_>0x7f && $_<0xA0 ? uniByName(nameByUni($_)): $_ } unpack('U*',decode($enc, pack('C*',0..255))) ] if(defined $enc);
$self->data->{e2n}=[ map { $self->data->{g2n}->[$self->data->{u2g}->{$_} || 0] || '.notdef' } @{$self->data->{e2u}} ];
$self->data->{e2g}=[ map { $self->data->{u2g}->{$_} || 0 } @{$self->data->{e2u}} ];
$self->data->{u2e}={};
foreach my $n (reverse 0..255)
{
$self->data->{u2e}->{$self->data->{e2u}->[$n]}=$n unless(defined $self->data->{u2e}->{$self->data->{e2u}->[$n]});
}
return($self);
}
sub subsetByCId
{
return(1);
}
sub subvec
{
return(1);
}
sub glyphNum
{
my $self=shift @_;
if(defined $self->data->{glyphs})
{
return ( $self->data->{glyphs} );
}
return ( scalar @{$self->data->{wx}} );
}
sub outobjdeep
{
my ($self, $fh, $pdf, %opts) = @_;
return $self->SUPER::outobjdeep($fh, $pdf) if defined $opts{'passthru'};
$self->SUPER::outobjdeep($fh, $pdf, %opts);
}
1;
__END__
=head1 AUTHOR
alfred reibenschuh
=head1 HISTORY
$Log: CIDFont.pm,v $
Revision 2.3 2007/03/17 20:38:50 areibens
replaced IOString dep. with scalar IO.
Revision 2.2 2007/01/04 16:02:28 areibens
applied untested fix for acrobat 8 "<ident> TJ" bug
Revision 2.1 2006/06/19 19:22:07 areibens
removed dup sub
Revision 2.0 2005/11/16 02:16:04 areibens
revision workaround for SF cvs import not to screw up CPAN
Revision 1.2 2005/11/16 01:27:48 areibens
genesis2
Revision 1.1 2005/11/16 01:19:25 areibens
genesis
Revision 1.15 2005/10/20 21:05:05 fredo
added handling of optional kerning
Revision 1.14 2005/06/17 19:44:03 fredo
fixed CPAN modulefile versioning (again)
Revision 1.13 2005/06/17 18:53:34 fredo
fixed CPAN modulefile versioning (dislikes cvs)
Revision 1.12 2005/03/14 22:01:06 fredo
upd 2005
Revision 1.11 2004/12/16 00:30:53 fredo
added no warn for recursion
Revision 1.10 2004/11/24 20:10:55 fredo
added virtual font handling
Revision 1.9 2004/11/22 21:07:55 fredo
fixed multibyte-encoding support to work consistently acress cjk/ttf/otf
Revision 1.8 2004/11/21 02:57:53 fredo
cosmetic change
Revision 1.7 2004/10/26 14:42:49 fredo
added alternative glyph-width storage/retrieval
Revision 1.6 2004/06/15 09:14:41 fredo
removed cr+lf
Revision 1.5 2004/06/07 19:44:36 fredo
cleaned out cr+lf for lf
Revision 1.4 2003/12/08 13:05:33 Administrator
corrected to proper licencing statement
Revision 1.3 2003/11/30 17:28:54 Administrator
merged into default
Revision 1.2.2.1 2003/11/30 16:56:35 Administrator
merged into default
Revision 1.2 2003/11/30 11:44:49 Administrator
added CVS id/log
=cut