<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package PDF::API2::Resource::CIDFont;

use base 'PDF::API2::Resource::BaseFont';

use strict;
no warnings qw[ deprecated recursion uninitialized ];

our $VERSION = '2.033'; # VERSION

use Encode qw(:all);

use PDF::API2::Basic::PDF::Utils;
use PDF::API2::Util;

=head1 NAME

PDF::API2::Resource::CIDFont - Base class for CID fonts

=head1 METHODS

=over

=item $font = PDF::API2::Resource::CIDFont-&gt;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-&gt;SUPER::new($pdf,$name);
    $pdf-&gt;new_obj($self) if(defined($pdf) &amp;&amp; !$self-&gt;is_obj($pdf));

    $self-&gt;{Type} = PDFName('Font');
    $self-&gt;{'Subtype'} = PDFName('Type0');
    $self-&gt;{'Encoding'} = PDFName('Identity-H');

    my $de=PDFDict();
    $pdf-&gt;new_obj($de);
    $self-&gt;{'DescendantFonts'} = PDFArray($de);

    $de-&gt;{'Type'} = PDFName('Font');
    $de-&gt;{'CIDSystemInfo'} = PDFDict();
    $de-&gt;{'CIDSystemInfo'}-&gt;{Registry} = PDFStr('Adobe');
    $de-&gt;{'CIDSystemInfo'}-&gt;{Ordering} = PDFStr('Identity');
    $de-&gt;{'CIDSystemInfo'}-&gt;{Supplement} = PDFNum(0);
    $de-&gt;{'CIDToGIDMap'} = PDFName('Identity');

    $self-&gt;{' de'} = $de;

    return($self);
}

sub glyphByCId { return( $_[0]-&gt;data-&gt;{g2n}-&gt;[$_[1]] ); }

sub uniByCId { return( $_[0]-&gt;data-&gt;{g2u}-&gt;[$_[1]] ); }

sub cidByUni { return( $_[0]-&gt;data-&gt;{u2g}-&gt;{$_[1]} ); }

sub cidByEnc { return( $_[0]-&gt;data-&gt;{e2g}-&gt;[$_[1]] ); }

sub wxByCId
{
    my $self=shift @_;
    my $g=shift @_;
    my $w;

    if(ref($self-&gt;data-&gt;{wx}) eq 'ARRAY' &amp;&amp; defined $self-&gt;data-&gt;{wx}-&gt;[$g])
    {
        $w = int($self-&gt;data-&gt;{wx}-&gt;[$g]);
    }
    elsif(ref($self-&gt;data-&gt;{wx}) eq 'HASH' &amp;&amp; defined $self-&gt;data-&gt;{wx}-&gt;{$g})
    {
        $w = int($self-&gt;data-&gt;{wx}-&gt;{$g});
    }
    else
    {
        $w = $self-&gt;missingwidth;
    }

    return($w);
}

sub wxByUni { return( $_[0]-&gt;wxByCId($_[0]-&gt;data-&gt;{u2g}-&gt;{$_[1]}) ); }
sub wxByEnc { return( $_[0]-&gt;wxByCId($_[0]-&gt;data-&gt;{e2g}-&gt;[$_[1]]) ); }

sub width
{
    my ($self,$text)=@_;
    return($self-&gt;width_cid($self-&gt;cidsByStr($text)));
}

sub width_cid
{
    my ($self,$text)=@_;
    my $width=0;
    my $lastglyph=0;
    foreach my $n (unpack('n*',$text))
    {
        $width+=$self-&gt;wxByCId($n);
        if($self-&gt;{-dokern} &amp;&amp; $self-&gt;haveKernPairs())
        {
            if($self-&gt;kernPairCid($lastglyph, $n))
            {
                $width-=$self-&gt;kernPairCid($lastglyph, $n);
            }
        }
        $lastglyph=$n;
    }
    $width/=1000;
    return($width);
}

=item $cidstring = $font-&gt;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-&gt;cidByEnc($_) } unpack('C*',$s));
    return($s);
}

sub cidsByStr
{
    my ($self,$text)=@_;
    if(is_utf8($text) &amp;&amp; defined $self-&gt;data-&gt;{decode} &amp;&amp; $self-&gt;data-&gt;{decode} ne 'ident')
    {
        $text=encode($self-&gt;data-&gt;{decode},$text);
    }
    elsif(is_utf8($text) &amp;&amp; $self-&gt;data-&gt;{decode} eq 'ident')
    {
        $text=$self-&gt;cidsByUtf($text);
    }
    elsif(!is_utf8($text) &amp;&amp; defined $self-&gt;data-&gt;{encode} &amp;&amp; $self-&gt;data-&gt;{decode} eq 'ident')
    {
        $text=$self-&gt;cidsByUtf(decode($self-&gt;data-&gt;{encode},$text));
    }
    elsif(!is_utf8($text) &amp;&amp; $self-&gt;can('issymbol') &amp;&amp; $self-&gt;issymbol &amp;&amp; $self-&gt;data-&gt;{decode} eq 'ident')
    {
        $text=pack('U*',(map { $_+0xf000 } unpack('C*',$text)));
        $text=$self-&gt;cidsByUtf($text);
    }
    else
    {
        $text=$self-&gt;_cidsByStr($text);
    }
    return($text);
}

=item $cidstring = $font-&gt;cidsByUtf $utf8string

Returns the cid-encoded string from utf8-string.

=cut

sub cidsByUtf {
    my ($self,$s)=@_;
    $s=pack('n*',map { $self-&gt;cidByUni($_) } (map { $_&gt;0x7f &amp;&amp; $_&lt;0xA0 ? uniByName(nameByUni($_)): $_ } unpack('U*',$s)));
    utf8::downgrade($s);
    return($s);
}

sub textByStr
{
    my ($self,$text)=@_;
    return($self-&gt;text_cid($self-&gt;cidsByStr($text)));
}

sub textByStrKern
{
    my ($self,$text,$size,$ident)=@_;
    return($self-&gt;text_cid_kern($self-&gt;cidsByStr($text),$size,$ident));
}

sub text
{
    my ($self,$text,$size,$ident)=@_;
    my $newtext=$self-&gt;textByStr($text);
    if(defined $size &amp;&amp; $self-&gt;{-dokern})
    {
        $newtext=$self-&gt;textByStrKern($text,$size,$ident);
        return($newtext);
    }
    elsif(defined $size)
    {
        if(defined($ident) &amp;&amp; $ident!=0)
        {
	        return("[ $ident $newtext ] TJ");
        }
        else
        {
	        return("$newtext Tj");
        }
    }
    else
    {
        return($newtext);
    }
}

sub text_cid
{
    my ($self,$text,$size)=@_;
    if($self-&gt;can('fontfile'))
    {
        foreach my $g (unpack('n*',$text))
        {
            $self-&gt;fontfile-&gt;subsetByCId($g);
        }
    }
    my $newtext=unpack('H*',$text);
    if(defined $size)
    {
        return("&lt;$newtext&gt; Tj");
    }
    else
    {
        return("&lt;$newtext&gt;");
    }
}

sub text_cid_kern
{
    my ($self,$text,$size,$ident)=@_;
    if($self-&gt;can('fontfile'))
    {
        foreach my $g (unpack('n*',$text))
        {
            $self-&gt;fontfile-&gt;subsetByCId($g);
        }
    }
    if(defined $size &amp;&amp; $self-&gt;{-dokern} &amp;&amp; $self-&gt;haveKernPairs())
    {
        my $newtext=' ';
        my $lastglyph=0;
        my $tBefore=0;
        foreach my $n (unpack('n*',$text))
        {
            if($self-&gt;kernPairCid($lastglyph, $n))
            {
                $newtext.='&gt; ' if($tBefore);
                $newtext.=sprintf('%i ',$self-&gt;kernPairCid($lastglyph, $n));
                $tBefore=0;
            }
            $lastglyph=$n;
            my $t=sprintf('%04X',$n);
            $newtext.='&lt;' if(!$tBefore);
            $newtext.=$t;
            $tBefore=1;
        }
        $newtext.='&gt; ' if($tBefore);
        if(defined($ident) &amp;&amp; $ident!=0)
        {
	        return("[ $ident $newtext ] TJ");
        }
        else
        {
            return("[ $newtext ] TJ");
        }
    }
    elsif(defined $size)
    {
        my $newtext=unpack('H*',$text);
        if(defined($ident) &amp;&amp; $ident!=0)
        {
	        return("[ $ident &lt;$newtext&gt; ] TJ");
        }
        else
        {
	        return("&lt;$newtext&gt; Tj");
        }
    }
    else
    {
        my $newtext=unpack('H*',$text);
        return("&lt;$newtext&gt;");
    }
}

sub kernPairCid
{
    return(0);
}

sub haveKernPairs
{
    return(0);
}

sub encodeByName
{
    my ($self,$enc) = @_;
    return if($self-&gt;issymbol);

    $self-&gt;data-&gt;{e2u}=[ map { $_&gt;0x7f &amp;&amp; $_&lt;0xA0 ? uniByName(nameByUni($_)): $_ } unpack('U*',decode($enc, pack('C*',0..255))) ] if(defined $enc);
    $self-&gt;data-&gt;{e2n}=[ map { $self-&gt;data-&gt;{g2n}-&gt;[$self-&gt;data-&gt;{u2g}-&gt;{$_} || 0] || '.notdef' } @{$self-&gt;data-&gt;{e2u}} ];
    $self-&gt;data-&gt;{e2g}=[ map { $self-&gt;data-&gt;{u2g}-&gt;{$_} || 0 } @{$self-&gt;data-&gt;{e2u}} ];

    $self-&gt;data-&gt;{u2e}={};
    foreach my $n (reverse 0..255)
    {
        $self-&gt;data-&gt;{u2e}-&gt;{$self-&gt;data-&gt;{e2u}-&gt;[$n]}=$n unless(defined $self-&gt;data-&gt;{u2e}-&gt;{$self-&gt;data-&gt;{e2u}-&gt;[$n]});
    }

    return($self);
}

sub subsetByCId
{
    return(1);
}

sub subvec
{
    return(1);
}

sub glyphNum
{
    my $self=shift @_;
    if(defined $self-&gt;data-&gt;{glyphs})
    {
        return ( $self-&gt;data-&gt;{glyphs} );
    }
    return ( scalar @{$self-&gt;data-&gt;{wx}} );
}

sub outobjdeep
{
    my ($self, $fh, $pdf, %opts) = @_;

    $self-&gt;SUPER::outobjdeep($fh, $pdf, %opts);
}

=back

=cut

1;
</pre></body></html>