File Coverage

blib/lib/PDF/API2/Resource/BaseFont.pm
Criterion Covered Total %
statement 159 240 66.2
branch 26 62 41.9
condition 35 84 41.6
subroutine 35 56 62.5
pod 44 49 89.8
total 299 491 60.9


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::BaseFont;
2              
3 10     10   12976 use base 'PDF::API2::Resource';
  10         21  
  10         1200  
4              
5 10     10   80 use strict;
  10         21  
  10         238  
6 10     10   49 use warnings;
  10         20  
  10         484  
7              
8             our $VERSION = '2.044'; # VERSION
9              
10 10     10   73 use Compress::Zlib;
  10         29  
  10         3600  
11 10     10   79 use PDF::API2::Basic::PDF::Utils;
  10         26  
  10         856  
12 10     10   70 use PDF::API2::Util;
  10         30  
  10         1773  
13 10     10   89 use Scalar::Util qw(weaken);
  10         24  
  10         40441  
14              
15             =head1 NAME
16              
17             PDF::API2::Resource::BaseFont - Base class for font resources
18              
19             =head1 METHODS
20              
21             =over
22              
23             =item $font = PDF::API2::Resource::BaseFont->new($pdf, $name)
24              
25             Return a font resource object.
26              
27             =cut
28              
29             sub new {
30 54     54 1 213 my ($class, $pdf, $name) = @_;
31 54         98 my $self;
32              
33 54 50       197 $class = ref($class) if ref($class);
34 54         315 $self = $class->SUPER::new($pdf, $name);
35              
36 54 50       516 $pdf->new_obj($self) unless $self->is_obj($pdf);
37              
38 54         380 $self->{'Type'} = PDFName('Font');
39              
40 54         338 $self->{' apipdf'} = $pdf;
41 54         216 weaken $self->{' apipdf'};
42 54         154 return $self;
43             }
44              
45 41284     41284 0 75542 sub data { return $_[0]->{' data'}; }
46              
47             =item $descriptor = $font->descrByData()
48              
49             Return the font's FontDescriptor key structure based on the font's data.
50              
51             =cut
52              
53             sub descrByData {
54 16     16 1 34 my $self = shift();
55              
56 16         49 my $descriptor = PDFDict();
57 16         65 $self->{' apipdf'}->new_obj($descriptor);
58              
59 16         47 $descriptor->{'Type'} = PDFName('FontDescriptor');
60 16         72 $descriptor->{'FontName'} = PDFName($self->fontname());
61              
62 16   100     81 my @box = map { PDFNum($_ || 0) } $self->fontbbox();
  64         171  
63 16         61 $descriptor->{'FontBBox'} = PDFArray(@box);
64              
65 16   50     78 $descriptor->{'Ascent'} = PDFNum($self->ascender() || 0);
66 16   50     63 $descriptor->{'Descent'} = PDFNum($self->descender() || 0);
67 16   100     91 $descriptor->{'ItalicAngle'} = PDFNum($self->italicangle() || 0.0);
68 16   50     94 $descriptor->{'XHeight'} = PDFNum($self->xheight() || (($self->fontbbox())[3] * 0.5) || 500);
69 16   50     80 $descriptor->{'CapHeight'} = PDFNum($self->capheight() || ($self->fontbbox())[3] || 800);
70 16   50     61 $descriptor->{'StemV'} = PDFNum($self->stemv() || 0);
71 16   50     74 $descriptor->{'StemH'} = PDFNum($self->stemh() || 0);
72 16   50     76 $descriptor->{'AvgWidth'} = PDFNum($self->avgwidth() || 300);
73 16   100     70 $descriptor->{'MissingWidth'} = PDFNum($self->missingwidth() || 300);
74 16   66     71 $descriptor->{'MaxWidth'} = PDFNum($self->maxwidth() || $self->missingwidth() || ($self->fontbbox())[2]);
75 16 50 50     63 $descriptor->{'Flags'} = PDFNum($self->flags() || 0) unless $self->data->{'iscore'};
76 16 100       69 if (defined $self->data->{'panose'}) {
77 1         3 $descriptor->{'Style'} = PDFDict();
78 1         4 $descriptor->{'Style'}->{'Panose'} = PDFStrHex($self->data->{'panose'});
79             }
80 16 100       53 $descriptor->{'FontFamily'} = PDFStr($self->data->{'fontfamily'}) if defined $self->data->{'fontfamily'};
81 16 100       35 $descriptor->{'FontWeight'} = PDFNum($self->data->{'fontweight'}) if defined $self->data->{'fontweight'};
82 16 100       56 $descriptor->{'FontStretch'} = PDFName($self->data->{'fontstretch'}) if defined $self->data->{'fontstretch'};
83              
84 16         66 return $descriptor;
85             }
86              
87             sub tounicodemap {
88 1     1 0 3 my $self = shift();
89              
90 1 50       3 return $self if defined $self->{'ToUnicode'};
91              
92 1         2 my $stream = qq|\%\% Custom\n\%\% CMap\n\%\%\n/CIDInit /ProcSet findresource begin\n|;
93 1         4 $stream .= qq|12 dict begin begincmap\n|;
94 1         3 $stream .= qq|/CIDSystemInfo <<\n|;
95 1         4 $stream .= sprintf(qq| /Registry (%s)\n|, $self->name());
96 1         13 $stream .= qq| /Ordering (XYZ)\n|;
97 1         3 $stream .= qq| /Supplement 0\n|;
98 1         2 $stream .= qq|>> def\n|;
99 1         4 $stream .= sprintf(qq|/CMapName /pdfapi2-%s+0 def\n|, $self->name());
100 1 50 33     18 if ($self->can('uniByCId') and $self->can('glyphNum')) {
101             # this is a type0 font
102 0         0 $stream .= sprintf(qq|1 begincodespacerange <0000> <%04X> endcodespacerange\n|, $self->glyphNum() - 1);
103 0         0 for (my $j = 0; $j < $self->glyphNum(); $j++) {
104 0 0       0 my $i = $self->glyphNum() - $j > 100 ? 100 : $self->glyphNum() - $j;
105 0 0       0 if ($j == 0) {
    0          
106 0         0 $stream .= qq|$i beginbfrange\n|;
107             }
108             elsif ($j % 100 == 0) {
109 0         0 $stream .= qq|endbfrange\n|;
110 0         0 $stream .= qq|$i beginbfrange\n|;
111             }
112              
113             # Default to 0000 if uniByCId returns undef in order to match
114             # previous behavior minus an uninitialized value warning. It's
115             # worth looking into what should be happening here, since this may
116             # not be the correct behavior.
117 0   0     0 $stream .= sprintf(qq|<%04x> <%04x> <%04x>\n|, $j, $j, ($self->uniByCId($j) // 0));
118             }
119 0         0 $stream .= "endbfrange\n";
120             }
121             else {
122             # everything else is a single byte font
123 1         2 $stream .= qq|1 begincodespacerange\n<00> \nendcodespacerange\n|;
124 1         2 $stream .= qq|256 beginbfchar\n|;
125 1         5 for (my $j = 0; $j < 256; $j++) {
126 256   50     413 $stream .= sprintf(qq|<%02X> <%04X>\n|, $j, $self->uniByEnc($j) // 0);
127             }
128 1         4 $stream .= qq|endbfchar\n|;
129             }
130 1         3 $stream .= qq|endcmap CMapName currendict /CMap defineresource pop end end\n|;
131              
132 1         5 my $cmap = PDFDict();
133 1         3 $cmap->{'Type'} = PDFName('CMap');
134 1         4 $cmap->{'CMapName'} = PDFName(sprintf(qq|pdfapi2-%s+0|, $self->name()));
135 1         3 $cmap->{'CIDSystemInfo'} = PDFDict();
136 1         3 $cmap->{'CIDSystemInfo'}->{'Registry'} = PDFStr($self->name());
137 1         3 $cmap->{'CIDSystemInfo'}->{'Ordering'} = PDFStr('XYZ');
138 1         4 $cmap->{'CIDSystemInfo'}->{'Supplement'} = PDFNum(0);
139              
140 1         4 $self->{' apipdf'}->new_obj($cmap);
141 1         2 $cmap->{' nofilt'} = 1;
142 1         17 $cmap->{' stream'} = Compress::Zlib::compress($stream);
143 1         782 $cmap->{'Filter'} = PDFArray(PDFName('FlateDecode'));
144 1         3 $self->{'ToUnicode'} = $cmap;
145              
146 1         4 return $self;
147             }
148              
149             =back
150              
151             =head1 FONT-MANAGEMENT RELATED METHODS
152              
153             =over
154              
155             =item $name = $font->fontname()
156              
157             Return the font's name (a.k.a. display name).
158              
159             =cut
160              
161 71     71 1 241 sub fontname { return $_[0]->data->{'fontname'}; }
162              
163             =item $name = $font->altname()
164              
165             Return the font's alternative name (a.k.a. Windows name for a postscript font).
166              
167             =cut
168              
169 0     0 1 0 sub altname { return $_[0]->data->{'altname'}; }
170              
171             =item $name = $font->subname()
172              
173             Return the font's subname (a.k.a. font variant, schriftschnitt).
174              
175             =cut
176              
177 0     0 1 0 sub subname { return $_[0]->data->{'subname'}; }
178              
179             =item $name = $font->apiname()
180              
181             Return the font's name to be used internally (should be equal to $font->name()).
182              
183             =cut
184              
185 0     0 1 0 sub apiname { return $_[0]->data->{'apiname'}; }
186              
187             =item $issymbol = $font->issymbol()
188              
189             Return the font's symbol flag.
190              
191             =cut
192              
193 77     77 1 205 sub issymbol { return $_[0]->data->{'issymbol'}; }
194              
195             =item $iscff = $font->iscff()
196              
197             Return the font's Compact Font Format flag.
198              
199             =cut
200              
201 0     0 1 0 sub iscff { return $_[0]->data->{'iscff'}; }
202              
203             =back
204              
205             =head1 TYPOGRAPHY RELATED METHODS
206              
207             =over
208              
209             =item ($llx, $lly, $urx, $ury) = $font->fontbbox()
210              
211             Return the font's bounding box.
212              
213             =cut
214              
215 31     31 1 55 sub fontbbox { return @{$_[0]->data->{'fontbbox'}}; }
  31         61  
216              
217             =item $capheight = $font->capheight()
218              
219             Return the font's capheight value.
220              
221             =cut
222              
223 16     16 1 42 sub capheight { return $_[0]->data->{'capheight'}; }
224              
225             =item $xheight = $font->xheight()
226              
227             Return the font's xheight value.
228              
229             =cut
230              
231 16     16 1 56 sub xheight { return $_[0]->data->{'xheight'}; }
232              
233             =item $missingwidth = $font->missingwidth()
234              
235             Return the font's missingwidth value.
236              
237             =cut
238              
239 467     467 1 740 sub missingwidth { return $_[0]->data->{'missingwidth'}; }
240              
241             =item $maxwidth = $font->maxwidth()
242              
243             Return the font's maxwidth value.
244              
245             =cut
246              
247 16     16 1 42 sub maxwidth { return $_[0]->data->{'maxwidth'}; }
248              
249             =item $avgwidth = $font->avgwidth()
250              
251             Return the font's avgwidth value.
252              
253             =cut
254              
255             sub avgwidth {
256 16     16 1 64 my $self = shift();
257 16         54 my $aw = $self->data->{'avgwidth'};
258 16   33     111 $aw ||= ((
259             $self->wxByGlyph('a') * 64 +
260             $self->wxByGlyph('b') * 14 +
261             $self->wxByGlyph('c') * 27 +
262             $self->wxByGlyph('d') * 35 +
263             $self->wxByGlyph('e') * 100 +
264             $self->wxByGlyph('f') * 20 +
265             $self->wxByGlyph('g') * 14 +
266             $self->wxByGlyph('h') * 42 +
267             $self->wxByGlyph('i') * 63 +
268             $self->wxByGlyph('j') * 3 +
269             $self->wxByGlyph('k') * 6 +
270             $self->wxByGlyph('l') * 35 +
271             $self->wxByGlyph('m') * 20 +
272             $self->wxByGlyph('n') * 56 +
273             $self->wxByGlyph('o') * 56 +
274             $self->wxByGlyph('p') * 17 +
275             $self->wxByGlyph('q') * 4 +
276             $self->wxByGlyph('r') * 49 +
277             $self->wxByGlyph('s') * 56 +
278             $self->wxByGlyph('t') * 71 +
279             $self->wxByGlyph('u') * 31 +
280             $self->wxByGlyph('v') * 10 +
281             $self->wxByGlyph('w') * 18 +
282             $self->wxByGlyph('x') * 3 +
283             $self->wxByGlyph('y') * 18 +
284             $self->wxByGlyph('z') * 2 +
285             $self->wxByGlyph('A') * 64 +
286             $self->wxByGlyph('B') * 14 +
287             $self->wxByGlyph('C') * 27 +
288             $self->wxByGlyph('D') * 35 +
289             $self->wxByGlyph('E') * 100 +
290             $self->wxByGlyph('F') * 20 +
291             $self->wxByGlyph('G') * 14 +
292             $self->wxByGlyph('H') * 42 +
293             $self->wxByGlyph('I') * 63 +
294             $self->wxByGlyph('J') * 3 +
295             $self->wxByGlyph('K') * 6 +
296             $self->wxByGlyph('L') * 35 +
297             $self->wxByGlyph('M') * 20 +
298             $self->wxByGlyph('N') * 56 +
299             $self->wxByGlyph('O') * 56 +
300             $self->wxByGlyph('P') * 17 +
301             $self->wxByGlyph('Q') * 4 +
302             $self->wxByGlyph('R') * 49 +
303             $self->wxByGlyph('S') * 56 +
304             $self->wxByGlyph('T') * 71 +
305             $self->wxByGlyph('U') * 31 +
306             $self->wxByGlyph('V') * 10 +
307             $self->wxByGlyph('W') * 18 +
308             $self->wxByGlyph('X') * 3 +
309             $self->wxByGlyph('Y') * 18 +
310             $self->wxByGlyph('Z') * 2 +
311             $self->wxByGlyph('space') * 332
312             ) / 2000);
313 16         144 return int($aw);
314             }
315              
316             =item $flags = $font->flags()
317              
318             Return the font's flags value.
319              
320             =cut
321              
322 16     16 1 58 sub flags { return $_[0]->data->{'flags'}; }
323              
324             =item $stemv = $font->stemv()
325              
326             Return the font's stemv value.
327              
328             =cut
329              
330 16     16 1 72 sub stemv { return $_[0]->data->{'stemv'}; }
331              
332             =item $stemh = $font->stemh()
333              
334             Return the font's stemh value.
335              
336             =cut
337              
338 16     16 1 52 sub stemh { return $_[0]->data->{'stemh'}; }
339              
340             =item $italicangle = $font->italicangle()
341              
342             Return the font's italicangle value.
343              
344             =cut
345              
346 16     16 1 52 sub italicangle { return $_[0]->data->{'italicangle'}; }
347              
348             =item $isfixedpitch = $font->isfixedpitch()
349              
350             Return the font's isfixedpitch flag.
351              
352             =cut
353              
354 0     0 1 0 sub isfixedpitch { return $_[0]->data->{'isfixedpitch'}; }
355              
356             =item $underlineposition = $font->underlineposition()
357              
358             Return the font's underlineposition value.
359              
360             =cut
361              
362 0     0 1 0 sub underlineposition { return $_[0]->data->{'underlineposition'}; }
363              
364             =item $underlinethickness = $font->underlinethickness()
365              
366             Return the font's underlinethickness value.
367              
368             =cut
369              
370 0     0 1 0 sub underlinethickness { return $_[0]->data->{'underlinethickness'}; }
371              
372             =item $ascender = $font->ascender()
373              
374             Return the font's ascender value.
375              
376             =cut
377              
378 16     16 1 61 sub ascender { return $_[0]->data->{'ascender'}; }
379              
380             =item $descender = $font->descender()
381              
382             Return the font's descender value.
383              
384             =cut
385              
386 16     16 1 51 sub descender { return $_[0]->data->{'descender'}; }
387              
388             =back
389              
390             =head1 GLYPH RELATED METHODS
391              
392             =over 4
393              
394             =item @names = $font->glyphNames()
395              
396             Return the defined glyph names of the font.
397              
398             =cut
399              
400 0     0 1 0 sub glyphNames { return keys %{$_[0]->data->{'wx'}}; }
  0         0  
401              
402             =item $glNum = $font->glyphNum()
403              
404             Return the number of defined glyph names of the font.
405              
406             =cut
407              
408 0     0 1 0 sub glyphNum { return scalar keys %{$_[0]->data->{'wx'}}; }
  0         0  
409              
410             =item $uni = $font->uniByGlyph($char)
411              
412             Return the unicode by glyph name.
413              
414             =cut
415              
416 0     0 1 0 sub uniByGlyph { return $_[0]->data->{'n2u'}->{$_[1]}; }
417              
418             =item $uni = $font->uniByEnc($char)
419              
420             Return the unicode by the fonts encoding map.
421              
422             =cut
423              
424 256     256 1 381 sub uniByEnc { return $_[0]->data->{'e2u'}->[$_[1]]; }
425              
426             =item $uni = $font->uniByMap($char)
427              
428             Return the unicode by the font's default map.
429              
430             =cut
431              
432 0     0 1 0 sub uniByMap { return $_[0]->data->{'uni'}->[$_[1]]; }
433              
434             =item $char = $font->encByGlyph($glyph)
435              
436             Return the character by the given glyph name of the font's encoding map.
437              
438             =cut
439              
440 0   0 0 1 0 sub encByGlyph { return $_[0]->data->{'n2e'}->{$_[1]} || 0; }
441              
442             =item $char = $font->encByUni($uni)
443              
444             Return the character by the given unicode of the font's encoding map.
445              
446             =cut
447              
448 27   50 27 1 45 sub encByUni { return $_[0]->data->{'u2e'}->{$_[1]} || $_[0]->data->{'u2c'}->{$_[1]} || 0; }
449              
450             =item $char = $font->mapByGlyph($glyph)
451              
452             Return the character by the given glyph name of the font's default map.
453              
454             =cut
455              
456 0   0 0 1 0 sub mapByGlyph { return $_[0]->data->{'n2c'}->{$_[1]} || 0; }
457              
458             =item $char = $font->mapByUni($uni)
459              
460             Return the character by the given unicode of the fonts default map.
461              
462             =cut
463              
464 0   0 0 1 0 sub mapByUni { return $_[0]->data->{'u2c'}->{$_[1]} || 0; }
465              
466             =item $name = $font->glyphByUni($uni)
467              
468             Return the glyph's name by the font's unicode map.
469             B non-standard glyph-names are mapped onto
470             the ms-symbol area (0xF000).
471              
472             =cut
473              
474 0   0 0 1 0 sub glyphByUni { return $_[0]->data->{'u2n'}->{$_[1]} || '.notdef'; }
475              
476             =item $name = $font->glyphByEnc($char)
477              
478             Return the glyph's name by the font's encoding map.
479              
480             =cut
481              
482             sub glyphByEnc {
483 25885     25885 1 38449 my ($self, $e) = @_;
484 25885         39340 my $g = $self->data->{'e2n'}->[$e];
485 25885         50239 return $g;
486             }
487              
488             =item $name = $font->glyphByMap($char)
489              
490             Return the glyph's name by the font's default map.
491              
492             =cut
493              
494 0     0 1 0 sub glyphByMap { return $_[0]->data->{'char'}->[$_[1]]; }
495              
496             =item $width = $font->wxByGlyph($glyph)
497              
498             Return the glyph's width.
499              
500             =cut
501              
502             sub wxByGlyph {
503 848     848 1 1188 my $self = shift();
504 848         1154 my $glyph = shift();
505 848         1062 my $width;
506 848 100       1247 if (ref($self->data->{'wx'}) eq 'HASH') {
507 795         1173 $width = $self->data->{'wx'}->{$glyph};
508 795   66     1463 $width //= $self->missingwidth();
509 795   100     1401 $width //= 300;
510             }
511             else {
512 53         97 my $cid = $self->cidByUni(uniByName($glyph));
513 53 50       110 $width = $self->data->{'wx'}->[$cid] if defined $cid;
514 53   33     90 $width //= $self->missingwidth();
515 53   50     93 $width //= 300;
516             }
517 848         2556 return $width;
518             }
519              
520             =item $width = $font->wxByUni($uni)
521              
522             Return the unicode's width.
523              
524             =cut
525              
526             sub wxByUni {
527 0     0 1 0 my $self = shift();
528 0         0 my $val = shift();
529 0         0 my $gid = $self->glyphByUni($val);
530 0         0 my $width;
531 0 0       0 $width = $self->data->{'wx'}->{$gid} if defined $gid;
532 0   0     0 $width //= $self->missingwidth();
533 0   0     0 $width //= 300;
534 0         0 return $width;
535             }
536              
537             =item $width = $font->wxByEnc($char)
538              
539             Return the character's width based on the current encoding.
540              
541             =cut
542              
543             sub wxByEnc {
544 12317     12317 1 18947 my ($self, $e) = @_;
545 12317         19653 my $glyph = $self->glyphByEnc($e);
546 12317         15585 my $width;
547 12317 50       24625 $width = $self->data->{'wx'}->{$glyph} if defined $glyph;
548 12317   100     20803 $width //= $self->missingwidth();
549 12317   100     19792 $width //= 300;
550 12317         26251 return $width;
551             }
552              
553             =item $width = $font->wxByMap($char)
554              
555             Return the character's width based on the font's default encoding.
556              
557             =cut
558              
559             sub wxByMap {
560 0     0 1 0 my ($self, $map) = @_;
561 0         0 my $glyph = $self->glyphByMap($map);
562 0         0 my $width;
563 0 0       0 $width = $self->data->{'wx'}->{$glyph} if defined $glyph;
564 0   0     0 $width //= $self->missingwidth();
565 0   0     0 $width //= 300;
566 0         0 return $width;
567             }
568              
569             =item $wd = $font->width($text)
570              
571             Return the width of $text as if it were at size 1.
572              
573             =cut
574              
575             sub width {
576 185     185 1 317 my ($self, $text) = @_;
577 185 100       452 $text = $self->strByUtf($text) if utf8::is_utf8($text);
578              
579 185         267 my @cache;
580 185         283 my $width = 0;
581 185   33     399 my $kern = $self->{'-dokern'} && ref($self->data->{'kern'});
582 185         282 my $last_glyph = '';
583 185         519 foreach my $n (unpack('C*', $text)) {
584 2710   66     4722 $cache[$n] //= $self->wxByEnc($n);
585 2710         3684 $width += $cache[$n];
586 2710 50       4520 if ($kern) {
587 0   0     0 $width += ($self->data->{'kern'}->{$last_glyph . ':' . $self->data->{'e2n'}->[$n]} // 0);
588 0         0 $last_glyph = $self->data->{'e2n'}->[$n];
589             }
590             }
591 185         355 $width /= 1000;
592 185         560 return $width;
593             }
594              
595             =item @widths = $font->width_array($text)
596              
597             Return the widths of the words in $text as if they were at size 1.
598              
599             =cut
600              
601             sub width_array {
602 0     0 1 0 my ($self, $text) = @_;
603 0 0       0 $text = $self->utfByStr($text) unless utf8::is_utf8($text);
604 0         0 my @widths = map { $self->width($_) } split(/\s+/, $text);
  0         0  
605 0         0 return @widths;
606             }
607              
608             =back
609              
610             =head1 STRING METHODS
611              
612             =over
613              
614             =item $utf8_string = $font->utfByStr($string)
615              
616             Return the utf8-string from string based on the font's encoding map.
617              
618             =cut
619              
620             sub utfByStr {
621 0     0 1 0 my ($self, $string) = @_;
622 0         0 $string = pack('U*', map { $self->uniByEnc($_) } unpack('C*', $string));
  0         0  
623 0         0 utf8::upgrade($string);
624 0         0 return $string;
625             }
626              
627             =item $string = $font->strByUtf($utf8_string)
628              
629             Return the encoded string from utf8-string based on the font's encoding map.
630              
631             =cut
632              
633             sub strByUtf {
634 9     9 1 15 my ($self, $string) = @_;
635 9         24 $string = pack('C*', map { $self->encByUni($_) & 0xFF } unpack('U*', $string));
  27         61  
636 9         26 utf8::downgrade($string);
637 9         19 return $string;
638             }
639              
640             =item $pdf_string = $font->textByStr($text)
641              
642             Return a properly formatted representation of $text for use in the PDF.
643              
644             =cut
645              
646             sub textByStr {
647 30     30 1 63 my ($self, $string) = @_;
648 30 100       91 $string = $self->strByUtf($string) if utf8::is_utf8($string);
649              
650 30         53 my $text = $string;
651 30         81 $text =~ s/\\/\\\\/go;
652 30         73 $text =~ s/([\x00-\x1f])/sprintf('\%03lo', ord($1))/ge;
  0         0  
653 30         58 $text =~ s/([\{\}\[\]\(\)])/\\$1/g;
654 30         64 return $text;
655             }
656              
657             sub textByStrKern {
658 0     0 0 0 my ($self, $string) = @_;
659 0 0 0     0 return '(' . $self->textByStr($string) . ')' unless $self->{'-dokern'} and ref($self->data->{'kern'});
660              
661 0 0       0 $string = $self->strByUtf($string) if utf8::is_utf8($string);
662              
663 0         0 my $text = ' ';
664 0         0 my $tBefore = 0;
665 0         0 my $last_glyph = '';
666 0         0 foreach my $n (unpack('C*', $string)) {
667 0 0       0 if (defined $self->data->{'kern'}->{$last_glyph . ':' . $self->data->{'e2n'}->[$n]}) {
668 0 0       0 $text .= ') ' if $tBefore;
669 0         0 $text .= sprintf('%i ', -($self->data->{'kern'}->{$last_glyph . ':' . $self->data->{'e2n'}->[$n]}));
670 0         0 $tBefore = 0;
671             }
672 0         0 $last_glyph = $self->data->{'e2n'}->[$n];
673 0         0 my $t = pack('C', $n);
674 0         0 $t =~ s/\\/\\\\/g;
675 0         0 $t =~ s/([\x00-\x1f])/sprintf('\%03lo', ord($1))/ge;
  0         0  
676 0         0 $t =~ s/([\{\}\[\]\(\)])/\\$1/g;
677 0 0       0 $text .= '(' unless $tBefore;
678 0         0 $text .= "$t";
679 0         0 $tBefore = 1;
680             }
681 0 0       0 $text .= ') ' if $tBefore;
682 0         0 return $text;
683             }
684              
685             # Maintainer's note: $size here is used solely as a flag to determine whether or
686             # not to append a text-showing operator (TJ or Tj).
687             sub text {
688 30     30 0 69 my ($self, $string, $size, $indent) = @_;
689 30         95 my $text = $self->textByStr($string);
690              
691 30 50 33     158 if (defined $size and $self->{'-dokern'}) {
    50          
692 0         0 $text = $self->textByStrKern($string);
693 0 0       0 return "[ $indent $text ] TJ" if $indent;
694 0         0 return "[ $text ] TJ";
695             }
696             elsif (defined $size) {
697 30 100       187 return "[ $indent ($text) ] TJ" if $indent;
698 18         82 return "($text) Tj";
699             }
700             else {
701 0         0 return "($text)";
702             }
703             }
704              
705 34     34 0 102 sub isvirtual { return }
706              
707             =back
708              
709             =cut
710              
711             1;