File Coverage

blib/lib/PDF/API3/Compat/API2/Resource/Font/SynFont.pm

Criterion	Covered	Total	%
statement	29	139	20.8
branch	0	48	0.0
condition	0	34	0.0
subroutine	10	12	83.3
pod	2	2	100.0
total	41	235	17.4

#=======================================================================
#    ____  ____  _____              _    ____ ___   ____
#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
#
#   A Perl Module Chain to faciliate the Creation and Modification
#   of High-Quality "Portable Document Format (PDF)" Files.
#
#   Copyright 1999-2005 Alfred Reibenschuh .
#
#=======================================================================
#
#   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: SynFont.pm,v 2.2 2008/08/10 14:43:08 areibens Exp $
#
#=======================================================================
package PDF::API3::Compat::API2::Resource::Font::SynFont;

BEGIN {

    use utf8;
    use Encode qw(:all);

    use vars qw( @ISA $VERSION );
    use PDF::API3::Compat::API2::Resource::Font;
    use PDF::API3::Compat::API2::Util;
    use PDF::API3::Compat::API2::Basic::PDF::Utils;
    use Math::Trig;
    use Unicode::UCD 'charinfo';

    @ISA=qw(PDF::API3::Compat::API2::Resource::Font);

    ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.2 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2008/08/10 14:43:08 $

}
no warnings qw[ deprecated recursion uninitialized ];

=head1 NAME

PDF::API3::Compat::API2::Resource::Font::SynFont - Module for using synthetic Fonts.

=head1 SYNOPSIS

    #
    use PDF::API3::Compat::API2;
    #
    $pdf = PDF::API3::Compat::API2->new;
    $sft = $pdf->synfont($cft);
    #

=head1 METHODS

=over 4

=cut

=item $font = PDF::API3::Compat::API2::Resource::Font::SynFont->new $pdf, $fontobj, %options

Returns a synfont object.

=cut

=pod

Valid %options are:

I<-encode>
... changes the encoding of the font from its default.
See I 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.

I<-slant>
... slant/expansion factor (0.1-0.9 = slant, 1.1+ = expansion).

I<-oblique>
... italic angle (+/-)

I<-bold>
... embolding factor (0.1+, bold=1, heavy=2, ...).

I<-space>
... additional charspacing in em (0-1000).

I<-caps>
... create synthetic small-caps.

=cut

sub new
{
    my ($class,$pdf,$font,@opts) = @_;
    my ($self,$data);
    my %opts=@opts;
    my $first=1;
    my $last=255;
    my $slant=$opts{-slant}||1;
    my $oblique=$opts{-oblique}||0;
    my $space=$opts{-space}||'0';
    my $bold=($opts{-bold}||0)*10; # convert to em

    $self->{' slant'}=$slant;
    $self->{' oblique'}=$oblique;
    $self->{' bold'}=$bold;
    $self->{' boldmove'}=0.001;
    $self->{' space'}=$space;

    $class = ref $class if ref $class;
    $self = $class->SUPER::new($pdf,
        pdfkey()
        .'+'.($font->name)
        .($opts{-caps} ? '+Caps' : '')
        .($opts{-vname} ? '+'.$opts{-vname} : '')
    );
    $pdf->new_obj($self) unless($self->is_obj($pdf));
    $self->{' font'}=$font;
    $self->{' data'}={
        'type' => 'Type3',
        'ascender' => $font->ascender,
        'capheight' => $font->capheight,
        'descender' => $font->descender,
        'iscore' => '0',
        'isfixedpitch' => $font->isfixedpitch,
        'italicangle' => $font->italicangle + $oblique,
        'missingwidth' => $font->missingwidth * $slant,
        'underlineposition' => $font->underlineposition,
        'underlinethickness' => $font->underlinethickness,
        'xheight' => $font->xheight,
        'firstchar' => $first,
        'lastchar' => $last,
        'char' => [ '.notdef' ],
        'uni' => [ 0 ],
        'u2e' => { 0 => 0 },
        'fontbbox' => '',
        'wx' => { 'space' => '600' },
    };

    if(ref($font->fontbbox))
    {
        $self->data->{fontbbox}=[ @{$font->fontbbox} ];
    }
    else
    {
        $self->data->{fontbbox}=[ $font->fontbbox ];
    }
    $self->data->{fontbbox}->[0]*=$slant;
    $self->data->{fontbbox}->[2]*=$slant;

    $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 $procs=PDFDict();
    $pdf->new_obj($procs);
    $self->{'CharProcs'} = $procs;

    $self->{Resources}=PDFDict();
    $self->{Resources}->{ProcSet}=PDFArray(map { PDFName($_) } qw[ PDF Text ImageB ImageC ImageI ]);
    my $xo=PDFDict();
    $self->{Resources}->{Font}=$xo;
    $self->{Resources}->{Font}->{FSN}=$font;
    foreach my $w ($first..$last)
    {
        $self->data->{char}->[$w]=$font->glyphByEnc($w);
        $self->data->{uni}->[$w]=uniByName($self->data->{char}->[$w]);
        $self->data->{u2e}->{$self->data->{uni}->[$w]}=$w;
    }

    if($font->isa('PDF::API3::Compat::API2::Resource::CIDFont'))
    {
      $self->{'Encoding'}=PDFDict();
      $self->{'Encoding'}->{Type}=PDFName('Encoding');
      $self->{'Encoding'}->{Differences}=PDFArray();
      foreach my $w ($first..$last)
      {
          if(defined $self->data->{char}->[$w] && $self->data->{char}->[$w] ne '.notdef')
          {
            $self->{'Encoding'}->{Differences}->add_elements(PDFNum($w),PDFName($self->data->{char}->[$w]));
          }
      }
    }
    else
    {
      $self->{'Encoding'}=$font->{Encoding};
    }

    #use Data::Dumper;
    #print Dumper($self->data);
    my @widths=();
    foreach my $w ($first..$last)
    {
        if($self->data->{char}->[$w] eq '.notdef')
        {
            push @widths,$self->missingwidth;
            next;
        }
        my $char=PDFDict();
        my $wth=int($font->width(chr($w))*1000*$slant+2*$space);
        $procs->{$font->glyphByEnc($w)}=$char;
        #$char->{Filter}=PDFArray(PDFName('FlateDecode'));
        $char->{' stream'}=$wth." 0 ".join(' ',map { int($_) } $self->fontbbox)." d1\n";
        $char->{' stream'}.="BT\n";
        $char->{' stream'}.=join(' ',1,0,tan(deg2rad($oblique)),1,0,0)." Tm\n" if($oblique);
        $char->{' stream'}.="2 Tr ".($bold)." w\n" if($bold);
        # my $ci = charinfo($self->data->{uni}->[$w]);
        my $ci={};
  		if ($self->data->{uni}->[$w] ne '')
  		{
    		$ci = charinfo($self->data->{uni}->[$w]);
  		}
        if($opts{-caps} && $ci->{upper})
        {
            $char->{' stream'}.="/FSN 800 Tf\n";
            $char->{' stream'}.=($slant*110)." Tz\n";
            $char->{' stream'}.=" [ -$space ] TJ\n" if($space);
            my $ch=$self->encByUni(hex($ci->{upper}));
            $wth=int($font->width(chr($ch))*800*$slant*1.1+2*$space);
            $char->{' stream'}.=$font->text(chr($ch));
        }
        else
        {
            $char->{' stream'}.="/FSN 1000 Tf\n";
            $char->{' stream'}.=($slant*100)." Tz\n" if($slant!=1);
            $char->{' stream'}.=" [ -$space ] TJ\n" if($space);
            $char->{' stream'}.=$font->text(chr($w));
        }
        $char->{' stream'}.=" Tj\nET\n";
        push @widths,$wth;
        $self->data->{wx}->{$font->glyphByEnc($w)}=$wth;
        $pdf->new_obj($char);
    }

    $procs->{'.notdef'}=$procs->{$font->data->{char}->[32]};
    $self->{Widths}=PDFArray(map { PDFNum($_) } @widths);
    $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::API3::Compat::API2::Resource::Font::SynFont->new_api $api, $fontobj, %options

Returns a synfont object. This method is different from 'new' that
it needs an PDF::API3::Compat::API2-object rather than a PDF::API3::Compat::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);
}

1;

__END__