libtext-pdf-perl 0.31-1 / usr / share / perl5 / Text / PDF / TTFont0.pm

package Text::PDF::TTFont0;

=head1 NAME

Text::PDF::TTFont0 - Inherits from L<PDF::Dict> and represents a TrueType Type 0
font within a PDF file.

=head1 DESCRIPTION

A font consists of two primary parts in a PDF file: the header and the font
descriptor. Whilst two fonts may share font descriptors, they will have their
own header dictionaries including encoding and widhth information.

=head1 INSTANCE VARIABLES

There are no instance variables beyond the variables which directly correspond
to entries in the appropriate PDF dictionaries.

=head1 METHODS

=cut

use strict;
use vars qw(@ISA);
# no warnings qw(uninitialized);

use Text::PDF::TTFont;
use Text::PDF::Dict;
@ISA = qw(Text::PDF::TTFont);

use Font::TTF::Font;
use Text::PDF::Utils;

=head2 Text::PDF::TTFont->new($parent, $fontfname. $pdfname)

Creates a new font resource for the given fontfile. This includes the font
descriptor and the font stream. The $pdfname is the name by which this font
resource will be known throughout a particular PDF file.

All font resources are full PDF objects.

=cut

sub new
{
    my ($class, $parent, $fontname, $pdfname, %opt) = @_;
    my ($desc, $sinfo, $unistr, $touni, @rev);
    my ($i, $first, $num, $upem, @wid, $name, $ff2, $ffh);

    my ($self) = $class->SUPER::new($parent, $fontname, $pdfname, -istype0 => 1, %opt);
    my ($font) = $self->{' font'};

    $self->{'Subtype'} = PDFName('Type0');
    $self->{'Encoding'} = PDFName('Identity-H');

    $parent->{' version'} = 3 unless (defined $parent->{' version'} && $parent->{' version'} > 3);
    $desc = PDFDict();
    $parent->new_obj($desc);
    $desc->{'Type'} = $self->{'Type'};
    $desc->{'Subtype'} = PDFName('CIDFontType2');
    $desc->{'BaseFont'} = $self->{'BaseFont'};
#    $name = $self->{'BaseFont'}->val;
#    $name =~ s/^.*\+//oi;
#    $self->{'BaseFont'} = PDF::Name->new($parent, $name . "-Identity-H");
    $desc->{'FontDescriptor'} = $self->{'FontDescriptor'};
    delete $self->{'FontDescriptor'};

    $num = $font->{'maxp'}{'numGlyphs'};
    $upem = $font->{'head'}{'unitsPerEm'};
    $desc->{'DW'} = $desc->{'FontDescriptor'}{'MissingWidth'};
    $desc->{'W'} = PDFArray();
    $parent->new_obj($desc->{'W'});
    $font->{'hmtx'}->read;
    unless ($opt{-subset})
    {
        $first = 1;
        for ($i = 1; $i < $num; $i++)
        {
            push(@wid, PDFNum(int($font->{'hmtx'}{'advance'}[$i] * 1000 / $upem)));
            if ($i % 20 == 19 || $i + 1 >= $num)
            {
                $desc->{'W'}->add_elements(PDFNum($first),
                        PDFArray(@wid));
                @wid = ();
                $first = $i + 1;
            }
        }
    }
    
    $self->{'DescendantFonts'} = PDFArray($desc);

    $sinfo = PDFDict();
#    $parent->new_obj($sinfo);
    $sinfo->{'Registry'} = PDFStr('Adobe');
    $sinfo->{'Ordering'} = PDFStr('Identity');
    $sinfo->{'Supplement'} = PDFNum(0);
    $desc->{'CIDSystemInfo'} = $sinfo;
    $ff2 = $desc->{'FontDescriptor'}{'FontFile2'};
    delete $ff2->{' streamfile'};
#        $ff2->{' stream'} = "";
#        $ffh = Text::PDF::TTIOString->new(\$ff2->{' stream'});
#        $font->out($ffh, 'cvt ', 'fpgm', 'glyf', 'head', 'hhea', 'hmtx', 'loca', 'maxp', 'prep');
#        $ff2->{'Filter'} = PDFArray(PDFName("FlateDecode"));
#        $ff2->{'Length1'} = PDFNum(length($ff2->{' stream'}));

    if ($opt{'ToUnicode'})
    {
        @rev = $font->{'cmap'}->read->reverse;
        $unistr = '/CIDInit /ProcSet findresource being 12 dict begin begincmap
/CIDSystemInfo << /Registry (' . $self->{'BaseFont'}->val . '+0) /Ordering (XYZ)
/Supplement 0 >> def
/CMapName /' . $self->{'BaseFont'}->val . '+0 def
1 begincodespacerange <';
        $unistr .= sprintf("%04x> <%04x> endcodespacerange\n", 1, $num - 1);
        for ($i = 1; $i < $num; $i++)
        {
            if ($i % 100 == 0)
            {
                $unistr .= "endbfrange\n";
                $unistr .= $num - $i > 100 ? 100 : $num - $i;
                $unistr .= " beginbfrange\n";
            }
            $unistr .= sprintf("<%04x> <%04x> <%04x>\n", $i, $i, $rev[$i]);
        }
        $unistr .= "endbfrange\nendcmap CMapName currendict /CMap defineresource pop end end";
        $touni = PDFDict();
        $parent->new_obj($touni);
        $touni->{' stream'} = $unistr;
        $touni->{'Filter'} = PDFArray(PDFName("FlateDecode"));
        $self->{'ToUnicode'} = $touni;
    }
    
    $self;
}


=head2 out_text($text)

Returns the string to be put into a content stream for text to be output in this font.
The text is assumed to be UTF8 encoded and the return string is a glyph sequence for
the text. If subsetting is enabled, then all the glyphs returned are also marked for
output.

=cut

sub out_text
{
    my ($self, $text) = @_;
    my (@clist) = Text::PDF::Utils::unpacku($text);
    my ($f) = $self->{' font'};
    my ($g, $res);

    foreach $g (map {$f->{'cmap'}->ms_lookup($_)} (@clist))
    {
        vec($self->{' subvec'}, $g, 1) = 1 if ($self->{' subset'});
        $res .= sprintf("%04X", $g);
    }
    "<$res>";
}


=head2 out_glyphs(@n)

Marks the glyphs as being needed in the output font when subsetting. Returns a string
to render the glyphs as specified.

=cut

sub out_glyphs
{
    my ($self, @list) = @_;
    my ($g, $res);
    
    foreach $g (@list)
    {
        vec($self->{' subvec'}, $g, 1) = 1 if ($self->{' subset'});
        $res .= sprintf("%04X", $g);
    }
    "<$res>";
}


=head2 width($text)

Returns the width of the string, assuming it to be UTF8 encoded.

=cut

sub width
{
    my ($self, $text) = @_;
    my (@clist) = Text::PDF::Utils::unpacku($text);
    my ($f) = $self->{' font'};
    my ($width, $g);

    foreach $g (map {$f->{'cmap'}->ms_lookup($_)} (@clist))
    { $width += $f->{'hmtx'}{'advance'}[$g]; }
    $width / $f->{'head'}{'unitsPerEm'};
}
    

=head2 outobjdeep($fh, $pdf, %opts)

Handles the creation of the font stream including subsetting at this point. So
if you get this far, that's it for subsetting.

=cut

sub outobjdeep
{
    my ($self, $fh, $pdf, %opts) = @_;
    my ($d) = $self->{'DescendantFonts'}->val->[0];
    my ($f) = $self->{' font'};
    my ($s) = $d->{'FontDescriptor'}{'FontFile2'};
    my ($ffh);

    if ($self->{' subset'})
    {
        my ($max) = length($self->{' subvec'}) * 8;
        my ($upem) = $f->{'head'}{'unitsPerEm'};
        my ($mode, $miniArr, $i, $j, $first, @minilist);
        
        $f->{'glyf'}->read;

        for ($i = 0; $i <= $max; $i++)
        {
            next unless(vec($self->{' subvec'},$i,1));
            next unless($f->{'loca'}{glyphs}[$i]);
            map { vec($self->{' subvec'},$_,1)=1; } $f->{loca}{glyphs}[$i]->get_refs;
        }

        $max = length($self->{' subvec'}) * 8;

        for ($i = 0; $i <= $max; $i++)
        {
            if (!$mode && vec($self->{' subvec'}, $i, 1))
            {
                $first = $i;
                $mode = 1;
                @minilist = ();
            } elsif ($mode && !vec($self->{' subvec'}, $i, 1))
            {
                for ($j = 0; $j < scalar @minilist; $j++)
                {
                    if ($j % 20 == 0)
                    {
                        $miniArr = PDFArray();
                        $d->{'W'}->add_elements(PDFNum($first + $j), $miniArr)
                    }
                    $miniArr->add_elements(PDFNum($minilist[$j]));
                }
                $mode = 0;
            }

            if ($mode)
            { push(@minilist, int($f->{'hmtx'}{'advance'}[$i] / $upem * 1000)); }
            else
            { $f->{'loca'}{glyphs}[$i] = undef; }
        }
        for ( ; $i < $f->{'maxp'}{'numGlyphs'}; $i++)
        { $f->{'loca'}{'glyphs'}[$i] = undef; }
    }
    $s->{' stream'} = "";
    $ffh = Text::PDF::TTIOString->new(\$s->{' stream'});
    $f->out($ffh, 'cvt ', 'fpgm', 'glyf', 'head', 'hhea', 'hmtx', 'loca', 'maxp', 'prep');
    $s->{'Filter'} = PDFArray(PDFName("FlateDecode"));
    $s->{'Length1'} = PDFNum(length($s->{' stream'}));

    $self->SUPER::outobjdeep($fh, $pdf, %opts, 'passthru' => 1);
    $self;
}


=head2 ship_out($pdf)

Ship this font out to the given $pdf file context

=cut

sub ship_out
{
    my ($self, $pdf) = @_;
    my ($d);

    foreach $d ($self->{'DescendantFonts'}->elementsof)
    { $pdf->ship_out($self, $d, $d->{'FontDescriptor'},
            $d->{'FontDescriptor'}{'FontFile2'}); }
    $pdf->ship_out($self->{'ToUnicode'}) if (defined $self->{'ToUnicode'});
    $self;
}


=head2 empty

Empty the font of as much as possible in order to save memory

=cut

sub empty
{
    my ($self) = @_;
    my ($d);

    if (defined $self->{'DescendantFonts'})
    {
        foreach $d ($self->{'DescendantFonts'}->elementsof)
        {
            $d->{'FontDescriptor'}{'FontFile2'}->empty;
            $d->{'FontDescriptor'}->empty;
            $d->empty;
        }
    }
    $self->{'ToUnicode'}->empty if (defined $self->{'ToUnicode'});
    $self->SUPER::empty;
}

1;