#=======================================================================
#    ____  ____  _____              _    ____ ___   ____
#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
#
#   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: SynFont.pm,v 1.14 2004/12/29 01:13:21 fredo Exp $
#
#=======================================================================
package PDF::API2::Resource::Font::SynFont;

BEGIN {

    use utf8;
    use Encode qw(:all);

    use vars qw( @ISA $VERSION );
    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.14 $' =~ /Revision: (\S+)\s/; # $Date: 2004/12/29 01:13:21 $

}
no warnings qw[ deprecated recursion uninitialized ];

=head1 NAME

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

=head1 SYNOPSIS

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

=head1 METHODS

=over 4

=cut

=item $font = PDF::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<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.

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 ) );

    $self->{'Encoding'}=$font->{Encoding};

    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;
    }
    #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]);
        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'}.=$self->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'}.=$self->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::API2::Resource::Font::SynFont->new_api $api, $fontobj, %options

Returns a synfont 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);
}

1;

__END__

=back

=head1 AUTHOR

alfred reibenschuh

=head1 HISTORY

    $Log: SynFont.pm,v $
    Revision 1.14  2004/12/29 01:13:21  fredo
    documented -caps option

    Revision 1.13  2004/12/16 00:30:54  fredo
    added no warn for recursion

    Revision 1.12  2004/11/29 10:00:54  fredo
    added charspacer docs

    Revision 1.11  2004/11/26 15:14:59  fredo
    fixed docs

    Revision 1.10  2004/11/26 15:10:38  fredo
    added spacer mod option

    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