File Coverage

blib/lib/PDF/Builder/Resource/BaseFont.pm
Criterion Covered Total %
statement 161 256 62.8
branch 26 80 32.5
condition 26 77 33.7
subroutine 35 58 60.3
pod 47 51 92.1
total 295 522 56.5


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::BaseFont;
2              
3 9     9   77 use base 'PDF::Builder::Resource';
  9         18  
  9         1276  
4              
5 9     9   80 use strict;
  9         18  
  9         258  
6 9     9   41 use warnings;
  9         15  
  9         834  
7              
8             our $VERSION = '3.028'; # VERSION
9             our $LAST_UPDATE = '3.027'; # manually update whenever code is changed
10              
11 9     9   63 use Compress::Zlib;
  9         28  
  9         3462  
12             #use Encode qw(:all);
13 9     9   68 use PDF::Builder::Basic::PDF::Utils;
  9         18  
  9         871  
14 9     9   53 use PDF::Builder::Util;
  9         17  
  9         1734  
15 9     9   72 use Scalar::Util qw(weaken);
  9         20  
  9         44737  
16              
17             =head1 NAME
18              
19             PDF::Builder::Resource::BaseFont - Base class for font resources
20              
21             Inherits from L<PDF::Builder::Resource>
22              
23             =head1 METHODS
24              
25             =head2 new
26              
27             $font = PDF::Builder::Resource::BaseFont->new($pdf, $name)
28              
29             =over
30              
31             Return a font resource object.
32              
33             =back
34              
35             =cut
36              
37             sub new {
38 38     38 1 155 my ($class, $pdf, $name) = @_;
39              
40 38         91 my $self;
41              
42 38 50       157 $class = ref($class) if ref($class);
43 38         339 $self = $class->SUPER::new($pdf, $name);
44              
45 38 50       149 $pdf->new_obj($self) unless $self->is_obj($pdf);
46              
47 38         140 $self->{'Type'} = PDFName('Font');
48              
49 38         111 $self->{' apipdf'} = $pdf;
50 38         82 weaken $self->{' apipdf'};
51              
52 38         116 return $self;
53             }
54              
55             sub data {
56 27662     27662 0 72688 return $_[0]->{' data'};
57             }
58              
59             =head2 descrByData
60              
61             $descriptor = $font->descrByData()
62              
63             =over
64              
65             Return the font's FontDescriptor key structure based on the font's data.
66              
67             =back
68              
69             =cut
70              
71             sub descrByData {
72 1     1 1 4 my $self = shift();
73              
74 1         3 my $descriptor = PDFDict();
75 1         6 $self->{' apipdf'}->new_obj($descriptor);
76              
77 1         5 $descriptor->{'Type'} = PDFName('FontDescriptor');
78 1         4 $descriptor->{'FontName'} = PDFName($self->fontname());
79              
80 1   50     9 my @box = map { PDFNum($_ || 0) } $self->fontbbox();
  4         14  
81 1         5 $descriptor->{'FontBBox'} = PDFArray(@box);
82              
83 1   50     11 $descriptor->{'Ascent'} = PDFNum($self->ascender() || 0);
84 1   50     7 $descriptor->{'Descent'} = PDFNum($self->descender() || 0);
85 1   50     8 $descriptor->{'ItalicAngle'} = PDFNum($self->italicangle() || 0.0);
86 1   50     8 $descriptor->{'XHeight'} = PDFNum($self->xheight() || (($self->fontbbox())[3]*0.5) || 500);
87 1   50     7 $descriptor->{'CapHeight'} = PDFNum($self->capheight() || ($self->fontbbox())[3] || 800);
88 1   50     24 $descriptor->{'StemV'} = PDFNum($self->stemv() || 0);
89 1   50     7 $descriptor->{'StemH'} = PDFNum($self->stemh() || 0);
90 1   50     8 $descriptor->{'AvgWidth'} = PDFNum($self->avgwidth() || 300);
91 1   50     7 $descriptor->{'MissingWidth'} = PDFNum($self->missingwidth() || 300);
92 1   33     5 $descriptor->{'MaxWidth'} = PDFNum($self->maxwidth() || $self->missingwidth() || ($self->fontbbox())[2]);
93 1 50 50     2 $descriptor->{'Flags'} = PDFNum($self->flags() || 0) unless $self->data()->{'iscore'};
94 1 50       2 if (defined $self->data()->{'panose'}) {
95 1         3 $descriptor->{'Style'} = PDFDict();
96 1         2 $descriptor->{'Style'}->{'Panose'} = PDFStrHex($self->data()->{'panose'});
97             }
98             $descriptor->{'FontFamily'} = PDFString($self->data()->{'fontfamily'}, 'x')
99 1 50       2 if defined $self->data()->{'fontfamily'};
100             $descriptor->{'FontWeight'} = PDFNum($self->data()->{'fontweight'})
101 1 50       2 if defined $self->data()->{'fontweight'};
102             $descriptor->{'FontStretch'} = PDFName($self->data()->{'fontstretch'})
103 1 50       4 if defined $self->data()->{'fontstretch'};
104              
105 1         3 return $descriptor;
106             }
107              
108             sub tounicodemap {
109 1     1 0 4 my $self = shift();
110              
111 1 50       5 return $self if defined $self->{'ToUnicode'};
112              
113 1         6 my $stream = qq|\%\% Custom\n\%\% CMap\n\%\%\n/CIDInit /ProcSet findresource begin\n|;
114 1         6 $stream .= qq|12 dict begin begincmap\n|;
115 1         18 $stream .= qq|/CIDSystemInfo <<\n|;
116 1         10 $stream .= sprintf(qq| /Registry (%s)\n|, $self->name());
117 1         6 $stream .= qq| /Ordering (XYZ)\n|;
118 1         4 $stream .= qq| /Supplement 0\n|;
119 1         5 $stream .= qq|>> def\n|;
120 1         5 $stream .= sprintf(qq|/CMapName /pdfbldr-%s+0 def\n|, $self->name());
121 1 50 33     48 if ($self->can('uniByCId') and $self->can('glyphNum')) {
122             # this is a type0 font
123 0         0 $stream .= sprintf(qq|1 begincodespacerange <0000> <%04X> endcodespacerange\n|, $self->glyphNum() - 1);
124 0         0 for (my $j = 0; $j < $self->glyphNum(); $j++) {
125 0 0       0 my $i = $self->glyphNum() - $j > 100 ? 100 : $self->glyphNum() - $j;
126 0 0       0 if ($j == 0) {
    0          
127 0         0 $stream .= qq|$i beginbfrange\n|;
128             } elsif ($j % 100 == 0) {
129 0         0 $stream .= qq|endbfrange\n|;
130 0         0 $stream .= qq|$i beginbfrange\n|;
131             }
132             # Default to 0000 if uniByCId returns undef in order to match
133             # previous behavior minus an uninitialized value warning. It's
134             # worth looking into what should be happening here, since this may
135             # not be the correct behavior.
136 0   0     0 $stream .= sprintf(qq|<%04x> <%04x> <%04x>\n|, $j, $j, ($self->uniByCId($j) // 0));
137             }
138 0         0 $stream .= "endbfrange\n";
139             } else {
140             # everything else is single byte font
141 1         5 $stream .= qq|1 begincodespacerange\n<00> <FF>\nendcodespacerange\n|;
142 1         3 $stream .= qq|256 beginbfchar\n|;
143 1         8 for (my $j=0; $j < 256; $j++) {
144 256         578 $stream .= sprintf(qq|<%02X> <%04X>\n|, $j, $self->uniByEnc($j));
145             }
146 1         7 $stream .= qq|endbfchar\n|;
147             }
148 1         4 $stream .= qq|endcmap CMapName currendict /CMap defineresource pop end end\n|;
149              
150 1         9 my $cmap = PDFDict();
151 1         6 $cmap->{'Type'} = PDFName('CMap');
152 1         9 $cmap->{'CMapName'} = PDFName(sprintf(qq|pdfbldr-%s+0|, $self->name()));
153 1         7 $cmap->{'CIDSystemInfo'} = PDFDict();
154 1         51 $cmap->{'CIDSystemInfo'}->{'Registry'} = PDFString($self->name(), 'x');
155 1         5 $cmap->{'CIDSystemInfo'}->{'Ordering'} = PDFString('XYZ', 'x');
156 1         4 $cmap->{'CIDSystemInfo'}->{'Supplement'} = PDFNum(0);
157              
158 1         15 $self->{' apipdf'}->new_obj($cmap);
159 1         6 $cmap->{' nofilt'} = 1;
160 1         11 $cmap->{' stream'} = Compress::Zlib::compress($stream);
161 1         1270 $cmap->{'Filter'} = PDFArray(PDFName('FlateDecode'));
162 1         8 $self->{'ToUnicode'} = $cmap;
163              
164 1         7 return $self;
165             }
166              
167             =head1 FONT-MANAGEMENT RELATED METHODS
168              
169             =head2 fontname
170              
171             $name = $font->fontname()
172              
173             =over
174              
175             Return the font's name (a.k.a. display name).
176              
177             =back
178              
179             =cut
180              
181             sub fontname {
182 40     40 1 136 return $_[0]->data()->{'fontname'};
183             }
184              
185             =head2 altname
186              
187             $name = $font->altname()
188              
189             =over
190              
191             Return the font's alternative name (a.k.a. Windows name for a PostScript font).
192              
193             =back
194              
195             =cut
196              
197             sub altname {
198 0     0 1 0 return $_[0]->data()->{'altname'};
199             }
200              
201             =head2 subname
202              
203             $name = $font->subname()
204              
205             =over
206              
207             Return the font's subname (a.k.a. font variant).
208              
209             =back
210              
211             =cut
212              
213             sub subname {
214 0     0 1 0 return $_[0]->data()->{'subname'};
215             }
216              
217             =head2 apiname
218              
219             $name = $font->apiname()
220              
221             =over
222              
223             Return the font's name to be used internally (should be equal to $font->name()).
224              
225             =back
226              
227             =cut
228              
229             sub apiname {
230 0     0 1 0 return $_[0]->data()->{'apiname'};
231             }
232              
233             =head2 issymbol
234              
235             $issymbol = $font->issymbol()
236              
237             =over
238              
239             Return the font's symbol flag (i.e., is this a symbol font).
240              
241             =back
242              
243             =cut
244              
245             sub issymbol {
246 74     74 1 264 return $_[0]->data()->{'issymbol'};
247             }
248              
249             =head2 iscff
250              
251             $iscff = $font->iscff()
252              
253             =over
254              
255             Return the font's Compact Font Format flag.
256              
257             =back
258              
259             =cut
260              
261             sub iscff {
262 0     0 1 0 return $_[0]->data()->{'iscff'};
263             }
264              
265             =head1 TYPOGRAPHY-RELATED METHODS
266              
267             =head2 upem
268              
269             $upem = $font->upem()
270              
271             =over
272              
273             Return the font's scaling factor (Units Per em). It is typically 1000 in most
274             fonts, but more recent TTF and OTF fonts often use 2048 units.
275              
276             =back
277              
278             =cut
279              
280             sub upem {
281 0     0 1 0 my $upem = $_[0]->data()->{'upem'};
282 0 0       0 if (!defined $upem) { $upem = 1000; }
  0         0  
283 0         0 return $upem;
284             }
285              
286             =head2 fontbbox
287              
288             ($llx,$lly, $urx,$ury) = $font->fontbbox()
289              
290             =over
291              
292             Return the font's bounding box.
293              
294             =back
295              
296             =cut
297              
298             sub fontbbox {
299 1     1 1 4 my @bbox = @{$_[0]->data()->{'fontbbox'}};
  1         4  
300             # rearrange to LL UR order
301 1 50       5 if ($bbox[0] > $bbox[2]) {
302 0         0 @bbox = ($bbox[2], $bbox[3], $bbox[0], $bbox[1]);
303             }
304 1         4 return @bbox;
305             }
306              
307             =head2 capheight
308              
309             $capheight = $font->capheight()
310              
311             =over
312              
313             Return the font's capheight value.
314              
315             =back
316              
317             =cut
318              
319             sub capheight {
320 1     1 1 4 return $_[0]->data()->{'capheight'};
321             }
322              
323             =head2 xheight
324              
325             $xheight = $font->xheight()
326              
327             =over
328              
329             Return the font's xheight value.
330              
331             =back
332              
333             =cut
334              
335             sub xheight {
336 1     1 1 3 return $_[0]->data()->{'xheight'};
337             }
338              
339             =head2 missingwidth
340              
341             $missingwidth = $font->missingwidth()
342              
343             =over
344              
345             Return the font's missingwidth value.
346              
347             =back
348              
349             =cut
350              
351             sub missingwidth {
352 115     115 1 275 return $_[0]->data()->{'missingwidth'};
353             }
354              
355             =head2 maxwidth
356              
357             $maxwidth = $font->maxwidth()
358              
359             =over
360              
361             Return the font's maxwidth value.
362              
363             =back
364              
365             =cut
366              
367             sub maxwidth {
368 1     1 1 2 return $_[0]->data()->{'maxwidth'};
369             }
370              
371             =head2 avgwidth
372              
373             $avgwidth = $font->avgwidth()
374              
375             =over
376              
377             Return the font's avgwidth (average width) value.
378              
379             =back
380              
381             =cut
382              
383             sub avgwidth {
384 1     1 1 3 my ($self) = @_;
385              
386 1         4 my $aw = $self->data()->{'avgwidth'};
387 1   33     16 $aw ||= ((
388             # numbers are character-frequency weighting counts
389             # presumably for English text... ? it may be a little off for
390             # other languages
391             $self->wxByGlyph('a')*64 +
392             $self->wxByGlyph('b')*14 +
393             $self->wxByGlyph('c')*27 +
394             $self->wxByGlyph('d')*35 +
395             $self->wxByGlyph('e')*100 +
396             $self->wxByGlyph('f')*20 +
397             $self->wxByGlyph('g')*14 +
398             $self->wxByGlyph('h')*42 +
399             $self->wxByGlyph('i')*63 +
400             $self->wxByGlyph('j')* 3 +
401             $self->wxByGlyph('k')* 6 +
402             $self->wxByGlyph('l')*35 +
403             $self->wxByGlyph('m')*20 +
404             $self->wxByGlyph('n')*56 +
405             $self->wxByGlyph('o')*56 +
406             $self->wxByGlyph('p')*17 +
407             $self->wxByGlyph('q')* 4 +
408             $self->wxByGlyph('r')*49 +
409             $self->wxByGlyph('s')*56 +
410             $self->wxByGlyph('t')*71 +
411             $self->wxByGlyph('u')*31 +
412             $self->wxByGlyph('v')*10 +
413             $self->wxByGlyph('w')*18 +
414             $self->wxByGlyph('x')* 3 +
415             $self->wxByGlyph('y')*18 +
416             $self->wxByGlyph('z')* 2 +
417             $self->wxByGlyph('A')*64 +
418             $self->wxByGlyph('B')*14 +
419             $self->wxByGlyph('C')*27 +
420             $self->wxByGlyph('D')*35 +
421             $self->wxByGlyph('E')*100 +
422             $self->wxByGlyph('F')*20 +
423             $self->wxByGlyph('G')*14 +
424             $self->wxByGlyph('H')*42 +
425             $self->wxByGlyph('I')*63 +
426             $self->wxByGlyph('J')* 3 +
427             $self->wxByGlyph('K')* 6 +
428             $self->wxByGlyph('L')*35 +
429             $self->wxByGlyph('M')*20 +
430             $self->wxByGlyph('N')*56 +
431             $self->wxByGlyph('O')*56 +
432             $self->wxByGlyph('P')*17 +
433             $self->wxByGlyph('Q')* 4 +
434             $self->wxByGlyph('R')*49 +
435             $self->wxByGlyph('S')*56 +
436             $self->wxByGlyph('T')*71 +
437             $self->wxByGlyph('U')*31 +
438             $self->wxByGlyph('V')*10 +
439             $self->wxByGlyph('W')*18 +
440             $self->wxByGlyph('X')* 3 +
441             $self->wxByGlyph('Y')*18 +
442             $self->wxByGlyph('Z')* 2 +
443             $self->wxByGlyph('space')*332
444             ) / 2000);
445              
446 1         8 return int($aw);
447             }
448              
449             =head2 flags
450              
451             $flags = $font->flags()
452              
453             =over
454              
455             Return the font's flags value.
456              
457             =back
458              
459             =cut
460              
461             sub flags {
462 1     1 1 2 return $_[0]->data()->{'flags'};
463             }
464              
465             =head2 stemv
466              
467             $stemv = $font->stemv()
468              
469             =over
470              
471             Return the font's stemv value.
472              
473             =back
474              
475             =cut
476              
477             sub stemv {
478 1     1 1 5 return $_[0]->data()->{'stemv'};
479             }
480              
481             =head2 stemh
482              
483             $stemh = $font->stemh()
484              
485             =over
486              
487             Return the font's stemh value.
488              
489             =back
490              
491             =cut
492              
493             sub stemh {
494 1     1 1 5 return $_[0]->data()->{'stemh'};
495             }
496              
497             =head2 italicangle
498              
499             $italicangle = $font->italicangle()
500              
501             =over
502              
503             Return the font's italicangle (slant, obliqueness) value.
504              
505             =back
506              
507             =cut
508              
509             sub italicangle {
510 1     1 1 158 return $_[0]->data()->{'italicangle'};
511             }
512              
513             =head2 isfixedpitch
514              
515             $isfixedpitch = $font->isfixedpitch()
516              
517             =over
518              
519             Return the font's isfixedpitch flag.
520              
521             =back
522              
523             =cut
524              
525             sub isfixedpitch {
526 0     0 1 0 return $_[0]->data()->{'isfixedpitch'};
527             }
528              
529             =head2 underlineposition
530              
531             $underlineposition = $font->underlineposition()
532              
533             =over
534              
535             Return the font's underlineposition value.
536              
537             =back
538              
539             =cut
540              
541             sub underlineposition {
542 0     0 1 0 return $_[0]->data()->{'underlineposition'};
543             }
544              
545             =head2 underlinethickness
546              
547             $underlinethickness = $font->underlinethickness()
548              
549             =over
550              
551             Return the font's underlinethickness value.
552              
553             =back
554              
555             =cut
556              
557             sub underlinethickness {
558 0     0 1 0 return $_[0]->data()->{'underlinethickness'};
559             }
560              
561             =head2 ascender
562              
563             $ascender = $font->ascender()
564              
565             =over
566              
567             Return the font's ascender value.
568              
569             =back
570              
571             =cut
572              
573             sub ascender {
574 1     1 1 4 return $_[0]->data()->{'ascender'};
575             }
576              
577             =head2 descender
578              
579             $descender = $font->descender()
580              
581             =over
582              
583             Return the font's descender value.
584              
585             =back
586              
587             =cut
588              
589             sub descender {
590 1     1 1 5 return $_[0]->data()->{'descender'};
591             }
592              
593             =head1 GLYPH-RELATED METHODS
594              
595             =head2 glyphNames
596              
597             @names = $font->glyphNames()
598              
599             =over
600              
601             Return the defined glyph names of the font.
602              
603             =back
604              
605             =cut
606              
607             sub glyphNames {
608 0     0 1 0 return keys %{$_[0]->data()->{'wx'}};
  0         0  
609             }
610              
611             =head2 glyphNum
612              
613             $glNum = $font->glyphNum()
614              
615             =over
616              
617             Return the number of defined glyph names of the font.
618              
619             =back
620              
621             =cut
622              
623             sub glyphNum {
624             #my $self = shift();
625             #return scalar $self->glyphNames();
626 0     0 1 0 return scalar keys %{$_[0]->data()->{'wx'}};
  0         0  
627             }
628              
629             =head2 uniByGlyph
630              
631             $uni = $font->uniByGlyph($char)
632              
633             =over
634              
635             Return the unicode by glyph name.
636              
637             =back
638              
639             =cut
640              
641             sub uniByGlyph {
642             #my ($self, $name) = @_;
643             #return $self->data()->{'n2u'}->{$name};
644 0     0 1 0 return $_[0]->data()->{'n2u'}->{$_[1]};
645             }
646              
647             =head2 uniByEnc
648              
649             $uni = $font->uniByEnc($char)
650              
651             =over
652              
653             Return the Unicode by the font's encoding map.
654              
655             =back
656              
657             =cut
658              
659             sub uniByEnc {
660 256     256 1 517 my ($self, $enc) = @_;
661 256         492 my $uni = $self->data()->{'e2u'}->[$enc];
662             # fallback to U+0000 if no match
663 256 50       549 $uni = 0 unless defined $uni;
664 256         801 return $uni;
665             }
666              
667             =head2 uniByMap
668              
669             $uni = $font->uniByMap($char)
670              
671             =over
672              
673             Return the Unicode by the font's default map.
674              
675             =back
676              
677             =cut
678              
679             sub uniByMap {
680 0     0 1 0 return $_[0]->data()->{'uni'}->[$_[1]];
681             }
682              
683             =head2 encByGlyph
684              
685             $char = $font->encByGlyph($glyph)
686              
687             =over
688              
689             Return the character by the given glyph name of the font's encoding map.
690              
691             =back
692              
693             =cut
694              
695             sub encByGlyph {
696 0   0 0 1 0 return $_[0]->data()->{'n2e'}->{$_[1]} || 0;
697             }
698              
699             =head2 encByUni
700              
701             $char = $font->encByUni($uni)
702              
703             =over
704              
705             Return the character by the given Unicode of the font's encoding map.
706              
707             =back
708              
709             =cut
710              
711             sub encByUni {
712             return $_[0]->data()->{'u2e'}->{$_[1]} ||
713 18   50 18 1 28 $_[0]->data()->{'u2c'}->{$_[1]} ||
714             0;
715             }
716              
717             =head2 mapByGlyph
718              
719             $char = $font->mapByGlyph($glyph)
720              
721             =over
722              
723             Return the character by the given glyph name of the font's default map.
724              
725             =back
726              
727             =cut
728              
729             sub mapByGlyph {
730 0   0 0 1 0 return $_[0]->data()->{'n2c'}->{$_[1]} || 0;
731             }
732              
733             =head2 mapByUni
734              
735             $char = $font->mapByUni($uni)
736              
737             =over
738              
739             Return the character by the given Unicode of the font's default map.
740              
741             =back
742              
743             =cut
744              
745             sub mapByUni {
746 0   0 0 1 0 return $_[0]->data()->{'u2c'}->{$_[1]} || 0;
747             }
748              
749             =head2 glyphByUni
750              
751             $name = $font->glyphByUni($unicode)
752              
753             =over
754              
755             Return the glyph's name by the font's Unicode map.
756             B<CAUTION:> non-standard glyph-names are mapped onto
757             the ms-symbol area (0xF000).
758              
759             =back
760              
761             =cut
762              
763             sub glyphByUni {
764 0   0 0 1 0 return $_[0]->data()->{'u2n'}->{$_[1]} || '.notdef';
765             }
766              
767             =head2 glyphByEnc
768              
769             $name = $font->glyphByEnc($char)
770              
771             =over
772              
773             Return the glyph's name by the font's encoding map.
774              
775             =back
776              
777             =cut
778              
779             sub glyphByEnc {
780 18170     18170 1 32322 return $_[0]->data()->{'e2n'}->[$_[1]];
781             }
782              
783             =head2 glyphByMap
784              
785             $name = $font->glyphByMap($char)
786              
787             =over
788              
789             Return the glyph's name by the font's default map.
790              
791             =back
792              
793             =cut
794              
795             sub glyphByMap {
796 0     0 1 0 return $_[0]->data()->{'char'}->[$_[1]];
797             }
798              
799             =head2 wxByGlyph
800              
801             $width = $font->wxByGlyph($glyph)
802              
803             =over
804              
805             Return the glyph's width.
806             This is a value, that when divided by 1000 and multiplied by
807             the font size (height in points), gives the advance width to the
808             next character's start. Typically, the width will be under 1000.
809              
810             =back
811              
812             =cut
813              
814             sub wxByGlyph {
815 53     53 1 95 my ($self, $glyph) = @_;
816              
817 53         55 my $width;
818 53 50       79 if (ref($self->data()->{'wx'}) eq 'HASH') {
819 0 0       0 $width = $self->data()->{'wx'}->{$glyph} if defined $glyph;
820             } else {
821 53         87 my $cid = $self->cidByUni(uniByName($glyph));
822 53 50       101 $width = $self->data()->{'wx'}->[$cid] if defined $cid;
823             }
824 53   33     85 $width //= $self->missingwidth();
825 53   50     78 $width //= 300;
826              
827 53         152 return $width;
828             }
829              
830             =head2 wxByUni
831              
832             $width = $font->wxByUni($uni)
833              
834             =over
835              
836             Return the Unicode character's width.
837             This is a value, that when divided by 1000 and multiplied by
838             the font size (height in points), gives the advance width to the
839             next character's start. Typically, the width will be under 1000.
840              
841             =back
842              
843             =cut
844              
845             sub wxByUni {
846 0     0 1 0 my ($self, $uni) = @_;
847 0         0 my ($gid, $width);
848              
849 0 0       0 $gid = $self->glyphByUni($uni) if defined $uni;
850 0 0       0 $width = $self->data()->{'wx'}->{$gid} if defined $gid;
851 0   0     0 $width //= $self->missingwidth();
852 0   0     0 $width //= 300;
853              
854 0         0 return $width;
855             }
856              
857             =head2 wxByEnc
858              
859             $width = $font->wxByEnc($char)
860              
861             =over
862              
863             Return the character's width based on the current encoding.
864             This is a value, that when divided by 1000 and multiplied by
865             the font size (height in points), gives the advance width to the
866             next character's start. Typically, the width will be under 1000.
867              
868             =back
869              
870             =cut
871              
872             sub wxByEnc {
873 8698     8698 1 14037 my ($self, $char) = @_;
874              
875 8698         11857 my $glyph;
876 8698 50       20291 $glyph = $self->glyphByEnc($char) if defined $char;
877 8698         12572 my $width;
878 8698 50       18318 $width = $self->data()->{'wx'}->{$glyph} if defined $glyph;
879              
880 8698   100     18660 $width //= $self->missingwidth();
881 8698   100     15471 $width //= 300;
882              
883 8698         19904 return $width;
884             }
885              
886             =head2 wxMissingByEnc
887              
888             $flag = $font->wxMissingByEnc($char)
889              
890             =over
891              
892             Return true if the character's width (based on the current encoding) is
893             supplied by "missing width" of font.
894              
895             =back
896              
897             =cut
898              
899             sub wxMissingByEnc {
900 0     0 1 0 my ($self, $char) = @_;
901              
902 0         0 my $glyph = $self->glyphByEnc($char);
903 0         0 my $width = $self->data()->{'wx'}->{$glyph};
904              
905 0         0 return !defined($width);
906             }
907              
908             =head2 wxByMap
909              
910             $width = $font->wxByMap($char)
911              
912             =over
913              
914             Return the character's width based on the font's default encoding.
915             This is a value, that when divided by 1000 and multiplied by
916             the font size (height in points), gives the advance width to the
917             next character's start. Typically, the width will be under 1000.
918              
919             =back
920              
921             =cut
922              
923             sub wxByMap {
924 0     0 1 0 my ($self, $char) = @_;
925              
926 0         0 my $glyph;
927 0 0       0 $glyph = $self->glyphByMap($char) if defined $char;
928 0         0 my $width;
929 0 0       0 $width = $self->data()->{'wx'}->{$glyph} if defined $glyph;
930 0   0     0 $width //= $self->missingwidth();
931 0   0     0 $width //= 300;
932              
933 0         0 return $width;
934             }
935              
936             =head2 width
937              
938             $wd = $font->width($text)
939              
940             =over
941              
942             Return the width of $text as if it were at font size 1 (unscaled).
943             B<CAUTION:> works correctly only if a proper Perl string
944             is used, either in native or UTF-8 format (check utf8-flag).
945              
946             =back
947              
948             =cut
949              
950             sub width {
951 182     182 1 390 my ($self, $text) = @_;
952              
953 182 100       588 $text = $self->strByUtf($text) if utf8::is_utf8($text);
954              
955 182         304 my @cache;
956 182         326 my $width = 0;
957 182   33     484 my $kern = $self->{'-dokern'} && ref($self->data()->{'kern'});
958 182         293 my $last_glyph = '';
959 182         548 foreach my $n (unpack('C*',$text)) {
960 2287   66     4705 $cache[$n] //= $self->wxByEnc($n);
961 2287         3366 $width += $cache[$n];
962 2287 50       4683 if ($kern) {
963 0         0 my $glyph = $self->data()->{'e2n'}->[$n];
964 0   0     0 $width += ($self->data()->{'kern'}->{$last_glyph . ':' . $glyph} // 0);
965 0         0 $last_glyph = $glyph;
966             }
967             }
968 182         415 $width /= 1000;
969 182         747 return $width;
970             }
971              
972             =head2 width_array
973              
974             @widths = $font->width_array($text)
975              
976             =over
977              
978             Return (as an array) the widths of the words in $text as if they were at size 1.
979              
980             =back
981              
982             =cut
983              
984             sub width_array {
985 0     0 1 0 my ($self, $text) = @_;
986              
987 0 0       0 $text = $self->utfByStr($text) unless utf8::is_utf8($text);
988 0         0 my @widths = map { $self->width($_) } split(/\s+/, $text);
  0         0  
989 0         0 return @widths;
990             }
991              
992             =head2 utfByStr
993              
994             $utf8string = $font->utfByStr($string)
995              
996             =over
997              
998             Return the utf8-string from string based on the font's encoding map.
999              
1000             =back
1001              
1002             =cut
1003              
1004             sub utfByStr {
1005 0     0 1 0 my ($self, $string) = @_;
1006              
1007 0         0 $string = pack('U*', map { $self->uniByEnc($_) } unpack('C*', $string));
  0         0  
1008 0         0 utf8::upgrade($string);
1009 0         0 return $string;
1010             }
1011              
1012             =head2 strByUtf
1013              
1014             $string = $font->strByUtf($utf8_string)
1015              
1016             =over
1017              
1018             Return the encoded string from utf8-string based on the font's encoding map.
1019              
1020             =back
1021              
1022             =cut
1023              
1024             sub strByUtf {
1025 6     6 1 9 my ($self, $utf8_string) = @_;
1026              
1027 6         13 $utf8_string = pack('C*', map { $self->encByUni($_) & 0xFF } unpack('U*', $utf8_string));
  18         25  
1028 6         14 utf8::downgrade($utf8_string);
1029 6         9 return $utf8_string;
1030             }
1031              
1032             =head2 textByStr
1033              
1034             $pdf_string = $font->textByStr($string)
1035              
1036             =over
1037              
1038             Return a properly formatted representation of $string for use in the PDF.
1039              
1040             =back
1041              
1042             =cut
1043              
1044             sub textByStr {
1045 31     31 1 68 my ($self, $string) = @_;
1046              
1047 31 50       78 if (not defined $string) { $string = ''; }
  0         0  
1048 31 100       250 $string = $self->strByUtf($string) if utf8::is_utf8($string);
1049 31         57 my $text = $string;
1050 31         91 $text =~ s/\\/\\\\/go;
1051 31         107 $text =~ s/([\x00-\x1f])/sprintf('\%03lo',ord($1))/ge;
  0         0  
1052 31         71 $text =~ s/([\{\}\[\]\(\)])/\\$1/g;
1053              
1054 31         79 return $text;
1055             }
1056              
1057             =head2 textByStrKern
1058              
1059             $pdf_string = $font->textByStrKern($string)
1060              
1061             =over
1062              
1063             Return a properly formatted representation of $string, with kerning,
1064             for use in the PDF.
1065              
1066             =back
1067              
1068             =cut
1069              
1070             sub textByStrKern {
1071 0     0 1 0 my ($self, $string) = @_;
1072              
1073 0 0 0     0 return '(' . $self->textByStr($string) . ')' unless $self->{'-dokern'} && ref($self->data()->{'kern'});
1074 0 0       0 $string = $self->strByUtf($string) if utf8::is_utf8($string);
1075              
1076 0         0 my $text = ' ';
1077 0         0 my $tBefore = 0;
1078 0         0 my $last_glyph = '';
1079              
1080 0         0 foreach my $n (unpack('C*', $string)) {
1081 0         0 my $glyph = $self->data()->{'e2n'}->[$n];
1082 0 0       0 if (defined $self->data()->{'kern'}->{$last_glyph . ':' . $glyph}) {
1083 0 0       0 $text .= ') ' if $tBefore;
1084 0         0 $text .= sprintf('%i ', -($self->data()->{'kern'}->{$last_glyph . ':' . $glyph}));
1085 0         0 $tBefore = 0;
1086             }
1087 0         0 $last_glyph = $glyph;
1088 0         0 my $t = pack('C', $n);
1089 0         0 $t =~ s/\\/\\\\/go;
1090 0         0 $t =~ s/([\x00-\x1f])/sprintf('\%03lo',ord($1))/ge;
  0         0  
1091 0         0 $t =~ s/([\{\}\[\]\(\)])/\\$1/g;
1092 0 0       0 $text .= '(' unless $tBefore;
1093 0         0 $text .= "$t";
1094 0         0 $tBefore = 1;
1095             }
1096 0 0       0 $text .= ') ' if $tBefore;
1097 0         0 return $text;
1098             }
1099              
1100             # Maintainer's note: $size here is used solely as a flag to determine whether or
1101             # not to append a text-showing operator (TJ or Tj).
1102             sub text {
1103 31     31 0 116 my ($self, $string, $size, $indent) = @_;
1104 31 50       94 if (not defined $string) { $string = ''; }
  0         0  
1105 31         126 my $text = $self->textByStr($string);
1106              
1107 31 50 33     190 if (defined $size && $self->{'-dokern'}) {
    50          
1108 0         0 $text = $self->textByStrKern($string);
1109 0 0       0 return "[ $indent $text ] TJ" if $indent;
1110 0         0 return "[ $text ] TJ";
1111             } elsif (defined $size) {
1112 31 100       160 return "[ $indent ($text) ] TJ" if $indent;
1113 19         97 return "($text) Tj";
1114             } else {
1115             # will need a later Tj operator to actually see this!
1116 0         0 return "($text)";
1117             }
1118             }
1119              
1120             sub isvirtual {
1121 32     32 0 132 return;
1122             }
1123              
1124             1;