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