1package PDF::Builder::Resource::CIDFont; 2 3use base 'PDF::Builder::Resource::BaseFont'; 4 5use strict; 6use warnings; 7#no warnings qw[ deprecated recursion uninitialized ]; 8 9our $VERSION = '3.023'; # VERSION 10our $LAST_UPDATE = '3.021'; # manually update whenever code is changed 11 12use Encode qw(:all); 13 14use PDF::Builder::Basic::PDF::Utils; 15use PDF::Builder::Util; 16 17=head1 NAME 18 19PDF::Builder::Resource::CIDFont - Base class for CID fonts 20 21=head1 METHODS 22 23=over 24 25=item $font = PDF::Builder::Resource::CIDFont->new($pdf, $name) 26 27Returns a cid-font object, base class for all CID-based fonts. 28 29=cut 30 31sub new { 32 my ($class, $pdf, $name, @opts) = @_; 33 34 my %opts = (); 35 %opts = @opts if (scalar @opts)%2 == 0; 36 37 $class = ref $class if ref $class; 38 my $self = $class->SUPER::new($pdf, $name); 39 $pdf->new_obj($self) if defined($pdf) && !$self->is_obj($pdf); 40 41 $self->{'Type'} = PDFName('Font'); 42 $self->{'Subtype'} = PDFName('Type0'); 43 $self->{'Encoding'} = PDFName('Identity-H'); 44 45 my $de = PDFDict(); 46 $pdf->new_obj($de); 47 $self->{'DescendantFonts'} = PDFArray($de); 48 49 $de->{'Type'} = PDFName('Font'); 50 $de->{'CIDSystemInfo'} = PDFDict(); 51 $de->{'CIDSystemInfo'}->{'Registry'} = PDFString('Adobe', 'x'); 52 $de->{'CIDSystemInfo'}->{'Ordering'} = PDFString('Identity', 'x'); 53 $de->{'CIDSystemInfo'}->{'Supplement'} = PDFNum(0); 54 $de->{'CIDToGIDMap'} = PDFName('Identity'); 55 56 $self->{' de'} = $de; 57 58 return $self; 59} 60 61sub glyphByCId { 62 return $_[0]->data()->{'g2n'}->[$_[1]]; 63} 64 65sub uniByCId { 66 my ($self, $gid) = @_; 67 my $uni = $self->data()->{'g2u'}->[$gid]; 68 # fallback to U+0000 if no match 69 $uni = 0 unless defined $uni; 70 return $uni; 71} 72 73# note that cidByUni has been seen returning 'undef' in some cases. be sure 74# to handle this! 75sub cidByUni { 76 return $_[0]->data()->{'u2g'}->{$_[1]}; 77} 78 79sub cidByEnc { 80 return $_[0]->data()->{'e2g'}->[$_[1]]; 81} 82 83sub wxByCId { 84 my $self = shift; 85 my $g = shift; 86 87 my $w; 88 89 if (ref($self->data()->{'wx'}) eq 'ARRAY' && 90 defined $self->data()->{'wx'}->[$g]) { 91 $w = int($self->data()->{'wx'}->[$g]); 92 } elsif (ref($self->data()->{'wx'}) eq 'HASH' && 93 defined $self->data()->{'wx'}->{$g}) { 94 $w = int($self->data()->{'wx'}->{$g}); 95 } else { 96 $w = $self->missingwidth(); 97 } 98 99 return $w; 100} 101 102sub wxByUni { 103 return $_[0]->wxByCId($_[0]->data()->{'u2g'}->{$_[1]}); 104} 105 106sub wxByEnc { 107 return $_[0]->wxByCId($_[0]->data()->{'e2g'}->[$_[1]]); 108} 109 110sub width { 111 my ($self, $text) = @_; 112 113 return $self->width_cid($self->cidsByStr($text)); 114} 115 116sub width_cid { 117 my ($self, $text) = @_; 118 119 my $width = 0; 120 my $lastglyph = 0; 121 foreach my $n (unpack('n*', $text)) { 122 $width += $self->wxByCId($n); 123 if ($self->{'-dokern'} && $self->haveKernPairs()) { 124 if ($self->kernPairCid($lastglyph, $n)) { 125 $width -= $self->kernPairCid($lastglyph, $n); 126 } 127 } 128 $lastglyph = $n; 129 } 130 $width /= 1000; 131 return $width; 132} 133 134=item $cidstring = $font->cidsByStr($string) 135 136Returns the cid-string from string based on the font's encoding map. 137 138=cut 139 140sub _cidsByStr { 141 my ($self, $s) = @_; 142 143 $s = pack('n*', map { $self->cidByEnc($_) } unpack('C*', $s)); 144 return $s; 145} 146 147sub cidsByStr { 148 my ($self, $text) = @_; 149 150 if (utf8::is_utf8($text) && 151 defined $self->data()->{'decode'} && 152 $self->data()->{'decode'} ne 'ident') { 153 $text = encode($self->data()->{'decode'}, $text); 154 } elsif (utf8::is_utf8($text) && $self->data()->{'decode'} eq 'ident') { 155 $text = $self->cidsByUtf($text); 156 } elsif (!utf8::is_utf8($text) && 157 defined $self->data()->{'encode'} && 158 $self->data()->{'decode'} eq 'ident') { 159 $text = $self->cidsByUtf(decode($self->data()->{'encode'}, $text)); 160 } elsif (!utf8::is_utf8($text) && 161 $self->can('issymbol') && 162 $self->issymbol() && 163 $self->data()->{'decode'} eq 'ident') { 164 $text = pack('U*', (map { $_+0xf000 } unpack('C*', $text))); 165 $text = $self->cidsByUtf($text); 166 } else { 167 $text = $self->_cidsByStr($text); 168 } 169 return $text; 170} 171 172=item $cidstring = $font->cidsByUtf($utf8string) 173 174Returns the CID-encoded string from utf8-string. 175 176=cut 177 178sub cidsByUtf { 179 my ($self, $s) = @_; 180 181 $s = pack('n*', map { $self->cidByUni($_)||0 } (map { $_>0x7f && $_<0xA0? uniByName(nameByUni($_)): $_ } unpack('U*', $s))); 182 utf8::downgrade($s); 183 return $s; 184} 185 186sub textByStr { 187 my ($self, $text) = @_; 188 189 return $self->text_cid($self->cidsByStr($text)); 190} 191 192sub textByStrKern { 193 my ($self, $text, $size, $indent) = @_; 194 195 return $self->text_cid_kern($self->cidsByStr($text), $size, $indent); 196} 197 198sub text { 199 my ($self, $text, $size, $indent) = @_; 200 201 my $newtext = $self->textByStr($text); 202 if (defined $size && $self->{'-dokern'}) { 203 $newtext = $self->textByStrKern($text, $size, $indent); 204 return $newtext; 205 } elsif (defined $size) { 206 if (defined($indent) && $indent!=0) { 207 return("[ $indent $newtext ] TJ"); 208 } else { 209 return "$newtext Tj"; 210 } 211 } else { 212 return $newtext; 213 } 214} 215 216sub text_cid { 217 my ($self, $text, $size) = @_; 218 219 if ($self->can('fontfile')) { 220 foreach my $g (unpack('n*', $text)) { 221 $self->fontfile()->subsetByCId($g); 222 } 223 } 224 my $newtext = unpack('H*', $text); 225 if (defined $size) { 226 return "<$newtext> Tj"; 227 } else { 228 return "<$newtext>"; 229 } 230} 231 232sub text_cid_kern { 233 my ($self, $text, $size, $indent) = @_; 234 235 if ($self->can('fontfile')) { 236 foreach my $g (unpack('n*', $text)) { 237 $self->fontfile()->subsetByCId($g); 238 } 239 } 240 if (defined $size && $self->{'-dokern'} && $self->haveKernPairs()) { 241 my $newtext = ' '; 242 my $lastglyph = 0; 243 my $tBefore = 0; 244 foreach my $n (unpack('n*', $text)) { 245 if ($self->kernPairCid($lastglyph, $n)) { 246 $newtext .= '> ' if $tBefore; 247 $newtext .= sprintf('%i ', $self->kernPairCid($lastglyph, $n)); 248 $tBefore = 0; 249 } 250 $lastglyph = $n; 251 my $t = sprintf('%04X', $n); 252 $newtext .= '<' if !$tBefore; 253 $newtext .= $t; 254 $tBefore = 1; 255 } 256 $newtext .= '> ' if $tBefore; 257 if (defined($indent) && $indent != 0) { 258 return "[ $indent $newtext ] TJ"; 259 } else { 260 return "[ $newtext ] TJ"; 261 } 262 } elsif (defined $size) { 263 my $newtext = unpack('H*', $text); 264 if (defined($indent) && $indent != 0) { 265 return "[ $indent <$newtext> ] TJ"; 266 } else { 267 return "<$newtext> Tj"; 268 } 269 } else { 270 my $newtext = unpack('H*', $text); 271 return "<$newtext>"; 272 } 273} 274 275sub kernPairCid { 276 return 0; 277} 278 279sub haveKernPairs { 280 return 0; 281} 282 283sub encodeByName { 284 my ($self, $enc) = @_; 285 286 return if $self->issymbol(); 287 288 $self->data()->{'e2u'} = [ map { $_>0x7f && $_<0xA0? uniByName(nameByUni($_)): $_ } unpack('U*', decode($enc, pack('C*', 0..255))) ] if defined $enc; 289 $self->data()->{'e2n'} = [ map { $self->data()->{'g2n'}->[$self->data()->{'u2g'}->{$_} || 0] || '.notdef' } @{$self->data()->{'e2u'}} ]; 290 $self->data()->{'e2g'} = [ map { $self->data()->{'u2g'}->{$_} || 0 } @{$self->data()->{'e2u'}} ]; 291 292 $self->data()->{'u2e'} = {}; 293 foreach my $n (reverse 0..255) { 294 $self->data()->{'u2e'}->{$self->data()->{'e2u'}->[$n]} = $n 295 unless defined $self->data()->{'u2e'}->{$self->data()->{'e2u'}->[$n]}; 296 } 297 298 return $self; 299} 300 301sub subsetByCId { 302 return 1; 303} 304 305sub subvec { 306 return 1; 307} 308 309sub glyphNum { 310 my $self = shift; 311 312 if (defined $self->data()->{'glyphs'}) { 313 return $self->data()->{'glyphs'}; 314 } 315 return scalar @{$self->data()->{'wx'}}; 316} 317 318#sub outobjdeep { 319# my ($self, $fh, $pdf, %opts) = @_; 320# 321# return $self->SUPER::outobjdeep($fh, $pdf, %opts); 322#} 323 324=back 325 326=cut 327 3281; 329